Skip to content

GitLab

Commit 124c9ce9 authored by Erwan Jahier's avatar Erwan Jahier
Browse files

Update the lus2lic plugin.

parent 8eb71ec8
Hide whitespace changes
Inline Side-by-side
source/Makefile
View file @ 124c9ce9
......@@ -411,8 +411,7 @@ lut4ocaml_assert:$(OBJDIR)
# cp -f $(OBJDIR)/lut4ocaml.top $(PRE_RELEASE_DIR)/bin || true
lut4ocaml-cp:
cp -f $(OBJDIR)/lutinRun.* $(PRE_RELEASE_DIR)/lib
# cp -f $(OBJDIR)/lut4ocaml_*.* $(PRE_RELEASE_DIR)/lib
cp -f $(OBJDIR)/lut4ocaml*.*a $(PRE_RELEASE_DIR)/lib
# cf lut4ocaml dans user-rules
......@@ -783,7 +782,8 @@ lutin-labo-install:
labo: lutin-labo-install
rdbg:
# copy my verimag install to www dirs
rdbg-www:
cp -rf $(CAML_INSTALL_DIR)/lutin/ ~/rdbg/www/plugins/$(HOSTTYPE)-ocaml$(shell $(OCAMLC) -version)/
cp -rf $(CAML_INSTALL_DIR)/lustre-v6/ ~/rdbg/www/plugins/$(HOSTTYPE)-ocaml$(shell $(OCAMLC) -version)/
cp ~/lus2lic/linux/bin/lus2lic ~/rdbg/www/plugins/$(HOSTTYPE)-ocaml$(shell $(OCAMLC) -version)/bin/
......
source/lus2lic/astPredef.ml
View file @ 124c9ce9
(* Time-stamp: <modified the 28/05/2013 (at 10:47) by Erwan Jahier> *)
(* Time-stamp: <modified the 26/06/2014 (at 18:29) by Erwan Jahier> *)
(** Predefined operators Type definition *)
......@@ -21,10 +21,9 @@ type op =
| IMPL_n
| EQ_n
| NEQ_n
| LT_n
| LTE_n
| GT_n
| GTE_n
| LT_n | LTE_n | GT_n | GTE_n
| ILT_n | ILTE_n| IGT_n| IGTE_n
| RLT_n| RLTE_n| RGT_n| RGTE_n
| DIV_n
| MOD_n
(* ternary *)
......@@ -55,7 +54,10 @@ type op =
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;
EQ_n; NEQ_n; LT_n; LTE_n; GT_n; GTE_n;
LT_n; LTE_n; GT_n; GTE_n ;
ILT_n; ILTE_n; IGT_n; IGTE_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
......@@ -69,7 +71,10 @@ let iterable_op = [
DIV_n; MOD_n; IUMINUS_n; IMINUS_n; IPLUS_n; ISLASH_n; ITIMES_n;
RUMINUS_n; RMINUS_n; RPLUS_n; RSLASH_n; RTIMES_n ;
UMINUS_n; MINUS_n; PLUS_n; SLASH_n; TIMES_n ;
EQ_n; NEQ_n; LT_n; LTE_n; GT_n; GTE_n ;
EQ_n; NEQ_n;
LT_n; LTE_n; GT_n; GTE_n ;
ILT_n; ILTE_n; IGT_n; IGTE_n ;
RLT_n; RLTE_n; RGT_n; RGTE_n ;
IF_n;
]
......@@ -89,10 +94,10 @@ let op2string = function
| IMPL_n -> "=>"
| EQ_n -> "="
| NEQ_n -> "<>"
| LT_n -> "<"
| LTE_n -> "<="
| GT_n -> ">"
| GTE_n -> ">="
| LT_n | ILT_n | RLT_n -> "<"
| LTE_n | ILTE_n | RLTE_n -> "<="
| GT_n | IGT_n | RGT_n -> ">"
| GTE_n | IGTE_n | RGTE_n -> ">="
| DIV_n -> "div"
| MOD_n -> "mod"
| IF_n -> "if"
......@@ -119,9 +124,17 @@ let op2string_long = function
| NEQ_n -> "neq"
| IMPL_n -> "impl"
| LT_n -> "lt"
| ILT_n -> "ilt"
| RLT_n -> "rlt"
| LTE_n -> "lte"
| ILTE_n -> "ilte"
| RLTE_n -> "rlte"
| GT_n -> "gt"
| IGT_n -> "igt"
| RGT_n -> "rgt"
| GTE_n -> "gte"
| IGTE_n -> "igte"
| RGTE_n -> "rgte"
| DIESE_n -> "diese"
| UMINUS_n -> "uminus"
| MINUS_n -> "minus"
......@@ -141,7 +154,10 @@ let op2string_long = function
| op -> op2string op
let is_infix = function
| AND_n | OR_n | XOR_n | IMPL_n | EQ_n | NEQ_n | LT_n | LTE_n | GT_n | GTE_n | DIV_n
| AND_n | OR_n | XOR_n | IMPL_n | EQ_n | NEQ_n | LT_n | LTE_n | GT_n | GTE_n
| ILT_n | ILTE_n| IGT_n| IGTE_n
| RLT_n| RLTE_n| RGT_n| RGTE_n
| DIV_n
| MOD_n | IF_n | MINUS_n | PLUS_n | SLASH_n | TIMES_n | IMINUS_n | IPLUS_n
| ISLASH_n | ITIMES_n | RMINUS_n | RPLUS_n | RSLASH_n | RTIMES_n
-> true
......@@ -171,9 +187,17 @@ let (string_to_op : string -> op) =
| "eq" -> EQ_n
| "neq" -> NEQ_n
| "lt" -> LT_n
| "ilt" -> ILT_n
| "rlt" -> RLT_n
| "lte" -> LTE_n
| "ilte" -> ILTE_n
| "rlte" -> RLTE_n
| "gt" -> GT_n
| "igt" -> IGT_n
| "rgt" -> RGT_n
| "gte" -> GTE_n
| "igte" -> IGTE_n
| "rgte" -> RGTE_n
| "div" -> DIV_n
| "mod" -> MOD_n
(* ternary *)
......
source/lus2lic/l2lRmPoly.ml
View file @ 124c9ce9
(* Time-stamp: <modified the 16/05/2013 (at 10:27) by Erwan Jahier> *)
(* Time-stamp: <modified the 26/06/2014 (at 17:59) by Erwan Jahier> *)
(*
Source 2 source transformation :
......@@ -11,6 +11,12 @@ open Lic
let dbg = (Verbose.get_flag "poly")
let (is_predef_overloaded : Lic.node_key -> bool) =
fun nk ->
match fst nk with
| ("Lustre",("times"|"slash"|"uminus"|"minus"|"plus"|"lt"|"lte"|"gt"|"gte")) -> true
| _ -> false
(** utile : on ne traite que les poly non externe *)
let node_is_poly ne =
(Lic.node_is_poly ne) && not (Lic.node_is_extern ne)
......@@ -27,6 +33,21 @@ let static_args_of_matches matches =
TypeStaticArgLic (tid, te)
) matches
(* tranform "plus" into "iplus", etc. *)
let (instanciate_node_key: Lic.type_matches -> Lic.node_key -> Lic.node_key) =
fun tmatches nk ->
if is_predef_overloaded nk then (
let ((m,n),sargs) = nk in
try if List.assoc AnyNum tmatches = Int_type_eff then
("Lustre","i"^n),sargs
else
("Lustre","r"^n),sargs
with Not_found -> nk
) else
nk
let rec doit (inprg : LicPrg.t) : LicPrg.t =
(* n.b. on fait un minumum d'effet de bord pour
pas avoir trop d'acummulateur ... *)
......@@ -47,7 +68,9 @@ let rec doit (inprg : LicPrg.t) : LicPrg.t =
(** TRAITE LES NOEUDS : *)
let rec do_node k (ne:Lic.node_exp) = (
if node_is_poly ne then
(* pour les noeuds polymorphes/surchagés, on fait rien du tout *)
(* pour les noeuds *NON* polymorphes/surchagés, on fait rien du tout.
pour les noeuds Lustre polymorphe (if, eq, neq) non plus.
*)
Verbose.exe ~flag:dbg (fun() -> Printf.printf
"### Warning: no code generated for polymorphic/overloaded node '%s'\n"
(Lic.string_of_node_key ne.node_key_eff))
......@@ -102,15 +125,19 @@ let rec doit (inprg : LicPrg.t) : LicPrg.t =
| Some n -> n
| None -> assert false
in
let nk' = if node_is_poly ne then (
Verbose.exe ~flag:dbg (fun () ->
Printf.fprintf stderr "#DBG: CALL poly node %s\n"
(Lxm.details posop.src));
let intypes = types_of_operands ops' in
let (inpars, _) = Lic.profile_of_node_exp ne in
let tmatches = UnifyType.is_matched inpars intypes in
{it=solve_poly tmatches nk.it ne; src=nk.src}
) else nk in
let nk' = if is_predef_overloaded nk.it then
(Lxm.flagit (instanciate_node_key m nk.it) nk.src)
else if node_is_poly ne
then (
Verbose.exe ~flag:dbg (fun () ->
Printf.fprintf stderr "#DBG: CALL poly node %s\n" (Lxm.details posop.src));
let intypes = types_of_operands ops' in
let (inpars, _) = Lic.profile_of_node_exp ne in
let tmatches = UnifyType.is_matched inpars intypes in
{it=solve_poly tmatches nk.it ne; src=nk.src}
)
else nk
in
let posop' = Lxm.flagit (CALL nk') posop.src in
CallByPosLic (posop', ops')
| x ->
......@@ -132,7 +159,7 @@ let rec doit (inprg : LicPrg.t) : LicPrg.t =
| TypeStaticArgLic (id, ty) -> a
| NodeStaticArgLic (id, nk) -> (
match nk with
| (("Lustre",_),[]) -> a
| (("Lustre",_),[]) -> NodeStaticArgLic (id, instanciate_node_key m nk)
| _ ->
let ne =
match LicPrg.find_node inprg nk with
......
source/lus2lic/l2lRmPoly.mli
View file @ 124c9ce9
(* Time-stamp: <modified the 18/12/2012 (at 10:13) by Erwan Jahier> *)
(* Time-stamp: <modified the 30/06/2014 (at 10:26) by Erwan Jahier> *)
(** Remove overloading of nodes used with iterators.
nb: it actually does not remove remove polymorphism actually -> TODO: Rename this module.
nb2 : only if/then/else is truely polymorphic.
(** Remove polymorphism and overloading
nb :
- il est préférable d'appeler
......
source/lus2lic/lic2soc.ml
View file @ 124c9ce9
(** Time-stamp: <modified the 25/06/2014 (at 14:38) by Erwan Jahier> *)
(** Time-stamp: <modified the 01/07/2014 (at 17:36) by Erwan Jahier> *)
(* XXX ce module est mal crit. A reprendre. (R1) *)
......@@ -32,6 +32,8 @@ let create_context: (LicPrg.t -> ctx) =
locals = [];
}
exception Polymorphic
let rec lic_to_data_type: (Lic.type_ -> Data.t) =
function
| Lic.Bool_type_eff -> Data.Bool
......@@ -50,8 +52,18 @@ let rec lic_to_data_type: (Lic.type_ -> Data.t) =
)
| 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.TypeVar Lic.Any -> assert false (* Data.Alpha 0 *)
| Lic.TypeVar Lic.AnyNum -> assert false (* Data.Alpha 1 *)
| Lic.TypeVar Lic.Any -> Data.Alpha 0
| Lic.TypeVar Lic.AnyNum ->
(* For some reasons, L2lRmPoly did not manage to resolve all the overloeding.
In that case, we stop.
nb : i raise an exception here because I've got no Lxm.t to use
to display a nice error message. If ever Polymorphic is raised
at the toplevel, its means that my "try/with Polymorphic" is not
done at the right place
*)
raise Polymorphic
(*********************************************************************************)
(** Renomme une variable dfinie par l'utilisateur.
......@@ -250,6 +262,22 @@ let build_step: Lxm.t -> string -> Lic.node_exp -> Soc.var list ->
Soc.impl = Soc.Gaol (locals, List.map gao_of_action actions)
}
let build_extern_step: Lxm.t -> string -> Lic.node_exp -> Soc.step_method =
fun lxm name node ->
(* Converti les entres/sorties d'un noeud en index
d'entres/sorties du composant *)
let convert_node_interface = fun l ->
fst (List.fold_left (fun (a, i) _ -> a @ [i], i+1) ([], 0) l)
in
{
Soc.name = name;
Soc.lxm = lxm;
Soc.idx_ins = convert_node_interface node.Lic.inlist_eff;
Soc.idx_outs = convert_node_interface node.Lic.outlist_eff;
Soc.impl = Soc.Extern
(* Soc.impl = Soc.Gaol ([], []) *)
}
let (lic_to_soc_var : Lic.var_info -> Soc.var) =
fun vi ->
vi.Lic.var_name_eff, lic_to_data_type vi.Lic.var_type_eff
......@@ -412,9 +440,9 @@ let (make_instance :
fun lxm clk ctx soc ->
match soc.Soc.instances with
| [] -> (
match soc.Soc.have_mem with
| None -> ctx, None
| Some (_) -> (* pre/fby/arrow/condact *)
match soc.Soc.memory with
| Soc.No_mem -> ctx, None
| _ -> (* pre/fby/arrow/condact + extern *)
let ctx, m = create_instance_from_soc ctx soc in
ctx, Some(m)
)
......@@ -725,6 +753,12 @@ let rec f: (LicPrg.t -> Lic.node_key -> Soc.key * Soc.tbl) =
let soc_tbl = SocMap.add soc.key soc soc_tbl in
snd (process_node nk soc_tbl)
)
| Polymorphic ->
let msg = (Lxm.details node.lxm) ^
": cannot infer the type of this polymorphic node. Please be more specific.\n"
in
raise (Lv6errors.Global_error msg)
in
sk, soc_tbl
......@@ -756,7 +790,7 @@ let rec f: (LicPrg.t -> Lic.node_key -> Soc.key * Soc.tbl) =
impl = Condact(nsk, List.flatten (List.map lic2soc_const vel));
}
];
Soc.have_mem = Some Data.Bool; (* to hold the first step flag *)
Soc.memory = Soc.Mem Data.Bool; (* to hold the first step flag *)
Soc.precedences = [];
}
in
......@@ -813,7 +847,7 @@ let rec f: (LicPrg.t -> Lic.node_key -> Soc.key * Soc.tbl) =
Soc.profile = soc_profile_of_node node;
Soc.instances = instances ;
Soc.step = [step];
Soc.have_mem = None;
Soc.memory = Soc.No_mem;
Soc.precedences = [];
}
in
......@@ -853,7 +887,7 @@ let rec f: (LicPrg.t -> Lic.node_key -> Soc.key * Soc.tbl) =
impl = Iterator(snd (fst nk), nsk, c);
}
];
Soc.have_mem = None;
Soc.memory = Soc.No_mem;
Soc.precedences = [];
}
......@@ -892,7 +926,7 @@ let rec f: (LicPrg.t -> Lic.node_key -> Soc.key * Soc.tbl) =
impl = Boolred(i,j,k);
}
];
Soc.have_mem = None;
Soc.memory = Soc.No_mem;
Soc.precedences = [];
}
in
......@@ -902,23 +936,22 @@ let rec f: (LicPrg.t -> Lic.node_key -> Soc.key * Soc.tbl) =
in
let (soc_of_extern: Lic.node_exp -> Soc.tbl -> (ctx * Soc.t * Soc.tbl) option) =
fun node soc_tbl ->
try
try
let soc = SocPredef.of_soc_key soc_key in
Some(ctx, soc, soc_tbl)
with e ->
with _ ->
(* This extern node is not a predef *)
let step = build_extern_step lxm "step" node in
let soc = {
Soc.key = soc_key;
Soc.profile = soc_profile_of_node node;
Soc.instances = [] ;
Soc.step = [];
Soc.have_mem = None; (* XXX there is something todo if node.Lic.has_mem_eff; *)
Soc.step = [step];
Soc.memory = if node.Lic.has_mem_eff then Soc.Mem_hidden else Soc.No_mem;
Soc.precedences = [];
}
in
(* Some(create_context licprg, soc) *)
print_string "Extern node not yet supported, sorry\n";
flush stdout;
assert false
Some(ctx, soc, soc_tbl)
in
match node.Lic.def_eff with
| AbstractLic None -> assert false (* None if extern in the provide part *)
......
source/lus2lic/licEvalConst.ml
View file @ 124c9ce9
(* Time-stamp: <modified the 11/04/2013 (at 15:31) by Erwan Jahier> *)
(* Time-stamp: <modified the 26/06/2014 (at 18:32) by Erwan Jahier> *)
open AstPredef
open Lic
......@@ -145,10 +145,10 @@ let f
| IMPL_n -> bbb_evaluator (fun a b -> (not a) || b) ll
| EQ_n -> aab_evaluator (=) ll
| NEQ_n -> aab_evaluator (<>) ll
| LT_n -> aab_evaluator (<) ll
| LTE_n -> aab_evaluator (<=) ll
| GT_n -> aab_evaluator (>) ll
| GTE_n -> aab_evaluator (>=) ll
| LT_n | ILT_n | RLT_n -> aab_evaluator (<) ll
| LTE_n | ILTE_n | RLTE_n -> aab_evaluator (<=) ll
| GT_n | IGT_n | RGT_n -> aab_evaluator (>) ll
| GTE_n | IGTE_n | RGTE_n -> aab_evaluator (>=) ll
| DIV_n -> iii_evaluator (/) ll
| MOD_n -> iii_evaluator (mod) ll
| IF_n -> ite_evaluator ll
......
source/lus2lic/licEvalType.ml
View file @ 124c9ce9
(* Time-stamp: <modified the 11/04/2013 (at 15:51) by Erwan Jahier> *)
(* Time-stamp: <modified the 26/06/2014 (at 18:31) by Erwan Jahier> *)
open AstPredef
open Lxm
......@@ -80,6 +80,9 @@ let baaa_profile = [(id "c", b);(id "b1",(TypeVar Any));(id "b2",(TypeVar Any))]
(** overloaded operator profiles *)
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 oob_profile = [(id "i1",(TypeVar AnyNum));(id "i2",(TypeVar AnyNum))], [(id "o",b)]
let iib_profile = [(id "i1",i);(id "i2",i)], [(id "o",b)]
let rrb_profile = [(id "i1",r);(id "i2",r)], [(id "o",b)]
(* let diese_profile = assert false *)
......@@ -275,8 +278,12 @@ let op2profile
| UMINUS_n -> oo_profile
| IUMINUS_n -> ii_profile
| 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
| IMPL_n | AND_n | OR_n | XOR_n -> bbb_profile
| NEQ_n
| EQ_n -> aab_profile
| RLT_n | RLTE_n | RGT_n | RGTE_n -> rrb_profile
| ILT_n | ILTE_n | IGT_n | IGTE_n -> iib_profile
| LT_n | LTE_n | GT_n | GTE_n -> oob_profile
| 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
......
source/lus2lic/lv6version.ml
View file @ 124c9ce9
(** Automatically generated from Makefile *)
let tool = "lus2lic"
let branch = "(no"
let commit = "487"
let sha_1 = "cf5ed5016ffbffb042fab17b9d5a33ca3232574b"
let commit = "494"
let sha_1 = "a4df5e5e2e3dfa12f721235e46c167022e858ee6"
let str = (branch ^ "." ^ commit ^ " (" ^ sha_1 ^ ")")
let maintainer = "jahier@imag.fr"
source/lus2lic/soc.ml
View file @ 124c9ce9
(* Time-stamp: <modified the 25/06/2014 (at 14:21) by Erwan Jahier> *)
(* Time-stamp: <modified the 01/07/2014 (at 15:40) by Erwan Jahier> *)
(** Synchronous Object Component *)
......@@ -56,6 +56,7 @@ type step_impl =
| Iterator of string * key * int (* iterator, iterated soc key, size *)
| Boolred of int * int * int
| Condact of key * var_expr list (* condact-ed node, default constants *)
| Extern
type step_method = {
name : ident;
......@@ -78,6 +79,11 @@ type precedence = ident * ident list
opening.
*)
type memory =
| No_mem
| Mem of Data.t
| Mem_hidden (* for extern nodes *)
type t = {
(* les memoires de l'objet sont calculées par l'interpreteur (ou l'objet C) *)
key : key;
......@@ -87,11 +93,11 @@ type t = {
step : step_method list; (* the order in the list is a valid w.r.t.
the partial order defined in precedences *)
precedences : precedence list; (* partial order over step methods *)
have_mem : Data.t option;
memory : memory;
(* Do this soc have a memory (pre, fby) + its type *)
}
(* SocKeyMap ? *)
module SocMap = Map.Make(
struct
type t = key
......
source/lus2lic/socExec.ml
View file @ 124c9ce9
(* Time-stamp: <modified the 20/06/2014 (at 11:29) by Erwan Jahier> *)
(* Time-stamp: <modified the 01/07/2014 (at 17:13) by Erwan Jahier> *)
open Soc
open Data
......@@ -32,6 +32,7 @@ let rec (soc_step : Soc.step_method -> Soc.tbl -> Soc.t -> SocExecValue.ctx
let soc_name,_,_ = soc.key in
let ctx =
match step.impl with
| Extern -> assert false (* fixme !!! *)
| Predef -> (
try
let ctx = SocExecEvalPredef.get soc.key ctx in
......@@ -76,7 +77,7 @@ let rec (soc_step : Soc.step_method -> Soc.tbl -> Soc.t -> SocExecValue.ctx
let ctx = do_step inst_name node_step ctx soc_tbl node_soc vel_in vel_out in
{ ctx with cpath=path_saved }
else
let first_step = Var ("$first_step",Bool) in
let first_step = Var ("_memory",Bool) in
let v = get_value ctx first_step in
if v = U || v = B true then
(* We are on the first step of node_soc;
......@@ -88,7 +89,7 @@ let rec (soc_step : Soc.step_method -> Soc.tbl -> Soc.t -> SocExecValue.ctx
and the output will keep their previous value. *)
{ ctx with cpath=path_saved }
in
let ctx = { ctx with s = sadd ctx.s ("$first_step"::ctx.cpath) (B false) } in
let ctx = { ctx with s = sadd ctx.s ("_memory"::ctx.cpath) (B false) } in
ctx
)
| Iterator(iter, node_sk, n) ->
......
source/lus2lic/socExecValue.ml
View file @ 124c9ce9
(* Time-stamp: <modified the 25/06/2014 (at 15:34) by Erwan Jahier> *)
(* Time-stamp: <modified the 01/07/2014 (at 14:42) by Erwan Jahier> *)
let dbg = (Verbose.get_flag "exec")
......@@ -259,7 +259,7 @@ let rec (get_value : ctx -> var_expr -> Data.v) =
| Const(id, Bool) -> assert false
| Const(id, Extern _) -> assert false
| Const(id, Alias _) -> assert false
(* | Const(id,Alpha _) -> assert false (* todo *) *)
| Const(id,Alpha _) -> assert false (* todo *)
| Field(ve,fn,t) ->
let s = get_value ctx ve in
(match s with
......@@ -352,18 +352,19 @@ let rec (create_ctx : Soc.tbl -> Soc.t -> ctx) =
let rec (init_soc: Soc.t -> ident list -> substs -> substs) =
fun soc cpath mem ->
let mem =
match soc.have_mem, soc.key with
| Some(vt), (_,_,MemInit dft_value) -> (
match soc.memory, soc.key with
| Mem(vt), (_,_,MemInit dft_value) -> (
let name = (SocPredef.get_mem_name soc.key vt)::cpath in
let value = get_value empty_ctx dft_value in
sadd mem name value
)
| Some(vt), _ -> (
| Mem(vt), _ -> (
let name = (SocPredef.get_mem_name soc.key vt)::cpath in
let value = U in
sadd mem name value
)
| None,_ -> mem
| No_mem,_ -> mem
| Mem_hidden,_ -> mem
in
List.fold_left (init_instances cpath) mem soc.instances
......
source/lus2lic/socPredef.ml
View file @ 124c9ce9
(* Time-stamp: <modified the 25/06/2014 (at 14:59) by Erwan Jahier> *)
(* Time-stamp: <modified the 01/07/2014 (at 15:25) by Erwan Jahier> *)
(** Synchronous Object Code for Predefined operators. *)
......@@ -60,7 +60,7 @@ let make_soc key profile steps = {
(* init = None; *)
precedences = [];
step = steps;
have_mem = None;
memory = No_mem;
}
......@@ -90,7 +90,7 @@ let of_fby_soc_key : Soc.var_expr -> Soc.key -> Soc.t =
key = sk;
profile = prof;
instances = [];
have_mem = Some t; (* so that pre_mem exist *)
memory = Mem t; (* so that pre_mem exist *)
step = [
(* faire qque chose de init maintenant !!! *)
{
......@@ -122,6 +122,7 @@ let of_soc_key : Soc.key -> Soc.t =
let sp = soc_profile_of_types in
let sp_nary = soc_profile_of_types_nary in
match id with
| "Lustre::ruminus"
| "Lustre::iuminus"
| "Lustre::uminus" -> (make_soc sk (sp tl) [step11])
| "Lustre::not" -> (make_soc sk (sp tl) [step11])
......@@ -130,16 +131,33 @@ let of_soc_key : Soc.key -> Soc.t =
| "Lustre::mod" -> (make_soc sk (sp tl) [step21 None])
| "Lustre::iplus"
| "Lustre::rplus"
| "Lustre::plus" -> (make_soc sk (sp tl) [step21 None])
| "Lustre::times" -> (make_soc sk (sp tl) [step21 None])
| "Lustre::slash" -> (make_soc sk (sp tl) [step21 None])
| "Lustre::div" -> (make_soc sk (sp tl) [step21 None])
| "Lustre::minus" -> (make_soc sk (sp tl) [step21 None])
| "Lustre::times"
| "Lustre::itimes"
| "Lustre::rtimes" -> (make_soc sk (sp tl) [step21 None])
| "Lustre::slash"
| "Lustre::islash"
| "Lustre::rslash" -> (make_soc sk (sp tl) [step21 None])
| "Lustre::div"
| "Lustre::idiv"
| "Lustre::rdiv" -> (make_soc sk (sp tl) [step21 None])
| "Lustre::minus"
| "Lustre::iminus"
| "Lustre::rminus" -> (make_soc sk (sp tl) [step21 None])
| "Lustre::lt" -> (make_soc sk (sp tl) [step21 None])
| "Lustre::gt" -> (make_soc sk (sp tl) [step21 None])
| "Lustre::lte" -> (make_soc sk (sp tl) [step21 None])
| "Lustre::gte" -> (make_soc sk (sp tl) [step21 None])
| "Lustre::ilt" -> (make_soc sk (sp tl) [step21 None])
| "Lustre::igt" -> (make_soc sk (sp tl) [step21 None])
| "Lustre::ilte" -> (make_soc sk (sp tl) [step21 None])
| "Lustre::igte"