From 56eca725e87755878c816ad372dac1ff6c820d5d Mon Sep 17 00:00:00 2001
From: Erwan Jahier <jahier@imag.fr>
Date: Thu, 6 Mar 2008 14:55:13 +0100
Subject: [PATCH] nop
---
src/TODO | 2 +-
src/compiledData.ml | 3 +-
src/evalConst.ml | 135 ++++++------------
src/evalType.ml | 40 +++---
src/lazyCompiler.ml | 28 +++-
src/symbolTab.ml | 18 ++-
.../semantics}/const2.lus | 0
7 files changed, 97 insertions(+), 129 deletions(-)
rename src/test/{should_work/to_sort_out => should_fail/semantics}/const2.lus (100%)
diff --git a/src/TODO b/src/TODO
index 70e05dc8..a8cb90f7 100644
--- a/src/TODO
+++ b/src/TODO
@@ -114,7 +114,7 @@ nb2 : rejeter les noeuds sans memoire (ce faisant sans indiquer
alors rajouter l'option --infer-memoryless-annotation). Ou alors, on
se contente d'emmettre des warning.
-
+nb3 : function = memoryless node
diff --git a/src/compiledData.ml b/src/compiledData.ml
index e4aa0b72..4ba8bd20 100644
--- a/src/compiledData.ml
+++ b/src/compiledData.ml
@@ -1,4 +1,4 @@
-(** Time-stamp: <modified the 20/02/2008 (at 15:04) by Erwan Jahier> *)
+(** Time-stamp: <modified the 26/02/2008 (at 16:21) by Erwan Jahier> *)
(**
@@ -176,6 +176,7 @@ Type : eq_eff
----------------------------------------------------------------------*)
and eq_eff = {
eqf_left_list : left_eff list ;
+(* il manque la partie droite!!! *)
}
(*---------------------------------------------------------------------
Type : const_eff
diff --git a/src/evalConst.ml b/src/evalConst.ml
index 8f9bf2de..65ecdc93 100644
--- a/src/evalConst.ml
+++ b/src/evalConst.ml
@@ -1,4 +1,4 @@
-(** Time-stamp: <modified the 20/02/2008 (at 16:04) by Erwan Jahier> *)
+(** Time-stamp: <modified the 05/03/2008 (at 16:52) by Erwan Jahier> *)
open Printf
@@ -60,8 +60,8 @@ let op_computer (posop : predef_node) (src: Lxm.t)
= (
match args with
[Bool_const_eff v0; Bool_const_eff v1] -> [Bool_const_eff (f v0 v1)]
- | [x0; x1] -> (type_error [x0; x1] "bool*bool")
- | x -> (arity_error x "2" )
+ | [x0; x1] -> (type_error [x0; x1] "bool*bool")
+ | x -> (arity_error x "2" )
) in
(*----------------------------
le template pour tous les :
@@ -74,14 +74,14 @@ let op_computer (posop : predef_node) (src: Lxm.t)
= (
match args with
[Int_const_eff v0; Int_const_eff v1] -> [Int_const_eff (f v0 v1)]
- | [x0; x1] -> (type_error [x0; x1] "int*int")
- | x -> (arity_error x "2" )
+ | [x0; x1] -> (type_error [x0; x1] "int*int")
+ | x -> (arity_error x "2" )
) in
(*----------------------------
le template pour tous les :
num*num->bool
N.B. on est obligé de passer
- 2 "copie" du comparateur
+ 2 "copies" du comparateur
(fi pour int, fr pour float)
sinon caml ne peut pas typer ...
----------------------------*)
@@ -94,16 +94,16 @@ let op_computer (posop : predef_node) (src: Lxm.t)
match args with
[Int_const_eff v0; Int_const_eff v1] -> (
[Bool_const_eff (fi v0 v1)]
- ) |
- [Real_const_eff v0; Real_const_eff v1] -> (
+ )
+ | [Real_const_eff v0; Real_const_eff v1] -> (
let res = (fr v0 v1) in
warning src
(sprintf
"float in static exp: %f%s%f evaluated as %b" v0 nm v1 res);
[Bool_const_eff res]
- ) |
- [x0; x1] -> (type_error [x0; x1] "int*int or real*real")
- | x -> (arity_error x "2" )
+ )
+ | [x0; x1] -> (type_error [x0; x1] "int*int or real*real")
+ | x -> (arity_error x "2" )
) in
(*----------------------------
le template pour tous les :
@@ -116,18 +116,18 @@ let op_computer (posop : predef_node) (src: Lxm.t)
(args : const_eff list)
= (
match args with
- [Int_const_eff v0; Int_const_eff v1] -> (
+ [Int_const_eff v0; Int_const_eff v1] ->
[Int_const_eff (fi v0 v1)]
- ) |
- [Real_const_eff v0; Real_const_eff v1] -> (
- let res = (fr v0 v1) in
- warning src
- (sprintf
- "float in static exp: %f%s%f evaluated as %f" v0 nm v1 res);
- [Real_const_eff res]
- ) |
- [x0; x1] -> (type_error [x0; x1] "int*int or real*real")
- | x -> (arity_error x "2" )
+
+ | [Real_const_eff v0; Real_const_eff v1] -> (
+ let res = (fr v0 v1) in
+ warning src
+ (sprintf
+ "float in static exp: %f%s%f evaluated as %f" v0 nm v1 res);
+ [Real_const_eff res]
+ )
+ | [x0; x1] -> (type_error [x0; x1] "int*int or real*real")
+ | x -> (arity_error x "2" )
) in
(*----------------------------
Calcul du if
@@ -142,7 +142,8 @@ let op_computer (posop : predef_node) (src: Lxm.t)
)
| [x0; x1; x2] -> (type_error args "bool*t*t for some type t")
| x -> (arity_error x "3")
- ) in
+ )
+ in
(*----------------------------
Calcul de l'égalité
N.B. Sur les constantes abstraites
@@ -155,18 +156,17 @@ let op_computer (posop : predef_node) (src: Lxm.t)
= (
let rec fields_eq f0 f1 = (
match (f0, f1) with
- ([], []) -> (
+ | ([], []) ->
[Bool_const_eff true]
- ) |
- ((f0,h0)::t0, (f1,h1)::t1) -> (
- assert (f0 = f1);
- match (compute_eq [h0;h1]) with
- [Bool_const_eff false] -> [Bool_const_eff false]
- | [Bool_const_eff true] -> (fields_eq t0 t1)
- | _ -> assert false
- )
- |
- _ -> assert false
+
+ | ((f0,h0)::t0, (f1,h1)::t1) -> (
+ assert (f0 = f1);
+ match (compute_eq [h0;h1]) with
+ [Bool_const_eff false] -> [Bool_const_eff false]
+ | [Bool_const_eff true] -> (fields_eq t0 t1)
+ | _ -> assert false
+ )
+ | _ -> assert false
)
in
match args with
@@ -205,7 +205,8 @@ let op_computer (posop : predef_node) (src: Lxm.t)
)
| [x;y] -> type_error args "t*t for some type t"
| x -> arity_error args "2"
- ) in
+ )
+ in
(* match principal *)
match posop with
TRUE_n -> (
@@ -277,7 +278,7 @@ let op_computer (posop : predef_node) (src: Lxm.t)
function x -> (
match (compute_eq x) with
[Bool_const_eff v] -> [Bool_const_eff (not v)]
- | x -> x
+ | x -> x
)
)
| LT_n -> ( generic_num_comp "<" (<) (<) )
@@ -324,7 +325,6 @@ let op_computer (posop : predef_node) (src: Lxm.t)
| CONCAT_n -> assert false
| HAT_n -> assert false
| FBY_n -> assert false
- | NULL_exp -> assert false
)
(*----------------------------------------------------
@@ -448,61 +448,6 @@ let make_struct_const
))
)
-(************DEBUT SCORIE***************************************
-
-(*----------------------------------------------------
-SCORIES : PAS D'EXTENTION HOMOMORPHE IMPLICITE EN V6
- Application d'une opération homomorphe classique
-------------------------------------------------------
-Si TOUS les args sont des tableaux de même taille,
-alors on en conclue qu'il s'agit d'une extension
-homomorphe
-----------------------------------------------------*)
-
-(*
-Transforme (si possible)
-une liste de tableaux en tableau de liste.
-exemple (c'est plus parlant !):
-get_extension_args [
- Array_const_eff([| a1; a2; ...; an |],ta) ;
- Array_const_eff([| b1; b2; ...; bn |],tb) ;
- ...
- Array_const_eff([| z1; z2; ...; zn |],zb) ;
-] =
-Some [ [a1; b1; ...; z1]; ... [an; bn; ...; zn] ]
-Dans les autres cas => none
-*)
-
-let get_extension_args (clist : const_eff list) = (
- let treat_arg (c : const_eff) (acc : const_eff list array option) = (
- match c with
- Array_const_eff (ctab, typ) -> (
- match acc with
- None -> Some (Array.map (function x -> [x]) ctab)
- | Some res -> Some (Utils.array_map2 (fun x -> fun y -> x::y) ctab res)
- ) | _ -> raise (Invalid_argument "")
- )
- in try
- List.fold_right treat_arg clist None
- with _ -> None
-)
-
-let rec compute_homomorphic_op
- (oper : const_eff list -> const_eff list)
- (args : const_eff list) =
-(
- match (get_extension_args args) with
- None -> (
- (* pas extension => on opere juste *)
- oper args
- ) |
- Some c_lst_tab -> (
- (* extension *)
- let elts = Array.map (compute_homomorphic_op oper) c_lst_tab in
- [ make_array_const elts ]
- )
-)
-***********FIN SCORIE***************************************)
(*----------------------------------------------------
Evaluation récursive des expressions constantes
@@ -556,12 +501,12 @@ let rec f
IDENT_n id -> (
(* 2007-07 on interdit les externes *)
match (env.id2const id lxm) with
- Extern_const_eff _ -> (
+ | Extern_const_eff _ -> (
raise (EvalConst_error( sprintf
"external constant not allowed (%s)"
(Lxm.details lxm)))
- ) |
- x -> [ x ]
+ )
+ | x -> [ x ]
)
(* opérateur lazzy *)
| WITH_n -> (
diff --git a/src/evalType.ml b/src/evalType.ml
index d3485f38..c047795b 100644
--- a/src/evalType.ml
+++ b/src/evalType.ml
@@ -1,4 +1,4 @@
-(** Time-stamp: <modified the 07/02/2008 (at 17:12) by Erwan Jahier> *)
+(** Time-stamp: <modified the 05/03/2008 (at 14:49) by Erwan Jahier> *)
open Lxm
open Errors
@@ -23,23 +23,21 @@ Effets de bord :
----------------------------------------------------------------------*)
let rec (f:CompiledData.id_solver -> SyntaxTreeCore.type_exp -> CompiledData.type_eff)=
- fun env texp -> (
- try (
- match texp.it with
- Bool_type_exp -> Bool_type_eff
- | Int_type_exp -> Int_type_eff
- | Real_type_exp -> Real_type_eff
- | Named_type_exp s -> (
- env.id2type s texp.src
- )
- | Array_type_exp (elt_texp, szexp) -> (
- let elt_teff = f env elt_texp in
- try (
- let sz = EvalConst.eval_array_size env szexp in
- Array_type_eff ( elt_teff, sz)
- ) with EvalArray_error msg -> raise(EvalType_error msg)
- )
- ) with EvalType_error msg -> (
- raise (Compile_error(texp.src, "can't eval type: "^msg))
- )
- )
+ fun env texp ->
+ try (
+ match texp.it with
+ | Bool_type_exp -> Bool_type_eff
+ | Int_type_exp -> Int_type_eff
+ | Real_type_exp -> Real_type_eff
+ | Named_type_exp s -> env.id2type s texp.src
+ | Array_type_exp (elt_texp, szexp) -> (
+ let elt_teff = f env elt_texp in
+ try (
+ let sz = EvalConst.eval_array_size env szexp in
+ Array_type_eff (elt_teff, sz)
+ ) with EvalArray_error msg -> raise(EvalType_error msg)
+ )
+ )
+ with EvalType_error msg ->
+ raise (Compile_error(texp.src, "can't eval type: "^msg))
+
diff --git a/src/lazyCompiler.ml b/src/lazyCompiler.ml
index 0b67b718..8c25f2d1 100644
--- a/src/lazyCompiler.ml
+++ b/src/lazyCompiler.ml
@@ -1,4 +1,4 @@
-(** Time-stamp: <modified the 20/02/2008 (at 15:41) by Erwan Jahier> *)
+(** Time-stamp: <modified the 06/03/2008 (at 10:05) by Erwan Jahier> *)
open Lxm
@@ -57,6 +57,11 @@ fun tbl ->
prov_types = Hashtbl.create 0;
prov_consts = Hashtbl.create 0;
prov_nodes = Hashtbl.create 0;
+
+(* XXX Remplir ces tables avec les infos relatives aux opérateurs prédéfinis !!! *)
+
+(* XXX il manque aussi une table pour les clocks !!! *)
+
}
(******************************************************************************)
@@ -88,6 +93,11 @@ fun tbl ->
(10) [solve_const_idref] solves constant reference (w.r.t. short/long ident)
+
+ XXX clocks checking
+ ------------------
+ Ditto, but todo!
+
nb: for x in {type, const, node}, there are several functions that returns [x_eff]:
- [x_check]
@@ -108,7 +118,8 @@ fun tbl ->
no static parameters. Then:
- [node_check] calls [solve_x_idref] to perfrom name resolution
and it calls
-
+
+ nb3:
*)
@@ -289,7 +300,8 @@ and (type_check_interface_do: t -> Ident.long -> Lxm.t -> SymbolTab.t ->
and (const_check_interface_do: t -> Ident.long -> Lxm.t -> SymbolTab.t ->
- Ident.pack_name -> SyntaxTreeCore.const_info srcflagged -> CompiledData.const_eff) =
+ Ident.pack_name -> SyntaxTreeCore.const_info srcflagged ->
+ CompiledData.const_eff) =
fun this cn lxm prov_symbols p const_def ->
let prov_const_eff = const_check_do this cn lxm prov_symbols p const_def in
let body_const_eff = const_check this cn lxm in
@@ -518,10 +530,17 @@ and (node_check_do: t -> CompiledData.node_key -> Lxm.t -> SymbolTab.t ->
match node_def.it with
| Node n ->
(match n.uni_def with
- | NodeAlias (profile_opt, {src=_;it= CallPreDef(node)}) ->
+ | NodeAlias (profile_opt, {src=_;it= CallPreDef(ITERATOR_n(_,_,_))}) ->
finish_me "node alias with predef operator";
assert false
+ | NodeAlias (_, {src=_;it= CallPreDef(node)}) ->
+ assert false
+ (*
+ The only predef node that have static arg are array iterators.
+
+ Raise a msg or is it catched before ?
+ *)
| NodeAlias (
profile_opt, { src = lxm; it = CallUsrDef(idref, static_args) }
) ->
@@ -551,7 +570,6 @@ and (node_check_do: t -> CompiledData.node_key -> Lxm.t -> SymbolTab.t ->
);
res
-
| NodeAbstract(vi_il, vi_ol) ->
let aux vi = EvalType.f node_id_solver vi.it.va_type in
make_user_node_eff
diff --git a/src/symbolTab.ml b/src/symbolTab.ml
index 37951f44..cb66a05f 100644
--- a/src/symbolTab.ml
+++ b/src/symbolTab.ml
@@ -1,4 +1,4 @@
-(** Time-stamp: <modified the 15/02/2008 (at 11:40) by Erwan Jahier> *)
+(** Time-stamp: <modified the 06/03/2008 (at 14:45) by Erwan Jahier> *)
(*
Sous-module pour SyntaxTab
@@ -19,11 +19,17 @@ type t = {
}
(* Création/initialisation d'une symbol_tab *)
-let create () = {
- st_consts = Hashtbl.create 50;
- st_types = Hashtbl.create 50;
- st_nodes = Hashtbl.create 50;
-}
+let create () =
+ let consts_tbl = Hashtbl.create 50
+ and types_tbl = Hashtbl.create 50
+ and nodes_tbl = Hashtbl.create 50
+ in
+(* List.iter (fun (n,xx) -> Hashtbl.add nodes_tbl n xx) predef_node_list; *)
+ {
+ st_consts = consts_tbl;
+ st_types = types_tbl;
+ st_nodes = nodes_tbl;
+ }
let find_type (this: t) (id: Ident.t) lxm =
try Hashtbl.find (this.st_types) id
diff --git a/src/test/should_work/to_sort_out/const2.lus b/src/test/should_fail/semantics/const2.lus
similarity index 100%
rename from src/test/should_work/to_sort_out/const2.lus
rename to src/test/should_fail/semantics/const2.lus
--
GitLab