]> Repositorios git - scryer-prolog.git/commitdiff
add unknown flag to set_prolog_flag and current_prolog_flag setof_bagof_fixes origin/setof_bagof_fixes
authorMark <[email protected]>
Sat, 15 Jul 2023 01:10:10 +0000 (19:10 -0600)
committerMark <[email protected]>
Sat, 15 Jul 2023 01:10:10 +0000 (19:10 -0600)
build/instructions_template.rs
src/forms.rs
src/lib/builtins.pl
src/machine/dispatch.rs
src/machine/mod.rs
src/machine/system_calls.rs
src/parser/ast.rs

index 25fa6b1bac9d997cc749e1f45547966fa7cbc09f..a4c7294ea006ba446f4e75602947b2fb267d9c64 100644 (file)
@@ -410,6 +410,8 @@ enum SystemClauseType {
     GetCutPoint,
     #[strum_discriminants(strum(props(Arity = "1", Name = "$get_double_quotes")))]
     GetDoubleQuotes,
+    #[strum_discriminants(strum(props(Arity = "1", Name = "$get_unknown")))]
+    GetUnknown,
     #[strum_discriminants(strum(props(Arity = "1", Name = "$install_new_block")))]
     InstallNewBlock,
     #[strum_discriminants(strum(props(Arity = "0", Name = "$maybe")))]
@@ -438,6 +440,8 @@ enum SystemClauseType {
     SetCutPointByDefault(RegType),
     #[strum_discriminants(strum(props(Arity = "1", Name = "$set_double_quotes")))]
     SetDoubleQuotes,
+    #[strum_discriminants(strum(props(Arity = "1", Name = "$set_unknown")))]
+    SetUnknown,
     #[strum_discriminants(strum(props(Arity = "1", Name = "$set_seed")))]
     SetSeed,
     #[strum_discriminants(strum(props(Arity = "4", Name = "$skip_max_list")))]
@@ -1723,6 +1727,7 @@ fn generate_instruction_preface() -> TokenStream {
                     &Instruction::CallGetCurrentSCCBlock |
                     &Instruction::CallGetCutPoint |
                     &Instruction::CallGetDoubleQuotes |
+                    &Instruction::CallGetUnknown |
                     &Instruction::CallInstallNewBlock |
                     &Instruction::CallMaybe |
                     &Instruction::CallCpuNow |
@@ -1748,6 +1753,7 @@ fn generate_instruction_preface() -> TokenStream {
                     &Instruction::CallPopFromBallStack |
                     &Instruction::CallSetCutPointByDefault(..) |
                     &Instruction::CallSetDoubleQuotes |
+                    &Instruction::CallSetUnknown |
                     &Instruction::CallSetSeed |
                     &Instruction::CallSkipMaxList |
                     &Instruction::CallSleep |
@@ -1948,6 +1954,7 @@ fn generate_instruction_preface() -> TokenStream {
                     &Instruction::ExecuteGetCurrentSCCBlock |
                     &Instruction::ExecuteGetCutPoint |
                     &Instruction::ExecuteGetDoubleQuotes |
+                    &Instruction::ExecuteGetUnknown |
                     &Instruction::ExecuteInstallNewBlock |
                     &Instruction::ExecuteMaybe |
                     &Instruction::ExecuteCpuNow |
@@ -1973,6 +1980,7 @@ fn generate_instruction_preface() -> TokenStream {
                     &Instruction::ExecutePopFromBallStack |
                     &Instruction::ExecuteSetCutPointByDefault(_) |
                     &Instruction::ExecuteSetDoubleQuotes |
+                    &Instruction::ExecuteSetUnknown |
                     &Instruction::ExecuteSetSeed |
                     &Instruction::ExecuteSkipMaxList |
                     &Instruction::ExecuteSleep |
index ca5c7ffefb22a687f05a47142b2df66a3f50a7d5..2e04eb0efb146c0e7d09ac38558edc6a0c440b62 100644 (file)
@@ -55,7 +55,7 @@ impl AppendOrPrepend {
     }
 }
 
-#[derive(Debug)]
+#[derive(Debug, Clone, Copy)]
 pub enum VarComparison {
     Indistinct,
     Distinct
index 7769592613765d6caad7c66856e5d8ad694b1438..4d37710c97f0eef05913d6102a16e54ff3ca0beb 100644 (file)
@@ -140,7 +140,9 @@ call(_, _, _, _, _, _, _, _, _).
 %  * `occurs_check`: Returns if the occurs check is enabled. The occurs check prevents the creation cyclic terms.
 %    Historically the Prolog unification algorithm didn't do that check so changing the value modifies how Prolog
 %    operates in the low-level. Possible values are `false`  (default), `true` (unification has this check
-%    enabled) and `error` which throws an exception when a cylic term is created. Read ans write.
+%    enabled) and `error` which throws an exception when a cylic term is created. Read and write.
+%  * `unknown`: How undefined predicates are handled when called. Possible values are `error` (the default, an error is thrown),
+%    `fail` (the call silently fails) and `warn` (the call fails and a warning about the undefined predicate is printed).
 %
 current_prolog_flag(Flag, Value) :- Flag == max_arity, !, Value = 1023.
 current_prolog_flag(max_arity, 1023).
@@ -150,6 +152,8 @@ current_prolog_flag(Flag, Value) :- Flag == integer_rounding_function, !, Value
 current_prolog_flag(integer_rounding_function, toward_zero).
 current_prolog_flag(Flag, Value) :- Flag == double_quotes, !, '$get_double_quotes'(Value).
 current_prolog_flag(double_quotes, Value) :- '$get_double_quotes'(Value).
+current_prolog_flag(Flag, Value) :- Flag == unknown, !, '$get_unknown'(Value).
+current_prolog_flag(unknown, Value) :- '$get_unknown'(Value).
 current_prolog_flag(Flag, _) :- Flag == max_integer, !, '$fail'.
 current_prolog_flag(Flag, _) :- Flag == min_integer, !, '$fail'.
 current_prolog_flag(Flag, OccursCheckEnabled) :-
@@ -190,6 +194,12 @@ set_prolog_flag(double_quotes, atom) :-
     !, '$set_double_quotes'(atom). % 7.11.2.5, list of char codes (UTF8).
 set_prolog_flag(double_quotes, codes) :-
     !, '$set_double_quotes'(codes).
+set_prolog_flag(unknown, error) :-
+    !, '$set_unknown'(error).
+set_prolog_flag(unknown, warning) :-
+    !, '$set_unknown'(warning).
+set_prolog_flag(unknown, fail) :-
+    !, '$set_unknown'(fail).
 set_prolog_flag(occurs_check, true) :-
     !, '$set_sto_as_unify'.
 set_prolog_flag(occurs_check, false) :-
index a36bf29b978d8bc202ce5e450284266090c5d891..d73be74ffb64e5f8f40ec2da46f4d0a4e42477ce 100644 (file)
@@ -4194,6 +4194,14 @@ impl Machine {
                     self.get_double_quotes();
                     step_or_fail!(self, self.machine_st.p = self.machine_st.cp);
                 }
+                &Instruction::CallGetUnknown => {
+                    self.get_unknown();
+                    step_or_fail!(self, self.machine_st.p += 1);
+                }
+                &Instruction::ExecuteGetUnknown => {
+                    self.get_unknown();
+                    step_or_fail!(self, self.machine_st.p = self.machine_st.cp);
+                }
                 &Instruction::CallInstallNewBlock => {
                     self.machine_st.install_new_block(self.machine_st.registers[1]);
                     step_or_fail!(self, self.machine_st.p += 1);
@@ -4374,6 +4382,14 @@ impl Machine {
                     self.set_double_quotes();
                     step_or_fail!(self, self.machine_st.p = self.machine_st.cp);
                 }
+                &Instruction::CallSetUnknown => {
+                    self.set_unknown();
+                    step_or_fail!(self, self.machine_st.p += 1);
+                }
+                &Instruction::ExecuteSetUnknown => {
+                    self.set_unknown();
+                    step_or_fail!(self, self.machine_st.p = self.machine_st.cp);
+                }
                 &Instruction::CallSetSeed => {
                     self.set_seed();
                     step_or_fail!(self, self.machine_st.p += 1);
index 41cc4f394fc27e0d51ad041aa376e33613a84028..0dd44a1e91e82dcac3961100e3290153b78ea9ed 100644 (file)
@@ -1027,6 +1027,24 @@ impl Machine {
         self.machine_st.heap.truncate(target_h);
     }
 
+    #[inline(always)]
+    fn undefined_procedure(&mut self, name: Atom, arity: usize) -> CallResult {
+        match self.machine_st.flags.unknown {
+            Unknown::Error => {
+                Err(self.machine_st.throw_undefined_error(name, arity))
+            }
+            Unknown::Fail => {
+                self.machine_st.fail = true;
+                Ok(())
+            }
+            Unknown::Warn => {
+                println!("warning: predicate {}/{} is undefined", name.as_str(), arity);
+                self.machine_st.fail = true;
+                Ok(())
+            }
+        }
+    }
+
     #[inline(always)]
     fn try_call(&mut self, name: Atom, arity: usize, idx: IndexPtr) -> CallResult {
         let compiled_tl_index = idx.p() as usize;
@@ -1036,7 +1054,7 @@ impl Machine {
                 self.machine_st.fail = true;
             }
             IndexPtrTag::Undefined => {
-                return Err(self.machine_st.throw_undefined_error(name, arity));
+                return self.undefined_procedure(name, arity);
             }
             IndexPtrTag::DynamicIndex => {
                 self.machine_st.dynamic_mode = FirstOrNext::First;
@@ -1059,7 +1077,7 @@ impl Machine {
                 self.machine_st.fail = true;
             }
             IndexPtrTag::Undefined => {
-                return Err(self.machine_st.throw_undefined_error(name, arity));
+                return self.undefined_procedure(name, arity);
             }
             IndexPtrTag::DynamicIndex => {
                 self.machine_st.dynamic_mode = FirstOrNext::First;
@@ -1088,7 +1106,7 @@ impl Machine {
                 if let Some(idx) = module.code_dir.get(&(name, arity)).cloned() {
                     self.try_call(name, arity, idx.get())
                 } else {
-                    Err(self.machine_st.throw_undefined_error(name, arity))
+                    self.undefined_procedure(name, arity)
                 }
             } else {
                 let stub = functor_stub(name, arity);
@@ -1107,14 +1125,14 @@ impl Machine {
             if let Some(idx) = self.indices.code_dir.get(&(name, arity)).cloned() {
                 self.try_execute(name, arity, idx.get())
             } else {
-                Err(self.machine_st.throw_undefined_error(name, arity))
+                self.undefined_procedure(name, arity)
             }
         } else {
             if let Some(module) = self.indices.modules.get(&module_name) {
                 if let Some(idx) = module.code_dir.get(&(name, arity)).cloned() {
                     self.try_execute(name, arity, idx.get())
                 } else {
-                    Err(self.machine_st.throw_undefined_error(name, arity))
+                    self.undefined_procedure(name, arity)
                 }
             } else {
                 let stub = functor_stub(name, arity);
index 4a4965a20cfa1c0f93bb633379524abc9310cd76..26ac9e360487a6b3c5c315e5eae5cddd938ed023 100644 (file)
@@ -5187,6 +5187,20 @@ impl Machine {
         );
     }
 
+    #[inline(always)]
+    pub(crate) fn get_unknown(&mut self) {
+        let a1 = self.deref_register(1);
+
+        self.machine_st.unify_atom(
+            match self.machine_st.flags.unknown {
+                Unknown::Error => atom!("error"),
+                Unknown::Fail => atom!("fail"),
+                Unknown::Warn => atom!("warning"),
+            },
+            a1,
+        );
+    }
+
     #[inline(always)]
     pub(crate) fn get_scc_cleaner(&mut self) {
         let dest = self.machine_st.registers[1];
@@ -5521,7 +5535,7 @@ impl Machine {
 
     #[inline(always)]
     pub(crate) fn set_double_quotes(&mut self) {
-        let atom = cell_as_atom!(self.machine_st.registers[1]);
+        let atom = cell_as_atom!(self.deref_register(1));
 
         self.machine_st.flags.double_quotes = match atom {
             atom!("atom") => DoubleQuotes::Atom,
@@ -5534,6 +5548,21 @@ impl Machine {
         };
     }
 
+    #[inline(always)]
+    pub(crate) fn set_unknown(&mut self) {
+        let atom = cell_as_atom!(self.deref_register(1));
+
+        self.machine_st.flags.unknown = match atom {
+            atom!("error") => Unknown::Error,
+            atom!("fail") => Unknown::Fail,
+            atom!("warning") => Unknown::Warn,
+            _ => {
+                self.machine_st.fail = true;
+                return;
+            }
+        };
+    }
+
     #[inline(always)]
     pub(crate) fn inference_level(&mut self) {
         let a1 = self.deref_register(1);
index caed5915b76b92f4899c297fc4d7d731a600553b..68ebd0fa5fc98da8eefffc16adaa25512425faad 100644 (file)
@@ -303,12 +303,14 @@ pub type OpDir = IndexMap<(Atom, Fixity), OpDesc, FxBuildHasher>;
 #[derive(Debug, Clone, Copy)]
 pub struct MachineFlags {
     pub double_quotes: DoubleQuotes,
+    pub unknown: Unknown,
 }
 
 impl Default for MachineFlags {
     fn default() -> Self {
         MachineFlags {
             double_quotes: DoubleQuotes::default(),
+            unknown: Unknown::default(),
         }
     }
 }
@@ -340,6 +342,34 @@ impl Default for DoubleQuotes {
     }
 }
 
+#[derive(Debug, Clone, Copy)]
+pub enum Unknown {
+    Error,
+    Fail,
+    Warn,
+}
+
+impl Unknown {
+    pub fn is_error(self) -> bool {
+        matches!(self, Unknown::Error)
+    }
+
+    pub fn is_fail(self) -> bool {
+        matches!(self, Unknown::Fail)
+    }
+
+    pub fn is_warn(self) -> bool {
+        matches!(self, Unknown::Warn)
+    }
+}
+
+impl Default for Unknown {
+    #[inline]
+    fn default() -> Self {
+        Unknown::Error
+    }
+}
+
 pub fn default_op_dir() -> OpDir {
     let mut op_dir = OpDir::with_hasher(FxBuildHasher::default());