changed label_pattern syntax

git-svn-id: http://caml.inria.fr/svn/ocaml/trunk@2677 f963ae5c-01c2-4b8c-9fe0-0dff7051ff02

23 files changed, 57 insertions, 45 deletions

diff --git a/emacs/caml-font.el b/emacs/caml-font.el
index e10192a67..feb4c918f 100644
--- a/emacs/caml-font.el
+++ b/emacs/caml-font.el
@@ -43,9 +43,9 @@
 		 "\\|\"[^\"\\]*\\(\\\\\\(.\\|\n\\)[^\"\\]*\\)*\"")
 	 'font-lock-string-face)
 ;labels (and open)
-   '("\\([?]?\\<[A-Za-z][A-Za-z0-9_']*:\\)\\([^:=]\\|\\'\\|$\\)" 1
+   '("\\(\\<[A-Za-z][A-Za-z0-9_']*:\\)\\([^:=]\\|\\'\\|$\\)" 1
      font-lock-variable-name-face)
-   '("\\<\\(assert\\|open\\|include\\)\\>\\|[?]?\\<:[A-Za-z][A-Za-z0-9_']*\\>"
+   '("\\<\\(assert\\|open\\|include\\|:[A-Za-z][A-Za-z0-9_']*\\)\\>\\|?"
      . font-lock-variable-name-face)
 ;modules and constructors
    '("\\(\\<\\|:\\)\\([A-Z][A-Za-z0-9_']*\\)\\>"
diff --git a/otherlibs/labltk/browser/editor.ml b/otherlibs/labltk/browser/editor.ml
index 9176a7da1..f99845eb3 100644
--- a/otherlibs/labltk/browser/editor.ml
+++ b/otherlibs/labltk/browser/editor.ml
@@ -522,7 +522,7 @@ end
 
 let already_open : editor option ref = ref None
 
-let editor ?:file ?:pos[=0] () =
+let editor ?:file ?(:pos=0) () =
 
   if match !already_open with None -> false
   | Some ed ->
@@ -535,7 +535,7 @@ let editor ?:file ?:pos[=0] () =
     already_open := Some ed;
     if file <> None then ed#reopen :file :pos
 
-let f ?:file ?:pos ?:opendialog[=false] () =
+let f ?:file ?:pos ?(:opendialog=false) () =
   if opendialog then
     Fileselect.f title:"Open File"
       action:(function [file] -> editor :file () | _ -> ())
diff --git a/otherlibs/labltk/browser/fileselect.ml b/otherlibs/labltk/browser/fileselect.ml
index b72b6ce4e..cea020edb 100644
--- a/otherlibs/labltk/browser/fileselect.ml
+++ b/otherlibs/labltk/browser/fileselect.ml
@@ -74,9 +74,9 @@ let load_in_path = ref false
 
 let search_in_path :name = Misc.find_in_path !Config.load_path name
 
-let f :title action:proc ?:dir[=Unix.getcwd ()]
-    ?filter:deffilter[="*"] ?file:deffile[=""]
-    ?:multi[=false] ?:sync[=false] ?:usepath[=true] () =
+let f :title action:proc ?(:dir = Unix.getcwd ())
+    ?(filter:deffilter ="*") ?(file:deffile ="")
+    ?(:multi=false) ?(:sync=false) ?(:usepath=true) () =
 
   let current_pattern = ref ""
   and current_dir = ref dir in
diff --git a/otherlibs/labltk/browser/jg_button.ml b/otherlibs/labltk/browser/jg_button.ml
index ea963decd..da3bc1294 100644
--- a/otherlibs/labltk/browser/jg_button.ml
+++ b/otherlibs/labltk/browser/jg_button.ml
@@ -2,7 +2,7 @@
 
 open Tk
 
-let create_destroyer :parent ?:text[="Ok"] tl =
+let create_destroyer :parent ?(:text="Ok") tl =
     Button.create parent :text command:(fun () -> destroy tl)
 
 let add_destroyer ?:text tl =
diff --git a/otherlibs/labltk/browser/jg_completion.ml b/otherlibs/labltk/browser/jg_completion.ml
index 16c321bf6..7dedf0330 100644
--- a/otherlibs/labltk/browser/jg_completion.ml
+++ b/otherlibs/labltk/browser/jg_completion.ml
@@ -1,6 +1,6 @@
 (* $Id$ *)
 
-let lt_string ?:nocase[=false] s1 s2 =
+let lt_string ?(:nocase=false) s1 s2 =
   if nocase then String.lowercase s1 < String.lowercase s2 else s1 < s2
 
 class completion ?:nocase texts = object
diff --git a/otherlibs/labltk/browser/jg_menu.ml b/otherlibs/labltk/browser/jg_menu.ml
index 5bbba8c79..45cdc0c46 100644
--- a/otherlibs/labltk/browser/jg_menu.ml
+++ b/otherlibs/labltk/browser/jg_menu.ml
@@ -2,7 +2,7 @@
 
 open Tk
 
-class c :parent ?underline:n[=0] text = object (self)
+class c :parent ?(underline:n=0) text = object (self)
   val pair =
     let button =
       Menubutton.create parent :text underline:n in
@@ -19,7 +19,7 @@ class c :parent ?underline:n[=0] text = object (self)
       ?font:string ->            ?foreground:color ->
       ?image:image ->            ?state:state ->
       string -> unit
-  method add_command ?underline:n[=0] ?:accelerator ?:activebackground
+  method add_command ?(underline:n=0) ?:accelerator ?:activebackground
       ?:activeforeground ?:background ?:bitmap ?:command ?:font ?:foreground
       ?:image ?:state label =
     Menu.add_command (self#menu) :label underline:n ?:accelerator
diff --git a/otherlibs/labltk/browser/jg_message.ml b/otherlibs/labltk/browser/jg_message.ml
index bc0273016..27b8f2eec 100644
--- a/otherlibs/labltk/browser/jg_message.ml
+++ b/otherlibs/labltk/browser/jg_message.ml
@@ -28,7 +28,7 @@ class formatted :parent :width :maxheight :minheight =
 end
 *)
 
-let formatted :title ?:on ?:width[=60] ?:maxheight[=10] ?:minheight[=0] () =
+let formatted :title ?:on ?(:width=60) ?(:maxheight=10) ?(:minheight=0) () =
   let tl, frame =
     match on with
       Some frame -> coe frame, frame
diff --git a/otherlibs/labltk/browser/jg_multibox.ml b/otherlibs/labltk/browser/jg_multibox.ml
index 1858a48f8..f7c1ec2c4 100644
--- a/otherlibs/labltk/browser/jg_multibox.ml
+++ b/otherlibs/labltk/browser/jg_multibox.ml
@@ -67,7 +67,7 @@ class c :cols :texts ?:maxheight ?:width parent = object (self)
   method parent = parent'
   method boxes = boxes
   method current = current
-  method recenter?:aligntop[=false] n =
+  method recenter ?(:aligntop=false) n =
     current <-
        if n < 0 then 0 else
        if n < length then n else length - 1;
diff --git a/otherlibs/labltk/browser/jg_text.ml b/otherlibs/labltk/browser/jg_text.ml
index 8a3dd8ceb..e4e3ed56a 100644
--- a/otherlibs/labltk/browser/jg_text.ml
+++ b/otherlibs/labltk/browser/jg_text.ml
@@ -5,9 +5,9 @@ open Jg_tk
 
 let get_all tw = Text.get tw start:tstart end:(tposend 1)
 
-let tag_and_see tw :tag :start end:e =
+let tag_and_see tw :tag :start :end =
   Text.tag_remove tw start:(tpos 0) end:tend :tag;
-  Text.tag_add tw :start end:e :tag;
+  Text.tag_add tw :start :end :tag;
   try
     Text.see tw index:(`Tagfirst tag, []);
     Text.mark_set tw mark:"insert" index:(`Tagfirst tag, [])
diff --git a/otherlibs/labltk/browser/lexical.ml b/otherlibs/labltk/browser/lexical.ml
index 33a68e488..8c1209a66 100644
--- a/otherlibs/labltk/browser/lexical.ml
+++ b/otherlibs/labltk/browser/lexical.ml
@@ -20,12 +20,12 @@ let init_tags tw =
   Text.tag_configure tw tag:"error" relief:`Raised;
   Text.tag_raise tw tag:"error"
 
-let tag ?:start[=tstart] ?end:pend[=tend] tw =
+let tag ?(:start=tstart) ?(:end=tend) tw =
   let tpos c = (Text.index tw index:start, [`Char c]) in
