From: Aleksy Grabowski <hurufu@gmail.com>
Date: Thu, 5 Dec 2024 10:15:42 +0000 (+0100)
Subject: Remove DCGs that have thrown an exception during term expansion
X-Git-Tag: v0.10.0~86^2
X-Git-Url: https://git.sagredo.dev/?a=commitdiff_plain;h=a599a11169fc7570d108b2d6577aafe19c66a76b;p=scryer-prolog.git

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
---

diff --git a/src/lib/dcgs.pl b/src/lib/dcgs.pl
index 200e57a8..2dc858a4 100644
--- a/src/lib/dcgs.pl
+++ b/src/lib/dcgs.pl
@@ -214,10 +214,13 @@ dcg_cbody(( GRIf -> GRThen ), S0, S, ( If -> Then )) :-
     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
new file mode 100644
index 00000000..188e02ad
--- /dev/null
+++ 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
new file mode 100644
index 00000000..e69de29b
diff --git a/tests/scryer/cli/issues/not_supported_dcg_constructs.stdout b/tests/scryer/cli/issues/not_supported_dcg_constructs.stdout
new file mode 100644
index 00000000..664e0e21
--- /dev/null
+++ 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
new file mode 100644
index 00000000..12c51768
--- /dev/null
+++ 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"
+]