]> Repositorios git - scryer-prolog.git/commitdiff
port '$get_from_list' to '$get_from_attr_list' in Rust
authorMark Thom <[email protected]>
Mon, 6 Feb 2023 08:23:29 +0000 (01:23 -0700)
committerMark Thom <[email protected]>
Mon, 6 Feb 2023 08:23:29 +0000 (01:23 -0700)
build/instructions_template.rs
src/lib/atts.pl
src/machine/dispatch.rs
src/machine/system_calls.rs

index 48166239d1153953bb2f40d8104b98aa37ab5817..23c96068289bacbaf994696a9213837a5bf25626 100644 (file)
@@ -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(_) |
index 372a9bdd052e078ec7d324a6b1f3a88adcab8d4f..752be478a886e11c32b9aa7e0532b4344766df47 100644 (file)
@@ -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),
index 89fa348a8f5166ec3ab4647fff9d2791f362e04d..5ea18ba46cfe993851293908a976f65f0da3e5c3 100644 (file)
@@ -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);
+                }
             }
         }
 
index 93dcdb092fd08e93a8f009af05cb716bd2d2af4d..a41d4aefa6f6f1fce5c59c8426ce2d3472935fc2 100644 (file)
@@ -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);