Commit acb706f6 authored by Kim Nguyễn's avatar Kim Nguyễn
Browse files

Fix the generation of OCaml stub code to link CDuce and OCaml code.

Add a new flag --binarystub to allow creating the stubs in binary format instead of OCaml text source.
parent ce7ff52a
......@@ -18,6 +18,8 @@ let mlstub = ref false
let topstub = ref false
let binarystub = ref false
let version () =
Printf.eprintf "CDuce, version %s\n" Version.cduce_version;
Printf.eprintf "Using OCaml %s compiler\n" Version.ocaml_compiler;
......@@ -80,6 +82,9 @@ let parse_argv () =
( "--topstub",
Arg.Set topstub,
" produce stub ML code for a toplevel from a primitive file" );
( "--binarystub",
Arg.Set binarystub,
" output stub ML code in binary format (default text format)" );
( "-help",
Arg.Unit (fun () -> raise (Arg.Bad "unknown option '-help'")),
"" );
......@@ -212,5 +217,5 @@ let main () =
| `Run (f, args) ->
Cduce_driver.set_argv args;
Cduce_driver.run f
| `Mlstub f -> Librarian.prepare_stub f
| `Topstub f -> !Librarian.make_wrapper f
| `Mlstub f -> Librarian.prepare_stub !binarystub f
| `Topstub f -> !Librarian.make_wrapper !binarystub f
......@@ -229,18 +229,18 @@ let () =
Eval.get_builtin := Hashtbl.find static_externals
let stub_ml =
ref (fun _ _ _ _ _ ->
ref (fun _ _ _ _ _ _ _ ->
Printf.eprintf "Fatal error: no support for the OCaml interface.\n";
exit 2)
let prepare_stub src =
let prepare_stub binary src =
let c = real_load src in
(* Create stub types in a fresh compilation unit *)
Compunit.enter ();
let i1, i2 = Compunit.get_hash c.descr in
Compunit.set_hash (Compunit.current ()) (-i1) i2;
!stub_ml (U.get_str c.name) c.typing c.compile c.ext_info (fun types ->
!stub_ml binary src (U.get_str c.name) c.typing c.compile c.ext_info (fun types ->
Compunit.leave ();
Marshal.to_string (Value.extract_all (), types, c) [])
......@@ -268,4 +268,4 @@ let name d = (from_descr d).name
let run d = run (from_descr d)
let make_wrapper = ref (fun _ -> failwith "OCaml/CDuce interface not available")
let make_wrapper = ref (fun _ _ -> failwith "OCaml/CDuce interface not available")
......@@ -14,13 +14,13 @@ val compile_run: bool -> U.t -> string -> unit
val load_run: U.t -> unit
val run: Compunit.t -> unit
val prepare_stub: string -> unit
val prepare_stub: bool -> string -> unit
val ocaml_stub: string ->
Types.t array * (Value.t array -> unit) *
Value.t array *
(unit -> unit)
val stub_ml : (string -> Typer.t -> Compile.env ->
val stub_ml : (bool -> string -> string -> Typer.t -> Compile.env ->
Externals.ext_info option -> (Types.t array -> string) ->
unit) ref
......@@ -29,4 +29,4 @@ val register_static_external: string -> Value.t -> unit
val get_builtins: unit -> string list
val make_wrapper: (string -> unit) ref
val make_wrapper: (bool -> string -> unit) ref
......@@ -877,7 +877,7 @@ and_expr_list:
app_expr:
| e1=app_expr e2=no_seq_expr {
if is_not e1 then exp $sloc (logical_not e2)
else exp $sloc (Apply (e1, e2))
else exp $sloc (Apply (e1, e2))
}
| e = no_seq_expr { e }
;
......
......@@ -43,6 +43,7 @@ val nil : t
val vtrue : t
val vfalse : t
val vbool : bool -> t
val pair : t -> t -> t
(** @return a Record value from an associative list of fields *)
val vrecord : (Label.t * t) list -> t
......
This diff is collapsed.
This diff is collapsed.
......@@ -143,9 +143,9 @@ let builtins =
"array";
"Big_int.big_int";
"option";
"Cduce_lib.Value.t";
"Cduce_lib.Encodings.Utf8.t";
"Cduce_lib.Atoms.V.t";
"Cduce_core.Value.t";
"Cduce_types.Encodings.Utf8.t";
"Cduce_types.Atoms.V.t";
]
let vars = ref []
......@@ -352,6 +352,14 @@ let load_module name =
in
raise (Loc.Generic s)
let build_type_decl id t rs =
match Ocaml.Printtyp.tree_of_type_declaration id t rs with
Outcometree.Osig_type (otdecl, ors) ->
Ast_helper.Str.type_
| _ -> assert false
let read_cmi name =
Mlcompat.Mltypes.load_path ();
let filename = Mlcompat.Mltypes.find_in_path (name ^ ".cmi") in
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment