Commit 0ee8b14c authored by Erwan Jahier's avatar Erwan Jahier
Browse files

Update the lus2lic plugin

parent c36f349a
......@@ -70,13 +70,16 @@ returns(x, y, p1x, p1y, p2x, p2y, p3x, p3y, p4x, p4y: real ; freeze:bool) =
{ draw_params() &> escape() } fby
-- { draw_params() and keep_position() } fby
{
|1: loop [0,40] line() -- forward straigth ahead for a while
-- |1: loop [0,40] line() -- forward straigth ahead for a while
|3: loop [0,40] curve() -- forward by turning for a while
|3: loop [0,60] spiral() -- forward by turning for a while
-- |3: loop [0,60] spiral() -- forward by turning for a while
}
-- do escape()
-- nb: if it is inside the obstacle, it keeps its position until it can move
}
node xxx (x : real) returns(cosx: real) =
loop { cosx = sin(x) }
(** Time-stamp: <modified the 06/10/2014 (at 10:46) by Erwan Jahier> *)
(** Time-stamp: <modified the 06/01/2015 (at 10:52) by Erwan Jahier> *)
let dbg = (Verbose.get_flag "deps")
......@@ -18,17 +18,11 @@ let string_of_action: (action -> string) =
in
let string_of_params p = String.concat ", " (List.map SocUtils.string_of_filter p) in
if o = [] then
Format.sprintf "%s(%s)"
(string_of_operation p)
(string_of_params i)
Format.sprintf "%s(%s)" (string_of_operation p) (string_of_params i)
else
Format.sprintf "%s = %s(%s) on %s"
(string_of_params o)
(string_of_operation p)
(string_of_params i)
(Lic.string_of_clock c)
(string_of_operation p) (string_of_params i) (Lic.string_of_clock c)
let string_of_action_simple: (action -> string) =
fun (c, i, o, p,_) ->
......
(* Time-stamp: <modified the 16/11/2014 (at 21:43) by Erwan JAHIER> *)
(* Time-stamp: <modified the 07/01/2015 (at 08:47) by Erwan Jahier> *)
(** Define the Data Structure representing Compiled programs. By
compiled we mean that constant are propagated, packages are
......@@ -154,7 +154,7 @@ and val_exp =
a cleaner solution would be to define two versions of val_exp: one with
type info, and one without. But it is a big mutually recursive thing,
and doing that would be a little bit heavy...
XXX why not an option type?
XXX why not an option type? because of tuples?
*)
ve_clk : clock list
(* ditto *)
......@@ -262,7 +262,7 @@ and clock =
| BaseLic
| ClockVar of int (* to deal with polymorphic clocks (i.e., constants) *)
| On of (Ident.long * Ident.t * type_) * clock
(* - The clock constructor,
(* - The clock constructor (holding the clock value),
- the clock variable
- the type of the clock variable (enum or bool)
- the clock of the clock
......
(** Time-stamp: <modified the 09/10/2014 (at 18:09) by Erwan Jahier> *)
(** Time-stamp: <modified the 07/01/2015 (at 16:18) by Erwan Jahier> *)
(* XXX ce module est mal crit. A reprendre. (R1) *)
......@@ -12,7 +12,6 @@ type action = ActionsDeps.action
(* Raised when a soc that haven't been translated yet is used in
another soc during the translation *)
exception Undef_soc of Soc.key * Lxm.t * Lic.by_pos_op * Data.t list * Soc.var_expr option
exception Undef_merge_soc of Soc.key * Lxm.t * val_exp * (const srcflagged * val_exp) list
(*********************************************************************************)
(** Informations lies au contexte de traduction. *)
......@@ -381,6 +380,50 @@ let rec (val_exp_to_filter: LicPrg.t -> Lic.val_exp -> Soc.var_expr) =
raise (Lv6errors.Global_error msg)
)
(*********************************************************************************)
let rec (is_a_sub_clock : Lic.clock -> Lic.clock -> bool) =
fun ck1 ck2 ->
ck1 = ck2 ||
match ck1,ck2 with
| _, BaseLic -> true
| BaseLic, _ -> false
| On(_,ck1), On(_,_) -> ck1 = ck2 || is_a_sub_clock ck1 ck2
| ClockVar _, _ -> assert false
| _, ClockVar _ -> assert false
| _, _ -> assert false
(* We can have 2 different definitions for the clock of an
expression. It can be the clock of its output, which is useful to
check that the lhs and the rhs of an equation are on the same
clock. But for node call, it also makes sense to consider that
the clock of the expression is the clock of its input, as their
control when the node should be called.
Anyway, the field ve_clk contains the clock of the outputs, and
this node compute the clock of the input (i.e., the quicker clock
among the inputs).
*)
let (clock_of_expr : Lic.val_exp -> Lic.clock) =
function
| { ve_core = CallByPosLic({it=CALL _}, args) } ->
let clks = List.map (fun arg -> arg.ve_clk) args in
let clks = List.flatten clks in
List.fold_left
(fun ck1 ck2 ->
if is_a_sub_clock ck1 ck2 then ck2 else
(assert (is_a_sub_clock ck2 ck1); ck1)
)
(List.hd clks) (List.tl clks)
| ve ->
(* if the expression is not a node call, its clock is the clock
of its output *)
(match ve.ve_clk with
| clk::_ -> clk (* no multiclock tuple for the time being *)
| [] -> assert false)
(*********************************************************************************)
(* type instance_init = Soc.instance * action list (* instance + son initialisation *) *)
......@@ -443,42 +486,20 @@ let (make_instance :
ctx, Some(m)
(*********************************************************************************)
(** Transforme une expression en action(s), et retourne la liste des variables
cres pour stocker le rsultat du calcul de cette expression.
Ces nouvelles variables serviront d'entres pour l'expression parente.
(** actions_of_expression_acc translates an expression and an
accumulator into an new accumulator. The accumulator is augmented
with the action resulting from the translation of the expression
plus the new dependancies.
It also augments the 3rd element of the 5-tuple that holds a list
of Soc.var_expr ; this list is meant to be used by the recursive calls only
(i.e., not by actions_of_expression)
*)
type e2a_acc = ctx * action list * Soc.var_expr list * Soc.instance list * ActionsDeps.t
(* XXX Bquille en attendant mieux *)
let (node_key_of_pos_op : Lic.by_pos_op -> Lic.node_key) = fun op ->
match op with
| PRE -> ("","Lustre::pre"),[]
| ARROW -> ("","Lustre::arrow" ),[]
| FBY-> ("","Lustre::fby"),[]
| CURRENT _ -> ("","Lustre::current"),[]
| CONCAT-> ("","Lustre::concat"),[]
| ARRAY -> ("","Lustre::array"),[]
| ARRAY_SLICE _ -> ("","Lustre::array_slice"),[]
| HAT _ -> ("","Lustre::hat"),[]
| CALL n | PREDEF_CALL n -> n.it
| _ -> assert false
let (get_exp_type : Soc.var_expr list -> Data.t list) =
fun vl ->
let tl = List.map Soc.data_type_of_var_expr vl in
tl
(* let res = *)
(* match tl with *)
(* | [] -> assert false *)
(* | [t] -> t *)
(* | t::_ -> Data.Array(t, List.length tl) *)
(* in *)
(* res *)
type e2a_acc =
ctx * action list * Soc.var_expr list (* this list is used in rec calls*)
* Soc.instance list * ActionsDeps.t
let rec (actions_of_expression_acc: Lxm.t -> Soc.tbl ->
let rec (actions_of_expression_acc: Lxm.t -> Soc.tbl ->
Lic.clock -> Soc.var_expr list -> e2a_acc -> Lic.val_exp -> e2a_acc) =
fun lxm soc_tbl clk lpl acc expr ->
let (ctx, al, iol, ml, deps) = acc in
......@@ -511,11 +532,45 @@ let rec (actions_of_expression_acc: Lxm.t -> Soc.tbl ->
in
ctx, actions@al, iol, ml, deps
)
| Merge(mclk, cl) -> (
(* Merge (like when) does not generate any soc, but states when
expressions are executed.
Here, we split Lic.Merge into several actions. Hopefully,
the test opening optimisation stage would be able to
reconstruct this merge into a proper Soc.case.
*)
let acc = List.fold_left
(fun acc (cc_flg,ve) ->
let clk_type = List.hd mclk.ve_typ in
let clkclk = List.hd mclk.ve_clk in
let clk_id = match mclk with
| { ve_core= CallByPosLic({it=VAR_REF id},[]) } -> id
| _ -> assert false
in
let cc_long = match cc_flg.it with
| Bool_const_eff true -> "Lustre", "true"
| Bool_const_eff false -> "Lustre", "false"
| Enum_const_eff(long,_) -> long
| _ -> assert false
in
let (clk:Lic.clock) = On((cc_long, clk_id, clk_type),clkclk) in
let ctx, actions, _, mems, deps = acc in
let ctx, actions2, inputs, mems2, deps2 =
actions_of_expression cc_flg.src soc_tbl ctx clk lpl ve
in
let mems = mems@mems2 in
let deps = ActionsDeps.concat deps deps2 in
let actions = (clk, inputs, lpl, Soc.Assign, cc_flg.src)::actions@actions2 in
ctx, actions, inputs, mems, deps
)
acc
cl
in
acc
)
| CallByPosLic (by_pos_op_flg, val_exp_list) -> (
match by_pos_op_flg.it with
| 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 -> (
(* 'when' does not generate any soc, but it states
when expressions are executed . *)
......@@ -533,23 +588,43 @@ let rec (actions_of_expression_acc: Lxm.t -> Soc.tbl ->
in
ctx, actions_reclocked, outputs, mems, deps
)
| 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 *)
| CURRENT _
| Lic.ARRAY_SLICE _
| CALL _ | PREDEF_CALL _
| HAT _ | ARRAY | PRE | ARROW | FBY | CONCAT -> (
(* retreive the soc of "expr" in soc_tbl *)
let soc : Soc.t =
let args_types : Data.t list =
List.map lic_to_data_type
(List.flatten (List.map (fun ve -> ve.ve_typ) val_exp_list))
in
let res_type = List.map lic_to_data_type expr.ve_typ in
(* let res_type = get_exp_type lpl in *)
(* let (get_exp_type : Soc.var_expr list -> Data.t list) =
fun vl ->
let tl = List.map Soc.data_type_of_var_expr vl in
tl
let res_type = get_exp_type lpl in *)
let full_profile = args_types @ res_type in
let si_opt = match by_pos_op_flg.it with
Lic.ARRAY_SLICE si -> Some si | _ -> None
in
(* XXX Bquille en attendant mieux *)
let (node_key_of_pos_op : Lic.by_pos_op -> Lic.node_key) = fun op ->
match op with
| PRE -> ("","Lustre::pre"),[]
| ARROW -> ("","Lustre::arrow" ),[]
| FBY-> ("","Lustre::fby"),[]
| CURRENT _ -> ("","Lustre::current"),[]
| CONCAT-> ("","Lustre::concat"),[]
| ARRAY -> ("","Lustre::array"),[]
| ARRAY_SLICE _ -> ("","Lustre::array_slice"),[]
| HAT _ -> ("","Lustre::hat"),[]
| CALL n | PREDEF_CALL n -> n.it
| _ -> assert false
in
let node_key = node_key_of_pos_op by_pos_op_flg.it in
let sk = make_soc_key_of_node_key node_key si_opt full_profile in
let (sk_name, sk_prof,_) = sk in
......@@ -580,66 +655,21 @@ let rec (actions_of_expression_acc: Lxm.t -> Soc.tbl ->
make_e2a_elt lxm clk lpl acc val_exp_list soc
)
)
| Merge(mclk, cl) -> (
let soc : Soc.t =
let (args_types : Data.t list) =
List.map lic_to_data_type
(List.flatten (List.map (fun (_,ve) -> ve.ve_typ) cl))
in
(* let res_type = List.map lic_to_data_type expr.ve_typ in *)
let res_type = get_exp_type lpl in
let full_profile = args_types @ res_type in
let sk = make_soc_key_of_node_key (("Lustre","merge"),[]) None full_profile in
try Soc.SocMap.find sk soc_tbl
with Not_found ->
Verbose.exe ~flag:dbg (fun () ->
let kl = fst (List.split (Soc.SocMap.bindings soc_tbl)) in
let klstr = List.map SocUtils.string_of_soc_key kl in
print_string ("\n********* Cannot find the soc.key " ^ (
SocUtils.string_of_soc_key sk) ^ " in \n\t" ^ (
String.concat "\n\t" klstr)^"\n"); flush stdout;
);
raise (Undef_merge_soc (sk, lxm, mclk, cl))
in
(* In order to reuse make_e2a_elt, I tranforsm the merge into a call
by position opeator ; hence I sort cl using to the type of mclk *)
let clk_type = List.hd mclk.ve_typ in
let (rank_of : Ident.long -> Ident.long -> Ident.long list -> int * int) =
fun c1 c2 l ->
let rec aux = function
| [] -> assert false
| x::t -> if x = c1 then 0,1 else if x = c2 then 1,0 else aux t
in
aux l
in
let long_of_const = function Enum_const_eff(l,_) -> l | _ -> assert false in
let compare_enum_case ({it=c1},_) ({it=c2},_) =
match clk_type with
| Bool_type_eff -> compare c2 c1 (* because in ocaml false < true *)
| Enum_type_eff(_,l) ->
let r1, r2 = rank_of (long_of_const c1) (long_of_const c2) l in
compare r1 r2
| _ -> assert false
in
let cl = List.sort compare_enum_case cl in
let val_exp_list = mclk::(List.map snd cl) in
make_e2a_elt lxm clk lpl acc val_exp_list soc
)
)
and (make_e2a_elt: Lxm.t -> Lic.clock -> Soc.var_expr list -> e2a_acc ->
Lic.val_exp list -> Soc.t -> e2a_acc) =
(* Use the soc to build the corresponding
- actions
- instances
- action dependances
*)
fun lxm clk lpl (ctx, al, iol, ml, deps) val_exp_list soc ->
fun lxm clk lpl acc val_exp_list soc ->
(* Update the acc with the actions made of the soc call:
lpl = soc(val_exp_list) on clk
*)
let (ctx, al, iol, ml, deps) = acc in
let inputs = List.map (val_exp_to_filter ctx.prg) val_exp_list in
let ctx, mem_opt = make_instance lxm clk ctx soc in
let actions =
let m2act = action_of_step lxm soc clk inputs lpl mem_opt in
List.map m2act soc.Soc.step
in
let actions = al @ actions in
let dependances : ActionsDeps.t =
let (prefixed_actions : (Soc.ident * action) list) = List.map2
(fun s a -> s.Soc.name,a) soc.Soc.step actions
......@@ -647,8 +677,9 @@ and (make_e2a_elt: Lxm.t -> Lic.clock -> Soc.var_expr list -> e2a_acc ->
ActionsDeps.generate_deps_from_step_policy
soc.Soc.precedences prefixed_actions
in
let dependances = ActionsDeps.concat deps dependances in
let ml = match mem_opt with Some m -> m::ml | None -> ml in
(ctx, actions, lpl, ml, dependances)
(ctx, actions, iol, ml, dependances)
(** Traduction d'une liste d'expressions. *)
and (actions_of_expression_list: Lxm.t -> Soc.tbl -> Lic.clock -> Soc.var_expr list ->
......@@ -656,64 +687,19 @@ and (actions_of_expression_list: Lxm.t -> Soc.tbl -> Lic.clock -> Soc.var_expr l
fun lxm soc_tbl clk lpl expr_list acc ->
List.fold_left (actions_of_expression_acc lxm soc_tbl clk lpl) expr_list acc
let (actions_of_expression : Lxm.t -> Soc.tbl -> ctx -> Lic.clock -> Soc.var_expr list ->
Lic.val_exp -> e2a_acc) =
and (actions_of_expression : Lxm.t -> Soc.tbl -> ctx -> Lic.clock -> Soc.var_expr list ->
Lic.val_exp -> e2a_acc) =
fun lxm soc_tbl ctx clk lpl expr ->
let acc0 = (ctx, [], [], [], ActionsDeps.empty) in
actions_of_expression_acc lxm soc_tbl clk lpl acc0 expr
(*********************************************************************************)
actions_of_expression_acc lxm soc_tbl clk lpl acc0 expr
let rec (is_a_sub_clock : Lic.clock -> Lic.clock -> bool) =
fun ck1 ck2 ->
ck1 = ck2 ||
match ck1,ck2 with
| _, BaseLic -> true
| BaseLic, _ -> false
| On(_,ck1), On(_,_) -> ck1 = ck2 || is_a_sub_clock ck1 ck2
| ClockVar _, _ -> assert false
| _, ClockVar _ -> assert false
| _, _ -> assert false
(* We can have 2 different definitions for the clock of an
expression. It can be the clock of its output, which is useful to
check that the lhs and the rhs of an equation are on the same
clock. But for node call, it also makes sense to consider that
the clock of the expression is the clock of its input, as their
control when the node should be called.
Anyway, the field ve_clk contains the clock of the outputs, and
this node compute the clock of the input (i.e., the quicker clock
among the inputs).
*)
let (clock_of_expr : Lic.val_exp -> Lic.clock) =
function
| { ve_core = CallByPosLic({it=CALL _}, args) } ->
let clks = List.map (fun arg -> arg.ve_clk) args in
let clks = List.flatten clks in
List.fold_left
(fun ck1 ck2 ->
if is_a_sub_clock ck1 ck2 then ck2 else
(assert (is_a_sub_clock ck2 ck1); ck1)
)
(List.hd clks) (List.tl clks)
| ve ->
(* if the expression is not a node call, its clock is the clock
of its output *)
(match ve.ve_clk with
| clk::_ -> clk (* no multiclock tuple for the time being *)
| [] -> assert false)
(*********************************************************************************)
(** Traduction d'une quation complte.
On traduit d'abord l'expression de l'quation, puis on fait une galit
entre les variables issues de la traduction de l'expression et la partie
gauche de l'quation. *)
(** Translates a equation into one or several actions.
Generated dependencies are merged by the caller.
*)
let (actions_of_equation: Lxm.t -> Soc.tbl -> ctx -> Lic.eq_info ->
ctx * action list * Soc.instance list * ActionsDeps.t) =
fun lxm soc_tbl ctx (left_part, right_part) ->
......@@ -784,11 +770,6 @@ 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)
)
| Undef_merge_soc (sk, lxm, clk, case_l) -> (
let soc = SocPredef.make_merge_soc sk in
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"
......
(** Automatically generated from Makefile *)
let tool = "lus2lic"
let branch = "master"
let commit = "542"
let sha_1 = "1042961407535d5fa282ca148411cc3915e7dd8a"
let commit = "545"
let sha_1 = "b80ad1fe8e6f5be3afb88f00e393ff8b2faa38f8"
let str = (branch ^ "." ^ commit ^ " (" ^ sha_1 ^ ")")
let maintainer = "jahier@imag.fr"
(* Time-stamp: <modified the 14/08/2014 (at 10:01) by Erwan Jahier> *)
(* Time-stamp: <modified the 06/01/2015 (at 11:35) by Erwan Jahier> *)
(** Synchronous Object Component *)
......@@ -49,7 +49,7 @@ type atomic_operation =
type gao =
| Case of ident (* enum var *) * (ident (* enum value *) * gao list) list
| Call of var_expr list * atomic_operation * var_expr list
(* outputs * op * inputs *)
(* outputs (lhs) * op * inputs (rhs) *)
type step_impl =
| Predef
......
(* Time-stamp: <modified the 14/08/2014 (at 16:46) by Erwan Jahier> *)
(* Time-stamp: <modified the 07/01/2015 (at 16:19) by Erwan Jahier> *)
open SocExecValue
open Data
......@@ -261,15 +261,6 @@ let lustre_array tl ctx =
let a = Array.of_list l in
{ ctx with s = sadd ctx.s ("z"::ctx.cpath) (A a) }
let lustre_merge tl ctx =
let (vn,vv) = match get_val "clk" ctx with
| B(true) -> "z"::ctx.cpath, get_val "x0" ctx
| B(false) -> "z"::ctx.cpath, get_val "x1" ctx
| E(_,i) -> "z"::ctx.cpath, get_val ("x"^(string_of_int i)) ctx
| _ -> assert false
in
{ ctx with s = sadd ctx.s vn vv }
let lustre_slice tl si_opt ctx =
let _t,size = match List.hd (List.rev tl) with
| Data.Array(t,i) -> t,i
......@@ -373,8 +364,7 @@ let (get: Soc.key -> (ctx -> ctx)) =
| "Lustre::arrow" -> lustre_arrow
| "Lustre::current" -> assert false
| "Lustre::merge" -> lustre_merge tl
| "Lustre::array_slice" -> lustre_slice tl si_opt
| "Lustre::nor" -> assert false (* ougth to be translated into boolred *)
......
(* Time-stamp: <modified the 08/10/2014 (at 17:49) by Erwan Jahier> *)
(* Time-stamp: <modified the 07/01/2015 (at 16:17) by Erwan Jahier> *)
(** Synchronous Object Code for Predefined operators. *)
......@@ -386,33 +386,6 @@ let make_array_slice_soc : Lic.slice_info -> int -> Data.t -> Soc.t =
memory = No_mem;
}
let (make_merge_soc: Soc.key -> Soc.t) =
fun sk ->
let (id, tl, _) = sk in
let in_tl, out_t = match List.rev tl with x::l -> List.rev l, x | [] -> assert false in
let profile_in = ("clk", List.hd in_tl)::
(List.mapi (fun i vt -> "x"^(string_of_int i), vt) in_tl)
in
let i = List.length in_tl in
{
Soc.key = sk;
Soc.profile = profile_in, ["z", out_t];
Soc.instances = [] ;
Soc.step = [
{
name = "step";
lxm = Lxm.dummy "merge soc";
idx_ins = SocUtils.gen_index_list (i+1);
idx_outs = [0];
impl = Predef;
}
];
Soc.memory = No_mem;
Soc.precedences = [];
}
let make_array_soc: int -> Data.t -> Soc.t =
fun i t ->
let iprof =
......
(* Time-stamp: <modified the 08/04/2013 (at 14:11) by Erwan Jahier> *)
(* Time-stamp: <modified the 07/01/2015 (at 16:18) by Erwan Jahier> *)
(** Synchronous Object Code for Predefined operators. *)
......@@ -14,5 +14,3 @@ val soc_interface_of_pos_op:
Lxm.t -> Lic.by_pos_op -> Data.t list -> Soc.var_expr option -> Soc.t
val get_mem_name : Soc.key -> Data.t -> string
val make_merge_soc: Soc.key -> Soc.t
Supports Markdown
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment