summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
Diffstat
-rw-r--r--emacs/caml-font.el4
-rw-r--r--otherlibs/labltk/browser/editor.ml4
-rw-r--r--otherlibs/labltk/browser/fileselect.ml6
-rw-r--r--otherlibs/labltk/browser/jg_button.ml2
-rw-r--r--otherlibs/labltk/browser/jg_completion.ml2
-rw-r--r--otherlibs/labltk/browser/jg_menu.ml4
-rw-r--r--otherlibs/labltk/browser/jg_message.ml2
-rw-r--r--otherlibs/labltk/browser/jg_multibox.ml2
-rw-r--r--otherlibs/labltk/browser/jg_text.ml4
-rw-r--r--otherlibs/labltk/browser/lexical.ml6
-rw-r--r--otherlibs/labltk/browser/searchpos.ml4
-rw-r--r--otherlibs/labltk/browser/setpath.ml2
-rw-r--r--otherlibs/labltk/browser/shell.ml6
-rw-r--r--otherlibs/labltk/browser/viewer.ml2
-rw-r--r--otherlibs/labltk/builtin/dialog.ml2
-rw-r--r--otherlibs/labltk/compiler/compile.ml6
-rw-r--r--otherlibs/labltk/compiler/tables.ml2
-rw-r--r--parsing/lexer.mll1
-rw-r--r--parsing/parser.mly31
-rw-r--r--stdlib/callback.ml2
-rw-r--r--stdlib/obj.ml2
-rw-r--r--stdlib/parsing.ml4
-rw-r--r--utils/config.mlp2
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
generated by cgit v1.2.3-70-g09d2 (git 2.46.0) at 2025-03-20 03:58:21 +0000