summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorJacques Garrigue <garrigue at math.nagoya-u.ac.jp>2001-09-02 13:42:19 +0000
committerJacques Garrigue <garrigue at math.nagoya-u.ac.jp>2001-09-02 13:42:19 +0000
commitfe2e11a8fb4dcf166ffb7f91e6eb8dd0f4402f25 (patch)
tree8dff8da7bfc88f25c78afe5340d78daa8c89587c
parent7e053c39de8693928b83038c1727f5d90228c39d (diff)
downloadocaml-fe2e11a8fb4dcf166ffb7f91e6eb8dd0f4402f25.tar.gz
remove doublonsstrict_labels
git-svn-id: http://caml.inria.fr/svn/ocaml/branches/strict_labels@3687 f963ae5c-01c2-4b8c-9fe0-0dff7051ff02
-rw-r--r--otherlibs/labltk/browser/editor.ml6
-rw-r--r--otherlibs/labltk/browser/searchpos.ml3
-rw-r--r--otherlibs/labltk/compiler/Makefile8
-rw-r--r--otherlibs/labltk/compiler/compile.ml6
-rw-r--r--otherlibs/labltk/compiler/intf.ml2
-rw-r--r--otherlibs/labltk/compiler/lexer.mll3
-rw-r--r--otherlibs/labltk/compiler/maincompile.ml9
-rw-r--r--otherlibs/labltk/compiler/tables.ml18
-rw-r--r--otherlibs/labltk/jpf/balloon.ml3
-rw-r--r--otherlibs/labltk/support/.depend20
-rw-r--r--otherlibs/labltk/support/fileevent.ml9
-rw-r--r--otherlibs/labltk/support/protocol.ml7
-rw-r--r--otherlibs/labltk/support/support.ml4
-rw-r--r--otherlibs/labltk/support/support.mli2
-rw-r--r--otherlibs/labltk/support/textvariable.ml7
-rw-r--r--otherlibs/labltk/support/timer.ml3
-rw-r--r--otherlibs/labltk/support/widget.ml7
-rw-r--r--stdlib/Makefile6
-rw-r--r--stdlib/format.ml7
-rw-r--r--stdlib/format.mli10
-rw-r--r--stdlib/hashtbl.ml5
-rw-r--r--stdlib/hashtbl.mli2
-rw-r--r--stdlib/listLabels.mli16
-rw-r--r--stdlib/map.ml3
-rw-r--r--stdlib/map.mli1
-rw-r--r--stdlib/marshal.ml5
-rw-r--r--stdlib/marshal.mli2
-rw-r--r--stdlib/pervasives.ml10
-rw-r--r--stdlib/pervasives.mli2
-rw-r--r--stdlib/stdLabels.mli16
-rw-r--r--stdlib/sys.ml1
-rw-r--r--stdlib/sys.mli3
-rw-r--r--stdlib/weak.ml3
-rw-r--r--stdlib/weak.mli2
-rw-r--r--utils/config.mlp2
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