Commit 057c12c6 authored by Pietro Abate's avatar Pietro Abate

[r2004-06-28 04:51:58 by afrisch] -static

Original author: afrisch
Date: 2004-06-28 04:51:59+00:00
parent f6ac2e83
......@@ -288,7 +288,7 @@ let compile src out_dir =
let out = Filename.concat out_dir (cu ^ ".cdo") in
let id = Types.CompUnit.mk (U.mk_latin1 cu) in
Librarian.compile !verbose cu id src;
Librarian.save id out;
Librarian.save cu id out;
exit 0
with exn -> catch_exn Format.err_formatter exn; exit 1
......
......@@ -64,6 +64,7 @@ let deserialize s =
let types = Serialize.Get.array Types.deserialize s in
mk ((typing,compile,code),types)
(*
let serialize_dep=
Serialize.Put.list
(Serialize.Put.pair Encodings.Utf8.serialize Serialize.Put.string)
......@@ -71,6 +72,7 @@ let serialize_dep=
let deserialize_dep =
Serialize.Get.list
(Serialize.Get.pair Encodings.Utf8.deserialize Serialize.Get.string)
*)
let find_obj id =
......@@ -79,7 +81,7 @@ let find_obj id =
List.find (fun p -> Sys.file_exists (Filename.concat p base)) !obj_path in
Filename.concat p base
let save id out =
let save name id out =
protect_op "Save compilation unit";
let cu = find id in
......@@ -103,10 +105,10 @@ let save id out =
) depend
with Not_found -> assert false in
let depend = Serialize.Put.run serialize_dep depend in
(* let depend = Serialize.Put.run serialize_dep depend in *)
let digest = Digest.string raw in
let oc = open_out out in
Marshal.to_channel oc (digest,depend,raw,cu.stub) [];
Marshal.to_channel oc (name,digest,depend,raw,cu.stub) [];
close_out oc
......@@ -192,28 +194,40 @@ let rec load id =
try open_in obj
with Sys_error _ -> raise (CannotOpen obj) in
let (dig, depend, raw, stub) =
let (name, dig, depend, raw, stub) =
try Marshal.from_channel ic
with Failure _ | End_of_file -> raise (InvalidObject obj) in
close_in ic;
let depend = Serialize.Get.run deserialize_dep depend in
(* let depend = Serialize.Get.run deserialize_dep depend in *)
check_loop id;
if !during_compile then depends := id :: !depends;
List.iter (fun (id,dig) -> load_check (C.mk id) dig) depend;
C.enter id;
let cu = Serialize.Get.run deserialize raw in
C.leave ();
cu.depends <- List.map (fun (id,_) -> C.mk id) depend;
cu.digest <- Some dig;
C.Tbl.add tbl id cu;
Typer.register_types id cu.typing;
cu
load_from_string id raw dig depend
and load_check id exp =
let cu = load id in
check_digest id exp cu.digest
and load_from_string id raw dig depend =
List.iter (fun (id,dig) -> load_check (C.mk id) dig) depend;
C.enter id;
let cu = Serialize.Get.run deserialize raw in
C.leave ();
cu.depends <- List.map (fun (id,_) -> C.mk id) depend;
C.Tbl.add tbl id cu;
Typer.register_types id cu.typing;
cu.digest <- Some dig;
cu
let load_from_string id raw dig depend =
if C.Tbl.mem tbl id then failwith "Librarian: unit already loaded";
load_from_string id raw dig depend
let register_unit id raw dig depend =
let id = C.mk (Ident.U.mk id) in
let depend = List.map (fun (x,y) -> (Ident.U.mk x,y)) depend in
ignore (load_from_string id raw dig depend)
let rec run id =
let cu = find id in
match cu.status with
......@@ -238,8 +252,12 @@ let rec run id =
let import id = ignore (load id)
let import_check id chk = ignore (load_check id chk)
let import_and_run id = import id; run id
let import_from_string id str dig dep = ignore (load_from_string id str dig dep)
let () =
Typer.from_comp_unit := (fun cu -> (load cu).typing);
Compile.from_comp_unit := (fun cu -> (load cu).compile);
......
......@@ -9,8 +9,12 @@ val obj_path: string list ref
val compile: bool -> string -> Types.CompUnit.t -> string -> unit
val run: Types.CompUnit.t -> unit
val import: Types.CompUnit.t -> unit
val import_check: Types.CompUnit.t -> Digest.t -> unit
val import_from_string: Types.CompUnit.t -> string -> string -> (Ident.U.t * Digest.t) list -> unit
val register_unit: string -> string -> string -> (string * string) list -> unit
val import_and_run: Types.CompUnit.t -> unit
val save: Types.CompUnit.t -> string -> unit
val save: string -> Types.CompUnit.t -> string -> unit
val registered_types: Types.CompUnit.t -> Types.t array
......
......@@ -7,6 +7,7 @@ module type S = sig
val clear: 'a t -> unit
val add: 'a t -> key -> 'a -> unit
val find: 'a t -> key -> 'a
val mem: 'a t -> key -> bool
end
type key = int
......@@ -46,3 +47,8 @@ let find t i =
| None -> raise Not_found
| Some x -> x
let mem t i =
if i >= Array.length !t then false
else match (!t).(i) with
| None -> false
| Some _ -> true
......@@ -7,6 +7,7 @@ module type S = sig
val clear: 'a t -> unit
val add: 'a t -> key -> 'a -> unit
val find: 'a t -> key -> 'a
val mem: 'a t -> key -> bool
end
include S with type key = int
let loc = (-1,-1)
let usage =
"Usage: cdo2ml <module>.cdo
"Usage: cdo2ml [-static] <module>.cdo
Can also be used as a preprocessor for OCaml:
ocamlc -c -pp cdo2ml -impl <module>.cdo
ocamlc -c -pp \"cdo2ml -static\" -impl <module>.cdo
"
let err () = prerr_endline usage; exit 1
let () =
let fn =
if Array.length Sys.argv != 2 then (prerr_endline usage; exit 1)
else Sys.argv.(1) in
let fn,static =
match Array.length Sys.argv with
| 2 -> Sys.argv.(1),false
| 3 ->
if Sys.argv.(1) <> "-static" then err ();
Sys.argv.(2),true
| _ -> err ()
in
let ic =
try open_in (Sys.argv.(1))
try open_in fn
with Sys_error x ->
prerr_endline x;
exit 1 in
let (digest,depend,raw,extra) = input_value ic in
let (name,digest,depend,raw,stub) :
string * Digest.t * (string*string) list * string *
(string * MLast.str_item list) option =
input_value ic in
let (prolog,code) =
match extra with
match stub with
| None ->
Printf.eprintf "Error: no stub found in this cdo file !\n";
exit 1
| Some x -> x in
print_endline "(* Automatically generated by cdo2ml.ml. Do no edit ! *)";
if static then (
Printf.printf
"let () = CDuce_all.Librarian.register_unit %S %S %S ["
name raw digest;
List.iter (fun (cu,chk) -> Printf.printf "(%S,%S)" cu chk) depend;
Printf.printf "]\n";
);
print_endline prolog;
let code = List.map (fun x -> (x,loc)) code in
!Pcaml.print_implem code
......@@ -460,7 +460,7 @@ let stub name ty_env c_env values =
<:str_item< Librarian.run cu >>
] @
(if g = [] then [] else [ <:str_item< value rec $list:g$ >> ]) @
[ <:str_item< value $list:items$ >> ]
(if items = [] then [] else [ <:str_item< value $list:items$ >> ])
......@@ -469,13 +469,15 @@ let () =
(fun cu ty_env c_env ->
try
let name = String.capitalize cu in
let (prolog, values) = Mltypes.read_cmi name in
let (prolog, values) =
try Mltypes.read_cmi name
with Not_found ->
Printf.eprintf "Warning: no caml interface\n";
("",[]) in
let code = stub cu ty_env c_env values in
Some (Obj.magic (prolog,code)),
get_registered_types ()
with
| Mltypes.Error s -> raise (Location.Generic s)
| Not_found -> Printf.eprintf "Warning: no caml interface\n"; None, [||]
with Mltypes.Error s -> raise (Location.Generic s)
);
Externals.register_external :=
......
......@@ -2,9 +2,12 @@
run:
ocamlc -c a.mli
../../cduce --compile c.cd
../../cduce --compile a.cd
../../cdo2ml a.cdo > a.ml
ocamlfind ocamlc -package cduce -linkpkg -o a a.ml b.ml
../../cdo2ml -static c.cdo > c.ml
../../cdo2ml -static a.cdo > a.ml
ocamlfind ocamlc -package cduce -linkpkg -o a c.ml a.ml b.ml
rm *.cdo
./a
clean:
......
......@@ -18,7 +18,7 @@ let pp (x : Any) : Latin1 = string_of x
let exists = external "Sys.file_exists"
let i = 1
let i = c:j
let home = external "Sys.getenv" "HOME"
......
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