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!("$flush_output"), 1) => Some(SystemClauseType::FlushOutput),
(atom!("$del_attr_non_head"), 1) => Some(SystemClauseType::DeleteAttribute), (atom!("$del_attr_non_head"), 1) => Some(SystemClauseType::DeleteAttribute),
(atom!("$del_attr_head"), 1) => Some(SystemClauseType::DeleteHeadAttribute), (atom!("$del_attr_head"), 1) => Some(SystemClauseType::DeleteHeadAttribute),
(atom!("$get_next_db_ref"), 2) => Some(SystemClauseType::GetNextDBRef), (atom!("$get_next_db_ref"), 4) => Some(SystemClauseType::GetNextDBRef),
(atom!("$get_next_op_db_ref"), 2) => Some(SystemClauseType::GetNextOpDBRef), (atom!("$get_next_op_db_ref"), 7) => Some(SystemClauseType::GetNextOpDBRef),
(atom!("$module_call"), _) => Some(SystemClauseType::DynamicModuleResolution(arity - 2)), (atom!("$module_call"), _) => Some(SystemClauseType::DynamicModuleResolution(arity - 2)),
(atom!("$enqueue_attr_var"), 1) => Some(SystemClauseType::EnqueueAttributedVar), (atom!("$enqueue_attr_var"), 1) => Some(SystemClauseType::EnqueueAttributedVar),
(atom!("$partial_string_tail"), 2) => Some(SystemClauseType::PartialStringTail), (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 :- Module : Predicate :-
( atom(Module) -> '$module_call'(Module, Predicate) ( atom(Module) -> '$module_call'(Module, Predicate)
; throw(error(type_error(atom, Module), (:)/2)) ; throw(error(type_error(atom, Module), (:)/2))
). ).
% dynamic module resolution. % dynamic module resolution.
:(Module, Predicate, A1) :- :(Module, Predicate, A1) :-
( atom(Module) -> '$module_call'(A1, Module, Predicate) ( atom(Module) -> '$module_call'(A1, Module, Predicate)
; throw(error(type_error(atom, Module), (:)/2)) ; throw(error(type_error(atom, Module), (:)/2))
). ).
:(Module, Predicate, A1, A2) :- :(Module, Predicate, A1, A2) :-
( atom(Module) -> '$module_call'(A1, A2, Module, Predicate) ( atom(Module) -> '$module_call'(A1, A2, Module, Predicate)
; throw(error(type_error(atom, Module), (:)/2)) ; throw(error(type_error(atom, Module), (:)/2))
). ).
:(Module, Predicate, A1, A2, A3) :- :(Module, Predicate, A1, A2, A3) :-
( atom(Module) -> '$module_call'(A1, A2, A3, Module, Predicate) ( atom(Module) -> '$module_call'(A1, A2, A3, Module, Predicate)
; throw(error(type_error(atom, Module), (:)/2)) ; throw(error(type_error(atom, Module), (:)/2))
). ).
:(Module, Predicate, A1, A2, A3, A4) :- :(Module, Predicate, A1, A2, A3, A4) :-
( atom(Module) -> '$module_call'(A1, A2, A3, A4, Module, Predicate) ( atom(Module) -> '$module_call'(A1, A2, A3, A4, Module, Predicate)
; throw(error(type_error(atom, Module), (:)/2)) ; throw(error(type_error(atom, Module), (:)/2))
). ).
:(Module, Predicate, A1, A2, A3, A4, A5) :- :(Module, Predicate, A1, A2, A3, A4, A5) :-
( atom(Module) -> '$module_call'(A1, A2, A3, A4, A5, Module, Predicate) ( atom(Module) -> '$module_call'(A1, A2, A3, A4, A5, Module, Predicate)
; throw(error(type_error(atom, Module), (:)/2)) ; throw(error(type_error(atom, Module), (:)/2))
). ).
:(Module, Predicate, A1, A2, A3, A4, A5, A6) :- :(Module, Predicate, A1, A2, A3, A4, A5, A6) :-
( atom(Module) -> '$module_call'(A1, A2, A3, A4, A5, A6, Module, Predicate) ( atom(Module) -> '$module_call'(A1, A2, A3, A4, A5, A6, Module, Predicate)
; throw(error(type_error(atom, Module), (:)/2)) ; throw(error(type_error(atom, Module), (:)/2))
). ).
:(Module, Predicate, A1, A2, A3, A4, A5, A6, A7) :- :(Module, Predicate, A1, A2, A3, A4, A5, A6, A7) :-
( atom(Module) -> '$module_call'(A1, A2, A3, A4, A5, A6, A7, Module, Predicate) ( atom(Module) -> '$module_call'(A1, A2, A3, A4, A5, A6, A7, Module, Predicate)
; throw(error(type_error(atom, Module), (:)/2)) ; throw(error(type_error(atom, Module), (:)/2))
). ).
:(Module, Predicate, A1, A2, A3, A4, A5, A6, A7, A8) :- :(Module, Predicate, A1, A2, A3, A4, A5, A6, A7, A8) :-
( atom(Module) -> '$module_call'(A1, A2, A3, A4, A5, A6, A7, A8, Module, Predicate) ( atom(Module) -> '$module_call'(A1, A2, A3, A4, A5, A6, A7, A8, Module, Predicate)
; throw(error(type_error(atom, Module), (:)/2)) ; throw(error(type_error(atom, Module), (:)/2))
). ).
:(Module, Predicate, A1, A2, A3, A4, A5, A6, A7, A8, A9) :- :(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) ( atom(Module) -> '$module_call'(A1, A2, A3, A4, A5, A6, A7, A8, A9, Module, Predicate)
; throw(error(type_error(atom, Module), (:)/2)) ; throw(error(type_error(atom, Module), (:)/2))
). ).
:(Module, Predicate, A1, A2, A3, A4, A5, A6, A7, A8, A9, A10) :- :(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) ( atom(Module) -> '$module_call'(A1, A2, A3, A4, A5, A6, A7, A8, A9, A10, Module, Predicate)
; throw(error(type_error(atom, Module), (:)/2)) ; throw(error(type_error(atom, Module), (:)/2))
). ).
% flags. % flags.

