Remove DCGs that have thrown an exception during term expansion

Some DCG constructs aren't supported and can't be expanded, here we remove offending DCG rule and don't compile it at all – in a similar fashion to what we do when incorrect goal was found – whole predicate isn't getting compiled. Fixes #2675
mthom · Dec 22, 2024 · a599a11 · a599a11
1 parent ff03432
commit a599a11
Show file tree

Hide file tree

Showing 5 changed files with 19 additions and 2 deletions.
diff --git a/src/lib/dcgs.pl b/src/lib/dcgs.pl
@@ -214,10 +214,13 @@
     dcg_body(GRIf, S0, S1, If),
     dcg_body(GRThen, S1, S, Then).
 
+
+% When DCG expansion throws an exception – remove offending term and rethrow.
+user:term_expansion(throw_dcg_expansion_error(E), _) :-
+    throw(E).
 user:term_expansion(Term0, Term) :-
     nonvar(Term0),
-    dcg_rule(Term0, Term).
-
+    catch(dcg_rule(Term0, Term), E, Term = throw_dcg_expansion_error(E)).
 
 %% seq(Seq)//
 % 

diff --git a/tests/scryer/cli/issues/not_supported_dcg_constructs.in/main.pl b/tests/scryer/cli/issues/not_supported_dcg_constructs.in/main.pl
@@ -0,0 +1,6 @@
+:- use_module(library(dcgs)).
+
+d -->
+        (   { true } -> []
+        ;   { true } -> []
+        ).
diff --git a/tests/scryer/cli/issues/not_supported_dcg_constructs.stderr b/tests/scryer/cli/issues/not_supported_dcg_constructs.stderr
diff --git a/tests/scryer/cli/issues/not_supported_dcg_constructs.stdout b/tests/scryer/cli/issues/not_supported_dcg_constructs.stdout
@@ -0,0 +1 @@
+   error(representation_error(dcg_body),[culprit-({true}->[])]).
diff --git a/tests/scryer/cli/issues/not_supported_dcg_constructs.toml b/tests/scryer/cli/issues/not_supported_dcg_constructs.toml
@@ -0,0 +1,7 @@
+# issue 2675
+args = [
+    "-f",
+    "--no-add-history",
+    "-g", "halt",
+     "main.pl"
+]
Original file line number	Diff line number	Diff line change
		@@ -0,0 +1 @@
		error(representation_error(dcg_body),[culprit-({true}->[])]).