Updated Obc Ast

compiler/obc/obc.ml

@@ -11,6 +11,7 @@
 open Misc
 open Names
 open Ident
+open Types
 
 type var_name = ident
 type type_name = longname
@@ -21,13 +22,6 @@ type obj_name = name
 type op_name = longname
 type field_name = longname
 
-type ty =
-  | Tint
-  | Tfloat
-  | Tbool
-  | Tid of type_name
-  | Tarray of ty * static_exp
-
 type type_dec =
     { t_name : name;
       t_desc : tdesc }
@@ -37,54 +31,61 @@ and tdesc =
   | Type_enum of name list
   | Type_struct of (name * ty) list
 
-type lhs =
+type lhs = { l_desc : lhs_desc; l_ty : ty }
-  | Var of var_name
-  | Mem of var_name
-  | Field of lhs * field_name
-  | Array of lhs * exp
 
-and exp =
+and lhs_desc =
-  | Lhs of lhs
+  | Lvar of var_name
-  | Const of static_exp
+  | Lmem of var_name
-  | Op of op_name * exp list
+  | Lfield of lhs * field_name
-  | Struct_lit of type_name * (field_name * exp) list
+  | Larray of lhs * exp
-  | Array_lit of exp list
+
+and exp = { e_desc : exp_desc; e_ty : ty }
+
+and exp_desc =
+  | Elhs of lhs
+  | Econst of static_exp
+  | Eop of op_name * exp list
+  | Estruct of type_name * (field_name * exp) list
+  | Earray of exp list
 
 type obj_call =
-  | Context of obj_name
+  | Oobj of obj_name
-  | Array_context of obj_name * lhs
+  | Oarray of obj_name * lhs
+
+type method_name =
+  | Mreset
+  | Mstep
+  | Mother of name
 
-(* act list au lieu de Comp *)
 type act =
-  | Assgn of lhs * exp
+  | Aassgn of lhs * exp
-  | Call of lhs list * obj_call * exp list
+  | Acall of lhs list * obj_call * method_name * exp list
-  | Case of exp * (longname * act list) list
+  | Acase of exp * (longname * block) list
-  | For of var_name * static_exp * static_exp * act list
+  | Afor of var_name * static_exp * static_exp * block
-  | Reinit of obj_name
+
+and block = act list
 
 type var_dec =
     { v_ident : var_name;
-      v_type : ty;
+      v_type : ty; (*v_controllable : bool*) }
-      (*v_controllable : bool*) }
 
 type obj_dec =
     { o_name : obj_name;
-      o_method : fun_name;
       o_class : instance_name;
-      o_size : int; }
+      o_size : static_exp; }
 
 type method_def =
     { f_name : fun_name;
       f_inputs : var_dec list;
       f_outputs : var_dec list;
       f_locals : var_dec list;
-      f_body : act list }
+      f_body : act list; }
 
 type class_def =
     { c_name : class_name;
       c_mems : var_dec list;
       c_objs  : obj_dec list;
-      c_methods: method_def list; (*Map ?*) }
+      c_methods: method_def list; }
 
 type program =
     { p_pragmas: (name * string) list;
@@ -92,28 +93,21 @@ type program =
       p_types : type_dec list;
       p_defs  : class_def list }
 
-(*
-type step_fun =
-    { inp    : var_dec list;
-      out    : var_dec list;
-      local  : var_dec list;
-      controllables : var_dec list; (* GD : ugly patch to delay controllable
-                                       variables definition to target code
-                                       generation *)
-      bd     : act }
-
-type reset_fun = act
-    *)
-
 let mk_var_dec name ty =
   { v_ident = name; v_type = ty }
 
+let mk_exp ?(ty=invalid_type) desc =
+  { e_desc = desc; e_ty = ty }
+
+let mk_lhs ?(ty=invalid_type) desc =
+  { l_desc = desc; l_ty = ty }
+
 let rec var_name x =
   match x with
-    | Var x -> x
+    | Lvar x -> x
-    | Mem x -> x
+    | Lmem x -> x
-    | Field(x,_) -> var_name x
+    | Lfield(x,_) -> var_name x
-    | Array(l, _) -> var_name l
+    | Larray(l, _) -> var_name l
 
 (** Returns whether an object of name n belongs to
     a list of var_dec. *)
@@ -129,5 +123,5 @@ let rec vd_find n = function
       if vd.v_ident = n then vd else vd_find n l
 
 let lhs_of_exp = function
-  | Lhs l -> l
+  | Elhs l -> l
   | _ -> assert false