correct base_clock and signature.

This commit is contained in:
Léonard Gérard 2011-05-12 17:40:23 +02:00
parent 4c2a5121e4
commit 74cc367a0e
8 changed files with 60 additions and 20 deletions

View file

@ -104,6 +104,10 @@ let prod ck_l = match ck_l with
| [ck] -> Ck ck
| _ -> Cprod (List.map (fun ck -> Ck ck) ck_l)
let rec root_ck_of ck = match ck_repr ck with
| Cbase | Cvar _ -> ck
| Con(ck,_,_) -> root_ck_of ck
(*
let rec tuple ck = function
| Tprod ty_list ->

View file

@ -146,7 +146,7 @@ let print_ident ff id = Format.fprintf ff "%s" (name id)
| Cbase -> fprintf ff "base"
| Con (ck, c, n) ->
fprintf ff "%a on %a(%a)" print_ck ck print_qualname c print_ident n
| Cvar { contents = Cindex _ } -> fprintf ff "base"
| Cvar { contents = Cindex i } -> fprintf ff "'a%i" i
| Cvar { contents = Clink ck } -> print_ck ff ck
let rec print_ct ff = function

View file

@ -139,7 +139,7 @@ let typing_eq h { eq_lhs = pat; eq_rhs = e } =
| Some(reset) -> ck_of_name h reset in
let ct = typing_app h ck_r pat op args in
ct, ck_r
| Eiterator (_, _, _, pargs, args, r) ->
| Eiterator (_, _, _, pargs, args, r) -> (*TODO*)
(* Typed exactly as a fun or a node... *)
let ck_r = match r with
| None -> fresh_clock()
@ -147,7 +147,6 @@ let typing_eq h { eq_lhs = pat; eq_rhs = e } =
in
List.iter (expect_extvalue h ck_r) pargs;
List.iter (expect_extvalue h ck_r) args;
(*TODO*)
Ck ck_r, ck_r
in
e.e_base_ck <- base;
@ -191,11 +190,13 @@ let typing_contract h contract =
append_env h c_list
let typing_node node =
let h = append_env Env.empty node.n_input in
let h = append_env h node.n_output in
let h = typing_contract h node.n_contract in
let h0 = append_env Env.empty node.n_input in
let h0 = append_env h0 node.n_output in
let h = typing_contract h0 node.n_contract in
let h = append_env h node.n_local in
typing_eqs h node.n_equs;
(* synchronize input and output on base : find the free vars and set them to base *)
Env.iter (fun id ck -> unify_ck (root_ck_of ck) Cbase) h0;
(*update clock info in variables descriptions *)
let set_clock vd = { vd with v_clock = ck_repr (Env.find vd.v_ident h) } in
let node = { node with n_input = List.map set_clock node.n_input;

View file

@ -0,0 +1,32 @@
(**************************************************************************)
(* *)
(* Heptagon *)
(* *)
(* Author : Marc Pouzet *)
(* Organization : Demons, LRI, University of Paris-Sud, Orsay *)
(* *)
(**************************************************************************)
open Clocks
open Minils
(* Any clock variable left after clocking is free and should be set to level_ck.
Since inputs and outputs are grounded to Cbase, this append when
no data dependance exists between an expression and the inputs/outputs.*)
(* We are confident that it is sufficient to unify level_ck with base_ck
for expressions having a base_ck == Cvar.
The other ones are coming from one like this one,
indeed if it was Con (Cvar,c,x) x would have to be defined with an expression of clock Cvar.*)
let exp _ acc e =
let _ = match ck_repr e.e_base_ck with
| Cvar ({contents = Cindex _}) -> unify_ck e.e_base_ck e.e_level_ck
| _ -> ()
in
e,acc (* no recursion since in minils exps are not recursive *)
let program p =
let funs = { Mls_mapfold.defaults with Mls_mapfold.exp = exp } in
let p, _ = Mls_mapfold.program_it funs [] p in
p

View file

@ -17,6 +17,9 @@ let compile_program p =
(* Clocking *)
let p = pass "Clocking" true Clocking.program p pp in
(* Level clocks *)
let p = pass "Level clock" true Level_clock.program p pp in
(* Check that the dataflow code is well initialized *)
(*let p = silent_pass "Initialization check" !init Init.program p in *)

View file

@ -27,19 +27,7 @@ let rec print_pat ff = function
| Evarpat n -> print_ident ff n
| Etuplepat pat_list ->
fprintf ff "@[<2>(%a)@]" (print_list_r print_pat """,""") pat_list
(*
let rec print_ck ff = function
| Cbase -> fprintf ff "base"
| Con (ck, c, n) ->
fprintf ff "%a on %a(%a)" print_ck ck print_qualname c print_ident n
| Cvar { contents = Cindex _ } -> fprintf ff "base"
| Cvar { contents = Clink ck } -> print_ck ff ck
let rec print_ct ff = function
| Ck ck -> print_ck ff ck
| Cprod ct_list ->
fprintf ff "@[<2>(%a)@]" (print_list_r print_clock """ *""") ct_list
*)
let print_vd ff { v_ident = n; v_type = ty; v_clock = ck } =
if !Compiler_options.full_type_info then
fprintf ff "%a : %a :: %a" print_ident n print_type ty print_ck ck

View file

@ -11,9 +11,11 @@ let
y = x_cur when c
tel
node use_current (c : bool; x : int) returns (y : int on c)
var x_cur :int;
node use_current (c : bool; x : int) returns (b : bool on c; y : int on c)
var x_cur, y2 :int;
let
x_cur = current(c,x);
y = x_cur when c;
y2 = internal_current(c,x);
b = y = y2;
tel

10
test/good/side_effet.ept Normal file
View file

@ -0,0 +1,10 @@
node hello() returns (b:bool)
var tmp : bool;
let
tmp = (*printf("hello")*) true;
automaton
state A var ttmp :bool; do
b = true;
ttmp = (*printf("hello")*) true;
end;
tel