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

tag DCG constructs with module names for proper resolution

Browse Source
This commit is contained in:
Mark Thom
2021-11-19 23:00:56 -07:00
parent addc817cca
commit 0e2db4a23e
5 changed files with 146 additions and 103 deletions
Download Patch File Download Diff File Expand all files Collapse all files

4
src/clause_types.rs
View File

@@ -638,8 +638,8 @@ impl SystemClauseType {
(atom!("$flush_output"), 1) => Some(SystemClauseType::FlushOutput),
(atom!("$del_attr_non_head"), 1) => Some(SystemClauseType::DeleteAttribute),
(atom!("$del_attr_head"), 1) => Some(SystemClauseType::DeleteHeadAttribute),
(atom!("$get_next_db_ref"), 2) => Some(SystemClauseType::GetNextDBRef),
(atom!("$get_next_op_db_ref"), 2) => Some(SystemClauseType::GetNextOpDBRef),
(atom!("$get_next_db_ref"), 4) => Some(SystemClauseType::GetNextDBRef),
(atom!("$get_next_op_db_ref"), 7) => Some(SystemClauseType::GetNextOpDBRef),
(atom!("$module_call"), _) => Some(SystemClauseType::DynamicModuleResolution(arity - 2)),
(atom!("$enqueue_attr_var"), 1) => Some(SystemClauseType::EnqueueAttributedVar),
(atom!("$partial_string_tail"), 2) => Some(SystemClauseType::PartialStringTail),

44
src/lib/builtins.pl
View File

@@ -61,61 +61,61 @@ call(G, A, B, C, D, E, F, G, H) :- '$call'(G, A, B, C, D, E, F, G, H).
Module : Predicate :-
( atom(Module) -> '$module_call'(Module, Predicate)
; throw(error(type_error(atom, Module), (:)/2))
( atom(Module) -> '$module_call'(Module, Predicate)
; throw(error(type_error(atom, Module), (:)/2))
).
% dynamic module resolution.
:(Module, Predicate, A1) :-
( atom(Module) -> '$module_call'(A1, Module, Predicate)
; throw(error(type_error(atom, Module), (:)/2))
( 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))
( 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))
( 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))
( 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))
( 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))
( 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))
( 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))
( 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))
( 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))
( atom(Module) -> '$module_call'(A1, A2, A3, A4, A5, A6, A7, A8, A9, A10, Module, Predicate)
; throw(error(type_error(atom, Module), (:)/2))
).
% flags.

150
src/lib/dcgs.pl
View File

