diff options
75 files changed, 703 insertions, 696 deletions
diff --git a/otherlibs/bigarray/bigarray.mli b/otherlibs/bigarray/bigarray.mli index c30fc52f9..4c33f31c2 100644 --- a/otherlibs/bigarray/bigarray.mli +++ b/otherlibs/bigarray/bigarray.mli @@ -263,7 +263,7 @@ module Genarray: sig a valid sub-array of [a], that is, if [ofs] < 1, or [len] < 0, or [ofs + len > Genarray.nth_dim a (Genarray.num_dims a - 1)]. *) external slice_left: - ('a, 'b, c_layout) t -> pos:int array -> ('a, 'b, c_layout) t + ('a, 'b, c_layout) t -> int array -> ('a, 'b, c_layout) t = "bigarray_slice" (* Extract a sub-array of lower dimension from the given big array by fixing one or several of the first (left-most) coordinates. @@ -280,7 +280,7 @@ module Genarray: sig Raise [Invalid_arg] if [M >= N], or if [[|i1; ... ; iM|]] is outside the bounds of [a]. *) external slice_right: - ('a, 'b, fortran_layout) t -> pos:int array -> ('a, 'b, fortran_layout) t + ('a, 'b, fortran_layout) t -> int array -> ('a, 'b, fortran_layout) t = "bigarray_slice" (* Extract a sub-array of lower dimension from the given big array by fixing one or several of the last (right-most) coordinates. diff --git a/otherlibs/db/db.mli b/otherlibs/db/db.mli index 520f5db8f..c22e337e9 100644 --- a/otherlibs/db/db.mli +++ b/otherlibs/db/db.mli @@ -56,18 +56,18 @@ external dbopen : external close : t -> unit = "caml_db_close" -external del : t -> key:key -> mode:routine_flag list -> unit +external del : t -> key -> mode:routine_flag list -> unit = "caml_db_del" (* raise Not_found if the key was not in the file *) -external get : t -> key:key -> mode:routine_flag list -> data +external get : t -> key -> mode:routine_flag list -> data = "caml_db_get" (* raise Not_found if the key was not in the file *) -external put : t -> key:key -> data:data -> mode:routine_flag list -> unit +external put : t -> key -> data:data -> mode:routine_flag list -> unit = "caml_db_put" -external seq : t -> key:key -> mode:routine_flag list -> (key * data) +external seq : t -> key -> mode:routine_flag list -> (key * data) = "caml_db_seq" external sync : t -> unit @@ -75,7 +75,7 @@ external sync : t -> unit val add : t -> key:key -> data:data -> unit -val find : t -> key:key -> data -val find_all : t -> key:key -> data list -val remove : t -> key:key -> unit +val find : t -> key -> data +val find_all : t -> key -> data list +val remove : t -> key -> unit val iter : fun:(key:string -> data:string -> unit) -> t -> unit diff --git a/otherlibs/dbm/dbm.mli b/otherlibs/dbm/dbm.mli index 32ff149c7..accde917f 100644 --- a/otherlibs/dbm/dbm.mli +++ b/otherlibs/dbm/dbm.mli @@ -35,7 +35,7 @@ val opendbm : string -> mode:open_flag list -> perm:int -> t files, if the database is created. *) external close : t -> unit = "caml_dbm_close" (* Close the given descriptor. *) -external find : t -> key:string -> string = "caml_dbm_fetch" +external find : t -> string -> string = "caml_dbm_fetch" (* [find db key] returns the data associated with the given [key] in the database opened for the descriptor [db]. Raise [Not_found] if the [key] has no associated data. *) @@ -48,7 +48,7 @@ external replace : t -> key:string -> data:string -> unit = "caml_dbm_replace" the database [db]. If the database already contains data associated with [key], that data is discarded and silently replaced by the new [data]. *) -external remove : t -> key:string -> unit = "caml_dbm_delete" +external remove : t -> string -> unit = "caml_dbm_delete" (* [remove db key data] removes the data associated with [key] in [db]. If [key] has no associated data, raise [Dbm_error "dbm_delete"]. *) @@ -58,7 +58,7 @@ external nextkey : t -> string = "caml_dbm_nextkey" [firstkey db] returns the first key, and repeated calls to [nextkey db] return the remaining keys. [Not_found] is raised when all keys have been enumerated. *) -val iter : fun:(key:string -> data:string -> 'a) -> t -> unit +val iter : f:(key:string -> data:string -> 'a) -> t -> unit (* [iter f db] applies [f] to each ([key], [data]) pair in the database [db]. [f] receives [key] as first argument and [data] as second argument. *) diff --git a/otherlibs/labltk/Widgets.src b/otherlibs/labltk/Widgets.src index da3c2054b..7cbb200a5 100644 --- a/otherlibs/labltk/Widgets.src +++ b/otherlibs/labltk/Widgets.src @@ -827,13 +827,13 @@ widget listbox { function (int,int,int,int) bbox [widget(listbox); "bbox"; index: Index(listbox)] function () configure [widget(listbox); "configure"; option(listbox) list] function (string) configure_get [widget(listbox); "configure"] - function (Index(listbox) as "[>`Num int]" list) curselection [widget(listbox); "curselection"] + function (Index(listbox) as "[>`Num of int]" list) curselection [widget(listbox); "curselection"] function () delete [widget(listbox); "delete"; first: Index(listbox); last: Index(listbox)] function (string) get [widget(listbox); "get"; index: Index(listbox)] function (string list) get_range [widget(listbox); "get"; first: Index(listbox); last: Index(listbox)] - function (Index(listbox) as "[>`Num int]") index [widget(listbox); "index"; index: Index(listbox)] + function (Index(listbox) as "[>`Num of int]") index [widget(listbox); "index"; index: Index(listbox)] function () insert [widget(listbox); "insert"; index: Index(listbox); texts: string list] - function (Index(listbox) as "[>`Num int]") nearest [widget(listbox); "nearest"; y: int] + function (Index(listbox) as "[>`Num of int]") nearest [widget(listbox); "nearest"; y: int] function () scan_mark [widget(listbox); "scan"; "mark"; x: int; y: int] function () scan_dragto [widget(listbox); "scan"; "dragto"; x: int; y: int] function () see [widget(listbox); "see"; index: Index(listbox)] @@ -1552,7 +1552,7 @@ widget text { function (string) image_create [widget(text); "image"; "create"; option(embeddedi) list] function (string list) image_names [widget(text); "image"; "names"] - function (Index(text) as "[>`Linechar int * int]") index [widget(text); "index"; index: TextIndex] + function (Index(text) as "[>`Linechar of int * int]") index [widget(text); "index"; index: TextIndex] function () insert [widget(text); "insert"; index: TextIndex; text: string; ?tags: [TextTag list]] # Mark function () mark_gravity_set [widget(text); "mark"; "gravity"; mark: TextMark; direction: MarkDirection] @@ -1563,7 +1563,7 @@ widget text { # Scan function () scan_mark [widget(text); "scan"; "mark"; x: int; y: int] function () scan_dragto [widget(text); "scan"; "dragto"; x: int; y: int] - function (Index(text) as "[>`Linechar int * int]") search [widget(text); "search"; switches: TextSearch list; "--"; pattern: string; start: TextIndex; ?stop: [TextIndex]] + function (Index(text) as "[>`Linechar of int * int]") search [widget(text); "search"; switches: TextSearch list; "--"; pattern: string; start: TextIndex; ?stop: [TextIndex]] function () see [widget(text); "see"; index: TextIndex] # Tags function () tag_add [widget(text); "tag"; "add"; tag: TextTag; start: TextIndex; end: TextIndex] @@ -1577,11 +1577,11 @@ widget text { function (TextTag list) tag_names [widget(text); "tag"; "names"; ?index: [TextIndex]] # function (TextTag list) tag_allnames [widget(text); "tag"; "names"] # function (TextTag list) tag_indexnames [widget(text); "tag"; "names"; index: TextIndex] - function (Index(text) as "[>`Linechar int * int]", Index(text) as "[>`Linechar int * int]") tag_nextrange [widget(text); "tag"; "nextrange"; tag: TextTag; start: TextIndex; ?end: [TextIndex]] + function (Index(text) as "[>`Linechar of int * int]", Index(text) as "[>`Linechar of int * int]") tag_nextrange [widget(text); "tag"; "nextrange"; tag: TextTag; start: TextIndex; ?end: [TextIndex]] function () tag_raise [widget(text); "tag"; "raise"; tag: TextTag; ?above: [TextTag]] # function () tag_raise_above [widget(text); "tag"; "raise"; tag: TextTag; above: TextTag] # function () tag_raise_top [widget(text); "tag"; "raise"; tag: TextTag ] - function (Index(text) as "[>`Linechar int * int]" list) tag_ranges [widget(text); "tag"; "ranges"; tag: TextTag] + function (Index(text) as "[>`Linechar of int * int]" list) tag_ranges [widget(text); "tag"; "ranges"; tag: TextTag] function () tag_remove [widget(text); "tag"; "remove"; tag: TextTag; start: TextIndex; end: TextIndex] function () tag_remove_char [widget(text); "tag"; "remove"; tag: TextTag; at: TextIndex] function () window_configure [widget(text); "window"; "configure"; tag: TextTag; option(embeddedw) list] diff --git a/otherlibs/labltk/browser/editor.ml b/otherlibs/labltk/browser/editor.ml index a4f194223..6725f5dab 100644 --- a/otherlibs/labltk/browser/editor.ml +++ b/otherlibs/labltk/browser/editor.ml @@ -28,14 +28,14 @@ let compiler_preferences () = let mk_chkbutton :text :ref :invert = let variable = Textvariable.create on:tl () in if (if invert then not !ref else !ref) then - Textvariable.set variable to:"1"; + Textvariable.set variable "1"; Checkbutton.create tl :text :variable, (fun () -> ref := Textvariable.get variable = (if invert then "0" else "1")) in let chkbuttons, setflags = List.split (List.map - fun:(fun (text, ref, invert) -> mk_chkbutton :text :ref :invert) + f:(fun (text, ref, invert) -> mk_chkbutton :text :ref :invert) [ "No pervasives", Clflags.nopervasives, false; "No warnings", Typecheck.nowarnings, false; "Modern", Clflags.classic, true; @@ -45,7 +45,7 @@ let compiler_preferences () = let buttons = Frame.create tl in let ok = Button.create buttons text:"Ok" padx:20 command: begin fun () -> - List.iter fun:(fun f -> f ()) setflags; + List.iter f:(fun f -> f ()) setflags; destroy tl end and cancel = Jg_button.create_destroyer tl parent:buttons text:"Cancel" @@ -54,9 +54,9 @@ let compiler_preferences () = pack [ok;cancel] side:`Left fill:`X expand:true; pack [buttons] side:`Bottom fill:`X -let rec exclude key:txt = function +let rec exclude txt = function [] -> [] - | x :: l -> if txt.number = x.number then l else x :: exclude key:txt l + | x :: l -> if txt.number = x.number then l else x :: exclude txt l let goto_line tw = let tl = Jg_toplevel.titled "Go to" in @@ -85,7 +85,7 @@ let goto_line tw = and cancel = Jg_button.create_destroyer tl parent:buttons text:"Cancel" in Focus.set il; - List.iter [il; ic] fun: + List.iter [il; ic] f: begin fun w -> Jg_bind.enter_focus w; Jg_bind.return_invoke w button:ok @@ -111,12 +111,12 @@ let select_shell txt = begin fun () -> try let name = Listbox.get box index:`Active in - txt.shell <- Some (name, List.assoc key:name shells); + txt.shell <- Some (name, List.assoc name shells); destroy tl with Not_found -> txt.shell <- None; destroy tl end in - Listbox.insert box index:`End texts:(List.map fun:fst shells); + Listbox.insert box index:`End texts:(List.map f:fst shells); Listbox.configure box height:(List.length shells); bind box events:[`KeyPressDetail"Return"] breakable:true action:(fun _ -> Button.invoke ok; break ()); @@ -166,7 +166,7 @@ let send_phrase txt = then begin after := true; let anon, real = - List.partition !block_start pred:(fun x -> x = -1) in + List.partition !block_start f:(fun x -> x = -1) in block_start := anon; if real <> [] then start := List.hd real; end; @@ -264,7 +264,7 @@ let indent_line = let width_previous = string_width previous in if width_previous <= width then 2 else width_previous - width in - Text.insert tw index:(ins,[]) text:(String.make len:indent ' ') + Text.insert tw index:(ins,[]) text:(String.make indent ' ') (* The editor class *) @@ -289,7 +289,7 @@ class editor :top :menus = object (self) List.iter (Sort.list windows order: (fun w1 w2 -> Filename.basename w1.name < Filename.basename w2.name)) - fun: + f: begin fun txt -> Menu.add_radiobutton window_menu#menu label:(Filename.basename txt.name) @@ -300,12 +300,12 @@ class editor :top :menus = object (self) method set_edit txt = if windows <> [] then Pack.forget [(List.hd windows).frame]; - windows <- txt :: exclude key:txt windows; + windows <- txt :: exclude txt windows; self#reset_window_menu; current_tw <- txt.tw; Checkbutton.configure label text:(Filename.basename txt.name) variable:txt.modified; - Textvariable.set vwindow to:txt.number; + Textvariable.set vwindow txt.number; Text.yview txt.tw scroll:(`Page 0); pack [txt.frame] fill:`Both expand:true side:`Bottom @@ -327,13 +327,13 @@ class editor :top :menus = object (self) action:(fun ev -> if ev.ev_Char <> "" & (ev.ev_Char.[0] >= ' ' or - List.mem item:ev.ev_Char.[0] - (List.map fun:control ['d'; 'h'; 'i'; 'k'; 'o'; 't'; 'w'; 'y'])) - then Textvariable.set txt.modified to:"modified"); + List.mem ev.ev_Char.[0] + (List.map f:control ['d'; 'h'; 'i'; 'k'; 'o'; 't'; 'w'; 'y'])) + then Textvariable.set txt.modified "modified"); bind tw events:[`KeyPressDetail"Tab"] breakable:true action:(fun _ -> indent_line tw; - Textvariable.set txt.modified to:"modified"; + Textvariable.set txt.modified "modified"; break ()); bind tw events:[`Modified([`Control],`KeyPressDetail"k")] action:(fun _ -> @@ -352,7 +352,7 @@ class editor :top :menus = object (self) bind tw events:[`Motion] action:(fun _ -> Focus.set tw); bind tw events:[`ButtonPressDetail 2] action:(fun _ -> - Textvariable.set txt.modified to:"modified"; + Textvariable.set txt.modified "modified"; Lexical.tag txt.tw start:(`Mark"insert", [`Linestart]) end:(`Mark"insert", [`Lineend])); bind tw events:[`Modified([`Double], `ButtonPressDetail 1)] @@ -370,7 +370,7 @@ class editor :top :menus = object (self) method clear_errors () = Text.tag_remove current_tw tag:"error" start:tstart end:tend; List.iter error_messages - fun:(fun tl -> try destroy tl with Protocol.TkError _ -> ()); + f:(fun tl -> try destroy tl with Protocol.TkError _ -> ()); error_messages <- [] method typecheck () = @@ -397,7 +397,7 @@ class editor :top :menus = object (self) end; let file = open_out name in let text = Text.get txt.tw start:tstart end:(tposend 1) in - output_string text to:file; + output_string file text; close_out file; Checkbutton.configure label text:(Filename.basename name); Checkbutton.deselect label; @@ -411,7 +411,7 @@ class editor :top :menus = object (self) try let index = try - self#set_edit (List.find windows pred:(fun x -> x.name = name)); + self#set_edit (List.find windows f:(fun x -> x.name = name)); let txt = List.hd windows in if Textvariable.get txt.modified = "modified" then begin match Jg_message.ask master:top title:"Open" @@ -428,7 +428,7 @@ class editor :top :menus = object (self) let file = open_in name and tw = current_tw and len = ref 0 - and buf = String.create len:4096 in + and buf = String.create 4096 in Text.delete tw start:tstart end:tend; while len := input file :buf pos:0 len:4096; @@ -439,8 +439,8 @@ class editor :top :menus = object (self) close_in file; Text.mark_set tw mark:"insert" :index; Text.see tw :index; - if Filename.check_suffix name suff:".ml" or - Filename.check_suffix name suff:".mli" + if Filename.check_suffix name ".ml" or + Filename.check_suffix name ".mli" then begin if !lex_on_load then self#lex (); if !type_on_load then self#typecheck () @@ -457,7 +457,7 @@ class editor :top :menus = object (self) | `no -> () | `cancel -> raise Exit end; - windows <- exclude key:txt windows; + windows <- exclude txt windows; if windows = [] then self#new_window (current_dir ^ "/untitled") else self#set_edit (List.hd windows); @@ -474,7 +474,7 @@ class editor :top :menus = object (self) method quit () = try - List.iter windows fun: + List.iter windows f: begin fun txt -> if Textvariable.get txt.modified = "modified" then match Jg_message.ask master:top title:"Quit" @@ -508,7 +508,7 @@ class editor :top :menus = object (self) [`Alt], "x", (fun () -> send_phrase (List.hd windows)); [`Alt], "l", self#lex; [`Alt], "t", self#typecheck ] - fun:begin fun (modi,key,act) -> + f:begin fun (modi,key,act) -> bind top events:[`Modified(modi, `KeyPressDetail key)] breakable:true action:(fun _ -> act (); break ()) end; @@ -585,7 +585,7 @@ class editor :top :menus = object (self) command:Viewer.close_all_views; (* pack everything *) - pack (List.map fun:(fun m -> coe m#button) + pack (List.map f:(fun m -> coe m#button) [file_menu; edit_menu; compiler_menu; module_menu; window_menu] @ [coe label]) side:`Left ipadx:5 anchor:`W; diff --git a/otherlibs/labltk/browser/fileselect.ml b/otherlibs/labltk/browser/fileselect.ml index 33bc84979..2553591a0 100644 --- a/otherlibs/labltk/browser/fileselect.ml +++ b/otherlibs/labltk/browser/fileselect.ml @@ -23,23 +23,23 @@ open Tk (**** Memoized rexgexp *) -let (~) = Jg_memo.fast fun:Str.regexp +let (~) = Jg_memo.fast f:Str.regexp (************************************************************ Path name *) let parse_filter src = (* replace // by / *) - let s = global_replace pat:~"/+" with:"/" src in + let s = global_replace pat:~"/+" templ:"/" src in (* replace /./ by / *) - let s = global_replace pat:~"/\./" with:"/" s in + let s = global_replace pat:~"/\./" templ:"/" s in (* replace hoge/../ by "" *) let s = global_replace s - pat:~"\([^/]\|[^\./][^/]\|[^/][^\./]\|[^/][^/]+\)/\.\./" with:"" in + pat:~"\([^/]\|[^\./][^/]\|[^/][^\./]\|[^/][^/]+\)/\.\./" templ:"" in (* replace hoge/..$ by *) let s = global_replace s - pat:~"\([^/]\|[^\./][^/]\|[^/][^\./]\|[^/][^/]+\)/\.\.$" with:"" in + pat:~"\([^/]\|[^\./][^/]\|[^/][^\./]\|[^/][^/]+\)/\.\.$" templ:"" in (* replace ^/../../ by / *) - let s = global_replace pat:~"^\(/\.\.\)+/" with:"/" s in + let s = global_replace pat:~"^\(/\.\.\)+/" templ:"/" s in if string_match s pat:~"^\([^\*?[]*/\)\(.*\)" pos:0 then let dirs = matched_group 1 s and ptrn = matched_group 2 s @@ -47,19 +47,19 @@ let parse_filter src = dirs, ptrn else "", s -let rec fixpoint fun:f v = +let rec fixpoint :f v = let v' = f v in - if v = v' then v else fixpoint fun:f v' + if v = v' then v else fixpoint :f v' let unix_regexp s = - let s = Str.global_replace pat:~"[$^.+]" with:"\\\\\\0" s in - let s = Str.global_replace pat:~"\\*" with:".*" s in - let s = Str.global_replace pat:~"\\?" with:".?" s in + let s = Str.global_replace pat:~"[$^.+]" templ:"\\\\\\0" s in + let s = Str.global_replace pat:~"\\*" templ:".*" s in + let s = Str.global_replace pat:~"\\?" templ:".?" s in let s = fixpoint s - fun:(Str.replace_first pat:~"\\({.*\\),\\(.*}\\)" with:"\\1\\|\\2") in + f:(Str.replace_first pat:~"\\({.*\\),\\(.*}\\)" templ:"\\1\\|\\2") in let s = - Str.global_replace pat:~"{\\(.*\\)}" with:"\\(\\1\\)" s in + Str.global_replace pat:~"{\\(.*\\)}" templ:"\\(\\1\\)" s in Str.regexp s let exact_match s :pat = @@ -68,7 +68,7 @@ let exact_match s :pat = let ls :dir :pattern = let files = get_files_in_directory dir in let regexp = unix_regexp pattern in - List.filter files pred:(exact_match pat:regexp) + List.filter files f:(exact_match pat:regexp) (* let ls :dir :pattern = @@ -94,7 +94,7 @@ let f :title action:proc ?(:dir = Unix.getcwd ()) let filter_var = new_var () and selection_var = new_var () and sync_var = new_var () in - Textvariable.set filter_var to:deffilter; + Textvariable.set filter_var deffilter; let frm = Frame.create tl borderwidth:1 relief:`Raised in let df = Frame.create frm in @@ -125,19 +125,19 @@ let f :title action:proc ?(:dir = Unix.getcwd ()) (get_files_in_directory dir) in let matched_files = (* get matched file by subshell call. *) if !load_in_path & usepath then - List.fold_left !Config.load_path acc:[] fun: - begin fun :acc dir -> + List.fold_left !Config.load_path init:[] f: + begin fun acc dir -> let files = ls :dir :pattern in Sort.merge order:(<) files - (List.fold_left files :acc - fun:(fun :acc name -> List2.exclude item:name acc)) + (List.fold_left files init:acc + f:(fun acc name -> List2.exclude name acc)) end else - List.fold_left directories acc:(ls :dir :pattern) - fun:(fun :acc dir -> List2.exclude item:dir acc) + List.fold_left directories init:(ls :dir :pattern) + f:(fun acc dir -> List2.exclude dir acc) in - Textvariable.set filter_var to:filter; - Textvariable.set selection_var to:(dir ^ deffile); + Textvariable.set filter_var filter; + Textvariable.set selection_var (dir ^ deffile); Listbox.delete filter_listbox first:(`Num 0) last:`End; Listbox.insert filter_listbox index:`End texts:matched_files; Jg_box.recenter filter_listbox index:(`Num 0); @@ -158,13 +158,13 @@ let f :title action:proc ?(:dir = Unix.getcwd ()) destroy tl; let l = if !load_in_path & usepath then - List.fold_right l acc:[] fun: - begin fun name :acc -> + List.fold_right l init:[] f: + begin fun name acc -> if name <> "" & name.[0] = '/' then name :: acc else try search_in_path :name :: acc with Not_found -> acc end else - List.map l fun: + List.map l f: begin fun x -> if x <> "" & x.[0] = '/' then x else !current_dir ^ "/" ^ x @@ -173,7 +173,7 @@ let f :title action:proc ?(:dir = Unix.getcwd ()) if sync then begin selected_files := l; - Textvariable.set sync_var to:"1" + Textvariable.set sync_var "1" end else proc l in @@ -207,7 +207,7 @@ let f :title action:proc ?(:dir = Unix.getcwd ()) and okb = Button.create cfrm text:"Ok" command: begin fun () -> let files = - List.map (Listbox.curselection filter_listbox) fun: + List.map (Listbox.curselection filter_listbox) f: begin fun x -> !current_dir ^ Listbox.get filter_listbox index:x end @@ -231,9 +231,9 @@ let f :title action:proc ?(:dir = Unix.getcwd ()) let name = Listbox.get filter_listbox index:(Listbox.nearest filter_listbox y:ev.ev_MouseY) in if !load_in_path & usepath then - try Textvariable.set selection_var to:(search_in_path :name) + try Textvariable.set selection_var (search_in_path :name) with Not_found -> () - else Textvariable.set selection_var to:(!current_dir ^ "/" ^ name)); + else Textvariable.set selection_var (!current_dir ^ "/" ^ name)); Jg_box.add_completion directory_listbox action: begin fun index -> diff --git a/otherlibs/labltk/browser/jg_completion.ml b/otherlibs/labltk/browser/jg_completion.ml index f6c76021f..130c56919 100644 --- a/otherlibs/labltk/browser/jg_completion.ml +++ b/otherlibs/labltk/browser/jg_completion.ml @@ -24,13 +24,13 @@ class completion ?:nocase texts = object method add c = prefix <- prefix ^ c; while current < List.length texts - 1 & - lt_string (List.nth texts pos:current) prefix ?:nocase + lt_string (List.nth texts current) prefix ?:nocase do current <- current + 1 done; current method current = current - method get_current = List.nth texts pos:current + method get_current = List.nth texts current method reset = prefix <- ""; current <- 0 diff --git a/otherlibs/labltk/browser/jg_config.ml b/otherlibs/labltk/browser/jg_config.ml index 49500e2fc..610f850f8 100644 --- a/otherlibs/labltk/browser/jg_config.ml +++ b/otherlibs/labltk/browser/jg_config.ml @@ -26,7 +26,7 @@ let init () = if font = "" then variable else font in List.iter ["Button"; "Label"; "Menu"; "Menubutton"; "Radiobutton"] - fun:(fun cl -> Option.add path:("*" ^ cl ^ ".font") font); + f:(fun cl -> Option.add path:("*" ^ cl ^ ".font") font); Option.add path:"*Menu.tearOff" "0" priority:`StartupFile; Option.add path:"*Button.padY" "0" priority:`StartupFile; Option.add path:"*Text.highlightThickness" "0" priority:`StartupFile; diff --git a/otherlibs/labltk/browser/jg_memo.ml b/otherlibs/labltk/browser/jg_memo.ml index 89940d2f1..f6f6e773b 100644 --- a/otherlibs/labltk/browser/jg_memo.ml +++ b/otherlibs/labltk/browser/jg_memo.ml @@ -17,15 +17,15 @@ type ('a, 'b) assoc_list = Nil | Cons of 'a * 'b * ('a, 'b) assoc_list -let rec assq :key = function +let rec assq key = function Nil -> raise Not_found | Cons (a, b, l) -> - if key == a then b else assq :key l + if key == a then b else assq key l -let fast fun:f = +let fast :f = let memo = ref Nil in fun key -> - try assq :key !memo + try assq key !memo with Not_found -> let data = f key in memo := Cons(key, data, !memo); diff --git a/otherlibs/labltk/browser/jg_memo.mli b/otherlibs/labltk/browser/jg_memo.mli index 675120e7e..708d95d98 100644 --- a/otherlibs/labltk/browser/jg_memo.mli +++ b/otherlibs/labltk/browser/jg_memo.mli @@ -13,6 +13,6 @@ (* $Id$ *) -val fast : fun:('a -> 'b) -> 'a -> 'b +val fast : f:('a -> 'b) -> 'a -> 'b (* "fast" memoizer: uses a List.assq like function *) (* Good for a smallish number of keys, phisically equal *) diff --git a/otherlibs/labltk/browser/jg_message.ml b/otherlibs/labltk/browser/jg_message.ml index 7238126d7..f36cda643 100644 --- a/otherlibs/labltk/browser/jg_message.ml +++ b/otherlibs/labltk/browser/jg_message.ml @@ -87,7 +87,7 @@ let ask :title ?:master text = and cancel = Jg_button.create_destroyer tl parent:fw text:"Cancel" in bind tl events:[`Destroy] extend:true - action:(fun _ -> Textvariable.set sync to:"1"); + action:(fun _ -> Textvariable.set sync "1"); pack [accept; refuse; cancel] side:`Left fill:`X expand:true; pack [mw] side:`Top fill:`Both; pack [fw] side:`Bottom fill:`X expand:true; diff --git a/otherlibs/labltk/browser/jg_multibox.ml b/otherlibs/labltk/browser/jg_multibox.ml index 68cab68cf..bdf5143c3 100644 --- a/otherlibs/labltk/browser/jg_multibox.ml +++ b/otherlibs/labltk/browser/jg_multibox.ml @@ -13,8 +13,8 @@ (* $Id$ *) -let rec gen_list fun:f :len = - if len = 0 then [] else f () :: gen_list fun:f len:(len - 1) +let rec gen_list f:f :len = + if len = 0 then [] else f () :: gen_list f:f len:(len - 1) let rec make_list :len :fill = if len = 0 then [] else fill :: make_list len:(len - 1) :fill @@ -54,7 +54,7 @@ let rec split l :len = if l = [] then make_list :len fill:[] else let (cars,r) = first l :len in let cdrs = split r :len in - List.map2 cars cdrs fun:(fun a l -> a::l) + List.map2 cars cdrs f:(fun a l -> a::l) open Tk @@ -68,7 +68,7 @@ class c :cols :texts ?:maxheight ?:width parent = object (self) match maxheight with None -> height | Some max -> min max height in - gen_list len:cols fun: + gen_list len:cols f: begin fun () -> Listbox.create parent :height ?:width highlightthickness:0 @@ -86,9 +86,9 @@ class c :cols :texts ?:maxheight ?:width parent = object (self) if n < length then n else length - 1; (* Activate it, to keep consistent with Up/Down. You have to be in Extended or Browse mode *) - let box = List.nth boxes pos:(current mod cols) + let box = List.nth boxes (current mod cols) and index = `Num (current / cols) in - List.iter boxes fun: + List.iter boxes f: begin fun box -> Listbox.selection_clear box first:(`Num 0) last:`End; Listbox.selection_anchor box :index; @@ -98,10 +98,10 @@ class c :cols :texts ?:maxheight ?:width parent = object (self) if aligntop then Listbox.yview_index box :index else Listbox.see box :index; let (first,last) = Listbox.yview_get box in - List.iter boxes fun:(Listbox.yview scroll:(`Moveto first)) + List.iter boxes f:(Listbox.yview scroll:(`Moveto first)) method init = let textl = split len:cols texts in - List.iter2 boxes textl fun: + List.iter2 boxes textl f: begin fun box texts -> Jg_bind.enter_focus box; Listbox.insert box :texts index:`End @@ -123,14 +123,14 @@ class c :cols :texts ?:maxheight ?:width parent = object (self) "Next", (fun n -> n + current_height () * cols); "Home", (fun _ -> 0); "End", (fun _ -> List.length texts) ] - fun:begin fun (key,f) -> + f:begin fun (key,f) -> self#bind_kbd events:[`KeyPressDetail key] action:(fun _ index:n -> self#recenter (f n); break ()) end; self#recenter 0 method bind_mouse :events :action = let i = ref 0 in - List.iter boxes fun: + List.iter boxes f: begin fun box -> let b = !i in bind box :events breakable:true fields:[`MouseX;`MouseY] @@ -141,7 +141,7 @@ class c :cols :texts ?:maxheight ?:width parent = object (self) end method bind_kbd :events :action = let i = ref 0 in - List.iter boxes fun: + List.iter boxes f: begin fun box -> let b = !i in bind box :events breakable:true fields:[`Char] @@ -156,9 +156,9 @@ let add_scrollbar (box : c) = let boxes = box#boxes in let sb = Scrollbar.create (box#parent) - command:(fun :scroll -> List.iter boxes fun:(Listbox.yview :scroll)) in + command:(fun :scroll -> List.iter boxes f:(Listbox.yview :scroll)) in List.iter boxes - fun:(fun lb -> Listbox.configure lb yscrollcommand:(Scrollbar.set sb)); + f:(fun lb -> Listbox.configure lb yscrollcommand:(Scrollbar.set sb)); pack [sb] before:(List.hd boxes) side:`Right fill:`Y; sb diff --git a/otherlibs/labltk/browser/jg_text.ml b/otherlibs/labltk/browser/jg_text.ml index 32e163530..910cd518d 100644 --- a/otherlibs/labltk/browser/jg_text.ml +++ b/otherlibs/labltk/browser/jg_text.ml @@ -92,8 +92,8 @@ let search_string tw = Focus.set text; Jg_bind.return_invoke text button:search; Jg_bind.escape_destroy tl; - Textvariable.set direction to:"forward"; - Textvariable.set mode to:"nocase"; + Textvariable.set direction "forward"; + Textvariable.set mode "nocase"; pack [label] side:`Left; pack [text] side:`Right fill:`X expand:true; pack [back; forw] side:`Left; diff --git a/otherlibs/labltk/browser/lexical.ml b/otherlibs/labltk/browser/lexical.ml index ecdebcb3c..655c3cc18 100644 --- a/otherlibs/labltk/browser/lexical.ml +++ b/otherlibs/labltk/browser/lexical.ml @@ -25,7 +25,7 @@ and colors = "indianred4"; "saddlebrown"; "midnightblue"] let init_tags tw = - List.iter2 tags colors fun: + List.iter2 tags colors f: begin fun tag col -> Text.tag_configure tw :tag foreground:(`Color col) end; @@ -38,7 +38,7 @@ let tag ?(:start=tstart) ?(:end=tend) tw = 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 :tag); + f:(fun tag -> Text.tag_remove tw :start :end :tag); try while true do let tag = diff --git a/otherlibs/labltk/browser/list2.ml b/otherlibs/labltk/browser/list2.ml index 8c7a8825c..80cac04ef 100644 --- a/otherlibs/labltk/browser/list2.ml +++ b/otherlibs/labltk/browser/list2.ml @@ -13,8 +13,8 @@ (* $Id$ *) -let exclude item:x l = List.filter l pred:((<>) x) +let exclude x l = List.filter l f:((<>) x) -let rec flat_map fun:f = function +let rec flat_map :f = function [] -> [] - | x :: l -> f x @ flat_map fun:f l + | x :: l -> f x @ flat_map :f l diff --git a/otherlibs/labltk/browser/searchid.ml b/otherlibs/labltk/browser/searchid.ml index 1d63d3521..c892992e2 100644 --- a/otherlibs/labltk/browser/searchid.ml +++ b/otherlibs/labltk/browser/searchid.ml @@ -69,23 +69,23 @@ let rec permutations l = match l with | [a;b] -> [l; [b;a]] | _ -> let _, perms = - List.fold_left l acc:(l,[]) fun: - begin fun acc:(l, perms) a -> + List.fold_left l init:(l,[]) f: + begin fun (l, perms) a -> let l = List.tl l in l @ [a], - List.map (permutations l) fun:(fun l -> a :: l) @ perms + List.map (permutations l) f:(fun l -> a :: l) @ perms end in perms let rec choose n in:l = let len = List.length l in if n = len then [l] else - if n = 1 then List.map l fun:(fun x -> [x]) else + if n = 1 then List.map l f:(fun x -> [x]) else if n = 0 then [[]] else if n > len then [] else match l with [] -> [] | a :: l -> - List.map (choose (n-1) in:l) fun:(fun l -> a :: l) + List.map (choose (n-1) in:l) f:(fun l -> a :: l) @ choose n in:l let rec arr p in:n = @@ -107,38 +107,38 @@ let rec equal :prefix t1 t2 = in let r1, r2, pairs = merge_row_fields fields1 fields2 in row1.row_closed = row2.row_closed & r1 = [] & r2 = [] & - List.for_all pairs pred: + List.for_all pairs f: begin fun (_,f1,f2) -> match row_field_repr f1, row_field_repr f2 with Rpresent None, Rpresent None -> true | Rpresent(Some t1), Rpresent (Some t2) -> equal t1 t2 :prefix | Reither(c1, tl1, _), Reither(c2, tl2, _) -> c1 = c2 & List.length tl1 = List.length tl2 & - List.for_all2 tl1 tl2 pred:(equal :prefix) + List.for_all2 tl1 tl2 f:(equal :prefix) | _ -> false end | Tarrow _, Tarrow _ -> let l1, t1 = all_args t1 and l2, t2 = all_args t2 in equal t1 t2 :prefix & List.length l1 = List.length l2 & - List.exists (permutations l1) pred: + List.exists (permutations l1) f: begin fun l1 -> - List.for_all2 l1 l2 pred: + List.for_all2 l1 l2 f: begin fun (p1,t1) (p2,t2) -> (p1 = "" or p1 = p2) & equal t1 t2 :prefix end end | Ttuple l1, Ttuple l2 -> List.length l1 = List.length l2 & - List.for_all2 l1 l2 pred:(equal :prefix) + List.for_all2 l1 l2 f:(equal :prefix) | Tconstr (p1, l1, _), Tconstr (p2, l2, _) -> remove_prefix :prefix (longident_of_path p1) = (longident_of_path p2) & List.length l1 = List.length l2 - & List.for_all2 l1 l2 pred:(equal :prefix) + & List.for_all2 l1 l2 f:(equal :prefix) | _ -> false let is_opt s = s <> "" & s.[0] = '?' -let get_options = List.filter pred:is_opt +let get_options = List.filter f:is_opt let rec included :prefix t1 t2 = match (repr t1).desc, (repr t2).desc with @@ -150,14 +150,14 @@ let rec included :prefix t1 t2 = in let r1, r2, pairs = merge_row_fields fields1 fields2 in r1 = [] & - List.for_all pairs pred: + List.for_all pairs f: begin fun (_,f1,f2) -> match row_field_repr f1, row_field_repr f2 with Rpresent None, Rpresent None -> true | Rpresent(Some t1), Rpresent (Some t2) -> included t1 t2 :prefix | Reither(c1, tl1, _), Reither(c2, tl2, _) -> c1 = c2 & List.length tl1 = List.length tl2 & - List.for_all2 tl1 tl2 pred:(included :prefix) + List.for_all2 tl1 tl2 f:(included :prefix) | _ -> false end | Tarrow _, Tarrow _ -> @@ -167,12 +167,12 @@ let rec included :prefix t1 t2 = let l2 = if arr len1 in:len2 < 100 then l2 else let ll1 = get_options (fst (List.split l1)) in List.filter l2 - pred:(fun (l,_) -> not (is_opt l) or List.mem item:l ll1) + f:(fun (l,_) -> not (is_opt l) or List.mem l ll1) in len1 <= len2 & - List.exists (List2.flat_map fun:permutations (choose len1 in:l2)) pred: + List.exists (List2.flat_map f:permutations (choose len1 in:l2)) f: begin fun l2 -> - List.for_all2 l1 l2 pred: + List.for_all2 l1 l2 f: begin fun (p1,t1) (p2,t2) -> (p1 = "" or p1 = p2) & included t1 t2 :prefix end @@ -180,27 +180,27 @@ let rec included :prefix t1 t2 = | Ttuple l1, Ttuple l2 -> let len1 = List.length l1 in len1 <= List.length l2 & - List.exists (List2.flat_map fun:permutations (choose len1 in:l2)) pred: + List.exists (List2.flat_map f:permutations (choose len1 in:l2)) f: begin fun l2 -> - List.for_all2 l1 l2 pred:(included :prefix) + List.for_all2 l1 l2 f:(included :prefix) end | _, Ttuple _ -> included (newty (Ttuple [t1])) t2 :prefix | Tconstr (p1, l1, _), Tconstr (p2, l2, _) -> remove_prefix :prefix (longident_of_path p1) = (longident_of_path p2) & List.length l1 = List.length l2 - & List.for_all2 l1 l2 pred:(included :prefix) + & List.for_all2 l1 l2 f:(included :prefix) | _ -> false let mklid = function [] -> raise (Invalid_argument "Searchid.mklid") | x :: l -> - List.fold_left l acc:(Lident x) fun:(fun :acc x -> Ldot (acc, x)) + List.fold_left l init:(Lident x) f:(fun acc x -> Ldot (acc, x)) let mkpath = function [] -> raise (Invalid_argument "Searchid.mklid") | x :: l -> - List.fold_left l acc:(Pident (Ident.create x)) - fun:(fun :acc x -> Pdot (acc, x, 0)) + List.fold_left l init:(Pident (Ident.create x)) + f:(fun acc x -> Pdot (acc, x, 0)) let get_fields :prefix :sign self = let env = open_signature (mkpath prefix) sign initial in @@ -214,7 +214,7 @@ let rec search_type_in_signature t in:sign :prefix :mode = `included -> included t :prefix | `exact -> equal t :prefix and lid_of_id id = mklid (prefix @ [Ident.name id]) in - List2.flat_map sign fun: + List2.flat_map sign f: begin fun item -> match item with Tsig_value (id, vd) -> if matches vd.val_type then [lid_of_id id, Pvalue] else [] @@ -227,13 +227,13 @@ let rec search_type_in_signature t in:sign :prefix :mode = begin match td.type_kind with Type_abstract -> false | Type_variant l -> - List.exists l pred:(fun (_, l) -> List.exists l pred:matches) + List.exists l f:(fun (_, l) -> List.exists l f:matches) | Type_record(l, rep) -> - List.exists l pred:(fun (_, _, t) -> matches t) + List.exists l f:(fun (_, _, t) -> matches t) end then [lid_of_id id, Ptype] else [] | Tsig_exception (id, l) -> - if List.exists l pred:matches + if List.exists l f:matches then [lid_of_id id, Pconstructor] else [] | Tsig_module (id, Tmty_signature sign) -> @@ -246,13 +246,13 @@ let rec search_type_in_signature t in:sign :prefix :mode = if matches self or (match cl.cty_new with None -> false | Some ty -> matches ty) (* or List.exists (get_fields :prefix :sign self) - pred:(fun (_,_,ty_field) -> matches ty_field) *) + f:(fun (_,_,ty_field) -> matches ty_field) *) then [lid_of_id id, Pclass] else [] | Tsig_cltype (id, cl) -> let self = self_type cl.clty_type in if matches self (* or List.exists (get_fields :prefix :sign self) - pred:(fun (_,_,ty_field) -> matches ty_field) *) + f:(fun (_,_,ty_field) -> matches ty_field) *) then [lid_of_id id, Pclass] else [] end @@ -262,13 +262,13 @@ let search_all_types t :mode = | `included, Tarrow _ -> [t] | `included, _ -> [t; newty(Tarrow("",t,newvar())); newty(Tarrow("",newvar(),t))] - in List2.flat_map !module_list fun: + in List2.flat_map !module_list f: begin fun modname -> let mlid = Lident modname in try match lookup_module mlid initial with _, Tmty_signature sign -> List2.flat_map tl - fun:(search_type_in_signature in:sign prefix:[modname] :mode) + f:(search_type_in_signature in:sign prefix:[modname] :mode) | _ -> [] with Not_found | Env.Error _ -> [] end @@ -280,8 +280,8 @@ let search_string_type text :mode = let sexp = Parse.interface (Lexing.from_string ("val z : " ^ text)) in let sign = try Typemod.transl_signature !start_env sexp with _ -> - let env = List.fold_left !module_list acc:initial fun: - begin fun :acc m -> + let env = List.fold_left !module_list init:initial f: + begin fun acc m -> try open_pers_signature m acc with Env.Error _ -> acc end in try Typemod.transl_signature env sexp @@ -332,11 +332,11 @@ let search_pattern_symbol text = if text = "" then [] else let pattern = explode text in let check i = check_match :pattern (explode (Ident.name i)) in - let l = List.map !module_list fun: + let l = List.map !module_list f: begin fun modname -> Lident modname, try match lookup_module (Lident modname) initial with _, Tmty_signature sign -> - List2.flat_map sign fun: + List2.flat_map sign f: begin function Tsig_value (i, _) when check i -> [i, Pvalue] | Tsig_type (i, _) when check i -> [i, Ptype] @@ -346,12 +346,12 @@ let search_pattern_symbol text = | Tsig_class (i, cl) when check i or List.exists (get_fields prefix:[modname] :sign (self_type cl.cty_type)) - pred:(fun (name,_,_) -> check_match :pattern (explode name)) + f:(fun (name,_,_) -> check_match :pattern (explode name)) -> [i, Pclass] | Tsig_cltype (i, cl) when check i or List.exists (get_fields prefix:[modname] :sign (self_type cl.clty_type)) - pred:(fun (name,_,_) -> check_match :pattern (explode name)) + f:(fun (name,_,_) -> check_match :pattern (explode name)) -> [i, Pcltype] | _ -> [] end @@ -359,9 +359,9 @@ let search_pattern_symbol text = with Env.Error _ -> [] end in - List2.flat_map l fun: + List2.flat_map l f: begin fun (m, l) -> - List.map l fun:(fun (i, p) -> Ldot (m, Ident.name i), p) + List.map l f:(fun (i, p) -> Ldot (m, Ident.name i), p) end (* @@ -394,15 +394,15 @@ let rec bound_variables pat = Ppat_any | Ppat_constant _ | Ppat_type _ -> [] | Ppat_var s -> [s] | Ppat_alias (pat,s) -> s :: bound_variables pat - | Ppat_tuple l -> List2.flat_map l fun:bound_variables + | Ppat_tuple l -> List2.flat_map l f:bound_variables | Ppat_construct (_,None,_) -> [] | Ppat_construct (_,Some pat,_) -> bound_variables pat | Ppat_variant (_,None) -> [] | Ppat_variant (_,Some pat) -> bound_variables pat | Ppat_record l -> - List2.flat_map l fun:(fun (_,pat) -> bound_variables pat) + List2.flat_map l f:(fun (_,pat) -> bound_variables pat) | Ppat_array l -> - List2.flat_map l fun:bound_variables + List2.flat_map l f:bound_variables | Ppat_or (pat1,pat2) -> bound_variables pat1 @ bound_variables pat2 | Ppat_constraint (pat,_) -> bound_variables pat @@ -413,8 +413,8 @@ let search_structure str :name :kind :prefix = match prefix with [] -> str | modu::prefix -> let str = - List.fold_left acc:[] str fun: - begin fun :acc item -> + List.fold_left init:[] str f: + begin fun acc item -> match item.pstr_desc with Pstr_module (s, mexp) when s = modu -> loc := mexp.pmod_loc.loc_start; @@ -426,19 +426,19 @@ let search_structure str :name :kind :prefix = end in search_module str :prefix in - List.iter (search_module str :prefix) fun: + List.iter (search_module str :prefix) f: begin fun item -> if match item.pstr_desc with Pstr_value (_, l) when kind = Pvalue -> - List.iter l fun: + List.iter l f: begin fun (pat,_) -> - if List.mem item:name (bound_variables pat) + if List.mem name (bound_variables pat) then loc := pat.ppat_loc.loc_start end; false | Pstr_primitive (s, _) when kind = Pvalue -> name = s | Pstr_type l when kind = Ptype -> - List.iter l fun: + List.iter l f: begin fun (s, td) -> if s = name then loc := td.ptype_loc.loc_start end; @@ -447,13 +447,13 @@ let search_structure str :name :kind :prefix = | Pstr_module (s, _) when kind = Pmodule -> name = s | Pstr_modtype (s, _) when kind = Pmodtype -> name = s | Pstr_class l when kind = Pclass or kind = Ptype or kind = Pcltype -> - List.iter l fun: + List.iter l f: begin fun c -> if c.pci_name = name then loc := c.pci_loc.loc_start end; false | Pstr_class_type l when kind = Pcltype or kind = Ptype -> - List.iter l fun: + List.iter l f: begin fun c -> if c.pci_name = name then loc := c.pci_loc.loc_start end; @@ -469,8 +469,8 @@ let search_signature sign :name :kind :prefix = match prefix with [] -> sign | modu::prefix -> let sign = - List.fold_left acc:[] sign fun: - begin fun :acc item -> + List.fold_left init:[] sign f: + begin fun acc item -> match item.psig_desc with Psig_module (s, mtyp) when s = modu -> loc := mtyp.pmty_loc.loc_start; @@ -482,12 +482,12 @@ let search_signature sign :name :kind :prefix = end in search_module_type sign :prefix in - List.iter (search_module_type sign :prefix) fun: + List.iter (search_module_type sign :prefix) f: begin fun item -> if match item.psig_desc with Psig_value (s, _) when kind = Pvalue -> name = s | Psig_type l when kind = Ptype -> - List.iter l fun: + List.iter l f: begin fun (s, td) -> if s = name then loc := td.ptype_loc.loc_start end; @@ -496,13 +496,13 @@ let search_signature sign :name :kind :prefix = | Psig_module (s, _) when kind = Pmodule -> name = s | Psig_modtype (s, _) when kind = Pmodtype -> name = s | Psig_class l when kind = Pclass or kind = Ptype or kind = Pcltype -> - List.iter l fun: + List.iter l f: begin fun c -> if c.pci_name = name then loc := c.pci_loc.loc_start end; false | Psig_class_type l when kind = Ptype or kind = Pcltype -> - List.iter l fun: + List.iter l f: begin fun c -> if c.pci_name = name then loc := c.pci_loc.loc_start end; diff --git a/otherlibs/labltk/browser/searchpos.ml b/otherlibs/labltk/browser/searchpos.ml index 6cb3a8434..4b7560f9d 100644 --- a/otherlibs/labltk/browser/searchpos.ml +++ b/otherlibs/labltk/browser/searchpos.ml @@ -26,7 +26,7 @@ open Searchid (* auxiliary functions *) -let (~) = Jg_memo.fast fun:Str.regexp +let (~) = Jg_memo.fast f:Str.regexp let lines_to_chars n in:s = let l = String.length s in @@ -68,7 +68,7 @@ let rec list_of_path = function (* a simple wrapper *) class buffer :size = object - val buffer = Buffer.create :size + val buffer = Buffer.create size method out :buf = Buffer.add_substring buffer buf method get = Buffer.contents buffer end @@ -86,23 +86,23 @@ let rec search_pos_type t :pos :env = | Ptyp_var _ -> () | Ptyp_variant(tl, _, _) -> List.iter tl - fun:(fun (_,_,tl) -> List.iter tl fun:(search_pos_type :pos :env)) + f:(fun (_,_,tl) -> List.iter tl f:(search_pos_type :pos :env)) | Ptyp_arrow (_, t1, t2) -> search_pos_type t1 :pos :env; search_pos_type t2 :pos :env | Ptyp_tuple tl -> - List.iter tl fun:(search_pos_type :pos :env) + List.iter tl f:(search_pos_type :pos :env) | Ptyp_constr (lid, tl) -> - List.iter tl fun:(search_pos_type :pos :env); + List.iter tl f:(search_pos_type :pos :env); raise (Found_sig (`Type, lid, env)) | Ptyp_object fl -> - List.iter fl fun: + List.iter fl f: begin function | {pfield_desc = Pfield (_, ty)} -> search_pos_type ty :pos :env | _ -> () end | Ptyp_class (lid, tl, _) -> - List.iter tl fun:(search_pos_type :pos :env); + List.iter tl f:(search_pos_type :pos :env); raise (Found_sig (`Type, lid, env)) | Ptyp_alias (t, _) -> search_pos_type :pos :env t); raise Not_found @@ -114,7 +114,7 @@ let rec search_pos_class_type cl :pos :env = Pcty_constr (lid, _) -> raise (Found_sig (`Class, lid, env)) | Pcty_signature (_, cfl) -> - List.iter cfl fun: + List.iter cfl f: begin function Pctf_inher cty -> search_pos_class_type cty :pos :env | Pctf_val (_, _, Some ty, loc) -> @@ -147,17 +147,17 @@ let search_pos_type_decl td :pos :env = Ptype_abstract -> () | Ptype_variant dl -> List.iter dl - fun:(fun (_, tl) -> List.iter tl fun:(search_pos_type :pos :env)) + f:(fun (_, tl) -> List.iter tl f:(search_pos_type :pos :env)) | Ptype_record dl -> - List.iter dl fun:(fun (_, _, t) -> search_pos_type t :pos :env) + List.iter dl f:(fun (_, _, t) -> search_pos_type t :pos :env) end; raise Not_found end let rec search_pos_signature l :pos :env = ignore ( - List.fold_left l acc:env fun: - begin fun acc:env pt -> + List.fold_left l init:env f: + begin fun env pt -> let env = match pt.psig_desc with Psig_open id -> let path, mt = lookup_module id env in @@ -174,9 +174,9 @@ let rec search_pos_signature l :pos :env = begin match pt.psig_desc with Psig_value (_, desc) -> search_pos_type desc.pval_type :pos :env | Psig_type l -> - List.iter l fun:(fun (_,desc) -> search_pos_type_decl :pos desc :env) + List.iter l f:(fun (_,desc) -> search_pos_type_decl :pos desc :env) | Psig_exception (_, l) -> - List.iter l fun:(search_pos_type :pos :env); + List.iter l f:(search_pos_type :pos :env); raise (Found_sig (`Type, Lident "exn", env)) | Psig_module (_, t) -> search_pos_module t :pos :env @@ -185,10 +185,10 @@ let rec search_pos_signature l :pos :env = | Psig_modtype _ -> () | Psig_class l -> List.iter l - fun:(fun ci -> search_pos_class_type ci.pci_expr :pos :env) + f:(fun ci -> search_pos_class_type ci.pci_expr :pos :env) | Psig_class_type l -> List.iter l - fun:(fun ci -> search_pos_class_type ci.pci_expr :pos :env) + f:(fun ci -> search_pos_class_type ci.pci_expr :pos :env) (* The last cases should not happen in generated interfaces *) | Psig_open lid -> raise (Found_sig (`Module, lid, env)) | Psig_include t -> search_pos_module t :pos :env @@ -208,7 +208,7 @@ and search_pos_module m :pos :env = search_pos_module m2 :pos :env | Pmty_with (m, l) -> search_pos_module m :pos :env; - List.iter l fun: + List.iter l f: begin function _, Pwith_type t -> search_pos_type_decl t :pos :env | _ -> () @@ -225,22 +225,22 @@ type module_widgets = mw_edit: Widget.button Widget.widget; mw_intf: Widget.button Widget.widget } -let shown_modules = Hashtbl.create size:17 +let shown_modules = Hashtbl.create 17 let filter_modules () = - Hashtbl.iter shown_modules fun: + Hashtbl.iter shown_modules f: begin fun :key :data -> if not (Winfo.exists data.mw_frame) then - Hashtbl.remove :key shown_modules + Hashtbl.remove shown_modules key end let add_shown_module path :widgets = Hashtbl.add shown_modules key:path data:widgets and find_shown_module path = filter_modules (); - Hashtbl.find shown_modules key:path + Hashtbl.find shown_modules path let is_shown_module path = filter_modules (); - Hashtbl.mem shown_modules key:path + Hashtbl.mem shown_modules path (* Viewing a signature *) @@ -265,7 +265,7 @@ let edit_source :file :path :sign = let pos = try let chan = open_in file in - if Filename.check_suffix file suff:".ml" then + if Filename.check_suffix file ".ml" then let parsed = Parse.implementation (Lexing.from_channel chan) in close_in chan; Searchid.search_structure parsed :name :kind :prefix @@ -303,7 +303,7 @@ let rec view_signature ?:title ?:path ?(:env = !start_env) sign = command:(fun () -> view_signature sign :title :env); pack [widgets.mw_detach] side:`Left; Pack.forget [widgets.mw_edit; widgets.mw_intf]; - List.iter2 [widgets.mw_edit; widgets.mw_intf] [".ml"; ".mli"] fun: + List.iter2 [widgets.mw_edit; widgets.mw_intf] [".ml"; ".mli"] f: begin fun button ext -> try let id = head_id path in @@ -318,7 +318,7 @@ let rec view_signature ?:title ?:path ?(:env = !start_env) sign = let top = Winfo.toplevel widgets.mw_frame in if not (Winfo.ismapped top) then Wm.deiconify top; Focus.set top; - List.iter fun:destroy (Winfo.children widgets.mw_frame); + List.iter f:destroy (Winfo.children widgets.mw_frame); Jg_message.formatted :title on:widgets.mw_frame maxheight:15 () with Not_found -> let tl, tw, finish = Jg_message.formatted :title maxheight:15 () in @@ -484,17 +484,19 @@ and view_decl_menu lid :kind :env :parent = in (* Menu.add_separator menu; *) List.iter l - fun:(fun label -> Menu.add_command menu :label :font state:`Disabled) + f:(fun label -> Menu.add_command menu :label :font state:`Disabled) end; menu (* search and view in a structure *) -type fkind = - [ `Exp [`Expr|`Pat|`Const|`Val Path.t|`Var Path.t|`New Path.t] +type fkind = [ + `Exp of + [`Expr|`Pat|`Const|`Val of Path.t|`Var of Path.t|`New of Path.t] * Types.type_expr - | `Class Path.t * Types.class_type - | `Module Path.t * Types.module_type ] + | `Class of Path.t * Types.class_type + | `Module of Path.t * Types.module_type +] exception Found_str of fkind * Env.t let view_type kind :env = @@ -573,7 +575,7 @@ let view_type_menu kind :env :parent = if font = "" then "7x14" else font in (* Menu.add_separator menu; *) - List.iter l fun: + List.iter l f: begin fun label -> match (Ctype.repr ty).desc with Tconstr (path,_,_) -> Menu.add_command menu :label :font @@ -588,11 +590,11 @@ let view_type_menu kind :env :parent = menu let rec search_pos_structure :pos str = - List.iter str fun: + List.iter str f: begin function Tstr_eval exp -> search_pos_expr exp :pos | Tstr_value (rec_flag, l) -> - List.iter l fun: + List.iter l f: begin fun (pat, exp) -> let env = if rec_flag = Asttypes.Recursive then exp.exp_env else Env.empty in @@ -607,7 +609,7 @@ let rec search_pos_structure :pos str = | Tstr_modtype _ -> () | Tstr_open _ -> () | Tstr_class l -> - List.iter l fun:(fun (id, _, _, cl) -> search_pos_class_expr cl :pos) + List.iter l f:(fun (id, _, _, cl) -> search_pos_class_expr cl :pos) | Tstr_cltype _ -> () end @@ -617,35 +619,35 @@ and search_pos_class_expr :pos cl = Tclass_ident path -> raise (Found_str (`Class (path, cl.cl_type), !start_env)) | Tclass_structure cls -> - List.iter cls.cl_field fun: + List.iter cls.cl_field f: begin function Cf_inher (cl, _, _) -> search_pos_class_expr cl :pos | Cf_val (_, _, exp) -> search_pos_expr exp :pos | Cf_meth (_, exp) -> search_pos_expr exp :pos | Cf_let (_, pel, iel) -> - List.iter pel fun: + List.iter pel f: begin fun (pat, exp) -> search_pos_pat pat :pos env:exp.exp_env; search_pos_expr exp :pos end; - List.iter iel fun:(fun (_,exp) -> search_pos_expr exp :pos) + List.iter iel f:(fun (_,exp) -> search_pos_expr exp :pos) | Cf_init exp -> search_pos_expr exp :pos end | Tclass_fun (pat, iel, cl, _) -> search_pos_pat pat :pos env:pat.pat_env; - List.iter iel fun:(fun (_,exp) -> search_pos_expr exp :pos); + List.iter iel f:(fun (_,exp) -> search_pos_expr exp :pos); search_pos_class_expr cl :pos | Tclass_apply (cl, el) -> search_pos_class_expr cl :pos; - List.iter el fun:(Misc.may (search_pos_expr :pos)) + List.iter el f:(Misc.may (search_pos_expr :pos)) | Tclass_let (_, pel, iel, cl) -> - List.iter pel fun: + List.iter pel f: begin fun (pat, exp) -> search_pos_pat pat :pos env:exp.exp_env; search_pos_expr exp :pos end; - List.iter iel fun:(fun (_,exp) -> search_pos_expr exp :pos); + List.iter iel f:(fun (_,exp) -> search_pos_expr exp :pos); search_pos_class_expr cl :pos | Tclass_constraint (cl, _, _, _) -> search_pos_class_expr cl :pos @@ -662,46 +664,46 @@ and search_pos_expr :pos exp = | Texp_constant v -> raise (Found_str (`Exp(`Const, exp.exp_type), exp.exp_env)) | Texp_let (_, expl, exp) -> - List.iter expl fun: + List.iter expl f: begin fun (pat, exp') -> search_pos_pat pat :pos env:exp.exp_env; search_pos_expr exp' :pos end; search_pos_expr exp :pos | Texp_function (l, _) -> - List.iter l fun: + List.iter l f: begin fun (pat, exp) -> search_pos_pat pat :pos env:exp.exp_env; search_pos_expr exp :pos end | Texp_apply (exp, l) -> - List.iter l fun:(Misc.may (search_pos_expr :pos)); + List.iter l f:(Misc.may (search_pos_expr :pos)); search_pos_expr exp :pos | Texp_match (exp, l, _) -> search_pos_expr exp :pos; - List.iter l fun: + List.iter l f: begin fun (pat, exp) -> search_pos_pat pat :pos env:exp.exp_env; search_pos_expr exp :pos end | Texp_try (exp, l) -> search_pos_expr exp :pos; - List.iter l fun: + List.iter l f: begin fun (pat, exp) -> search_pos_pat pat :pos env:exp.exp_env; search_pos_expr exp :pos end - | Texp_tuple l -> List.iter l fun:(search_pos_expr :pos) - | Texp_construct (_, l) -> List.iter l fun:(search_pos_expr :pos) + | Texp_tuple l -> List.iter l f:(search_pos_expr :pos) + | Texp_construct (_, l) -> List.iter l f:(search_pos_expr :pos) | Texp_variant (_, None) -> () | Texp_variant (_, Some exp) -> search_pos_expr exp :pos | Texp_record (l, opt) -> - List.iter l fun:(fun (_, exp) -> search_pos_expr exp :pos); + List.iter l f:(fun (_, exp) -> search_pos_expr exp :pos); (match opt with None -> () | Some exp -> search_pos_expr exp :pos) | Texp_field (exp, _) -> search_pos_expr exp :pos | Texp_setfield (a, _, b) -> search_pos_expr a :pos; search_pos_expr b :pos - | Texp_array l -> List.iter l fun:(search_pos_expr :pos) + | Texp_array l -> List.iter l f:(search_pos_expr :pos) | Texp_ifthenelse (a, b, c) -> search_pos_expr a :pos; search_pos_expr b :pos; begin match c with None -> () @@ -712,7 +714,7 @@ and search_pos_expr :pos exp = | Texp_while (a,b) -> search_pos_expr a :pos; search_pos_expr b :pos | Texp_for (_, a, b, _, c) -> - List.iter [a;b;c] fun:(search_pos_expr :pos) + List.iter [a;b;c] f:(search_pos_expr :pos) | Texp_when (a, b) -> search_pos_expr a :pos; search_pos_expr b :pos | Texp_send (exp, _) -> search_pos_expr exp :pos @@ -724,7 +726,7 @@ and search_pos_expr :pos exp = search_pos_expr exp :pos; raise (Found_str (`Exp(`Var path, exp.exp_type), exp.exp_env)) | Texp_override (_, l) -> - List.iter l fun:(fun (_, exp) -> search_pos_expr exp :pos) + List.iter l f:(fun (_, exp) -> search_pos_expr exp :pos) | Texp_letmodule (id, modexp, exp) -> search_pos_module_expr modexp :pos; search_pos_expr exp :pos @@ -742,15 +744,15 @@ and search_pos_pat :pos :env pat = | Tpat_constant _ -> raise (Found_str (`Exp(`Const, pat.pat_type), env)) | Tpat_tuple l -> - List.iter l fun:(search_pos_pat :pos :env) + List.iter l f:(search_pos_pat :pos :env) | Tpat_construct (_, l) -> - List.iter l fun:(search_pos_pat :pos :env) + List.iter l f:(search_pos_pat :pos :env) | Tpat_variant (_, None, _) -> () | Tpat_variant (_, Some pat, _) -> search_pos_pat pat :pos :env | Tpat_record l -> - List.iter l fun:(fun (_, pat) -> search_pos_pat pat :pos :env) + List.iter l f:(fun (_, pat) -> search_pos_pat pat :pos :env) | Tpat_array l -> - List.iter l fun:(search_pos_pat :pos :env) + List.iter l f:(search_pos_pat :pos :env) | Tpat_or (a, b) -> search_pos_pat a :pos :env; search_pos_pat b :pos :env end; diff --git a/otherlibs/labltk/browser/searchpos.mli b/otherlibs/labltk/browser/searchpos.mli index d1e3c3ed2..14e431cbf 100644 --- a/otherlibs/labltk/browser/searchpos.mli +++ b/otherlibs/labltk/browser/searchpos.mli @@ -52,11 +52,13 @@ val view_decl_menu : Longident.t -> kind:skind -> env:Env.t -> parent:text widget -> menu widget -type fkind = - [ `Exp [`Expr|`Pat|`Const|`Val Path.t|`Var Path.t|`New Path.t] +type fkind = [ + `Exp of + [`Expr|`Pat|`Const|`Val of Path.t|`Var of Path.t|`New of Path.t] * Types.type_expr - | `Class Path.t * Types.class_type - | `Module Path.t * Types.module_type ] + | `Class of Path.t * Types.class_type + | `Module of Path.t * Types.module_type +] exception Found_str of fkind * Env.t val search_pos_structure : pos:int -> Typedtree.structure_item list -> unit diff --git a/otherlibs/labltk/browser/setpath.ml b/otherlibs/labltk/browser/setpath.ml index bd3f47321..85f77eec2 100644 --- a/otherlibs/labltk/browser/setpath.ml +++ b/otherlibs/labltk/browser/setpath.ml @@ -22,7 +22,7 @@ let update_hooks = ref [] let add_update_hook f = update_hooks := f :: !update_hooks let exec_update_hooks () = - update_hooks := List.filter !update_hooks pred: + update_hooks := List.filter !update_hooks f: begin fun f -> try f (); true with Protocol.TkError _ -> false @@ -35,7 +35,7 @@ let set_load_path l = let get_load_path () = !Config.load_path let renew_dirs box :var :dir = - Textvariable.set var to:dir; + Textvariable.set var dir; Listbox.delete box first:(`Num 0) last:`End; Listbox.insert box index:`End texts:(Useunix.get_directories_in_files path:dir @@ -51,7 +51,7 @@ let add_to_path :dirs ?(:base="") box = let dirs = if base = "" then dirs else if dirs = [] then [base] else - List.map dirs fun: + List.map dirs f: begin function "." -> base | ".." -> Filename.dirname base @@ -59,13 +59,13 @@ let add_to_path :dirs ?(:base="") box = end in set_load_path - (dirs @ List.fold_left dirs acc:(get_load_path ()) - fun:(fun :acc x -> List2.exclude item:x acc)) + (dirs @ List.fold_left dirs init:(get_load_path ()) + f:(fun acc x -> List2.exclude x acc)) let remove_path box :dirs = set_load_path - (List.fold_left dirs acc:(get_load_path ()) - fun:(fun :acc x -> List2.exclude item:x acc)) + (List.fold_left dirs init:(get_load_path ()) + f:(fun acc x -> List2.exclude x acc)) (* main function *) @@ -118,12 +118,12 @@ let f :dir = let add_paths _ = add_to_path pathbox base:!current_dir dirs:(List.map (Listbox.curselection dirbox) - fun:(fun x -> Listbox.get dirbox index:x)); + f:(fun x -> Listbox.get dirbox index:x)); Listbox.selection_clear dirbox first:(`Num 0) last:`End and remove_paths _ = remove_path pathbox dirs:(List.map (Listbox.curselection pathbox) - fun:(fun x -> Listbox.get pathbox index:x)) + f:(fun x -> Listbox.get pathbox index:x)) in bind dirbox events:[`KeyPressDetail "Insert"] action:add_paths; bind pathbox events:[`KeyPressDetail "Delete"] action:remove_paths; diff --git a/otherlibs/labltk/browser/shell.ml b/otherlibs/labltk/browser/shell.ml index a8188b9f0..7e8b479bd 100644 --- a/otherlibs/labltk/browser/shell.ml +++ b/otherlibs/labltk/browser/shell.ml @@ -19,7 +19,7 @@ open Dummy (* Here again, memoize regexps *) -let (~) = Jg_memo.fast fun:Str.regexp +let (~) = Jg_memo.fast f:Str.regexp (* Nice history class. May reuse *) @@ -29,13 +29,13 @@ class ['a] history () = object method empty = history = [] method add s = count <- 0; history <- s :: history method previous = - let s = List.nth pos:count history in + let s = List.nth history count in count <- (count + 1) mod List.length history; s method next = let l = List.length history in count <- (l + count - 1) mod l; - List.nth history pos:((l + count - 1) mod l) + List.nth history ((l + count - 1) mod l) end let dump_mem ?(:pos = 0) ?:len obj = @@ -44,7 +44,7 @@ let dump_mem ?(:pos = 0) ?:len obj = match len with | None -> Obj.size obj * Sys.word_size / 8 - pos | Some x -> x in - let buf = Buffer.create size:256 in + let buf = Buffer.create 256 in for i = pos to len - 1 do let c = String.unsafe_get (Obj.obj obj) i in Buffer.add_string buf (Printf.sprintf "%02x" (Char.code c)) @@ -74,7 +74,7 @@ object (self) val h = new history () val mutable alive = true val mutable reading = false - val ibuffer = Buffer.create size:1024 + val ibuffer = Buffer.create 1024 val imutex = Mutex.create () val mutable ithreads = [] method alive = alive @@ -86,9 +86,9 @@ object (self) try if Sys.os_type = "Win32" then begin ignore (Unix.write sig1 buf:"T" pos:0 len:1); - List.iter fun:(protect Unix.close) [sig1; sig2] + List.iter f:(protect Unix.close) [sig1; sig2] end else begin - List.iter fun:(protect Unix.close) [in1; err1; sig1; sig2]; + List.iter f:(protect Unix.close) [in1; err1; sig1; sig2]; Fileevent.remove_fileinput fd:in1; Fileevent.remove_fileinput fd:err1; Unix.kill :pid signal:Sys.sigkill; @@ -107,12 +107,12 @@ object (self) with Unix.Unix_error _ -> () method send s = if alive then try - output_string s to:out; + output_string out s; flush out with Sys_error _ -> () method private read :fd :len = begin try - let buf = String.create :len in + let buf = String.create len in let len = Unix.read fd :buf pos:0 :len in if len > 0 then begin self#insert (String.sub buf pos:0 :len); @@ -183,16 +183,16 @@ object (self) ([`Control], `KeyPressDetail"c", [], fun _ -> self#interrupt); ([], `Destroy, [], fun _ -> self#kill) ] in - List.iter bindings fun: + List.iter bindings f: begin fun (modif,event,fields,action) -> bind textw events:[`Modified(modif,event)] :fields :action end; bind textw events:[`KeyPressDetail"Return"] breakable:true action:(fun _ -> self#return; break()); - List.iter fun:Unix.close [in2;out2;err2]; + List.iter f:Unix.close [in2;out2;err2]; if Sys.os_type = "Win32" then begin let fileinput_thread fd = - let buf = String.create len:1024 in + let buf = String.create 1024 in let len = ref 0 in try while len := ThreadUnix.read fd :buf pos:0 len:1024; !len > 0 do Mutex.lock imutex; @@ -200,11 +200,11 @@ object (self) Mutex.unlock imutex done with Unix.Unix_error _ -> () in - ithreads <- List.map [in1; err1] fun:(Thread.create fileinput_thread); + ithreads <- List.map [in1; err1] f:(Thread.create fileinput_thread); let rec read_buffer () = Mutex.lock imutex; if Buffer.length ibuffer > 0 then begin - self#insert (Str.global_replace pat:~"\r\n" with:"\n" + self#insert (Str.global_replace pat:~"\r\n" templ:"\n" (Buffer.contents ibuffer)); Buffer.reset ibuffer; Text.mark_set textw mark:"input" index:(`Mark"insert",[`Char(-1)]) @@ -215,7 +215,7 @@ object (self) read_buffer () end else begin try - List.iter [in1;err1] fun: + List.iter [in1;err1] f: begin fun fd -> Fileevent.add_fileinput :fd callback:(fun () -> ignore (self#read :fd len:1024)) @@ -230,11 +230,11 @@ let shells : (string * shell) list ref = ref [] (* Called before exiting *) let kill_all () = - List.iter !shells fun:(fun (_,sh) -> if sh#alive then sh#kill); + List.iter !shells f:(fun (_,sh) -> if sh#alive then sh#kill); shells := [] let get_all () = - let all = List.filter !shells pred:(fun (_,sh) -> sh#alive) in + let all = List.filter !shells f:(fun (_,sh) -> sh#alive) in shells := all; all @@ -243,7 +243,7 @@ let may_exec_unix prog = with Unix.Unix_error _ -> false let may_exec_win prog = - List.exists pred:may_exec_unix [prog; prog^".exe"; prog^".cmo"; prog^".bat"] + List.exists f:may_exec_unix [prog; prog^".exe"; prog^".cmo"; prog^".bat"] let may_exec = if Sys.os_type = "Win32" then may_exec_win else may_exec_unix @@ -254,7 +254,7 @@ let warnings = ref "A" let f :prog :title = let progargs = - List.filter pred:((<>) "") (Str.split sep:~" " prog) in + List.filter f:((<>) "") (Str.split sep:~" " prog) in if progargs = [] then () else let prog = List.hd progargs in let path = @@ -263,7 +263,7 @@ let f :prog :title = let exists = if not (Filename.is_implicit prog) then may_exec prog else List.exists exec_path - pred:(fun dir -> may_exec (Filename.concat dir prog)) in + f:(fun dir -> may_exec (Filename.concat dir prog)) in if not exists then () else let tl = Jg_toplevel.titled title in let menus = Frame.create tl name:"menubar" in @@ -278,15 +278,15 @@ let f :prog :title = pack [sb] fill:`Y side:`Right; pack [tw] fill:`Both expand:true side:`Left; pack [frame] fill:`Both expand:true; - let env = Array.map (Unix.environment ()) fun: + let env = Array.map (Unix.environment ()) f: begin fun s -> if Str.string_match pat:~"TERM=" s pos:0 then "TERM=dumb" else s end in let load_path = - List2.flat_map !Config.load_path fun:(fun dir -> ["-I"; dir]) in + List2.flat_map !Config.load_path f:(fun dir -> ["-I"; dir]) in let modern = if !Clflags.classic then [] else ["-label"] in let warnings = - if List.mem item:"-w" progargs || !warnings = "A" then [] + if List.mem "-w" progargs || !warnings = "A" then [] else ["-w"; !warnings] in let args = Array.of_list (progargs @ modern @ warnings @ load_path) in @@ -299,7 +299,7 @@ let f :prog :title = if l = [] then () else let name = List.hd l in current_dir := Filename.dirname name; - if Filename.check_suffix name suff:".ml" + if Filename.check_suffix name ".ml" then let cmd = "#use \"" ^ name ^ "\";;\n" in sh#insert cmd; sh#send cmd) @@ -312,8 +312,8 @@ let f :prog :title = if l = [] then () else let name = List.hd l in current_dir := Filename.dirname name; - if Filename.check_suffix name suff:".cmo" or - Filename.check_suffix name suff:".cma" + if Filename.check_suffix name ".cmo" or + Filename.check_suffix name ".cma" then let cmd = "#load \"" ^ name ^ "\";;\n" in sh#insert cmd; sh#send cmd) @@ -321,7 +321,7 @@ let f :prog :title = file_menu#add_command "Import path" command: begin fun () -> List.iter (List.rev !Config.load_path) - fun:(fun dir -> sh#send ("#directory \"" ^ dir ^ "\";;\n")) + f:(fun dir -> sh#send ("#directory \"" ^ dir ^ "\";;\n")) end; file_menu#add_command "Close" command:(fun () -> destroy tl); history_menu#add_command "Previous " accelerator:"M-p" diff --git a/otherlibs/labltk/browser/typecheck.ml b/otherlibs/labltk/browser/typecheck.ml index 90cd1aca5..2cdf33bb7 100644 --- a/otherlibs/labltk/browser/typecheck.ml +++ b/otherlibs/labltk/browser/typecheck.ml @@ -34,7 +34,7 @@ let f txt = txt.psignature <- []; try - if Filename.check_suffix txt.name suff:".mli" then + if Filename.check_suffix txt.name ".mli" then let psign = Parse.interface (Lexing.from_string text) in txt.psignature <- psign; txt.signature <- Typemod.transl_signature !env psign @@ -42,7 +42,7 @@ let f txt = else (* others are interpreted as .ml *) let psl = Parse.use_file (Lexing.from_string text) in - List.iter psl fun: + List.iter psl f: begin function Ptop_def pstr -> let str, sign, env' = Typemod.type_structure !env pstr in diff --git a/otherlibs/labltk/browser/useunix.ml b/otherlibs/labltk/browser/useunix.ml index 9d29cc050..056bd6709 100644 --- a/otherlibs/labltk/browser/useunix.ml +++ b/otherlibs/labltk/browser/useunix.ml @@ -38,7 +38,7 @@ let is_directory name = with _ -> false let get_directories_in_files :path = - List.filter pred:(fun x -> is_directory (path ^ "/" ^ x)) + List.filter f:(fun x -> is_directory (path ^ "/" ^ x)) (************************************************** Subshell call *) let subshell :cmd = diff --git a/otherlibs/labltk/browser/viewer.ml b/otherlibs/labltk/browser/viewer.ml index e5943f096..1711ee112 100644 --- a/otherlibs/labltk/browser/viewer.ml +++ b/otherlibs/labltk/browser/viewer.ml @@ -24,17 +24,18 @@ open Searchpos open Searchid let list_modules :path = - List.fold_left path acc:[] fun: - begin fun :acc dir -> + List.fold_left path init:[] f: + begin fun modules dir -> let l = List.filter (Useunix.get_files_in_directory dir) - pred:(fun x -> Filename.check_suffix x suff:".cmi") in - let l = List.map l fun: + f:(fun x -> Filename.check_suffix x ".cmi") in + let l = List.map l f: begin fun x -> - String.capitalize (Filename.chop_suffix x suff:".cmi") + String.capitalize (Filename.chop_suffix x ".cmi") end in - List.fold_left l :acc - fun:(fun :acc item -> if List.mem acc :item then acc else item :: acc) + List.fold_left l init:modules + f:(fun modules item -> + if List.mem item modules then modules else item :: modules) end let reset_modules box = @@ -93,7 +94,7 @@ let choose_symbol :title :env ?:signature ?:path l = (fun (li1, _) (li2,_) -> string_of_longident li1 < string_of_longident li2) in - let nl = List.map l fun: + let nl = List.map l f: begin fun (li, k) -> string_of_longident li ^ " (" ^ string_of_kind k ^ ")" end in @@ -106,7 +107,7 @@ let choose_symbol :title :env ?:signature ?:path l = if List.length nl > 9 then ignore (Jg_multibox.add_scrollbar box); Jg_multibox.add_completion box action: begin fun pos -> - let li, k = List.nth l :pos in + let li, k = List.nth l pos in let path = match path, li with None, Ldot (lip, _) -> @@ -177,7 +178,7 @@ let search_symbol () = Focus.set ew; Jg_bind.return_invoke ew button:search; - Textvariable.set which to:!search_which; + Textvariable.set which !search_which; pack [itself; extype; iotype] side:`Left anchor:`W; pack [search; ok] side:`Left fill:`X expand:true; pack [coe ew; coe choice; coe buttons] @@ -217,7 +218,7 @@ let view_defined modlid :env = let close_all_views () = List.iter !top_widgets - fun:(fun tl -> try destroy tl with Protocol.TkError _ -> ()); + f:(fun tl -> try destroy tl with Protocol.TkError _ -> ()); top_widgets := [] @@ -239,14 +240,15 @@ let start_shell () = Jg_entry.create entries command:(fun _ -> Button.invoke ok) and e2 = Jg_entry.create entries command:(fun _ -> Button.invoke ok) - and names = List.map fun:fst (Shell.get_all ()) in + and names = List.map f:fst (Shell.get_all ()) in Entry.insert e1 index:`End text:!default_shell; - while List.mem names item:("Shell #" ^ string_of_int !shell_counter) do + let shell_name () = "Shell #" ^ string_of_int !shell_counter in + while List.mem (shell_name ()) names do incr shell_counter done; - Entry.insert e2 index:`End text:("Shell #" ^ string_of_int !shell_counter); + Entry.insert e2 index:`End text:(shell_name ()); Button.configure ok command:(fun () -> - if not (List.mem names item:(Entry.get e2)) then begin + if not (List.mem (Entry.get e2) names) then begin default_shell := Entry.get e1; Shell.f prog:!default_shell title:(Entry.get e2); destroy tl diff --git a/otherlibs/labltk/builtin/builtin_GetBitmap.ml b/otherlibs/labltk/builtin/builtin_GetBitmap.ml index b031b0ff9..060d77d32 100644 --- a/otherlibs/labltk/builtin/builtin_GetBitmap.ml +++ b/otherlibs/labltk/builtin/builtin_GetBitmap.ml @@ -1,8 +1,8 @@ (* Tk_GetBitmap emulation *) (* type *) type bitmap = [ - | `File string (* path of file *) - | `Predefined string (* bitmap name *) + | `File of string (* path of file *) + | `Predefined of string (* bitmap name *) ] (* /type *) diff --git a/otherlibs/labltk/builtin/builtin_GetCursor.ml b/otherlibs/labltk/builtin/builtin_GetCursor.ml index f922f071d..543fbc19c 100644 --- a/otherlibs/labltk/builtin/builtin_GetCursor.ml +++ b/otherlibs/labltk/builtin/builtin_GetCursor.ml @@ -1,7 +1,7 @@ (* Color *) (* type *) type color = [ - | `Color string + | `Color of string | `Black (* tk keyword: black *) | `White (* tk keyword: white *) | `Red (* tk keyword: red *) @@ -14,11 +14,11 @@ type color = [ (* Tk_GetCursor emulation *) (* type *) type cursor = [ - | `Xcursor string - | `Xcursorfg string * color - | `Xcursorfgbg string * color * color - | `Cursorfilefg string * color - | `Cursormaskfile string * string * color * color + | `Xcursor of string + | `Xcursorfg of string * color + | `Xcursorfgbg of string * color * color + | `Cursorfilefg of string * color + | `Cursormaskfile of string * string * color * color ] (* /type *) diff --git a/otherlibs/labltk/builtin/builtin_GetPixel.ml b/otherlibs/labltk/builtin/builtin_GetPixel.ml index c08473488..017893470 100644 --- a/otherlibs/labltk/builtin/builtin_GetPixel.ml +++ b/otherlibs/labltk/builtin/builtin_GetPixel.ml @@ -1,11 +1,11 @@ (* Tk_GetPixels emulation *) (* type *) type units = [ - | `Pix int - | `Cm float - | `In float - | `Mm float - | `Pt float + | `Pix of int + | `Cm of float + | `In of float + | `Mm of float + | `Pt of float ] (* /type *) diff --git a/otherlibs/labltk/builtin/builtin_ScrollValue.ml b/otherlibs/labltk/builtin/builtin_ScrollValue.ml index f3ab019c0..250fd2eda 100644 --- a/otherlibs/labltk/builtin/builtin_ScrollValue.ml +++ b/otherlibs/labltk/builtin/builtin_ScrollValue.ml @@ -1,8 +1,8 @@ (* type *) type scrollValue = [ - | `Page(int) (* tk option: scroll <int> page *) - | `Unit(int) (* tk option: scroll <int> unit *) - | `Moveto(float) (* tk option: moveto <float> *) + | `Page of int (* tk option: scroll <int> page *) + | `Unit of int (* tk option: scroll <int> unit *) + | `Moveto of float (* tk option: moveto <float> *) ] (* /type *) diff --git a/otherlibs/labltk/builtin/builtin_bind.ml b/otherlibs/labltk/builtin/builtin_bind.ml index 8cd3194ab..7a6480ebb 100644 --- a/otherlibs/labltk/builtin/builtin_bind.ml +++ b/otherlibs/labltk/builtin/builtin_bind.ml @@ -5,9 +5,9 @@ open Widget (* type *) type event = [ | `ButtonPress (* also Button, but we omit it *) - | `ButtonPressDetail (int) + | `ButtonPressDetail of int | `ButtonRelease - | `ButtonReleaseDetail (int) + | `ButtonReleaseDetail of int | `Circulate | `ColorMap | `Configure @@ -18,9 +18,9 @@ type event = [ | `FocusOut | `Gravity | `KeyPress (* also Key, but we omit it *) - | `KeyPressDetail (string) (* /usr/include/X11/keysymdef.h *) + | `KeyPressDetail of string (* /usr/include/X11/keysymdef.h *) | `KeyRelease - | `KeyReleaseDetail (string) + | `KeyReleaseDetail of string | `Leave | `Map | `Motion @@ -28,7 +28,7 @@ type event = [ | `Reparent | `Unmap | `Visibility - | `Modified modifier list * event + | `Modified of modifier list * event ] and modifier = [ @@ -178,7 +178,7 @@ let wrapeventInfo f (what : eventField list) = ev_RootY = 0 } in function args -> let l = ref args in - List.iter fun:(function field -> + List.iter f:(function field -> match !l with | [] -> () | v :: rest -> filleventInfo ev v field; l := rest) diff --git a/otherlibs/labltk/builtin/builtin_bindtags.ml b/otherlibs/labltk/builtin/builtin_bindtags.ml index 3ea204c70..a775188ee 100644 --- a/otherlibs/labltk/builtin/builtin_bindtags.ml +++ b/otherlibs/labltk/builtin/builtin_bindtags.ml @@ -1,7 +1,7 @@ (* type *) type bindings = [ - | `Tag(string) (* tk option: <string> *) - | `Widget(any widget) (* tk option: <widget> *) + | `Tag of string (* tk option: <string> *) + | `Widget of any widget (* tk option: <widget> *) ] (* /type *) diff --git a/otherlibs/labltk/builtin/builtin_index.ml b/otherlibs/labltk/builtin/builtin_index.ml index 7b2f369ed..750019b1c 100644 --- a/otherlibs/labltk/builtin/builtin_index.ml +++ b/otherlibs/labltk/builtin/builtin_index.ml @@ -5,51 +5,51 @@ *) type canvas_index = [ - | `Num(int) - | `End - | `Insert - | `Selfirst - | `Sellast - | `Atxy(int * int) + | `Num of int + | `End + | `Insert + | `Selfirst + | `Sellast + | `Atxy of int * int ] type entry_index = [ - | `Num(int) + | `Num of int | `End - | `Insert - | `Selfirst - | `Sellast - | `At(int) + | `Insert + | `Selfirst + | `Sellast + | `At of int | `Anchor ] type listbox_index = [ - | `Num(int) + | `Num of int | `Active | `Anchor | `End - | `Atxy(int * int) + | `Atxy of int * int ] type menu_index = [ - | `Num(int) + | `Num of int | `Active | `End - | `Last - | `None - | `At(int) - | `Pattern(string) + | `Last + | `None + | `At of int + | `Pattern of string ] type text_index = [ - | `Linechar(int * int) - | `Atxy(int * int) + | `Linechar of int * int + | `Atxy of int * int | `End - | `Mark(string) - | `Tagfirst(string) - | `Taglast(string) - | `Window(any widget) - | `Image(string) + | `Mark of string + | `Tagfirst of string + | `Taglast of string + | `Window of any widget + | `Image of string ] type linechar_index = int * int diff --git a/otherlibs/labltk/builtin/builtin_palette.ml b/otherlibs/labltk/builtin/builtin_palette.ml index 1859d8649..5c327f9f5 100644 --- a/otherlibs/labltk/builtin/builtin_palette.ml +++ b/otherlibs/labltk/builtin/builtin_palette.ml @@ -1,7 +1,7 @@ (* type *) type paletteType = [ - | `Gray (int) - | `Rgb (int * int * int) + | `Gray of int + | `Rgb of int * int * int ] (* /type *) diff --git a/otherlibs/labltk/builtin/builtin_text.ml b/otherlibs/labltk/builtin/builtin_text.ml index 0d57d457b..f81c7f2fb 100644 --- a/otherlibs/labltk/builtin/builtin_text.ml +++ b/otherlibs/labltk/builtin/builtin_text.ml @@ -10,8 +10,8 @@ type textTag = string (* type *) type textModifier = [ - | `Char(int) (* tk keyword: +/- Xchars *) - | `Line(int) (* tk keyword: +/- Xlines *) + | `Char of int (* tk keyword: +/- Xchars *) + | `Line of int (* tk keyword: +/- Xlines *) | `Linestart (* tk keyword: linestart *) | `Lineend (* tk keyword: lineend *) | `Wordstart (* tk keyword: wordstart *) diff --git a/otherlibs/labltk/builtin/builtini_bind.ml b/otherlibs/labltk/builtin/builtini_bind.ml index 61e0baa61..d6d708d4d 100644 --- a/otherlibs/labltk/builtin/builtini_bind.ml +++ b/otherlibs/labltk/builtin/builtini_bind.ml @@ -44,11 +44,11 @@ let cCAMLtoTKevent (ev : event) = | `Unmap -> "Unmap" | `Visibility -> "Visibility" | `Modified(ml, ev) -> - String.concat sep:"" (List.map fun:cCAMLtoTKmodifier ml) + String.concat sep:"" (List.map f:cCAMLtoTKmodifier ml) ^ convert ev in "<" ^ convert ev ^ ">" let cCAMLtoTKeventSequence (l : event list) = - TkToken(String.concat sep:"" (List.map fun:cCAMLtoTKevent l)) + TkToken(String.concat sep:"" (List.map f:cCAMLtoTKevent l)) diff --git a/otherlibs/labltk/builtin/builtini_index.ml b/otherlibs/labltk/builtin/builtini_index.ml index 5940a27ec..e30160066 100644 --- a/otherlibs/labltk/builtin/builtini_index.ml +++ b/otherlibs/labltk/builtin/builtini_index.ml @@ -28,7 +28,7 @@ let cCAMLtoTKtext_index = (cCAMLtoTKindex : text_index -> tkArgs) let cTKtoCAMLtext_index s = try - let p = String.index char:'.' s in + let p = String.index s '.' in `Linechar (int_of_string (String.sub s pos:0 len:p), int_of_string (String.sub s pos:(p + 1) len:(String.length s - p - 1))) diff --git a/otherlibs/labltk/builtin/builtini_text.ml b/otherlibs/labltk/builtin/builtini_text.ml index 076c29fd5..99b85f875 100644 --- a/otherlibs/labltk/builtin/builtini_text.ml +++ b/otherlibs/labltk/builtin/builtini_text.ml @@ -23,7 +23,7 @@ let cCAMLtoTKtextIndex (i : textIndex) = let ppTextIndex (base, ml : textIndex) = match cCAMLtoTKtext_index base with TkToken ppbase -> - String.concat sep:"" (ppbase :: List.map fun:ppTextModifier ml) + String.concat sep:"" (ppbase :: List.map f:ppTextModifier ml) | _ -> assert false in TkToken (ppTextIndex i) diff --git a/otherlibs/labltk/builtin/dialog.ml b/otherlibs/labltk/builtin/dialog.ml index 257661b5e..bd8262489 100644 --- a/otherlibs/labltk/builtin/dialog.ml +++ b/otherlibs/labltk/builtin/dialog.ml @@ -7,6 +7,6 @@ let create :parent :title :message :buttons ?:name TkToken message; cCAMLtoTKbitmap bitmap; TkToken (string_of_int default); - TkTokenList (List.map fun:(fun x -> TkToken x) buttons)|] + TkTokenList (List.map f:(fun x -> TkToken x) buttons)|] in int_of_string res diff --git a/otherlibs/labltk/builtin/optionmenu.ml b/otherlibs/labltk/builtin/optionmenu.ml index 3ade5d57d..0fcba9b13 100644 --- a/otherlibs/labltk/builtin/optionmenu.ml +++ b/otherlibs/labltk/builtin/optionmenu.ml @@ -9,7 +9,7 @@ let create :parent :variable ?:name values = tkEval [|TkToken "tk_optionMenu"; TkToken (Widget.name w); cCAMLtoTKtextVariable variable; - TkTokenList (List.map fun:(fun x -> TkToken x) values)|] in + TkTokenList (List.map f:(fun x -> TkToken x) values)|] in if res <> Widget.name mw then raise (TkError "internal error in Optionmenu.create") else diff --git a/otherlibs/labltk/builtin/selection_handle_set.ml b/otherlibs/labltk/builtin/selection_handle_set.ml index 9d05bb059..2a7fe8b4c 100644 --- a/otherlibs/labltk/builtin/selection_handle_set.ml +++ b/otherlibs/labltk/builtin/selection_handle_set.ml @@ -7,7 +7,7 @@ selection_handle_icccm_optionals (fun opts w -> cCAMLtoTKwidget w; let id = register_callback w callback:(function args -> let a1 = int_of_string (List.hd args) in - let a2 = int_of_string (List.nth args pos:1) in + let a2 = int_of_string (List.nth args 1) in tkreturn (cmd pos:a1 len:a2)) in TkToken ("camlcb " ^ id) |]) diff --git a/otherlibs/labltk/compiler/compile.ml b/otherlibs/labltk/compiler/compile.ml index 888668d30..fc8e195f6 100644 --- a/otherlibs/labltk/compiler/compile.ml +++ b/otherlibs/labltk/compiler/compile.ml @@ -39,7 +39,7 @@ let small s = Char.chr(Char.code(s.[i]) - (Char.code 'A' - Char.code 'a')) else s.[i] in - sout := !sout ^ (String.make len:1 c) + sout := !sout ^ (String.make 1 c) done; !sout @@ -47,7 +47,7 @@ let small_ident s = let idents = ["to"; "raise"; "in"; "class"; "new"] in let s = small s in - if List.mem item:s idents then (String.make len:1 s.[0]) ^ s + if List.mem s idents then (String.make 1 s.[0]) ^ s else s let gettklabel fc = @@ -61,17 +61,17 @@ let gettklabel fc = let count item:x l = let count = ref 0 in - List.iter fun:(fun y -> if x = y then incr count) l; + List.iter f:(fun y -> if x = y then incr count) l; !count (* Extract all types from a template *) let rec types_of_template = function StringArg _ -> [] | TypeArg (l, t) -> [l, t] - | ListArg l -> List.flatten (List.map fun:types_of_template l) + | ListArg l -> List.flatten (List.map f:types_of_template l) | OptionalArgs (l, tl, _) -> begin - match List.flatten (List.map fun:types_of_template tl) with + match List.flatten (List.map f:types_of_template tl) with ["", t] -> ["?" ^ l, t] | [_, _] -> raise (Failure "0 label required") | _ -> raise (Failure "0 or more than 1 args in for optionals") @@ -97,10 +97,10 @@ let ppMLtype ?(:any=false) ?(:return=false) ?(:def=false) ?(:counter=ref 0) = else begin try - let typdef = Hashtbl.find types_table key:sup in - let fcl = List.assoc key:sub typdef.subtypes in - let tklabels = List.map fun:gettklabel fcl in - let l = List.map fcl fun: + let typdef = Hashtbl.find types_table sup in + let fcl = List.assoc sub typdef.subtypes in + let tklabels = List.map f:gettklabel fcl in + let l = List.map fcl f: begin fun fc -> "?" ^ begin let p = gettklabel fc in if count item:p tklabels > 1 then small fc.ml_name else p @@ -113,7 +113,7 @@ let ppMLtype ?(:any=false) ?(:return=false) ?(:def=false) ?(:counter=ref 0) = | l -> "(" ^ String.concat sep:"*" (List.map l - fun:(fun lt -> ppMLtype (labeloff lt at:"ppMLtype"))) + f:(fun lt -> ppMLtype (labeloff lt at:"ppMLtype"))) ^ ")" end in String.concat sep:" ->\n" l @@ -121,14 +121,14 @@ let ppMLtype ?(:any=false) ?(:return=false) ?(:def=false) ?(:counter=ref 0) = Not_found -> Printf.eprintf "ppMLtype %s/%s\n" sup sub; exit (-1) end | List ty -> (ppMLtype ty) ^ " list" - | Product tyl -> String.concat sep:" * " (List.map fun:ppMLtype tyl) + | Product tyl -> String.concat sep:" * " (List.map f:ppMLtype tyl) | Record tyl -> String.concat sep:" * " - (List.map tyl fun:(fun (l, t) -> labelstring l ^ ppMLtype t)) + (List.map tyl f:(fun (l, t) -> labelstring l ^ ppMLtype t)) | Subtype ("widget", sub) -> sub ^ " widget" | UserDefined "widget" -> if any then "any widget" else - let c = String.make len:1 (Char.chr(Char.code 'a' + !counter)) + let c = String.make 1 (Char.chr(Char.code 'a' + !counter)) in incr counter; "'" ^ c ^ " widget" @@ -136,19 +136,19 @@ let ppMLtype ?(:any=false) ?(:return=false) ?(:def=false) ?(:counter=ref 0) = (* a bit dirty hack for ImageBitmap and ImagePhoto *) begin try - let typdef = Hashtbl.find types_table key:s in + let typdef = Hashtbl.find types_table s in if typdef.variant then if return then try "[>" ^ String.concat sep:"|" - (List.map typdef.constructors fun: + (List.map typdef.constructors f: begin fun c -> "`" ^ c.var_name ^ (match types_of_template c.template with [] -> "" - | l -> " " ^ ppMLtype (Product (List.map l - fun:(labeloff at:"ppMLtype UserDefined")))) + | l -> " of " ^ ppMLtype (Product (List.map l + f:(labeloff at:"ppMLtype UserDefined")))) end) ^ "]" with Not_found -> prerr_endline ("ppMLtype " ^ s ^ " ?"); s @@ -163,7 +163,7 @@ let ppMLtype ?(:any=false) ?(:return=false) ?(:def=false) ?(:counter=ref 0) = raise (Failure "Function (Product tyl) ? ppMLtype") | Function (Record tyl) -> "(" ^ String.concat sep:" -> " - (List.map tyl fun:(fun (l, t) -> labelstring l ^ ppMLtype t)) + (List.map tyl f:(fun (l, t) -> labelstring l ^ ppMLtype t)) ^ " -> unit)" | Function ty -> "(" ^ (ppMLtype ty) ^ " -> unit)" @@ -175,13 +175,13 @@ let ppMLtype ?(:any=false) ?(:return=false) ?(:def=false) ?(:counter=ref 0) = let rec ppTemplate = function StringArg s -> s | TypeArg (l, t) -> "<" ^ ppMLtype t ^ ">" - | ListArg l -> "{" ^ String.concat sep:" " (List.map fun:ppTemplate l) ^ "}" + | ListArg l -> "{" ^ String.concat sep:" " (List.map f:ppTemplate l) ^ "}" | OptionalArgs (l, tl, d) -> - "?" ^ l ^ "{" ^ String.concat sep:" " (List.map fun:ppTemplate tl) - ^ "}[<" ^ String.concat sep:" " (List.map fun:ppTemplate d) ^ ">]" + "?" ^ l ^ "{" ^ String.concat sep:" " (List.map f:ppTemplate tl) + ^ "}[<" ^ String.concat sep:" " (List.map f:ppTemplate d) ^ ">]" let doc_of_template = function - ListArg l -> String.concat sep:" " (List.map fun:ppTemplate l) + ListArg l -> String.concat sep:" " (List.map f:ppTemplate l) | t -> ppTemplate t (* @@ -195,7 +195,7 @@ let write_constructor :w {ml_name = mlconstr; template = t} = [] -> () | l -> w " of "; w (ppMLtype any:true (Product (List.map l - fun:(labeloff at:"write_constructor")))) + f:(labeloff at:"write_constructor")))) end; w " (* tk option: "; w (doc_of_template t); w " *)" @@ -204,7 +204,7 @@ let write_constructors :w = function [] -> fatal_error "empty type" | x :: l -> write_constructor :w x; - List.iter l fun: + List.iter l f: begin fun x -> w "\n | "; write_constructor :w x @@ -217,16 +217,16 @@ let write_variant :w {ml_name = mlconstr; var_name = varname; template = t} = begin match types_of_template t with [] -> () | l -> - w " "; + w " of "; w (ppMLtype any:true def:true - (Product (List.map l fun:(labeloff at:"write_variant")))) + (Product (List.map l f:(labeloff at:"write_variant")))) end; w " (* tk option: "; w (doc_of_template t); w " *)" let write_variants :w = function [] -> fatal_error "empty variants" | l -> - List.iter l fun: + List.iter l f: begin fun x -> w "\n | "; write_variant :w x @@ -305,7 +305,7 @@ let rec wrapper_code fname of:ty = let vnames = varnames prefix:"a" (List.length tyl) in (* getting the arguments *) let readarg = - List.map2 vnames tyl fun: + List.map2 vnames tyl f: begin fun v (l, ty) -> match type_parser_arity ty with OneToken -> @@ -319,7 +319,7 @@ let rec wrapper_code fname of:ty = end in String.concat sep:"" readarg ^ fname ^ " " ^ String.concat sep:" " - (List.map2 fun:(fun v (l, _) -> labelstring l ^ v) vnames tyl) + (List.map2 f:(fun v (l, _) -> labelstring l ^ v) vnames tyl) (* all other types are read in one operation *) | List ty -> @@ -359,7 +359,7 @@ type mini_parser = let can_generate_parser constructors = let pp = {zeroary = []; intpar = []; stringpar = []} in - if List.for_all constructors pred: + if List.for_all constructors f: begin fun c -> match c.template with ListArg [StringArg s] -> @@ -398,7 +398,7 @@ let write_TKtoCAML :w name def:typdef = w (" with _ ->\n") end; w (" match n with\n"); - List.iter pp.zeroary fun: + List.iter pp.zeroary f: begin fun (tk, ml) -> w " | \""; w tk; w "\" -> "; w ml; w "\n" end; @@ -413,7 +413,7 @@ let write_TKtoCAML :w name def:typdef = in begin write :name consts:typdef.constructors; - List.iter typdef.subtypes fun: begin + List.iter typdef.subtypes f: begin fun (subname, consts) -> write name:(subname ^ "_" ^ name) :consts end end @@ -489,14 +489,14 @@ let code_of_template :context_widget ?(func:funtemplate=false) template = let rec coderec = function StringArg s -> "TkToken \"" ^ s ^ "\"" | TypeArg (_, List (Subtype (sup, sub) as ty)) -> - let typdef = Hashtbl.find key:sup types_table in - let classdef = List.assoc key:sub typdef.subtypes in + let typdef = Hashtbl.find types_table sup in + let classdef = List.assoc sub typdef.subtypes in let lbl = gettklabel (List.hd classdef) in catch_opts := (sub ^ "_" ^ sup, lbl); newvar := newvar2; "TkTokenList opts" | TypeArg (l, List ty) -> - "TkTokenList (List.map fun:(function x -> " + "TkTokenList (List.map f:(function x -> " ^ converterCAMLtoTK :context_widget "x" as:ty ^ ") " ^ !newvar l ^ ")" | TypeArg (l, Function tyarg) -> @@ -506,12 +506,12 @@ let code_of_template :context_widget ?(func:funtemplate=false) template = | TypeArg (l, ty) -> converterCAMLtoTK :context_widget (!newvar l) as:ty | ListArg l -> "TkQuote (TkTokenList [" - ^ String.concat sep:";\n " (List.map fun:coderec l) ^ "])" + ^ String.concat sep:";\n " (List.map f:coderec l) ^ "])" | OptionalArgs (l, tl, d) -> let nv = !newvar ("?" ^ l) in optionvar := Some nv; (* Store *) - let argstr = String.concat sep:"; " (List.map fun:coderec tl) in - let defstr = String.concat sep:"; " (List.map fun:coderec d) in + let argstr = String.concat sep:"; " (List.map f:coderec tl) in + let defstr = String.concat sep:"; " (List.map f:coderec d) in "TkTokenList (match " ^ nv ^ " with\n" ^ " | Some " ^ nv ^ " -> [" ^ argstr ^ "]\n" ^ " | None -> [" ^ defstr ^ "])" @@ -520,14 +520,14 @@ let code_of_template :context_widget ?(func:funtemplate=false) template = if funtemplate then match template with ListArg l -> - "[|" ^ String.concat sep:";\n " (List.map fun:coderec l) ^ "|]" + "[|" ^ String.concat sep:";\n " (List.map f:coderec l) ^ "|]" | _ -> "[|" ^ coderec template ^ "|]" else match template with ListArg [x] -> coderec x | ListArg l -> "TkTokenList [" ^ - String.concat sep:";\n " (List.map fun:coderec l) ^ + String.concat sep:";\n " (List.map f:coderec l) ^ "]" | _ -> coderec template in @@ -553,7 +553,7 @@ let write_clause :w :context_widget comp = | [x] -> w " "; w (labeloff x at:"write_clause"); warrow() | l -> w " ( "; - w (String.concat sep:", " (List.map fun:(labeloff at:"write_clause") l)); + w (String.concat sep:", " (List.map f:(labeloff at:"write_clause") l)); w ")"; warrow() end; @@ -576,7 +576,7 @@ let write_CAMLtoTK :w def:typdef ?(safetype:st = true) name = end; w (" = function"); List.iter constrs - fun:(fun c -> w "\n | "; write_clause :w :context_widget c); + f:(fun c -> w "\n | "; write_clause :w :context_widget c); w "\n\n\n" in @@ -585,12 +585,12 @@ let write_CAMLtoTK :w def:typdef ?(safetype:st = true) name = if typdef.subtypes == [] then write_one name constrs else - List.iter constrs fun: + List.iter constrs f: begin fun fc -> let code, vars, _, (co, _) = code_of_template context_widget:"dummy" fc.template in if co <> "" then fatal_error "optionals in optionals"; - let vars = List.map fun:snd vars in + let vars = List.map f:snd vars in w "let ccCAMLtoTK"; w name; w "_"; w (small fc.ml_name); w " ("; w (String.concat sep:", " vars); w ") =\n "; w code; w "\n\n" @@ -601,7 +601,7 @@ let rec write_result_parsing :w = function List String -> w "(splitlist res)" | List ty -> - w (" List.map fun: " ^ converterTKtoCAML "(splitlist res)" as:ty) + w (" List.map f: " ^ converterTKtoCAML "(splitlist res)" as:ty) | Product tyl -> raise (Failure "Product -> record was done. ???") | Record tyl -> (* of course all the labels are "" *) let rnames = varnames prefix:"r" (List.length tyl) in @@ -609,7 +609,7 @@ let rec write_result_parsing :w = function w ("\n if List.length l <> " ^ string_of_int (List.length tyl)); w ("\n then Pervasives.raise (TkError (\"unexpected result: \" ^ res))"); w ("\n else "); - List.iter2 rnames tyl fun: + List.iter2 rnames tyl f: begin fun r (l, ty) -> if l <> "" then raise (Failure "lables in return type!!!"); w (" let " ^ r ^ ", l = "); @@ -653,7 +653,7 @@ let write_function :w def = in replace_args u:[] l:[] o:[] (List.rev (variables @ variables2)) in - List.iter (lv@ov) fun:(fun (l, v) -> w " "; w (labelstring l); w v); + List.iter (lv@ov) f:(fun (l, v) -> w " "; w (labelstring l); w v); if co <> "" then begin if lv = [] && ov = [] then w (" ?" ^ lbl ^ ":eta"); w " =\n"; @@ -661,10 +661,10 @@ let write_function :w def = if lv = [] && ov = [] then w (" ?" ^ lbl ^ ":eta"); w " (fun opts"; if uv = [] then w " ()" - else List.iter uv fun:(fun x -> w " "; w x); + else List.iter uv f:(fun x -> w " "; w x); w " ->\n" end else begin - List.iter uv fun:(fun x -> w " "; w x); + List.iter uv f:(fun x -> w " "; w x); if (ov <> [] || lv = []) && uv = [] then w " ()"; w " =\n" end; @@ -727,12 +727,12 @@ let write_external :w def = let write_catch_optionals :w clas def:typdef = if typdef.subtypes = [] then () else - List.iter typdef.subtypes fun: + List.iter typdef.subtypes f: begin fun (subclass, classdefs) -> w ("let " ^ subclass ^ "_" ^ clas ^ "_optionals f = fun\n"); - let tklabels = List.map fun:gettklabel classdefs in + let tklabels = List.map f:gettklabel classdefs in let l = - List.map classdefs fun: + List.map classdefs f: begin fun fc -> (* let code, vars, _, (co, _) = @@ -745,16 +745,16 @@ let write_catch_optionals :w clas def:typdef = small fc.ml_name end in let p = - List.map l fun: + List.map l f: begin fun (s, si, _) -> if s = si then " ?:" ^ s else " ?" ^ s ^ ":" ^ si end in let v = - List.map l fun: + List.map l f: begin fun (_, si, s) -> (* - let vars = List.map fun:snd vars in + let vars = List.map f:snd vars in let vars = String.concat sep:"," vars in "(maycons (fun (" ^ vars ^ ") -> " ^ code ^ ") " ^ si *) @@ -765,6 +765,6 @@ let write_catch_optionals :w clas def:typdef = w " f "; w (String.concat sep:"\n " v); w "\n []"; - w (String.make len:(List.length v) ')'); + w (String.make (List.length v) ')'); w "\n\n" end diff --git a/otherlibs/labltk/compiler/intf.ml b/otherlibs/labltk/compiler/intf.ml index d8e8310aa..4f646df34 100644 --- a/otherlibs/labltk/compiler/intf.ml +++ b/otherlibs/labltk/compiler/intf.ml @@ -24,24 +24,24 @@ let write_create_p :w wname = w "val create :\n ?name:string ->\n"; begin try - let option = Hashtbl.find types_table key:"options" in - let classdefs = List.assoc key:wname option.subtypes in - let tklabels = List.map fun:gettklabel classdefs in - let l = List.map classdefs fun: + let option = Hashtbl.find types_table "options" in + let classdefs = List.assoc wname option.subtypes in + let tklabels = List.map f:gettklabel classdefs in + let l = List.map classdefs f: begin fun fc -> begin let p = gettklabel fc in if count item:p tklabels > 1 then small fc.ml_name else p end, fc.template end in w (String.concat sep:" ->\n" - (List.map l fun: + (List.map l f: begin fun (s, t) -> " ?" ^ s ^ ":" ^(ppMLtype (match types_of_template t with | [t] -> labeloff t at:"write_create_p" | [] -> fatal_error "multiple" - | l -> Product (List.map fun:(labeloff at:"write_create_p") l))) + | l -> Product (List.map f:(labeloff at:"write_create_p") l))) end)) with Not_found -> fatal_error "in write_create_p" end; @@ -72,7 +72,7 @@ let write_function_type :w def = in let counter = ref 0 in List.iter (ls @ os @ us) - fun:(fun (l, t) -> labelprint :w l; w (ppMLtype t :counter); w " -> "); + f:(fun (l, t) -> labelprint :w l; w (ppMLtype t :counter); w " -> "); if (os <> [] || ls = []) && us = [] then w "unit -> "; w (ppMLtype any:true return:true def.result); (* RETURN TYPE !!! *) w " \n"; diff --git a/otherlibs/labltk/compiler/lexer.mll b/otherlibs/labltk/compiler/lexer.mll index a2251b902..337c5cdc2 100644 --- a/otherlibs/labltk/compiler/lexer.mll +++ b/otherlibs/labltk/compiler/lexer.mll @@ -25,10 +25,10 @@ let current_line = ref 1 (* The table of keywords *) -let keyword_table = (Hashtbl.create size:149 : (string, token) Hashtbl.t) +let keyword_table = (Hashtbl.create 149 : (string, token) Hashtbl.t) let _ = List.iter - fun:(fun (str,tok) -> Hashtbl.add keyword_table key:str data:tok) + f:(fun (str,tok) -> Hashtbl.add keyword_table key:str data:tok) [ "int", TYINT; "float", TYFLOAT; @@ -52,7 +52,7 @@ let _ = List.iter (* To buffer string literals *) -let initial_string_buffer = String.create len:256 +let initial_string_buffer = String.create 256 let string_buff = ref initial_string_buffer let string_index = ref 0 @@ -63,7 +63,7 @@ let reset_string_buffer () = let store_string_char c = if !string_index >= String.length (!string_buff) then begin - let new_buff = String.create len:(String.length (!string_buff) * 2) in + let new_buff = String.create (String.length (!string_buff) * 2) in String.blit src:(!string_buff) src_pos:0 dst:new_buff dst_pos:0 len:(String.length (!string_buff)); string_buff := new_buff @@ -85,9 +85,9 @@ let char_for_backslash = function | c -> c let char_for_decimal_code lexbuf i = - Char.chr(100 * (Char.code(Lexing.lexeme_char lexbuf pos:i) - 48) + - 10 * (Char.code(Lexing.lexeme_char lexbuf pos:(i+1)) - 48) + - (Char.code(Lexing.lexeme_char lexbuf pos:(i+2)) - 48)) + Char.chr(100 * (Char.code(Lexing.lexeme_char lexbuf i) - 48) + + 10 * (Char.code(Lexing.lexeme_char lexbuf (i+1)) - 48) + + (Char.code(Lexing.lexeme_char lexbuf (i+2)) - 48)) let saved_string_start = ref 0 @@ -101,7 +101,7 @@ rule main = parse ( '_' ? ['A'-'Z' 'a'-'z' '\192'-'\214' '\216'-'\246' '\248'-'\255' (*'*) '0'-'9' ] ) * { let s = Lexing.lexeme lexbuf in try - Hashtbl.find keyword_table key:s + Hashtbl.find keyword_table s with Not_found -> IDENT s } @@ -134,7 +134,7 @@ and string = parse | '\\' [' ' '\010' '\013' '\009' '\026' '\012'] + { string lexbuf } | '\\' ['\\' '"' 'n' 't' 'b' 'r'] - { store_string_char(char_for_backslash(Lexing.lexeme_char lexbuf pos:1)); + { store_string_char(char_for_backslash(Lexing.lexeme_char lexbuf 1)); string lexbuf } | '\\' ['0'-'9'] ['0'-'9'] ['0'-'9'] { store_string_char(char_for_decimal_code lexbuf 1); @@ -143,10 +143,10 @@ and string = parse { raise (Lexical_error("string not terminated")) } | '\010' { incr current_line; - store_string_char(Lexing.lexeme_char lexbuf pos:0); + store_string_char(Lexing.lexeme_char lexbuf 0); string lexbuf } | _ - { store_string_char(Lexing.lexeme_char lexbuf pos:0); + { store_string_char(Lexing.lexeme_char lexbuf 0); string lexbuf } and comment = parse diff --git a/otherlibs/labltk/compiler/maincompile.ml b/otherlibs/labltk/compiler/maincompile.ml index fd6c7ddc4..23fbd9c47 100644 --- a/otherlibs/labltk/compiler/maincompile.ml +++ b/otherlibs/labltk/compiler/maincompile.ml @@ -84,7 +84,7 @@ let parse_file filename = in an hash table. *) let elements t = let elems = ref [] in - Hashtbl.iter fun:(fun key:_ data:d -> elems := d :: !elems) t; + Hashtbl.iter f:(fun key:_ data:d -> elems := d :: !elems) t; !elems;; (* Verifies that duplicated clauses are semantically equivalent and @@ -111,24 +111,24 @@ let uniq_clauses = function prerr_endline err; fatal_error err end in - let t = Hashtbl.create size:11 in + let t = Hashtbl.create 11 in List.iter l - fun:(fun constr -> + f:(fun constr -> let c = constr.var_name in - if Hashtbl.mem t key:c - then (check_constr constr (Hashtbl.find t key:c)) + if Hashtbl.mem t c + then (check_constr constr (Hashtbl.find t c)) else Hashtbl.add t key:c data:constr); elements t;; let option_hack oc = - if Hashtbl.mem types_table key:"options" then - let typdef = Hashtbl.find types_table key:"options" in + if Hashtbl.mem types_table "options" then + let typdef = Hashtbl.find types_table "options" in let hack = { parser_arity = OneToken; constructors = begin let constrs = - List.map typdef.constructors fun: + List.map typdef.constructors f: begin fun c -> { component = Constructor; ml_name = c.ml_name; @@ -148,7 +148,7 @@ let option_hack oc = variant = false } in write_CAMLtoTK - w:(output_string to:oc) def:hack safetype:false "options_constrs" + w:(output_string oc) def:hack safetype:false "options_constrs" let compile () = verbose_endline "Creating tkgen.ml ..."; @@ -157,25 +157,25 @@ let compile () = let oc'' = open_out_bin (destfile "tkfgen.ml") in let sorted_types = Tsort.sort types_order in verbose_endline " writing types ..."; - List.iter sorted_types fun: + List.iter sorted_types f: begin fun typname -> verbose_string (" " ^ typname ^ " "); try - let typdef = Hashtbl.find types_table key:typname in + let typdef = Hashtbl.find types_table typname in verbose_string "type "; - write_type intf:(output_string to:oc) - impl:(output_string to:oc') + write_type intf:(output_string oc) + impl:(output_string oc') typname def:typdef; verbose_string "C2T "; - write_CAMLtoTK w:(output_string to:oc') typname def:typdef; + write_CAMLtoTK w:(output_string oc') typname def:typdef; verbose_string "T2C "; - if List.mem item:typname !types_returned then - write_TKtoCAML w:(output_string to:oc') typname def:typdef; + if List.mem typname !types_returned then + write_TKtoCAML w:(output_string oc') typname def:typdef; verbose_string "CO "; - write_catch_optionals w:(output_string to:oc') typname def:typdef; + write_catch_optionals w:(output_string oc') typname def:typdef; verbose_endline "." with Not_found -> - if not (List.mem_assoc key:typname !types_external) then + if not (List.mem_assoc typname !types_external) then begin verbose_string "Type "; verbose_string typname; @@ -186,7 +186,7 @@ let compile () = verbose_endline " option hacking ..."; option_hack oc'; verbose_endline " writing functions ..."; - List.iter fun:(write_function w:(output_string to:oc'')) !function_table; + List.iter f:(write_function w:(output_string oc'')) !function_table; close_out oc; close_out oc'; close_out oc''; @@ -195,21 +195,21 @@ let compile () = verbose_endline "Creating tkgen.mli ..."; let oc = open_out_bin (destfile "tkgen.mli") in List.iter (sort_components !function_table) - fun:(write_function_type w:(output_string to:oc)); + f:(write_function_type w:(output_string oc)); close_out oc; verbose_endline "Creating other ml, mli ..."; - Hashtbl.iter module_table fun: + Hashtbl.iter module_table f: begin fun key:wname data:wdef -> verbose_endline (" "^wname); let modname = wname in let oc = open_out_bin (destfile (modname ^ ".ml")) and oc' = open_out_bin (destfile (modname ^ ".mli")) in begin match wdef.module_type with - Widget -> output_string to:oc' ("(* The "^wname^" widget *)\n") - | Family -> output_string to:oc' ("(* The "^wname^" commands *)\n") + Widget -> output_string oc' ("(* The "^wname^" widget *)\n") + | Family -> output_string oc' ("(* The "^wname^" commands *)\n") end; - output_string to:oc "open Protocol\n"; - List.iter fun:(fun s -> output_string s to:oc; output_string s to:oc') + output_string oc "open Protocol\n"; + List.iter f:(fun s -> output_string oc s; output_string oc' s) [ "open Tk\n"; "open Tkintf\n"; "open Widget\n"; @@ -217,17 +217,17 @@ let compile () = ]; begin match wdef.module_type with Widget -> - write_create w:(output_string to:oc) wname; - write_create_p w:(output_string to:oc') wname + write_create w:(output_string oc) wname; + write_create_p w:(output_string oc') wname | Family -> () end; - List.iter fun:(write_function w:(output_string to:oc)) + List.iter f:(write_function w:(output_string oc)) (sort_components wdef.commands); - List.iter fun:(write_function_type w:(output_string to:oc')) + List.iter f:(write_function_type w:(output_string oc')) (sort_components wdef.commands); - List.iter fun:(write_external w:(output_string to:oc)) + List.iter f:(write_external w:(output_string oc)) (sort_components wdef.externals); - List.iter fun:(write_external_type w:(output_string to:oc')) + List.iter f:(write_external_type w:(output_string oc')) (sort_components wdef.externals); close_out oc; close_out oc' @@ -235,27 +235,27 @@ let compile () = (* write the module list for the Makefile *) (* and hack to death until it works *) let oc = open_out_bin (destfile "modules") in - output_string to:oc "WIDGETOBJS="; + output_string oc "WIDGETOBJS="; Hashtbl.iter module_table - fun:(fun key:name data:_ -> - output_string to:oc name; - output_string to:oc ".cmo "); - output_string to:oc "\n"; + f:(fun key:name data:_ -> + output_string oc name; + output_string oc ".cmo "); + output_string oc "\n"; Hashtbl.iter module_table - fun:(fun key:name data:_ -> - output_string to:oc name; - output_string to:oc ".ml "); - output_string to:oc ": tkgen.ml\n\n"; - Hashtbl.iter module_table fun: + f:(fun key:name data:_ -> + output_string oc name; + output_string oc ".ml "); + output_string oc ": tkgen.ml\n\n"; + Hashtbl.iter module_table f: begin fun key:name data:_ -> - output_string to:oc name; - output_string to:oc ".cmo : "; - output_string to:oc name; - output_string to:oc ".ml\n"; - output_string to:oc name; - output_string to:oc ".cmi : "; - output_string to:oc name; - output_string to:oc ".mli\n" + output_string oc name; + output_string oc ".cmo : "; + output_string oc name; + output_string oc ".ml\n"; + output_string oc name; + output_string oc ".cmi : "; + output_string oc name; + output_string oc ".mli\n" end; close_out oc diff --git a/otherlibs/labltk/compiler/printer.ml b/otherlibs/labltk/compiler/printer.ml index 5a74357c3..d4bb5db72 100644 --- a/otherlibs/labltk/compiler/printer.ml +++ b/otherlibs/labltk/compiler/printer.ml @@ -23,7 +23,7 @@ let escape_string s = | _ -> () done; if !more = 0 then s else - let res = String.create len:(String.length s + !more) in + let res = String.create (String.length s + !more) in let j = ref 0 in for i = 0 to String.length s - 1 do let c = s.[i] in @@ -33,7 +33,7 @@ let escape_string s = done; res;; -let escape_char c = if c = '\'' then "\\'" else String.make len:1 c;; +let escape_char c = if c = '\'' then "\\'" else String.make 1 c;; let print_quoted_string s = printf "\"%s\"" (escape_string s);; let print_quoted_char c = printf "'%s'" (escape_char c);; diff --git a/otherlibs/labltk/compiler/tables.ml b/otherlibs/labltk/compiler/tables.ml index 41602b2bf..1ab6d36ff 100644 --- a/otherlibs/labltk/compiler/tables.ml +++ b/otherlibs/labltk/compiler/tables.ml @@ -99,7 +99,7 @@ type module_def = { (******************** The tables ********************) (* the table of all explicitly defined types *) -let types_table = (Hashtbl.create size:37 : (string, type_def) Hashtbl.t) +let types_table = (Hashtbl.create 37 : (string, type_def) Hashtbl.t) (* "builtin" types *) let types_external = ref ([] : (string * parser_arity) list) (* dependancy order *) @@ -109,7 +109,7 @@ let types_returned = ref ([] : string list) (* Function table *) let function_table = ref ([] : fullcomponent list) (* Widget/Module table *) -let module_table = (Hashtbl.create size:37 : (string, module_def) Hashtbl.t) +let module_table = (Hashtbl.create 37 : (string, module_def) Hashtbl.t) (* variant name *) @@ -162,23 +162,23 @@ let new_type typname arity = let is_subtyped s = s = "widget" or try - let typdef = Hashtbl.find types_table key:s in + let typdef = Hashtbl.find types_table s in typdef.subtypes <> [] with Not_found -> false let requires_widget_context s = try - (Hashtbl.find types_table key:s).requires_widget_context + (Hashtbl.find types_table s).requires_widget_context with Not_found -> false let declared_type_parser_arity s = try - (Hashtbl.find types_table key:s).parser_arity + (Hashtbl.find types_table s).parser_arity with Not_found -> - try List.assoc key:s !types_external + try List.assoc s !types_external with Not_found -> prerr_string "Type "; prerr_string s; @@ -210,8 +210,8 @@ let enter_external_type s v = let rec enter_argtype = function Unit | Int | Float | Bool | Char | String -> () | List ty -> enter_argtype ty - | Product tyl -> List.iter fun:enter_argtype tyl - | Record tyl -> List.iter tyl fun:(fun (l,t) -> enter_argtype t) + | Product tyl -> List.iter f:enter_argtype tyl + | Record tyl -> List.iter tyl f:(fun (l,t) -> enter_argtype t) | UserDefined s -> Tsort.add_element types_order s | Subtype (s,_) -> Tsort.add_element types_order s | Function ty -> enter_argtype ty @@ -220,14 +220,14 @@ let rec enter_argtype = function let rec enter_template_types = function StringArg _ -> () | TypeArg (l,t) -> enter_argtype t - | ListArg l -> List.iter fun:enter_template_types l - | OptionalArgs (_,tl,_) -> List.iter fun:enter_template_types tl + | ListArg l -> List.iter f:enter_template_types l + | OptionalArgs (_,tl,_) -> List.iter f:enter_template_types tl (* Find type dependancies on s *) let rec add_dependancies s = function List ty -> add_dependancies s ty - | Product tyl -> List.iter fun:(add_dependancies s) tyl + | Product tyl -> List.iter f:(add_dependancies s) tyl | Subtype(s',_) -> if s <> s' then Tsort.add_relation types_order (s', s) | UserDefined s' -> if s <> s' then Tsort.add_relation types_order (s', s) | Function ty -> add_dependancies s ty @@ -237,20 +237,20 @@ let rec add_dependancies s = let rec add_template_dependancies s = function StringArg _ -> () | TypeArg (l,t) -> add_dependancies s t - | ListArg l -> List.iter fun:(add_template_dependancies s) l - | OptionalArgs (_,tl,_) -> List.iter fun:(add_template_dependancies s) tl + | ListArg l -> List.iter f:(add_template_dependancies s) l + | OptionalArgs (_,tl,_) -> List.iter f:(add_template_dependancies s) tl (* Assumes functions are not nested in products, which is reasonable due to syntax*) let rec has_callback = function StringArg _ -> false | TypeArg (l,Function _ ) -> true | TypeArg _ -> false - | ListArg l -> List.exists pred:has_callback l - | OptionalArgs (_,tl,_) -> List.exists pred:has_callback tl + | ListArg l -> List.exists f:has_callback l + | OptionalArgs (_,tl,_) -> List.exists f:has_callback tl (*** Returned types ***) let really_add ty = - if List.mem item:ty !types_returned then () + if List.mem ty !types_returned then () else types_returned := ty :: !types_returned let rec add_return_type = function @@ -261,8 +261,8 @@ let rec add_return_type = function | Char -> () | String -> () | List ty -> add_return_type ty - | Product tyl -> List.iter fun:add_return_type tyl - | Record tyl -> List.iter tyl fun:(fun (l,t) -> add_return_type t) + | Product tyl -> List.iter f:add_return_type tyl + | Record tyl -> List.iter tyl f:(fun (l,t) -> add_return_type t) | UserDefined s -> really_add s | Subtype (s,_) -> really_add s | Function _ -> fatal_error "unexpected return type (function)" (* whoah *) @@ -299,11 +299,11 @@ let rec find_constructor cname = function (* Enter a type, must not be previously defined *) let enter_type typname ?(:variant = false) arity constructors = - if Hashtbl.mem types_table key:typname then + if Hashtbl.mem types_table typname then raise (Duplicate_Definition ("type", typname)) else let typdef = new_type typname arity in if variant then typdef.variant <- true; - List.iter constructors fun: + List.iter constructors f: begin fun c -> if not (check_duplicate_constr false c typdef.constructors) then begin @@ -320,14 +320,14 @@ let enter_type typname ?(:variant = false) arity constructors = let enter_subtype typ arity subtyp constructors = (* Retrieve the type if already defined, else add a new one *) let typdef = - try Hashtbl.find types_table key:typ + try Hashtbl.find types_table typ with Not_found -> new_type typ arity in - if List.mem_assoc key:subtyp typdef.subtypes + if List.mem_assoc subtyp typdef.subtypes then raise (Duplicate_Definition ("subtype", typ ^" "^subtyp)) else begin let real_constructors = - List.map constructors fun: + List.map constructors f: begin function Full c -> if not (check_duplicate_constr true c typdef.constructors) @@ -354,41 +354,41 @@ let enter_subtype typ arity subtyp constructors = all components are assumed to be in Full form *) let retrieve_option optname = let optiontyp = - try Hashtbl.find types_table key:"options" + try Hashtbl.find types_table "options" with Not_found -> raise (Invalid_implicit_constructor optname) in find_constructor optname optiontyp.constructors (* Sort components by type *) -let rec add_sort acc:l obj = +let rec add_sort l obj = match l with [] -> [obj.component ,[obj]] | (s',l)::rest -> if obj.component = s' then (s',obj::l)::rest else - (s',l)::(add_sort acc:rest obj) + (s',l)::(add_sort rest obj) -let separate_components = List.fold_left fun:add_sort acc:[] +let separate_components = List.fold_left f:add_sort init:[] let enter_widget name components = - if Hashtbl.mem module_table key:name then + if Hashtbl.mem module_table name then raise (Duplicate_Definition ("widget/module", name)) else let sorted_components = separate_components components in - List.iter sorted_components fun: + List.iter sorted_components f: begin function Constructor, l -> enter_subtype "options" MultipleToken - name (List.map fun:(fun c -> Full c) l) + name (List.map f:(fun c -> Full c) l) | Command, l -> - List.iter fun:enter_component_types l + List.iter f:enter_component_types l | External, _ -> () end; let commands = - try List.assoc key:Command sorted_components + try List.assoc Command sorted_components with Not_found -> [] and externals = - try List.assoc key:External sorted_components + try List.assoc External sorted_components with Not_found -> [] in Hashtbl.add module_table key:name @@ -402,20 +402,20 @@ let enter_function comp = (******************** Modules ********************) let enter_module name components = - if Hashtbl.mem module_table key:name then + if Hashtbl.mem module_table name then raise (Duplicate_Definition ("widget/module", name)) else let sorted_components = separate_components components in - List.iter sorted_components fun: + List.iter sorted_components f: begin function Constructor, l -> fatal_error "unexpected Constructor" - | Command, l -> List.iter fun:enter_component_types l + | Command, l -> List.iter f:enter_component_types l | External, _ -> () end; let commands = - try List.assoc key:Command sorted_components + try List.assoc Command sorted_components with Not_found -> [] and externals = - try List.assoc key:External sorted_components + try List.assoc External sorted_components with Not_found -> [] in Hashtbl.add module_table key:name diff --git a/otherlibs/labltk/compiler/tsort.ml b/otherlibs/labltk/compiler/tsort.ml index 4f0d49692..246eca2db 100644 --- a/otherlibs/labltk/compiler/tsort.ml +++ b/otherlibs/labltk/compiler/tsort.ml @@ -62,13 +62,13 @@ let sort order = let q = Queue.create () and result = ref [] in List.iter !order - fun:(function {pred_count = n} as node -> + f:(function {pred_count = n} as node -> if n = 0 then Queue.add node q); begin try while true do let t = Queue.take q in result := t.node :: !result; - List.iter t.successors fun: + List.iter t.successors f: begin fun s -> let n = s.pred_count - 1 in s.pred_count <- n; @@ -78,7 +78,7 @@ let sort order = with Queue.Empty -> List.iter !order - fun:(fun node -> if node.pred_count <> 0 + f:(fun node -> if node.pred_count <> 0 then raise Cyclic) end; !result diff --git a/otherlibs/labltk/jpf/balloon.ml b/otherlibs/labltk/jpf/balloon.ml index c783a0be6..cd8a706e2 100644 --- a/otherlibs/labltk/jpf/balloon.ml +++ b/otherlibs/labltk/jpf/balloon.ml @@ -69,17 +69,17 @@ let put on: w ms: millisec mesg = List.iter [[`Leave]; [`ButtonPress]; [`ButtonRelease]; [`Destroy]; [`KeyPress]; [`KeyRelease]] - fun:(fun events -> bind w :events extend:true action:(fun _ -> reset ())); - List.iter [[`Enter]; [`Motion]] fun: + f:(fun events -> bind w :events extend:true action:(fun _ -> reset ())); + List.iter [[`Enter]; [`Motion]] f: begin fun events -> bind w :events extend:true fields:[`RootX; `RootY] action:(fun ev -> reset (); set ev) end let init () = - let t = Hashtbl.create size:101 in + let t = Hashtbl.create 101 in Protocol.add_destroy_hook (fun w -> - Hashtbl.remove t key:w); + Hashtbl.remove t w); topw := Toplevel.create default_toplevel; Wm.overrideredirect_set !topw to: true; Wm.withdraw !topw; @@ -88,7 +88,7 @@ let init () = pack [!popupw]; bind_class "all" events: [`Enter] extend:true fields:[`Widget] action: begin fun w -> - try Hashtbl.find t key: w.ev_Widget + try Hashtbl.find t w.ev_Widget with Not_found -> Hashtbl.add t key:w.ev_Widget data: (); let x = Option.get w.ev_Widget name: "balloon" class: "Balloon" in diff --git a/otherlibs/labltk/jpf/fileselect.ml b/otherlibs/labltk/jpf/fileselect.ml index e3b08e051..5197102ce 100644 --- a/otherlibs/labltk/jpf/fileselect.ml +++ b/otherlibs/labltk/jpf/fileselect.ml @@ -72,19 +72,19 @@ let dirget = regexp "^\([^\*?[]*/\)\(.*\)" let parse_filter src = (* replace // by / *) - let s = global_replace pat:(regexp "/+") with:"/" src in + let s = global_replace pat:(regexp "/+") templ:"/" src in (* replace /./ by / *) - let s = global_replace pat:(regexp "/\./") with:"/" s in + let s = global_replace pat:(regexp "/\./") templ:"/" s in (* replace ????/../ by "" *) let s = global_replace s pat:(regexp "\([^/]\|[^\./][^/]\|[^/][^\./]\|[^/][^/]+\)/\.\./") - with:"" in + templ:"" in (* replace ????/..$ by "" *) let s = global_replace s pat:(regexp "\([^/]\|[^\./][^/]\|[^/][^\./]\|[^/][^/]+\)/\.\.$") - with:"" in + templ:"" in (* replace ^/../../ by / *) - let s = global_replace pat:(regexp "^\(/\.\.\)+/") with:"/" s in + let s = global_replace pat:(regexp "^\(/\.\.\)+/") templ:"/" s in if string_match pat:dirget s pos:0 then let dirs = matched_group 1 s and ptrn = matched_group 2 s @@ -112,11 +112,11 @@ let get_files_in_directory dir = let rec get_directories_in_files path = List.filter - pred:(fun x -> try (stat (path ^ x)).st_kind = S_DIR with _ -> false) + f:(fun x -> try (stat (path ^ x)).st_kind = S_DIR with _ -> false) let remove_directories path = List.filter - pred:(fun x -> try (stat (path ^ x)).st_kind <> S_DIR with _ -> false) + f:(fun x -> try (stat (path ^ x)).st_kind <> S_DIR with _ -> false) (************************* a nice interface to listbox - from frx_listbox.ml *) @@ -238,8 +238,8 @@ let f :title action:proc filter:deffilter file:deffile :multi :sync = (* get matched file by subshell call. *) let matched_files = remove_directories dirname (ls dirname patternname) in - Textvariable.set filter_var to:filter; - Textvariable.set selection_var to:(dirname ^ deffile); + Textvariable.set filter_var filter; + Textvariable.set selection_var (dirname ^ deffile); Listbox.delete directory_listbox first:(`Num 0) last:`End; Listbox.insert directory_listbox index:`End texts:directories; Listbox.delete filter_listbox first:(`Num 0) last:`End; @@ -259,7 +259,7 @@ let f :title action:proc filter:deffilter file:deffile :multi :sync = if sync then begin selected_files := l; - Textvariable.set sync_var to:"1" + Textvariable.set sync_var "1" end else begin @@ -273,7 +273,7 @@ let f :title action:proc filter:deffilter file:deffile :multi :sync = begin fun () -> let files = List.map (Listbox.curselection filter_listbox) - fun:(fun x -> !current_dir ^ (Listbox.get filter_listbox index:x)) + f:(fun x -> !current_dir ^ (Listbox.get filter_listbox index:x)) in let files = if files = [] then [Textvariable.get selection_var] else files in @@ -294,7 +294,7 @@ let f :title action:proc filter:deffilter file:deffile :multi :sync = let action _ = let files = List.map (Listbox.curselection filter_listbox) - fun:(fun x -> !current_dir ^ (Listbox.get filter_listbox index:x)) + f:(fun x -> !current_dir ^ (Listbox.get filter_listbox index:x)) in activate files () in diff --git a/otherlibs/labltk/support/fileevent.ml b/otherlibs/labltk/support/fileevent.ml index 3fd4243dd..b2710d75c 100644 --- a/otherlibs/labltk/support/fileevent.ml +++ b/otherlibs/labltk/support/fileevent.ml @@ -29,7 +29,7 @@ external rem_file_output : file_descr -> unit (* File input handlers *) -let fd_table = Hashtbl.create size:37 (* Avoid space leak in callback table *) +let fd_table = Hashtbl.create 37 (* Avoid space leak in callback table *) let add_fileinput :fd callback:f = let id = new_function_id () in @@ -42,9 +42,9 @@ let add_fileinput :fd callback:f = let remove_fileinput :fd = try - let id = Hashtbl.find fd_table key:(fd, 'r') in + let id = Hashtbl.find fd_table (fd, 'r') in clear_callback id; - Hashtbl.remove fd_table key:(fd, 'r'); + Hashtbl.remove fd_table (fd, 'r'); if !Protocol.debug then begin prerr_string "clear "; Protocol.prerr_cbid id; @@ -65,9 +65,9 @@ let add_fileoutput :fd callback:f = let remove_fileoutput :fd = try - let id = Hashtbl.find fd_table key:(fd, 'w') in + let id = Hashtbl.find fd_table (fd, 'w') in clear_callback id; - Hashtbl.remove fd_table key:(fd, 'w'); + Hashtbl.remove fd_table (fd, 'w'); if !Protocol.debug then begin prerr_string "clear "; Protocol.prerr_cbid id; diff --git a/otherlibs/labltk/support/protocol.ml b/otherlibs/labltk/support/protocol.ml index 9d7cb2e1f..9de095826 100644 --- a/otherlibs/labltk/support/protocol.ml +++ b/otherlibs/labltk/support/protocol.ml @@ -57,10 +57,10 @@ let debug = let dump_args args = let rec print_arg = function TkToken s -> prerr_string s; prerr_string " " - | TkTokenList l -> List.iter fun:print_arg l + | TkTokenList l -> List.iter f:print_arg l | TkQuote a -> prerr_string "{"; print_arg a; prerr_string "} " in - Array.iter fun:print_arg args; + Array.iter f:print_arg args; prerr_newline() (* @@ -92,10 +92,10 @@ let cTKtoCAMLwidget = function let callback_naming_table = - (Hashtbl.create size:401 : (int, callback_buffer -> unit) Hashtbl.t) + (Hashtbl.create 401 : (int, callback_buffer -> unit) Hashtbl.t) let callback_memo_table = - (Hashtbl.create size:401 : (any widget, int) Hashtbl.t) + (Hashtbl.create 401 : (any widget, int) Hashtbl.t) let new_function_id = let counter = ref 0 in @@ -113,15 +113,15 @@ let register_callback w callback:f = (string_of_cbid id) let clear_callback id = - Hashtbl.remove callback_naming_table key:id + Hashtbl.remove callback_naming_table id (* Clear callbacks associated to a given widget *) let remove_callbacks w = let w = forget_type w in - let cb_ids = Hashtbl.find_all callback_memo_table key:w in - List.iter fun:clear_callback cb_ids; + let cb_ids = Hashtbl.find_all callback_memo_table w in + List.iter f:clear_callback cb_ids; for i = 1 to List.length cb_ids do - Hashtbl.remove callback_memo_table key:w + Hashtbl.remove callback_memo_table w done (* Hand-coded callback for destroyed widgets @@ -140,7 +140,7 @@ let install_cleanup () = let call_destroy_hooks = function [wname] -> let w = cTKtoCAMLwidget wname in - List.iter fun:(fun f -> f w) !destroy_hooks + List.iter f:(fun f -> f w) !destroy_hooks | _ -> raise (TkError "bad cleanup callback") in let fid = new_function_id () in Hashtbl.add callback_naming_table key:fid data:call_destroy_hooks; @@ -155,10 +155,10 @@ let prerr_cbid id = let dispatch_callback id args = if !debug then begin prerr_cbid id; - List.iter fun:(fun x -> prerr_string " "; prerr_string x) args; + List.iter f:(fun x -> prerr_string " "; prerr_string x) args; prerr_newline() end; - (Hashtbl.find callback_naming_table key:id) args; + (Hashtbl.find callback_naming_table id) args; if !debug then prerr_endline "<<-" let protected_dispatch id args = diff --git a/otherlibs/labltk/support/textvariable.ml b/otherlibs/labltk/support/textvariable.ml index adeb85032..18568988f 100644 --- a/otherlibs/labltk/support/textvariable.ml +++ b/otherlibs/labltk/support/textvariable.ml @@ -21,18 +21,18 @@ external internal_tracevar : string -> cbid -> unit = "camltk_trace_var" external internal_untracevar : string -> cbid -> unit = "camltk_untrace_var" -external set : string -> to:string -> unit = "camltk_setvar" +external set : string -> string -> unit = "camltk_setvar" external get : string -> string = "camltk_getvar" type textVariable = string (* List of handles *) -let handles = Hashtbl.create size:401 +let handles = Hashtbl.create 401 let add_handle var cbid = try - let r = Hashtbl.find handles key:var in + let r = Hashtbl.find handles var in r := cbid :: !r with Not_found -> @@ -48,9 +48,9 @@ let exceptq x = let rem_handle var cbid = try - let r = Hashtbl.find handles key:var in + let r = Hashtbl.find handles var in match exceptq cbid !r with - [] -> Hashtbl.remove handles key:var + [] -> Hashtbl.remove handles var | remaining -> r := remaining with Not_found -> () @@ -60,9 +60,9 @@ let rem_handle var cbid = *) let rem_all_handles var = try - let r = Hashtbl.find handles key:var in - List.iter fun:(internal_untracevar var) !r; - Hashtbl.remove handles key:var + let r = Hashtbl.find handles var in + List.iter f:(internal_untracevar var) !r; + Hashtbl.remove handles var with Not_found -> () @@ -85,31 +85,31 @@ let handle vname f = module StringSet = Set.Make(struct type t = string let compare = compare end) let freelist = ref (StringSet.empty) -let memo = Hashtbl.create size:101 +let memo = Hashtbl.create 101 (* Added a variable v referenced by widget w *) let add w v = let w = Widget.forget_type w in let r = - try Hashtbl.find memo key:w + try Hashtbl.find memo w with Not_found -> let r = ref StringSet.empty in Hashtbl.add memo key:w data:r; r in - r := StringSet.add !r item:v + r := StringSet.add v !r (* to be used with care ! *) let free v = rem_all_handles v; - freelist := StringSet.add item:v !freelist + freelist := StringSet.add v !freelist (* Free variables associated with a widget *) let freew w = try - let r = Hashtbl.find memo key:w in - StringSet.iter fun:free !r; - Hashtbl.remove memo key:w + let r = Hashtbl.find memo w in + StringSet.iter f:free !r; + Hashtbl.remove memo w with Not_found -> () @@ -125,9 +125,9 @@ let getv () = end else let v = StringSet.choose !freelist in - freelist := StringSet.remove item:v !freelist; + freelist := StringSet.remove v !freelist; v in - set v to:""; + set v ""; v let create ?on: w () = @@ -141,7 +141,7 @@ let create ?on: w () = (* to be used with care ! *) let free v = - freelist := StringSet.add item:v !freelist + freelist := StringSet.add v !freelist let cCAMLtoTKtextVariable s = TkToken s diff --git a/otherlibs/labltk/support/textvariable.mli b/otherlibs/labltk/support/textvariable.mli index f2e22a828..0b4a7a535 100644 --- a/otherlibs/labltk/support/textvariable.mli +++ b/otherlibs/labltk/support/textvariable.mli @@ -25,7 +25,7 @@ type textVariable val create : ?on: 'a widget -> unit -> textVariable (* Allocation of a textVariable with lifetime associated to widget if a widget is specified *) -val set : textVariable -> to: string -> unit +val set : textVariable -> string -> unit (* Setting the val of a textVariable *) val get : textVariable -> string (* Reading the val of a textVariable *) diff --git a/otherlibs/labltk/support/widget.ml b/otherlibs/labltk/support/widget.ml index 883d8624f..0ec71c09a 100644 --- a/otherlibs/labltk/support/widget.ml +++ b/otherlibs/labltk/support/widget.ml @@ -50,7 +50,7 @@ let forget_type w = (Obj.magic (w : 'a widget) : any widget) let coe = forget_type (* table of widgets *) -let table = (Hashtbl.create size:401 : (string, any widget) Hashtbl.t) +let table = (Hashtbl.create 401 : (string, any widget) Hashtbl.t) let name = function Untyped s -> s @@ -75,13 +75,13 @@ let dummy = Untyped "dummy" let remove w = - Hashtbl.remove table key:(name w) + Hashtbl.remove table (name w) (* Retype widgets returned from Tk *) (* JPF report: sometime s is "", see Protocol.cTKtoCAMLwidget *) let get_atom s = try - Hashtbl.find table key:s + Hashtbl.find table s with Not_found -> Untyped s @@ -103,7 +103,7 @@ let naming_scheme = [ "toplevel", "top" ] -let widget_any_table = List.map fun:fst naming_scheme +let widget_any_table = List.map f:fst naming_scheme (* subtypes *) let widget_button_table = [ "button" ] and widget_canvas_table = [ "canvas" ] @@ -123,7 +123,7 @@ and widget_toplevel_table = [ "toplevel" ] let new_suffix clas n = try - (List.assoc key:clas naming_scheme) ^ (string_of_int n) + (List.assoc clas naming_scheme) ^ (string_of_int n) with Not_found -> "w" ^ (string_of_int n) @@ -165,11 +165,11 @@ let check_class w clas = match w with Untyped _ -> () (* assume run-time check by tk*) | Typed(_,c) -> - if List.mem clas item:c then () + if List.mem c clas then () else raise (IllegalWidgetType c) (* Checking membership of constructor in subtype table *) let chk_sub errname table c = - if List.mem table item:c then () + if List.mem c table then () else raise (Invalid_argument errname) diff --git a/otherlibs/str/str.mli b/otherlibs/str/str.mli index 146930adf..06051db70 100644 --- a/otherlibs/str/str.mli +++ b/otherlibs/str/str.mli @@ -114,27 +114,28 @@ val group_end: int -> int (*** Replacement *) -val global_replace: pat:regexp -> with:string -> string -> string - (* [global_replace regexp repl s] returns a string identical to [s], +val global_replace: pat:regexp -> templ:string -> string -> string + (* [global_replace regexp templ s] returns a string identical to [s], except that all substrings of [s] that match [regexp] have been - replaced by [repl]. The replacement text [repl] can contain + replaced by [templ]. The replacement template [templ] can contain [\1], [\2], etc; these sequences will be replaced by the text matched by the corresponding group in the regular expression. [\0] stands for the text matched by the whole regular expression. *) -val replace_first: pat:regexp -> with:string -> string -> string +val replace_first: pat:regexp -> templ:string -> string -> string (* Same as [global_replace], except that only the first substring matching the regular expression is replaced. *) val global_substitute: - pat:regexp -> with:(string -> string) -> string -> string + pat:regexp -> subst:(string -> string) -> string -> string (* [global_substitute regexp subst s] returns a string identical to [s], except that all substrings of [s] that match [regexp] have been replaced by the result of function [subst]. The function [subst] is called once for each matching substring, and receives [s] (the whole text) as argument. *) -val substitute_first: pat:regexp -> with:(string -> string) -> string -> string +val substitute_first: + pat:regexp -> subst:(string -> string) -> string -> string (* Same as [global_substitute], except that only the first substring matching the regular expression is replaced. *) -val replace_matched : string -> string -> string +val replace_matched : templ:string -> string -> string (* [replace_matched repl s] returns the replacement text [repl] in which [\1], [\2], etc. have been replaced by the text matched by the corresponding groups in the most recent matching @@ -175,16 +176,16 @@ val bounded_full_split: sep:regexp -> string -> int -> split_result list (*** Extracting substrings *) -val string_before: string -> pos:int -> string +val string_before: string -> int -> string (* [string_before s n] returns the substring of all characters of [s] that precede position [n] (excluding the character at position [n]). *) -val string_after: string -> pos:int -> string +val string_after: string -> int -> string (* [string_after s n] returns the substring of all characters of [s] that follow position [n] (including the character at position [n]). *) -val first_chars: string -> pos:int -> string +val first_chars: string -> len:int -> string (* [first_chars s n] returns the first [n] characters of [s]. This is the same function as [string_before]. *) -val last_chars: string -> pos:int -> string +val last_chars: string -> len:int -> string (* [last_chars s n] returns the last [n] characters of [s]. *) diff --git a/otherlibs/systhreads/event.mli b/otherlibs/systhreads/event.mli index 082df6d10..2214117b4 100644 --- a/otherlibs/systhreads/event.mli +++ b/otherlibs/systhreads/event.mli @@ -26,7 +26,7 @@ val new_channel: unit -> 'a channel type 'a event (* The type of communication events returning a result of type ['a]. *) -val send: to:'a channel -> 'a -> unit event +val send: 'a channel -> 'a -> unit event (* [send ch v] returns the event consisting in sending the value [v] over the channel [ch]. The result value of this event is [()]. *) val receive: 'a channel -> 'a event @@ -39,11 +39,11 @@ val always: 'a -> 'a event val choose: 'a event list -> 'a event (* [choose evl] returns the event that is the alternative of all the events in the list [evl]. *) -val wrap: 'a event -> fun:('a -> 'b) -> 'b event +val wrap: 'a event -> f:('a -> 'b) -> 'b event (* [wrap ev fn] returns the event that performs the same communications as [ev], then applies the post-processing function [fn] on the return value. *) -val wrap_abort: 'a event -> fun:(unit -> unit) -> 'a event +val wrap_abort: 'a event -> f:(unit -> unit) -> 'a event (* [wrap_abort ev fn] returns the event that performs the same communications as [ev], but if it is not selected the function [fn] is called after the synchronization. *) diff --git a/otherlibs/systhreads/threadUnix.mli b/otherlibs/systhreads/threadUnix.mli index 12e2e7522..3f94cd1f3 100644 --- a/otherlibs/systhreads/threadUnix.mli +++ b/otherlibs/systhreads/threadUnix.mli @@ -26,7 +26,7 @@ val execv : prog:string -> args:string array -> unit val execve : prog:string -> args:string array -> env:string array -> unit val execvp : prog:string -> args:string array -> unit val wait : unit -> int * Unix.process_status -val waitpid : flags:Unix.wait_flag list -> int -> int * Unix.process_status +val waitpid : mode:Unix.wait_flag list -> int -> int * Unix.process_status val system : string -> Unix.process_status (*** Basic input/output *) @@ -72,11 +72,11 @@ val socket : domain:Unix.socket_domain -> val accept : Unix.file_descr -> Unix.file_descr * Unix.sockaddr val connect : Unix.file_descr -> Unix.sockaddr -> unit val recv : Unix.file_descr -> buf:string -> - pos:int -> len:int -> flags:Unix.msg_flag list -> int + pos:int -> len:int -> mode:Unix.msg_flag list -> int val recvfrom : Unix.file_descr -> buf:string -> pos:int -> len:int -> - flags:Unix.msg_flag list -> int * Unix.sockaddr + mode:Unix.msg_flag list -> int * Unix.sockaddr val send : Unix.file_descr -> buf:string -> pos:int -> len:int -> - flags:Unix.msg_flag list -> int + mode:Unix.msg_flag list -> int val sendto : Unix.file_descr -> buf:string -> pos:int -> len:int -> - flags:Unix.msg_flag list -> addr:Unix.sockaddr -> int + mode:Unix.msg_flag list -> addr:Unix.sockaddr -> int val open_connection : Unix.sockaddr -> in_channel * out_channel diff --git a/otherlibs/threads/event.mli b/otherlibs/threads/event.mli index 082df6d10..2214117b4 100644 --- a/otherlibs/threads/event.mli +++ b/otherlibs/threads/event.mli @@ -26,7 +26,7 @@ val new_channel: unit -> 'a channel type 'a event (* The type of communication events returning a result of type ['a]. *) -val send: to:'a channel -> 'a -> unit event +val send: 'a channel -> 'a -> unit event (* [send ch v] returns the event consisting in sending the value [v] over the channel [ch]. The result value of this event is [()]. *) val receive: 'a channel -> 'a event @@ -39,11 +39,11 @@ val always: 'a -> 'a event val choose: 'a event list -> 'a event (* [choose evl] returns the event that is the alternative of all the events in the list [evl]. *) -val wrap: 'a event -> fun:('a -> 'b) -> 'b event +val wrap: 'a event -> f:('a -> 'b) -> 'b event (* [wrap ev fn] returns the event that performs the same communications as [ev], then applies the post-processing function [fn] on the return value. *) -val wrap_abort: 'a event -> fun:(unit -> unit) -> 'a event +val wrap_abort: 'a event -> f:(unit -> unit) -> 'a event (* [wrap_abort ev fn] returns the event that performs the same communications as [ev], but if it is not selected the function [fn] is called after the synchronization. *) diff --git a/otherlibs/threads/threadUnix.mli b/otherlibs/threads/threadUnix.mli index f8e37c7f9..39e5858e4 100644 --- a/otherlibs/threads/threadUnix.mli +++ b/otherlibs/threads/threadUnix.mli @@ -26,7 +26,7 @@ val execv : prog:string -> args:string array -> unit val execve : prog:string -> args:string array -> env:string array -> unit val execvp : prog:string -> args:string array -> unit val wait : unit -> int * Unix.process_status -val waitpid : flags:Unix.wait_flag list -> int -> int * Unix.process_status +val waitpid : mode:Unix.wait_flag list -> int -> int * Unix.process_status val system : string -> Unix.process_status (*** Basic input/output *) @@ -76,14 +76,14 @@ val socketpair : domain:Unix.socket_domain -> type:Unix.socket_type -> val accept : Unix.file_descr -> Unix.file_descr * Unix.sockaddr val connect : Unix.file_descr -> Unix.sockaddr -> unit val recv : Unix.file_descr -> buf:string -> - pos:int -> len:int -> flags:Unix.msg_flag list -> int + pos:int -> len:int -> mode:Unix.msg_flag list -> int val recvfrom : Unix.file_descr -> buf:string -> pos:int -> len:int -> - flags:Unix.msg_flag list -> int * Unix.sockaddr + mode:Unix.msg_flag list -> int * Unix.sockaddr val send : Unix.file_descr -> buf:string -> pos:int -> len:int -> - flags:Unix.msg_flag list -> int + mode:Unix.msg_flag list -> int val sendto : Unix.file_descr -> buf:string -> pos:int -> len:int -> - flags:Unix.msg_flag list -> addr:Unix.sockaddr -> int + mode:Unix.msg_flag list -> addr:Unix.sockaddr -> int val open_connection : Unix.sockaddr -> in_channel * out_channel val establish_server : - fun:(in:in_channel -> out:out_channel -> 'a) -> + (in_channel -> out_channel -> 'a) -> addr:Unix.sockaddr -> unit diff --git a/otherlibs/unix/unix.mli b/otherlibs/unix/unix.mli index eeb6aedcf..acd62a799 100644 --- a/otherlibs/unix/unix.mli +++ b/otherlibs/unix/unix.mli @@ -256,9 +256,9 @@ type seek_command = the current position, [SEEK_END] relative to the end of the file. *) -val lseek : file_descr -> pos:int -> mode:seek_command -> int +val lseek : file_descr -> int -> mode:seek_command -> int (* Set the current position for a file descriptor *) -val truncate : name:string -> len:int -> unit +val truncate : file:string -> len:int -> unit (* Truncates the named file to the given size. *) val ftruncate : file_descr -> len:int -> unit (* Truncates the file corresponding to the given descriptor @@ -780,9 +780,9 @@ type socket_option = | SO_OOBINLINE (* Leave out-of-band data in line *) (* The socket options settable with [setsockopt]. *) -val getsockopt : file_descr -> key:socket_option -> bool +val getsockopt : file_descr -> socket_option -> bool (* Return the current status of an option in the given socket. *) -val setsockopt : file_descr -> key:socket_option -> bool -> unit +val setsockopt : file_descr -> socket_option -> bool -> unit (* Set or clear an option in the given socket. *) (*** High-level network connection functions *) @@ -796,7 +796,7 @@ val shutdown_connection : in_channel -> unit (* ``Shut down'' a connection established with [open_connection]; that is, transmit an end-of-file condition to the server reading on the other side of the connection. *) -val establish_server : fun:(in:in_channel -> out:out_channel -> unit) -> +val establish_server : (in_channel -> out_channel -> unit) -> addr:sockaddr -> unit (* Establish a server on the given address. The function given as first argument is called for each connection diff --git a/stdlib/array.mli b/stdlib/array.mli index e98b80cec..f45cac336 100644 --- a/stdlib/array.mli +++ b/stdlib/array.mli @@ -29,8 +29,8 @@ external set: 'a array -> int -> 'a -> unit = "%array_safe_set" Raise [Invalid_argument "Array.set"] if [n] is outside the range 0 to [Array.length a - 1]. You can also write [a.(n) <- x] instead of [Array.set a n x]. *) -external make: len:int -> 'a -> 'a array = "make_vect" -external create: len:int -> 'a -> 'a array = "make_vect" +external make: int -> 'a -> 'a array = "make_vect" +external create: int -> 'a -> 'a array = "make_vect" (* [Array.make n x] returns a fresh array of length [n], initialized with [x]. All the elements of this new array are initially @@ -42,7 +42,7 @@ external create: len:int -> 'a -> 'a array = "make_vect" If the value of [x] is a floating-point number, then the maximum size is only [Sys.max_array_length / 2]. [Array.create] is a deprecated alias for [Array.make]. *) -val init: len:int -> fun:(int -> 'a) -> 'a array +val init: int -> f:(int -> 'a) -> 'a array (* [Array.init n f] returns a fresh array of length [n], with element number [i] initialized to the result of [f i]. In other terms, [Array.init n f] tabulates the results of [f] @@ -96,24 +96,24 @@ val to_list: 'a array -> 'a list val of_list: 'a list -> 'a array (* [Array.of_list l] returns a fresh array containing the elements of [l]. *) -val iter: fun:('a -> unit) -> 'a array -> unit +val iter: f:('a -> unit) -> 'a array -> unit (* [Array.iter f a] applies function [f] in turn to all the elements of [a]. It is equivalent to [f a.(0); f a.(1); ...; f a.(Array.length a - 1); ()]. *) -val map: fun:('a -> 'b) -> 'a array -> 'b array +val map: f:('a -> 'b) -> 'a array -> 'b array (* [Array.map f a] applies function [f] to all the elements of [a], and builds an array with the results returned by [f]: [[| f a.(0); f a.(1); ...; f a.(Array.length a - 1) |]]. *) -val iteri: fun:(i:int -> 'a -> unit) -> 'a array -> unit -val mapi: fun:(i:int -> 'a -> 'b) -> 'a array -> 'b array +val iteri: f:(int -> 'a -> unit) -> 'a array -> unit +val mapi: f:(int -> 'a -> 'b) -> 'a array -> 'b array (* Same as [Array.iter] and [Array.map] respectively, but the function is applied to the index of the element as first argument, and the element itself as second argument. *) -val fold_left: fun:(acc:'a -> 'b -> 'a) -> acc:'a -> 'b array -> 'a +val fold_left: f:('a -> 'b -> 'a) -> init:'a -> 'b array -> 'a (* [Array.fold_left f x a] computes [f (... (f (f x a.(0)) a.(1)) ...) a.(n-1)], where [n] is the length of the array [a]. *) -val fold_right: fun:('b -> acc:'a -> 'a) -> 'b array -> acc:'a -> 'a +val fold_right: f:('b -> 'a -> 'a) -> 'b array -> init:'a -> 'a (* [Array.fold_right f a x] computes [f a.(0) (f a.(1) ( ... (f a.(n-1) x) ...))], where [n] is the length of the array [a]. *) diff --git a/stdlib/buffer.mli b/stdlib/buffer.mli index 1a2866704..adb7e3038 100644 --- a/stdlib/buffer.mli +++ b/stdlib/buffer.mli @@ -20,7 +20,7 @@ type t (* The abstract type of buffers. *) -val create : size:int -> t +val create : int -> t (* [create n] returns a fresh buffer, initially empty. The [n] parameter is the initial size of the internal string that holds the buffer contents. That string is automatically @@ -63,6 +63,6 @@ val add_channel : t -> in_channel -> len:int -> unit input channel [ic] and stores them at the end of buffer [b]. Raise [End_of_file] if the channel contains fewer than [n] characters. *) -val output_buffer : to:out_channel -> t -> unit +val output_buffer : out_channel -> t -> unit (* [output_buffer oc b] writes the current contents of buffer [b] on the output channel [oc]. *) diff --git a/stdlib/digest.mli b/stdlib/digest.mli index 2da4560db..dcba690f9 100644 --- a/stdlib/digest.mli +++ b/stdlib/digest.mli @@ -32,7 +32,7 @@ external channel: in_channel -> len:int -> t = "md5_chan" and returns their digest. *) val file: string -> t (* Return the digest of the file whose name is given. *) -val output: to:out_channel -> t -> unit +val output: out_channel -> t -> unit (* Write a digest on the given output channel. *) val input: in_channel -> t (* Read a digest from the given input channel. *) diff --git a/stdlib/filename.mli b/stdlib/filename.mli index 1be8239a3..47b00538d 100644 --- a/stdlib/filename.mli +++ b/stdlib/filename.mli @@ -32,10 +32,10 @@ val is_implicit : string -> bool with an explicit reference to the current directory ([./] or [../] in Unix), [false] if it starts with an explicit reference to the root directory or the current directory. *) -val check_suffix : string -> suff:string -> bool +val check_suffix : string -> string -> bool (* [check_suffix name suff] returns [true] if the filename [name] ends with the suffix [suff]. *) -val chop_suffix : string -> suff:string -> string +val chop_suffix : string -> string -> string (* [chop_suffix name suff] removes the suffix [suff] from the filename [name]. The behavior is undefined if [name] does not end with the suffix [suff]. *) diff --git a/stdlib/hashtbl.mli b/stdlib/hashtbl.mli index 9364edac9..41ab86df8 100644 --- a/stdlib/hashtbl.mli +++ b/stdlib/hashtbl.mli @@ -21,7 +21,7 @@ type ('a, 'b) t (* The type of hash tables from type ['a] to type ['b]. *) -val create : size:int -> ('a,'b) t +val create : int -> ('a,'b) t (* [Hashtbl.create n] creates a new, empty hash table, with initial size [n]. For best results, [n] should be on the order of the expected number of elements that will be in @@ -38,25 +38,25 @@ val add : ('a, 'b) t -> key:'a -> data:'b -> unit the previous binding for [x], if any, is restored. (Same behavior as with association lists.) *) -val find : ('a, 'b) t -> key:'a -> 'b +val find : ('a, 'b) t -> 'a -> 'b (* [Hashtbl.find tbl x] returns the current binding of [x] in [tbl], or raises [Not_found] if no such binding exists. *) -val find_all : ('a, 'b) t -> key:'a -> 'b list +val find_all : ('a, 'b) t -> 'a -> 'b list (* [Hashtbl.find_all tbl x] returns the list of all data associated with [x] in [tbl]. The current binding is returned first, then the previous bindings, in reverse order of introduction in the table. *) -val mem : ('a, 'b) t -> key:'a -> bool +val mem : ('a, 'b) t -> 'a -> bool (* [Hashtbl.mem tbl x] checks if [x] is bound in [tbl]. *) -val remove : ('a, 'b) t -> key:'a -> unit +val remove : ('a, 'b) t -> 'a -> unit (* [Hashtbl.remove tbl x] removes the current binding of [x] in [tbl], restoring the previous binding if it exists. It does nothing if [x] is not bound in [tbl]. *) -val iter : fun:(key:'a -> data:'b -> unit) -> ('a, 'b) t -> unit +val iter : f:(key:'a -> data:'b -> unit) -> ('a, 'b) t -> unit (* [Hashtbl.iter f tbl] applies [f] to all bindings in table [tbl]. [f] receives the key as first argument, and the associated value as second argument. The order in which the bindings are passed to @@ -88,14 +88,14 @@ module type S = sig type key type 'a t - val create: size:int -> 'a t + val create: int -> 'a t val clear: 'a t -> unit val add: 'a t -> key:key -> data:'a -> unit - val remove: 'a t -> key:key -> unit - val find: 'a t -> key:key -> 'a - val find_all: 'a t -> key:key -> 'a list - val mem: 'a t -> key:key -> bool - val iter: fun:(key:key -> data:'a -> unit) -> 'a t -> unit + val remove: 'a t -> key -> unit + val find: 'a t -> key -> 'a + val find_all: 'a t -> key -> 'a list + val mem: 'a t -> key -> bool + val iter: f:(key:key -> data:'a -> unit) -> 'a t -> unit end module Make(H: HashedType): (S with type key = H.t) diff --git a/stdlib/lexing.mli b/stdlib/lexing.mli index 240f83a34..d4dfb283a 100644 --- a/stdlib/lexing.mli +++ b/stdlib/lexing.mli @@ -40,7 +40,7 @@ val from_string : string -> lexbuf the given string. Reading starts from the first character in the string. An end-of-input condition is generated when the end of the string is reached. *) -val from_function : (buffer:string -> len:int -> int) -> lexbuf +val from_function : (buf:string -> len:int -> int) -> lexbuf (* Create a lexer buffer with the given function as its reading method. When the scanner needs more characters, it will call the given function, giving it a character string [s] and a character @@ -62,7 +62,7 @@ val from_function : (buffer:string -> len:int -> int) -> lexbuf val lexeme : lexbuf -> string (* [Lexing.lexeme lexbuf] returns the string matched by the regular expression. *) -val lexeme_char : lexbuf -> pos:int -> char +val lexeme_char : lexbuf -> int -> char (* [Lexing.lexeme_char lexbuf i] returns character number [i] in the matched string. *) val lexeme_start : lexbuf -> int diff --git a/stdlib/list.mli b/stdlib/list.mli index e39795887..cb2345353 100644 --- a/stdlib/list.mli +++ b/stdlib/list.mli @@ -33,7 +33,7 @@ val hd : 'a list -> 'a val tl : 'a list -> 'a list (* Return the given list without its first element. Raise [Failure "tl"] if the list is empty. *) -val nth : 'a list -> pos:int -> 'a +val nth : 'a list -> int -> 'a (* Return the n-th element of the given list. The first element (head of the list) is at position 0. Raise [Failure "nth"] if the list is too short. *) @@ -54,49 +54,49 @@ val flatten : 'a list list -> 'a list (** Iterators *) -val iter : fun:('a -> unit) -> 'a list -> unit +val iter : f:('a -> unit) -> 'a list -> unit (* [List.iter f [a1; ...; an]] applies function [f] in turn to [a1; ...; an]. It is equivalent to [begin f a1; f a2; ...; f an; () end]. *) -val map : fun:('a -> 'b) -> 'a list -> 'b list +val map : f:('a -> 'b) -> 'a list -> 'b list (* [List.map f [a1; ...; an]] applies function [f] to [a1, ..., an], and builds the list [[f a1; ...; f an]] with the results returned by [f]. Not tail-recursive. *) -val rev_map : fun:('a -> 'b) -> 'a list -> 'b list +val rev_map : f:('a -> 'b) -> 'a list -> 'b list (* [List.rev_map f l] gives the same result as [List.rev (List.map f l)], but is tail-recursive and more efficient. *) -val fold_left : fun:(acc:'a -> 'b -> 'a) -> acc:'a -> 'b list -> 'a +val fold_left : f:('a -> 'b -> 'a) -> init:'a -> 'b list -> 'a (* [List.fold_left f a [b1; ...; bn]] is [f (... (f (f a b1) b2) ...) bn]. *) -val fold_right : fun:('a -> acc:'b -> 'b) -> 'a list -> acc:'b -> 'b +val fold_right : f:('a -> 'b -> 'b) -> 'a list -> init:'b -> 'b (* [List.fold_right f [a1; ...; an] b] is [f a1 (f a2 (... (f an b) ...))]. Not tail-recursive. *) (** Iterators on two lists *) -val iter2 : fun:('a -> 'b -> unit) -> 'a list -> 'b list -> unit +val iter2 : f:('a -> 'b -> unit) -> 'a list -> 'b list -> unit (* [List.iter2 f [a1; ...; an] [b1; ...; bn]] calls in turn [f a1 b1; ...; f an bn]. Raise [Invalid_argument] if the two lists have different lengths. *) -val map2 : fun:('a -> 'b -> 'c) -> 'a list -> 'b list -> 'c list +val map2 : f:('a -> 'b -> 'c) -> 'a list -> 'b list -> 'c list (* [List.map2 f [a1; ...; an] [b1; ...; bn]] is [[f a1 b1; ...; f an bn]]. Raise [Invalid_argument] if the two lists have different lengths. Not tail-recursive. *) -val rev_map2 : fun:('a -> 'b -> 'c) -> 'a list -> 'b list -> 'c list +val rev_map2 : f:('a -> 'b -> 'c) -> 'a list -> 'b list -> 'c list (* [List.rev_map2 f l] gives the same result as [List.rev (List.map2 f l)], but is tail-recursive and more efficient. *) val fold_left2 : - fun:(acc:'a -> 'b -> 'c -> 'a) -> acc:'a -> 'b list -> 'c list -> 'a + f:('a -> 'b -> 'c -> 'a) -> init:'a -> 'b list -> 'c list -> 'a (* [List.fold_left2 f a [b1; ...; bn] [c1; ...; cn]] is [f (... (f (f a b1 c1) b2 c2) ...) bn cn]. Raise [Invalid_argument] if the two lists have different lengths. *) val fold_right2 : - fun:('a -> 'b -> acc:'c -> 'c) -> 'a list -> 'b list -> acc:'c -> 'c + f:('a -> 'b -> 'c -> 'c) -> 'a list -> 'b list -> init:'c -> 'c (* [List.fold_right2 f [a1; ...; an] [b1; ...; bn] c] is [f a1 b1 (f a2 b2 (... (f an bn c) ...))]. Raise [Invalid_argument] if the two lists have @@ -104,42 +104,42 @@ val fold_right2 : (** List scanning *) -val for_all : pred:('a -> bool) -> 'a list -> bool +val for_all : f:('a -> bool) -> 'a list -> bool (* [for_all p [a1; ...; an]] checks if all elements of the list satisfy the predicate [p]. That is, it returns [(p a1) && (p a2) && ... && (p an)]. *) -val exists : pred:('a -> bool) -> 'a list -> bool +val exists : f:('a -> bool) -> 'a list -> bool (* [exists p [a1; ...; an]] checks if at least one element of the list satisfies the predicate [p]. That is, it returns [(p a1) || (p a2) || ... || (p an)]. *) -val for_all2 : pred:('a -> 'b -> bool) -> 'a list -> 'b list -> bool -val exists2 : pred:('a -> 'b -> bool) -> 'a list -> 'b list -> bool +val for_all2 : f:('a -> 'b -> bool) -> 'a list -> 'b list -> bool +val exists2 : f:('a -> 'b -> bool) -> 'a list -> 'b list -> bool (* Same as [for_all] and [exists], but for a two-argument predicate. Raise [Invalid_argument] if the two lists have different lengths. *) -val mem : item:'a -> 'a list -> bool +val mem : 'a -> 'a list -> bool (* [mem a l] is true if and only if [a] is equal to an element of [l]. *) -val memq : item:'a -> 'a list -> bool +val memq : 'a -> 'a list -> bool (* Same as [mem], but uses physical equality instead of structural equality to compare list elements. *) (** List searching *) -val find : pred:('a -> bool) -> 'a list -> 'a +val find : f:('a -> bool) -> 'a list -> 'a (* [find p l] returns the first element of the list [l] that satisfies the predicate [p]. Raise [Not_found] if there is no value that satisfies [p] in the list [l]. *) -val filter : pred:('a -> bool) -> 'a list -> 'a list -val find_all : pred:('a -> bool) -> 'a list -> 'a list +val filter : f:('a -> bool) -> 'a list -> 'a list +val find_all : f:('a -> bool) -> 'a list -> 'a list (* [filter p l] returns all the elements of the list [l] that satisfies the predicate [p]. The order of the elements in the input list is preserved. [find_all] is another name for [filter]. *) -val partition : pred:('a -> bool) -> 'a list -> 'a list * 'a list +val partition : f:('a -> bool) -> 'a list -> 'a list * 'a list (* [partition p l] returns a pair of lists [(l1, l2)], where [l1] is the list of all the elements of [l] that satisfy the predicate [p], and [l2] is the list of all the @@ -148,30 +148,30 @@ val partition : pred:('a -> bool) -> 'a list -> 'a list * 'a list (** Association lists *) -val assoc : key:'a -> ('a * 'b) list -> 'b +val assoc : 'a -> ('a * 'b) list -> 'b (* [assoc a l] returns the value associated with key [a] in the list of pairs [l]. That is, [assoc a [ ...; (a,b); ...] = b] if [(a,b)] is the leftmost binding of [a] in list [l]. Raise [Not_found] if there is no value associated with [a] in the list [l]. *) -val assq : key:'a -> ('a * 'b) list -> 'b +val assq : 'a -> ('a * 'b) list -> 'b (* Same as [assoc], but uses physical equality instead of structural equality to compare keys. *) -val mem_assoc : key:'a -> ('a * 'b) list -> bool +val mem_assoc : 'a -> ('a * 'b) list -> bool (* Same as [assoc], but simply return true if a binding exists, and false if no bindings exist for the given key. *) -val mem_assq : key:'a -> ('a * 'b) list -> bool +val mem_assq : 'a -> ('a * 'b) list -> bool (* Same as [mem_assoc], but uses physical equality instead of structural equality to compare keys. *) -val remove_assoc : key:'a -> ('a * 'b) list -> ('a * 'b) list +val remove_assoc : 'a -> ('a * 'b) list -> ('a * 'b) list (* [remove_assoc a l] returns the list of pairs [l] without the first pair with key [a], if any. Not tail-recursive. *) -val remove_assq : key:'a -> ('a * 'b) list -> ('a * 'b) list +val remove_assq : 'a -> ('a * 'b) list -> ('a * 'b) list (* Same as [remove_assq], but uses physical equality instead of structural equality to compare keys. Not tail-recursive. *) diff --git a/stdlib/map.mli b/stdlib/map.mli index a49c0b081..780cf3c54 100644 --- a/stdlib/map.mli +++ b/stdlib/map.mli @@ -48,31 +48,31 @@ module type S = (* [add x y m] returns a map containing the same bindings as [m], plus a binding of [x] to [y]. If [x] was already bound in [m], its previous binding disappears. *) - val find: key:key -> 'a t -> 'a + val find: key -> 'a t -> 'a (* [find x m] returns the current binding of [x] in [m], or raises [Not_found] if no such binding exists. *) - val remove: key:key -> 'a t -> 'a t + val remove: key -> 'a t -> 'a t (* [remove x m] returns a map containing the same bindings as [m], except for [x] which is unbound in the returned map. *) - val mem: key:key -> 'a t -> bool + val mem: key -> 'a t -> bool (* [mem x m] returns [true] if [m] contains a binding for [m], and [false] otherwise. *) - val iter: fun:(key:key -> data:'a -> unit) -> 'a t -> unit + val iter: f:(key:key -> data:'a -> unit) -> 'a t -> unit (* [iter f m] applies [f] to all bindings in map [m]. [f] receives the key as first argument, and the associated value as second argument. The order in which the bindings are passed to [f] is unspecified. Only current bindings are presented to [f]: bindings hidden by more recent bindings are not passed to [f]. *) - val map: fun:('a -> 'b) -> 'a t -> 'b t + val map: f:('a -> 'b) -> 'a t -> 'b t (* [map f m] returns a map with same domain as [m], where the associated value [a] of all bindings of [m] has been replaced by the result of the application of [f] to [a]. The order in which the associated values are passed to [f] is unspecified. *) - val mapi: fun:(key:key -> data:'a -> 'b) -> 'a t -> 'b t + val mapi: f:(key -> 'a -> 'b) -> 'a t -> 'b t (* Same as [map], but the function receives as arguments both the key and the associated value for each binding of the map. *) - val fold: fun:(key:key -> data:'a -> acc:'b -> 'b) -> 'a t -> acc:'b -> 'b + val fold: f:(key:key -> data:'a -> 'b -> 'b) -> 'a t -> init:'b -> 'b (* [fold f m a] computes [(f kN dN ... (f k1 d1 a)...)], where [k1 ... kN] are the keys of all bindings in [m], and [d1 ... dN] are the associated data. diff --git a/stdlib/marshal.mli b/stdlib/marshal.mli index d55f175e5..b49eb0def 100644 --- a/stdlib/marshal.mli +++ b/stdlib/marshal.mli @@ -47,7 +47,7 @@ type extern_flags = | Closures (* Send function closures *) (* The flags to the [Marshal.to_*] functions below. *) -external to_channel: out_channel -> data:'a -> flags:extern_flags list -> unit +external to_channel: out_channel -> 'a -> mode:extern_flags list -> unit = "output_value" (* [Marshal.to_channel chan v flags] writes the representation of [v] on channel [chan]. The [flags] argument is a @@ -78,7 +78,7 @@ external to_channel: out_channel -> data:'a -> flags:extern_flags list -> unit at un-marshaling time, using an MD5 digest of the code transmitted along with the code position.) *) -external to_string: data:'a -> flags:extern_flags list -> string +external to_string: 'a -> mode:extern_flags list -> string = "output_value_to_string" (* [Marshal.to_string v flags] returns a string containing the representation of [v] as a sequence of bytes. @@ -86,7 +86,7 @@ external to_string: data:'a -> flags:extern_flags list -> string [Marshal.to_channel]. *) val to_buffer: string -> pos:int -> len:int -> - data:'a -> flags:extern_flags list -> int + 'a -> mode:extern_flags list -> int (* [Marshal.to_buffer buff ofs len v flags] marshals the value [v], storing its byte representation in the string [buff], starting at character number [ofs], and writing at most diff --git a/stdlib/obj.mli b/stdlib/obj.mli index a35316e3b..0a3be860a 100644 --- a/stdlib/obj.mli +++ b/stdlib/obj.mli @@ -25,8 +25,8 @@ external is_block : t -> bool = "obj_is_block" external is_int : t -> bool = "%obj_is_int" external tag : t -> int = "obj_tag" external size : t -> int = "%obj_size" -external field : t -> pos:int -> t = "%obj_field" -external set_field : t -> pos:int -> t -> unit = "%obj_set_field" +external field : t -> int -> t = "%obj_field" +external set_field : t -> int -> t -> unit = "%obj_set_field" external new_block : int -> len:int -> t = "obj_block" external dup : t -> t = "obj_dup" external truncate : t -> len:int -> unit = "obj_truncate" diff --git a/stdlib/pervasives.mli b/stdlib/pervasives.mli index 2b46f0e85..41607f09c 100644 --- a/stdlib/pervasives.mli +++ b/stdlib/pervasives.mli @@ -451,36 +451,36 @@ val flush : out_channel -> unit performing all pending writes on that channel. Interactive programs must be careful about flushing standard output and standard error at the right time. *) -val output_char : to:out_channel -> char -> unit +val output_char : out_channel -> char -> unit (* Write the character on the given output channel. *) -val output_string : to:out_channel -> string -> unit +val output_string : out_channel -> string -> unit (* Write the string on the given output channel. *) val output : out_channel -> buf:string -> pos:int -> len:int -> unit (* Write [len] characters from string [buf], starting at offset [pos], to the given output channel. Raise [Invalid_argument "output"] if [pos] and [len] do not designate a valid substring of [buf]. *) -val output_byte : to:out_channel -> int -> unit +val output_byte : out_channel -> int -> unit (* Write one 8-bit integer (as the single character with that code) on the given output channel. The given integer is taken modulo 256. *) -val output_binary_int : to:out_channel -> int -> unit +val output_binary_int : out_channel -> int -> unit (* Write one integer in binary format on the given output channel. The only reliable way to read it back is through the [input_binary_int] function. The format is compatible across all machines for a given version of Objective Caml. *) -val output_value : to:out_channel -> 'a -> unit +val output_value : out_channel -> 'a -> unit (* Write the representation of a structured value of any type to a channel. Circularities and sharing inside the value are detected and preserved. The object can be read back, by the function [input_value]. See the description of module [Marshal] for more information. [output_value] is equivalent to [Marshal.to_channel] with an empty list of flags. *) -val seek_out : out_channel -> pos:int -> unit - (* Set the current writing position to [pos] for the given channel. - This works only for regular files. On files of other kinds - (such as terminals, pipes and sockets), the behavior is - unspecified. *) +val seek_out : out_channel -> int -> unit + (* [seek_out chan pos] sets the current writing position to [pos] + for channel [chan]. This works only for regular files. On + files of other kinds (such as terminals, pipes and sockets), + the behavior is unspecified. *) val pos_out : out_channel -> int (* Return the current writing position for the given channel. *) val out_channel_length : out_channel -> int @@ -562,10 +562,10 @@ val input_value : in_channel -> 'a This function is identical to [Marshal.from_channel]; see the description of module [Marshal] for more information, in particular concerning the lack of type safety. *) -val seek_in : in_channel -> pos:int -> unit - (* Set the current reading position to [pos] for the given channel. - This works only for regular files. On files of other kinds, - the behavior is unspecified. *) +val seek_in : in_channel -> int -> unit + (* [seek_in chan pos] sets the current reading position to [pos] + for channel [chan]. This works only for regular files. On + files of other kinds, the behavior is unspecified. *) val pos_in : in_channel -> int (* Return the current reading position for the given channel. *) val in_channel_length : in_channel -> int diff --git a/stdlib/queue.mli b/stdlib/queue.mli index c569ae7dc..1f10951a1 100644 --- a/stdlib/queue.mli +++ b/stdlib/queue.mli @@ -36,7 +36,7 @@ val clear : 'a t -> unit (* Discard all elements from a queue. *) val length: 'a t -> int (* Return the number of elements in a queue. *) -val iter: fun:('a -> unit) -> 'a t -> unit +val iter: f:('a -> unit) -> 'a t -> unit (* [iter f q] applies [f] in turn to all elements of [q], from the least recently entered to the most recently entered. The queue itself is unchanged. *) diff --git a/stdlib/set.mli b/stdlib/set.mli index e48cbd4c5..467562743 100644 --- a/stdlib/set.mli +++ b/stdlib/set.mli @@ -46,14 +46,14 @@ module type S = (* The empty set. *) val is_empty: t -> bool (* Test whether a set is empty or not. *) - val mem: item:elt -> t -> bool + val mem: elt -> t -> bool (* [mem x s] tests whether [x] belongs to the set [s]. *) - val add: item:elt -> t -> t + val add: elt -> t -> t (* [add x s] returns a set containing all elements of [s], plus [x]. If [x] was already in [s], [s] is returned unchanged. *) val singleton: elt -> t (* [singleton x] returns the one-element set containing only [x]. *) - val remove: item:elt -> t -> t + val remove: elt -> t -> t (* [remove x s] returns a set containing all elements of [s], except [x]. If [x] was not in [s], [s] is returned unchanged. *) val union: t -> t -> t @@ -69,11 +69,11 @@ module type S = val subset: t -> t -> bool (* [subset s1 s2] tests whether the set [s1] is a subset of the set [s2]. *) - val iter: fun:(elt -> unit) -> t -> unit + val iter: f:(elt -> unit) -> t -> unit (* [iter f s] applies [f] in turn to all elements of [s]. The order in which the elements of [s] are presented to [f] is unspecified. *) - val fold: fun:(elt -> acc:'a -> 'a) -> t -> acc:'a -> 'a + val fold: f:(elt -> 'a -> 'a) -> t -> init:'a -> 'a (* [fold f s a] computes [(f xN ... (f x2 (f x1 a))...)], where [x1 ... xN] are the elements of [s]. The order in which elements of [s] are presented to [f] is diff --git a/stdlib/stack.mli b/stdlib/stack.mli index 7815657c7..b90d56871 100644 --- a/stdlib/stack.mli +++ b/stdlib/stack.mli @@ -33,7 +33,7 @@ val clear : 'a t -> unit (* Discard all elements from a stack. *) val length: 'a t -> int (* Return the number of elements in a stack. *) -val iter: fun:('a -> unit) -> 'a t -> unit +val iter: f:('a -> unit) -> 'a t -> unit (* [iter f s] applies [f] in turn to all elements of [s], from the element at the top of the stack to the element at the bottom of the stack. The stack itself is unchanged. *) diff --git a/stdlib/stream.mli b/stdlib/stream.mli index 31454b570..d12f23255 100644 --- a/stdlib/stream.mli +++ b/stdlib/stream.mli @@ -45,7 +45,7 @@ val of_channel : in_channel -> char t;; (** Stream iterator *) -val iter : fun:('a -> unit) -> 'a t -> unit;; +val iter : f:('a -> unit) -> 'a t -> unit;; (* [Stream.iter f s] scans the whole stream s, applying function [f] in turn to each stream element encountered. *) diff --git a/stdlib/string.mli b/stdlib/string.mli index 9894ebcea..b4dbd8809 100644 --- a/stdlib/string.mli +++ b/stdlib/string.mli @@ -31,12 +31,12 @@ external set : string -> int -> char -> unit = "%string_safe_set" 0 to [(String.length s - 1)]. You can also write [s.[n] <- c] instead of [String.set s n c]. *) -external create : len:int -> string = "create_string" +external create : int -> string = "create_string" (* [String.create n] returns a fresh string of length [n]. The string initially contains arbitrary characters. Raise [Invalid_argument] if [n <= 0] or [n > Sys.max_string_length]. *) -val make : len:int -> char -> string +val make : int -> char -> string (* [String.make n c] returns a fresh string of length [n], filled with the character [c]. Raise [Invalid_argument] if [n <= 0] or [n > Sys.max_string_length]. @@ -76,31 +76,31 @@ val escaped: string -> string by escape sequences, following the lexical conventions of Objective Caml. *) -val index: string -> char:char -> int +val index: string -> char -> int (* [String.index s c] returns the position of the leftmost occurrence of character [c] in string [s]. Raise [Not_found] if [c] does not occur in [s]. *) -val rindex: string -> char:char -> int +val rindex: string -> char -> int (* [String.rindex s c] returns the position of the rightmost occurrence of character [c] in string [s]. Raise [Not_found] if [c] does not occur in [s]. *) -val index_from: string -> pos:int -> char:char -> int -val rindex_from: string -> pos:int -> char:char -> int +val index_from: string -> int -> char -> int +val rindex_from: string -> int -> char -> int (* Same as [String.index] and [String.rindex], but start searching at the character position given as second argument. [String.index s c] is equivalent to [String.index_from s 0 c], and [String.rindex s c] to [String.rindex_from s (String.length s - 1) c]. *) -val contains : string -> char:char -> bool +val contains : string -> char -> bool (* [String.contains s c] tests if character [c] appears in the string [s]. *) -val contains_from : string -> pos:int -> char:char -> bool +val contains_from : string -> int -> char -> bool (* [String.contains_from s start c] tests if character [c] appears in the substring of [s] starting from [start] to the end of [s]. Raise [Invalid_argument] if [start] is not a valid index of [s]. *) -val rcontains_from : string -> pos:int -> char:char -> bool +val rcontains_from : string -> int -> char -> bool (* [String.rcontains_from s stop c] tests if character [c] appears in the substring of [s] starting from the beginning of [s] to index [stop]. diff --git a/stdlib/weak.mli b/stdlib/weak.mli index 5e671fdbd..26192608a 100644 --- a/stdlib/weak.mli +++ b/stdlib/weak.mli @@ -22,7 +22,7 @@ type 'a t;; empty if the object was erased by the GC. *) -val create : len:int -> 'a t;; +val create : int -> 'a t;; (* [Weak.create n] returns a new weak array of length [n]. All the pointers are initially empty. *) @@ -30,20 +30,20 @@ val length : 'a t -> int;; (* [Weak.length ar] returns the length (number of elements) of [ar]. *) -val set : 'a t -> pos:int -> 'a option -> unit;; +val set : 'a t -> int -> 'a option -> unit;; (* [Weak.set ar n (Some el)] sets the [n]th cell of [ar] to be a (full) pointer to [el]; [Weak.set ar n None] sets the [n]th cell of [ar] to empty. Raise [Invalid_argument "Weak.set"] if [n] is not in the range 0 to [Weak.length a - 1]. *) -val get : 'a t -> pos:int -> 'a option;; +val get : 'a t -> int -> 'a option;; (* [Weak.get ar n] returns None if the [n]th cell of [ar] is empty, [Some x] (where [x] is the object) if it is full. Raise [Invalid_argument "Weak.get"] if [n] is not in the range 0 to [Weak.length a - 1]. *) -val check: 'a t -> pos:int -> bool;; +val check: 'a t -> int -> bool;; (* [Weak.check ar n] returns [true] if the [n]th cell of [ar] is full, [false] if it is empty. Note that even if [Weak.check ar n] returns [true], a subsequent [Weak.get ar n] can return [None]. |