Merge pull request #2302 from triska/dcg_representation

Throw representation errors for unsupported DCG grammar control constructs
mthom · Jan 22, 2024 · eab3bff · eab3bff
2 parents 58cd0d1 + 81dba11
commit eab3bff
Show file tree

Hide file tree

Showing 2 changed files with 18 additions and 16 deletions.
diff --git a/src/lib/clpz.pl b/src/lib/clpz.pl
@@ -4171,6 +4171,7 @@
 ground(T) --> { ground(T) }.
 
 true --> [].
+false --> { false }.
 
 X >= Y	--> { X >= Y }.
 X =< Y  --> { X =< Y }.
@@ -4228,7 +4229,7 @@
             )
         ).
 
-%do_queue --> print_queue, { false }.
+%do_queue --> print_queue, false.
 do_queue -->
         (   queue_enabled ->
             (   queue_get_goal(Goal) -> { call(Goal) }, do_queue
@@ -4592,7 +4593,7 @@
             kill(MState),
             (   S_I + D_I =< S_J -> []
             ;   S_J + D_J =< S_I -> []
-            ;   { false }
+            ;   false
             )
         ;   serialize_lower_upper(S_I, D_I, S_J, D_J, MState),
             serialize_lower_upper(S_J, D_J, S_I, D_I, MState)
@@ -4665,7 +4666,7 @@
         (   nonvar(V) ->
             (   V =:= 0 -> kill(MState), { X in 0..sup }
             ;   V < 0 -> kill(MState), { X #= V / 2 }
-            ;   V > 0 -> { false }
+            ;   false % V > 0
             )
         ;   nonvar(X) ->
             kill(MState),
@@ -5052,8 +5053,8 @@
 %% % Z = X mod Y
 
 run_propagator(pmod(X,Y,Z), MState) -->
-        (   Y == 0 -> { false }
-        ;   Y == Z -> { false }
+        (   Y == 0 -> false
+        ;   Y == Z -> false
         ;   X == Y -> kill(MState), queue_goal(Z = 0)
         ;   true
         ),
@@ -5062,7 +5063,7 @@
             Z is X mod Y
         ;   nonvar(Y), nonvar(Z) ->
             (   Y > 0 -> Z >= 0, Z < Y
-            ;   Y < 0 -> Z =< 0, Z > Y
+            ;   Z =< 0, Z > Y    % Y < 0
             ),
             (   { fd_get(X, _, n(XL), _, _) } ->
                 (   (XL - Z) mod Y =\= 0 ->
@@ -5131,7 +5132,7 @@
                         fd_put(Z, ZD2, ZPs)
                         % queue_goal(Z #=< X)
                     )
-                ;   X < 0 ->
+                ;   X < 0,
                     (   { fd_get(Y, _, _, n(YU), _), YU < X } ->
                         kill(MState),
                         queue_goal(Z = X)
@@ -5171,7 +5172,7 @@
                     fd_put(Z, ZD5, ZPs)
                     % queue_goal(Z in ZMin..0)
                 )
-            ;   Y > 0 ->
+            ;   Y > 0,
                 (   { fd_get(X, _, n(XL), n(XU), _), XL >= 0, Y > XU } ->
                     kill(MState),
                     queue_goal(Z = X)
@@ -5382,7 +5383,7 @@
             ;   nonvar(Z) ->
                 (   Z =:= X -> kill(MState), queue_goal(X #>= Y)
                 ;   Z > X -> queue_goal(Z = Y)
-                ;   { false } % Z < X
+                ;   false % Z < X
                 )
             ;   Y == Z -> kill(MState), queue_goal(Y #>= X)
             ;   { fd_get(Y, _, YInf, YSup, _) },
@@ -5418,7 +5419,7 @@
             ;   nonvar(Z) ->
                 (   Z =:= X -> kill(MState), { X #=< Y }
                 ;   Z < X -> Z = Y
-                ;   { false } % Z > X
+                ;   false % Z > X
                 )
             ;   Y == Z -> kill(MState), queue_goal(Y #=< X)
             ;   { fd_get(Y, _, YInf, YSup, _) },
@@ -5733,8 +5734,7 @@
             B = 1
         ;   { B == 0 } ->
             (   { fd_inf(V, inf) } -> []
-            ;   { fd_sup(V, sup) } -> []
-            ;   { false }
+            ;   { fd_sup(V, sup) }
             )
         ;   []
         ).

diff --git a/src/lib/dcgs.pl b/src/lib/dcgs.pl
@@ -154,8 +154,6 @@
 dcg_body(NonTerminal, S0, S, Goal1) :-
     nonvar(NonTerminal),
     \+ dcg_constr(NonTerminal),
-    NonTerminal \= ( _ -> _ ),
-    NonTerminal \= ( \+ _ ),
     loader:strip_module(NonTerminal, M, NonTerminal0),
     dcg_non_terminal(NonTerminal0, S0, S, Goal0),
     (  functor(NonTerminal, (:), 2) ->
@@ -176,8 +174,10 @@
 dcg_constr(phrase(_,_)). % extension of 7.14.9
 dcg_constr(phrase(_,_,_)). % extension of 7.14.9
 dcg_constr(!). % 7.14.10
-%% dcg_constr(\+ _). % 7.14.11 - not (existence implementation dep.)
-dcg_constr((_->_)). % 7.14.12 - if-then (existence implementation dep.)
+dcg_constr(\+ _) :- % 7.14.11 - not (existence implementation dep.)
+    throw(error(representation_error(dcg_body), phrase/3)).
+dcg_constr((_->_)) :- % 7.14.12 - if-then (existence implementation dep.)
+    throw(error(representation_error(dcg_body), phrase/3)).
 
 % The principal functor of the first argument indicates
 % the construct to be expanded.
@@ -244,6 +244,8 @@
 
 error_goal(error(E, must_be/2), error(E, must_be/2)).
 error_goal(error(E, (=..)/2), error(E, (=..)/2)).
+error_goal(error(representation_error(dcg_body), Context),
+           error(representation_error(dcg_body), Context)).
 error_goal(E, _) :- throw(E).
 
 user:goal_expansion(phrase(GRBody, S, S0), GRBody2) :-