rishi/scryer-prolog
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

add unknown flag to set_prolog_flag and current_prolog_flag

Browse Source
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
Download Patch File Download Diff File Expand all files Collapse all files

8
build/instructions_template.rs
View 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 |

2
src/forms.rs
View File

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

12
src/lib/builtins.pl
View 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) :-

16
src/machine/dispatch.rs
View 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);

28
src/machine/mod.rs
View 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);

31
src/machine/system_calls.rs
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)]
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);

30
src/parser/ast.rs
View 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());