diff --git a/_oasis b/_oasis
index b00cf5dbcf6608712696b258bb045ac7b606b580..8b7ac287b1efe1364389fcdbbe251c0e1bc7b4e4 100644
--- a/_oasis
+++ b/_oasis
@@ -37,5 +37,5 @@ Library "lustre-v6"
Install:true
XMETAEnable: true
XMETADescription: an API to call the Lustre v6 interpreter from ocaml
- InternalModules: SocExecValue,SocUtils,Lv6util,Lv6version,Lv6errors,Lxm,Lv6MainArgs,Verbose,Soc,SocPredef,Ident,SocExec,SocExecEvalPredef,Compile,AstTab,AstTabSymbol,AstInstanciateModel,Lv6parserUtils,AstV6,FilenameExtras,LicTab,LicDump,AstPredef,Lic,AstCore,LicName,IdSolver,EvalConst,LicEvalConst,LicEvalType,UnifyType,Ast2lic,AstV6Dump,EvalClock,UnifyClock,LicEvalClock,EvalType,LicPrg,LicMetaOp,L2lCheckOutputs,Misc,L2lRmPoly,L2lExpandMetaOp,L2lSplit,L2lExpandNodes,L2lExpandArrays,L2lCheckLoops,L2lCheckMemSafe,L2lOptimIte,Lv6lexer,Lv6parser,AstRecognizePredef,Lic2soc,Action,ActionsDeps,SocVar,Lus2licRun,SortActions
+ InternalModules: SocExecValue,SocUtils,Lv6util,Lv6version,Lv6errors,Lxm,Lv6MainArgs,Verbose,Soc,SocPredef,Lv6Id,SocExec,SocExecEvalPredef,Compile,AstTab,AstTabSymbol,AstInstanciateModel,Lv6parserUtils,AstV6,FilenameExtras,LicTab,LicDump,AstPredef,Lic,AstCore,LicName,IdSolver,EvalConst,LicEvalConst,LicEvalType,UnifyType,Ast2lic,AstV6Dump,EvalClock,UnifyClock,LicEvalClock,EvalType,LicPrg,LicMetaOp,L2lCheckOutputs,Misc,L2lRmPoly,L2lExpandMetaOp,L2lSplit,L2lExpandNodes,L2lExpandArrays,L2lCheckLoops,L2lCheckMemSafe,L2lOptimIte,Lv6lexer,Lv6parser,AstRecognizePredef,Lic2soc,Action,ActionsDeps,SocVar,Lus2licRun,SortActions
# Comment se passer de cette liste à la Prevert ?
diff --git a/src/assertion2lutin.ml b/src/assertion2lutin.ml
index fac247855a5597f190ab91c847ae14cb8859286e..46a97f73c03bbfcc2c1905ae312167e5c734d089 100644
--- a/src/assertion2lutin.ml
+++ b/src/assertion2lutin.ml
@@ -1,4 +1,4 @@
-(* Time-stamp: <modified the 22/01/2015 (at 09:43) by Erwan Jahier> *)
+(* Time-stamp: <modified the 26/02/2015 (at 11:18) by Erwan Jahier> *)
open Lxm
@@ -98,7 +98,7 @@ and (string_of_by_pos_op_eff: Lic.by_pos_op srcflagged -> Lic.val_exp list -> st
| ARRAY_ACCES(i), [ve1] ->
(string_of_val_exp_eff ve1) ^ "_" ^ (string_of_int i)
| STRUCT_ACCESS(id), [ve1] ->
- (string_of_val_exp_eff ve1) ^ "_" ^ (Ident.to_string id)
+ (string_of_val_exp_eff ve1) ^ "_" ^ (Lv6Id.to_string id)
| STRUCT_ACCESS _, _
| PRE, _
diff --git a/src/ast2lic.ml b/src/ast2lic.ml
index b78efbbcf3ee90d0bbc4f65cd47dc7103f696370..349c6c279713f729c330f318aaa123379a4369d3 100644
--- a/src/ast2lic.ml
+++ b/src/ast2lic.ml
@@ -1,4 +1,4 @@
-(* Time-stamp: <modified the 21/01/2015 (at 17:00) by Erwan Jahier> *)
+(* Time-stamp: <modified the 26/02/2015 (at 11:19) by Erwan Jahier> *)
open Lxm
@@ -8,7 +8,7 @@ open AstCore
open Lic
open IdSolver
open Lv6errors
-open Ident
+open Lv6Id
(** debug flag: on prend le meme que LicTab ... *)
let dbg = (Verbose.get_flag "lazyc")
@@ -35,17 +35,17 @@ let rec (of_type: IdSolver.t -> AstCore.type_exp -> Lic.type_) =
-let (add_pack_name : IdSolver.t -> Lxm.t -> Ident.idref -> Ident.idref) =
+let (add_pack_name : IdSolver.t -> Lxm.t -> Lv6Id.idref -> Lv6Id.idref) =
fun id_solver lxm cc ->
try
- match Ident.pack_of_idref cc with
+ match Lv6Id.pack_of_idref cc with
| Some _ -> cc
| None ->
- let id = Ident.of_idref cc in
+ let id = Lv6Id.of_idref cc in
let pn =
AstTabSymbol.find_pack_of_const id_solver.global_symbols id lxm
in
- Ident.make_idref pn id
+ Lv6Id.make_idref pn id
with _ -> cc (* raise en error? *)
@@ -116,9 +116,9 @@ TRAITER LES MACROS PREDEF :
(* pour abstraire la nature des params statiques *)
type abstract_static_param =
- | ASP_const of Ident.t
- | ASP_type of Ident.t
- | ASP_node of Ident.t
+ | ASP_const of Lv6Id.t
+ | ASP_type of Lv6Id.t
+ | ASP_node of Lv6Id.t
let do_abstract_static_param x =
match x.it with
@@ -130,12 +130,12 @@ match x.it with
let get_abstract_static_params
(symbols: AstTabSymbol.t)
(lxm: Lxm.t)
- (idref: Ident.idref)
+ (idref: Lv6Id.idref)
: abstract_static_param list =
Verbose.exe ~flag:dbg (fun () ->
Printf.fprintf stderr "#DBG: Ast2lic.get_abstract_static %s\n"
- (Ident.raw_string_of_idref idref)
+ (Lv6Id.raw_string_of_idref idref)
) ;
match (idref.id_pack, idref.id_id) with
| (Some "Lustre", "map")
@@ -146,7 +146,7 @@ let get_abstract_static_params
| (Some "Lustre", "condact") -> [ ASP_node "oper"; ASP_const "dflt" ]
| _ -> (
try
- let spl = match AstTabSymbol.find_node symbols (Ident.name_of_idref idref) lxm with
+ let spl = match AstTabSymbol.find_node symbols (Lv6Id.name_of_idref idref) lxm with
| AstTabSymbol.Local ni -> ni.it.static_params
| AstTabSymbol.Imported(imported_node, params) -> params
in List.map do_abstract_static_param spl
@@ -250,7 +250,7 @@ and check_static_arg
in
let res = match (sa.it, asp) with
(* ident vs type *)
- | (StaticArgIdent idref, ASP_type id) ->
+ | (StaticArgLv6Id idref, ASP_type id) ->
let teff = node_id_solver.id2type idref sa.src in
TypeStaticArgLic (id, teff)
(* type_exp vs type *)
@@ -258,7 +258,7 @@ and check_static_arg
let teff = of_type node_id_solver te in
TypeStaticArgLic (id, teff)
(* ident vs const *)
- | (StaticArgIdent idref, ASP_const id) ->
+ | (StaticArgLv6Id idref, ASP_const id) ->
let ceff = node_id_solver.id2const idref sa.src in
ConstStaticArgLic (id, ceff)
(* val_exp vs const *)
@@ -269,7 +269,7 @@ and check_static_arg
| _ -> ConstStaticArgLic (id,Tuple_const_eff ceff)
)
(* id vs node *)
- | (StaticArgIdent idref, ASP_node id) ->
+ | (StaticArgLv6Id idref, ASP_node id) ->
let sargs = [] in
let neff = node_id_solver.id2node idref sargs sa.src in
NodeStaticArgLic (id, neff.node_key_eff)
@@ -533,12 +533,12 @@ and (translate_val_exp : IdSolver.t -> UnifyClock.subst -> AstCore.val_exp
and translate_by_name_op id_solver op s =
let to_long idref =
- match Ident.pack_of_idref idref with
+ match Lv6Id.pack_of_idref idref with
| None -> (* If no pack name is provided, we lookup it in the symbol table *)
- let id = Ident.of_idref idref in
+ let id = Lv6Id.of_idref idref in
let pn = AstTabSymbol.find_pack_of_type id_solver.global_symbols id op.src in
- Ident.make_long pn idref.id_id
- | Some pn -> Ident.make_long pn idref.id_id
+ Lv6Id.make_long pn idref.id_id
+ | Some pn -> Lv6Id.make_long pn idref.id_id
in
let s, nop =
match op.it with
@@ -570,7 +570,7 @@ and const_of_static_arg id_solver const_or_const_ident lxm =
(* EvalConst.f ne fabrique PAS de tuple, on le fait ici *)
Tuple_const_eff xl
)
- | StaticArgIdent(id) -> id_solver.id2const id lxm
+ | StaticArgLv6Id(id) -> id_solver.id2const id lxm
| StaticArgType _
| StaticArgNode _ -> raise (Compile_error(lxm, "a constant was expected"))
@@ -578,7 +578,7 @@ and const_of_static_arg id_solver const_or_const_ident lxm =
and node_of_static_arg id_solver node_or_node_ident lxm =
match node_or_node_ident with
- | StaticArgIdent(id) ->
+ | StaticArgLv6Id(id) ->
let sargs = [] in (* it is an alias: no static arg *)
id_solver.id2node id sargs lxm
diff --git a/src/astCore.ml b/src/astCore.ml
index 059f633287dfa258c729e110b270509cc5fa9843..84a5ba5ebdae56955916e28f7d01140de3f5e2da 100644
--- a/src/astCore.ml
+++ b/src/astCore.ml
@@ -1,4 +1,4 @@
-(* Time-stamp: <modified the 21/01/2015 (at 16:59) by Erwan Jahier> *)
+(* Time-stamp: <modified the 26/02/2015 (at 11:19) by Erwan Jahier> *)
(** (Raw) Abstract syntax tree of source Lustre Core programs. *)
@@ -9,7 +9,7 @@ open Lxm
(**********************************************************************************)
type clock_exp =
| Base
- | NamedClock of Ident.clk srcflagged
+ | NamedClock of Lv6Id.clk srcflagged
(**********************************************************************************)
(** [type_exp] is used to type flow, parameters, constants. *)
@@ -19,12 +19,12 @@ and
| Bool_type_exp
| Int_type_exp
| Real_type_exp
- | Named_type_exp of Ident.idref
+ | Named_type_exp of Lv6Id.idref
| Array_type_exp of (type_exp * val_exp)
and node_info = {
- name : Ident.t;
+ name : Lv6Id.t;
static_params : static_param srcflagged list;
vars : node_vars option; (* aliased node may have no i/o decl *)
(* consts : ICI A FAIRE *)
@@ -35,21 +35,21 @@ and node_info = {
}
and static_param =
- | StaticParamType of Ident.t
- | StaticParamConst of Ident.t * type_exp
+ | StaticParamType of Lv6Id.t
+ | StaticParamConst of Lv6Id.t * type_exp
| StaticParamNode of
- (Ident.t * var_info srcflagged list * var_info srcflagged list * has_mem_flag * is_safe_flag)
+ (Lv6Id.t * var_info srcflagged list * var_info srcflagged list * has_mem_flag * is_safe_flag)
and node_vars = {
- inlist : Ident.t list;
- outlist : Ident.t list;
- loclist : Ident.t list option; (* abstract/ext node have no body *)
+ inlist : Lv6Id.t list;
+ outlist : Lv6Id.t list;
+ loclist : Lv6Id.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_table = (Lv6Id.t, var_info srcflagged) Hashtbl.t
and var_info = {
var_nature : var_nature;
- var_name : Ident.t;
+ var_name : Lv6Id.t;
var_number : int;
var_type : type_exp;
var_clock : clock_exp
@@ -76,8 +76,8 @@ and is_safe_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))
+ | LeftVar of (Lv6Id.t srcflagged)
+ | LeftField of (left_part * (Lv6Id.t srcflagged))
| LeftArray of (left_part * (val_exp srcflagged))
| LeftSlice of (left_part * (slice_info srcflagged))
@@ -91,7 +91,7 @@ and by_pos_op =
(* zeroaire *)
| Predef_n of AstPredef.op srcflagged
| CALL_n of node_exp srcflagged (* e.g., a_node<<xx>> *)
- | IDENT_n of Ident.idref (* constant or variable *)
+ | IDENT_n of Lv6Id.idref (* constant or variable *)
| PRE_n
| ARROW_n
@@ -105,7 +105,7 @@ and by_pos_op =
| CONCAT_n
| HAT_n
| ARRAY_n
- | STRUCT_ACCESS_n of Ident.t
+ | STRUCT_ACCESS_n of Lv6Id.t
| ARRAY_ACCES_n of val_exp
| ARRAY_SLICE_n of slice_info
@@ -118,27 +118,27 @@ and by_pos_op =
(* - avec passage par position, auquel cas les *)
(* opérandes sont des val_exp *)
(* - avec passage par nom, auquel cas les *)
-(* opérandes sont des Ident.t * val_exp *)
+(* opérandes sont des Lv6Id.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)
- | Merge_n of val_exp srcflagged * (Ident.idref srcflagged * val_exp) list
+ | CallByName of (by_name_op srcflagged * (Lv6Id.t srcflagged * val_exp) list)
+ | Merge_n of val_exp srcflagged * (Lv6Id.idref srcflagged * val_exp) list
| Merge_bool_n of val_exp srcflagged * val_exp * val_exp
and operands = Oper of val_exp list
(* Virer cet Oper ? Non, sinon ca boucle... *)
and by_name_op =
- | STRUCT_n of Ident.idref
- | STRUCT_WITH_n of Ident.idref * Ident.idref
+ | STRUCT_n of Lv6Id.idref
+ | STRUCT_WITH_n of Lv6Id.idref * Lv6Id.idref
| STRUCT_anonymous_n
(* for backward compatibility with lv4 *)
and node_exp =
- (Ident.idref * (static_arg srcflagged list))
+ (Lv6Id.idref * (static_arg srcflagged list))
(** Params statiques effectifs :
- val_exp (pour les constantes)
@@ -147,7 +147,7 @@ and node_exp =
- ident : a résoudre, peut etre const, type ou node
*)
and static_arg =
- | StaticArgIdent of Ident.idref
+ | StaticArgLv6Id of Lv6Id.idref
| StaticArgConst of val_exp
| StaticArgType of type_exp
@@ -160,35 +160,35 @@ and static_arg =
(** constant *)
and const_info =
- | ExternalConst of (Ident.t * type_exp * val_exp option)
- | EnumConst of (Ident.t * type_exp)
- | DefinedConst of (Ident.t * type_exp option * val_exp)
+ | ExternalConst of (Lv6Id.t * type_exp * val_exp option)
+ | EnumConst of (Lv6Id.t * type_exp)
+ | DefinedConst of (Lv6Id.t * type_exp option * val_exp)
(** Type *)
type field_info = {
- fd_name : Ident.t ;
+ fd_name : Lv6Id.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
+ st_name : Lv6Id.t ;
+ st_flist : Lv6Id.t list; (* field name list *)
+ st_ftable : (Lv6Id.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)
+ | ExternalType of (Lv6Id.t)
+ | AliasedType of (Lv6Id.t * type_exp)
+ | EnumType of (Lv6Id.t * Lv6Id.t srcflagged list)
| StructType of struct_type_info
- | ArrayType of (Ident.t * type_exp * val_exp)
+ | ArrayType of (Lv6Id.t * type_exp * val_exp)
(** Operator *)
type item_ident =
- | ConstItem of Ident.t
- | TypeItem of Ident.t
- | NodeItem of Ident.t * static_param srcflagged list
+ | ConstItem of Lv6Id.t
+ | TypeItem of Lv6Id.t
+ | NodeItem of Lv6Id.t * static_param srcflagged list
type item_info =
ConstInfo of const_info
@@ -201,7 +201,7 @@ let rec string_of_type_exp x =
| Bool_type_exp -> "bool"
| Int_type_exp -> "int"
| Real_type_exp -> "real"
- | Named_type_exp id -> (Ident.string_of_idref id)
+ | Named_type_exp id -> (Lv6Id.string_of_idref id)
| Array_type_exp (te, sz) -> (string_of_type_exp te) ^ "^ ..."
diff --git a/src/astInstanciateModel.ml b/src/astInstanciateModel.ml
index 185951d590714b83d6cd61eea003d46c05e69583..4004c338572a94063a399055e51068148cb8cad5 100644
--- a/src/astInstanciateModel.ml
+++ b/src/astInstanciateModel.ml
@@ -1,4 +1,4 @@
-(* Time-stamp: <modified the 21/01/2015 (at 16:47) by Erwan Jahier> *)
+(* Time-stamp: <modified the 26/02/2015 (at 11:19) by Erwan Jahier> *)
open Lxm
open AstV6
@@ -23,9 +23,9 @@ let instance_error lxm =
*)
type check_arg_acc = item_ident list * item_info srcflagged list
type tables =
- (Ident.t, const_info Lxm.srcflagged) Hashtbl.t *
- (Ident.t, type_info Lxm.srcflagged) Hashtbl.t *
- (Ident.t, node_info Lxm.srcflagged) Hashtbl.t
+ (Lv6Id.t, const_info Lxm.srcflagged) Hashtbl.t *
+ (Lv6Id.t, type_info Lxm.srcflagged) Hashtbl.t *
+ (Lv6Id.t, node_info Lxm.srcflagged) Hashtbl.t
(** Insert an item in the lexeme table. Raise [Compile_error] if already defined. *)
@@ -46,7 +46,7 @@ let put_in_tab
let (check_arg :
- tables -> (Ident.t * static_arg srcflagged) list -> check_arg_acc ->
+ tables -> (Lv6Id.t * static_arg srcflagged) list -> check_arg_acc ->
static_param srcflagged -> check_arg_acc) =
fun (ctab, ttab, ntab) args (defs, prov) param ->
let find_arg id =
@@ -56,7 +56,7 @@ let (check_arg :
| StaticParamType s -> (
let arg = find_arg s in
let te = match arg.it with
- | StaticArgIdent idr -> Lxm.flagit (Named_type_exp idr) arg.src
+ | StaticArgLv6Id idr -> Lxm.flagit (Named_type_exp idr) arg.src
| StaticArgType x -> x
| _ -> instance_error param.src
in
@@ -69,7 +69,7 @@ let (check_arg :
| StaticParamConst (s,te) -> (
let arg = find_arg s in
let ce = match (arg.it) with
- | StaticArgIdent idr -> Lv6parserUtils.leafexp arg.src (IDENT_n idr)
+ | StaticArgLv6Id idr -> Lv6parserUtils.leafexp arg.src (IDENT_n idr)
| StaticArgConst x -> x
| _ -> instance_error param.src
in
@@ -82,7 +82,7 @@ let (check_arg :
| StaticParamNode (s, inl, outl, has_memory, is_safe) -> (
let arg = find_arg s in
let by_pos_op = match (arg.it) with
- | StaticArgIdent idr -> CALL_n(Lxm.flagit ((idr,[])) arg.src)
+ | StaticArgLv6Id idr -> CALL_n(Lxm.flagit ((idr,[])) arg.src)
| StaticArgNode by_pos_op -> by_pos_op
| _ -> instance_error param.src
in
@@ -103,7 +103,7 @@ let (check_arg :
((NodeItem (s,sparams))::defs, x::prov)
)
-let (f: (Ident.t, AstV6.model_info Lxm.srcflagged) Hashtbl.t ->
+let (f: (Lv6Id.t, AstV6.model_info Lxm.srcflagged) Hashtbl.t ->
(AstV6.pack_info Lxm.srcflagged) -> AstV6.pack_given) =
fun mtab pdata ->
match (pdata.it.pa_def) with
@@ -111,7 +111,7 @@ let (f: (Ident.t, AstV6.model_info Lxm.srcflagged) Hashtbl.t ->
| PackInstance pi ->
let mi = try Hashtbl.find mtab pi.pi_model with Not_found ->
let msg = Printf.sprintf "bad pack instance: model %s undeclared"
- (Ident.to_string pi.pi_model)
+ (Lv6Id.to_string pi.pi_model)
in
raise ( Compile_error (pdata.src, msg))
in
@@ -121,14 +121,14 @@ let (f: (Ident.t, AstV6.model_info Lxm.srcflagged) Hashtbl.t ->
let ntab = Hashtbl.copy mi.it.mo_body.pk_node_table in
let args = pi.pi_args in
let pars = mi.it.mo_needs in
- let (used_packages : Ident.pack_name srcflagged list) =
+ let (used_packages : Lv6Id.pack_name srcflagged list) =
(* We add to the list of used packages the packages that are explicitely
used in the model arguments *)
List.fold_left
(fun acc (_,arg) ->
(match arg.it with
- | StaticArgIdent(idref) ->
- (match Ident.pack_of_idref idref with
+ | StaticArgLv6Id(idref) ->
+ (match Lv6Id.pack_of_idref idref with
| None -> acc
| Some p ->
let p_flagged = Lxm.flagit p arg.src in
@@ -150,7 +150,7 @@ let (f: (Ident.t, AstV6.model_info Lxm.srcflagged) Hashtbl.t ->
if (pars_nb <> args_nb) then
let msg = "\n*** " ^pars_nb ^ " arguments are expected, but "^args_nb^
" were provided when defining package "^
- (Ident.pack_name_to_string pdata.it.pa_name)
+ (Lv6Id.pack_name_to_string pdata.it.pa_name)
in
raise(Compile_error (pdata.src, msg))
else
@@ -177,7 +177,7 @@ let (f: (Ident.t, AstV6.model_info Lxm.srcflagged) Hashtbl.t ->
with Invalid_argument _ ->
let msg = Printf.sprintf
"bad pack instance: %d args provided while model %s has %d params"
- (List.length args) (Ident.to_string pi.pi_model) (List.length pars)
+ (List.length args) (Lv6Id.to_string pi.pi_model) (List.length pars)
in
raise (Compile_error (pdata.src, msg))
diff --git a/src/astInstanciateModel.mli b/src/astInstanciateModel.mli
index bd6bb91e7c5092bbd818c2c179c19c421ceaae1f..f79cd222aad2e1ce1604b5419c1da51e58a4118a 100644
--- a/src/astInstanciateModel.mli
+++ b/src/astInstanciateModel.mli
@@ -1,4 +1,4 @@
-(* Time-stamp: <modified the 13/12/2012 (at 11:34) by Erwan Jahier> *)
+(* Time-stamp: <modified the 26/02/2015 (at 13:44) by Erwan Jahier> *)
(** Create packages from Model instances. *)
@@ -43,7 +43,7 @@ On met en relation les couples (param formel, arg effectif) :
(* ZZZ remplit AstTab.t par effet de bords. *)
val f :
(* la table des sources de modeles *)
- (Ident.t, AstV6.model_info Lxm.srcflagged) Hashtbl.t ->
+ (Lv6Id.t, AstV6.model_info Lxm.srcflagged) Hashtbl.t ->
(* la def de pack à traiter *)
(AstV6.pack_info Lxm.srcflagged) ->
AstV6.pack_given
diff --git a/src/astPredef.ml b/src/astPredef.ml
index 61859b4523ba868ca37f37c4f8c0002d6ada7527..39392df4a1dc923765dad7d86b68b826bb9f5794 100644
--- a/src/astPredef.ml
+++ b/src/astPredef.ml
@@ -1,15 +1,17 @@
-(* Time-stamp: <modified the 26/06/2014 (at 18:29) by Erwan Jahier> *)
+(* Time-stamp: <modified the 26/02/2015 (at 11:25) by Erwan Jahier> *)
(** Predefined operators Type definition *)
(* XXX shoud not type int, real, and bool be handled there ? *)
type op =
+
(* zero-ary *)
| TRUE_n
+
| FALSE_n
- | RCONST_n of Ident.t (* we don't want to touch reals! *)
- | ICONST_n of Ident.t (* so we don't touch int either...*)
+ | RCONST_n of Lv6Id.t (* we don't want to touch reals! *)
+ | ICONST_n of Lv6Id.t (* so we don't touch int either...*)
(* unary *)
| NOT_n
| REAL2INT_n
@@ -83,8 +85,8 @@ let iterable_op = [
let op2string = function
| TRUE_n -> "true"
| FALSE_n -> "false"
- | ICONST_n id -> Ident.to_string id
- | RCONST_n id -> Ident.to_string id
+ | ICONST_n id -> Lv6Id.to_string id
+ | RCONST_n id -> Lv6Id.to_string id
| NOT_n -> "not"
| REAL2INT_n -> "real2int"
| INT2REAL_n -> "int2real"
@@ -254,17 +256,17 @@ let (is_a_predef_op : string -> bool) =
type 'a evaluator = 'a list list -> 'a list
-let (op_to_long : op -> Ident.long) =
+let (op_to_long : op -> Lv6Id.long) =
fun op ->
- Ident.make_long
- (Ident.pack_name_of_string "Lustre")
- (Ident.of_string (op2string_long op))
+ Lv6Id.make_long
+ (Lv6Id.pack_name_of_string "Lustre")
+ (Lv6Id.of_string (op2string_long op))
-let (op_to_idref : op -> Ident.idref) =
+let (op_to_idref : op -> Lv6Id.idref) =
fun op ->
- Ident.make_idref
- (Ident.pack_name_of_string "Lustre")
- (Ident.of_string (op2string_long op))
+ Lv6Id.make_idref
+ (Lv6Id.pack_name_of_string "Lustre")
+ (Lv6Id.of_string (op2string_long op))
(*********************************************************************************)
(* Automatically generate the latex documentation associated to predefined
diff --git a/src/astRecognizePredef.ml b/src/astRecognizePredef.ml
index 320ce70b41a25e3ad7a494cc642eae09077b921f..d6c784bfe3edff36a4f6f6a8a2a43d976148f6d3 100644
--- a/src/astRecognizePredef.ml
+++ b/src/astRecognizePredef.ml
@@ -1,16 +1,16 @@
-(* Time-stamp: <modified the 16/05/2013 (at 17:39) by Erwan Jahier> *)
+(* Time-stamp: <modified the 26/02/2015 (at 11:19) by Erwan Jahier> *)
-let (get_predef : Ident.idref -> AstPredef.op option) =
+let (get_predef : Lv6Id.idref -> AstPredef.op option) =
fun idref ->
let get_op () =
- try Some (AstPredef.string_to_op (Ident.to_string (Ident.name_of_idref idref)))
+ try Some (AstPredef.string_to_op (Lv6Id.to_string (Lv6Id.name_of_idref idref)))
with Not_found -> None
in
- match Ident.pack_of_idref idref with
+ match Lv6Id.pack_of_idref idref with
| None -> None
(* get_op () (* The Lustre package is «use»d by default *) *)
- | Some p -> if (Ident.pack_name_to_string p) = "Lustre" then get_op () else None
+ | Some p -> if (Lv6Id.pack_name_to_string p) = "Lustre" then get_op () else None
open AstV6
open AstCore
@@ -60,9 +60,9 @@ and r_static_param sp = sp
and r_by_name_static_arg (id,arg) =
let arg_it =
match arg.it with
- | StaticArgIdent(idref) -> (
+ | StaticArgLv6Id(idref) -> (
match get_predef idref with
- | None -> StaticArgIdent idref
+ | None -> StaticArgLv6Id idref
| Some predef -> StaticArgNode (Predef_n (flagit predef arg.src))
)
| StaticArgConst(ve) -> StaticArgConst(r_val_exp ve)
@@ -73,9 +73,9 @@ and r_by_name_static_arg (id,arg) =
and r_static_arg arg =
match arg.it with
- | StaticArgIdent(idref) -> (
+ | StaticArgLv6Id(idref) -> (
match get_predef idref with
- | None -> StaticArgIdent idref
+ | None -> StaticArgLv6Id idref
| Some predef -> StaticArgNode (Predef_n (flagit predef arg.src))
)
| StaticArgConst(ve) -> StaticArgConst(r_val_exp ve)
diff --git a/src/astRecognizePredef.mli b/src/astRecognizePredef.mli
index 27acb8d8dc96124611641ea3999e1e41f488b1b4..41feb1bbfdaeaf3cda11af13fa89fab0382ff780 100644
--- a/src/astRecognizePredef.mli
+++ b/src/astRecognizePredef.mli
@@ -1,4 +1,4 @@
-(* Time-stamp: <modified the 13/12/2012 (at 11:18) by Erwan Jahier> *)
+(* Time-stamp: <modified the 26/02/2015 (at 13:44) by Erwan Jahier> *)
(** Replaces idref that corresponds to predefined items with the
AstCore.Predef constructor
@@ -9,11 +9,11 @@
- To do that, first paramatrize the AS (cf AstCore) by the kind
of ident that is used. Indeed, during parsing, we cannot
- always know what Ident.long should we have, given an
- Ident.idref, or a Ident.t. The idea is then to write a function
+ always know what Lv6Id.long should we have, given an
+ Lv6Id.idref, or a Lv6Id.t. The idea is then to write a function
resolve_name which profile is
- (Ident.idref) AstCore.t -> (long) AstCore.t
+ (Lv6Id.idref) AstCore.t -> (long) AstCore.t
*)
val f : AstV6.t -> AstV6.t
diff --git a/src/astTab.ml b/src/astTab.ml
index a13d0e71b66b9e90d4c516841fc2ec4dd0e69c3b..bac9a116294a0522b9b49fca00830f22c9e424e1 100644
--- a/src/astTab.ml
+++ b/src/astTab.ml
@@ -1,4 +1,4 @@
-(* Time-stamp: <modified the 11/04/2013 (at 15:28) by Erwan Jahier> *)
+(* Time-stamp: <modified the 26/02/2015 (at 11:20) by Erwan Jahier> *)
(**
Table des infos sources : une couche au dessus de AstV6 pour mieux
@@ -43,7 +43,7 @@ open Lv6errors
nature + nom simple -> nom complet
- (c.a.d. ??? + AstV6.item_ident -> Ident.long)
+ (c.a.d. ??? + AstV6.item_ident -> Lv6Id.long)
*)
type pack_mng = {
@@ -55,7 +55,7 @@ type pack_mng = {
pm_actual_src : AstV6.pack_given;
(* table "brute" des items provided *)
(* pour les "user" du pack *)
- pm_user_items : (AstCore.item_ident, Ident.long Lxm.srcflagged) Hashtbl.t;
+ pm_user_items : (AstCore.item_ident, Lv6Id.long Lxm.srcflagged) Hashtbl.t;
(* les tables de symboles pour compil ultérieure *)
pm_body_stab : AstTabSymbol.t;
(* la table pour provide n'est créée que si besoin ... *)
@@ -77,28 +77,28 @@ type pack_mng = {
type t = {
(* liste + tables des sources bruts *)
st_list : AstV6.pack_or_model list ;
- st_raw_mod_tab : (Ident.t , model_info srcflagged) Hashtbl.t ;
- st_raw_pack_tab : (Ident.pack_name , pack_info srcflagged) Hashtbl.t ;
+ st_raw_mod_tab : (Lv6Id.t , model_info srcflagged) Hashtbl.t ;
+ st_raw_pack_tab : (Lv6Id.pack_name , pack_info srcflagged) Hashtbl.t ;
(* table des managers de packs *)
- st_pack_mng_tab : (Ident.pack_name , pack_mng) Hashtbl.t;
+ st_pack_mng_tab : (Lv6Id.pack_name , pack_mng) Hashtbl.t;
}
(* exported *)
-let (pack_list:t -> Ident.pack_name list) =
+let (pack_list:t -> Lv6Id.pack_name list) =
fun this ->
Hashtbl.fold (fun n p l -> n::l) this.st_pack_mng_tab []
(* exported *)
-let (pack_body_env: t -> Ident.pack_name -> AstTabSymbol.t) =
+let (pack_body_env: t -> Lv6Id.pack_name -> AstTabSymbol.t) =
fun this p ->
try
(Hashtbl.find this.st_pack_mng_tab p).pm_body_stab
with Not_found ->
print_string ("*** Can not find package '" ^
- (Ident.pack_name_to_string p) ^ "' in the following packages: ");
+ (Lv6Id.pack_name_to_string p) ^ "' in the following packages: ");
Hashtbl.iter
- (fun pn pm -> print_string ("\n***\t '"^(Ident.pack_name_to_string pn)^ "'"))
+ (fun pn pm -> print_string ("\n***\t '"^(Lv6Id.pack_name_to_string pn)^ "'"))
this.st_pack_mng_tab;
print_string "\n";
flush stdout;
@@ -106,12 +106,12 @@ let (pack_body_env: t -> Ident.pack_name -> AstTabSymbol.t) =
(* exported *)
-let (pack_prov_env: t -> Ident.pack_name -> Lxm.t -> AstTabSymbol.t option) =
+let (pack_prov_env: t -> Lv6Id.pack_name -> Lxm.t -> AstTabSymbol.t option) =
fun this p lxm ->
try (Hashtbl.find this.st_pack_mng_tab p).pm_provide_stab
with Not_found ->
(* let msg = *)
-(* ("\n*** Could not find package " ^(Ident.pack_name_to_string p) ^ *)
+(* ("\n*** Could not find package " ^(Lv6Id.pack_name_to_string p) ^ *)
(* " in the package table" ) *)
(* in *)
None
@@ -140,18 +140,18 @@ let put_in_tab
init de la table des items provided (pour les users)
****************************************************************************)
let init_user_items (this: pack_mng) = (
- let pname = Ident.pack_name_of_string (Lxm.str this.pm_lxm) in
+ let pname = Lv6Id.pack_name_of_string (Lxm.str this.pm_lxm) in
(** Exportation D'une const_info *)
- let export_const (s:Ident.t) (xci: AstCore.const_info srcflagged) =
- Verbose.printf ~level:3 " export const %s\n" (Ident.to_string s);
+ let export_const (s:Lv6Id.t) (xci: AstCore.const_info srcflagged) =
+ Verbose.printf ~level:3 " export const %s\n" (Lv6Id.to_string s);
put_in_tab "const" this.pm_user_items
(ConstItem s)
- (Lxm.flagit (Ident.make_long pname s) xci.src)
+ (Lxm.flagit (Lv6Id.make_long pname s) xci.src)
in
(** Exportation D'un type_info *)
- let export_type (s: Ident.t) (xti: AstCore.type_info srcflagged) =
+ let export_type (s: Lv6Id.t) (xti: AstCore.type_info srcflagged) =
( match (xti.it) with
| EnumType (_, ecl) -> (
(* Cas particulier des types enums *)
@@ -159,10 +159,10 @@ let init_user_items (this: pack_mng) = (
let treat_enum_const ec =
let s = ec.it in
let lxm = ec.src in
- Verbose.printf ~level:3 " export enum const %s\n" (Ident.to_string s);
+ Verbose.printf ~level:3 " export enum const %s\n" (Lv6Id.to_string s);
put_in_tab "const" this.pm_user_items
(ConstItem s)
- (Lxm.flagit (Ident.make_long pname s) lxm)
+ (Lxm.flagit (Lv6Id.make_long pname s) lxm)
in
List.iter treat_enum_const ecl
)
@@ -172,18 +172,18 @@ let init_user_items (this: pack_mng) = (
| ArrayType _
-> ()
);
- Verbose.printf ~level:3 " export type %s\n" (Ident.to_string s);
+ Verbose.printf ~level:3 " export type %s\n" (Lv6Id.to_string s);
put_in_tab "type" this.pm_user_items
(TypeItem s)
- (Lxm.flagit (Ident.make_long pname s) xti.src)
+ (Lxm.flagit (Lv6Id.make_long pname s) xti.src)
in
(** Exportation D'un node_info *)
- let export_node (s: Ident.t) (xoi: AstCore.node_info srcflagged) =
- Verbose.printf ~level:3 " export node %s\n" (Ident.to_string s);
+ let export_node (s: Lv6Id.t) (xoi: AstCore.node_info srcflagged) =
+ Verbose.printf ~level:3 " export node %s\n" (Lv6Id.to_string s);
put_in_tab "node" this.pm_user_items
(NodeItem (s,xoi.it.static_params))
- (Lxm.flagit (Ident.make_long pname s) xoi.src)
+ (Lxm.flagit (Lv6Id.make_long pname s) xoi.src)
in
let pg = this.pm_actual_src in
@@ -266,7 +266,7 @@ let rec (create : AstV6.pack_or_model list -> t) =
(* passe 2 *)
Verbose.printf ~level:3 "*** AstTab.create pass 2\n";
let init_pack_mng pname pdata = (
- Verbose.printf ~level:3 " init pack %s\n" (Ident.pack_name_to_string pname);
+ Verbose.printf ~level:3 " init pack %s\n" (Lv6Id.pack_name_to_string pname);
let pg = AstInstanciateModel.f res.st_raw_mod_tab pdata in
Hashtbl.add res.st_pack_mng_tab
pname
@@ -289,7 +289,7 @@ and
(* cas d'un package *)
| AstV6.NSPack pi ->
let lxm = pi.Lxm.src in
- let nme = (Ident.pack_name_of_string (Lxm.str lxm)) in
+ let nme = (Lv6Id.pack_name_of_string (Lxm.str lxm)) in
put_in_tab "package" this.st_raw_pack_tab nme pi
| AstV6.NSModel mi -> (* cas d'un modele *)
@@ -318,13 +318,13 @@ and
- puis les déclarations locales qui peuvent éventuellement
masquer les précédentes (warning ?)
*)
- init_pack_mng_stabs (this: t) (pname: Ident.pack_name) (pm: pack_mng) = (
+ init_pack_mng_stabs (this: t) (pname: Lv6Id.pack_name) (pm: pack_mng) = (
let pg = pm.pm_actual_src in
Verbose.printf ~level:3 " init symbol tables for pack %s\n"
- (Ident.pack_name_to_string pname);
+ (Lv6Id.pack_name_to_string pname);
(* ON COMMENCE PAR TRAITER LE PG_USES *)
- let treat_uses (px:Ident.pack_name srcflagged) = (
+ let treat_uses (px:Lv6Id.pack_name srcflagged) = (
let pname = px.it in
let lxm = px.src in
let pum =
@@ -333,7 +333,7 @@ and
in
let fill_used_item
(ii: AstCore.item_ident)
- (iks: Ident.long Lxm.srcflagged) =
+ (iks: Lv6Id.long Lxm.srcflagged) =
(match ii with
| ConstItem n -> (
AstTabSymbol.add_import_const pm.pm_body_stab px.it n iks.it;
@@ -389,20 +389,20 @@ and
(****************************************************************************
Associations :
--------------
-- Ident.t -> Ident.long * AstCore.xxxx_info
+- Lv6Id.t -> Lv6Id.long * AstCore.xxxx_info
****************************************************************************)
-(* associations idref -> Ident.long *)
-let find_type (genv: t) (pck: string) (idr: Ident.t) =
+(* associations idref -> Lv6Id.long *)
+let find_type (genv: t) (pck: string) (idr: Lv6Id.t) =
print_string "*** not implemented.\n";
assert false
-let find_const (genv: t) (pck: string) (idr: Ident.t) =
+let find_const (genv: t) (pck: string) (idr: Lv6Id.t) =
print_string "*** not implemented.\n";
assert false
-let find_node (genv: t) (pck: string) (idr: Ident.t) =
+let find_node (genv: t) (pck: string) (idr: Lv6Id.t) =
print_string "*** not implemented.\n";
assert false
@@ -421,21 +421,21 @@ let (dump : t -> unit) =
x.st_list ;
p "\n\t - Raw model table: ";
- (* st_raw_mod_tab : (Ident.t , model_info srcflagged) Hashtbl.t ; *)
+ (* st_raw_mod_tab : (Lv6Id.t , model_info srcflagged) Hashtbl.t ; *)
Hashtbl.iter
- (fun id _mi -> p ((Ident.to_string id) ^ " "))
+ (fun id _mi -> p ((Lv6Id.to_string id) ^ " "))
x.st_raw_mod_tab;
p "\n\t - Raw Package table: ";
- (* st_raw_pack_tab : (Ident.pack_name , pack_info srcflagged) Hashtbl.t ; *)
+ (* st_raw_pack_tab : (Lv6Id.pack_name , pack_info srcflagged) Hashtbl.t ; *)
Hashtbl.iter
- (fun pn pi -> p ((Ident.pack_name_to_string pn) ^ " "))
+ (fun pn pi -> p ((Lv6Id.pack_name_to_string pn) ^ " "))
x.st_raw_pack_tab;
p "\n\t - Package manager table: ";
- (* st_pack_mng_tab : (Ident.pack_name , pack_mng) Hashtbl.t; *)
+ (* st_pack_mng_tab : (Lv6Id.pack_name , pack_mng) Hashtbl.t; *)
Hashtbl.iter
- (fun pn pm -> p ((Ident.pack_name_to_string pn) ^ " "))
+ (fun pn pm -> p ((Lv6Id.pack_name_to_string pn) ^ " "))
x.st_pack_mng_tab;
p "\nEnd of Syntax table dump. »\n"
diff --git a/src/astTab.mli b/src/astTab.mli
index 74416ba27f825f12084544b2cefe2533ae2dbae4..0d7b8f790bf061f18efa40fd5e268d2be57587ca 100644
--- a/src/astTab.mli
+++ b/src/astTab.mli
@@ -1,4 +1,4 @@
-(* Time-stamp: <modified the 12/12/2012 (at 17:20) by Erwan Jahier> *)
+(* Time-stamp: <modified the 26/02/2015 (at 13:44) by Erwan Jahier> *)
(** Tabulated version of the parse tree.
@@ -15,13 +15,13 @@ val create : AstV6.pack_or_model list -> t
(** accès aux infos *)
-val pack_body_env : t -> Ident.pack_name -> AstTabSymbol.t
+val pack_body_env : t -> Lv6Id.pack_name -> AstTabSymbol.t
(** A package may have no provided part *)
-val pack_prov_env : t -> Ident.pack_name -> Lxm.t -> AstTabSymbol.t option
+val pack_prov_env : t -> Lv6Id.pack_name -> Lxm.t -> AstTabSymbol.t option
(** Liste des noms de packs *)
-val pack_list : t -> Ident.pack_name list
+val pack_list : t -> Lv6Id.pack_name list
(** For debug. *)
val dump : t -> unit
diff --git a/src/astTabSymbol.ml b/src/astTabSymbol.ml
index 679d87edd6daec5d75bc3ddad9e1c8a4d37a79c4..4ebc876843cf09727549a24d868d8806abb78302 100644
--- a/src/astTabSymbol.ml
+++ b/src/astTabSymbol.ml
@@ -1,4 +1,4 @@
-(* Time-stamp: <modified the 09/07/2014 (at 17:18) by Erwan Jahier> *)
+(* Time-stamp: <modified the 26/02/2015 (at 11:20) by Erwan Jahier> *)
(**
Sous-module pour AstTab
@@ -10,12 +10,12 @@ open Lv6errors
type 'a elt =
| Local of 'a
- | Imported of Ident.long * static_param srcflagged list
+ | Imported of Lv6Id.long * static_param srcflagged list
type t = {
- st_consts: (Ident.t , (Ident.pack_name * const_info srcflagged elt)) Hashtbl.t ;
- st_types : (Ident.t , (Ident.pack_name * type_info srcflagged elt)) Hashtbl.t ;
- st_nodes : (Ident.t , (node_info srcflagged) elt) Hashtbl.t ;
+ st_consts: (Lv6Id.t , (Lv6Id.pack_name * const_info srcflagged elt)) Hashtbl.t ;
+ st_types : (Lv6Id.t , (Lv6Id.pack_name * type_info srcflagged elt)) Hashtbl.t ;
+ st_nodes : (Lv6Id.t , (node_info srcflagged) elt) Hashtbl.t ;
}
(* Création/initialisation d'une symbol_tab *)
@@ -30,68 +30,68 @@ let create () =
st_nodes = nodes_tbl;
}
-let find_type (this: t) (id: Ident.t) lxm =
+let find_type (this: t) (id: Lv6Id.t) lxm =
try snd (Hashtbl.find (this.st_types) id)
with Not_found ->
- raise (Compile_error(lxm, "unknown type (" ^ (Ident.to_string id)^")"))
+ raise (Compile_error(lxm, "unknown type (" ^ (Lv6Id.to_string id)^")"))
-let find_pack_of_type (this: t) (id: Ident.t) lxm =
+let find_pack_of_type (this: t) (id: Lv6Id.t) lxm =
try fst (Hashtbl.find (this.st_types) id)
with Not_found ->
- raise (Compile_error(lxm, "unknown type (" ^ (Ident.to_string id)^")"))
+ raise (Compile_error(lxm, "unknown type (" ^ (Lv6Id.to_string id)^")"))
-let find_const (this: t) (id: Ident.t) lxm =
+let find_const (this: t) (id: Lv6Id.t) lxm =
try snd (Hashtbl.find (this.st_consts) id)
with Not_found ->
- raise (Unknown_constant(lxm, (Ident.to_string id)))
+ raise (Unknown_constant(lxm, (Lv6Id.to_string id)))
-let find_pack_of_const (this: t) (id: Ident.t) lxm =
+let find_pack_of_const (this: t) (id: Lv6Id.t) lxm =
try fst (Hashtbl.find (this.st_consts) id)
with Not_found ->
- raise (Unknown_constant(lxm, (Ident.to_string id)))
+ raise (Unknown_constant(lxm, (Lv6Id.to_string id)))
-let find_node (this: t) (id: Ident.t) lxm =
+let find_node (this: t) (id: Lv6Id.t) lxm =
try Hashtbl.find (this.st_nodes) id
with Not_found ->
if Lxm.line lxm = 0 && Lxm.cend lxm = 0 then
(* A hack to print a nicer error msg when the node asked in the
command-line is not found in the input files*)
- raise (Global_error("Can not find node " ^ (Ident.to_string id)))
+ raise (Global_error("Can not find node " ^ (Lv6Id.to_string id)))
else
let all_nodes =
- Hashtbl.fold (fun n _ acc -> (Ident.to_string n)::acc) this.st_nodes []
+ Hashtbl.fold (fun n _ acc -> (Lv6Id.to_string n)::acc) this.st_nodes []
in
- let msg = "unknown node: " ^ (Ident.to_string id)^"\n" ^
+ let msg = "unknown node: " ^ (Lv6Id.to_string id)^"\n" ^
"*** known nodes are: " ^ (String.concat ", " all_nodes) ^ "\n"
in
raise (Compile_error(lxm, msg))
(* Manip de AstTabSymbol.t *)
-let add_import_const (this: t) (pn:Ident.pack_name) (id: Ident.t) (aid: Ident.long) =
+let add_import_const (this: t) (pn:Lv6Id.pack_name) (id: Lv6Id.t) (aid: Lv6Id.long) =
Hashtbl.replace (this.st_consts) id (pn, Imported (aid, []))
-let add_import_type (this: t) (id: Ident.t) (aid: Ident.long) =
- Hashtbl.replace (this.st_types) id (Ident.pack_of_long aid, Imported (aid, []))
+let add_import_type (this: t) (id: Lv6Id.t) (aid: Lv6Id.long) =
+ Hashtbl.replace (this.st_types) id (Lv6Id.pack_of_long aid, Imported (aid, []))
-let add_import_node (this: t) (id: Ident.t) (aid: Ident.long)
+let add_import_node (this: t) (id: Lv6Id.t) (aid: Lv6Id.long)
(params:static_param srcflagged list) =
Hashtbl.replace (this.st_nodes) id (Imported (aid, params))
-let add_const (this: t) (pn:Ident.pack_name) (n: Ident.t)
+let add_const (this: t) (pn:Lv6Id.pack_name) (n: Lv6Id.t)
(cix: (const_info srcflagged)) =
Hashtbl.replace this.st_consts n (pn, Local cix)
-let add_type (this: t) pn (n: Ident.t) (tix: type_info srcflagged) = (
+let add_type (this: t) pn (n: Lv6Id.t) (tix: type_info srcflagged) = (
Hashtbl.replace this.st_types n (pn, Local tix) ;
(* cas particulier des types enums *)
match tix.it with
EnumType (_, ecl) -> (
let tname = Lxm.str tix.src in
let treat_enum_const ec = (
- let te = Named_type_exp { Ident.id_pack = None; Ident.id_id = tname} in
+ let te = Named_type_exp { Lv6Id.id_pack = None; Lv6Id.id_id = tname} in
let tex = Lxm.flagit te tix.src in
let ci = EnumConst (ec.it, tex) in
add_const this pn ec.it (Lxm.flagit ci (ec.src));
@@ -102,7 +102,7 @@ let add_type (this: t) pn (n: Ident.t) (tix: type_info srcflagged) = (
| _ -> ()
)
-let add_node (this: t) (n: Ident.t) (oix: node_info srcflagged) =
+let add_node (this: t) (n: Lv6Id.t) (oix: node_info srcflagged) =
Hashtbl.add this.st_nodes n (Local oix)
diff --git a/src/astTabSymbol.mli b/src/astTabSymbol.mli
index e2efa42bd412182ed436b46186e5860b2392c7b0..4ff0c758c7e4cface42a3dc752e1a6206191d31f 100644
--- a/src/astTabSymbol.mli
+++ b/src/astTabSymbol.mli
@@ -1,4 +1,4 @@
-(* Time-stamp: <modified the 13/12/2012 (at 14:40) by Erwan Jahier> *)
+(* Time-stamp: <modified the 26/02/2015 (at 13:44) by Erwan Jahier> *)
(** Maps ident to entities (const, type et oper) in some particular contexts. *)
@@ -16,7 +16,7 @@ open Lxm
(** Symbol table elements. *)
type 'a elt =
| Local of 'a
- | Imported of Ident.long * static_param srcflagged list
+ | Imported of Lv6Id.long * static_param srcflagged list
type t
@@ -25,27 +25,27 @@ val create : unit -> t
(** Manip de AstTabSymbol.t *)
(** Raise a proper compil error message if not found *)
-val find_type : t -> Ident.t -> Lxm.t -> (type_info Lxm.srcflagged) elt
-val find_const : t -> Ident.t -> Lxm.t -> (const_info Lxm.srcflagged) elt
-val find_node : t -> Ident.t -> Lxm.t -> (node_info Lxm.srcflagged) elt
+val find_type : t -> Lv6Id.t -> Lxm.t -> (type_info Lxm.srcflagged) elt
+val find_const : t -> Lv6Id.t -> Lxm.t -> (const_info Lxm.srcflagged) elt
+val find_node : t -> Lv6Id.t -> Lxm.t -> (node_info Lxm.srcflagged) elt
-val find_pack_of_type : t -> Ident.t -> Lxm.t -> Ident.pack_name
-val find_pack_of_const : t -> Ident.t -> Lxm.t -> Ident.pack_name
+val find_pack_of_type : t -> Lv6Id.t -> Lxm.t -> Lv6Id.pack_name
+val find_pack_of_const : t -> Lv6Id.t -> Lxm.t -> Lv6Id.pack_name
(** Ajout de nom d'item importés (via uses) *)
-val add_import_const : t -> Ident.pack_name -> Ident.t -> Ident.long -> unit
-val add_import_type : t -> Ident.t -> Ident.long -> unit
-val add_import_node : t -> Ident.t -> Ident.long -> static_param srcflagged list -> unit
+val add_import_const : t -> Lv6Id.pack_name -> Lv6Id.t -> Lv6Id.long -> unit
+val add_import_type : t -> Lv6Id.t -> Lv6Id.long -> unit
+val add_import_node : t -> Lv6Id.t -> Lv6Id.long -> static_param srcflagged list -> unit
(** Add local items declaration *)
-val add_type : t -> Ident.pack_name -> Ident.t -> type_info Lxm.srcflagged -> unit
-val add_const : t -> Ident.pack_name -> Ident.t -> const_info Lxm.srcflagged -> unit
-val add_node : t -> Ident.t -> node_info Lxm.srcflagged -> unit
+val add_type : t -> Lv6Id.pack_name -> Lv6Id.t -> type_info Lxm.srcflagged -> unit
+val add_const : t -> Lv6Id.pack_name -> Lv6Id.t -> const_info Lxm.srcflagged -> unit
+val add_node : t -> Lv6Id.t -> node_info Lxm.srcflagged -> unit
(** Itérer sur les items *)
-val iter_types: t -> (Ident.t -> (type_info Lxm.srcflagged) elt -> unit) -> unit
-val iter_consts: t ->(Ident.t -> (const_info Lxm.srcflagged) elt -> unit) -> unit
-val iter_nodes : t ->(Ident.t -> (node_info Lxm.srcflagged) elt -> unit) -> unit
+val iter_types: t -> (Lv6Id.t -> (type_info Lxm.srcflagged) elt -> unit) -> unit
+val iter_consts: t ->(Lv6Id.t -> (const_info Lxm.srcflagged) elt -> unit) -> unit
+val iter_nodes : t ->(Lv6Id.t -> (node_info Lxm.srcflagged) elt -> unit) -> unit
diff --git a/src/astV6.ml b/src/astV6.ml
index cc9ae01dfba063fa4e1316fabb48d4bc2dbf9056..7daef727012539d40b30b28dd81da9ce4f7a34ef 100644
--- a/src/astV6.ml
+++ b/src/astV6.ml
@@ -1,4 +1,4 @@
-(* Time-stamp: <modified the 11/04/2013 (at 15:28) by Erwan Jahier> *)
+(* Time-stamp: <modified the 26/02/2015 (at 11:20) by Erwan Jahier> *)
(** (Raw) Abstract syntax tree of source Lustre V6 programs.
@@ -31,15 +31,15 @@ and
| NSModel of model_info srcflagged
and
model_info = {
- mo_name : Ident.pack_name ;
- mo_uses : Ident.pack_name srcflagged list ;
+ mo_name : Lv6Id.pack_name ;
+ mo_uses : Lv6Id.pack_name srcflagged list ;
mo_needs : static_param srcflagged list ;
(* N.B. CAS PARTICULIER DE item_info *)
mo_provides : item_info srcflagged list option;
mo_body : packbody ;
}
and pack_info = {
- pa_name : Ident.pack_name ;
+ pa_name : Lv6Id.pack_name ;
pa_def : pack_def ;
}
and
@@ -48,15 +48,15 @@ and
| PackInstance of pack_instance
and
pack_given = {
- pg_uses : Ident.pack_name srcflagged list ;
+ pg_uses : Lv6Id.pack_name srcflagged list ;
(* N.B. CAS PARTICULIER DE item_info *)
pg_provides : item_info srcflagged list option;
pg_body : packbody ;
}
and
pack_instance = {
- pi_model : Ident.t ;
- pi_args : (Ident.t * static_arg srcflagged) list ;
+ pi_model : Lv6Id.t ;
+ pi_args : (Lv6Id.t * static_arg srcflagged) list ;
}
(** Collection de noeuds, types const etc.
- une table pour chaque sorte de defs
@@ -65,9 +65,9 @@ and
*)
and
packbody = {
- pk_const_table : (Ident.t, const_info srcflagged ) Hashtbl.t ;
- pk_type_table : (Ident.t, type_info srcflagged ) Hashtbl.t ;
- pk_node_table : (Ident.t, node_info srcflagged ) Hashtbl.t ;
+ pk_const_table : (Lv6Id.t, const_info srcflagged ) Hashtbl.t ;
+ pk_type_table : (Lv6Id.t, type_info srcflagged ) Hashtbl.t ;
+ pk_node_table : (Lv6Id.t, node_info srcflagged ) Hashtbl.t ;
pk_def_list : item_ident list ;
}
@@ -130,5 +130,5 @@ let rec lexeme_of_left_part = function
(********************************************)
let (pack_or_model_to_string: pack_or_model -> string) =
function
- | NSPack pi -> Ident.pack_name_to_string pi.it.pa_name ^ " (pack) "
- | NSModel mi -> Ident.pack_name_to_string mi.it.mo_name ^ " (model) "
+ | NSPack pi -> Lv6Id.pack_name_to_string pi.it.pa_name ^ " (pack) "
+ | NSModel mi -> Lv6Id.pack_name_to_string mi.it.mo_name ^ " (model) "
diff --git a/src/astV6Dump.ml b/src/astV6Dump.ml
index d22c30d299860e67918e02f80039c5b93b7a9be8..c03363598a73db0cd180ba0c0ec853e4f7b1ffd3 100644
--- a/src/astV6Dump.ml
+++ b/src/astV6Dump.ml
@@ -1,4 +1,4 @@
-(* Time-stamp: <modified the 21/01/2015 (at 16:56) by Erwan Jahier> *)
+(* Time-stamp: <modified the 26/02/2015 (at 11:20) by Erwan Jahier> *)
open Lxm
@@ -24,7 +24,7 @@ let rec (op2string : AstCore.by_pos_op -> string) =
| (WHEN_n _ce) -> "when"
| (HAT_n ) -> "^"
| (CONCAT_n ) -> "|"
- | (IDENT_n idref) -> Ident.string_of_idref idref
+ | (IDENT_n idref) -> Lv6Id.string_of_idref idref
| (FBY_n ) -> "fby"
| (WITH_n(_,_,_)) -> "with"
| (TUPLE_n ) -> assert false
@@ -56,7 +56,7 @@ and packbody (os: Format.formatter) (pkg: AstV6.packbody) =
(match d with
ConstItem id
| TypeItem id
- | NodeItem (id,_) -> Ident.to_string id
+ | NodeItem (id,_) -> Lv6Id.to_string id
)
);
flush stdout;
@@ -118,11 +118,11 @@ and dump_type_def (os: Format.formatter) (info: type_info ) = (
(****************************)
(* dump d'une liste de noms *)
(****************************)
-and dump_id_list (os : formatter) (idlst : Ident.t srcflagged list) = (
+and dump_id_list (os : formatter) (idlst : Lv6Id.t srcflagged list) = (
match idlst with
[] -> ()
- | h::[] -> ( fprintf os "%s" (Ident.to_string h.it))
- | h::t -> ( fprintf os "%s, %a" (Ident.to_string h.it) dump_id_list t)
+ | h::[] -> ( fprintf os "%s" (Lv6Id.to_string h.it))
+ | h::t -> ( fprintf os "%s, %a" (Lv6Id.to_string h.it) dump_id_list t)
)
(*****************************)
(* dump d'une liste de field *)
@@ -136,27 +136,27 @@ and dump_field_list (os: Format.formatter) (filst: field_info list) = (
and dump_field (os: Format.formatter) (finfo: field_info) = (
match finfo with
{fd_name=id; fd_type=ty; fd_value=None} -> (
- fprintf os "%s : %a" (Ident.to_string id) dump_type_exp ty
+ fprintf os "%s : %a" (Lv6Id.to_string id) dump_type_exp ty
)
|
{fd_name=id; fd_type=ty; fd_value=Some ex} -> (
- fprintf os "%s : %a = %a" (Ident.to_string id)
+ fprintf os "%s : %a = %a" (Lv6Id.to_string id)
dump_type_exp ty dump_val_exp ex
)
)
and dump_param_list
(os: Format.formatter)
- (plst: (Ident.t option * type_exp) list) =
+ (plst: (Lv6Id.t option * type_exp) list) =
(
match plst with
[] -> ()
| h::[] -> ( fprintf os "%a" dump_param h )
| h::t -> ( fprintf os "%a; %a" dump_param h dump_param_list t)
)
-and dump_param (os: Format.formatter) (p: (Ident.t option * type_exp)) = (
+and dump_param (os: Format.formatter) (p: (Lv6Id.t option * type_exp)) = (
match p with
(None, ty) -> (fprintf os "%a" dump_type_exp ty)
- | (Some id, ty) -> (fprintf os "%s : %a" (Ident.to_string id) dump_type_exp ty)
+ | (Some id, ty) -> (fprintf os "%s : %a" (Lv6Id.to_string id) dump_type_exp ty)
)
(**************************)
(* dump d'une eq. de node *)
@@ -194,14 +194,14 @@ and dump_static_param
(sp: static_param srcflagged) =
(
match sp.it with
- | StaticParamType id -> fprintf os "type %s" (Ident.to_string id)
+ | StaticParamType id -> fprintf os "type %s" (Lv6Id.to_string id)
| StaticParamConst (id, exp) -> fprintf os "const %s : %a"
- (Ident.to_string id) dump_type_exp exp
+ (Lv6Id.to_string id) dump_type_exp exp
| StaticParamNode (id, ins, outs, has_mem,is_safe) -> (
fprintf os "%s%s %s(@,%a@,)returns(@,%a@,)"
(if is_safe then "" else "unsafe ")
(if has_mem then "node" else "function")
- (Ident.to_string id)
+ (Lv6Id.to_string id)
dump_line_var_decl_list ins dump_line_var_decl_list outs
)
)
@@ -212,7 +212,7 @@ and dump_node (os: Format.formatter) (x: node_info srcflagged) = (
let lxm = x.src and ninfo = x.it in
fprintf os "-- %s" (Lxm.details lxm) ;
fprintf os " (node definition)@\n" ;
- fprintf os "node %s" (Ident.to_string ninfo.name);
+ fprintf os "node %s" (Lv6Id.to_string ninfo.name);
fprintf os " <<@\n" ;
fprintf os "@[<b 3>@ %a@]@\n" dump_static_param_list ninfo.static_params;
fprintf os ">>\n";
@@ -224,7 +224,7 @@ and dump_node (os: Format.formatter) (x: node_info srcflagged) = (
loclist = loclist_opt;
vartable = vartab;
} ->
- let get_info (id: Ident.t) = (Hashtbl.find vartab id).it in
+ let get_info (id: Lv6Id.t) = (Hashtbl.find vartab id).it in
let inlst = List.map get_info inlist in
let outlst = List.map get_info outlist in
fprintf os "(@\n" ;
@@ -276,13 +276,13 @@ and dump_line_var_decl_list (os: Format.formatter) (lst: var_info srcflagged lis
| h::t -> ( fprintf os "%a;@,%a" dump_var_decl h.it dump_line_var_decl_list t )
)
and dump_var_decl (os: Format.formatter) (vinfo: var_info ) = (
- fprintf os "%s : %a" (Ident.to_string vinfo.var_name) dump_type_exp vinfo.var_type ;
+ fprintf os "%s : %a" (Lv6Id.to_string vinfo.var_name) dump_type_exp vinfo.var_type ;
(
match vinfo.var_clock with
Base -> ()
| NamedClock({it=cc,id;src=lxm}) ->
- let cc_str = Ident.long_to_string cc in
- let id_str = Ident.to_string id in
+ let cc_str = Lv6Id.long_to_string cc in
+ let id_str = Lv6Id.to_string id in
let clk_str =
if cc_str = "true" then id_str
else if cc_str = "false" then ("not " ^ id_str)
@@ -299,7 +299,7 @@ and dump_type_exp (os: Format.formatter) (x: type_exp) = (
Bool_type_exp -> fprintf os "bool"
| Int_type_exp -> fprintf os "int"
| Real_type_exp -> fprintf os "real"
- | Named_type_exp id -> fprintf os "%s" (Ident.string_of_idref id)
+ | Named_type_exp id -> fprintf os "%s" (Lv6Id.string_of_idref id)
| Array_type_exp (te, sz) -> (
dump_type_exp os te ;
fprintf os "^" ;
@@ -341,8 +341,8 @@ and dump_left_part_list (os: Format.formatter) (lfts: left_part list) =
and dump_left_part (os: Format.formatter) (lft: left_part) =
(
match lft with
- LeftVar idflg -> fprintf os "%s" (Ident.to_string idflg.it)
- | LeftField (l, idflg) -> fprintf os "%a.%s" dump_left_part l (Ident.to_string idflg.it)
+ LeftVar idflg -> fprintf os "%s" (Lv6Id.to_string idflg.it)
+ | LeftField (l, idflg) -> fprintf os "%a.%s" dump_left_part l (Lv6Id.to_string idflg.it)
| LeftArray (l, expflg) ->
fprintf os "%a[@,%a@,]" dump_left_part l dump_val_exp expflg.it
| LeftSlice (l, slcflg) ->
@@ -373,7 +373,7 @@ and dump_val_exp_list (os : formatter) (xl: val_exp list) = (
and dump_by_pos_exp (os: Format.formatter) (oper: by_pos_op) (pars: operands) =
(
match (oper, pars) with
- | (IDENT_n id,Oper []) -> dump_leaf_exp os (Ident.string_of_idref id)
+ | (IDENT_n id,Oper []) -> dump_leaf_exp os (Lv6Id.string_of_idref id)
| (PRE_n, Oper [p0]) -> dump_unary_exp os "pre" p0
| (CURRENT_n, Oper [p0]) -> dump_unary_exp os "current" p0
| (ARROW_n, Oper [p0;p1]) -> dump_binary_exp os "->" p0 p1
@@ -384,8 +384,8 @@ and dump_by_pos_exp (os: Format.formatter) (oper: by_pos_op) (pars: operands) =
match (x.it, pars) with
| (TRUE_n, Oper []) -> dump_leaf_exp os "true"
| (FALSE_n, Oper []) -> dump_leaf_exp os "false"
- | (ICONST_n s, Oper []) -> dump_leaf_exp os (Ident.to_string s)
- | (RCONST_n s, Oper []) -> dump_leaf_exp os (Ident.to_string s)
+ | (ICONST_n s, Oper []) -> dump_leaf_exp os (Lv6Id.to_string s)
+ | (RCONST_n s, Oper []) -> dump_leaf_exp os (Lv6Id.to_string s)
(* unaires *)
| (NOT_n, Oper [p0]) -> dump_unary_exp os "not" p0
| (UMINUS_n, Oper [p0]) -> dump_unary_exp os "-" p0
@@ -435,7 +435,7 @@ and dump_by_pos_exp (os: Format.formatter) (oper: by_pos_op) (pars: operands) =
| (ARRAY_SLICE_n sl, Oper [p0]) -> fprintf os "%a[@,%a@,]"
dump_val_exp p0 dump_slice_info sl
| (STRUCT_ACCESS_n fld, Oper [p0]) -> fprintf os "%a.%s"
- dump_val_exp p0 (Ident.to_string fld)
+ dump_val_exp p0 (Lv6Id.to_string fld)
| (FBY_n, _) -> assert false
@@ -494,13 +494,13 @@ and dump_nary_exp
)
and string_of_node_exp (id, sal) =
- (Ident.string_of_idref id) ^
+ (Lv6Id.string_of_idref id) ^
(if sal = [] then "" else
"<<" ^ (String.concat ", " (List.map static_arg_to_string sal)) ^ ">>")
and static_arg_to_string arg =
match arg.it with
- | StaticArgIdent id -> Ident.string_of_idref id
+ | StaticArgLv6Id id -> Lv6Id.string_of_idref id
| StaticArgConst ve -> "const xxx"
| StaticArgType te -> "type xxx"
| StaticArgNode op -> "node "^(op2string op)
@@ -523,14 +523,14 @@ and dump_static_sarg
(sa: static_arg)
=
match sa with
- | StaticArgIdent id -> fprintf os "%s" (Ident.string_of_idref id)
+ | StaticArgLv6Id id -> fprintf os "%s" (Lv6Id.string_of_idref id)
| StaticArgConst ve -> fprintf os "const %a" dump_val_exp ve
| StaticArgType te -> fprintf os "type %a" dump_type_exp te
| StaticArgNode op -> fprintf os "node %s" (op2string op)
and dump_static_arg_list
(os : Format.formatter)
- (lst: (Ident.t * static_arg srcflagged) list)
+ (lst: (Lv6Id.t * static_arg srcflagged) list)
= (
match lst with
| [] -> ()
@@ -540,11 +540,11 @@ and dump_static_arg_list
)
and dump_static_arg
(os : Format.formatter)
- ((id,sa): Ident.t * static_arg srcflagged)
+ ((id,sa): Lv6Id.t * static_arg srcflagged)
=
- fprintf os "%s = " (Ident.to_string id);
+ fprintf os "%s = " (Lv6Id.to_string id);
match sa.it with
- | StaticArgIdent id -> fprintf os "%s" (Ident.string_of_idref id)
+ | StaticArgLv6Id id -> fprintf os "%s" (Lv6Id.string_of_idref id)
| StaticArgConst ve -> fprintf os "const %a" dump_val_exp ve
| StaticArgType te -> fprintf os "type %a" dump_type_exp te
| StaticArgNode op -> fprintf os "node %s" (op2string op)
@@ -565,15 +565,15 @@ and dump_slice_info
and dump_by_name_exp
(os: Format.formatter)
(oper: by_name_op)
- (pars: (Ident.t srcflagged * val_exp) list) =
+ (pars: (Lv6Id.t srcflagged * val_exp) list) =
(
match (oper, pars) with
| (STRUCT_n id, pl) -> (
- fprintf os "%s{@,%a@,}" (Ident.string_of_idref id) dump_named_pars pl
+ fprintf os "%s{@,%a@,}" (Lv6Id.string_of_idref id) dump_named_pars pl
)
| (STRUCT_WITH_n (id1,id2), pl) -> (
- fprintf os "%s{ %s with @,%a@,}" (Ident.string_of_idref id1)
- (Ident.string_of_idref id2) dump_named_pars pl
+ fprintf os "%s{ %s with @,%a@,}" (Lv6Id.string_of_idref id1)
+ (Lv6Id.string_of_idref id2) dump_named_pars pl
)
| (STRUCT_anonymous_n, pl) -> (
fprintf os "{@,%a@,}" dump_named_pars pl
@@ -581,12 +581,12 @@ and dump_by_name_exp
)
and dump_named_pars
(os: Format.formatter)
- (pars: (Ident.t srcflagged * val_exp) list) =
+ (pars: (Lv6Id.t srcflagged * val_exp) list) =
( match pars with
[] -> ()
- |(v,e)::[] -> fprintf os "%s = %a" (Ident.to_string v.it) dump_val_exp e
+ |(v,e)::[] -> fprintf os "%s = %a" (Lv6Id.to_string v.it) dump_val_exp e
|(v,e)::l ->
- fprintf os "%s = %a;@,%a" (Ident.to_string v.it) dump_val_exp e
+ fprintf os "%s = %a;@,%a" (Lv6Id.to_string v.it) dump_val_exp e
dump_named_pars l
)
@@ -594,7 +594,7 @@ and dump_named_pars
let dump_packinstance (os: Format.formatter) (pi: AstV6.pack_instance) = (
Format.fprintf os "= %s(%a);@\n"
- (Ident.to_string pi.pi_model)
+ (Lv6Id.to_string pi.pi_model)
dump_static_arg_list pi.pi_args ;
)
@@ -616,7 +616,7 @@ let rec packinfo (os: Format.formatter) (pf: AstV6.pack_info srcflagged) = (
let (p, lxm) = (pf.it, pf.src) in
Format.fprintf os "@?@[<b 0>" ;
Format.fprintf os "-----------------------------\n";
- Format.fprintf os "-- PACKAGE DEF \"%s\"\n" (Ident.pack_name_to_string p.pa_name);
+ Format.fprintf os "-- PACKAGE DEF \"%s\"\n" (Lv6Id.pack_name_to_string p.pa_name);
Format.fprintf os "-----------------------------\n";
Format.fprintf os "-- %s\n" (Lxm.details lxm) ;
(
@@ -635,10 +635,10 @@ let modelinfo (os: Format.formatter) (mf: AstV6.model_info srcflagged) = (
let (m, lxm) = (mf.it, mf.src) in
Format.fprintf os "@?@[<b 0>" ;
Format.fprintf os "-----------------------------\n";
- Format.fprintf os "-- MODEL DEF \"%s\"\n" (Ident.pack_name_to_string m.mo_name);
+ Format.fprintf os "-- MODEL DEF \"%s\"\n" (Lv6Id.pack_name_to_string m.mo_name);
Format.fprintf os "-----------------------------\n";
Format.fprintf os "-- %s\n" (Lxm.details lxm) ;
- Format.fprintf os "model %s@\n" (Ident.pack_name_to_string m.mo_name);
+ Format.fprintf os "model %s@\n" (Lv6Id.pack_name_to_string m.mo_name);
( match (m.mo_needs) with
[] -> ()
diff --git a/src/astV6Dump.mli b/src/astV6Dump.mli
index ff082ef024067f76344785734dfb5ba51f8c8398..899073048e8759bcec692085a9eb1ef5b3af03a1 100644
--- a/src/astV6Dump.mli
+++ b/src/astV6Dump.mli
@@ -1,4 +1,4 @@
-(* Time-stamp: <modified the 12/12/2012 (at 17:07) by Erwan Jahier> *)
+(* Time-stamp: <modified the 26/02/2015 (at 13:45) by Erwan Jahier> *)
(** Pretty-printing the Syntax Tree *)
@@ -17,4 +17,4 @@ val print_node_exp : out_channel -> AstCore.node_exp -> unit
val dump_val_exp : Format.formatter -> AstCore.val_exp -> unit
val dump_type_exp : Format.formatter -> AstCore.type_exp -> unit
-val dump_static_arg : Format.formatter -> Ident.t * AstCore.static_arg Lxm.srcflagged -> unit
+val dump_static_arg : Format.formatter -> Lv6Id.t * AstCore.static_arg Lxm.srcflagged -> unit
diff --git a/src/compile.ml b/src/compile.ml
index 26a9a222e9f456fa4c30d92f95fe05d39fb9584a..62a9ffe95654764ae139464cb663440252baa933 100644
--- a/src/compile.ml
+++ b/src/compile.ml
@@ -1,4 +1,4 @@
-(* Time-stamp: <modified the 21/01/2015 (at 15:15) by Erwan Jahier> *)
+(* Time-stamp: <modified the 26/02/2015 (at 11:20) by Erwan Jahier> *)
open Lxm
open Lv6errors
@@ -11,7 +11,7 @@ let info msg =
let t = Sys.time() in
Verbose.exe ~level:1 (fun () -> Printf.eprintf "%4.4f: %s%!" t msg)
-let (doit : Lv6MainArgs.t -> AstV6.pack_or_model list -> Ident.idref option -> LicPrg.t) =
+let (doit : Lv6MainArgs.t -> AstV6.pack_or_model list -> Lv6Id.idref option -> LicPrg.t) =
fun opt srclist main_node ->
(* let t0 = Sys.time() in *)
info "Start compiling to lic...\n";
@@ -73,20 +73,20 @@ let (doit : Lv6MainArgs.t -> AstV6.pack_or_model list -> Ident.idref option -> L
in
let zelic =
if opt.Lv6MainArgs.expand_node_call <> [] || opt.Lv6MainArgs.expand_nodes then (
- let mn:Ident.idref =
+ let mn:Lv6Id.idref =
match main_node with
| None ->
(match LicPrg.choose_node zelic with
| None -> assert false
- | Some(nk,_) -> Ident.idref_of_long (fst nk)
+ | Some(nk,_) -> Lv6Id.idref_of_long (fst nk)
)
| Some mn -> mn
in
- let ids_to_expand = (List.map Ident.idref_of_string opt.Lv6MainArgs.expand_node_call) in
+ let ids_to_expand = (List.map Lv6Id.idref_of_string opt.Lv6MainArgs.expand_node_call) in
let long_match_idref (p,n) idref =
(* if no pack is specified, we match them all *)
- (Ident.name_of_idref idref = n)
- && (match Ident.pack_of_idref idref with None -> true | Some p2 -> p = p2)
+ (Lv6Id.name_of_idref idref = n)
+ && (match Lv6Id.pack_of_idref idref with None -> true | Some p2 -> p = p2)
in
let nodes_to_keep: Lic.node_key list =
LicPrg.fold_nodes
@@ -105,7 +105,7 @@ let (doit : Lv6MainArgs.t -> AstV6.pack_or_model list -> Ident.idref option -> L
in
assert (nodes_to_keep <> []);
info ("Expanding the following node calls: "
- ^(String.concat "," (List.map Ident.string_of_idref ids_to_expand))^"\n");
+ ^(String.concat "," (List.map Lv6Id.string_of_idref ids_to_expand))^"\n");
L2lExpandNodes.doit nodes_to_keep zelic
)
else
@@ -235,7 +235,7 @@ let (get_source_list : Lv6MainArgs.t -> string list -> AstV6.pack_or_model list)
(* Let's perform some clashes checks *)
if Hashtbl.mem tbl x then
let ybis = Hashtbl.find tbl x in
- print_string ("*** Error: "^(Ident.to_string x)^" is defined twice: \n\t" ^
+ print_string ("*** Error: "^(Lv6Id.to_string x)^" is defined twice: \n\t" ^
(Lxm.details y.src) ^ "\n\t" ^
(Lxm.details ybis.src) ^ ".\n");
exit 2
@@ -260,6 +260,6 @@ let (get_source_list : Lv6MainArgs.t -> string list -> AstV6.pack_or_model list)
with _ ->
print_string ("*** '"^first_file^"': bad file name.\n"); exit 1
in
- let pi = AstV6.give_pack_this_name (Ident.pack_name_of_string name) unpacked_merged in
+ let pi = AstV6.give_pack_this_name (Lv6Id.pack_name_of_string name) unpacked_merged in
let p = NSPack (Lxm.flagit pi (Lxm.dummy name)) in
p::packed_list
diff --git a/src/compile.mli b/src/compile.mli
index f12aab299255b62726664fe0f605faf67ba4bc8e..38e0bc305b3dace81d760997a2d687ff33f2987c 100644
--- a/src/compile.mli
+++ b/src/compile.mli
@@ -1,4 +1,4 @@
-(* Time-stamp: <modified the 12/04/2013 (at 08:50) by Erwan Jahier> *)
+(* Time-stamp: <modified the 26/02/2015 (at 13:45) by Erwan Jahier> *)
(** Main bis *)
@@ -6,7 +6,7 @@
main node. *)
-val doit : Lv6MainArgs.t -> AstV6.pack_or_model list -> Ident.idref option -> LicPrg.t
+val doit : Lv6MainArgs.t -> AstV6.pack_or_model list -> Lv6Id.idref option -> LicPrg.t
val get_source_list : Lv6MainArgs.t -> string list -> AstV6.pack_or_model list
diff --git a/src/evalClock.ml b/src/evalClock.ml
index 79c90ebbb0009a06a416ad720a707b420a7cc912..c916c47f80d5ace9bede4c27bda6e8e4b4de9067 100644
--- a/src/evalClock.ml
+++ b/src/evalClock.ml
@@ -1,4 +1,4 @@
-(* Time-stamp: <modified the 01/09/2014 (at 14:29) by Erwan Jahier> *)
+(* Time-stamp: <modified the 26/02/2015 (at 11:20) by Erwan Jahier> *)
open AstPredef
@@ -123,21 +123,21 @@ let rec (var_info_eff_of_left_eff: Lic.left -> Lic.var_info) =
| LeftVarLic (v, _) -> v
| LeftFieldLic (l, id,_) ->
let v = var_info_eff_of_left_eff l in
- let new_name = (Ident.to_string v.var_name_eff) ^ "." ^ (Ident.to_string id) in
- { v with var_name_eff = Ident.of_string new_name }
+ let new_name = (Lv6Id.to_string v.var_name_eff) ^ "." ^ (Lv6Id.to_string id) in
+ { v with var_name_eff = Lv6Id.of_string new_name }
| LeftArrayLic (l,i,_) ->
let v = var_info_eff_of_left_eff l in
- let new_name = (Ident.to_string v.var_name_eff) ^ "[" ^
+ let new_name = (Lv6Id.to_string v.var_name_eff) ^ "[" ^
(string_of_int i) ^ "]"
in
- { v with var_name_eff = Ident.of_string new_name }
+ { v with var_name_eff = Lv6Id.of_string new_name }
| LeftSliceLic (l,si,_) ->
let v = var_info_eff_of_left_eff l in
- let new_name = (Ident.to_string v.var_name_eff) ^ (LicDump.string_of_slice_info_eff si)
+ let new_name = (Lv6Id.to_string v.var_name_eff) ^ (LicDump.string_of_slice_info_eff si)
in
- { v with var_name_eff = Ident.of_string new_name }
+ { v with var_name_eff = Lv6Id.of_string new_name }
let var_info_eff_to_clock_eff v = v.var_clock_eff
@@ -428,7 +428,7 @@ and (eval_by_pos_clock : IdSolver.t -> Lic.by_pos_op -> Lxm.t -> Lic.val_exp lis
| Lic.CONST_REF idl,args ->
let _const = IdSolver.const_eff_of_item_key id_solver idl lxm in
let s, clk = UnifyClock.new_clock_var s in
- args,([Ident.of_long idl, clk], s)
+ args,([Lv6Id.of_long idl, clk], s)
| Lic.CALL nkf,args ->
let node_key = nkf.it in
let lxm = nkf.src in
@@ -513,8 +513,8 @@ and (eval_by_pos_clock : IdSolver.t -> Lic.by_pos_op -> Lxm.t -> Lic.val_exp lis
args, cl, s
and (eval_by_name_clock : IdSolver.t -> Lic.by_name_op -> Lxm.t ->
- (Ident.t Lxm.srcflagged * Lic.val_exp) list -> subst ->
- (Ident.t Lxm.srcflagged * Lic.val_exp) list * Lic.id_clock list * subst) =
+ (Lv6Id.t Lxm.srcflagged * Lic.val_exp) list -> subst ->
+ (Lv6Id.t Lxm.srcflagged * Lic.val_exp) list * Lic.id_clock list * subst) =
fun id_solver namop lxm namargs s ->
let apply_subst s (id,clk) = id, UnifyClock.apply_subst s clk in
let args = List.map (fun (id,ve) -> ve) namargs in
diff --git a/src/evalConst.ml b/src/evalConst.ml
index 6bb74c289b87cb2518ce12369046ade70d9d9e0d..7e6b08e1b63d5ed825ab66f0a43d4cf0ba2a529c 100644
--- a/src/evalConst.ml
+++ b/src/evalConst.ml
@@ -1,4 +1,4 @@
-(* Time-stamp: <modified the 11/04/2013 (at 15:57) by Erwan Jahier> *)
+(* Time-stamp: <modified the 26/02/2015 (at 11:21) by Erwan Jahier> *)
open Printf
@@ -93,12 +93,12 @@ let (make_array_const : Lic.const list list -> Lic.const) =
N.B. Par construction on sait que arg_tab n'a pas de doublons
*)
-let make_struct_const (teff : Lic.type_) (id_opt : Ident.idref option)
- (arg_tab : (Ident.t, Lxm.t * Lic.const) Hashtbl.t) =
+let make_struct_const (teff : Lic.type_) (id_opt : Lv6Id.idref option)
+ (arg_tab : (Lv6Id.t, Lxm.t * Lic.const) Hashtbl.t) =
(* on verifie qu'on a bien un type struct *)
(match teff with
Struct_type_eff (tnm, flst) -> (
- let make_eff_field ((fn: Ident.t),((ft:Lic.type_),(fv:Lic.const option))) =
+ let make_eff_field ((fn: Lv6Id.t),((ft:Lic.type_),(fv:Lic.const option))) =
(* on construit la liste dans le BON ordre *)
try
(* on prend en priorité dans arg_tab *)
@@ -110,7 +110,7 @@ let make_struct_const (teff : Lic.type_) (id_opt : Ident.idref option)
else raise (Compile_error(
lxm ,
sprintf "\n*** type error in struct %s, %s instead of %s"
- (Ident.string_of_long2 tnm)
+ (Lv6Id.string_of_long2 tnm)
(Lic.string_of_type vt)
(Lic.string_of_type ft) ))
with Not_found ->
@@ -123,16 +123,16 @@ let make_struct_const (teff : Lic.type_) (id_opt : Ident.idref option)
| None,None ->
raise (EvalConst_error(
sprintf "bad struct expression, no value given for field %s"
- (Ident.to_string fn)))
+ (Lv6Id.to_string fn)))
)
in
(* on mappe flst pour avoir la liste dans le bon ordre *)
let eff_fields = List.map make_eff_field flst in
(* si arg_tab n'est pas vide, erreur sur le premier *)
- let raise_error (id : Ident.t) ((lxm : Lxm.t), (veff : Lic.const))
+ let raise_error (id : Lv6Id.t) ((lxm : Lxm.t), (veff : Lic.const))
= raise(Compile_error(
lxm, sprintf "\n*** %s is not a field of struct %s"
- (Ident.to_string id)
+ (Lv6Id.to_string id)
(Lic.string_of_type(teff))))
in
Hashtbl.iter raise_error arg_tab; (* ok : tout s'est bien passé ! *)
@@ -305,7 +305,7 @@ let rec f
with Not_found ->
raise (EvalConst_error
(Printf.sprintf "%s is not a field of struct %s"
- (Ident.to_string fid)
+ (Lv6Id.to_string fid)
(Lic.string_of_type(typ))))
)
| [x] -> type_error_const [x] "struct type"
@@ -334,15 +334,15 @@ let rec f
and eval_by_name_const
(namop : by_name_op) (* l'operateur *)
(lxm : Lxm.t) (* source de l'opérateur *)
- (namargs : (Ident.t srcflagged * val_exp) list) (* arguments *)
+ (namargs : (Lv6Id.t srcflagged * val_exp) list) (* arguments *)
= (
let arg_tab = Hashtbl.create 50 in
- let treat_one_arg opid ((pid:Ident.t srcflagged), (pexp:val_exp)) =
+ let treat_one_arg opid ((pid:Lv6Id.t srcflagged), (pexp:val_exp)) =
if Hashtbl.mem arg_tab pid.it
then
raise(EvalConst_error(
sprintf "multiple definition of param %s in %s call"
- (Ident.to_string pid.it) (Ident.string_of_idref opid)))
+ (Lv6Id.to_string pid.it) (Lv6Id.string_of_idref opid)))
else
let v = rec_eval_const pexp in
match v with
@@ -350,7 +350,7 @@ let rec f
| _ ->
raise(EvalConst_error(
sprintf "unexpected tuple value for param %s in %s call"
- (Ident.to_string pid.it) (Ident.string_of_idref opid)))
+ (Lv6Id.to_string pid.it) (Lv6Id.string_of_idref opid)))
in
match namop with
| STRUCT_anonymous_n -> finish_me "anonymous struct"; assert false
@@ -427,10 +427,10 @@ and eval_array_index
| [Int_const_eff i]
| [Abstract_const_eff(_,_, (Int_const_eff i), true)] -> int_of_string i
| [Abstract_const_eff(id,_,_,false)] ->
- raise(EvalArray_error("The const " ^ (Ident.string_of_long2 id) ^
+ raise(EvalArray_error("The const " ^ (Lv6Id.string_of_long2 id) ^
" is abstract"))
| [Extern_const_eff(id,_)] ->
- raise(EvalArray_error("The const " ^ (Ident.string_of_long2 id) ^
+ raise(EvalArray_error("The const " ^ (Lv6Id.string_of_long2 id) ^
" is extern"))
| [x] -> raise(EvalArray_error(sprintf
"bad array index, int expected but get %s"
diff --git a/src/evalConst.mli b/src/evalConst.mli
index 470e361e0c36ad550341e2858d1492c752b05033..9e23817aa966d261a29465b38e2c21140152fc27 100644
--- a/src/evalConst.mli
+++ b/src/evalConst.mli
@@ -1,4 +1,4 @@
-(* Time-stamp: <modified the 12/02/2013 (at 18:07) by Erwan Jahier> *)
+(* Time-stamp: <modified the 26/02/2015 (at 13:46) by Erwan Jahier> *)
(** Static evaluation of constants. *)
@@ -13,8 +13,8 @@ PARAMETRES :
(voir Lic.
type IdSolver.t = {
- id2const : Ident.idref -> Lxm.t -> const_eff
- id2type : Ident.idref -> Lxm.t -> const_eff
+ id2const : Lv6Id.idref -> Lxm.t -> const_eff
+ id2type : Lv6Id.idref -> Lxm.t -> const_eff
}
(N.B. on passe le lexeme pour déventuels messages d'erreurs)
diff --git a/src/evalType.ml b/src/evalType.ml
index f5f611ba61692bb27feaa6aa5718c8f0e78e1b3e..f4a162ff0374cfe80eaeb3bf412d0989f9b813f3 100644
--- a/src/evalType.ml
+++ b/src/evalType.ml
@@ -1,4 +1,4 @@
-(** Time-stamp: <modified the 14/08/2014 (at 10:42) by Erwan Jahier> *)
+(** Time-stamp: <modified the 26/02/2015 (at 11:21) by Erwan Jahier> *)
open AstPredef
@@ -153,7 +153,7 @@ and eval_by_pos_type
raise (
EvalType_error
(Printf.sprintf "%s is not a field of struct %s"
- (Ident.to_string fid)
+ (Lv6Id.to_string fid)
(Lic.string_of_type (List.hd targ))))
)
| [x] -> raise_type_error [x] [] "some struct type was expected"
@@ -273,9 +273,9 @@ and eval_by_pos_type
Juste pour les structures ...
*)
and eval_by_name_type (id_solver: IdSolver.t) (namop: Lic.by_name_op) (lxm: Lxm.t)
- (namargs: (Ident.t Lxm.srcflagged * Lic.val_exp) list )
+ (namargs: (Lv6Id.t Lxm.srcflagged * Lic.val_exp) list )
(* renvoie la liste de modif de champs compilée + le type du résultat *)
- : (Ident.t Lxm.srcflagged * Lic.val_exp) list * Lic.type_ list
+ : (Lv6Id.t Lxm.srcflagged * Lic.val_exp) list * Lic.type_ list
=
match namop with
| Lic.STRUCT_anonymous ->
@@ -292,7 +292,7 @@ and eval_by_name_type (id_solver: IdSolver.t) (namop: Lic.by_name_op) (lxm: Lxm
| Lic.STRUCT (opid)
| Lic.STRUCT_with (opid,_) ->
- let struct_type = id_solver.id2type (Ident.idref_of_long opid) lxm in
+ let struct_type = id_solver.id2type (Lv6Id.idref_of_long opid) lxm in
match struct_type with
| Struct_type_eff(sn, fl) ->
let do_field_assign (fn, fv) =
@@ -300,7 +300,7 @@ and eval_by_name_type (id_solver: IdSolver.t) (namop: Lic.by_name_op) (lxm: Lxm
let (ft,fopt) =
try List.assoc fn.it fl
with Not_found ->
- let msg = "type error: bad field"^(Ident.to_string fn.it) in
+ let msg = "type error: bad field"^(Lv6Id.to_string fn.it) in
raise (Compile_error(lxm, msg))
in
(* let's check the type of fv *)
@@ -332,12 +332,12 @@ and eval_by_name_type (id_solver: IdSolver.t) (namop: Lic.by_name_op) (lxm: Lxm
with Not_found ->
let msg = Printf.sprintf
"Error: the field '%s' of structure '%s' is undefined"
- (id) (Ident.string_of_long opid)
+ (id) (Lv6Id.string_of_long opid)
in
raise (Compile_error(lxm, msg))
)
| Lic.STRUCT_with(_,id_with),[] ->
- let (type_of_struct_field : Ident.t -> Lic.type_ -> Lic.type_) =
+ let (type_of_struct_field : Lv6Id.t -> Lic.type_ -> Lic.type_) =
fun id t ->
match t with
| Struct_type_eff(l,fl) ->
@@ -348,8 +348,8 @@ and eval_by_name_type (id_solver: IdSolver.t) (namop: Lic.by_name_op) (lxm: Lxm
assert false)
| _ -> assert false
in
- let (get_field_of_id : Ident.t -> Ident.t -> Lxm.t ->
- Ident.t Lxm.srcflagged * Lic.val_exp) =
+ let (get_field_of_id : Lv6Id.t -> Lv6Id.t -> Lxm.t ->
+ Lv6Id.t Lxm.srcflagged * Lic.val_exp) =
fun id_with id lxm ->
let vi = id_solver.id2var id_with lxm in
let dft_ve =
diff --git a/src/idSolver.ml b/src/idSolver.ml
index d3abc6a2a3eb0e41eea12758771e9e0b4ff8e033..18d4898925a7d6ced03bd71f793f5d2811c9903d 100644
--- a/src/idSolver.ml
+++ b/src/idSolver.ml
@@ -1,24 +1,24 @@
-(* Time-stamp: <modified the 13/02/2013 (at 08:51) by Erwan Jahier> *)
+(* Time-stamp: <modified the 26/02/2015 (at 11:21) by Erwan Jahier> *)
(** Utilities for managing node environements (items tables) *)
type t = {
- id2const : Ident.idref -> Lxm.t -> Lic.const;
- id2type : Ident.idref -> Lxm.t -> Lic.type_;
- id2node : Ident.idref -> Lic.static_arg list -> Lxm.t -> Lic.node_exp;
+ id2const : Lv6Id.idref -> Lxm.t -> Lic.const;
+ id2type : Lv6Id.idref -> Lxm.t -> Lic.type_;
+ id2node : Lv6Id.idref -> Lic.static_arg list -> Lxm.t -> Lic.node_exp;
- id2var : Ident.t -> Lxm.t -> Lic.var_info;
+ id2var : Lv6Id.t -> Lxm.t -> Lic.var_info;
global_symbols : AstTabSymbol.t;
}
type local_env = {
lenv_node_key : Lic.node_key ;
(* lenv_globals : pack_env ; *)
- lenv_types : (Ident.t, Lic.type_) Hashtbl.t ;
- lenv_const : (Ident.t, Lic.const) Hashtbl.t ;
- lenv_nodes : (Ident.t, Lic.node_key) Hashtbl.t ;
- lenv_vars : (Ident.t, Lic.var_info) Hashtbl.t ;
+ lenv_types : (Lv6Id.t, Lic.type_) Hashtbl.t ;
+ lenv_const : (Lv6Id.t, Lic.const) Hashtbl.t ;
+ lenv_nodes : (Lv6Id.t, Lic.node_key) Hashtbl.t ;
+ lenv_vars : (Lv6Id.t, Lic.var_info) Hashtbl.t ;
}
@@ -60,19 +60,19 @@ type node_env = {
global: t;
}
-let (lookup_type: local_env -> Ident.idref -> Lxm.t -> Lic.type_) =
+let (lookup_type: local_env -> Lv6Id.idref -> Lxm.t -> Lic.type_) =
fun env id lxm ->
- Hashtbl.find env.lenv_types (Ident.of_idref id)
+ Hashtbl.find env.lenv_types (Lv6Id.of_idref id)
-let (lookup_node : local_env -> Ident.idref -> Lxm.t -> Lic.node_key) =
+let (lookup_node : local_env -> Lv6Id.idref -> Lxm.t -> Lic.node_key) =
fun env id lxm ->
- Hashtbl.find env.lenv_nodes (Ident.of_idref id)
+ Hashtbl.find env.lenv_nodes (Lv6Id.of_idref id)
-let (lookup_const: local_env -> Ident.idref -> Lxm.t -> Lic.const) =
+let (lookup_const: local_env -> Lv6Id.idref -> Lxm.t -> Lic.const) =
fun env id lmx ->
- Hashtbl.find env.lenv_const (Ident.of_idref id)
+ Hashtbl.find env.lenv_const (Lv6Id.of_idref id)
-let (lookup_var: local_env -> Ident.t -> Lxm.t -> Lic.var_info) =
+let (lookup_var: local_env -> Lv6Id.t -> Lxm.t -> Lic.var_info) =
fun env id lmx ->
Hashtbl.find env.lenv_vars id
@@ -82,17 +82,17 @@ let node_exp_of_node_key
(id_solver: t) (node_key: Lic.node_key) (lxm : Lxm.t)
: Lic.node_exp =
let (id, sargs) = node_key in
- id_solver.id2node (Ident.idref_of_long id) sargs lxm
+ id_solver.id2node (Lv6Id.idref_of_long id) sargs lxm
let var_info_of_ident
- (id_solver: t) (id: Ident.t) (lxm : Lxm.t)
+ (id_solver: t) (id: Lv6Id.t) (lxm : Lxm.t)
: Lic.var_info =
id_solver.id2var id lxm
let const_eff_of_item_key
(id_solver: t) (id: Lic.item_key) (lxm : Lxm.t)
: Lic.const =
- id_solver.id2const (Ident.idref_of_long id) lxm
+ id_solver.id2const (Lv6Id.idref_of_long id) lxm
diff --git a/src/ident.ml b/src/ident.ml
deleted file mode 100644
index 26c192c6750529391d781ccd6739590edc6cd9cf..0000000000000000000000000000000000000000
--- a/src/ident.ml
+++ /dev/null
@@ -1,195 +0,0 @@
-(* Time-stamp: <modified the 26/05/2014 (at 10:44) by Erwan Jahier> *)
-
-(* J'ai appele ca symbol (mais ca remplace le ident) :
-c'est juste une couche qui garantit l'unicite en memoire
-des strings ...
-C'est tout petit, non ???
-
-(* debut symbol.mli *)
-type t
-val to_string : t -> string
-val of_string : string -> t
-
-(* fin symbol.mli *)
-
-------------------
-
-(* debut symbol.ml *)
-type t = string
-
-module WeakStringTab = struct
- include Weak.Make(
- struct
- type t = string
- let equal = (=)
- let hash = Hashtbl.hash
- end
- )
-end
-
-let zetab = WeakStringTab.create 100
-let (to_string : t -> string) =
- fun x -> x
-
-let (of_string : string -> t) =
- fun x -> (
- WeakStringTab.merge zetab x
- )
-(* fin symbol.ml *)
-
- *)
-
-(*cf ~/dd/ocaml-3.10.0/typing/ident.ml *)
-
-type t = string
-type pack_name = t
-type long = pack_name * t
-
-let (pack_of_long : long -> pack_name) =
- fun l -> fst l
-
-let (of_long : long -> t) =
- fun l -> snd l
-
-let (to_string : t -> string) =
- fun x -> x
-
-let (of_string : string -> t) =
- fun x -> x
-
-let (pack_name_of_string : string -> pack_name) =
- fun x -> x
-
-let (pack_name_to_string : pack_name -> string) =
- fun x -> x
-
-let (string_of_long : long -> string) =
- fun (pn, id) ->
- let sep =
- if Lv6MainArgs.global_opt.Lv6MainArgs.ec || Lv6MainArgs.global_opt.Lv6MainArgs.lv4
- then "__" else "::"
- in
- match pn with
- | "" -> id
- | _ ->
-(* if Lv6MainArgs.global_opt.Lv6MainArgs.no_prefix then id else *)
- Printf.sprintf "%s%s%s" pn sep id
-
-let (string_of_long2 : long -> string) =
- function
- | "Lustre","true" -> "true"
- | "Lustre","false" -> "false"
- | (pn, id) -> pn ^"::"^ id
-
-let (no_pack_string_of_long : long -> string) =
- fun (pn, id) ->
- id
-
-let (long_to_string : long -> string) =
- string_of_long2
-
-let (make_long : pack_name -> t -> long) =
- fun pn id -> (pn,id)
-
-let dft_pack_name = ref "DftPack" (* this dft value ougth to be reset before being used *)
-
-let (set_dft_pack_name : pack_name -> unit) =
- fun pn ->
-(* print_string ("Change the dft pack name to "^ pn^"\n");flush stdout; *)
- dft_pack_name := pn
-
-
-
-(* -> syntaxeTree.ml ? *)
-
-type idref =
- {
- id_pack : pack_name option;
- id_id : t
- }
-
-let (pack_of_idref : idref -> pack_name option) =
- fun ir -> ir.id_pack
-
-let (name_of_idref : idref -> t) =
- fun ir -> ir.id_id
-
-
-(* utilitaires idref *)
-let idref_of_string s = (
- match (Str.split (Str.regexp "::") s) with
- [i] -> { id_pack = None; id_id = i}
- | [p;i]-> { id_pack = Some p; id_id = i}
- | _ -> raise (Failure ("idref_of_string: \""^s^"\" not a proper ident"))
-)
-
-let out_of_pack s = ("", s)
-
-let (long_of_string : string -> long) =
- fun s ->
- match (Str.split (Str.regexp "::") s) with
- [i] -> !dft_pack_name, i
- | [p;i]-> p, i
- | _ -> raise (Failure ("idref_of_string: \""^s^"\" not a proper ident"))
-
-let string_of_idref i = (
- match i.id_pack with
- Some p ->
- if Lv6MainArgs.global_opt.Lv6MainArgs.no_prefix then i.id_id else
- if Lv6MainArgs.global_opt.Lv6MainArgs.ec then p^"__"^i.id_id else
- if Lv6MainArgs.global_opt.Lv6MainArgs.lv4 then (p^"__"^i.id_id) else
- (p^"::"^i.id_id)
- | None -> i.id_id
-)
-let string_of_idref_bis i = (
- match i.id_pack with
- Some p -> (p^"::"^i.id_id)
- | None -> i.id_id
-)
-let raw_string_of_idref i = (
- let p = match i.id_pack with
- | Some p -> "Some \""^p^"\""
- | None -> "None"
- in
- Printf.sprintf "(%s, \"%s\")" p i.id_id
-)
-
-
-let (wrap_idref : idref -> string -> string -> idref) =
- fun { id_pack = p ; id_id = id } pref suff ->
- { id_pack = p ; id_id = of_string (pref ^ (to_string id)^suff) }
-
-let (of_idref : idref -> t) =
- fun idref ->
- of_string (string_of_idref idref)
-
-let (to_idref : t -> idref) =
- fun id -> idref_of_string (to_string id)
-
-let (long_of_idref : idref -> long) =
- fun idr ->
- match pack_of_idref idr with
- Some p -> (p, name_of_idref idr)
- | None -> (!dft_pack_name, name_of_idref idr)
-
-let (idref_of_long : long -> idref) =
- fun (pn,id) ->
- { id_pack = Some pn ; id_id = id }
-
-let (idref_of_id : t -> idref) =
- fun id ->
- { id_pack = None ; id_id = id }
-
-let (make_idref : pack_name -> t -> idref) =
- fun pn id ->
- { id_pack = Some pn ; id_id = id }
-
-
-
-type clk = long * t
-
-let (string_of_clk : clk -> string) =
- fun (cc,cv) ->
- (string_of_long cc) ^ "(" ^ (to_string cv) ^ ")"
-
-(*************************************************************************)
diff --git a/src/ident.mli b/src/ident.mli
deleted file mode 100644
index d1f079e7d58b225798ced61cb88b966295b04006..0000000000000000000000000000000000000000
--- a/src/ident.mli
+++ /dev/null
@@ -1,72 +0,0 @@
-(* Time-stamp: <modified the 24/04/2013 (at 17:24) by Erwan Jahier> *)
-
-(** *)
-
-type t = string
-type long = t * t
-type pack_name = t
-
-val to_string : t -> string
-val of_string : string -> t
-
-val of_long : long -> t
-val pack_name_of_string : string -> pack_name
-val pack_name_to_string : pack_name -> string
-val pack_of_long : long -> pack_name
-
-val string_of_long : long -> string
-val string_of_long2 : long -> string
-(** To ignore pack name (meaningful when generating ec code for exemple *)
-val no_pack_string_of_long : long -> string
-val long_to_string : long -> string
-val long_of_string : string -> long
-
-val make_long : pack_name -> t -> long
-
-(** lift simple string to long WITH EMPTY PACK *)
-val out_of_pack : string -> long
-
-val set_dft_pack_name : pack_name -> unit
-
-(* TODO: a renommer et a abstraire ??
- a mettre dans syntaxe.ml ???
-
- During parsing, we don't know yet what default name we should
- give to the package. Once we know it, we manipulate Ident.t rather than idref
-
- idref is used to denote user ident, that migth be prefixed
- by the module name or not. One of the first stage of the compiling
- will consist in transforming those idref (should be called user_id?)
- into Ident.long
-
-*)
-type idref =
- {
- id_pack : string option;
- id_id : string
- }
-
-val idref_of_string : string -> idref
-val make_idref : pack_name -> t -> idref
-
-
-val string_of_idref : idref -> string
-val string_of_idref_bis : idref -> string
-val raw_string_of_idref : idref -> string
-val of_idref : idref -> t
-val to_idref : t -> idref
-
-val name_of_idref : idref -> t
-val pack_of_idref : idref -> pack_name option
-
-(** [long_of_idref default_pack_name id_ref] builds a long ident from a
- AstV6.idref *)
-val long_of_idref : idref -> long
-
-val idref_of_long : long -> idref
-val idref_of_id : t -> idref
-
-type clk = long * t
-val string_of_clk : clk -> string
-
-val wrap_idref : idref -> string -> string -> idref
diff --git a/src/l2lCheckLoops.ml b/src/l2lCheckLoops.ml
index 9dbbfc1fc400d4a098bfc4e608cdade9c79df90c..7a3070d733698d71bee1b374dc634cb074ab1379 100644
--- a/src/l2lCheckLoops.ml
+++ b/src/l2lCheckLoops.ml
@@ -1,12 +1,12 @@
-(* Time-stamp: <modified the 21/01/2015 (at 14:37) by Erwan Jahier> *)
+(* Time-stamp: <modified the 26/02/2015 (at 13:50) by Erwan Jahier> *)
open Lxm
open Lv6errors
open Lic
open Misc
-module IdMap = Map.Make(struct type t = Ident.t let compare = compare end)
-module IdSet = Set.Make(struct type t = Ident.t let compare = compare end)
+module IdMap = Map.Make(struct type t = Lv6Id.t let compare = compare end)
+module IdSet = Set.Make(struct type t = Lv6Id.t let compare = compare end)
(* Associate to an ident the set of idents it depends on *)
type dependencies = (Lxm.t * IdSet.t) IdMap.t
@@ -49,7 +49,7 @@ exception Error of (Lxm.t * string * LicPrg.t)
type visit_status = Todo | Doing | Done
type visit_info = visit_status IdMap.t
-let (status : Ident.t -> visit_info -> visit_status) = IdMap.find
+let (status : Lv6Id.t -> visit_info -> visit_status) = IdMap.find
(* At init, all the idents are 'Todo' *)
let (visit_init: dependencies -> visit_info) =
@@ -57,7 +57,7 @@ let (visit_init: dependencies -> visit_info) =
let f id _ acc = IdMap.add id Todo acc in
IdMap.fold f deps IdMap.empty
-let rec (visit : dependencies -> visit_info -> Ident.t -> Ident.t list -> visit_info) =
+let rec (visit : dependencies -> visit_info -> Lv6Id.t -> Lv6Id.t list -> visit_info) =
fun deps vi id path ->
assert (IdMap.mem id deps);
let path = id::path in
diff --git a/src/l2lCheckOutputs.ml b/src/l2lCheckOutputs.ml
index 339e93a97054be30c9861e5f6581f7f9260a2026..e5a85c8474ab4b89d52d38668baa101550152601 100644
--- a/src/l2lCheckOutputs.ml
+++ b/src/l2lCheckOutputs.ml
@@ -1,4 +1,4 @@
-(* Time-stamp: <modified the 11/04/2013 (at 15:30) by Erwan Jahier> *)
+(* Time-stamp: <modified the 26/02/2015 (at 11:26) by Erwan Jahier> *)
open Lxm
open Lv6errors
@@ -10,10 +10,10 @@ open Misc
type var_def_state =
| VDS_def (* completly defined *)
| VDS_undef (* completly undefined *)
- | VDS_struct of (Ident.t * var_def_state) list
+ | VDS_struct of (Lv6Id.t * var_def_state) list
| VDS_array of var_def_state array
-let id2str = Ident.to_string
+let id2str = Lv6Id.to_string
let int2str = string_of_int
(* Returns the list of undefined variables *)
diff --git a/src/l2lExpandArrays.ml b/src/l2lExpandArrays.ml
index 72563543f199a37b0e7abcf514511f59d52851f7..1702de02800f4ca7f7c6be3379feff00d3519d87 100644
--- a/src/l2lExpandArrays.ml
+++ b/src/l2lExpandArrays.ml
@@ -1,4 +1,4 @@
-(** Time-stamp: <modified the 14/01/2015 (at 14:53) by Erwan Jahier> *)
+(** Time-stamp: <modified the 26/02/2015 (at 11:21) by Erwan Jahier> *)
(* Replace structures and arrays by as many variables as necessary.
Since structures can be nested, it migth be a lot of new variables...
@@ -47,7 +47,7 @@ type local_ctx = {
XXX code dupl. with Split.new_var
*)
let new_var str lctx type_eff clock_eff =
- let id = Ident.of_string (LicName.new_local_var str) in
+ let id = Lv6Id.of_string (LicName.new_local_var str) in
(* let id = lctx.idgen str in (* XXX use which one ??? *) *)
let var =
{
@@ -71,9 +71,9 @@ exception Polymorphic
(* returns a new var based on [vi] with type [type_eff]. *)
let clone_var node_env vi str type_eff =
- let str = (Ident.to_string vi.var_name_eff) ^ str in
- let id = Ident.of_string (str) in
- let clk_id = Ident.of_string str in
+ let str = (Lv6Id.to_string vi.var_name_eff) ^ str in
+ let id = Lv6Id.of_string (str) in
+ let clk_id = Lv6Id.of_string str in
let type_eff = match type_eff with
TypeVar Any | TypeVar AnyNum -> raise Polymorphic
| _ -> type_eff
@@ -141,7 +141,7 @@ let (index_list_of_slice_info : Lic.slice_info -> int list) =
(* var_trees are used to represent left var_tree, and val_exp var_tree *)
type 'a var_tree =
A of 'a var_tree list (* should i use an array there? *)
- | S of (Ident.t * 'a var_tree) list (* A Map.t ? *)
+ | S of (Lv6Id.t * 'a var_tree) list (* A Map.t ? *)
| L of 'a
(* Quite similar to L2lCheckOutputs.var_def_state, which is logic. *)
@@ -176,7 +176,7 @@ let rec (gen_var_trees :
| Struct_type_eff(_, fl) ->
S (List.map
(fun (fn, (steff, _const_opt)) ->
- let prefix = prefix^"_"^(Ident.to_string fn) in
+ let prefix = prefix^"_"^(Lv6Id.to_string fn) in
(fn, loop prefix steff )
)
fl)
@@ -257,7 +257,7 @@ and (var_trees_of_val_exp :
local_ctx -> acc -> Lic.val_exp -> acc * Lic.val_exp var_tree) =
fun lctx acc ve ->
let make_val_exp lxm vi prefix teff =
- let prefix = (Ident.to_string vi.var_name_eff) ^ prefix in
+ let prefix = (Lv6Id.to_string vi.var_name_eff) ^ prefix in
let id = prefix in
{
ve_core = CallByPosLic({src=lxm;it=(VAR_REF id)}, []);
@@ -322,7 +322,7 @@ and (var_trees_of_val_exp :
do_const acc lctx lxm const
with _ ->
let msg =
- "\n*** during Array expansion: '"^ (Ident.string_of_long2 idl)^
+ "\n*** during Array expansion: '"^ (Lv6Id.string_of_long2 idl)^
"': Unknown constant.\n*** Current constants are: "^
(LicPrg.fold_consts
(fun k c acc -> acc^(Printf.sprintf "\n\t%s" (Lic.string_of_const c)))
@@ -574,7 +574,7 @@ and (expand_var_info: local_ctx -> var_info list * acc ->
| Struct_type_eff (name, fl) ->
List.fold_left
(fun (vil,acc) (fn, (ft,_const_opt)) ->
- let new_var = clone_var lctx vi ("_" ^ Ident.to_string fn) ft in
+ let new_var = clone_var lctx vi ("_" ^ Lv6Id.to_string fn) ft in
let new_vil, new_acc = expand_var_info lctx (vil,acc) new_var in
new_vil, new_acc
)
diff --git a/src/l2lExpandMetaOp.ml b/src/l2lExpandMetaOp.ml
index f7fff5aa94e92a0827b2c1ffd91c38b10df6e886..d0ab95a201e25858371230f7d54e9e8ee2b9d096 100644
--- a/src/l2lExpandMetaOp.ml
+++ b/src/l2lExpandMetaOp.ml
@@ -1,4 +1,4 @@
-(** Time-stamp: <modified the 02/09/2014 (at 10:32) by Erwan Jahier> *)
+(** Time-stamp: <modified the 26/02/2015 (at 11:21) by Erwan Jahier> *)
open Lxm
open Lic
@@ -15,7 +15,7 @@ type local_ctx = {
(********************************************************************************)
(* stuff to create fresh var names. *)
let new_var str lctx type_eff clock_eff =
- let id = Ident.of_string (LicName.new_local_var str) in
+ let id = Lv6Id.of_string (LicName.new_local_var str) in
let var =
{
var_name_eff = id;
@@ -129,7 +129,7 @@ let (node_to_val_exp : Lic.node_key -> Lic.type_ list -> Lic.clock list ->
ve_typ = tl;
ve_core = core
}
-let (binop_to_val_exp : Ident.t -> val_exp -> val_exp -> val_exp) =
+let (binop_to_val_exp : Lv6Id.t -> val_exp -> val_exp -> val_exp) =
fun op ve1 ve2 ->
let op = { it = PREDEF_CALL({src=lxm;it=("Lustre",op),[]}) ; src = lxm } in
{
@@ -137,7 +137,7 @@ let (binop_to_val_exp : Ident.t -> val_exp -> val_exp -> val_exp) =
ve_typ = ve1.ve_typ;
ve_core = CallByPosLic(op, [ve1; ve2])
}
-let (binop_to_val_exp_bool : Ident.t -> val_exp -> val_exp -> val_exp) =
+let (binop_to_val_exp_bool : Lv6Id.t -> val_exp -> val_exp -> val_exp) =
fun op ve1 ve2 ->
let op = { it = PREDEF_CALL({src=lxm;it=("Lustre",op),[]}) ; src = lxm } in
{
diff --git a/src/l2lExpandNodes.ml b/src/l2lExpandNodes.ml
index 1e776f400ba06c590201989b54eeb39da6ec0746..32641037f42db80dedbcbf274545cc2c1b7ae8f9 100644
--- a/src/l2lExpandNodes.ml
+++ b/src/l2lExpandNodes.ml
@@ -1,4 +1,4 @@
-(* Time-stamp: <modified the 16/01/2015 (at 10:18) by Erwan Jahier> *)
+(* Time-stamp: <modified the 26/02/2015 (at 11:27) by Erwan Jahier> *)
open Lxm
@@ -33,7 +33,7 @@ let rec (get_node_body : local_ctx -> Lic.node_exp -> Lic.node_body option) =
| MetaOpLic -> None
(********************************************************************************)
-type subst = (Ident.t * var_info) list
+type subst = (Lv6Id.t * var_info) list
let rec (substitute :
subst -> Lic.eq_info Lxm.srcflagged -> Lic.eq_info Lxm.srcflagged) =
fun s { it = (lhs,ve) ; src = lxm } ->
@@ -115,7 +115,7 @@ type acc =
let (mk_fresh_loc : local_ctx -> var_info -> clock -> var_info) =
fun lctx v c ->
- new_var (Ident.to_string v.var_name_eff) v.var_type_eff (fst v.var_clock_eff, c)
+ new_var (Lv6Id.to_string v.var_name_eff) v.var_type_eff (fst v.var_clock_eff, c)
(* When expanding a node call such as
@@ -284,7 +284,7 @@ and (expand_assert : local_ctx * acc -> val_exp srcflagged -> local_ctx * acc) =
*)
let lxm = ve.src in
let ve = ve.it in
- let clk = Ident.of_string "dummy_expand_assert", BaseLic in
+ let clk = Lv6Id.of_string "dummy_expand_assert", BaseLic in
let assert_var = new_var "assert" Bool_type_eff clk in
let assert_eq = Lxm.flagit ([LeftVarLic(assert_var,lxm)], ve) lxm in
let assert_op = Lic.VAR_REF(assert_var.var_name_eff) in
diff --git a/src/lic.ml b/src/lic.ml
index c2ba1524c06c3529f91a600ab864cfef3afa8f9c..d93d9d8ec8d8ad576d5f81ddd7dfbf13b1936a70 100644
--- a/src/lic.ml
+++ b/src/lic.ml
@@ -1,4 +1,4 @@
-(* Time-stamp: <modified the 20/01/2015 (at 16:04) by Erwan Jahier> *)
+(* Time-stamp: <modified the 26/02/2015 (at 11:21) by Erwan Jahier> *)
(** Define the Data Structure representing Compiled programs. By
compiled we mean that constant are propagated, packages are
@@ -96,15 +96,15 @@ type type_ =
| Bool_type_eff
| Int_type_eff
| Real_type_eff
- | External_type_eff of Ident.long
- | Abstract_type_eff of Ident.long * type_
+ | External_type_eff of Lv6Id.long
+ | Abstract_type_eff of Lv6Id.long * type_
- (* | Alias_type_eff of Ident.long *)
+ (* | Alias_type_eff of Lv6Id.long *)
- | Enum_type_eff of Ident.long * (Ident.long list)
+ | Enum_type_eff of Lv6Id.long * (Lv6Id.long list)
| Array_type_eff of type_ * int
| Struct_type_eff of
- Ident.long * (Ident.t * (type_ * const option)) list
+ Lv6Id.long * (Lv6Id.t * (type_ * const option)) list
| TypeVar of type_var
(* [Overload] is like [Any], except that it can only be [int] or [real] *)
and type_var =
@@ -116,7 +116,7 @@ and type_var =
débranché la verif de type lors de l'instanciation de noeud. J'en
aurais peut-etre besoin le jour où j'y rebrancherai.
*)
-and node_profile = (Ident.t * type_) list * (Ident.t * type_) list
+and node_profile = (Lv6Id.t * type_) list * (Lv6Id.t * type_) list
and profile = type_ list * type_ list
and slice_info = {
@@ -140,7 +140,7 @@ and left =
N.B. On garde aussi l'info source des idents au cas ou.*)
| LeftVarLic of (var_info * Lxm.t)
- | LeftFieldLic of (left * Ident.t * type_)
+ | LeftFieldLic of (left * Lv6Id.t * type_)
| LeftArrayLic of (left * int * type_) (* XXX should be called LeftArrayIndexLic? *)
| LeftSliceLic of (left * slice_info * type_)
@@ -166,25 +166,25 @@ and val_exp =
*)
and val_exp_core =
| CallByPosLic of (by_pos_op srcflagged * val_exp list)
- | CallByNameLic of (by_name_op srcflagged * (Ident.t srcflagged * val_exp) list)
+ | CallByNameLic of (by_name_op srcflagged * (Lv6Id.t srcflagged * val_exp) list)
| Merge of val_exp * (const srcflagged * val_exp) list
and by_name_op =
- | STRUCT of Ident.long
- | STRUCT_with of Ident.long * Ident.t (* XXX devrait etre une expression !!! *)
+ | STRUCT of Lv6Id.long
+ | STRUCT_with of Lv6Id.long * Lv6Id.t (* XXX devrait etre une expression !!! *)
| STRUCT_anonymous
and by_pos_op =
| PREDEF_CALL of node_key srcflagged
| CALL of node_key srcflagged
- | CONST_REF of Ident.long
+ | CONST_REF of Lv6Id.long
| CONST of const
- | VAR_REF of Ident.t
+ | VAR_REF of Lv6Id.t
| PRE
| ARROW
| FBY
- | CURRENT of Ident.long option (* hold the clock constructor; the clock var is
+ | CURRENT of Lv6Id.long option (* hold the clock constructor; the clock var is
provided via the args (val_exp list) *)
(* nb : we have an option type because we know the clock after
clock checking only *)
@@ -195,7 +195,7 @@ and by_pos_op =
| CONCAT
| HAT of int
| ARRAY
- | STRUCT_ACCESS of Ident.t
+ | STRUCT_ACCESS of Lv6Id.t
(* those are different from [by_pos_op] *)
@@ -219,15 +219,15 @@ and const =
| Int_const_eff of string
| Real_const_eff of string
(* type atomique non predef : on précise le type *)
- | Extern_const_eff of (Ident.long * type_)
- | Abstract_const_eff of (Ident.long * type_ * const * bool)
+ | Extern_const_eff of (Lv6Id.long * type_)
+ | Abstract_const_eff of (Lv6Id.long * type_ * const * bool)
(* if the abstract const is extern (i.e., defined as an extern
in the provided part), then the bool flag is set to
true.
*)
- | Enum_const_eff of (Ident.long * type_)
+ | Enum_const_eff of (Lv6Id.long * type_)
(* type_ structure : liste (champ,valeur) + type_ structure *)
- | Struct_const_eff of ((Ident.t * const) list * type_)
+ | Struct_const_eff of ((Lv6Id.t * const) list * type_)
(* type_ tableau : liste des valeurs + type_ des elts + taille *)
| Array_const_eff of (const list * type_)
| Tuple_const_eff of const list
@@ -244,13 +244,13 @@ and const =
----------------------------------------------------------------------*)
(* ICI à completer/modifier sans doute *)
and var_info = {
- var_name_eff : Ident.t;
+ var_name_eff : Lv6Id.t;
var_nature_eff : AstCore.var_nature;
var_number_eff : int;
var_type_eff : type_;
var_clock_eff : id_clock;
}
-and id_clock = Ident.t * clock
+and id_clock = Lv6Id.t * clock
(*
A pair made of an ident and its clock.
@@ -261,7 +261,7 @@ and id_clock = Ident.t * clock
and clock =
| BaseLic
| ClockVar of int (* to deal with polymorphic clocks (i.e., constants) *)
- | On of (Ident.long * Ident.t * type_) * clock
+ | On of (Lv6Id.long * Lv6Id.t * type_) * clock
(* - The clock constructor (holding the clock value),
- the clock variable
- the type of the clock variable (enum or bool)
@@ -309,14 +309,14 @@ and node_body = {
}
(* key used for type, constant, and clock tables *)
-and item_key = Ident.long
+and item_key = Lv6Id.long
and node_key = item_key * static_arg list
and static_arg =
(* may be a tuple *)
- | ConstStaticArgLic of (Ident.t * const)
- | TypeStaticArgLic of (Ident.t * type_)
- (* | NodeStaticArgLic of (Ident.t * sarg_node_eff * node_exp) *)
- | NodeStaticArgLic of (Ident.t * node_key)
+ | ConstStaticArgLic of (Lv6Id.t * const)
+ | TypeStaticArgLic of (Lv6Id.t * type_)
+ (* | NodeStaticArgLic of (Lv6Id.t * sarg_node_eff * node_exp) *)
+ | NodeStaticArgLic of (Lv6Id.t * node_key)
and sarg_node_eff = node_key * var_info list * var_info list
@@ -360,20 +360,20 @@ let (profile_of_node_exp : node_exp -> profile) =
(* type world_env = { *)
(* wenv_src : AstV6.pack_or_model list; *)
-(* wenv_mod_srcs : (Ident.t, AstV6.model_info srcflagged) Hashtbl.t ; *)
-(* wenv_pack_srcs : (Ident.t, AstV6.pack_info srcflagged) Hashtbl.t ; *)
-(* wenv_pack_envs : (Ident.t, pack_env) Hashtbl.t ; *)
+(* wenv_mod_srcs : (Lv6Id.t, AstV6.model_info srcflagged) Hashtbl.t ; *)
+(* wenv_pack_srcs : (Lv6Id.t, AstV6.pack_info srcflagged) Hashtbl.t ; *)
+(* wenv_pack_envs : (Lv6Id.t, pack_env) Hashtbl.t ; *)
(* } *)
(* and pack_env = { *)
(* penv_world : world_env ; *)
(* (* penv_src : AstV6.package ; *) *)
-(* penv_type_table : (Ident.t, type check_flag) Hashtbl.t ; *)
-(* penv_const_table : (Ident.t, const check_flag) Hashtbl.t ; *)
-(* penv_oper_table : (Ident.t, node_half) Hashtbl.t ; *)
+(* penv_type_table : (Lv6Id.t, type check_flag) Hashtbl.t ; *)
+(* penv_const_table : (Lv6Id.t, const check_flag) Hashtbl.t ; *)
+(* penv_oper_table : (Lv6Id.t, node_half) Hashtbl.t ; *)
(* penv_node_table : (node_key, node_exp check_flag) Hashtbl.t *)
(* } *)
-(* the local tables are indexed by Ident.t, because local idents (var,const, flow)
+(* the local tables are indexed by Lv6Id.t, because local idents (var,const, flow)
cannot have any package name.
and for nodes, the only possibility to have an entry in this table is via the
@@ -425,24 +425,24 @@ let (var_are_compatible : var_info -> var_info -> bool) =
(clock_are_equals (snd v1.var_clock_eff) (snd v2.var_clock_eff))
let ident_of_type = function
- | Bool_type_eff -> Ident.out_of_pack "bool"
- | Int_type_eff -> Ident.out_of_pack "int"
- | Real_type_eff -> Ident.out_of_pack "real"
+ | Bool_type_eff -> Lv6Id.out_of_pack "bool"
+ | Int_type_eff -> Lv6Id.out_of_pack "int"
+ | Real_type_eff -> Lv6Id.out_of_pack "real"
| External_type_eff id
| Abstract_type_eff (id, _)
| Enum_type_eff (id, _)
| Struct_type_eff (id, _) -> id
- | TypeVar Any -> Ident.out_of_pack "any"
- | (TypeVar AnyNum) -> Ident.out_of_pack "anynum"
+ | TypeVar Any -> Lv6Id.out_of_pack "any"
+ | (TypeVar AnyNum) -> Lv6Id.out_of_pack "anynum"
| Array_type_eff(_,_) -> assert false
(****************************************************************************)
(* Utilitaires liés aux node_key *)
-let (node_key_of_idref : Ident.idref -> node_key) =
- fun nkey -> (Ident.long_of_idref nkey, [])
+let (node_key_of_idref : Lv6Id.idref -> node_key) =
+ fun nkey -> (Lv6Id.long_of_idref nkey, [])
let (node_key_of_ident : string -> node_key) =
- fun id -> (Ident.long_of_string id, [])
+ fun id -> (Lv6Id.long_of_string id, [])
(* OBSOLETE ET UN PEU FAUX !
R1: pas forcément obsolete ; cf commentaire plus haut.
@@ -601,7 +601,7 @@ let (clock_of_left: left -> clock) =
snd (var_info_of_left left).var_clock_eff
-let string_of_ident = Ident.string_of_long2
+let string_of_ident = Lv6Id.string_of_long2
let rec string_of_type = function
| Bool_type_eff -> "bool"
@@ -628,7 +628,7 @@ and string_of_clock = function
| BaseLic -> " on base"
| ClockVar i -> " on 'c"^(string_of_int i)
| On ( (cc,cv,ct), ck) ->
- " on "^(Ident.long_to_string cc) ^ "(" ^ (Ident.to_string cv) ^ ")" ^(string_of_clock ck)
+ " on "^(Lv6Id.long_to_string cc) ^ "(" ^ (Lv6Id.to_string cv) ^ ")" ^(string_of_clock ck)
and enum_to_string s ll =
match Lv6MainArgs.global_opt.Lv6MainArgs.expand_enums with
@@ -646,7 +646,7 @@ and string_of_const = function
| Enum_const_eff _ -> assert false
| Struct_const_eff (fl, t) ->
let string_of_field (id, veff) =
- (Ident.to_string id)^" = "^ (string_of_const veff)
+ (Lv6Id.to_string id)^" = "^ (string_of_const veff)
in
Printf.sprintf "%s{%s}"
(string_of_type t)
@@ -658,8 +658,8 @@ and string_of_const = function
and string_of_var_info x =
(AstCore.string_of_var_nature x.var_nature_eff) ^ " " ^
- (Ident.to_string x.var_name_eff) ^ ":"^(string_of_type x.var_type_eff)^
- (string_of_clock (snd x.var_clock_eff)^"("^ (Ident.to_string (fst x.var_clock_eff)) ^","^
+ (Lv6Id.to_string x.var_name_eff) ^ ":"^(string_of_type x.var_type_eff)^
+ (string_of_clock (snd x.var_clock_eff)^"("^ (Lv6Id.to_string (fst x.var_clock_eff)) ^","^
(string_of_int x.var_number_eff)^")")
and string_of_var_list vl = String.concat " ; " (List.map string_of_var_info vl)
@@ -694,7 +694,7 @@ let string_of_node_exp ne =
(* ne.has_mem_eff : bool; *)
(* ne.is_safe_eff : bool; *)
-(* NodeStaticArgLic of (Ident.t * sarg_node_eff * node_exp) *)
+(* NodeStaticArgLic of (Lv6Id.t * sarg_node_eff * node_exp) *)
(* sarg_node_eff = node_key * var_info list * var_info list *)
(* utile : liste standard de var_info a partir de liste de type *)
diff --git a/src/lic2soc.ml b/src/lic2soc.ml
index 2cbec144972ef005360eb209db14fd315fafeb8f..6f96930e8d672035b49a54ab948364ea0227d62e 100644
--- a/src/lic2soc.ml
+++ b/src/lic2soc.ml
@@ -1,4 +1,4 @@
-(** Time-stamp: <modified the 24/02/2015 (at 09:13) by Erwan Jahier> *)
+(** Time-stamp: <modified the 26/02/2015 (at 11:21) by Erwan Jahier> *)
(* XXX ce module est mal écrit. A reprendre. (R1) *)
@@ -38,19 +38,19 @@ let rec lic_to_data_type: (Lic.type_ -> Data.t) =
| Lic.Bool_type_eff -> Data.Bool
| Lic.Int_type_eff -> Data.Int
| Lic.Real_type_eff -> Data.Real
- | Lic.External_type_eff s -> Data.Extern (Ident.string_of_long s)
+ | Lic.External_type_eff s -> Data.Extern (Lv6Id.string_of_long s)
| Lic.Enum_type_eff (id, l) -> (
- Data.Enum(Ident.string_of_long id, List.map Ident.string_of_long l)
+ Data.Enum(Lv6Id.string_of_long id, List.map Lv6Id.string_of_long l)
)
| Lic.Struct_type_eff (id, fl) -> (
let trans_field (id,(t,_)) = (* fde_value is ignored. Good idea? *)
- Ident.to_string id, lic_to_data_type t
+ Lv6Id.to_string id, lic_to_data_type t
in
- let id = Ident.string_of_long id in
+ let id = Lv6Id.string_of_long id in
Data.Struct(id, List.map trans_field fl)
)
| Lic.Array_type_eff(ty,i) -> Data.Array(lic_to_data_type ty,i)
- | Lic.Abstract_type_eff (id, t) -> Data.Alias(Ident.string_of_long id,lic_to_data_type t)
+ | Lic.Abstract_type_eff (id, t) -> Data.Alias(Lv6Id.string_of_long id,lic_to_data_type t)
| Lic.TypeVar Lic.Any -> Data.Alpha 0
| Lic.TypeVar Lic.AnyNum ->
(* For some reasons, L2lRmPoly did not manage to resolve all the overloeding.
@@ -109,8 +109,8 @@ let rec (lic2soc_const : Lic.const -> Soc.var_expr list) =
| Bool_const_eff false -> [Soc.Const("false", Data.Bool)]
| Int_const_eff i -> [Soc.Const(i, Data.Int)]
| Real_const_eff r -> [Soc.Const(r, Data.Real)]
- | Extern_const_eff (s, teff) -> [Soc.Const(Ident.string_of_long s, lic_to_data_type teff)]
- | Abstract_const_eff (s, teff,_,_) -> [Soc.Const(Ident.string_of_long s, lic_to_data_type teff)]
+ | Extern_const_eff (s, teff) -> [Soc.Const(Lv6Id.string_of_long s, lic_to_data_type teff)]
+ | Abstract_const_eff (s, teff,_,_) -> [Soc.Const(Lv6Id.string_of_long s, lic_to_data_type teff)]
| Enum_const_eff (s, teff) ->
let ll = match teff with Enum_type_eff(_,ll) -> ll | _ -> assert false in
[Soc.Const(enum_to_string s ll, lic_to_data_type teff)]
@@ -141,7 +141,7 @@ let rec get_leaf: (LicPrg.t -> Lic.val_exp -> Soc.var_expr list option) =
Some [translation]
| Lic.CONST_REF l -> (
let type_ = lic_to_data_type (List.hd type_) in
- Some [Soc.Const(Ident.string_of_long l, type_)]
+ Some [Soc.Const(Lv6Id.string_of_long l, type_)]
)
| Lic.CONST c -> Some(lic2soc_const c)
| Lic.STRUCT_ACCESS(field) -> (
@@ -317,7 +317,7 @@ let rec (val_exp_to_filter: LicPrg.t -> Lic.val_exp -> Soc.var_expr list) =
[translation]
| CONST_REF l -> (
let type_ = lic_to_data_type (List.hd type_) in
- [Soc.Const(Ident.string_of_long l, type_)]
+ [Soc.Const(Lv6Id.string_of_long l, type_)]
)
| CONST (Bool_const_eff true) -> [Soc.Const("true", Data.Bool)]
| CONST (Bool_const_eff false) -> [Soc.Const("false", Data.Bool)]
diff --git a/src/licDump.ml b/src/licDump.ml
index 3868345d737f52e2cef17d38a2c699dfe9694b1f..23b1013ddcf7e353ab89bf2815ad323f5f247ac4 100644
--- a/src/licDump.ml
+++ b/src/licDump.ml
@@ -1,4 +1,4 @@
-(* Time-stamp: <modified the 21/01/2015 (at 18:01) by Erwan Jahier> *)
+(* Time-stamp: <modified the 26/02/2015 (at 11:22) by Erwan Jahier> *)
open Lv6errors
open Printf
@@ -8,13 +8,13 @@ open List
open Lv6MainArgs
(* XXX changer le nom de cette fonction *)
-let (dump_long : Ident.long -> string) = fun x ->
+let (dump_long : Lv6Id.long -> string) = fun x ->
if global_opt.no_prefix then
- Ident.no_pack_string_of_long x
+ Lv6Id.no_pack_string_of_long x
else
- Ident.string_of_long x
+ Lv6Id.string_of_long x
(* fun id -> *)
-(* let str = Ident.string_of_long id in *)
+(* let str = Lv6Id.string_of_long id in *)
(* Str.global_replace (Str.regexp "::") "__" str *)
(******************************************************************************)
@@ -43,8 +43,8 @@ let rec is_a_tuple (e:Lic.val_exp) : bool =
(******************************************************************************)
let string_of_ident x =
if global_opt.no_prefix
- then Ident.no_pack_string_of_long x
- else Ident.string_of_long2 x
+ then Lv6Id.no_pack_string_of_long x
+ else Lv6Id.string_of_long2 x
let rec string_of_const_eff =
@@ -63,7 +63,7 @@ let rec string_of_const_eff =
| Struct_const_eff (fl, t) -> (
let string_of_field =
function (id, veff) ->
- (Ident.to_string id)^" = "^ (string_of_const_eff veff)
+ (Lv6Id.to_string id)^" = "^ (string_of_const_eff veff)
in
let flst = List.map string_of_field fl in
(string_of_type_eff t)^"{"^(String.concat "; " flst)^"}"
@@ -116,7 +116,7 @@ and string_ident_of_const_eff c =
| Enum_const_eff _ -> string_of_const_eff c
| Struct_const_eff (_, t) -> (
match t with
- | Struct_type_eff (sn,_) -> Ident.no_pack_string_of_long sn
+ | Struct_type_eff (sn,_) -> Lv6Id.no_pack_string_of_long sn
| _ -> assert false
)
| Array_const_eff (ctab, t) -> string_of_type_eff t
@@ -145,7 +145,7 @@ and string_def_of_type_eff = function
| Struct_type_eff (name, fl) ->
assert (fl <>[]);
let f sep acc (id, (type_eff, const_eff_opt)) =
- acc ^ sep ^ (Ident.to_string id) ^ " : " ^
+ acc ^ sep ^ (Lv6Id.to_string id) ^ " : " ^
(string_of_type_eff type_eff) ^
match const_eff_opt with
None -> ""
@@ -197,7 +197,7 @@ and string_of_const = function
| Enum_const_eff _ -> assert false
| Struct_const_eff (fl, t) ->
let string_of_field (id, veff) =
- (Ident.to_string id)^" = "^ (string_of_const veff)
+ (Lv6Id.to_string id)^" = "^ (string_of_const veff)
in
Printf.sprintf "%s{%s}"
(string_of_type_eff t)
@@ -211,8 +211,8 @@ and string_of_const = function
and string_of_var_info x =
(AstCore.string_of_var_nature x.var_nature_eff) ^ " " ^
- (Ident.to_string x.var_name_eff) ^ ":"^(string_of_type_eff x.var_type_eff)^
- (string_of_clock (snd x.var_clock_eff)^"("^ (Ident.to_string (fst x.var_clock_eff)) ^","^
+ (Lv6Id.to_string x.var_name_eff) ^ ":"^(string_of_type_eff x.var_type_eff)^
+ (string_of_clock (snd x.var_clock_eff)^"("^ (Lv6Id.to_string (fst x.var_clock_eff)) ^","^
(string_of_int x.var_number_eff)^")")
and string_of_var_list vl = String.concat " ; " (List.map string_of_var_info vl)
@@ -243,11 +243,11 @@ and string_of_node_key_rec (no_prefix:bool) (nkey: node_key) =
match nkey with
| (ik, []) ->
if no_prefix
- then Ident.no_pack_string_of_long ik
- else Ident.string_of_long ik
+ then Lv6Id.no_pack_string_of_long ik
+ else Lv6Id.string_of_long ik
| (ik, salst) ->
let astrings = List.map static_arg2string_bis salst in
- let name = sprintf "%s_%s" (Ident.no_pack_string_of_long ik) (String.concat "_" astrings) in
+ let name = sprintf "%s_%s" (Lv6Id.no_pack_string_of_long ik) (String.concat "_" astrings) in
(LicName.node_key nkey name)
(* for printing iterators *)
@@ -256,7 +256,7 @@ and string_of_node_key_iter (nkey: node_key) =
| (ik, []) -> dump_long ik
| (ik, salst) ->
let astrings = List.map (static_arg2string) salst in
- sprintf "%s<<%s>>" (Ident.string_of_long ik) (String.concat ", " astrings)
+ sprintf "%s<<%s>>" (Lv6Id.string_of_long ik) (String.concat ", " astrings)
(* pour ecrire UN NIVEAU d'arg statique (cf. LicMetaOp *)
and string_of_node_key_def (nkey: node_key) =
@@ -264,7 +264,7 @@ and string_of_node_key_def (nkey: node_key) =
| (ik, []) -> dump_long ik
| (ik, salst) ->
let astrings = List.map (string_of_static_arg) salst in
- sprintf "%s<<%s>>" (Ident.string_of_long ik) (String.concat ", " astrings)
+ sprintf "%s<<%s>>" (Lv6Id.string_of_long ik) (String.concat ", " astrings)
(* for inventing a name to parametrized nodes *)
and static_arg2string_bis (sa : Lic.static_arg) =
@@ -273,7 +273,7 @@ and static_arg2string_bis (sa : Lic.static_arg) =
| TypeStaticArgLic (id, teff) -> sprintf "%s" (string_of_type_eff teff)
(* | NodeStaticArgLic (id, ((long, _sargs), _, _), _) -> *)
| NodeStaticArgLic (id, (long,_)) ->
- sprintf "%s" (Ident.no_pack_string_of_long long)
+ sprintf "%s" (Lv6Id.no_pack_string_of_long long)
(* for printing recursive node and iterators *)
and static_arg2string (sa : Lic.static_arg) =
@@ -297,7 +297,7 @@ and static_arg2string_rec (sa : Lic.static_arg) =
and (string_of_var_info_eff: Lic.var_info -> string) =
fun x ->
- (Ident.to_string x.var_name_eff) ^ ":"^(string_of_type_eff x.var_type_eff)
+ (Lv6Id.to_string x.var_name_eff) ^ ":"^(string_of_type_eff x.var_type_eff)
and (type_string_of_var_info_eff: Lic.var_info -> string) =
fun x -> (string_of_type_eff x.var_type_eff) ^
@@ -305,7 +305,7 @@ and (type_string_of_var_info_eff: Lic.var_info -> string) =
and string_of_decl var_info_eff =
let vt_str =
- (Ident.to_string var_info_eff.var_name_eff) ^ ":" ^
+ (Lv6Id.to_string var_info_eff.var_name_eff) ^ ":" ^
(string_of_type_eff var_info_eff.var_type_eff)
in
let clk_str = (string_of_clock (snd var_info_eff.var_clock_eff)) in
@@ -326,8 +326,8 @@ and string_of_slice_info_eff si_eff =
and (string_of_leff : Lic.left -> string) =
function
- | LeftVarLic (vi_eff,_) -> Ident.to_string vi_eff.var_name_eff
- | LeftFieldLic(leff,id,_) -> (string_of_leff leff) ^ "." ^ (Ident.to_string id)
+ | LeftVarLic (vi_eff,_) -> Lv6Id.to_string vi_eff.var_name_eff
+ | LeftFieldLic(leff,id,_) -> (string_of_leff leff) ^ "." ^ (Lv6Id.to_string id)
| LeftArrayLic(leff,i,_) -> (string_of_leff leff) ^ "[" ^ (string_of_int i) ^ "]"
| LeftSliceLic(leff,si,_) -> (string_of_leff leff) ^ (string_of_slice_info_eff si)
@@ -431,7 +431,7 @@ and (string_of_by_pos_op_eff: Lic.by_pos_op srcflagged -> Lic.val_exp list -> st
| HAT (i), _ -> assert false
| ARRAY, vel -> tuple_square vel
| STRUCT_ACCESS(id), [ve1] ->
- (string_of_val_exp_eff ve1) ^ "." ^ (Ident.to_string id)
+ (string_of_val_exp_eff ve1) ^ "." ^ (Lv6Id.to_string id)
| ARRAY_ACCES(i), [ve1] ->
(string_of_val_exp_eff ve1) ^ "[" ^ (string_of_int i) ^ "]"
@@ -501,15 +501,15 @@ and string_of_val_exp_eff_core ve_core =
)
| CallByNameLic(by_name_op_eff, fl) ->
(match by_name_op_eff.it with
- | STRUCT (long) -> (Ident.string_of_long long)
- | STRUCT_with (long, _dft) -> (Ident.string_of_long long)
+ | STRUCT (long) -> (Lv6Id.string_of_long long)
+ | STRUCT_with (long, _dft) -> (Lv6Id.string_of_long long)
| STRUCT_anonymous -> ""
) ^ (
"{" ^ (String.concat ";"
(List.map
(fun (id,veff) ->
let str = string_of_val_exp_eff veff in
- (Ident.to_string id.it) ^ "=" ^
+ (Lv6Id.to_string id.it) ^ "=" ^
(if is_a_tuple veff then ("("^ str^")") else str)
)
fl)) ^
@@ -578,7 +578,7 @@ and (string_of_node_def : Lic.node_def -> string list) =
(* exported *)
-and (type_decl: Ident.long -> Lic.type_ -> string) =
+and (type_decl: Lv6Id.long -> Lic.type_ -> string) =
fun tname teff ->
"type " ^ (dump_long tname) ^
(match teff with
@@ -590,7 +590,7 @@ and (type_decl: Ident.long -> Lic.type_ -> string) =
)
(* exported *)
-and (const_decl: Ident.long -> Lic.const -> string) =
+and (const_decl: Lv6Id.long -> Lic.const -> string) =
fun tname ceff ->
let begin_str = ("const " ^ (dump_long tname)) in
let end_str = (string_of_const_eff ceff) ^ ";\n" in
@@ -666,20 +666,20 @@ and (string_of_clock_exp : AstCore.clock_exp -> string) =
| AstCore.NamedClock clk ->
" when " ^ (string_of_ident_clk clk.it)
-and (string_of_ident_clk : Ident.clk -> string) =
+and (string_of_ident_clk : Lv6Id.clk -> string) =
fun clk ->
let (cc,v) = clk in
let clk_exp_str =
match cc with
- | "Lustre","true" -> (Ident.to_string v)
- | "Lustre","false" -> "not " ^ (Ident.to_string v)
+ | "Lustre","true" -> (Lv6Id.to_string v)
+ | "Lustre","false" -> "not " ^ (Lv6Id.to_string v)
| _ ->
(* if global_opt.lv4 || global_opt.ec then *)
(* raise (Lv6errors.Global_error *)
(* ("Cannot generate V4 style Lustre for programs with enumerated "^ *)
(* "clocks (yet), sorry.")) *)
(* else *)
- Ident.string_of_clk clk
+ Lv6Id.string_of_clk clk
in
clk_exp_str
diff --git a/src/licEvalClock.ml b/src/licEvalClock.ml
index a625d6f9e151de03a80753dd25fd6b2981b35525..0402b58a24b1bb953b0cb87f420dca3744468fd8 100644
--- a/src/licEvalClock.ml
+++ b/src/licEvalClock.ml
@@ -1,4 +1,4 @@
-(* Time-stamp: <modified the 13/08/2014 (at 16:59) by Erwan Jahier> *)
+(* Time-stamp: <modified the 26/02/2015 (at 11:22) by Erwan Jahier> *)
open AstPredef
@@ -16,7 +16,7 @@ type clocker = UnifyClock.subst -> Lic.id_clock list list ->
let (constant_profile: string -> clocker) =
fun str s _ ->
let s, clk = UnifyClock.new_clock_var s in
- [Ident.of_string str, clk], s
+ [Lv6Id.of_string str, clk], s
let (op_profile: clocker) =
fun s cl ->
diff --git a/src/licEvalConst.ml b/src/licEvalConst.ml
index f657a4620f1f7ca9fb649bd37e70d832be5d300d..8f68455c25ec4118575a88918c948714f27c7a46 100644
--- a/src/licEvalConst.ml
+++ b/src/licEvalConst.ml
@@ -1,4 +1,4 @@
-(* Time-stamp: <modified the 26/06/2014 (at 18:32) by Erwan Jahier> *)
+(* Time-stamp: <modified the 26/02/2015 (at 11:27) by Erwan Jahier> *)
open AstPredef
open Lic
@@ -79,17 +79,17 @@ let (oo_evaluator:(int -> int) -> (float -> float) -> const_evaluator) =
| [Real_const_eff v0] -> eval_real_error () (* [Real_const_eff (opr v0)] *)
| _ -> assert false (* should not occur because eval_type is called before *)
-let (sf_evaluator: Ident.t -> const_evaluator) =
- fun id ceff_ll -> [Real_const_eff (Ident.to_string id)]
+let (sf_evaluator: Lv6Id.t -> const_evaluator) =
+ fun id ceff_ll -> [Real_const_eff (Lv6Id.to_string id)]
-let (si_evaluator: Ident.t -> const_evaluator) =
+let (si_evaluator: Lv6Id.t -> const_evaluator) =
fun id ceff_ll ->
- try let v = (Ident.to_string id) in
+ try let v = (Lv6Id.to_string id) in
[Int_const_eff v]
with Failure "int_of_string" ->
raise (EvalConst_error(
Printf.sprintf "\n*** fail to convert the string \"%s\" into an int"
- (Ident.to_string id)))
+ (Lv6Id.to_string id)))
let (sb_evaluator: bool -> const_evaluator) =
fun v ceff_ll ->
diff --git a/src/licEvalType.ml b/src/licEvalType.ml
index 3320c73f684b0d08ff9a0e6ef0b73f56e3f92e62..1f5acafa7f7818be59a9d46e6e6841187bc06da4 100644
--- a/src/licEvalType.ml
+++ b/src/licEvalType.ml
@@ -1,4 +1,4 @@
-(* Time-stamp: <modified the 21/01/2015 (at 16:55) by Erwan Jahier> *)
+(* Time-stamp: <modified the 26/02/2015 (at 11:22) by Erwan Jahier> *)
open AstPredef
open Lxm
@@ -52,7 +52,7 @@ let raise_arity_error (msg:string) (get:int) (expect:int) =
let i = Int_type_eff
let r = Real_type_eff
let b = Bool_type_eff
-let id str = Ident.of_string str
+let id str = Lv6Id.of_string str
(** A few useful type profiles for simple operators *)
let bb_profile = [(id "i", b)], [(id "o", b)] (* bool -> bool *)
@@ -88,7 +88,7 @@ let rrb_profile = [(id "i1",r);(id "i2",r)], [(id "o",b)]
(** iterators profiles *)
(* [type_to_array_type [x1;...;xn] c] returns the array type [x1^c;...;xn^c] *)
-let (type_to_array_type: Lic.var_info list -> int -> (Ident.t * Lic.type_) list) =
+let (type_to_array_type: Lic.var_info list -> int -> (Lv6Id.t * Lic.type_) list) =
fun l c ->
List.map (fun vi -> vi.var_name_eff, Array_type_eff(vi.var_type_eff,c)) l
diff --git a/src/licName.ml b/src/licName.ml
index 887a64122bc897ecef6a7dd6b87a085e5f57837c..77e68aa517f94e57d2d412e42f3a4c9aed01dca4 100644
--- a/src/licName.ml
+++ b/src/licName.ml
@@ -1,4 +1,4 @@
-(* Time-stamp: <modified the 16/01/2015 (at 13:53) by Erwan Jahier> *)
+(* Time-stamp: <modified the 26/02/2015 (at 11:22) by Erwan Jahier> *)
(* maps node_key to a string that won't clash *)
@@ -16,7 +16,7 @@ let (node_key: Lic.node_key -> string -> string) =
with Not_found ->
(* let's build an ident that won't clash *)
(* all new name should not begins with a "_" ; hence we prefix by "n_" *)
- let name = if name = "" then "n_" ^ (Ident.no_pack_string_of_long long) else name in
+ let name = if name = "" then "n_" ^ (Lv6Id.no_pack_string_of_long long) else name in
if not (Hashtbl.mem node_name_tbl name) then
(
(* that name won't clash, but let's tabulate it *)
@@ -140,7 +140,7 @@ let (new_local_var : string -> string) =
open Lic
let (new_var_info : string -> Lic.type_ -> Lic.id_clock -> Lic.var_info) =
fun str type_eff clock_eff ->
- let id = Ident.of_string (new_local_var str) in
+ let id = Lv6Id.of_string (new_local_var str) in
let var =
{
var_name_eff = id;
diff --git a/src/licPrg.ml b/src/licPrg.ml
index f555c63d6272640a31afad72d821476f6e25bf47..a40c870bd118da4698a48e5ac71965feab48b12d 100644
--- a/src/licPrg.ml
+++ b/src/licPrg.ml
@@ -1,4 +1,4 @@
-(* Time-stamp: <modified the 16/01/2015 (at 10:24) by Erwan Jahier> *)
+(* Time-stamp: <modified the 26/02/2015 (at 11:22) by Erwan Jahier> *)
module ItemKeyMap = struct
include Map.Make (
@@ -51,7 +51,7 @@ let rec pretty_sfx i =
let fresh_type_id this pname pfx =
let rec fresh x =
let id = Printf.sprintf "%s%s" pfx (pretty_sfx x) in
- let res = Ident.make_long pname id in
+ let res = Lv6Id.make_long pname id in
if ItemKeyMap.mem res this.types then fresh (x+1)
else res
in
@@ -65,7 +65,7 @@ let find_node this k = try Some(NodeKeyMap.find k this.nodes ) with Not_found -
let node_exists this k = NodeKeyMap.mem k this.nodes
-let (find_var : Ident.t -> Lic.node_exp -> Lic.var_info option) =
+let (find_var : Lv6Id.t -> Lic.node_exp -> Lic.var_info option) =
fun id ne ->
let name_matches vi = vi.Lic.var_name_eff = id in
try Some (List.find name_matches ne.Lic.inlist_eff) with Not_found ->
@@ -124,7 +124,7 @@ let del_node (k:Lic.node_key) (prg:t) : t =
{ prg with nodes = NodeKeyMap.remove k prg.nodes }
exception Print_me of Lic.node_exp
-let to_file (opt: Lv6MainArgs.t) (this:t) (main_node: Ident.idref option) =
+let to_file (opt: Lv6MainArgs.t) (this:t) (main_node: Lv6Id.idref option) =
Lv6util.dump_entete opt.Lv6MainArgs.oc;
(* On imprime dans l'ordre du iter, donc pas terrible ???
*)
@@ -209,9 +209,9 @@ let to_file (opt: Lv6MainArgs.t) (this:t) (main_node: Ident.idref option) =
(* in ec, we first need to declare the profile of extern nodes *)
NodeKeyMap.iter
(fun (key,_) nexp -> (
- if nexp.Lic.def_eff = Lic.ExternLic && Ident.pack_of_long key <> "Lustre" then (
+ if nexp.Lic.def_eff = Lic.ExternLic && Lv6Id.pack_of_long key <> "Lustre" then (
let str = (if nexp.Lic.has_mem_eff then "extern node " else "function ") ^
- (Ident.of_long key)^(LicDump.profile_of_node_exp_eff nexp)^".\n"
+ (Lv6Id.of_long key)^(LicDump.profile_of_node_exp_eff nexp)^".\n"
in
output_string opt.Lv6MainArgs.oc (str);
flush opt.Lv6MainArgs.oc;
@@ -226,11 +226,11 @@ let to_file (opt: Lv6MainArgs.t) (this:t) (main_node: Ident.idref option) =
NodeKeyMap.iter
(fun (key,_) nexp -> (
match main_node with
- | Some { Ident.id_pack = None ; Ident.id_id= name } ->
- if Ident.of_long key = name && Ident.pack_of_long key <> "Lustre"
+ | Some { Lv6Id.id_pack = None ; Lv6Id.id_id= name } ->
+ if Lv6Id.of_long key = name && Lv6Id.pack_of_long key <> "Lustre"
then raise (Print_me nexp)
| Some idref ->
- if Ident.long_of_idref idref = key then raise (Print_me nexp)
+ if Lv6Id.long_of_idref idref = key then raise (Print_me nexp)
| None -> (
match nexp.Lic.node_key_eff, nexp.Lic.def_eff with
(* only user or extern nodes with a body makes valid ec node *)
diff --git a/src/licPrg.mli b/src/licPrg.mli
index 14976dab846fd683830fb601b75b1b46076ea34c..abadb2f20951c1a90ba3e24953e642e9c54bdcc2 100644
--- a/src/licPrg.mli
+++ b/src/licPrg.mli
@@ -1,4 +1,4 @@
-(* Time-stamp: <modified the 09/10/2014 (at 09:51) by Erwan Jahier> *)
+(* Time-stamp: <modified the 26/02/2015 (at 13:45) by Erwan Jahier> *)
(** The data structure resulting from the compilation process *)
@@ -45,7 +45,7 @@ val iter_consts : (Lic.item_key -> Lic.const -> unit) -> t -> unit
val iter_types : (Lic.item_key -> Lic.type_ -> unit) -> t -> unit
val iter_nodes : (Lic.node_key -> Lic.node_exp -> unit) -> t -> unit
-val to_file : Lv6MainArgs.t -> t -> Ident.idref option -> unit
+val to_file : Lv6MainArgs.t -> t -> Lv6Id.idref option -> unit
val find_type : t -> Lic.item_key -> Lic.type_ option
val find_const : t -> Lic.item_key -> Lic.const option
@@ -54,9 +54,9 @@ val node_exists: t -> Lic.node_key -> bool
(** choose a user node *)
val choose_node : t -> (Lic.node_key * Lic.node_exp) option
-val find_var : Ident.t -> Lic.node_exp -> Lic.var_info option
+val find_var : Lv6Id.t -> Lic.node_exp -> Lic.var_info option
-val fresh_type_id : t -> Ident.pack_name -> string -> Ident.long
+val fresh_type_id : t -> Lv6Id.pack_name -> string -> Lv6Id.long
(** utile : générateur de noms de flow 'frais'
ATTENTION ! si on en utilise plusieurs
diff --git a/src/licTab.ml b/src/licTab.ml
index 9043953b3e9577b859dd7228c2dade6a51b3182a..ccd7664e38c5a6418f81ebc70e4cc1437302c6ba 100644
--- a/src/licTab.ml
+++ b/src/licTab.ml
@@ -1,4 +1,4 @@
-(* Time-stamp: <modified the 21/01/2015 (at 17:02) by Erwan Jahier> *)
+(* Time-stamp: <modified the 26/02/2015 (at 11:28) by Erwan Jahier> *)
open Lxm
@@ -17,7 +17,7 @@ let finish_me msg = print_string ("\n\tXXX licTab:"^msg^" -> finish me!\n")
(** Returns the ident on which the recursion was detected, plus an execution
stack description.
*)
-exception Recursion_error of (Ident.long as 'id) * (string list as 'stack)
+exception Recursion_error of (Lv6Id.long as 'id) * (string list as 'stack)
exception BadCheckRef_error
@@ -163,8 +163,8 @@ let (create : AstTab.t -> t) =
let x_check
(* tab find_x x_check_do lookup_x_eff pack_of_x_key name_of_x_key this x_key lxm = *)
(tab : ('x_key, 'x_eff Lic.check_flag) Hashtbl.t)
- (find_x : AstTabSymbol.t -> Ident.t -> Lxm.t -> ('x_info Lxm.srcflagged) AstTabSymbol.elt)
- (x_check_do : t -> 'x_key -> Lxm.t -> AstTabSymbol.t -> bool -> Ident.pack_name -> 'x_info srcflagged -> 'x_eff)
+ (find_x : AstTabSymbol.t -> Lv6Id.t -> Lxm.t -> ('x_info Lxm.srcflagged) AstTabSymbol.elt)
+ (x_check_do : t -> 'x_key -> Lxm.t -> AstTabSymbol.t -> bool -> Lv6Id.pack_name -> 'x_info srcflagged -> 'x_eff)
(x_builtin : t -> 'x_key -> Lxm.t -> 'x_eff)
(lookup_x_eff : ('x_key, 'x_eff Lic.check_flag) Hashtbl.t -> 'x_key -> Lxm.t -> 'x_eff)
(pack_of_x_key : 'x_key -> string )
@@ -184,7 +184,7 @@ let x_check
let x_def = match find_x x_pack_symbols xn lxm with
| AstTabSymbol.Local x_def -> x_def
| AstTabSymbol.Imported (lid,_) ->
- print_string ("*** " ^ (Ident.string_of_long2 lid) ^ "???\n" ^
+ print_string ("*** " ^ (Lv6Id.string_of_long2 lid) ^ "???\n" ^
(Lxm.details lxm));
assert false (* should not occur *)
in
@@ -229,18 +229,18 @@ let lookup_x_eff x_label id_of_x_key x_tab x_key lxm =
| Lic.Incorrect -> raise (BadCheckRef_error)
let (lookup_type_eff: (Lic.item_key, Lic.type_ Lic.check_flag) Hashtbl.t ->
- Ident.long -> Lxm.t -> Lic.type_) =
+ Lv6Id.long -> Lxm.t -> Lic.type_) =
lookup_x_eff "type ref " (fun k -> k)
-let (type_builtin : t -> Ident.long -> Lxm.t -> Lic.type_) =
+let (type_builtin : t -> Lv6Id.long -> Lxm.t -> Lic.type_) =
fun _ _ _ -> raise Not_found
let (lookup_const_eff:(Lic.item_key, Lic.const Lic.check_flag) Hashtbl.t ->
- Ident.long -> Lxm.t -> Lic.const) =
+ Lv6Id.long -> Lxm.t -> Lic.const) =
lookup_x_eff "const ref " (fun k -> k)
-let (const_builtin : t -> Ident.long -> Lxm.t -> Lic.const) =
+let (const_builtin : t -> Lv6Id.long -> Lxm.t -> Lic.const) =
fun _ _ _ -> raise Not_found
(*
@@ -302,8 +302,8 @@ let node_builtin (this: t) (key: Lic.node_key) (lxm: Lxm.t) : Lic.node_exp =
let solve_x_idref
x_check_interface x_check find_x x_label to_x_key this symbols
provide_flag currpack idr sargs lxm =
- let s = Ident.name_of_idref idr in
- match Ident.pack_of_idref idr with
+ let s = Lv6Id.name_of_idref idr in
+ match Lv6Id.pack_of_idref idr with
| Some p ->
if p = currpack
then x_check this (to_x_key currpack s) lxm
@@ -319,7 +319,7 @@ let solve_x_idref
else x_check this x_key lxm
| AstTabSymbol.Imported(fid,params) ->
- let (pi,si) = (Ident.pack_of_long fid, Ident.of_long fid) in
+ let (pi,si) = (Lv6Id.pack_of_long fid, Lv6Id.of_long fid) in
assert(params=[]); (* todo *)
x_check_interface this (to_x_key pi si) lxm
@@ -334,7 +334,7 @@ let solve_x_idref
let find_var_info lxm vars id =
try Hashtbl.find vars.vartable id
with Not_found ->
- raise (Compile_error (lxm,"\n*** Unknown ident: " ^ (Ident.to_string id)))
+ raise (Compile_error (lxm,"\n*** Unknown ident: " ^ (Lv6Id.to_string id)))
@@ -344,74 +344,74 @@ let find_var_info lxm vars id =
(** Tabulated version of [type_check_do]. *)
let rec type_check
(this: t)
- (key: Ident.long)
+ (key: Lv6Id.long)
(lxm: Lxm.t)
: Lic.type_ =
Verbose.exe ~flag:dbg (fun () ->
- Printf.printf "#DBG: licTab.type_check '%s'\n" (Ident.string_of_long2 key));
+ Printf.printf "#DBG: licTab.type_check '%s'\n" (Lv6Id.string_of_long2 key));
x_check this.types AstTabSymbol.find_type type_check_do type_builtin lookup_type_eff
- Ident.pack_of_long Ident.of_long this
+ Lv6Id.pack_of_long Lv6Id.of_long this
key lxm
(** Tabulated version of [const_check_do]. *)
and const_check
(this: t)
- (key: Ident.long)
+ (key: Lv6Id.long)
(lxm: Lxm.t)
: Lic.const =
Verbose.exe ~flag:dbg (fun() -> Printf.printf
- "#DBG: licTab.const_check '%s'\n" (Ident.string_of_long2 key));
+ "#DBG: licTab.const_check '%s'\n" (Lv6Id.string_of_long2 key));
x_check this.consts AstTabSymbol.find_const const_check_do const_builtin lookup_const_eff
- Ident.pack_of_long Ident.of_long this
+ Lv6Id.pack_of_long Lv6Id.of_long this
key lxm
(** Tabulated version of [type_check_interface_do]. *)
and type_check_interface
(this: t)
- (key: Ident.long)
+ (key: Lv6Id.long)
(lxm: Lxm.t)
: Lic.type_ =
Verbose.exe ~flag:dbg (fun() -> Printf.printf
- "#DBG: licTab.type_check_interface '%s'\n" (Ident.string_of_long2 key));
+ "#DBG: licTab.type_check_interface '%s'\n" (Lv6Id.string_of_long2 key));
x_check_interface
this.prov_types AstTabSymbol.find_type type_check type_check_interface_do
- type_builtin lookup_type_eff Ident.pack_of_long Ident.of_long this
+ type_builtin lookup_type_eff Lv6Id.pack_of_long Lv6Id.of_long this
key lxm
(** Tabulated version of [const_check_interface_do]. *)
and const_check_interface
(this: t)
- (key: Ident.long)
+ (key: Lv6Id.long)
(lxm: Lxm.t)
: Lic.const =
Verbose.exe ~flag:dbg (fun () -> Printf.printf
- "#DBG: licTab.const_check_interface '%s'\n" (Ident.string_of_long2 key));
+ "#DBG: licTab.const_check_interface '%s'\n" (Lv6Id.string_of_long2 key));
x_check_interface
this.prov_consts AstTabSymbol.find_const const_check const_check_interface_do
- const_builtin lookup_const_eff Ident.pack_of_long Ident.of_long this
+ const_builtin lookup_const_eff Lv6Id.pack_of_long Lv6Id.of_long this
key lxm
(** solving type and constant references *)
-and (solve_type_idref : t -> AstTabSymbol.t -> bool -> Ident.pack_name ->
- Ident.idref -> Lxm.t -> Lic.type_) =
+and (solve_type_idref : t -> AstTabSymbol.t -> bool -> Lv6Id.pack_name ->
+ Lv6Id.idref -> Lxm.t -> Lic.type_) =
fun this symbols provide_flag currpack idr lxm ->
solve_x_idref
type_check_interface type_check AstTabSymbol.find_type "type"
- (fun p id -> Ident.make_long p id)
+ (fun p id -> Lv6Id.make_long p id)
this symbols provide_flag currpack idr [] lxm
-and (solve_const_idref : t -> AstTabSymbol.t -> bool -> Ident.pack_name ->
- Ident.idref -> Lxm.t -> Lic.const) =
+and (solve_const_idref : t -> AstTabSymbol.t -> bool -> Lv6Id.pack_name ->
+ Lv6Id.idref -> Lxm.t -> Lic.const) =
fun this symbols provide_flag currpack idr lxm ->
solve_x_idref
const_check_interface const_check AstTabSymbol.find_const "const"
- (fun p id -> Ident.make_long p id)
+ (fun p id -> Lv6Id.make_long p id)
this symbols provide_flag currpack idr [] lxm
(* now the real work! *)
-and (type_check_interface_do: t -> Ident.long -> Lxm.t -> AstTabSymbol.t ->
- Ident.pack_name -> AstCore.type_info srcflagged ->
+and (type_check_interface_do: t -> Lv6Id.long -> Lxm.t -> AstTabSymbol.t ->
+ Lv6Id.pack_name -> AstCore.type_info srcflagged ->
Lic.type_) =
fun this type_name lxm prov_symbols pack_name type_def ->
(* We type check the interface and the body.
@@ -432,8 +432,8 @@ and (type_check_interface_do: t -> Ident.long -> Lxm.t -> AstTabSymbol.t ->
(Lic.string_of_type body_type_eff))))
-and (const_check_interface_do: t -> Ident.long -> Lxm.t -> AstTabSymbol.t ->
- Ident.pack_name -> AstCore.const_info srcflagged ->
+and (const_check_interface_do: t -> Lv6Id.long -> Lxm.t -> AstTabSymbol.t ->
+ Lv6Id.pack_name -> AstCore.const_info srcflagged ->
Lic.const) =
fun this cn lxm prov_symbols p const_def ->
let prov_const_eff = const_check_do this cn lxm prov_symbols true p const_def in
@@ -498,8 +498,8 @@ and (const_check_interface_do: t -> Ident.long -> Lxm.t -> AstTabSymbol.t ->
assert false
-and (type_check_do: t -> Ident.long -> Lxm.t -> AstTabSymbol.t -> bool ->
- Ident.pack_name -> AstCore.type_info srcflagged ->
+and (type_check_do: t -> Lv6Id.long -> Lxm.t -> AstTabSymbol.t -> bool ->
+ Lv6Id.pack_name -> AstCore.type_info srcflagged ->
Lic.type_) =
fun this type_name lxm symbols provide_flag pack_name type_def ->
try (
@@ -516,8 +516,8 @@ and (type_check_do: t -> Ident.long -> Lxm.t -> AstTabSymbol.t -> bool ->
match type_def.it with
| ArrayType _ -> finish_me " array handling "; assert false
| ExternalType s -> (
- let lid = Ident.make_long pack_name s in
- let idref = Ident.idref_of_long lid in
+ let lid = Lv6Id.make_long pack_name s in
+ let idref = Lv6Id.idref_of_long lid in
try
Abstract_type_eff (lid, id_solver.id2type idref lxm)
with e ->
@@ -525,12 +525,12 @@ and (type_check_do: t -> Ident.long -> Lxm.t -> AstTabSymbol.t -> bool ->
)
| AliasedType (s, texp) -> Ast2lic.of_type id_solver texp
| EnumType (s, clst) -> (
- let n = Ident.make_long pack_name s in
- let add_pack_name x = Ident.make_long pack_name x.it in
+ let n = Lv6Id.make_long pack_name s in
+ let add_pack_name x = Lv6Id.make_long pack_name x.it in
Enum_type_eff (n, List.map add_pack_name clst)
)
| StructType sti -> (
- let make_field (fname : Ident.t) =
+ let make_field (fname : Lv6Id.t) =
let field_def = Hashtbl.find sti.st_ftable fname in
let teff = Ast2lic.of_type id_solver field_def.it.fd_type in
match field_def.it.fd_value with
@@ -553,7 +553,7 @@ and (type_check_do: t -> Ident.long -> Lxm.t -> AstTabSymbol.t -> bool ->
"bad field value: tuple not allowed"))
)
in
- let n = Ident.make_long pack_name sti.st_name in
+ let n = Lv6Id.make_long pack_name sti.st_name in
let eff_fields = List.map make_field sti.st_flist in
Struct_type_eff (n, eff_fields)
)
@@ -567,8 +567,8 @@ and (type_check_do: t -> Ident.long -> Lxm.t -> AstTabSymbol.t -> bool ->
raise ( Recursion_error (root, ("type ref "^(Lxm.details lxm))::stack))
-and (const_check_do : t -> Ident.long -> Lxm.t -> AstTabSymbol.t -> bool ->
- Ident.pack_name -> AstCore.const_info srcflagged ->
+and (const_check_do : t -> Lv6Id.long -> Lxm.t -> AstTabSymbol.t -> bool ->
+ Lv6Id.pack_name -> AstCore.const_info srcflagged ->
Lic.const) =
fun this cn lxm symbols provide_flag currpack const_def ->
(* [cn] and [lxm] are used for recursion errors.
@@ -587,7 +587,7 @@ and (const_check_do : t -> Ident.long -> Lxm.t -> AstTabSymbol.t -> bool ->
let const_eff =
match const_def.it with
| ExternalConst (id, texp, val_opt) ->
- let lid = Ident.make_long currpack id in
+ let lid = Lv6Id.make_long currpack id in
let teff = Ast2lic.of_type id_solver texp in
if provide_flag then
match val_opt with
@@ -613,7 +613,7 @@ and (const_check_do : t -> Ident.long -> Lxm.t -> AstTabSymbol.t -> bool ->
(* indeed, how can a body constant be extern and have a value? *)
)
| EnumConst (id, texp) ->
- Enum_const_eff ((Ident.make_long currpack id), Ast2lic.of_type id_solver texp)
+ Enum_const_eff ((Lv6Id.make_long currpack id), Ast2lic.of_type id_solver texp)
| DefinedConst (id, texp_opt, vexp ) -> (
match (EvalConst.f id_solver vexp) with
@@ -650,7 +650,7 @@ and (const_check_do : t -> Ident.long -> Lxm.t -> AstTabSymbol.t -> bool ->
and (node_check_interface_do: t -> Lic.node_key -> Lxm.t ->
- AstTabSymbol.t -> Ident.pack_name -> AstCore.node_info srcflagged ->
+ AstTabSymbol.t -> Lv6Id.pack_name -> AstCore.node_info srcflagged ->
Lic.node_exp) =
fun this nk lxm symbols pn node_def ->
(* DEUX checks :
@@ -664,7 +664,7 @@ and (node_check_interface_do: t -> Lic.node_key -> Lxm.t ->
if t1 = t2 or t1 is abstract and and t2.
*)
let msg_prefix =
- ("provided node for " ^ (Ident.string_of_long2 (fst nk)) ^
+ ("provided node for " ^ (Lv6Id.string_of_long2 (fst nk)) ^
" is not compatible with its implementation: ")
in
let str_of_var = Lic.string_of_var_info in
@@ -737,7 +737,7 @@ and (node_check_interface_do: t -> Lic.node_key -> Lxm.t ->
(lxm: Lxm.t)
(symbols: AstTabSymbol.t)
(provide_flag: bool)
- (pack_name: Ident.pack_name)
+ (pack_name: Lv6Id.pack_name)
(node_def: AstCore.node_info srcflagged)
: Lic.node_exp =
(* START node_check_do *)
@@ -783,11 +783,11 @@ and (node_check_interface_do: t -> Lic.node_key -> Lxm.t ->
Verbose.exe ~level:3 (
fun () ->
Printf.printf "*** Dont find type %s in local_env\n"
- (Ident.string_of_idref id);
+ (Lv6Id.string_of_idref id);
Printf.printf "*** local_env.lenv_types contain def for: ";
Hashtbl.iter
(fun id t ->
- Printf.printf "%s, " (Ident.to_string id) )
+ Printf.printf "%s, " (Lv6Id.to_string id) )
local_env.lenv_types;
Printf.printf "\n";
flush stdout);
@@ -796,7 +796,7 @@ and (node_check_interface_do: t -> Lic.node_key -> Lxm.t ->
(fun id sargs lxm ->
(try
let (node_id,sargs) = IdSolver.lookup_node local_env id lxm in
- let node_id = Ident.idref_of_long node_id in
+ let node_id = Lv6Id.idref_of_long node_id in
solve_node_idref this symbols provide_flag pack_name node_id sargs lxm
(* node_check this (node_id,[]) lxm *)
@@ -815,7 +815,7 @@ and (node_check_interface_do: t -> Lic.node_key -> Lxm.t ->
(* building not aliased nodes *)
Verbose.exe ~level:3
(fun () -> Printf.printf
- "*** local_env while entering (make_node_eff %s):\n" (Ident.to_string id);
+ "*** local_env while entering (make_node_eff %s):\n" (Lv6Id.to_string id);
IdSolver.dump_local_env stderr local_env
);
(********************************************************)
@@ -823,11 +823,11 @@ and (node_check_interface_do: t -> Lic.node_key -> Lxm.t ->
(********************************************************)
(* init intermediate table *)
let sz = List.length node_def.it.loc_consts in
- let temp_const_eff_tab : (Ident.long, Lic.const Lic.check_flag) Hashtbl.t =
+ let temp_const_eff_tab : (Lv6Id.long, Lic.const Lic.check_flag) Hashtbl.t =
Hashtbl.create sz
in
let temp_const_def_tab :
- (Ident.t,(Lxm.t * AstCore.type_exp option * AstCore.val_exp)) Hashtbl.t =
+ (Lv6Id.t,(Lxm.t * AstCore.type_exp option * AstCore.val_exp)) Hashtbl.t =
Hashtbl.create sz
in
let init_local_const (lxm, cinfo) = (
@@ -894,8 +894,8 @@ and (node_check_interface_do: t -> Lic.node_key -> Lxm.t ->
(* is id a local const ? *)
try (
(* certainly NOT if id has a pack *)
- let id = if (Ident.pack_of_idref idrf = None)
- then Ident.name_of_idref idrf
+ let id = if (Lv6Id.pack_of_idref idrf = None)
+ then Lv6Id.name_of_idref idrf
else raise Not_found
in
let ce = treat_local_const id in
@@ -903,7 +903,7 @@ and (node_check_interface_do: t -> Lic.node_key -> Lxm.t ->
) with Not_found -> (
(* not a local constant -> search in global env *)
Verbose.printf ~level:3
- " * %s not a local const, should be global ?" (Ident.string_of_idref idrf);
+ " * %s not a local const, should be global ?" (Lv6Id.string_of_idref idrf);
let ce = node_id_solver.id2const idrf lxm in
Verbose.exe ~level:3 (fun() -> Printf.printf
" YES -> %s\n" (LicDump.string_of_const_eff ce));
@@ -953,7 +953,7 @@ and (node_check_interface_do: t -> Lic.node_key -> Lxm.t ->
Hashtbl.add local_env.lenv_vars id vi_eff;
vi_eff
in
- let (sort_vars : Ident.t list -> Ident.t list) =
+ let (sort_vars : Lv6Id.t list -> Lv6Id.t list) =
fun l ->
(* I cannot use List.sort as I only have a partial order on vars
-> hence I perform a topological sort *)
@@ -981,9 +981,9 @@ and (node_check_interface_do: t -> Lic.node_key -> Lxm.t ->
Compile_error (
lxm,
"\n*** Clock dependency loop: " ^
- (Ident.to_string v) ^ " depends on " ^
- (Ident.to_string v2) ^ ", which depends on " ^
- (Ident.to_string v))
+ (Lv6Id.to_string v) ^ " depends on " ^
+ (Lv6Id.to_string v2) ^ ", which depends on " ^
+ (Lv6Id.to_string v))
)
else
let l1,l2 = List.partition (fun v -> v=v2) l in
@@ -1155,7 +1155,7 @@ and (node_check_interface_do: t -> Lic.node_key -> Lxm.t ->
: node_exp
=
Verbose.printf ~level:3
- "*** Lic.make_alias_node %s \n" (Ident.long_to_string (fst alias_nk));
+ "*** Lic.make_alias_node %s \n" (Lv6Id.long_to_string (fst alias_nk));
flush stdout;
let (outs:left list) = List.map (fun vi -> LeftVarLic (vi, lxm)) vol in
@@ -1213,8 +1213,8 @@ and (node_check_interface_do: t -> Lic.node_key -> Lxm.t ->
(this: t)
(symbols: AstTabSymbol.t)
(provide_flag: bool)
- (currpack: Ident.pack_name)
- (idr: Ident.idref)
+ (currpack: Lv6Id.pack_name)
+ (idr: Lv6Id.idref)
(sargs: Lic.static_arg list)
(lxm: Lxm.t)
: Lic.node_exp =
@@ -1224,7 +1224,7 @@ and (node_check_interface_do: t -> Lic.node_key -> Lxm.t ->
(fun p id ->
(* builds a [node_key] from a [pack_name] and a [node] id,
and a Lic.static_arg list *)
- let long = Ident.make_long p id in
+ let long = Lv6Id.make_long p id in
let node_key = long, sargs in
node_key
)
@@ -1238,16 +1238,16 @@ and (node_check_interface_do: t -> Lic.node_key -> Lxm.t ->
Verbose.printf ~flag:dbg "#DBG: licTab.node_check '%s'\n" (Lic.string_of_node_key nk);
try (
- let pack_of_x_key = fun nk -> Ident.pack_of_long (fst nk) in
- let name_of_x_key = fun nk -> Ident.of_long (fst nk) in
+ let pack_of_x_key = fun nk -> Lv6Id.pack_of_long (fst nk) in
+ let name_of_x_key = fun nk -> Lv6Id.of_long (fst nk) in
x_check this.nodes AstTabSymbol.find_node node_check_do node_builtin lookup_node_exp_eff
pack_of_x_key
name_of_x_key
this nk lxm
) with
Recursion_error (n, stack) ->
- let msg = "Recursion loop detected in node " ^ (Ident.string_of_long2 (fst nk)) in
- let msg = msg ^ "\n*** "^ (Ident.string_of_long2 n) ^ " depends on itself\n "
+ let msg = "Recursion loop detected in node " ^ (Lv6Id.string_of_long2 (fst nk)) in
+ let msg = msg ^ "\n*** "^ (Lv6Id.string_of_long2 n) ^ " depends on itself\n "
^ (String.concat "\n*****" stack) in
raise (Compile_error (lxm, msg))
@@ -1259,8 +1259,8 @@ and (node_check_interface_do: t -> Lic.node_key -> Lxm.t ->
Verbose.printf ~flag:dbg "#DBG: licTab.node_check_interface '%s'\n" (Lic.string_of_node_key nk);
x_check_interface this.prov_nodes AstTabSymbol.find_node node_check
node_check_interface_do node_builtin lookup_node_exp_eff
- (fun nk -> Ident.pack_of_long (fst nk))
- (fun nk -> Ident.of_long (fst nk)) this nk
+ (fun nk -> Lv6Id.pack_of_long (fst nk))
+ (fun nk -> Lv6Id.of_long (fst nk)) this nk
lxm
@@ -1280,16 +1280,16 @@ let compile_all_item this label x_check_interface string_of_x_key
| AstTabSymbol.Imported(item_def,_) -> ()
(* Printf.printf "\t\t%s %s = %s (imported)\n" *)
-(* label (string_of_x_key (to_key id)) (Ident.string_of_long2 item_def) *)
+(* label (string_of_x_key (to_key id)) (Lv6Id.string_of_long2 item_def) *)
let compile_all_types pack_name this =
- compile_all_item this "type" type_check_interface Ident.string_of_long2
- Lic.string_of_type (fun id -> Ident.make_long pack_name id)
+ compile_all_item this "type" type_check_interface Lv6Id.string_of_long2
+ Lic.string_of_type (fun id -> Lv6Id.make_long pack_name id)
let compile_all_constants pack_name this =
- compile_all_item this "const" const_check_interface Ident.string_of_long
- LicDump.string_of_const_eff (fun id -> Ident.make_long pack_name id)
+ compile_all_item this "const" const_check_interface Lv6Id.string_of_long
+ LicDump.string_of_const_eff (fun id -> Lv6Id.make_long pack_name id)
let (get_static_params : (node_info Lxm.srcflagged) AstTabSymbol.elt ->
@@ -1306,7 +1306,7 @@ let compile_all_nodes pack_name this id ni_f =
compile_all_item this "node" node_check_interface
(LicDump.string_of_node_key_rec false )
Lic.profile_of_node_exp
- (fun id -> (Ident.make_long pack_name id, [])) id ni_f
+ (fun id -> (Lv6Id.make_long pack_name id, [])) id ni_f
(**** to_lic : translate the (finalized) internal structure
into a proper LicPrg, for forthcoming manip and other prg 2 prg
@@ -1319,14 +1319,14 @@ let to_lic_prg (this:t) : LicPrg.t =
(* normally, only checked and correct programs are lic'ified *)
let unflag = function Checked x -> x | _ -> assert false in
let add_item add_x k v prg =
- match Ident.pack_of_long k with
+ match Lv6Id.pack_of_long k with
| "Lustre" -> prg
| _ -> add_x k (unflag v) prg
in
let add_node k v prg =
Verbose.printf ~flag:dbg "#DBG: licTab.to_lic: node key '%s'\n"
(Lic.string_of_node_key k);
- match Ident.pack_of_long (fst k) with
+ match Lv6Id.pack_of_long (fst k) with
(* | "Lustre" -> prg *)
| _ -> LicPrg.add_node k (unflag v) prg
in
@@ -1341,7 +1341,7 @@ let to_lic_prg (this:t) : LicPrg.t =
*)
let compile_all (this:t) : t =
let testpack pack_name = (
- Verbose.printf ~level:3 " * package %s\n" (Ident.pack_name_to_string pack_name);
+ Verbose.printf ~level:3 " * package %s\n" (Lv6Id.pack_name_to_string pack_name);
let prov_symbols =
match AstTab.pack_prov_env this.src_tab pack_name (Lxm.dummy "") with
| Some tab -> tab
@@ -1365,20 +1365,20 @@ let compile_all (this:t) : t =
this
with
Recursion_error (n, stack) ->
- let msg = "Recursion loop detected in node " ^ (Ident.string_of_long2 n) in
+ let msg = "Recursion loop detected in node " ^ (Lv6Id.string_of_long2 n) in
let msg = msg ^ "\n*****" ^ (String.concat "\n*****" stack) in
raise (Compile_error (Lxm.dummy "", msg))
-let compile_node (this:t) (main_node:Ident.idref) : t =
+let compile_node (this:t) (main_node:Lv6Id.idref) : t =
(* la clée "absolue" du main node (pas d'args statiques) *)
let main_node_key = node_key_of_idref main_node in
Verbose.printf
"-- MAIN NODE: \"%s\"\n"
(LicDump.string_of_node_key_rec false main_node_key);
- let lxm = match Ident.pack_of_idref main_node with
+ let lxm = match Lv6Id.pack_of_idref main_node with
| None -> Lxm.dummy ""
- | Some pn -> Lxm.dummy (Ident.pack_name_to_string pn)
+ | Some pn -> Lxm.dummy (Lv6Id.pack_name_to_string pn)
in
let _ = node_check this main_node_key lxm in
this
diff --git a/src/licTab.mli b/src/licTab.mli
index fcce569d080b6b4b3281064a8de3e692f6720018..e9873da9254cff6f5941e11ab8ad073f8068b55b 100644
--- a/src/licTab.mli
+++ b/src/licTab.mli
@@ -1,4 +1,4 @@
-(* Time-stamp: <modified the 13/12/2012 (at 16:21) by Erwan Jahier> *)
+(* Time-stamp: <modified the 26/02/2015 (at 13:46) by Erwan Jahier> *)
(* nb: compiling = type checking + constant evaluation *)
@@ -15,10 +15,10 @@ type t
(** Create a lazy compiler. *)
val create : AstTab.t -> t
-exception Recursion_error of Ident.long * string list
+exception Recursion_error of Lv6Id.long * string list
(** Compiles one node (and update internal tables) *)
-val compile_node : t -> Ident.idref -> t
+val compile_node : t -> Lv6Id.idref -> t
(** compile all items (and update internal tables) *)
val compile_all : t -> t
diff --git a/src/lus2licRun.ml b/src/lus2licRun.ml
index bb9139fb4e682874c48b4b436a3be5bd1d234470..059f0a107ac7124116ab93cedcc328a3b7d077c6 100644
--- a/src/lus2licRun.ml
+++ b/src/lus2licRun.ml
@@ -1,4 +1,4 @@
-(* Time-stamp: <modified the 27/02/2015 (at 09:50) by Erwan Jahier> *)
+(* Time-stamp: <modified the 27/02/2015 (at 10:04) by Erwan Jahier> *)
(*-----------------------------------------------------------------------
** Copyright (C) - Verimag.
*)
@@ -20,17 +20,17 @@ let make argv =
exit 1
);
let new_dft_pack = Filename.basename (Filename.chop_extension (List.hd opt.infiles)) in
- Ident.set_dft_pack_name new_dft_pack;
+ Lv6Id.set_dft_pack_name new_dft_pack;
let main_node =
if opt.main_node = "" then None else
- Some (Ident.idref_of_string opt.main_node)
+ Some (Lv6Id.idref_of_string opt.main_node)
in
if opt.outfile <> "" then opt.oc <- open_out opt.outfile;
let nsl = Compile.get_source_list opt opt.infiles in
let lic_prg = Compile.doit opt nsl main_node in
- let nk = (Lic.node_key_of_idref (Ident.to_idref opt.main_node)) in
+ let nk = (Lic.node_key_of_idref (Lv6Id.to_idref opt.main_node)) in
let sk, soc_tbl =
if LicPrg.node_exists lic_prg nk then (
Lic2soc.f lic_prg nk
diff --git a/src/lv6errors.ml b/src/lv6errors.ml
index 9179d3f889f1ab485f7c24211f77eb8b9a34e36a..6e1b6146b78c2cca593184799b8e6e758d824b40 100644
--- a/src/lv6errors.ml
+++ b/src/lv6errors.ml
@@ -1,4 +1,4 @@
-(* Time-stamp: <modified the 25/02/2013 (at 17:09) by Erwan Jahier> *)
+(* Time-stamp: <modified the 26/02/2015 (at 11:22) by Erwan Jahier> *)
(** *)
@@ -93,7 +93,7 @@ Une erreur associ
exception Compile_error of Lxm.t * string
exception Unknown_constant of Lxm.t * string
-exception Unknown_var of Lxm.t * Ident.t
+exception Unknown_var of Lxm.t * Lv6Id.t
(** ---------------------------------------------------------------------
Une erreur plus generale
diff --git a/src/lv6parser.mly b/src/lv6parser.mly
index 3a55004a9775ffc8ceb5f49074e6e1bed810b27f..06f2e6d145b5f86e1d2eb0af644bc09532a68b62 100644
--- a/src/lv6parser.mly
+++ b/src/lv6parser.mly
@@ -214,28 +214,28 @@ ProvideList: Provide TK_SEMICOL /* ebnf:print=expand */
Provide:
/* constante abstraite */
- TK_CONST Ident TK_COLON Type ConstDefOpt
+ TK_CONST Lv6Id TK_COLON Type ConstDefOpt
{
Lxm.flagit
(ConstInfo (ExternalConst (Lxm.id $2, $4, $5)))
$2
}
/* noeud abstrait */
-| TK_UNSAFE TK_NODE Ident Params TK_RETURNS Params
+| TK_UNSAFE TK_NODE Lv6Id Params TK_RETURNS Params
{
treat_abstract_node true true $3 $4 $6
}
/* fonction abstraite */
-| TK_NODE Ident Params TK_RETURNS Params
+| TK_NODE Lv6Id Params TK_RETURNS Params
{
treat_abstract_node false true $2 $3 $5
}
/* fonction abstraite */
-| TK_UNSAFE TK_FUNCTION Ident Params TK_RETURNS Params
+| TK_UNSAFE TK_FUNCTION Lv6Id Params TK_RETURNS Params
{
treat_abstract_node true false $3 $4 $6
}
-| TK_FUNCTION Ident Params TK_RETURNS Params
+| TK_FUNCTION Lv6Id Params TK_RETURNS Params
{
treat_abstract_node false false $2 $3 $5
}
@@ -252,7 +252,7 @@ ConstDefOpt: /* ebnf:print=expand */
}
;
ModelDecl:
- TK_MODEL Ident
+ TK_MODEL Lv6Id
Uses
/* TK_NEEDS PackParamList TK_SEMICOL */
TK_NEEDS StaticParamList TK_SEMICOL
@@ -262,7 +262,7 @@ ModelDecl:
TK_END
{
let mdecl = {
- mo_name = (Ident.pack_name_of_string (Lxm.str $2));
+ mo_name = (Lv6Id.pack_name_of_string (Lxm.str $2));
mo_uses = $3 ;
mo_needs = (List.rev $5) ;
mo_provides = $7 ;
@@ -274,7 +274,7 @@ ModelDecl:
PackDecl:
- TK_PACKAGE Ident
+ TK_PACKAGE Lv6Id
Uses
Provides
TK_BODY
@@ -287,7 +287,7 @@ PackDecl:
pg_body = $6;
} in
let pdecl = {
- pa_name = (Ident.pack_name_of_string (Lxm.str $2));
+ pa_name = (Lv6Id.pack_name_of_string (Lxm.str $2));
pa_def = pdef;
} in
{it = pdecl; src = $2 }
@@ -306,7 +306,7 @@ PackParamList:
Uses:
/* nada */
{ [] }
-| TK_USES IdentList TK_SEMICOL
+| TK_USES Lv6IdList TK_SEMICOL
{
List.rev_map lexeme_to_pack_name_flagged $2
}
@@ -321,7 +321,7 @@ Eq_or_Is: TK_EQ {}
for backward compatibility
*/
PackEq:
- TK_PACKAGE Ident Eq_or_Is Ident TK_OPEN_PAR
+ TK_PACKAGE Lv6Id Eq_or_Is Lv6Id TK_OPEN_PAR
ByNameStaticArgList
TK_CLOSE_PAR TK_SEMICOL
{
@@ -330,7 +330,7 @@ PackEq:
pi_args = (List.rev $6);
} in
let pa = {
- pa_name = (Ident.pack_name_of_string (Lxm.str $2));
+ pa_name = (Lv6Id.pack_name_of_string (Lxm.str $2));
pa_def = pdef;
} in
{it = pa; src = $2 }
@@ -376,9 +376,9 @@ OneDecl: /* ebnf:print=short */
{ }
;
-/* Identifiers and lists */
+/* Lv6Idifiers and lists */
-IdentRef: /* ebnf:print=ignore */
+Lv6IdRef: /* ebnf:print=ignore */
/* simple or long ... */
TK_IDENT
{ idref_of_lxm $1 }
@@ -386,49 +386,49 @@ IdentRef: /* ebnf:print=ignore */
{ idref_of_lxm $1 }
;
-/* Identifiers and lists */
+/* Lv6Idifiers and lists */
-Ident: /* ebnf:print=ignore */
+Lv6Id: /* ebnf:print=ignore */
TK_IDENT Pragma
{ (Lv6parserUtils.make_ident $1 $2) }
;
-IdentList: /* ebnf:print=expand */
- Ident
+Lv6IdList: /* ebnf:print=expand */
+ Lv6Id
{ [$1] }
- | IdentList TK_COMA Ident
+ | Lv6IdList TK_COMA Lv6Id
{ $3::$1 }
;
-TypedIdentsList: TypedIdents
+TypedLv6IdsList: TypedLv6Ids
{ [ $1 ] }
- | TypedIdentsList TK_SEMICOL TypedIdents
+ | TypedLv6IdsList TK_SEMICOL TypedLv6Ids
{ $3::$1 }
;
-TypedIdents: IdentList TK_COLON Type
+TypedLv6Ids: Lv6IdList TK_COLON Type
/* WARNING ! il faut remettre la liste à l'endroit */
{ ((List.rev $1), $3 ) }
;
-TypedValuedIdents: TypedValuedIdent
+TypedValuedLv6Ids: TypedValuedLv6Id
{ $1 }
- | TypedValuedIdents TK_SEMICOL TypedValuedIdent
+ | TypedValuedLv6Ids TK_SEMICOL TypedValuedLv6Id
{ List.append $1 $3 }
;
-TypedValuedIdent :
+TypedValuedLv6Id :
/* Les listes d'idents en partie gauche sont
acceptées pour les idents SANS valeur
*/
- Ident TK_COLON Type
+ Lv6Id TK_COLON Type
{ (id_valopt_list_of_id_list [$1] $3 ) }
- | Ident TK_COMA IdentList TK_COLON Type
+ | Lv6Id TK_COMA Lv6IdList TK_COLON Type
{ (id_valopt_list_of_id_list ($1::(List.rev $3)) $5) }
/* Mais pas pour les constantes définies :
*/
- | Ident TK_COLON Type TK_EQ Expression
+ | Lv6Id TK_COLON Type TK_EQ Expression
{ [id_valopt_of_id_val $1 $3 $5] }
;
@@ -450,14 +450,14 @@ ConstDeclList:
OneConstDecl:
/* Les listes d'idents en partie gauche sont acceptées
pour les constantes externes : */
- Ident TK_COLON Type
+ Lv6Id TK_COLON Type
{ (make_external_const_list [$1] $3 ) }
- | Ident TK_COMA IdentList TK_COLON Type
+ | Lv6Id TK_COMA Lv6IdList TK_COLON Type
{ (make_external_const_list ($1::(List.rev $3)) $5) }
/* Mais pas pour les constantes définies : */
- | Ident TK_COLON Type TK_EQ Expression
+ | Lv6Id TK_COLON Type TK_EQ Expression
{ [ (make_defined_const $1 (Some $3) $5) ] }
- | Ident TK_EQ Expression
+ | Lv6Id TK_EQ Expression
{ [ (make_defined_const $1 (None) $3 ) ] }
;
@@ -477,21 +477,21 @@ TypeDeclList: OneTypeDecl TK_SEMICOL
/* returns a couple (lxm, type_info) */
OneTypeDecl:
/* type abstrait (externes) */
- Ident
+ Lv6Id
{ ($1, ExternalType (Lxm.id $1)) }
/* un alias sur type immédiat */
- | Ident TK_EQ Type
+ | Lv6Id TK_EQ Type
{ ($1, AliasedType ((Lxm.id $1), $3)) }
/* type énuméré */
/* WARNING ! il faut remettre la liste à l'endroit */
- | Ident TK_EQ TK_ENUM TK_OPEN_BRACE IdentList TK_CLOSE_BRACE
+ | Lv6Id TK_EQ TK_ENUM TK_OPEN_BRACE Lv6IdList TK_CLOSE_BRACE
{
let cstnamelist = List.rev_map lexeme_to_ident_flagged $5 in
($1, EnumType ((Lxm.id $1), cstnamelist))
}
/* type structure à champs nommés */
/* WARNING ! la liste est déjà à l'endroit */
- | Ident TK_EQ OptStruct TK_OPEN_BRACE TypedValuedIdents OptSemicol TK_CLOSE_BRACE
+ | Lv6Id TK_EQ OptStruct TK_OPEN_BRACE TypedValuedLv6Ids OptSemicol TK_CLOSE_BRACE
{
let typinfo = StructType (make_struct_type_info $1 $5) in
($1, typinfo)
@@ -513,7 +513,7 @@ Type:
| TK_INT { {src=$1; it=Int_type_exp } }
| TK_REAL { {src=$1; it=Real_type_exp } }
/* ref à un type nommé */
- | IdentRef { {src=$1.src; it= Named_type_exp $1.it } }
+ | Lv6IdRef { {src=$1.src; it= Named_type_exp $1.it } }
/* ou tableau immédiat */
| Type TK_HAT Expression
{ {src=$2; it=Array_type_exp ($1 , $3) } }
@@ -523,13 +523,13 @@ Type:
/* extern nodes */
ExtNodeDecl:
- TK_EXTERN TK_FUNCTION Ident Params TK_RETURNS Params OptSemicol
+ TK_EXTERN TK_FUNCTION Lv6Id Params TK_RETURNS Params OptSemicol
{ treat_external_node false false $3 $4 $6 }
-| TK_UNSAFE TK_EXTERN TK_FUNCTION Ident Params TK_RETURNS Params OptSemicol
+| TK_UNSAFE TK_EXTERN TK_FUNCTION Lv6Id Params TK_RETURNS Params OptSemicol
{ treat_external_node true false $4 $5 $7 }
-| TK_EXTERN TK_NODE Ident Params TK_RETURNS Params OptSemicol
+| TK_EXTERN TK_NODE Lv6Id Params TK_RETURNS Params OptSemicol
{ treat_external_node false true $3 $4 $6 }
-| TK_UNSAFE TK_EXTERN TK_NODE Ident Params TK_RETURNS Params OptSemicol
+| TK_UNSAFE TK_EXTERN TK_NODE Lv6Id Params TK_RETURNS Params OptSemicol
{ treat_external_node true true $4 $5 $7 }
;
@@ -538,25 +538,25 @@ ExtNodeDecl:
NodeDecl: LocalNode {};
LocalNode:
- TK_NODE Ident StaticParams Params TK_RETURNS Params OptSemicol
+ TK_NODE Lv6Id StaticParams Params TK_RETURNS Params OptSemicol
LocalDecls Body OptEndNode
{ treat_node_decl false true $2 $3 $4 $6 $8 (fst $9) (snd $9) }
- | TK_FUNCTION Ident StaticParams Params TK_RETURNS Params OptSemicol
+ | TK_FUNCTION Lv6Id StaticParams Params TK_RETURNS Params OptSemicol
LocalDecls Body OptEndNode
{ treat_node_decl false false $2 $3 $4 $6 $8 (fst $9) (snd $9) }
- | TK_NODE Ident StaticParams NodeProfileOpt TK_EQ EffectiveNode OptSemicol
+ | TK_NODE Lv6Id StaticParams NodeProfileOpt TK_EQ EffectiveNode OptSemicol
{ treat_node_alias false true $2 $3 $4 $6 }
- | TK_FUNCTION Ident StaticParams NodeProfileOpt TK_EQ EffectiveNode OptSemicol
+ | TK_FUNCTION Lv6Id StaticParams NodeProfileOpt TK_EQ EffectiveNode OptSemicol
{ treat_node_alias false false $2 $3 $4 $6 }
- | TK_UNSAFE TK_NODE Ident StaticParams Params TK_RETURNS Params OptSemicol
+ | TK_UNSAFE TK_NODE Lv6Id StaticParams Params TK_RETURNS Params OptSemicol
LocalDecls Body OptEndNode
{ treat_node_decl true true $3 $4 $5 $7 $9 (fst $10) (snd $10) }
- | TK_UNSAFE TK_FUNCTION Ident StaticParams Params TK_RETURNS Params OptSemicol
+ | TK_UNSAFE TK_FUNCTION Lv6Id StaticParams Params TK_RETURNS Params OptSemicol
LocalDecls Body OptEndNode
{ treat_node_decl true false $3 $4 $5 $7 $9 (fst $10) (snd $10) }
- | TK_UNSAFE TK_NODE Ident StaticParams NodeProfileOpt TK_EQ EffectiveNode OptSemicol
+ | TK_UNSAFE TK_NODE Lv6Id StaticParams NodeProfileOpt TK_EQ EffectiveNode OptSemicol
{ treat_node_alias true true $3 $4 $5 $7 }
- | TK_UNSAFE TK_FUNCTION Ident StaticParams NodeProfileOpt TK_EQ EffectiveNode OptSemicol
+ | TK_UNSAFE TK_FUNCTION Lv6Id StaticParams NodeProfileOpt TK_EQ EffectiveNode OptSemicol
{ treat_node_alias true false $3 $4 $5 $7 }
;
@@ -583,11 +583,11 @@ StaticParamList:
{ $3::$1 }
;
StaticParam:
- TK_TYPE Ident
+ TK_TYPE Lv6Id
{ {it=(StaticParamType (Lxm.id $2)); src=$2} }
- | TK_CONST Ident TK_COLON Type
+ | TK_CONST Lv6Id TK_COLON Type
{ {it=(StaticParamConst (Lxm.id $2 , $4)); src=$2} }
- | TK_NODE Ident Params TK_RETURNS Params
+ | TK_NODE Lv6Id Params TK_RETURNS Params
{
let invars = clocked_ids_to_var_infos VarInput $3 in
let outvars = clocked_ids_to_var_infos VarOutput $5 in
@@ -600,7 +600,7 @@ StaticParam:
) in
Lxm.flagit xn $2
}
- | TK_FUNCTION Ident Params TK_RETURNS Params
+ | TK_FUNCTION Lv6Id Params TK_RETURNS Params
{
let invars = clocked_ids_to_var_infos VarInput $3 in
let outvars = clocked_ids_to_var_infos VarOutput $5 in
@@ -613,7 +613,7 @@ StaticParam:
) in
Lxm.flagit xn $2
}
- | TK_UNSAFE TK_NODE Ident Params TK_RETURNS Params
+ | TK_UNSAFE TK_NODE Lv6Id Params TK_RETURNS Params
{
let invars = clocked_ids_to_var_infos VarInput $4 in
let outvars = clocked_ids_to_var_infos VarOutput $6 in
@@ -626,7 +626,7 @@ StaticParam:
) in
Lxm.flagit xn $3
}
- | TK_UNSAFE TK_FUNCTION Ident Params TK_RETURNS Params
+ | TK_UNSAFE TK_FUNCTION Lv6Id Params TK_RETURNS Params
{
let invars = clocked_ids_to_var_infos VarInput $4 in
let outvars = clocked_ids_to_var_infos VarOutput $6 in
@@ -721,21 +721,21 @@ VarDecl:
Pas de clock : sous-entendu sur la base
exemple: x, ..., z : type
*/
- TypedIdents
+ TypedLv6Ids
{ ([$1], Base) }
|
/*
Clock explicite sur UNE seule liste d'idents typés
exemple: x, ..., z : type when clock
*/
- TypedIdents TK_WHEN ClockExpr
+ TypedLv6Ids TK_WHEN ClockExpr
{ ([$1], $3) }
|
/*
Clock explicite sur PLUSIEURS listes d'idents typés
exemple: (x,..,z : t1 ; a,...,b : t2) when clock
*/
- TK_OPEN_PAR TypedIdentsList TK_CLOSE_PAR TK_WHEN ClockExpr
+ TK_OPEN_PAR TypedLv6IdsList TK_CLOSE_PAR TK_WHEN ClockExpr
/* WARNING ! il faut remettre la liste à l'endroit */
{ ( (List.rev $2), $5 ) }
;
@@ -782,7 +782,7 @@ LeftItemList: LeftItem
{ $3::$1 }
;
-LeftItem: Ident
+LeftItem: Lv6Id
{ LeftVar ( {src = $1; it = Lxm.id $1} ) }
| FieldLeftItem
{ $1 }
@@ -791,7 +791,7 @@ LeftItem: Ident
;
-FieldLeftItem: LeftItem TK_DOT Ident
+FieldLeftItem: LeftItem TK_DOT Lv6Id
{ LeftField ($1 , {src = $3; it = Lxm.id $3} ) }
;
@@ -808,7 +808,7 @@ TableLeftItem:
Expression:
/* zéroaires */
Constant { $1 }
- | IdentRef { leafexp $1.src (IDENT_n $1.it) }
+ | Lv6IdRef { leafexp $1.src (IDENT_n $1.it) }
/* unaires */
| TK_NOT Expression { unexp_predef $1 NOT_n $2 }
| TK_MINUS Expression %prec TK_UMINUS
@@ -866,7 +866,7 @@ Expression:
| Expression TK_OPEN_BRACKET Select TK_CLOSE_BRACKET
{ unexp $3.src (ARRAY_SLICE_n $3.it) $1 }
/* Acces aux structures */
- | Expression TK_DOT Ident
+ | Expression TK_DOT Lv6Id
{ unexp $2 (STRUCT_ACCESS_n (Lxm.id $3)) $1 }
/* Appels par noms */
| CallByNameExpression
@@ -875,7 +875,7 @@ Expression:
| TK_OPEN_PAR ExpressionList TK_CLOSE_PAR
{ if (List.length $2 = 1) then (List.hd $2) else naryexp $1 TUPLE_n (List.rev $2) }
/* merge */
- | TK_MERGE Ident MergeCaseList
+ | TK_MERGE Lv6Id MergeCaseList
{ make_merge_op $2 $3 }
;
@@ -887,7 +887,7 @@ MergeCaseList:
;
MergeCase:
- | TK_OPEN_PAR IdentRef TK_ARROW Expression TK_CLOSE_PAR
+ | TK_OPEN_PAR Lv6IdRef TK_ARROW Expression TK_CLOSE_PAR
{ (Idref $2.it,$2.src,$4) }
| TK_OPEN_PAR TK_TRUE TK_ARROW Expression TK_CLOSE_PAR
{ (Bool true, $2,$4) }
@@ -896,12 +896,12 @@ MergeCase:
;
ClockExpr:
- IdentRef TK_OPEN_PAR Ident TK_CLOSE_PAR
+ Lv6IdRef TK_OPEN_PAR Lv6Id TK_CLOSE_PAR
{ (make_clock_exp $1.it $3) }
- | Ident { (make_clock_exp (Ident.idref_of_string "Lustre::true") $1) }
- | TK_NOT Ident { (make_clock_exp (Ident.idref_of_string "Lustre::false") $2) }
- | TK_NOT TK_OPEN_PAR Ident TK_CLOSE_PAR
- { (make_clock_exp (Ident.idref_of_string "Lustre::false") $3) }
+ | Lv6Id { (make_clock_exp (Lv6Id.idref_of_string "Lustre::true") $1) }
+ | TK_NOT Lv6Id { (make_clock_exp (Lv6Id.idref_of_string "Lustre::false") $2) }
+ | TK_NOT TK_OPEN_PAR Lv6Id TK_CLOSE_PAR
+ { (make_clock_exp (Lv6Id.idref_of_string "Lustre::false") $3) }
;
PredefOp: /* ebnf:print=short */
@@ -953,10 +953,10 @@ CallByPosExpression:
EffectiveNode:
/* Juste un nom */
- IdentRef
+ Lv6IdRef
{ {src=$1.src; it=(($1.it, [])) } }
/* Un nom + des params statiques */
- | IdentRef TK_OPEN_STATIC_PAR StaticArgList TK_CLOSE_STATIC_PAR
+ | Lv6IdRef TK_OPEN_STATIC_PAR StaticArgList TK_CLOSE_STATIC_PAR
{ {src=$1.src; it=(($1.it, List.rev $3)) } }
/* Un operateur prédéfini
| TK_OPERATOR PredefOp,[]
@@ -1002,7 +1002,7 @@ StaticArg:
match $1 with
| CallByPos (op, x) -> (
match op.it with
- | IDENT_n idref -> {src=op.src ; it = StaticArgIdent idref }
+ | IDENT_n idref -> {src=op.src ; it = StaticArgLv6Id idref }
| _ -> {src=op.src ; it= StaticArgConst $1}
)
| Merge_bool_n _
@@ -1039,27 +1039,27 @@ ByNameStaticArgList:
ByNameStaticArg:
/* nature explicite */
- TK_TYPE Ident TK_EQ Type
+ TK_TYPE Lv6Id TK_EQ Type
{ (Lxm.id $2, {src=$1 ; it= StaticArgType $4 }) }
- | TK_CONST Ident TK_EQ Expression
+ | TK_CONST Lv6Id TK_EQ Expression
{ (Lxm.id $2, {src=$1 ; it= StaticArgConst $4 }) }
- | TK_NODE Ident TK_EQ EffectiveNode
+ | TK_NODE Lv6Id TK_EQ EffectiveNode
{ (Lxm.id $2, {src=$1 ; it= StaticArgNode (CALL_n $4) }) }
- | TK_FUNCTION Ident TK_EQ EffectiveNode
+ | TK_FUNCTION Lv6Id TK_EQ EffectiveNode
{ (Lxm.id $2, {src=$1 ; it= StaticArgNode (CALL_n $4) }) }
- | Ident TK_EQ PredefOp
+ | Lv6Id TK_EQ PredefOp
{ Lxm.id $1, {src=$3.src; it=StaticArgNode $3.it } }
/* un ident OU une expression simple (à résoudre) */
/* c'est au retour qu'on choisit */
- | Ident TK_EQ SimpleExp
+ | Lv6Id TK_EQ SimpleExp
{ Lxm.id $1,
match $3 with
| CallByPos (op, x) -> (
match op.it with
- | IDENT_n idref -> {src=op.src ; it = StaticArgIdent idref }
+ | IDENT_n idref -> {src=op.src ; it = StaticArgLv6Id idref }
| _ -> {src=op.src ; it= StaticArgConst $3}
)
| Merge_bool_n _
@@ -1069,14 +1069,14 @@ ByNameStaticArg:
assert false
}
/* un type sans ambiguite */
- | Ident TK_EQ SurelyType
+ | Lv6Id TK_EQ SurelyType
{ Lxm.id $1, {src=$3.src; it=StaticArgType $3} }
/* un node sans ambiguite */
- | Ident TK_EQ SurelyNode
+ | Lv6Id TK_EQ SurelyNode
{ Lxm.id $1, {src=$3.src; it=StaticArgNode (CALL_n $3)} }
;
-SurelyNode: IdentRef TK_OPEN_STATIC_PAR StaticArgList TK_CLOSE_STATIC_PAR
+SurelyNode: Lv6IdRef TK_OPEN_STATIC_PAR StaticArgList TK_CLOSE_STATIC_PAR
{ {src=$1.src; it=($1.it, List.rev $3) } }
;
@@ -1093,7 +1093,7 @@ SurelyType:
/* SimpleExp = (hopefuly) statically evaluable exp */
SimpleExp:
Constant { $1 }
- | IdentRef { leafexp $1.src (IDENT_n $1.it) }
+ | Lv6IdRef { leafexp $1.src (IDENT_n $1.it) }
| SimpleTuple { $1 }
| TK_NOT SimpleExp { unexp_predef $1 NOT_n $2 }
| TK_MINUS SimpleExp %prec TK_UMINUS { unexp_predef $1 UMINUS_n $2 }
@@ -1140,12 +1140,12 @@ donc pas de soucis d'
*/
CallByNameExpression:
/* WARNING ! il faut remettre la liste à l'endroit */
- | IdentRef TK_OPEN_BRACE CallByNameParamList OptSemicol TK_CLOSE_BRACE
+ | Lv6IdRef TK_OPEN_BRACE CallByNameParamList OptSemicol TK_CLOSE_BRACE
{ bynameexp $1.src (STRUCT_n $1.it) (List.rev $3) }
- | IdentRef TK_OPEN_BRACE IdentRef TK_WITH CallByNameParamList OptSemicol TK_CLOSE_BRACE
+ | Lv6IdRef TK_OPEN_BRACE Lv6IdRef TK_WITH CallByNameParamList OptSemicol TK_CLOSE_BRACE
{ bynameexp $1.src (STRUCT_WITH_n ($1.it,$3.it)) (List.rev $5) }
/* on peut avoir une liste vide */
- | IdentRef TK_OPEN_BRACE TK_CLOSE_BRACE
+ | Lv6IdRef TK_OPEN_BRACE TK_CLOSE_BRACE
{ bynameexp $1.src (STRUCT_n $1.it) ([]) }
/* COMPATIBILITY : immediate "struct" without the type name
| TK_OPEN_BRACE CallByNameParamList OptSemicol TK_CLOSE_BRACE
@@ -1170,7 +1170,7 @@ sepVariant: /* ebnf:print=expand */
CallByNameParam:
- Ident TK_EQ Expression
+ Lv6Id TK_EQ Expression
{ ({it=Lxm.id $1;src=$1} , $3) }
;
diff --git a/src/lv6parserUtils.ml b/src/lv6parserUtils.ml
index eca40500e140c2ec967e3d73d97a8522e8b856ec..ef8a48555463339e62915164c6b5e8ffd6935de5 100644
--- a/src/lv6parserUtils.ml
+++ b/src/lv6parserUtils.ml
@@ -1,4 +1,4 @@
-(* Time-stamp: <modified the 20/01/2015 (at 14:23) by Erwan Jahier> *)
+(* Time-stamp: <modified the 26/02/2015 (at 11:22) by Erwan Jahier> *)
(** *)
@@ -129,7 +129,7 @@ let idref_of_lxm lxm =
let name = (Lxm.str lxm) in
if name.[0] = '_' then (
Hashtbl.add name_table name ());
- try Lxm.flagit (Ident.idref_of_string name) lxm
+ try Lxm.flagit (Lv6Id.idref_of_string name) lxm
with _ ->
print_string ("Lv6parser.idref_of_lxm" ^(Lxm.str lxm));
assert false
@@ -138,7 +138,7 @@ let idref_of_lxm lxm =
(** Traitement des listes d'idents avec valeur éventuelle
(constantes, champs de struct etc...)
*)
-let (lexeme_to_ident_flagged: Lxm.t -> Ident.t Lxm.srcflagged) =
+let (lexeme_to_ident_flagged: Lxm.t -> Lv6Id.t Lxm.srcflagged) =
fun x -> {it = (Lxm.id x); src = x }
let (lexeme_to_val_exp_flagged: Lxm.t -> val_exp Lxm.srcflagged) =
@@ -147,15 +147,15 @@ let (lexeme_to_val_exp_flagged: Lxm.t -> val_exp Lxm.srcflagged) =
let ve = CallByPos({ it = IDENT_n idref.it ; src=x },Oper []) in
{it = ve; src = x }
-let (lexeme_to_pack_name_flagged:Lxm.t -> Ident.pack_name Lxm.srcflagged) =
- fun x -> {it = (Ident.pack_name_of_string (Lxm.str x)); src = x }
+let (lexeme_to_pack_name_flagged:Lxm.t -> Lv6Id.pack_name Lxm.srcflagged) =
+ fun x -> {it = (Lv6Id.pack_name_of_string (Lxm.str x)); src = x }
let (make_merge_bool_op : Lxm.t -> val_exp -> val_exp -> val_exp) =
fun enum_clk vet vef ->
Merge_bool_n(lexeme_to_val_exp_flagged enum_clk, vet, vef)
-type bool_or_idref = Bool of bool | Idref of Ident.idref
+type bool_or_idref = Bool of bool | Idref of Lv6Id.idref
(** Utilitaries to build [val_exp] *)
let make_merge_op (enum_clk:Lxm.t) (l:(bool_or_idref * Lxm.t * val_exp) list) =
match l with
@@ -176,7 +176,7 @@ let make_merge_op (enum_clk:Lxm.t) (l:(bool_or_idref * Lxm.t * val_exp) list) =
in
Merge_n(lexeme_to_val_exp_flagged enum_clk, l)
-let save_make_merge_op (enum_clk:Lxm.t) (l:(Ident.idref srcflagged * val_exp) list) =
+let save_make_merge_op (enum_clk:Lxm.t) (l:(Lv6Id.idref srcflagged * val_exp) list) =
let l = List.map (fun (idref,ve) -> idref,ve) l in
Merge_n(lexeme_to_val_exp_flagged enum_clk, l)
@@ -223,7 +223,7 @@ let naryexp_predef lxm op elst =
let bynameexp lxm op nelst = CallByName( {src = lxm ; it = op } , nelst )
-open Ident
+open Lv6Id
@@ -232,12 +232,12 @@ open Ident
-----------------------------------------------------------------------
Rôle :
proc générique pour mettre une info 'a dans
- une table (Ident.t, 'a srcflagged).
+ une table (Lv6Id.t, 'a srcflagged).
Effets de bord :
erreur de compil si déjà utilisé
*)
-let (add_info : (Ident.t, 'a srcflagged) Hashtbl.t ->
+let (add_info : (Lv6Id.t, 'a srcflagged) Hashtbl.t ->
string -> (* une string en cas d'erreur *)
Lxm.t -> (* le lexeme en question *)
'a -> (* l'info en question *)
@@ -263,9 +263,9 @@ let (add_info : (Ident.t, 'a srcflagged) Hashtbl.t ->
one or several of those tables.
*)
-let (const_table:(Ident.t, const_info srcflagged) Hashtbl.t) = Hashtbl.create 50
-let (type_table :(Ident.t, type_info srcflagged) Hashtbl.t) = Hashtbl.create 50
-let (node_table :(Ident.t, node_info srcflagged) Hashtbl.t) = Hashtbl.create 50
+let (const_table:(Lv6Id.t, const_info srcflagged) Hashtbl.t) = Hashtbl.create 50
+let (type_table :(Lv6Id.t, type_info srcflagged) Hashtbl.t) = Hashtbl.create 50
+let (node_table :(Lv6Id.t, node_info srcflagged) Hashtbl.t) = Hashtbl.create 50
let (def_list : item_ident list ref) = ref []
@@ -306,7 +306,7 @@ let (make_struct_type_info : Lxm.t -> id_valopt list (* la liste des champs *)
fun typlxm flexlist ->
(* On anticipe la construction de la table de champs *)
let ftab = Hashtbl.create 50 in
- let (put_in_ftab : (Lxm.t * type_exp * val_exp option) -> Ident.t) =
+ let (put_in_ftab : (Lxm.t * type_exp * val_exp option) -> Lv6Id.t) =
(* Traitement d'un champ élémentaire *)
fun (lx, ty, va) ->
(* fabrique le field_info *)
@@ -502,10 +502,10 @@ let (threat_slice_start : Lxm.t -> val_exp -> val_exp option -> slice_info srcfl
let int_to_val_exp istr =
try
ignore (int_of_string istr);
- let ic = flagit (ICONST_n (Ident.of_string(istr))) lxm in
+ let ic = flagit (ICONST_n (Lv6Id.of_string(istr))) lxm in
CallByPos(flagit (Predef_n (ic)) lxm, Oper [])
with _ ->
- CallByPos(flagit (IDENT_n (Ident.idref_of_string(istr))) lxm, Oper [])
+ CallByPos(flagit (IDENT_n (Lv6Id.idref_of_string(istr))) lxm, Oper [])
in
match Str.split (Str.regexp (Str.quote "..")) str with
| [first] ->
@@ -526,6 +526,6 @@ let (make_ident : Lxm.t -> pragma list -> Lxm.t) =
(**********************************************************************************)
-let (make_clock_exp : Ident.idref -> Lxm.t -> clock_exp) =
+let (make_clock_exp : Lv6Id.idref -> Lxm.t -> clock_exp) =
fun str v_lxm ->
- NamedClock( Lxm.flagit (Ident.long_of_idref str, (Lxm.id v_lxm)) v_lxm)
+ NamedClock( Lxm.flagit (Lv6Id.long_of_idref str, (Lxm.id v_lxm)) v_lxm)
diff --git a/src/lxm.ml b/src/lxm.ml
index 938a4221773af8697f5df22b8d23bb11f8375118..86adea53871d39a121795473b15c9dec773c6902 100644
--- a/src/lxm.ml
+++ b/src/lxm.ml
@@ -1,4 +1,4 @@
-(* Time-stamp: <modified the 12/04/2013 (at 08:47) by Erwan Jahier> *)
+(* Time-stamp: <modified the 26/02/2015 (at 11:22) by Erwan Jahier> *)
(** Common to lus2lic and lic2loc *)
@@ -22,7 +22,7 @@ type t = {
}
let str x = (x._str)
-let id x = (Ident.of_string x._str)
+let id x = (Lv6Id.of_string x._str)
let line x = (x._line)
let cstart x = (x._cstart)
let cend x = (x._cend)
diff --git a/src/lxm.mli b/src/lxm.mli
index 1cc04824bc4d0b5f26dc58c2765db94ad81cc810..bae67cdf8bb373376b788af3f08def21d39cc9bf 100644
--- a/src/lxm.mli
+++ b/src/lxm.mli
@@ -1,4 +1,4 @@
-(* Time-stamp: <modified the 13/12/2012 (at 14:34) by Erwan Jahier> *)
+(* Time-stamp: <modified the 26/02/2015 (at 13:45) by Erwan Jahier> *)
(** Lexemes *)
@@ -11,7 +11,7 @@ type pragma = Pragma of string * string
val dummy : string -> t
val str : t -> string
-val id : t -> Ident.t
+val id : t -> Lv6Id.t
val line : t -> int
val file : t -> string
val pragma : t -> pragma list
diff --git a/src/main.ml b/src/main.ml
index a0066e62d134b01e10b046438f01c52efbfc1b7e..44d6a181213e4998483967a42d51052c2fc221bd 100644
--- a/src/main.ml
+++ b/src/main.ml
@@ -1,4 +1,4 @@
-(* Time-stamp: <modified the 15/01/2015 (at 13:43) by Erwan Jahier> *)
+(* Time-stamp: <modified the 26/02/2015 (at 11:22) by Erwan Jahier> *)
open Verbose
open AstV6
@@ -32,13 +32,13 @@ let find_a_node opt =
name
-let (gen_rif_interface : LicPrg.t -> Ident.idref option -> Lv6MainArgs.t -> unit) =
+let (gen_rif_interface : LicPrg.t -> Lv6Id.idref option -> Lv6MainArgs.t -> unit) =
fun lic_prg main_node opt ->
let msk, zesoc, main_node =
match main_node with
| None -> (
let name = find_a_node opt in
- let main_node = Ident.to_idref name in
+ let main_node = Lv6Id.to_idref name in
let nk = (Lic.node_key_of_idref main_node) in
if LicPrg.node_exists lic_prg nk then (
output_string stdout ("WARNING: No main node is specified. I'll try with "
@@ -58,8 +58,8 @@ let (gen_rif_interface : LicPrg.t -> Ident.idref option -> Lv6MainArgs.t -> unit
in
let my_type_to_string t =
let str = Data.type_to_string t in
- let idref = Ident.idref_of_string str in
- (idref.Ident.id_id)
+ let idref = Lv6Id.idref_of_string str in
+ (idref.Lv6Id.id_id)
in
let soc = try Soc.SocMap.find msk zesoc with Not_found -> assert false in
let invars,outvars=soc.Soc.profile in
@@ -73,13 +73,13 @@ let (gen_rif_interface : LicPrg.t -> Ident.idref option -> Lv6MainArgs.t -> unit
(* Generates a lutin env and a lustre oracle for the node *)
-let (gen_autotest_files : LicPrg.t -> Ident.idref option -> Lv6MainArgs.t -> unit) =
+let (gen_autotest_files : LicPrg.t -> Lv6Id.idref option -> Lv6MainArgs.t -> unit) =
fun lic_prg main_node opt ->
let msk, zesoc, main_node =
match main_node with
| None -> (
let name = find_a_node opt in
- let main_node = Ident.to_idref name in
+ let main_node = Lv6Id.to_idref name in
let nk = (Lic.node_key_of_idref main_node) in
if LicPrg.node_exists lic_prg nk then (
output_string stdout ("WARNING: No main node is specified. I'll try with " ^ name ^"\n");
@@ -110,14 +110,14 @@ let (gen_autotest_files : LicPrg.t -> Ident.idref option -> Lv6MainArgs.t -> uni
let my_type_to_string range_flag t =
(* Remove the module name to have correct Lutin and lv4 type decl *)
let str = Data.type_to_string t in
- let idref = Ident.idref_of_string str in
+ let idref = Lv6Id.idref_of_string str in
(if range_flag then (
match t with
| Data.Real -> " real [-10000.0;10000.0]"
| Data.Int -> " int [-10000;10000]"
| Data.Enum(_, idl) -> " int [0;"^(string_of_int (List.length idl - 1)) ^"]"
- | _ -> idref.Ident.id_id
- ) else idref.Ident.id_id)
+ | _ -> idref.Lv6Id.id_id
+ ) else idref.Lv6Id.id_id)
in
let soc = try Soc.SocMap.find msk zesoc with Not_found -> assert false in
let invars,outvars=soc.Soc.profile in
@@ -125,7 +125,7 @@ let (gen_autotest_files : LicPrg.t -> Ident.idref option -> Lv6MainArgs.t -> uni
let outvars = SocVar.expand_profile true false outvars in
let invars_str = List.map (fun (n,t) -> n^":"^(my_type_to_string true t)) invars in
let outvars_str = List.map (fun (n,t) -> n^":"^(my_type_to_string false t)) outvars in
- let name = main_node.Ident.id_id in
+ let name = main_node.Lv6Id.id_id in
let lutin_file_name = ("_"^name^"_env.lut") in
let oc = open_out lutin_file_name in
Lv6util.dump_entete oc;
@@ -210,10 +210,10 @@ let main () = (
if opt.run_unit_test then (UnifyType.unit_test (); exit 0);
if (opt.infiles = []) then (Lv6MainArgs.usage stderr opt; exit 1);
let new_dft_pack = Filename.basename (Filename.chop_extension (List.hd opt.infiles)) in
- Ident.set_dft_pack_name new_dft_pack;
+ Lv6Id.set_dft_pack_name new_dft_pack;
let main_node =
- if opt.main_node = "" then None else Some (Ident.idref_of_string opt.main_node)
+ if opt.main_node = "" then None else Some (Lv6Id.idref_of_string opt.main_node)
in
if opt.outfile <> "" then opt.oc <- open_out opt.outfile;
(try (
@@ -232,7 +232,7 @@ let main () = (
(match main_node with
| None -> (
let name = find_a_node opt in
- let nk = (Lic.node_key_of_idref (Ident.to_idref name)) in
+ let nk = (Lic.node_key_of_idref (Lv6Id.to_idref name)) in
if LicPrg.node_exists lic_prg nk then (
print_string ("WARNING: No main node is specified. I'll try with " ^ name ^"\n");
flush stdout;
@@ -273,7 +273,7 @@ let main () = (
| Global_error s -> print_global_error s; my_exit opt 1
| Parse_error -> print_compile_error (Lxm.last_made ()) "syntax error"; my_exit opt 1
| Unknown_var(lxm,id) ->
- print_compile_error lxm ("unknown variable (" ^ (Ident.to_string id) ^")");
+ print_compile_error lxm ("unknown variable (" ^ (Lv6Id.to_string id) ^")");
my_exit opt 1
| Unknown_constant(lxm,str) ->
print_compile_error lxm ("unknown constant (" ^ str ^")");
diff --git a/src/misc.ml b/src/misc.ml
index d7ec3f99a4fe05d74a37ee71d0a5505b348b8e35..1b24c63fce59e35356bf3e78b3b385d4e5c632f4 100644
--- a/src/misc.ml
+++ b/src/misc.ml
@@ -1,4 +1,4 @@
-(* Time-stamp: <modified the 29/03/2013 (at 16:06) by Erwan Jahier> *)
+(* Time-stamp: <modified the 26/02/2015 (at 13:46) by Erwan Jahier> *)
open Lic
open Lxm
@@ -11,7 +11,7 @@ open Lxm
type filtered_left = Lic.var_info * Lxm.t * filter list
and filter =
| Slice of int * int * int * Lic.type_
- | Faccess of Ident.t * Lic.type_
+ | Faccess of Lv6Id.t * Lic.type_
| Aaccess of int * Lic.type_
let rec (left_eff_to_filtered_left: Lic.left Lxm.srcflagged -> filtered_left) =
diff --git a/src/myGenlex.ml b/src/myGenlex.ml
index d1fa2ac98fda75ab8759f1dc96dcb359f26e6c33..cd2f94c4d69da1aa14b19a274c20e7e90a09dfb9 100644
--- a/src/myGenlex.ml
+++ b/src/myGenlex.ml
@@ -63,7 +63,7 @@ let make_lexer keywords =
then
Kwd ((s, e), id)
else
- Ident ((s, e), id)
+ Lv6Id ((s, e), id)
and keyword_or_error c s e=
let id = String.make 1 c in
if
diff --git a/src/myGenlex.mli b/src/myGenlex.mli
index db168a2ced21ac3e9f46dde2b35849e45a41d288..1d6cc92fd187240244c3aa009a8cd5317219d250 100644
--- a/src/myGenlex.mli
+++ b/src/myGenlex.mli
@@ -44,14 +44,14 @@ type source_info = int * int (* line and column *)
(** The type of tokens. The lexical classes are: [Int] and [Float]
for integer and floating-point numbers; [String] for
string literals, enclosed in double quotes; [Char] for
- character literals, enclosed in single quotes; [Ident] for
+ character literals, enclosed in single quotes; [Lv6Id] for
identifiers (either sequences of letters, digits, underscores
and quotes, or sequences of ``operator characters'' such as
[+], [*], etc); and [Kwd] for keywords (either identifiers or
single ``special characters'' such as [(], [}], etc). *)
type token =
Kwd of source_info * string
- | Ident of source_info * string
+ | Lv6Id of source_info * string
| Int of source_info * int
| Float of source_info * float
| String of source_info * string
@@ -61,7 +61,7 @@ type token =
val make_lexer : string list -> char Stream.t -> token Stream.t
(** Construct the lexer function. The first argument is the list of
keywords. An identifier [s] is returned as [Kwd s] if [s]
- belongs to this list, and as [Ident s] otherwise.
+ belongs to this list, and as [Lv6Id s] otherwise.
A special character [s] is returned as [Kwd s] if [s]
belongs to this list, and cause a lexical error (exception
[Parse_error]) otherwise. Blanks and newlines are skipped.
diff --git a/src/soc.ml b/src/soc.ml
index d8156f548775fab5c1e0a8aac2f4a2dbe14957d0..f23393a09f791e123f0aa3d3e663451737170aa9 100644
--- a/src/soc.ml
+++ b/src/soc.ml
@@ -1,4 +1,4 @@
-(* Time-stamp: <modified the 11/02/2015 (at 16:59) by Erwan Jahier> *)
+(* Time-stamp: <modified the 26/02/2015 (at 11:23) by Erwan Jahier> *)
(** Synchronous Object Component *)
@@ -22,7 +22,7 @@ type key_opt =
| Nomore
| Slic of int * int * int (* for slices *)
| MemInit of var_expr (* for fby *)
- | Curr of Ident.long (* clock constructor for current *)
+ | Curr of Lv6Id.long (* clock constructor for current *)
type key =
ident *
diff --git a/src/soc2c.ml b/src/soc2c.ml
index d6bbf5a00a914effa4172cfdeacbbd81d84bc0e6..4cd2ffd6bbf0b27ff5eb04bd708cdf4bede80987 100644
--- a/src/soc2c.ml
+++ b/src/soc2c.ml
@@ -1,4 +1,4 @@
-(* Time-stamp: <modified the 12/02/2015 (at 17:31) by Erwan Jahier> *)
+(* Time-stamp: <modified the 26/02/2015 (at 13:47) by Erwan Jahier> *)
(* let put (os: out_channel) (fmt:('a, unit, string, unit) format4) : 'a = *)
@@ -302,7 +302,7 @@ let rec (const_to_c: Lic.const -> string) =
| Lic.Struct_const_eff (fl, t) -> (
let string_of_field =
function (id, veff) ->
- (Ident.to_string id)^" = "^ (const_to_c veff)
+ (Lv6Id.to_string id)^" = "^ (const_to_c veff)
in
let flst = List.map string_of_field fl in
(* (string_of_type_eff t)^ *)
diff --git a/src/soc2cDep.mli b/src/soc2cDep.mli
index 1174af789e1e9633ad2da338f24fefd19a2b98a3..ccb922b35958b3126c43b429f8ba98b5c5545290 100644
--- a/src/soc2cDep.mli
+++ b/src/soc2cDep.mli
@@ -1,4 +1,4 @@
-(* Time-stamp: <modified the 09/02/2015 (at 16:47) by Erwan Jahier> *)
+(* Time-stamp: <modified the 26/02/2015 (at 13:45) by Erwan Jahier> *)
(** Choose between the various C code generators (heap-based, Stack
@@ -27,7 +27,7 @@ val string_of_var_expr: Soc.t -> Soc.var_expr -> string
(* [ctx_var vk id] *)
-val ctx_var : Soc2cUtil.var_kind -> Soc.t -> Ident.t -> string
+val ctx_var : Soc2cUtil.var_kind -> Soc.t -> Lv6Id.t -> string
(* [gen_step_call soc called_soc vel_out vel_in ctx sname step_arg]
Generates the C code that performs the call to a step method of
diff --git a/src/soc2cExtern.ml b/src/soc2cExtern.ml
index 832c00573d0bb3e1464e73fe7e4a8a02bb4824d5..33c59762e9482af2a815ef011d8e24d0ec583182 100644
--- a/src/soc2cExtern.ml
+++ b/src/soc2cExtern.ml
@@ -1,4 +1,4 @@
-(* Time-stamp: <modified the 06/02/2015 (at 16:07) by Erwan Jahier> *)
+(* Time-stamp: <modified the 26/02/2015 (at 11:23) by Erwan Jahier> *)
open Soc2cIdent
diff --git a/src/soc2cGenAssign.ml b/src/soc2cGenAssign.ml
index a8ff2a5c2e65fe7bdb45df8d7bfc2f2672d3a1bf..b5f1453a391f3998aad55803c403f98e759f6e83 100644
--- a/src/soc2cGenAssign.ml
+++ b/src/soc2cGenAssign.ml
@@ -1,4 +1,4 @@
-(* Time-stamp: <modified the 08/10/2014 (at 18:23) by Erwan Jahier> *)
+(* Time-stamp: <modified the 26/02/2015 (at 13:48) by Erwan Jahier> *)
open Data
open Lic
diff --git a/src/soc2cHeap.ml b/src/soc2cHeap.ml
index fc47832ef70c1687eb35249eddf4b24e348c80bf..1b8ddce6b8601259b60fb7d263453334ea5f6f4b 100644
--- a/src/soc2cHeap.ml
+++ b/src/soc2cHeap.ml
@@ -1,4 +1,4 @@
-(* Time-stamp: <modified the 13/02/2015 (at 16:01) by Erwan Jahier> *)
+(* Time-stamp: <modified the 26/02/2015 (at 13:47) by Erwan Jahier> *)
open Soc2cUtil
open Soc2cIdent
@@ -60,7 +60,7 @@ let (step_name : Soc.key -> string -> string) =
let str = Printf.sprintf "%s_%s" (Soc2cIdent.get_soc_name sk) sm in
id2s str
-let (ctx_var : var_kind -> Soc.t -> Ident.t -> string) =
+let (ctx_var : var_kind -> Soc.t -> Lv6Id.t -> string) =
fun opt soc id ->
match opt with
| ML_IO sk -> Printf.sprintf "%s_ctx.%s" (Soc2cIdent.get_soc_name sk) (id2s id)
diff --git a/src/soc2cHeap.mli b/src/soc2cHeap.mli
index 205e3cc9d0b33ccc73c5e577b2ce06e1b43fd5eb..777258852de74c2df31569c4e371925ccf1af5d0 100644
--- a/src/soc2cHeap.mli
+++ b/src/soc2cHeap.mli
@@ -1,4 +1,4 @@
-(* Time-stamp: <modified the 13/02/2015 (at 15:37) by Erwan Jahier> *)
+(* Time-stamp: <modified the 26/02/2015 (at 13:46) by Erwan Jahier> *)
(** Gathers all entities (functions, types) that implement the
heap-based C generator. *)
@@ -19,7 +19,7 @@ val string_of_var_expr: Soc.t -> Soc.var_expr -> string
(* [ctx_var vk id] *)
-val ctx_var : Soc2cUtil.var_kind -> Soc.t -> Ident.t -> string
+val ctx_var : Soc2cUtil.var_kind -> Soc.t -> Lv6Id.t -> string
(* [gen_step_call soc called_soc vel_out vel_in ctx sname step_arg]
Generates the C code that performs the call to a step method of
diff --git a/src/soc2cIdent.ml b/src/soc2cIdent.ml
index 13eaf6b1e3a3189f8da4b03b0ad08620235520fc..d088eb84f9bd3493d680c5f8f126a1232e9f8b73 100644
--- a/src/soc2cIdent.ml
+++ b/src/soc2cIdent.ml
@@ -1,4 +1,4 @@
-(* Time-stamp: <modified the 28/01/2015 (at 15:18) by Erwan Jahier> *)
+(* Time-stamp: <modified the 26/02/2015 (at 11:24) by Erwan Jahier> *)
open Soc
let colcol = Str.regexp "::"
@@ -14,7 +14,7 @@ let id2s id = (* XXX Refuser les noms de module à la con plutot *)
let str = Str.global_replace colcol "_" str in
str
-let long2s l = id2s (Ident.string_of_long l)
+let long2s l = id2s (Lv6Id.string_of_long l)
let rec (type_to_short_string : Data.t -> string) =
fun v ->
diff --git a/src/soc2cStack.ml b/src/soc2cStack.ml
index 489bfb13101adf8d4c38c901f4ede067a3aa46f9..d92738097008a8b2db9ea5f505a7bbcd3f4f2fc3 100644
--- a/src/soc2cStack.ml
+++ b/src/soc2cStack.ml
@@ -1,4 +1,4 @@
-(* Time-stamp: <modified the 13/02/2015 (at 15:38) by Erwan Jahier> *)
+(* Time-stamp: <modified the 26/02/2015 (at 11:24) by Erwan Jahier> *)
open Soc2cUtil
open Soc2cIdent
@@ -97,7 +97,7 @@ let (step_name : Soc.key -> string -> string) =
let str = Printf.sprintf "%s_%s" (Soc2cIdent.get_soc_name sk) sm in
id2s str
-let (ctx_var : var_kind -> Soc.t -> Ident.t -> string) =
+let (ctx_var : var_kind -> Soc.t -> Lv6Id.t -> string) =
fun opt soc id ->
if mem_interface_out soc id then
Printf.sprintf "*%s" (id2s id)
diff --git a/src/soc2cStack.mli b/src/soc2cStack.mli
index f310673a9bb75e603f3685f3d8f776728fd94d03..b6ab42c5c3930400d0a6e045bfe486a3a0864f9f 100644
--- a/src/soc2cStack.mli
+++ b/src/soc2cStack.mli
@@ -1,4 +1,4 @@
-(* Time-stamp: <modified the 13/02/2015 (at 15:38) by Erwan Jahier> *)
+(* Time-stamp: <modified the 26/02/2015 (at 13:46) by Erwan Jahier> *)
(** Gathers all entities (functions, types) that implement the
heap-based C generator. *)
@@ -27,7 +27,7 @@ val string_of_var_expr: Soc.t -> Soc.var_expr -> string
(* [ctx_var vk id] *)
-val ctx_var : Soc2cUtil.var_kind -> Soc.t -> Ident.t -> string
+val ctx_var : Soc2cUtil.var_kind -> Soc.t -> Lv6Id.t -> string
(** [gen_step_call soc called_soc vel_out vel_in ctx sname step_arg]
Generates the C code that performs the call to a step method of
diff --git a/src/socExec.ml b/src/socExec.ml
index b36558edfaa5524b63df9cb2c1bc1fc78d4467e7..17f7030add7a167c712113ecd3ceaf00b6eba7de 100644
--- a/src/socExec.ml
+++ b/src/socExec.ml
@@ -1,4 +1,4 @@
-(* Time-stamp: <modified the 14/08/2014 (at 17:16) by Erwan Jahier> *)
+(* Time-stamp: <modified the 26/02/2015 (at 11:25) by Erwan Jahier> *)
open Soc
open Data
@@ -167,7 +167,7 @@ and (do_gao : Lxm.t -> Soc.tbl -> SocExecValue.ctx -> gao -> SocExecValue.ctx)
let ctx = { ctx with cpath = path_saved } in
ctx
)
-and (do_step : Ident.t -> step_method -> SocExecValue.ctx -> Soc.tbl -> Soc.t ->
+and (do_step : Lv6Id.t -> step_method -> SocExecValue.ctx -> Soc.tbl -> Soc.t ->
var_expr list -> var_expr list -> SocExecValue.ctx) =
fun name step ctx soc_tbl soc vel_in vel_out ->
let soc_in_vars, soc_out_vars = soc.profile in
diff --git a/src/socPredef.ml b/src/socPredef.ml
index 70fd339176c4566bc146c5171fe0fe6bbb45c974..34ab39e5ff95840dd7250534ef1f58243e9dd3f3 100644
--- a/src/socPredef.ml
+++ b/src/socPredef.ml
@@ -1,4 +1,4 @@
-(* Time-stamp: <modified the 14/01/2015 (at 15:01) by Erwan Jahier> *)
+(* Time-stamp: <modified the 26/02/2015 (at 11:25) by Erwan Jahier> *)
(** Synchronous Object Code for Predefined operators. *)
@@ -189,7 +189,7 @@ let of_soc_key : Soc.key -> Soc.t =
impl =
Gaol([],
[Case((fst cv),[
- (Ident.string_of_long2 cc, [Call([Var(mem)], Assign, [Var(vin)])])]);
+ (Lv6Id.string_of_long2 cc, [Call([Var(mem)], Assign, [Var(vin)])])]);
Call([Var(vout)], Assign, [Var(mem)])])
};
];
@@ -487,7 +487,7 @@ let (soc_interface_of_pos_op:
instanciate_soc soc concrete_type
| Lic.PREDEF_CALL {Lxm.it=(op,sargs)}, _, _ ->
assert (sargs=[]);
- let soc_name = Ident.string_of_long op in
+ let soc_name = Lv6Id.string_of_long op in
let out_type = output_type_of_op soc_name types in
let soc = of_soc_key (soc_name, types@[out_type], Nomore) in
soc
diff --git a/src/socUtils.ml b/src/socUtils.ml
index a0d166de82a4bf743557ecb9a4cf6d1d1327585f..fddae5f2fef6c8759d108812eededf6f2158d773 100644
--- a/src/socUtils.ml
+++ b/src/socUtils.ml
@@ -1,4 +1,4 @@
-(** Time-stamp: <modified the 06/02/2015 (at 15:59) by Erwan Jahier> *)
+(** Time-stamp: <modified the 26/02/2015 (at 11:25) by Erwan Jahier> *)
open Soc
@@ -81,7 +81,7 @@ let string_of_soc_key_ff: (Soc.key -> Format.formatter -> unit) =
(String.concat " -> " (List.map string_of_type_ref types)));
(match si_opt with
| Nomore -> ()
- | Curr(cc) -> fprintf ff "%s" (Ident.string_of_long2 cc)
+ | Curr(cc) -> fprintf ff "%s" (Lv6Id.string_of_long2 cc)
| Slic(f,l,step) -> fprintf ff "[%d .. %d step %d]" f l step
| MemInit ve -> string_of_filter_ff ve ff
)
diff --git a/src/sortActions.ml b/src/sortActions.ml
index 08cbc022bf5fc3a314473a9c70cc28810f70d26c..262654fb0377e167096c2d93713c5003ef5357ca 100644
--- a/src/sortActions.ml
+++ b/src/sortActions.ml
@@ -1,4 +1,4 @@
-(** Time-stamp: <modified the 26/01/2015 (at 11:24) by Erwan Jahier> *)
+(** Time-stamp: <modified the 26/02/2015 (at 11:25) by Erwan Jahier> *)
(** topological sort of actions (that may optimize test openning) *)
@@ -81,7 +81,7 @@ let rec (gao_of_action: Action.t -> Soc.gao) =
| Lic.BaseLic -> acc
| Lic.ClockVar i -> acc (* should not occur? *)
| Lic.On((value, cvar, _ctyp), outter_clock) ->
- let cc = Ident.string_of_long2 value in
+ let cc = Lv6Id.string_of_long2 value in
let acc = Soc.Case (cvar, [cc, [acc]]) in
unpack_clock acc outter_clock
in
diff --git a/src/unifyClock.ml b/src/unifyClock.ml
index 9d1bd4131cd1608565f55f8ee6171925b94f6816..415c2aba1b675c680a9d83eb7f54b503ba563bbb 100644
--- a/src/unifyClock.ml
+++ b/src/unifyClock.ml
@@ -1,4 +1,4 @@
-(* Time-stamp: <modified the 26/08/2014 (at 16:51) by Erwan Jahier> *)
+(* Time-stamp: <modified the 26/02/2015 (at 11:25) by Erwan Jahier> *)
(* XXX a revoir et faire comme expliqué ici :
http://www.cs.cornell.edu/courses/cs3110/2011sp/lectures/lec26-type-inference/type-inference.htm
@@ -30,7 +30,7 @@ let dbg = (Verbose.get_flag "clocking")
let ci2str = LicDump.string_of_clock2
(* exported *)
-type subst1 = (Ident.t * Ident.t) list
+type subst1 = (Lv6Id.t * Lv6Id.t) list
(**
A dedicated kind of substitution tailored to deal with clock variables
@@ -98,7 +98,7 @@ let (subst2_to_string : subst2 -> string) =
let (subst_to_string : subst -> string) =
fun (s1,s2) ->
- let v2s = Ident.to_string in
+ let v2s = Lv6Id.to_string in
let s2str = subst2_to_string s2 in
(String.concat ", " (List.map (fun (v1,v2) -> (v2s v1) ^ "/" ^ (v2s v2)) s1)) ^
(if s2str = "" then "" else (" " ^ s2str))
@@ -109,7 +109,7 @@ let (subst_to_string : subst -> string) =
let (empty_subst2:subst2) = { cpt = 0 ; cv_tbl = IntMap.empty }
let (empty_subst:subst) = [], empty_subst2
-let (add_subst1 : Ident.t -> Ident.t -> subst1 -> subst1) =
+let (add_subst1 : Lv6Id.t -> Lv6Id.t -> subst1 -> subst1) =
fun id1 id2 s ->
if List.mem_assoc id1 s then s else (id1,id2)::s
@@ -148,7 +148,7 @@ let (add_subst2 : int -> Lic.clock -> subst2 -> subst2) =
-let (find_subst1 : Ident.t -> subst1 -> Ident.t option) =
+let (find_subst1 : Lv6Id.t -> subst1 -> Lv6Id.t option) =
fun id s ->
try Some (List.assoc id s) with Not_found -> None
diff --git a/src/unifyClock.mli b/src/unifyClock.mli
index d2efdca9cba6a6e2ef122cfb51e5747a82adf531..86832710422420f9ae2b5c020a650808288f0075 100644
--- a/src/unifyClock.mli
+++ b/src/unifyClock.mli
@@ -1,4 +1,4 @@
-(* Time-stamp: <modified the 26/08/2014 (at 16:00) by Erwan Jahier> *)
+(* Time-stamp: <modified the 26/02/2015 (at 13:46) by Erwan Jahier> *)
(** Sub module of EvalClock that defines clock-checking utilities.
@@ -22,11 +22,11 @@
XXX Make subst abstract?
*)
-type subst1 = (Ident.t * Ident.t) list
+type subst1 = (Lv6Id.t * Lv6Id.t) list
type subst2
type subst = subst1 * subst2
-(* = (Ident.t * Ident.t) list * (int * Lic.clock) list *)
+(* = (Lv6Id.t * Lv6Id.t) list * (int * Lic.clock) list *)
val empty_subst : subst
diff --git a/src/unifyType.ml b/src/unifyType.ml
index 8fd3a1cb1d6fa7f365ed48e2fcf7497a3ecf2b8e..9dd4b16c95927f503184e5caba71a0be2e810446 100644
--- a/src/unifyType.ml
+++ b/src/unifyType.ml
@@ -1,4 +1,4 @@
-(* Time-stamp: <modified the 13/08/2014 (at 09:40) by Erwan Jahier> *)
+(* Time-stamp: <modified the 26/02/2015 (at 11:25) by Erwan Jahier> *)
(*
12/07. Premier pas vers une méthode un peu plus standard :
@@ -173,12 +173,12 @@ let is_matched (expect_l: Lic.type_ list) (given_l: Lic.type_ list) : Lic.type_m
let i = Int_type_eff
let r = Real_type_eff
let b = Bool_type_eff
-let e = External_type_eff (Ident.long_of_string "Toto::t")
+let e = External_type_eff (Lv6Id.long_of_string "Toto::t")
let o = TypeVar AnyNum
let a = (TypeVar Any)
let array t c = Array_type_eff(t,c)
-let struc t = Struct_type_eff ((Ident.long_of_string "T::t"),
- [(Ident.of_string "x"),(t,None)])
+let struc t = Struct_type_eff ((Lv6Id.long_of_string "T::t"),
+ [(Lv6Id.of_string "x"),(t,None)])
let unify_failed = function Ko(_) -> true | _ -> false
let to_string = function
@@ -269,7 +269,7 @@ let (profile_is_compatible: node_key -> Lxm.t -> Lic.type_ list * Lic.type_ list
| Abstract_type_eff(name, _) -> (TypeVar Any)
| t -> t
in
- let msg_prefix = ("provided node for " ^ (Ident.string_of_long2 (fst nk)) ^
+ let msg_prefix = ("provided node for " ^ (Lv6Id.string_of_long2 (fst nk)) ^
" is not compatible with its implementation: ")
in
let apply_subst s t = try List.assoc t s with Not_found -> t in
diff --git a/test/lus2lic.sum b/test/lus2lic.sum
index 0c334309a306f3737ce02d70ee2ab2a32ca79086..f29d16704692090b111696ece791a7bc3fda20f6 100644
--- a/test/lus2lic.sum
+++ b/test/lus2lic.sum
@@ -1,5 +1,5 @@
==> lus2lic0.sum <==
-Test Run By jahier on Thu Feb 26 09:56:45
+Test Run By jahier on Fri Feb 27 09:29:00
Native configuration is x86_64-unknown-linux-gnu
=== lus2lic0 tests ===
@@ -63,7 +63,7 @@ XFAIL: Test bad programs (assert): test_lus2lic_no_node should_fail/assert/lecte
XFAIL: Test bad programs (assert): test_lus2lic_no_node should_fail/assert/s.lus
==> lus2lic1.sum <==
-Test Run By jahier on Thu Feb 26 09:56:50
+Test Run By jahier on Fri Feb 27 09:29:05
Native configuration is x86_64-unknown-linux-gnu
=== lus2lic1 tests ===
@@ -397,7 +397,7 @@ PASS: gcc -o multipar.exec multipar_multipar.c multipar_multipar_loop.c
PASS: /home/jahier/lus2lic/test/../utils/compare_exec_and_2c multipar.lus {}
==> lus2lic2.sum <==
-Test Run By jahier on Thu Feb 26 09:57:27
+Test Run By jahier on Fri Feb 27 09:29:43
Native configuration is x86_64-unknown-linux-gnu
=== lus2lic2 tests ===
@@ -727,7 +727,7 @@ PASS: gcc -o zzz2.exec zzz2_zzz2.c zzz2_zzz2_loop.c
PASS: /home/jahier/lus2lic/test/../utils/compare_exec_and_2c zzz2.lus {}
==> lus2lic3.sum <==
-Test Run By jahier on Thu Feb 26 09:58:37
+Test Run By jahier on Fri Feb 27 09:31:01
Native configuration is x86_64-unknown-linux-gnu
=== lus2lic3 tests ===
@@ -1230,7 +1230,7 @@ PASS: ./myec2c {-o multipar.c multipar.ec}
PASS: /home/jahier/lus2lic/test/../utils/test_lus2lic_no_node multipar.lus {}
==> lus2lic4.sum <==
-Test Run By jahier on Thu Feb 26 09:59:20
+Test Run By jahier on Fri Feb 27 09:31:53
Native configuration is x86_64-unknown-linux-gnu
=== lus2lic4 tests ===
@@ -1726,14 +1726,14 @@ PASS: /home/jahier/lus2lic/test/../utils/test_lus2lic_no_node zzz2.lus {}
# of unexpected failures 3
===============================
# Total number of failures: 14
-lus2lic0.log:testcase ./lus2lic.tests/test0.exp completed in 4 seconds
-lus2lic1.log:testcase ./lus2lic.tests/test1.exp completed in 37 seconds
-lus2lic2.log:testcase ./lus2lic.tests/test2.exp completed in 70 seconds
-lus2lic3.log:testcase ./lus2lic.tests/test3.exp completed in 42 seconds
-lus2lic4.log:testcase ./lus2lic.tests/test4.exp completed in 70 seconds
+lus2lic0.log:testcase ./lus2lic.tests/test0.exp completed in 5 seconds
+lus2lic1.log:testcase ./lus2lic.tests/test1.exp completed in 38 seconds
+lus2lic2.log:testcase ./lus2lic.tests/test2.exp completed in 78 seconds
+lus2lic3.log:testcase ./lus2lic.tests/test3.exp completed in 51 seconds
+lus2lic4.log:testcase ./lus2lic.tests/test4.exp completed in 86 seconds
* Ref time:
-0.05user 0.03system 3:45.39elapsed 0%CPU (0avgtext+0avgdata 5120maxresident)k
-160inputs+0outputs (0major+5522minor)pagefaults 0swaps
+0.04user 0.04system 4:19.05elapsed 0%CPU (0avgtext+0avgdata 5120maxresident)k
+160inputs+0outputs (0major+5547minor)pagefaults 0swaps
* Quick time (-j 4):
-0.04user 0.02system 1:21.11elapsed 0%CPU (0avgtext+0avgdata 5076maxresident)k
-160inputs+0outputs (0major+5559minor)pagefaults 0swaps
+0.04user 0.02system 1:27.38elapsed 0%CPU (0avgtext+0avgdata 5088maxresident)k
+160inputs+0outputs (0major+5580minor)pagefaults 0swaps
diff --git a/test/lus2lic.time b/test/lus2lic.time
index 49af92113a2dd726ecb3d353bb1d9640290567ac..250753ec499bc0a8e5d8e2c27612e4d3a9f26ea4 100644
--- a/test/lus2lic.time
+++ b/test/lus2lic.time
@@ -1,11 +1,11 @@
-lus2lic0.log:testcase ./lus2lic.tests/test0.exp completed in 4 seconds
-lus2lic1.log:testcase ./lus2lic.tests/test1.exp completed in 37 seconds
-lus2lic2.log:testcase ./lus2lic.tests/test2.exp completed in 70 seconds
-lus2lic3.log:testcase ./lus2lic.tests/test3.exp completed in 42 seconds
-lus2lic4.log:testcase ./lus2lic.tests/test4.exp completed in 70 seconds
+lus2lic0.log:testcase ./lus2lic.tests/test0.exp completed in 5 seconds
+lus2lic1.log:testcase ./lus2lic.tests/test1.exp completed in 38 seconds
+lus2lic2.log:testcase ./lus2lic.tests/test2.exp completed in 78 seconds
+lus2lic3.log:testcase ./lus2lic.tests/test3.exp completed in 51 seconds
+lus2lic4.log:testcase ./lus2lic.tests/test4.exp completed in 86 seconds
* Ref time:
-0.05user 0.03system 3:45.39elapsed 0%CPU (0avgtext+0avgdata 5120maxresident)k
-160inputs+0outputs (0major+5522minor)pagefaults 0swaps
+0.04user 0.04system 4:19.05elapsed 0%CPU (0avgtext+0avgdata 5120maxresident)k
+160inputs+0outputs (0major+5547minor)pagefaults 0swaps
* Quick time (-j 4):
-0.04user 0.02system 1:21.11elapsed 0%CPU (0avgtext+0avgdata 5076maxresident)k
-160inputs+0outputs (0major+5559minor)pagefaults 0swaps
+0.04user 0.02system 1:27.38elapsed 0%CPU (0avgtext+0avgdata 5088maxresident)k
+160inputs+0outputs (0major+5580minor)pagefaults 0swaps