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

change goal and term expansions, change call/N to use goal expansions

Browse Source
This commit is contained in:
Mark Thom
2019-12-10 21:36:02 -07:00
parent b0fa45cd33
commit 196784bd09
20 changed files with 424 additions and 243 deletions
Download Patch File Download Diff File Expand all files Collapse all files

11
src/prolog/lib/atts.pl
View File

@@ -56,14 +56,15 @@
'$del_attr'(Ls0, V, Attr) :-
Ls0 = [Att | Ls1],
nonvar(Att),
( Att \= Attr -> '$del_attr_buried'(Ls0, Ls1, V, Attr)
; '$enqueue_attr_var'(V),
'$del_attr_head'(V), '$del_attr'(Ls1, V, Attr)
( Att \= Attr -> '$del_attr_buried'(Ls0, Ls1, V, Attr)
; '$enqueue_attr_var'(V),
'$del_attr_head'(V),
'$del_attr'(Ls1, V, Attr)
).
'$del_attr_step'(Ls1, V, Attr) :-
( nonvar(Ls1) -> Ls1 = [_ | Ls2], '$del_attr_buried'(Ls1, Ls2, V, Attr)
; true ).
( nonvar(Ls1) -> Ls1 = [_ | Ls2], '$del_attr_buried'(Ls1, Ls2, V, Attr)
; true ).
%% assumptions: Ls0 is a list, Ls1 is its tail;
%% the head of Ls0 can be ignored.

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

@@ -43,7 +43,11 @@ user:term_expansion((:- op(Pred, Spec, [Op | OtherOps])), OpResults) :-
(:)/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,
bagof/3, call/1, call/2, call/3, call/4,
call/5, call/6, call/7, call/8, call/9,
call/10, call/11, call/12, call/13,
call/14, call/15, call/16, call/17,
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,
@@ -55,6 +59,76 @@ 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]).
%% call/{1..17}
call(Goal) :-
( '$module_of'(Module, Goal),
Module:goal_expansion(Goal, ExpandedGoal) ->
true
; Goal = ExpandedGoal
),
'$call'(ExpandedGoal).
'$call_body'(Goal, As) :-
Goal =.. F,
lists:append(F, As, Fs),
ExpandedGoal0 =.. Fs,
( '$module_of'(Module, ExpandedGoal0),
Module:goal_expansion(ExpandedGoal0, ExpandedGoal1) ->
true
; ExpandedGoal1 = ExpandedGoal0
),
'$call'(ExpandedGoal1).
call(Goal, A1) :-
'$call_body'(Goal, [A1]).
call(Goal, A1, A2) :-
'$call_body'(Goal, [A1, A2]).
call(Goal, A1, A2, A3) :-
'$call_body'(Goal, [A1, A2, A3]).
call(Goal, A1, A2, A3, A4) :-
'$call_body'(Goal, [A1, A2, A3, A4]).
call(Goal, A1, A2, A3, A4, A5) :-
'$call_body'(Goal, [A1, A2, A3, A4, A5]).
call(Goal, A1, A2, A3, A4, A5, A6) :-
'$call_body'(Goal, [A1, A2, A3, A4, A5, A6]).
call(Goal, A1, A2, A3, A4, A5, A6, A7) :-
'$call_body'(Goal, [A1, A2, A3, A4, A5, A6, A7]).
call(Goal, A1, A2, A3, A4, A5, A6, A7, A8) :-
'$call_body'(Goal, [A1, A2, A3, A4, A5, A6, A7, A8]).
call(Goal, A1, A2, A3, A4, A5, A6, A7, A8, A9) :-
'$call_body'(Goal, [A1, A2, A3, A4, A5, A6, A7, A8, A9]).
call(Goal, A1, A2, A3, A4, A5, A6, A7, A8, A9, A10) :-
'$call_body'(Goal, [A1, A2, A3, A4, A5, A6, A7, A8, A9, A10]).
call(Goal, A1, A2, A3, A4, A5, A6, A7, A8, A9, A10, A11) :-
'$call_body'(Goal, [A1, A2, A3, A4, A5, A6, A7, A8, A9, A10, A11]).
call(Goal, A1, A2, A3, A4, A5, A6, A7, A8, A9, A10, A11, A12) :-
'$call_body'(Goal, [A1, A2, A3, A4, A5, A6, A7, A8, A9, A10, A11, A12]).
call(Goal, A1, A2, A3, A4, A5, A6, A7, A8, A9, A10, A11, A12, A13) :-
'$call_body'(Goal, [A1, A2, A3, A4, A5, A6, A7, A8, A9, A10, A11, A12, A13]).
call(Goal, A1, A2, A3, A4, A5, A6, A7, A8, A9, A10, A11, A12, A13, A14) :-
'$call_body'(Goal, [A1, A2, A3, A4, A5, A6, A7, A8, A9, A10, A11, A12, A13, A14]).
call(Goal, A1, A2, A3, A4, A5, A6, A7, A8, A9, A10, A11, A12, A13, A14, A15) :-
'$call_body'(Goal, [A1, A2, A3, A4, A5, A6, A7, A8, A9, A10, A11, A12, A13, A14, A15]).
call(Goal, A1, A2, A3, A4, A5, A6, A7, A8, A9, A10, A11, A12, A13, A14, A15, A16) :-
'$call_body'(Goal, [A1, A2, A3, A4, A5, A6, A7, A8, A9, A10, A11, A12, A13, A14, A15, A16]).
% the maximum arity flag. needs to be replaced with
% current_prolog_flag(max_arity, MAX_ARITY).
max_arity(255).
@@ -177,13 +251,13 @@ set_prolog_flag(Flag, _) :-
fail :- '$fail'.
\+ G :- G, !, false.
\+ G :- call(G), !, false.
\+ _.
X \= X :- !, false.
_ \= _.
once(G) :- G, !.
once(G) :- call(G), !.
repeat.
repeat :- repeat.
@@ -200,13 +274,14 @@ comma_errors(G1, G2, B) :- '$call_with_default_policy'(','(G1, G2, B)).
'$set_cp'(B),
'$call_with_default_policy'(comma_errors(G1, G2, B)).
','(!, Atom, B) :- Atom == !, '$set_cp'(B).
','(!, G, B) :- '$set_cp'(B), G.
','(!, G, B) :- '$set_cp'(B), call(G).
','(G, CF, B) :- compound(CF),
'$call_with_default_policy'(CF = ','(G1, G2)),
!, G,
!,
call(G),
'$call_with_default_policy'(comma_errors(G1, G2, B)).
','(G, Atom, B) :- Atom == !, !, G, '$set_cp'(B).
','(G1, G2, _) :- G1, G2.
','(G, Atom, B) :- Atom == !, !, call(G), '$set_cp'(B).
','(G1, G2, _) :- call(G1), call(G2).
;(G1, G2) :- '$get_b_value'(B), ;(G1, G2, B).
@@ -214,37 +289,47 @@ comma_errors(G1, G2, B) :- '$call_with_default_policy'(','(G1, G2, B)).
;(G1, G4, B) :- compound(G1),
'$call_with_default_policy'(G1 = ->(G2, G3)),
!,
(G2 -> G3 ; '$set_cp'(B), G4).
;(G1, G2, B) :- G1 == !, '$set_cp'(B), G2.
;(G1, G2, B) :- G2 == !, G1, '$set_cp'(B).
;(G, _, _) :- G.
;(_, G, _) :- G.
( call(G2) -> call(G3)
; '$set_cp'(B),
call(G4)
).
;(G1, G2, B) :- G1 == !, '$set_cp'(B), call(G2).
;(G1, G2, B) :- G2 == !, call(G1), '$set_cp'(B).
;(G, _, _) :- call(G).
;(_, G, _) :- call(G).
G1 -> G2 :- '$get_b_value'(B), '$call_with_default_policy'(->(G1, G2, B)).
:- non_counted_backtracking (->)/3.
->(G1, G2, B) :- G2 == !, G1, '$set_cp'(B).
->(G1, G2, B) :- G1, '$set_cp'(B), G2.
->(G1, G2, B) :- G2 == !, call(G1), '$set_cp'(B).
->(G1, G2, B) :- call(G1), '$set_cp'(B), call(G2).
% univ.
:- non_counted_backtracking univ_errors/3.
univ_errors(Term, List, N) :-
'$skip_max_list'(N, -1, List, R),
( var(R) -> ( var(Term), throw(error(instantiation_error, (=..)/2)) % 8.5.3.3 a)
; true )
; R \== [] -> throw(error(type_error(list, List), (=..)/2)) % 8.5.3.3 b)
; List = [H|T] -> ( var(H), var(Term), % R == [] => List is a proper list.
throw(error(instantiation_error, (=..)/2)) % 8.5.3.3 c)
; T \== [], nonvar(H), \+ atom(H),
throw(error(type_error(atom, H), (=..)/2)) % 8.5.3.3 d)
; compound(H), T == [],
throw(error(type_error(atomic, H), (=..)/2)) % 8.5.3.3 e)
; var(Term), max_arity(M), N - 1 > M,
throw(error(representation_error(max_arity), (=..)/2)) % 8.5.3.3 g)
; true )
; var(Term) -> throw(error(domain_error(non_empty_list, List), (=..)/2)) % 8.5.3.3 f)
; true ).
( var(R) ->
( var(Term), throw(error(instantiation_error, (=..)/2)) % 8.5.3.3 a)
; true
)
; R \== [] ->
throw(error(type_error(list, List), (=..)/2)) % 8.5.3.3 b)
; List = [H|T] ->
( var(H), var(Term), % R == [] => List is a proper list.
throw(error(instantiation_error, (=..)/2)) % 8.5.3.3 c)
; T \== [], nonvar(H), \+ atom(H),
throw(error(type_error(atom, H), (=..)/2)) % 8.5.3.3 d)
; compound(H), T == [],
throw(error(type_error(atomic, H), (=..)/2)) % 8.5.3.3 e)
; var(Term), max_arity(M), N - 1 > M,
throw(error(representation_error(max_arity), (=..)/2)) % 8.5.3.3 g)
; true
)
; var(Term) ->
throw(error(domain_error(non_empty_list, List), (=..)/2)) % 8.5.3.3 f)
; true
).
Term =.. List :- '$call_with_default_policy'(univ_errors(Term, List, N)),
'$call_with_default_policy'(univ_worker(Term, List, N)).
@@ -371,7 +456,8 @@ catch(G,C,R) :- '$get_current_block'(Bb), '$call_with_default_policy'(catch(G,C,
:- non_counted_backtracking catch/4.
catch(G,C,R,Bb) :-
'$install_new_block'(NBb), call(G),
'$install_new_block'(NBb),
call(G),
'$call_with_default_policy'(end_block(Bb, NBb)).
catch(G,C,R,Bb) :-
'$reset_block'(Bb),

7
src/prolog/lib/dcgs.pl
View File

@@ -4,8 +4,9 @@
:- use_module(library(lists), [append/3]).
user:term_expansion(Term0, (Head :- Body)) :-
dcg_rule(Term0, Term),
user:term_expansion(Term0, Term) :-
nonvar(Term0),
dcg_rule(Term0, (Head :- Body)),
Term = (Head :- Body).
phrase(GRBody, S0) :-
@@ -33,7 +34,7 @@ phrase_((A ; B), S0, S) :-
%% phrase_((A | B), S0, S) :-
%% ( phrase(A, S0, S) ; phrase(B, S0, S) ).
phrase_({G}, S0, S) :-
( G, S0 = S ).
( call(G), S0 = S ).
phrase_(call(G), S0, S) :-
call(G, S0, S).
phrase_((A -> B), S0, S) :-

23
src/prolog/lib/non_iso.pl
View File

@@ -46,8 +46,11 @@ call_cleanup(G, C) :- setup_call_cleanup(true, G, C).
% setup_call_cleanup.
setup_call_cleanup(S, G, C) :- '$get_b_value'(B),
S, '$set_cp_by_default'(B), '$get_current_block'(Bb),
setup_call_cleanup(S, G, C) :-
'$get_b_value'(B),
call(S),
'$set_cp_by_default'(B),
'$get_current_block'(Bb),
( '$call_with_default_policy'(var(C)) ->
throw(error(instantiation_error, setup_call_cleanup/3))
; '$call_with_default_policy'(scc_helper(C, G, Bb))
@@ -83,10 +86,14 @@ run_cleaners_with_handling :-
:- non_counted_backtracking run_cleaners_without_handling/1.
run_cleaners_without_handling(Cp) :-
'$get_scc_cleaner'(C), '$get_level'(B), C, '$set_cp_by_default'(B),
'$get_scc_cleaner'(C),
'$get_level'(B),
call(C),
'$set_cp_by_default'(B),
'$call_with_default_policy'(run_cleaners_without_handling(Cp)).
run_cleaners_without_handling(Cp) :-
'$set_cp_by_default'(Cp), '$restore_cut_policy'.
'$set_cp_by_default'(Cp),
'$restore_cut_policy'.
% call_with_inference_limit
@@ -123,8 +130,12 @@ call_with_inference_limit(G, L, R, Bb, B) :-
call_with_inference_limit(_, _, R, Bb, B) :-
'$reset_block'(Bb),
'$remove_inference_counter'(B, _),
( '$get_ball'(Ball), '$get_level'(Cp), '$set_cp_by_default'(Cp)
; '$remove_call_policy_check'(B), '$fail' ),
( '$get_ball'(Ball),
'$get_level'(Cp),
'$set_cp_by_default'(Cp)
; '$remove_call_policy_check'(B),
'$fail'
),
'$erase_ball',
'$call_with_default_policy'(handle_ile(B, Ball, R)).