add unknown flag to set_prolog_flag and current_prolog_flag

This commit is contained in:
Mark
2023-07-14 19:10:10 -06:00
parent 101d0548db
commit ff5e9a793b
7 changed files with 119 additions and 8 deletions

View File

@@ -410,6 +410,8 @@ enum SystemClauseType {
GetCutPoint, GetCutPoint,
#[strum_discriminants(strum(props(Arity = "1", Name = "$get_double_quotes")))] #[strum_discriminants(strum(props(Arity = "1", Name = "$get_double_quotes")))]
GetDoubleQuotes, GetDoubleQuotes,
#[strum_discriminants(strum(props(Arity = "1", Name = "$get_unknown")))]
GetUnknown,
#[strum_discriminants(strum(props(Arity = "1", Name = "$install_new_block")))] #[strum_discriminants(strum(props(Arity = "1", Name = "$install_new_block")))]
InstallNewBlock, InstallNewBlock,
#[strum_discriminants(strum(props(Arity = "0", Name = "$maybe")))] #[strum_discriminants(strum(props(Arity = "0", Name = "$maybe")))]
@@ -438,6 +440,8 @@ enum SystemClauseType {
SetCutPointByDefault(RegType), SetCutPointByDefault(RegType),
#[strum_discriminants(strum(props(Arity = "1", Name = "$set_double_quotes")))] #[strum_discriminants(strum(props(Arity = "1", Name = "$set_double_quotes")))]
SetDoubleQuotes, SetDoubleQuotes,
#[strum_discriminants(strum(props(Arity = "1", Name = "$set_unknown")))]
SetUnknown,
#[strum_discriminants(strum(props(Arity = "1", Name = "$set_seed")))] #[strum_discriminants(strum(props(Arity = "1", Name = "$set_seed")))]
SetSeed, SetSeed,
#[strum_discriminants(strum(props(Arity = "4", Name = "$skip_max_list")))] #[strum_discriminants(strum(props(Arity = "4", Name = "$skip_max_list")))]
@@ -1723,6 +1727,7 @@ fn generate_instruction_preface() -> TokenStream {
&Instruction::CallGetCurrentSCCBlock | &Instruction::CallGetCurrentSCCBlock |
&Instruction::CallGetCutPoint | &Instruction::CallGetCutPoint |
&Instruction::CallGetDoubleQuotes | &Instruction::CallGetDoubleQuotes |
&Instruction::CallGetUnknown |
&Instruction::CallInstallNewBlock | &Instruction::CallInstallNewBlock |
&Instruction::CallMaybe | &Instruction::CallMaybe |
&Instruction::CallCpuNow | &Instruction::CallCpuNow |
@@ -1748,6 +1753,7 @@ fn generate_instruction_preface() -> TokenStream {
&Instruction::CallPopFromBallStack | &Instruction::CallPopFromBallStack |
&Instruction::CallSetCutPointByDefault(..) | &Instruction::CallSetCutPointByDefault(..) |
&Instruction::CallSetDoubleQuotes | &Instruction::CallSetDoubleQuotes |
&Instruction::CallSetUnknown |
&Instruction::CallSetSeed | &Instruction::CallSetSeed |
&Instruction::CallSkipMaxList | &Instruction::CallSkipMaxList |
&Instruction::CallSleep | &Instruction::CallSleep |
@@ -1948,6 +1954,7 @@ fn generate_instruction_preface() -> TokenStream {
&Instruction::ExecuteGetCurrentSCCBlock | &Instruction::ExecuteGetCurrentSCCBlock |
&Instruction::ExecuteGetCutPoint | &Instruction::ExecuteGetCutPoint |
&Instruction::ExecuteGetDoubleQuotes | &Instruction::ExecuteGetDoubleQuotes |
&Instruction::ExecuteGetUnknown |
&Instruction::ExecuteInstallNewBlock | &Instruction::ExecuteInstallNewBlock |
&Instruction::ExecuteMaybe | &Instruction::ExecuteMaybe |
&Instruction::ExecuteCpuNow | &Instruction::ExecuteCpuNow |
@@ -1973,6 +1980,7 @@ fn generate_instruction_preface() -> TokenStream {
&Instruction::ExecutePopFromBallStack | &Instruction::ExecutePopFromBallStack |
&Instruction::ExecuteSetCutPointByDefault(_) | &Instruction::ExecuteSetCutPointByDefault(_) |
&Instruction::ExecuteSetDoubleQuotes | &Instruction::ExecuteSetDoubleQuotes |
&Instruction::ExecuteSetUnknown |
&Instruction::ExecuteSetSeed | &Instruction::ExecuteSetSeed |
&Instruction::ExecuteSkipMaxList | &Instruction::ExecuteSkipMaxList |
&Instruction::ExecuteSleep | &Instruction::ExecuteSleep |

View File

@@ -55,7 +55,7 @@ impl AppendOrPrepend {
} }
} }
#[derive(Debug)] #[derive(Debug, Clone, Copy)]
pub enum VarComparison { pub enum VarComparison {
Indistinct, Indistinct,
Distinct Distinct

View File

@@ -140,7 +140,9 @@ call(_, _, _, _, _, _, _, _, _).
% * `occurs_check`: Returns if the occurs check is enabled. The occurs check prevents the creation cyclic terms. % * `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 % 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 % 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(Flag, Value) :- Flag == max_arity, !, Value = 1023.
current_prolog_flag(max_arity, 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(integer_rounding_function, toward_zero).
current_prolog_flag(Flag, Value) :- Flag == double_quotes, !, '$get_double_quotes'(Value). 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(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 == max_integer, !, '$fail'.
current_prolog_flag(Flag, _) :- Flag == min_integer, !, '$fail'. current_prolog_flag(Flag, _) :- Flag == min_integer, !, '$fail'.
current_prolog_flag(Flag, OccursCheckEnabled) :- 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_double_quotes'(atom). % 7.11.2.5, list of char codes (UTF8).
set_prolog_flag(double_quotes, codes) :- set_prolog_flag(double_quotes, codes) :-
!, '$set_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_prolog_flag(occurs_check, true) :-
!, '$set_sto_as_unify'. !, '$set_sto_as_unify'.
set_prolog_flag(occurs_check, false) :- set_prolog_flag(occurs_check, false) :-

View File

@@ -4194,6 +4194,14 @@ impl Machine {
self.get_double_quotes(); self.get_double_quotes();
step_or_fail!(self, self.machine_st.p = self.machine_st.cp); 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 => { &Instruction::CallInstallNewBlock => {
self.machine_st.install_new_block(self.machine_st.registers[1]); self.machine_st.install_new_block(self.machine_st.registers[1]);
step_or_fail!(self, self.machine_st.p += 1); step_or_fail!(self, self.machine_st.p += 1);
@@ -4374,6 +4382,14 @@ impl Machine {
self.set_double_quotes(); self.set_double_quotes();
step_or_fail!(self, self.machine_st.p = self.machine_st.cp); 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 => { &Instruction::CallSetSeed => {
self.set_seed(); self.set_seed();
step_or_fail!(self, self.machine_st.p += 1); step_or_fail!(self, self.machine_st.p += 1);

View File

@@ -1027,6 +1027,24 @@ impl Machine {
self.machine_st.heap.truncate(target_h); 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)] #[inline(always)]
fn try_call(&mut self, name: Atom, arity: usize, idx: IndexPtr) -> CallResult { fn try_call(&mut self, name: Atom, arity: usize, idx: IndexPtr) -> CallResult {
let compiled_tl_index = idx.p() as usize; let compiled_tl_index = idx.p() as usize;
@@ -1036,7 +1054,7 @@ impl Machine {
self.machine_st.fail = true; self.machine_st.fail = true;
} }
IndexPtrTag::Undefined => { IndexPtrTag::Undefined => {
return Err(self.machine_st.throw_undefined_error(name, arity)); return self.undefined_procedure(name, arity);
} }
IndexPtrTag::DynamicIndex => { IndexPtrTag::DynamicIndex => {
self.machine_st.dynamic_mode = FirstOrNext::First; self.machine_st.dynamic_mode = FirstOrNext::First;
@@ -1059,7 +1077,7 @@ impl Machine {
self.machine_st.fail = true; self.machine_st.fail = true;
} }
IndexPtrTag::Undefined => { IndexPtrTag::Undefined => {
return Err(self.machine_st.throw_undefined_error(name, arity)); return self.undefined_procedure(name, arity);
} }
IndexPtrTag::DynamicIndex => { IndexPtrTag::DynamicIndex => {
self.machine_st.dynamic_mode = FirstOrNext::First; self.machine_st.dynamic_mode = FirstOrNext::First;
@@ -1088,7 +1106,7 @@ impl Machine {
if let Some(idx) = module.code_dir.get(&(name, arity)).cloned() { if let Some(idx) = module.code_dir.get(&(name, arity)).cloned() {
self.try_call(name, arity, idx.get()) self.try_call(name, arity, idx.get())
} else { } else {
Err(self.machine_st.throw_undefined_error(name, arity)) self.undefined_procedure(name, arity)
} }
} else { } else {
let stub = functor_stub(name, arity); let stub = functor_stub(name, arity);
@@ -1107,14 +1125,14 @@ impl Machine {
if let Some(idx) = self.indices.code_dir.get(&(name, arity)).cloned() { if let Some(idx) = self.indices.code_dir.get(&(name, arity)).cloned() {
self.try_execute(name, arity, idx.get()) self.try_execute(name, arity, idx.get())
} else { } else {
Err(self.machine_st.throw_undefined_error(name, arity)) self.undefined_procedure(name, arity)
} }
} else { } else {
if let Some(module) = self.indices.modules.get(&module_name) { if let Some(module) = self.indices.modules.get(&module_name) {
if let Some(idx) = module.code_dir.get(&(name, arity)).cloned() { if let Some(idx) = module.code_dir.get(&(name, arity)).cloned() {
self.try_execute(name, arity, idx.get()) self.try_execute(name, arity, idx.get())
} else { } else {
Err(self.machine_st.throw_undefined_error(name, arity)) self.undefined_procedure(name, arity)
} }
} else { } else {
let stub = functor_stub(name, arity); let stub = functor_stub(name, arity);

View 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)] #[inline(always)]
pub(crate) fn get_scc_cleaner(&mut self) { pub(crate) fn get_scc_cleaner(&mut self) {
let dest = self.machine_st.registers[1]; let dest = self.machine_st.registers[1];
@@ -5521,7 +5535,7 @@ impl Machine {
#[inline(always)] #[inline(always)]
pub(crate) fn set_double_quotes(&mut self) { 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 { self.machine_st.flags.double_quotes = match atom {
atom!("atom") => DoubleQuotes::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)] #[inline(always)]
pub(crate) fn inference_level(&mut self) { pub(crate) fn inference_level(&mut self) {
let a1 = self.deref_register(1); let a1 = self.deref_register(1);

View File

@@ -303,12 +303,14 @@ pub type OpDir = IndexMap<(Atom, Fixity), OpDesc, FxBuildHasher>;
#[derive(Debug, Clone, Copy)] #[derive(Debug, Clone, Copy)]
pub struct MachineFlags { pub struct MachineFlags {
pub double_quotes: DoubleQuotes, pub double_quotes: DoubleQuotes,
pub unknown: Unknown,
} }
impl Default for MachineFlags { impl Default for MachineFlags {
fn default() -> Self { fn default() -> Self {
MachineFlags { MachineFlags {
double_quotes: DoubleQuotes::default(), 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 { pub fn default_op_dir() -> OpDir {
let mut op_dir = OpDir::with_hasher(FxBuildHasher::default()); let mut op_dir = OpDir::with_hasher(FxBuildHasher::default());