Unify toploop.mli / opttoploop.mli

.gitignore

@@ -259,6 +259,13 @@ _build
 /tools/caml-tex
 /tools/eventlog_metadata
 
+/toplevel/byte/toploop.mli
+/toplevel/byte/topdirs.mli
+/toplevel/byte/topmain.mli
+/toplevel/native/toploop.mli
+/toplevel/native/topdirs.mli
+/toplevel/native/topmain.mli
+
 /utils/config.ml
 /utils/domainstate.ml
 /utils/domainstate.mli

Makefile

@@ -67,8 +67,6 @@ OPTSTART=driver/optmain.cmo
 
 TOPLEVELSTART=toplevel/topstart.cmo
 
-OPTTOPLEVELSTART=toplevel/opttopstart.cmo
-
 PERVASIVES=$(STDLIB_MODULES) outcometree topdirs toploop
 
 LIBFILES=stdlib.cma std_exit.cmo *.cmi camlheader
@@ -373,6 +371,12 @@ endif
 	   driver/*.cmi \
 	   toplevel/*.cmi \
 	   "$(INSTALL_COMPLIBDIR)"
+	$(INSTALL_DATA) \
+	   toplevel/native/*.cmi \
+	   "$(INSTALL_COMPLIBDIR)"
+	$(INSTALL_DATA) \
+	   toplevel/byte/*.cmi \
+	   "$(INSTALL_COMPLIBDIR)"
 ifeq "$(INSTALL_SOURCE_ARTIFACTS)" "true"
 	$(INSTALL_DATA) \
 	   utils/*.cmt utils/*.cmti utils/*.mli \
@@ -384,6 +388,9 @@ ifeq "$(INSTALL_SOURCE_ARTIFACTS)" "true"
 	   driver/*.cmt driver/*.cmti driver/*.mli \
 	   toplevel/*.cmt toplevel/*.cmti toplevel/*.mli \
 	   "$(INSTALL_COMPLIBDIR)"
+	$(INSTALL_DATA) \
+	   toplevel/byte/*.cmt toplevel/byte/*.cmti toplevel/byte/*.mli \
+	   "$(INSTALL_COMPLIBDIR)"
 endif
 	$(INSTALL_DATA) \
 	  compilerlibs/*.cma \
@@ -397,8 +404,8 @@ endif
 	   "$(INSTALL_LIBDIR)"
 ifeq "$(INSTALL_SOURCE_ARTIFACTS)" "true"
 	$(INSTALL_DATA) \
-	   toplevel/topdirs.cmt toplevel/topdirs.cmti \
-           toplevel/topdirs.mli \
+	   toplevel/byte/topdirs.cmt \
+	   toplevel/topdirs.cmti toplevel/byte/topdirs.mli \
 	   "$(INSTALL_LIBDIR)"
 endif
 	$(MAKE) -C tools install
@@ -538,10 +545,7 @@ installoptopt:
 	if test -f ocamlnat$(EXE) ; then \
 	  $(INSTALL_PROG) ocamlnat$(EXE) "$(INSTALL_BINDIR)"; \
 	  $(INSTALL_DATA) \
-	     toplevel/opttopdirs.cmi \
-	     "$(INSTALL_LIBDIR)"; \
-	  $(INSTALL_DATA) \
-	     $(OPTTOPLEVELSTART:.cmo=.cmx) $(OPTTOPLEVELSTART:.cmo=.$(O)) \
+	     $(TOPLEVELSTART:.cmo=.cmx) $(TOPLEVELSTART:.cmo=.$(O)) \
 	     "$(INSTALL_COMPLIBDIR)"; \
 	fi
 	cd "$(INSTALL_COMPLIBDIR)" && \
@@ -555,7 +559,8 @@ ifeq "$(INSTALL_SOURCE_ARTIFACTS)" "true"
 	   utils/*.ml parsing/*.ml typing/*.ml bytecomp/*.ml driver/*.ml \
            file_formats/*.ml \
            lambda/*.ml \
-	   toplevel/*.ml middle_end/*.ml middle_end/closure/*.ml \
+	   toplevel/*.ml toplevel/byte/*.ml \
+	   middle_end/*.ml middle_end/closure/*.ml \
      middle_end/flambda/*.ml middle_end/flambda/base_types/*.ml \
 	   asmcomp/*.ml \
 	   asmcmp/debug/*.ml \
@@ -611,7 +616,7 @@ ocaml_dependencies := \
 
 .INTERMEDIATE: ocaml.tmp
 ocaml.tmp: $(ocaml_dependencies)
-	$(CAMLC) $(LINKFLAGS) -linkall -o $@ $^
+	$(CAMLC) $(LINKFLAGS) -I toplevel/byte -linkall -o $@ $^
 
 ocaml$(EXE): $(expunge) ocaml.tmp
 	- $(CAMLRUN) $^ $@ $(PERVASIVES)
@@ -1004,8 +1009,12 @@ ocamlnat$(EXE): compilerlibs/ocamlcommon.cmxa compilerlibs/ocamloptcomp.cmxa \
     compilerlibs/ocamlbytecomp.cmxa \
     otherlibs/dynlink/dynlink.cmxa \
     compilerlibs/ocamlopttoplevel.cmxa \
-    $(OPTTOPLEVELSTART:.cmo=.cmx)
-	$(CAMLOPT_CMD) $(LINKFLAGS) -linkall -o $@ $^
+    $(TOPLEVELSTART:.cmo=.cmx)
+	$(CAMLOPT_CMD) $(LINKFLAGS) -linkall -I toplevel/native -o $@ $^
+
+$(TOPLEVELSTART:.cmo=.cmx): $(TOPLEVELSTART:.cmo=.ml) \
+     toplevel/native/topmain.cmx
+	$(CAMLOPT_CMD) $(COMPFLAGS) $(OPTCOMPFLAGS) -I toplevel/native -c $<
 
 partialclean::
 	rm -f ocamlnat ocamlnat.exe
@@ -1040,19 +1049,19 @@ endif
 .SUFFIXES: .ml .mli .cmo .cmi .cmx
 
 .ml.cmo:
-	$(CAMLC) $(COMPFLAGS) -c $<
+	$(CAMLC) $(COMPFLAGS) -c $< -I $(@D)
 
 .mli.cmi:
 	$(CAMLC) $(COMPFLAGS) -c $<
 
 .ml.cmx:
-	$(CAMLOPT) $(COMPFLAGS) $(OPTCOMPFLAGS) -c $<
+	$(CAMLOPT) $(COMPFLAGS) $(OPTCOMPFLAGS) -c $< -I $(@D)
 
 partialclean::
 	for d in utils parsing typing bytecomp asmcomp middle_end file_formats \
            lambda middle_end/closure middle_end/flambda \
            middle_end/flambda/base_types asmcomp/debug \
-           driver toplevel tools; do \
+           driver toplevel toplevel/byte toplevel/native tools; do \
 	  rm -f $$d/*.cm[ioxt] $$d/*.cmti $$d/*.annot $$d/*.s $$d/*.asm \
 	    $$d/*.o $$d/*.obj $$d/*.so $$d/*.dll; \
 	done
@@ -1062,8 +1071,8 @@ depend: beforedepend
 	(for d in utils parsing typing bytecomp asmcomp middle_end \
          lambda file_formats middle_end/closure middle_end/flambda \
          middle_end/flambda/base_types asmcomp/debug \
-         driver toplevel; \
-         do $(CAMLDEP) $(DEPFLAGS) $(DEPINCLUDES) $$d/*.mli $$d/*.ml || exit; \
+         driver toplevel toplevel/byte toplevel/native; \
+         do $(CAMLDEP) $(DEPFLAGS) -I $$d $(DEPINCLUDES) $$d/*.mli $$d/*.ml || exit; \
          done) > .depend
 
 .PHONY: distclean

compilerlibs/Makefile.compilerlibs

@@ -261,14 +261,32 @@ MIDDLE_END_CMI=\
 OPTCOMP=$(MIDDLE_END) $(ASMCOMP)
 OPTCOMP_CMI=$(MIDDLE_END_CMI) $(ASMCOMP_CMI)
 
-TOPLEVEL=toplevel/genprintval.cmo toplevel/toploop.cmo \
-  toplevel/trace.cmo toplevel/topdirs.cmo toplevel/topmain.cmo
-TOPLEVEL_CMI=
+TOPLEVEL=toplevel/genprintval.cmo toplevel/byte/toploop.cmo \
+  toplevel/byte/trace.cmo toplevel/byte/topdirs.cmo toplevel/byte/topmain.cmo
+TOPLEVEL_CMI=toplevel/byte/toploop.cmi toplevel/byte/trace.cmi toplevel/byte/topdirs.cmi toplevel/byte/topmain.cmi
 
-OPTTOPLEVEL=toplevel/genprintval.cmo toplevel/opttoploop.cmo \
-  toplevel/opttopdirs.cmo toplevel/opttopmain.cmo
-OPTTOPLEVEL_CMI=
+OPTTOPLEVEL=toplevel/genprintval.cmo toplevel/native/toploop.cmo \
+  toplevel/native/topdirs.cmo toplevel/native/topmain.cmo
+OPTTOPLEVEL_CMI=toplevel/native/toploop.cmi toplevel/native/topdirs.cmi toplevel/native/topmain.cmi
 
+TOPLEVEL_SHARED_MLIS = toploop.mli topdirs.mli topmain.mli
+
+toplevel/%/toploop.cmi: toplevel/toploop.cmi
+	cp $< toplevel/toploop.mli $(@D)
+
+toplevel/%/topdirs.cmi: toplevel/topdirs.cmi
+	cp $< toplevel/topdirs.mli $(@D)
+
+toplevel/%/topmain.cmi: toplevel/topmain.cmi
+	cp $< toplevel/topmain.mli $(@D)
+
+beforedepend::
+	cp $(TOPLEVEL_SHARED_MLIS:%=toplevel/%) toplevel/byte/
+	cp $(TOPLEVEL_SHARED_MLIS:%=toplevel/%) toplevel/native/
+
+partialclean::
+	rm -f $(TOPLEVEL_SHARED_MLIS:%=toplevel/byte/%)
+	rm -f $(TOPLEVEL_SHARED_MLIS:%=toplevel/native/%)
 
 $(COMMON:.cmo=.cmx) $(BYTECOMP:.cmo=.cmx) $(OPTCOMP:.cmo=.cmx): ocamlopt$(EXE)
 $(OPTTOPLEVEL:.cmo=.cmx): ocamlopt$(EXE)
@@ -322,12 +340,12 @@ partialclean::
 
 
 compilerlibs/ocamltoplevel.cma: $(TOPLEVEL_CMI) $(TOPLEVEL)
-	$(CAMLC) -a -o $@ $(TOPLEVEL)
+	$(CAMLC) -a -o $@ -I toplevel/byte $(TOPLEVEL)
 partialclean::
 	rm -f compilerlibs/ocamltoplevel.cma
 
 compilerlibs/ocamlopttoplevel.cmxa: $(OPTTOPLEVEL_CMI) $(OPTTOPLEVEL:.cmo=.cmx)
-	$(CAMLOPT) -a -o $@ $(OPTTOPLEVEL:.cmo=.cmx)
+	$(CAMLOPT) -a -o $@ -I toplevel/native $(OPTTOPLEVEL:.cmo=.cmx)
 partialclean::
 	rm -f compilerlibs/ocamlopttoplevel.cmxa \
 	  compilerlibs/ocamlopttoplevel.a compilerlibs/ocamlopttoplevel.lib

toplevel/opttopdirs.mli → toplevel/byte/topdirs.mli

@@ -26,6 +26,9 @@ val dir_use : formatter -> string -> unit
 val dir_use_output : formatter -> string -> unit
 val dir_install_printer : formatter -> Longident.t -> unit
 val dir_remove_printer : formatter -> Longident.t -> unit
+val dir_trace : formatter -> Longident.t -> unit
+val dir_untrace : formatter -> Longident.t -> unit
+val dir_untrace_all : formatter -> unit -> unit
 
 type 'a printer_type_new = Format.formatter -> 'a -> unit
 type 'a printer_type_old = 'a -> unit

toplevel/opttopdirs.ml → toplevel/native/topdirs.ml

@@ -19,7 +19,7 @@ open Format
 open Misc
 open Longident
 open Types
-open Opttoploop
+open Toploop
 
 (* The standard output formatter *)
 let std_out = std_formatter
@@ -114,8 +114,8 @@ let _ = Hashtbl.add directive_table "load" (Directive_string (dir_load std_out))
 
 (* Load commands from a file *)
 
-let dir_use ppf name = ignore(Opttoploop.use_file ppf name)
-let dir_use_output ppf name = ignore(Opttoploop.use_output ppf name)
+let dir_use ppf name = ignore(Toploop.use_file ppf name)
+let dir_use_output ppf name = ignore(Toploop.use_output ppf name)
 
 let _ = Hashtbl.add directive_table "use" (Directive_string (dir_use std_out))
 let _ = Hashtbl.add directive_table "use_output"
@@ -195,6 +195,12 @@ let parse_warnings ppf iserr s =
   try Warnings.parse_options iserr s
   with Arg.Bad err -> fprintf ppf "%s.@." err
 
+let unavailable () = invalid_arg "Directive unavailable in the native toplevel."
+
+let dir_trace _ _ = unavailable ()
+let dir_untrace _ _ = unavailable ()
+let dir_untrace_all _ _ = unavailable ()
+
 let _ =
 (* Control the printing of values *)
 

toplevel/opttoploop.ml → toplevel/native/toploop.ml

@@ -60,6 +60,10 @@ type directive_fun =
    | Directive_ident of (Longident.t -> unit)
    | Directive_bool of (bool -> unit)
 
+type directive_info = {
+  section: string;
+  doc: string;
+}
 
 let remembered = ref Ident.empty
 
@@ -215,6 +219,14 @@ let run_hooks hook = List.iter (fun f -> f hook) !hooks
 
 (* Load in-core and execute a lambda term *)
 
+let may_trace = ref false (* Global lock on tracing *)
+
+let backtrace = ref None
+
+let record_backtrace () =
+  if Printexc.backtrace_status ()
+  then backtrace := Some (Printexc.get_backtrace ())
+
 let phrase_seqid = ref 0
 let phrase_name = ref "TOP"
 
@@ -271,12 +283,21 @@ let load_lambda ppf ~module_ident ~required_globals lam size =
     if Filename.is_implicit dll
     then Filename.concat (Sys.getcwd ()) dll
     else dll in
-  let res = dll_run dll !phrase_name in
-  (try Sys.remove dll with Sys_error _ -> ());
-  (* note: under windows, cannot remove a loaded dll
-     (should remember the handles, close them in at_exit, and then remove
-     files) *)
-  res
+  match
+    may_trace := true;
+    Fun.protect
+      ~finally:(fun () ->
+          may_trace := false;
+          (try Sys.remove dll with Sys_error _ -> ()))
+            (* note: under windows, cannot remove a loaded dll
+               (should remember the handles, close them in at_exit, and then
+               remove files) *)
+      (fun () -> dll_run dll !phrase_name)
+  with
+  | res -> res
+  | exception x ->
+      record_backtrace ();
+      Exception x
 
 (* Print the outcome of an evaluation *)
 
@@ -300,12 +321,26 @@ let print_out_exception ppf exn outv =
 let print_exception_outcome ppf exn =
   if exn = Out_of_memory then Gc.full_major ();
   let outv = outval_of_value !toplevel_env (Obj.repr exn) Predef.type_exn in
-  print_out_exception ppf exn outv
+  print_out_exception ppf exn outv;
+  if Printexc.backtrace_status ()
+  then
+    match !backtrace with
+      | None -> ()
+      | Some b ->
+          print_string b;
+          backtrace := None
 
 (* The table of toplevel directives.
    Filled by functions from module topdirs. *)
 
-let directive_table = (Hashtbl.create 13 : (string, directive_fun) Hashtbl.t)
+let directive_table = (Hashtbl.create 23 : (string, directive_fun) Hashtbl.t)
+
+let directive_info_table =
+  (Hashtbl.create 23 : (string, directive_info) Hashtbl.t)
+
+let add_directive name dir_fun dir_info =
+  Hashtbl.add directive_table name dir_fun;
+  Hashtbl.add directive_info_table name dir_info
 
 (* Execute a toplevel phrase *)
 
@@ -682,3 +717,8 @@ let run_script ppf name args =
     else name
   in
   use_silently ppf explicit_name
+
+(* API compat *)
+
+let getvalue _ = assert false
+let setvalue _ _ = assert false

toplevel/opttopmain.ml → toplevel/native/topmain.ml

@@ -40,12 +40,12 @@ let expand_position pos len =
 
 
 let prepare ppf =
-  Opttoploop.set_paths ();
+  Toploop.set_paths ();
   try
     let res =
-      List.for_all (Opttopdirs.load_file ppf) (List.rev !preload_objects)
+      List.for_all (Topdirs.load_file ppf) (List.rev !preload_objects)
     in
-    Opttoploop.run_hooks Opttoploop.Startup;
+    Toploop.run_hooks Toploop.Startup;
     res
   with x ->
     try Location.report_exception ppf x; false
@@ -73,7 +73,7 @@ let file_argument name =
                               (Array.length !argv - !Arg.current)
       in
       Compmisc.read_clflags_from_env ();
-      if prepare ppf && Opttoploop.run_script ppf name newargs
+      if prepare ppf && Toploop.run_script ppf name newargs
       then raise (Exit_with_status 0)
       else raise (Exit_with_status 2)
     end
@@ -115,7 +115,7 @@ let main () =
   Compmisc.read_clflags_from_env ();
   if not (prepare Format.err_formatter) then raise (Exit_with_status 2);
   Compmisc.init_path ();
-  Opttoploop.loop Format.std_formatter
+  Toploop.loop Format.std_formatter
 
 let main () =
   match main () with