summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
Diffstat
-rw-r--r--camlp4/camlp4/ast2pt.ml8
-rw-r--r--camlp4/etc/pa_o.ml29
-rw-r--r--camlp4/meta/pa_r.ml21
-rw-r--r--camlp4/ocaml_src/camlp4/ast2pt.ml9
-rw-r--r--camlp4/ocaml_src/meta/pa_r.ml27
5 files changed, 52 insertions, 42 deletions
diff --git a/camlp4/camlp4/ast2pt.ml b/camlp4/camlp4/ast2pt.ml
index 21f2537f1..3eb0bc1f1 100644
--- a/camlp4/camlp4/ast2pt.ml
+++ b/camlp4/camlp4/ast2pt.ml
@@ -132,7 +132,7 @@ value mkli s =
value long_id_of_string_list loc sl =
match List.rev sl with
- [ [] -> error loc "bad ast"
+ [ [] -> error loc "bad ast in long ident"
| [s :: sl] -> mkli s (List.rev sl) ]
;
@@ -291,7 +291,7 @@ value paolab loc lab peoo =
let lab =
match (lab, peoo) with
[ ("", Some (PaLid _ i | PaTyc _ (PaLid _ i) _, _)) -> i
- | ("", _) -> error loc "bad ast"
+ | ("", _) -> error loc "bad ast in label"
| _ -> lab ]
in
let (p, eo) =
@@ -555,7 +555,7 @@ value rec expr =
| [(loc, ml, ExLid _ s) :: l] ->
(mkexp loc (Pexp_ident (mkli s ml)), l)
| [(_, [], e) :: l] -> (expr e, l)
- | _ -> error loc "bad ast" ]
+ | _ -> error loc "bad ast in expression" ]
in
let (_, e) =
List.fold_left
@@ -914,7 +914,7 @@ value directive loc =
fun
[ ExLid _ i | ExUid _ i -> [i]
| ExAcc _ e (ExLid _ i) | ExAcc _ e (ExUid _ i) -> loop e @ [i]
- | e -> raise_with_loc (loc_of_expr e) (Failure "bad ast") ]
+ | e -> raise_with_loc (loc_of_expr e) (Failure "bad ast in directive") ]
in
Pdir_ident (long_id_of_string_list loc sl) ]
;
diff --git a/camlp4/etc/pa_o.ml b/camlp4/etc/pa_o.ml
index d5efa6611..de370c7f7 100644
--- a/camlp4/etc/pa_o.ml
+++ b/camlp4/etc/pa_o.ml
@@ -18,7 +18,6 @@ open Pcaml;
Pcaml.syntax_name.val := "OCaml";
Pcaml.no_constructors_arity.val := True;
-
do {
let odfa = Plexer.dollar_for_antiquotation.val in
Plexer.dollar_for_antiquotation.val := False;
@@ -54,6 +53,16 @@ value o2b =
| None -> False ]
;
+value mkexprident _loc ids = match ids with
+ [ [] -> Stdpp.raise_with_loc _loc (Stream.Error "illegal long identifier")
+ | [ id :: ids ] ->
+ let rec loop m = fun
+ [ [ id :: ids ] -> loop <:expr< $m$ . $id$ >> ids
+ | [] -> m ]
+ in
+ loop id ids ]
+;
+
value mkumin _loc f arg =
match (f, arg) with
[ ("-", <:expr< $int:n$ >>) when int_of_string n > 0 ->
@@ -665,7 +674,7 @@ EXTEND
| c = CHAR -> <:expr< $chr:c$ >>
| UIDENT "True" -> <:expr< $uid:" True"$ >>
| UIDENT "False" -> <:expr< $uid:" False"$ >>
- | i = expr_ident -> i
+ | ids = expr_ident -> mkexprident _loc ids
| s = "false" -> <:expr< False >>
| s = "true" -> <:expr< True >>
| "["; "]" -> <:expr< [] >>
@@ -746,17 +755,13 @@ EXTEND
;
expr_ident:
[ RIGHTA
- [ i = LIDENT -> <:expr< $lid:i$ >>
- | i = UIDENT -> <:expr< $uid:i$ >>
- | i = UIDENT; "."; j = SELF ->
- let rec loop m =
- fun
- [ <:expr< $x$ . $y$ >> -> loop <:expr< $m$ . $x$ >> y
- | e -> <:expr< $m$ . $e$ >> ]
- in
- loop <:expr< $uid:i$ >> j
+ [ i = LIDENT -> [ <:expr< $lid:i$ >> ]
+ | i = UIDENT -> [ <:expr< $uid:i$ >> ]
| i = UIDENT; "."; "("; j = operator_rparen ->
- <:expr< $uid:i$ . $lid:j$ >> ] ]
+ [ <:expr< $uid:i$ >> ; <:expr< $lid:j$ >> ]
+ | i = UIDENT; "."; j = SELF -> [ <:expr< $uid:i$ >> :: j ]
+ ]
+ ]
;
(* Patterns *)
patt:
diff --git a/camlp4/meta/pa_r.ml b/camlp4/meta/pa_r.ml
index 721bd7509..983e9f136 100644
--- a/camlp4/meta/pa_r.ml
+++ b/camlp4/meta/pa_r.ml
@@ -133,13 +133,14 @@ value mklistpat _loc last =
<:patt< [$p1$ :: $loop False pl$] >> ]
;
-value mkexprident _loc i j =
- let rec loop m =
- fun
- [ <:expr< $x$ . $y$ >> -> loop <:expr< $m$ . $x$ >> y
- | e -> <:expr< $m$ . $e$ >> ]
+value mkexprident _loc ids = match ids with
+ [ [] -> Stdpp.raise_with_loc _loc (Stream.Error "illegal long identifier")
+ | [ id :: ids ] ->
+ let rec loop m = fun
+ [ [ id :: ids ] -> loop <:expr< $m$ . $id$ >> ids
+ | [] -> m ]
in
- loop <:expr< $uid:i$ >> j
+ loop id ids ]
;
value mkassert _loc e =
@@ -391,7 +392,7 @@ EXTEND
| s = FLOAT -> <:expr< $flo:s$ >>
| s = STRING -> <:expr< $str:s$ >>
| s = CHAR -> <:expr< $chr:s$ >>
- | i = expr_ident -> i
+ | ids = expr_ident -> mkexprident _loc ids
| "["; "]" -> <:expr< [] >>
| "["; el = LIST1 expr SEP ";"; last = cons_expr_opt; "]" ->
mklistexp _loc last el
@@ -446,9 +447,9 @@ EXTEND
;
expr_ident:
[ RIGHTA
- [ i = LIDENT -> <:expr< $lid:i$ >>
- | i = UIDENT -> <:expr< $uid:i$ >>
- | i = UIDENT; "."; j = SELF -> mkexprident _loc i j ] ]
+ [ i = LIDENT -> [ <:expr< $lid:i$ >> ]
+ | i = UIDENT -> [ <:expr< $uid:i$ >> ]
+ | i = UIDENT; "."; j = SELF -> [ <:expr< $uid:i$ >> :: j ] ] ]
;
fun_def:
[ RIGHTA
diff --git a/camlp4/ocaml_src/camlp4/ast2pt.ml b/camlp4/ocaml_src/camlp4/ast2pt.ml
index 178009231..7103f947f 100644
--- a/camlp4/ocaml_src/camlp4/ast2pt.ml
+++ b/camlp4/ocaml_src/camlp4/ast2pt.ml
@@ -121,7 +121,7 @@ let mkli s =
let long_id_of_string_list loc sl =
match List.rev sl with
- [] -> error loc "bad ast"
+ [] -> error loc "bad ast in long ident"
| s :: sl -> mkli s (List.rev sl)
;;
@@ -279,7 +279,7 @@ let paolab loc lab peoo =
let lab =
match lab, peoo with
"", Some ((PaLid (_, i) | PaTyc (_, PaLid (_, i), _)), _) -> i
- | "", _ -> error loc "bad ast"
+ | "", _ -> error loc "bad ast in label"
| _ -> lab
in
let (p, eo) =
@@ -556,7 +556,7 @@ let rec expr =
| (loc, ml, ExLid (_, s)) :: l ->
mkexp loc (Pexp_ident (mkli s ml)), l
| (_, [], e) :: l -> expr e, l
- | _ -> error loc "bad ast"
+ | _ -> error loc "bad ast in expression"
in
let (_, e) =
List.fold_left
@@ -936,7 +936,8 @@ let directive loc =
ExLid (_, i) | ExUid (_, i) -> [i]
| ExAcc (_, e, ExLid (_, i)) | ExAcc (_, e, ExUid (_, i)) ->
loop e @ [i]
- | e -> raise_with_loc (loc_of_expr e) (Failure "bad ast")
+ | e ->
+ raise_with_loc (loc_of_expr e) (Failure "bad ast in directive")
in
loop e
in
diff --git a/camlp4/ocaml_src/meta/pa_r.ml b/camlp4/ocaml_src/meta/pa_r.ml
index 2fa43b727..46bd68581 100644
--- a/camlp4/ocaml_src/meta/pa_r.ml
+++ b/camlp4/ocaml_src/meta/pa_r.ml
@@ -136,13 +136,16 @@ let mklistpat _loc last =
loop true
;;
-let mkexprident _loc i j =
- let rec loop m =
- function
- MLast.ExAcc (_, x, y) -> loop (MLast.ExAcc (_loc, m, x)) y
- | e -> MLast.ExAcc (_loc, m, e)
- in
- loop (MLast.ExUid (_loc, i)) j
+let mkexprident _loc ids =
+ match ids with
+ [] -> Stdpp.raise_with_loc _loc (Stream.Error "illegal long identifier")
+ | id :: ids ->
+ let rec loop m =
+ function
+ id :: ids -> loop (MLast.ExAcc (_loc, m, id)) ids
+ | [] -> m
+ in
+ loop id ids
;;
let mkassert _loc e =
@@ -1207,8 +1210,8 @@ Grammar.extend
[Gramext.Snterm
(Grammar.Entry.obj (expr_ident : 'expr_ident Grammar.Entry.e))],
Gramext.action
- (fun (i : 'expr_ident) (_loc : Lexing.position * Lexing.position) ->
- (i : 'expr));
+ (fun (ids : 'expr_ident) (_loc : Lexing.position * Lexing.position) ->
+ (mkexprident _loc ids : 'expr));
[Gramext.Stoken ("CHAR", "")],
Gramext.action
(fun (s : string) (_loc : Lexing.position * Lexing.position) ->
@@ -1373,15 +1376,15 @@ Grammar.extend
Gramext.action
(fun (j : 'expr_ident) _ (i : string)
(_loc : Lexing.position * Lexing.position) ->
- (mkexprident _loc i j : 'expr_ident));
+ (MLast.ExUid (_loc, i) :: j : 'expr_ident));
[Gramext.Stoken ("UIDENT", "")],
Gramext.action
(fun (i : string) (_loc : Lexing.position * Lexing.position) ->
- (MLast.ExUid (_loc, i) : 'expr_ident));
+ ([MLast.ExUid (_loc, i)] : 'expr_ident));
[Gramext.Stoken ("LIDENT", "")],
Gramext.action
(fun (i : string) (_loc : Lexing.position * Lexing.position) ->
- (MLast.ExLid (_loc, i) : 'expr_ident))]];
+ ([MLast.ExLid (_loc, i)] : 'expr_ident))]];
Grammar.Entry.obj (fun_def : 'fun_def Grammar.Entry.e), None,
[None, Some Gramext.RightA,
[[Gramext.Stoken ("", "->");
generated by cgit v1.2.3-70-g09d2 (git 2.46.0) at 2025-03-16 20:58:56 +0000