Fixed parsing of labels/type constraints (bug #1818)

git-svn-id: http://caml.inria.fr/svn/ocaml/trunk@5846 f963ae5c-01c2-4b8c-9fe0-0dff7051ff02
lucasaiu · Sep 25, 2003 · ba1aa1b · ba1aa1b
1 parent 015b6a2
commit ba1aa1b
Show file tree

Hide file tree

Showing 11 changed files with 163 additions and 51 deletions.
diff --git a/camlp4/CHANGES b/camlp4/CHANGES
@@ -1,4 +1,11 @@
-Camlp4 Version 3.07 beta
+Camlp4 Version 3.07 beta2
+________________________
+
+- [09 Sep 03] Added tokens LABEL and OPTLABEL in plexer, and use them in
+  both parsers (ocaml and revised). There was, afaik, no other way to fix
+  ambiguities (bugs) in parsing labels and type constraints.
+
+Camlp4 Version 3.07 beta1
 ________________________
 
 - [July 03] Updated the ocaml/camlp4 CVS tree with the camlp4

diff --git a/camlp4/etc/pa_o.ml b/camlp4/etc/pa_o.ml
@@ -1150,8 +1150,14 @@ EXTEND
   (* Labels *)
   ctyp: AFTER "arrow"
     [ NONA
-      [ i = lident_colon; t = SELF -> <:ctyp< ~ $i$ : $t$ >>
-      | i = QUESTIONIDENT; ":"; t = SELF -> <:ctyp< ? $i$ : $t$ >> ] ]
+      [ i = lident_colon; t1 = ctyp LEVEL "star"; "->"; t2 = SELF ->
+          <:ctyp< ~ $i$ : $t1$ -> $t2$ >>
+      | i = OPTLABEL; t1 = ctyp LEVEL "star"; "->"; t2 = SELF ->
+          <:ctyp< ? $i$ : $t1$ -> $t2$ >>
+      | i = QUESTIONIDENT; ":"; t1 = ctyp LEVEL "star"; "->"; t2 = SELF ->
+          <:ctyp< ? $i$ : $t1$ -> $t2$ >>
+      | "?"; i=lident_colon;t1 = ctyp LEVEL "star"; "->"; t2 = SELF ->
+          <:ctyp< ? $i$ : $t1$ -> $t2$ >> ] ]
   ;
   ctyp: LEVEL "simple"
     [ [ "["; OPT "|"; rfl = LIST1 row_field SEP "|"; "]" ->
@@ -1179,10 +1185,12 @@ EXTEND
   ;
   expr: AFTER "apply"
     [ "label"
-      [ i = TILDEIDENT; ":"; e = SELF -> <:expr< ~ $i$ : $e$ >>
+      [ i = LABEL; e = SELF -> <:expr< ~ $i$ : $e$ >>
       | i = TILDEIDENT -> <:expr< ~ $i$ >>
-      | i = QUESTIONIDENT; ":"; e = SELF -> <:expr< ? $i$ : $e$ >>
-      | i = QUESTIONIDENT -> <:expr< ? $i$ >> ] ]
+      | "~"; i = LIDENT -> <:expr< ~ $i$ >>
+      | i = OPTLABEL; e = SELF -> <:expr< ? $i$ : $e$ >>
+      | i = QUESTIONIDENT -> <:expr< ? $i$ >> 
+      | "?"; i = LIDENT -> <:expr< ? $i$ >> ] ]
   ;
   expr: LEVEL "simple"
     [ [ "`"; s = ident -> <:expr< ` $s$ >> ] ]
@@ -1198,24 +1206,26 @@ EXTEND
       | "#"; t = mod_ident -> <:patt< # $list:t$ >> ] ]
   ;
   labeled_patt:
-    [ [ i = TILDEIDENT; ":"; p = patt LEVEL "simple" ->
+    [ [ i = LABEL; p = patt LEVEL "simple" ->
            <:patt< ~ $i$ : $p$ >>
       | i = TILDEIDENT ->
            <:patt< ~ $i$ >>
+      | "~"; i=LIDENT -> <:patt< ~ $i$ >>
       | "~"; "("; i = LIDENT; ")" ->
            <:patt< ~ $i$ >>
       | "~"; "("; i = LIDENT; ":"; t = ctyp; ")" ->
            <:patt< ~ $i$ : ($lid:i$ : $t$) >>
-      | i = QUESTIONIDENT; ":"; j = LIDENT ->
+      | i = OPTLABEL; j = LIDENT ->
            <:patt< ? $i$ : ($lid:j$) >>
-      | i = QUESTIONIDENT; ":"; "("; p = patt; "="; e = expr; ")" ->
+      | i = OPTLABEL; "("; p = patt; "="; e = expr; ")" ->
           <:patt< ? $i$ : ( $p$ = $e$ ) >>
-      | i = QUESTIONIDENT; ":"; "("; p = patt; ":"; t = ctyp; ")" ->
+      | i = OPTLABEL; "("; p = patt; ":"; t = ctyp; ")" ->
           <:patt< ? $i$ : ( $p$ : $t$ ) >>
-      | i = QUESTIONIDENT; ":"; "("; p = patt; ":"; t = ctyp; "=";
+      | i = OPTLABEL; "("; p = patt; ":"; t = ctyp; "=";
         e = expr; ")" ->
           <:patt< ? $i$ : ( $p$ : $t$ = $e$ ) >>
       | i = QUESTIONIDENT -> <:patt< ? $i$ >>
+      | "?"; i = LIDENT -> <:patt< ? $i$ >>
       | "?"; "("; i = LIDENT; "="; e = expr; ")" ->
           <:patt< ? ( $lid:i$ = $e$ ) >>
       | "?"; "("; i = LIDENT; ":"; t = ctyp; "="; e = expr; ")" ->
@@ -1226,9 +1236,13 @@ EXTEND
           <:patt< ? ( $lid:i$ : $t$ ) >> ] ]
   ;
   class_type:
-    [ [ i = lident_colon; t = ctyp LEVEL "ctyp1"; "->"; ct = SELF ->
+    [ [ i = lident_colon; t = ctyp LEVEL "star"; "->"; ct = SELF ->
           <:class_type< [ ~ $i$ : $t$ ] -> $ct$ >>
-      | i = QUESTIONIDENT; ":"; t = ctyp LEVEL "ctyp1"; "->"; ct = SELF ->
+      | i = OPTLABEL; t = ctyp LEVEL "star"; "->"; ct = SELF ->
+          <:class_type< [ ? $i$ : $t$ ] -> $ct$ >> 
+      | i = QUESTIONIDENT; ":"; t = ctyp LEVEL "star"; "->"; ct = SELF ->
+          <:class_type< [ ? $i$ : $t$ ] -> $ct$ >> 
+      | "?"; i = LIDENT; ":"; t = ctyp LEVEL "star"; "->"; ct = SELF ->
           <:class_type< [ ? $i$ : $t$ ] -> $ct$ >> ] ]
   ;
   class_fun_binding:

diff --git a/camlp4/lib/plexer.ml b/camlp4/lib/plexer.ml
@@ -462,7 +462,12 @@ value next_token_fun dfa ssd find_kwd bolpos glexr =
     try (("", find_kwd s), loc) with
     [ Not_found ->
         if error_on_unknown_keywords.val then err loc ("illegal token: " ^ s)
-        else (("", s), loc) ]
+        else (("", s), loc) ] in
+  let error_if_keyword ( ((_,id), loc) as a) =
+    try do {
+      ignore(find_kwd id);
+      err loc ("illegal use of a keyword as a label: " ^ id) }
+    with [ Not_found -> a ]
   in
   let rec next_token after_space =
     parser bp
@@ -511,17 +516,24 @@ value next_token_fun dfa ssd find_kwd bolpos glexr =
     | [: `('~' as c);
          a =
            parser
-           [ [: `('a'..'z' as c); len = ident (store 0 c) :] ep ->
-               (("TILDEIDENT", get_buff len), (bp, ep))
+           [ [: `('a'..'z' as c); len = ident (store 0 c); s :] ep ->
+               let id = get_buff len in
+               match s with parser
+               [ [: `':' :] eb -> error_if_keyword (("LABEL", id), (bp,ep))
+               | [: :] -> error_if_keyword (("TILDEIDENT", id), (bp, ep)) ]
            | [: s :] ->
                let id = get_buff (ident2 (store 0 c) s) in
                keyword_or_error (bp, Stream.count s) id ] :] ->
         a
+
     | [: `('?' as c);
          a =
            parser
-           [ [: `('a'..'z' as c); len = ident (store 0 c) :] ep ->
-               (("QUESTIONIDENT", get_buff len), (bp, ep))
+           [ [: `('a'..'z' as c); len = ident (store 0 c); s :] ep ->
+               let id = get_buff len in
+               match s with parser
+               [ [: `':' :] eb -> error_if_keyword (("OPTLABEL", id), (bp,ep))
+               | [: :] -> error_if_keyword (("QUESTIONIDENT", id), (bp, ep)) ]
            | [: s :] ->
                let id = get_buff (ident2 (store 0 c) s) in
                keyword_or_error (bp, Stream.count s) id ] :] ->
@@ -883,9 +895,10 @@ value using_token kwd_table ident_table (p_con, p_prm) =
             if Hashtbl.mem kwd_table p_prm then
               error_ident_and_keyword p_con p_prm
             else Hashtbl.add ident_table p_prm p_con ]
-  | "TILDEIDENT" | "QUESTIONIDENT" | "INT" | "INT32" | "INT64" | "NATIVEINT"
-  | "FLOAT" | "CHAR" | "STRING" |
-    "QUOTATION" | "ANTIQUOT" | "LOCATE" | "EOI" ->
+  | "INT" | "INT32" | "INT64" | "NATIVEINT"
+  | "FLOAT" | "CHAR" | "STRING"
+  | "TILDEIDENT" | "QUESTIONIDENT" | "LABEL" | "OPTLABEL"
+  | "QUOTATION" | "ANTIQUOT" | "LOCATE" | "EOI" ->
       ()
   | _ ->
       raise

diff --git a/camlp4/meta/pa_r.ml b/camlp4/meta/pa_r.ml
@@ -751,7 +751,9 @@ EXTEND
   ctyp: AFTER "arrow"
     [ NONA
       [ i = TILDEIDENT; ":"; t = SELF -> <:ctyp< ~ $i$ : $t$ >>
-      | i = QUESTIONIDENT; ":"; t = SELF -> <:ctyp< ? $i$ : $t$ >> ] ]
+      | i = LABEL; t = SELF -> <:ctyp< ~ $i$ : $t$ >>
+      | i = QUESTIONIDENT; ":"; t = SELF -> <:ctyp< ? $i$ : $t$ >> 
+      | i = OPTLABEL; t = SELF -> <:ctyp< ? $i$ : $t$ >> ] ]
   ;
   ctyp: LEVEL "simple"
     [ [ "["; "="; rfl = row_field_list; "]" ->
@@ -779,9 +781,12 @@ EXTEND
     [ [ "`"; s = ident -> <:patt< ` $s$ >>
       | "#"; sl = mod_ident -> <:patt< # $list:sl$ >>
       | i = TILDEIDENT; ":"; p = SELF -> <:patt< ~ $i$ : $p$ >>
+      | i = LABEL; p = SELF -> <:patt< ~ $i$ : $p$ >>
       | i = TILDEIDENT -> <:patt< ~ $i$ >>
       | i = QUESTIONIDENT; ":"; "("; p = patt_tcon; eo = OPT eq_expr; ")" ->
           <:patt< ? $i$ : ($p$ $opt:eo$) >>
+      | i = OPTLABEL; "("; p = patt_tcon; eo = OPT eq_expr; ")" ->
+          <:patt< ? $i$ : ($p$ $opt:eo$) >>
       | i = QUESTIONIDENT ->
           <:patt< ? $i$ >>
       | "?"; "("; p = patt_tcon; eo = OPT eq_expr; ")" ->
@@ -793,9 +798,12 @@ EXTEND
   ;
   ipatt:
     [ [ i = TILDEIDENT; ":"; p = SELF -> <:patt< ~ $i$ : $p$ >>
+      | i = LABEL; p = SELF -> <:patt< ~ $i$ : $p$ >>
       | i = TILDEIDENT -> <:patt< ~ $i$ >>
       | i = QUESTIONIDENT; ":"; "("; p = ipatt_tcon; eo = OPT eq_expr; ")" ->
           <:patt< ? $i$ : ($p$ $opt:eo$) >>
+      | i = OPTLABEL; "("; p = ipatt_tcon; eo = OPT eq_expr; ")" ->
+          <:patt< ? $i$ : ($p$ $opt:eo$) >>
       | i = QUESTIONIDENT ->
           <:patt< ? $i$ >>
       | "?"; "("; p = ipatt_tcon; eo = OPT eq_expr; ")" ->
@@ -811,8 +819,10 @@ EXTEND
   expr: AFTER "apply"
     [ "label" NONA
       [ i = TILDEIDENT; ":"; e = SELF -> <:expr< ~ $i$ : $e$ >>
+      | i = LABEL; e = SELF -> <:expr< ~ $i$ : $e$ >>
       | i = TILDEIDENT -> <:expr< ~ $i$ >>
       | i = QUESTIONIDENT; ":"; e = SELF -> <:expr< ? $i$ : $e$ >>
+      | i = OPTLABEL; e = SELF -> <:expr< ? $i$ : $e$ >>
       | i = QUESTIONIDENT -> <:expr< ? $i$ >> ] ]
   ;
   expr: LEVEL "simple"

diff --git a/camlp4/ocaml_src/camlp4/Makefile b/camlp4/ocaml_src/camlp4/Makefile
@@ -37,7 +37,7 @@ camlp4.cmxa: $(CAMLP4_XOBJS)
 	$(OCAMLOPT) $(LINKFLAGS) $(CAMLP4_XOBJS) -a -o camlp4.cmxa
 
 clean::
-	rm -f *.cm* *.pp[io] *.o *.bak .*.bak *.out *.opt
+	rm -f *.cm* *.pp[io] *.$(O) *.$(A) *.bak .*.bak *.out *.opt
 	rm -f $(CAMLP4)
 
 depend:
@@ -64,7 +64,7 @@ install:
 	cp mLast.cmi quotation.cmi ast2pt.cmi pcaml.cmi spretty.cmi "$(LIBDIR)/camlp4/."
 	cp camlp4.cma $(LIBDIR)/camlp4/.
 	if [ -f camlp4.cmxa ]; \
-	  then cp camlp4.cmxa camlp4.a $(LIBDIR)/camlp4/.; \
+	  then cp camlp4.cmxa camlp4.$(A) $(LIBDIR)/camlp4/.; \
 	  else : ; \
 	fi
 

diff --git a/camlp4/ocaml_src/camlp4/spretty.ml b/camlp4/ocaml_src/camlp4/spretty.ml
@@ -222,7 +222,7 @@ let rec hprint_pretty tab pos spc =
   | VL [] -> pos, spc
   | VL x -> hprint_box tab pos spc x
   | BE x -> hprint_box tab pos spc x
-  | BV x -> hprint_box tab pos spc x (* invalid_arg "hprint_pretty" *)
+  | BV x -> hprint_box tab pos spc x
   | LI ((comm, nl_bef, tab_bef), x) ->
       if !lazy_tab >= 0 then
         begin

diff --git a/camlp4/ocaml_src/lib/Makefile b/camlp4/ocaml_src/lib/Makefile
@@ -18,7 +18,7 @@ $(TARGET:.cma=.cmxa): $(OBJS:.cmo=.cmx)
 	$(OCAMLOPT) $(OBJS:.cmo=.cmx) -a -o $(TARGET:.cma=.cmxa)
 
 clean::
-	rm -f *.cm[ioax] *.cmxa *.pp[io] *.o *.a *.bak .*.bak $(TARGET)
+	rm -f *.cm[ioax] *.cmxa *.pp[io] *.$(O) *.$(A) *.bak .*.bak $(TARGET)
 
 depend:
 	cp .depend .depend.bak
@@ -43,10 +43,6 @@ install:
 
 installopt:
 	cp $(TARGET:.cma=.cmxa) *.cmx "$(LIBDIR)/camlp4/."
-	if test -f $(TARGET:.cma=.lib); then \
-	  cp $(TARGET:.cma=.lib) "$(LIBDIR)/camlp4/."; \
-	else \
-	  tar cf - $(TARGET:.cma=.a) | (cd "$(LIBDIR)/camlp4/."; tar xf -); \
-	fi
+	tar cf - $(TARGET:.cma=.$(A)) | (cd "$(LIBDIR)/camlp4/."; tar xf -)
 
 include .depend
diff --git a/camlp4/ocaml_src/lib/plexer.ml b/camlp4/ocaml_src/lib/plexer.ml
@@ -483,6 +483,13 @@ let next_token_fun dfa ssd find_kwd bolpos glexr =
         if !error_on_unknown_keywords then err loc ("illegal token: " ^ s)
         else ("", s), loc
   in
+  let error_if_keyword ((_, id), loc as a) =
+    try
+      ignore (find_kwd id);
+      err loc ("illegal use of a keyword as a label: " ^ id)
+    with
+      Not_found -> a
+  in
   let rec next_token after_space (strm__ : _ Stream.t) =
     let bp = Stream.count strm__ in
     match Stream.peek strm__ with
@@ -553,8 +560,17 @@ let next_token_fun dfa ssd find_kwd bolpos glexr =
                 try ident (store 0 c) strm__ with
                   Stream.Failure -> raise (Stream.Error "")
               in
+              let s = strm__ in
               let ep = Stream.count strm__ in
-              ("TILDEIDENT", get_buff len), (bp, ep)
+              let id = get_buff len in
+              let (strm__ : _ Stream.t) = s in
+              begin match Stream.peek strm__ with
+                Some ':' ->
+                  Stream.junk strm__;
+                  let eb = Stream.count strm__ in
+                  error_if_keyword (("LABEL", id), (bp, ep))
+              | _ -> error_if_keyword (("TILDEIDENT", id), (bp, ep))
+              end
           | _ ->
               let id = get_buff (ident2 (store 0 c) strm__) in
               keyword_or_error (bp, Stream.count strm__) id
@@ -571,8 +587,17 @@ let next_token_fun dfa ssd find_kwd bolpos glexr =
                 try ident (store 0 c) strm__ with
                   Stream.Failure -> raise (Stream.Error "")
               in
+              let s = strm__ in
               let ep = Stream.count strm__ in
-              ("QUESTIONIDENT", get_buff len), (bp, ep)
+              let id = get_buff len in
+              let (strm__ : _ Stream.t) = s in
+              begin match Stream.peek strm__ with
+                Some ':' ->
+                  Stream.junk strm__;
+                  let eb = Stream.count strm__ in
+                  error_if_keyword (("OPTLABEL", id), (bp, ep))
+              | _ -> error_if_keyword (("QUESTIONIDENT", id), (bp, ep))
+              end
           | _ ->
               let id = get_buff (ident2 (store 0 c) strm__) in
               keyword_or_error (bp, Stream.count strm__) id
@@ -1109,9 +1134,9 @@ let using_token kwd_table ident_table (p_con, p_prm) =
               error_ident_and_keyword p_con p_prm
             else Hashtbl.add ident_table p_prm p_con
         end
-  | "TILDEIDENT" | "QUESTIONIDENT" | "INT" | "INT32" | "INT64" | "NATIVEINT" |
-    "FLOAT" | "CHAR" | "STRING" | "QUOTATION" | "ANTIQUOT" | "LOCATE" |
-    "EOI" ->
+  | "INT" | "INT32" | "INT64" | "NATIVEINT" | "FLOAT" | "CHAR" | "STRING" |
+    "TILDEIDENT" | "QUESTIONIDENT" | "LABEL" | "OPTLABEL" | "QUOTATION" |
+    "ANTIQUOT" | "LOCATE" | "EOI" ->
       ()
   | _ ->
       raise
@@ -1184,11 +1209,11 @@ let gmake () =
   let id_table = Hashtbl.create 301 in
   let glexr =
     ref
-      {tok_func = (fun _ -> raise (Match_failure ("plexer.ml", 959, 17)));
-       tok_using = (fun _ -> raise (Match_failure ("plexer.ml", 959, 37)));
-       tok_removing = (fun _ -> raise (Match_failure ("plexer.ml", 959, 60)));
-       tok_match = (fun _ -> raise (Match_failure ("plexer.ml", 960, 18)));
-       tok_text = (fun _ -> raise (Match_failure ("plexer.ml", 960, 37)));
+      {tok_func = (fun _ -> raise (Match_failure ("plexer.ml", 972, 17)));
+       tok_using = (fun _ -> raise (Match_failure ("plexer.ml", 972, 37)));
+       tok_removing = (fun _ -> raise (Match_failure ("plexer.ml", 972, 60)));
+       tok_match = (fun _ -> raise (Match_failure ("plexer.ml", 973, 18)));
+       tok_text = (fun _ -> raise (Match_failure ("plexer.ml", 973, 37)));
        tok_comm = None}
   in
   let glex =
@@ -1218,11 +1243,12 @@ let make () =
   let id_table = Hashtbl.create 301 in
   let glexr =
     ref
-      {tok_func = (fun _ -> raise (Match_failure ("plexer.ml", 988, 17)));
-       tok_using = (fun _ -> raise (Match_failure ("plexer.ml", 988, 37)));
-       tok_removing = (fun _ -> raise (Match_failure ("plexer.ml", 988, 60)));
-       tok_match = (fun _ -> raise (Match_failure ("plexer.ml", 989, 18)));
-       tok_text = (fun _ -> raise (Match_failure ("plexer.ml", 989, 37)));
+      {tok_func = (fun _ -> raise (Match_failure ("plexer.ml", 1001, 17)));
+       tok_using = (fun _ -> raise (Match_failure ("plexer.ml", 1001, 37)));
+       tok_removing =
+         (fun _ -> raise (Match_failure ("plexer.ml", 1001, 60)));
+       tok_match = (fun _ -> raise (Match_failure ("plexer.ml", 1002, 18)));
+       tok_text = (fun _ -> raise (Match_failure ("plexer.ml", 1002, 37)));
        tok_comm = None}
   in
   {func = func kwd_table glexr; using = using_token kwd_table id_table;

diff --git a/camlp4/ocaml_src/meta/Makefile b/camlp4/ocaml_src/meta/Makefile
@@ -48,8 +48,8 @@ install:
 	cp pa_macro.cmi pa_extend.cmi "$(LIBDIR)/camlp4/."
 	cp camlp4r$(EXE) "$(BINDIR)/."
 	if test -f camlp4r.opt; then \
-	  cp camlp4r.opt "$(BINDIR)/." ;\
-	  for target in $(OBJSX) $(OBJSX:.cmx=.o) ; do \
+	  cp camlp4r.opt "$(BINDIR)/camlp4r.opt$(EXE)" ;\
+	  for target in $(OBJSX) $(OBJSX:.cmx=.$(O)) ; do \
 	    if test -f $$target; then \
 	      cp $$target "$(LIBDIR)/camlp4/."; \
 	    fi; \