@@ -1,16 +1,25 @@
:- module(dcgs,
[op(1105, xfy, '|'),
phrase/2,
phrase/3,
seq//1,
seqq//1,
... //0
]).
phrase/2,
phrase/3,
seq//1,
seqq//1,
... //0
]).
:- use_module(library(error)).
:- use_module(library(lists), [append/3]).
:- use_module(library(lists), [append/3, member/2]).
:- use_module(library(loader), [strip_module/3]).
load_context(GRBody, Module, GRBody0) :-
strip_module(GRBody, Module, GRBody0),
( nonvar(Module) ->
true
; prolog_load_context(module, Module) ->
true
; true
).
:- meta_predicate phrase(2, ?).
:- meta_predicate phrase(2, ?, ?).
@@ -18,77 +27,78 @@
phrase(GRBody, S0) :-
phrase(GRBody, S0, []).
phrase(GRBody, S0, S) :-
( var(GRBody) ->
throw(error(instantiation_error, phrase/3))
; strip_module(GRBody, Module, GRBody0),
; load_context(GRBody, Module, GRBody0),
dcg_constr(GRBody0) ->
( var(Module) ->
phrase_(GRBody0, S0, S)
; phrase_(Module:GRBody0, S0, S)
; phrase_(GRBody0, S0, S, Module)
)
; functor(GRBody, _, _) ->
call(GRBody, S0, S)
; throw(error(type_error(callable, GRBody), phrase/3))
).
phrase_([], S, S).
phrase_(!, S, S).
phrase_(_:[], S, S) :- !.
phrase_(_:!, S, S) :- !.
phrase_((A, B), S0, S) :-
phrase(A, S0, S1), phrase(B, S1, S).
phrase_(M:(A, B), S0, S) :-
!,
phrase(M:A, S0, S1), phrase(M:B, S1, S).
phrase_((A -> B ; C), S0, S) :-
!,
( phrase(A, S0, S1) ->
phrase(B, S1, S)
; phrase(C, S0, S)
).
phrase_(M:(A -> B ; C), S0, S) :-
!,
phrase_([], S, S, _).
phrase_(!, S, S, _).
phrase_((A, B), S0, S, M) :-
phrase(M:A, S0, S1),
phrase(M:B, S1, S).
phrase_((A -> B ; C), S0, S, M) :-
( phrase(M:A, S0, S1) ->
phrase(M:B, S1, S)
; phrase(M:C, S0, S)
).
phrase_((A ; B), S0, S) :-
( phrase(A, S0, S) ; phrase(B, S0, S) ).
phrase_(M:(A ; B), S0, S) :-
!,
( phrase(M:A, S0, S) ; phrase(M:B, S0, S) ).
phrase_((A | B), S0, S) :-
( phrase(A, S0, S) ; phrase(B, S0, S) ).
phrase_(M:(A | B), S0, S) :-
!,
( phrase(M:A, S0, S) ; phrase(M:B, S0, S) ).
phrase_({G}, S0, S) :-
( call(G), S0 = S ).
phrase_(M:{G}, S0, S) :-
!,
( call(M:G), S0 = S ).
phrase_(call(G), S0, S) :-
call(G, S0, S).
phrase_(M:call(G), S0, S) :-
!,
phrase_((A ; B), S0, S, M) :-
( phrase(M:A, S0, S)
; phrase(M:B, S0, S)
).
phrase_((A | B), S0, S, M) :-
( phrase(M:A, S0, S)
; phrase(M:B, S0, S)
).
phrase_({G}, S, S, M) :-
call(M:G).
phrase_(call(G), S0, S, M) :-
call(M:G, S0, S).
phrase_((A -> B), S0, S) :-
phrase((A -> B ; fail), S0, S).
phrase_(M:(A -> B), S0, S) :-
!,
phrase((M:A -> M:B ; fail), S0, S).
phrase_(phrase(NonTerminal), S0, S) :-
phrase(NonTerminal, S0, S).
phrase_(M:phrase(NonTerminal), S0, S) :-
!,
phrase(M:NonTerminal, S0, S).
phrase_([T|Ts], S0, S) :-
append([T|Ts], S, S0).
phrase_(_:[T|Ts], S0, S) :-
phrase_((A -> B), S0, S, M) :-
( phrase(M:A, S0, S1) ->
phrase(M:B, S1, S)
; fail
).
phrase_(phrase(NonTerminal), S0, S, M) :-
phrase(NonTerminal, S0, S, M).
phrase_([T|Ts], S0, S, _) :-
append([T|Ts], S, S0).
phrase_([], S, S).
phrase_(!, S, S).
phrase_(M:G, S0, S) :-
phrase_(G, S0, S, M).
phrase_((A, B), S0, S) :-
phrase(A, S0, S1),
phrase(B, S1, S).
phrase_((A -> B ; C), S0, S) :-
( phrase(A, S0, S1) ->
phrase(B, S1, S)
; phrase(C, S0, S)
).
phrase_((A ; B), S0, S) :-
( phrase(A, S0, S) ; phrase(B, S0, S) ).
phrase_((A | B), S0, S) :-
( phrase(A, S0, S) ; phrase(B, S0, S) ).
phrase_({G}, S0, S) :-
( call(G), S0 = S ).
phrase_(call(G), S0, S) :-
call(G, S0, S).
phrase_((A -> B), S0, S) :-
phrase((A -> B ; fail), S0, S).
phrase_(phrase(NonTerminal), S0, S) :-
phrase(NonTerminal, S0, S).
phrase_([T|Ts], S0, S) :-
append([T|Ts], S, S0).
% The same version of the below two dcg_rule clauses, but with module scoping.
dcg_rule(( M:NonTerminal, Terminals --> GRBody ), ( M:Head :- Body )) :-
@@ -193,3 +203,25 @@ seqq([Es|Ess]) --> seq(Es), seqq(Ess).
% Describes an arbitrary number of elements
... --> [] | [_], ... .
user:goal_expansion(phrase(GRBody, S, S0), phrase(GRBody1, S, S0)) :-
strip_module(GRBody, M, GRBody0),
var(M),
prolog_load_context(module, M),
( nonvar(GRBody0) ->
GRBody0 \== [],
dcg_constr(GRBody0),
predicate_property(GRBody0, meta_predicate(_))
),
GRBody1 = M:GRBody0.
user:goal_expansion(phrase(GRBody, S), phrase(GRBody1, S, [])) :-
strip_module(GRBody, M, GRBody0),
var(M),
prolog_load_context(module, M),
( nonvar(GRBody0) ->
GRBody0 \== [],
dcg_constr(GRBody0),
predicate_property(GRBody0, meta_predicate(_))
),
GRBody1 = M:GRBody0.

