From: Mark Thom <markjordanthom@gmail.com>
Date: Mon, 6 Feb 2023 08:23:29 +0000 (-0700)
Subject: port '$get_from_list' to '$get_from_attr_list' in Rust
X-Git-Tag: v0.9.2~191
X-Git-Url: https://git.sagredo.dev/?a=commitdiff_plain;h=9454d670c778d41ca45f45f584fd2f26267f2750;p=scryer-prolog.git

port '$get_from_list' to '$get_from_attr_list' in Rust
---

diff --git a/build/instructions_template.rs b/build/instructions_template.rs
index 48166239..23c96068 100644
--- a/build/instructions_template.rs
+++ b/build/instructions_template.rs
@@ -566,6 +566,8 @@ enum SystemClauseType {
     GetClauseP,
     #[strum_discriminants(strum(props(Arity = "6", Name = "$invoke_clause_at_p")))]
     InvokeClauseAtP,
+    #[strum_discriminants(strum(props(Arity = "2", Name = "$get_from_attr_list")))]
+    GetFromAttributedVarList,
     REPL(REPLCodePtr),
 }
 
@@ -1626,6 +1628,7 @@ fn generate_instruction_preface() -> TokenStream {
                     &Instruction::CallIsExpandedOrInlined(_) |
                     &Instruction::CallGetClauseP(_) |
                     &Instruction::CallInvokeClauseAtP(_) |
+                    &Instruction::CallGetFromAttributedVarList(_) |
                     &Instruction::CallEnqueueAttributedVar(_) |
                     &Instruction::CallFetchGlobalVar(_) |
                     &Instruction::CallFirstStream(_) |
@@ -1841,6 +1844,7 @@ fn generate_instruction_preface() -> TokenStream {
                     &Instruction::ExecuteIsExpandedOrInlined(_) |
                     &Instruction::ExecuteGetClauseP(_) |
                     &Instruction::ExecuteInvokeClauseAtP(_) |
+                    &Instruction::ExecuteGetFromAttributedVarList(_) |
                     &Instruction::ExecuteEnqueueAttributedVar(_) |
                     &Instruction::ExecuteFetchGlobalVar(_) |
                     &Instruction::ExecuteFirstStream(_) |
diff --git a/src/lib/atts.pl b/src/lib/atts.pl
index 372a9bdd..752be478 100644
--- a/src/lib/atts.pl
+++ b/src/lib/atts.pl
@@ -34,8 +34,9 @@
 '$get_attr'(V, Attr) :-
     '$get_attr_list'(V, Ls),
     nonvar(Ls),
-    '$get_from_list'(Ls, V, Attr).
+    '$get_from_attr_list'(Ls, Attr).
 
+/*
 '$get_from_list'([L|Ls], V, Attr) :-
     nonvar(L),
     (  L \= Attr ->
@@ -43,6 +44,7 @@
        '$get_from_list'(Ls, V, Attr)
     ;  L = Attr
     ).
+*/
 
 '$put_attr'(V, Attr) :-
     '$get_attr_list'(V, Ls),
diff --git a/src/machine/dispatch.rs b/src/machine/dispatch.rs
index 89fa348a..5ea18ba4 100644
--- a/src/machine/dispatch.rs
+++ b/src/machine/dispatch.rs
@@ -5207,6 +5207,14 @@ impl Machine {
 
                     self.machine_st.execute_at_index(2, p);
                 }
+                &Instruction::CallGetFromAttributedVarList(_) => {
+                    self.get_from_attributed_variable_list();
+                    step_or_fail!(self, self.machine_st.p += 1);
+                }
+                &Instruction::ExecuteGetFromAttributedVarList(_) => {
+                    self.get_from_attributed_variable_list();
+                    step_or_fail!(self, self.machine_st.p = self.machine_st.cp);
+                }
             }
         }
 
diff --git a/src/machine/system_calls.rs b/src/machine/system_calls.rs
index 93dcdb09..a41d4aef 100644
--- a/src/machine/system_calls.rs
+++ b/src/machine/system_calls.rs
@@ -4328,6 +4328,71 @@ impl Machine {
         self.machine_st.bind(Ref::heap_cell(attr_var_list), list_addr);
     }
 
+    #[inline(always)]
+    pub(crate) fn get_from_attributed_variable_list(&mut self) {
+        let mut attrs_list = self.deref_register(1);
+        let attr = self.deref_register(2);
+
+        let (name, arity) = match self.machine_st.name_and_arity_from_heap(attr) {
+            Some(key) => key,
+            None => {
+                self.machine_st.fail = true;
+                return;
+            }
+        };
+
+        while let HeapCellValueTag::Lis = attrs_list.get_tag() {
+            let mut list_head = self.machine_st.heap[attrs_list.get_value()];
+
+            loop {
+                read_heap_cell!(list_head,
+                    (HeapCellValueTag::AttrVar | HeapCellValueTag::Var, h) => {
+                        if list_head != self.machine_st.heap[h] {
+                            list_head = self.machine_st.heap[h];
+                        } else {
+                            self.machine_st.fail = true;
+                            return;
+                        }
+                    }
+                    (HeapCellValueTag::Str | HeapCellValueTag::Atom) => {
+                        let (t_name, t_arity) = self.machine_st
+                            .name_and_arity_from_heap(list_head)
+                            .unwrap();
+
+                        if name == t_name && arity == t_arity {
+                            let old_tr = self.machine_st.tr;
+
+                            unify!(self.machine_st, list_head, attr);
+
+                            if self.machine_st.fail {
+                                let curr_tr = self.machine_st.trail.len();
+
+                                self.unwind_trail(old_tr, curr_tr);
+                                self.machine_st.tr = old_tr;
+
+                                self.machine_st.pdl.clear();
+                                self.machine_st.fail = false;
+                            } else {
+                                return;
+                            }
+                        }
+
+                        break;
+                    }
+                    _ => {
+                        break;
+                    }
+                );
+            }
+
+            attrs_list = self.machine_st.store(
+                self.machine_st.deref(self.machine_st.heap[attrs_list.get_value()+1])
+            );
+        }
+
+        self.machine_st.fail = true;
+    }
+
     #[inline(always)]
     pub(crate) fn get_attr_var_queue_delimiter(&mut self) {
         let addr = self.deref_register(1);