delay callable errors in control predicates (#1282)

diff --git a/src/lib/builtins.pl b/src/lib/builtins.pl
index f88fef3a1d0974705605a3aa80a57eb929647bc9..c381b3131f07208b41bed9aeac440e7e5103287b 100644 (file)
--- 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 c5228d1f4d4682c6d4650e737e3c44807d7c83e9..3d3e8bd200d13cf117409844a58c50610082bcc6 100644 (file)
--- 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 ee4d152d7dcd6296d3b4c2181d51cc9a3ae54ec1..ef548a2e22df328f577bf62e03618cff35161956 100644 (file)
--- 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!();
                 }
             });