Skip to content
Snippets Groups Projects
Commit 0a87c4a3 authored by Erwan Jahier's avatar Erwan Jahier
Browse files

The -exec mode now supports 'hat' ("^").

parent 3d24ea7e
No related branches found
No related tags found
No related merge requests found
Hide whitespace changes
Inline Side-by-side
src/astPredef.ml
+ 3
− 3
View file @ 0a87c4a3
(* Time-stamp: <modified the 13/12/2012 (at 14:35) by Erwan Jahier> *) (* Time-stamp: <modified the 19/03/2013 (at 11:00) by Erwan Jahier> *)
(** Predefined operators Type definition *) (** Predefined operators Type definition *)
...@@ -121,12 +121,12 @@ let op2string_long = function ...@@ -121,12 +121,12 @@ let op2string_long = function
| TIMES_n -> "times" | TIMES_n -> "times"
| IUMINUS_n -> "iuminus" | IUMINUS_n -> "iuminus"
| IMINUS_n -> "iminus" | IMINUS_n -> "iminus"
| IPLUS_n -> "iplus" | IPLUS_n -> "plus"
| ISLASH_n -> "idiv" | ISLASH_n -> "idiv"
| ITIMES_n -> "itimes" | ITIMES_n -> "itimes"
| RUMINUS_n -> "ruminus" | RUMINUS_n -> "ruminus"
| RMINUS_n -> "rminus" | RMINUS_n -> "rminus"
| RPLUS_n -> "rplus" | RPLUS_n -> "plus"
| RSLASH_n -> "rdiv" | RSLASH_n -> "rdiv"
| RTIMES_n -> "rtimes" | RTIMES_n -> "rtimes"
| op -> op2string op | op -> op2string op
......
src/lic2soc.ml
+ 10
− 7
View file @ 0a87c4a3
(** Time-stamp: <modified the 19/03/2013 (at 10:32) by Erwan Jahier> *) (** Time-stamp: <modified the 19/03/2013 (at 15:11) by Erwan Jahier> *)
open Lxm open Lxm
open Lic open Lic
...@@ -423,6 +423,10 @@ let by_pos_op_to_soc_ident = function ...@@ -423,6 +423,10 @@ let by_pos_op_to_soc_ident = function
| CALL n -> string_of_node_key n.it | CALL n -> string_of_node_key n.it
| _ -> assert false | _ -> assert false
let (get_exp_type : Soc.var_expr list -> Soc.var_type list) =
List.map Soc.var_type_of_var_expr
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) = Lic.clock -> Soc.var_expr list -> e2a_acc -> Lic.val_exp -> e2a_acc) =
fun lxm soc_tbl clk lpl acc expr -> fun lxm soc_tbl clk lpl acc expr ->
...@@ -509,16 +513,15 @@ let rec (actions_of_expression_acc: Lxm.t -> Soc.tbl -> ...@@ -509,16 +513,15 @@ let rec (actions_of_expression_acc: Lxm.t -> Soc.tbl ->
List.map lic_to_soc_type List.map lic_to_soc_type
(List.flatten (List.map (fun ve -> ve.ve_typ) val_exp_list)) (List.flatten (List.map (fun ve -> ve.ve_typ) val_exp_list))
in in
let exp_type = List.hd(List.rev args_types) in let res_type = get_exp_type lpl in
let args_types_plus = let full_profile =
(* Add the type of the expression (indeed, eg, if ARROW has (* Add the type of the expression (indeed, eg, if ARROW has
2 args of the same type t, its profile is "t -> t -> t" 2 args of the same type t, its profile is "t -> t -> t"
hence we add the missing t in hence we add the missing t in
*) *)
args_types @ [exp_type] args_types @ res_type
in in
let id = SocPredef.instanciate_name id exp_type in let sk = id, full_profile, None in
let sk = id, args_types_plus, None in
try Soc.SocMap.find sk soc_tbl try Soc.SocMap.find sk soc_tbl
with Not_found -> with Not_found ->
Verbose.exe ~flag:dbg (fun () -> Verbose.exe ~flag:dbg (fun () ->
...@@ -702,7 +705,7 @@ let f: (LicPrg.t -> Lic.node_key -> Soc.key * Soc.tbl) = ...@@ -702,7 +705,7 @@ let f: (LicPrg.t -> Lic.node_key -> Soc.key * Soc.tbl) =
let t = List.hd types in let t = List.hd types in
(* The arrow is translated into a if. So we make sure that the "if" (* The arrow is translated into a if. So we make sure that the "if"
is in the soc tbl *) is in the soc tbl *)
let if_sk = SocPredef.instanciate_name "Lustre::if" t, [Bool;t;t], None in let if_sk = "Lustre::if", [Bool;t;t], None in
let acc_comp = let acc_comp =
if pos_op = Lic.ARROW && not(SocMap.mem if_sk acc_comp) then if pos_op = Lic.ARROW && not(SocMap.mem if_sk acc_comp) then
let soc = SocPredef.soc_interface_of_pos_op lxm let soc = SocPredef.soc_interface_of_pos_op lxm
......
src/soc.ml
+ 9
− 1
View file @ 0a87c4a3
(* Time-stamp: <modified the 18/03/2013 (at 15:46) by Erwan Jahier> *) (* Time-stamp: <modified the 19/03/2013 (at 15:08) by Erwan Jahier> *)
(** Synchronous Object Component *) (** Synchronous Object Component *)
...@@ -32,6 +32,14 @@ type var_expr = ...@@ -32,6 +32,14 @@ type var_expr =
| Field of var_expr * var | Field of var_expr * var
| Index of var_expr * int * var_type | Index of var_expr * int * var_type
let (var_type_of_var_expr : var_expr -> var_type) =
function
| Var(_,vt)
| Const(_,vt)
| Field(_, (_,vt))
| Index(_,_,vt) -> vt
type atomic_operation = type atomic_operation =
| Assign (* Wire *) | Assign (* Wire *)
| Method of instance * ident (* node step call ; the ident is the step name *) | Method of instance * ident (* node step call ; the ident is the step name *)
......
src/socExecEvalPredef.ml
+ 48
− 170
View file @ 0a87c4a3
(* Time-stamp: <modified the 14/03/2013 (at 14:24) by Erwan Jahier> *) (* Time-stamp: <modified the 19/03/2013 (at 14:40) by Erwan Jahier> *)
open SocExecValue open SocExecValue
open Soc open Soc
(* A boring but simple module... *) (* A boring but simple module... *)
let (lustre_iplus : ctx -> ctx) = let (lustre_plus : ctx -> ctx) =
fun ctx -> fun ctx ->
let ns = let ns =
match [get_val "x" ctx; get_val "y" ctx] with match [get_val "x" ctx; get_val "y" ctx] with
| [I x1; I x2] -> "z"::ctx.cpath,I(x1+x2) | [I x1; I x2] -> "z"::ctx.cpath,I(x1+x2)
| [U; _] | [_;U] -> "z"::ctx.cpath,U
| _ -> assert false
in
{ ctx with s = sadd ctx.s ns }
let (lustre_rplus:ctx -> ctx) =
fun ctx ->
let ns =
match ([get_val "x" ctx; get_val "y" ctx]) with
| [F i1; F i2] -> "z"::ctx.cpath,F(i1+.i2) | [F i1; F i2] -> "z"::ctx.cpath,F(i1+.i2)
| [U; _] | [_;U] -> "z"::ctx.cpath,U | [U; _] | [_;U] -> "z"::ctx.cpath,U
| _ -> assert false | _ -> assert false
in in
{ ctx with s = sadd ctx.s ns } { ctx with s = sadd ctx.s ns }
let lustre_times ctx =
let lustre_itimes ctx =
let ns = let ns =
match ([get_val "x" ctx; get_val "y" ctx]) with match ([get_val "x" ctx; get_val "y" ctx]) with
| [I x1; I x2] -> "z"::ctx.cpath,I(x1 * x2) | [I x1; I x2] -> "z"::ctx.cpath,I(x1 * x2)
| [U; _] | [_;U] -> "z"::ctx.cpath,U
| _ -> assert false
in
{ ctx with s = sadd ctx.s ns }
let lustre_rtimes ctx =
let ns =
match ([get_val "x" ctx; get_val "y" ctx]) with
| [F x1; F x2] -> "z"::ctx.cpath,F(x1 *. x2) | [F x1; F x2] -> "z"::ctx.cpath,F(x1 *. x2)
| [U; _] | [_;U] -> "z"::ctx.cpath,U | [U; _] | [_;U] -> "z"::ctx.cpath,U
| _ -> assert false | _ -> assert false
...@@ -46,19 +27,10 @@ let lustre_rtimes ctx = ...@@ -46,19 +27,10 @@ let lustre_rtimes ctx =
{ ctx with s = sadd ctx.s ns } { ctx with s = sadd ctx.s ns }
let lustre_idiv ctx = let lustre_div ctx =
let ns = let ns =
match ([get_val "x" ctx; get_val "y" ctx]) with match ([get_val "x" ctx; get_val "y" ctx]) with
| [I x1; I x2] -> "z"::ctx.cpath,I(x1 / x2) | [I x1; I x2] -> "z"::ctx.cpath,I(x1 / x2)
| [U; _] | [_;U] -> "z"::ctx.cpath,U
| _ -> assert false
in
{ ctx with s = sadd ctx.s ns }
let lustre_rdiv ctx =
let ns =
match ([get_val "x" ctx; get_val "y" ctx]) with
| [F x1; F x2] -> "z"::ctx.cpath,F(x1 /. x2) | [F x1; F x2] -> "z"::ctx.cpath,F(x1 /. x2)
| [U; _] | [_;U] -> "z"::ctx.cpath,U | [U; _] | [_;U] -> "z"::ctx.cpath,U
| _ -> assert false | _ -> assert false
...@@ -66,26 +38,16 @@ let lustre_rdiv ctx = ...@@ -66,26 +38,16 @@ let lustre_rdiv ctx =
{ ctx with s = sadd ctx.s ns } { ctx with s = sadd ctx.s ns }
let lustre_iminus ctx = let lustre_minus ctx =
let ns = let ns =
match ([get_val "x" ctx; get_val "y" ctx]) with match ([get_val "x" ctx; get_val "y" ctx]) with
| [I x1; I x2] -> "z"::ctx.cpath,I(x1 - x2) | [I x1; I x2] -> "z"::ctx.cpath,I(x1 - x2)
| [U; _] | [_;U] -> "z"::ctx.cpath,U
| _ -> assert false
in
{ ctx with s = sadd ctx.s ns }
let lustre_rminus ctx =
let ns =
match ([get_val "x" ctx; get_val "y" ctx]) with
| [F x1; F x2] -> "z"::ctx.cpath,F(x1 -. x2) | [F x1; F x2] -> "z"::ctx.cpath,F(x1 -. x2)
| [U; _] | [_;U] -> "z"::ctx.cpath,U | [U; _] | [_;U] -> "z"::ctx.cpath,U
| _ -> assert false | _ -> assert false
in in
{ ctx with s = sadd ctx.s ns } { ctx with s = sadd ctx.s ns }
let lustre_mod ctx = let lustre_mod ctx =
let ns = let ns =
match ([get_val "x" ctx; get_val "y" ctx]) with match ([get_val "x" ctx; get_val "y" ctx]) with
...@@ -96,46 +58,27 @@ let lustre_mod ctx = ...@@ -96,46 +58,27 @@ let lustre_mod ctx =
{ ctx with s = sadd ctx.s ns } { ctx with s = sadd ctx.s ns }
let lustre_ieq ctx = let lustre_eq ctx =
let ns = let ns =
match ([get_val "x" ctx; get_val "y" ctx]) with match ([get_val "x" ctx; get_val "y" ctx]) with
| [I x1; I x2] -> "z"::ctx.cpath,B(x1 = x2) | [I x1; I x2] -> "z"::ctx.cpath,B(x1 = x2)
| [U; _] | [_;U] -> "z"::ctx.cpath,U
| _ -> assert false
in
{ ctx with s = sadd ctx.s ns }
let lustre_req ctx =
let ns =
match ([get_val "x" ctx; get_val "y" ctx]) with
| [F x1; F x2] -> "z"::ctx.cpath,B(x1 = x2) | [F x1; F x2] -> "z"::ctx.cpath,B(x1 = x2)
| [B x1; B x2] -> "z"::ctx.cpath,B(x1 = x2)
| [U; _] | [_;U] -> "z"::ctx.cpath,U | [U; _] | [_;U] -> "z"::ctx.cpath,U
| _ -> assert false | _ -> assert false
in in
{ ctx with s = sadd ctx.s ns } { ctx with s = sadd ctx.s ns }
let lustre_uminus ctx =
let lustre_iuminus ctx =
let ns = let ns =
match ([get_val "x" ctx]) with match ([get_val "x" ctx]) with
| [I x1] -> "z"::ctx.cpath,I(- x1) | [I x1] -> "z"::ctx.cpath,I(- x1)
| [U; _] | [_;U] -> "z"::ctx.cpath,U
| _ -> assert false
in
{ ctx with s = sadd ctx.s ns }
let lustre_ruminus ctx =
let ns =
match ([get_val "x" ctx]) with
| [F x1] -> "z"::ctx.cpath,F(-. x1) | [F x1] -> "z"::ctx.cpath,F(-. x1)
| [U] -> "z"::ctx.cpath,U | [U; _] | [_;U] -> "z"::ctx.cpath,U
| _ -> assert false | _ -> assert false
in in
{ ctx with s = sadd ctx.s ns } { ctx with s = sadd ctx.s ns }
let lustre_real2int ctx = let lustre_real2int ctx =
let ns = let ns =
match ([get_val "x" ctx]) with match ([get_val "x" ctx]) with
...@@ -166,86 +109,46 @@ let lustre_not ctx = ...@@ -166,86 +109,46 @@ let lustre_not ctx =
{ ctx with s = sadd ctx.s ns } { ctx with s = sadd ctx.s ns }
let lustre_ilt ctx = let lustre_lt ctx =
let ns = let ns =
match ([get_val "x" ctx; get_val "y" ctx]) with match ([get_val "x" ctx; get_val "y" ctx]) with
| [I x1; I x2] -> "z"::ctx.cpath,B(x1 < x2) | [I x1; I x2] -> "z"::ctx.cpath,B(x1 < x2)
| [U; _] | [_;U] -> "z"::ctx.cpath,U
| _ -> assert false
in
{ ctx with s = sadd ctx.s ns }
let lustre_rlt ctx =
let ns =
match ([get_val "x" ctx; get_val "y" ctx]) with
| [F x1; F x2] -> "z"::ctx.cpath,B(x1 < x2) | [F x1; F x2] -> "z"::ctx.cpath,B(x1 < x2)
| [U; _] | [_;U] -> "z"::ctx.cpath,U | [U; _] | [_;U] -> "z"::ctx.cpath,U
| _ -> assert false | _ -> assert false
in in
{ ctx with s = sadd ctx.s ns } { ctx with s = sadd ctx.s ns }
let lustre_gt ctx =
let lustre_igt ctx =
let ns = let ns =
match ([get_val "x" ctx; get_val "y" ctx]) with match ([get_val "x" ctx; get_val "y" ctx]) with
| [I x1; I x2] -> "z"::ctx.cpath,B(x1 > x2) | [I x1; I x2] -> "z"::ctx.cpath,B(x1 > x2)
| [U; _] | [_;U] -> "z"::ctx.cpath,U
| _ -> assert false
in
{ ctx with s = sadd ctx.s ns }
let lustre_rgt ctx =
let ns =
match ([get_val "x" ctx; get_val "y" ctx]) with
| [F x1; F x2] -> "z"::ctx.cpath,B(x1 > x2) | [F x1; F x2] -> "z"::ctx.cpath,B(x1 > x2)
| [U; _] | [_;U] -> "z"::ctx.cpath,U | [U; _] | [_;U] -> "z"::ctx.cpath,U
| _ -> assert false | _ -> assert false
in in
{ ctx with s = sadd ctx.s ns } { ctx with s = sadd ctx.s ns }
let lustre_lte ctx =
let lustre_ilte ctx =
let ns = let ns =
match ([get_val "x" ctx; get_val "y" ctx]) with match ([get_val "x" ctx; get_val "y" ctx]) with
| [I x1; I x2] -> "z"::ctx.cpath,B(x1 <= x2) | [I x1; I x2] -> "z"::ctx.cpath,B(x1 <= x2)
| [U; _] | [_;U] -> "z"::ctx.cpath,U
| _ -> assert false
in
{ ctx with s = sadd ctx.s ns }
let lustre_rlte ctx =
let ns =
match ([get_val "x" ctx; get_val "y" ctx]) with
| [F x1; F x2] -> "z"::ctx.cpath,B(x1 <= x2) | [F x1; F x2] -> "z"::ctx.cpath,B(x1 <= x2)
| [U; _] | [_;U] -> "z"::ctx.cpath,U | [U; _] | [_;U] -> "z"::ctx.cpath,U
| _ -> assert false | _ -> assert false
in in
{ ctx with s = sadd ctx.s ns } { ctx with s = sadd ctx.s ns }
let lustre_gte ctx =
let lustre_igte ctx =
let ns = let ns =
match ([get_val "x" ctx; get_val "y" ctx]) with match ([get_val "x" ctx; get_val "y" ctx]) with
| [I x1; I x2] -> "z"::ctx.cpath,B(x1 >= x2) | [I x1; I x2] -> "z"::ctx.cpath,B(x1 >= x2)
| [U; _] | [_;U] -> "z"::ctx.cpath,U
| _ -> assert false
in
{ ctx with s = sadd ctx.s ns }
let lustre_rgte ctx =
let ns =
match ([get_val "x" ctx; get_val "y" ctx]) with
| [F x1; F x2] -> "z"::ctx.cpath,B(x1 >= x2) | [F x1; F x2] -> "z"::ctx.cpath,B(x1 >= x2)
| [U; _] | [_;U] -> "z"::ctx.cpath,U | [U; _] | [_;U] -> "z"::ctx.cpath,U
| _ -> assert false | _ -> assert false
in in
{ ctx with s = sadd ctx.s ns } { ctx with s = sadd ctx.s ns }
let lustre_and ctx = let lustre_and ctx =
let ns = let ns =
match ([get_val "x" ctx; get_val "y" ctx]) with match ([get_val "x" ctx; get_val "y" ctx]) with
...@@ -255,15 +158,6 @@ let lustre_and ctx = ...@@ -255,15 +158,6 @@ let lustre_and ctx =
in in
{ ctx with s = sadd ctx.s ns } { ctx with s = sadd ctx.s ns }
let lustre_beq ctx =
let ns =
match ([get_val "x" ctx; get_val "y" ctx]) with
| [B x1; B x2] -> "z"::ctx.cpath,B(x1 = x2)
| [U; _] | [_;U] -> "z"::ctx.cpath,U
| _ -> assert false
in
{ ctx with s = sadd ctx.s ns }
let lustre_neq ctx = let lustre_neq ctx =
let ns = let ns =
...@@ -294,43 +188,39 @@ let lustre_impl ctx = ...@@ -294,43 +188,39 @@ let lustre_impl ctx =
in in
{ ctx with s = sadd ctx.s ns } { ctx with s = sadd ctx.s ns }
let lustre_if ctx =
let lustre_iif ctx =
let ns = let ns =
match ([get_val "c" ctx; get_val "xt" ctx; get_val "xe" ctx]) with match ([get_val "c" ctx; get_val "xt" ctx; get_val "xe" ctx]) with
| [B c; I x1; I x2] -> "z"::ctx.cpath,I(if c then x1 else x2) | [B c; I x1; I x2] -> "z"::ctx.cpath,I(if c then x1 else x2)
| [B c; F x1; F x2] -> "z"::ctx.cpath,F(if c then x1 else x2)
| [B c; B x1; B x2] -> "z"::ctx.cpath,B(if c then x1 else x2)
| [B c; I x1; U] -> "z"::ctx.cpath,if c then I x1 else U | [B c; I x1; U] -> "z"::ctx.cpath,if c then I x1 else U
| [B c; U; I x2] -> "z"::ctx.cpath,if c then U else I x2 | [B c; U; I x2] -> "z"::ctx.cpath,if c then U else I x2
| [B c; B x1; U] -> "z"::ctx.cpath,if c then B x1 else U
| [B c; U; B x2] -> "z"::ctx.cpath,if c then U else B x2
| [B c; F x1; U] -> "z"::ctx.cpath,if c then F x1 else U
| [B c; U; F x2] -> "z"::ctx.cpath,if c then U else F x2
| [U;_; _] | [_;U;U] -> "z"::ctx.cpath,U | [U;_; _] | [_;U;U] -> "z"::ctx.cpath,U
| _ -> assert false | _ -> assert false
in in
{ ctx with s = sadd ctx.s ns } { ctx with s = sadd ctx.s ns }
let lustre_hat tl ctx =
let lustre_rif ctx = let i = match tl with
| [_;Soc.Array(_,i)] -> i
| _ -> assert false
in
let ns = let ns =
match ([get_val "c" ctx; get_val "xt" ctx; get_val "xe" ctx]) with match ([get_val "x" ctx]) with
| [B c; F x1; F x2] -> "z"::ctx.cpath,F(if c then x1 else x2) | [B x] -> "z"::ctx.cpath,A(Array.make i (B x))
| [B c; F x1; U] -> "z"::ctx.cpath,if c then F x1 else U | [I x] -> "z"::ctx.cpath,A(Array.make i (I x))
| [B c; U; F x2] -> "z"::ctx.cpath,if c then U else F x2 | [F x] -> "z"::ctx.cpath,A(Array.make i (F x))
| [U;_; _] | [_;U;U] -> "z"::ctx.cpath,U | [A x] -> "z"::ctx.cpath,A(Array.make i (A x))
| [U] -> "z"::ctx.cpath,U
| _ -> assert false | _ -> assert false
in in
{ ctx with s = sadd ctx.s ns } { ctx with s = sadd ctx.s ns }
let lustre_bif ctx =
let ns =
match ([get_val "c" ctx; get_val "xt" ctx; get_val "xe" ctx]) with
| [B c; B x1; B x2] -> "z"::ctx.cpath,B(if c then x1 else x2)
| [B c; B x1; U] -> "z"::ctx.cpath,if c then B x1 else U
| [B c; U; B x2] -> "z"::ctx.cpath,if c then U else B x2
| [U;_; _] | [_;U;U] -> "z"::ctx.cpath,U
| _ -> assert false
in
{ ctx with s = sadd ctx.s ns }
(* That one is different *) (* That one is different *)
let lustre_xor ctx = assert false let lustre_xor ctx = assert false
let lustre_diese ctx = assert false let lustre_diese ctx = assert false
...@@ -339,49 +229,37 @@ let lustre_diese ctx = assert false ...@@ -339,49 +229,37 @@ let lustre_diese ctx = assert false
(* let l = List.filter (fun x -> x=B true) values in *) (* let l = List.filter (fun x -> x=B true) values in *)
(* "z"::ctx.cpath,B(List.length l = 1) *) (* "z"::ctx.cpath,B(List.length l = 1) *)
(* exported *) (* exported *)
let (get: Soc.key -> (ctx -> ctx)) = let (get: Soc.key -> (ctx -> ctx)) =
fun (n,_,_) -> fun (n,tl,_) ->
match n with match n with
| "Lustre::iplus" -> lustre_iplus | "Lustre::plus" -> lustre_plus
| "Lustre::rplus" -> lustre_rplus | "Lustre::times"-> lustre_times
| "Lustre::itimes"-> lustre_itimes | "Lustre::div" -> lustre_div
| "Lustre::rtimes"-> lustre_rtimes | "Lustre::minus"-> lustre_minus
| "Lustre::idiv" -> lustre_idiv
| "Lustre::rdiv" -> lustre_rdiv
| "Lustre::iminus"-> lustre_iminus
| "Lustre::rminus"-> lustre_rminus
| "Lustre::mod" -> lustre_mod | "Lustre::mod" -> lustre_mod
| "Lustre::iuminus" -> lustre_iuminus | "Lustre::uminus" -> lustre_uminus
| "Lustre::ruminus" -> lustre_ruminus
| "Lustre::not" -> lustre_not | "Lustre::not" -> lustre_not
| "Lustre::real2int" -> lustre_real2int | "Lustre::real2int" -> lustre_real2int
| "Lustre::int2real" -> lustre_int2real | "Lustre::int2real" -> lustre_int2real
| "Lustre::ilt" -> lustre_ilt | "Lustre::lt" -> lustre_lt
| "Lustre::rlt" -> lustre_rlt | "Lustre::gt" -> lustre_gt
| "Lustre::igt" -> lustre_igt | "Lustre::lte" -> lustre_lte
| "Lustre::rgt" -> lustre_rgt | "Lustre::gte" -> lustre_gte
| "Lustre::ilte" -> lustre_ilte
| "Lustre::rlte" -> lustre_rlte
| "Lustre::igte" -> lustre_igte
| "Lustre::rgte" -> lustre_rgte
| "Lustre::and" -> lustre_and | "Lustre::and" -> lustre_and
| "Lustre::beq" -> lustre_beq | "Lustre::eq" -> lustre_eq
| "Lustre::ieq" -> lustre_ieq
| "Lustre::req" -> lustre_req
| "Lustre::neq" -> lustre_neq | "Lustre::neq" -> lustre_neq
| "Lustre::or" -> lustre_or | "Lustre::or" -> lustre_or
| "Lustre::impl" -> lustre_impl | "Lustre::impl" -> lustre_impl
| "Lustre::iif" -> lustre_iif | "Lustre::if" -> lustre_if
| "Lustre::rif" -> lustre_rif
| "Lustre::bif" -> lustre_bif | "Lustre::hat" -> lustre_hat tl
| "Lustre::xor" -> lustre_xor | "Lustre::xor" -> lustre_xor
| "Lustre::diese" -> lustre_diese | "Lustre::diese" -> lustre_diese
......
src/socExecValue.ml
+ 8
− 3
View file @ 0a87c4a3
(* Time-stamp: <modified the 18/03/2013 (at 15:20) by Erwan Jahier> *) (* Time-stamp: <modified the 19/03/2013 (at 14:41) by Erwan Jahier> *)
open Soc open Soc
type t = I of int | F of float | B of bool | E of Soc.ident | U type t = I of int | F of float | B of bool | E of Soc.ident | A of t array | U
(* Meant to represent paths in the call tree. Actually it both (* Meant to represent paths in the call tree. Actually it both
represent path and variable with a path, depending on the represent path and variable with a path, depending on the
...@@ -70,13 +70,18 @@ let (filter_top_subst : substs -> (Soc.ident * t) list) = ...@@ -70,13 +70,18 @@ let (filter_top_subst : substs -> (Soc.ident * t) list) =
Node(l) -> List.fold_left aux [] l Node(l) -> List.fold_left aux [] l
| _ -> assert false | _ -> assert false
let (to_string : t -> string) = let rec (to_string : t -> string) =
function function
| I i -> string_of_int i | I i -> string_of_int i
| F f -> string_of_float f | F f -> string_of_float f
| B true -> "t" | B true -> "t"
| B false -> "f" | B false -> "f"
| E e -> e | E e -> e
| A a ->
let str = ref "" in
let f i a = str := !str ^ " " ^ (to_string a) in
Array.iteri f a;
!str
| U -> "not initialised" | U -> "not initialised"
let (string_of_subst_list : (path * t) list -> string) = let (string_of_subst_list : (path * t) list -> string) =
......
src/socExecValue.mli
+ 3
− 2
View file @ 0a87c4a3
(* Time-stamp: <modified the 18/03/2013 (at 10:43) by Erwan Jahier> *) (* Time-stamp: <modified the 19/03/2013 (at 14:04) by Erwan Jahier> *)
(** Manipulating data in the Soc interpreter *) (** Manipulating data in the Soc interpreter *)
type t = I of int | F of float | B of bool | E of Soc.ident | U (* to set uninitialized mem *) type t = | I of int | F of float | B of bool | E of Soc.ident | A of t array
| U (* to set uninitialized mem *)
type subst = (Soc.ident list * t) type subst = (Soc.ident list * t)
type substs type substs
......
src/socPredef.ml
+ 15
− 46
View file @ 0a87c4a3
(* Time-stamp: <modified the 19/03/2013 (at 10:13) by Erwan Jahier> *) (* Time-stamp: <modified the 19/03/2013 (at 14:39) by Erwan Jahier> *)
(** Synchronous Object Code for Predefined operators. *) (** Synchronous Object Code for Predefined operators. *)
...@@ -79,14 +79,6 @@ let make_soc key profile steps = { ...@@ -79,14 +79,6 @@ let make_soc key profile steps = {
have_mem = None; have_mem = None;
} }
let (instanciate_name : string -> Soc.var_type -> string) =
fun id concrete_type ->
match Str.split (Str.regexp "::") id, concrete_type with
| ["Lustre";op], Soc.Int -> "Lustre::i" ^ op
| ["Lustre";op], Soc.Real -> "Lustre::r" ^ op
| ["Lustre";op], Soc.Bool -> "Lustre::b" ^ op
| _,_ -> id
let first_instant = Var("first_instant", Bool) let first_instant = Var("first_instant", Bool)
let (get_mem_name : Soc.key -> var_type -> string) = let (get_mem_name : Soc.key -> var_type -> string) =
...@@ -113,8 +105,9 @@ let of_soc_key : Soc.key -> Soc.t = ...@@ -113,8 +105,9 @@ let of_soc_key : Soc.key -> Soc.t =
| "Lustre::real2int" -> (make_soc sk (sp tl) [step11]) | "Lustre::real2int" -> (make_soc sk (sp tl) [step11])
| "Lustre::int2real" -> (make_soc sk (sp tl) [step11]) | "Lustre::int2real" -> (make_soc sk (sp tl) [step11])
| "Lustre::iplus" -> (make_soc sk (sp tl) [step21 None]) | "Lustre::plus" -> (make_soc sk (sp tl) [step21 None])
| "Lustre::rplus" -> (make_soc sk (sp tl) [step21 None]) | "Lustre::iplus" -> assert false
| "Lustre::rplus" -> assert false
| "Lustre::itimes" -> (make_soc sk (sp tl) [step21 None]) | "Lustre::itimes" -> (make_soc sk (sp tl) [step21 None])
| "Lustre::rtimes" -> (make_soc sk (sp tl) [step21 None]) | "Lustre::rtimes" -> (make_soc sk (sp tl) [step21 None])
| "Lustre::idiv" -> (make_soc sk (sp tl) [step21 None]) | "Lustre::idiv" -> (make_soc sk (sp tl) [step21 None])
...@@ -197,8 +190,7 @@ let of_soc_key : Soc.key -> Soc.t = ...@@ -197,8 +190,7 @@ let of_soc_key : Soc.key -> Soc.t =
idx_ins = [0;1]; idx_ins = [0;1];
idx_outs = [0]; idx_outs = [0];
impl = Some([],[Call([Var(vout)], impl = Some([],[Call([Var(vout)],
Procedure (instanciate_name "Lustre::if" t, Procedure ("Lustre::if",[Bool;t;t;t],None),
[Bool;t;t;t],None),
[Var(pre_mem);Var(v1);Var(v2)])]); [Var(pre_mem);Var(v1);Var(v2)])]);
}; };
{ {
...@@ -275,22 +267,6 @@ let of_soc_key : Soc.key -> Soc.t = ...@@ -275,22 +267,6 @@ let of_soc_key : Soc.key -> Soc.t =
} }
]; ];
} }
| "Lustre::hat" -> {
key = sk;
profile = (sp tl);
instances = [];
precedences = [];
have_mem = None;
step = [
{
name = "step";
lxm = Lxm.dummy "predef soc";
idx_ins = [0; 1];
idx_outs = [0];
impl = None;
}
];
}
| _ -> | _ ->
print_string ("*** The soc of "^id ^ " is not defined. FINISH ME! \n"); flush stdout; print_string ("*** The soc of "^id ^ " is not defined. FINISH ME! \n"); flush stdout;
assert false assert false
...@@ -314,9 +290,7 @@ let instanciate_soc: Soc.t -> Soc.var_type -> Soc.t = ...@@ -314,9 +290,7 @@ let instanciate_soc: Soc.t -> Soc.var_type -> Soc.t =
List.map (fun (vn,vt) -> vn, instanciate_type vt) (snd c.profile) List.map (fun (vn,vt) -> vn, instanciate_type vt) (snd c.profile)
in in
let instanciate_key (key1, key2, key3) = let instanciate_key (key1, key2, key3) =
(instanciate_name key1 concrete_type, (key1, List.map instanciate_type key2, key3)
List.map instanciate_type key2,
key3)
in in
let new_key = instanciate_key c.key in let new_key = instanciate_key c.key in
let new_instances = let new_instances =
...@@ -391,13 +365,13 @@ let make_hat_soc: int -> Soc.var_type -> Soc.t = ...@@ -391,13 +365,13 @@ let make_hat_soc: int -> Soc.var_type -> Soc.t =
| t -> Soc.Array(t,i) | t -> Soc.Array(t,i)
in in
{ {
key = ("Lustre::hat", [t;Int], None); key = ("Lustre::hat", [t;array_type], None);
profile = (["t", t], ["st", array_type]); profile = ([("x", t)], ["z", array_type]);
instances = []; instances = [];
step = [ step = [
{ {
name = "step"; name = "step";
lxm = Lxm.dummy "predef soc"; lxm = Lxm.dummy "predef hat soc";
idx_ins = [0]; idx_ins = [0];
idx_outs = [0]; idx_outs = [0];
impl = None; impl = None;
...@@ -405,7 +379,6 @@ let make_hat_soc: int -> Soc.var_type -> Soc.t = ...@@ -405,7 +379,6 @@ let make_hat_soc: int -> Soc.var_type -> Soc.t =
]; ];
precedences = []; precedences = [];
have_mem = None; have_mem = None;
(* init = None; *)
} }
...@@ -414,10 +387,10 @@ let soc_interface_of_predef: ...@@ -414,10 +387,10 @@ let soc_interface_of_predef:
Lxm.t -> AstPredef.op -> Soc.var_type list -> Soc.t = Lxm.t -> AstPredef.op -> Soc.var_type list -> Soc.t =
fun lxm op types -> fun lxm op types ->
match (op, types) with (* utile de re-vrifier le type ? *) match (op, types) with (* utile de re-vrifier le type ? *)
| AstPredef.IPLUS_n, [Int; Int] -> of_soc_key (("Lustre::iplus"), types@[Int], None) | AstPredef.IPLUS_n, [Int; Int] -> of_soc_key (("Lustre::plus"), types@[Int], None)
| AstPredef.PLUS_n, [Int; Int] -> of_soc_key (("Lustre::iplus"), 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::rplus"), types@[Real], None) | AstPredef.PLUS_n, [Real; Real] -> of_soc_key (("Lustre::plus"), types@[Real], None)
| AstPredef.RPLUS_n, [Real; Real] -> of_soc_key (("Lustre::rplus"), 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::itimes"), types@[Int], None) | AstPredef.ITIMES_n,[Int; Int] -> of_soc_key (("Lustre::itimes"), types@[Int], None)
| AstPredef.TIMES_n, [Int; Int] -> of_soc_key (("Lustre::itimes"), types@[Int], None) | AstPredef.TIMES_n, [Int; Int] -> of_soc_key (("Lustre::itimes"), types@[Int], None)
| AstPredef.TIMES_n, [Real; Real] -> of_soc_key (("Lustre::rtimes"), types@[Real], None) | AstPredef.TIMES_n, [Real; Real] -> of_soc_key (("Lustre::rtimes"), types@[Real], None)
...@@ -529,12 +502,8 @@ let (soc_interface_of_pos_op: ...@@ -529,12 +502,8 @@ let (soc_interface_of_pos_op:
let soc = instanciate_soc soc concrete_type in let soc = instanciate_soc soc concrete_type in
soc soc
| Lic.HAT i,_ -> | Lic.HAT i,_ ->
let concrete_type = List.nth types 0 in let elt_type = List.nth types 0 in
let soc = of_soc_key (("Lustre::hat"), types@[concrete_type], None) in (make_hat_soc i elt_type)
let soc = instanciate_soc soc concrete_type in
soc
(* let elt_type = List.nth types 0 in *)
(* (make_hat_soc i elt_type) *)
| Lic.ARRAY, _ -> | Lic.ARRAY, _ ->
let concrete_type = List.nth types 0 in let concrete_type = List.nth types 0 in
......
src/socPredef.mli
+ 1
− 5
View file @ 0a87c4a3
(* Time-stamp: <modified the 18/03/2013 (at 21:54) by Erwan Jahier> *) (* Time-stamp: <modified the 19/03/2013 (at 11:18) by Erwan Jahier> *)
(** Synchronous Object Code for Predefined operators. *) (** Synchronous Object Code for Predefined operators. *)
...@@ -13,8 +13,4 @@ val of_soc_key : Soc.key -> Soc.t ...@@ -13,8 +13,4 @@ val of_soc_key : Soc.key -> Soc.t
val soc_interface_of_pos_op: val soc_interface_of_pos_op:
Lxm.t -> Lic.by_pos_op -> Soc.var_type list -> Soc.t Lxm.t -> Lic.by_pos_op -> Soc.var_type list -> Soc.t
val instanciate_name : string -> Soc.var_type -> string
val get_mem_name : Soc.key -> Soc.var_type -> string val get_mem_name : Soc.key -> Soc.var_type -> string
todo.org
+ 2
− 0
View file @ 0a87c4a3
...@@ -14,6 +14,8 @@ que de lancer luciole ...@@ -14,6 +14,8 @@ que de lancer luciole
** TODO Écrire un test qui mette en jeu exhaustivement tous les operateurs ** TODO Écrire un test qui mette en jeu exhaustivement tous les operateurs
- State "TODO" from "" [2013-03-19 Tue 10:38] - State "TODO" from "" [2013-03-19 Tue 10:38]
** TODO revoir l'intégration à rif_base et genlex ** TODO revoir l'intégration à rif_base et genlex
- State "TODO" from "" [2013-03-19 Tue 10:25] - State "TODO" from "" [2013-03-19 Tue 10:25]
** TODO Découper un peu les fonctions dans src/lic2soc.ml ** TODO Découper un peu les fonctions dans src/lic2soc.ml
......
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