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

add (:)/{3..12} to enable metacalls on module-prefixed predicates

Browse Source
This commit is contained in:
Mark Thom
2019-11-26 20:51:59 -07:00
parent c3c53017f9
commit 0a665b79f2
3 changed files with 73 additions and 15 deletions
Download Patch File Download Diff File Expand all files Collapse all files

6
src/prolog/clause_types.rs
View File

@@ -170,7 +170,7 @@ pub enum SystemClauseType {
CopyToLiftedHeap,
DeleteAttribute,
DeleteHeadAttribute,
DynamicModuleResolution,
DynamicModuleResolution(usize),
EnqueueAttributeGoal,
EnqueueAttributedVar,
ExpandGoal,
@@ -278,7 +278,7 @@ impl SystemClauseType {
&SystemClauseType::CopyToLiftedHeap => clause_name!("$copy_to_lh"),
&SystemClauseType::DeleteAttribute => clause_name!("$del_attr_non_head"),
&SystemClauseType::DeleteHeadAttribute => clause_name!("$del_attr_head"),
&SystemClauseType::DynamicModuleResolution => clause_name!("$module_call"),
&SystemClauseType::DynamicModuleResolution(_) => clause_name!("$module_call"),
&SystemClauseType::EnqueueAttributeGoal => clause_name!("$enqueue_attribute_goal"),
&SystemClauseType::EnqueueAttributedVar => clause_name!("$enqueue_attr_var"),
&SystemClauseType::ExpandTerm => clause_name!("$expand_term"),
@@ -399,7 +399,7 @@ impl SystemClauseType {
("$get_next_op_db_ref", 2) => Some(SystemClauseType::GetNextOpDBRef),
("$lookup_db_ref", 3) => Some(SystemClauseType::LookupDBRef),
("$lookup_op_db_ref", 4) => Some(SystemClauseType::LookupOpDBRef),
("$module_call", 2) => Some(SystemClauseType::DynamicModuleResolution),
("$module_call", _) => Some(SystemClauseType::DynamicModuleResolution(arity - 2)),
("$enqueue_attribute_goal", 1) => Some(SystemClauseType::EnqueueAttributeGoal),
("$enqueue_attr_var", 1) => Some(SystemClauseType::EnqueueAttributedVar),
("$expand_term", 2) => Some(SystemClauseType::ExpandTerm),

64
src/prolog/lib/builtins.pl
View File

@@ -39,10 +39,12 @@ user:term_expansion((:- op(Pred, Spec, [Op | OtherOps])), OpResults) :-
:- op(900, fy, \+).
:- module(builtins, [(=)/2, (\=)/2, (\+)/1, (',')/2, (->)/2, (;)/2,
(=..)/2, (:)/2, abolish/1, asserta/1, assertz/1,
atom_chars/2, atom_codes/2, atom_concat/3,
atom_length/2, bagof/3, catch/3, char_code/2,
clause/2, current_op/3, current_predicate/1,
(=..)/2, (:)/2, (:)/3, (:)/4, (:)/5, (:)/6,
(:)/7, (:)/8, (:)/9, (:)/10, (:)/11, (:)/12,
abolish/1, asserta/1, assertz/1, atom_chars/2,
atom_codes/2, atom_concat/3, atom_length/2,
bagof/3, catch/3, char_code/2, clause/2,
current_op/3, current_predicate/1,
current_prolog_flag/2, expand_goal/2,
expand_term/2, fail/0, false/0, findall/3,
findall/4, get_char/1, halt/0, max_arity/1,
@@ -53,7 +55,8 @@ user:term_expansion((:- op(Pred, Spec, [Op | OtherOps])), OpResults) :-
true/0, unify_with_occurs_check/2, write/1,
write_canonical/1, write_term/2, writeq/1]).
% the maximum arity flag. needs to be replaced with current_prolog_flag(max_arity, MAX_ARITY).
% the maximum arity flag. needs to be replaced with
% current_prolog_flag(max_arity, MAX_ARITY).
max_arity(255).
% unify.
@@ -70,6 +73,57 @@ Module : Predicate :-
; throw(error(type_error(atom, Module), (:)/2))
).
:(Module, Predicate, A1) :-
( atom(Module) -> '$module_call'(A1, Module, Predicate)
; throw(error(type_error(atom, Module), (:)/2))
).
:(Module, Predicate, A1, A2) :-
( atom(Module) -> '$module_call'(A1, A2, Module, Predicate)
; throw(error(type_error(atom, Module), (:)/2))
).
:(Module, Predicate, A1, A2, A3) :-
( atom(Module) -> '$module_call'(A1, A2, A3, Module, Predicate)
; throw(error(type_error(atom, Module), (:)/2))
).
:(Module, Predicate, A1, A2, A3, A4) :-
( atom(Module) -> '$module_call'(A1, A2, A3, A4, Module, Predicate)
; throw(error(type_error(atom, Module), (:)/2))
).
:(Module, Predicate, A1, A2, A3, A4, A5) :-
( atom(Module) -> '$module_call'(A1, A2, A3, A4, A5, Module, Predicate)
; throw(error(type_error(atom, Module), (:)/2))
).
:(Module, Predicate, A1, A2, A3, A4, A5, A6) :-
( atom(Module) -> '$module_call'(A1, A2, A3, A4, A5, A6, Module, Predicate)
; throw(error(type_error(atom, Module), (:)/2))
).
:(Module, Predicate, A1, A2, A3, A4, A5, A6, A7) :-
( atom(Module) -> '$module_call'(A1, A2, A3, A4, A5, A6, A7, Module, Predicate)
; throw(error(type_error(atom, Module), (:)/2))
).
:(Module, Predicate, A1, A2, A3, A4, A5, A6, A7, A8) :-
( atom(Module) -> '$module_call'(A1, A2, A3, A4, A5, A6, A7, A8, Module, Predicate)
; throw(error(type_error(atom, Module), (:)/2))
).
:(Module, Predicate, A1, A2, A3, A4, A5, A6, A7, A8, A9) :-
( atom(Module) -> '$module_call'(A1, A2, A3, A4, A5, A6, A7, A8, A9, Module, Predicate)
; throw(error(type_error(atom, Module), (:)/2))
).
:(Module, Predicate, A1, A2, A3, A4, A5, A6, A7, A8, A9, A10) :-
( atom(Module) -> '$module_call'(A1, A2, A3, A4, A5, A6, A7, A8, A9, A10, Module, Predicate)
; throw(error(type_error(atom, Module), (:)/2))
).
% flags.
current_prolog_flag(Flag, false) :- Flag == bounded, !.

18
src/prolog/machine/system_calls.rs
View File

@@ -1092,27 +1092,31 @@ impl MachineState {
_ => unreachable!(),
}
}
&SystemClauseType::DynamicModuleResolution => {
let module_name = self.store(self.deref(self[temp_v!(1)].clone()));
&SystemClauseType::DynamicModuleResolution(narity) => {
let module_name = self.store(self.deref(self[temp_v!(1 + narity)].clone()));
if let Addr::Con(Constant::Atom(module_name, _)) = module_name {
match self.store(self.deref(self[temp_v!(2)].clone())) {
match self.store(self.deref(self[temp_v!(2 + narity)].clone())) {
Addr::Str(a) => {
if let HeapCellValue::NamedStr(arity, name, _) = self.heap[a].clone() {
for i in 1..arity + 1 {
for i in (arity + 1 .. arity + narity + 1).rev() {
self.registers[i] = self.registers[i - arity].clone();
}
for i in 1 .. arity + 1 {
self.registers[i] = self.heap[a + i].as_addr(a + i);
}
return self.module_lookup(
indices,
(name, arity),
(name, arity + narity),
module_name,
true,
);
}
}
Addr::Con(Constant::Atom(name, _)) => {
return self.module_lookup(indices, (name, 0), module_name, true)
Addr::Con(Constant::Atom(name, _)) => {
return self.module_lookup(indices, (name, narity), module_name, true)
}
addr => {
let stub = MachineError::functor_stub(clause_name!("(:)"), 2);