From 0021ec6f792ba4823def8ebfd5f25a94101cf7d2 Mon Sep 17 00:00:00 2001
From: Erwan Jahier <jahier@imag.fr>
Date: Fri, 29 Mar 2013 15:41:44 +0100
Subject: [PATCH] The -exec mode now supports the fillred iterator. It way only
working with map BTW.
nb: thus it works with red and fill since they are exactly the same !!!
---
src/l2lExpandMetaOp.ml | 4 ++--
src/l2lRmPoly.ml | 25 +++++++++++--------------
src/lic2soc.ml | 10 +++++-----
src/socExec.ml | 29 +++++++++++++++++++++--------
test/lus2lic.sum | 2 +-
test/lus2lic.time | 2 +-
6 files changed, 41 insertions(+), 31 deletions(-)
diff --git a/src/l2lExpandMetaOp.ml b/src/l2lExpandMetaOp.ml
index 539d037c..640474fc 100644
--- a/src/l2lExpandMetaOp.ml
+++ b/src/l2lExpandMetaOp.ml
@@ -1,4 +1,4 @@
-(** Time-stamp: <modified the 27/03/2013 (at 09:49) by Erwan Jahier> *)
+(** Time-stamp: <modified the 29/03/2013 (at 11:23) by Erwan Jahier> *)
open Lxm
open Lic
@@ -130,7 +130,7 @@ let (create_fillred_body: local_ctx -> Lic.static_arg list -> Lic.node_body * va
tau * tau_1^c * ... * tau_n^c -> tau * teta_1^c * ... * teta_l^c
*)
let iter_node,c = match List.sort compare sargs with
- | [ConstStaticArgLic(_,Int_const_eff(c)) ; NodeStaticArgLic(_,_node_key)]
+ | [ConstStaticArgLic(_,Int_const_eff(c));NodeStaticArgLic(_,_node_key)]
| [ConstStaticArgLic(_,Int_const_eff(c));TypeStaticArgLic(_); NodeStaticArgLic(_,_node_key)]
->
_node_key,c
diff --git a/src/l2lRmPoly.ml b/src/l2lRmPoly.ml
index af4e504b..2711736a 100644
--- a/src/l2lRmPoly.ml
+++ b/src/l2lRmPoly.ml
@@ -1,4 +1,4 @@
-(* Time-stamp: <modified the 27/03/2013 (at 09:55) by Erwan Jahier> *)
+(* Time-stamp: <modified the 29/03/2013 (at 11:05) by Erwan Jahier> *)
(*
Source 2 source transformation :
@@ -114,7 +114,7 @@ let rec doit (inprg : LicPrg.t) : LicPrg.t =
let posop' = Lxm.flagit (CALL nk') posop.src in
CallByPosLic (posop', ops')
| x ->
- (* dans tout les autre cas, raf ? *)
+ (* dans tout les autre cas, raf ? *)
CallByPosLic (posop, ops')
)
| CallByNameLic (namop, idops) ->
@@ -125,11 +125,8 @@ let rec doit (inprg : LicPrg.t) : LicPrg.t =
Merge (ce, cl)
in
{ e with ve_core = core'; ve_typ = typ' }
- (* TRAITEMENT DES PARAMS STATIQUES *)
- and do_static_arg
- (m: Lic.type_matches)
- (a: Lic.static_arg)
- : Lic.static_arg =
+ (* TRAITEMENT DES PARAMS STATIQUES *)
+ and do_static_arg (m: Lic.type_matches) (a: Lic.static_arg) : Lic.static_arg =
match a with
| ConstStaticArgLic (id, cst) -> a
| TypeStaticArgLic (id, ty) -> a
@@ -145,10 +142,10 @@ let rec doit (inprg : LicPrg.t) : LicPrg.t =
let nk' = solve_poly m nk ne in
NodeStaticArgLic (id, nk')
)
- (** Gros du boulot :
- soit un noeud poly, soit un profil attendu,
- fabrique s'il n'existe pas déjà , un noeud non poly adéquat ...
- *)
+ (** Gros du boulot :
+ soit un noeud poly, soit un profil attendu,
+ fabrique s'il n'existe pas déjà , un noeud non poly adéquat ...
+ *)
and solve_poly (tmatches: Lic.type_matches) (nk: Lic.node_key) (ne: Lic.node_exp)
: Lic.node_key =
Verbose.exe ~flag:dbg (fun () ->
@@ -164,10 +161,10 @@ let rec doit (inprg : LicPrg.t) : LicPrg.t =
{ vi with var_type_eff = nt }
in
let (nid, sargs) = nk in
- (* nouvelle clé unique = ancienne + tmatches *)
-(* let sargs' = sargs@(static_args_of_matches tmatches) in *)
+ (* nouvelle clé unique = ancienne + tmatches *)
+ (* let sargs' = sargs@(static_args_of_matches tmatches) in *)
let sargs' = (List.map (do_static_arg tmatches) sargs)
-(* @(static_args_of_matches tmatches) *)
+ @(static_args_of_matches tmatches)
in
let nk' = (nid, sargs') in
let def' = match ne.def_eff with
diff --git a/src/lic2soc.ml b/src/lic2soc.ml
index c9abd275..35b5ffbe 100644
--- a/src/lic2soc.ml
+++ b/src/lic2soc.ml
@@ -1,4 +1,4 @@
-(** Time-stamp: <modified the 29/03/2013 (at 09:54) by Erwan Jahier> *)
+(** Time-stamp: <modified the 29/03/2013 (at 11:12) by Erwan Jahier> *)
open Lxm
open Lic
@@ -47,8 +47,8 @@ let rec lic_to_soc_type: (Lic.type_ -> Soc.var_type) =
)
| Lic.Array_type_eff(ty,i) -> Soc.Array(lic_to_soc_type ty,i)
| Lic.Abstract_type_eff (id, _) -> assert false
- | Lic.TypeVar Lic.Any -> assert false
- | Lic.TypeVar Lic.AnyNum -> assert false
+ | Lic.TypeVar Lic.Any -> Soc.Alpha 0
+ | Lic.TypeVar Lic.AnyNum -> Soc.Alpha 1
@@ -714,8 +714,8 @@ let rec f: (LicPrg.t -> Lic.node_key -> Soc.key * Soc.tbl) =
let (soc_of_metaop: Lic.node_key -> Soc.tbl -> (ctx * Soc.t * Soc.tbl) option) =
fun nk soc_tbl ->
let iter_node,c = match List.sort compare (snd nk) with
- | [ConstStaticArgLic(_,Int_const_eff(c)) ;
- (* TypeStaticArgLic(_); *)
+ | [ConstStaticArgLic(_,Int_const_eff(c)) ; NodeStaticArgLic(_,node_key)]
+ | [ConstStaticArgLic(_,Int_const_eff(c)) ; TypeStaticArgLic(_);
NodeStaticArgLic(_,node_key)] ->
node_key,c
| _ -> assert false
diff --git a/src/socExec.ml b/src/socExec.ml
index 151e6734..f64c210e 100644
--- a/src/socExec.ml
+++ b/src/socExec.ml
@@ -1,4 +1,4 @@
-(* Time-stamp: <modified the 29/03/2013 (at 10:59) by Erwan Jahier> *)
+(* Time-stamp: <modified the 29/03/2013 (at 15:41) by Erwan Jahier> *)
open Soc
open SocExecValue
@@ -6,7 +6,7 @@ open SocExecValue
let dbg = Some(Verbose.get_flag "exec")
let (assign_expr : ctx -> var_expr -> var_expr -> ctx) =
- fun ctx ve_in ve_out ->
+ fun ctx ve_in ve_out -> (* ve_out := ve_in (in ctx) *)
{ ctx with s =
let v = SocExecValue.get_value ctx ve_in in
sadd_partial ctx.s ve_out ctx.cpath v
@@ -30,11 +30,12 @@ let rec (soc_step : Soc.step_method -> Soc.tbl -> Soc.t -> SocExecValue.ctx
| Predef -> (
try SocExecEvalPredef.get soc.key ctx
with Not_found -> (* Not a predef op *) print_string (
- "*** Int error in "^soc_name^". Is it defined in SocExecEvalPredef?\n");
+ "*** internal error in "^soc_name^". Is it defined in SocExecEvalPredef?\n");
flush stdout; assert false
)
| Gaol(vl,gaol) -> List.fold_left (do_gao step.lxm soc_tbl) ctx gaol
- | Iterator("map", node_sk, n) ->
+ | Iterator("boolred", node_sk, n) -> assert false (* todo *)
+ | Iterator(iter, node_sk, n) ->
let node_soc = SocUtils.find step.lxm node_sk soc_tbl in
let node_step = match node_soc.step with [step] -> step | _ -> assert false in
let iter_inputs,iter_outputs = soc.profile in
@@ -47,12 +48,24 @@ let rec (soc_step : Soc.step_method -> Soc.tbl -> Soc.t -> SocExecValue.ctx
in
for i = 0 to n-1 do
rctx := { !rctx with cpath = inst_name.(i)::ctx.cpath };
- let vel_in : var_expr list = List.map (array_index i) iter_inputs in
- let vel_out : var_expr list = List.map (array_index i) iter_outputs in
- rctx := do_step inst_name.(i) node_step !rctx soc_tbl soc vel_in vel_out;
+ let vel_in, vel_out =
+ match iter with
+ | "map" -> (List.map (array_index i) iter_inputs,
+ List.map (array_index i) iter_outputs)
+ | "fold" | "red" | "fill" | "fillred" ->
+ let a_in = Var (List.hd iter_inputs) in
+ ( a_in::(List.map (array_index i) (List.tl iter_inputs)),
+ a_in::(List.map (array_index i) (List.tl iter_outputs)))
+ | _ -> assert false (* should not occur *)
+ in
+ rctx := do_step inst_name.(i) node_step !rctx soc_tbl node_soc vel_in vel_out;
done;
+ if iter <> "map" then (
+ let a_in = Var (List.hd iter_inputs) in
+ let a_out = Var (List.hd iter_outputs) in
+ rctx := assign_expr !rctx a_in a_out); (* a_out=a_n *)
!rctx;
- | Iterator(it, it_soc, n) -> assert false
+
and (do_gao : Lxm.t -> Soc.tbl -> SocExecValue.ctx -> gao -> SocExecValue.ctx) =
fun lxm soc_tbl ctx gao ->
diff --git a/test/lus2lic.sum b/test/lus2lic.sum
index 6b4c7e9c..e8e78026 100644
--- a/test/lus2lic.sum
+++ b/test/lus2lic.sum
@@ -1,4 +1,4 @@
-Test Run By jahier on Fri Mar 29 08:55:59 2013
+Test Run By jahier on Fri Mar 29 11:35:44 2013
Native configuration is i686-pc-linux-gnu
=== lus2lic tests ===
diff --git a/test/lus2lic.time b/test/lus2lic.time
index 78b14b72..8eb98ea4 100644
--- a/test/lus2lic.time
+++ b/test/lus2lic.time
@@ -1,2 +1,2 @@
-testcase ./lus2lic.tests/non-reg.exp completed in 29 seconds
+testcase ./lus2lic.tests/non-reg.exp completed in 26 seconds
testcase ./lus2lic.tests/progression.exp completed in 0 seconds
--
GitLab