From: Mark Date: Sat, 15 Jul 2023 01:10:10 +0000 (-0600) Subject: add unknown flag to set_prolog_flag and current_prolog_flag X-Git-Tag: v0.9.2~41^2 X-Git-Url: https://git.sagredo.dev/?a=commitdiff_plain;h=ff5e9a793b839c72250030286675487632ab174c;p=scryer-prolog.git add unknown flag to set_prolog_flag and current_prolog_flag --- diff --git a/build/instructions_template.rs b/build/instructions_template.rs index 25fa6b1b..a4c7294e 100644 --- a/build/instructions_template.rs +++ b/build/instructions_template.rs @@ -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 | diff --git a/src/forms.rs b/src/forms.rs index ca5c7ffe..2e04eb0e 100644 --- a/src/forms.rs +++ b/src/forms.rs @@ -55,7 +55,7 @@ impl AppendOrPrepend { } } -#[derive(Debug)] +#[derive(Debug, Clone, Copy)] pub enum VarComparison { Indistinct, Distinct diff --git a/src/lib/builtins.pl b/src/lib/builtins.pl index 77695926..4d37710c 100644 --- a/src/lib/builtins.pl +++ b/src/lib/builtins.pl @@ -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) :- diff --git a/src/machine/dispatch.rs b/src/machine/dispatch.rs index a36bf29b..d73be74f 100644 --- a/src/machine/dispatch.rs +++ b/src/machine/dispatch.rs @@ -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); diff --git a/src/machine/mod.rs b/src/machine/mod.rs index 41cc4f39..0dd44a1e 100644 --- a/src/machine/mod.rs +++ b/src/machine/mod.rs @@ -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); diff --git a/src/machine/system_calls.rs b/src/machine/system_calls.rs index 4a4965a2..26ac9e36 100644 --- a/src/machine/system_calls.rs +++ b/src/machine/system_calls.rs @@ -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); diff --git a/src/parser/ast.rs b/src/parser/ast.rs index caed5915..68ebd0fa 100644 --- a/src/parser/ast.rs +++ b/src/parser/ast.rs @@ -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());