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

[r2004-06-25 14:10:58 by afrisch] Fix for records

Original author: afrisch
Date: 2004-06-25 14:10:58+00:00
parent 4379e70e
......@@ -534,7 +534,7 @@ let cduce2ocaml_desc = cduce2ocaml_fun None
let ocaml2cduce_record ( name, desc ) =
let func = Code.Ml_ident "mk_qname" in
let cod1 = Code.Ml_abstraction ( func, [ Code.Ml_ident name ] ) in
let cod1 = Code.Ml_abstraction ( func, [ Code.Ml_string name ] ) in
let cod2 = Code.Ml_ident ( "x." ^ name ) in
let cod2 = Code.Ml_abstraction ( ocaml2cduce_fun desc, [ cod2 ] ) in
Code.Ml_tuple [ cod1; cod2 ]
......@@ -600,6 +600,7 @@ let cduce2ocaml_record ( name, desc ) =
let func = Code.Ml_ident "record_field" in
let code = Code.Ml_ident ( "\"" ^ name ^ "\"" ) in
let code = Code.Ml_abstraction ( func, [ Code.Ml_ident "map"; code ] ) in
let code = Code.Ml_abstraction ( desc, [ code ] ) in
name, code
let cduce2ocaml_variant ( name, list ) = match list with
......@@ -701,7 +702,7 @@ end = struct
and generate_main cduce_cu = List.fold_left ( generate_hnode cduce_cu ) []
let generate fmt modname caml_cu cduce_cu =
Format.fprintf fmt "open Cdml@.";
Format.fprintf fmt "open Cdml@.open CDuce_all@.";
Format.fprintf fmt "exception Error of string@.";
Format.fprintf fmt "let comp_unit = Cdml.initialize \"%s\"@." modname;
let code = generate_main cduce_cu ( CompUnit.hnodes caml_cu ) in
......
......@@ -47,6 +47,7 @@ module Code = struct
| Ml_fun of ml * ml
| Ml_function of ( ml * ml ) list * bool
| Ml_ident of string
| Ml_string of string
| Ml_let_in of ml * ml * ml
| Ml_list of ml list
| Ml_match of ml * ( ml * ml ) list * bool
......@@ -203,6 +204,9 @@ let rec print_ml fmt level = function
| Code.Ml_ident name ->
print_tabs fmt level;
Format.fprintf fmt "%s" name
| Code.Ml_string name ->
print_tabs fmt level;
Format.fprintf fmt "\"%s\"" name
| Code.Ml_let_in ( c1, c2, c3 ) ->
print_tabs fmt level;
Format.fprintf fmt "let ";
......
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