diff options
author | Jacques Garrigue <garrigue at math.nagoya-u.ac.jp> | 2001-09-02 13:42:19 +0000 |
---|---|---|
committer | Jacques Garrigue <garrigue at math.nagoya-u.ac.jp> | 2001-09-02 13:42:19 +0000 |
commit | fe2e11a8fb4dcf166ffb7f91e6eb8dd0f4402f25 (patch) | |
tree | 8dff8da7bfc88f25c78afe5340d78daa8c89587c | |
parent | 7e053c39de8693928b83038c1727f5d90228c39d (diff) | |
download | ocaml-fe2e11a8fb4dcf166ffb7f91e6eb8dd0f4402f25.tar.gz |
remove doublonsstrict_labels
git-svn-id: http://caml.inria.fr/svn/ocaml/branches/strict_labels@3687 f963ae5c-01c2-4b8c-9fe0-0dff7051ff02
35 files changed, 91 insertions, 122 deletions
diff --git a/otherlibs/labltk/browser/editor.ml b/otherlibs/labltk/browser/editor.ml index b1900c6765..279098d3da 100644 --- a/otherlibs/labltk/browser/editor.ml +++ b/otherlibs/labltk/browser/editor.ml @@ -113,7 +113,7 @@ let select_shell txt = begin fun () -> try let name = Listbox.get box ~index:`Active in - txt.shell <- Some (name, List.assoc name shells); + txt.shell <- Some (name, List.assoc name ~map:shells); destroy tl with Not_found -> txt.shell <- None; destroy tl end @@ -392,7 +392,7 @@ class editor ~top ~menus = object (self) try if Sys.file_exists name then if txt.name = name then - Sys.rename' ~src:name ~dst:(name ^ "~") + Sys.rename name (name ^ "~") else begin match Jg_message.ask ~master:top ~title:"Save" ("File `" ^ name ^ "' exists. Overwrite it?") @@ -434,7 +434,7 @@ class editor ~top ~menus = object (self) and buf = String.create 4096 in Text.delete tw ~start:tstart ~stop:tend; while - len := input' file ~buf ~pos:0 ~len:4096; + len := input file buf 0 4096; !len > 0 do Jg_text.output tw ~buf ~pos:0 ~len:!len diff --git a/otherlibs/labltk/browser/searchpos.ml b/otherlibs/labltk/browser/searchpos.ml index 18e01e531e..e5c222d6da 100644 --- a/otherlibs/labltk/browser/searchpos.ml +++ b/otherlibs/labltk/browser/searchpos.ml @@ -14,6 +14,7 @@ (* $Id$ *) open StdLabels +open Support open Tk open Jg_tk open Parsetree @@ -235,7 +236,7 @@ let filter_modules () = Hashtbl.remove shown_modules key) shown_modules let add_shown_module path ~widgets = - Hashtbl.add' shown_modules ~key:path ~data:widgets + Hashtbl'.add shown_modules ~key:path ~data:widgets let find_shown_module path = try filter_modules (); diff --git a/otherlibs/labltk/compiler/Makefile b/otherlibs/labltk/compiler/Makefile index 6b215dcbfd..302ad25880 100644 --- a/otherlibs/labltk/compiler/Makefile +++ b/otherlibs/labltk/compiler/Makefile @@ -1,7 +1,7 @@ include ../support/Makefile.common -OBJS=tsort.cmo tables.cmo printer.cmo lexer.cmo parser.cmo \ - compile.cmo intf.cmo maincompile.cmo +OBJS= ../support/support.cmo tsort.cmo tables.cmo printer.cmo lexer.cmo \ + parser.cmo compile.cmo intf.cmo maincompile.cmo tkcompiler : $(OBJS) $(LABLC) $(LINKFLAGS) -o tkcompiler $(OBJS) @@ -25,10 +25,10 @@ install: .SUFFIXES : .mli .ml .cmi .cmo .mlp .mli.cmi: - $(LABLCOMP) $(COMPFLAGS) $< + $(LABLCOMP) $(COMPFLAGS) -I ../support $< .ml.cmo: - $(LABLCOMP) $(COMPFLAGS) $< + $(LABLCOMP) $(COMPFLAGS) -I ../support $< depend: parser.ml parser.mli lexer.ml $(LABLDEP) *.mli *.ml > .depend diff --git a/otherlibs/labltk/compiler/compile.ml b/otherlibs/labltk/compiler/compile.ml index ca51bafcf9..66cfcf7a7d 100644 --- a/otherlibs/labltk/compiler/compile.ml +++ b/otherlibs/labltk/compiler/compile.ml @@ -52,7 +52,7 @@ let gettklabel fc = else s in begin if List.mem s forbidden then - try List.assoc s nicknames + try List.assoc s ~map:nicknames with Not_found -> small fc.var_name else s end @@ -97,7 +97,7 @@ let ppMLtype ?(any=false) ?(return=false) ?(def=false) ?(counter=ref 0) = begin try let typdef = Hashtbl.find types_table sup in - let fcl = List.assoc sub typdef.subtypes in + let fcl = List.assoc sub ~map:typdef.subtypes in let tklabels = List.map ~f:gettklabel fcl in let l = List.map fcl ~f: begin fun fc -> @@ -499,7 +499,7 @@ let code_of_template ~context_widget ?func:(funtemplate=false) template = StringArg s -> "TkToken \"" ^ s ^ "\"" | TypeArg (_, List (Subtype (sup, sub) as ty)) -> let typdef = Hashtbl.find types_table sup in - let classdef = List.assoc sub typdef.subtypes in + let classdef = List.assoc sub ~map:typdef.subtypes in let lbl = gettklabel (List.hd classdef) in catch_opts := (sub ^ "_" ^ sup, lbl); newvar := newvar2; diff --git a/otherlibs/labltk/compiler/intf.ml b/otherlibs/labltk/compiler/intf.ml index 489fa3930e..fdeac2edbb 100644 --- a/otherlibs/labltk/compiler/intf.ml +++ b/otherlibs/labltk/compiler/intf.ml @@ -27,7 +27,7 @@ let write_create_p ~w wname = begin try let option = Hashtbl.find types_table "options" in - let classdefs = List.assoc wname option.subtypes in + let classdefs = List.assoc wname ~map:option.subtypes in let tklabels = List.map ~f:gettklabel classdefs in let l = List.map classdefs ~f: begin fun fc -> diff --git a/otherlibs/labltk/compiler/lexer.mll b/otherlibs/labltk/compiler/lexer.mll index 6daa17fc16..8de3956810 100644 --- a/otherlibs/labltk/compiler/lexer.mll +++ b/otherlibs/labltk/compiler/lexer.mll @@ -19,6 +19,7 @@ open StdLabels open Lexing open Parser +open Support exception Lexical_error of string let current_line = ref 1 @@ -29,7 +30,7 @@ let current_line = ref 1 let keyword_table = (Hashtbl.create 149 : (string, token) Hashtbl.t) let _ = List.iter - ~f:(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; diff --git a/otherlibs/labltk/compiler/maincompile.ml b/otherlibs/labltk/compiler/maincompile.ml index 146c5f08b5..65535df790 100644 --- a/otherlibs/labltk/compiler/maincompile.ml +++ b/otherlibs/labltk/compiler/maincompile.ml @@ -16,6 +16,7 @@ (* $Id$ *) open StdLabels +open Support open Tables open Printer open Compile @@ -118,7 +119,7 @@ let uniq_clauses = function let c = constr.var_name in if Hashtbl.mem t c then (check_constr constr (Hashtbl.find t c)) - else Hashtbl.add' t ~key:c ~data:constr); + else Hashtbl'.add t ~key:c ~data:constr); elements t;; let option_hack oc = @@ -268,11 +269,11 @@ let main () = (fun filename -> input_name := filename) "Usage: tkcompiler <source file>" ; try - verbose_string "Parsing... "; + verbose_endline "Parsing..."; parse_file !input_name; - verbose_string "Compiling... "; + verbose_endline "Compiling..."; compile (); - verbose_string "Finished"; + verbose_endline "Finished"; exit 0 with | Lexer.Lexical_error s -> diff --git a/otherlibs/labltk/compiler/tables.ml b/otherlibs/labltk/compiler/tables.ml index fa8aa502ca..85029b7726 100644 --- a/otherlibs/labltk/compiler/tables.ml +++ b/otherlibs/labltk/compiler/tables.ml @@ -16,6 +16,7 @@ (* $Id$ *) open StdLabels +open Support (* Internal compiler errors *) @@ -155,7 +156,7 @@ let new_type typname arity = subtypes = []; requires_widget_context = false; variant = false} in - Hashtbl.add' types_table ~key:typname ~data:typdef; + Hashtbl'.add types_table ~key:typname ~data:typdef; typdef @@ -180,7 +181,7 @@ let declared_type_parser_arity s = (Hashtbl.find types_table s).parser_arity with Not_found -> - try List.assoc s !types_external + try List.assoc s ~map:!types_external with Not_found -> prerr_string "Type "; prerr_string s; @@ -387,13 +388,13 @@ let enter_widget name components = | External, _ -> () end; let commands = - try List.assoc Command sorted_components + try List.assoc Command ~map:sorted_components with Not_found -> [] and externals = - try List.assoc External sorted_components + try List.assoc External ~map:sorted_components with Not_found -> [] in - Hashtbl.add' module_table ~key:name + Hashtbl'.add module_table ~key:name ~data:{module_type = Widget; commands = commands; externals = externals} (******************** Functions ********************) @@ -414,12 +415,11 @@ let enter_module name components = | External, _ -> () end; let commands = - try List.assoc Command sorted_components + try List.assoc Command ~map:sorted_components with Not_found -> [] and externals = - try List.assoc External sorted_components + try List.assoc External ~map:sorted_components with Not_found -> [] in - Hashtbl.add' module_table ~key:name + Hashtbl'.add module_table ~key:name ~data:{module_type = Family; commands = commands; externals = externals} - diff --git a/otherlibs/labltk/jpf/balloon.ml b/otherlibs/labltk/jpf/balloon.ml index 2ee8177bd4..7b2f2e074f 100644 --- a/otherlibs/labltk/jpf/balloon.ml +++ b/otherlibs/labltk/jpf/balloon.ml @@ -20,6 +20,7 @@ open StdLabels open Tk open Widget open Protocol +open Support (* switch -- if you do not want balloons, set false *) let flag = ref true @@ -92,7 +93,7 @@ let init () = begin fun w -> try Hashtbl.find t w.ev_Widget with Not_found -> - Hashtbl.add' t ~key:w.ev_Widget ~data: (); + Hashtbl'.add t ~key:w.ev_Widget ~data: (); let x = Option.get w.ev_Widget ~name: "balloon" ~clas: "Balloon" in if x <> "" then put ~on: w.ev_Widget ~ms: 1000 x end diff --git a/otherlibs/labltk/support/.depend b/otherlibs/labltk/support/.depend index 8c7b959bf6..c10b37a920 100644 --- a/otherlibs/labltk/support/.depend +++ b/otherlibs/labltk/support/.depend @@ -1,16 +1,16 @@ protocol.cmi: widget.cmi textvariable.cmi: protocol.cmi widget.cmi -fileevent.cmo: protocol.cmi fileevent.cmi -fileevent.cmx: protocol.cmx fileevent.cmi -protocol.cmo: widget.cmi protocol.cmi -protocol.cmx: widget.cmx protocol.cmi +fileevent.cmo: protocol.cmi support.cmi fileevent.cmi +fileevent.cmx: protocol.cmx support.cmx fileevent.cmi +protocol.cmo: support.cmi widget.cmi protocol.cmi +protocol.cmx: support.cmx widget.cmx protocol.cmi slave.cmo: widget.cmi slave.cmx: widget.cmx support.cmo: support.cmi support.cmx: support.cmi -textvariable.cmo: protocol.cmi widget.cmi textvariable.cmi -textvariable.cmx: protocol.cmx widget.cmx textvariable.cmi -timer.cmo: protocol.cmi timer.cmi -timer.cmx: protocol.cmx timer.cmi -widget.cmo: widget.cmi -widget.cmx: widget.cmi +textvariable.cmo: protocol.cmi support.cmi widget.cmi textvariable.cmi +textvariable.cmx: protocol.cmx support.cmx widget.cmx textvariable.cmi +timer.cmo: protocol.cmi support.cmi timer.cmi +timer.cmx: protocol.cmx support.cmx timer.cmi +widget.cmo: support.cmi widget.cmi +widget.cmx: support.cmx widget.cmi diff --git a/otherlibs/labltk/support/fileevent.ml b/otherlibs/labltk/support/fileevent.ml index f6d6e76aad..1e907c7684 100644 --- a/otherlibs/labltk/support/fileevent.ml +++ b/otherlibs/labltk/support/fileevent.ml @@ -16,6 +16,7 @@ (* $Id$ *) open Unix +open Support open Protocol external add_file_input : file_descr -> cbid -> unit @@ -33,8 +34,8 @@ let fd_table = Hashtbl.create 37 (* Avoid space leak in callback table *) let add_fileinput ~fd ~callback:f = let id = new_function_id () in - Hashtbl.add' callback_naming_table ~key:id ~data:(fun _ -> f()); - Hashtbl.add' fd_table ~key:(fd, 'r') ~data:id; + Hashtbl'.add callback_naming_table ~key:id ~data:(fun _ -> f()); + Hashtbl'.add fd_table ~key:(fd, 'r') ~data:id; if !Protocol.debug then begin Protocol.prerr_cbid id; prerr_endline " for fileinput" end; @@ -56,8 +57,8 @@ let remove_fileinput ~fd = let add_fileoutput ~fd ~callback:f = let id = new_function_id () in - Hashtbl.add' callback_naming_table ~key:id ~data:(fun _ -> f()); - Hashtbl.add' fd_table ~key:(fd, 'w') ~data:id; + Hashtbl'.add callback_naming_table ~key:id ~data:(fun _ -> f()); + Hashtbl'.add fd_table ~key:(fd, 'w') ~data:id; if !Protocol.debug then begin Protocol.prerr_cbid id; prerr_endline " for fileoutput" end; diff --git a/otherlibs/labltk/support/protocol.ml b/otherlibs/labltk/support/protocol.ml index 68e2eb993a..7ad8b317e6 100644 --- a/otherlibs/labltk/support/protocol.ml +++ b/otherlibs/labltk/support/protocol.ml @@ -16,6 +16,7 @@ (* $Id$ *) open StdLabels +open Support open Widget type callback_buffer = string list @@ -108,9 +109,9 @@ let string_of_cbid = string_of_int (* The callback should be cleared when w is destroyed *) let register_callback w ~callback:f = let id = new_function_id () in - Hashtbl.add' callback_naming_table ~key:id ~data:f; + Hashtbl'.add callback_naming_table ~key:id ~data:f; if (forget_type w) <> (forget_type Widget.dummy) then - Hashtbl.add' callback_memo_table ~key:(forget_type w) ~data:id; + Hashtbl'.add callback_memo_table ~key:(forget_type w) ~data:id; (string_of_cbid id) let clear_callback id = @@ -144,7 +145,7 @@ let install_cleanup () = 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; + Hashtbl'.add callback_naming_table ~key:fid ~data:call_destroy_hooks; (* setup general destroy callback *) tcl_command ("bind all <Destroy> {camlcb " ^ (string_of_cbid fid) ^" %W}") diff --git a/otherlibs/labltk/support/support.ml b/otherlibs/labltk/support/support.ml index ded07ee995..b6cd5e8c32 100644 --- a/otherlibs/labltk/support/support.ml +++ b/otherlibs/labltk/support/support.ml @@ -47,3 +47,7 @@ let maycons f x l = match x with Some x -> f x :: l | None -> l + +(* Get some labels on Hashtbl.add *) +module Hashtbl' = + struct let add tbl ~key ~data = Hashtbl.add tbl key data end diff --git a/otherlibs/labltk/support/support.mli b/otherlibs/labltk/support/support.mli index 78007e4eff..2eaf9b5e52 100644 --- a/otherlibs/labltk/support/support.mli +++ b/otherlibs/labltk/support/support.mli @@ -18,3 +18,5 @@ val split_str : pred:(char -> bool) -> string -> string list val may : ('a -> 'b) -> 'a option -> 'b option val maycons : ('a -> 'b) -> 'a option -> 'b list -> 'b list +module Hashtbl' : + sig val add : ('a, 'b) Hashtbl.t -> key:'a -> data:'b -> unit end diff --git a/otherlibs/labltk/support/textvariable.ml b/otherlibs/labltk/support/textvariable.ml index e9dd514772..df4c3b92dc 100644 --- a/otherlibs/labltk/support/textvariable.ml +++ b/otherlibs/labltk/support/textvariable.ml @@ -16,6 +16,7 @@ (* $Id$ *) open StdLabels +open Support open Protocol external internal_tracevar : string -> cbid -> unit @@ -37,7 +38,7 @@ let add_handle var cbid = r := cbid :: !r with Not_found -> - Hashtbl.add' handles var (ref [cbid]) + Hashtbl'.add handles var (ref [cbid]) let exceptq x = let rec ex acc = function @@ -75,7 +76,7 @@ let handle vname ~callback:f = clear_callback id; rem_handle vname id; f() in - Hashtbl.add' callback_naming_table ~key:id ~data:wrapped; + Hashtbl'.add callback_naming_table ~key:id ~data:wrapped; add_handle vname id; if !Protocol.debug then begin prerr_cbid id; prerr_string " for variable "; prerr_endline vname @@ -96,7 +97,7 @@ let add w v = with Not_found -> let r = ref StringSet.empty in - Hashtbl.add' memo ~key:w ~data:r; + Hashtbl'.add memo ~key:w ~data:r; r in r := StringSet.add v !r diff --git a/otherlibs/labltk/support/timer.ml b/otherlibs/labltk/support/timer.ml index 9bae936344..349bf6a2e3 100644 --- a/otherlibs/labltk/support/timer.ml +++ b/otherlibs/labltk/support/timer.ml @@ -16,6 +16,7 @@ (* $Id$ *) (* Timers *) +open Support open Protocol type tkTimer = int @@ -33,7 +34,7 @@ let add ~ms ~callback = let wrapped _ = clear_callback id; (* do it first in case f raises exception *) callback() in - Hashtbl.add' callback_naming_table ~key:id ~data:wrapped; + Hashtbl'.add callback_naming_table ~key:id ~data:wrapped; if !Protocol.debug then begin prerr_cbid id; prerr_endline " for timer" end; diff --git a/otherlibs/labltk/support/widget.ml b/otherlibs/labltk/support/widget.ml index 1c89bb5d90..6cc7c74743 100644 --- a/otherlibs/labltk/support/widget.ml +++ b/otherlibs/labltk/support/widget.ml @@ -16,6 +16,7 @@ (* $Id$ *) open StdLabels +open Support (* * Widgets @@ -68,7 +69,7 @@ let known_class = function let default_toplevel = let wname = "." in let w = Typed (wname, "toplevel") in - Hashtbl.add' table ~key:wname ~data:w; + Hashtbl'.add table ~key:wname ~data:w; w (* Dummy widget to which global callbacks are associated *) @@ -125,7 +126,7 @@ and widget_toplevel_table = [ "toplevel" ] let new_suffix clas n = try - (List.assoc clas naming_scheme) ^ (string_of_int n) + (List.assoc clas ~map:naming_scheme) ^ (string_of_int n) with Not_found -> "w" ^ (string_of_int n) @@ -147,7 +148,7 @@ let new_atom ~parent ?name:nom clas = else parentpath ^ "." ^ name in let w = Typed(path,clas) in - Hashtbl.add' table ~key:path ~data:w; + Hashtbl'.add table ~key:path ~data:w; w (* Just create a path. Only to check existence of widgets *) diff --git a/stdlib/Makefile b/stdlib/Makefile index f69f804e49..9a9d58823e 100644 --- a/stdlib/Makefile +++ b/stdlib/Makefile @@ -30,10 +30,10 @@ BASIC=pervasives.cmo array.cmo list.cmo char.cmo string.cmo sys.cmo \ buffer.cmo printf.cmo format.cmo arg.cmo printexc.cmo gc.cmo \ digest.cmo random.cmo oo.cmo genlex.cmo callback.cmo weak.cmo \ lazy.cmo filename.cmo int32.cmo int64.cmo nativeint.cmo -LABELLED=arrayLabels.ml listLabels.ml stringLabels.ml stdLabels.ml +LABELLED=arrayLabels.ml listLabels.ml stringLabels.ml -OBJS=$(BASIC) labelled.cmo -ALLOBJS=$(BASIC) $(LABELLED:.ml=.cmo) +OBJS=$(BASIC) labelled.cmo stdLabels.cmo +ALLOBJS=$(BASIC) $(LABELLED:.ml=.cmo) stdLabels.cmo all: stdlib.cma std_exit.cmo camlheader camlheader_ur diff --git a/stdlib/format.ml b/stdlib/format.ml index d3b3843d95..e36e2c0b12 100644 --- a/stdlib/format.ml +++ b/stdlib/format.ml @@ -566,12 +566,11 @@ let pp_set_formatter_output_functions state f g = let pp_get_formatter_output_functions state () = (state.pp_output_function, state.pp_flush_function);; -let pp_set_all_formatter_output_functions state f g h i = +let pp_set_all_formatter_output_functions state + ~out:f ~flush:g ~newline:h ~spaces:i = pp_set_formatter_output_functions state f g; state.pp_output_newline <- (function _ -> function () -> h ()); state.pp_output_spaces <- (function _ -> function n -> i n);; -let pp_set_all_formatter_output_functions' state ~out ~flush ~newline ~space = - pp_set_all_formatter_output_functions state out flush newline space let pp_get_all_formatter_output_functions state () = (state.pp_output_function, state.pp_flush_function, state.pp_output_newline state, state.pp_output_spaces state);; @@ -692,8 +691,6 @@ and get_formatter_output_functions = and set_all_formatter_output_functions = pp_set_all_formatter_output_functions std_formatter -and set_all_formatter_output_functions' = - pp_set_all_formatter_output_functions' std_formatter and get_all_formatter_output_functions = pp_get_all_formatter_output_functions std_formatter;; diff --git a/stdlib/format.mli b/stdlib/format.mli index c6123c3b18..d36a033fe2 100644 --- a/stdlib/format.mli +++ b/stdlib/format.mli @@ -242,11 +242,8 @@ val get_formatter_output_functions : (*** Changing the meaning of pretty printing (indentation, line breaking, and printing material) *) val set_all_formatter_output_functions : - (string -> int -> int -> unit) -> (unit -> unit) -> - (unit -> unit) -> (int -> unit) -> unit;; -val set_all_formatter_output_functions' : out:(string -> int -> int -> unit) -> flush:(unit -> unit) -> - newline:(unit -> unit) -> space:(int -> unit) -> unit;; + newline:(unit -> unit) -> spaces:(int -> unit) -> unit;; (* [set_all_formatter_output_functions out flush outnewline outspace] redirects the pretty-printer output to the functions [out] and [flush] as described in @@ -362,11 +359,8 @@ val pp_set_formatter_output_functions : formatter -> val pp_get_formatter_output_functions : formatter -> unit -> (string -> int -> int -> unit) * (unit -> unit);; val pp_set_all_formatter_output_functions : formatter -> - (string -> int -> int -> unit) -> (unit -> unit) -> - (unit -> unit) -> (int -> unit) -> unit;; -val pp_set_all_formatter_output_functions' : formatter -> out:(string -> int -> int -> unit) -> flush:(unit -> unit) -> - newline:(unit -> unit) -> space:(int -> unit) -> unit;; + newline:(unit -> unit) -> spaces:(int -> unit) -> unit;; val pp_get_all_formatter_output_functions : formatter -> unit -> (string -> int -> int -> unit) * (unit -> unit) * (unit -> unit) * (int -> unit);; diff --git a/stdlib/hashtbl.ml b/stdlib/hashtbl.ml index de0bee09b1..d39fd28a23 100644 --- a/stdlib/hashtbl.ml +++ b/stdlib/hashtbl.ml @@ -70,8 +70,6 @@ let add h key info = h.data.(i) <- bucket; if bucket_too_long h.max_len bucket then resize hash h -let add' h ~key ~data = add h key data - let remove h key = let rec remove_bucket = function Empty -> @@ -159,7 +157,6 @@ module type S = val create: int -> 'a t val clear: 'a t -> unit val add: 'a t -> key -> 'a -> unit - val add': 'a t -> key:key -> data:'a -> unit val remove: 'a t -> key -> unit val find: 'a t -> key -> 'a val find_all: 'a t -> key -> 'a list @@ -182,8 +179,6 @@ module Make(H: HashedType): (S with type key = H.t) = h.data.(i) <- bucket; if bucket_too_long h.max_len bucket then resize H.hash h - let add' h ~key ~data = add h key data - let remove h key = let rec remove_bucket = function Empty -> diff --git a/stdlib/hashtbl.mli b/stdlib/hashtbl.mli index ca1fdce3fe..b268eef36e 100644 --- a/stdlib/hashtbl.mli +++ b/stdlib/hashtbl.mli @@ -32,7 +32,6 @@ val clear : ('a, 'b) t -> unit (* Empty a hash table. *) val add : ('a, 'b) t -> 'a -> 'b -> unit -val add' : ('a, 'b) t -> key:'a -> data:'b -> unit (* [Hashtbl.add tbl x y] adds a binding of [x] to [y] in table [tbl]. Previous bindings for [x] are not removed, but simply hidden. That is, after performing [Hashtbl.remove tbl x], @@ -99,7 +98,6 @@ module type S = val create: int -> 'a t val clear: 'a t -> unit val add: 'a t -> key -> 'a -> unit - val add': 'a t -> key:key -> data:'a -> unit val remove: 'a t -> key -> unit val find: 'a t -> key -> 'a val find_all: 'a t -> key -> 'a list diff --git a/stdlib/listLabels.mli b/stdlib/listLabels.mli index e11f29c001..3c2f9d761e 100644 --- a/stdlib/listLabels.mli +++ b/stdlib/listLabels.mli @@ -117,10 +117,10 @@ 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 : 'a -> 'a list -> bool +val mem : 'a -> set:'a list -> bool (* [mem a l] is true if and only if [a] is equal to an element of [l]. *) -val memq : 'a -> 'a list -> bool +val memq : 'a -> set:'a list -> bool (* Same as [mem], but uses physical equality instead of structural equality to compare list elements. *) @@ -148,30 +148,30 @@ val partition : f:('a -> bool) -> 'a list -> 'a list * 'a list (** Association lists *) -val assoc : 'a -> ('a * 'b) list -> 'b +val assoc : 'a -> map:('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 : 'a -> ('a * 'b) list -> 'b +val assq : 'a -> map:('a * 'b) list -> 'b (* Same as [assoc], but uses physical equality instead of structural equality to compare keys. *) -val mem_assoc : 'a -> ('a * 'b) list -> bool +val mem_assoc : 'a -> map:('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 : 'a -> ('a * 'b) list -> bool +val mem_assq : 'a -> map:('a * 'b) list -> bool (* Same as [mem_assoc], but uses physical equality instead of structural equality to compare keys. *) -val remove_assoc : 'a -> ('a * 'b) list -> ('a * 'b) list +val remove_assoc : 'a -> map:('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 : 'a -> ('a * 'b) list -> ('a * 'b) list +val remove_assq : 'a -> map:('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.ml b/stdlib/map.ml index f1fdaa6cdf..634753feb0 100644 --- a/stdlib/map.ml +++ b/stdlib/map.ml @@ -24,7 +24,6 @@ module type S = type +'a t val empty: 'a t val add: key -> 'a -> 'a t -> 'a t - val add': key:key -> data:'a -> 'a t -> 'a t val find: key -> 'a t -> 'a val remove: key -> 'a t -> 'a t val mem: key -> 'a t -> bool @@ -94,8 +93,6 @@ module Make(Ord: OrderedType) = struct else bal l v d (add x data r) - let add' ~key ~data t = add key data t - let rec find x = function Empty -> raise Not_found diff --git a/stdlib/map.mli b/stdlib/map.mli index 8fb691638d..61a7a8c166 100644 --- a/stdlib/map.mli +++ b/stdlib/map.mli @@ -45,7 +45,6 @@ module type S = val empty: 'a t (* The empty map. *) val add: key -> 'a -> 'a t -> 'a t - val add': key:key -> data:'a -> 'a t -> 'a t (* [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. *) diff --git a/stdlib/marshal.ml b/stdlib/marshal.ml index 8f2bef00a3..cf49605d00 100644 --- a/stdlib/marshal.ml +++ b/stdlib/marshal.ml @@ -29,11 +29,6 @@ let to_buffer buff ofs len v flags = then invalid_arg "Marshal.to_buffer: substring out of bounds" else to_buffer_unsafe buff ofs len v flags -let to_buffer' ~buf:buff ~pos:ofs ~len v ~mode:flags = - if ofs < 0 || len < 0 || ofs + len > String.length buff - then invalid_arg "Marshal.to_buffer: substring out of bounds" - else to_buffer_unsafe buff ofs len v flags - external from_channel: in_channel -> 'a = "input_value" external from_string_unsafe: string -> int -> 'a = "input_value_from_string" external data_size_unsafe: string -> int -> int = "marshal_data_size" diff --git a/stdlib/marshal.mli b/stdlib/marshal.mli index 36ae1c9550..b3bfcba800 100644 --- a/stdlib/marshal.mli +++ b/stdlib/marshal.mli @@ -85,8 +85,6 @@ external to_string: 'a -> extern_flags list -> string [Marshal.to_channel]. *) val to_buffer: string -> int -> int -> 'a -> extern_flags list -> int -val to_buffer': - buf:string -> pos:int -> len: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/pervasives.ml b/stdlib/pervasives.ml index eb121fed69..58408aace7 100644 --- a/stdlib/pervasives.ml +++ b/stdlib/pervasives.ml @@ -228,11 +228,6 @@ let output oc s ofs len = then invalid_arg "output" else unsafe_output oc s ofs len -let output' oc ~buf:s ~pos:ofs ~len = - if ofs < 0 || len < 0 || ofs + len > string_length s - then invalid_arg "output" - else unsafe_output oc s ofs len - external output_byte : out_channel -> int -> unit = "caml_output_char" external output_binary_int : out_channel -> int -> unit = "caml_output_int" @@ -269,11 +264,6 @@ let input ic s ofs len = then invalid_arg "input" else unsafe_input ic s ofs len -let input' ic ~buf:s ~pos:ofs ~len = - if ofs < 0 || len < 0 || ofs + len > string_length s - then invalid_arg "input" - else unsafe_input ic s ofs len - let rec unsafe_really_input ic s ofs len = if len <= 0 then () else begin let r = unsafe_input ic s ofs len in diff --git a/stdlib/pervasives.mli b/stdlib/pervasives.mli index 19afe246e3..a749529b9b 100644 --- a/stdlib/pervasives.mli +++ b/stdlib/pervasives.mli @@ -487,7 +487,6 @@ val output_char : out_channel -> char -> unit val output_string : out_channel -> string -> unit (* Write the string on the given output channel. *) val output : out_channel -> string -> int -> int -> unit -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 @@ -558,7 +557,6 @@ val input_line : in_channel -> string Raise [End_of_file] if the end of the file is reached at the beginning of line. *) val input : in_channel -> string -> int -> int -> int -val input' : in_channel -> buf:string -> pos:int -> len:int -> int (* Read up to [len] characters from the given channel, storing them in string [buf], starting at character number [pos]. It returns the actual number of characters read, between 0 and diff --git a/stdlib/stdLabels.mli b/stdlib/stdLabels.mli index b920fb446e..47c53301fe 100644 --- a/stdlib/stdLabels.mli +++ b/stdlib/stdLabels.mli @@ -72,18 +72,18 @@ module List : sig val exists : f:('a -> bool) -> 'a 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 - val mem : 'a -> 'a list -> bool - val memq : 'a -> 'a list -> bool + val mem : 'a -> set:'a list -> bool + val memq : 'a -> set:'a list -> bool val find : f:('a -> bool) -> 'a list -> 'a val filter : f:('a -> bool) -> 'a list -> 'a list val find_all : f:('a -> bool) -> 'a list -> 'a list val partition : f:('a -> bool) -> 'a list -> 'a list * 'a list - val assoc : 'a -> ('a * 'b) list -> 'b - val assq : 'a -> ('a * 'b) list -> 'b - val mem_assoc : 'a -> ('a * 'b) list -> bool - val mem_assq : 'a -> ('a * 'b) list -> bool - val remove_assoc : 'a -> ('a * 'b) list -> ('a * 'b) list - val remove_assq : 'a -> ('a * 'b) list -> ('a * 'b) list + val assoc : 'a -> map:('a * 'b) list -> 'b + val assq : 'a -> map:('a * 'b) list -> 'b + val mem_assoc : 'a -> map:('a * 'b) list -> bool + val mem_assq : 'a -> map:('a * 'b) list -> bool + val remove_assoc : 'a -> map:('a * 'b) list -> ('a * 'b) list + val remove_assq : 'a -> map:('a * 'b) list -> ('a * 'b) list val split : ('a * 'b) list -> 'a list * 'b list val combine : 'a list -> 'b list -> ('a * 'b) list val sort : cmp:('a -> 'a -> int) -> 'a list -> 'a list diff --git a/stdlib/sys.ml b/stdlib/sys.ml index 924f007b56..122a9620d1 100644 --- a/stdlib/sys.ml +++ b/stdlib/sys.ml @@ -25,7 +25,6 @@ let max_string_length = word_size / 8 * max_array_length - 1;; external file_exists: string -> bool = "sys_file_exists" external remove: string -> unit = "sys_remove" external rename : string -> string -> unit = "sys_rename" -external rename' : src:string -> dst:string -> unit = "sys_rename" external getenv: string -> string = "sys_getenv" external command: string -> int = "sys_system_command" external time: unit -> float = "sys_time" diff --git a/stdlib/sys.mli b/stdlib/sys.mli index 66d4fa2bec..4768d571e4 100644 --- a/stdlib/sys.mli +++ b/stdlib/sys.mli @@ -23,8 +23,7 @@ external file_exists: string -> bool = "sys_file_exists" (* Test if a file with the given name exists. *) external remove: string -> unit = "sys_remove" (* Remove the given file name from the file system. *) -external rename : string -> string -> unit = "sys_rename" -external rename' : src:string -> dst:string -> unit = "sys_rename" +external rename: string -> string -> unit = "sys_rename" (* Rename a file. The first argument is the old name and the second is the new name. *) external getenv: string -> string = "sys_getenv" diff --git a/stdlib/weak.ml b/stdlib/weak.ml index 944fbc60e5..b57cc64cc3 100644 --- a/stdlib/weak.ml +++ b/stdlib/weak.ml @@ -53,6 +53,3 @@ let blit ar1 of1 ar2 of2 len = end end ;; - -let blit' ~src ~src_pos ~dst ~dst_pos ~len = - blit src src_pos dst dst_pos len diff --git a/stdlib/weak.mli b/stdlib/weak.mli index 296ff6040f..1327086d30 100644 --- a/stdlib/weak.mli +++ b/stdlib/weak.mli @@ -68,8 +68,6 @@ val fill: 'a t -> int -> int -> 'a option -> unit;; if [ofs] and [len] do not designate a valid subarray of [a]. *) val blit : 'a t -> int -> 'a t -> int -> int -> unit;; -val blit' : src:'a t -> src_pos:int -> - dst:'a t -> dst_pos:int -> len:int -> unit;; (* [Weak.blit ar1 off1 ar2 off2 len] copies [len] weak pointers from [ar1] (starting at [off1]) to [ar2] (starting at [off2]). It works correctly even if [ar1] and [ar2] are the same. diff --git a/utils/config.mlp b/utils/config.mlp index 1381f67f08..1b976c51ac 100644 --- a/utils/config.mlp +++ b/utils/config.mlp @@ -12,7 +12,7 @@ (* $Id$ *) -let version = "3.01+2s (2001-05-08)" +let version = "3.01+2s (2001-01-02)" let standard_library = try |