Changes

+2019-05-31:
+-----------
+* have configure use (GNU) make rather than grep to read
+  ocaml/Makefile.config, due to change in ocaml 4.08
+* add "library" target, to avoid compiling ocamlbrowser
+* update ocamlbrowser for ocaml 4.08
+
+2018-12-20:
+-----------
+* Fix browser for module aliases and polymorphic variants
+
+2018-07-11:
+-----------
+* Release labltk-8.06.5, for ocaml 4.07
+
+2018-06-26:
+-----------
+* Update browser for ocaml 4.07
+
+2017-10-30:
+-----------
+* Release labltk-8.06.4, for ocaml 4.06
+
+2017-09-19:
+-----------
+* prepare for 4.06: -safe-string transition and browser updates
+
+2017-07-19:
+-----------
+* Release labltk-8.06.3, for ocaml 4.05
+* Various fixes for ocaml 4.05 (merge debian patches by Stephane Glondu)
+
+2017-05-15:
+-----------
+* Fix configuration and Makefile for OCaml 4.06
+
+2016-08-13:
+-----------
+* suppress gcc warning about unused variable (Damien Doligez)
+
 2016-08-10:
 -----------
 * Release labltk-8.06.2, for ocaml 4.04

INSTALL

@@ -3,10 +3,12 @@
 
 PREREQUISITES
 
-* OCaml (>= 4.02) should be installed
+* OCaml (>= 4.08) should be installed
 
 * Tcl/Tk (>= 8.03) should be installed
 
+* ocamlfind is used if available
+
 INSTALLATION INSTRUCTIONS FOR UNIX AND OSX
 
 1- Configure the system. From the top directory, do:
@@ -40,6 +42,8 @@ The "configure" script accepts the following options:
         Examples:
         for an OSX installation using macports, use just
          ./configure -tklibs -L/opt/local/lib -tkdefs -I/opt/local/include
+        if you prefer to use the system Tcl/Tk,
+         ./configure -tklibs "-framework Tcl -framework Tk" -tk-no-x11 -tkdefs "-I/Applications/Xcode.app/Contents/Developer/Platforms/MacOSX.platform/Developer/SDKs/MacOSX.sdk/System/Library/Frameworks/Tk.framework/Headers"
         for Japanese Tcl/Tk whose headers are in specific directories
         and libraries in /usr/local/lib, you can use
          ./configure -tklibs "-L/usr/local/lib -ltk8.0jp -ltcl8.0jp"
@@ -53,6 +57,11 @@ The "configure" script accepts the following options:
         Verbose output of the configuration tests. Use it if the outcome
         of configure is not what you were expecting.
 
+Additionally, you may set the MAKE environment variable to set the
+command used to read the ocaml configuration Makefile.
+Default is "make". It should be compatible with GNU Make.
+
+
 2- From the top directory do
 
         make all
@@ -61,6 +70,9 @@ and optionally
 
         make opt
 
+You may replace "all" with "library" if you wish to compile only
+the library, without ocamlbrowser.
+
 3- From the top directory do
 
         make install

Makefile

@@ -21,7 +21,11 @@ SUBDIRS=compiler support lib jpf frx examples_labltk \
 SUBDIRS_GENERATED=camltk labltk
 include config/Makefile
 
-all:
+all: library
+	cd browser; $(MAKE)
+opt: libraryopt
+
+library:
 	cd support; $(MAKE)
 	cd compiler; $(MAKE)
 	cd labltk; $(MAKE) -f Makefile.gen
@@ -31,9 +35,8 @@ all:
 	cd lib; $(MAKE)
 	cd jpf; $(MAKE)
 	cd frx; $(MAKE)
-	cd browser; $(MAKE)
 
-allopt:
+libraryopt:
 	cd support; $(MAKE) opt
 	cd labltk; $(MAKE) -f Makefile.gen
 	cd labltk; $(MAKE) opt
@@ -46,7 +49,7 @@ allopt:
 byte: all
 opt: allopt
 
-.PHONY: all allopt byte opt
+.PHONY: all allopt byte opt apiref library libraryopt
 .PHONY: labltk camltk examples examples_labltk examples_camltk
 .PHONY: install installopt partialclean clean depend
 
@@ -66,6 +69,10 @@ examples_labltk:
 examples_camltk:
 	cd examples_camltk; $(MAKE) all
 
