summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
Diffstat
-rw-r--r--camlp4/examples/_tags6
-rw-r--r--camlp4/examples/fancy_lambda_quot.ml159
-rw-r--r--camlp4/examples/fancy_lambda_quot_test.ml22
-rw-r--r--camlp4/examples/gettext_test.ml1
-rw-r--r--camlp4/examples/lambda_parser.ml34
-rw-r--r--camlp4/examples/lambda_quot_expr.ml1
-rw-r--r--camlp4/examples/lambda_quot_patt.ml41
-rw-r--r--camlp4/test/fixtures/pprecordtyp.ml26
-rw-r--r--camlp4/test/fixtures/pr4314.ml1
-rw-r--r--camlp4/test/fixtures/pr4314gram1.ml36
-rw-r--r--camlp4/test/fixtures/pr4314gram2.ml36
-rw-r--r--camlp4/test/fixtures/pr4314gram3.ml36
-rw-r--r--camlp4/test/fixtures/pr4314gram4.ml36
-rw-r--r--camlp4/test/fixtures/pr4314gram5.ml38
-rw-r--r--camlp4/test/fixtures/pr4329.ml50
-rw-r--r--camlp4/test/fixtures/pr4330.ml50
16 files changed, 572 insertions, 1 deletions
diff --git a/camlp4/examples/_tags b/camlp4/examples/_tags
index c35bcfbfc..19b2d7017 100644
--- a/camlp4/examples/_tags
+++ b/camlp4/examples/_tags
@@ -1,9 +1,11 @@
+true: warn_A, warn_e
<{apply_operator,type_quotation,global_handler,expression_closure{,_filter}}.ml> or <free_vars_test.*>: camlp4rf, use_camlp4
"lambda_quot.ml": camlp4rf, use_camlp4_full
-"lambda_quot_o.ml": camlp4of, use_camlp4_full
+<{fancy_,}lambda_{quot,quot_{expr,patt},parser}.ml>: camlp4of, use_camlp4_full
"macros.ml" or <arith.*> or "gen_match_case.ml": camlp4of, use_camlp4
"test_macros.ml": pp(camlp4of ./macros.cmo)
"lambda_test.ml": pp(camlp4of ./lambda_quot_o.cmo)
+"fancy_lambda_quot_test.ml": use_camlp4, pp(camlp4of ./fancy_lambda_quot.cmo)
<parse_files.*>: camlp4of, use_camlp4_full, use_dynlink
"test_type_quotation.ml": pp(camlp4of ./type_quotation.cmo)
"apply_operator_test.ml": pp(camlp4o ./apply_operator.cmo)
@@ -13,3 +15,5 @@
"syb_map.ml": pp(camlp4o -filter map), use_camlp4
"ex_str.ml": camlp4of, use_camlp4, use_camlp4_full
"ex_str_test.ml": pp(camlp4o ./ex_str.cmo)
+"poly_by_default.ml": camlp4of, use_camlp4
+"poly_by_default_test.ml": pp(camlp4of ./poly_by_default.cmo)
diff --git a/camlp4/examples/fancy_lambda_quot.ml b/camlp4/examples/fancy_lambda_quot.ml
new file mode 100644
index 000000000..be21fa2fd
--- /dev/null
+++ b/camlp4/examples/fancy_lambda_quot.ml
@@ -0,0 +1,159 @@
+(* module LambdaSyntax = struct
+ module Loc = Camlp4.PreCast.Loc
+ type 'a antiquotable =
+ | Val of Loc.t * 'a
+ | Ant of Loc.t * string
+ type term' =
+ | Lam of var * term
+ | App of term * term
+ | Var of var
+ | Int of int antiquotable
+ |+ Why you don't want an antiquotation case here:
+ * Basically it seems natural that since an antiquotation of expression
+ * can be at any expression place. One can be a
+ * .... in fact not I not against that...
+ | Anti of Loc.t * string
+ +|
+ and term = term' antiquotable
+ and var = string antiquotable
+end *)
+module Antiquotable = struct
+ module Loc = Camlp4.PreCast.Loc
+ type 'a t =
+ | Val of Loc.t * 'a
+ | Ant of Loc.t * string
+end
+module Identity_type_functor = struct
+ type 'a t = 'a
+end
+module MakeLambdaSyntax(Node : sig type 'a t end) = struct
+ type term' =
+ | Lam of var * term
+ | App of term * term
+ | Var of var
+ | Int of num
+ and term = term' Node.t
+ and num = int Node.t
+ and var = string Node.t
+end
+module AntiquotableLambdaSyntax = MakeLambdaSyntax(Antiquotable);;
+module LambdaSyntax = MakeLambdaSyntax(Identity_type_functor);;
+module LambdaParser = struct
+ open Antiquotable;;
+ open AntiquotableLambdaSyntax;;
+ open Camlp4.PreCast;;
+
+ module LambdaGram = MakeGram(Lexer);;
+
+ let term = LambdaGram.Entry.mk "term";;
+ let term_eoi = LambdaGram.Entry.mk "lambda term quotation";;
+
+ Camlp4_config.antiquotations := true;;
+
+ let mkLam _loc v t = Val(_loc, Lam(v, t));;
+ let mkApp _loc f x = Val(_loc, App(f, x));;
+ let mkVar _loc x = Val(_loc, Var(x));;
+ let mkInt _loc v = Val(_loc, Int(v));;
+
+ EXTEND LambdaGram
+ GLOBAL: term term_eoi;
+ term:
+ [ "top"
+ [ "fun"; v = var; "->"; t = term -> mkLam _loc v t ]
+ | "app"
+ [ t1 = SELF; t2 = SELF -> mkApp _loc t1 t2 ]
+ | "simple"
+ [ `ANTIQUOT((""|"term"), a) -> Ant(_loc, a)
+ | i = int -> mkInt _loc i
+ | v = var -> mkVar _loc v
+ | "("; t = term; ")" -> t ]
+ ];
+ var:
+ [[ v = LIDENT -> Val(_loc, v)
+ | `ANTIQUOT((""|"var"), a) -> Ant(_loc, a)
+ ]];
+ int:
+ [[ `INT(i, _) -> Val(_loc, i)
+ | `ANTIQUOT((""|"int"), a) -> Ant(_loc, a)
+ ]];
+ term_eoi:
+ [[ t = term; `EOI -> t ]];
+ END;;
+
+ let parse_string = LambdaGram.parse_string term_eoi
+end
+module LambdaLifter = struct
+ open Antiquotable;;
+ open AntiquotableLambdaSyntax;;
+ module CamlSyntax =
+ Camlp4OCamlParser.Make(
+ Camlp4OCamlRevisedParser.Make(
+ Camlp4.PreCast.Syntax
+ )
+ );;
+ module Ast = Camlp4.PreCast.Ast
+ let expr_of_string = CamlSyntax.Gram.parse_string CamlSyntax.expr_eoi;;
+ let patt_of_string = CamlSyntax.Gram.parse_string CamlSyntax.patt_eoi;;
+
+ (*
+ << fun x -> $3$ >> -> Lam(VAtom"x", 3)
+
+ (* compilo.ml -pp lam.cmo *)
+ match t with
+ | << (fun $x$ -> $e1$) $e2$ >> -> << $subst ...$ >>
+ *)
+
+ (* This part can be generated use SwitchValRepr *)
+ let rec term_to_expr = function
+ | Val(_loc, Lam(v, t)) -> <:expr< Lam($var_to_expr v$, $term_to_expr t$) >>
+ | Val(_loc, App(t1, t2)) -> <:expr< App($term_to_expr t1$, $term_to_expr t2$) >>
+ | Val(_loc, Var(v)) -> <:expr< Var($var_to_expr v$) >>
+ | Val(_loc, Int(i)) -> <:expr< Int($int_to_expr i$) >>
+ | Ant(_loc, a) -> expr_of_string _loc a
+ and var_to_expr = function
+ | Val(_loc, v) -> <:expr< $str:v$ >>
+ | Ant(_loc, s) -> expr_of_string _loc s
+ and int_to_expr = function
+ | Val(_loc, v) -> <:expr< $`int:v$ >>
+ | Ant(_loc, s) -> expr_of_string _loc s
+ ;;
+
+ let rec term_to_patt = function
+ | Val(_loc, Lam(v, t)) -> <:patt< Lam($var_to_patt v$, $term_to_patt t$) >>
+ | Val(_loc, App(t1, t2)) -> <:patt< App($term_to_patt t1$, $term_to_patt t2$) >>
+ | Val(_loc, Var(v)) -> <:patt< Var($var_to_patt v$) >>
+ | Val(_loc, Int(i)) -> <:patt< Int($int_to_patt i$) >>
+ | Ant(_loc, a) -> patt_of_string _loc a
+ and var_to_patt = function
+ | Val(_loc, v) -> <:patt< $str:v$ >>
+ | Ant(_loc, s) -> patt_of_string _loc s
+ and int_to_patt = function
+ | Val(_loc, v) -> <:patt< $`int:v$ >>
+ | Ant(_loc, s) -> patt_of_string _loc s
+ ;;
+
+ (*
+Arrow(Var"a", Var"b")
+<:typ< 'a -> 'b >>
+
+ let a = ...
+ let b = ...
+ let ( ^-> ) t1 t2 = Arrow(t1, t2)
+ a ^-> b
+ *)
+end
+module LambadExpander = struct
+ module Q = Camlp4.PreCast.Syntax.Quotation;;
+ let expand_lambda_quot_expr loc _loc_name_opt quotation_contents =
+ LambdaLifter.term_to_expr
+ (LambdaParser.parse_string loc quotation_contents)
+ ;;
+ Q.add "lam" Q.DynAst.expr_tag expand_lambda_quot_expr;;
+ let expand_lambda_quot_patt loc _loc_name_opt quotation_contents =
+ LambdaLifter.term_to_patt
+ (LambdaParser.parse_string loc quotation_contents)
+ ;;
+ Q.add "lam" Q.DynAst.patt_tag expand_lambda_quot_patt;;
+
+ Q.default := "lam";;
+end
diff --git a/camlp4/examples/fancy_lambda_quot_test.ml b/camlp4/examples/fancy_lambda_quot_test.ml
new file mode 100644
index 000000000..32009828f
--- /dev/null
+++ b/camlp4/examples/fancy_lambda_quot_test.ml
@@ -0,0 +1,22 @@
+open Fancy_lambda_quot.LambdaSyntax;;
+let _loc = Camlp4.PreCast.Loc.ghost;;
+let rec propagate = function
+ | << $f$ $x$ $y$ >> ->
+ begin match propagate f, propagate x, propagate y with
+ | f, << $int:i$ >>, << $int:j$ >> ->
+ begin match f with
+ | << plus >> -> << $int:i + j$ >>
+ | << minus >> -> << $int:i - j$ >>
+ | << times >> -> << $int:i * j$ >>
+ | << div >> -> << $int:i / j$ >>
+ | _ -> << $f$ $int:i$ $int:j$ >>
+ end
+ | f, x, y -> << $f$ $x$ $y$ >>
+ end
+ | << $f$ $x$ >> -> << $propagate f$ $propagate x$ >>
+ | << fun $x$ -> $e$ >> -> << fun $x$ -> $propagate e$ >> (* here x should not be a primitive like plus *)
+ | << $var:_$ >> | << $int:_$ >> as e -> e
+;;
+
+let ex1 = propagate << f (fun x -> g (plus 3 (times 4 42)) (minus 1 (x 3))) >>
+;;
diff --git a/camlp4/examples/gettext_test.ml b/camlp4/examples/gettext_test.ml
new file mode 100644
index 000000000..27f6ceed2
--- /dev/null
+++ b/camlp4/examples/gettext_test.ml
@@ -0,0 +1 @@
+f "test", f "foo", "bar"
diff --git a/camlp4/examples/lambda_parser.ml b/camlp4/examples/lambda_parser.ml
new file mode 100644
index 000000000..9c7097679
--- /dev/null
+++ b/camlp4/examples/lambda_parser.ml
@@ -0,0 +1,34 @@
+(* Please keep me in sync with brion.inria.fr/gallium/index.php/Lambda_calculus_quotations *)
+
+type term =
+ | Lam of var * term
+ | App of term * term
+ | Int of int
+ | Var of var
+and var = string
+
+module LambdaGram = Camlp4.PreCast.MakeGram(Camlp4.PreCast.Lexer);;
+module Loc = Camlp4.PreCast.Loc;; (* should not be necessary when camlp4 will be fixed *)
+open Camlp4.Sig;; (* from tokens *)
+let term = LambdaGram.Entry.mk "term";;
+let term_eoi = LambdaGram.Entry.mk "lambda term quotation";;
+
+EXTEND LambdaGram
+ GLOBAL: term term_eoi;
+ term:
+ [ "top"
+ [ "fun"; v = var; "->"; t = term -> Lam(v, t) ]
+ | "app"
+ [ t1 = SELF; t2 = SELF -> App(t1, t2) ]
+ | "simple"
+ [ v = var -> Var(v)
+ | `INT(i, _) -> Int(i)
+ | "("; t = term; ")" -> t ]
+ ];
+ var:
+ [[ `LIDENT v -> v ]];
+ term_eoi:
+ [[ t = term; `EOI -> t ]];
+END;;
+
+let lambda_parser = LambdaGram.parse_string term_eoi;;
diff --git a/camlp4/examples/lambda_quot_expr.ml b/camlp4/examples/lambda_quot_expr.ml
index 3b51f47f5..98922123a 100644
--- a/camlp4/examples/lambda_quot_expr.ml
+++ b/camlp4/examples/lambda_quot_expr.ml
@@ -35,6 +35,7 @@ END;;
let expand_lambda_quot_expr loc _loc_name_opt quotation_contents =
LambdaGram.parse_string term_eoi loc quotation_contents;;
+(* to have this syntax <:lam< fun k -> k >> *)
Syntax.Quotation.add "lam" Syntax.Quotation.DynAst.expr_tag expand_lambda_quot_expr;;
Syntax.Quotation.default := "lam";;
diff --git a/camlp4/examples/lambda_quot_patt.ml b/camlp4/examples/lambda_quot_patt.ml
new file mode 100644
index 000000000..e6732dd3a
--- /dev/null
+++ b/camlp4/examples/lambda_quot_patt.ml
@@ -0,0 +1,41 @@
+(* Please keep me in sync with brion.inria.fr/gallium/index.php/Lambda_calculus_quotations *)
+
+open Camlp4.PreCast;;
+module CamlSyntax = Camlp4OCamlParser.Make(Camlp4OCamlRevisedParser.Make(Syntax));;
+
+let patt_of_string = CamlSyntax.Gram.parse_string CamlSyntax.patt_eoi;;
+
+module LambdaGram = MakeGram(Lexer);;
+
+let term = LambdaGram.Entry.mk "term";;
+let term_eoi = LambdaGram.Entry.mk "lambda term quotation";;
+
+Camlp4_config.antiquotations := true;;
+
+EXTEND LambdaGram
+ GLOBAL: term term_eoi;
+ term:
+ [ "top"
+ [ "fun"; v = var; "->"; t = term -> <:patt< `Lam($v$, $t$) >> ]
+ | "app"
+ [ t1 = SELF; t2 = SELF -> <:patt< `App($t1$, $t2$) >> ]
+ | "simple"
+ [ `ANTIQUOT((""|"term"), a) -> patt_of_string _loc a
+ | v = var -> <:patt< `Var($v$) >>
+ | "("; t = term; ")" -> t ]
+ ];
+ var:
+ [[ v = LIDENT -> <:patt< $str:v$ >>
+ | `ANTIQUOT((""|"var"), a) -> patt_of_string _loc a
+ ]];
+ term_eoi:
+ [[ t = term; `EOI -> t ]];
+END;;
+
+let expand_lambda_quot_patt loc _loc_name_opt quotation_contents =
+ LambdaGram.parse_string term_eoi loc quotation_contents;;
+
+(* function <:lam< fun x -> $(t|u)$ >> -> ... *)
+Syntax.Quotation.add "lam" Syntax.Quotation.DynAst.patt_tag expand_lambda_quot_patt;;
+
+Syntax.Quotation.default := "lam";;
diff --git a/camlp4/test/fixtures/pprecordtyp.ml b/camlp4/test/fixtures/pprecordtyp.ml
new file mode 100644
index 000000000..1b140af04
--- /dev/null
+++ b/camlp4/test/fixtures/pprecordtyp.ml
@@ -0,0 +1,26 @@
+open Camlp4.PreCast
+
+let _loc = Loc.mk "?"
+
+let base base fields ty =
+ let fields = List.fold_right (fun field acc ->
+ let c = <:ctyp< $lid:field$ : $uid:field$.record >> in
+ <:ctyp< $c$ ; $acc$ >>) fields <:ctyp< >>
+ in
+ <:module_binding< $uid:base$ :
+ sig type record = {
+ key : $ty$;
+ $fields$
+ } end = struct
+ type record = {
+ key : $ty$;
+ $fields$
+ } end
+ >>
+
+module CleanAst = Camlp4.Struct.CleanAst.Make(Ast)
+let _ =
+ let b = base "b" ["f1"; "f2"] <:ctyp< int >> in
+ Camlp4.PreCast.Printers.OCaml.print_implem
+ ((new CleanAst.clean_ast)#str_item
+ <:str_item< module rec $b$ >>)
diff --git a/camlp4/test/fixtures/pr4314.ml b/camlp4/test/fixtures/pr4314.ml
new file mode 100644
index 000000000..9e6b23bc3
--- /dev/null
+++ b/camlp4/test/fixtures/pr4314.ml
@@ -0,0 +1 @@
+(int_of_string "1" : unit);
diff --git a/camlp4/test/fixtures/pr4314gram1.ml b/camlp4/test/fixtures/pr4314gram1.ml
new file mode 100644
index 000000000..a83b073a3
--- /dev/null
+++ b/camlp4/test/fixtures/pr4314gram1.ml
@@ -0,0 +1,36 @@
+open Camlp4.PreCast ;
+module G = Camlp4.PreCast.Gram ;
+
+value exp = G.Entry.mk "exp" ;
+value prog = G.Entry.mk "prog" ;
+
+EXTEND G
+exp:
+[ "apply"
+ [ e1 = SELF; e2 = SELF ->
+ let p = Loc.dump in
+ let () =
+ Format.eprintf "e1: %a,@.e2: %a,@.e1-e2: %a,@._loc: %a@."
+ p e1 p e2 p (Loc.merge e1 e2) p _loc
+ in
+ _loc
+ ]
+| "simple"
+ [ _ = LIDENT -> _loc ]
+];
+prog: [[ e = exp; `EOI -> e ]];
+END ;
+
+(* and the following function: *)
+
+value parse_string entry s =
+try
+ G.parse_string entry (Loc.mk "<string>") s
+with [ Loc.Exc_located loc exn ->
+begin
+ print_endline (Loc.to_string loc);
+ print_endline (Printexc.to_string exn);
+ failwith "Syntax Error"
+end ] ;
+
+parse_string prog "f x";
diff --git a/camlp4/test/fixtures/pr4314gram2.ml b/camlp4/test/fixtures/pr4314gram2.ml
new file mode 100644
index 000000000..38a5222e1
--- /dev/null
+++ b/camlp4/test/fixtures/pr4314gram2.ml
@@ -0,0 +1,36 @@
+open Camlp4.PreCast ;
+module G = Camlp4.PreCast.Gram ;
+
+value exp = G.Entry.mk "exp" ;
+value prog = G.Entry.mk "prog" ;
+
+EXTEND G
+exp:
+[ "apply"
+ [ e1 = exp LEVEL "simple"; e2 = SELF ->
+ let p = Loc.dump in
+ let () =
+ Format.eprintf "e1: %a,@.e2: %a,@.e1-e2: %a,@._loc: %a@."
+ p e1 p e2 p (Loc.merge e1 e2) p _loc
+ in
+ _loc
+ ]
+| "simple"
+ [ _ = LIDENT -> _loc ]
+];
+prog: [[ e = exp; `EOI -> e ]];
+END ;
+
+(* and the following function: *)
+
+value parse_string entry s =
+try
+ G.parse_string entry (Loc.mk "<string>") s
+with [ Loc.Exc_located loc exn ->
+begin
+ print_endline (Loc.to_string loc);
+ print_endline (Printexc.to_string exn);
+ failwith "Syntax Error"
+end ] ;
+
+parse_string prog "f x";
diff --git a/camlp4/test/fixtures/pr4314gram3.ml b/camlp4/test/fixtures/pr4314gram3.ml
new file mode 100644
index 000000000..3298bcbfe
--- /dev/null
+++ b/camlp4/test/fixtures/pr4314gram3.ml
@@ -0,0 +1,36 @@
+open Camlp4.PreCast ;
+module G = Camlp4.PreCast.Gram ;
+
+value exp = G.Entry.mk "exp" ;
+value prog = G.Entry.mk "prog" ;
+
+EXTEND G
+exp:
+[ "apply"
+ [ e1 = SELF; e2 = exp LEVEL "simple" ->
+ let p = Loc.dump in
+ let () =
+ Format.eprintf "e1: %a,@.e2: %a,@.e1-e2: %a,@._loc: %a@."
+ p e1 p e2 p (Loc.merge e1 e2) p _loc
+ in
+ _loc
+ ]
+| "simple"
+ [ _ = LIDENT -> _loc ]
+];
+prog: [[ e = exp; `EOI -> e ]];
+END ;
+
+(* and the following function: *)
+
+value parse_string entry s =
+try
+ G.parse_string entry (Loc.mk "<string>") s
+with [ Loc.Exc_located loc exn ->
+begin
+ print_endline (Loc.to_string loc);
+ print_endline (Printexc.to_string exn);
+ failwith "Syntax Error"
+end ] ;
+
+parse_string prog "f x";
diff --git a/camlp4/test/fixtures/pr4314gram4.ml b/camlp4/test/fixtures/pr4314gram4.ml
new file mode 100644
index 000000000..1c6712e24
--- /dev/null
+++ b/camlp4/test/fixtures/pr4314gram4.ml
@@ -0,0 +1,36 @@
+open Camlp4.PreCast ;
+module G = Camlp4.PreCast.Gram ;
+
+value exp = G.Entry.mk "exp" ;
+value prog = G.Entry.mk "prog" ;
+
+EXTEND G
+exp:
+[ "apply"
+ [ e1 = SELF; e2 = exp LEVEL "simple"; e3 = exp LEVEL "simple" ->
+ let p = Loc.dump in
+ let () =
+ Format.eprintf "e1: %a,@.e2: %a,@.e3: %a,@._loc: %a@."
+ p e1 p e2 p e3 p _loc
+ in
+ _loc
+ ]
+| "simple"
+ [ _ = LIDENT -> _loc ]
+];
+prog: [[ e = exp; `EOI -> e ]];
+END ;
+
+(* and the following function: *)
+
+value parse_string entry s =
+try
+ G.parse_string entry (Loc.mk "<string>") s
+with [ Loc.Exc_located loc exn ->
+begin
+ print_endline (Loc.to_string loc);
+ print_endline (Printexc.to_string exn);
+ failwith "Syntax Error"
+end ] ;
+
+parse_string prog "f x y";
diff --git a/camlp4/test/fixtures/pr4314gram5.ml b/camlp4/test/fixtures/pr4314gram5.ml
new file mode 100644
index 000000000..bd2fb11cd
--- /dev/null
+++ b/camlp4/test/fixtures/pr4314gram5.ml
@@ -0,0 +1,38 @@
+open Camlp4.PreCast ;
+module G = Camlp4.PreCast.Gram ;
+
+value exp = G.Entry.mk "exp" ;
+value prog = G.Entry.mk "prog" ;
+
+EXTEND G
+exp:
+[ "apply"
+[ e1 = SELF; e2 = exp LEVEL "simple"; e3 = SELF ->
+ let p = Loc.dump in
+ let () =
+ Format.eprintf "e1: %a,@.e2: %a,@.e3: %a,@._loc: %a@."
+ p e1 p e2 p e3 p _loc
+ in
+ _loc
+ ]
+| "simple"
+[ x = LIDENT; y = LIDENT ->
+ let () = Format.eprintf "reduce expr simple (%S, %S) at %a@." x y Loc.dump _loc in _loc ]
+];
+prog: [[ e = exp; `EOI -> e ]];
+END ;
+
+(* and the following function: *)
+
+value parse_string entry s =
+try
+ print_endline s;
+ G.parse_string entry (Loc.mk "<string>") s
+with [ Loc.Exc_located loc exn ->
+begin
+ print_endline (Loc.to_string loc);
+ print_endline (Printexc.to_string exn);
+ failwith "Syntax Error"
+end ] ;
+
+parse_string prog "f1 f2 x1 x2 y1 y2";
diff --git a/camlp4/test/fixtures/pr4329.ml b/camlp4/test/fixtures/pr4329.ml
new file mode 100644
index 000000000..72f2b7876
--- /dev/null
+++ b/camlp4/test/fixtures/pr4329.ml
@@ -0,0 +1,50 @@
+open Camlp4.PreCast ;
+module G = Camlp4.PreCast.Gram;
+
+value ab_eoi = G.Entry.mk "ab_eoi" ;
+value a_or_ab = G.Entry.mk "a_or_ab" ;
+value a_or_ab_eoi = G.Entry.mk "a_or_ab_eoi" ;
+value c_a_or_ab_eoi = G.Entry.mk "c_a_or_ab_eoi" ;
+
+EXTEND G
+ab_eoi: [[ "a"; "b"; `EOI -> () ]];
+a_or_ab: [[ "a" -> () | "a"; "b" -> () ]];
+a_or_ab_eoi: [[ a_or_ab; `EOI -> () ]];
+c_a_or_ab_eoi: [[ "c"; a_or_ab; `EOI -> () ]];
+END ;
+
+value parse_string entry s =
+try
+ G.parse_string entry (Loc.mk "<string>") s
+with [ Loc.Exc_located loc exn ->
+begin
+ print_endline (Loc.to_string loc);
+ print_endline (Printexc.to_string exn);
+ (* failwith "Syntax Error" *)
+end ] ;
+
+(* Consider the following syntax errors: *)
+parse_string ab_eoi "a c" ;
+(* File "<string>", line 1, characters 2-3
+Stream.Error("illegal begin of ab_eoi")
+Exception: Failure "Syntax Error".
+--> "Illegal begin": at least the first symbol was correct
+--> nevertheless, the reported position is correct
+--> The message used to be: "b" then EOI expected after "a" in [ab_eoi] *)
+
+parse_string a_or_ab_eoi "a c" ;
+(* File "<string>", line 1, characters 0-1
+Stream.Error("illegal begin of a_or_ab_eoi")
+Exception: Failure "Syntax Error".
+--> "Illegal begin": at least the first non-terminal was correct
+--> the reported position is weird
+--> I think the message used to be either: "b" expected after "a" in
+[a_or_ab]
+or: EOI expected after [a_or_ab] in [a_or_ab_eoi] *)
+
+parse_string c_a_or_ab_eoi "c a c" ;
+(* File "<string>", line 1, characters 2-3
+Stream.Error("[a_or_ab] expected after \"c\" (in [c_a_or_ab_eoi])")
+Exception: Failure "Syntax Error".
+--> "[a_or_ab] expected": this is very confusing: there is a valid a_or_ab
+there, namely "a" *)
diff --git a/camlp4/test/fixtures/pr4330.ml b/camlp4/test/fixtures/pr4330.ml
new file mode 100644
index 000000000..636db7442
--- /dev/null
+++ b/camlp4/test/fixtures/pr4330.ml
@@ -0,0 +1,50 @@
+open Camlp4.PreCast ;
+module G = Camlp4.PreCast.Gram ;
+
+value a = G.Entry.mk "a" ;
+value a_eoi = G.Entry.mk "a_eoi" ;
+
+EXTEND G
+a: [[ "one" -> 1 | x = a; "plus"; y = a -> x+y ]];
+a_eoi: [[ x = a; `EOI -> x ]];
+END ;
+
+(* and the following function: *)
+
+value parse_string entry s =
+try
+ G.parse_string entry (Loc.mk "<string>") s
+with [ Loc.Exc_located loc exn ->
+begin
+ print_endline (Loc.to_string loc);
+ print_endline (Printexc.to_string exn);
+ failwith "Syntax Error"
+end ] ;
+
+(* The following is correct: *)
+
+assert (parse_string a_eoi "one plus one" = 2);
+
+(* While all of the following inputs should be rejected because they are not *)
+(* legal according to the grammar: *)
+
+parse_string a_eoi "one plus" ;
+(* - : int = 1 *)
+parse_string a_eoi "one plus plus" ;
+(* - : int = 1 *)
+parse_string a_eoi "one plus one plus" ;
+(* - : int = 2 *)
+parse_string a_eoi "one plus one plus plus" ;
+(* - : int = 2 *)
+
+(* Curiously, you may only repeat the operator twice. If you specify it three
+times, gramlib complains. *)
+
+parse_string a_eoi "one plus plus plus" ;
+(* File "<string>", line 1, characters 9-13 *)
+(* Stream.Error("EOI expected after [a] (in [a_eoi])") *)
+(* Exception: Failure "Syntax Error". *)
+parse_string a_eoi "one plus one plus plus plus" ;
+(* File "<string>", line 1, characters 18-22 *)
+(* Stream.Error("EOI expected after [a] (in [a_eoi])") *)
+(* Exception: Failure "Syntax Error". *)
generated by cgit v1.2.3-70-g09d2 (git 2.46.0) at 2025-03-21 19:48:59 +0000