Skip to content

GitLab

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

[r2004-05-09 22:03:06 by jdemouth] New version of OCaml loader. 

Original author: jdemouth
Date: 2004-05-09 22:03:07+00:00
parent 47b03747
Expand all Hide whitespace changes
Inline Side-by-side
Showing with 552 additions and 569 deletions
cdo2cmo/cdml.ml 0 → 100644
View file @ fbc9d22a
open CDuce_all
type any
let initialize modname =
let cu = Types.CompUnit.mk ( Ident.U.mk_latin1 modname ) in
Librarian.import cu;
Librarian.run cu;
cu
let ocaml2cduce_bool = function
| true -> Value.Atom ( Atoms.V.mk_ascii "true" )
| false -> Value.Atom ( Atoms.V.mk_ascii "false" )
let cduce2ocaml_bool = function
| Value.Atom a ->
let v = Ns.QName.to_string ( Atoms.V.value a ) in
compare v "true" = 0
| _ -> assert false
let ocaml2cduce_char c =
let v = Chars.V.mk_char c in Value.Char v
let cduce2ocaml_char = function
| Value.Char c -> Chars.V.to_char c
| _ -> assert false
let ocaml2cduce_int i =
let s = string_of_int i in Value.Integer ( Intervals.V.mk s )
let cduce2ocaml_int = function
| Value.Integer i -> Intervals.V.get_int i
| _ -> assert false
let ocaml2cduce_string s =
Value.string_latin1 s
let cduce2ocaml_string s =
Value.get_string_latin1 s
let ocaml2cduce_unit () =
Value.sequence []
cdo2cmo/cdml.mli 0 → 100644
View file @ fbc9d22a
(** [any] is the used to represent all CDuce possible values ( = Value.t ). *)
type any
open CDuce_all
val initialize : string -> Types.CompUnit.t
val ocaml2cduce_bool : bool -> Value.t
val cduce2ocaml_bool : Value.t -> bool
val ocaml2cduce_char : char -> Value.t
val cduce2ocaml_char : Value.t -> char
val ocaml2cduce_int : int -> Value.t
val cduce2ocaml_int : Value.t -> int
val ocaml2cduce_string : string -> Value.t
val cduce2ocaml_string : Value.t -> string
val ocaml2cduce_unit : unit -> Value.t
cdo2cmo/ml_cduce.ml
View file @ fbc9d22a
ifdef ML_INTERFACE then
open Ml_types
ifdef ML_INTERFACE then
module Translations = struct
module StringHash = Hashtbl.Make(
struct
type t = string
let equal = (=)
let hash = Hashtbl.hash
end )
type t = cduce_t StringHash.t
type t = cduce_t NodeTbl.t
(* Create an empty table. *)
let create = StringHash.create
let create = NodeTbl.create
(* Add a new translation in the table. *)
let add tbl id value = StringHash.add tbl id value
let add tbl id value = NodeTbl.add tbl id value
(* Get translation associated with [id]. *)
let find tbl id = StringHash.find tbl id
let find tbl id = NodeTbl.find tbl id
end
ifdef ML_INTERFACE then
let translations = Translations.create 17
(***********************************************************************************)
ifdef ML_INTERFACE then
let cd_type_nil =
let nil = Atoms.atom ( Atoms.V.mk_ascii "nil" ) in
Types.atom nil
let nil = Atoms.atom ( Atoms.V.mk_ascii "nil" ) in Types.atom nil
ifdef ML_INTERFACE then
let rec from_ocaml_rec left array = function
| { ml_id = id; ml_kind = ML_type; ml_decl = decl } ->
| { n_path = id; n_kind = ML_type; n_decl = decl } ->
Types.descr ( from_ocaml_type left array id decl )
| { ml_kind = ML_value; ml_decl = decl } ->
| { n_kind = ML_value; n_decl = decl } ->
from_decl left array decl
| { ml_kind = ML_module _ } -> assert false
| { n_kind = ML_module } -> assert false
and from_ocaml_type left array id decl =
and from_ocaml_type left array path decl =
try
Translations.find translations id
Translations.find translations path
with Not_found ->
let node = Types.make () in
Translations.add translations id node;
Translations.add translations path node;
let desc = from_decl left array decl in
Types.define node desc;
node
......@@ -77,9 +64,11 @@ and from_decl left array = function
in
Types.cup t desc
) Types.empty list
| ML_modsign _ -> assert false
| ML_nil -> assert false
and from_desc left array = function
| ML_any -> Types.cons Types.any
| ML_arrow ( lbl, d1, d2 ) ->
let node = Types.make () in
let l = from_desc true array d1
......@@ -95,7 +84,7 @@ and from_desc left array = function
Types.define node ( Types.char ( Chars.mk_classes [ ( 0, 255 ) ] ) );
node
| ML_ident ( id, params, ocaml ) ->
from_ocaml_type left params ocaml.ml_id ocaml.ml_decl
from_ocaml_type left params ocaml.n_path ocaml.n_decl
| ML_int ->
let node = Types.make () in
let lB = Intervals.V.mk ( string_of_int min_int )
......@@ -105,6 +94,7 @@ and from_desc left array = function
| ML_list d ->
let desc = from_desc left array d in
Sequence.star_node desc
| ML_no_manifest -> assert false
| ML_option desc ->
let node = Types.make () in
let trans = Types.descr ( from_desc left array desc ) in
......@@ -115,7 +105,7 @@ and from_desc left array = function
let get = ML_arrow ( None, ML_unit, desc )
and set = ML_arrow ( None, desc, ML_unit ) in
let ref = ML_record [ "get", get ; "set", set ] in
Types.define node ( from_decl left array ref );
Types.define node ( from_decl false array ref );
node
| ML_string ->
let node = Types.make () in
......@@ -128,8 +118,7 @@ and from_desc left array = function
let node = Types.make () in
Types.define node Sequence.nil_type;
node
| ML_var id ->
from_desc left array array.( id )
| ML_var id -> from_desc left array array.( id )
and tuple_of_list left array list =
let rec internal tail = function
......@@ -165,10 +154,9 @@ and variant_of_list left array list =
(***********************************************************************************)
ifdef ML_INTERFACE then
module Type : sig
type t = cduce_t
val from_ocaml : ocaml_t -> t
val from_ocaml : ocaml_node -> t
val print : Format.formatter -> t -> unit
val is_subtype : t -> t -> bool
end = struct
......@@ -180,7 +168,6 @@ end
(***********************************************************************************)
ifdef ML_INTERFACE then
module CompUnit : sig
type t
val from_types_cu : string -> Types.CompUnit.t -> t
......@@ -219,7 +206,8 @@ end = struct
let env = !Compile.from_comp_unit cu in
let id = Ident.ident ( Ident.U.mk_latin1 name ) in
let f_slot = Compile.find id env in
match f_slot with Lambda.Global i -> i
match f_slot with
| Lambda.Ext ( _, i ) -> i
| _ -> assert false
let module_name cu = cu.cu_mod
......
cdo2cmo/ml_checker.ml
View file @ fbc9d22a
ifdef ML_INTERFACE then
type error =
| Undefined_value of string * string
| Type_mismatch of string * Ml_ocaml.Type.t * Ml_cduce.Type.t * Ml_cduce.Type.t
ifdef ML_INTERFACE then
exception Error of error
ifdef ML_INTERFACE then
let error e = raise ( Error e )
ifdef ML_INTERFACE then
let report_error = function
| Undefined_value ( file, func ) ->
Format.eprintf "cduce2ocaml : error in file %s.cmi:@." file;
......@@ -20,24 +16,23 @@ let report_error = function
Format.eprintf "\nis not a subtype of@.";
Ml_cduce.Type.print Format.err_formatter ml_cd_t;
Format.eprintf "\nwhich is the canonical translation of@.";
Ml_ocaml.Type.print Format.err_formatter ( true, [ ml_t ] )
Ml_ocaml.Type.print Format.err_formatter ml_t
(***********************************************************************************)
ifdef ML_INTERFACE then
let run ml_cu cd_cu =
let file = Ml_cduce.CompUnit.module_name cd_cu in
String.set file 0 ( Char.lowercase ( String.get file 0 ) );
try Ml_ocaml.CompUnit.iter (
fun ( _, list ) -> match list with
| [ { Ml_types.ml_kind = Ml_types.ML_value } as ml_t ] -> (
fun hnode -> match hnode.Ml_types.h_nodes with
| [ { Ml_types.n_kind = Ml_types.ML_value } as ml_t ] -> (
try
let cd_type = Ml_cduce.Type.from_ocaml ml_t
and cd_base = Ml_cduce.CompUnit.find_value cd_cu ml_t.Ml_types.ml_name in
and cd_base = Ml_cduce.CompUnit.find_value cd_cu ( Ml_ocaml.ptos false ml_t.Ml_types.n_name ) in
if not ( Ml_cduce.Type.is_subtype cd_base cd_type )
then error ( Type_mismatch ( file, ml_t, cd_type, cd_base ) );
then error ( Type_mismatch ( file, hnode, cd_type, cd_base ) );
with Not_found ->
error ( Undefined_value ( file, ml_t.Ml_types.ml_name ) ) )
error ( Undefined_value ( file, ( Ml_ocaml.ptos false ml_t.Ml_types.n_name ) ) ) )
| _ -> ()
) ml_cu
with Error e -> report_error e; exit 1
cdo2cmo/ml_generator.ml
View file @ fbc9d22a
ifdef ML_INTERFACE then
open Ml_types
(***********************************************************************************)
ifdef ML_INTERFACE then
(* Context used to decide how to print a type. *)
module Ctx = struct
type t = {
......@@ -37,7 +35,6 @@ end
* match cdo2cmo_r with (* translate to int, see CD_to_int *) *
* ******************************************************************************* *)
ifdef ML_INTERFACE then
type code_t =
| To_CDuce_bool
| To_CDuce_char
......@@ -46,9 +43,10 @@ type code_t =
| To_CDuce_list of code_t
| To_CDuce_option of code_t
| To_CDuce_record of ( string * code_t ) list
| To_CDuce_reference of code_t * code_t
| To_CDuce_string
| To_CDuce_tuple of code_t list
| To_CDuce_type of string
| To_CDuce_type of ML.Path.t
| To_CDuce_unit
| To_CDuce_variant of ( string * code_t list ) list
| To_OCaml_bool
......@@ -60,11 +58,10 @@ type code_t =
| To_OCaml_record of ( string * code_t ) list
| To_OCaml_string
| To_OCaml_tuple of code_t list
| To_OCaml_type of string
| To_OCaml_type of ML.Path.t
| To_OCaml_unit
| To_OCaml_variant of ( string * code_t list ) list
ifdef ML_INTERFACE then
type value_t =
| Type_to_cd of string * bool * bool * code_t
| Type_to_ml of string * bool * bool * code_t
......@@ -72,7 +69,6 @@ type value_t =
(***********************************************************************************)
ifdef ML_INTERFACE then
let rec dump fmt = function
| Type_to_cd ( name, first, is_rec, code ) ->
let () = match first, is_rec with
......@@ -95,14 +91,14 @@ let rec dump fmt = function
| Value ( name, slot, code ) ->
Format.fprintf fmt "let %s = @." name;
Format.fprintf fmt "let cdo2cmo__val = @.";
Format.fprintf fmt "!CDuce_all.Eval.from_comp_unit cdo2cmo__cu %d in@." slot;
Format.fprintf fmt "!CDuce_all.Eval.get_global cdo2cmo__cu %d in@." slot;
dump_code fmt "cdo2cmo__val" code
and dump_code fmt name = function
| To_CDuce_bool ->
Format.fprintf fmt "CDuce_all.Value.vbool %s@." name
Format.fprintf fmt "Cdml.ocaml2cduce_bool %s@." name
| To_CDuce_char ->
assert false (* TODO *)
Format.fprintf fmt "Cdml.ocaml2cduce_char %s@." name
| To_CDuce_fun ( func, arg, code1, code2 ) ->
Format.fprintf fmt "let %s = fun %s -> @." func arg;
Format.fprintf fmt "let cdo2cmo__p = @.";
......@@ -113,10 +109,7 @@ and dump_code fmt name = function
Format.fprintf fmt "in@.";
Format.fprintf fmt "CDuce_all.Value.Abstraction( [], %s )@." func
| To_CDuce_int ->
Format.fprintf fmt "CDuce_all.Value.const (@.";
Format.fprintf fmt "CDuce_all.Types.Integer (@.";
Format.fprintf fmt "CDuce_all.Intervals.V.mk (@.";
Format.fprintf fmt "string_of_int %s ))) @." name
Format.fprintf fmt "Cdml.ocaml2cduce_int %s @." name
| To_CDuce_list code ->
Format.fprintf fmt "CDuce_all.Value.sequence (@.";
Format.fprintf fmt "List.map (fun cdo2cmo__e -> @.";
......@@ -143,10 +136,22 @@ and dump_code fmt name = function
print_list tl in
print_list list;
Format.fprintf fmt " ]@."
| To_CDuce_reference ( code1, code2 ) ->
Format.fprintf fmt "CDuce_all.Value.vrecord [@.";
Format.fprintf fmt "((CDuce_all.Ns.mk_ascii \"\", ";
Format.fprintf fmt "CDuce_all.Encodings.Utf8.mk \"set\"),";
Format.fprintf fmt "CDuce_all.Value.Abstraction ( [], fun cdo2cmo__v -> %s := @." name;
dump_code fmt "cdo2cmo__v" code1;
Format.fprintf fmt "; Cdml.ocaml2cduce_unit () )); @.";
Format.fprintf fmt "((CDuce_all.Ns.mk_ascii \"\",";
Format.fprintf fmt "CDuce_all.Encodings.Utf8.mk \"get\"),";
Format.fprintf fmt "CDuce_all.Value.Abstraction ( [], fun _ -> @.";
dump_code fmt ( "!" ^ name ) code2;
Format.fprintf fmt "))]@."
| To_CDuce_string ->
Format.fprintf fmt "CDuce_all.Value.string_latin1 %s@." name
Format.fprintf fmt "Cdml.ocaml2cduce_string %s@." name
| To_CDuce_unit ->
Format.fprintf fmt "CDuce_all.Value.sequence [] @."
Format.fprintf fmt "Cdml.ocaml2cduce_unit ()@."
| To_CDuce_tuple list ->
let rec print_proj n = function
| [] -> assert false
......@@ -172,8 +177,8 @@ and dump_code fmt name = function
print_proj 0 list;
Format.fprintf fmt ") = %s in@." name;
print_list 0 list
| To_CDuce_type id ->
Format.fprintf fmt "ocaml2cduce__%s %s@." id name
| To_CDuce_type path ->
Format.fprintf fmt "ocaml2cduce__%s %s@." ( ML.Path.name path ) name
| To_CDuce_variant list ->
let rec print_proj n m =
if n < m then begin
......@@ -214,7 +219,7 @@ and dump_code fmt name = function
Format.fprintf fmt "match %s with @." name;
List.iter print list
| To_OCaml_bool ->
Format.fprintf fmt " CDuce_all.Value.equal %s CDuce_all.Value.vtrue@." name
Format.fprintf fmt "Cdml.cduce2ocaml_bool %s@." name
| To_OCaml_char ->
assert false (* TODO *)
| To_OCaml_fun ( lbl, code1, code2 ) ->
......@@ -235,10 +240,7 @@ and dump_code fmt name = function
Format.fprintf fmt " | _ -> assert false ) in@.";
dump_code fmt "cdo2cmo__val" code2
| To_OCaml_int ->
Format.fprintf fmt " match CDuce_all.Value.inv_const %s with@." name;
Format.fprintf fmt " | CDuce_all.Types.Integer i -> @.";
Format.fprintf fmt " CDuce_all.Intervals.V.get_int i@.";
Format.fprintf fmt " | _ -> assert false@."
Format.fprintf fmt "Cdml.cduce2ocaml_int %s @." name
| To_OCaml_list code ->
Format.fprintf fmt " let rec cdo2cmo__seq list = function @.";
Format.fprintf fmt " | CDuce_all.Value.Atom _ -> list@.";
......@@ -286,7 +288,7 @@ and dump_code fmt name = function
Format.fprintf fmt " }@.";
Format.fprintf fmt "| _ -> assert false@."
| To_OCaml_string ->
Format.fprintf fmt " CDuce_all.Value.get_string_latin1 %s@." name
Format.fprintf fmt " Cdml.cduce2ocaml_string %s@." name
| To_OCaml_tuple list ->
let rec proj n = function
| [ _ ; _ ] ->
......@@ -317,9 +319,9 @@ and dump_code fmt name = function
Format.fprintf fmt ")@.";
Format.fprintf fmt " | _ -> assert false@."
| To_OCaml_type id ->
Format.fprintf fmt "cduce2ocaml__%s %s@." id name
Format.fprintf fmt "cduce2ocaml__%s %s@." ( Ml_ocaml.ptos false id ) name
| To_OCaml_unit ->
Format.fprintf fmt " ()@."
Format.fprintf fmt "()@."
| To_OCaml_variant list ->
let rec print_proj n m =
if n < m then begin
......@@ -360,11 +362,9 @@ and dump_code fmt name = function
Format.fprintf fmt " with @.";
print_list list
ifdef ML_INTERFACE then
let dump_list fmt list =
List.iter ( fun value -> dump fmt value ) list
ifdef ML_INTERFACE then
let rec generate_ml ctx name desc =
let slot = ml_value_slot ctx name in
let code = generate_to_ml ctx "cdo2cmo__val" desc in
......@@ -392,6 +392,7 @@ and generate_to_ml ctx name = function
field, list
) list in
To_OCaml_variant list
| ML_modsign _ -> assert false
| ML_nil -> assert false
and generate_desc_to_ml ctx name desc =
......@@ -403,15 +404,17 @@ and generate_desc_to_ml_rec ctx (* name *) = function
| ML_int -> To_OCaml_int
| ML_string -> To_OCaml_string
| ML_unit -> To_OCaml_unit
| ML_any -> assert false
| ML_arrow ( lbl, d1, d2 ) ->
let ctx, lbl = generate_ml_arg ctx lbl in
let code1 = generate_desc_to_cd ctx lbl d1 in
let code2 = generate_desc_to_ml ctx lbl d2 in
To_OCaml_fun ( lbl, code1, code2 )
| ML_ident ( _, _, { Ml_types.ml_id = id } ) ->
To_OCaml_type id
| ML_ident ( _, _, { Ml_types.n_path = path } ) ->
To_OCaml_type path
| ML_list d ->
To_OCaml_list ( generate_desc_to_ml_rec ctx d )
| ML_no_manifest -> assert false
| ML_option d ->
To_OCaml_option ( generate_desc_to_ml_rec ctx d )
| ML_reference _ -> assert false
......@@ -442,6 +445,7 @@ and generate_to_cd ctx name = function
field, list
) list in
To_CDuce_variant list
| ML_modsign _ -> assert false
| ML_nil -> assert false
and generate_desc_to_cd ctx name desc =
......@@ -453,19 +457,23 @@ and generate_desc_to_cd_rec ctx name = function
| ML_int -> To_CDuce_int
| ML_string -> To_CDuce_string
| ML_unit -> To_CDuce_unit
| ML_any -> assert false
| ML_arrow ( lbl, d1, d2 ) ->
let ctx, lbl = Ctx.generate_name ctx in
let code1 = generate_desc_to_ml ctx lbl d1 in
let code2 = generate_desc_to_cd ctx name d2 in
To_CDuce_fun ( name, lbl, code1, code2 )
| ML_ident ( _, _, { Ml_types.ml_id = id } ) ->
To_CDuce_type id
| ML_ident ( _, _, { Ml_types.n_path = path } ) ->
To_CDuce_type path
| ML_list d ->
To_CDuce_list ( generate_desc_to_cd_rec ctx name d )
| ML_no_manifest -> assert false
| ML_option d ->
To_CDuce_option ( generate_desc_to_cd_rec ctx name d )
| ML_reference d -> assert false
(* To_CDuce_reference ( generate_desc_to_cd_rec ctx name d ) *)
| ML_reference d ->
let code1 = generate_desc_to_ml_rec ctx (*name*) d
and code2 = generate_desc_to_cd_rec ctx name d in
To_CDuce_reference ( code1, code2 )
| ML_tuple list ->
let list = List.map ( generate_desc_to_cd_rec ctx name ) list in
To_CDuce_tuple list
......@@ -477,69 +485,60 @@ and generate_ml_arg ctx = function
and ml_value_slot ctx = Ml_cduce.CompUnit.find_value_slot ( Ctx.comp_unit ctx )
ifdef ML_INTERFACE then
let generate_type_to_ml ctx is_rec list =
let rec internal first tail = function
| [] -> tail
| { Ml_types.ml_id = id; Ml_types.ml_rec = r; Ml_types.ml_decl = decl } :: tl ->
let is_rec = is_rec || r in
| { Ml_types.n_path = id; (*Ml_types.rec = r;*) Ml_types.n_decl = decl } :: tl ->
let is_rec = is_rec (*|| r*) in
let code = generate_to_ml ctx "cdo2cmo__val" decl in
internal false ( tail @ [ Type_to_ml ( id, first, is_rec, code ) ] ) tl
internal false ( tail @ [ Type_to_ml ( ( Ml_ocaml.ptos false id ),
first, is_rec, code ) ] ) tl
in
internal true [] list
ifdef ML_INTERFACE then
let generate_type_to_cd ctx is_rec list =
let rec internal first tail = function
| [] -> tail
| { Ml_types.ml_id = id; Ml_types.ml_rec = r; Ml_types.ml_decl = decl } :: tl ->
let is_rec = r || is_rec in
| { Ml_types.n_path = id; (*Ml_types.rec = r;*) Ml_types.n_decl = decl } :: tl ->
let is_rec = (*r ||*) is_rec in
let code = generate_to_cd ctx "cdo2cmo__val" decl in
internal false ( tail @ [ Type_to_cd ( id, first, is_rec, code ) ] ) tl
internal false ( tail @ [ Type_to_cd ( ( Ml_ocaml.ptos false id ),
first, is_rec, code ) ] ) tl
in
internal true [] list
(***********************************************************************************)
ifdef ML_INTERFACE then
let ml_print fmt cu t =
let name = t.ml_name
and decl = t.ml_decl
and kind = t.ml_kind in
let name = Ml_ocaml.ptos false t.n_name
and decl = t.n_decl
and kind = t.n_kind in
let code = generate_ml ( Ctx.create cu ) name decl in dump fmt code
(***********************************************************************************)
ifdef ML_INTERFACE then
module ML : sig
val generate : Format.formatter -> Ml_ocaml.CompUnit.t -> Ml_cduce.CompUnit.t -> unit
end = struct
let generate fmt ml_cu cd_cu =
let mod_name = Ml_cduce.CompUnit.module_name cd_cu in
Format.fprintf fmt "exception Error of string@.";
Format.fprintf fmt "let cdo2cmo__cu = @.";
Format.fprintf fmt " let cdo2cmo__cu = @.";
Format.fprintf fmt " CDuce_all.Types.CompUnit.mk (@.";
Format.fprintf fmt " CDuce_all.Ident.U.mk_latin1 \"%s\") in@." mod_name;
Format.fprintf fmt " CDuce_all.Librarian.import cdo2cmo__cu;@.";
Format.fprintf fmt " CDuce_all.Librarian.run (CDuce_all.Value.sequence []) ";
Format.fprintf fmt "cdo2cmo__cu;@.";
Format.fprintf fmt "cdo2cmo__cu@.";
Format.fprintf fmt "let cdo2cmo__cu = Cdml.initialize \"%s\"@." mod_name;
Ml_ocaml.CompUnit.iter (
fun ( need, list ) -> match list with
| [ { Ml_types.ml_kind = Ml_types.ML_type } as ml_type ] ->
Ml_ocaml.Type.print fmt ( need, [ ml_type ] );
fun hnode -> match hnode.Ml_types.h_nodes with
| [ { Ml_types.n_kind = Ml_types.ML_type } as ml_type ] ->
Ml_ocaml.Type.print fmt hnode;
let code = generate_type_to_ml ( Ctx.create cd_cu ) false [ ml_type ] in
dump_list fmt code;
let code = generate_type_to_cd ( Ctx.create cd_cu ) false [ ml_type ] in
dump_list fmt code
| ( { Ml_types.ml_kind = Ml_types.ML_type } :: tl ) ->
Ml_ocaml.Type.print fmt ( need, list );
let code = generate_type_to_ml ( Ctx.create cd_cu ) true list in
| ( { Ml_types.n_kind = Ml_types.ML_type } :: tl ) ->
Ml_ocaml.Type.print fmt hnode;
let code = generate_type_to_ml ( Ctx.create cd_cu ) true hnode.Ml_types.h_nodes in
dump_list fmt code;
let code = generate_type_to_cd ( Ctx.create cd_cu ) true list in
let code = generate_type_to_cd ( Ctx.create cd_cu ) true hnode.Ml_types.h_nodes in
dump_list fmt code
| [ { Ml_types.ml_kind = Ml_types.ML_value } as ml_type ] ->
| [ { Ml_types.n_kind = Ml_types.ML_value } as ml_type ] ->
ml_print fmt cd_cu ml_type
| _ -> ()
) ml_cu
......
cdo2cmo/ml_ocaml.ml
View file @ fbc9d22a
This diff is collapsed.
cdo2cmo/ml_types.ml
View file @ fbc9d22a
ifdef ML_INTERFACE then
type ocaml_t =
{ ml_id: string;
ml_name: string;
ml_kind: ocaml_kind;
mutable ml_rec: bool;
mutable ml_decl: ocaml_decl }
module ML = OCaml_all
type ocaml_node =
{ n_kind: ocaml_kind;
mutable n_path: ML.Path.t;
mutable n_name: ML.Path.t;
mutable n_decl: ocaml_decl }
and ocaml_kind =
| ML_module
| ML_type
| ML_value
| ML_module of ocaml_t list
and ocaml_decl =
| ML_modsign of ocaml_hypernode list
| ML_nil
| ML_abstract of ocaml_desc
| ML_record of ( string * ocaml_desc ) list
| ML_variant of ( string * ocaml_desc list ) list