[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

cdo2cmo/src/generator.ml

@@ -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