syntaxTreeCore.ml

(** Time-stamp: <modified the 15/02/2008 (at 11:45) 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 =
  | Node    of user_node_info
  | ExtNode of ext_node_info
and
  ext_node_info = {
    eni_name    : Ident.t;
    eni_inputs  : (Ident.t option * type_exp) list;
    eni_outputs : (Ident.t option * type_exp) list;
    eni_has_mem : bool;
    eni_is_safe : bool;
  }
and
  user_node_info = {
    uni_name    : Ident.t ;
    uni_static_params : static_param srcflagged list;
    uni_def     : node_def;
    uni_has_mem : bool;
    uni_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 has_mem_flag = bool

and node_profile = (var_info srcflagged list * var_info srcflagged list)
and node_def =
  | NodeAbstract of node_profile
  | NodeBody   of node_body
  | NodeAlias  of node_profile option * node_exp srcflagged

and node_body = {
  nbdy_inlist  : Ident.t list;
  nbdy_outlist : Ident.t list;
  nbdy_loclist : Ident.t list;
  nbdy_vartable: var_info_table;
  nbdy_asserts : (val_exp srcflagged) list;
  nbdy_eqs     : (eq_info srcflagged) list
}
and var_info_table = (Ident.t, var_info srcflagged) Hashtbl.t
and var_info = {
  va_nature : var_nature;
  va_name   : Ident.t;
  va_type   : type_exp;
  va_clock  : clock_exp 
}
and var_nature =
  | VarInput
  | VarOutput
  | VarLocal

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 predef_node =
(* zeroaire *)
    NULL_exp
  | TRUE_n
  | FALSE_n
  | ICONST_n of Ident.t
  | RCONST_n of Ident.t
  | IDENT_n  of Ident.idref
(* unaires *)
  | NOT_n
  | UMINUS_n
  | PRE_n
  | CURRENT_n
  | REAL2INT_n
  | INT2REAL_n
(* binaires *)
  | ARROW_n
  | FBY_n
  | WHEN_n
  | AND_n
  | OR_n
  | XOR_n
  | IMPL_n
  | EQ_n
  | NEQ_n
  | LT_n
  | LTE_n
  | GT_n
  | GTE_n
  | DIV_n
  | MOD_n
  | MINUS_n
  | PLUS_n
  | SLASH_n
  | TIMES_n
  | POWER_n
  | HAT_n
  | CONCAT_n
(* ternaires *)
  | IF_n
  | WITH_n
(* n-aires *)
  | NOR_n
  | DIESE_n
  | TUPLE_n
  | ARRAY_n
      (************************************************)
      (* Info associes aux expressions  (suite)      *)
      (************************************************)
      (* pseudo-unaire : A USAGE INTERNE *)
      (* projection de tuple             *)
  | PROJ_n of int
      (* pseudo-unaire : appel par position *)
  | CALL_n of node_exp srcflagged
      (* 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 = predef_node srcflagged * operands *)

and val_exp = 
  | CallByPos  of (predef_node  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 =
  | CallPreDef of predef_node
  | CallUsrDef of (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 )

let node_info_has_memory = function
  | Node uni -> uni.uni_has_mem
  | ExtNode eni -> eni.eni_has_mem