Port Static to recent api changes

compiler/global/signature.ml

@@ -18,6 +18,7 @@ let interface_format_version = "8"
 (** Node argument *)
 type arg = { a_name : name option; a_type : ty }
 
+(** Node static parameters *)
 type param = { p_name : name; p_type : ty }
 
 (** Node signature *)
@@ -45,8 +46,8 @@ let mk_param name ty = { p_name = name; p_type = ty }
 let mk_field n ty = { f_name = n; f_type = ty }
 
 
-let print_param ff p = Names.print_name ff p.p_name
-
+let print_param ff p =
+  fprintf ff "%a:%a"  Names.print_name p.p_name  print_type p.p_type
 
 let rec field_assoc f = function
   | [] -> raise Not_found

compiler/global/static.ml

@@ -55,24 +55,32 @@ let apply_int_op op n1 n2 =
 let rec simplify env se =
   match se with
     | Sint _ | Sfloat _ | Sbool _ | Sconstructor -> se
-    | Svar id -> (try simplify env (NamesEnv.find id env) with | _ -> Svar id)
+    | Svar id -> (try simplify env (NamesEnv.find id env) with | _ -> se)
     | Sop (op, [e1; e2]) ->
-        (match simplify env e1, simplify env e2 with
-           | Sint n1, Sint n2 -> apply_int_op op n1 n2
-           | e1, e2 -> Sop (op, [e1; e2])
+        let e1 = simplify env e1 in
+        let e2 = simplify env e2 in
+        (match e1.e_desc, e2.e_desc with
+           | Sint n1, Sint n2 -> { se with se_desc = apply_int_op op n1 n2 }
+           | _, _ -> { se with se_desc = Sop (op, [e1; e2]) }
         )
-    | Sop (op, se_list) -> Sop (op, List.map (simplify env) se_list)
-    | 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)
+    | Sop (op, se_list) ->
+        { se with se_desc = Sop (op, List.map (simplify env) se_list) }
+    | Sarray se_list ->
+        { se with se_desc = Sarray (List.map (simplify env) se_list) }
+    | Sarray_power (se, n) ->
+         { se with se_desc = Sarray_power (simplify env se, simplify env n) }
+    | Stuple se_list ->
+         { se with se_desc = Stuple (List.map (simplify env) se_list) }
     | Srecord f_se_list ->
-        Srecord (List.map (fun (f,se) -> f, simplify env se) f_se_list)
+        { se with se_desc = 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
     Instanciation_failed if it cannot be computed (if a var has no value).*)
 let int_of_static_exp env e =
-  match simplify env e with | Sint n -> n | _ -> raise Instanciation_failed
+  let e =  simplify env e in
+  match e.e_desc with | Sint n -> n | _ -> raise Instanciation_failed
 
 (** [is_true env constr] returns whether the constraint is satisfied
     in the environment (or None if this can be decided)
@@ -85,15 +93,15 @@ let is_true env =
         let e1 = simplify env e1 in
         let e2 = simplify env e2
         in
-        (match e1, e2 with
-           | SConst n1, SConst n2 -> Some (n1 = n2), Cequal (e1, e2)
+        (match e1.e_desc, e2.e_desc with
+           | Sint n1, Sint n2 -> Some (n1 = n2), Cequal (e1, e2)
            | (_, _) -> None, Cequal (e1, e2))
     | Clequal (e1, e2) ->
         let e1 = simplify env e1 in
         let e2 = simplify env e2
         in
-        (match e1, e2 with
-           | SConst n1, SConst n2 -> Some (n1 <= n2), Clequal (e1, e2)
+        (match e1.e_desc, e2.e_desc with
+           | Sint n1, Sint n2 -> Some (n1 <= n2), Clequal (e1, e2)
            | _, _ -> None, Clequal (e1, e2))
     | Cfalse -> None, Cfalse
 
@@ -115,16 +123,19 @@ let rec solve const_env =
 
 (** Substitutes variables in the size exp with their value
     in the map (mapping vars to size exps). *)
-let rec static_exp_subst m = function
-  | Svar n -> (try List.assoc n m with | Not_found -> Svar n)
-  | Sop (op, se_list) -> Sop (op, List.map (static_exp_subst m) se_list)
-  | Sarray_power (se, n) -> Sarray_power (static_exp_subst m se,
-                                          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
+let rec static_exp_subst m se =
+  let desc = match se.e_desc with
+    | Svar n -> (try List.assoc n m with | Not_found -> Svar n)
+    | Sop (op, se_list) -> Sop (op, List.map (static_exp_subst m) se_list)
+    | Sarray_power (se, n) -> Sarray_power (static_exp_subst m se,
+                                            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
+  in
+    { se with se_desc = desc }
 
 (** Substitutes variables in the constraint list with their value
     in the map (mapping vars to size exps). *)
@@ -135,7 +146,7 @@ let instanciate_constr m constr =
     | Cfalse -> Cfalse
   in List.map (replace_one m) constr
 
-let rec print_static_exp ff = function
+let rec print_static_exp ff se = match se.e_desc with
   | Sint i -> fprintf ff "%d" i
   | Sbool b -> fprintf ff "%b" b
   | Sfloat f -> fprintf ff "%f" f

compiler/global/types.ml

@@ -10,8 +10,6 @@
 open Names
 open Location
 
-type ty = | Tprod of ty list | Tid of longname | Tarray of ty * static_exp
-
 type static_exp = { se_desc: static_exp_desc; se_ty: ty; se_loc: location }
 
 and static_exp_desc =
@@ -26,6 +24,8 @@ and static_exp_desc =
   | Srecord of (longname * static_exp) list (** { f1 = e1; f2 = e2; ... } *)
   | Sop of longname * static_exp list (** defined ops for now in pervasives *)
 
+type ty = | Tprod of ty list | Tid of longname | Tarray of ty * static_exp
+
 let invalid_type = Tprod []
 
 let mk_static_exp ?(loc = no_location) ?(ty = invalid_type) =