From: Mark Thom <markjordanthom@gmail.com>
Date: Sun, 1 Jan 2023 22:54:51 +0000 (-0700)
Subject: optimize register allocations for tails of lists (#1612)
X-Git-Url: https://git.sagredo.dev/?a=commitdiff_plain;h=fd19128530f68c4623e9df5d0eab6042f62ac8c6;p=scryer-prolog.git

optimize register allocations for tails of lists (#1612)
---

diff --git a/src/codegen.rs b/src/codegen.rs
index 6f722336..c44ce843 100644
--- a/src/codegen.rs
+++ b/src/codegen.rs
@@ -242,6 +242,70 @@ fn trim_structure_by_last_arg(instr: &mut Instruction, last_arg: &Term) {
     }
 }
 
+trait ConsCompile<'a>: CompilationTarget<'a> {
+    fn compile_cons(
+        cg: &mut CodeGenerator,
+        lvl: Level,
+        term_loc: GenContext,
+        head: &'a Term,
+        tail: &'a Term,
+        cell: &'a Cell<RegType>,
+        is_exposed: bool,
+        target: &mut Code,
+    );
+}
+
+impl<'a> ConsCompile<'a> for FactInstruction {
+    fn compile_cons(
+        cg: &mut CodeGenerator,
+        lvl: Level,
+        term_loc: GenContext,
+        head: &'a Term,
+        tail: &'a Term,
+        cell: &'a Cell<RegType>,
+        is_exposed: bool,
+        target: &mut Code,
+    ) {
+        cg.marker.mark_non_var::<FactInstruction>(lvl, term_loc, cell, target);
+        target.push(FactInstruction::to_list(lvl, cell.get()));
+
+        cg.subterm_to_instr::<FactInstruction>(head, term_loc, is_exposed, target);
+        cg.subterm_to_instr::<FactInstruction>(tail, term_loc, is_exposed, target);
+    }
+}
+
+impl<'a> ConsCompile<'a> for QueryInstruction {
+    fn compile_cons(
+        cg: &mut CodeGenerator,
+        lvl: Level,
+        term_loc: GenContext,
+        head: &'a Term,
+        tail: &'a Term,
+        cell: &'a Cell<RegType>,
+        is_exposed: bool,
+        target: &mut Code,
+    ) {
+        let mut r_opt = None;
+
+        if let Term::Cons(..) = tail {
+            if lvl == Level::Deep {
+                r_opt = Some(cell.get());
+            }
+        }
+
+        cg.marker.mark_non_var::<QueryInstruction>(lvl, term_loc, cell, target);
+        cg.subterm_to_instr::<QueryInstruction>(head, term_loc, is_exposed, target);
+
+        if let Some(r) = r_opt {
+            target.push(QueryInstruction::clause_arg_to_instr(r));
+        } else {
+            cg.subterm_to_instr::<QueryInstruction>(tail, term_loc, is_exposed, target);
+        }
+
+        target.push(QueryInstruction::to_list(lvl, cell.get()));
+    }
+}
+
 impl<'b> CodeGenerator<'b> {
     pub(crate) fn new(atom_tbl: &'b mut AtomTable, settings: CodeGenSettings) -> Self {
         CodeGenerator {
@@ -334,7 +398,7 @@ impl<'b> CodeGenerator<'b> {
         is_exposed: bool,
     ) -> Code
     where
-        Target: crate::targets::CompilationTarget<'a>,
+        Target: crate::targets::CompilationTarget<'a> + ConsCompile<'a>,
         Iter: Iterator<Item = TermRef<'a>>,
     {
         let mut target: Code = Vec::new();
@@ -363,11 +427,16 @@ impl<'b> CodeGenerator<'b> {
                     }
                 }
                 TermRef::Cons(lvl, cell, head, tail) => {
-                    self.marker.mark_non_var::<Target>(lvl, term_loc, cell, &mut target);
-                    target.push(Target::to_list(lvl, cell.get()));
-
-                    self.subterm_to_instr::<Target>(head, term_loc, is_exposed, &mut target);
-                    self.subterm_to_instr::<Target>(tail, term_loc, is_exposed, &mut target);
+                    Target::compile_cons(
+                        self,
+                        lvl,
+                        term_loc,
+                        head,
+                        tail,
+                        cell,
+                        is_exposed,
+                        &mut target,
+                    );
                 }
                 TermRef::Literal(lvl @ Level::Shallow, cell, Literal::String(ref string)) => {
                     self.marker.mark_non_var::<Target>(lvl, term_loc, cell, &mut target);
diff --git a/src/iterators.rs b/src/iterators.rs
index 62054b04..94426f1e 100644
--- a/src/iterators.rs
+++ b/src/iterators.rs
@@ -77,8 +77,7 @@ pub(crate) struct QueryIterator<'a> {
 
 impl<'a> QueryIterator<'a> {
     fn push_subterm(&mut self, lvl: Level, term: &'a Term) {
-        self.state_stack
-            .push(TermIterState::subterm_to_state(lvl, term));
+        self.state_stack.push(TermIterState::subterm_to_state(lvl, term));
     }
 
     fn from_rule_head_clause(terms: &'a Vec<Term>) -> Self {
@@ -193,7 +192,29 @@ impl<'a> Iterator for QueryIterator<'a> {
                 TermIterState::InitialCons(lvl, cell, head, tail) => {
                     self.state_stack.push(TermIterState::FinalCons(lvl, cell, head, tail));
 
-                    self.push_subterm(lvl.child_level(), tail);
+                    if let Term::Cons(inner_cell, inner_head, inner_tail) = tail {
+                        // if the lvl is shallow, we've encountered
+                        // the first cons cell of a list. for all
+                        // remaining cons cells in the list, use the
+                        // parent cons' register cell so that the same
+                        // register is used across all the put_list
+                        // instructions for this list except the head.
+
+                        self.state_stack.push(TermIterState::InitialCons(
+                            lvl.child_level(),
+                            if let Level::Deep = lvl {
+                                cell
+                            } else {
+                                inner_cell
+                            },
+                            inner_head.as_ref(),
+                            inner_tail.as_ref(),
+                        ));
+                    } else {
+                        self.push_subterm(lvl.child_level(), tail);
+                    }
+
+                    // self.push_subterm(lvl.child_level(), tail);
                     self.push_subterm(lvl.child_level(), head);
                 }
                 TermIterState::InitialPartialString(lvl, cell, string, tail) => {
diff --git a/src/machine/dispatch.rs b/src/machine/dispatch.rs
index d3a6a9e1..ade7f6be 100644
--- a/src/machine/dispatch.rs
+++ b/src/machine/dispatch.rs
@@ -3202,7 +3202,9 @@ impl Machine {
                     self.machine_st.p += 1;
                 }
                 &Instruction::PutList(_, reg) => {
-                    self.machine_st[reg] = list_loc_as_cell!(self.machine_st.heap.len());
+                    // subtract 2 because the instructions to emit the terms to the heap
+                    // precede this instruction.
+                    self.machine_st[reg] = list_loc_as_cell!(self.machine_st.heap.len() - 2);
                     self.machine_st.p += 1;
                 }
                 &Instruction::PutPartialString(_, string, reg, has_tail) => {