Commit fca58d8c authored by Pietro Abate's avatar Pietro Abate

[r2007-08-19 12:30:33 by afrisch] Allow reference to named OCaml types.

Original author: afrisch
Date: 2007-08-19 12:31:21+00:00
parent 339a5a79
Since 0.5.6
* Allow reference to named OCaml types (by Pietro Abate)
0.5.0
* Port to OCaml 3.10, with the help of Nicolas Pouillard
......
......@@ -684,6 +684,8 @@ let to_cd_dyn = function
let register () =
Typer.has_ocaml_unit :=
(fun cu -> Mltypes.has_cmi (U.get_str cu));
Typer.cduce_conv :=
(fun v -> typ_descr (Mltypes.find_type v).def);
Librarian.stub_ml := stub_ml;
Externals.register := register;
Externals.ext_info := (fun () -> Obj.magic !exts);
......
......@@ -223,6 +223,14 @@ let unfold ty =
vars := [];
(t,n)
let unfold_type p =
vars := [];
Hashtbl.clear constr_table;
let t = unfold_constr { seen = IntSet.empty; constrs = StringSet.empty;
vars = IntMap.empty } p [] in
assert (!vars = []);
t
(* Reading .cmi *)
let unsupported s =
......@@ -233,6 +241,7 @@ let has_cmi name =
try ignore (Misc.find_in_path_uncap !Config.load_path (name ^ ".cmi")); true
with Not_found -> false
(* find the cduce type associated to an ocaml value *)
let find_value v =
Config.load_path := Config.standard_library :: !Loc.obj_path;
let li = Longident.parse v in
......@@ -240,6 +249,14 @@ let find_value v =
let (_,vd) = Env.lookup_value li Env.initial in
unfold vd.val_type
(* find the cduce type associated to an ocaml type *)
let find_type t =
Config.load_path := Config.standard_library :: !Loc.obj_path;
let li = Longident.parse t in
ocaml_env := Env.initial;
let (p,_) = Env.lookup_type li Env.initial in
unfold_type p
let values_of_sig name sg =
List.fold_left
(fun accu v -> match v with
......
......@@ -31,4 +31,4 @@ val print_ocaml : Format.formatter -> Types.type_expr -> unit
val find_value: string -> t * int
val find_type : string -> t
......@@ -131,7 +131,12 @@ let find_id env0 env loc head x =
with Not_found when head ->
try ECDuce (!load_comp_unit x)
with Not_found ->
error loc "Cannot resolve this identifier"
if ((match (U.get_str x).[0] with 'A'..'Z' -> true | _ -> false)
&& !has_ocaml_unit x)
then EOCaml (U.get_str x)
else
error loc ("Cannot resolve this identifier " ^
(Ns.QName.to_string id))
let find_id_comp env0 env loc x =
if ((match (U.get_str x).[0] with 'A'..'Z' -> true | _ -> false)
......@@ -241,11 +246,16 @@ let type_ns env loc p ns =
ns = Ns.add_prefix p ns env.ns;
ids = Env.add (Ns.empty,p) (ENamespace ns) env.ids }
let cduce_conv = ref (fun _ -> failwith "cduce conv not initialized")
let find_global_type env loc ids =
match find_global env loc ids with
| Type t | ESchemaComponent (t,_) -> t
| EOCamlComponent s ->
let t = !cduce_conv s in
let v = ident env loc (U.mk s) in
Types.Print.register_global "" v t ;
t
| _ -> error loc "This path does not refer to a type"
let find_global_schema_component env loc ids =
......
......@@ -69,3 +69,4 @@ val has_static_external: (string -> bool) ref
val load_schema:
(string -> string -> Ns.Uri.t * (Types.t * Schema_validator.t) Ident.Env.t) ref
val cduce_conv : (string -> Types.t) ref
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