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

delay callable errors in control predicates (#1282)

Browse Source
This commit is contained in:
Mark Thom
2022-02-17 20:26:30 -07:00
parent 5b829636cb
commit 55d8de1b23
3 changed files with 117 additions and 61 deletions
Download Patch File Download Diff File Expand all files Collapse all files

115
src/lib/builtins.pl
View File

@@ -208,70 +208,115 @@ repeat :- repeat.
:- meta_predicate ->(0,0). :- meta_predicate ->(0,0).
! :- '$get_staggered_cp'(B), '$set_cp'(B).
G1 -> G2 :- '$get_staggered_cp'(B), call('$call'(G1)), '$set_cp'(B), call('$call'(G2)). G1 -> G2 :- control_entry_point((G1 -> G2)).
G ; _ :- call('$call'(G)).
_ ; G :- call('$call'(G)).
','(G1, G2) :- '$get_staggered_cp'(B), comma_dispatch(G1,G2,B). :- non_counted_backtracking staggered_if_then/2.
staggered_if_then(G1, G2) :-
'$get_staggered_cp'(B),
call('$call'(G1)),
'$set_cp'(B),
call('$call'(G2)).
G1 ; G2 :- control_entry_point((G1 ; G2)).
:- non_counted_backtracking staggered_sc/2.
staggered_sc(G, _) :- call('$call'(G)).
staggered_sc(_, G) :- call('$call'(G)).
! :- !.
:- non_counted_backtracking set_cp/1.
set_cp(B) :- '$set_cp'(B). set_cp(B) :- '$set_cp'(B).
:- non_counted_backtracking comma_dispatch/3. ','(G1, G2) :- control_entry_point((G1, G2)).
:- non_counted_backtracking control_entry_point/1.
control_entry_point(G) :-
functor(G, Name, Arity),
catch(builtins:control_entry_point_(G),
dispatch_prep_error,
builtins:throw(error(type_error(callable, G), Name/Arity))).
:- non_counted_backtracking control_entry_point_/1.
control_entry_point_(G) :-
'$get_cp'(B),
dispatch_prep(G,B,Conts),
dispatch_call_list(Conts).
comma_dispatch(G1, G2, B) :-
comma_dispatch_prep((G1, G2), B, Conts),
comma_dispatch_call_list(Conts).
:- non_counted_backtracking cont_list_to_goal/2. :- non_counted_backtracking cont_list_to_goal/2.
cont_list_goal([Cont], Cont) :- !. cont_list_goal([Cont], Cont) :- !.
cont_list_goal(Conts, builtins:comma_dispatch_call_list(Conts)). cont_list_goal(Conts, builtins:dispatch_call_list(Conts)).
:- non_counted_backtracking comma_dispatch_prep/3.
comma_dispatch_prep(Gs, B, [Cont|Conts]) :- :- non_counted_backtracking module_qualified_cut/1.
module_qualified_cut(Gs) :-
( functor(Gs, call, 1) ->
arg(1, Gs, G1)
; Gs = G1
),
functor(G1, (:), 2),
arg(2, G1, G2),
G2 == !.
:- non_counted_backtracking dispatch_prep/3.
dispatch_prep(Gs, B, [Cont|Conts]) :-
( callable(Gs) -> ( callable(Gs) ->
( functor(Gs, ',', 2) -> ( functor(Gs, ',', 2) ->
arg(1, Gs, G1), arg(1, Gs, G1),
arg(2, Gs, G2), arg(2, Gs, G2),
comma_dispatch_prep(G1, B, IConts1), dispatch_prep(G1, B, IConts1),
cont_list_goal(IConts1, Cont), cont_list_goal(IConts1, Cont),
comma_dispatch_prep(G2, B, Conts) dispatch_prep(G2, B, Conts)
; Gs == ! ->
Cont = builtins:set_cp(B),
Conts = []
; functor(Gs, ';', 2) -> ; functor(Gs, ';', 2) ->
arg(1, Gs, G1), arg(1, Gs, G1),
arg(2, Gs, G2), arg(2, Gs, G2),
comma_dispatch_prep(G1, B, IConts0), dispatch_prep(G1, B, IConts0),
comma_dispatch_prep(G2, B, IConts1), dispatch_prep(G2, B, IConts1),
cont_list_goal(IConts0, Cont0), cont_list_goal(IConts0, Cont0),
cont_list_goal(IConts1, Cont1), cont_list_goal(IConts1, Cont1),
Cont = ( Cont0 ; Cont1 ), Cont = builtins:staggered_sc(Cont0, Cont1),
Conts = [] Conts = []
; functor(Gs, ->, 2) -> ; functor(Gs, ->, 2) ->
arg(1, Gs, G1), arg(1, Gs, G1),
arg(2, Gs, G2), arg(2, Gs, G2),
comma_dispatch_prep(G1, B, IConts1), dispatch_prep(G1, B, IConts1),
comma_dispatch_prep(G2, B, IConts2), dispatch_prep(G2, B, IConts2),
cont_list_goal(IConts1, Cont1), cont_list_goal(IConts1, Cont1),
cont_list_goal(IConts2, Cont2), cont_list_goal(IConts2, Cont2),
Cont = (Cont1 -> Cont2), Cont = builtins:staggered_if_then(Cont1, Cont2),
Conts = []
; ( Gs == ! ; module_qualified_cut(Gs) ) ->
Cont = builtins:set_cp(B),
Conts = [] Conts = []
; Cont = Gs, ; Cont = Gs,
Conts = [] Conts = []
) )
; Cont = Gs, ; var(Gs) ->
Cont = Gs,
Conts = [] Conts = []
; throw(dispatch_prep_error)
). ).
:- non_counted_backtracking comma_dispatch_call_list/1.
comma_dispatch_call_list([]). :- non_counted_backtracking dispatch_call_list/1.
comma_dispatch_call_list([G1,G2,G3,G4,G5,G6,G7,G8|Gs]) :-
dispatch_call_list([]).
dispatch_call_list([G1,G2,G3,G4,G5,G6,G7,G8|Gs]) :-
!, !,
'$call'(G1), '$call'(G1),
'$call'(G2), '$call'(G2),
@@ -281,8 +326,8 @@ comma_dispatch_call_list([G1,G2,G3,G4,G5,G6,G7,G8|Gs]) :-
'$call'(G6), '$call'(G6),
'$call'(G7), '$call'(G7),
'$call'(G8), '$call'(G8),
'$call_with_default_policy'(comma_dispatch_call_list(Gs)). '$call_with_default_policy'(dispatch_call_list(Gs)).
comma_dispatch_call_list([G1,G2,G3,G4,G5,G6,G7]) :- dispatch_call_list([G1,G2,G3,G4,G5,G6,G7]) :-
!, !,
'$call'(G1), '$call'(G1),
'$call'(G2), '$call'(G2),
@@ -291,7 +336,7 @@ comma_dispatch_call_list([G1,G2,G3,G4,G5,G6,G7]) :-
'$call'(G5), '$call'(G5),
'$call'(G6), '$call'(G6),
'$call'(G7). '$call'(G7).
comma_dispatch_call_list([G1,G2,G3,G4,G5,G6]) :- dispatch_call_list([G1,G2,G3,G4,G5,G6]) :-
!, !,
'$call'(G1), '$call'(G1),
'$call'(G2), '$call'(G2),
@@ -299,29 +344,29 @@ comma_dispatch_call_list([G1,G2,G3,G4,G5,G6]) :-
'$call'(G4), '$call'(G4),
'$call'(G5), '$call'(G5),
'$call'(G6). '$call'(G6).
comma_dispatch_call_list([G1,G2,G3,G4,G5]) :- dispatch_call_list([G1,G2,G3,G4,G5]) :-
!, !,
'$call'(G1), '$call'(G1),
'$call'(G2), '$call'(G2),
'$call'(G3), '$call'(G3),
'$call'(G4), '$call'(G4),
'$call'(G5). '$call'(G5).
comma_dispatch_call_list([G1,G2,G3,G4]) :- dispatch_call_list([G1,G2,G3,G4]) :-
!, !,
'$call'(G1), '$call'(G1),
'$call'(G2), '$call'(G2),
'$call'(G3), '$call'(G3),
'$call'(G4). '$call'(G4).
comma_dispatch_call_list([G1,G2,G3]) :- dispatch_call_list([G1,G2,G3]) :-
!, !,
'$call'(G1), '$call'(G1),
'$call'(G2), '$call'(G2),
'$call'(G3). '$call'(G3).
comma_dispatch_call_list([G1,G2]) :- dispatch_call_list([G1,G2]) :-
!, !,
'$call'(G1), '$call'(G1),
'$call'(G2). '$call'(G2).
comma_dispatch_call_list([G1]) :- dispatch_call_list([G1]) :-
'$call'(G1). '$call'(G1).

37
src/loader.pl
View File

@@ -671,7 +671,10 @@ expand_module_names(Goals, MetaSpecs, Module, ExpandedGoals, HeadVars) :-
expand_goal(UnexpandedGoals, Module, ExpandedGoals) :- expand_goal(UnexpandedGoals, Module, ExpandedGoals) :-
expand_goal(UnexpandedGoals, Module, ExpandedGoals, []), % if a goal isn't callable, defer to call/N to report the error.
catch('$call'(loader:expand_goal(UnexpandedGoals, Module, ExpandedGoals, [])),
error(type_error(callable, _), _),
'$call'(UnexpandedGoals = ExpandedGoals)),
!. !.
expand_goal_cases((Goal0, Goals0), Module, ExpandedGoals, HeadVars) :- expand_goal_cases((Goal0, Goals0), Module, ExpandedGoals, HeadVars) :-
@@ -716,27 +719,25 @@ expand_goal(UnexpandedGoals, Module, ExpandedGoals, HeadVars) :-
thread_goals(Goals0, Goals1, Hole, Functor) :- thread_goals(Goals0, Goals1, Hole, Functor) :-
( var(Goals0) -> ( var(Goals0) ->
Goals1 =.. [Functor, Goals0, Hole] Goals1 =.. [Functor, Goals0, Hole]
; ( Goals0 = [G | Gs] -> ; Goals0 = [G | Gs] ->
( Gs == [] -> ( Gs == [] ->
Goals1 =.. [Functor, G, Hole] Goals1 =.. [Functor, G, Hole]
; Goals1 =.. [Functor, G, Goals2], ; Goals1 =.. [Functor, G, Goals2],
thread_goals(Gs, Goals2, Hole, Functor) thread_goals(Gs, Goals2, Hole, Functor)
)
; Goals1 =.. [Functor, Goals0, Hole]
) )
; Goals1 =.. [Functor, Goals0, Hole]
). ).
thread_goals(Goals0, Goals1, Functor) :- thread_goals(Goals0, Goals1, Functor) :-
( var(Goals0) -> ( var(Goals0) ->
Goals0 = Goals1 Goals0 = Goals1
; ( Goals0 = [G | Gs] -> ; Goals0 = [G | Gs] ->
( Gs = [] -> ( Gs = [] ->
Goals1 = G Goals1 = G
; Goals1 =.. [Functor, G, Goals2], ; Goals1 =.. [Functor, G, Goals2],
thread_goals(Gs, Goals2, Functor) thread_goals(Gs, Goals2, Functor)
)
; Goals1 = Goals0
) )
; Goals1 = Goals0
). ).
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
@@ -780,12 +781,14 @@ call_clause('$call'(G), G0) :-
instantiation_error(call/1) instantiation_error(call/1)
; G = M:G1, ; G = M:G1,
!, !,
callable(G1),
functor(G1, F, _), functor(G1, F, _),
atom(F), atom(F),
atom(M), atom(M),
F \== [], F \== [],
G0 = M:G1 G0 = M:G1
; !, ; !,
callable(G),
functor(G, F, _), functor(G, F, _),
atom(F), atom(F),
F \== [], F \== [],
@@ -795,6 +798,7 @@ call_clause('$call'(G), G0) :-
call_clause(G, G0) :- call_clause(G, G0) :-
strip_module(G, M, G1), strip_module(G, M, G1),
callable(G1),
functor(G1, F, _), functor(G1, F, _),
atom(F), atom(F),
F \== [], F \== [],
@@ -825,6 +829,7 @@ call_clause('$call'(G1), Args, N, G0) :-
F \== [], F \== [],
append(As, Args, As1), append(As, Args, As1),
G3 =.. [F | As1], G3 =.. [F | As1],
callable(G3),
G0 = M:G3 G0 = M:G3
; !, ; !,
G1 =.. [F | As], G1 =.. [F | As],
@@ -833,6 +838,7 @@ call_clause('$call'(G1), Args, N, G0) :-
load_context(M), load_context(M),
append(As, Args, As1), append(As, Args, As1),
G2 =.. [F | As1], G2 =.. [F | As1],
callable(G2),
G0 = M:G2 G0 = M:G2
). ).
@@ -847,6 +853,7 @@ call_clause(G, Args, _, G0) :-
), ),
append(As, Args, As1), append(As, Args, As1),
G2 =.. [F | As1], G2 =.. [F | As1],
callable(G2),
expand_goal(call(M:G2), M, call(G0)). expand_goal(call(M:G2), M, call(G0)).

26
src/machine/system_calls.rs
View File

@@ -3929,20 +3929,24 @@ impl Machine {
let semicolon_second_clause_p = unsafe { let semicolon_second_clause_p = unsafe {
LOC_INIT.call_once(|| { LOC_INIT.call_once(|| {
match self.indices.code_dir.get(&(atom!(";"), 2)).map(|cell| cell.get()) { if let Some(builtins) = self.indices.modules.get(&atom!("builtins")) {
Some(IndexPtr::Index(p)) => { match builtins.code_dir.get(&(atom!("staggered_sc"), 2)).map(|cell| cell.get()) {
match &self.code[p] { Some(IndexPtr::Index(p)) => {
&Instruction::TryMeElse(o) => { match &self.code[p] {
SEMICOLON_SECOND_BRANCH_LOC = p + o; &Instruction::TryMeElse(o) => {
} SEMICOLON_SECOND_BRANCH_LOC = p + o;
_ => { }
unreachable!(); _ => {
unreachable!();
}
} }
} }
_ => {
unreachable!();
}
} }
_ => { } else {
unreachable!(); unreachable!();
}
} }
}); });