diff --git a/src/ast2lic.ml b/src/ast2lic.ml
index 7b5518139d7be27fa5bc6af2c8dd9ba047a3842f..84d1ccdc3d3be5165bb17b1389790599ea6392a3 100644
--- a/src/ast2lic.ml
+++ b/src/ast2lic.ml
@@ -1,4 +1,4 @@
-(* Time-stamp: <modified the 12/02/2013 (at 18:22) by Erwan Jahier> *)
+(* Time-stamp: <modified the 13/02/2013 (at 15:10) by Erwan Jahier> *)
open Lxm
@@ -343,7 +343,6 @@ and (translate_left_part : IdSolver.t -> AstCore.left_part -> Lic.left) =
| _ -> raise (Compile_error(sif.src, "an array was expected"))
)
-
and (translate_val_exp : IdSolver.t -> UnifyClock.subst -> AstCore.val_exp
-> UnifyClock.subst * Lic.val_exp) =
fun id_solver s ve ->
@@ -404,7 +403,7 @@ and (translate_val_exp : IdSolver.t -> UnifyClock.subst -> AstCore.val_exp
let lxm = by_pos_op.src in
let by_pos_op = by_pos_op.it in
let mk_by_pos_op by_pos_op_eff =
- CallByPosLic(flagit by_pos_op_eff lxm, OperLic vel_eff)
+ CallByPosLic(flagit by_pos_op_eff lxm, vel_eff)
in
let s, vef_core =
match by_pos_op with
@@ -438,9 +437,7 @@ and (translate_val_exp : IdSolver.t -> UnifyClock.subst -> AstCore.val_exp
| FBY_n -> s, mk_by_pos_op Lic.FBY
| CONCAT_n -> s, mk_by_pos_op Lic.CONCAT
| TUPLE_n -> s, mk_by_pos_op Lic.TUPLE
- | ARRAY_n ->
- s, CallByPosLic(flagit (Lic.ARRAY vel_eff) lxm, OperLic [])
-
+ | ARRAY_n -> s, CallByPosLic(flagit Lic.ARRAY lxm, vel_eff)
| STRUCT_ACCESS_n fid ->
s, mk_by_pos_op (Lic.STRUCT_ACCESS (fid))
@@ -451,27 +448,22 @@ and (translate_val_exp : IdSolver.t -> UnifyClock.subst -> AstCore.val_exp
mk_by_pos_op (Lic.WHEN (NamedClock { it = (cc,cv) ; src = lxm }))
| ARRAY_ACCES_n ve_index ->
- s, mk_by_pos_op (
- Lic.ARRAY_ACCES(
- EvalConst.eval_array_index id_solver ve_index lxm))
+ s, mk_by_pos_op (Lic.ARRAY_ACCES(
+ EvalConst.eval_array_index id_solver ve_index lxm))
| ARRAY_SLICE_n si ->
- s, mk_by_pos_op
- (Lic.ARRAY_SLICE(
- EvalConst.eval_array_slice id_solver si lxm))
+ s, mk_by_pos_op (Lic.ARRAY_SLICE(
+ EvalConst.eval_array_slice id_solver si lxm))
| HAT_n -> (
match vel with
| [exp; ve_size] ->
- let size_const_eff = EvalConst.f id_solver ve_size
- and s, exp_eff = translate_val_exp id_solver s exp in
+ let size_const_eff = EvalConst.f id_solver ve_size in
(match size_const_eff with
- | [Int_const_eff size] ->
- s, mk_by_pos_op (Lic.HAT(size, exp_eff))
+ | [Int_const_eff sz] -> s, mk_by_pos_op (Lic.HAT(sz))
| _ -> assert false)
| _ -> assert false
)
-
in
s, vef_core, lxm
in
@@ -491,9 +483,9 @@ and translate_by_name_op id_solver op s =
let s, nop =
match op.it with
| STRUCT_anonymous_n -> s, STRUCT_anonymous
- | STRUCT_n idref -> s, STRUCT (to_long idref, None)
+ | STRUCT_n idref -> s, STRUCT (to_long idref)
| STRUCT_WITH_n (idref1, idref2) ->
- s, STRUCT (to_long idref1, Some(idref2.id_id))
+ s, STRUCT_with (to_long idref1, idref2.id_id)
in
s, flagit nop op.src
diff --git a/src/compile.ml b/src/compile.ml
index 2bb9f72267f22e5d75b0a38a6bdd1d1f02f077d3..ca8b7a79f5583fa465ace814bf0a93e5dc3f0a23 100644
--- a/src/compile.ml
+++ b/src/compile.ml
@@ -1,5 +1,4 @@
-(* Time-stamp: <modified the 01/02/2013 (at 17:28) by Erwan Jahier> *)
-
+(* Time-stamp: <modified the 13/02/2013 (at 14:56) by Erwan Jahier> *)
open Lxm
open Errors
diff --git a/src/evalClock.ml b/src/evalClock.ml
index c09f48bc0c725778e7282dce5a2185ffcb22c063..af2c804dffb9e78f7f08e9984112c6470fae79ce 100644
--- a/src/evalClock.ml
+++ b/src/evalClock.ml
@@ -1,4 +1,4 @@
-(* Time-stamp: <modified the 13/02/2013 (at 08:49) by Erwan Jahier> *)
+(* Time-stamp: <modified the 13/02/2013 (at 10:09) by Erwan Jahier> *)
open AstPredef
@@ -204,7 +204,7 @@ let rec (f : Lxm.t -> IdSolver.t -> subst -> Lic.val_exp -> Lic.clock list ->
and f_aux id_solver s ve =
let (cel, s), lxm =
match ve.ve_core with
- | CallByPosLic ({it=posop; src=lxm}, OperLic args) ->
+ | CallByPosLic ({it=posop; src=lxm}, args) ->
eval_by_pos_clock id_solver posop lxm args s, lxm
| CallByNameLic ({it=nmop; src=lxm}, nmargs ) -> (
try eval_by_name_clock id_solver nmop lxm nmargs s, lxm
@@ -332,11 +332,10 @@ and (eval_by_pos_clock : IdSolver.t -> Lic.by_pos_op -> Lxm.t -> Lic.val_exp lis
(* f_aux id_solver (List.hd args) *)
- | Lic.HAT(i,ve),args ->
+ | Lic.HAT(i),[ve] ->
let (_,clk,s) = f_aux id_solver s ve in
clk,s
- (* nb: the args have been put inside the HAT_eff constructor *)
-
+ | Lic.HAT(i),_ -> assert false
| Lic.VAR_REF id,args ->
let vi = IdSolver.var_info_of_ident id_solver id lxm in
@@ -401,7 +400,7 @@ and (eval_by_pos_clock : IdSolver.t -> Lic.by_pos_op -> Lxm.t -> Lic.val_exp lis
| Lic.ARROW,args
| Lic.FBY ,args
| Lic.CONCAT,args
- | Lic.ARRAY(args),_ -> (
+ | Lic.ARRAY,args -> (
(* Check that all args are of the same (unifiable) clocks.
XXX : we suppose that all those operators are
@@ -426,19 +425,17 @@ and (eval_by_name_clock : IdSolver.t -> Lic.by_name_op -> Lxm.t ->
(Ident.t Lxm.srcflagged * Lic.val_exp) list -> subst ->
Lic.id_clock list * subst) =
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 *)
+ 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
+ let clk,s = UnifyClock.list lxm flat_clk_args s in
+ let clk_list = List.map (apply_subst s) (List.hd clk_args) in
match namop with
| Lic.STRUCT_anonymous -> assert false (* cf EvalType.E *)
- | Lic.STRUCT(_, dft_opt) ->
- 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 *)
- 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
- let clk,s = UnifyClock.list lxm flat_clk_args s in
- let clk_list = List.map (apply_subst s) (List.hd clk_args) in
- match dft_opt with
- | None -> clk_list, s
- | Some(idref) ->
+ | Lic.STRUCT(_) -> clk_list, s
+ | Lic.STRUCT_with(_, dft) ->
(* XXX should i do something here ??? *)
- clk_list, s
+ clk_list, s
diff --git a/src/evalType.ml b/src/evalType.ml
index 4667f046e415b714d4e7b61cf56a591a2d3e73ef..3fd89511e9d146f4abfd08345c06951e7939f760 100644
--- a/src/evalType.ml
+++ b/src/evalType.ml
@@ -1,4 +1,4 @@
-(** Time-stamp: <modified the 13/02/2013 (at 08:49) by Erwan Jahier> *)
+(** Time-stamp: <modified the 13/02/2013 (at 10:51) by Erwan Jahier> *)
open AstPredef
@@ -30,7 +30,7 @@ let rec (f : IdSolver.t -> Lic.val_exp -> Lic.val_exp * Lic.type_ list) =
fun id_solver ve ->
let ve_core, tl =
match ve.ve_core with
- | CallByPosLic ({it=posop; src=lxm}, OperLic args) -> (
+ | CallByPosLic ({it=posop; src=lxm}, args) -> (
let posop_opt, args, tl =
try eval_by_pos_type id_solver posop lxm args
with EvalType_error msg ->
@@ -38,8 +38,8 @@ let rec (f : IdSolver.t -> Lic.val_exp -> Lic.val_exp * Lic.type_ list) =
in
let ve =
match posop_opt with
- | None -> CallByPosLic ({it=posop; src=lxm}, OperLic args)
- | Some posop -> CallByPosLic ({it=posop; src=lxm}, OperLic args)
+ | None -> CallByPosLic ({it=posop; src=lxm}, args)
+ | Some posop -> CallByPosLic ({it=posop; src=lxm}, args)
in
ve, tl
)
@@ -155,10 +155,8 @@ and eval_by_pos_type
| x -> raise_arity_error "" (List.length x) 1
in
None, [arg], [teff_field]
-
-
| Lic.ARRAY_ACCES(i) ->
- assert (List.length args = 1);
+ assert (List.length args = 1);
let arg, targ = f id_solver (List.hd args) in
let sz, teff =
match targ with
@@ -199,32 +197,29 @@ and eval_by_pos_type
in
None, [arg], [Array_type_eff(teff_elt, sieff.se_width)]
- | Lic.HAT(size,ceff) ->
- let ceff, teff_list = f id_solver ceff in
- let tl = List.map (fun teff -> Array_type_eff(teff, size)) teff_list in
- Some(Lic.HAT(size,ceff)), [], tl
-
- | Lic.ARRAY(args) ->
+ | Lic.HAT(size) ->
+ let arg, targs = f id_solver (List.hd args) in
+ let targ = try List.hd targs with _ -> assert false in
+ let teff = Array_type_eff(targ, size) in
+ Some(Lic.HAT(size)), [arg], [teff]
+
+ | Lic.ARRAY ->
(* check that args are of the same type *)
let args, targs = List.split (List.map (f id_solver) args) in
- let teff_elt =
+ let teff_elt_opt =
List.fold_left
(fun acc teff ->
match acc with
- | [] -> teff
- | [sacc] -> if acc = teff then acc else
- raise(EvalType_error(
- "all array elements should be of the same type"))
- | _ -> assert false
+ | None -> Some teff
+ | Some teff' -> if teff' = teff then acc else
+ raise(EvalType_error("all array elements should have the same type"))
)
- []
- targs
- in
- let tve =
- assert (List.length teff_elt = 1);
- [Array_type_eff(List.hd teff_elt, List.length args)]
+ None
+ (List.flatten targs)
in
- Some(Lic.ARRAY(args)), [], tve
+ let teff_elt:Lic.type_ = match teff_elt_opt with None -> assert false | Some x -> x in
+ let tve = [Array_type_eff(teff_elt, List.length args)] in
+ None, args, tve
| Lic.WHEN clk_exp -> (
let args, targs = List.split (List.map (f id_solver) args) in
@@ -284,7 +279,8 @@ and eval_by_name_type (id_solver: IdSolver.t) (namop: Lic.by_name_op) (lxm: Lxm
finish_me "anonymous struct not yet supported";
assert false
- | Lic.STRUCT (opid,dft_opt) ->
+ | Lic.STRUCT (opid)
+ | Lic.STRUCT_with (opid,_) ->
let struct_type = id_solver.id2type (Ident.idref_of_long opid) lxm in
match struct_type with
| Struct_type_eff(sn, fl) ->
@@ -307,10 +303,11 @@ and eval_by_name_type (id_solver: IdSolver.t) (namop: Lic.by_name_op) (lxm: Lxm
List.map
(fun (id,_) ->
let l = List.filter (fun (idf,_) -> id=idf.it) namargs in
- match dft_opt, l with
+ match namop, l with
| _,[x] -> x
| _,_::_ -> assert false
- | None,[] -> (
+ | (STRUCT_anonymous, []) -> assert false
+ | Lic.STRUCT(_),[] -> (
try
let const =
match snd(List.assoc id fl) with
@@ -328,7 +325,7 @@ and eval_by_name_type (id_solver: IdSolver.t) (namop: Lic.by_name_op) (lxm: Lxm
in
raise (Compile_error(lxm, msg))
)
- | Some (id_with),[] ->
+ | Lic.STRUCT_with(_,id_with),[] ->
let (type_of_struct_field : Ident.t -> Lic.type_ -> Lic.type_) =
fun id t ->
match t with
@@ -345,14 +342,14 @@ and eval_by_name_type (id_solver: IdSolver.t) (namop: Lic.by_name_op) (lxm: Lxm
fun id_with id lxm ->
let vi = id_solver.id2var id_with lxm in
let dft_ve =
- {ve_core = CallByPosLic(flagit (VAR_REF id_with) lxm,OperLic[]);
+ {ve_core = CallByPosLic(flagit (VAR_REF id_with) lxm,[]);
ve_typ = [vi.var_type_eff];
ve_clk = [snd vi.var_clock_eff]
}
in
let ve =
{ve_core = CallByPosLic ((flagit (STRUCT_ACCESS id) lxm),
- OperLic [dft_ve]);
+ [dft_ve]);
ve_typ = [type_of_struct_field id vi.var_type_eff];
ve_clk = [snd vi.var_clock_eff]
}
diff --git a/src/l2lAliasType.ml b/src/l2lAliasType.ml
index f9574e27eace0522a2b10d7e344923c6079873b3..d7830383f224ec4f1c4d7b5b826c0282ca224595 100644
--- a/src/l2lAliasType.ml
+++ b/src/l2lAliasType.ml
@@ -1,4 +1,4 @@
-(* Time-stamp: <modified the 17/01/2013 (at 10:39) by Erwan Jahier> *)
+(* Time-stamp: <modified the 13/02/2013 (at 15:10) by Erwan Jahier> *)
(**
Source 2 source transformation :
diff --git a/src/l2lCheckLoops.ml b/src/l2lCheckLoops.ml
index 850264056da67e4eec366643d63117357dbbd20b..d06c5807a8ff421dc85dd4254dc60fdb52cb2f0c 100644
--- a/src/l2lCheckLoops.ml
+++ b/src/l2lCheckLoops.ml
@@ -1,4 +1,4 @@
-(* Time-stamp: <modified the 06/02/2013 (at 17:55) by Erwan Jahier> *)
+(* Time-stamp: <modified the 13/02/2013 (at 10:24) by Erwan Jahier> *)
open Lxm
open Errors
@@ -21,7 +21,7 @@ and
| CallByPosLic ({ it=FBY }, _)
| CallByPosLic ({ it=PRE }, _)
-> s (* pre is not a dependance! *)
- | CallByPosLic (by_pos_op, OperLic vel) ->
+ | CallByPosLic (by_pos_op, vel) ->
let s = vars_of_by_pos_op s by_pos_op.it in
List.fold_left vars_of_exp s vel
| Merge(ce, l) ->
@@ -31,11 +31,9 @@ and
and
vars_of_by_pos_op s = function
| VAR_REF id -> IdSet.add id s
- | HAT(_,ve) -> vars_of_exp s ve
- | ARRAY(vel) -> List.fold_left vars_of_exp s vel
| PREDEF_CALL(_)
| ARRAY_SLICE _ | ARRAY_ACCES _ | ARROW | FBY | CURRENT | WHEN _
- | STRUCT_ACCESS _
+ | ARRAY | HAT(_) | STRUCT_ACCESS _
| TUPLE | CONCAT | CONST_REF _ | CALL _ -> s
| PRE -> assert false
and
diff --git a/src/l2lCheckOutputs.ml b/src/l2lCheckOutputs.ml
index 68f37e060aea3623c5cdd16cb8c6c0f2db6cae2c..903ad292cff437b053b36b61fbfd541a648924a0 100644
--- a/src/l2lCheckOutputs.ml
+++ b/src/l2lCheckOutputs.ml
@@ -1,4 +1,4 @@
-(* Time-stamp: <modified the 23/01/2013 (at 10:01) by Erwan Jahier> *)
+(* Time-stamp: <modified the 13/02/2013 (at 15:09) by Erwan Jahier> *)
open Lxm
open Errors
diff --git a/src/l2lExpandArrays.ml b/src/l2lExpandArrays.ml
index e98abfcc2f1828608abfa02ac1e2a636c7c8288f..4ceb4145465509f00906e9c8254fc0efeb48d4c8 100644
--- a/src/l2lExpandArrays.ml
+++ b/src/l2lExpandArrays.ml
@@ -1,4 +1,4 @@
-(** Time-stamp: <modified the 07/02/2013 (at 11:40) by Erwan Jahier> *)
+(** Time-stamp: <modified the 13/02/2013 (at 15:09) 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...
@@ -243,7 +243,7 @@ and (var_trees_of_val_exp :
let prefix = (Ident.to_string vi.var_name_eff) ^ prefix in
let id = prefix in
{
- ve_core = CallByPosLic({src=lxm;it=(VAR_REF id)}, OperLic []);
+ ve_core = CallByPosLic({src=lxm;it=(VAR_REF id)}, []);
ve_typ = [vi.var_type_eff] ;
ve_clk = [snd vi.var_clock_eff]
}
@@ -251,7 +251,7 @@ and (var_trees_of_val_exp :
let loop = var_trees_of_val_exp lctx acc in
match ve.ve_core with
| Merge(ce,cl) -> assert false
- | CallByPosLic (by_pos_op, OperLic vel) -> (
+ | CallByPosLic (by_pos_op, vel) -> (
let lxm = by_pos_op.src in
let by_pos_op = by_pos_op.it in
match by_pos_op with
@@ -325,7 +325,7 @@ and (var_trees_of_val_exp :
in
raise (Errors.Compile_error(lxm, msg))
)
- | HAT(_) | CONCAT | ARRAY(_)
+ | HAT(_) | CONCAT | ARRAY
| PREDEF_CALL _ | CALL _
| PRE | ARROW | FBY | CURRENT | WHEN _ | TUPLE -> (
(* Create a new loc var to alias such expressions *)
@@ -350,13 +350,22 @@ and (break_tuple : Lxm.t -> left list -> val_exp -> Lic.eq_info srcflagged list)
*)
let rec aux ve = (* flatten val exp*)
match ve.ve_core with
- | CallByPosLic ({it= TUPLE}, OperLic vel) -> List.flatten (List.map aux vel)
- | CallByPosLic (unop, OperLic [ve1]) ->
+ | CallByPosLic ({it= TUPLE}, vel)
+ | CallByPosLic ({it= ARRAY}, vel) -> List.flatten (List.map aux vel)
+ | CallByPosLic ({src=lxm;it= HAT(i)}, vel) ->
+ let ve1 = List.hd vel in
let ve1l = aux ve1 in
List.map
- (fun ve1 -> { ve1 with ve_core = CallByPosLic (unop, OperLic [ve1])} )
+ (fun ve1 -> { ve1 with ve_core = CallByPosLic ({src=lxm;it= HAT(i)}, [ve1])} )
ve1l
- | CallByPosLic (binop, OperLic [ve1;ve2]) ->
+
+
+ | CallByPosLic (unop, [ve1]) ->
+ let ve1l = aux ve1 in
+ List.map
+ (fun ve1 -> { ve1 with ve_core = CallByPosLic (unop, [ve1])} )
+ ve1l
+ | CallByPosLic (binop, [ve1;ve2]) ->
let ve1l, ve2l = aux ve1, aux ve2 in
if (List.length ve1l <> List.length ve2l) then
let vel2str vel =
@@ -371,11 +380,11 @@ and (break_tuple : Lxm.t -> left list -> val_exp -> Lic.eq_info srcflagged list)
else
List.map2
(fun ve1 ve2 ->
- { ve with ve_core = CallByPosLic (binop, OperLic [ve1;ve2])})
+ { ve with ve_core = CallByPosLic (binop, [ve1;ve2])})
ve1l
ve2l
- | CallByPosLic ({it= PREDEF_CALL(IF_n); src=lxm}, OperLic [cond; ve1; ve2]) ->
+ | CallByPosLic ({it= PREDEF_CALL(IF_n); src=lxm}, [cond; ve1; ve2]) ->
let ve1l, ve2l = aux ve1, aux ve2 in
if (List.length ve1l <> List.length ve2l) then
let vel2str vel =
@@ -392,7 +401,7 @@ and (break_tuple : Lxm.t -> left list -> val_exp -> Lic.eq_info srcflagged list)
(fun ve1 ve2 ->
{ ve with ve_core =
CallByPosLic ({it= PREDEF_CALL(IF_n); src=lxm},
- OperLic [cond;ve1;ve2])}
+ [cond;ve1;ve2])}
)
ve1l
ve2l
@@ -441,22 +450,18 @@ and (expand_val_exp: local_ctx -> acc -> val_exp -> val_exp * acc) =
let cl = List.combine left vel in
let newve = { ve with ve_core = Merge(ce,cl) } in
newve, acc
- | CallByPosLic (by_pos_op, OperLic vel) ->
+ | CallByPosLic (by_pos_op, vel) ->
let lxm = by_pos_op.src in
let by_pos_op = by_pos_op.it in
let by_pos_op, acc, vel =
match by_pos_op with
- | HAT(i,ve) ->
- let ve, acc = expand_val_exp lctx acc ve in
+ | HAT(i) ->
+ let ve, acc = expand_val_exp lctx acc (List.hd vel) in
let rec unfold cpt =
if cpt = 0 then [] else ve::(unfold (cpt-1))
in
TUPLE, acc, unfold i
- | ARRAY(vel) ->
- let vel,acc = expand_val_exp_list lctx acc vel in
- TUPLE, acc, vel
-
- | CONCAT | PREDEF_CALL _ | CALL _
+ | ARRAY | CONCAT | PREDEF_CALL _ | CALL _
| PRE | ARROW | FBY | CURRENT | WHEN _ | TUPLE
->
let vel,acc = expand_val_exp_list lctx acc vel in
@@ -473,7 +478,7 @@ and (expand_val_exp: local_ctx -> acc -> val_exp -> val_exp * acc) =
in
TUPLE, acc, flatten_var_tree vt
in
- let newve = CallByPosLic(Lxm.flagit by_pos_op lxm, OperLic vel) in
+ let newve = CallByPosLic(Lxm.flagit by_pos_op lxm, vel) in
let newve = { ve with ve_core = newve } in
(* if newve.core <> ve.core then ( *)
(* EvalClock.copy newve ve *)
@@ -515,7 +520,7 @@ and (expand_val_exp: local_ctx -> acc -> val_exp -> val_exp * acc) =
let newve = {
ve_typ = ve.ve_typ;
ve_clk = ve.ve_clk;
- ve_core= CallByPosLic({ src=lxm ; it=TUPLE }, OperLic (List.rev vel))
+ ve_core= CallByPosLic({ src=lxm ; it=TUPLE }, (List.rev vel))
}
in
(* if newve.core <> ve.core then ( *)
diff --git a/src/l2lExpandMetaOp.ml b/src/l2lExpandMetaOp.ml
index 29120d1c4c0917ad1b5c87299b727b7c124aee28..149ea64bf0c4f82d2612f9d0e41c4556acd6c1d5 100644
--- a/src/l2lExpandMetaOp.ml
+++ b/src/l2lExpandMetaOp.ml
@@ -1,4 +1,4 @@
-(** Time-stamp: <modified the 06/02/2013 (at 16:28) by Erwan Jahier> *)
+(** Time-stamp: <modified the 13/02/2013 (at 15:11) by Erwan Jahier> *)
open Lxm
open Lic
@@ -52,7 +52,7 @@ let lxm = Lxm.dummy "no_source"
let (val_exp_of_var_info : Lic.var_info -> Lic.val_exp) =
fun vi ->
{
- ve_core = CallByPosLic({src=lxm;it=Lic.VAR_REF vi.var_name_eff}, OperLic []);
+ ve_core = CallByPosLic({src=lxm;it=Lic.VAR_REF vi.var_name_eff}, []);
ve_typ = [vi.var_type_eff];
ve_clk = [snd vi.var_clock_eff];
}
@@ -68,7 +68,7 @@ let (val_exp_of_int : int -> Lic.val_exp) =
{
ve_clk = [BaseLic];
ve_typ = [Int_type_eff];
- ve_core = CallByPosLic({it=PREDEF_CALL(id_of_int i);src=lxm},OperLic[])
+ ve_core = CallByPosLic({it=PREDEF_CALL(id_of_int i);src=lxm},[])
}
let rec (elt_type_of_array : Lic.type_ -> Lic.type_) =
@@ -83,7 +83,7 @@ let (array_var_to_val_exp : int -> var_info -> val_exp) =
let t_elt = elt_type_of_array vi.var_type_eff in
let op_flg = {src = lxm ; it = ARRAY_ACCES(i)} in
{
- ve_core = CallByPosLic(op_flg, OperLic [val_exp_of_var_info vi]);
+ ve_core = CallByPosLic(op_flg, [val_exp_of_var_info vi]);
ve_typ = [t_elt];
ve_clk = [snd vi.var_clock_eff];
}
@@ -91,7 +91,7 @@ let (array_var_to_val_exp : int -> var_info -> val_exp) =
let (node_to_val_exp : Lic.node_key -> Lic.type_ list -> val_exp list -> val_exp) =
fun nk t vel ->
let nk = { src = lxm ; it = nk } in
- let core = CallByPosLic( { src = lxm ; it = CALL nk }, OperLic vel) in
+ let core = CallByPosLic( { src = lxm ; it = CALL nk }, vel) in
{
ve_clk = List.map (fun _ -> BaseLic) t;
ve_typ = t;
@@ -103,7 +103,7 @@ let (binop_to_val_exp : AstPredef.op -> val_exp -> val_exp -> val_exp) =
{
ve_clk = ve1.ve_clk;
ve_typ = ve1.ve_typ;
- ve_core = CallByPosLic(op, OperLic [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 ->
@@ -111,7 +111,7 @@ let (ite_to_val_exp : val_exp -> val_exp -> val_exp -> val_exp) =
{
ve_clk = ve2.ve_clk;
ve_typ = ve2.ve_typ;
- ve_core = CallByPosLic(ite_op, OperLic [ve1; ve2; ve3])
+ ve_core = CallByPosLic(ite_op, [ve1; ve2; ve3])
}
let (array_var_to_left : int -> var_info -> Lic.left) =
@@ -207,7 +207,7 @@ 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)}, OperLic args) }
+ ve_core = CallByPosLic({src=lxm;it=(CALL iter_node)}, args) }
in
let eq = { src = lxm ; it = (lhs, rhs) } in
eq
@@ -257,7 +257,7 @@ 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)}, OperLic xi_j) }
+ ve_core = CallByPosLic({src=lxm;it=(CALL iter_node)}, xi_j) }
in
let eq = { src = lxm ; it = (lhs, rhs) } in
eq
diff --git a/src/l2lExpandNodes.ml b/src/l2lExpandNodes.ml
index e6842a6a59a72ca34999780907e3b2fb3bf74519..673ae6c450ffb5bb1a0f169ddca81e636e1087e8 100644
--- a/src/l2lExpandNodes.ml
+++ b/src/l2lExpandNodes.ml
@@ -1,4 +1,4 @@
-(* Time-stamp: <modified the 06/02/2013 (at 17:56) by Erwan Jahier> *)
+(* Time-stamp: <modified the 13/02/2013 (at 10:25) by Erwan Jahier> *)
open Lxm
@@ -69,7 +69,7 @@ and (subst_in_val_exp : subst -> val_exp -> val_exp) =
let newve = {
ve with ve_core =
match ve.ve_core with
- | CallByPosLic (by_pos_op, OperLic vel) ->
+ | CallByPosLic (by_pos_op, vel) ->
let lxm = by_pos_op.src in
let by_pos_op = by_pos_op.it in
let vel = List.map (subst_in_val_exp s) vel in
@@ -84,19 +84,18 @@ and (subst_in_val_exp : subst -> val_exp -> val_exp) =
in
VAR_REF id'
- | HAT(i,ve) -> HAT(i, subst_in_val_exp s ve)
- | ARRAY(vel) -> ARRAY(List.map (subst_in_val_exp s) vel)
+ | HAT(i) -> HAT(i)
| WHEN(AstCore.Base) -> WHEN(AstCore.Base)
| WHEN(AstCore.NamedClock {src=lxm;it=(cc,cv)}) ->
let var = List.assoc cv s in
let cv = var.var_name_eff in
WHEN(AstCore.NamedClock {src=lxm;it=(cc,cv)})
| PREDEF_CALL _| CALL _ | PRE | ARROW | FBY | CURRENT | TUPLE
- | CONCAT | STRUCT_ACCESS _ | ARRAY_ACCES _ | ARRAY_SLICE _
+ | ARRAY | CONCAT | STRUCT_ACCESS _ | ARRAY_ACCES _ | ARRAY_SLICE _
(* | CONST _ *)
-> by_pos_op
in
- CallByPosLic(Lxm.flagit by_pos_op lxm, OperLic vel)
+ CallByPosLic(Lxm.flagit by_pos_op lxm, vel)
| CallByNameLic(by_name_op, fl) ->
let fl = List.map (fun (id,ve) -> (id, subst_in_val_exp s ve)) fl in
@@ -156,7 +155,7 @@ let (mk_output_subst : local_ctx -> Lxm.t -> var_info list -> Lic.left list ->
let nv = mk_fresh_loc lctx v in
let nv_id = nv.var_name_eff in
let nve = {
- ve_core = CallByPosLic({it=VAR_REF nv_id;src = lxm },OperLic []);
+ ve_core = CallByPosLic({it=VAR_REF nv_id;src = lxm },[]);
ve_typ = [nv.var_type_eff];
ve_clk = [snd nv.var_clock_eff]
}
@@ -189,7 +188,7 @@ let rec (expand_eq : local_ctx -> acc -> Lic.eq_info Lxm.srcflagged -> acc) =
and (expand_eq_aux: local_ctx -> Lic.eq_info -> acc option)=
fun lctx (lhs,ve) ->
match ve.ve_core with
- | CallByPosLic( { it = Lic.CALL node_key ; src = lxm }, OperLic vel) ->
+ | CallByPosLic( { it = Lic.CALL node_key ; src = lxm }, vel) ->
let node =
match LicPrg.find_node lctx.prg node_key.it with
| Some n -> n
@@ -248,7 +247,7 @@ and (expand_assert : local_ctx -> acc -> val_exp srcflagged -> acc) =
let assert_eq = Lxm.flagit ([LeftVarLic(assert_var,lxm)], ve) lxm in
let assert_op = Lic.VAR_REF(assert_var.var_name_eff) in
let nve = {
- ve_core = CallByPosLic((Lxm.flagit assert_op lxm, OperLic []));
+ ve_core = CallByPosLic((Lxm.flagit assert_op lxm, []));
ve_typ = [Bool_type_eff];
ve_clk = [BaseLic]
}
diff --git a/src/l2lRmPoly.ml b/src/l2lRmPoly.ml
index f2ce1919bb88cf22a952f7275791655616724951..316c8f7d7e0c8598342dbce18299885be905f08c 100644
--- a/src/l2lRmPoly.ml
+++ b/src/l2lRmPoly.ml
@@ -1,4 +1,4 @@
-(* Time-stamp: <modified the 06/02/2013 (at 16:28) by Erwan Jahier> *)
+(* Time-stamp: <modified the 13/02/2013 (at 16:07) by Erwan Jahier> *)
(*
Source 2 source transformation :
@@ -16,7 +16,7 @@ let node_is_poly ne =
(Lic.node_is_poly ne) && not (Lic.node_is_extern ne)
let types_of_operands ops =
- match ops with OperLic vl ->
+ match ops with vl ->
List.flatten (List.map Lic.type_of_val_exp vl)
(* transforme un type match en pseudo-arg statique
@@ -92,8 +92,8 @@ let rec doit (inprg : LicPrg.t) : LicPrg.t =
and do_exp (m: Lic.type_matches) (e: Lic.val_exp) : Lic.val_exp =
let typ' = Lic.apply_type_matches m e.ve_typ in
let core' = match e.ve_core with
- | CallByPosLic (posop, OperLic ops) -> (
- let ops' = OperLic (List.map (do_exp m) ops) in
+ | CallByPosLic (posop, ops) -> (
+ let ops' = (List.map (do_exp m) ops) in
match posop.it with
| PREDEF_CALL (pop) -> CallByPosLic (posop, ops')
| CALL nk ->
diff --git a/src/l2lSplit.ml b/src/l2lSplit.ml
index c3641bed723c788365a33c2cc626320fa63988e8..11cd09a1afa65626f791b72712832cc7e9c7c9b0 100644
--- a/src/l2lSplit.ml
+++ b/src/l2lSplit.ml
@@ -30,7 +30,7 @@ let new_var getid type_eff clock_eff =
(* functions that deal with tuple breaking *)
let rec (get_vel_from_tuple : val_exp -> val_exp list) =
function
- | { ve_core = CallByPosLic({it=Lic.TUPLE }, OperLic vel) } ->
+ | { ve_core = CallByPosLic({it=Lic.TUPLE }, vel) } ->
List.flatten (List.map get_vel_from_tuple vel)
| ve -> [ve]
@@ -43,9 +43,9 @@ let rec (remove_tuple_from_eq : eq_info srcflagged -> eq_info srcflagged) =
fun {src=lxm;it=(lhs,ve)} ->
let ve =
match ve.ve_core with
- | CallByPosLic({it=op;src=lxm }, OperLic vel) ->
+ | CallByPosLic({it=op;src=lxm }, vel) ->
{ ve with
- ve_core = CallByPosLic({it=op;src=lxm}, OperLic (remove_tuple vel)) }
+ ve_core = CallByPosLic({it=op;src=lxm}, (remove_tuple vel)) }
| _ -> ve
in
{src=lxm;it=(lhs,ve)}
@@ -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}, OperLic [c;ve1;ve2]) ->
+ | CallByPosLic({it=Lic.PREDEF_CALL(AstPredef.IF_n);src=lxm}, [c;ve1;ve2]) ->
let vel1 = get_vel_from_tuple ve1
and vel2 = get_vel_from_tuple ve2
in
@@ -76,35 +76,35 @@ let (break_it_do : val_exp -> val_exp list) =
(fun ve1 ve2 ->
{ ve_core =
CallByPosLic({it=Lic.PREDEF_CALL(AstPredef.IF_n);src=lxm},
- OperLic [c;ve1;ve2]);
+ [c;ve1;ve2]);
ve_typ = ve1.ve_typ;
ve_clk = ve1.ve_clk;
}
)
vel1
vel2
- | CallByPosLic({it=WHEN clk; src=lxm}, OperLic vel) -> (
+ | CallByPosLic({it=WHEN clk; src=lxm}, vel) -> (
let vel = List.flatten (List.map get_vel_from_tuple vel) in
List.map
(fun ve ->
{ ve with
- ve_core=CallByPosLic({it=WHEN clk ; src=lxm }, OperLic [ve])})
+ ve_core=CallByPosLic({it=WHEN clk ; src=lxm }, [ve])})
vel
)
- | CallByPosLic({it=Lic.TUPLE ; src=lxm }, OperLic vel) -> (remove_tuple vel)
- | CallByPosLic({it=op ; src=lxm }, OperLic [ve]) ->
+ | CallByPosLic({it=Lic.TUPLE ; src=lxm }, vel) -> (remove_tuple vel)
+ | CallByPosLic({it=op ; src=lxm }, [ve]) ->
let vel = get_vel_from_tuple ve in
List.map
- (fun ve -> { ve with ve_core=CallByPosLic({it=op;src=lxm}, OperLic [ve])})
+ (fun ve -> { ve with ve_core=CallByPosLic({it=op;src=lxm}, [ve])})
vel
- | CallByPosLic({it=op ; src=lxm }, OperLic [ve1;ve2]) ->
+ | CallByPosLic({it=op ; src=lxm }, [ve1;ve2]) ->
let vel1 = get_vel_from_tuple ve1
and vel2 = get_vel_from_tuple ve2
in
assert (List.length vel1 = List.length vel2);
List.map2
(fun ve1 ve2 ->
- { ve_core = CallByPosLic({it=op ; src=lxm }, OperLic [ve1;ve2]);
+ { ve_core = CallByPosLic({it=op ; src=lxm }, [ve1;ve2]);
ve_typ = ve1.ve_typ;
ve_clk = ve1.ve_clk }
)
@@ -193,7 +193,7 @@ and (split_val_exp : bool -> bool -> LicPrg.id_generator -> Lic.val_exp ->
| On(clock,_) ->
let clk_exp = AstCore.NamedClock (Lxm.flagit clock lxm) in
{ ve with ve_core =
- CallByPosLic({src=lxm;it=Lic.WHEN clk_exp},OperLic [ve])},
+ CallByPosLic({src=lxm;it=Lic.WHEN clk_exp},[ve])},
([],[])
| (ClockVar _) (* should not occur *)
@@ -224,7 +224,7 @@ and (split_val_exp : bool -> bool -> LicPrg.id_generator -> Lic.val_exp ->
| [nv] -> { ve with ve_core =
CallByPosLic(
Lxm.flagit (Lic.VAR_REF (nv.var_name_eff)) lxm,
- OperLic []
+ []
)}
| _ -> assert false
in
@@ -232,31 +232,24 @@ and (split_val_exp : bool -> bool -> LicPrg.id_generator -> Lic.val_exp ->
let eq = Lxm.flagit (lpl, rhs) lxm in
nve, (eql@[eq], vl@nv_l)
)
- | CallByPosLic(by_pos_op_eff, OperLic vel) -> (
+ | CallByPosLic(by_pos_op_eff, vel) -> (
(* recursively split the arguments *)
let lxm = by_pos_op_eff.src in
let (rhs, (eql,vl)) =
match by_pos_op_eff.it with
- (* for HAT, a particular treatment is done because the
- val_exp is attached to it *)
- | Lic.HAT(i,ve) ->
- let ve, (eql, vl) = split_val_exp false false getid ve in
- let by_pos_op_eff = Lxm.flagit (Lic.HAT(i, ve)) lxm in
- let rhs = CallByPosLic(by_pos_op_eff, OperLic []) in
+ | Lic.HAT(i) ->
+ let vel, (eql, vl) = split_val_exp_list false false getid vel in
+ let by_pos_op_eff = Lxm.flagit (Lic.HAT(i)) lxm in
+ let rhs = CallByPosLic(by_pos_op_eff, vel) in
rhs, (eql, vl)
| Lic.WHEN ve -> (* should we create a var for the clock? *)
let vel,(eql, vl) = split_val_exp_list true false getid vel in
let by_pos_op_eff = Lxm.flagit (Lic.WHEN(ve)) lxm in
- let rhs = CallByPosLic(by_pos_op_eff, OperLic vel) in
- rhs, (eql, vl)
- | Lic.ARRAY vel ->
- let vel, (eql, vl) = split_val_exp_list false false getid vel in
- let by_pos_op_eff = Lxm.flagit (Lic.ARRAY(vel)) lxm in
- let rhs = CallByPosLic(by_pos_op_eff, OperLic []) in
+ let rhs = CallByPosLic(by_pos_op_eff, vel) in
rhs, (eql, vl)
| _ ->
let vel, (eql, vl) = split_val_exp_list false false getid vel in
- let rhs = CallByPosLic(by_pos_op_eff, OperLic vel) in
+ let rhs = CallByPosLic(by_pos_op_eff, vel) in
rhs, (eql, vl)
in
let rhs = { ve with ve_core = rhs } in
@@ -275,28 +268,26 @@ and (split_val_exp : bool -> bool -> LicPrg.id_generator -> Lic.val_exp ->
ve_clk = clk_l;
ve_core = CallByPosLic(
Lxm.flagit (Lic.VAR_REF (nv.var_name_eff)) lxm,
- OperLic [])
+ [])
}
| _ -> {
ve_typ = List.map (fun v -> v.var_type_eff) nv_l;
ve_clk = clk_l;
ve_core = CallByPosLic(
Lxm.flagit Lic.TUPLE lxm,
- OperLic
- (List.map
- (fun nv ->
- let nnv = {
- ve_core = CallByPosLic
- (Lxm.flagit (Lic.VAR_REF (nv.var_name_eff)) lxm,
- OperLic []);
- ve_typ = [nv.var_type_eff];
- ve_clk = [snd nv.var_clock_eff]
- }
- in
- nnv
- )
- nv_l
- )
+ (List.map
+ (fun nv ->
+ let nnv = {
+ ve_core = CallByPosLic
+ (Lxm.flagit (Lic.VAR_REF (nv.var_name_eff)) lxm, []);
+ ve_typ = [nv.var_type_eff];
+ ve_clk = [snd nv.var_clock_eff]
+ }
+ in
+ nnv
+ )
+ nv_l
+ )
)
}
in
@@ -316,9 +307,9 @@ and (split_val_exp_list : bool ->
(vel,(eql,vl))
and split_node (getid: LicPrg.id_generator) (n: Lic.node_exp) : Lic.node_exp =
- Verbose.exe ~flag:dbg (fun () ->
- Printf.printf "*** Splitting node %s\n"
- (LicDump.string_of_node_key_iter n.node_key_eff));
+ Verbose.exe ~flag:dbg (fun () ->
+ Printf.printf "*** Splitting node %s\n"
+ (LicDump.string_of_node_key_iter n.node_key_eff));
let res = match n.def_eff with
| ExternLic
| MetaOpLic _
diff --git a/src/lic.ml b/src/lic.ml
index 6a42dda0823a130a4bf5b9a8838e131c810e7e59..83516cfbf77e538033637ef37e87249613c21ac5 100644
--- a/src/lic.ml
+++ b/src/lic.ml
@@ -1,4 +1,4 @@
-(* Time-stamp: <modified the 13/02/2013 (at 08:45) by Erwan Jahier> *)
+(* Time-stamp: <modified the 13/02/2013 (at 15:58) by Erwan Jahier> *)
(** Define the Data Structure representing Compiled programs. *)
@@ -57,11 +57,6 @@
(initialisation) et dans CheckNode pour la partie node/template qui
est faite à la demande.
- TYPES FONCTIONNEL :
-
- - id_solver (en fait, une structure qui contient plusieurs fonctions,
- une pour traiter les constantes, une pour traiter les types)
-
UTILITAIRES :
- type_of_const : renvoie le type d'une const
@@ -109,10 +104,11 @@ and type_var =
| Any
| AnyNum
-(* Utile :
-- arguments et profils
+(* pascal : A VIRER A MOYEN TERME !
+ R1 : euh... a voir. Pour l'instant, ca ne sert plus car Pascal a
+ débranché la verif de type lors de l'instanciation de noeud. J'en
+ aurais peut-etre besoin le jour où j'y rebrancherai.
*)
-(* A VIRER A MOYEN TERME ! *)
and node_profile = (Ident.t * type_) list * (Ident.t * type_) list
and profile = type_ list * type_ list
@@ -162,17 +158,14 @@ and val_exp =
pour typer l'appel de l'opérateur ?
*)
and val_exp_core =
- | CallByPosLic of (by_pos_op srcflagged * operands)
+ | CallByPosLic of (by_pos_op srcflagged * val_exp list)
| CallByNameLic of
(by_name_op srcflagged * (Ident.t srcflagged * val_exp) list)
| Merge of Ident.t srcflagged * (const srcflagged * val_exp) list
-and operands = OperLic of val_exp list (* Essayer d'y virer voir si ca marche encore *)
-
and by_name_op =
- | STRUCT of Ident.long *
- Ident.t option (* XXX devrait etre une expression !!! *)
- (* 'Some' if the struct is defined via a 'with' *)
+ | STRUCT of Ident.long
+ | STRUCT_with of Ident.long * Ident.t (* XXX devrait etre une expression !!! *)
| STRUCT_anonymous
and by_pos_op =
@@ -190,8 +183,8 @@ and by_pos_op =
| TUPLE
| CONCAT
- | HAT of int * val_exp (* XXX mettre ce val_exp dans les operands *)
- | ARRAY of val_exp list (* XXX mettre ce val_exp dans les operands *)
+ | HAT of int
+ | ARRAY
| STRUCT_ACCESS of Ident.t
(* those are different from [by_pos_op] *)
@@ -314,7 +307,6 @@ and static_arg =
and sarg_node_eff = node_key * var_info list * var_info list
(****************************************************************************)
-
(* Because of clocks and types, we cannot rely on compare; hence this
dedicated function *)
let (compare_var_info : var_info -> var_info -> int) =
@@ -436,7 +428,9 @@ let ident_of_type = function
let (make_simple_node_key : Ident.long -> node_key) =
fun nkey -> (nkey, [])
-(* OBSOLETE ET UN PEU FAUX ! *)
+(* OBSOLETE ET UN PEU FAUX !
+ R1: pas forcément obsolete ; cf commentaire plus haut.
+*)
let rec (subst_type : type_ -> type_ -> type_) =
fun t teff_ext -> match teff_ext with
(* substitutes [t] in [teff_ext] *)
diff --git a/src/licDump.ml b/src/licDump.ml
index 5779fc2ea8c99baae7f2e73b1db7a41065cf7dad..5ab5551757f0d7ebb5069727e8d22d1260052f2f 100644
--- a/src/licDump.ml
+++ b/src/licDump.ml
@@ -1,4 +1,4 @@
-(* Time-stamp: <modified the 12/02/2013 (at 18:03) by Erwan Jahier> *)
+(* Time-stamp: <modified the 13/02/2013 (at 15:09) by Erwan Jahier> *)
open Errors
open Printf
@@ -34,8 +34,8 @@ let _ = assert (get_rank 5 [1;3;5] = 3)
(* check it is a non-singleton tuple *)
let rec is_a_tuple (e:Lic.val_exp) : bool =
match e.ve_core with
- | CallByPosLic ({ it = TUPLE }, OperLic [ve]) -> is_a_tuple ve
- | CallByPosLic ({ it = TUPLE }, OperLic vel) -> List.length vel > 1
+ | CallByPosLic ({ it = TUPLE }, [ve]) -> is_a_tuple ve
+ | CallByPosLic ({ it = TUPLE }, vel) -> List.length vel > 1
| _ -> false
(******************************************************************************)
@@ -438,8 +438,9 @@ and (string_of_by_pos_op_eff: Lic.by_pos_op srcflagged -> Lic.val_exp list -> st
| TUPLE,_ -> (tuple vel)
| CONCAT, [ve1; ve2] ->
(string_of_val_exp_eff ve1) ^ " | " ^ (string_of_val_exp_eff ve2)
- | HAT (i, ve), _ -> (string_of_val_exp_eff ve) ^ "^" ^ (string_of_int i)
- | ARRAY vel, _ -> tuple_square vel
+ | HAT (i), [ve] -> (string_of_val_exp_eff ve) ^ "^" ^ (string_of_int i)
+ | HAT (i), _ -> assert false
+ | ARRAY, vel -> tuple_square vel
| STRUCT_ACCESS(id), [ve1] ->
(string_of_val_exp_eff ve1) ^ "." ^ (Ident.to_string id)
@@ -487,7 +488,7 @@ and (string_of_by_pos_op_eff: Lic.by_pos_op srcflagged -> Lic.val_exp list -> st
and string_of_val_exp_eff ve = string_of_val_exp_eff_core ve.ve_core
and string_of_val_exp_eff_core ve_core =
match ve_core with
- | CallByPosLic (by_pos_op_eff, OperLic vel) ->
+ | CallByPosLic (by_pos_op_eff, vel) ->
(* ICI : on pourrait afficher en commentaire l'éventuel type_matches ? *)
(string_of_by_pos_op_eff by_pos_op_eff vel)
@@ -513,7 +514,8 @@ and string_of_val_exp_eff_core ve_core =
)
| CallByNameLic(by_name_op_eff, fl) ->
(match by_name_op_eff.it with
- | STRUCT (long, _dft_opt) -> (Ident.string_of_long long)
+ | STRUCT (long) -> (Ident.string_of_long long)
+ | STRUCT_with (long, _dft) -> (Ident.string_of_long long)
| STRUCT_anonymous -> ""
) ^ (
"{" ^ (String.concat ";"
diff --git a/src/licPrg.mli b/src/licPrg.mli
index f5bf92901aa3e400eb933acc3e1ab344da170510..cf13a38267564c7825b016ecf259f65e7f3fed35 100644
--- a/src/licPrg.mli
+++ b/src/licPrg.mli
@@ -1,4 +1,4 @@
-(* Time-stamp: <modified the 16/01/2013 (at 18:34) by Erwan Jahier> *)
+(* Time-stamp: <modified the 13/02/2013 (at 16:05) by Erwan Jahier> *)
(** The data structure resulting from the compilation process *)
@@ -25,6 +25,7 @@
type t
+
val add_type : Lic.item_key -> Lic.type_ -> t -> t
val add_const : Lic.item_key -> Lic.const -> t -> t
val add_node : Lic.node_key -> Lic.node_exp -> t -> t
diff --git a/src/licTab.ml b/src/licTab.ml
index c4707729487bee1c16fd68051619d188afdac446..b9606c0f192a3a58e8283ec986bac86233a35d83 100644
--- a/src/licTab.ml
+++ b/src/licTab.ml
@@ -1,4 +1,4 @@
-(* Time-stamp: <modified the 13/02/2013 (at 08:21) by Erwan Jahier> *)
+(* Time-stamp: <modified the 13/02/2013 (at 15:08) by Erwan Jahier> *)
open Lxm
@@ -1169,14 +1169,13 @@ and (node_check_interface_do: t -> Lic.node_key -> Lxm.t ->
{ ve_core =
CallByPosLic(
(Lxm.flagit (CALL(Lxm.flagit aliased_node.node_key_eff lxm)) lxm,
- OperLic
(List.map
(fun vi -> (* build operands*)
let ve = {
ve_typ = [vi.var_type_eff];
ve_clk = [snd vi.var_clock_eff];
ve_core = CallByPosLic(
- Lxm.flagit (VAR_REF(vi.var_name_eff)) lxm, OperLic [])}
+ Lxm.flagit (VAR_REF(vi.var_name_eff)) lxm, [])}
in
ve
)
diff --git a/src/unifyClock.ml b/src/unifyClock.ml
index 4b785df043ceae7d05fe210fc3a58d4ef32b44b8..b7cbe429413a2723b647e5d6ff099a6273458310 100644
--- a/src/unifyClock.ml
+++ b/src/unifyClock.ml
@@ -1,4 +1,4 @@
-(* Time-stamp: <modified the 12/02/2013 (at 18:06) by Erwan Jahier> *)
+(* Time-stamp: <modified the 13/02/2013 (at 10:08) by Erwan Jahier> *)
open LicDump
@@ -193,9 +193,9 @@ let rec (apply_subst_val_exp : subst -> Lic.val_exp -> Lic.val_exp) =
fun s ve ->
let ve_core =
match ve.ve_core with
- | CallByPosLic (by_pos_op, OperLic vel) ->
+ | CallByPosLic (by_pos_op, vel) ->
let vel = List.map (apply_subst_val_exp s) vel in
- CallByPosLic (by_pos_op, OperLic vel)
+ CallByPosLic (by_pos_op, vel)
| CallByNameLic(by_name_op, fl) ->
let fl = List.map
(fun (fn,ve) -> (fn, apply_subst_val_exp s ve)) fl
@@ -278,7 +278,7 @@ let rec (const_to_val_eff: Lxm.t -> bool -> subst -> const -> subst * val_exp) =
fun lxm expand_const s const ->
let mk_by_pos_op_arg by_pos_op_eff arg =
let s, clk = new_clock_var s in
- { ve_core = CallByPosLic(flagit by_pos_op_eff lxm, OperLic arg) ;
+ { ve_core = CallByPosLic(flagit by_pos_op_eff lxm, arg) ;
ve_typ = types_of_const const ;
ve_clk = [clk];
}
@@ -309,8 +309,8 @@ let rec (const_to_val_eff: Lxm.t -> bool -> subst -> const -> subst * val_exp) =
(s,[])
ct
in
- let vel = List.rev vel in
- s, mk_by_pos_op (ARRAY vel)
+ let vel = List.rev vel in
+ s, mk_by_pos_op_arg ARRAY vel
| Tuple_const_eff cl ->
let s, vel =
List.fold_left
@@ -328,7 +328,7 @@ let rec (const_to_val_eff: Lxm.t -> bool -> subst -> const -> subst * val_exp) =
| Struct_type_eff(sname, _) -> sname
| _ -> assert false
in
- let name_op_flg = flagit (STRUCT(sname, None)) lxm in
+ let name_op_flg = flagit (STRUCT(sname)) lxm in
let s, fl =
List.fold_left
(fun (s,fl) (id,const) ->
diff --git a/src/unifyType.ml b/src/unifyType.ml
index ccc080ad250634eaa1d06ae6bbf7d64cc0cb728c..e0adaafe0d12ecec997d6aabf9f6905ae0f9d01b 100644
--- a/src/unifyType.ml
+++ b/src/unifyType.ml
@@ -1,4 +1,4 @@
-(* Time-stamp: <modified the 01/02/2013 (at 17:25) by Erwan Jahier> *)
+(* Time-stamp: <modified the 13/02/2013 (at 15:08) by Erwan Jahier> *)
(*
12/07. Premier pas vers une méthode un peu plus standard :
diff --git a/test/lus2lic.sum b/test/lus2lic.sum
index 7572ddc4c7273a8bffd684bf413adf07fbf812c0..322c9529e8636708911c2b488e9e7c69c59881a0 100644
--- a/test/lus2lic.sum
+++ b/test/lus2lic.sum
@@ -1,4 +1,4 @@
-Test Run By jahier on Wed Feb 13 09:20:45 2013
+Test Run By jahier on Wed Feb 13 14:16:05 2013
Native configuration is i686-pc-linux-gnu
=== lus2lic tests ===
diff --git a/test/lus2lic.time b/test/lus2lic.time
index 76997001418c69fdba5c738b15d75c03a8b0ec06..dfafd0d5f66e96dd46ecf60b6e57e68a094e9177 100644
--- a/test/lus2lic.time
+++ b/test/lus2lic.time
@@ -1,2 +1,2 @@
-testcase ./lus2lic.tests/non-reg.exp completed in 24 seconds
+testcase ./lus2lic.tests/non-reg.exp completed in 23 seconds
testcase ./lus2lic.tests/progression.exp completed in 0 seconds
diff --git a/todo.org b/todo.org
index 9c6262f7b4d182ac3ccbd130680c18cb3bcb9ec7..620afae20430afaa46ce7f94ca9695a786f9251e 100644
--- a/todo.org
+++ b/todo.org
@@ -22,6 +22,9 @@ file:src/ast2lic.ml::202
A FAIRE + TARD ? !!
*)
+fixer le commentaire "OBSOLETE ET UN PEU FAUX"
+ file:/~/lus2lic/src/lic.ml::440
+
** TODO mauvais numero de ligne lors d'erreur d'instanciation de parametres de noeud
- State "TODO" from "" [2012-12-21 Fri 10:58]
@@ -56,31 +59,14 @@ entre les var inventées dans split et dans expandnodes !!)
Pascal a introduit un mecanisme qui shunte LicName -> en discuter avec lui.
-** TODO Définir les fonctions de UglyStuff proprement
- - State "TODO" from "" [2012-12-10 Mon 16:38]
-file:~/lus2lic/src/uglyStuff.ml
-bon j'y ai mis dans IdSolver ; c'est pas si choquant maintenant que
-ces fonctions ne sont plus dans Lic.
-
-
-** TODO Mettre tout les val_exp dans les operand dans Lic
- - State "TODO" from "" [2013-02-12 Tue 18:30]
-XXX essayer de virer le constructeur Oper qui n'a pas l'air de servir à grand chose
-
-** TODO definir un Lic.STRUCT_WITH plutot que de passer par un type option
- - State "TODO" from "" [2013-02-12 Tue 18:32]
-
-** TODO fixer le commentaire "OBSOLETE ET UN PEU FAUX"
- - State "TODO" from "" [2013-02-13 Wed 08:41]
- file:/~/lus2lic/src/lic.ml::440
* Divers
-** STARTED Intégrer le résultat de mly2bnf dans le manuel
** TODO lic2c : le jour ou on genere du code C, y'a peut-etre des trucs a recuperer
- State "TODO" from "" [2012-12-10 Mon 14:32]
chez Cedric Pasteur qui a une implementation pour optimiser la maj
des tableaux
+http://www.di.ens.fr/~pouzet/bib/lctes12.pdf
** TODO Revoir le nommage des instances de noeuds parametriques
par ex, pour should_work/NONREG/param_struct.lus
@@ -91,66 +77,6 @@ des tableaux
** TODO le with devrait opérer sur une val_exp, pas sur un ident.
- State "TODO" from "" [2013-02-12 Tue 18:31]
-* Types alias
-** WAITING Ya un probleme avec ce fichier lustre (compilait avant)
- - State "WAITING" from "STARTED" [2013-01-17 Thu 10:48]
- - State "STARTED" from "TODO" [2013-01-17 Thu 10:48]
-file:test/should_work/call/call04.lus
-
-il semble y avoir une confusion entre parametre et arguments lors
-d'appels de noeuds définis vie des itérateurs de tableau
-
-idem pour
-file:test/should_work/fab_test/morel2.lus
-et pleins d'autres. hm, y'aurait pas d'itérateurs dans celui la.
-
--> ok : c'était à c'était cause de l2lAliasType qui faisait que les
-types lic n'étaient plus uniques et du coups les substitutions dans
-l'expansion des noeuds ne se faisaient plus correctement.
-
-je met en attente en attendant de savoir ce qu'on fait de ce module.
-moi j'ai bien envie de virer AbstractType de Lic.type_. En effet, j'avais
-fait attention à tous les virer pour éviter les soucis, mais le plus
-propre c'est d'y virer vraiment.
-
-Pascal lui, s'en est servi pour faire des types alias, alors que ca
-n'est pas fait pour. Cela dit, si on créé des types alias, on risque
-d'avoir le meme genre de soucis. A quoi ca sert d'avoir de tels types
-? pour moi le role de la compil ca serait plutot de les virer que de
-les rajouter, mais bon. A discuter. cf point d'apres
-
-** TODO Enlever Abstract_type_eff de Lic.type_ ou vérifier partout que c'est correct.
- - State "TODO" from "" [2012-12-20 Thu 17:26]
-dans lic.ml, on definit les types compilés ainsi :
-and type_ =
- | Bool_type_eff
- | Int_type_eff
- | Real_type_eff
- | Abstract_type_eff of Ident.long * type_
- | Array_type_eff of type_ * int
- ...
-
-Mais est-ce vraiment utile de garder le Abstract_type_eff à ce niveau ?
-
-en effet, ca oblige à traiter les 2 cas en permanence (par ex lors des
-transfo llic2lic).
-
-Pascal suggere carrément de
-- definir un type type_ref of string
-- transformer les expressions lic de telle sorte que il n'y ait plus
- de type_ mais juste des type_ref
-
-Car en fait, actuellement, le type Lic.type_ sert à faire la verif de
-type et a representer le type des expressions lic. Du coup le type
-des expressions est inutilement compliqué; d'ou l'idée d'avoir juste
-des "type_ref of string" (Ce qui simplifiera la travail des passes
-ultérieures, style lic2c).
-
-Bon, je ferai ca quand tous les tests fonctionneront et pendant que
-j'essairais de me passer de ulglyStuff/id_solver. A voir aussi ce qui
-sera le plus pratique quand je me remettrai à bosser sur le
-lic2c/licexe
-
* Pas clair
** WAITING Regarder si on pourrait se passer du PREDEF_CALL (et de passer par le CALL normal)
@@ -232,3 +158,84 @@ bon, y'a plus d'erreur, mais ca ne compile pas. Est-ce choquant ?
On pourrait utiliser file:src/misc.ml pour prendre finement en compte les
struct et les arrays.
+
+** WAITING Ya un probleme avec ce fichier lustre (compilait avant)
+ - State "WAITING" from "STARTED" [2013-01-17 Thu 10:48]
+ - State "STARTED" from "TODO" [2013-01-17 Thu 10:48]
+file:test/should_work/call/call04.lus
+
+il semble y avoir une confusion entre parametre et arguments lors
+d'appels de noeuds définis via des itérateurs de tableau
+
+idem pour
+file:test/should_work/fab_test/morel2.lus
+et pleins d'autres. hm, y'aurait pas d'itérateurs dans celui la.
+
+-> ok : c'était à de l2lAliasType (que j'ai déranché du coup) qui
+faisait que les types lic n'étaient plus uniques et du coup les
+substitutions dans l'expansion des noeuds ne se faisaient plus
+correctement.
+
+je met en attente en attendant de savoir ce qu'on fait de ce module.
+moi j'ai bien envie de virer AbstractType de Lic.type_. En effet, j'avais
+fait attention à tous les virer pour éviter les soucis, mais le plus
+propre c'est d'y virer vraiment.
+
+Pascal lui, s'en est servi pour faire des types alias, alors que ca
+n'est pas fait pour. Cela dit, si on créé des types alias, on risque
+d'avoir le meme genre de soucis. A quoi ca sert d'avoir de tels types
+? pour moi le role de la compil ca serait plutot de les virer que de
+les rajouter, mais bon. A discuter. cf point d'apres
+
+** TODO Enlever Abstract_type_eff de Lic.type_ ou vérifier partout que c'est correct.
+ - State "TODO" from "" [2012-12-20 Thu 17:26]
+dans lic.ml, on definit les types compilés ainsi :
+and type_ =
+ | Bool_type_eff
+ | Int_type_eff
+ | Real_type_eff
+ | Abstract_type_eff of Ident.long * type_
+ | Array_type_eff of type_ * int
+ ...
+
+Mais est-ce vraiment utile de garder le Abstract_type_eff à ce niveau ?
+
+en effet, ca oblige à traiter les 2 cas en permanence (par ex lors des
+transfos l2l).
+
+Pascal suggere carrément de
+- definir un type
+
+#+begin_src ocaml
+type type_ref of string
+#+end_src
+- transformer les expressions lic de telle sorte que il n'y ait plus
+ de type_ mais juste des type_ref
+
+Car en fait, actuellement, le type Lic.type_ sert à faire la verif de
+type et a representer le type des expressions lic. Du coup le type
+des expressions est inutilement compliqué; d'ou l'idée d'avoir juste
+des "type_ref of string" (Ce qui simplifiera (?) le travail des
+passes ultérieures, style lic2c).
+
+Bon, je ferai ca quand tous les tests fonctionneront et pendant que
+j'essairais de me passer de ulglyStuff/id_solver. A voir aussi ce qui
+sera le plus pratique quand je me remettrai à bosser sur le
+lic2c/licexe
+
+
+Autre idée : Dans LicPrg, ne plus utiliser de Lic.type_ mais des
+LicPrg.type_ (=string)
++ une table LicPrg.type_ -> Lic.type au cas où
+
+l2lAliasTypes fait plus au moins le boulot. Faudrait intergrer cette
+passe à la fonction qui construit le LicPrg initial.
+
+boarf ; ca fait beaucoup de bazard pour pas grand chose. Ce qui
+simplifierait les choses pour la suite, c'est de ne plus avoir de
+Lic.type_ du tout dans les val_exp et autre.
+
+Autre idée : je fais ca lors du passage à la structure de données
+suivante (soc). Oui, ca fait du sens. en plus, les l2l* utilisent les
+infos Lic.type_, donc autant attendre un peu avant de s'en passer.
+
diff --git a/todo.org_archive b/todo.org_archive
index f06f5be5f6c23aceb5869513b433dfefffd9490d..4f4132e1c5963552d6f7e011df21d0d8979a4d26 100644
--- a/todo.org_archive
+++ b/todo.org_archive
@@ -500,6 +500,39 @@ file:~/lus2lic/src/uglyStuff.ml
bon j'y ai mis dans IdSolver ; c'est pas si choquant maintenant que
ces fonctions ne sont plus dans Lic.
+* TODO definir un Lic.STRUCT_WITH plutot que de passer par un type option
+ - State "TODO" from "" [2013-02-12 Tue 18:32]
+ :PROPERTIES:
+ :ARCHIVE_TIME: 2013-02-13 Wed 09:31
+ :ARCHIVE_FILE: ~/lus2lic/todo.org
+ :ARCHIVE_OLPATH: Aesthetes issues
+ :ARCHIVE_CATEGORY: lv6
+ :ARCHIVE_TODO: TODO
+ :END:
+
+* TODO Mettre tout les val_exp dans les operand dans Lic
+ - State "TODO" from "" [2013-02-12 Tue 18:30]
+ :PROPERTIES:
+ :ARCHIVE_TIME: 2013-02-13 Wed 11:16
+ :ARCHIVE_FILE: ~/lus2lic/todo.org
+ :ARCHIVE_OLPATH: Aesthetes issues
+ :ARCHIVE_CATEGORY: lv6
+ :ARCHIVE_TODO: TODO
+ :END:
+
+XXX essayer de virer le constructeur Oper qui n'a pas l'air de servir à grand chose
+* STARTED Intégrer le résultat de mly2bnf dans le manuel
+ :PROPERTIES:
+ :ARCHIVE_TIME: 2013-02-13 Wed 14:15
+ :ARCHIVE_FILE: ~/lus2lic/todo.org
+ :ARCHIVE_OLPATH: Divers
+ :ARCHIVE_CATEGORY: lv6
+ :ARCHIVE_TODO: STARTED
+ :END:
+
+
+
+