From 55d8de1b237b0cfc5c562b78ffcbfae3ef9b3277 Mon Sep 17 00:00:00 2001 From: Mark Thom Date: Thu, 17 Feb 2022 20:26:30 -0700 Subject: [PATCH] delay callable errors in control predicates (#1282) --- src/lib/builtins.pl | 115 +++++++++++++++++++++++++----------- src/loader.pl | 37 +++++++----- src/machine/system_calls.rs | 26 ++++---- 3 files changed, 117 insertions(+), 61 deletions(-) diff --git a/src/lib/builtins.pl b/src/lib/builtins.pl index f88fef3a..c381b313 100644 --- a/src/lib/builtins.pl +++ b/src/lib/builtins.pl @@ -208,70 +208,115 @@ repeat :- repeat. :- 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). -:- 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. 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 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 comma_dispatch_prep/3. +:- non_counted_backtracking dispatch_prep/3. -comma_dispatch_prep(Gs, B, [Cont|Conts]) :- +dispatch_prep(Gs, B, [Cont|Conts]) :- ( callable(Gs) -> ( functor(Gs, ',', 2) -> arg(1, Gs, G1), arg(2, Gs, G2), - comma_dispatch_prep(G1, B, IConts1), + dispatch_prep(G1, B, IConts1), cont_list_goal(IConts1, Cont), - comma_dispatch_prep(G2, B, Conts) - ; Gs == ! -> - Cont = builtins:set_cp(B), - Conts = [] + dispatch_prep(G2, B, Conts) ; functor(Gs, ';', 2) -> arg(1, Gs, G1), arg(2, Gs, G2), - comma_dispatch_prep(G1, B, IConts0), - comma_dispatch_prep(G2, B, IConts1), + dispatch_prep(G1, B, IConts0), + dispatch_prep(G2, B, IConts1), cont_list_goal(IConts0, Cont0), cont_list_goal(IConts1, Cont1), - Cont = ( Cont0 ; Cont1 ), + Cont = builtins:staggered_sc(Cont0, Cont1), Conts = [] ; functor(Gs, ->, 2) -> arg(1, Gs, G1), arg(2, Gs, G2), - comma_dispatch_prep(G1, B, IConts1), - comma_dispatch_prep(G2, B, IConts2), + dispatch_prep(G1, B, IConts1), + dispatch_prep(G2, B, IConts2), cont_list_goal(IConts1, Cont1), 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 = [] ; Cont = Gs, Conts = [] ) - ; Cont = Gs, + ; var(Gs) -> + Cont = Gs, Conts = [] + ; throw(dispatch_prep_error) ). -:- non_counted_backtracking comma_dispatch_call_list/1. -comma_dispatch_call_list([]). -comma_dispatch_call_list([G1,G2,G3,G4,G5,G6,G7,G8|Gs]) :- +:- non_counted_backtracking dispatch_call_list/1. + +dispatch_call_list([]). +dispatch_call_list([G1,G2,G3,G4,G5,G6,G7,G8|Gs]) :- !, '$call'(G1), '$call'(G2), @@ -281,8 +326,8 @@ comma_dispatch_call_list([G1,G2,G3,G4,G5,G6,G7,G8|Gs]) :- '$call'(G6), '$call'(G7), '$call'(G8), - '$call_with_default_policy'(comma_dispatch_call_list(Gs)). -comma_dispatch_call_list([G1,G2,G3,G4,G5,G6,G7]) :- + '$call_with_default_policy'(dispatch_call_list(Gs)). +dispatch_call_list([G1,G2,G3,G4,G5,G6,G7]) :- !, '$call'(G1), '$call'(G2), @@ -291,7 +336,7 @@ comma_dispatch_call_list([G1,G2,G3,G4,G5,G6,G7]) :- '$call'(G5), '$call'(G6), '$call'(G7). -comma_dispatch_call_list([G1,G2,G3,G4,G5,G6]) :- +dispatch_call_list([G1,G2,G3,G4,G5,G6]) :- !, '$call'(G1), '$call'(G2), @@ -299,29 +344,29 @@ comma_dispatch_call_list([G1,G2,G3,G4,G5,G6]) :- '$call'(G4), '$call'(G5), '$call'(G6). -comma_dispatch_call_list([G1,G2,G3,G4,G5]) :- +dispatch_call_list([G1,G2,G3,G4,G5]) :- !, '$call'(G1), '$call'(G2), '$call'(G3), '$call'(G4), '$call'(G5). -comma_dispatch_call_list([G1,G2,G3,G4]) :- +dispatch_call_list([G1,G2,G3,G4]) :- !, '$call'(G1), '$call'(G2), '$call'(G3), '$call'(G4). -comma_dispatch_call_list([G1,G2,G3]) :- +dispatch_call_list([G1,G2,G3]) :- !, '$call'(G1), '$call'(G2), '$call'(G3). -comma_dispatch_call_list([G1,G2]) :- +dispatch_call_list([G1,G2]) :- !, '$call'(G1), '$call'(G2). -comma_dispatch_call_list([G1]) :- +dispatch_call_list([G1]) :- '$call'(G1). diff --git a/src/loader.pl b/src/loader.pl index c5228d1f..3d3e8bd2 100644 --- a/src/loader.pl +++ b/src/loader.pl @@ -671,7 +671,10 @@ expand_module_names(Goals, MetaSpecs, Module, ExpandedGoals, HeadVars) :- 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) :- @@ -716,27 +719,25 @@ expand_goal(UnexpandedGoals, Module, ExpandedGoals, HeadVars) :- thread_goals(Goals0, Goals1, Hole, Functor) :- ( var(Goals0) -> Goals1 =.. [Functor, Goals0, Hole] - ; ( Goals0 = [G | Gs] -> - ( Gs == [] -> - Goals1 =.. [Functor, G, Hole] - ; Goals1 =.. [Functor, G, Goals2], - thread_goals(Gs, Goals2, Hole, Functor) - ) - ; Goals1 =.. [Functor, Goals0, Hole] + ; Goals0 = [G | Gs] -> + ( Gs == [] -> + Goals1 =.. [Functor, G, Hole] + ; Goals1 =.. [Functor, G, Goals2], + thread_goals(Gs, Goals2, Hole, Functor) ) + ; Goals1 =.. [Functor, Goals0, Hole] ). 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 + ; Goals0 = [G | Gs] -> + ( Gs = [] -> + Goals1 = G + ; Goals1 =.. [Functor, G, Goals2], + thread_goals(Gs, Goals2, Functor) ) + ; Goals1 = Goals0 ). %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% @@ -780,12 +781,14 @@ call_clause('$call'(G), G0) :- instantiation_error(call/1) ; G = M:G1, !, + callable(G1), functor(G1, F, _), atom(F), atom(M), F \== [], G0 = M:G1 ; !, + callable(G), functor(G, F, _), atom(F), F \== [], @@ -795,6 +798,7 @@ call_clause('$call'(G), G0) :- call_clause(G, G0) :- strip_module(G, M, G1), + callable(G1), functor(G1, F, _), atom(F), F \== [], @@ -825,6 +829,7 @@ call_clause('$call'(G1), Args, N, G0) :- F \== [], append(As, Args, As1), G3 =.. [F | As1], + callable(G3), G0 = M:G3 ; !, G1 =.. [F | As], @@ -833,6 +838,7 @@ call_clause('$call'(G1), Args, N, G0) :- load_context(M), append(As, Args, As1), G2 =.. [F | As1], + callable(G2), G0 = M:G2 ). @@ -847,6 +853,7 @@ call_clause(G, Args, _, G0) :- ), append(As, Args, As1), G2 =.. [F | As1], + callable(G2), expand_goal(call(M:G2), M, call(G0)). diff --git a/src/machine/system_calls.rs b/src/machine/system_calls.rs index ee4d152d..ef548a2e 100644 --- a/src/machine/system_calls.rs +++ b/src/machine/system_calls.rs @@ -3929,20 +3929,24 @@ impl Machine { let semicolon_second_clause_p = unsafe { LOC_INIT.call_once(|| { - match self.indices.code_dir.get(&(atom!(";"), 2)).map(|cell| cell.get()) { - Some(IndexPtr::Index(p)) => { - match &self.code[p] { - &Instruction::TryMeElse(o) => { - SEMICOLON_SECOND_BRANCH_LOC = p + o; - } - _ => { - unreachable!(); + if let Some(builtins) = self.indices.modules.get(&atom!("builtins")) { + match builtins.code_dir.get(&(atom!("staggered_sc"), 2)).map(|cell| cell.get()) { + Some(IndexPtr::Index(p)) => { + match &self.code[p] { + &Instruction::TryMeElse(o) => { + SEMICOLON_SECOND_BRANCH_LOC = p + o; + } + _ => { + unreachable!(); + } } } + _ => { + unreachable!(); + } } - _ => { - unreachable!(); - } + } else { + unreachable!(); } }); -- 2.54.0