From 276bdfdd29d8ea458f150399d393cd2d700bfaea Mon Sep 17 00:00:00 2001
From: Erwan Jahier <jahier@imag.fr>
Date: Tue, 20 May 2008 09:59:14 +0200
Subject: [PATCH] Add support for iterators. Tests using "mapred" are now
compiling ok (support for fill, red, etc. is coming soon).
In order to add support for iterators, I have extended the by_pos_op
(and the by_pos_op_eff) data type with a list of static arguments. In
other words, iterators are handled as a particular case of predefined
operators.
---
src/TODO | 80 +++++-----
src/compiledData.ml | 5 +-
src/compiledDataDump.ml | 37 +++--
src/evalConst.ml | 14 +-
src/evalType.ml | 7 +-
src/getEff.ml | 57 ++++++-
src/iteratorSemantic.ml | 21 +++
src/iteratorSemantic.mli | 1 +
src/parser.mly | 48 +++---
src/parserUtils.ml | 29 ++--
src/predef.ml | 119 ++++++++------
src/predefSemantics.ml | 62 ++++++--
src/predefSemantics.mli | 16 +-
src/syntaxTab.ml | 15 +-
src/syntaxTreeCore.ml | 5 +-
src/syntaxTreeDump.ml | 94 +++++------
src/syntaxTreeDump.mli | 3 +-
src/test/should_work/NONREG/Int.lus | 16 +-
src/test/should_work/demo/map_red_iter.lus | 3 +-
src/test/test.res.exp | 172 +++++++++++++++++----
20 files changed, 530 insertions(+), 274 deletions(-)
create mode 100644 src/iteratorSemantic.ml
create mode 100644 src/iteratorSemantic.mli
diff --git a/src/TODO b/src/TODO
index 5fcbdc81..d54ae6d7 100644
--- a/src/TODO
+++ b/src/TODO
@@ -74,16 +74,6 @@ les operateurs aritmetiques, bof.
* pour l'evaluation statique de l'egalité, j'ai pas fait pareil...
-> à discuter (cf predefInfo.ml)
-
-***********************************************************************************
-*** a faire
-
-* le clock checking
-
-* le merge
-
-* les itérateurs
-
o Lazycompiler.solve_x_idref
Comment se faisse que je n'ai pas besoin de me servir de cet
@@ -101,30 +91,16 @@ lazycompiler.ml:
duplication basically).
+***********************************************************************************
+*** a faire
-* Quand les constantes enum sont crées, ne devraient-elles pas être créées
-comme étant des constantes externes ?
-
-Ca éviterait de générer des trucs du genre
- const declaration__rouge = declaration__rouge;
-
-(cf in should_work/demo/declaration.lus
- couleur = enum {bleu, blanc, rouge};
-)
-
-
-* test/should_work/Pascal/consensus.lus
-
-la recursion statique ne marche pas ("with (n=1)" pas pris en compte
+*** facile
+* BUG dans test/should_work/NONREG/Int.lus
-node consensus<<const n : int>>(T: bool^n) returns (a: bool);
-let
- a = with (n = 1)
- then T[0]
- else T[0] and consensus << n-1 >> (T[1..n-1]);
-tel
+la constante 'Int8::zero' a pour type 'bool^8' au lieu de 'Int8::Int'
+* Evaluer statiquement les iterateurs quand c'est possible (cf evalConst.ml)
* "1..2" ne marche pas car le lexer renvoie
"1." ".2"
@@ -142,25 +118,51 @@ generer les lexemes qui vont bien,
tk_real+tk_real -> tk_int+tk_dotdot+tk_int
-* evalEq.translate_left_part : faire plus de verification sur les
-index de slice
+* autoriser le fait le pouvoir donner une valeur par defaut à une constante
+ exportée. («provides const : n = 4; »)
-* parser.mly : rajouter les pragma !
+* Dans les messages d'erreurs, le numero de colonne est faux à cause des tabulations
-* patcher le mode emacs
- - rajouter modele, package, etc.
- - l'indentation est vraiment à chier
* Verifier que les fonctions sont des fonctions etc.
-* autoriser le fait le pouvoir donner une valeur par defaut à une constante
- exportée. («provides const : n = 4; »)
-* Dans les messages d'erreurs, le numero de colonne est faux à cause des tabulations
+
+*** moins facile
+
+* le clock checking
+
+* le merge
+
+* les itérateurs
+
+
+* test/should_work/Pascal/consensus.lus
+
+la recursion statique ne marche pas ("with (n=1)" pas pris en compte
+
+
+node consensus<<const n : int>>(T: bool^n) returns (a: bool);
+let
+ a = with (n = 1)
+ then T[0]
+ else T[0] and consensus << n-1 >> (T[1..n-1]);
+tel
+
+
+* evalEq.translate_left_part : faire plus de verification sur les
+index de slice
+
+* parser.mly : rajouter les pragma !
+
+* patcher le mode emacs
+ - rajouter modele, package, etc.
+ - l'indentation est vraiment à chier
+
* finir de rédiger le manuel
* Essayer de tronconner le lazyCompiler, 700 lignes, c'est trop (et
diff --git a/src/compiledData.ml b/src/compiledData.ml
index 7341759f..fdb1a9d9 100644
--- a/src/compiledData.ml
+++ b/src/compiledData.ml
@@ -1,4 +1,4 @@
-(** Time-stamp: <modified the 15/05/2008 (at 16:08) by Erwan Jahier> *)
+(** Time-stamp: <modified the 19/05/2008 (at 16:44) by Erwan Jahier> *)
(**
@@ -168,7 +168,7 @@ and by_name_op_eff =
and by_pos_op_eff =
- | Predef_eff of Predef.op
+ | Predef_eff of Predef.op * static_arg_eff list
| CALL_eff of node_exp_eff srcflagged
| IDENT_eff of Ident.idref
@@ -191,7 +191,6 @@ and by_pos_op_eff =
| ARRAY_ACCES_eff of int * type_eff (* index + type of the element *)
| ARRAY_SLICE_eff of slice_info_eff * type_eff
| MERGE_eff of (Ident.t * (Ident.t list))
- | ITERATOR_eff of (Ident.t * Ident.t * val_exp_eff)
(*---------------------------------------------------------------------
diff --git a/src/compiledDataDump.ml b/src/compiledDataDump.ml
index 283bdd00..a919c875 100644
--- a/src/compiledDataDump.ml
+++ b/src/compiledDataDump.ml
@@ -59,22 +59,20 @@ and string_of_type_eff_list = function
| l -> String.concat " * " (List.map string_of_type_eff l)
-
-let rec string_of_node_key (nkey: node_key) = (
- let arg2string (sa : static_arg_eff) =
+
+let rec string_of_node_key (nkey: node_key) =
+ match nkey with
+ | (ik, []) -> long ik
+ | (ik, salst) ->
+ let astrings = List.map static_arg2string salst in
+ sprintf "%s<<%s>>" (long ik) (String.concat ", " astrings)
+
+and static_arg2string (sa : static_arg_eff) =
match sa with
| ConstStaticArgEff (id, ceff) -> sprintf "const %s" (string_of_const_eff ceff)
| TypeStaticArgEff (id, teff) -> sprintf "type %s" (string_of_type_eff teff)
| NodeStaticArgEff (id, opeff) ->
sprintf "node %s" (string_of_node_key opeff.node_key_eff)
- in
- match nkey with
- | (ik, []) -> long ik
- | (ik, salst) ->
- let astrings = List.map arg2string salst in
- sprintf "%s<<%s>>" (long ik) (String.concat ", " astrings)
-)
-
let (string_of_var_info_eff: var_info_eff -> string) =
fun x ->
@@ -120,19 +118,22 @@ let rec (string_of_by_pos_op_eff : by_pos_op_eff -> val_exp_eff list -> string)
"[" ^ (String.concat ", " (List.map string_of_val_exp_eff vel)) ^ "]"
in
match posop,vel with
- | Predef_eff Predef.IF_n, [ve1; ve2; ve3] ->
+ | Predef_eff (Predef.IF_n,_), [ve1; ve2; ve3] ->
" if (" ^ (string_of_val_exp_eff ve1) ^
") then (" ^ (string_of_val_exp_eff ve2) ^
") else (" ^ (string_of_val_exp_eff ve3) ^ ")"
- | Predef_eff op, [ve1; ve2] ->
+ | Predef_eff(op,sargs), [ve1; ve2] ->
if Predef.is_infix op then ("("^
(string_of_val_exp_eff ve1) ^ " " ^ (Predef.op2string op) ^ " " ^
(string_of_val_exp_eff ve2) ^ ")"
) else (
(Predef.op2string op) ^ (tuple vel)
)
- | Predef_eff op, _ -> (Predef.op2string op) ^ (tuple vel)
+ | Predef_eff(op,sargs), _ -> (Predef.op2string op) ^
+ (if sargs = [] then "" else
+ "<<" ^ (String.concat ", " (List.map static_arg2string sargs))
+ ^ ">>") ^ (tuple vel)
| CALL_eff nee, _ -> (
string_of_node_key nee.it.node_key_eff) ^ (tuple vel)
@@ -162,7 +163,7 @@ let rec (string_of_by_pos_op_eff : by_pos_op_eff -> val_exp_eff list -> string)
| ARRAY_SLICE_eff(_,_), _ -> assert false (* todo *)
| MERGE_eff _, _ -> assert false (* todo *)
- | ITERATOR_eff _, _ -> assert false (* todo *)
+(* | ITERATOR_eff _, _ -> assert false (* todo *) *)
(* Cannot happen *)
| WHEN_eff, _ -> assert false
@@ -256,7 +257,11 @@ let (const_decl: Ident.long -> const_eff -> string) =
(match ceff with
| Extern_const_eff _ -> ":" ^ (string_of_type_eff (type_of_const_eff ceff))
| Enum_const_eff _ -> "" (* enum const are defined as extern const *)
- | _ -> " = " ^ (string_of_const_eff ceff)
+ | Struct_const_eff _ -> assert false
+ | Array_const_eff _
+ | Bool_const_eff _
+ | Int_const_eff _
+ | Real_const_eff _ -> " = " ^ (string_of_const_eff ceff)
) ^ ";\n"
let (node_of_node_exp_eff: node_exp_eff -> string) =
diff --git a/src/evalConst.ml b/src/evalConst.ml
index 9cb24ed5..a6e40ca6 100644
--- a/src/evalConst.ml
+++ b/src/evalConst.ml
@@ -1,4 +1,4 @@
-(** Time-stamp: <modified the 16/05/2008 (at 09:34) by Erwan Jahier> *)
+(** Time-stamp: <modified the 19/05/2008 (at 17:00) by Erwan Jahier> *)
open Printf
@@ -316,11 +316,15 @@ let rec f
| CURRENT_n -> not_evaluable_construct "current"
| PRE_n -> not_evaluable_construct "pre"
- | ITERATOR_n _ -> not_evaluable_construct "iterator"
- | Predef op
+ | Predef(op,sargs)
->
- let effargs = (List.map rec_eval_const args) in
- PredefSemantics.const_eval op (effargs)
+ if sargs = [] then
+ let effargs = (List.map rec_eval_const args) in
+ PredefSemantics.const_eval op [] effargs
+ else
+ (* Well, it migth be possible after all... TODO *)
+ not_evaluable_construct (op2string op)
+
) (* FIN DE : eval_by_pos_const *)
(*-------------------------------------*)
diff --git a/src/evalType.ml b/src/evalType.ml
index 2d75131c..87930fff 100644
--- a/src/evalType.ml
+++ b/src/evalType.ml
@@ -1,4 +1,4 @@
-(** Time-stamp: <modified the 16/05/2008 (at 09:32) by Erwan Jahier> *)
+(** Time-stamp: <modified the 19/05/2008 (at 17:01) by Erwan Jahier> *)
open Predef
@@ -28,8 +28,8 @@ and (eval_by_pos_type :
id_solver -> by_pos_op_eff -> Lxm.t -> val_exp_eff list -> type_eff list) =
fun id_solver posop lxm args ->
match posop with
- | Predef_eff op ->
- PredefSemantics.type_eval op (List.map (f id_solver) args)
+ | Predef_eff (op,sargs) ->
+ PredefSemantics.type_eval op sargs (List.map (f id_solver) args)
| CALL_eff node_exp_eff -> snd (List.split node_exp_eff.it.outlist_eff)
| IDENT_eff id -> (
@@ -134,7 +134,6 @@ and (eval_by_pos_type :
| [teff] -> teff
| _ -> raise(EvalType_error("arity error (1 arg expected)"))
)
- | ITERATOR_eff _ -> finish_me "iterator"; assert false
| MERGE_eff _ -> finish_me "merge"; assert false
diff --git a/src/getEff.ml b/src/getEff.ml
index 8033538e..d2fcc143 100644
--- a/src/getEff.ml
+++ b/src/getEff.ml
@@ -1,4 +1,4 @@
-(** Time-stamp: <modified the 16/05/2008 (at 09:31) by Erwan Jahier> *)
+(** Time-stamp: <modified the 19/05/2008 (at 17:26) by Erwan Jahier> *)
open Lxm
@@ -94,7 +94,7 @@ and (check_static_arg : CompiledData.id_solver ->
let teff = typ node_id_solver te in
TypeStaticArgEff (id, teff)
- | StaticArgNode(ne), StaticParamNode(id,_,_,_)->
+ | StaticArgNode(ne), StaticParamNode(id,_,_,_) ->
let neff = node node_id_solver {src=sa.src; it=ne } in
NodeStaticArgEff (id, neff)
@@ -133,8 +133,8 @@ let rec (eq : id_solver -> eq_info srcflagged -> eq_info_eff srcflagged) =
if le <> re then
let msg = "type mismatch: \n***\t'"
^ (CompiledDataDump.string_of_type_eff le) ^
- "'\n*** is not compatible with \n***\t'"
- ^ (CompiledDataDump.string_of_type_eff re) ^ "'"
+ "' (left-hand-side) \n*** is not compatible with \n***\t'"
+ ^ (CompiledDataDump.string_of_type_eff re) ^ "' (rigth-hand-side)"
in
raise (Compile_error(eq_info.src, msg))
)
@@ -212,11 +212,54 @@ and translate_by_name_op = function
and translate_field id_solver (id, ve) = (id, translate_val_exp id_solver ve)
+
+(* XXX autre nom, autre module ?
+ ca fait partie de la definition des iterateurs d'une certaine maniere...
+ -> créer 2 modules, Iterator + IteratorSemantics
+*)
+and get_const id_solver const_or_const_ident lxm =
+ match const_or_const_ident with
+ | StaticArgConst(c) -> List.hd (EvalConst.f id_solver c)
+ | StaticArgIdent(id) -> id_solver.id2const id lxm
+ | StaticArgType _
+ | StaticArgNode _ -> raise (Compile_error(lxm, "a constant was expected"))
+
+and get_node id_solver node_or_node_ident lxm =
+ match node_or_node_ident with
+ | StaticArgIdent(id) ->
+ let sargs = [] in (* I should do something more clever here to support
+ imbricated use of iterators (e.g., "map<<map<<..." *)
+ id_solver.id2node id sargs lxm
+ | StaticArgNode(ne) -> node id_solver {src=lxm; it=ne }
+ | StaticArgType _
+ | StaticArgConst _ -> raise (Compile_error(lxm, "a node was expected"))
+
+
and (translate_by_pos_op : id_solver -> by_pos_op -> Lxm.t -> val_exp list ->
by_pos_op_eff) =
fun id_solver by_pos_op lxm args ->
match by_pos_op with
- | Predef op -> Predef_eff op
+ (* put that in another module ? yes, see above.*)
+ | Predef(Map,_) -> finish_me "map"; assert false
+ | Predef(Fill,_) -> finish_me "fill"; assert false
+ | Predef(Red,_) -> finish_me "red"; assert false
+ | Predef(MapRed, [{src=lxm_n;it=node}; {src=lxm_c;it=const}]) ->
+ let sargs_eff =
+ [NodeStaticArgEff(
+ Ident.of_string "mapnode", get_node id_solver node lxm_n);
+ ConstStaticArgEff(
+ Ident.of_string "mapsize", get_const id_solver const lxm_c)]
+ in
+ Predef_eff(MapRed, sargs_eff)
+
+ | Predef(MapRed, args) ->
+ raise (Compile_error(lxm, "bad arguments number for map_red"))
+
+ | Predef(BoolRed,_) ->finish_me "boolred"; assert false
+
+ (* other predef operators *)
+ | Predef(op, args) -> assert (args=[]); Predef_eff (op,[])
+
| CALL_n node_exp_f ->
CALL_eff (flagit (node id_solver node_exp_f) node_exp_f.src)
@@ -273,9 +316,7 @@ and (translate_by_pos_op : id_solver -> by_pos_op -> Lxm.t -> val_exp list ->
)
| MERGE_n(id, idl) -> MERGE_eff(id, idl)
-
- | ITERATOR_n(id1, id2, ve) ->
- ITERATOR_eff(id1, id2, translate_val_exp id_solver ve)
+
and (translate_slice_info : id_solver -> slice_info -> int -> Lxm.t ->
slice_info_eff) =
diff --git a/src/iteratorSemantic.ml b/src/iteratorSemantic.ml
new file mode 100644
index 00000000..69ad7c1c
--- /dev/null
+++ b/src/iteratorSemantic.ml
@@ -0,0 +1,21 @@
+
+
+
+
+
+(*********************************************************************************)
+let (check_iterator_args : CompiledData.id_solver -> Predef.op ->
+ static_arg srcflagged list -> static_arg_eff list) =
+ fun id_solver op args ->
+ match op,args with
+ | Map,_ -> assert false
+ | Fill,_ -> assert false
+ | Red,_ -> assert false
+ | MapRed, [{src=lxm_n;it=StaticArgNode(n)}; {src=lxm_c;it=StaticArgConst(c)}] ->
+ let neff = GetEff.node id_solver {src=lxm_n; it=n } in
+ let ceff = List.hd (EvalConst.f id_solver c) in
+ [NodeStaticArgEff(Ident.of_string "mapnode", neff);
+ ConstStaticArgEff(Ident.of_string "mapsize", ceff)]
+ | MapRed, _ -> failwith "bad arguments for mapred"
+ | BoolRed,_ ->assert false
+
diff --git a/src/iteratorSemantic.mli b/src/iteratorSemantic.mli
new file mode 100644
index 00000000..ae217094
--- /dev/null
+++ b/src/iteratorSemantic.mli
@@ -0,0 +1 @@
+val check_iterator_args : CompiledData.id_solver -> Predef.op
diff --git a/src/parser.mly b/src/parser.mly
index 5d4539d4..e809c372 100644
--- a/src/parser.mly
+++ b/src/parser.mly
@@ -1097,29 +1097,29 @@ sxExpression:
;
sxPredefOp:
- | TK_NOT { {src=$1; it=Predef(NOT_n)} }
+ | TK_NOT { {src=$1; it=Predef(NOT_n,[])} }
| TK_FBY { {src=$1; it=FBY_n} }
| TK_PRE { {src=$1; it=PRE_n} }
| TK_CURRENT{ {src=$1; it=CURRENT_n} }
| TK_ARROW { {src=$1; it=ARROW_n} }
| TK_WHEN { {src=$1; it=WHEN_n} }
- | TK_AND { {src=$1; it=Predef(AND_n) } }
- | TK_OR { {src=$1; it=Predef(OR_n) } }
- | TK_XOR { {src=$1; it=Predef(XOR_n) } }
- | TK_IMPL { {src=$1; it=Predef(IMPL_n) } }
- | TK_EQ { {src=$1; it=Predef(EQ_n) } }
- | TK_NEQ { {src=$1; it=Predef(NEQ_n) } }
- | TK_LT { {src=$1; it=Predef(LT_n) } }
- | TK_LTE { {src=$1; it=Predef(LTE_n) } }
- | TK_GT { {src=$1; it=Predef(GT_n) } }
- | TK_GTE { {src=$1; it=Predef(GTE_n) } }
- | TK_DIV { {src=$1; it=Predef(DIV_n) } }
- | TK_MOD { {src=$1; it=Predef(MOD_n) } }
- | TK_MINUS { {src=$1; it=Predef(MINUS_n) } }
- | TK_PLUS { {src=$1; it=Predef(PLUS_n) } }
- | TK_SLASH { {src=$1; it=Predef(SLASH_n) } }
- | TK_STAR { {src=$1; it=Predef(TIMES_n) } }
- | TK_IF { {src=$1; it=Predef(IF_n) } }
+ | TK_AND { {src=$1; it=Predef(AND_n,[]) } }
+ | TK_OR { {src=$1; it=Predef(OR_n,[]) } }
+ | TK_XOR { {src=$1; it=Predef(XOR_n,[]) } }
+ | TK_IMPL { {src=$1; it=Predef(IMPL_n,[]) } }
+ | TK_EQ { {src=$1; it=Predef(EQ_n,[]) } }
+ | TK_NEQ { {src=$1; it=Predef(NEQ_n,[]) } }
+ | TK_LT { {src=$1; it=Predef(LT_n,[]) } }
+ | TK_LTE { {src=$1; it=Predef(LTE_n,[]) } }
+ | TK_GT { {src=$1; it=Predef(GT_n,[]) } }
+ | TK_GTE { {src=$1; it=Predef(GTE_n,[]) } }
+ | TK_DIV { {src=$1; it=Predef(DIV_n,[]) } }
+ | TK_MOD { {src=$1; it=Predef(MOD_n,[]) } }
+ | TK_MINUS { {src=$1; it=Predef(MINUS_n,[]) } }
+ | TK_PLUS { {src=$1; it=Predef(PLUS_n,[]) } }
+ | TK_SLASH { {src=$1; it=Predef(SLASH_n,[]) } }
+ | TK_STAR { {src=$1; it=Predef(TIMES_n,[]) } }
+ | TK_IF { {src=$1; it=Predef(IF_n,[]) } }
;
/* Appel fonctionnel par position (classique) */
/* NB
@@ -1143,7 +1143,7 @@ sxEffectiveNode:
| sxIdentRef TK_OPEN_STATIC_PAR sxStaticArgList TK_CLOSE_STATIC_PAR
{ {src=$1.src; it=(($1.it, List.rev $3)) } }
/* Un operateur prédéfini
- | TK_OPERATOR sxPredefOp
+ | TK_OPERATOR sxPredefOp,[]
{ {src=$; it=($2.it, []) } }
;
XXX pour l'instant, j'enleve la possibilité d'avoir
@@ -1201,7 +1201,7 @@ sxStaticArgList:
sxSurelyNode:
| sxIdentRef TK_OPEN_STATIC_PAR sxStaticArgList TK_CLOSE_STATIC_PAR
{ {src=$1.src; it=($1.it, List.rev $3) } }
-/* | TK_OPERATOR sxPredefOp
+/* | TK_OPERATOR sxPredefOp,[]
{ {src=$2.src; it= ( $2.it)} }
XXX pour l'instant, j'enleve la possibilité d'avoir
(operator +(1,2)). On verra ca plus tard
@@ -1293,13 +1293,13 @@ sxExpressionList: sxExpression
;
sxConstant: TK_TRUE
- { (leafexp $1 (Predef TRUE_n)) }
+ { (leafexp $1 (Predef(TRUE_n,[]))) }
| TK_FALSE
- { (leafexp $1 (Predef FALSE_n)) }
+ { (leafexp $1 (Predef(FALSE_n,[]))) }
| TK_ICONST
- { (leafexp $1 (Predef(ICONST_n (Lxm.id $1)))) }
+ { (leafexp $1 (Predef((ICONST_n (Lxm.id $1)),[]))) }
| TK_RCONST
- { (leafexp $1 (Predef(RCONST_n (Lxm.id $1)))) }
+ { (leafexp $1 (Predef((RCONST_n (Lxm.id $1)),[]))) }
;
/* WARNING ! : les listes sont crées à l'envers */
diff --git a/src/parserUtils.ml b/src/parserUtils.ml
index 35cef339..39c2b4fc 100644
--- a/src/parserUtils.ml
+++ b/src/parserUtils.ml
@@ -1,4 +1,4 @@
-(** Time-stamp: <modified the 20/03/2008 (at 11:35) by Erwan Jahier> *)
+(** Time-stamp: <modified the 16/05/2008 (at 15:10) by Erwan Jahier> *)
@@ -122,30 +122,33 @@ let flat_twice_flagged_list
let leafexp lxm op = CallByPos({src = lxm ; it = op }, Oper [])
let unexp lxm op e1 = CallByPos( {src = lxm ; it = op }, Oper [e1] )
-let unexp_predef lxm op e1 = CallByPos( {src = lxm ; it = Predef op }, Oper [e1] )
+let unexp_predef lxm op e1 = CallByPos( {src = lxm ; it = Predef (op,[]) }, Oper [e1] )
let binexp lxm op e1 e2 = CallByPos( {src = lxm ; it = op }, Oper [e1 ; e2] )
-let binexp_predef lxm op e1 e2 = CallByPos( {src = lxm ; it = Predef op }, Oper [e1 ; e2] )
+let binexp_predef lxm op e1 e2 = CallByPos( {src = lxm ; it = Predef (op,[]) },
+ Oper [e1 ; e2] )
let ternexp lxm op e1 e2 e3 = CallByPos( {src = lxm ; it = op }, Oper [e1 ; e2; e3] )
-let ternexp_predef lxm op e1 e2 e3 = CallByPos( {src = lxm ; it = Predef op }, Oper [e1 ; e2; e3] )
+let ternexp_predef lxm op e1 e2 e3 = CallByPos( {src = lxm ; it = Predef (op,[]) },
+ Oper [e1 ; e2; e3] )
let naryexp lxm op elst = CallByPos( {src = lxm ; it = op }, Oper elst )
-let naryexp_predef lxm op elst = CallByPos( {src = lxm ; it = Predef op }, Oper elst )
+let naryexp_predef lxm op elst = CallByPos( {src = lxm ; it = Predef (op,[]) },
+ Oper elst )
let bynameexp lxm op nelst = CallByName( {src = lxm ; it = op } , nelst )
open Ident
-(* used in the parser to recognize if a node is a predefined operators *)
+(* used in the parser to recognize if a node is a predefined operator *)
let (call_or_predef : node_exp Lxm.srcflagged -> by_pos_op) =
fun nef ->
let {it=(idref, sargs); src=lxm } = nef in
- match idref.id_pack with
- | None (* We consider that the Lustre package is used by default *)
- | Some "Lustre" -> (
- try Predef (Predef.string_to_op idref.id_id)
- with Not_found -> CALL_n nef
- )
- | Some _ -> CALL_n nef
+ match idref.id_pack with
+ | None (* We consider that the Lustre package is «use»d by default *)
+ | Some "Lustre" -> (
+ try Predef (Predef.string_to_op idref.id_id, sargs)
+ with Not_found -> CALL_n nef
+ )
+ | Some _ -> CALL_n nef
diff --git a/src/predef.ml b/src/predef.ml
index 201f8fa3..11fe99a8 100644
--- a/src/predef.ml
+++ b/src/predef.ml
@@ -1,4 +1,4 @@
-(** Time-stamp: <modified the 01/04/2008 (at 15:29) by Erwan Jahier> *)
+(** Time-stamp: <modified the 20/05/2008 (at 09:39) by Erwan Jahier> *)
@@ -51,6 +51,13 @@ type op =
| RSLASH_n
| RTIMES_n
+(* Array iterator *)
+ | Map
+ | Fill
+ | Red
+ | MapRed
+ | BoolRed
+
let op2string = function
| TRUE_n -> "true"
| FALSE_n -> "false"
@@ -89,6 +96,11 @@ let op2string = function
| RPLUS_n -> "+"
| RSLASH_n -> "/"
| RTIMES_n -> "*"
+ | Map -> "map"
+ | Fill -> "fill"
+ | Red -> "red"
+ | MapRed -> "map_red"
+ | BoolRed -> "bool_red"
let is_infix = function
| AND_n | OR_n | XOR_n | IMPL_n | EQ_n | NEQ_n | LT_n | LTE_n | GT_n | GTE_n | DIV_n
@@ -99,54 +111,63 @@ let is_infix = function
(*********************************************************************************)
-let (string_to_op : string -> op) = function
-
- (* zero-ary *)
- | "true" -> TRUE_n
- | "false" -> FALSE_n
- (* unary *)
- | "not" -> NOT_n
- | "real2int" -> REAL2INT_n
- | "int2real" -> INT2REAL_n
- (* binary *)
- | "and" -> AND_n
- | "or" -> OR_n
- | "xor" -> XOR_n
- | "impl" -> IMPL_n
- | "eq" -> EQ_n
- | "neq" -> NEQ_n
- | "lt" -> LT_n
- | "lte" -> LTE_n
- | "gt" -> GT_n
- | "gte" -> GTE_n
- | "div" -> DIV_n
- | "mod" -> MOD_n
- (* ternary *)
- | "if" -> IF_n
- (* n-ary *)
- | "nor" -> NOR_n
- | "diese" -> DIESE_n (* XXX should i put "#" instead ??? *)
-
- (* overloaded operator *)
- | "uminus" -> UMINUS_n
- | "minus" -> MINUS_n
- | "plus" -> PLUS_n
- | "slash" -> SLASH_n
- | "times" -> TIMES_n
-
- (* un-overloaded operator *)
- | "iuminus" -> IUMINUS_n
- | "iminus" -> IMINUS_n
- | "iplus" -> IPLUS_n
- | "islash" -> ISLASH_n
- | "itimes" -> ITIMES_n
-
- | "ruminus" -> RUMINUS_n
- | "rminus" -> RMINUS_n
- | "rplus" -> RPLUS_n
- | "rslash" -> RSLASH_n
- | "rtimes" -> RTIMES_n
- | _ -> raise Not_found
+let (string_to_op : string -> op) =
+ function
+ (* zero-ary *)
+ | "true" -> TRUE_n
+ | "false" -> FALSE_n
+ (* unary *)
+ | "not" -> NOT_n
+ | "real2int" -> REAL2INT_n
+ | "int2real" -> INT2REAL_n
+ (* binary *)
+ | "and" -> AND_n
+ | "or" -> OR_n
+ | "xor" -> XOR_n
+ | "impl" -> IMPL_n
+ | "eq" -> EQ_n
+ | "neq" -> NEQ_n
+ | "lt" -> LT_n
+ | "lte" -> LTE_n
+ | "gt" -> GT_n
+ | "gte" -> GTE_n
+ | "div" -> DIV_n
+ | "mod" -> MOD_n
+ (* ternary *)
+ | "if" -> IF_n
+ (* n-ary *)
+ | "nor" -> NOR_n
+ | "diese" -> DIESE_n (* XXX should i put "#" instead ??? *)
+
+ (* overloaded operator *)
+ | "uminus" -> UMINUS_n
+ | "minus" -> MINUS_n
+ | "plus" -> PLUS_n
+ | "slash" -> SLASH_n
+ | "times" -> TIMES_n
+
+ (* un-overloaded operator *)
+ | "iuminus" -> IUMINUS_n
+ | "iminus" -> IMINUS_n
+ | "iplus" -> IPLUS_n
+ | "islash" -> ISLASH_n
+ | "itimes" -> ITIMES_n
+
+ | "ruminus" -> RUMINUS_n
+ | "rminus" -> RMINUS_n
+ | "rplus" -> RPLUS_n
+ | "rslash" -> RSLASH_n
+ | "rtimes" -> RTIMES_n
+
+ (* array iterator *)
+ | "map" -> Map
+ | "fill" -> Fill
+ | "red" -> Red
+ | "map_red" -> MapRed
+ | "bool_red" -> BoolRed
+
+ | _ -> raise Not_found
+
(*********************************************************************************)
(* Automatically generate the latex documentation associated to predefined
diff --git a/src/predefSemantics.ml b/src/predefSemantics.ml
index d619b144..93915f87 100644
--- a/src/predefSemantics.ml
+++ b/src/predefSemantics.ml
@@ -1,10 +1,10 @@
-(** Time-stamp: <modified the 14/04/2008 (at 17:58) by Erwan Jahier> *)
+(** Time-stamp: <modified the 20/05/2008 (at 09:44) by Erwan Jahier> *)
open Predef
open SyntaxTreeCore
open CompiledData
-
+open Lxm
(* exported *)
type 'a evaluator = 'a list list -> 'a list
@@ -18,10 +18,15 @@ exception EvalConst_error of string
exception EvalType_error of string
let (type_error : type_eff list -> string -> 'a) =
- fun v expect ->
- raise (EvalType_error(
- "type mismatch"^(if expect = "" then "" else (expect^" expected"))))
-
+ fun tel expect ->
+ let str_l = List.map CompiledDataDump.string_of_type_eff tel in
+ let str_provided = String.concat "*" str_l in
+ raise (EvalType_error(
+ ("\n*** type '" ^ str_provided ^ "' was provided" ^
+ (if expect = "" then ""
+ else (" whereas\n*** type '" ^expect^"' was expected")))))
+
+
let arity_error (v : 'a list) (expect : string) =
raise (EvalType_error(
Printf.sprintf "arity error (%d arguments, whereas %s were expected)"
@@ -157,9 +162,33 @@ let (boolred_typer : typer) =
(List.flatten ceff_ll)
in
[Bool_type_eff]
-
+
+
+
+let (mapred_typer : static_arg_eff list -> typer) =
+ fun sargs teff_ll ->
+ (* Given a list of type [tau;tau_1;...;tau_n] and an integer c,
+ returns the list of types [tau; tau_1^c;...; tau_n^c] *)
+ let teff_l = List.flatten teff_ll in
+ let type_to_array_type l c = (* builds the tau_i^c from the tau_i *)
+ assert (l<>[]);
+ (List.hd l)::(List.map (fun t -> Array_type_eff(t,c)) (List.tl l))
+ in
+ match sargs with
+ | [NodeStaticArgEff(_,n);ConstStaticArgEff(_,Int_const_eff c)] ->
+ let (lti,lto) = CompiledData.profile_of_node_exp_eff n in
+ let lti_power_c = type_to_array_type lti c in
+ if lti_power_c = teff_l then type_to_array_type lto c
+ else
+ let str_l =
+ List.map CompiledDataDump.string_of_type_eff lti_power_c
+ in
+ type_error teff_l (String.concat "*" str_l)
+ | _ -> assert false
+
(* exported *)
-let (type_eval: op -> typer) = function
+let (type_eval: op -> static_arg_eff list -> typer) =
+ fun op sargs -> match op with
| TRUE_n
| FALSE_n -> sb_typer
| ICONST_n id -> si_typer id
@@ -198,6 +227,12 @@ let (type_eval: op -> typer) = function
| NOR_n
| DIESE_n -> boolred_typer
+ | Map -> assert false
+ | Fill -> assert false
+ | Red -> assert false
+ | MapRed -> mapred_typer sargs
+ | BoolRed -> boolred_typer
+
(*********************************************************************************)
let (bbb_evaluator:(bool -> bool -> bool) -> const_evaluator) =
@@ -299,11 +334,11 @@ let (boolred_evaluator : int -> const_evaluator) =
(* exported *)
-let (const_eval: op -> const_evaluator) =
- fun op ll ->
+let (const_eval: op -> static_arg_eff list -> const_evaluator) =
+ fun op sargs ll ->
(* we first check the type so that we do not need to check it during the const
evaluation *)
- ignore (type_eval op (List.map (List.map type_of_const_eff) ll));
+ ignore (type_eval op sargs (List.map (List.map type_of_const_eff) ll));
match op with
| TRUE_n -> sb_evaluator true ll
| FALSE_n -> sb_evaluator false ll
@@ -342,6 +377,11 @@ let (const_eval: op -> const_evaluator) =
| RTIMES_n -> fff_evaluator ( *.) ll
| NOR_n -> boolred_evaluator 0 ll
| DIESE_n -> boolred_evaluator 1 ll
+ | Map -> assert false
+ | Fill -> assert false
+ | Red -> assert false
+ | MapRed -> assert false
+ | BoolRed -> boolred_evaluator 1 ll
(*********************************************************************************)
let finish_me msg =
diff --git a/src/predefSemantics.mli b/src/predefSemantics.mli
index 6224e4ee..8c5f9fe0 100644
--- a/src/predefSemantics.mli
+++ b/src/predefSemantics.mli
@@ -1,4 +1,4 @@
-(** Time-stamp: <modified the 14/04/2008 (at 17:59) by Erwan Jahier> *)
+(** Time-stamp: <modified the 19/05/2008 (at 14:55) by Erwan Jahier> *)
(**
As far as predefined operators are concerned, typing, clock checking, and constant
@@ -34,14 +34,20 @@ type clocker = clock_eff evaluator
exception EvalConst_error of string
exception EvalType_error of string
-(* that says how to statically evaluate constants *)
-val const_eval: Predef.op -> const_evaluator
+(* That function says how to statically evaluate constants *)
+val const_eval:
+ Predef.op -> CompiledData.static_arg_eff list -> const_evaluator
-(* provides the type profile of predef operators *)
-val type_eval: Predef.op -> typer
+(* Provides the type profile of predef operators. More precisely, given an operator
+ and a list of types, This function checks that the provided types are ok, and
+ returns the list of the operator output types.
+*)
+val type_eval:
+ Predef.op -> CompiledData.static_arg_eff list -> typer
val type_error_const : const_eff list -> string -> 'a
val type_error : type_eff list -> string -> 'a
val arity_error_const : const_eff list -> string -> 'a
val arity_error : type_eff list -> string -> 'a
+
diff --git a/src/syntaxTab.ml b/src/syntaxTab.ml
index 45111fa3..9e54d80a 100644
--- a/src/syntaxTab.ml
+++ b/src/syntaxTab.ml
@@ -1,4 +1,4 @@
-(** Time-stamp: <modified the 16/05/2008 (at 10:20) by Erwan Jahier> *)
+(** Time-stamp: <modified the 16/05/2008 (at 11:04) by Erwan Jahier> *)
(**
Table des infos sources : une couche au dessus de SyntaxTree pour mieux
@@ -24,7 +24,6 @@ open Lxm
open SyntaxTree
open SyntaxTreeCore
open Errors
-open SyntaxTabUtils
(** Package manager
@@ -122,7 +121,7 @@ let init_user_items (this: pack_mng) = (
(** Exportation D'une const_info *)
let export_const (s:Ident.t) (xci: SyntaxTreeCore.const_info srcflagged) =
Verbose.printf " export const %s\n" (Ident.to_string s);
- put_in_tab "const" this.pm_user_items
+ SyntaxTabUtils.put_in_tab "const" this.pm_user_items
(ConstItem s)
(Lxm.flagit (Ident.make_long pname s) xci.src)
in
@@ -137,7 +136,7 @@ let init_user_items (this: pack_mng) = (
let s = ec.it in
let lxm = ec.src in
Verbose.printf " export enum const %s\n" (Ident.to_string s);
- put_in_tab "const" this.pm_user_items
+ SyntaxTabUtils.put_in_tab "const" this.pm_user_items
(ConstItem s)
(Lxm.flagit (Ident.make_long pname s) lxm)
in
@@ -150,7 +149,7 @@ let init_user_items (this: pack_mng) = (
-> ()
);
Verbose.printf " export type %s\n" (Ident.to_string s);
- put_in_tab "type" this.pm_user_items
+ SyntaxTabUtils.put_in_tab "type" this.pm_user_items
(TypeItem s)
(Lxm.flagit (Ident.make_long pname s) xti.src)
in
@@ -158,7 +157,7 @@ let init_user_items (this: pack_mng) = (
(** Exportation D'un node_info *)
let export_node (s: Ident.t) (xoi: SyntaxTreeCore.node_info srcflagged) =
Verbose.printf " export node %s\n" (Ident.to_string s);
- put_in_tab "node" this.pm_user_items
+ SyntaxTabUtils.put_in_tab "node" this.pm_user_items
(NodeItem (s,xoi.it.static_params))
(Lxm.flagit (Ident.make_long pname s) xoi.src)
in
@@ -266,12 +265,12 @@ let rec (create : SyntaxTree.pack_or_model list -> t) =
| SyntaxTree.NSPack pi ->
let lxm = pi.Lxm.src in
let nme = (Ident.pack_name_of_string (Lxm.str lxm)) in
- put_in_tab "package" this.st_raw_pack_tab nme pi
+ SyntaxTabUtils.put_in_tab "package" this.st_raw_pack_tab nme pi
| SyntaxTree.NSModel mi -> (* cas d'un modele *)
let lxm = mi.Lxm.src in
let nme = (Lxm.id lxm) in
- put_in_tab "model" this.st_raw_mod_tab nme mi
+ SyntaxTabUtils.put_in_tab "model" this.st_raw_mod_tab nme mi
in
List.iter treat_ns sl
and
diff --git a/src/syntaxTreeCore.ml b/src/syntaxTreeCore.ml
index 3c33819e..fcd7129b 100644
--- a/src/syntaxTreeCore.ml
+++ b/src/syntaxTreeCore.ml
@@ -1,4 +1,4 @@
-(** Time-stamp: <modified the 18/04/2008 (at 15:24) by Erwan Jahier> *)
+(** Time-stamp: <modified the 19/05/2008 (at 17:28) by Erwan Jahier> *)
(** (Raw) Abstract syntax tree of source programs. *)
@@ -86,7 +86,7 @@ and slice_info = {
and by_pos_op =
(* zeroaire *)
- | Predef of Predef.op
+ | Predef of Predef.op * static_arg srcflagged list
| CALL_n of node_exp srcflagged
| IDENT_n of Ident.idref
@@ -107,7 +107,6 @@ and by_pos_op =
| ARRAY_ACCES_n of val_exp
| ARRAY_SLICE_n of slice_info
| MERGE_n of (Ident.t * (Ident.t list))
- | ITERATOR_n of (Ident.t * Ident.t * val_exp) (* iter name, node name, array size *)
(************************************************)
diff --git a/src/syntaxTreeDump.ml b/src/syntaxTreeDump.ml
index 67cdb0e9..1d07c618 100644
--- a/src/syntaxTreeDump.ml
+++ b/src/syntaxTreeDump.ml
@@ -1,4 +1,4 @@
-(** Time-stamp: <modified the 27/03/2008 (at 15:37) by Erwan Jahier> *)
+(** Time-stamp: <modified the 20/05/2008 (at 09:55) by Erwan Jahier> *)
open Lxm
@@ -10,11 +10,20 @@ open Format
(***********************************************************************************)
(* exported *)
+let static_arg_to_string arg =
+ match arg.it with
+ | StaticArgIdent id -> Ident.string_of_idref id
+ | StaticArgConst ve -> "const xxx"
+ | StaticArgType te -> "type xxx"
+ | StaticArgNode ne -> "node xxx"
+
let (op2string : SyntaxTreeCore.by_pos_op -> string) =
fun op ->
match op with
(* unaires *)
- | Predef op -> Predef.op2string op
+ | Predef(op,sargs) -> (Predef.op2string op) ^
+ (if sargs = [] then "" else
+ "<<" ^ (String.concat ", " (List.map static_arg_to_string sargs)) ^ ">>")
| (PRE_n ) -> "pre"
| (CURRENT_n) -> "current"
(* binaires *)
@@ -31,8 +40,7 @@ let (op2string : SyntaxTreeCore.by_pos_op -> string) =
| (ARRAY_ACCES_n _ ) -> assert false
| (ARRAY_SLICE_n sl) -> assert false
| (STRUCT_ACCESS_n fld) -> assert false
- | ITERATOR_n _ -> assert false
- | MERGE_n _ -> assert false
+ | (MERGE_n _) -> assert false
(***********************************************************************************)
@@ -361,54 +369,54 @@ and dump_val_exp_list (os : formatter) (xl: val_exp list) = (
and dump_by_pos_exp (os: Format.formatter) (oper: by_pos_op) (pars: operands) =
(
match (oper, pars) with
- (Predef TRUE_n, Oper []) -> dump_leaf_exp os "true"
- | (Predef FALSE_n, Oper []) -> dump_leaf_exp os "false"
- | (Predef (ICONST_n s), Oper []) -> dump_leaf_exp os (Ident.to_string s)
- | (Predef (RCONST_n s), Oper []) -> dump_leaf_exp os (Ident.to_string s)
+ (Predef (TRUE_n,_), Oper []) -> dump_leaf_exp os "true"
+ | (Predef (FALSE_n,_), Oper []) -> dump_leaf_exp os "false"
+ | (Predef (ICONST_n s, _), Oper []) -> dump_leaf_exp os (Ident.to_string s)
+ | (Predef (RCONST_n s, _), Oper []) -> dump_leaf_exp os (Ident.to_string s)
| (IDENT_n id,Oper []) -> dump_leaf_exp os (Ident.string_of_idref id)
(* unaires *)
- | (Predef NOT_n, Oper [p0]) -> dump_unary_exp os "not" p0
- | (Predef UMINUS_n, Oper [p0]) -> dump_unary_exp os "-" p0
- | (Predef RUMINUS_n, Oper [p0]) -> dump_unary_exp os "-" p0
- | (Predef IUMINUS_n, Oper [p0]) -> dump_unary_exp os "-" p0
+ | (Predef (NOT_n,_), Oper [p0]) -> dump_unary_exp os "not" p0
+ | (Predef (UMINUS_n,_), Oper [p0]) -> dump_unary_exp os "-" p0
+ | (Predef (RUMINUS_n,_), Oper [p0]) -> dump_unary_exp os "-" p0
+ | (Predef (IUMINUS_n,_), Oper [p0]) -> dump_unary_exp os "-" p0
| (PRE_n, Oper [p0]) -> dump_unary_exp os "pre" p0
| (CURRENT_n, Oper [p0]) -> dump_unary_exp os "current" p0
- | (Predef REAL2INT_n, Oper [p0]) -> dump_unary_exp os "int" p0
- | (Predef INT2REAL_n, Oper [p0]) -> dump_unary_exp os "real" p0
+ | (Predef (REAL2INT_n,_), Oper [p0]) -> dump_unary_exp os "int" p0
+ | (Predef (INT2REAL_n,_), Oper [p0]) -> dump_unary_exp os "real" p0
(* binaires *)
| (ARROW_n, Oper [p0;p1]) -> dump_binary_exp os "->" p0 p1
| (FBY_n, Oper [p0;p1]) -> dump_binary_exp os "fby" p0 p1
| (WHEN_n, Oper [p0;p1]) -> dump_binary_exp os "when" p0 p1
- | (Predef AND_n, Oper [p0;p1]) -> dump_binary_exp os "and" p0 p1
- | (Predef OR_n, Oper [p0;p1]) -> dump_binary_exp os "or" p0 p1
- | (Predef XOR_n, Oper [p0;p1]) -> dump_binary_exp os "xor" p0 p1
- | (Predef IMPL_n, Oper [p0;p1]) -> dump_binary_exp os "=>" p0 p1
- | (Predef EQ_n, Oper [p0;p1]) -> dump_binary_exp os "=" p0 p1
- | (Predef NEQ_n, Oper [p0;p1]) -> dump_binary_exp os "<>" p0 p1
- | (Predef LT_n, Oper [p0;p1]) -> dump_binary_exp os "<" p0 p1
- | (Predef LTE_n, Oper [p0;p1]) -> dump_binary_exp os "<=" p0 p1
- | (Predef GT_n, Oper [p0;p1]) -> dump_binary_exp os ">" p0 p1
- | (Predef GTE_n, Oper [p0;p1]) -> dump_binary_exp os ">=" p0 p1
- | (Predef DIV_n, Oper [p0;p1]) -> dump_binary_exp os "div" p0 p1
- | (Predef MOD_n, Oper [p0;p1]) -> dump_binary_exp os "mod" p0 p1
- | (Predef MINUS_n, Oper [p0]) -> dump_unary_exp os "-" p0
- | (Predef RMINUS_n, Oper [p0]) -> dump_unary_exp os "-" p0
- | (Predef IMINUS_n, Oper [p0]) -> dump_unary_exp os "-" p0
- | (Predef PLUS_n, Oper [p0;p1]) -> dump_binary_exp os "+" p0 p1
- | (Predef RPLUS_n, Oper [p0;p1]) -> dump_binary_exp os "+" p0 p1
- | (Predef IPLUS_n, Oper [p0;p1]) -> dump_binary_exp os "+" p0 p1
- | (Predef SLASH_n, Oper [p0;p1]) -> dump_binary_exp os "/" p0 p1
- | (Predef RSLASH_n, Oper [p0;p1]) -> dump_binary_exp os "/" p0 p1
- | (Predef ISLASH_n, Oper [p0;p1]) -> dump_binary_exp os "/" p0 p1
- | (Predef TIMES_n, Oper [p0;p1]) -> dump_binary_exp os "*" p0 p1
- | (Predef RTIMES_n, Oper [p0;p1]) -> dump_binary_exp os "*" p0 p1
- | (Predef ITIMES_n, Oper [p0;p1]) -> dump_binary_exp os "*" p0 p1
+ | (Predef (AND_n,_), Oper [p0;p1]) -> dump_binary_exp os "and" p0 p1
+ | (Predef (OR_n,_), Oper [p0;p1]) -> dump_binary_exp os "or" p0 p1
+ | (Predef (XOR_n,_), Oper [p0;p1]) -> dump_binary_exp os "xor" p0 p1
+ | (Predef (IMPL_n,_), Oper [p0;p1]) -> dump_binary_exp os "=>" p0 p1
+ | (Predef (EQ_n,_), Oper [p0;p1]) -> dump_binary_exp os "=" p0 p1
+ | (Predef (NEQ_n,_), Oper [p0;p1]) -> dump_binary_exp os "<>" p0 p1
+ | (Predef (LT_n,_), Oper [p0;p1]) -> dump_binary_exp os "<" p0 p1
+ | (Predef (LTE_n,_), Oper [p0;p1]) -> dump_binary_exp os "<=" p0 p1
+ | (Predef (GT_n,_), Oper [p0;p1]) -> dump_binary_exp os ">" p0 p1
+ | (Predef (GTE_n,_), Oper [p0;p1]) -> dump_binary_exp os ">=" p0 p1
+ | (Predef (DIV_n,_), Oper [p0;p1]) -> dump_binary_exp os "div" p0 p1
+ | (Predef (MOD_n,_), Oper [p0;p1]) -> dump_binary_exp os "mod" p0 p1
+ | (Predef (MINUS_n,_), Oper [p0]) -> dump_unary_exp os "-" p0
+ | (Predef (RMINUS_n,_), Oper [p0]) -> dump_unary_exp os "-" p0
+ | (Predef (IMINUS_n,_), Oper [p0]) -> dump_unary_exp os "-" p0
+ | (Predef (PLUS_n,_), Oper [p0;p1]) -> dump_binary_exp os "+" p0 p1
+ | (Predef (RPLUS_n,_), Oper [p0;p1]) -> dump_binary_exp os "+" p0 p1
+ | (Predef (IPLUS_n,_), Oper [p0;p1]) -> dump_binary_exp os "+" p0 p1
+ | (Predef (SLASH_n,_), Oper [p0;p1]) -> dump_binary_exp os "/" p0 p1
+ | (Predef (RSLASH_n,_), Oper [p0;p1]) -> dump_binary_exp os "/" p0 p1
+ | (Predef (ISLASH_n,_), Oper [p0;p1]) -> dump_binary_exp os "/" p0 p1
+ | (Predef (TIMES_n,_), Oper [p0;p1]) -> dump_binary_exp os "*" p0 p1
+ | (Predef (RTIMES_n,_), Oper [p0;p1]) -> dump_binary_exp os "*" p0 p1
+ | (Predef (ITIMES_n,_), Oper [p0;p1]) -> dump_binary_exp os "*" p0 p1
| (HAT_n, Oper [p0;p1]) -> dump_binary_exp os "^" p0 p1
| (CONCAT_n, Oper [p0;p1]) -> dump_binary_exp os "|" p0 p1
- | (Predef IF_n, Oper [p0;p1;p2]) -> dump_ternary_exp os "if" "then" "else" p0 p1 p2
+ | (Predef (IF_n,_), Oper [p0;p1;p2]) -> dump_ternary_exp os "if" "then" "else" p0 p1 p2
| (WITH_n, Oper [p0;p1;p2]) -> dump_ternary_exp os "with" "then" "else" p0 p1 p2
- | (Predef NOR_n, Oper pl) -> dump_nary_exp os "nor" pl
- | (Predef DIESE_n, Oper pl) -> dump_nary_exp os "#" pl
+ | (Predef (NOR_n,_), Oper pl) -> dump_nary_exp os "nor" pl
+ | (Predef (DIESE_n,_), Oper pl) -> dump_nary_exp os "#" pl
| (TUPLE_n, Oper pl) -> dump_nary_exp os "" pl
| (CALL_n s, Oper pl) -> fprintf os "%a(@,%a@,)"
dump_node_exp s.it dump_val_exp_list pl
@@ -420,8 +428,8 @@ and dump_by_pos_exp (os: Format.formatter) (oper: by_pos_op) (pars: operands) =
| (STRUCT_ACCESS_n fld, Oper [p0]) -> fprintf os "%a.%s"
dump_val_exp p0 (Ident.to_string fld)
- | (Predef _,_) -> assert false
- | (ITERATOR_n _, _) -> assert false
+ | (Predef (_,_),_) -> assert false
+(* | (ITERATOR_n _, _) -> assert false *)
| (MERGE_n _,_) -> assert false
| (FBY_n, _) -> assert false
diff --git a/src/syntaxTreeDump.mli b/src/syntaxTreeDump.mli
index e2a79469..b48fe992 100644
--- a/src/syntaxTreeDump.mli
+++ b/src/syntaxTreeDump.mli
@@ -1,4 +1,4 @@
-(** Time-stamp: <modified the 12/03/2008 (at 14:19) by Erwan Jahier> *)
+(** Time-stamp: <modified the 19/05/2008 (at 11:05) by Erwan Jahier> *)
(** Pretty-printing the internal structure *)
@@ -13,3 +13,4 @@ val op2string : SyntaxTreeCore.by_pos_op -> string
(**/**)
val dump_val_exp : Format.formatter -> SyntaxTreeCore.val_exp -> unit
val dump_type_exp : Format.formatter -> SyntaxTreeCore.type_exp -> unit
+val dump_static_arg : Format.formatter -> SyntaxTreeCore.static_arg -> unit
diff --git a/src/test/should_work/NONREG/Int.lus b/src/test/should_work/NONREG/Int.lus
index 0be7a8c8..8ffaddb9 100644
--- a/src/test/should_work/NONREG/Int.lus
+++ b/src/test/should_work/NONREG/Int.lus
@@ -14,7 +14,7 @@ model Int
function incr (x: Int) returns (incr: Int);
var co: bool;
let
- (incr,co) = map_red<<fulladd,n>>(true,x,zero);
+ (co, incr) = map_red<<fulladd,n>>(true,x,zero);
tel
function fulladd(ci, x, y: bool) returns (s, co: bool);
@@ -26,7 +26,7 @@ model Int
function add (x,y: Int) returns (sum: Int);
var co: bool;
let
- (sum, co) = map_red<<fulladd,n>>(false,x,y);
+ (co, sum) = map_red<<fulladd,n>>(false,x,y);
tel
end
@@ -42,11 +42,11 @@ uses Int8;
provides
node Nat(evt, reset: bool) returns (nat: Int8::Int);
body
- node Nat(evt, reset: bool) returns (nat: Int8::Int);
- let
- nat = if true -> reset then Int8::zero
- else if evt then Int8::incr(pre(nat))
- else pre(nat);
- tel
+ node Nat(evt, reset: bool) returns (nat: Int8::Int);
+ let
+ nat = if true -> reset then Int8::zero else
+ if evt then Int8::incr(pre(nat))
+ else pre(nat);
+ tel
end
diff --git a/src/test/should_work/demo/map_red_iter.lus b/src/test/should_work/demo/map_red_iter.lus
index 95ae6dce..e312302f 100644
--- a/src/test/should_work/demo/map_red_iter.lus
+++ b/src/test/should_work/demo/map_red_iter.lus
@@ -44,7 +44,8 @@ type T_InfoGenGlob = {
type T_ComChg = int;
-node traite_genCore_itere(acc_in : int; elt1 : bool; elt2 : int) returns (acc_out : int; elt : int);
+node traite_genCore_itere(acc_in : int; elt1 : bool; elt2 : int)
+returns (acc_out : int; elt : int);
let
elt = if(elt1)
then elt2
diff --git a/src/test/test.res.exp b/src/test/test.res.exp
index bbb958ef..9a283139 100644
--- a/src/test/test.res.exp
+++ b/src/test/test.res.exp
@@ -66,7 +66,40 @@ type Int8__Int = bool^8;
Exported constants:
const Int8__zero = [false, false, false, false, false, false, false, false];
Exported nodes:
-*** Error in file "should_work/NONREG/Int.lus", line 17, col 14 to 20, token 'map_red': unknown node (map_red)
+
+function Int8__fulladd(
+ ci:bool;
+ x:bool;
+ y:bool)
+returns (
+ s:bool;
+ co:bool);
+let
+ s = (ci xor (x xor y));
+ co = (((ci and x) or (x and y)) or (y and ci));
+tel
+-- end of node Int8__fulladd
+function Int8__incr(x:bool^8) returns (incr:bool^8);
+var
+ co:bool;
+let
+ (co, incr) = map_red<<node Int8__fulladd, const 8>>(true, x, zero);
+tel
+-- end of node Int8__incr
+function Int8__add(x:bool^8; y:bool^8) returns (sum:bool^8);
+var
+ co:bool;
+let
+ (co, sum) = map_red<<node Int8__fulladd, const 8>>(false, x, y);
+tel
+-- end of node Int8__add
+ * package mainPack
+ Exported types:
+ Exported constants:
+ Exported nodes:
+*** Error in file "should_work/NONREG/Int.lus", line 47, col 10 to 11, token 'if': type error:
+*** type 'bool*bool^8*Int8__Int' was provided whereas
+*** type 'bool*any*any' was expected
----------------------------------------------------------------------
@@ -5165,7 +5198,7 @@ type inter__selType = {i : int; b : bool; r : real};
XXX evalType.ml:anonymous struct not yet supported -> finish me!
-*** oops: an internal error occurred in file evalType.ml, line 156, column 3
+*** oops: an internal error occurred in file evalType.ml, line 155, column 3
*** when compiling lustre program should_work/Pascal/newpacks.lus
----------------------------------------------------------------------
@@ -5806,7 +5839,7 @@ type inter__selType = {i : int; b : bool; r : real};
XXX evalType.ml:anonymous struct not yet supported -> finish me!
-*** oops: an internal error occurred in file evalType.ml, line 156, column 3
+*** oops: an internal error occurred in file evalType.ml, line 155, column 3
*** when compiling lustre program should_work/Pascal/p.lus
----------------------------------------------------------------------
@@ -5907,7 +5940,7 @@ type inter__selType = {i : int; b : bool; r : real};
XXX evalType.ml:anonymous struct not yet supported -> finish me!
-*** oops: an internal error occurred in file evalType.ml, line 156, column 3
+*** oops: an internal error occurred in file evalType.ml, line 155, column 3
*** when compiling lustre program should_work/Pascal/packs.lus
----------------------------------------------------------------------
@@ -6859,8 +6892,6 @@ type filliter__t = int^5;
Exported constants:
const filliter__NBC = 3;
Exported nodes:
-*** Error in file "should_work/demo/filliter.lus", line 26, col 15 to 18, token 'fill': unknown node (fill)
-
node filliter__copie(acc_in:int) returns (acc_out:int; elt:int);
let
acc_out = acc_in;
@@ -6868,6 +6899,12 @@ let
tel
-- end of node filliter__copie
+ XXX getEff.ml:
+ XXX fill -> finish me!
+
+*** oops: an internal error occurred in file getEff.ml, line 244, column 39
+*** when compiling lustre program should_work/demo/filliter.lus
+
----------------------------------------------------------------------
====> ../lus2lic -vl 3 --compile-all-items should_work/demo/filter.lus
Opening file should_work/demo/filter.lus
@@ -7048,8 +7085,6 @@ type map_red_iter__T_InfoChgIndiv = {mesure_chg : int};
type map_red_iter__T_InfoGenGlob = {elt_bidon : int; chg2gen : int^20};
Exported constants:
Exported nodes:
-*** Error in file "should_work/demo/map_red_iter.lus", line 63, col 23 to 29, token 'map_red': unknown node (map_red)
-
node map_red_iter__traite_genCore_itere(
acc_in:int;
@@ -7064,6 +7099,23 @@ let
tel
-- end of node map_red_iter__traite_genCore_itere
+node map_red_iter__map_red_iter(
+ indice_gen:int;
+ InfoGenIndiv: {mesure_gen : int};
+ InfoGenGlob: {elt_bidon : int;
+ chg2gen : int^20};
+ TabEtatCharge:int^20;
+ TabComVal:bool^20)
+returns (
+ TabComChg:int^20);
+var
+ bidon:int;
+let
+ (bidon, TabComChg) = map_red<<node map_red_iter__traite_genCore_itere,
+ const 20>>(indice_gen, TabComVal, InfoGenGlob.chg2gen);
+tel
+-- end of node map_red_iter__map_red_iter
+
----------------------------------------------------------------------
====> ../lus2lic -vl 3 --compile-all-items should_work/demo/mapdeRed.lus
Opening file should_work/demo/mapdeRed.lus
@@ -7095,14 +7147,18 @@ End of Syntax table dump.
Exported types:
Exported constants:
Exported nodes:
-*** Error in file "should_work/demo/mapiter.lus", line 9, col 14 to 16, token 'map': unknown node (map)
-
node mapiter__incr_tab(a:int) returns (b:int);
let
b = (a + 1);
tel
-- end of node mapiter__incr_tab
+ XXX getEff.ml:
+ XXX map -> finish me!
+
+*** oops: an internal error occurred in file getEff.ml, line 243, column 38
+*** when compiling lustre program should_work/demo/mapiter.lus
+
----------------------------------------------------------------------
====> ../lus2lic -vl 3 --compile-all-items should_work/demo/mapiter_lv4.lus
Opening file should_work/demo/mapiter_lv4.lus
@@ -7224,14 +7280,18 @@ End of Syntax table dump.
Exported types:
Exported constants:
Exported nodes:
-*** Error in file "should_work/demo/rediter.lus", line 8, col 7 to 9, token 'red': unknown node (red)
-
node rediter__max(init:int; a:int) returns (b:int);
let
b = if ((init > a)) then (init) else (a);
tel
-- end of node rediter__max
+ XXX getEff.ml:
+ XXX red -> finish me!
+
+*** oops: an internal error occurred in file getEff.ml, line 245, column 38
+*** when compiling lustre program should_work/demo/rediter.lus
+
----------------------------------------------------------------------
====> ../lus2lic -vl 3 --compile-all-items should_work/demo/redoptest.lus
Opening file should_work/demo/redoptest.lus
@@ -7483,8 +7543,12 @@ End of Syntax table dump.
Exported constants:
const iter__n = 5;
Exported nodes:
-*** Error in file "should_work/fab_test/iter.lus", line 8, col 19 to 22, token 'fill': unknown node (fill)
+ XXX getEff.ml:
+ XXX fill -> finish me!
+
+*** oops: an internal error occurred in file getEff.ml, line 244, column 39
+*** when compiling lustre program should_work/fab_test/iter.lus
----------------------------------------------------------------------
====> ../lus2lic -vl 3 --compile-all-items should_work/fab_test/iterate.lus
@@ -7514,8 +7578,12 @@ End of Syntax table dump.
Exported types:
Exported constants:
Exported nodes:
-*** Error in file "should_work/fab_test/iterate.lus", line 13, col 24 to 26, token 'map': unknown node (map)
+ XXX getEff.ml:
+ XXX map -> finish me!
+
+*** oops: an internal error occurred in file getEff.ml, line 243, column 38
+*** when compiling lustre program should_work/fab_test/iterate.lus
----------------------------------------------------------------------
====> ../lus2lic -vl 3 --compile-all-items should_work/fab_test/lecteur.lus
@@ -7917,7 +7985,7 @@ type morel4__arrayi = int^2^3;
Warning. in file "should_work/fab_test/morel4.lus", line 33, col 17 to 17, token ',':
---> separator mismatch, ';' expected
-*** oops: an internal error occurred in file evalType.ml, line 156, column 3
+*** oops: an internal error occurred in file evalType.ml, line 155, column 3
*** when compiling lustre program should_work/fab_test/morel4.lus
----------------------------------------------------------------------
@@ -7995,7 +8063,7 @@ tel
XXX evalType.ml:anonymous struct not yet supported -> finish me!
-*** oops: an internal error occurred in file evalType.ml, line 156, column 3
+*** oops: an internal error occurred in file evalType.ml, line 155, column 3
*** when compiling lustre program should_work/fab_test/morel5.lus
----------------------------------------------------------------------
@@ -9422,8 +9490,6 @@ End of Syntax table dump.
Exported types:
Exported constants:
Exported nodes:
-*** Error in file "should_work/lionel/FillFollowedByRed.lus", line 35, col 23 to 26, token 'fill': unknown node (fill)
-
node FillFollowedByRed__reduced(
acc_in:bool;
@@ -9446,6 +9512,12 @@ let
tel
-- end of node FillFollowedByRed__filled
+ XXX getEff.ml:
+ XXX fill -> finish me!
+
+*** oops: an internal error occurred in file getEff.ml, line 244, column 39
+*** when compiling lustre program should_work/lionel/FillFollowedByRed.lus
+
----------------------------------------------------------------------
====> ../lus2lic -vl 3 --compile-all-items should_work/lionel/Gyroscope.lus
Opening file should_work/lionel/Gyroscope.lus
@@ -9495,8 +9567,12 @@ type produitBool__Tacc_inShift2 = {multiplieur : bool^10; rank : int; actual_ra
type produitBool__Tacc_inShift = {acc_in_PLC : {multiplieur : bool^10; rank : int}; actual_rank : int};
Exported constants:
Exported nodes:
-*** Error in file "should_work/lionel/ProduitBool/produitBool.lus", line 41, col 13 to 15, token 'red': unknown node (red)
+ XXX getEff.ml:
+ XXX red -> finish me!
+
+*** oops: an internal error occurred in file getEff.ml, line 245, column 38
+*** when compiling lustre program should_work/lionel/ProduitBool/produitBool.lus
----------------------------------------------------------------------
====> ../lus2lic -vl 3 --compile-all-items should_work/lionel/ProduitBool/shiftFill_ludic.lus
@@ -9548,8 +9624,12 @@ type shiftFill_ludic__t_iteratedStruct = {currentRank : int; rankToSelect : int
Exported constants:
const shiftFill_ludic__c_size = 10;
Exported nodes:
-*** Error in file "should_work/lionel/ProduitBool/shiftFill_ludic.lus", line 42, col 24 to 26, token 'red': unknown node (red)
+ XXX getEff.ml:
+ XXX red -> finish me!
+
+*** oops: an internal error occurred in file getEff.ml, line 245, column 38
+*** when compiling lustre program should_work/lionel/ProduitBool/shiftFill_ludic.lus
----------------------------------------------------------------------
====> ../lus2lic -vl 3 --compile-all-items should_work/lionel/ProduitBool/shift_ludic.lus
@@ -9604,8 +9684,12 @@ type shift_ludic__t_iteratedStruct = {currentRank : int; rankToSelect : int; el
Exported constants:
const shift_ludic__c_size = 10;
Exported nodes:
-*** Error in file "should_work/lionel/ProduitBool/shift_ludic.lus", line 68, col 25 to 28, token 'fill': unknown node (fill)
+ XXX getEff.ml:
+ XXX fill -> finish me!
+
+*** oops: an internal error occurred in file getEff.ml, line 244, column 39
+*** when compiling lustre program should_work/lionel/ProduitBool/shift_ludic.lus
----------------------------------------------------------------------
====> ../lus2lic -vl 3 --compile-all-items should_work/lionel/arrays.lus
@@ -9652,7 +9736,7 @@ type calculs_max__struct_max = {max1 : int; max2 : int; imax1 : int; imax2 : in
XXX evalType.ml:anonymous struct not yet supported -> finish me!
-*** oops: an internal error occurred in file evalType.ml, line 156, column 3
+*** oops: an internal error occurred in file evalType.ml, line 155, column 3
*** when compiling lustre program should_work/lionel/calculs_max.lus
----------------------------------------------------------------------
@@ -9691,7 +9775,7 @@ type deSimone__cell_accu = {token : bool; grant : bool};
XXX evalType.ml:anonymous struct not yet supported -> finish me!
-*** oops: an internal error occurred in file evalType.ml, line 156, column 3
+*** oops: an internal error occurred in file evalType.ml, line 155, column 3
*** when compiling lustre program should_work/lionel/deSimone.lus
----------------------------------------------------------------------
@@ -9721,8 +9805,12 @@ End of Syntax table dump.
type iterFibo__T_fibo = int^2;
Exported constants:
Exported nodes:
-*** Error in file "should_work/lionel/iterFibo.lus", line 14, col 14 to 17, token 'fill': unknown node (fill)
+ XXX getEff.ml:
+ XXX fill -> finish me!
+
+*** oops: an internal error occurred in file getEff.ml, line 244, column 39
+*** when compiling lustre program should_work/lionel/iterFibo.lus
----------------------------------------------------------------------
====> ../lus2lic -vl 3 --compile-all-items should_work/lionel/mapiter.lus
@@ -9780,7 +9868,7 @@ const moyenne__size = 10;
XXX evalType.ml:anonymous struct not yet supported -> finish me!
-*** oops: an internal error occurred in file evalType.ml, line 156, column 3
+*** oops: an internal error occurred in file evalType.ml, line 155, column 3
*** when compiling lustre program should_work/lionel/moyenne.lus
----------------------------------------------------------------------
@@ -9871,8 +9959,12 @@ const normal__EC_DELESTAGE = 4;
const normal__EC_ON = 0;
const normal__COM_ERR = 0;
Exported nodes:
-*** Error in file "should_work/lionel/normal.lus", line 139, col 27 to 29, token 'map': unknown node (map)
+ XXX getEff.ml:
+ XXX map -> finish me!
+
+*** oops: an internal error occurred in file getEff.ml, line 243, column 38
+*** when compiling lustre program should_work/lionel/normal.lus
----------------------------------------------------------------------
====> ../lus2lic -vl 3 --compile-all-items should_work/lionel/pipeline.lus
@@ -9901,8 +9993,6 @@ End of Syntax table dump.
Exported constants:
const pipeline__size = 10;
Exported nodes:
-*** Error in file "should_work/lionel/pipeline.lus", line 30, col 20 to 26, token 'map_red': unknown node (map_red)
-
node pipeline__oneStep_pipe(
accu_in:bool;
@@ -9915,6 +10005,13 @@ let
accu_out = elt_in;
tel
-- end of node pipeline__oneStep_pipe
+node pipeline__pipeline(in:bool^10) returns (out:bool^10);
+var
+ accu_out:bool;
+let
+ (accu_out, out) = map_red(true -> pre(accu_out), in);
+tel
+-- end of node pipeline__pipeline
----------------------------------------------------------------------
====> ../lus2lic -vl 3 --compile-all-items should_work/lionel/predefOp.lus
@@ -10022,8 +10119,12 @@ const testSilus__EC_DELESTAGE = 4;
const testSilus__EC_ON = 0;
const testSilus__COM_ERR = 0;
Exported nodes:
-*** Error in file "should_work/lionel/testSilus.lus", line 126, col 20 to 22, token 'map': unknown node (map)
+ XXX getEff.ml:
+ XXX map -> finish me!
+
+*** oops: an internal error occurred in file getEff.ml, line 243, column 38
+*** when compiling lustre program should_work/lionel/testSilus.lus
----------------------------------------------------------------------
====> ../lus2lic -vl 3 --compile-all-items should_work/lionel/triSel.lus
@@ -10072,7 +10173,7 @@ type triSel__Exchange_accu = {MinVal : int; MinRank : int; RankFrom : int; Curr
XXX evalType.ml:anonymous struct not yet supported -> finish me!
-*** oops: an internal error occurred in file evalType.ml, line 156, column 3
+*** oops: an internal error occurred in file evalType.ml, line 155, column 3
*** when compiling lustre program should_work/lionel/triSel.lus
----------------------------------------------------------------------
@@ -10115,7 +10216,7 @@ const contractForElementSelectionInArray__size = 10;
XXX evalType.ml:anonymous struct not yet supported -> finish me!
-*** oops: an internal error occurred in file evalType.ml, line 156, column 3
+*** oops: an internal error occurred in file evalType.ml, line 155, column 3
*** when compiling lustre program should_work/packEnvTest/contractForElementSelectionInArray/contractForElementSelectionInArray.lus
----------------------------------------------------------------------
@@ -10210,8 +10311,12 @@ type tri__sorted_iter_accu = {prev_elt : int; prop_is_tt : bool};
type tri__Exchange_accu = {MinVal : int; MinRank : int; RankFrom : int; CurrentVal : int; Rank : int};
Exported constants:
Exported nodes:
-*** Error in file "should_work/packEnvTest/contractForElementSelectionInArray/tri.lus", line 179, col 23 to 25, token 'red': unknown node (red)
+ XXX getEff.ml:
+ XXX red -> finish me!
+
+*** oops: an internal error occurred in file getEff.ml, line 245, column 38
+*** when compiling lustre program should_work/packEnvTest/contractForElementSelectionInArray/tri.lus
----------------------------------------------------------------------
====> ../lus2lic -vl 3 --compile-all-items should_work/packEnvTest/modelInst.lus
@@ -11175,5 +11280,6 @@ type const2__t6 = int^3^7^8^9^3;
type const2__t7 = int^3^7^8^9^3^8;
type const2__t8 = int^3^7^8^9^3^8^8;
Exported constants:
-*** Error in file "should_fail/type/const2.lus", line 16, col 12 to 13, token '<>': type error: type mismatch
+*** Error in file "should_fail/type/const2.lus", line 16, col 12 to 13, token '<>': type error:
+*** type 'int*real' was provided
--
GitLab