Commit 610cc98d authored by Pietro Abate's avatar Pietro Abate
Browse files

[r2004-02-19 10:11:15 by jdemouth] Fixes rec bug with recursive types + some other fixes

Original author: jdemouth
Date: 2004-02-19 10:11:15+00:00
parent a31c13a2
......@@ -195,10 +195,8 @@ and dump_code fmt name = function
let print ( label, list ) = match list with
| [] ->
Format.fprintf fmt "| %s -> @." label;
Format.fprintf fmt "CDuce_all.Value.Pair ( @.";
Format.fprintf fmt "CDuce_all.Value.Atom ( @.";
Format.fprintf fmt "CDuce_all.Atoms.V.mk_ascii \"%s\" ),@." label;
Format.fprintf fmt "CDuce_all.Value.nil )@."
Format.fprintf fmt "CDuce_all.Atoms.V.mk_ascii \"%s\" )@." label;
| list ->
Format.fprintf fmt "| %s ( " label;
print_proj 0 ( List.length list );
......@@ -315,6 +313,8 @@ and dump_code fmt name = function
Format.fprintf fmt ") ) @.";
print_list tl in
Format.fprintf fmt " let cdo2cmo__atom, cdo2cmo__desc = match %s with @." name;
Format.fprintf fmt " | CDuce_all.Value.Atom cdo2cmo__atom -> @.";
Format.fprintf fmt " cdo2cmo__atom, CDuce_all.Value.nil @.";
Format.fprintf fmt " | CDuce_all.Value.Pair ( @.";
Format.fprintf fmt " CDuce_all.Value.Atom cdo2cmo__atom, @.";
Format.fprintf fmt " cdo2cmo__desc ) -> @.";
......@@ -443,7 +443,8 @@ and ml_value_slot ctx = Cduce.CompUnit.find_value_slot ( Ctx.comp_unit ctx )
let generate_type_to_ml ctx is_rec list =
let rec internal first tail = function
| [] -> tail
| { Types.ml_id = id; Types.ml_decl = decl } :: tl ->
| { Types.ml_id = id; Types.ml_rec = r; Types.ml_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
in
......@@ -452,7 +453,8 @@ let generate_type_to_ml ctx is_rec list =
let generate_type_to_cd ctx is_rec list =
let rec internal first tail = function
| [] -> tail
| { Types.ml_id = id; Types.ml_decl = decl } :: tl ->
| { Types.ml_id = id; Types.ml_rec = r; Types.ml_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
in
......
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