Commit c03c038a authored by Pietro Abate's avatar Pietro Abate
Browse files

[r2005-07-15 13:20:10 by afrisch] Uid clashes + get rid of cdo2ml

Original author: afrisch
Date: 2005-07-15 13:20:10+00:00
parent a9c835af
......@@ -193,8 +193,8 @@ let abstr_lab l x res =
let rec to_cd e t =
(* Format.fprintf Format.std_formatter "to_cd %a [uid=%i; recurs=%i]@."
Mltypes.print t t.uid t.recurs; *)
(* Format.fprintf Format.err_formatter "to_cd %a [uid=%i; recurs=%i]@."
Mltypes.print t t.uid t.recurs; *)
if t.recurs > 0 then <:expr< $lid:to_cd_fun t$ $e$ >>
else to_cd_descr e t.def
......@@ -315,8 +315,8 @@ and tuple_to_cd tl vars = List.map2 (fun t id -> to_cd <:expr< $lid:id$ >> t) tl
and to_ml e t =
(* Format.fprintf Format.std_formatter "to_ml %a@."
Mltypes.print t; *)
(* Format.fprintf Format.err_formatter "to_ml %a@."
Mltypes.print t; *)
if t.recurs > 0 then <:expr< $lid:to_ml_fun t$ $e$ >>
else to_ml_descr e t.def
......@@ -478,7 +478,6 @@ let check_value ty_env c_env (s,caml_t,t) =
"The interface exports a value %s which is not available in the module@." s;
exit 1
in
(* Compute expected CDuce type *)
let et = Types.descr (typ t) in
......@@ -541,23 +540,27 @@ let stub ty_env c_env exts values mk prolog =
$list:m$
end in $items_expr$ >>, (Lexing.dummy_pos, Lexing.dummy_pos) ] in
let exe = Filename.concat (Filename.dirname Sys.argv.(0)) "cdo2ml" in
print_endline prolog;
!Pcaml.print_implem str_items
(* let exe = Filename.concat (Filename.dirname Sys.argv.(0)) "cdo2ml" in
let oc = Unix.open_process_out exe in
Marshal.to_channel oc str_items [];
flush oc;
ignore (Unix.close_process_out oc)
ignore (Unix.close_process_out oc) *)
let stub_ml name ty_env c_env exts mk =
try
let name = String.capitalize name in
let exts = match (Obj.magic exts : (string * Mltypes.t) list option) with
| None -> []
| Some exts -> List.iter (fun (_,t) -> Mltypes.reg_uid t) exts; exts in
(* First, read the description of ML types for externals.
Don't forget to call reg_uid to avoid uid clashes...
Do that before reading the cmi. *)
let (prolog, values) =
try Mltypes.read_cmi name
with Not_found -> ("",[]) in
let exts = match exts with
| None -> []
| Some exts -> Obj.magic exts in
stub ty_env c_env exts values mk prolog
with Mltypes.Error s -> raise (Location.Generic s)
......
......@@ -83,6 +83,27 @@ let new_slot () =
incr counter;
{ uid = !counter; recurs = 0; def = Abstract "DUMMY" }
let reg_uid t =
let saved = ref [] in
let rec aux t =
if t.recurs < 0 then () else begin
if t.uid > !counter then counter := t.uid;
saved := (t,t.recurs) :: !saved;
t.recurs <- (-1);
match t.def with
| Link t -> aux t
| Arrow (_,t1,t2) -> aux t1; aux t2
| Tuple tl -> List.iter aux tl
| PVariant pl -> List.iter (function (_,Some t) -> aux t | _ -> ()) pl
| Variant (_,pl,_) -> List.iter (fun (_,tl) -> List.iter aux tl) pl
| Record (_,tl,_) -> List.iter (fun (_,t) -> aux t) tl
| Builtin (_,tl) -> List.iter aux tl
| _ -> ()
end
in
aux t;
List.iter (fun (t,recurs) -> t.recurs <- recurs) !saved
let builtins =
List.fold_left (fun m x -> StringSet.add x m) StringSet.empty
[
......
......@@ -17,6 +17,8 @@ and def =
| Var of int
val reg_uid: t -> unit
(* Load an external .cmi *)
val has_cmi: string -> bool
val load_module: string -> (string * t) list
......
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