33
src/loader.pl
View File

@@ -315,6 +315,7 @@ compile_dispatch(user:goal_expansion(Term, Terms), Evacuable) :-
compile_dispatch((user:goal_expansion(Term, Terms) :- Body), Evacuable) :-
'$add_goal_expansion_clause'(user, (goal_expansion(Term, Terms) :- Body), Evacuable).
remove_module(Module, Evacuable) :-
( nonvar(Module),
Module = library(ModuleName),
@@ -708,17 +709,13 @@ expand_goal(UnexpandedGoals, Module, ExpandedGoals, HeadVars) :-
)
).
thread_goals(Goals0, Goals1, Functor) :-
( var(Goals0) ->
Goals0 = Goals1
; ( Goals0 = [G | Gs] ->
( Gs = [] ->
Goals1 = G
; Goals1 =.. [Functor, G, Goals2],
thread_goals(Gs, Goals2, Functor)
)
; Goals1 = Goals0
)
thread_goals([SG|SGs], G, F) :-
( SGs \== [], functor(G, F, 2) ->
arg(1, G, SG),
arg(2, G, Gs1),
thread_goals(SGs, Gs1, F)
; SG = G,
SGs = []
).
thread_goals(Goals0, Goals1, Hole, Functor) :-
@@ -734,6 +731,20 @@ thread_goals(Goals0, Goals1, Hole, Functor) :-
)
).
/*
thread_goals(Goals0, Goals1, Functor) :-
( var(Goals0) ->
Goals0 = Goals1
; ( Goals0 = [G | Gs] ->
( Gs = [] ->
Goals1 = G
; Goals1 =.. [Functor, G, Goals2],
thread_goals(Gs, Goals2, Functor)
)
; Goals1 = Goals0
)
).
*/
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%

18
src/machine/attributed_variables.rs
View File

@@ -86,21 +86,21 @@ impl MachineState {
.iter()
.filter_map(|h| {
read_heap_cell!(self.store(self.deref(heap_loc_as_cell!(*h))), //Addr::HeapCell(*h))) {
(HeapCellValueTag::AttrVar, h) => {
Some(attr_var_as_cell!(h))
}
_ => {
None
}
(HeapCellValueTag::AttrVar, h) => {
Some(attr_var_as_cell!(h))
}
_ => {
None
}
)
})
.collect();
attr_vars.sort_unstable_by(|a1, a2| {
compare_term_test!(self, *a1, *a2).unwrap_or(Ordering::Less)
});
compare_term_test!(self, *a1, *a2).unwrap_or(Ordering::Less)
});
attr_vars.dedup();
attr_vars.dedup();
attr_vars.into_iter()
}