From ee566aba5018c6a0f0e922c9524d6fd0f6bab051 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?C=C3=A9dric=20Pasteur?= <cedric.pasteur@ens.fr>
Date: Fri, 10 Dec 2010 09:18:24 +0100
Subject: [PATCH] Hept_parsetree_mapfold should also visit type_dec

This fixes a problem with test/good/type_alias.ept
and t8.ept.
---
 .../parsing/hept_parsetree_mapfold.ml         | 33 ++++++++++++++++++-
 1 file changed, 32 insertions(+), 1 deletion(-)

diff --git a/compiler/heptagon/parsing/hept_parsetree_mapfold.ml b/compiler/heptagon/parsing/hept_parsetree_mapfold.ml
index 1caaaa6..912fefc 100644
--- a/compiler/heptagon/parsing/hept_parsetree_mapfold.ml
+++ b/compiler/heptagon/parsing/hept_parsetree_mapfold.ml
@@ -64,6 +64,12 @@ type 'a hept_it_funs = {
   const_dec:
     'a hept_it_funs -> 'a -> Hept_parsetree.const_dec ->
         Hept_parsetree.const_dec * 'a;
+  type_dec:
+    'a hept_it_funs -> 'a -> Hept_parsetree.type_dec ->
+        Hept_parsetree.type_dec * 'a;
+  type_desc:
+    'a hept_it_funs -> 'a -> Hept_parsetree.type_desc ->
+        Hept_parsetree.type_desc * 'a;
   program:
     'a hept_it_funs -> 'a -> Hept_parsetree.program ->
         Hept_parsetree.program * 'a; }
@@ -300,11 +306,32 @@ and const_dec funs acc c =
   let c_value, acc = exp_it funs acc c.c_value in
   { c with c_value = c_value; c_type = c_type }, acc
 
+
+and type_dec_it funs acc td = funs.type_dec funs acc td
+and type_dec funs acc td =
+  let t_desc, acc = type_desc_it funs acc td.t_desc in
+  { td with t_desc = t_desc }, acc
+
+and type_desc_it funs acc td =
+  try funs.type_desc funs acc td with Fallback -> type_desc funs acc td
+and type_desc funs acc td = match td with
+  | Type_abs
+  | Type_enum _ -> td, acc
+  | Type_alias ty ->
+      let ty, acc = ty_it funs acc ty in
+        Type_alias ty, acc
+  | Type_struct c_t_list ->
+      let aux acc (f,ty) = let ty,acc = ty_it funs acc ty in
+        (f, ty), acc in
+      let c_t_list, acc = mapfold aux acc c_t_list in
+        Type_struct c_t_list, acc
+
 and program_it funs acc p = funs.program funs acc p
 and program funs acc p =
   let cd_list, acc = mapfold (const_dec_it funs) acc p.p_consts in
+  let td_list, acc = mapfold (type_dec_it funs) acc p.p_types in
   let nd_list, acc = mapfold (node_dec_it funs) acc p.p_nodes in
-  { p with p_consts = cd_list; p_nodes = nd_list }, acc
+  { p with p_consts = cd_list; p_nodes = nd_list; p_types = td_list }, acc
 
 
 let defaults = {
@@ -328,6 +355,8 @@ let defaults = {
   contract = contract;
   node_dec = node_dec;
   const_dec = const_dec;
+  type_dec = type_dec;
+  type_desc = type_desc;
   program = program }
 
 
@@ -353,5 +382,7 @@ let defaults_stop = {
   contract = stop;
   node_dec = stop;
   const_dec = stop;
+  type_dec = stop;
+  type_desc = stop;
   program = stop }