-  let text = Text.get tw :start end:pend in
+  let text = Text.get tw :start :end in
   let buffer = Lexing.from_string text in
   List.iter tags
-    fun:(fun tag -> Text.tag_remove tw :start end:pend :tag);
+    fun:(fun tag -> Text.tag_remove tw :start :end :tag);
   try
     while true do
     let tag =
diff --git a/otherlibs/labltk/browser/searchpos.ml b/otherlibs/labltk/browser/searchpos.ml
index 49d9d76aa..211332667 100644
--- a/otherlibs/labltk/browser/searchpos.ml
+++ b/otherlibs/labltk/browser/searchpos.ml
@@ -260,7 +260,7 @@ let edit_source :file :path :sign =
 (* List of windows to destroy by Close All *)
 let top_widgets = ref []
 
-let rec view_signature ?:title ?:path ?:env[= !start_env] sign =
+let rec view_signature ?:title ?:path ?(:env = !start_env) sign =
   let env =
     match path with None -> env
     | Some path -> Env.open_signature path sign env in
@@ -398,7 +398,7 @@ and view_modtype_id li :env =
   view_signature_item :path :env
     [Tsig_modtype(ident_of_path path default:"S", td)]
 
-and view_expr_type ?:title ?:path ?:env ?:name[="noname"] t =
+and view_expr_type ?:title ?:path ?:env ?(:name="noname") t =
   let title =
     match title, path with Some title, _ -> title
     | None, Some path -> string_of_path path
diff --git a/otherlibs/labltk/browser/setpath.ml b/otherlibs/labltk/browser/setpath.ml
index f9c478b07..8094b82e0 100644
--- a/otherlibs/labltk/browser/setpath.ml
+++ b/otherlibs/labltk/browser/setpath.ml
@@ -34,7 +34,7 @@ let renew_path box =
   Listbox.insert box index:`End texts:!Config.load_path;
   Jg_box.recenter box index:(`Num 0)
 
-let add_to_path :dirs ?:base[=""] box =
+let add_to_path :dirs ?(:base="") box =
   let dirs =
     if base = "" then dirs else
     if dirs = [] then [base] else
diff --git a/otherlibs/labltk/browser/shell.ml b/otherlibs/labltk/browser/shell.ml
index caf0ea476..98e33bbc4 100644
--- a/otherlibs/labltk/browser/shell.ml
+++ b/otherlibs/labltk/browser/shell.ml
@@ -78,9 +78,9 @@ object (self)
       end;
       self#insert (if dir = `previous then h#previous else h#next)
     end
