Add support to be able to iterate on predef op. iter<<iter>> does not

work yet though (returns the wrong type).

Also add the struct printer, and fix a bug in the static argument printing.

src/compiledData.ml

-(** Time-stamp: <modified the 26/05/2008 (at 09:37) by Erwan Jahier> *)
+(** Time-stamp: <modified the 27/05/2008 (at 13:25) by Erwan Jahier> *)
 
 (** 
 
@@ -131,6 +131,21 @@ and var_type =
   | Any 
   | Overload (* [Overload] is like [Any], except that it can only be [int] or [real] *)
       
+(* [type_eff] extended with  polymorphic or overloaded variables *)
+and type_eff_ext =
+  | Bool_type_eff_ext
+  | Int_type_eff_ext
+  | Real_type_eff_ext
+  | External_type_eff_ext of Ident.long
+  | Enum_type_eff_ext     of Ident.long * (Ident.long list)
+  | Array_type_eff_ext    of type_eff_ext * int
+  | Struct_type_eff_ext   of 
+      Ident.long * (Ident.t * (type_eff_ext * const_eff option)) list
+  | Any
+  | Overload 
+      (* [Overload] is like [Any], except that it can only be [int] or [real] *)
+
+
 and slice_info_eff = {
 (** Dénotation de tranche de tableau correcte :
     si A est le tableau d'entrée, alors S est le tableau
@@ -260,8 +275,8 @@ and clock_eff = (* XXX generalize me!*)
 *)
 and node_exp_eff = {
   node_key_eff : node_key ;
-  inlist_eff   : (Ident.t * var_type) list ;
-  outlist_eff  : (Ident.t * var_type) list ;
+  inlist_eff   : (Ident.t * type_eff_ext) list ;
+  outlist_eff  : (Ident.t * type_eff_ext) list ;
   loclist_eff  : (Ident.t * type_eff) list option; (* None => extern or abstract *)
   clock_inlist_eff  : int option list ;
   clock_outlist_eff : int option list ;
@@ -305,9 +320,41 @@ type 'a check_flag =
   | Checked of 'a
   | Incorrect
 
+let type_eff_to_type_eff_ext = function
+  | Bool_type_eff -> Bool_type_eff_ext
+  | Int_type_eff -> Int_type_eff_ext
+  | Real_type_eff -> Real_type_eff_ext
+  | External_type_eff l -> External_type_eff_ext l
+  | Enum_type_eff(l,el) ->  Enum_type_eff_ext(l,el)
+  | Array_type_eff(teff_ext,i) -> 
+      Array_type_eff_ext(type_eff_to_type_eff_ext teff_ext,i)
+  | Struct_type_eff(l, fl) -> 
+      Struct_type_eff_ext(
+	l, 
+	List.map 
+	  (fun (id,(teff,copt)) -> (id,(type_eff_to_type_eff_ext teff,copt)))
+	  fl)
+
+let rec type_eff_ext_to_type_eff = function
+  | Bool_type_eff_ext -> Bool_type_eff
+  | Int_type_eff_ext -> Int_type_eff
+  | Real_type_eff_ext -> Real_type_eff
+  | External_type_eff_ext l -> External_type_eff l
+  | Enum_type_eff_ext(l,el) ->  Enum_type_eff(l,el)
+  | Array_type_eff_ext(teff_ext,i) -> 
+      Array_type_eff(type_eff_ext_to_type_eff teff_ext,i)
+  | Struct_type_eff_ext(l, fl) -> 
+      Struct_type_eff(
+	l, 
+	List.map 
+	  (fun (id,(teff,copt)) -> (id,(type_eff_ext_to_type_eff teff,copt)))
+	  fl)
+  | Any ->  assert false
+  | Overload -> assert false
+
 
 let (profile_of_node_exp_eff : 
-       node_exp_eff -> var_type list * var_type list) =
+       node_exp_eff -> type_eff_ext list * type_eff_ext list) =
   fun ne -> 
     (snd (List.split ne.inlist_eff), snd (List.split ne.outlist_eff))
     
@@ -402,17 +449,16 @@ let (make_local_env : node_key -> local_env) =
     if t1 = t2 or t1 is abstract and not t2.
 *)
 let (type_eff_are_compatible : type_eff -> type_eff -> bool) =
-  fun te1 te2 -> match te1, te2 with 
+  fun te1 te2 -> match te1, te2 with
     | External_type_eff id1, External_type_eff id2 -> id1 = id2
     | External_type_eff _, _ -> true
     | t1, t2 -> t1 = t2
 
-let (var_type_are_compatible : var_type -> var_type -> bool) =
-  fun te1 te2 -> match te1, te2 with 
-    | Atype teff1, Atype teff2 -> type_eff_are_compatible teff2 teff2
-    | _ , _  -> assert false (* should not occur (would be easy to define though) *)
-(*     | Any, Any -> true *)
-(*     | Overload, Overload -> true *)
+let (type_eff_ext_are_compatible : type_eff_ext -> type_eff_ext -> bool) =
+  fun te1 te2 -> match te1, te2 with
+    | External_type_eff_ext id1, External_type_eff_ext id2 -> id1 = id2
+    | External_type_eff_ext _, _ -> true
+    | t1, t2 -> t1 = t2
   
 (****************************************************************************)
 (* Utilitaires liés aux node_key *)

src/test/should_work/lionel/matrice.lus

@@ -12,7 +12,7 @@ tel
 node matrice ( a : int ) returns ( sum: int; bid: T_fibo; T: int^m^n); 
 let 
 	bid, T = fill << fill << fibo ; m >> ; n >> ([a, a]);	
-	sum = red << red <<node plus ; m >> ; n >> (0, T ); 
+	sum = red << red <<node plus ; m >> ; n >> (0, T); 
 tel