clause_name!("$load_compiled_library"),
&SystemClauseType::REPL(REPLCodePtr::PushLoadStatePayload) =>
clause_name!("$push_load_state_payload"),
- &SystemClauseType::REPL(REPLCodePtr::UserAsserta) =>
+ &SystemClauseType::REPL(REPLCodePtr::Asserta) =>
clause_name!("$asserta"),
- &SystemClauseType::REPL(REPLCodePtr::UserAssertz) =>
+ &SystemClauseType::REPL(REPLCodePtr::Assertz) =>
clause_name!("$assertz"),
- &SystemClauseType::REPL(REPLCodePtr::UserRetract) =>
+ &SystemClauseType::REPL(REPLCodePtr::Retract) =>
clause_name!("$retract_clause"),
&SystemClauseType::REPL(REPLCodePtr::UseModule) =>
clause_name!("$use_module"),
Some(SystemClauseType::REPL(REPLCodePtr::AddGoalExpansionClause)),
("$add_term_expansion_clause", 3) =>
Some(SystemClauseType::REPL(REPLCodePtr::AddTermExpansionClause)),
- // ("$at_end_of_expansion", 0) => Some(SystemClauseType::AtEndOfExpansion),
("$atom_chars", 2) => Some(SystemClauseType::AtomChars),
("$atom_codes", 2) => Some(SystemClauseType::AtomCodes),
("$atom_length", 2) => Some(SystemClauseType::AtomLength),
// ("$abolish_module_clause", 3) => Some(SystemClauseType::AbolishModuleClause),
("$bind_from_register", 2) => Some(SystemClauseType::BindFromRegister),
- // ("$module_asserta", 5) => Some(SystemClauseType::ModuleAssertDynamicPredicateToFront),
- // ("$module_assertz", 5) => Some(SystemClauseType::ModuleAssertDynamicPredicateToBack),
("$call_continuation", 1) => Some(SystemClauseType::CallContinuation),
("$char_code", 2) => Some(SystemClauseType::CharCode),
("$char_type", 2) => Some(SystemClauseType::CharType),
("$peek_char", 2) => Some(SystemClauseType::PeekChar),
("$peek_code", 2) => Some(SystemClauseType::PeekCode),
("$is_partial_string", 1) => Some(SystemClauseType::IsPartialString),
-// ("$expand_term", 2) => Some(SystemClauseType::ExpandTerm),
-// ("$expand_goal", 2) => Some(SystemClauseType::ExpandGoal),
("$fetch_global_var", 2) => Some(SystemClauseType::FetchGlobalVar),
("$fetch_global_var_with_offset", 3) => Some(SystemClauseType::FetchGlobalVarWithOffset),
("$get_byte", 2) => Some(SystemClauseType::GetByte),
}
("$get_attr_list", 2) => Some(SystemClauseType::GetAttributedVariableList),
("$get_b_value", 1) => Some(SystemClauseType::GetBValue),
-// ("$get_clause", 2) => Some(SystemClauseType::GetClause),
-// ("$get_module_clause", 3) => Some(SystemClauseType::GetModuleClause),
("$get_lh_from_offset", 2) => Some(SystemClauseType::GetLiftedHeapFromOffset),
("$get_lh_from_offset_diff", 3) => Some(SystemClauseType::GetLiftedHeapFromOffsetDiff),
("$get_double_quotes", 1) => Some(SystemClauseType::GetDoubleQuotes),
("$cpu_now", 1) => Some(SystemClauseType::CpuNow),
("$current_time", 1) => Some(SystemClauseType::CurrentTime),
("$module_exists", 1) => Some(SystemClauseType::ModuleExists),
- // ("$module_retract_clause", 5) => Some(SystemClauseType::ModuleRetractClause),
- // ("$module_head_is_dynamic", 2) => Some(SystemClauseType::ModuleHeadIsDynamic),
("$no_such_predicate", 2) => Some(SystemClauseType::NoSuchPredicate),
("$number_to_chars", 2) => Some(SystemClauseType::NumberToChars),
("$number_to_codes", 2) => Some(SystemClauseType::NumberToCodes),
("$reset_cont_marker", 0) => Some(SystemClauseType::ResetContinuationMarker),
("$reset_global_var_at_key", 1) => Some(SystemClauseType::ResetGlobalVarAtKey),
("$reset_global_var_at_offset", 3) => Some(SystemClauseType::ResetGlobalVarAtOffset),
- // ("$retract_clause", 4) => Some(SystemClauseType::RetractClause),
("$return_from_verify_attr", 0) => Some(SystemClauseType::ReturnFromVerifyAttr),
("$set_ball", 1) => Some(SystemClauseType::SetBall),
("$set_cp_by_default", 1) => Some(SystemClauseType::SetCutPointByDefault(temp_v!(1))),
("$declare_module", 3) => Some(SystemClauseType::REPL(REPLCodePtr::DeclareModule)),
("$load_compiled_library", 2) => Some(SystemClauseType::REPL(REPLCodePtr::LoadCompiledLibrary)),
("$push_load_state_payload", 1) => Some(SystemClauseType::REPL(REPLCodePtr::PushLoadStatePayload)),
- ("$asserta", 4) => Some(SystemClauseType::REPL(REPLCodePtr::UserAsserta)),
- ("$assertz", 4) => Some(SystemClauseType::REPL(REPLCodePtr::UserAssertz)),
- ("$retract_clause", 3) => Some(SystemClauseType::REPL(REPLCodePtr::UserRetract)),
+ ("$asserta", 5) => Some(SystemClauseType::REPL(REPLCodePtr::Asserta)),
+ ("$assertz", 5) => Some(SystemClauseType::REPL(REPLCodePtr::Assertz)),
+ ("$retract_clause", 4) => Some(SystemClauseType::REPL(REPLCodePtr::Retract)),
("$variant", 2) => Some(SystemClauseType::Variant),
("$wam_instructions", 4) => Some(SystemClauseType::WAMInstructions),
("$write_term", 7) => Some(SystemClauseType::WriteTerm),
).
'$module_clause'(H, B, Module) :-
- ( var(H) -> throw(error(instantiation_error, clause/2))
+ ( var(H) ->
+ throw(error(instantiation_error, clause/2))
; functor(H, Name, Arity) ->
( Name == '.' ->
throw(error(type_error(callable, H), clause/2))
+ ; '$no_such_predicate'(Module, H) ->
+ '$fail'
; '$head_is_dynamic'(Module, H) ->
'$clause_body_is_valid'(B),
- Module:'$clause'(H, B) %%TODO: how do we show this exists?
+ Module:'$clause'(H, B)
; throw(error(permission_error(access, private_procedure, Name/Arity),
clause/2))
)
; throw(error(type_error(callable, H), clause/2))
).
-call_module_asserta(Head, Body, Name, Arity, Module) :-
+call_asserta(Head, Body, Name, Arity, Module) :-
'$clause_body_is_valid'(Body),
- functor(VarHead, Name, Arity),
- findall((VarHead :- VarBody), builtins:clause(Module:VarHead, VarBody), Clauses),
- '$module_asserta'((Head :- Body), Clauses, Name, Arity, Module).
-
-call_asserta(Head, Body, Name, Arity) :-
- '$clause_body_is_valid'(Body),
- functor(VarHead, Name, Arity),
- '$asserta'(Head, Body, Name, Arity).
+ functor(_, Name, Arity),
+ '$asserta'(Head, Body, Name, Arity, Module).
module_asserta_clause(Head, Body, Module) :-
- ( var(Head) -> throw(error(instantiation_error, asserta/1))
+ ( var(Head) ->
+ throw(error(instantiation_error, asserta/1))
; functor(Head, Name, Arity),
atom(Name),
Name \== '.' ->
- ( '$module_head_is_dynamic'(Head, Module) ->
- call_module_asserta(Head, Body, Name, Arity, Module)
+ ( '$head_is_dynamic'(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))
arg(2, Head, F),
module_asserta_clause(F, Body, Module)
; '$no_such_predicate'(user, Head) ->
- call_asserta(Head, Body, Name, Arity)
+ call_asserta(Head, Body, Name, Arity, user)
; '$head_is_dynamic'(user, Head) ->
- call_asserta(Head, Body, Name, Arity)
+ call_asserta(Head, Body, Name, Arity, user)
; throw(error(permission_error(modify, static_procedure, Name/Arity), asserta/1))
)
; throw(error(type_error(callable, Head), asserta/1))
asserta(Clause) :-
( Clause \= (_ :- _) ->
Head = Clause,
- Body = true, asserta_clause(Head, Body)
+ Body = true,
+ asserta_clause(Head, Body)
; Clause = (Head :- Body) ->
asserta_clause(Head, Body)
).
-% NOT MODIFIED.
-call_module_assertz(Head, Body, Name, Arity, Module) :-
- '$clause_body_is_valid'(Body),
- functor(VarHead, Name, Arity),
- findall((VarHead :- VarBody), builtins:clause(Module:VarHead, VarBody), Clauses),
- '$module_assertz'((Head :- Body), Clauses, Name, Arity, Module).
-
module_assertz_clause(Head, Body, Module) :-
( var(Head) ->
throw(error(instantiation_error, assertz/1))
atom(Name),
Name \== '.' ->
( '$head_is_dynamic'(Module, Head) ->
- call_module_assertz(Head, Body, Name, Arity, Module)
- ; throw(error(permission_error(modify, static_procedure, Name/Arity), assertz/1))
+ 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))
).
-% MODIFIED.
-call_assertz(Head, Body, Name, Arity) :-
+
+call_assertz(Head, Body, Name, Arity, Module) :-
'$clause_body_is_valid'(Body),
- functor(VarHead, Name, Arity),
- '$assertz'(Head, Body, Name, Arity).
+ functor(_, Name, Arity),
+ '$assertz'(Head, Body, Name, Arity, Module).
assertz_clause(Head, Body) :-
( var(Head) ->
; functor(Head, Name, Arity),
atom(Name),
Name \== '.' ->
- ( Name == (:),
- Arity =:= 2 ->
- arg(1, Head, Module),
- arg(2, Head, F),
- module_assertz_clause(F, Body, Module)
- ; '$no_such_predicate'(user, Head) ->
- call_assertz(Head, Body, Name, Arity)
- ; '$head_is_dynamic'(user, Head) ->
- call_assertz(Head, Body, Name, Arity)
- ; throw(error(permission_error(modify, static_procedure, Name/Arity), assertz/1))
+ ( Name == (:),
+ Arity =:= 2 ->
+ arg(1, Head, Module),
+ arg(2, Head, F),
+ module_assertz_clause(F, Body, Module)
+ ; '$no_such_predicate'(user, Head) ->
+ call_assertz(Head, Body, Name, Arity, user)
+ ; '$head_is_dynamic'(user, Head) ->
+ call_assertz(Head, Body, Name, Arity, user)
+ ; throw(error(permission_error(modify, static_procedure, Name/Arity),
+ assertz/1))
)
; throw(error(type_error(callable, Head), assertz/1))
).
module_retract_clauses([Clause|Clauses0], Head, Body, Name, Arity, Module) :-
functor(VarHead, Name, Arity),
- findall((VarHead :- VarBody), builtins:clause(Module:VarHead, VarBody), Clauses1),
+ findall((VarHead :- VarBody), Module:clause(Module:VarHead, VarBody), Clauses1),
first_match_index(Clauses1, (Head :- Body), 0, N),
( Clauses0 == [] -> !
; true
),
- '$module_retract_clause'(Name, Arity, N, Clauses1, Module).
+ '$retract_clause'(Name, Arity, N, Module).
module_retract_clauses([_|Clauses0], Head, Body, Name, Arity, Module) :-
module_retract_clauses(Clauses0, Head, Body, Name, Arity, Module).
call_module_retract(Head, Body, Name, Arity, Module) :-
- findall((Head :- Body), builtins:clause(Module:Head, Body), Clauses),
+ findall((Head :- Body), Module:clause(Module:Head, Body), Clauses),
module_retract_clauses(Clauses, Head, Body, Name, Arity, Module).
retract_module_clause(Head, Body, Module) :-
; functor(Head, Name, Arity),
atom(Name),
Name \== '.' ->
- ( '$module_head_is_dynamic'(Head, Module) ->
- call_module_retract(Head, Body, Name, Arity, Module)
- ; throw(error(permission_error(modify, static_procedure, Name/Arity), retract/1))
+ ( '$head_is_dynamic'(Module, Head) ->
+ call_module_retract(Head, Body, Name, Arity, Module)
+ ; throw(error(permission_error(modify, static_procedure, Name/Arity), retract/1))
)
; throw(error(type_error(callable, Head), retract/1))
).
( Clauses0 == [] -> !
; true
),
- '$retract_clause'(Name, Arity, N).
+ '$retract_clause'(Name, Arity, N, user).
retract_clauses([_ | Clauses0], Head, Body, Name, Arity) :-
retract_clauses(Clauses0, Head, Body, Name, Arity).
}
}
- set_switch_var_offset(
- code,
- later_indexing_loc,
- lower_bound_clause_start - later_indexing_loc,
- &mut self.retraction_info,
- );
-
result = merge_indexed_subsequences(
code,
skeleton,
&mut skeleton.clauses[lower_bound ..],
&mut self.retraction_info,
);
- }
- _ => {
- set_switch_var_offset_to_choice_instr(
+
+ set_switch_var_offset(
code,
- target_indexing_loc,
- lower_bound_clause_start - target_indexing_loc,
+ later_indexing_loc,
+ lower_bound_clause_start - later_indexing_loc,
&mut self.retraction_info,
);
-
+ }
+ _ => {
result = merge_indexed_subsequences(
code,
skeleton,
&mut skeleton.clauses[lower_bound ..],
&mut self.retraction_info,
);
+
+ set_switch_var_offset_to_choice_instr(
+ code,
+ target_indexing_loc,
+ lower_bound_clause_start - target_indexing_loc,
+ &mut self.retraction_info,
+ );
}
};
fn compile_clause_clauses<ClauseIter: Iterator<Item=(Term, Term)>>(
&mut self,
key: PredicateKey,
+ compilation_target: CompilationTarget,
clause_clauses: ClauseIter,
append_or_prepend: AppendOrPrepend,
) -> Result<(), SessionError> {
)
});
- let compilation_target = mem::replace(
+ let clause_clause_compilation_target =
+ match compilation_target {
+ CompilationTarget::User => {
+ CompilationTarget::Module(clause_name!("builtins"))
+ }
+ _ => {
+ compilation_target.clone()
+ }
+ };
+
+ let old_compilation_target = mem::replace(
&mut self.load_state.compilation_target,
- CompilationTarget::Module(clause_name!("builtins")),
+ clause_clause_compilation_target,
);
let mut clause_clause_locs = sdeq![];
);
if let Err(e) = result {
- self.load_state.compilation_target = compilation_target;
+ self.load_state.compilation_target = old_compilation_target;
return Err(e);
}
}
}
}
- self.load_state.compilation_target = compilation_target;
+ self.load_state.compilation_target = old_compilation_target;
Ok(())
}
if is_dynamic {
let iter = mem::replace(&mut self.clause_clauses, vec![]).into_iter();
- self.compile_clause_clauses(key, iter, AppendOrPrepend::Append)?;
+ let compilation_target = self.load_state.compilation_target.clone();
+
+ self.compile_clause_clauses(
+ key,
+ compilation_target,
+ iter,
+ AppendOrPrepend::Append,
+ )?;
}
Ok(self.predicates.clear())
}
pub(crate)
- fn compile_user_assert(&mut self, append_or_prepend: AppendOrPrepend) {
- let key =
- self.machine_st.read_predicate_key(
- self.machine_st[temp_v!(3)],
- self.machine_st[temp_v!(4)],
- );
+ fn compile_assert(&mut self, append_or_prepend: AppendOrPrepend) {
+ let key = self.machine_st.read_predicate_key(
+ self.machine_st[temp_v!(3)],
+ self.machine_st[temp_v!(4)],
+ );
+
+ let module_name = atom_from!(
+ self.machine_st,
+ self.machine_st.store(self.machine_st.deref(
+ self.machine_st[temp_v!(5)]
+ ))
+ );
- let compile_user_assert = || {
+ let compilation_target =
+ match module_name.as_str() {
+ "user" => CompilationTarget::User,
+ _ => CompilationTarget::Module(module_name),
+ };
+
+ let compile_assert = || {
let mut loader = Loader::new(LiveTermStream::new(ListingSource::User), self);
let head = loader.read_term_from_heap(temp_v!(1))?;
loader.incremental_compile_clause(
key.clone(),
asserted_clause,
- CompilationTarget::User,
+ compilation_target.clone(),
false,
append_or_prepend,
)?;
// if a new predicate was just created, make it dynamic.
loader.load_state.wam.indices.get_predicate_skeleton(
- &loader.load_state.compilation_target,
+ &compilation_target,
&key,
).map(|skeleton| skeleton.is_dynamic = true);
- loader.compile_clause_clauses(key, std::iter::once((head, body)), append_or_prepend)?;
+ loader.compile_clause_clauses(
+ key,
+ compilation_target,
+ std::iter::once((head, body)),
+ append_or_prepend,
+ )?;
LiveTermStream::evacuate(loader)
};
- match compile_user_assert() {
+ match compile_assert() {
Ok(_) => {
}
Err(e) => {
}
pub(crate)
- fn retract_user_clause(&mut self) {
+ fn retract_clause(&mut self) {
let key =
self.machine_st.read_predicate_key(
self.machine_st[temp_v!(1)],
unreachable!()
};
- let retract_user_clause = || {
+ let module_name = atom_from!(
+ self.machine_st,
+ self.machine_st.store(self.machine_st.deref(
+ self.machine_st[temp_v!(4)]
+ ))
+ );
+
+ let compilation_target =
+ match module_name.as_str() {
+ "user" => CompilationTarget::User,
+ _ => CompilationTarget::Module(module_name),
+ };
+
+ let clause_clause_compilation_target =
+ match &compilation_target {
+ CompilationTarget::User => {
+ CompilationTarget::Module(clause_name!("builtins"))
+ }
+ _ => {
+ compilation_target.clone()
+ }
+ };
+
+ let retract_clause = || {
let mut loader = Loader::new(LiveTermStream::new(ListingSource::User), self);
+ loader.load_state.compilation_target = compilation_target;
+
let clause_clause_loc = loader.load_state.retract_clause(key, target_pos);
let clause_assert_margin =
- loader.load_state.wam.indices.modules.get(&clause_name!("builtins"))
- .map(|builtins| builtins.clause_assert_margin)
+ loader.load_state.wam.indices.modules
+ .get(&clause_clause_compilation_target.module_name())
+ .map(|module| module.clause_assert_margin)
.unwrap();
let target_pos =
match loader.load_state.wam.indices.get_predicate_skeleton(
- &CompilationTarget::Module(clause_name!("builtins")),
+ &clause_clause_compilation_target,
&(clause_name!("$clause"), 2),
) {
Some(skeleton) => {
});
if result < clause_assert_margin {
- loader.load_state.wam.indices.modules.get_mut(&clause_name!("builtins"))
- .map(|builtins| builtins.clause_assert_margin -= 1);
+ loader.load_state.wam.indices.modules
+ .get_mut(&clause_clause_compilation_target.module_name())
+ .map(|module| module.clause_assert_margin -= 1);
}
result
}
};
-
- let compilation_target = mem::replace(
- &mut loader.load_state.compilation_target,
- CompilationTarget::Module(clause_name!("builtins")),
- );
-
+ loader.load_state.compilation_target = clause_clause_compilation_target;
loader.load_state.retract_clause((clause_name!("$clause"), 2), target_pos);
- loader.load_state.compilation_target = compilation_target;
LiveTermStream::evacuate(loader)
};
- match retract_user_clause() {
+ match retract_clause() {
Ok(_) => {
}
Err(e) => {
DiscontiguousProperty,
DynamicProperty,
CompilePendingPredicates,
- UserAsserta,
- UserAssertz,
- UserRetract,
+ Asserta,
+ Assertz,
+ Retract,
}
#[derive(Debug, Clone, PartialEq)]
REPLCodePtr::CompilePendingPredicates => {
self.compile_pending_predicates();
}
- REPLCodePtr::UserAssertz => {
- self.compile_user_assert(AppendOrPrepend::Append);
+ REPLCodePtr::Assertz => {
+ self.compile_assert(AppendOrPrepend::Append);
}
- REPLCodePtr::UserAsserta => {
- self.compile_user_assert(AppendOrPrepend::Prepend);
+ REPLCodePtr::Asserta => {
+ self.compile_assert(AppendOrPrepend::Prepend);
}
- REPLCodePtr::UserRetract => {
- self.retract_user_clause();
+ REPLCodePtr::Retract => {
+ self.retract_clause();
}
}
'$repl'([_|Args0]) :-
\+ argv(_),
( append(Args1, ["--"|Args2], Args0) ->
- asserta(argv(Args2)),
+ asserta('$toplevel':argv(Args2)),
Args = Args1
- ; asserta(argv([])),
+ ; asserta('$toplevel':argv([])),
Args = Args0
),
delegate_task(Args, []),
repl.
'$repl'(_) :-
- ( \+ argv(_) -> asserta(argv([]))
+ ( \+ argv(_) -> asserta('$toplevel':argv([]))
; true
),
repl.
write!(f, "REPLCodePtr::AddGoalExpansionClause"),
REPLCodePtr::AddTermExpansionClause =>
write!(f, "REPLCodePtr::AddTermExpansionClause"),
- REPLCodePtr::UserAssertz =>
- write!(f, "REPLCodePtr::UserAssertz"),
- REPLCodePtr::UserAsserta =>
- write!(f, "REPLCodePtr::UserAsserta"),
- REPLCodePtr::UserRetract =>
- write!(f, "REPLCodePtr::UserRetract"),
+ REPLCodePtr::Assertz =>
+ write!(f, "REPLCodePtr::Assertz"),
+ REPLCodePtr::Asserta =>
+ write!(f, "REPLCodePtr::Asserta"),
+ REPLCodePtr::Retract =>
+ write!(f, "REPLCodePtr::Retract"),
REPLCodePtr::ClauseToEvacuable =>
write!(f, "REPLCodePtr::ClauseToEvacuable"),
REPLCodePtr::ConcludeLoad =>
projects / scryer-prolog.git / commitdiff