+SUPPORTMLIS= fileevent support textvariable timer tkthread widget
+apiref:
+	$(BINDIR)/ocamldoc -I +threads -I support -I labltk $(SUPPORTMLIS:%=support/%.mli) labltk/*.mli labltk/tk.ml -sort -d htdocs/apiref -html || echo "There were errors"
+
 install:
 	cd support; $(MAKE) install
 	cd lib; $(MAKE) install
@@ -77,6 +84,9 @@ install:
 	cd browser; $(MAKE) install
 	if test -f lib/labltk.cmxa; then $(MAKE) installopt; else :; fi
 
+install-browser:
+	cd browser; $(MAKE) install
+
 installopt:
 	cd support; $(MAKE) installopt
 	cd lib; $(MAKE) installopt

README.md

@@ -5,3 +5,6 @@ https://forge.ocamlcore.org/projects/labltk/
 
 You can find documentation here:
 https://forge.ocamlcore.org/docman/?group_id=343&view=listfile&dirid=385
+
+Bug reports go to Github:
+https://github.com/garrigue/labltk/issues
\ No newline at end of file

browser/Makefile.shared

@@ -60,7 +60,8 @@ help.ml:
 	echo '";;' >> $@
 
 install:
-	cp ocamlbrowser$(EXE) $(INSTALLBINDIR)
+	if test -f ocamlbrowser$(EXE); then \
+	   cp ocamlbrowser$(EXE) $(INSTALLBINDIR); fi
 
 clean:
 	rm -f *.cm? ocamlbrowser$(EXE) dummy.ml *~ *.orig *.$(O) help.ml

browser/editor.ml

@@ -464,13 +464,13 @@ class editor ~top ~menus = object (self)
       let file = open_in name
       and tw = current_tw
       and len = ref 0
-      and buf = String.create 4096 in
+      and buf = Bytes.create 4096 in
       Text.delete tw ~start:tstart ~stop:tend;
       while
         len := input file buf 0 4096;
         !len > 0
       do
-        Jg_text.output tw ~buf ~pos:0 ~len:!len
+        Jg_text.output tw ~buf:(Bytes.unsafe_to_string buf) ~pos:0 ~len:!len
       done;
       close_in file;
       Text.mark_set tw ~mark:"insert" ~index;
@@ -614,10 +614,10 @@ class editor ~top ~menus = object (self)
       begin fun () ->
         let txt = List.hd windows in if txt.signature <> [] then
           let basename = Filename.basename txt.name in
-          let modname = String.capitalize
+          let modname = String.capitalize_ascii
               (try Filename.chop_extension basename with _ -> basename) in
           let env =
-            Env.add_module (Ident.create modname)
+            Env.add_module (Ident.create_local modname) Mp_present
               (Types.Mty_signature txt.signature)
               !Searchid.start_env
           in Viewer.view_defined (Longident.Lident modname) ~env ~show_all:true

browser/fileselect.ml

@@ -82,7 +82,7 @@ let ls ~dir ~pattern =
 (********************************************* Creation *)
 let load_in_path = ref false
 
-let search_in_path ~name = Misc.find_in_path !Config.load_path name
+let search_in_path ~name = Misc.find_in_path (Load_path.get_paths ()) name
 
 let f ~title ~action:proc ?(dir = Unix.getcwd ())
     ?filter:(deffilter ="*") ?file:(deffile ="")
@@ -128,7 +128,7 @@ 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 ~init:[] ~f:
+      List.fold_left (Load_path.get_paths ()) ~init:[] ~f:
       begin fun acc dir ->
         let files = ls ~dir ~pattern in
         List.merge compare files

browser/jg_completion.ml

@@ -15,7 +15,7 @@
 (* $Id$ *)
 
 let compare_string ?(nocase=false) s1 s2 =
-  if nocase then compare (String.lowercase s1) (String.lowercase s2)
+  if nocase then compare (String.lowercase_ascii s1) (String.lowercase_ascii s2)
   else compare s1 s2
 
 class completion ?nocase texts = object

browser/main.ml

@@ -96,10 +96,10 @@ let _ =
   Arg.parse spec
     (fun name -> raise(Arg.Bad("don't know what to do with " ^ name)))
     errmsg;
-  Config.load_path :=
-    Sys.getcwd ()
+  Load_path.init
+    (Sys.getcwd ()
      :: List.rev_map ~f:(Misc.expand_directory Config.standard_library) !path
-    @ [Config.standard_library];
+     @ [Config.standard_library]);
   Warnings.parse_options false !Shell.warnings;
   Unix.putenv "TERM" "noterminal";
   begin

browser/searchid.ml

@@ -51,7 +51,7 @@ let string_of_kind = function
 
 let rec longident_of_path = function
     Pident id -> Lident (Ident.name id)
-  | Pdot (path, s, _) -> Ldot (longident_of_path path, s)
+  | Pdot (path, s) -> Ldot (longident_of_path path, s)
   | Papply (p1, p2) -> Lapply (longident_of_path p1, longident_of_path p2)
 
 let rec remove_prefix lid ~prefix =
@@ -201,11 +201,12 @@ let mklid = function
 let mkpath = function
     [] -> raise (Invalid_argument "Searchid.mklid")
   | x :: l ->
-      List.fold_left l ~init:(Pident (Ident.create x))
-      ~f:(fun acc x -> Pdot (acc, x, 0))
+      List.fold_left l ~init:(Pident (Ident.create_local x))
+      ~f:(fun acc x -> Pdot (acc, x))
 
 let get_fields ~prefix ~sign self =
-  let env = open_signature Fresh (mkpath prefix) sign !start_env in
+  (*let env = open_signature Fresh (mkpath prefix) sign !start_env in*)
+  let env = add_signature sign !start_env in
   match (expand_head env self).desc with
     Tobject (ty_obj, _) ->
       let l,_ = flatten_fields ty_obj in l
@@ -222,9 +223,9 @@ let rec search_type_in_signature t ~sign ~prefix ~mode =
   in
   List2.flat_map sign ~f:
   begin fun item -> match item with
-        Sig_value (id, vd) ->
+        Sig_value (id, vd, _) ->
           if matches vd.val_type then [lid_of_id id, Pvalue] else []
-      | Sig_type (id, td, _) ->
+      | Sig_type (id, td, _, _) ->
           if
           matches (newconstr (Pident id) td.type_params) ||
           begin match td.type_manifest with
@@ -244,23 +245,23 @@ let rec search_type_in_signature t ~sign ~prefix ~mode =
             List.exists l ~f:(fun {Types.ld_type=t} -> matches t)
           end
           then [lid_of_id id, Ptype] else []
-      | Sig_typext (id, l, _) ->
+      | Sig_typext (id, l, _, _) ->
           if constructor_matches l.ext_args
           then [lid_of_id id, Pconstructor]
           else []
-      | Sig_module (id, {md_type=Mty_signature sign}, _) ->
+      | Sig_module (id, _, {md_type=Mty_signature sign}, _, _) ->
           search_type_in_signature t ~sign ~mode
             ~prefix:(prefix @ [Ident.name id])
       | Sig_module _ -> []
       | Sig_modtype _ -> []
-      | Sig_class (id, cl, _) ->
+      | Sig_class (id, cl, _, _) ->
           let self = self_type cl.cty_type in
           if matches self
           || (match cl.cty_new with None -> false | Some ty -> matches ty)
           (* || List.exists (get_fields ~prefix ~sign self)
               ~f:(fun (_,_,ty_field) -> matches ty_field) *)
           then [lid_of_id id, Pclass] else []
-      | Sig_class_type (id, cl, _) ->
+      | Sig_class_type (id, cl, _, _) ->
           let self = self_type cl.clty_type in
           if matches self
           (* || List.exists (get_fields ~prefix ~sign self)
@@ -307,7 +308,7 @@ let search_string_type text ~mode =
           let end_c = l.loc_end.Lexing.pos_cnum in
           raise (Error (start_c - 8, end_c - 8))
     in match sign with
-        [ Sig_value (_, vd) ] ->
+        [ Sig_value (_, vd, _) ] ->
           search_all_types vd.val_type ~mode
       | _ -> []
   with
@@ -365,17 +366,17 @@ let search_pattern_symbol text =
     with {md_type=Mty_signature sign} ->
         List2.flat_map sign ~f:
           begin function
-            Sig_value (i, _) when check i -> [i, Pvalue]
-          | Sig_type (i, _, _) when check i -> [i, Ptype]
-          | Sig_typext (i, _, _) when check i -> [i, Pconstructor]
-          | Sig_module (i, _, _) when check i -> [i, Pmodule]
-          | Sig_modtype (i, _) when check i -> [i, Pmodtype]
-          | Sig_class (i, cl, _) when check i
+            Sig_value (i, _, _) when check i -> [i, Pvalue]
+          | Sig_type (i, _, _, _) when check i -> [i, Ptype]
+          | Sig_typext (i, _, _, _) when check i -> [i, Pconstructor]
+          | Sig_module (i, _, _, _, _) when check i -> [i, Pmodule]
+          | Sig_modtype (i, _, _) when check i -> [i, Pmodtype]
+          | Sig_class (i, cl, _, _) when check i
             || List.exists
                 (get_fields ~prefix:[modname] ~sign (self_type cl.cty_type))
                 ~f:(fun (name,_,_) -> check_match ~pattern (explode name))
             -> [i, Pclass]
-          | Sig_class_type (i, cl, _) when check i
+          | Sig_class_type (i, cl, _, _) when check i
             || List.exists
                 (get_fields ~prefix:[modname] ~sign (self_type cl.clty_type))
                 ~f:(fun (name,_,_) -> check_match ~pattern (explode name))
@@ -483,7 +484,8 @@ let search_structure str ~name ~kind ~prefix =
 	      then loc := td.pext_loc.loc_start.Lexing.pos_cnum
             end;
           false
-      | Pstr_exception pcd when kind = Pconstructor -> name = pcd.pext_name.txt
+      | Pstr_exception pcd when kind = Pconstructor ->
+          name = pcd.ptyexn_constructor.pext_name.txt
       | Pstr_module x when kind = Pmodule -> name = x.pmb_name.txt
       | Pstr_modtype x when kind = Pmodtype -> name = x.pmtd_name.txt
       | Pstr_class l when kind = Pclass || kind = Ptype || kind = Pcltype ->
@@ -544,7 +546,8 @@ let search_signature sign ~name ~kind ~prefix =
 	      then loc := td.pext_loc.loc_start.Lexing.pos_cnum
             end;
           false
-      | Psig_exception pcd when kind = Pconstructor -> name = pcd.pext_name.txt
+      | Psig_exception pcd when kind = Pconstructor ->
+          name = pcd.ptyexn_constructor.pext_name.txt
       | Psig_module pmd when kind = Pmodule -> name = pmd.pmd_name.txt
       | Psig_modtype pmtd when kind = Pmodtype -> name = pmtd.pmtd_name.txt
       | Psig_class l when kind = Pclass || kind = Ptype || kind = Pcltype ->

browser/searchpos.ml

@@ -68,22 +68,22 @@ let rec string_of_longident = function
 let string_of_path p = string_of_longident (Searchid.longident_of_path p)
 
 let parent_path = function
-    Pdot (path, _, _) -> Some path
+    Pdot (path, _) -> Some path
   | Pident _ | Papply _ -> None
 
 let ident_of_path ~default = function
     Pident i -> i
-  | Pdot (_, s, _) -> Ident.create s
-  | Papply _ -> Ident.create default
+  | Pdot (_, s) -> Ident.create_local s
+  | Papply _ -> Ident.create_local default
 
 let rec head_id = function
     Pident id -> id
-  | Pdot (path,_,_) -> head_id path
+  | Pdot (path,_) -> head_id path
   | Papply (path,_) -> head_id path (* wrong, but ... *)
 
 let rec list_of_path = function
     Pident id -> [Ident.name id]
-  | Pdot (path, s, _) -> list_of_path path @ [s]
+  | Pdot (path, s) -> list_of_path path @ [s]
   | Papply (path, _) -> list_of_path path (* wrong, but ... *)
 
 (* a simple wrapper *)
@@ -108,8 +108,8 @@ let rec search_pos_type t ~pos ~env =
   | Ptyp_var _ -> ()
   | Ptyp_variant(tl, _, _) ->
       List.iter tl ~f:
-        begin function
-            Rtag (_,_,_,tl) -> List.iter tl ~f:(search_pos_type ~pos ~env)
+        begin fun prf -> match prf.prf_desc with
+            Rtag (_,_,tl) -> List.iter tl ~f:(search_pos_type ~pos ~env)
           | Rinherit st -> search_pos_type ~pos ~env st
         end
   | Ptyp_arrow (_, t1, t2) ->
@@ -121,7 +121,9 @@ let rec search_pos_type t ~pos ~env =
       List.iter tl ~f:(search_pos_type ~pos ~env);
       add_found_sig (`Type, lid.txt) ~env ~loc:t.ptyp_loc
   | Ptyp_object (fl, _) ->
-      List.iter fl ~f:(fun (_, _, ty) -> search_pos_type ty ~pos ~env)
+      List.iter fl ~f:
+        (fun pof -> match pof.pof_desc with
+          Oinherit ty | Otag (_, ty) -> search_pos_type ty ~pos ~env)
   | Ptyp_class (lid, tl) ->
       List.iter tl ~f:(search_pos_type ~pos ~env);
       add_found_sig (`Type, lid.txt) ~env ~loc:t.ptyp_loc
@@ -156,6 +158,8 @@ let rec search_pos_class_type cl ~pos ~env =
         search_pos_type ty ~pos ~env;
         search_pos_class_type cty ~pos ~env
     | Pcty_extension _ -> ()
+    | Pcty_open (_, cty) ->
+        search_pos_class_type cty ~pos ~env
     end
 
 let search_pos_arguments ~pos ~env = function
@@ -200,11 +204,11 @@ let rec search_pos_signature l ~pos ~env =
   List.fold_left l ~init:env ~f:
   begin fun env pt ->
     let env = match pt.psig_desc with
-      Psig_open {popen_override=ovf; popen_lid=id} ->
+      Psig_open {popen_override=ovf; popen_expr=id} ->
         let path, mt = Typetexp.find_module env Location.none id.txt in
-        begin match mt.md_type with
-          Mty_signature sign -> open_signature ovf path sign env
-        | _ -> env
+        begin match open_signature ovf path env with
+          Some env -> env
+        | None -> env
         end
     | sign_item ->
         try add_signature (Typemod.transl_signature env [pt]).sig_type env
@@ -221,7 +225,7 @@ let rec search_pos_signature l ~pos ~env =
 	    ~f:(search_pos_extension ~pos ~env);
 	  add_found_sig (`Type, pty.ptyext_path.txt) ~env ~loc:pt.psig_loc
       | Psig_exception ext ->
-	  search_pos_extension ext ~pos ~env;
+	  search_pos_extension ext.ptyexn_constructor ~pos ~env;
 	  add_found_sig (`Type, Lident "exn") ~env ~loc:pt.psig_loc
       | Psig_module pmd ->
           search_pos_module pmd.pmd_type ~pos ~env
@@ -237,10 +241,11 @@ let rec search_pos_signature l ~pos ~env =
           List.iter l
             ~f:(fun ci -> search_pos_class_type ci.pci_expr ~pos ~env)
       (* The last cases should not happen in generated interfaces *)
-      | Psig_open {popen_lid=lid} ->
+      | Psig_open {popen_expr=lid} ->
         add_found_sig (`Module, lid.txt) ~env ~loc:pt.psig_loc
       | Psig_include {pincl_mod=t} -> search_pos_module t ~pos ~env
       | Psig_attribute _ | Psig_extension _ -> ()
+      | Psig_typesubst _ | Psig_modsubst _ -> ()
       end;
     env
   end)
@@ -314,13 +319,13 @@ let edit_source ~file ~path ~sign =
     [item] ->
       let id, kind =
         match item with
-          Sig_value (id, _) -> id, Pvalue
-        | Sig_type (id, _, _) -> id, Ptype
-        | Sig_typext (id, _, _) -> id, Pconstructor
-        | Sig_module (id, _, _) -> id, Pmodule
-        | Sig_modtype (id, _) -> id, Pmodtype
-        | Sig_class (id, _, _) -> id, Pclass
-        | Sig_class_type (id, _, _) -> id, Pcltype
+          Sig_value (id, _, _) -> id, Pvalue
+        | Sig_type (id, _, _, _) -> id, Ptype
+        | Sig_typext (id, _, _, _) -> id, Pconstructor
+        | Sig_module (id, _, _, _, _) -> id, Pmodule
+        | Sig_modtype (id, _, _) -> id, Pmodtype
+        | Sig_class (id, _, _, _) -> id, Pclass
+        | Sig_class_type (id, _, _, _) -> id, Pcltype
       in
       let prefix = List.tl (list_of_path path) and name = Ident.name id in
       let pos =
@@ -342,13 +347,17 @@ let edit_source ~file ~path ~sign =
 let top_widgets = ref []
 
 let dummy_item =
-  Sig_modtype (Ident.create "dummy",
-               {mtd_type=None; mtd_attributes=[]; mtd_loc=Location.none})
+  Sig_modtype (Ident.create_local "dummy",
+               {mtd_type=None; mtd_attributes=[]; mtd_loc=Location.none},
+               Exported)
 
 let rec view_signature ?title ?path ?(env = !start_env) ?(detach=false) sign =
   let env =
     match path with None -> env
-    | Some path -> Env.open_signature Fresh path sign env in
+    | Some path ->
+        match Env.open_signature Fresh path env with None -> env
+        | Some env -> env
+  in
   let title =
     match title, path with Some title, _ -> title
     | None, Some path -> string_of_path path
@@ -388,7 +397,7 @@ let rec view_signature ?title ?path ?(env = !start_env) ?(detach=false) sign =
             try
               let id = head_id path in
               let file =
-                Misc.find_in_path_uncap !Config.load_path
+                Misc.find_in_path_uncap (Load_path.get_paths ())
                   ((Ident.name id) ^ ext) in
               Button.configure button
                 ~command:(fun () -> edit_source ~file ~path ~sign);
@@ -408,7 +417,7 @@ let rec view_signature ?title ?path ?(env = !start_env) ?(detach=false) sign =
       tl, tw, finish
   in
   Format.set_max_boxes 100;
-  Printtyp.wrap_printing_env env
+  Printtyp.wrap_printing_env ~error:false env
     (fun () -> Printtyp.signature Format.std_formatter sign);
   finish ();
   Lexical.init_tags tw;
@@ -459,12 +468,14 @@ and view_signature_item sign ~path ~env =
     ?path:(parent_path path) ~env
 
 and view_module path ~env =
-  match find_module path env with
-    {md_type=Mty_signature sign} ->
+  let modtype = find_module path env in
+  match scrape_alias env modtype.md_type with
+    Mty_signature sign ->
       !view_defined_ref (Searchid.longident_of_path path) ~env
-  | modtype ->
+  | _ ->
       let id = ident_of_path path ~default:"M" in
-      view_signature_item [Sig_module (id, modtype, Trec_not)] ~path ~env
+      view_signature_item [Sig_module (id, Mp_present, modtype,
+                                       Trec_not, Exported)] ~path ~env
 
 and view_module_id id ~env =
   let path = lookup_module ~load:true id env in
@@ -473,16 +484,23 @@ and view_module_id id ~env =
 and view_type_decl path ~env =
   let td = find_type path env in
   try match td.type_manifest with None -> raise Not_found
-    | Some ty -> match Ctype.repr ty with
-        {desc = Tobject _} ->
+    | Some ty -> match (Ctype.repr ty).desc with
+        Tobject _ ->
           let clt = find_cltype path env in
           view_signature_item ~path ~env
-            [Sig_class_type(ident_of_path path ~default:"ct", clt, Trec_first);
+            [Sig_class_type(ident_of_path path ~default:"ct", clt, Trec_first,
+                            Exported);
              dummy_item; dummy_item]
+      | Tvariant ({row_name = Some _} as row) ->
+          let td = {td with type_manifest = Some(
+                    Btype.newgenty (Tvariant {row with row_name = None}))} in
+          view_signature_item ~path ~env
+            [Sig_type(ident_of_path path ~default:"t", td, Trec_first,
+                      Exported)]
       | _ -> raise Not_found
   with Not_found ->
     view_signature_item ~path ~env
-      [Sig_type(ident_of_path path ~default:"t", td, Trec_first)]
+      [Sig_type(ident_of_path path ~default:"t", td, Trec_first, Exported)]
 
 and view_type_id li ~env =
   let path = lookup_type li env in
@@ -491,19 +509,20 @@ and view_type_id li ~env =
 and view_class_id li ~env =
   let path, cl = lookup_class li env in
   view_signature_item ~path ~env
-     [Sig_class(ident_of_path path ~default:"c", cl, Trec_first);
+     [Sig_class(ident_of_path path ~default:"c", cl, Trec_first, Exported);
       dummy_item; dummy_item; dummy_item]
 
 and view_cltype_id li ~env =
   let path, clt = lookup_cltype li env in
   view_signature_item ~path ~env
-     [Sig_class_type(ident_of_path path ~default:"ct", clt, Trec_first);
+     [Sig_class_type(ident_of_path path ~default:"ct", clt, Trec_first,
+                     Exported);
       dummy_item; dummy_item]
 
 and view_modtype_id li ~env =
   let path, td = lookup_modtype li env in
   view_signature_item ~path ~env
-    [Sig_modtype(ident_of_path path ~default:"S", td)]
+    [Sig_modtype(ident_of_path path ~default:"S", td, Exported)]
 
 and view_expr_type ?title ?path ?env ?(name="noname") t =
   let title =
@@ -511,12 +530,12 @@ and view_expr_type ?title ?path ?env ?(name="noname") t =
     | None, Some path -> string_of_path path
     | None, None -> "Expression type"
   and path, id =
-    match path with None -> None, Ident.create name
+    match path with None -> None, Ident.create_local name
     | Some path -> parent_path path, ident_of_path path ~default:name
   in
   view_signature ~title ?path ?env
     [Sig_value (id, {val_type = t; val_kind = Val_reg; val_attributes=[];
-                     val_loc = Location.none})]
+                     val_loc = Location.none}, Exported)]
 
 and view_decl lid ~kind ~env =
   match kind with
@@ -550,7 +569,7 @@ and view_decl_menu lid ~kind ~env ~parent =
     Format.set_formatter_output_functions buf#out (fun () -> ());
     Format.set_margin 60;
     Format.open_hbox ();
-    Printtyp.wrap_printing_env env begin fun () ->
+    Printtyp.wrap_printing_env ~error:false env begin fun () ->
       if kind = `Type then
         Printtyp.type_declaration
           (ident_of_path path ~default:"t")
@@ -598,7 +617,7 @@ let view_type kind ~env =
           begin try
             let vd = find_value path env in
             view_signature_item ~path ~env
-              [Sig_value(ident_of_path path ~default:"v", vd)]
+              [Sig_value(ident_of_path path ~default:"v", vd, Exported)]
           with Not_found ->
             view_expr_type ty ~path ~env
           end
@@ -608,14 +627,16 @@ let view_type kind ~env =
       | `New path ->
           let cl = find_class path env in
           view_signature_item ~path ~env
-            [Sig_class(ident_of_path path ~default:"c", cl, Trec_first)]
+            [Sig_class(ident_of_path path ~default:"c", cl, Trec_first,
+                       Exported)]
       end
   | `Class (path, cty) ->
       let cld = { cty_params = []; cty_variance = []; cty_type = cty;
                   cty_path = path; cty_new = None; cty_loc = Location.none;
                   cty_attributes = []} in
       view_signature_item ~path ~env
-        [Sig_class(ident_of_path path ~default:"c", cld, Trec_first)]
+        [Sig_class(ident_of_path path ~default:"c", cld, Trec_first,
+                   Exported)]
   | `Module (path, mty) ->
       match mty with
         Mty_signature sign -> view_signature sign ~path ~env
@@ -623,7 +644,8 @@ let view_type kind ~env =
           let md =
 	    {md_type = mty; md_attributes = []; md_loc = Location.none} in
           view_signature_item ~path ~env
-            [Sig_module(ident_of_path path ~default:"M", md, Trec_not)]
+            [Sig_module(ident_of_path path ~default:"M", Mp_present,
+                        md, Trec_not, Exported)]
 
 let view_type_menu kind ~env ~parent =
   let title =
@@ -655,7 +677,7 @@ let view_type_menu kind ~env ~parent =
       Format.open_hbox ();
       Printtyp.reset ();
       Printtyp.mark_loops ty;
-      Printtyp.wrap_printing_env env
+      Printtyp.wrap_printing_env ~error:false env
         (fun () -> Printtyp.type_expr Format.std_formatter ty);
       Format.close_box (); Format.print_flush ();
       Format.set_formatter_output_functions fo ff;
@@ -738,7 +760,7 @@ and search_pos_class_expr ~pos cl =
         search_pos_class_structure ~pos cls
     | Tcl_fun (_, pat, iel, cl, _) ->
         search_pos_pat pat ~pos ~env:pat.pat_env;
-        List.iter iel ~f:(fun (_,_, exp) -> search_pos_expr exp ~pos);
+        List.iter iel ~f:(fun (_, exp) -> search_pos_expr exp ~pos);
         search_pos_class_expr cl ~pos
     | Tcl_apply (cl, el) ->
         search_pos_class_expr cl ~pos;
@@ -749,12 +771,13 @@ and search_pos_class_expr ~pos cl =
             search_pos_pat pat ~pos ~env:exp.exp_env;
             search_pos_expr exp ~pos
           end;
-        List.iter iel ~f:(fun (_,_, exp) -> search_pos_expr exp ~pos);
+        List.iter iel ~f:(fun (_, exp) -> search_pos_expr exp ~pos);
         search_pos_class_expr cl ~pos
+    | Tcl_open (_, cl)
     | Tcl_constraint (cl, _, _, _, _) ->
         search_pos_class_expr cl ~pos
     end;
-    add_found_str (`Class (Pident (Ident.create "c"), cl.cl_type))
+    add_found_str (`Class (Pident (Ident.create_local "c"), cl.cl_type))
       ~env:!start_env ~loc:cl.cl_loc
   end
 
@@ -782,12 +805,12 @@ and search_pos_expr ~pos exp =
         search_pos_expr exp' ~pos
       end;
       search_pos_expr exp ~pos
-  | Texp_function (_, l, _) ->
+  | Texp_function {cases=l; _} ->
       List.iter l ~f:(search_case ~pos)
   | Texp_apply (exp, l) ->
       List.iter l ~f:(fun (_, x) -> Misc.may (search_pos_expr ~pos) x);
       search_pos_expr exp ~pos
-  | Texp_match (exp, l, _, _) ->
+  | Texp_match (exp, l, _) ->
       search_pos_expr exp ~pos;
       List.iter l ~f:(search_case ~pos)
   | Texp_try (exp, l) ->
@@ -829,7 +852,7 @@ and search_pos_expr ~pos exp =
         ~env:exp.exp_env ~loc:exp.exp_loc
   | Texp_override (_, l) ->
       List.iter l ~f:(fun (_, _, exp) -> search_pos_expr exp ~pos)
-  | Texp_letmodule (id, _, modexp, exp) ->
+  | Texp_letmodule (id, _, _, modexp, exp) ->
       search_pos_module_expr modexp ~pos;
       search_pos_expr exp ~pos
   | Texp_assert exp ->
@@ -846,6 +869,10 @@ and search_pos_expr ~pos exp =
       ()
   | Texp_letexception (_, exp) ->
       search_pos_expr exp ~pos
+  | Texp_letop _ ->
+      ()
+  | Texp_open (_, exp) ->
+      search_pos_expr exp ~pos
   end;
   add_found_str (`Exp(`Expr, exp.exp_type)) ~env:exp.exp_env ~loc:exp.exp_loc
   end
@@ -858,7 +885,8 @@ and search_pos_pat ~pos ~env pat =
       add_found_str (`Exp(`Val (Pident id), pat.pat_type))
         ~env ~loc:pat.pat_loc
   | Tpat_alias (pat, _, _) -> search_pos_pat pat ~pos ~env
-  | Tpat_lazy pat -> search_pos_pat pat ~pos ~env
+  | Tpat_lazy pat
+  | Tpat_exception pat -> search_pos_pat pat ~pos ~env
   | Tpat_constant _ ->
       add_found_str (`Exp(`Const, pat.pat_type)) ~env ~loc:pat.pat_loc
   | Tpat_tuple l ->
@@ -892,7 +920,7 @@ and search_pos_module_expr ~pos (m :module_expr) =
     | Tmod_constraint (m, _, _, _) -> search_pos_module_expr m ~pos
     | Tmod_unpack (e, _) -> search_pos_expr e ~pos
     end;
-    add_found_str (`Module (Pident (Ident.create "M"), m.mod_type))
+    add_found_str (`Module (Pident (Ident.create_local "M"), m.mod_type))
       ~env:m.mod_env ~loc:m.mod_loc
   end
 

browser/setpath.ml

@@ -31,10 +31,10 @@ let exec_update_hooks () =
       end
 
 let set_load_path l =
-    Config.load_path := l;
+    Load_path.init l;
     exec_update_hooks ()
 
-let get_load_path () = !Config.load_path
+let get_load_path () = Load_path.get_paths ()
 
 let renew_dirs box ~var ~dir =
   Textvariable.set var dir;
@@ -46,7 +46,7 @@ let renew_dirs box ~var ~dir =
 
 let renew_path box =
   Listbox.delete box ~first:(`Num 0) ~last:`End;
-  Listbox.insert box ~index:`End ~texts:!Config.load_path;
+  Listbox.insert box ~index:`End ~texts:(Load_path.get_paths ());
   Jg_box.recenter box ~index:(`Num 0)
 
 let add_to_path ~dirs ?(base="") box =

browser/shell.ml

@@ -84,7 +84,8 @@ object (self)
       alive <- false;
       protect close_out out;
       try
-        if use_sigpipe then ignore (Unix.write sig1 ~buf:"T" ~pos:0 ~len:1);
+        if use_sigpipe then
+          ignore (Unix.write sig1 ~buf:(Bytes.make 1 'T') ~pos:0 ~len:1);
         List.iter ~f:(protect Unix.close) [in1; err1; sig1; sig2];
         if not use_threads then begin
           Fileevent.remove_fileinput ~fd:in1;
@@ -100,7 +101,7 @@ object (self)
     if alive then try
       reading <- false;
       if use_sigpipe then begin
-        ignore (Unix.write sig1 ~buf:"C" ~pos:0 ~len:1);
+        ignore (Unix.write sig1 ~buf:(Bytes.make 1 'C') ~pos:0 ~len:1);
         self#send " "
       end else
         Unix.kill ~pid ~signal:Sys.sigint
@@ -112,10 +113,10 @@ object (self)
     with Sys_error _ -> ()
   method private read ~fd ~len =
     begin try
-      let buf = String.create len in
+      let buf = Bytes.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);
+        self#insert (Bytes.sub_string buf ~pos:0 ~len);
         Text.mark_set textw ~mark:"input" ~index:(`Mark"insert",[`Char(-1)])
       end;
       len
@@ -192,11 +193,11 @@ object (self)
     List.iter ~f:Unix.close [in2;out2;err2];
     if use_threads then begin
       let fileinput_thread fd =
-        let buf = String.create 1024 in
+        let buf = Bytes.create 1024 in
         let len = ref 0 in
         try while len := Unix.read fd ~buf ~pos:0 ~len:1024; !len > 0 do
           Mutex.lock imutex;
-          Buffer.add_substring ibuffer buf 0 !len;
+          Buffer.add_subbytes ibuffer buf 0 !len;
           Mutex.unlock imutex
         done with Unix.Unix_error _ -> ()
       in
@@ -294,7 +295,7 @@ let f ~prog ~title =
         if Str.string_match ~!"TERM=" s 0 then "TERM=dumb" else s
       end in
   let load_path =
-    List2.flat_map !Config.load_path ~f:(fun dir -> ["-I"; dir]) in
+    List2.flat_map (Load_path.get_paths ()) ~f:(fun dir -> ["-I"; dir]) in
   let load_path =
     if is_win32 then List.map ~f:protect_arg load_path else load_path in
   let labels = if !Clflags.classic then ["-nolabels"] else [] in
@@ -351,7 +352,7 @@ let f ~prog ~title =
     end;
   file_menu#add_command "Import path" ~command:
     begin fun () ->
-      List.iter (List.rev !Config.load_path) ~f:
+      List.iter (List.rev (Load_path.get_paths ())) ~f:
         (fun dir ->
           (!sh)#send ("#directory \"" ^ String.escaped dir ^ "\";;\n"))
     end;

browser/typecheck.ml

@@ -99,6 +99,7 @@ let f txt =
   txt.psignature <- [];
   ignore (Stypes.get_info ());
   Clflags.annotations := true;
+  Clflags.color := Some Misc.Color.Never;
 
   begin try
 
@@ -115,7 +116,8 @@ let f txt =
     List.iter psl ~f:
     begin function
       Ptop_def pstr ->
-        let str, sign, env' = Typemod.type_structure !env pstr Location.none in
+        let str, sign, _names, env' =
+          Typemod.type_structure !env pstr Location.none in
         txt.structure <- txt.structure @ str.str_items;
         txt.signature <- txt.signature @ sign;
         env := env'
@@ -133,34 +135,26 @@ let f txt =
       let et, ew, end_message = Jg_message.formatted ~title:"Error !" () in
       error_messages := et :: !error_messages;
       let range = match exn with
-        Lexer.Error (err, l) ->
-          Lexer.report_error Format.std_formatter err; l
-      | Syntaxerr.Error err ->
-          Syntaxerr.report_error Format.std_formatter err;
-          Syntaxerr.location_of_error err
-      | Typecore.Error (l, env, err) ->
-          Typecore.report_error env Format.std_formatter err; l
-      | Typeclass.Error (l, env, err) ->
-          Typeclass.report_error env Format.std_formatter err; l
-      | Typedecl.Error (l, err) ->
-          Typedecl.report_error Format.std_formatter err; l
-      | Typemod.Error (l, env, err) ->
-          Typemod.report_error env Format.std_formatter err; l
-      | Typetexp.Error (l, env, err) ->
-          Typetexp.report_error env Format.std_formatter err; l
-      | Includemod.Error errl ->
-          Includemod.report_error Format.std_formatter errl; Location.none
-      | Env.Error err ->
-          Env.report_error Format.std_formatter err; Location.none
+        Lexer.Error (err, l) -> l
+      | Syntaxerr.Error err -> Syntaxerr.location_of_error err
+      | Typecore.Error (l, env, err) -> l
+      | Typeclass.Error (l, env, err) -> l
+      | Typedecl.Error (l, err) -> l
+      | Typemod.Error (l, env, err) -> l
+      | Typetexp.Error (l, env, err) -> l
+      | _ -> Location.none
+      in
+      begin match exn with
       | Cmi_format.Error err ->
-          Cmi_format.report_error Format.std_formatter err; Location.none
+          Cmi_format.report_error Format.std_formatter err
       | Ctype.Tags(l, l') ->
-          Format.printf "In this program,@ variant constructors@ `%s and `%s@ have same hash value.@." l l';
-          Location.none
+          Format.printf 
+            "In this program,@ variant constructors@ `%s and `%s@ %s.@."
+            l l' "have same hash value"
       | Failure s ->
-          Format.printf "%s.@." s; Location.none
-      | _ -> assert false
-      in
+          Format.printf "%s.@." s
+      | _ -> Location.report_exception Format.std_formatter exn
+      end;
       end_message ();
       let s = range.loc_start.Lexing.pos_cnum in
       let e = range.loc_end.Lexing.pos_cnum in

browser/viewer.ml

@@ -27,7 +27,7 @@ open Searchid
 
 (* Managing the module list *)
 
-let list_modules ~path =
+let list_modules ?(path=Load_path.get_paths ()) () =
   List.fold_left path ~init:[] ~f:
   begin fun modules dir ->
     let l =
@@ -35,7 +35,7 @@ let list_modules ~path =
         ~f:(fun x -> Filename.check_suffix x ".cmi") in
     let l = List.map l ~f:
     begin fun x ->
-      String.capitalize (Filename.chop_suffix x ".cmi")
+      String.capitalize_ascii (Filename.chop_suffix x ".cmi")
     end in
     List.fold_left l ~init:modules
      ~f:(fun modules item ->
@@ -45,7 +45,7 @@ let list_modules ~path =
 let reset_modules box =
   Listbox.delete box ~first:(`Num 0) ~last:`End;
   module_list := List.sort (Jg_completion.compare_string ~nocase:true)
-      (list_modules ~path:!Config.load_path);
+      (list_modules ());
   Listbox.insert box ~index:`End ~texts:!module_list;
   Jg_box.recenter box ~index:(`Num 0)
 
@@ -61,7 +61,8 @@ let view_symbol ~kind ~env ?path id =
   match kind with
     Pvalue ->
       let path, vd = lookup_value id env in
-      view_signature_item ~path ~env [Sig_value (Ident.create name, vd)]
+      view_signature_item ~path ~env
+        [Sig_value (Ident.create_local name, vd, Exported)]
   | Ptype -> view_type_id id ~env
   | Plabel -> let ld = lookup_label id env in
       begin match ld.lbl_res.desc with
@@ -73,7 +74,7 @@ let view_symbol ~kind ~env ?path id =
       begin match cd.cstr_tag, cd.cstr_res.desc with
 	Cstr_extension _, Tconstr (cpath, args, _) ->
           view_signature ~title:(string_of_longident id) ~env ?path
-            [Sig_typext (Ident.create name,
+            [Sig_typext (Ident.create_local name,
 			 {Types.ext_type_path = cpath;
 			  ext_type_params = args;
 			  ext_args = Cstr_tuple cd.cstr_args;
@@ -82,8 +83,10 @@ let view_symbol ~kind ~env ?path id =
 			  ext_private = cd.cstr_private;
 			  ext_loc = cd.cstr_loc;
 			  ext_attributes = cd.cstr_attributes},
-			 if Path.same cpath Predef.path_exn then Text_exception
-			 else Text_first)]
+			 (if Path.same cpath Predef.path_exn
+                         then Text_exception
+			 else Text_first),
+                         Exported)]
       | _, Tconstr (cpath, _, _) ->
           view_type_decl cpath ~env
       | _ -> ()
@@ -194,7 +197,7 @@ let search_which = ref "Name"
 
 let search_symbol () =
   if !module_list = [] then
-  module_list := List.sort ~cmp:compare (list_modules ~path:!Config.load_path);
+  module_list := List.sort ~cmp:compare (list_modules ());
   let tl = Jg_toplevel.titled "Search symbol" in
   Jg_bind.escape_destroy tl;
   let ew = Entry.create tl ~width:30 in
@@ -226,17 +229,19 @@ let search_symbol () =
 (* Display the contents of a module *)
 
 let ident_of_decl ~modlid = function
-    Sig_value (id, _) -> Lident (Ident.name id), Pvalue
-  | Sig_type (id, _, _) -> Lident (Ident.name id), Ptype
-  | Sig_typext (id, _, _) -> Ldot (modlid, Ident.name id), Pconstructor
-  | Sig_module (id, _, _) -> Lident (Ident.name id), Pmodule
-  | Sig_modtype (id, _) -> Lident (Ident.name id), Pmodtype
-  | Sig_class (id, _, _) -> Lident (Ident.name id), Pclass
-  | Sig_class_type (id, _, _) -> Lident (Ident.name id), Pcltype
+    Sig_value (id, _, _) -> Lident (Ident.name id), Pvalue
+  | Sig_type (id, _, _, _) -> Lident (Ident.name id), Ptype
+  | Sig_typext (id, _, _, _) -> Ldot (modlid, Ident.name id), Pconstructor
+  | Sig_module (id, _, _, _, _) -> Lident (Ident.name id), Pmodule
+  | Sig_modtype (id, _, _) -> Lident (Ident.name id), Pmodtype
+  | Sig_class (id, _, _, _) -> Lident (Ident.name id), Pclass
+  | Sig_class_type (id, _, _, _) -> Lident (Ident.name id), Pcltype
 
 let view_defined ~env ?(show_all=false) modlid =
-  try match Typetexp.find_module env Location.none modlid with
-    path, {md_type=Mty_signature sign} ->
+  try
+  let path, modtype = Typetexp.find_module env Location.none modlid in
+  match scrape_alias env modtype.md_type with
+    Mty_signature sign ->
     let rec iter_sign sign idents =
       match sign with
         [] -> List.rev idents
@@ -249,7 +254,10 @@ let view_defined ~env ?(show_all=false) modlid =
     in
     let l = iter_sign sign [] in
     let title = string_of_path path in
-    let env = open_signature Asttypes.Fresh path sign env in
+    let env =
+      match open_signature Asttypes.Fresh path env with None -> env
+      | Some env -> env
+    in
     !choose_symbol_ref l ~title ~signature:sign ~env ~path;
     if show_all then view_signature sign ~title ~env ~path
   | _ -> ()
@@ -532,7 +540,7 @@ object (self)
       n
     with Not_found ->
       match path with
-        Path.Pdot (path', _, _) ->
+        Path.Pdot (path', _) ->
           let n = self#get_box ~path:path' in
           shown_paths <- shown_paths @ [path];
           if n + 1 >= List.length boxes then ignore self#create_box;
@@ -545,7 +553,7 @@ object (self)
   method set_path path ~sign =
     let rec path_elems l path =
       match path with
-        Path.Pdot (path, _, _) -> path_elems (path::l) path
+        Path.Pdot (path, _) -> path_elems (path::l) path
       | _ -> []
     in
     let path_elems path =
@@ -563,7 +571,7 @@ object (self)
       try
         let modlid, s =
           match path with
-            Path.Pdot (p, s, _) -> longident_of_path p, s
+            Path.Pdot (p, s) -> longident_of_path p, s
           | Path.Pident i -> Longident.Lident "M", Ident.name i
           | _ -> assert false
         in

builtin/rawimg.ml

-external rawget : string -> string
+external rawget : string -> bytes
     = "camltk_getimgdata"
-external rawset : string -> string -> int -> int -> int -> int -> unit
+external rawset : string -> bytes -> int -> int -> int -> int -> unit
     = "camltk_setimgdata_bytecode"  (* all int parameters MUST be positive *)
       "camltk_setimgdata_native"
 
 type t = {
   pixmap_width : int;
   pixmap_height: int;
-  pixmap_data: string
+  pixmap_data: bytes
 }
 
+let (.![]<-) = Bytes.set
+
 type pixel = string  (* 3 chars *)
 
 (* pixmap will be an abstract type *)
@@ -17,28 +19,28 @@ let width pix = pix.pixmap_width
 let height pix = pix.pixmap_height
 
 
-(* note: invalid size would have been caught by String.create, but we put
+(* note: invalid size would have been caught by Bytes.create, but we put
  * it here for documentation purpose *)
 let create w h =
   if w < 0 || h < 0 then invalid_arg "invalid size"
   else {
     pixmap_width = w;
     pixmap_height = h;
-    pixmap_data = String.create (w * h * 3);
+    pixmap_data = Bytes.create (w * h * 3);
   }
 
 (*
  * operations on pixmaps
  *)
 let unsafe_copy pix_from pix_to =
-  String.unsafe_blit pix_from.pixmap_data 0
+  Bytes.unsafe_blit pix_from.pixmap_data 0
                      pix_to.pixmap_data 0
-                     (String.length pix_from.pixmap_data)
+                     (Bytes.length pix_from.pixmap_data)
 
 (* We check only the length. w,h might be different... *)
 let copy pix_from pix_to =
-  let l = String.length pix_from.pixmap_data in
-  if l <> String.length pix_to.pixmap_data then
+  let l = Bytes.length pix_from.pixmap_data in
+  if l <> Bytes.length pix_to.pixmap_data then
     raise (Invalid_argument "copy: incompatible length")
   else unsafe_copy pix_from pix_to
 
@@ -46,13 +48,11 @@ let copy pix_from pix_to =
 (* Pixel operations *)
 let unsafe_get_pixel pixmap x y =
   let pos = (y * pixmap.pixmap_width + x) * 3 in
-  let r = String.create 3 in
-  String.unsafe_blit pixmap.pixmap_data pos r 0 3;
-  r
+  Bytes.sub_string pixmap.pixmap_data pos 3
 
 let unsafe_set_pixel pixmap x y pixel =
   let pos = (y * pixmap.pixmap_width + x) * 3 in
-  String.unsafe_blit pixel 0 pixmap.pixmap_data pos 3
+  Bytes.unsafe_blit (Bytes.unsafe_of_string pixel) 0 pixmap.pixmap_data pos 3
 
 (* To get safe operations, we can either check x,y wrt [0,w[ and [0,h[
    or rely on blit checking. We choose the first for clarity.
@@ -73,11 +73,11 @@ let default_color = "\000\000\000"
 
 (* Char.chr does range checking *)
 let pixel r g b =
-  let s = String.create 3 in
-  s.[0] <- Char.chr r;
-  s.[1] <- Char.chr g;
-  s.[2] <- Char.chr b;
-  s
+  let s = Bytes.create 3 in
+  s.![0] <- Char.chr r;
+  s.![1] <- Char.chr g;
+  s.![2] <- Char.chr b;
+  Bytes.unsafe_to_string s
 
 ##ifdef CAMLTK
 

compiler/compile.ml

@@ -56,7 +56,7 @@ let nicknames =
   [ "class", "clas";
     "type", "typ" ]
 
-let small = String.lowercase
+let small = String.lowercase_ascii
 
 let gettklabel fc =
   match fc.template with

compiler/lexer.mll

@@ -54,7 +54,7 @@ let _ = List.iter
 
 (* To buffer string literals *)
 
-let initial_string_buffer = String.create 256
+let initial_string_buffer = Bytes.create 256
 let string_buff = ref initial_string_buffer
 let string_index = ref 0
 
@@ -64,17 +64,17 @@ let reset_string_buffer () =
   ()
 
 let store_string_char c =
-  if !string_index >= String.length (!string_buff) then begin
-    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));
+  if !string_index >= Bytes.length (!string_buff) then begin
+    let new_buff = Bytes.create (Bytes.length (!string_buff) * 2) in
+      Bytes.blit ~src:(!string_buff) ~src_pos:0 ~dst:new_buff ~dst_pos:0
+                  ~len:(Bytes.length (!string_buff));
       string_buff := new_buff
   end;
-  String.set (!string_buff) (!string_index) c;
+  Bytes.set (!string_buff) (!string_index) c;
   incr string_index
 
 let get_stored_string () =
-  let s = String.sub (!string_buff) ~pos:0 ~len:(!string_index) in
+  let s = Bytes.sub_string (!string_buff) 0 (!string_index) in
     string_buff := initial_string_buffer;
     s
 (* To translate escape sequences *)

compiler/maincompile.ml

@@ -167,7 +167,7 @@ let option_hack oc =
 let realname name =
   (* module name fix for camltk *)
   let name = caml_name name in
-  if !Flags.camltk then "c" ^ String.capitalize name
+  if !Flags.camltk then "c" ^ String.capitalize_ascii name
   else name
 ;;
 
@@ -229,8 +229,8 @@ let compile () =
     Copyright.write ~w:(output_string oc);
     Copyright.write ~w:(output_string oc');
     begin match wdef.module_type with
-      Widget -> output_string oc' ("(* The "^wname^" widget *)\n")
-    | Family -> output_string oc' ("(* The "^wname^" commands  *)\n")
+      Widget -> output_string oc' ("(** The "^wname^" widget *)\n")
+    | Family -> output_string oc' ("(** The "^wname^" commands  *)\n")
     end;
     List.iter ~f:(fun s -> output_string oc s; output_string oc' s)
       begin
@@ -291,8 +291,8 @@ let compile () =
     Hashtbl.iter (fun name _ ->
       let cname = realname name in
       output_string oc (Printf.sprintf "module %s = %s;;\n"
-                          (String.capitalize (caml_name name))
-                          (String.capitalize cname))) module_table;
+                          (String.capitalize_ascii (caml_name name))
+                          (String.capitalize_ascii cname))) module_table;
     close_out oc
   end else begin
     let oc = open_out_bin (destfile "labltk.ml") in
@@ -312,8 +312,8 @@ module Timer = Timer;;\n\
     Hashtbl.iter (fun name _ ->
       let cname = realname name in
       output_string oc (Printf.sprintf "module %s = %s;;\n"
-                          (String.capitalize (caml_name name))
-                          (String.capitalize cname))) module_table;
+                          (String.capitalize_ascii (caml_name name))
+                          (String.capitalize_ascii cname))) module_table;
     (* widget typer *)
     output_string oc "\n(** Widget typers *)\n\nopen Widget\n\n";
     Hashtbl.iter (fun name def ->

compiler/parser.mly

@@ -63,7 +63,7 @@ open Tables
 
 %%
 TypeName:
-   IDENT { String.uncapitalize $1 }
+   IDENT { String.uncapitalize_ascii $1 }
  | WIDGET { "widget" }
 ;
 
@@ -329,7 +329,7 @@ entry :
 | WIDGET ModuleName LBRACE WidgetComponents RBRACE
     { enter_widget $2 $4 }
 | MODULE ModuleName LBRACE ModuleComponents RBRACE
-    { enter_module (String.uncapitalize $2) $4 }
+    { enter_module (String.uncapitalize_ascii $2) $4 }
 | EOF
     { raise End_of_file }
 ;