Commit 112f5ba1 authored by Erwan Jahier's avatar Erwan Jahier
Browse files

Merge conflicts wirg Pascal's trunk.

parents 1eb78afa 5a0e0595
......@@ -272,6 +272,8 @@ LURETTE_SOURCES=\
$(OBJDIR)/rif.ml \
$(OBJDIR)/coverage.mli \
$(OBJDIR)/coverage.ml \
$(OBJDIR)/reactive.mli \
$(OBJDIR)/reactive.ml \
LUTIN_SOURCES = \
$(OBJDIR)/version.ml \
......@@ -348,6 +350,8 @@ LUTIN_FILES = \
$(OBJDIR)/errors.ml \
$(OBJDIR)/lutParser.mly \
$(OBJDIR)/lutLexer.mll \
$(OBJDIR)/reactive.mli \
$(OBJDIR)/reactive.ml \
$(OBJDIR)/parsers.ml \
$(OBJDIR)/parsers.mli \
$(OBJDIR)/syntaxe.ml \
......
......@@ -10,7 +10,7 @@ CFLAGS = \
LIBS = -lluc4c_nc -llucky_nc -lgmp -lm -ldl -lstdc++
LUC2C=../../../$(HOSTTYPE)/bin/lutin --2c-4c -seed 42
LUC2CSOCK=../../../$(HOSTTYPE)/bin/lutin --2c-4c-socks 127.0.0.1 -seed 42
CALLVIASOCKET=../../../$(HOSTTYPE)/bin/call-via-socket -addr 127.0.0.1 -port 2000
CALLVIASOCKET=../../../$(HOSTTYPE)/bin/call-via-socket -addr 127.0.0.1 -port 2001
LUTIN=../../../$(HOSTTYPE)/bin/lutin -seed 42 -only-outputs -exe
ifeq ($(HOSTTYPE),mac)
......@@ -104,5 +104,5 @@ test2: clean foo-sock$(EXE)
utest2:
cp test2.rif test2.rif.exp
test: test1 test2
test: test1
......@@ -18,7 +18,7 @@ test:heater_control.ec heater_control$(EXE)
-rp "oracle:v6:heater_control.lus:not_a_fridge" \
-rp "env:lutin:env.lut:main" && \
grep -v "lurette chronogram" test.rif0 | \
grep -v "This is lurettop Version" test.rif0 | \
grep -v "This is lurette Version" test.rif0 | \
grep -v "The execution lasted"| sed -e "s/^M//" > test.rif &&\
rm -f test.res
diff -B -u -i test.rif.exp test.rif > test.res || true
......
......@@ -26,7 +26,7 @@ test:
rm -f test.rif .lurette_rc
$(LURETTETOP) -go --output test.rif0 env.lut && \
grep -v "lurette chronogram" test.rif0 | \
grep -v "This is lurettop Version" test.rif0 | \
grep -v "This is lurette Version" test.rif0 | \
grep -v "The execution lasted"| sed -e "s/^M//" > test.rif &&\
rm -f test.res
diff -B -u -i test.rif.exp test.rif > test.res || true
......
......@@ -35,6 +35,7 @@ test2: heat_ctrl2.cmxs
-rp "sut:ocaml:heat_ctrl2.cmxs:" \
-rp "env:lutin:sensors.lut:main" && \
grep -v "lurette chronogram" test2.rif0 | \
grep -v "lurette Version" | \
grep -v "The execution lasted"| sed -e "s/^M//" > test2.rif &&\
rm -f test2.res && diff -u -i test2.rif.exp test2.rif > test2.res
[ ! -s test2.res ] && make clean
......
# This is lurettop Version 1.54 (7bb02d3)
# The random engine was initialized with the seed 3
#inputs "T":real "T1":real "T2":real "T3":real
#outputs "Heat_on":bool
......
......@@ -263,7 +263,7 @@ let (f : unit -> int) =
!Solver.init_snt ();
Random.init seed;
Rif.write oc ("# This is lurettop Version " ^ Version.str ^ " (" ^Version.sha^")\n");
Rif.write oc ("# This is lurette Version " ^ Version.str ^ " (" ^Version.sha^")\n");
Rif.write oc ("# The random engine was initialized with the seed " ^
(string_of_int seed) ^ "\n" );
Rif_base.write_interface oc
......
......@@ -38,7 +38,6 @@ ZELANG=lut
#sources
SOURCES=$(LUTIN_SOURCES) \
$(OBJDIR)/main.ml \
......
......@@ -144,7 +144,7 @@ let make
(* - les variables support "Local" (de source_code) *)
(* Hashtbl.iter (print_support Local) (Expand.support_tab source_code); *)
List.iter print_support (Expand.local_list source_code);
List.iter print_support (Expand.local_out_list source_code);
(* - les alias (de source_code) *)
List.iter print_alias (Expand.alias_list source_code);
......
......@@ -3,6 +3,7 @@
------------------------------------------------------------
Table de symboles pour le check
---------------------------------------------------------------
---------------------------------------------------------------
C'est la structure qui permet :
- de réaliser le type/binding check (cf. CheckType)
......@@ -124,6 +125,7 @@ let get_exp_type (env : t) (e : Syntaxe.val_exp)
)
)
(*********************************************
AJOUT DU TYPING
Dans certains cas, une expression peut etre
......@@ -301,7 +303,7 @@ Ajout d'une macro dans le scope.
N.B. on distingue les macros avec
liste de param éventuellement vide
et les alias qui n'ont pas du tout
d'entrées (impornat pour l'expansion)
d'entrées (important pour l'expansion)
---------------------------------------------------*)
let add_let
......@@ -319,7 +321,7 @@ let add_let
(_, te) -> CkTypeEff.of_texp te
) in
let tinlist = List.map teff_of_param inlist in
let prof = CkTypeEff.get_prof tinlist tres in
let prof = CkTypeEff.get_prof tinlist [tres] in
CkIdentInfo.of_macro id prof li
) in
(* la clé = le nom dde la macro *)
......@@ -328,6 +330,19 @@ let add_let
[k.it]
)
let add_node
(env: t)
(ni : Syntaxe.node_info)
(nprof : CkTypeEff.profile)
(id : Syntaxe.ident) = (*unit*)
(
let ii = CkIdentInfo.of_node id nprof ni in
(* la clé = le nom dde la macro *)
let k = ni.ndi_ident in
put_in_scope env k ii;
[k.it]
)
(*---------------------------------------------------
Add extern def in the scope
-> if libs is Some thing, check
......@@ -378,7 +393,7 @@ let add_extern
let tinlist = List.map teff_of_param inlist in
(* MUST BE PURELY DATA *)
let prof = (
let res = CkTypeEff.get_prof tinlist tres in
let res = CkTypeEff.get_prof tinlist [tres] in
if (CkTypeEff.is_data_profile res) then res
else raise (
Compile_error (id.src,
......
......@@ -111,6 +111,13 @@ val add_let : t ->
Syntaxe.ident ->
scope_key
(* ajout d'un node x *)
val add_node : t ->
Syntaxe.node_info ->
CkTypeEff.profile -> (* whole profile *)
Syntaxe.ident ->
scope_key
(* ajout d'un extern x *)
val add_extern : t ->
Syntaxe.let_info ->
......
......@@ -69,6 +69,52 @@ let rec check_var_decl
(i,tdecl)
)
and
(* erun vars: opt type and init val, NO RANGE, + expected type *)
check_erun_var_decl
(env : CheckEnv.t)
(i, topt, vopt)
(txpc)
=
(
let teff = match topt with
| Some t ->
let tf = (CkTypeEff.of_texp t) in
if(CkTypeEff.lifts_to txpc tf) then tf
else ( type_error i.src [txpc] [tf] )
| None -> txpc
in
let _ = (
match vopt with
| None -> ()
| Some e -> (
let tcalc = check_exp env e in
if(CkTypeEff.lifts_to tcalc teff) then ()
else ( type_error i.src [tcalc] [teff] )
)
) in
(i,teff)
)
and
(* run result: id MUST be Support (controlable checked later) *)
check_run_var_decl
(env : CheckEnv.t)
(id)
(txpc)
=
(
let _ = match (CheckEnv.nature_of_ident env id) with
| Support_var -> ()
| _ -> (
raise (Compile_error (id.src,"identifier "^id.it^" not allowed as run result"))
) in
let tf = CheckEnv.type_of_ident env id in
let teff = if(CkTypeEff.lifts_to tf txpc) then txpc
else ( type_error id.src [tf] [txpc])
in
(id,teff)
)
and
check_exp
(env : CheckEnv.t)
(e : Syntaxe.val_exp) = (* CheckEnv.type_eff *)
......@@ -90,7 +136,7 @@ printf "check_exp\n";
match (CheckEnv.nature_of_ident env id) with
Macro_ident (_, prof) -> (
match CkTypeEff.split_prof prof with
([], t) -> t
([], [t]) -> t
| (til, _) -> (
arity_error e.src 0 (List.length til)
)
......@@ -210,6 +256,80 @@ printf "check_exp\n";
CheckEnv.restore env rkey ;
res
)
(* ERUN => modifie l'environnement *)
| ERUN_n (varlst, edef, e1) -> (
(* edef doit etre un node call (pour l'instant !) *)
let expected_types = (
match edef.it with
| CALL_n (id, elst) -> (
(* doit tre un node ... *)
match (CheckEnv.nature_of_ident env id) with
| Node_ident (_, prof) -> (
let tel = rec_list_call elst in
match_run_type_profile tel prof e.src
)
(* ... ou une fonction externe *)
| External_func (lio, eio, prof) -> (
let tel = rec_list_call elst in
[ match_type_profile tel prof e.src ]
)
| _ -> (
raise (Compile_error (e.src,
"identifier "^id.it^" cannot be used in run statement"))
)
)
| _ -> raise (Compile_error
(edef.src, "only node calls are supported in run statement"))
) in
(* on checke les ids wrt expected_types *)
let checked_ids = List.map2 (check_erun_var_decl env) varlst expected_types in
(* expected_types is associated to edef *)
CheckEnv.set_exp_type env edef (CkTypeEff.get_data_tuple expected_types);
(* on ajoute les vars dans env *)
let rkey = CheckEnv.add_support_vars env checked_ids in
let res = check_exp env e1 in
CheckEnv.restore env rkey ;
res
)
(* definitive RUN each id in idlst MUST be an existing controlable var
*)
| RUN_n (idlst, edef, e1opt) -> (
(* edef doit etre un node call (pour l'instant !) *)
let expected_types = (
match edef.it with
| CALL_n (id, elst) -> (
(* doit tre un node ... *)
match (CheckEnv.nature_of_ident env id) with
| Node_ident (_, prof) -> (
let tel = rec_list_call elst in
match_run_type_profile tel prof e.src
)
(* ... ou une fonction externe *)
| External_func (lio, eio, prof) -> (
let tel = rec_list_call elst in
[ match_type_profile tel prof e.src ]
)
| _ -> (
raise (Compile_error (e.src,
"identifier "^id.it^" cannot be used in run statement"))
)
)
| _ -> raise (Compile_error
(edef.src, "only node calls are supported in run statement"))
) in
(* on checke les ids wrt expected_types *)
let checked_ids = List.map2 (check_run_var_decl env) idlst expected_types in
(* expected_types is associated to edef *)
CheckEnv.set_exp_type env edef (CkTypeEff.get_data_tuple expected_types);
match e1opt with
| Some e1 ->
(* on ajoute les vars dans env *)
let rkey = CheckEnv.add_support_vars env checked_ids in
let res = check_exp env e1 in
CheckEnv.restore env rkey ;
res
| None -> CkTypeEff.trace
)
(* LET => modifie l'environnement *)
| LET_n (li, e1) -> (
(* on checke la def dans env ...*)
......@@ -316,11 +436,20 @@ printf "check_exp\n";
CheckEnv.set_exp_type env e e_teff;
e_teff
)
(* vrifie la compatibilit d'une liste
de types obtenus avec un profil attendu,
erreur de type si ca va pas ...
(* Old version : expect a single result type
kept to avoid a match (almost) everywhere
*)
and match_type_profile tel prof lxm = (
try (
match CkTypeEff.match_prof tel prof with
| [t] -> t
| _ -> assert false
) with _ ->
type_error lxm tel (CkTypeEff.params_of_prof prof)
)
(* General version, returns a list, used (only ?) for run's
*)
and match_run_type_profile tel prof lxm = (
try (
CkTypeEff.match_prof tel prof
) with _ ->
......@@ -382,6 +511,7 @@ and check_let
)
)
(* Returns the complete profile *)
let check_node
(env : CheckEnv.t)
(ni : Syntaxe.node_info) =
......@@ -394,11 +524,17 @@ let check_node
let rkey = CheckEnv.add_support_profile env ins outs in
(* calcul du type (et check par effet de bord *)
let tcalc = check_exp env ni.ndi_def in
if(CkTypeEff.lifts_to tcalc CkTypeEff.trace) then (
(* extract the type for creating the profile *)
let zeprof = if(CkTypeEff.lifts_to tcalc CkTypeEff.trace) then (
let teff_of_param = function (_, t) -> t in
let tins = List.map teff_of_param ins in
let touts = List.map teff_of_param outs in
CkTypeEff.get_prof tins touts
) else (
type_error lxm [tcalc] [CkTypeEff.trace]
) ;
CheckEnv.restore env rkey
type_error lxm [tcalc] [CkTypeEff.trace]
) in
CheckEnv.restore env rkey ;
zeprof
)
(*
......@@ -438,7 +574,8 @@ let check_pack
)
| NodeDef s -> (
let n = (Hashtbl.find p.pck_nodetab s.it) in
ignore (check_node env n)
let nprof = check_node env n in
ignore (CheckEnv.add_node env n nprof n.ndi_ident)
)
| ExceptDef s -> (
(* quivalent une constante
......
......@@ -29,7 +29,11 @@ type t = {
ii_name : string;
ii_def_ident : Syntaxe.ident option;
ii_nature : nature ;
ii_type : CkTypeEff.t ; (* type du rsulat seulement si macro *)
(* result type :
- single for macros
- tuple for nodes
*)
ii_type : CkTypeEff.t list ;
ii_hideable : bool;
} and nature =
Formal_param
......@@ -37,11 +41,13 @@ type t = {
| Const_ident
| Def_ident of Syntaxe.let_info
| Macro_ident of (Syntaxe.let_info option * CkTypeEff.profile)
| Node_ident of (Syntaxe.node_info option * CkTypeEff.profile)
| External_func of (Syntaxe.let_info option * extern_info option * CkTypeEff.profile)
(* info *)
let get_nature x = x.ii_nature
let get_type x = x.ii_type
let get_type x = match x.ii_type with [t] -> t | _ -> assert false
let is_hideable (x:t) = x.ii_hideable
......@@ -71,7 +77,7 @@ let of_local_cst (id : Syntaxe.ident) (te : CkTypeEff.t) = (
ii_name = id.it;
ii_def_ident = Some id;
ii_nature = Const_ident;
ii_type = te;
ii_type = [te];
ii_hideable = true;
}
)
......@@ -81,7 +87,7 @@ let of_global_cst (id : Syntaxe.ident) (te : CkTypeEff.t) = (
ii_name = id.it;
ii_def_ident = Some id;
ii_nature = Const_ident;
ii_type = te;
ii_type = [te];
ii_hideable = false;
}
)
......@@ -91,7 +97,7 @@ let of_predef_cst (nme : string) (te : CkTypeEff.t) = (
ii_name = nme;
ii_def_ident = None;
ii_nature = Const_ident ;
ii_type = te ;
ii_type = [te] ;
ii_hideable = false;
}
)
......@@ -101,7 +107,7 @@ let of_support (id : Syntaxe.ident) (te : CkTypeEff.t) = (
ii_name = id.it;
ii_def_ident = Some id;
ii_nature = Support_var;
ii_type = te ;
ii_type = [te] ;
ii_hideable = true;
}
)
......@@ -112,7 +118,7 @@ let of_param (id : Syntaxe.ident) (te : CkTypeEff.t) = (
ii_name = id.it;
ii_def_ident = Some id;
ii_nature = Formal_param;
ii_type = te ;
ii_type = [te] ;
ii_hideable = true;
}
)
......@@ -123,7 +129,7 @@ let of_alias (id : Syntaxe.ident) (te : CkTypeEff.t)
ii_name = id.it;
ii_def_ident = Some id;
ii_nature = Def_ident def;
ii_type = te ;
ii_type = [te] ;
ii_hideable = true;
}
)
......@@ -134,11 +140,25 @@ let of_macro (id : Syntaxe.ident) (prof : CkTypeEff.profile)
ii_name = id.it;
ii_def_ident = Some id;
ii_nature = Macro_ident (Some def, prof) ;
(* Single out type only *)
ii_type = CkTypeEff.res_of_prof prof ;
ii_hideable = true;
}
)
let of_node (id : Syntaxe.ident) (prof : CkTypeEff.profile)
(def : Syntaxe.node_info) = (
{
ii_name = id.it;
ii_def_ident = Some id;
ii_nature = Node_ident (Some def, prof) ;
(* Single out type only *)
ii_type = CkTypeEff.res_of_prof prof ;
ii_hideable = true;
}
)
(* la seule difference est qu'on ne peut pas masquer *)
let of_extern (id : Syntaxe.ident) (prof : CkTypeEff.profile)
(def : Syntaxe.let_info)
......@@ -162,22 +182,28 @@ let of_predef_op (nme : string) (prof : CkTypeEff.profile) = (
}
)
let to_string i = (
(match i.ii_nature with
Formal_param -> "Formal_param"
| Support_var -> "Support_var"
| Const_ident -> "Const_ident"
| Macro_ident (_ , p) -> "Macro_ident"
| Def_ident (_ ) -> "Def_ident"
| External_func (_ ) -> "External_func"
)^
" decl: "^
(* prints more accurate info: type or profile *)
let (nat, typing_info) =
let t = CkTypeEff.list_to_string i.ii_type in
match i.ii_nature with
| Formal_param -> ("Formal_param", t)
| Support_var -> ("Support_var", t)
| Const_ident -> ("Const_ident", t)
| Def_ident (_ ) -> ("Def_ident", t)
| Macro_ident (_ , p) -> ("Macro_ident", CkTypeEff.prof_to_string p)
| Node_ident (_ , p) -> ("Node_ident", CkTypeEff.prof_to_string p)
| External_func (_,_,p ) -> ("External_func", CkTypeEff.prof_to_string p)
in
nat^
", decl: "^
(match i.ii_def_ident with
None -> "predef"
| Some x -> (Errors.lexeme_details x.src)
)^
" hideable: "^
", typing: "^
typing_info
^
", hideable: "^
(if (i.ii_hideable) then "yes" else "no")
)
......@@ -32,7 +32,8 @@ type t = {
ii_name : string;
ii_def_ident : Syntaxe.ident option;
ii_nature : nature ;
ii_type : CkTypeEff.t ; (* type du rsulat seulement si macro *)
(* result type(s) for macros (nodes) *)
ii_type : CkTypeEff.t list ;
ii_hideable : bool;
} and nature =
Formal_param
......@@ -40,10 +41,12 @@ type t = {
| Const_ident
| Def_ident of Syntaxe.let_info
| Macro_ident of (Syntaxe.let_info option * CkTypeEff.profile)
| Node_ident of (Syntaxe.node_info option * CkTypeEff.profile)
| External_func of (Syntaxe.let_info option * extern_info option * CkTypeEff.profile)
val get_nature : t -> nature
(* use it only when type is surely single *)
val get_type : t -> CkTypeEff.t
(* rfrence un oprateur ou d'une constante prdfinie *)
......@@ -77,6 +80,9 @@ val of_local_cst : Syntaxe.ident -> CkTypeEff.t -> t
val of_macro : Syntaxe.ident -> CkTypeEff.profile -> Syntaxe.let_info -> t
val of_alias : Syntaxe.ident -> CkTypeEff.t -> Syntaxe.let_info -> t
(** node *)
val of_node : Syntaxe.ident -> CkTypeEff.profile -> Syntaxe.node_info -> t
(** extern : cas simplifie du precedent *)
val of_extern : Syntaxe.ident -> CkTypeEff.profile -> Syntaxe.let_info -> extern_info option -> t
......
......@@ -29,6 +29,7 @@ type t =
| TEFF_except
| TEFF_trace
| TEFF_data of basic
| TEFF_tuple of basic list
| TEFF_any of string * any_cond
| TEFF_ref of basic
and any_cond = (t -> t option)
......@@ -43,16 +44,38 @@ let is_data = function
TEFF_data _ -> true
| _ -> false
let get_data_tuple tl = (
let undata = function
TEFF_data d -> d
| _ -> raise (Failure "not a data")
in
TEFF_tuple (List.map undata tl)
)
let tuple_to_data_list t = (
let redata = function
d -> TEFF_data d
in
match t with
TEFF_tuple bl -> (List.map redata bl)
| _ -> raise (Failure "not a tuple")
)
let is_ref = function
TEFF_ref _ -> true
| _ -> false
let basic_to_string = (
function
Bool -> "bool"
| Int -> "int"
| Real -> "real"
)
(* pretty-print des types *)
let rec to_string = ( function
TEFF_data Bool -> "bool"
| TEFF_data Int -> "int"
| TEFF_data Real -> "real"
| TEFF_ref x -> (to_string (TEFF_data x))^" ref"
TEFF_data d -> (basic_to_string d)
| TEFF_tuple l -> String.concat "*" (List.map basic_to_string l)
| TEFF_ref x -> (basic_to_string x)^" ref"
| TEFF_trace -> "trace"
| TEFF_weight -> "weight"
| TEFF_except -> "exception"
......@@ -61,7 +84,7 @@ let rec to_string = ( function
(tl, t) -> (
sprintf "%s->%s"
(list_to_string tl)
(to_string t)
(list_to_string t)
)
) and list_to_string = ( function
[] -> ""
......@@ -70,10 +93,10 @@ let rec to_string = ( function
)