150
src/lib/dcgs.pl
View File

@@ -1,16 +1,25 @@
:- module(dcgs, :- module(dcgs,
[op(1105, xfy, '|'), [op(1105, xfy, '|'),
phrase/2, phrase/2,
phrase/3, phrase/3,
seq//1, seq//1,
seqq//1, seqq//1,
... //0 ... //0
]). ]).
:- use_module(library(error)). :- 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]). :- 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, ?).
:- meta_predicate phrase(2, ?, ?). :- meta_predicate phrase(2, ?, ?).
@@ -18,77 +27,78 @@
phrase(GRBody, S0) :- phrase(GRBody, S0) :-
phrase(GRBody, S0, []). phrase(GRBody, S0, []).
phrase(GRBody, S0, S) :- phrase(GRBody, S0, S) :-
( var(GRBody) -> ( var(GRBody) ->
throw(error(instantiation_error, phrase/3)) throw(error(instantiation_error, phrase/3))
; strip_module(GRBody, Module, GRBody0), ; load_context(GRBody, Module, GRBody0),
dcg_constr(GRBody0) -> dcg_constr(GRBody0) ->
( var(Module) -> ( var(Module) ->
phrase_(GRBody0, S0, S) phrase_(GRBody0, S0, S)
; phrase_(Module:GRBody0, S0, S) ; phrase_(GRBody0, S0, S, Module)
) )
; functor(GRBody, _, _) -> ; functor(GRBody, _, _) ->
call(GRBody, S0, S) call(GRBody, S0, S)
; throw(error(type_error(callable, GRBody), phrase/3)) ; throw(error(type_error(callable, GRBody), phrase/3))
). ).
phrase_([], S, S). phrase_([], S, S, _).
phrase_(!, S, S). phrase_(!, S, S, _).
phrase_(_:[], S, S) :- !. phrase_((A, B), S0, S, M) :-
phrase_(_:!, S, S) :- !. phrase(M:A, S0, S1),
phrase_((A, B), S0, S) :- phrase(M:B, S1, S).
phrase(A, S0, S1), phrase(B, S1, S). phrase_((A -> B ; C), S0, S, M) :-
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(M:A, S0, S1) -> ( phrase(M:A, S0, S1) ->
phrase(M:B, S1, S) phrase(M:B, S1, S)
; phrase(M:C, S0, S) ; phrase(M:C, S0, S)
). ).
phrase_((A ; B), S0, S) :- phrase_((A ; B), S0, S, M) :-
( phrase(A, S0, S) ; phrase(B, S0, S) ). ( phrase(M:A, S0, S)
phrase_(M:(A ; B), S0, S) :- ; phrase(M:B, S0, S)
!, ).
( phrase(M:A, S0, S) ; phrase(M:B, S0, S) ). phrase_((A | B), S0, S, M) :-
phrase_((A | B), S0, S) :- ( phrase(M:A, S0, S)
( phrase(A, S0, S) ; phrase(B, S0, S) ). ; phrase(M:B, S0, S)
phrase_(M:(A | B), S0, S) :- ).
!, phrase_({G}, S, S, M) :-
( phrase(M:A, S0, S) ; phrase(M:B, S0, S) ). call(M:G).
phrase_({G}, S0, S) :- phrase_(call(G), S0, S, M) :-
( 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) :-
!,
call(M:G, S0, S). call(M:G, S0, S).
phrase_((A -> B), S0, S) :- phrase_((A -> B), S0, S, M) :-
phrase((A -> B ; fail), S0, S). ( phrase(M:A, S0, S1) ->
phrase_(M:(A -> B), S0, S) :- phrase(M:B, S1, S)
!, ; fail
phrase((M:A -> M:B ; fail), S0, S). ).
phrase_(phrase(NonTerminal), S0, S) :- phrase_(phrase(NonTerminal), S0, S, M) :-
phrase(NonTerminal, S0, S). phrase(NonTerminal, S0, S, M).
phrase_(M:phrase(NonTerminal), S0, S) :- phrase_([T|Ts], S0, S, _) :-
!,
phrase(M:NonTerminal, S0, S).
phrase_([T|Ts], S0, S) :-
append([T|Ts], S, S0).
phrase_(_:[T|Ts], S0, S) :-
append([T|Ts], S, S0). 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. % The same version of the below two dcg_rule clauses, but with module scoping.
dcg_rule(( M:NonTerminal, Terminals --> GRBody ), ( M:Head :- Body )) :- 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 % 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) :- compile_dispatch((user:goal_expansion(Term, Terms) :- Body), Evacuable) :-
'$add_goal_expansion_clause'(user, (goal_expansion(Term, Terms) :- Body), Evacuable). '$add_goal_expansion_clause'(user, (goal_expansion(Term, Terms) :- Body), Evacuable).
remove_module(Module, Evacuable) :- remove_module(Module, Evacuable) :-
( nonvar(Module), ( nonvar(Module),
Module = library(ModuleName), Module = library(ModuleName),
@@ -708,17 +709,13 @@ expand_goal(UnexpandedGoals, Module, ExpandedGoals, HeadVars) :-
) )
). ).
thread_goals(Goals0, Goals1, Functor) :- thread_goals([SG|SGs], G, F) :-
( var(Goals0) -> ( SGs \== [], functor(G, F, 2) ->
Goals0 = Goals1 arg(1, G, SG),
; ( Goals0 = [G | Gs] -> arg(2, G, Gs1),
( Gs = [] -> thread_goals(SGs, Gs1, F)
Goals1 = G ; SG = G,
; Goals1 =.. [Functor, G, Goals2], SGs = []
thread_goals(Gs, Goals2, Functor)
)
; Goals1 = Goals0
)
). ).
thread_goals(Goals0, Goals1, Hole, Functor) :- 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() .iter()
.filter_map(|h| { .filter_map(|h| {
read_heap_cell!(self.store(self.deref(heap_loc_as_cell!(*h))), //Addr::HeapCell(*h))) { read_heap_cell!(self.store(self.deref(heap_loc_as_cell!(*h))), //Addr::HeapCell(*h))) {
(HeapCellValueTag::AttrVar, h) => { (HeapCellValueTag::AttrVar, h) => {
Some(attr_var_as_cell!(h)) Some(attr_var_as_cell!(h))
} }
_ => { _ => {
None None
} }
) )
}) })
.collect(); .collect();
attr_vars.sort_unstable_by(|a1, a2| { 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() attr_vars.into_iter()
} }