From 3690585710431277e4e042eafddf80a9dcd0e641 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?C=C3=A9dric=20Pasteur?= <cedric.pasteur@m4x.org>
Date: Tue, 6 Jul 2010 09:15:20 +0200
Subject: [PATCH] Added static records in static_exp

---
 compiler/global/static.ml                 |  7 +++++++
 compiler/global/types.ml                  |  1 +
 compiler/heptagon/parsing/hept_scoping.ml | 14 ++++++++------
 3 files changed, 16 insertions(+), 6 deletions(-)

diff --git a/compiler/global/static.ml b/compiler/global/static.ml
index d038b14..534b999 100644
--- a/compiler/global/static.ml
+++ b/compiler/global/static.ml
@@ -65,6 +65,8 @@ let rec simplify env se =
     | Sarray se_list -> Sarray (List.map (simplify env) se_list)
     | Sarray_power (se, n) -> Sarray_power (simplify env se, simplify env n)
     | Stuple se_list -> Stuple (List.map (simplify env) se_list)
+    | Srecord f_se_list ->
+        Srecord (List.map (fun (f,se) -> f, simplify env se) f_se_list)
 
 (** [int_of_static_exp env e] returns the value of the expression
     [e] in the environment [env], mapping vars to integers. Raises
@@ -120,6 +122,8 @@ let rec static_exp_subst m = function
                                           static_exp_subst m n)
   | Sarray se_list -> Sarray (List.map (static_exp_subst env) se_list)
   | Stuple se_list -> Stuple (List.map (static_exp_subst env) se_list)
+  | Srecord f_se_list ->
+      Srecord (List.map (fun (f,se) -> f, static_exp_subst env se) f_se_list)
   | s -> s
 
 (** Substitutes variables in the constraint list with their value
@@ -145,6 +149,9 @@ let rec print_static_exp ff = function
   | Sarray se_list ->
       fprintf ff "@[<2>%a@]" (print_list_r print_static_exp "["";""]") se_list
   | Stuple se_list -> print_static_exp_tuple se_list
+  | Srecord f_se_list ->
+      print_record (print_couple print_longname
+                      print_static_exp """ = """) ff f_se_list
 
 and print_static_exp_tuple ff l =
   fprintf ff "@[<2>%a@]" (print_list_r print_static_exp "("","")") l
diff --git a/compiler/global/types.ml b/compiler/global/types.ml
index 736e0c3..9f1237f 100644
--- a/compiler/global/types.ml
+++ b/compiler/global/types.ml
@@ -23,6 +23,7 @@ and static_exp_desc =
   | Stuple of static_exp list
   | Sarray_power of static_exp * static_exp (** power : 0^n : [0,0,0,0,0,..] *)
   | Sarray of static_exp list (** [ e1, e2, e3 ] *)
+  | Srecord of (longname * static_exp) list (** { f1 = e1; f2 = e2; ... } *)
   | Sop of longname * static_exp list (** defined ops for now in pervasives *)
 
 let invalid_type = Tprod []
diff --git a/compiler/heptagon/parsing/hept_scoping.ml b/compiler/heptagon/parsing/hept_scoping.ml
index f47dfe8..58f93cb 100644
--- a/compiler/heptagon/parsing/hept_scoping.ml
+++ b/compiler/heptagon/parsing/hept_scoping.ml
@@ -110,21 +110,23 @@ let op_from_app loc app =
 
 let rec static_exp_of_exp const_env e = match e.e_desc with
   | Evar n ->
-      if not (NamesEnv.mem n const_env) then
-        Error.message e.e_loc (Error.Econst_var n)
-      else
+      if NamesEnv.mem n const_env then
         Svar n
+      else
+        raise Not_static
   | Econst se -> se
   | Eapp({ a_op = Earray_fill }, [e;n]) ->
       Sarray_power (static_exp_of_exp const_env e,
                     static_exp_of_exp const_env n)
-  | Eapp({ a_op = Earray }, [e;n]) ->
+  | Eapp({ a_op = Earray }, e_list) ->
       Sarray (List.map (static_exp_of_exp const_env) e_list)
-  | Eapp({ a_op = Etuple }, [e;n]) ->
+  | Eapp({ a_op = Etuple }, e_list) ->
       Stuple (List.map (static_exp_of_exp const_env) e_list)
   | Eapp(app, e_list) ->
       let op = op_from_app e.e_loc app in
-      Sop(op, List.map (static_exp_of_exp const_env) e_list)
+        Sop(op, List.map (static_exp_of_exp const_env) e_list)
+  | Estruct e_list ->
+      Srecord (List.map (fun (f,e) -> f, static_exp_of_exp const_env e) e_list)
   | _ -> raise Not_static
 
 let expect_static_exp const_env e =