From 28f47082c3b43c60df755a2f33aaa9194c65c474 Mon Sep 17 00:00:00 2001
From: Erwan Jahier <jahier@imag.fr>
Date: Wed, 27 Mar 2013 10:07:04 +0100
Subject: [PATCH] Rework the type of Lic expressions w.r.t. predef expressions.
1) At the Lic level, there's no reason to distinguish betwenn node
calls, and predef node calls. Indeed it makes things simpler and more
homogeneous afterwards.
2) int strings are only converted when necessary (constant evaluation).
3) const are handled directly under Lic.by_pos_op instead of being under
PREDEF_CALL, which make things easier and more logical.
---
src/ast2lic.ml | 13 ++++-
src/astPredef.ml | 22 +++++--
src/astTab.ml | 11 ++--
src/evalClock.ml | 34 ++++++-----
src/evalConst.ml | 7 ++-
src/evalType.ml | 8 ++-
src/l2lCheckLoops.ml | 4 +-
src/l2lExpandArrays.ml | 46 ++++++++-------
src/l2lExpandMetaOp.ml | 57 ++++++++++--------
src/l2lExpandNodes.ml | 5 +-
src/l2lRmPoly.ml | 2 +-
src/l2lSplit.ml | 13 ++---
src/lic.ml | 9 +--
src/lic2soc.ml | 39 +++++++------
src/licDump.ml | 130 ++++++++++++++---------------------------
src/licEvalConst.ml | 32 +++++-----
src/licEvalType.ml | 57 +++++++++---------
src/licMetaOp.ml | 5 +-
src/licTab.ml | 11 ++--
src/socPredef.ml | 116 +++++++++---------------------------
src/unifyClock.ml | 12 ++--
test/lus2lic.sum | 2 +-
test/lus2lic.time | 4 +-
23 files changed, 287 insertions(+), 352 deletions(-)
diff --git a/src/ast2lic.ml b/src/ast2lic.ml
index 84d1ccdc..dbf77b52 100644
--- a/src/ast2lic.ml
+++ b/src/ast2lic.ml
@@ -1,4 +1,4 @@
-(* Time-stamp: <modified the 13/02/2013 (at 15:10) by Erwan Jahier> *)
+(* Time-stamp: <modified the 27/03/2013 (at 09:34) by Erwan Jahier> *)
open Lxm
@@ -409,7 +409,14 @@ and (translate_val_exp : IdSolver.t -> UnifyClock.subst -> AstCore.val_exp
match by_pos_op with
| WITH_n(_,_,_) -> assert false (* handled at the top of the function *)
(* put that in another module ? yes, see above.*)
- | Predef_n(op) -> s, mk_by_pos_op(PREDEF_CALL (op.it))
+
+ | Predef_n({it=TRUE_n}) -> s,mk_by_pos_op(Lic.CONST (Bool_const_eff true))
+ | Predef_n({it=FALSE_n}) -> s,mk_by_pos_op(Lic.CONST (Bool_const_eff false))
+ | Predef_n({it=RCONST_n r}) -> s,mk_by_pos_op(Lic.CONST (Real_const_eff r))
+ | Predef_n({it=ICONST_n i}) ->
+ s, mk_by_pos_op(Lic.CONST (Int_const_eff i))
+ | Predef_n(op) -> s, mk_by_pos_op(
+ Lic.PREDEF_CALL (flagit (AstPredef.op_to_long op.it,[]) op.src))
| CALL_n node_exp_f ->
let neff = of_node id_solver node_exp_f in
let ceff = Lic.CALL (flagit neff.node_key_eff node_exp_f.src) in
@@ -460,7 +467,7 @@ and (translate_val_exp : IdSolver.t -> UnifyClock.subst -> AstCore.val_exp
| [exp; ve_size] ->
let size_const_eff = EvalConst.f id_solver ve_size in
(match size_const_eff with
- | [Int_const_eff sz] -> s, mk_by_pos_op (Lic.HAT(sz))
+ | [Int_const_eff sz] -> s, mk_by_pos_op (Lic.HAT(int_of_string sz))
| _ -> assert false)
| _ -> assert false
)
diff --git a/src/astPredef.ml b/src/astPredef.ml
index 4bf24042..33d52cb9 100644
--- a/src/astPredef.ml
+++ b/src/astPredef.ml
@@ -1,4 +1,4 @@
-(* Time-stamp: <modified the 19/03/2013 (at 11:00) by Erwan Jahier> *)
+(* Time-stamp: <modified the 26/03/2013 (at 15:35) by Erwan Jahier> *)
(** Predefined operators Type definition *)
@@ -53,6 +53,15 @@ type op =
| RSLASH_n
| RTIMES_n
+let all_op = [
+ NOT_n; REAL2INT_n; INT2REAL_n; AND_n; OR_n; XOR_n; IMPL_n;
+ EQ_n; NEQ_n; LT_n; LTE_n; GT_n; GTE_n; DIV_n; MOD_n; IF_n;
+ NOR_n; DIESE_n; UMINUS_n; MINUS_n; PLUS_n; SLASH_n; TIMES_n;
+ IUMINUS_n; IMINUS_n; IPLUS_n; ISLASH_n; ITIMES_n; RUMINUS_n;
+ RMINUS_n; RPLUS_n; RSLASH_n; RTIMES_n
+]
+
+
(* can occur into an array iterator *)
(* GESTION DES OP PREDEF LAISSE A DESIRER *)
let iterable_op = [
@@ -107,7 +116,7 @@ let op2string = function
let op2string_long = function
| EQ_n -> "eq"
- | NEQ_n -> "diff"
+ | NEQ_n -> "neq"
| IMPL_n -> "impl"
| LT_n -> "lt"
| LTE_n -> "lte"
@@ -121,12 +130,12 @@ let op2string_long = function
| TIMES_n -> "times"
| IUMINUS_n -> "iuminus"
| IMINUS_n -> "iminus"
- | IPLUS_n -> "plus"
+ | IPLUS_n -> "iplus"
| ISLASH_n -> "idiv"
| ITIMES_n -> "itimes"
| RUMINUS_n -> "ruminus"
| RMINUS_n -> "rminus"
- | RPLUS_n -> "plus"
+ | RPLUS_n -> "rplus"
| RSLASH_n -> "rdiv"
| RTIMES_n -> "rtimes"
| op -> op2string op
@@ -209,6 +218,11 @@ let (string_to_op : string -> op) =
| _ -> raise Not_found
+let (is_a_predef_op : string -> bool) =
+ fun str ->
+ try ignore (string_to_op str); true
+ with Not_found -> false
+
(** An evaluator returns a list because Lustre calls returns tuples.
SE: migth raise some check error!
diff --git a/src/astTab.ml b/src/astTab.ml
index 7f9945be..0d18f37e 100644
--- a/src/astTab.ml
+++ b/src/astTab.ml
@@ -1,4 +1,4 @@
-(* Time-stamp: <modified the 01/02/2013 (at 14:22) by Erwan Jahier> *)
+(* Time-stamp: <modified the 26/03/2013 (at 10:31) by Erwan Jahier> *)
(**
Table des infos sources : une couche au dessus de AstV6 pour mieux
@@ -92,13 +92,14 @@ let (pack_list:t -> Ident.pack_name list) =
(* exported *)
let (pack_body_env: t -> Ident.pack_name -> AstTabSymbol.t) =
fun this p ->
- try (Hashtbl.find this.st_pack_mng_tab p).pm_body_stab
+ 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: ");
+ (Ident.pack_name_to_string p) ^ "' in the following packages: ");
Hashtbl.iter
- (fun pn pm -> print_string ("\n***\t '"^(Ident.pack_name_to_string pn)^ "'"))
- this.st_pack_mng_tab;
+ (fun pn pm -> print_string ("\n***\t '"^(Ident.pack_name_to_string pn)^ "'"))
+ this.st_pack_mng_tab;
print_string "\n";
flush stdout;
exit 2
diff --git a/src/evalClock.ml b/src/evalClock.ml
index af2c804d..51819edb 100644
--- a/src/evalClock.ml
+++ b/src/evalClock.ml
@@ -1,4 +1,4 @@
-(* Time-stamp: <modified the 13/02/2013 (at 10:09) by Erwan Jahier> *)
+(* Time-stamp: <modified the 26/03/2013 (at 18:24) by Erwan Jahier> *)
open AstPredef
@@ -341,11 +341,14 @@ and (eval_by_pos_clock : IdSolver.t -> Lic.by_pos_op -> Lxm.t -> Lic.val_exp lis
let vi = IdSolver.var_info_of_ident id_solver id lxm in
([var_info_eff_to_clock_eff vi], s)
+ | Lic.CONST c, args -> (
+ let s, clk = UnifyClock.new_clock_var s in
+ [Lic.string_of_const c, clk], s
+ )
| 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
([Ident.of_long idl, clk], s)
-
| Lic.CALL nkf,args ->
let node_key = nkf.it in
let node_exp_eff = IdSolver.node_exp_of_node_key id_solver node_key lxm in
@@ -375,18 +378,10 @@ and (eval_by_pos_clock : IdSolver.t -> Lic.by_pos_op -> Lxm.t -> Lic.val_exp lis
let s = check_args lxm s cil_arg (List.flatten clk_args) in
List.map (apply_subst s) cil_res, s
- (* One argument. *)
- | Lic.PRE,args
- | Lic.STRUCT_ACCESS _,args
- | Lic.ARRAY_ACCES (_),args
- | Lic.ARRAY_SLICE (_),args ->
- assert(List.length args = 1);
- let (_,clk,s) = f_aux id_solver s (List.hd args) in
- clk,s
-
- | Lic.PREDEF_CALL (op),args ->
+ | Lic.PREDEF_CALL (nkf),args ->
+ let op = AstPredef.string_to_op (snd(fst nkf.it)) in
let args, clk_args, s = f_list id_solver s args in
- let flat_clk_args = List.flatten clk_args in (* => mono-clock! *)
+ let flat_clk_args = List.flatten clk_args in (* all predef nodes are mono-clock! *)
let _,flat_clk_args = List.split flat_clk_args in
let clk_list, s =
if args = [] then [],s else
@@ -395,6 +390,15 @@ and (eval_by_pos_clock : IdSolver.t -> Lic.by_pos_op -> Lxm.t -> Lic.val_exp lis
in
LicEvalClock.f id_solver op lxm s clk_list
+ (* One argument. *)
+ | Lic.PRE,args
+ | Lic.STRUCT_ACCESS _,args
+ | Lic.ARRAY_ACCES (_),args
+ | Lic.ARRAY_SLICE (_),args ->
+ assert(List.length args = 1);
+ let (_,clk,s) = f_aux id_solver s (List.hd args) in
+ clk,s
+
(* may have tuples as arguments *)
| Lic.TUPLE,args
| Lic.ARROW,args
@@ -427,7 +431,7 @@ and (eval_by_name_clock : IdSolver.t -> Lic.by_name_op -> Lxm.t ->
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
- (* XXX The 3 following lines duplicates the code of TUPLE_eff and co *)
+ (* XXX The 3 following lines duplicates the code of TUPLE_eff and co *)
let args, clk_args, s = f_list id_solver s args in
let flat_clk_args = List.flatten clk_args in (* => mono-clock! *)
let _,flat_clk_args = List.split flat_clk_args in
@@ -437,5 +441,5 @@ and (eval_by_name_clock : IdSolver.t -> Lic.by_name_op -> Lxm.t ->
| Lic.STRUCT_anonymous -> assert false (* cf EvalType.E *)
| Lic.STRUCT(_) -> clk_list, s
| Lic.STRUCT_with(_, dft) ->
- (* XXX should i do something here ??? *)
+ (* XXX should i do something here ??? *)
clk_list, s
diff --git a/src/evalConst.ml b/src/evalConst.ml
index ff6483c7..adb49fbd 100644
--- a/src/evalConst.ml
+++ b/src/evalConst.ml
@@ -1,4 +1,4 @@
-(* Time-stamp: <modified the 12/02/2013 (at 18:07) by Erwan Jahier> *)
+(* Time-stamp: <modified the 27/03/2013 (at 09:35) by Erwan Jahier> *)
open Printf
@@ -394,6 +394,7 @@ and (eval_array_size: IdSolver.t -> val_exp -> int) =
fun id_solver szexp ->
match (f id_solver szexp) with
| [Int_const_eff sz] ->
+ let sz = int_of_string sz in
if (sz > 0) then sz else
raise(EvalArray_error(sprintf "bad array size %d" sz))
| [x] ->
@@ -425,7 +426,7 @@ and eval_array_index
(
match (f env ixexp) with
| [Int_const_eff i]
- | [Abstract_const_eff(_,_, (Int_const_eff i), true)] -> 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) ^
" is abstract"))
@@ -474,7 +475,7 @@ and eval_array_slice (env : IdSolver.t) (sl : slice_info) (lxm : Lxm.t) =
match sl.si_step with
| Some stepexp -> (
match (f env stepexp) with
- | [Int_const_eff s] -> s (* ok *)
+ | [Int_const_eff s] -> int_of_string s (* ok *)
| [x] -> raise(EvalArray_error(
sprintf "bad array step, int expected but get %s"
(Lic.string_of_type (Lic.type_of_const x))))
diff --git a/src/evalType.ml b/src/evalType.ml
index 3fd89511..5667db15 100644
--- a/src/evalType.ml
+++ b/src/evalType.ml
@@ -1,4 +1,4 @@
-(** Time-stamp: <modified the 13/02/2013 (at 10:51) by Erwan Jahier> *)
+(** Time-stamp: <modified the 26/03/2013 (at 18:26) by Erwan Jahier> *)
open AstPredef
@@ -70,10 +70,11 @@ and eval_by_pos_type
* Lic.type_ list (* The type of the val_exp "posop(args)" *)
) =
match posop with
- | PREDEF_CALL (op) -> (
+ | Lic.PREDEF_CALL (nkf) -> (
+ let op = AstPredef.string_to_op (snd(fst nkf.it)) in
let args, targs = List.split (List.map (f id_solver) args) in
(* ICI pas de matches possible ? *)
- let tve = LicEvalType.f id_solver op lxm targs in
+ let tve = LicEvalType.f id_solver op nkf.src targs in
None, args, tve
)
| Lic.CALL nkf ->
@@ -112,6 +113,7 @@ and eval_by_pos_type
Lic.apply_type_matches tmatches lto
in
(None, args, tve)
+ | Lic.CONST ceff -> None, [], Lic.types_of_const ceff
| Lic.CONST_REF idl ->
let ceff = IdSolver.const_eff_of_item_key id_solver idl lxm in
let tve = Lic.types_of_const ceff in
diff --git a/src/l2lCheckLoops.ml b/src/l2lCheckLoops.ml
index a41fd107..d22337a0 100644
--- a/src/l2lCheckLoops.ml
+++ b/src/l2lCheckLoops.ml
@@ -1,4 +1,4 @@
-(* Time-stamp: <modified the 22/03/2013 (at 17:13) by Erwan Jahier> *)
+(* Time-stamp: <modified the 25/03/2013 (at 18:05) by Erwan Jahier> *)
open Lxm
open Errors
@@ -34,7 +34,7 @@ and
| PREDEF_CALL(_)
| ARRAY_SLICE _ | ARRAY_ACCES _ | ARROW | FBY | CURRENT | WHEN _
| ARRAY | HAT(_) | STRUCT_ACCESS _
- | TUPLE | CONCAT | CONST_REF _ | CALL _ -> s
+ | TUPLE | CONCAT | CONST_REF _ | CALL _ | CONST _ -> s
| PRE -> assert false
and
vars_of_static_arg s = function
diff --git a/src/l2lExpandArrays.ml b/src/l2lExpandArrays.ml
index 2fadfad8..2c480236 100644
--- a/src/l2lExpandArrays.ml
+++ b/src/l2lExpandArrays.ml
@@ -1,4 +1,4 @@
-(** Time-stamp: <modified the 22/03/2013 (at 17:13) by Erwan Jahier> *)
+(** Time-stamp: <modified the 26/03/2013 (at 18:38) by Erwan Jahier> *)
(* Replace structures and arrays by as many variables as necessary.
Since structures can be recursive, it migth be a lot of new variables...
@@ -250,7 +250,7 @@ and (var_trees_of_val_exp :
in
let loop = var_trees_of_val_exp lctx acc in
match ve.ve_core with
- | Merge(ce,cl) -> assert false
+ | Merge(ce,cl) -> assert false (* todo *)
| CallByPosLic (by_pos_op, vel) -> (
let lxm = by_pos_op.src in
let by_pos_op = by_pos_op.it in
@@ -294,6 +294,7 @@ and (var_trees_of_val_exp :
in
raise (Errors.Compile_error(lxm, msg))
)
+ | CONST const -> do_const acc lctx lxm const
| CONST_REF idl -> (
try
let const =
@@ -301,24 +302,12 @@ and (var_trees_of_val_exp :
| Some c -> c
| None -> assert false
in
- let _s, ve_const =
- UnifyClock.const_to_val_eff lxm true UnifyClock.empty_subst const
- in
- let ve_const,acc =
- match ve_const.ve_core with
- | CallByPosLic ({it=CONST_REF _},_) ->
- (* in order to avoid a potential infinite loop *)
- (ve_const, acc)
-
- | _ -> expand_val_exp lctx acc ve_const
- in (acc, L (ve_const))
+ do_const acc lctx lxm const
with _ ->
let msg =
- "\n*** during Array expansion: '"^
- (Ident.string_of_long2 idl)^
- "': Unknown constant.\n"^
- "*** Current constants are: "^
- (LicPrg.fold_consts
+ "\n*** during Array expansion: '"^ (Ident.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)))
lctx.prg
"")
@@ -338,6 +327,20 @@ and (var_trees_of_val_exp :
let acc, nloc = make_new_loc lctx lxm acc ve in
acc, gen_var_trees (make_val_exp lxm nloc) "" nloc.var_type_eff
+and do_const acc lctx lxm const =
+ let _s, ve_const =
+ UnifyClock.const_to_val_eff lxm true UnifyClock.empty_subst const
+ in
+ let ve_const,acc =
+ match ve_const.ve_core with
+ | CallByPosLic ({it=CONST_REF _},_) ->
+ (* in order to avoid a potential infinite loop *)
+ (ve_const, acc)
+
+ | _ -> expand_val_exp lctx acc ve_const
+ in
+ (acc, L (ve_const))
+
and (break_tuple : Lxm.t -> left list -> val_exp -> Lic.eq_info srcflagged list) =
fun lxm left_list ve ->
if not !Global.ec then
@@ -384,7 +387,8 @@ and (break_tuple : Lxm.t -> left list -> val_exp -> Lic.eq_info srcflagged list)
ve1l
ve2l
- | CallByPosLic ({it= PREDEF_CALL(IF_n); src=lxm}, [cond; ve1; ve2]) ->
+ | CallByPosLic ({it= PREDEF_CALL({src=if_lxm ;
+ it = ("Lustre","if"),[]}); src=lxm}, [cond; ve1; ve2]) ->
let ve1l, ve2l = aux ve1, aux ve2 in
if (List.length ve1l <> List.length ve2l) then
let vel2str vel =
@@ -400,7 +404,7 @@ and (break_tuple : Lxm.t -> left list -> val_exp -> Lic.eq_info srcflagged list)
List.map2
(fun ve1 ve2 ->
{ ve with ve_core =
- CallByPosLic ({it= PREDEF_CALL(IF_n); src=lxm},
+ CallByPosLic ({it= PREDEF_CALL({src=if_lxm ; it = ("Lustre","if"),[]}); src=lxm},
[cond;ve1;ve2])}
)
ve1l
@@ -462,7 +466,7 @@ and (expand_val_exp: local_ctx -> acc -> val_exp -> val_exp * acc) =
in
TUPLE, acc, unfold i
| ARRAY | CONCAT | PREDEF_CALL _ | CALL _
- | PRE | ARROW | FBY | CURRENT | WHEN _ | TUPLE
+ | PRE | ARROW | FBY | CURRENT | WHEN _ | TUPLE | CONST _
->
let vel,acc = expand_val_exp_list lctx acc vel in
by_pos_op, acc, vel
diff --git a/src/l2lExpandMetaOp.ml b/src/l2lExpandMetaOp.ml
index 8ce548d5..539d037c 100644
--- a/src/l2lExpandMetaOp.ml
+++ b/src/l2lExpandMetaOp.ml
@@ -1,4 +1,4 @@
-(** Time-stamp: <modified the 22/03/2013 (at 17:39) by Erwan Jahier> *)
+(** Time-stamp: <modified the 27/03/2013 (at 09:49) by Erwan Jahier> *)
open Lxm
open Lic
@@ -30,7 +30,7 @@ let new_var str lctx type_eff clock_eff =
(********************************************************************************)
(* A small util function followed by a quick unit test. *)
-let rec fill i size = if i >= size then [] else i::(fill (i+1) size)
+let rec fill i size = if i >= size then [] else (i)::(fill (i+1) size)
let _ = assert (fill 0 5 = [0;1;2;3;4])
let rec (list_map3:
@@ -62,13 +62,12 @@ let (val_exp_of_const : Lic.const -> Lic.val_exp) =
let _,ve = UnifyClock.const_to_val_eff lxm true UnifyClock.empty_subst c in
ve
-let (val_exp_of_int : int -> Lic.val_exp) =
+let (val_exp_of_int : string -> Lic.val_exp) =
fun i ->
- let id_of_int i = AstPredef.ICONST_n(Ident.of_string (string_of_int i)) in
{
ve_clk = [BaseLic];
ve_typ = [Int_type_eff];
- ve_core = CallByPosLic({it=PREDEF_CALL(id_of_int i);src=lxm},[])
+ ve_core = CallByPosLic({it= CONST(Int_const_eff i);src=lxm},[])
}
let rec (elt_type_of_array : Lic.type_ -> Lic.type_) =
@@ -97,17 +96,17 @@ let (node_to_val_exp : Lic.node_key -> Lic.type_ list -> val_exp list -> val_exp
ve_typ = t;
ve_core = core
}
-let (binop_to_val_exp : AstPredef.op -> val_exp -> val_exp -> val_exp) =
- fun op ve1 ve2 ->
- let op = { it = PREDEF_CALL(op) ; src = lxm } in
+let (binop_to_val_exp : Ident.t -> val_exp -> val_exp -> val_exp) =
+ fun op ve1 ve2 ->
+ let op = { it = PREDEF_CALL({src=lxm;it=("Lustre",op),[]}) ; src = lxm } in
{
- ve_clk = ve1.ve_clk;
+ ve_clk = ve1.ve_clk;
ve_typ = ve1.ve_typ;
- ve_core = CallByPosLic(op, [ve1; ve2])
- }
+ ve_core = CallByPosLic(op, [ve1; ve2])
+ }
let (ite_to_val_exp : val_exp -> val_exp -> val_exp -> val_exp) =
fun ve1 ve2 ve3 ->
- let ite_op = { it = PREDEF_CALL(AstPredef.IF_n); src = lxm } in
+ let ite_op = { it = PREDEF_CALL({src=lxm;it=("Lustre","if"),[]}); src = lxm } in
{
ve_clk = ve2.ve_clk;
ve_typ = ve2.ve_typ;
@@ -166,6 +165,7 @@ let (create_fillred_body: local_ctx -> Lic.static_arg list -> Lic.node_body * va
acc_i+1, Y1[i], ... ,Yl[i] = n(acc_i,X1[i], ... ,Xk[i])
tel
*)
+ let c = int_of_string c in
let index_list = fill 0 c in
(* Building this list "acc_left_list" as [acc_1, ..., acc_c-2, acc_out] *)
let type_exp,clock_exp = acc_in.var_type_eff, snd acc_in.var_clock_eff in
@@ -208,7 +208,11 @@ let (create_fillred_body: local_ctx -> Lic.static_arg list -> Lic.node_body * va
let rhs = {
ve_typ = List.map Lic.type_of_left lhs;
ve_clk = cl;
- ve_core = CallByPosLic({src=lxm;it=(CALL iter_node)}, args) }
+ ve_core =
+ if AstPredef.is_a_predef_op (snd(fst iter_node.it)) then
+ CallByPosLic({src=lxm;it=(Lic.PREDEF_CALL iter_node)}, args)
+ else
+ CallByPosLic({src=lxm;it=(CALL iter_node)}, args) }
in
let eq = { src = lxm ; it = (lhs, rhs) } in
eq
@@ -243,6 +247,7 @@ let (create_map_body: local_ctx -> Lic.static_arg list -> Lic.node_body * var_in
let iter_node = Lxm.flagit iter_node lxm in
let (y1_yl : var_info list) = lctx.node.Lic.inlist_eff in
let (x1_xn : var_info list) = lctx.node.Lic.outlist_eff in
+ let c = int_of_string c in
let index_list = fill 0 c in
let neqs =
List.map
@@ -259,7 +264,12 @@ let (create_map_body: local_ctx -> Lic.static_arg list -> Lic.node_body * var_in
let rhs = {
ve_typ = List.map Lic.type_of_left lhs;
ve_clk = cl;
- ve_core = CallByPosLic({src=lxm;it=(CALL iter_node)}, xi_j) }
+ ve_core =
+ if AstPredef.is_a_predef_op (snd(fst iter_node.it)) then
+ CallByPosLic({src=lxm;it=(Lic.PREDEF_CALL iter_node)}, xi_j)
+ else
+ CallByPosLic({src=lxm;it=(CALL iter_node)}, xi_j)
+ }
in
let eq = { src = lxm ; it = (lhs, rhs) } in
eq
@@ -293,8 +303,8 @@ let (create_boolred_body: local_ctx -> int -> int -> int -> Lic.node_body * var_
in
let (cpt_vi : var_info) = new_var "cpt" lctx Int_type_eff BaseLic in
let cpt_left = LeftVarLic (cpt_vi,lxm) in
- let zero = val_exp_of_int 0
- and one = val_exp_of_int 1 in
+ let zero = val_exp_of_int "0"
+ and one = val_exp_of_int "1" in
let index_list = fill 0 k in (* [0;1; ...;k-1]*)
let (ite_list:Lic.val_exp list) = List.map
(fun i -> (* returns [if A[i] then 1 else 0]_i=0,k-1 *)
@@ -303,16 +313,16 @@ let (create_boolred_body: local_ctx -> int -> int -> int -> Lic.node_body * var_
)
index_list
in
- let cpt_rigth = List.fold_left (binop_to_val_exp AstPredef.IPLUS_n)
+ let cpt_rigth = List.fold_left (binop_to_val_exp "plus")
(List.hd ite_list) (List.tl ite_list) in
let res_left = LeftVarLic (res_vi,lxm) in
let res_rigth = (* i <= cpt && cpt <= j; *)
- let i_eff = val_exp_of_int i in
- let j_eff = val_exp_of_int j in
+ let i_eff = val_exp_of_int (string_of_int i) in
+ let j_eff = val_exp_of_int (string_of_int j) in
let cpt_eff = val_exp_of_var_info cpt_vi in
- let i_inf_cpt = binop_to_val_exp AstPredef.LTE_n i_eff cpt_eff in
- let cpt_inf_j = binop_to_val_exp AstPredef.LTE_n cpt_eff j_eff in
- binop_to_val_exp AstPredef.AND_n i_inf_cpt cpt_inf_j
+ let i_inf_cpt = binop_to_val_exp "lte" i_eff cpt_eff in
+ let cpt_inf_j = binop_to_val_exp "lte" cpt_eff j_eff in
+ binop_to_val_exp "and" i_inf_cpt cpt_inf_j
in
let cpt_eq = { src = lxm ; it = ([cpt_left], cpt_rigth) } in
let res_eq = { src = lxm ; it = ([res_left], res_rigth) } in
@@ -355,6 +365,7 @@ tel
let eq = { src = lxm ; it = (left, rigth) } in
{ asserts_eff = []; eqs_eff = [eq] }, []
+let ios = int_of_string
let (create_merge_body: local_ctx -> Lic.static_arg list -> Lic.node_body * var_info list) =
fun lctx sargs ->
@@ -374,7 +385,7 @@ let rec (create_meta_op_body: local_ctx -> Lic.node_key -> Lic.node_body * var_
ConstStaticArgLic(_, Int_const_eff j);
ConstStaticArgLic(_, Int_const_eff k)
] ->
- (i,j,k)
+ (ios i,ios j,ios k)
| _ -> assert false
in
create_boolred_body lctx i j k
diff --git a/src/l2lExpandNodes.ml b/src/l2lExpandNodes.ml
index dc40e16d..8c484d15 100644
--- a/src/l2lExpandNodes.ml
+++ b/src/l2lExpandNodes.ml
@@ -1,4 +1,4 @@
-(* Time-stamp: <modified the 22/03/2013 (at 17:41) by Erwan Jahier> *)
+(* Time-stamp: <modified the 26/03/2013 (at 10:18) by Erwan Jahier> *)
open Lxm
@@ -83,7 +83,6 @@ and (subst_in_val_exp : subst -> val_exp -> val_exp) =
with Not_found -> id
in
VAR_REF id'
-
| HAT(i) -> HAT(i)
| WHEN(AstCore.Base) -> WHEN(AstCore.Base)
| WHEN(AstCore.NamedClock {src=lxm;it=(cc,cv)}) ->
@@ -92,7 +91,7 @@ and (subst_in_val_exp : subst -> val_exp -> val_exp) =
WHEN(AstCore.NamedClock {src=lxm;it=(cc,cv)})
| PREDEF_CALL _| CALL _ | PRE | ARROW | FBY | CURRENT | TUPLE
| ARRAY | CONCAT | STRUCT_ACCESS _ | ARRAY_ACCES _ | ARRAY_SLICE _
- (* | CONST _ *)
+ | CONST _
-> by_pos_op
in
CallByPosLic(Lxm.flagit by_pos_op lxm, vel)
diff --git a/src/l2lRmPoly.ml b/src/l2lRmPoly.ml
index 2c467601..af4e504b 100644
--- a/src/l2lRmPoly.ml
+++ b/src/l2lRmPoly.ml
@@ -1,4 +1,4 @@
-(* Time-stamp: <modified the 22/03/2013 (at 18:39) by Erwan Jahier> *)
+(* Time-stamp: <modified the 27/03/2013 (at 09:55) by Erwan Jahier> *)
(*
Source 2 source transformation :
diff --git a/src/l2lSplit.ml b/src/l2lSplit.ml
index 4170a7c9..6870f836 100644
--- a/src/l2lSplit.ml
+++ b/src/l2lSplit.ml
@@ -58,7 +58,7 @@ let to_be_broken = function
| CallByPosLic({ it = Lic.CURRENT }, _) -> true
| CallByPosLic({ it = Lic.TUPLE }, _) -> true
| CallByPosLic({ it = Lic.WHEN _ }, _) -> true
- | CallByPosLic({ it = Lic.PREDEF_CALL(AstPredef.IF_n) }, _) -> true
+ | CallByPosLic({ it = Lic.PREDEF_CALL({ it = (("Lustre","if"),[]) })}, _) -> true
| _ -> false
@@ -67,7 +67,7 @@ let (break_it_do : val_exp -> val_exp list) =
fun ve ->
let nvel =
match ve.ve_core with
- | CallByPosLic({it=Lic.PREDEF_CALL(AstPredef.IF_n);src=lxm}, [c;ve1;ve2]) ->
+ | CallByPosLic({it=Lic.PREDEF_CALL({ it = (("Lustre","if"),[]) });src=lxm}, [c;ve1;ve2]) ->
let vel1 = get_vel_from_tuple ve1
and vel2 = get_vel_from_tuple ve2
in
@@ -75,7 +75,7 @@ let (break_it_do : val_exp -> val_exp list) =
List.map2
(fun ve1 ve2 ->
{ ve_core =
- CallByPosLic({it=Lic.PREDEF_CALL(AstPredef.IF_n);src=lxm},
+ CallByPosLic({it=Lic.PREDEF_CALL({ it = (("Lustre","if"),[]);src=lxm });src=lxm},
[c;ve1;ve2]);
ve_typ = ve1.ve_typ;
ve_clk = ve1.ve_clk;
@@ -181,12 +181,7 @@ and (split_val_exp : bool -> bool -> LicPrg.id_generator -> Lic.val_exp ->
| Merge(ce,cl) -> ve, ([],[]) (* Should we deal with complex flow in merge ? *)
| CallByPosLic({it=Lic.VAR_REF _}, _) -> ve, ([],[])
| CallByPosLic({it=Lic.CONST_REF _}, _) -> ve, ([],[])
- | CallByPosLic({src=lxm;it=Lic.PREDEF_CALL(AstPredef.TRUE_n)}, _)
- | CallByPosLic({src=lxm;it=Lic.PREDEF_CALL(AstPredef.FALSE_n)}, _)
- | CallByPosLic({src=lxm;it=Lic.PREDEF_CALL(AstPredef.ICONST_n _)}, _)
- | CallByPosLic({src=lxm;it=Lic.PREDEF_CALL(AstPredef.RCONST_n _)}, _)
- (* We do not create an intermediary variable for those,
- but *)
+ | CallByPosLic({src=lxm;it=Lic.CONST _}, _)
-> if not when_flag then
let clk = ve.ve_clk in
match (List.hd clk) with
diff --git a/src/lic.ml b/src/lic.ml
index 01b6cbfc..f68aea03 100644
--- a/src/lic.ml
+++ b/src/lic.ml
@@ -1,4 +1,4 @@
-(* Time-stamp: <modified the 22/03/2013 (at 17:13) by Erwan Jahier> *)
+(* Time-stamp: <modified the 27/03/2013 (at 09:55) by Erwan Jahier> *)
(** Define the Data Structure representing Compiled programs. *)
@@ -171,9 +171,10 @@ and by_name_op =
| STRUCT_anonymous
and by_pos_op =
- | PREDEF_CALL of AstPredef.op
+ | PREDEF_CALL of node_key srcflagged
| CALL of node_key srcflagged
| CONST_REF of Ident.long
+ | CONST of const
| VAR_REF of Ident.t
| PRE
@@ -208,7 +209,7 @@ and by_pos_op =
and const =
(* type predef *)
Bool_const_eff of bool
- | Int_const_eff of int (* XXX should be a string ! *)
+ | 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_)
@@ -607,7 +608,7 @@ and string_of_clock = function
and string_of_const = function
| Bool_const_eff true -> "true"
| Bool_const_eff false -> "false"
- | Int_const_eff i -> (sprintf "%d" i)
+ | Int_const_eff i -> (sprintf "%s" i)
| Real_const_eff r -> r
| Extern_const_eff (s,_) -> (string_of_ident s)
| Abstract_const_eff (s,t,v,_) -> (string_of_ident s)
diff --git a/src/lic2soc.ml b/src/lic2soc.ml
index ac1f48b2..01436b4b 100644
--- a/src/lic2soc.ml
+++ b/src/lic2soc.ml
@@ -1,4 +1,4 @@
-(** Time-stamp: <modified the 25/03/2013 (at 16:16) by Erwan Jahier> *)
+(** Time-stamp: <modified the 27/03/2013 (at 09:37) by Erwan Jahier> *)
open Lxm
open Lic
@@ -116,10 +116,12 @@ let rec get_leaf: (LicPrg.t -> Lic.val_exp -> Soc.var_expr list option) =
let type_ = lic_to_soc_type (List.hd type_) in
Some [Soc.Const(Ident.string_of_long l, type_)]
)
- | Lic.PREDEF_CALL AstPredef.TRUE_n -> Some [Soc.Const("true", Soc.Bool)]
- | Lic.PREDEF_CALL AstPredef.FALSE_n -> Some [Soc.Const("false", Soc.Bool)]
- | Lic.PREDEF_CALL AstPredef.RCONST_n id -> Some [Soc.Const(id, Soc.Real)]
- | Lic.PREDEF_CALL AstPredef.ICONST_n id -> Some [Soc.Const(id, Soc.Int)]
+ | Lic.CONST c -> assert false
+
+(* | Lic.PREDEF_CALL AstPredef.TRUE_n -> Some [Soc.Const("true", Soc.Bool)] *)
+(* | Lic.PREDEF_CALL AstPredef.FALSE_n -> Some [Soc.Const("false", Soc.Bool)] *)
+(* | Lic.PREDEF_CALL AstPredef.RCONST_n id -> Some [Soc.Const(id, Soc.Real)] *)
+(* | Lic.PREDEF_CALL AstPredef.ICONST_n id -> Some [Soc.Const(id, Soc.Int)] *)
| Lic.STRUCT_ACCESS(field) -> (
let expr = match val_exp_list with [e] -> e | _ -> assert false in
@@ -284,10 +286,17 @@ let (val_exp_to_filter: LicPrg.t -> Lic.val_exp -> Soc.var_expr) =
let type_ = lic_to_soc_type (List.hd type_) in
Soc.Const(Ident.string_of_long l, type_)
)
- | Lic.PREDEF_CALL AstPredef.TRUE_n -> Soc.Const("true", Soc.Bool)
- | Lic.PREDEF_CALL AstPredef.FALSE_n -> Soc.Const("false", Soc.Bool)
- | Lic.PREDEF_CALL AstPredef.RCONST_n id -> Soc.Const(id, Soc.Real)
- | Lic.PREDEF_CALL AstPredef.ICONST_n id -> Soc.Const(id, Soc.Int)
+ | CONST (Bool_const_eff true) -> Soc.Const("true", Soc.Bool)
+ | CONST (Bool_const_eff false) -> Soc.Const("false", Soc.Bool)
+ | CONST (Int_const_eff i) -> Soc.Const(i, Soc.Int)
+ | CONST (Real_const_eff str) -> Soc.Const(str, Soc.Real)
+ | CONST Extern_const_eff _ -> assert false
+ | CONST Abstract_const_eff _ -> assert false
+ | CONST Enum_const_eff _ -> assert false
+ | CONST Struct_const_eff _ -> assert false
+ | CONST Array_const_eff _ -> assert false
+ | CONST Tuple_const_eff _ -> assert false
+
| STRUCT_ACCESS(field) -> (
let expr = match val_exp_list with [e] -> e | _ -> assert false in
let type_ = match type_ with [t] -> lic_to_soc_type t | _ -> assert false in
@@ -404,12 +413,6 @@ type e2a_acc = ctx * action list * Soc.var_expr list * Soc.instance list * Actio
(* Béquille en attendant mieux *)
let by_pos_op_to_soc_ident = function
- | PREDEF_CALL AstPredef.TRUE_n -> assert false (* catched by get_leaf *)
- | PREDEF_CALL AstPredef.FALSE_n -> assert false
- | PREDEF_CALL AstPredef.RCONST_n id -> assert false
- | PREDEF_CALL AstPredef.ICONST_n id -> assert false
-
- | PREDEF_CALL c -> "Lustre::"^(AstPredef.op2string_long c)
| PRE -> "Lustre::pre"
| ARROW -> "Lustre::arrow"
| FBY-> "Lustre::fby"
@@ -417,6 +420,7 @@ let by_pos_op_to_soc_ident = function
| CONCAT-> "Lustre::concat"
| ARRAY -> "Lustre::array"
| HAT _ -> "Lustre::hat"
+ | PREDEF_CALL n
| CALL n -> string_of_node_key n.it
| _ -> assert false
@@ -463,7 +467,7 @@ let rec (actions_of_expression_acc: Lxm.t -> Soc.tbl ->
assert false
| CallByPosLic (by_pos_op_flg, val_exp_list) -> (
match by_pos_op_flg.it with
- | Lic.ARRAY_SLICE _ | Lic.VAR_REF _ | Lic.CONST_REF _
+ | Lic.ARRAY_SLICE _ | Lic.VAR_REF _ | Lic.CONST_REF _ | Lic.CONST _
| Lic.ARRAY_ACCES _ | Lic.STRUCT_ACCESS _ | Lic.TUPLE
-> assert false (* should not occur: handled via get_leaf *)
| Lic.WHEN ck -> (assert false
@@ -644,7 +648,7 @@ let rec f: (LicPrg.t -> Lic.node_key -> Soc.key * Soc.tbl) =
let soc_tbl =
if pos_op = Lic.ARROW && not(SocMap.mem if_sk soc_tbl) then
let soc = SocPredef.soc_interface_of_pos_op lxm
- (Lic.PREDEF_CALL AstPredef.IF_n) [Bool;t;t]
+ (Lic.PREDEF_CALL ({ it=("Lustre","if"),[]; src=lxm})) [Bool;t;t]
in
SocMap.add soc.key soc soc_tbl
else
@@ -710,6 +714,7 @@ let rec f: (LicPrg.t -> Lic.node_key -> Soc.key * Soc.tbl) =
(* TypeStaticArgLic(_); *)
NodeStaticArgLic(_,node_key)] ->
node_key,c
+ | _ -> assert false
in
let nsk, soc_tbl = process_node iter_node soc_tbl in
let soc = {
diff --git a/src/licDump.ml b/src/licDump.ml
index 7031225c..2ade5d3d 100644
--- a/src/licDump.ml
+++ b/src/licDump.ml
@@ -1,4 +1,4 @@
-(* Time-stamp: <modified the 22/03/2013 (at 17:17) by Erwan Jahier> *)
+(* Time-stamp: <modified the 27/03/2013 (at 09:37) by Erwan Jahier> *)
open Errors
open Printf
@@ -48,7 +48,7 @@ let rec string_of_const_eff =
function
| Bool_const_eff true -> "true"
| Bool_const_eff false -> "false"
- | Int_const_eff i -> (sprintf "%d" i)
+ | Int_const_eff i -> (sprintf "%s" i)
| Real_const_eff r -> r
| Extern_const_eff (s,t) -> (dump_long s)
| Abstract_const_eff (s,t,v,_) ->
@@ -102,7 +102,8 @@ and string_ident_of_const_eff c =
to generate a node name using static parameters *)
match c with
| Int_const_eff _
- | Real_const_eff _ ->
+ |
+Real_const_eff _ ->
correct_num_string(string_of_const_eff c)
| Bool_const_eff _
| Extern_const_eff _
@@ -179,7 +180,7 @@ and string_of_type_profile (i, o) =
and string_of_const = function
| Bool_const_eff true -> "true"
| Bool_const_eff false -> "false"
- | Int_const_eff i -> (sprintf "%d" i)
+ | Int_const_eff i -> (sprintf "%s" i)
| Real_const_eff r -> r
| Extern_const_eff (s,_) -> (string_of_ident s)
| Abstract_const_eff (s,t,v,_) -> (string_of_ident s)
@@ -202,7 +203,7 @@ 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)) ^","^
- (string_of_int x.var_number_eff)^")")
+ (string_of_int x.var_number_eff)^")")
and string_of_var_list vl = String.concat " ; " (List.map string_of_var_info vl)
@@ -295,7 +296,7 @@ and string_of_decl var_info_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
- if !Global.ec then vt_str else vt_str ^ clk_str
+ if !Global.ec then vt_str else vt_str ^ clk_str
and (string_of_type_decl_list : Lic.var_info list -> string -> string) =
fun tel sep ->
@@ -330,16 +331,20 @@ and (string_of_by_pos_op_eff: Lic.by_pos_op srcflagged -> Lic.val_exp list -> st
in
let str =
match posop.it,vel with
- | PREDEF_CALL (AstPredef.NOT_n), [ve1] ->
+ | CONST c,_ -> string_of_const_eff c
+ | CALL ({it=("Lustre","not"),[]}), [ve1]
+ | PREDEF_CALL ({it=("Lustre","not"),[]}), [ve1] ->
((op2string AstPredef.NOT_n) ^ " " ^
(if is_a_tuple ve1 then (tuple_par [ve1]) else sov ve1))
- | PREDEF_CALL (AstPredef.DIESE_n), [ve1] ->
+ | CALL ({it=("Lustre","diese"),[]}), [ve1]
+ | PREDEF_CALL ({it=("Lustre","diese"),[]}), [ve1] ->
if !Global.lv4
then sov ve1 (* lv4 does no accept to apply # on One var only! *)
- else ((op2string AstPredef.DIESE_n) ^ (tuple_par [ve1]))
+ else (("#") ^ (tuple_par [ve1]))
- | PREDEF_CALL (AstPredef.IF_n), [ve1; ve2; ve3] ->
+ | CALL ({it=("Lustre","if"),[]}), [ve1; ve2; ve3]
+ | PREDEF_CALL ({it=("Lustre","if"),[]}), [ve1; ve2; ve3] ->
let ve2str = string_of_val_exp_eff ve2 in
let ve2str = if is_a_tuple ve2 then "("^ve2str^")" else ve2str in
let ve3str = string_of_val_exp_eff ve3 in
@@ -347,74 +352,31 @@ and (string_of_by_pos_op_eff: Lic.by_pos_op srcflagged -> Lic.val_exp list -> st
" if " ^ (string_of_val_exp_eff ve1) ^
" then " ^ ve2str ^ " else " ^ ve3str
- | PREDEF_CALL(op), vel ->
- if AstPredef.is_infix op then (
- match vel with
- | [ve1; ve2] ->
- (string_of_val_exp_eff ve1) ^ " " ^ (op2string op) ^
- " " ^ (string_of_val_exp_eff ve2)
- | _ -> assert false
- )
- else
- ((op2string op) ^
- (match op with
- | AstPredef.ICONST_n _ | AstPredef.RCONST_n _ | AstPredef.NOT_n
- | AstPredef.UMINUS_n | AstPredef.IUMINUS_n | AstPredef.RUMINUS_n
- | AstPredef.FALSE_n | AstPredef.TRUE_n -> tuple vel
- | _ -> tuple_par vel
- )
- )
- | (CALL nkl,_) -> (
- let nk = nkl.it in
- if !Global.lv4 then
- (match nk with
- (* predef op that are iterated are translated into node_exp ;
- hence, we need to do (again) a particular threatment to have
- a node ouput (i.e., "2>a" vs "Lustre::lt(2,a)")
- *)
- | ("Lustre","uminus"), [] -> " -" ^ sov (hd vel)
- | ("Lustre","iuminus"), [] -> " -" ^ sov (hd vel)
- | ("Lustre","ruminus"), [] -> " -" ^ sov (hd vel)
- | ("Lustre","not"), [] -> " not " ^ sov (hd vel)
-
- | ("Lustre","lt"), [] -> sov (hd vel) ^ " < " ^ sov (hd (tl vel))
- | ("Lustre","lte"), [] -> sov (hd vel) ^ " <= " ^ sov (hd (tl vel))
- | ("Lustre","gt"), [] -> sov (hd vel) ^ " > " ^ sov (hd (tl vel))
- | ("Lustre","gte"), [] -> sov (hd vel) ^ " >= " ^ sov (hd (tl vel))
- | ("Lustre","eq"), [] -> sov (hd vel) ^ " = " ^ sov (hd (tl vel))
- | ("Lustre","neq"), [] -> sov (hd vel) ^ " <> " ^ sov (hd (tl vel))
- | ("Lustre","diff"), [] -> sov (hd vel) ^ " <> " ^ sov (hd (tl vel))
- | ("Lustre","plus"), [] -> sov (hd vel) ^ " + " ^ sov (hd (tl vel))
- | ("Lustre","iplus"), [] -> sov (hd vel) ^ " + " ^ sov (hd (tl vel))
- | ("Lustre","rplus"), [] -> sov (hd vel) ^ " + " ^ sov (hd (tl vel))
- | ("Lustre","minus"), [] -> sov (hd vel) ^ " - " ^ sov (hd (tl vel))
- | ("Lustre","iminus"), [] -> sov (hd vel) ^ " - " ^ sov (hd (tl vel))
- | ("Lustre","rminus"), [] -> sov (hd vel) ^ " - " ^ sov (hd (tl vel))
- | ("Lustre","div"), [] -> sov (hd vel) ^ " / " ^ sov (hd (tl vel))
- | ("Lustre","idiv"), [] -> sov (hd vel) ^ " / " ^ sov (hd (tl vel))
- | ("Lustre","rdiv"), [] -> sov (hd vel) ^ " / " ^ sov (hd (tl vel))
- | ("Lustre","times"), [] -> sov (hd vel) ^ " * " ^ sov (hd (tl vel))
- | ("Lustre","rtimes"), [] -> sov (hd vel) ^ " * " ^ sov (hd (tl vel))
- | ("Lustre","itimes"), [] -> sov (hd vel) ^ " * " ^ sov (hd (tl vel))
- | ("Lustre","slash"), [] -> sov (hd vel) ^ " / " ^ sov (hd (tl vel))
- | ("Lustre","rslash"), [] -> sov (hd vel) ^ " / " ^ sov (hd (tl vel))
- | ("Lustre","islash"), [] -> sov (hd vel) ^ " / " ^ sov (hd (tl vel))
-
- | ("Lustre","impl"), [] -> sov (hd vel) ^ " => " ^ sov (hd (tl vel))
- | ("Lustre","mod"), [] -> sov (hd vel) ^ " mod " ^ sov (hd (tl vel))
-
- | ("Lustre","and"), [] -> sov (hd vel) ^ " and " ^ sov (hd (tl vel))
- | ("Lustre","or"), [] -> sov (hd vel) ^ " or " ^ sov (hd (tl vel))
- | ("Lustre","xor"), [] -> sov (hd vel) ^ " xor " ^ sov (hd (tl vel))
-
- | ("Lustre","if"), [] ->
- " if " ^ sov (hd vel) ^ " then " ^ sov (hd (tl vel))
- ^ " else " ^ sov (hd (tl (tl vel)))
-
- | _ ->
- ((string_of_node_key nk) ^ (tuple_par vel))
- ) else
- ((string_of_node_key_rec nk) ^ (tuple_par vel))
+ | CALL(op), vel
+ | PREDEF_CALL(op), vel -> (
+ if AstPredef.is_a_predef_op (snd(fst op.it)) then
+ let op_str = snd (fst op.it) in
+ let op_short_str = AstPredef.op2string (AstPredef.string_to_op op_str) in
+ if AstPredef.is_infix (AstPredef.string_to_op op_str) then (
+ match vel with
+ | [ve1; ve2] ->
+ (string_of_val_exp_eff ve1) ^ " " ^ op_short_str ^
+ " " ^ (string_of_val_exp_eff ve2)
+ | _ -> assert false
+ )
+ else
+ (op_str ^
+ (match op_str with
+ | "not" | "true" | "false" -> tuple vel
+ | _ -> tuple_par vel
+ )
+ )
+ else
+ let nk = op.it in
+ if !Global.lv4 then
+ ((string_of_node_key nk) ^ (tuple_par vel))
+ else
+ ((string_of_node_key_rec nk) ^ (tuple_par vel))
)
| CONST_REF idl, _ -> dump_long idl
| VAR_REF id, _ -> id
@@ -462,10 +424,8 @@ and (string_of_by_pos_op_eff: Lic.by_pos_op srcflagged -> Lic.val_exp list -> st
let do_not_parenthesize = function
| VAR_REF _,_
| CONST_REF _,_
- | PREDEF_CALL((AstPredef.ICONST_n _)),_
- | PREDEF_CALL((AstPredef.RCONST_n _)),_
- | PREDEF_CALL((AstPredef.FALSE_n)),_
- | PREDEF_CALL((AstPredef.TRUE_n)),_
+ | PREDEF_CALL({it=("Lustre","true"),[]}),_
+ | PREDEF_CALL({it=("Lustre","false"),[]}),_
| ARRAY_ACCES _,_
| STRUCT_ACCESS _,_ -> true
| _,_ -> false
@@ -499,9 +459,9 @@ and string_of_val_exp_eff_core ve_core =
(string_of_val_exp_eff ct) ^ ") else current (" ^
(string_of_val_exp_eff cf) ^")"
) else (
- "merge " ^ (Ident.to_string ve.it) ^ " (true -> " ^
- (string_of_val_exp_eff ct) ^ ") (false -> "^ (string_of_val_exp_eff cf) ^")"
- )
+ "merge " ^ (Ident.to_string ve.it) ^ " (true -> " ^
+ (string_of_val_exp_eff ct) ^ ") (false -> "^ (string_of_val_exp_eff cf) ^")"
+ )
| Merge (ve, cl) -> (
"merge " ^ (Ident.to_string ve.it) ^ " " ^
(String.concat " "
diff --git a/src/licEvalConst.ml b/src/licEvalConst.ml
index c56e9b9e..53dbfa1e 100644
--- a/src/licEvalConst.ml
+++ b/src/licEvalConst.ml
@@ -1,4 +1,4 @@
-(* Time-stamp: <modified the 12/02/2013 (at 17:51) by Erwan Jahier> *)
+(* Time-stamp: <modified the 27/03/2013 (at 09:44) by Erwan Jahier> *)
open AstPredef
open Lic
@@ -19,6 +19,8 @@ let (type_error_const : Lic.const list -> string -> 'a) =
raise (EvalConst_error(
"type mismatch "^(if expect = "" then "" else (expect^" expected"))))
+let soi = string_of_int
+let ios = int_of_string
let (arity_error_const : Lic.const list -> string -> 'a) =
fun v expect ->
@@ -33,16 +35,16 @@ let (bbb_evaluator:(bool -> bool -> bool) -> const_evaluator) =
| _ -> assert false (* should not occur because eval_type is called before *)
let (ooo_evaluator:(int -> int -> int) -> (float -> float -> float) ->
- const_evaluator) =
+ const_evaluator) =
fun opi opr -> fun ll -> match List.flatten ll with
- | [Int_const_eff v0; Int_const_eff v1] -> [Int_const_eff (opi v0 v1)]
- | [Real_const_eff v0; Real_const_eff v1] -> eval_real_error ()
- (* [Real_const_eff (opr v0 v1)] *)
- | _ -> assert false (* should not occur because eval_type is called before *)
+ | [Int_const_eff v0; Int_const_eff v1] -> [Int_const_eff (soi (opi (ios v0) (ios v1)))]
+ | [Real_const_eff v0; Real_const_eff v1] -> eval_real_error ()
+ (* [Real_const_eff (opr v0 v1)] *)
+ | _ -> assert false (* should not occur because eval_type is called before *)
let (iii_evaluator:(int -> int -> int) -> const_evaluator) =
fun op -> fun ll -> match List.flatten ll with
- | [Int_const_eff v0; Int_const_eff v1] -> [Int_const_eff (op v0 v1)]
+ | [Int_const_eff v0; Int_const_eff v1] -> [Int_const_eff (soi (op (ios v0) (ios v1)))]
| _ -> assert false (* should not occur because eval_type is called before *)
let (aab_evaluator:('a -> 'a -> bool) -> const_evaluator) =
@@ -63,7 +65,7 @@ let (bb_evaluator:(bool -> bool) -> const_evaluator) =
let (ii_evaluator:(int -> int) -> const_evaluator) =
fun op -> fun ll -> match List.flatten ll with
- | [Int_const_eff v0] -> [Int_const_eff (op v0)]
+ | [Int_const_eff v0] -> [Int_const_eff (soi (op (ios v0)))]
| _ -> assert false (* should not occur because eval_type is called before *)
let (ff_evaluator:(float -> float) -> const_evaluator) =
@@ -73,7 +75,7 @@ let (ff_evaluator:(float -> float) -> const_evaluator) =
let (oo_evaluator:(int -> int) -> (float -> float) -> const_evaluator) =
fun opi opr -> fun ll -> match List.flatten ll with
- | [Int_const_eff v0] -> [Int_const_eff (opi v0)]
+ | [Int_const_eff v0] -> [Int_const_eff (soi (opi (ios v0)))]
| [Real_const_eff v0] -> eval_real_error () (* [Real_const_eff (opr v0)] *)
| _ -> assert false (* should not occur because eval_type is called before *)
@@ -82,12 +84,12 @@ let (sf_evaluator: Ident.t -> const_evaluator) =
let (si_evaluator: Ident.t -> const_evaluator) =
fun id ceff_ll ->
- try let v = int_of_string (Ident.to_string id) in
- [Int_const_eff v]
+ try let v = (Ident.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)))
+ Printf.sprintf "\n*** fail to convert the string \"%s\" into an int"
+ (Ident.to_string id)))
let (sb_evaluator: bool -> const_evaluator) =
fun v ceff_ll ->
@@ -95,12 +97,12 @@ let (sb_evaluator: bool -> const_evaluator) =
let (fi_evaluator:(string -> int) -> const_evaluator) =
fun op -> fun ll -> match List.flatten ll with
- | [Real_const_eff v0] -> [Int_const_eff (op v0)]
+ | [Real_const_eff v0] -> [Int_const_eff (soi (op v0))]
| _ -> assert false (* should not occur because [eval_type] is called before *)
let (if_evaluator: (int -> string) -> const_evaluator) =
fun op -> fun ll -> match List.flatten ll with
- | [Int_const_eff v0] -> [Real_const_eff (op v0)]
+ | [Int_const_eff v0] -> [Real_const_eff (op (ios v0))]
| _ -> assert false (* should not occur because [eval_type] is called before *)
let (ite_evaluator : const_evaluator) =
diff --git a/src/licEvalType.ml b/src/licEvalType.ml
index f04e4f18..f2400ac0 100644
--- a/src/licEvalType.ml
+++ b/src/licEvalType.ml
@@ -1,4 +1,4 @@
-(* Time-stamp: <modified the 13/02/2013 (at 08:49) by Erwan Jahier> *)
+(* Time-stamp: <modified the 27/03/2013 (at 10:00) by Erwan Jahier> *)
open AstPredef
open Lxm
@@ -78,6 +78,8 @@ let baaa_profile = [(id "c", b);(id "b1",(TypeVar Any));(id "b2",(TypeVar Any))]
let oo_profile = [(id "i",(TypeVar AnyNum))], [(id "o",(TypeVar AnyNum))]
let ooo_profile = [(id "i1",(TypeVar AnyNum));(id "i2",(TypeVar AnyNum))], [(id "o",(TypeVar AnyNum))]
+(* let diese_profile = assert false *)
+
(** 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) =
@@ -86,14 +88,11 @@ let (type_to_array_type: Lic.var_info list -> int -> (Ident.t * Lic.type_) list)
(* Extract the node and the constant from a list of static args *)
let get_node_and_int_const
- (lxm: Lxm.t)
- (sargs: Lic.static_arg list)
- : (Lic.node_key * int) =
-
+ (lxm: Lxm.t) (sargs: Lic.static_arg list) : (Lic.node_key * int) =
match sargs with
| [ NodeStaticArgLic (_,nk); ConstStaticArgLic carg ] -> (
let c = match carg with
- | (_, Int_const_eff c) -> c
+ | (_, Int_const_eff c) -> c
| (_, Abstract_const_eff(_,_,Int_const_eff c, true)) -> c
| (_, zcl) ->
let msg = "immediate integer expected, but get \""
@@ -101,7 +100,7 @@ let get_node_and_int_const
^ "\"\n"
in raise (Compile_error(lxm, msg))
in
- (nk, c)
+ (nk, int_of_string c)
)
| _ ->
let msg = "*** an integer and a node are expected.\n" in
@@ -243,7 +242,7 @@ let boolred_profile
(lxm: Lxm.t)
(sargs: Lic.static_arg list)
: Lic.node_profile =
- let (get_three_constants: Lxm.t -> Lic.static_arg list -> int * int * int) =
+ let (get_three_constants: Lxm.t -> Lic.static_arg list -> string * string * string) =
fun lxm sargs ->
match sargs with
| [ConstStaticArgLic(_,Int_const_eff i);
@@ -252,7 +251,7 @@ let boolred_profile
| _ -> raise (Compile_error(lxm, "\n*** type error: 3 int were expected"))
in
let (_i,_j,k) = get_three_constants lxm sargs in
- [id "i", (Array_type_eff(Bool_type_eff,k))], [id "o", b]
+ [id "i", (Array_type_eff(Bool_type_eff, int_of_string k))], [id "o", b]
(*---------------------------------------------------------------------*)
@@ -277,19 +276,17 @@ let op2profile
| RUMINUS_n -> rr_profile
| IMPL_n | AND_n | OR_n | XOR_n -> bbb_profile
| NEQ_n | EQ_n | LT_n | LTE_n | GT_n | GTE_n -> aab_profile
- | MINUS_n | PLUS_n | TIMES_n | SLASH_n -> ooo_profile
- | RMINUS_n | RPLUS_n | RTIMES_n | RSLASH_n -> rrr_profile
- | DIV_n | MOD_n | IMINUS_n | IPLUS_n | ISLASH_n | ITIMES_n -> iii_profile
-
- | NOR_n | DIESE_n -> assert false
- (* XXX The current representation of node_profile prevent us
- from being able to represent "bool list" (i.e., operator
- of variable arity). I could extend the type node_profile,
- but is it worth the complication just to be able to define
- alias nodes on "nor" and "#"? Actually, even if I extend
- this data type, I don'ty know how I could generate an
- alias node for them anyway...
- *)
+ | MINUS_n | PLUS_n | TIMES_n | SLASH_n | DIV_n -> ooo_profile
+ | RMINUS_n | RPLUS_n | RTIMES_n | RSLASH_n -> rrr_profile
+ | MOD_n | IMINUS_n | IPLUS_n | ISLASH_n | ITIMES_n -> iii_profile
+ (*
+ The current representation of node_profile prevent us from
+ being able to represent "bool list" (i.e., operator of variable
+ arity). I could extend the type node_profile, but is it worth the
+ complication just to be able to define alias nodes on "nor" and "#"?
+ Actually, even if I extend this data type, I don'ty know how I could
+ generate an alias node for them anyway... *)
+ | NOR_n | DIESE_n -> assert false (* diese_profile *)
in
res
@@ -397,10 +394,10 @@ let f
: typer = fun ll ->
match op with
| IF_n -> (
- (* VERRUE 1 *)
- (* j'arrive pas a traiter le if de facon generique (pour l'instant...)
- a cause du fait que le if peut renvoyer un tuple.
- *)
+ (* VERRUE 1 *)
+ (* j'arrive pas a traiter le if de facon generique (pour l'instant...)
+ a cause du fait que le if peut renvoyer un tuple.
+ *)
match ll with
| [[Bool_type_eff]; t; e] ->
if t = e then t else
@@ -408,8 +405,8 @@ let f
| x -> (raise_arity_error "" (List.length x) 3)
)
| (NOR_n | DIESE_n) ->
- (* VERRUE 2 : cf XXX above: therefore i define an ad-hoc
- check for them. *)
+ (* VERRUE 2 : cf XXX above: therefore i define an ad-hoc
+ check for them. *)
let check_nary_iter acc ceff =
match ceff with (Bool_type_eff) ->
acc | _ -> (type_error [ceff] "bool")
@@ -417,7 +414,7 @@ let f
List.fold_left check_nary_iter () (List.flatten ll);
[Bool_type_eff]
| _ ->
- (* general case *)
+ (* general case *)
let node_eff = make_node_exp_eff id_solver (Some false) op lxm in
let lti = List.map (fun v -> v.var_type_eff) node_eff.inlist_eff
and lto = List.map (fun v -> v.var_type_eff) node_eff.outlist_eff in
@@ -425,7 +422,7 @@ let f
if (List.length l <> List.length lti) then
raise_arity_error "" (List.length l) (List.length lti)
else if (l = []) then
- (* useless to call UnifyType.f ! *)
+ (* useless to call UnifyType.f ! *)
lto
else
match UnifyType.f lti l with
diff --git a/src/licMetaOp.ml b/src/licMetaOp.ml
index ae68816f..43ef3b2c 100644
--- a/src/licMetaOp.ml
+++ b/src/licMetaOp.ml
@@ -1,4 +1,4 @@
-(* Time-stamp: <modified the 22/03/2013 (at 17:18) by Erwan Jahier> *)
+(* Time-stamp: <modified the 27/03/2013 (at 09:46) by Erwan Jahier> *)
(* *)
@@ -19,7 +19,7 @@ let get_node_and_int_const (lxm: Lxm.t) (sargs: Lic.static_arg list)
^ "\"\n"
in raise (Compile_error(lxm, msg))
in
- (nk, c)
+ (nk, int_of_string c)
)
| _ ->
let msg = "*** an integer and a node are expected.\n" in
@@ -186,6 +186,7 @@ and do_boolred nk2nd nk lxm =
] -> i,j,k
| _ -> raise (Compile_error(lxm, "\n*** type error: 3 int were expected"))
in
+ let k = int_of_string k in
let ins = Lic.create_var_list AstCore.VarInput [ Array_type_eff(Bool_type_eff,k) ] in
let outs = Lic.create_var_list AstCore.VarOutput [ Bool_type_eff ] in
{
diff --git a/src/licTab.ml b/src/licTab.ml
index 50785367..d820a7df 100644
--- a/src/licTab.ml
+++ b/src/licTab.ml
@@ -1,4 +1,4 @@
-(* Time-stamp: <modified the 26/02/2013 (at 10:55) by Erwan Jahier> *)
+(* Time-stamp: <modified the 27/03/2013 (at 10:03) by Erwan Jahier> *)
open Lxm
@@ -53,10 +53,9 @@ let (create : AstTab.t -> t) =
fun tbl ->
let nodes_tbl = Hashtbl.create 0 in
let prov_nodes_tbl = Hashtbl.create 0 in
-(* GESTION DES OP PREDEF LAISSE A DESIRER !
- 12/07 on garde cette bequille, mais faudra
- sans doute revoir plus globalement ...
-*)
+ (* Iterated operators need to be in this table. Ideally, the lazy
+ compiler should be able to pull such strings though...
+ *)
List.iter
(fun op ->
let op_str = AstPredef.op2string op in
@@ -603,7 +602,7 @@ and (const_check_do : t -> Ident.long -> Lxm.t -> AstTabSymbol.t -> bool ->
type, but that would make quite a lot of noise in the
remaining...
*)
- Abstract_const_eff(lid, teff, Int_const_eff (-666), false)
+ Abstract_const_eff(lid, teff, Int_const_eff ("-666"), false)
| Some c ->
let ceff = match EvalConst.f id_solver c with
| [ceff] -> ceff
diff --git a/src/socPredef.ml b/src/socPredef.ml
index ef8a170f..7b2bf49d 100644
--- a/src/socPredef.ml
+++ b/src/socPredef.ml
@@ -1,4 +1,4 @@
-(* Time-stamp: <modified the 22/03/2013 (at 10:53) by Erwan Jahier> *)
+(* Time-stamp: <modified the 26/03/2013 (at 09:57) by Erwan Jahier> *)
(** Synchronous Object Code for Predefined operators. *)
@@ -390,100 +390,35 @@ let make_hat_soc: int -> Soc.var_type -> Soc.t =
-let soc_interface_of_predef:
- Lxm.t -> AstPredef.op -> Soc.var_type list -> Soc.t =
- fun lxm op types ->
- match (op, types) with (* utile de re-vérifier le type ? *)
- | AstPredef.IPLUS_n, [Int; Int] -> of_soc_key (("Lustre::plus"), types@[Int], None)
- | AstPredef.PLUS_n, [Int; Int] -> of_soc_key (("Lustre::plus"), types@[Int], None)
- | AstPredef.PLUS_n, [Real; Real] -> of_soc_key (("Lustre::plus"), types@[Real], None)
- | AstPredef.RPLUS_n, [Real; Real] -> of_soc_key (("Lustre::plus"), types@[Real], None)
- | AstPredef.ITIMES_n,[Int; Int] -> of_soc_key (("Lustre::times"), types@[Int], None)
- | AstPredef.TIMES_n, [Int; Int] -> of_soc_key (("Lustre::times"), types@[Int], None)
- | AstPredef.TIMES_n, [Real; Real] -> of_soc_key (("Lustre::times"), types@[Real], None)
- | AstPredef.RTIMES_n,[Real; Real] -> of_soc_key (("Lustre::times"), types@[Real], None)
- | AstPredef.ISLASH_n,[Int; Int] -> of_soc_key (("Lustre::div"), types@[Int], None)
- | AstPredef.SLASH_n, [Int; Int] -> of_soc_key (("Lustre::div"), types@[Int], None)
- | AstPredef.DIV_n, [Int; Int] -> of_soc_key (("Lustre::div"), types@[Int], None)
- | AstPredef.MOD_n, [Int;Int] -> of_soc_key (("Lustre::mod"), types@[Int], None)
- | AstPredef.SLASH_n, [Real; Real] -> of_soc_key (("Lustre::div"), types@[Real], None)
- | AstPredef.RSLASH_n,[Real; Real] -> of_soc_key (("Lustre::div"), types@[Real], None)
- | AstPredef.MINUS_n, [Int; Int] -> of_soc_key (("Lustre::minus"), types@[Int], None)
- | AstPredef.IMINUS_n,[Int; Int] -> of_soc_key (("Lustre::minus"), types@[Int], None)
- | AstPredef.MINUS_n, [Real; Real] -> of_soc_key (("Lustre::minus"), types@[Real], None)
- | AstPredef.RMINUS_n,[Real; Real] -> of_soc_key (("Lustre::minus"), types@[Real], None)
- | AstPredef.UMINUS_n,[Int] -> of_soc_key (("Lustre::uminus"), types@[Int], None)
- | AstPredef.IUMINUS_n, [Int] -> of_soc_key (("Lustre::uminus"), types@[Int], None)
- | AstPredef.UMINUS_n, [Real] -> of_soc_key (("Lustre::uminus"), types@[Real], None)
- | AstPredef.RUMINUS_n, [Real] -> of_soc_key (("Lustre::uminus"), types@[Real], None)
- | AstPredef.LT_n, [_; _] -> of_soc_key (("Lustre::lt"), types@[Bool], None)
- | AstPredef.GT_n, [_; _] -> of_soc_key (("Lustre::gt"), types@[Bool], None)
- | AstPredef.LTE_n, [_; _] -> of_soc_key (("Lustre::lte"), types@[Bool], None)
- | AstPredef.GTE_n, [_; _] -> of_soc_key (("Lustre::gte"), types@[Bool], None)
- | AstPredef.AND_n, [Bool; Bool] -> of_soc_key (("Lustre::and"), types@[Bool], None)
- | AstPredef.OR_n, [Bool; Bool] -> of_soc_key (("Lustre::or"), types@[Bool], None)
- | AstPredef.XOR_n, [Bool; Bool] -> of_soc_key (("Lustre::xor"), types@[Bool], None)
- | AstPredef.IMPL_n, [Bool; Bool] -> of_soc_key (("Lustre::impl"), types@[Bool], None)
- | AstPredef.EQ_n , [_; _] -> of_soc_key (("Lustre::eq"), types@[Bool], None)
- | AstPredef.NEQ_n, [_; _] -> of_soc_key (("Lustre::neq"), types@[Bool], None)
- | AstPredef.NOT_n, [Bool] -> of_soc_key (("Lustre::not"), types@[Bool], None)
-
- | AstPredef.TRUE_n, [] -> finish_me lxm ; assert false (* todo *)
- | AstPredef.FALSE_n, [] -> finish_me lxm ; assert false (* todo *)
- | AstPredef.RCONST_n _, [] -> finish_me lxm ; assert false (* todo *)
- | AstPredef.ICONST_n _, [] -> finish_me lxm ; assert false (* todo *)
- | AstPredef.REAL2INT_n, [Real] -> of_soc_key (("Lustre::real2int"), [Real;Int], None)
- | AstPredef.INT2REAL_n, [Int] -> finish_me lxm ; assert false (* todo *)
- | AstPredef.NOR_n, _ -> finish_me lxm ; assert false (* todo *)
- | AstPredef.DIESE_n, _ -> finish_me lxm ; assert false (* todo *)
- | AstPredef.IF_n, [Bool; a ; b ] ->
- let concrete_type = a in
- let comp = of_soc_key (("Lustre::if"), types@[concrete_type], None) in
- instanciate_soc comp concrete_type
-
- (* « incorrect lic » *)
- | AstPredef.IF_n, _ -> assert false
- | AstPredef.IUMINUS_n, _ -> assert false
- | AstPredef.IMINUS_n, _ -> assert false
- | AstPredef.RUMINUS_n, _ -> assert false
- | AstPredef.RMINUS_n, _ -> assert false
- | AstPredef.TRUE_n, _ -> assert false
- | AstPredef.FALSE_n, _ -> assert false
- | AstPredef.RCONST_n _, _ -> assert false
- | AstPredef.ICONST_n _, _ -> assert false
- | AstPredef.REAL2INT_n, _ -> assert false
- | AstPredef.INT2REAL_n, _ -> assert false
- | AstPredef.PLUS_n, _ -> assert false
- | AstPredef.IPLUS_n, _ -> assert false
- | AstPredef.RPLUS_n, _ -> assert false
- | AstPredef.TIMES_n, _ -> assert false
- | AstPredef.ITIMES_n, _ -> assert false
- | AstPredef.RTIMES_n, _ -> assert false
- | AstPredef.DIV_n, _ -> assert false
- | AstPredef.MOD_n, _ -> assert false
- | AstPredef.SLASH_n, _ -> assert false
- | AstPredef.ISLASH_n, _ -> assert false
- | AstPredef.RSLASH_n, _ -> assert false
- | AstPredef.MINUS_n, _ -> assert false
- | AstPredef.UMINUS_n, _ -> assert false
- | AstPredef.GT_n, _ -> assert false
- | AstPredef.LT_n, _ -> assert false
- | AstPredef.LTE_n, _ -> assert false
- | AstPredef.GTE_n, _ -> assert false
- | AstPredef.AND_n, _ -> assert false
- | AstPredef.OR_n, _ -> assert false
- | AstPredef.XOR_n, _ -> assert false
- | AstPredef.IMPL_n, _ -> assert false
- | AstPredef.EQ_n, _ -> assert false
- | AstPredef.NEQ_n, _ -> assert false
- | AstPredef.NOT_n, _ -> assert false
-
+let output_type_of_op op tl =
+ match op with
+ | "Lustre::eq"
+ | "Lustre::neq"
+ | "Lustre::lt"
+ | "Lustre::gt"
+ | "Lustre::lte"
+ | "Lustre::gte" -> Bool
+ | "Lustre::real2int" -> Int
+ | "Lustre::int2real" -> Real
+ | "Lustre::if" -> List.hd (List.tl tl)
+ | _ -> List.hd tl
+
let (soc_interface_of_pos_op:
Lxm.t -> Lic.by_pos_op -> Soc.var_type list -> Soc.t) =
fun lxm op types ->
match (op, types) with
- | Lic.PREDEF_CALL op, _ -> soc_interface_of_predef lxm op types
+ | Lic.PREDEF_CALL ({Lxm.it=("Lustre","if"),[]}), _ ->
+ let concrete_type = List.nth types 1 in
+ let soc = of_soc_key ("Lustre::if", types@[concrete_type], None) in
+ instanciate_soc soc concrete_type
+
+ | Lic.PREDEF_CALL {Lxm.it=(op,sargs)}, _ ->
+ assert (sargs=[]);
+ let soc_name = Ident.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], None) in
+ soc
| Lic.FBY, _ ->
let concrete_type = List.nth types 0 in
@@ -517,6 +452,7 @@ let (soc_interface_of_pos_op:
| Lic.CONCAT , _ -> assert false
| Lic.CALL _,_ -> assert false (* XXX todo *)
+ | Lic.CONST _ , _ -> assert false
(* Those are not soc *)
diff --git a/src/unifyClock.ml b/src/unifyClock.ml
index b7cbe429..233bc279 100644
--- a/src/unifyClock.ml
+++ b/src/unifyClock.ml
@@ -1,4 +1,4 @@
-(* Time-stamp: <modified the 13/02/2013 (at 10:08) by Erwan Jahier> *)
+(* Time-stamp: <modified the 27/03/2013 (at 10:04) by Erwan Jahier> *)
open LicDump
@@ -284,14 +284,10 @@ let rec (const_to_val_eff: Lxm.t -> bool -> subst -> const -> subst * val_exp) =
}
in
let mk_by_pos_op by_pos_op_eff = mk_by_pos_op_arg by_pos_op_eff [] in
- let id_of_int i = Ident.of_string (string_of_int i) in
match const with
- | Bool_const_eff b ->
- s, mk_by_pos_op (PREDEF_CALL((if b then AstPredef.TRUE_n else AstPredef.FALSE_n)))
- | Int_const_eff i ->
- s, mk_by_pos_op (PREDEF_CALL((AstPredef.ICONST_n (id_of_int i))))
- | Real_const_eff r ->
- s, mk_by_pos_op (PREDEF_CALL((AstPredef.RCONST_n (Ident.of_string r))))
+ | Bool_const_eff _
+ | Int_const_eff _
+ | Real_const_eff _ -> s, mk_by_pos_op (CONST const)
| Enum_const_eff (l, _)
| Extern_const_eff (l, _) -> s, mk_by_pos_op (CONST_REF l)
diff --git a/test/lus2lic.sum b/test/lus2lic.sum
index eb4863b2..7b7da54d 100644
--- a/test/lus2lic.sum
+++ b/test/lus2lic.sum
@@ -1,4 +1,4 @@
-Test Run By jahier on Mon Mar 25 16:20:24 2013
+Test Run By jahier on Wed Mar 27 09:50:22 2013
Native configuration is i686-pc-linux-gnu
=== lus2lic tests ===
diff --git a/test/lus2lic.time b/test/lus2lic.time
index 72603aab..0a65f1e7 100644
--- a/test/lus2lic.time
+++ b/test/lus2lic.time
@@ -1,2 +1,2 @@
-testcase ./lus2lic.tests/non-reg.exp completed in 25 seconds
-testcase ./lus2lic.tests/progression.exp completed in 0 seconds
+testcase ./lus2lic.tests/non-reg.exp completed in 26 seconds
+testcase ./lus2lic.tests/progression.exp completed in 1 seconds
--
GitLab