From: Mark Thom Date: Wed, 20 Jul 2022 02:29:22 +0000 (-0600) Subject: streamline assertz/1, asserta/1 X-Git-Tag: v0.9.1^2~56 X-Git-Url: https://git.sagredo.dev/?a=commitdiff_plain;h=6b05ee5130756e565f63284751c2c436e8c21d6e;p=scryer-prolog.git streamline assertz/1, asserta/1 --- diff --git a/build/instructions_template.rs b/build/instructions_template.rs index 51421227..4cd660df 100644 --- a/build/instructions_template.rs +++ b/build/instructions_template.rs @@ -190,9 +190,9 @@ enum REPLCodePtr { DynamicProperty, #[strum_discriminants(strum(props(Arity = "3", Name = "$abolish_clause")))] AbolishClause, - #[strum_discriminants(strum(props(Arity = "5", Name = "$asserta")))] + #[strum_discriminants(strum(props(Arity = "3", Name = "$asserta")))] Asserta, - #[strum_discriminants(strum(props(Arity = "5", Name = "$assertz")))] + #[strum_discriminants(strum(props(Arity = "3", Name = "$assertz")))] Assertz, #[strum_discriminants(strum(props(Arity = "4", Name = "$retract_clause")))] Retract, @@ -2195,6 +2195,7 @@ pub fn generate_instructions_rs() -> TokenStream { let mut clause_type_from_name_and_arity_arms = vec![]; let mut clause_type_to_instr_arms = vec![]; let mut clause_type_name_arms = vec![]; + let mut is_inbuilt_arms = vec![]; for (name, arity, variant) in instr_data.compare_number_variants { let ident = variant.ident.clone(); @@ -2249,6 +2250,12 @@ pub fn generate_instructions_rs() -> TokenStream { ) => Instruction::#instr_ident(#(#placeholder_ids),*, 0) } ); + + is_inbuilt_arms.push( + quote! { + (atom!(#name), #arity) => true + } + ); } for (name, arity, variant) in instr_data.compare_term_variants { @@ -2278,6 +2285,12 @@ pub fn generate_instructions_rs() -> TokenStream { ) => Instruction::#instr_ident(0) } ); + + is_inbuilt_arms.push( + quote! { + (atom!(#name), #arity) => true + } + ); } for (name, arity, variant) in instr_data.builtin_type_variants { @@ -2339,6 +2352,12 @@ pub fn generate_instructions_rs() -> TokenStream { ) => Instruction::#instr_ident(0) } }); + + is_inbuilt_arms.push( + quote! { + (atom!(#name), #arity) => true + } + ); } for (name, arity, variant) in instr_data.inlined_type_variants { @@ -2398,6 +2417,12 @@ pub fn generate_instructions_rs() -> TokenStream { ) => Instruction::#instr_ident(#(#placeholder_ids),*,0) } ); + + is_inbuilt_arms.push( + quote! { + (atom!(#name), #arity) => true + } + ); } for (name, arity, variant) in instr_data.system_clause_type_variants { @@ -2488,6 +2513,18 @@ pub fn generate_instructions_rs() -> TokenStream { ) => Instruction::#instr_ident(0) } }); + + is_inbuilt_arms.push( + if let Arity::Ident("arity") = &arity { + quote! { + (atom!(#name), _arity) => true + } + } else { + quote! { + (atom!(#name), #arity) => true + } + } + ); } for (name, arity, variant) in instr_data.repl_code_ptr_variants { @@ -2553,6 +2590,12 @@ pub fn generate_instructions_rs() -> TokenStream { )) => Instruction::#instr_ident(0) } }); + + is_inbuilt_arms.push( + quote! { + (atom!(#name), #arity) => true + } + ); } for (name, arity, variant) in instr_data.clause_type_variants { @@ -2622,6 +2665,12 @@ pub fn generate_instructions_rs() -> TokenStream { ClauseType::#ident => Instruction::#ident(0) } }); + + is_inbuilt_arms.push( + quote! { + (atom!(#name), _arity) => true + } + ); } let to_execute_arms: Vec<_> = instr_data.instr_variants @@ -2972,19 +3021,12 @@ pub fn generate_instructions_rs() -> TokenStream { } } - pub fn is_builtin(&self) -> bool { - if let ClauseType::BuiltIn(_) = self { - true - } else { - false - } - } - - pub fn is_inlined(&self) -> bool { - if let ClauseType::Inlined(_) = self { - true - } else { - false + pub fn is_inbuilt(name: Atom, arity: usize) -> bool { + match (name, arity) { + #( + #is_inbuilt_arms, + )* + _ => false, } } @@ -3179,7 +3221,7 @@ enum Arity { impl From<&'static str> for Arity { fn from(arity: &'static str) -> Self { usize::from_str_radix(&arity, 10) - .map(|n| Arity::Static(n)) + .map(Arity::Static) .unwrap_or_else(|_| Arity::Ident(arity)) } } diff --git a/src/lib/builtins.pl b/src/lib/builtins.pl index 9d7fcd02..8e4553ce 100644 --- a/src/lib/builtins.pl +++ b/src/lib/builtins.pl @@ -884,77 +884,46 @@ clause(H, B) :- ). -call_asserta(Head, Body, Name, Arity, Module) :- - '$clause_body_is_valid'(Body), - functor(_, Name, Arity), - '$asserta'(Head, Body, Name, Arity, Module). - - -module_asserta_clause(Head, Body, Module) :- - ( var(Head) -> - throw(error(instantiation_error, asserta/1)) - ; callable(Head), functor(Head, Name, Arity) -> - ( '$head_is_dynamic'(Module, Head) -> - call_asserta(Head, Body, Name, Arity, Module) - ; '$no_such_predicate'(Module, Head) -> - call_asserta(Head, Body, Name, Arity, Module) - ; throw(error(permission_error(modify, static_procedure, Name/Arity), asserta/1)) - ) - ; throw(error(type_error(callable, Head), asserta/1)) - ). - :- meta_predicate asserta(:). asserta(Clause0) :- - loader:strip_module(Clause0, Module, Clause), - ( var(Module) -> Module = user - ; true - ), - ( Clause \= (_ :- _) -> - Head = Clause, - Body = true, - module_asserta_clause(Head, Body, Module) - ; Clause = (Head :- Body) -> - module_asserta_clause(Head, Body, Module) - ). + loader:strip_subst_module(Clause0, user, Module, Clause), + asserta(Module, Clause). +asserta(Module, (Head :- Body)) :- + !, + '$asserta'(Module, Head, Body). +asserta(Module, Fact) :- + '$asserta'(Module, Fact, true). -module_assertz_clause(Head, Body, Module) :- - ( var(Head) -> - throw(error(instantiation_error, assertz/1)) - ; callable(Head), functor(Head, Name, Arity) -> - ( '$head_is_dynamic'(Module, Head) -> - call_assertz(Head, Body, Name, Arity, Module) - ; '$no_such_predicate'(Module, Head) -> - call_assertz(Head, Body, Name, Arity, Module) - ; throw(error(permission_error(modify, static_procedure, Name/Arity), - assertz/1)) - ) - ; throw(error(type_error(callable, Head), assertz/1)) - ). +:- meta_predicate assertz(:). + +assertz(Clause0) :- + loader:strip_subst_module(Clause0, user, Module, Clause), + assertz(Module, Clause). +assertz(Module, (Head :- Body)) :- + !, + '$assertz'(Module, Head, Body). +assertz(Module, Fact) :- + '$assertz'(Module, Fact, true). -call_assertz(Head, Body, Name, Arity, Module) :- - '$clause_body_is_valid'(Body), - functor(_, Name, Arity), - '$assertz'(Head, Body, Name, Arity, Module). -:- meta_predicate assertz(:). +:- meta_predicate retract(:). -assertz(Clause0) :- +retract(Clause0) :- loader:strip_module(Clause0, Module, Clause), - ( var(Module) -> Module = user - ; true - ), ( Clause \= (_ :- _) -> - Head = Clause, + loader:strip_module(Clause, Module, Head), + ( var(Module) -> Module = user + ; true + ), Body = true, - module_assertz_clause(Head, Body, Module) + retract_module_clause(Head, Body, Module) ; Clause = (Head :- Body) -> - module_assertz_clause(Head, Body, Module) + retract_module_clause(Head, Body, Module) ). - module_retract_clauses([Clause|Clauses0], Head, Body, Name, Arity, Module) :- functor(VarHead, Name, Arity), findall((VarHead :- VarBody), Module:'$clause'(VarHead, VarBody), Clauses1), @@ -1040,22 +1009,6 @@ retract_clause(Head, Body) :- ). -:- meta_predicate retract(:). - -retract(Clause0) :- - loader:strip_module(Clause0, Module, Clause), - ( Clause \= (_ :- _) -> - loader:strip_module(Clause, Module, Head), - ( var(Module) -> Module = user - ; true - ), - Body = true, - retract_module_clause(Head, Body, Module) - ; Clause = (Head :- Body) -> - retract_module_clause(Head, Body, Module) - ). - - :- meta_predicate retractall(:). retractall(Head) :- diff --git a/src/machine/loader.rs b/src/machine/loader.rs index 77d73bd6..0cc93f50 100644 --- a/src/machine/loader.rs +++ b/src/machine/loader.rs @@ -1899,13 +1899,10 @@ impl Machine { } } - pub(crate) fn compile_assert<'a>(&'a mut self, append_or_prepend: AppendOrPrepend) -> CallResult { - let key = self - .machine_st - .read_predicate_key(self.machine_st[temp_v!(3)], self.machine_st[temp_v!(4)]); - + pub(crate) fn compile_assert(&mut self, append_or_prepend: AppendOrPrepend) -> CallResult + { let module_name = cell_as_atom!( - self.machine_st.store(self.machine_st.deref(self.machine_st.registers[5])) + self.machine_st.store(self.machine_st.deref(self.machine_st.registers[1])) ); let compilation_target = match module_name { @@ -1913,14 +1910,62 @@ impl Machine { _ => CompilationTarget::Module(module_name), }; + let stub_gen = || { + match append_or_prepend { + AppendOrPrepend::Append => functor_stub(atom!("assertz"), 1), + AppendOrPrepend::Prepend => functor_stub(atom!("asserta"), 1), + } + }; + let mut compile_assert = || { let mut loader: Loader<'_, LiveLoadAndMachineState<'_>> = Loader::new(self, LiveTermStream::new(ListingSource::User)); loader.payload.compilation_target = compilation_target; - let head = loader.read_term_from_heap(temp_v!(1))?; - let body = loader.read_term_from_heap(temp_v!(2))?; + let head = loader.read_term_from_heap(temp_v!(2))?; + + let name = if let Some(name) = head.name() { + name + } else { + return Err(SessionError::from(CompilationError::InvalidRuleHead)); + }; + + let arity = head.arity(); + + let is_dynamic_predicate = loader + .wam_prelude + .indices + .is_dynamic_predicate( + module_name, + (name, arity), + ); + + let no_such_predicate = + if !is_dynamic_predicate && !ClauseType::is_inbuilt(name, arity) { + let idx_tag = loader + .wam_prelude + .indices + .get_predicate_code_index( + name, + arity, + module_name, + ) + .map(|code_idx| code_idx.get_tag()) + .unwrap_or(IndexPtrTag::DynamicUndefined); + + idx_tag == IndexPtrTag::DynamicUndefined || + idx_tag == IndexPtrTag::Undefined + } else { + is_dynamic_predicate + }; + + if !no_such_predicate { + LiveLoadAndMachineState::machine_st(&mut loader.payload).fail = true; + return LiveLoadAndMachineState::evacuate(loader); + } + + let body = loader.read_term_from_heap(temp_v!(3))?; let asserted_clause = Term::Clause( Cell::default(), @@ -1929,10 +1974,10 @@ impl Machine { ); // if a new predicate was just created, make it dynamic. - loader.add_dynamic_predicate(compilation_target, key.0, key.1)?; + loader.add_dynamic_predicate(compilation_target, name, arity)?; loader.incremental_compile_clause( - key, + (name, arity), asserted_clause, compilation_target, false, @@ -1943,7 +1988,7 @@ impl Machine { LiveLoadAndMachineState::machine_st(&mut loader.payload).global_clock += 1; loader.compile_clause_clauses( - key, + (name, arity), compilation_target, std::iter::once((head, body)), append_or_prepend, @@ -1954,14 +1999,30 @@ impl Machine { match compile_assert() { Ok(_) => Ok(()), + Err(SessionError::CompilationError( + CompilationError::InvalidRuleHead | + CompilationError::InadmissibleFact + )) => { + let err = self.machine_st.type_error( + ValidType::Callable, + self.machine_st.registers[2], + ); + + Err(self.machine_st.error_form(err, stub_gen())) + } + Err(SessionError::CompilationError( + CompilationError::InadmissibleQueryTerm + )) => { + let err = self.machine_st.type_error( + ValidType::Callable, + self.machine_st.registers[3], + ); + + Err(self.machine_st.error_form(err, stub_gen())) + } Err(e) => { - let stub = match append_or_prepend { - AppendOrPrepend::Append => functor_stub(atom!("assertz"), 1), - AppendOrPrepend::Prepend => functor_stub(atom!("asserta"), 1), - }; let err = self.machine_st.session_error(e); - - Err(self.machine_st.error_form(err, stub)) + Err(self.machine_st.error_form(err, stub_gen())) } } } diff --git a/src/machine/machine_errors.rs b/src/machine/machine_errors.rs index 7ea75315..ca2af22e 100644 --- a/src/machine/machine_errors.rs +++ b/src/machine/machine_errors.rs @@ -639,10 +639,10 @@ impl CompilationError { &CompilationError::ExpectedRel => { functor!(atom!("expected_relation")) } - &CompilationError::InadmissibleFact => { + &CompilationError::InadmissibleFact => { // TODO: type_error(callable, _). functor!(atom!("inadmissible_fact")) } - &CompilationError::InadmissibleQueryTerm => { + &CompilationError::InadmissibleQueryTerm => { // TODO: type_error(callable, _). functor!(atom!("inadmissible_query_term")) } &CompilationError::InconsistentEntry => { @@ -661,7 +661,8 @@ impl CompilationError { functor!(atom!("no_such_module"), [atom(module_name)]) } &CompilationError::InvalidRuleHead => { - functor!(atom!("invalid_head_of_rule")) + + functor!(atom!("invalid_head_of_rule")) // TODO: type_error(callable, _). } &CompilationError::InvalidUseModuleDecl => { functor!(atom!("invalid_use_module_declaration")) diff --git a/src/machine/machine_indices.rs b/src/machine/machine_indices.rs index c949fb90..601e912f 100644 --- a/src/machine/machine_indices.rs +++ b/src/machine/machine_indices.rs @@ -193,6 +193,11 @@ impl CodeIndex { *self.0.deref_mut() = value; } + #[inline(always)] + pub(crate) fn get_tag(self) -> IndexPtrTag { + self.0.tag() + } + #[inline(always)] pub(crate) fn replace(&mut self, value: IndexPtr) -> IndexPtr { std::mem::replace(self.0.deref_mut(), value) diff --git a/src/machine/system_calls.rs b/src/machine/system_calls.rs index a7b4ad0b..3eca612d 100644 --- a/src/machine/system_calls.rs +++ b/src/machine/system_calls.rs @@ -4326,9 +4326,7 @@ impl Machine { let (name, arity) = cell_as_atom_cell!(self.machine_st.heap[s]) .get_name_and_arity(); - let ct = ClauseType::from(name, arity, &mut self.machine_st.arena); - - if ct.is_inlined() || ct.is_builtin() { + if ClauseType::is_inbuilt(name, arity) { true } else { let index = self.indices.get_predicate_code_index( @@ -4348,9 +4346,7 @@ impl Machine { (HeapCellValueTag::Atom, (name, arity)) => { debug_assert_eq!(arity, 0); - let ct = ClauseType::from(name, 0, &mut self.machine_st.arena); - - if ct.is_inlined() || ct.is_builtin() { + if ClauseType::is_inbuilt(name, 0) { true } else { let index = self.indices.get_predicate_code_index(