-  method private lex ?:start[=`Mark"insert",[`Linestart]]
-      ?end:endx[=`Mark"insert",[`Lineend]] () =
-    Lexical.tag textw :start end:endx
+  method private lex ?(:start = `Mark"insert",[`Linestart])
+      ?(:end = `Mark"insert",[`Lineend]) () =
+    Lexical.tag textw :start :end
   method insert text =
     let idx = Text.index textw
         index:(`Mark"insert",[`Char(-1);`Linestart]) in
diff --git a/otherlibs/labltk/browser/viewer.ml b/otherlibs/labltk/browser/viewer.ml
index 9a20a4996..875780afa 100644
--- a/otherlibs/labltk/browser/viewer.ml
+++ b/otherlibs/labltk/browser/viewer.ml
@@ -245,7 +245,7 @@ let start_shell () =
   pack [ok;cancel] side:`Left fill:`X expand:true;
   pack [input;buttons] side:`Top fill:`X expand:true
 
-let f ?:dir[=Unix.getcwd()] ?:on () =
+let f ?(:dir=Unix.getcwd()) ?:on () =
   let tl = match on with
     None ->
       let tl = Jg_toplevel.titled "Module viewer" in
diff --git a/otherlibs/labltk/builtin/dialog.ml b/otherlibs/labltk/builtin/dialog.ml
index b2484e541..257661b5e 100644
--- a/otherlibs/labltk/builtin/dialog.ml
+++ b/otherlibs/labltk/builtin/dialog.ml
@@ -1,5 +1,5 @@
 let create :parent :title :message :buttons ?:name
-    ?:bitmap[=`Predefined ""] ?:default[= -1] () =
+    ?(:bitmap = `Predefined "") ?(:default = -1) () =
   let w = Widget.new_atom "toplevel" ?:name :parent in
   let res = tkEval [|TkToken"tk_dialog";
                      cCAMLtoTKwidget w;
diff --git a/otherlibs/labltk/compiler/compile.ml b/otherlibs/labltk/compiler/compile.ml
index bbf2c4e89..a7f46168d 100644
--- a/otherlibs/labltk/compiler/compile.ml
+++ b/otherlibs/labltk/compiler/compile.ml
@@ -66,7 +66,7 @@ let rec types_of_template = function
  * Pretty print a type
  *  used to write ML type definitions
  *)
-let ppMLtype ?:any[=false] ?:return[=false] ?:def[=false] ?:counter[=ref 0] =
+let ppMLtype ?(:any=false) ?(:return=false) ?(:def=false) ?(:counter=ref 0) =
   let rec ppMLtype =
   function
     Unit -> "unit"
@@ -492,7 +492,7 @@ let rec converterCAMLtoTK :context_widget argname as:ty =
  *
  *)
  
-let code_of_template :context_widget ?func:funtemplate[=false] template =
+let code_of_template :context_widget ?(func:funtemplate=false) template =
   let catch_opts = ref ("","") in (* class name and first option *)
   let variables = ref [] in
   let variables2 = ref [] in
@@ -591,7 +591,7 @@ let write_clause :w :context_widget comp =
 
 
 (* The full converter *)         
-let write_CAMLtoTK :w def:typdef ?safetype:st[=true] name =
+let write_CAMLtoTK :w def:typdef ?(safetype:st = true) name =
   let write_one name constrs =
     w ("let cCAMLtoTK"^name);
     let context_widget = 
diff --git a/otherlibs/labltk/compiler/tables.ml b/otherlibs/labltk/compiler/tables.ml
index efa0b9ac5..b93181048 100644
--- a/otherlibs/labltk/compiler/tables.ml
+++ b/otherlibs/labltk/compiler/tables.ml
@@ -283,7 +283,7 @@ let rec find_constructor cname = function
            else find_constructor cname l
 
 (* Enter a type, must not be previously defined *)
-let enter_type typname ?:variant[=false] arity constructors =
+let enter_type typname ?(:variant = false) arity constructors =
   try
       Hashtbl.find types_table key:typname;
       raise (Duplicate_Definition ("type", typname))
diff --git a/parsing/lexer.mll b/parsing/lexer.mll
index e545525b9..1b3da6d39 100644
--- a/parsing/lexer.mll
+++ b/parsing/lexer.mll
@@ -272,7 +272,6 @@ rule token = parse
   | "="  { EQUAL }
   | "["  { LBRACKET }
   | "[|" { LBRACKETBAR }
-  | "[=" { LBRACKETEQUAL }
   | "[<" { LBRACKETLESS }
   | "]"  { RBRACKET }
   | "{"  { LBRACE }
diff --git a/parsing/parser.mly b/parsing/parser.mly
index 8e999c76e..afb9c4139 100644
--- a/parsing/parser.mly
+++ b/parsing/parser.mly
@@ -212,7 +212,6 @@ let unclosed opening_name opening_num closing_name closing_num =
 %token LBRACELESS
 %token LBRACKET
 %token LBRACKETBAR
-%token LBRACKETEQUAL
 %token LBRACKETLESS
 %token LESS
 %token LESSMINUS
@@ -665,16 +664,34 @@ seq_expr:
   | expr SEMI seq_expr            { mkexp(Pexp_sequence($1, $3)) }
 ;
 labeled_simple_pattern:
-    QUESTION label_pattern LBRACKETEQUAL seq_expr RBRACKET
-      { ("?" ^ fst $2, Some $4, snd $2) }
-  | QUESTION label_pattern
+    QUESTION LPAREN label_let_pattern opt_default RPAREN
+      { ("?" ^ fst $3, $4, snd $3) }
+  | QUESTION label_simple_pattern
       { ("?" ^ fst $2, None, snd $2) }
-  | label_pattern
+  | LPAREN label_let_pattern RPAREN
+      { if !Clflags.classic then syntax_error () else (fst $2, None, snd $2) }
+  | label_simple_pattern
       { (fst $1, None, snd $1) }
   | simple_pattern
       { ("", None, $1) }
 ;
+opt_default:
+    /* empty */                         { None }
+  | EQUAL seq_expr                      { Some $2 }
+;
+label_let_pattern:
+    label_pattern
+      { $1 }
+  | label_pattern COLON core_type
+      { let (lab, pat) = $1 in (lab, mkpat(Ppat_constraint(pat, $3))) }
+;
 label_pattern:
+    LABEL pattern
+      { ($1, $2) }
+  | LABELID
+      { ($1, mkpat(Ppat_var $1)) }
+;
+label_simple_pattern:
     LABEL simple_pattern
       { ($1, $2) }
   | LABELID
@@ -1028,12 +1045,8 @@ simple_pattern:
       { unclosed "(" 1 ")" 3 }
   | LPAREN pattern COLON core_type RPAREN
       { mkpat(Ppat_constraint($2, $4)) }
-  | LPAREN LABEL core_type RPAREN
-      { mkpat(Ppat_constraint(mkpat(Ppat_var $2), $3)) }
   | LPAREN pattern COLON core_type error
       { unclosed "(" 1 ")" 5 }
-  | LPAREN LABEL core_type error
-      { unclosed "(" 1 ")" 4 }
 ;
 
 pattern_comma_list:
diff --git a/stdlib/callback.ml b/stdlib/callback.ml
index 5e19cdbdc..91e396553 100644
--- a/stdlib/callback.ml
+++ b/stdlib/callback.ml
@@ -19,5 +19,5 @@ external register_named_value: string -> Obj.t -> unit = "register_named_value"
 let register name v =
   register_named_value name (Obj.repr v)
 
-let register_exception name (exn: exn) =
+let register_exception name (exn : exn) =
   register_named_value name (Obj.field (Obj.repr exn) 0)
diff --git a/stdlib/obj.ml b/stdlib/obj.ml
index 0d72f4033..f2a5858f0 100644
--- a/stdlib/obj.ml
+++ b/stdlib/obj.ml
@@ -28,7 +28,7 @@ external new_block : int -> int -> t = "obj_block"
 external dup : t -> t = "obj_dup"
 external truncate : t -> int -> unit = "obj_truncate"
 
-let marshal (obj: t) =
+let marshal (obj : t) =
   Marshal.to_string obj []
 let unmarshal str pos =
   (Marshal.from_string str pos, pos + Marshal.total_size str pos)
diff --git a/stdlib/parsing.ml b/stdlib/parsing.ml
index 96eaa5da3..87270e846 100644
--- a/stdlib/parsing.ml
+++ b/stdlib/parsing.ml
@@ -114,7 +114,7 @@ let clear_parser() =
   Array.fill env.v_stack 0 env.stacksize (Obj.repr ());
   env.lval <- Obj.repr ()
 
-let current_lookahead_fun = ref (fun (x: Obj.t) -> false)
+let current_lookahead_fun = ref (fun (x : Obj.t) -> false)
 
 let yyparse tables start lexer lexbuf =
   let rec loop cmd arg =
@@ -187,4 +187,4 @@ let rhs_end n =
 let is_current_lookahead tok =
   (!current_lookahead_fun)(Obj.repr tok)
 
-let parse_error (msg: string) = ()
+let parse_error (msg : string) = ()
diff --git a/utils/config.mlp b/utils/config.mlp
index 51170649f..a0f574f0a 100644
--- a/utils/config.mlp
+++ b/utils/config.mlp
@@ -12,7 +12,7 @@
 
 (* $Id$ *)
 
-let version = "2.99 (99/12/07)"
+let version = "2.99 (99/12/08)"
 
 let standard_library =
   try