syntaxTreeCore.ml

(** Time-stamp: <modified the 13/03/2008 (at 15:31) by Erwan Jahier> *)


(** (Raw) Abstract syntax tree of source programs. *)

open Lxm


(**********************************************************************************)
type clock_exp =
  | BaseClock
  | NamedClock of Ident.t srcflagged

(**********************************************************************************)
(** [type_exp] is used to type flow, parameters, constants. *)
type type_exp = type_exp_core srcflagged
and
  type_exp_core =
  | Bool_type_exp
  | Int_type_exp
  | Real_type_exp
  | Named_type_exp of Ident.idref 
  | Array_type_exp of (type_exp * val_exp)


and node_info = {
  name    : Ident.t;
  static_params : static_param srcflagged list option;
  vars    : node_vars option;  (* aliased node may have no i/o decl *)
  def     : node_def;
  has_mem : bool;
  is_safe : bool;
}

and static_param =
  | StaticParamType  of Ident.t
  | StaticParamConst of (Ident.t * type_exp)
  | StaticParamNode  of
      (Ident.t * var_info srcflagged list * var_info srcflagged list * has_mem_flag)

and node_vars = {
  inlist  : Ident.t list;

  outlist : Ident.t list;
  loclist : Ident.t list option; (* abstract/ext node have no body *)
  vartable: var_info_table;
}
and var_info_table = (Ident.t, var_info srcflagged) Hashtbl.t
and var_info = {
  var_nature : var_nature;
  var_name   : Ident.t;
  var_type   : type_exp;
  var_clock  : clock_exp 
}
and var_nature =
  | VarInput
  | VarOutput
  | VarLocal

and node_def = 
  | Extern
  | Abstract
  | Body of node_body
  | Alias of node_exp srcflagged

and node_body = {
  asserts : (val_exp srcflagged) list;
  eqs     : (eq_info srcflagged) list;
}
and has_mem_flag = bool


and eq_info = (left_part list * val_exp)

and left_part = 
  | LeftVar of (Ident.t srcflagged)
  | LeftField of (left_part * (Ident.t srcflagged))
  | LeftArray of (left_part * (val_exp srcflagged))  
  | LeftSlice of (left_part * (slice_info srcflagged))

and slice_info = {
  si_first : val_exp ;
  si_last  : val_exp ;
  si_step  : val_exp option ;
}

and by_pos_op =
(* zeroaire *)
  | TRUE_n
  | FALSE_n
  | ICONST_n of Ident.t
  | RCONST_n of Ident.t
  | IDENT_n  of Ident.idref
(* unaires *)
  | NOT_n
  | CURRENT_n
  | REAL2INT_n
  | INT2REAL_n
(* binaires *)
  | AND_n
  | OR_n
  | XOR_n
  | IMPL_n
  | EQ_n
  | NEQ_n
  | LT_n
  | LTE_n
  | GT_n
  | GTE_n
  | DIV_n
  | MOD_n

(* ternaires *)
  | IF_n
(* n-aires *)
  | NOR_n
  | DIESE_n

(* overloaded operator *)
  | UMINUS_n
  | MINUS_n
  | PLUS_n
  | SLASH_n
  | TIMES_n
  | POWER_n

  | PRE_n

  (* pseudo-unaire : appel par position *)
  | CALL_n of node_exp srcflagged

(* operator that do not generate any op call *)
  | ARROW_n
  | FBY_n
  | WHEN_n
  | HAT_n
  | CONCAT_n
  | TUPLE_n
  | ARRAY_n
  | WITH_n

  (* pseudo-unaire : acces tableau *)
  | ARRAY_ACCES_n of val_exp
  | ARRAY_SLICE_n of slice_info
  (* pseudo-unaire : acces structure *)
  | STRUCT_ACCESS_n    of Ident.t
  | MERGE_n of (Ident.t * (Ident.t list))
  
  | ITERATOR_n of (Ident.t * Ident.t * val_exp)
      (** iterator name, node ident, array size *)

(************************************************)
(* Info associes aux expressions               *)
(************************************************)
(* Vision "fonctionnelle" des val_exp :         *)
(* Une exp. est une application d'operation :   *)
(* - avec passage par position, auquel cas les  *)
(* oprandes sont des val_exp                   *)
(* - avec passage par nom, auquel cas les       *)
(* oprandes sont des Ident.t * val_exp         *)
(************************************************)
(* and val_exp = by_pos_op srcflagged * operands *)

and val_exp = 
  | CallByPos  of (by_pos_op  srcflagged  * operands) 
  | CallByName of (by_name_op srcflagged  * (Ident.t srcflagged * val_exp) list)
   
and operands = Oper of val_exp list


and by_name_op =
  | STRUCT_n of Ident.idref
  | STRUCT_anonymous_n
      (* for backward compatibility with lv4 *)

and node_exp = 
      (Ident.idref * (static_arg srcflagged list))
	
(** Params statiques effectifs :
    - val_exp (pour les constantes)
    - type_exp (pour les types)
    - node_exp (pour les node)
    - ident : a rsoudre, peut etre const, type ou node 
*)
and static_arg =
  | StaticArgIdent of Ident.idref
  | StaticArgConst of val_exp
  | StaticArgType  of type_exp
  | StaticArgNode  of node_exp
(*   | StaticArgFunc  of node_exp *)


(**********************************************************************************)

(** constant *)

type const_info = 
  | ExternalConst  of (Ident.t * type_exp)
  | EnumConst      of (Ident.t * type_exp)
  | DefinedConst   of (Ident.t * type_exp option * val_exp)

(** Type *)

type field_info = {
  fd_name  : Ident.t ;
  fd_type  : type_exp ;
  fd_value : val_exp option
}
type struct_type_info = {
  st_name    : Ident.t ;
  st_flist   : Ident.t list; (* field name list *)
  st_ftable  : (Ident.t, field_info srcflagged)  Hashtbl.t 
}
type type_info =
  | ExternalType of (Ident.t)
  | AliasedType  of (Ident.t * type_exp)
  | EnumType     of (Ident.t * Ident.t srcflagged list)
  | StructType   of struct_type_info
  | ArrayType    of (Ident.t * type_exp * val_exp)

(** Operator *)

type item_ident =
  | ConstItem of Ident.t
  | TypeItem  of Ident.t
  | NodeItem  of Ident.t
      
type item_info =
    ConstInfo of const_info
  | TypeInfo  of type_info
  | NodeInfo  of node_info

(**********************************************************************************)

(** Utilitaries to build [val_exp] *)

let leafexp lxm op = CallByPos({src = lxm ; it = op }, Oper [])

let unexp lxm op e1 = CallByPos( {src = lxm ; it = op }, Oper [e1] )	

let binexp lxm op e1 e2 = CallByPos( {src = lxm ; it = op }, Oper [e1 ; e2] ) 

let ternexp lxm op e1 e2 e3 = CallByPos( {src = lxm ; it = op }, Oper [e1 ; e2; e3] )

let naryexp lxm op elst = CallByPos( {src = lxm ; it = op }, Oper elst )	


let bynameexp lxm op nelst = CallByName( {src = lxm ; it = op } , nelst )