├── benchs ├── rer.ept ├── count.ept ├── minus.ept ├── pip_ex.ept ├── emsoft03.ept ├── prodcell.ept ├── ums_verif.ept ├── landing_gear.ept ├── count.lus ├── main.txt ├── current.lus ├── abro.lus ├── avgvelocity.ept ├── avgvelocity.lus ├── rer-reset.lus ├── rer.lus ├── tracker.ept ├── tracker.lus ├── colors.lus ├── minus.lus ├── nav.lus ├── chrono.ept ├── chrono.lus ├── emsoft03.lus ├── buttons.ept ├── buttons.lus ├── emsoft05.ept ├── emsoft05.lus ├── stepper_motor.ept ├── stepper_motor.lus ├── stopwatch.ept ├── stopwatch.lus ├── halbwachs.ept ├── halbwachs.lus ├── ums_verif.lus └── groupwcet.ml ├── includes ├── tests ├── ok_arrow.lus ├── ok_outself.lus ├── ko_noargs.lus ├── ok_rev_list.lus ├── ok_dependonin.lus ├── ko_dependonout.lus ├── ok_simple.lus ├── ko_missingtypedecl.lus ├── ko_noreturn.lus ├── ko_cycliciface.lus ├── ko_dep_cycle.lus ├── ko_noargsnoreturn.lus ├── ko_last_dep.lus ├── ok_multifby.lus ├── ko_nonexhaustive.lus ├── ok_fbyfby.lus ├── ok_secondbase.lus ├── ok_div.lus ├── ko_dependonvar.lus ├── ko_parseprec1.lus ├── ko_parseprec2.lus ├── ko_duplicatebranch.lus ├── ko_mismatchconstructor.lus ├── ok_multieq.lus ├── ko_dep_cycle2.lus ├── ok_complete.lus ├── ok_multireset.lus ├── ko_branch_caus.lus ├── ok_multivar.lus ├── ok_switch2.lus ├── clean.sh ├── ok_external.lus ├── ok_inorderinputs.lus ├── ok_last_output.lus ├── ok_outoforderinputs.lus ├── ko_dupdef1.lus ├── ko_dupdef2.lus ├── ok_multieq_wconst2.lus ├── ko_cyclic2.lus ├── ok_clockedconstfby.lus ├── ok_fbymultick.lus ├── ok_multieq_wconst.lus ├── ko_shadowing.lus ├── ko_nolast.lus ├── ko_cyclic.lus ├── ko_switch_inclock.lus ├── ok_constfbyck.lus ├── ok_sched.lus ├── ok_last.lus ├── ko_switch_missingdec.lus ├── ko_switch_outclock.lus ├── ok_switch_local.lus ├── ko_unless_use_local.lus ├── ok_cktuples1.lus ├── ok_merge.lus ├── ko_switch_local.lus ├── ok_clockedconstfby2.lus ├── ko_auto_mixed.lus ├── ok_binopapp.lus ├── ok_ckonck2b.lus ├── ok_depout.lus ├── Makefile ├── ko_binopapp.lus ├── ko_whenexp3.lus ├── ok_wildcards.lus ├── ok_auto_subclock.lus ├── ko_whenexp.lus ├── ok_ckonck2.lus ├── ok_blockreset.lus ├── ok_divzeroargs.lus ├── ok_alias.lus ├── ok_fbymultick_infer.lus ├── ko_badalias.lus ├── ko_depout3.lus ├── ok_auto_local.lus ├── ko_depout4.lus ├── ok_switch.lus ├── ok_whenmulti.lus ├── ok_mergemulti.lus ├── ko_depout5.lus ├── ko_depout6.lus ├── ok_local.lus ├── ok_switchapp.lus ├── ok_datatypes.lus ├── ok_depout2.lus ├── ok_multiargs.lus ├── ok_branch_caus.lus ├── ok_ckmultiargs.lus ├── ok_depout5.lus ├── ok_clockedconstarg.lus ├── ok_last_caus.lus ├── ko_ckifteargs.lus ├── ok_multiifte.lus ├── ok_auto.lus ├── ok_clockedbinop.lus ├── ko_clockedconstarg.lus ├── ok_depout6.lus ├── ok_whenmulti2.lus ├── ok_tuples.lus ├── ok_parseprec.lus ├── ok_parseprec_when.lus ├── ok_clockedcapp.lus ├── ok_deadcode.lus ├── ok_cut_next_cycles.lus ├── ok_cut_last_cycles.lus ├── runtests.sh └── ok_clockedcapp2.lus ├── examples ├── count.lus ├── current.lus ├── abro.lus ├── avgvelocity.lus ├── rer-reset.lus ├── rer.lus ├── tracker.lus ├── colors.lus ├── minus.lus ├── nav.lus ├── chrono.lus ├── Makefile ├── stopwatch.lus ├── emsoft03.lus ├── emsoft05.lus ├── stepper-motor.lus ├── stepper-motor │ └── stepper-motor.lus ├── halbwachs.lus └── ums_verif.lus ├── AUTHORS ├── tools ├── velus.css ├── dpdgraph.v ├── Makefile ├── opam.sh └── pg ├── compile ├── .merlin ├── artifact.sh ├── src ├── Lustre │ ├── Denot │ │ ├── Cpo.v │ │ ├── Cpo │ │ │ └── readme.md │ │ ├── SDfunsCoind.v │ │ ├── CheckOp.v │ │ └── Denot.v │ ├── Parser │ │ ├── Makefile │ │ └── README.md │ ├── Unnesting │ │ ├── Normalization.v │ │ └── LUnnesting.v │ ├── Complete │ │ └── LComplete.v │ ├── NormFby │ │ └── LNormFby.v │ ├── NormLast │ │ └── LNormLast.v │ ├── CompAuto │ │ └── LCompAuto.v │ ├── ClockSwitch │ │ └── LClockSwitch.v │ └── InlineLocal │ │ └── LInlineLocal.v ├── Obc │ └── Obc.v ├── CoreExpr │ ├── CoreExpr.v │ └── CESyntax.v ├── CoindIndexed.v ├── Instantiator.v ├── NLustre │ ├── ExprInlining │ │ ├── EINormalArgs.v │ │ └── ExprInlining.v │ ├── DeadCodeElim │ │ └── DCENormalArgs.v │ └── DupRegRem │ │ └── DupRegRem.v ├── Transcription │ └── Transcription.v ├── NLustreToStc │ └── NL2StcNormalArgs.v ├── Stc │ └── CutCycles │ │ ├── CCNormalArgs.v │ │ └── CutCycles.v ├── veluscommon.ml └── Common │ └── CommonTactics.v ├── .gitlab-ci.yml ├── flake.lock ├── variables.mk └── configure /benchs/rer.ept: -------------------------------------------------------------------------------- 1 | rer.lus -------------------------------------------------------------------------------- /benchs/count.ept: -------------------------------------------------------------------------------- 1 | count.lus -------------------------------------------------------------------------------- /benchs/minus.ept: -------------------------------------------------------------------------------- 1 | minus.lus -------------------------------------------------------------------------------- /benchs/pip_ex.ept: -------------------------------------------------------------------------------- 1 | pip_ex.lus -------------------------------------------------------------------------------- /benchs/emsoft03.ept: -------------------------------------------------------------------------------- 1 | emsoft03.lus -------------------------------------------------------------------------------- /benchs/prodcell.ept: -------------------------------------------------------------------------------- 1 | prodcell.lus -------------------------------------------------------------------------------- /benchs/ums_verif.ept: -------------------------------------------------------------------------------- 1 | ums_verif.lus -------------------------------------------------------------------------------- /benchs/landing_gear.ept: -------------------------------------------------------------------------------- 1 | landing_gear.lus -------------------------------------------------------------------------------- /includes: -------------------------------------------------------------------------------- 1 | lib 2 | common 3 | backend 4 | cfrontend 5 | driver 6 | export 7 | cparser 8 | -------------------------------------------------------------------------------- /tests/ok_arrow.lus: -------------------------------------------------------------------------------- 1 | node arrow(x : int; y : int) returns (z : int) 2 | let z = x -> y; 3 | tel -------------------------------------------------------------------------------- /tests/ok_outself.lus: -------------------------------------------------------------------------------- 1 | node f(self : int) returns (out : bool); 2 | let out = self < 42; 3 | tel -------------------------------------------------------------------------------- /benchs/count.lus: -------------------------------------------------------------------------------- 1 | node count (i:int) returns (o:int) 2 | let 3 | o = (0 fby o) + i; 4 | tel 5 | 6 | -------------------------------------------------------------------------------- /examples/count.lus: -------------------------------------------------------------------------------- 1 | node count (i:int) returns (o:int) 2 | let 3 | o = (0 fby o) + i; 4 | tel 5 | 6 | -------------------------------------------------------------------------------- /tests/ko_noargs.lus: -------------------------------------------------------------------------------- 1 | 2 | node noargs() returns (a: bool); 3 | let 4 | a = false fby (not a); 5 | tel 6 | 7 | -------------------------------------------------------------------------------- /tests/ok_rev_list.lus: -------------------------------------------------------------------------------- 1 | node f(x : int) returns (y : bool; z : int) 2 | let 3 | y, z = ((true), (x)); 4 | tel 5 | -------------------------------------------------------------------------------- /tests/ok_dependonin.lus: -------------------------------------------------------------------------------- 1 | 2 | node f (a : bool) returns (y : bool when a); 3 | let 4 | y = true when a; 5 | tel 6 | 7 | -------------------------------------------------------------------------------- /tests/ko_dependonout.lus: -------------------------------------------------------------------------------- 1 | 2 | node f (a : bool; b : bool when y) returns (y:bool); 3 | let 4 | y = true; 5 | tel 6 | 7 | -------------------------------------------------------------------------------- /tests/ok_simple.lus: -------------------------------------------------------------------------------- 1 | 2 | node f(x: bool) 3 | returns (y: bool); 4 | let 5 | y = false fby (x and y or x); 6 | tel 7 | 8 | -------------------------------------------------------------------------------- /tests/ko_missingtypedecl.lus: -------------------------------------------------------------------------------- 1 | node f (x: t) returns (y: int) 2 | let 3 | y = case x of (A => 0) (C => 2) (B => 1); 4 | tel 5 | 6 | -------------------------------------------------------------------------------- /tests/ko_noreturn.lus: -------------------------------------------------------------------------------- 1 | 2 | node noreturns(a: bool) returns (); 3 | var w : bool; 4 | let 5 | w = false fby (not a); 6 | tel 7 | 8 | -------------------------------------------------------------------------------- /tests/ko_cycliciface.lus: -------------------------------------------------------------------------------- 1 | 2 | node f (x : bool; a : bool when b; b : bool when a) returns (y:bool); 3 | let 4 | y = true; 5 | tel 6 | 7 | -------------------------------------------------------------------------------- /tests/ko_dep_cycle.lus: -------------------------------------------------------------------------------- 1 | node f(i : int) returns (x, y, z : int) 2 | let 3 | x = i + z; 4 | y = x / 2; 5 | z = y + 1; 6 | tel 7 | -------------------------------------------------------------------------------- /tests/ko_noargsnoreturn.lus: -------------------------------------------------------------------------------- 1 | 2 | node noargsnoreturns() returns (); 3 | var w : bool; 4 | let 5 | w = false fby (not w); 6 | tel 7 | 8 | -------------------------------------------------------------------------------- /tests/ko_last_dep.lus: -------------------------------------------------------------------------------- 1 | node f(b : bool) returns (y : int) 2 | var x : int; 3 | let 4 | last x = x; 5 | x = last x; 6 | y = x; 7 | tel 8 | -------------------------------------------------------------------------------- /tests/ok_multifby.lus: -------------------------------------------------------------------------------- 1 | 2 | node swapdelay (a, b : bool) 3 | returns (x, y : bool); 4 | let 5 | (x, y) = (true, false) fby (a, b); 6 | tel 7 | 8 | -------------------------------------------------------------------------------- /AUTHORS: -------------------------------------------------------------------------------- 1 | Timothy Bourke 2 | Lélio Brun 3 | Pierre-Évariste Dagand 4 | Paul Jeanmaire 5 | Xavier Leroy 6 | Basile Pesin 7 | Marc Pouzet 8 | Lionel Rieg 9 | -------------------------------------------------------------------------------- /tests/ko_nonexhaustive.lus: -------------------------------------------------------------------------------- 1 | type t = A | B | C 2 | 3 | node f (x: t) returns (y: int) 4 | let 5 | y = case x of (A => 0) (C => 2); 6 | tel 7 | 8 | -------------------------------------------------------------------------------- /tests/ok_fbyfby.lus: -------------------------------------------------------------------------------- 1 | 2 | node fbyfby (i : bool) 3 | returns (x, y : bool); 4 | let 5 | x = true fby y; 6 | y = true fby (not x); 7 | tel 8 | 9 | -------------------------------------------------------------------------------- /tests/ok_secondbase.lus: -------------------------------------------------------------------------------- 1 | 2 | node f (a : bool when b; 3 | b : bool) 4 | returns (y : bool); 5 | let 6 | y = false fby true; 7 | tel 8 | 9 | -------------------------------------------------------------------------------- /tests/ok_div.lus: -------------------------------------------------------------------------------- 1 | -- the simple run-time error analysis should accept this 2 | node f (x : int) returns (y : int); 3 | let 4 | y = (x + 4) / 2; 5 | tel; 6 | -------------------------------------------------------------------------------- /tests/ko_dependonvar.lus: -------------------------------------------------------------------------------- 1 | 2 | node f (a : bool) returns (y : bool when c); 3 | var c : bool; 4 | let 5 | y = true when c; 6 | c = true; 7 | tel 8 | 9 | -------------------------------------------------------------------------------- /tests/ko_parseprec1.lus: -------------------------------------------------------------------------------- 1 | 2 | node f1(a : bool; b : int when a) returns (y : int when a); 3 | let 4 | y = b * 2 when a; (* (b * 2) when a *) 5 | tel 6 | 7 | -------------------------------------------------------------------------------- /tests/ko_parseprec2.lus: -------------------------------------------------------------------------------- 1 | 2 | node f2(a : bool; b : int when a) returns (y : int when a); 3 | let 4 | y = b + 1 when a; (* (b + 1) when a *) 5 | tel 6 | 7 | -------------------------------------------------------------------------------- /tests/ko_duplicatebranch.lus: -------------------------------------------------------------------------------- 1 | type t = A | B | C 2 | 3 | node f (x: t) returns (y: int) 4 | let 5 | y = case x of (A => 0) (B => 1) (B => 3) (C => 2); 6 | tel 7 | -------------------------------------------------------------------------------- /tests/ko_mismatchconstructor.lus: -------------------------------------------------------------------------------- 1 | type t = A | B | C 2 | 3 | node f (x: t) returns (y: int) 4 | let 5 | y = case x of (A => 0) (Y => 1) (C => 2); 6 | tel 7 | 8 | -------------------------------------------------------------------------------- /tests/ok_multieq.lus: -------------------------------------------------------------------------------- 1 | 2 | node f(a, b, c: bool) 3 | returns (x: bool; y: bool when x; z: bool when a); 4 | let 5 | x, y, z = (a, b when x, c when a); 6 | tel 7 | 8 | -------------------------------------------------------------------------------- /tests/ko_dep_cycle2.lus: -------------------------------------------------------------------------------- 1 | node f(b : bool) returns (x, y : int) 2 | let 3 | switch b 4 | | true do x = 0; y = x; 5 | | false do x = y; y = x; 6 | end 7 | tel 8 | -------------------------------------------------------------------------------- /tests/ok_complete.lus: -------------------------------------------------------------------------------- 1 | node f(b : bool) returns (x : int) 2 | let 3 | last x = 0; 4 | switch b 5 | | true do x = last x + 1 6 | | false do 7 | end 8 | tel 9 | -------------------------------------------------------------------------------- /tests/ok_multireset.lus: -------------------------------------------------------------------------------- 1 | node multireset(r1, r2 : bool) returns (x : int) 2 | let 3 | reset 4 | reset 5 | x = 0 fby (x + 1); 6 | every r2; 7 | every r1; 8 | tel -------------------------------------------------------------------------------- /tests/ko_branch_caus.lus: -------------------------------------------------------------------------------- 1 | node f(b : bool) returns (x, y : int) 2 | let 3 | y = x + 1; 4 | switch b 5 | | true do x = 0 6 | | false do x = y - 1 7 | end 8 | tel 9 | -------------------------------------------------------------------------------- /tests/ok_multivar.lus: -------------------------------------------------------------------------------- 1 | 2 | node multivars (a: bool) returns (y: bool); 3 | var b : bool; 4 | var c : bool; 5 | let 6 | b = a; 7 | c = b; 8 | y = c; 9 | tel 10 | -------------------------------------------------------------------------------- /tests/ok_switch2.lus: -------------------------------------------------------------------------------- 1 | type t = A | B 2 | 3 | node f(x : t) returns (y : int) 4 | let 5 | switch x 6 | | A do y = 0; 7 | | B do y = 1; 8 | end 9 | tel 10 | -------------------------------------------------------------------------------- /tests/clean.sh: -------------------------------------------------------------------------------- 1 | #!/usr/bin/env sh 2 | 3 | rm -rf \ 4 | *.parsed.lus *.nolast.lus *.noauto.lus *.noswitch.lus *.nolocal.lus \ 5 | *.n.lus *.stc *.obc \ 6 | *.light.c *.s *.exe 7 | -------------------------------------------------------------------------------- /tests/ok_external.lus: -------------------------------------------------------------------------------- 1 | external sinf(float) returns float 2 | external cosf(float) returns float 3 | 4 | node main(x : float) returns (y : float) 5 | let y = cosf(sinf(x)); 6 | tel 7 | -------------------------------------------------------------------------------- /tests/ok_inorderinputs.lus: -------------------------------------------------------------------------------- 1 | 2 | node f (a : bool; 3 | b : bool when a; 4 | c : bool when b) 5 | returns (y : bool); 6 | let 7 | y = true; 8 | tel 9 | 10 | -------------------------------------------------------------------------------- /tests/ok_last_output.lus: -------------------------------------------------------------------------------- 1 | node f(b : bool) returns (x : int) 2 | let 3 | last x = 0; 4 | switch b 5 | | true do x = last x + 1; 6 | | false do x = last x - 1; 7 | end; 8 | tel 9 | -------------------------------------------------------------------------------- /tests/ok_outoforderinputs.lus: -------------------------------------------------------------------------------- 1 | 2 | node f (a : bool; 3 | b : bool when c; 4 | c : bool when a) 5 | returns (y : bool); 6 | let 7 | y = true; 8 | tel 9 | 10 | -------------------------------------------------------------------------------- /tests/ko_dupdef1.lus: -------------------------------------------------------------------------------- 1 | 2 | node wrong(x: bool) returns (y: bool; z: bool); 3 | let 4 | y = false; (* OK *) 5 | z = true; (* OK *) 6 | y = false; (* KO *) 7 | tel 8 | 9 | -------------------------------------------------------------------------------- /tests/ko_dupdef2.lus: -------------------------------------------------------------------------------- 1 | 2 | node wrong(w: bool) returns (x: bool; y: bool; z: bool); 3 | let 4 | x, y = (false, false); (* OK *) 5 | z, z = (false, false); (* KO *) 6 | tel 7 | 8 | -------------------------------------------------------------------------------- /tests/ok_multieq_wconst2.lus: -------------------------------------------------------------------------------- 1 | 2 | node f(a, b, c: bool) 3 | returns (w: bool when z; x: bool; y: bool when x; z: bool when a); 4 | let 5 | w, x, y, z = (true, true, true, true); 6 | tel 7 | 8 | -------------------------------------------------------------------------------- /tests/ko_cyclic2.lus: -------------------------------------------------------------------------------- 1 | 2 | node f (x : bool) returns (y:bool); 3 | var a : bool when b; 4 | b : bool when a; 5 | let 6 | y = true; 7 | a = true; 8 | b = true; 9 | tel 10 | 11 | -------------------------------------------------------------------------------- /tests/ok_clockedconstfby.lus: -------------------------------------------------------------------------------- 1 | 2 | node f(x: bool; y: bool when x) 3 | returns (z: bool); 4 | var w: bool when x; 5 | let 6 | w = false fby (not y); 7 | z = merge x w true; 8 | tel 9 | 10 | -------------------------------------------------------------------------------- /tests/ok_fbymultick.lus: -------------------------------------------------------------------------------- 1 | 2 | node fbyfby (a, b : bool) 3 | returns (x : bool when a; y : bool when b); 4 | let 5 | (x, y) = (true when a, false when b) fby (false when a, true when b); 6 | tel 7 | 8 | -------------------------------------------------------------------------------- /tests/ok_multieq_wconst.lus: -------------------------------------------------------------------------------- 1 | 2 | node f(a, b, c: bool) 3 | returns (w: bool when z; x: bool; y: bool when x; z: bool when a); 4 | let 5 | w, x, y, z = (true, a, b when x, c when a); 6 | tel 7 | 8 | -------------------------------------------------------------------------------- /tests/ko_shadowing.lus: -------------------------------------------------------------------------------- 1 | node f(x : bool) returns (y : int when x) 2 | let 3 | y = 1 when x; 4 | var x : bool; z : int when x; 5 | let 6 | x = false; 7 | z = y; 8 | tel; 9 | tel 10 | -------------------------------------------------------------------------------- /tests/ko_nolast.lus: -------------------------------------------------------------------------------- 1 | node f(b : bool) returns (y : int) 2 | var x : int; 3 | let 4 | switch b 5 | | true do x = last x + 1 6 | | false do x = last x - 1 7 | end; 8 | y = x; 9 | tel 10 | -------------------------------------------------------------------------------- /tests/ko_cyclic.lus: -------------------------------------------------------------------------------- 1 | 2 | node f (x : bool) returns (y:bool); 3 | var a : bool when b; 4 | b : bool when a; 5 | let 6 | y = true; 7 | a = true when b; 8 | b = true when a; 9 | tel 10 | 11 | -------------------------------------------------------------------------------- /tests/ko_switch_inclock.lus: -------------------------------------------------------------------------------- 1 | type t = A | B 2 | 3 | node f(b : bool; x : t; z : int when b) returns (y : int); 4 | let 5 | switch x 6 | | A do y = merge b z 1; 7 | | B do y = 2; 8 | end 9 | tel 10 | -------------------------------------------------------------------------------- /tests/ok_constfbyck.lus: -------------------------------------------------------------------------------- 1 | 2 | 3 | node test(ck: bool) returns (y: bool); 4 | var x : bool when ck; 5 | let 6 | x = (false fby true) and (true fby (false when ck)); 7 | y = merge ck x true; 8 | tel 9 | 10 | -------------------------------------------------------------------------------- /tests/ok_sched.lus: -------------------------------------------------------------------------------- 1 | node last_next_order(x : int) returns (y : int); 2 | let y = 0 fby 1; 3 | tel 4 | 5 | node unused_fby(x : int) returns (y : int); 6 | var v : int; 7 | let 8 | v = 0 fby 1; 9 | y = 42; 10 | tel -------------------------------------------------------------------------------- /tests/ok_last.lus: -------------------------------------------------------------------------------- 1 | node f(b : bool) returns (y : int) 2 | var x : int; 3 | let 4 | last x = 0; 5 | switch b 6 | | true do x = last x + 1 7 | | false do x = last x - 1 8 | end; 9 | y = x; 10 | tel 11 | -------------------------------------------------------------------------------- /tests/ko_switch_missingdec.lus: -------------------------------------------------------------------------------- 1 | type t = A | B | C 2 | 3 | node g(x : t) returns (y : int; z : bool); 4 | let 5 | switch x 6 | | A do z = false; 7 | | B do y = 2; z = true; 8 | | C do y = 3; z = true; 9 | end 10 | tel 11 | -------------------------------------------------------------------------------- /tests/ko_switch_outclock.lus: -------------------------------------------------------------------------------- 1 | type t = A | B 2 | 3 | (* y should be on the same clock as x *) 4 | node f(b : bool; x : t) returns (y : int when b); 5 | let 6 | switch x 7 | | A do y = 1; 8 | | B do y = 2; 9 | end 10 | tel 11 | -------------------------------------------------------------------------------- /tests/ok_switch_local.lus: -------------------------------------------------------------------------------- 1 | type t = A 2 | 3 | node f(w : t) returns (y : int) 4 | let 5 | switch w 6 | | A do var t : int :: . on A(w); 7 | let t = 4; 8 | y = merge w (A => t); 9 | tel 10 | end 11 | tel 12 | -------------------------------------------------------------------------------- /tests/ko_unless_use_local.lus: -------------------------------------------------------------------------------- 1 | node f(b : bool) returns (x : int) 2 | let 3 | automaton initially A 4 | state A var t : int; do 5 | t = 0 fby (t + 1); 6 | x = t; 7 | unless (0 fby t) = 5 then A 8 | end 9 | tel 10 | -------------------------------------------------------------------------------- /tests/ok_cktuples1.lus: -------------------------------------------------------------------------------- 1 | 2 | node swap (a, b, c : bool) 3 | returns (x, y : bool); 4 | var v : bool when a; 5 | w : bool when b; 6 | let 7 | (v, w) = (c when a, c when b); 8 | x = merge a v false; 9 | y = merge b w false; 10 | tel 11 | 12 | -------------------------------------------------------------------------------- /tests/ok_merge.lus: -------------------------------------------------------------------------------- 1 | 2 | node f (a, b : bool) 3 | returns (y : bool); 4 | var w : bool when a; 5 | x : bool when not a; 6 | let 7 | w = (not b) when a; 8 | x = b when not a; 9 | y = merge a (true => w) (false => x); 10 | tel 11 | 12 | -------------------------------------------------------------------------------- /tools/velus.css: -------------------------------------------------------------------------------- 1 | .expr { 2 | color: green; 3 | } 4 | 5 | .operator { 6 | color: green; 7 | } 8 | 9 | .constant { 10 | color: blue; 11 | } 12 | 13 | .type { 14 | color: blue; 15 | } 16 | 17 | .block { 18 | color: purple; 19 | } 20 | -------------------------------------------------------------------------------- /benchs/main.txt: -------------------------------------------------------------------------------- 1 | chrono.lus chrono.chrono_step 2 | cruise.lus cruise.cruisecontrol_step 3 | heater.lus heater.controller_2_step 4 | stopwatch.lus stopwatch.stopwatch_step 5 | buttons.lus buttons.buttons_step 6 | stepper_motor.lus stepper_motor.stepper_motor_step 7 | -------------------------------------------------------------------------------- /tests/ko_switch_local.lus: -------------------------------------------------------------------------------- 1 | type t = A 2 | 3 | node f(ckw : bool; w : t :: . on ckw) returns (y : int :: . on ckw) 4 | let 5 | switch w 6 | | A do var t : int; 7 | let t = 4; 8 | y = (t when ckw) + 3; 9 | tel 10 | end 11 | tel 12 | -------------------------------------------------------------------------------- /tests/ok_clockedconstfby2.lus: -------------------------------------------------------------------------------- 1 | 2 | node g (x: bool; y: bool when x) 3 | returns (z: bool); 4 | let 5 | z = false fby (not z); 6 | tel 7 | 8 | node f (x: bool; y: bool when x) 9 | returns (w: bool); 10 | let 11 | w = g(x, false fby (not y)); 12 | tel 13 | 14 | -------------------------------------------------------------------------------- /benchs/current.lus: -------------------------------------------------------------------------------- 1 | (* 2 | This example is taken from §1.2.2, Pouzet 2006. “The Lucid Synchrone 3 | reference manual”, version 3. 4 | *) 5 | node current(d : int; ck : bool; x : int when ck) returns (y : int); 6 | let 7 | y = merge(ck; x; (d fby y) when not ck); 8 | tel 9 | -------------------------------------------------------------------------------- /compile: -------------------------------------------------------------------------------- 1 | #!/usr/bin/env sh 2 | 3 | SRCFILE=${1:?"Source file not given"} 4 | NODE=${2:-main} 5 | NAME=${SRCFILE%.*} 6 | 7 | ./velus -dnlustre -dstc -dsch -dobc -dclight -sync -main $NODE $SRCFILE && \ 8 | CompCert/ccomp -stdlib CompCert/runtime -o $NAME.exe $NAME.sync.c $NAME.s 9 | -------------------------------------------------------------------------------- /tests/ko_auto_mixed.lus: -------------------------------------------------------------------------------- 1 | node mixed(b : bool) returns (y : int) 2 | let 3 | automaton 4 | initially A 5 | state A do y = 0 fby (y + 1) 6 | until b then B 7 | state B do y = 0 fby (y - 1) 8 | unless b then A 9 | end 10 | tel 11 | -------------------------------------------------------------------------------- /tests/ok_binopapp.lus: -------------------------------------------------------------------------------- 1 | 2 | node notnot (x : bool) returns (y : bool); 3 | var w : bool; 4 | let 5 | w = false fby x; 6 | y = w or x; 7 | tel 8 | 9 | node binop (x : bool) 10 | returns (y : bool); 11 | let 12 | y = notnot(x) or notnot(not x); 13 | tel 14 | 15 | -------------------------------------------------------------------------------- /examples/current.lus: -------------------------------------------------------------------------------- 1 | (* 2 | This example is taken from §1.2.2, Pouzet 2006. “The Lucid Synchrone 3 | reference manual”, version 3. 4 | *) 5 | node current(d : int; ck : bool; x : int when ck) returns (y : int); 6 | let 7 | y = merge(ck; x; (d fby y) when not ck); 8 | tel 9 | -------------------------------------------------------------------------------- /tests/ok_ckonck2b.lus: -------------------------------------------------------------------------------- 1 | 2 | node f(a: bool; b: bool; c: bool when b; d: bool when c) 3 | returns (z: bool; w : bool when b; x : bool when c; y : bool when d); 4 | let 5 | w = a when b; 6 | x = w when c; 7 | y = x when d; 8 | z = false fby true; 9 | tel 10 | 11 | -------------------------------------------------------------------------------- /tests/ok_depout.lus: -------------------------------------------------------------------------------- 1 | 2 | node f(a: bool) 3 | returns (y: bool; z: bool when y); 4 | let 5 | y = false fby a; 6 | z = true when y; 7 | tel 8 | 9 | node main(b: bool) 10 | returns (x: bool); 11 | var y : bool when x; 12 | let 13 | (x, y) = f(b); 14 | tel 15 | 16 | -------------------------------------------------------------------------------- /tests/Makefile: -------------------------------------------------------------------------------- 1 | .PHONY: run clean cleanall 2 | 3 | run: 4 | ./runtests.sh 5 | 6 | clean: 7 | -@rm -rf \ 8 | *.parsed.lus *.nolast.lus *.noauto.lus *.noswitch.lus *.nolocal.lus \ 9 | *.n.lus *.stc *.obc \ 10 | *.light.c *.s *.exe 11 | 12 | cleanall: clean 13 | 14 | -------------------------------------------------------------------------------- /tests/ko_binopapp.lus: -------------------------------------------------------------------------------- 1 | 2 | node notnot (x : bool) returns (y, z : bool); 3 | var w : bool; 4 | let 5 | w = false fby x; 6 | y = w or y; 7 | z = w and x; 8 | tel 9 | 10 | node binop (x : bool) 11 | returns (y : bool); 12 | let 13 | y = notnot(x) or notnot(not x); 14 | tel 15 | 16 | -------------------------------------------------------------------------------- /tests/ko_whenexp3.lus: -------------------------------------------------------------------------------- 1 | 2 | node f(a: bool; b: bool when a) returns (y: bool); 3 | let 4 | y = true fby false; 5 | tel 6 | 7 | node wrong(w, x: bool) returns (y: bool; z: bool); 8 | let 9 | y = f(x, true when x); (* OK *) 10 | z = f(w, true when x); (* KO *) 11 | tel 12 | 13 | -------------------------------------------------------------------------------- /tests/ok_wildcards.lus: -------------------------------------------------------------------------------- 1 | type t = A | B | C | D | E | F 2 | 3 | node f (x: t) returns (y: int; z : bool) 4 | let 5 | (y, z) = case x of 6 | (A => (1, true)) 7 | (D => (4, true)) 8 | (E => (5, true)) 9 | (_ => (0, false)); 10 | tel 11 | -------------------------------------------------------------------------------- /tests/ok_auto_subclock.lus: -------------------------------------------------------------------------------- 1 | node f(ck : bool; b : bool when ck) returns (y : int when ck) 2 | let 3 | automaton 4 | initially A 5 | state A do y = 0 fby (y + 1) 6 | until b then B 7 | state B do y = 0 fby (y - 1) 8 | until b then A 9 | end 10 | tel 11 | -------------------------------------------------------------------------------- /tests/ko_whenexp.lus: -------------------------------------------------------------------------------- 1 | 2 | node f(a: bool; b: bool when a) returns (y: bool); 3 | let 4 | y = true fby false; 5 | tel 6 | 7 | node wrong(x: bool) returns (y: bool; z: bool); 8 | let 9 | y = f(x, true when x); (* OK *) 10 | z = f(not x, true when not x); (* KO *) 11 | tel 12 | 13 | -------------------------------------------------------------------------------- /tests/ok_ckonck2.lus: -------------------------------------------------------------------------------- 1 | 2 | node f(a: bool; b: bool; c: bool when b; d: bool when c) 3 | returns (z: bool); 4 | var w : bool when b; 5 | x : bool when c; 6 | y : bool when d; 7 | let 8 | w = a when b; 9 | x = w when c; 10 | y = x when d; 11 | z = false fby true; 12 | tel 13 | 14 | -------------------------------------------------------------------------------- /tests/ok_blockreset.lus: -------------------------------------------------------------------------------- 1 | node fby_reset(r : bool) returns (x : int); 2 | let 3 | reset 4 | x = 0 fby (x + 1); 5 | every r; 6 | tel 7 | 8 | node arrow_reset(x : int) returns (y : int; t : bool); 9 | let 10 | reset 11 | y = x -> 0; 12 | t = x <> 0; 13 | every (true fby false); 14 | tel -------------------------------------------------------------------------------- /.merlin: -------------------------------------------------------------------------------- 1 | B _build/src 2 | B _build/extraction/extracted 3 | S src 4 | S src/Lustre 5 | S src/Normalization 6 | S src/CoreExpr 7 | S src/NLustre 8 | S src/SyBloc 9 | S src/Obc 10 | S src/ObcToClight 11 | S CompCert/common 12 | S CompCert/lib 13 | S CompCert/cparser 14 | S CompCert/cfrontend 15 | PKG ocamlgraph 16 | -------------------------------------------------------------------------------- /tests/ok_divzeroargs.lus: -------------------------------------------------------------------------------- 1 | 2 | node g(w: bool; x : int; y : int when w; z : int when w) 3 | returns (v: bool); 4 | let 5 | v = false fby w; 6 | tel 7 | 8 | node f(a: int) 9 | returns (b: bool) 10 | var ck : bool; 11 | let 12 | ck = a > 0; 13 | b = g(ck, 1 / (a * a + 1) , (1 when ck) / (a when ck), 3 when ck); 14 | tel 15 | 16 | -------------------------------------------------------------------------------- /tests/ok_alias.lus: -------------------------------------------------------------------------------- 1 | 2 | node f(a : bool when c; 3 | b : bool when d; 4 | c, d : bool) 5 | returns (y: bool); 6 | let 7 | y = true fby false; 8 | tel 9 | 10 | node wrong(w : bool when z; 11 | x : bool when z; 12 | z : bool) 13 | returns (u: bool); 14 | let 15 | u = f(w, x, z, z); 16 | tel 17 | 18 | -------------------------------------------------------------------------------- /tests/ok_fbymultick_infer.lus: -------------------------------------------------------------------------------- 1 | 2 | node fbyfby1 (a, b : bool) 3 | returns (x : bool when a; y : bool when b); 4 | let 5 | (x, y) = (true, false) fby (false when a, true when b); 6 | tel 7 | 8 | node fbyfby2 (a, b : bool) 9 | returns (x : bool when a; y : bool when b); 10 | let 11 | (x, y) = (true, false) fby (false, true); 12 | tel 13 | 14 | -------------------------------------------------------------------------------- /tests/ko_badalias.lus: -------------------------------------------------------------------------------- 1 | 2 | node f(a : bool when c; 3 | b : bool when d; 4 | c, d : bool) 5 | returns (y: bool); 6 | let 7 | y = true fby false; 8 | tel 9 | 10 | node wrong(w : bool when z; 11 | x : bool when z; 12 | y, z : bool) 13 | returns (u: bool); 14 | let 15 | u = f(w, x, y, z); 16 | tel 17 | 18 | -------------------------------------------------------------------------------- /tests/ko_depout3.lus: -------------------------------------------------------------------------------- 1 | 2 | node f(a: bool) 3 | returns (y: bool; z: bool when y); 4 | let 5 | y = false fby a; 6 | z = true when y; 7 | tel 8 | 9 | node g(a: bool; b: bool when a) 10 | returns (y: bool when a); 11 | let 12 | y = b; 13 | tel 14 | 15 | node main(b: bool) 16 | returns (x: bool) 17 | let 18 | x = g(f(b)); 19 | tel 20 | 21 | -------------------------------------------------------------------------------- /tests/ok_auto_local.lus: -------------------------------------------------------------------------------- 1 | node test(b : bool) returns (y : int) 2 | let 3 | automaton initially A 4 | state A var d : int; do 5 | d = 0 fby (d + 1); 6 | y = d / 2; 7 | until d > 5 continue B 8 | | d > 10 then A 9 | state B do 10 | y = 0; 11 | until true continue A 12 | end 13 | tel 14 | -------------------------------------------------------------------------------- /tests/ko_depout4.lus: -------------------------------------------------------------------------------- 1 | 2 | node f(a: bool) 3 | returns (y: bool; z: bool when y); 4 | let 5 | y = false fby a; 6 | z = true when y; 7 | tel 8 | 9 | node g(a: bool; b: bool when a) 10 | returns (y: bool when a); 11 | let 12 | y = b; 13 | tel 14 | 15 | node main(b: bool) 16 | returns (x: bool when b) 17 | let 18 | x = g(f(b)); 19 | tel 20 | 21 | -------------------------------------------------------------------------------- /tests/ok_switch.lus: -------------------------------------------------------------------------------- 1 | type t = A | B | C 2 | 3 | node f(x : t) returns (y : int); 4 | let 5 | switch x 6 | | A do y = 1 7 | | B do y = 2 8 | | C do y = 3 9 | end 10 | tel 11 | 12 | node g(x : t) returns (y : int; z : bool); 13 | let 14 | switch x 15 | | A do z = false; y = 2 16 | | B do y = 2; z = true 17 | | C do y = 3; z = true 18 | end 19 | tel 20 | -------------------------------------------------------------------------------- /tests/ok_whenmulti.lus: -------------------------------------------------------------------------------- 1 | 2 | node f (a : bool) 3 | returns (x, y : bool) 4 | let 5 | x = a; 6 | y = false fby not a; 7 | tel 8 | 9 | node multimerge (a, b : bool) 10 | returns (y : bool) 11 | var w1, w2 : bool when a; 12 | x : bool when not a; 13 | let 14 | (w1, w2) = f(b) when a; 15 | x = b when not a; 16 | y = merge a w1 x; 17 | tel 18 | 19 | -------------------------------------------------------------------------------- /benchs/abro.lus: -------------------------------------------------------------------------------- 1 | (** 2 | * Adaptation of Resetting example 3 | * From the Pouzet, Lucid Synchrone Manual V3 4 | * Section 1.6.3 5 | *) 6 | 7 | node expect(a : bool) returns (o : bool) 8 | let 9 | o = a or (false fby o); 10 | tel 11 | 12 | node abro(a, b, r : bool) returns (o : bool) 13 | let 14 | reset 15 | o = expect(a) and expect(b); 16 | every r; 17 | tel 18 | -------------------------------------------------------------------------------- /tests/ok_mergemulti.lus: -------------------------------------------------------------------------------- 1 | 2 | node f (a : bool) 3 | returns (x, y : bool) 4 | let 5 | x = a; 6 | y = not a; 7 | tel 8 | 9 | node multimerge (a, b : bool) 10 | returns (y, z : bool) 11 | var w : bool when a; 12 | x : bool when not a; 13 | let 14 | w = (not b) when a; 15 | x = b when not a; 16 | (y, z) = merge a (true => f(w)) (false => f(x)); 17 | tel 18 | 19 | -------------------------------------------------------------------------------- /examples/abro.lus: -------------------------------------------------------------------------------- 1 | (** 2 | * Adaptation of Resetting example 3 | * From the Pouzet, Lucid Synchrone Manual V3 4 | * Section 1.6.3 5 | *) 6 | 7 | node expect(a : bool) returns (o : bool) 8 | let 9 | o = a or (false fby o); 10 | tel 11 | 12 | node abro(a, b, r : bool) returns (o : bool) 13 | let 14 | reset 15 | o = expect(a) and expect(b); 16 | every r; 17 | tel 18 | -------------------------------------------------------------------------------- /tests/ko_depout5.lus: -------------------------------------------------------------------------------- 1 | 2 | node f(a: bool) 3 | returns (y: bool; z: bool when y); 4 | let 5 | y = false fby a; 6 | z = true when y; 7 | tel 8 | 9 | node g(a: bool; b: bool when a) 10 | returns (x: bool; y: bool when x); 11 | let 12 | x = a; 13 | y = b; 14 | tel 15 | 16 | node main(b: bool) 17 | returns (w: bool; x: bool when w); 18 | let 19 | (w, x) = g(f(b)); 20 | tel 21 | 22 | -------------------------------------------------------------------------------- /tests/ko_depout6.lus: -------------------------------------------------------------------------------- 1 | 2 | node f(a: bool) 3 | returns (y: bool; z: bool when a) 4 | let 5 | y = false fby a; 6 | z = true when a; 7 | tel 8 | 9 | node g(a: bool; b: bool when a) 10 | returns (x: bool; y: bool when a) 11 | let 12 | x = a; 13 | y = b; 14 | tel 15 | 16 | node main(b: bool) 17 | returns (w: bool; x: bool when b) 18 | let 19 | (w, x) = g(f(b)); 20 | tel 21 | 22 | -------------------------------------------------------------------------------- /tests/ok_local.lus: -------------------------------------------------------------------------------- 1 | node f(x : int) returns (z : bool) 2 | var y : int; 3 | let 4 | -- We support both heptagon syntax and let/tel syntax for local blocks 5 | do var t : int; in 6 | -- x -> t -> y 7 | t = x fby (t + 1); 8 | y = t; 9 | done; 10 | var t : int; 11 | let 12 | -- y -> t -> z 13 | t = y + 1; 14 | z = t > 0; 15 | tel 16 | -- x --> y --> z 17 | tel 18 | -------------------------------------------------------------------------------- /tests/ok_switchapp.lus: -------------------------------------------------------------------------------- 1 | node f(x : bool; y : int when x) returns (z : bool) 2 | let 3 | z = x; 4 | tel 5 | 6 | node g(z : bool) returns (t : bool) 7 | let 8 | t = not z; 9 | tel 10 | 11 | node h(x : bool) returns (y : int) 12 | var t : int when x; 13 | let 14 | t = 42 fby (t + 1); 15 | switch g(f(x, t)) 16 | | True do y = 12; 17 | | False do y = 21; 18 | end 19 | tel 20 | -------------------------------------------------------------------------------- /artifact.sh: -------------------------------------------------------------------------------- 1 | #!/usr/bin/env sh 2 | 3 | # Clean up 4 | make realclean 5 | ./tests/clean.sh 6 | 7 | # Tarball 8 | tar -czf velus.tar.gz \ 9 | CompCert \ 10 | readme.md \ 11 | configure \ 12 | includes \ 13 | variables.mk \ 14 | tools/automake.mll \ 15 | Makefile \ 16 | vfiles \ 17 | src/ \ 18 | extraction/ \ 19 | tests/*.lus \ 20 | examples/ \ 21 | doc/ 22 | -------------------------------------------------------------------------------- /tests/ok_datatypes.lus: -------------------------------------------------------------------------------- 1 | type t = A | B | C 2 | 3 | node f (x: t) returns (y: int) 4 | let 5 | y = case x of (A => 0) (C => 2) (B => 1); 6 | tel 7 | 8 | node g (x: t) returns (y: int) 9 | var a : int when A(x); 10 | b : int when B(x); 11 | c : int :: . on C(x); 12 | let 13 | a = 0 when A(x); 14 | b = 1 when B(x); 15 | c = 2 when C(x); 16 | y = merge x (B => b) (C => c) (A => a); 17 | tel 18 | -------------------------------------------------------------------------------- /tools/dpdgraph.v: -------------------------------------------------------------------------------- 1 | Require dpdgraph.dpdgraph. 2 | 3 | From Velus Require Import Common. 4 | From Velus Require Import Common.CommonProgram Common.CommonTyping. 5 | From Velus Require Import Instantiator. 6 | From Velus Require Import Velus NLCorrectness VelusCorrectness. 7 | 8 | Print FileDependGraph 9 | AcyGraph 10 | Interface 11 | Instantiator 12 | Velus NLCorrectness VelusCorrectness. 13 | -------------------------------------------------------------------------------- /tests/ok_depout2.lus: -------------------------------------------------------------------------------- 1 | 2 | node f(a: bool) 3 | returns (y: bool; z: bool when y) 4 | let 5 | y = false fby a; 6 | z = true when y; 7 | tel 8 | 9 | node g(a: bool; b: bool when a) 10 | returns (y: bool) 11 | let 12 | y = true fby false; 13 | tel 14 | 15 | node main(b: bool) 16 | returns (x: bool) 17 | var y1 : bool; z1 : bool when y1; 18 | let 19 | (y1, z1) = f(b); 20 | x = g(y1, z1); 21 | tel 22 | 23 | -------------------------------------------------------------------------------- /tests/ok_multiargs.lus: -------------------------------------------------------------------------------- 1 | 2 | node swap (a, b : bool) 3 | returns (x, y : bool); 4 | let 5 | x = b; 6 | y = a; 7 | tel 8 | 9 | node shuffle (a, b, c, d : bool) 10 | returns (w, x, y, z : bool); 11 | let 12 | (w, x) = swap(a, b); 13 | (y, z) = swap(c, d); 14 | tel 15 | 16 | node main (a, b, c, d : bool) 17 | returns (w, x, y, z : bool); 18 | let 19 | (w, x, y, z) = shuffle(shuffle(swap(a, b), swap(c, d))); 20 | tel 21 | 22 | -------------------------------------------------------------------------------- /tests/ok_branch_caus.lus: -------------------------------------------------------------------------------- 1 | node f(b : bool) returns (x, y : int) 2 | let 3 | switch b 4 | | true do x = 0; y = x + 1 5 | | false do y = 0; x = y - 1 6 | end 7 | tel 8 | 9 | node g(b : bool) returns (x, y : int) 10 | let 11 | automaton initially A 12 | state A 13 | do x = 0; y = x + 1 14 | until b then B 15 | state B 16 | do y = 0; x = y - 1 17 | until b then A 18 | end 19 | tel 20 | -------------------------------------------------------------------------------- /benchs/avgvelocity.ept: -------------------------------------------------------------------------------- 1 | node counter (ini:int; inc:int; rest:bool) returns (n:int) 2 | let 3 | n = if rest then ini else ((0 fby n) + inc); 4 | tel 5 | 6 | node avgvelocity (delta : int; sec : bool) 7 | returns (v : int) 8 | let 9 | v = merge sec 10 | (true -> ((counter (0, delta, false) when sec) * 11 | (counter (0 when sec, 1 when sec, false when sec)))) 12 | (false -> ((0 fby v) whenot sec)); 13 | tel 14 | -------------------------------------------------------------------------------- /benchs/avgvelocity.lus: -------------------------------------------------------------------------------- 1 | node counter (ini:int; inc:int; rest:bool) returns (n:int) 2 | let 3 | n = if rest then ini else ((0 fby n) + inc); 4 | tel 5 | 6 | node avgvelocity (delta : int; sec : bool) 7 | returns (v : int) 8 | let 9 | v = merge sec 10 | (true => ((counter (0, delta, false) when sec) * 11 | (counter (0 when sec, 1 when sec, false when sec)))) 12 | (false => ((0 fby v) whenot sec)); 13 | tel 14 | -------------------------------------------------------------------------------- /examples/avgvelocity.lus: -------------------------------------------------------------------------------- 1 | node counter (ini:int; inc:int; rest:bool) returns (n:int) 2 | let 3 | n = if rest then ini else ((0 fby n) + inc); 4 | tel 5 | 6 | node avgvelocity (delta : int; sec : bool) 7 | returns (v : int) 8 | let 9 | v = merge sec 10 | (true => ((counter (0, delta, false) when sec) / 11 | (counter (0 when sec, 1 when sec, false when sec)))) 12 | (false => ((0 fby v) whenot sec)); 13 | tel 14 | -------------------------------------------------------------------------------- /src/Lustre/Denot/Cpo.v: -------------------------------------------------------------------------------- 1 | (* Components of the Cpo library needed to define the denotational semantics *) 2 | From Velus Require Export Lustre.Denot.Cpo.Cpo_def. 3 | From Velus Require Export Lustre.Denot.Cpo.Cpo_streams_type. 4 | From Velus Require Export Lustre.Denot.Cpo.Systems. 5 | 6 | From Velus Require Export Lustre.Denot.Cpo_ext.Cpo_def_ext. 7 | From Velus Require Export Lustre.Denot.Cpo_ext.DS_ext. 8 | From Velus Require Export Lustre.Denot.Cpo_ext.Nprod. 9 | -------------------------------------------------------------------------------- /src/Lustre/Denot/Cpo/readme.md: -------------------------------------------------------------------------------- 1 | # Denotational semantics for Kahn Networks 2 | 3 | This sudirectory contains the work of [Christine Paulin-Mohring](https://www.lri.fr/~paulin/). 4 | The original files can be found at https://www.lri.fr/~paulin/KahnNetworks. 5 | This work is described in the chapter “A constructive denotational semantics for Kahn networks in Coq” 6 | from the book “From Semantics and Computer Science: Essays in Honor of Gilles Kahn”, Cambridge University Press, 2009. 7 | -------------------------------------------------------------------------------- /tests/ok_ckmultiargs.lus: -------------------------------------------------------------------------------- 1 | 2 | node mok (a, b, c : bool) 3 | returns (x: bool when a; y : bool when b); 4 | let 5 | (x, y) = ((false fby c) when a, c when b); 6 | tel 7 | 8 | node kom (a, b : bool; y : bool when a; z : bool when b) 9 | returns (u, v: bool); 10 | let 11 | u = merge a (true -> y) (false -> false); 12 | v = merge b (true -> z) (false -> false); 13 | tel 14 | 15 | node main (a, b, c : bool) 16 | returns (w, x : bool); 17 | let 18 | (w, x) = kom(a, b, mok(a, b, c)); 19 | tel 20 | -------------------------------------------------------------------------------- /tests/ok_depout5.lus: -------------------------------------------------------------------------------- 1 | 2 | node f(a: bool) 3 | returns (y: bool; z: bool when y); 4 | let 5 | y = false fby a; 6 | z = true when y; 7 | tel 8 | 9 | node g(a: bool; b: bool when a) 10 | returns (x: bool; y: bool when x); 11 | let 12 | x = merge a true false; 13 | y = (merge a b false) when x; 14 | tel 15 | 16 | node main(b: bool) 17 | returns (w: bool; x: bool when w); 18 | var y1 : bool; z1 : bool when y1; 19 | let 20 | (y1, z1) = f(b); 21 | (w, x) = g(y1, z1); 22 | tel 23 | 24 | -------------------------------------------------------------------------------- /tests/ok_clockedconstarg.lus: -------------------------------------------------------------------------------- 1 | 2 | node f(x: bool; y: bool when x) 3 | returns (z: bool); 4 | var w: bool; 5 | let 6 | w = merge x (y and (z when x)) 7 | (z when not x); 8 | z = false fby w; 9 | tel 10 | 11 | node g(x: bool) 12 | returns (y: bool); 13 | let 14 | (* The correct form is: 15 | y = f(x, false when x) 16 | 17 | This example tests whether the compiler infers the missing 18 | "when" in the arguments of a node. *) 19 | y = f(x, false); 20 | tel 21 | 22 | -------------------------------------------------------------------------------- /tests/ok_last_caus.lus: -------------------------------------------------------------------------------- 1 | node f(b : bool) returns (y : int) 2 | var x : int; 3 | let 4 | last x = 0; 5 | x = last x; 6 | y = x; 7 | tel 8 | 9 | (** Interestingly, x can be used to calculate last x *) 10 | node g(b : bool) returns (y : int) 11 | var x : int; 12 | let 13 | last x = x; 14 | x = 0; 15 | y = x; 16 | tel 17 | 18 | node h(b : bool) returns (y : int) 19 | var x, z : int; 20 | let 21 | last x = z; 22 | last z = last x; 23 | (x, z) = (last z, 0); 24 | y = x; 25 | tel 26 | -------------------------------------------------------------------------------- /tests/ko_ckifteargs.lus: -------------------------------------------------------------------------------- 1 | 2 | node mok (a, b, c : bool) 3 | returns (x: bool when a; y : bool when b); 4 | let 5 | (x, y) = ((false fby c) when a, c when b); 6 | tel 7 | 8 | node kom (a, b : bool; y : bool when a; z : bool when b) 9 | returns (u, v: bool); 10 | let 11 | u = merge a y false; 12 | v = merge b z false; 13 | tel 14 | 15 | node main (a, b, c : bool) 16 | returns (w, x : bool); 17 | let 18 | (w, x) = kom(a, b, if c then mok(a, b, c) 19 | else mok(a, b, not c)); 20 | tel 21 | 22 | -------------------------------------------------------------------------------- /tests/ok_multiifte.lus: -------------------------------------------------------------------------------- 1 | 2 | node swap (a, b : bool) 3 | returns (x, y : bool); 4 | let 5 | x = false fby b; 6 | y = a; 7 | tel 8 | 9 | node shuffle (a, b, c, d : bool) 10 | returns (w, x, y, z : bool); 11 | let 12 | (w, x) = swap(a, b); 13 | (y, z) = swap(c, d); 14 | tel 15 | 16 | node main (a, b, c, d : bool) 17 | returns (w, x, y, z : bool); 18 | let 19 | (w, x, y, z) = shuffle(if a 20 | then shuffle(swap(a, b), swap(c, d)) 21 | else (a, b, c, d)); 22 | tel 23 | 24 | -------------------------------------------------------------------------------- /tests/ok_auto.lus: -------------------------------------------------------------------------------- 1 | node weak(c0, b : bool) returns (y : int) 2 | let 3 | automaton 4 | initially if c0 then A; otherwise B 5 | state A do y = 0 fby (y + 1) 6 | until b then B 7 | state B do y = 0 fby (y - 1) 8 | until b then A 9 | end 10 | tel 11 | 12 | node strong(b : bool) returns (y : int) 13 | let 14 | automaton 15 | initially A 16 | state A do y = 0 fby (y + 1) 17 | unless b then B 18 | state B do y = 0 fby (y - 1) 19 | unless b then A 20 | end 21 | tel 22 | -------------------------------------------------------------------------------- /tests/ok_clockedbinop.lus: -------------------------------------------------------------------------------- 1 | 2 | node f(x: bool; y: bool when x) 3 | returns (z: bool); 4 | var w: bool; 5 | let 6 | w = merge x (true -> y and (z when x)) 7 | (false -> z when not x); 8 | z = false fby w; 9 | tel 10 | 11 | node g(x: bool) 12 | returns (y: bool); 13 | var w: bool when x; 14 | let 15 | w = true when x; 16 | (* The correct form is: 17 | y = f(x, false when x) 18 | 19 | This example tests whether the compiler infers the missing 20 | "when" in the arguments of a node. *) 21 | y = f(x, false and w); 22 | tel 23 | 24 | -------------------------------------------------------------------------------- /tests/ko_clockedconstarg.lus: -------------------------------------------------------------------------------- 1 | 2 | node f(x: bool; y: bool when x) 3 | returns (z: bool); 4 | var w: bool; 5 | let 6 | w = merge x (y and (z when x)) 7 | (z when not x); 8 | z = false fby w; 9 | tel 10 | 11 | node h(x: bool) 12 | returns (y: bool); 13 | let 14 | y = true fby not x; 15 | tel 16 | 17 | node g(x: bool) 18 | returns (y: bool); 19 | let 20 | (* The only way this expression could be correct, would be to 21 | name the output of h(x) and use it to sample the constant 22 | argument: 23 | w = h(x); 24 | y = f(w, false when w); 25 | *) 26 | y = f(h(x), false); 27 | tel 28 | 29 | -------------------------------------------------------------------------------- /benchs/rer-reset.lus: -------------------------------------------------------------------------------- 1 | (* 2 | This example is adapted from §1.2.2, Pouzet 2006. “The Lucid Synchrone 3 | reference manual”, version 3. See also Bourke, Jeanmaire, Pesin, and Pouzet, 4 | JFLA 2021. 5 | *) 6 | node count_down(n : int) 7 | returns (cpt : int) 8 | let 9 | cpt = n fby (cpt - 1); 10 | tel 11 | 12 | node rising_edge_retrigger(i : bool; n : int) 13 | returns (o : bool) 14 | var edge, ck : bool; v : int; 15 | let 16 | edge = i and (false fby (not i)); 17 | ck = edge or (false fby o); 18 | v = merge ck 19 | ((restart count_down every edge)(n when ck)) 20 | 0; 21 | o = v > 0; 22 | tel 23 | 24 | -------------------------------------------------------------------------------- /examples/rer-reset.lus: -------------------------------------------------------------------------------- 1 | (* 2 | This example is adapted from §1.2.2, Pouzet 2006. “The Lucid Synchrone 3 | reference manual”, version 3. See also Bourke, Jeanmaire, Pesin, and Pouzet, 4 | JFLA 2021. 5 | *) 6 | node count_down(n : int) 7 | returns (cpt : int) 8 | let 9 | cpt = n fby (cpt - 1); 10 | tel 11 | 12 | node rising_edge_retrigger(i : bool; n : int) 13 | returns (o : bool) 14 | var edge, ck : bool; v : int; 15 | let 16 | edge = i and (false fby (not i)); 17 | ck = edge or (false fby o); 18 | v = merge ck 19 | ((restart count_down every edge)(n when ck)) 20 | 0; 21 | o = v > 0; 22 | tel 23 | 24 | -------------------------------------------------------------------------------- /benchs/rer.lus: -------------------------------------------------------------------------------- 1 | (* 2 | This example is adapted from §1.2.2, Pouzet 2006. “The Lucid Synchrone 3 | reference manual”, version 3. See also Bourke, Jeanmaire, Pesin, and Pouzet, 4 | JFLA 2021. 5 | *) 6 | node count_down(res : bool; n : int) 7 | returns (cpt : int) 8 | let 9 | cpt = if res then n else (n fby (cpt - 1)); 10 | tel 11 | 12 | node rising_edge_retrigger(i : bool; n : int) 13 | returns (o : bool) 14 | var edge, ck : bool; v : int; 15 | let 16 | edge = i and (false fby (not i)); 17 | ck = edge or (false fby o); 18 | v = merge ck 19 | (count_down((edge, n) when ck)) 20 | (0 when not ck); 21 | o = v > 0; 22 | tel 23 | 24 | -------------------------------------------------------------------------------- /examples/rer.lus: -------------------------------------------------------------------------------- 1 | (* 2 | This example is adapted from §1.2.2, Pouzet 2006. “The Lucid Synchrone 3 | reference manual”, version 3. See also Bourke, Jeanmaire, Pesin, and Pouzet, 4 | JFLA 2021. 5 | *) 6 | node count_down(res : bool; n : int) 7 | returns (cpt : int) 8 | let 9 | cpt = if res then n else (n fby (cpt - 1)); 10 | tel 11 | 12 | node rising_edge_retrigger(i : bool; n : int) 13 | returns (o : bool) 14 | var edge, ck : bool; v : int; 15 | let 16 | edge = i and (false fby (not i)); 17 | ck = edge or (false fby o); 18 | v = merge ck 19 | (count_down((edge, n) when ck)) 20 | (0 when not ck); 21 | o = v > 0; 22 | tel 23 | 24 | -------------------------------------------------------------------------------- /src/Lustre/Parser/Makefile: -------------------------------------------------------------------------------- 1 | include ../../../variables.mk 2 | 3 | .PHONY: all clean 4 | 5 | all: LustreParser.v LustreLexer.ml LustreParser2.ml LustreParser2.mli 6 | 7 | clean: 8 | rm -f LustreParser.v LustreLexer.ml LustreParser2.ml LustreParser2.mli LustreParser2.mly 9 | 10 | cleanall: clean 11 | 12 | LustreParser.v: LustreParser.vy 13 | $(MENHIR) --explain --no-stdlib --coq --coq-no-version-check $< 14 | 15 | LustreParser2.mly: LustreParser.vy 16 | $(MENHIR) --no-stdlib --coq --only-preprocess-u $< > $@ 17 | 18 | LustreLexer.ml: LustreLexer.mll 19 | ocamllex $< 20 | 21 | LustreParser2.ml LustreParser2.mli: LustreParser2.mly 22 | $(MENHIR) --no-stdlib --table $< 23 | -------------------------------------------------------------------------------- /src/Lustre/Parser/README.md: -------------------------------------------------------------------------------- 1 | 2 | 3 | Running the parser from the OCaml top level 4 | ------------------------------------------- 5 | 6 | First build the parser and lexer: 7 | ``` 8 | make extraction/Parser.cma Lexer.cmo 9 | ``` 10 | 11 | Then load them into the top-level: 12 | ``` 13 | rlwrap ocaml 14 | #directory "extraction";; 15 | #load "Parser.cma";; 16 | #load "Lexer.cmo";; 17 | let s = Lexer.tokens_stream "test.lus";; 18 | let rec fn n = if n = 0 then Datatypes.O else Datatypes.S (fn (n - 1));; 19 | let r = Parser.translation_unit_file (fn 100) s;; 20 | let Parser.Parser.Inter.Parsed_pr (r', s') = r;; 21 | let r'' = (Obj.magic r' : Ast.declaration list);; 22 | ``` 23 | 24 | -------------------------------------------------------------------------------- /tests/ok_depout6.lus: -------------------------------------------------------------------------------- 1 | 2 | node f(a: bool) 3 | returns (y: bool; z: bool when y); 4 | let 5 | y = false fby a; 6 | z = true when y; 7 | tel 8 | 9 | node g(a: bool; b: bool when a) 10 | returns (x: bool; y: bool when x); 11 | let 12 | x = merge a true false; 13 | y = (merge a b false) when x; 14 | tel 15 | 16 | node main(b: bool) 17 | returns (w: bool; x: bool when w) 18 | var y1 : bool; z1 : bool when y1; 19 | x2 : bool; y2 : bool when x2; 20 | x3 : bool; y3 : bool when x3; 21 | x4 : bool; y4 : bool when x4; 22 | let 23 | (y1, z1) = f(b); 24 | (x2, y2) = g(y1, z1); 25 | (x3, y3) = g(x2, y2); 26 | (x4, y4) = g(x3, y3); 27 | (w, x) = g(x4, y4); 28 | tel 29 | 30 | -------------------------------------------------------------------------------- /benchs/tracker.ept: -------------------------------------------------------------------------------- 1 | node counter(ini, inc: int; rest: bool) returns (n: int) 2 | let 3 | n = if (true fby false) or rest then ini else (1 fby n) + inc; 4 | tel 5 | 6 | node d_integrator(gamma: int) 7 | returns (speed, position: int) 8 | let 9 | speed = counter(0, gamma, false); 10 | position = counter(0, speed, false); 11 | tel 12 | 13 | node rising(s: bool) returns (edge: bool) 14 | let 15 | edge = not (true fby s) and s; 16 | tel 17 | 18 | node tracker(acc, limit: int) returns (p, t: int) 19 | var s : int; x : bool; 20 | let 21 | x = rising(s > limit); 22 | (s, p) = d_integrator(acc); 23 | t = merge x (true -> counter(1 when x, 1 when x, false when x)) 24 | (false -> (0 fby t) when not x); 25 | tel 26 | 27 | -------------------------------------------------------------------------------- /benchs/tracker.lus: -------------------------------------------------------------------------------- 1 | node counter(ini, inc: int; rest: bool) returns (n: int) 2 | let 3 | n = if (true fby false) or rest then ini else (1 fby n) + inc; 4 | tel 5 | 6 | node d_integrator(gamma: int) 7 | returns (speed, position: int) 8 | let 9 | speed = counter(0, gamma, false); 10 | position = counter(0, speed, false); 11 | tel 12 | 13 | node rising(s: bool) returns (edge: bool) 14 | let 15 | edge = not (true fby s) and s; 16 | tel 17 | 18 | node tracker(acc, limit: int) returns (p, t: int) 19 | var s : int; x : bool; 20 | let 21 | x = rising(s > limit); 22 | (s, p) = d_integrator(acc); 23 | t = merge x (true => counter(1 when x, 1 when x, false when x)) 24 | (false => (0 fby t) when not x); 25 | tel 26 | 27 | -------------------------------------------------------------------------------- /examples/tracker.lus: -------------------------------------------------------------------------------- 1 | node counter (ini:int; inc:int; rest:bool) returns (n:int) 2 | let 3 | n = if rest then ini else ((0 fby n) + inc); 4 | tel 5 | 6 | node d_integrator(gamma: int) 7 | returns (speed, position: int) 8 | let 9 | speed = counter(0, gamma, false); 10 | position = counter(0, speed, false); 11 | tel 12 | 13 | node rising(s: bool) returns (edge: bool) 14 | let 15 | edge = not (true fby s) and s; 16 | tel 17 | 18 | node tracker(acc, limit: int) returns (p, t: int) 19 | var s : int; x : bool; 20 | let 21 | x = rising(s > limit); 22 | (s, p) = d_integrator(acc); 23 | t = merge x 24 | (true => counter(1 when x, 1 when x, false when x)) 25 | (false => (0 fby t) when not x); 26 | tel 27 | 28 | -------------------------------------------------------------------------------- /tests/ok_whenmulti2.lus: -------------------------------------------------------------------------------- 1 | 2 | node f (a : bool) 3 | returns (x, y : bool) 4 | let 5 | x = a; 6 | y = false fby not a; 7 | tel 8 | 9 | node multimerge (a, b : bool) 10 | returns (y : bool) 11 | var w1, w2, w3, w4 : bool when a; 12 | x : bool when not a; 13 | let 14 | (* Works in Lustre v6. 15 | 16 | Fails in Heptagon with: 17 | > (w1, w2, w3, w4) = (f(b), f(not b)) when a; 18 | > ^^^^^^^^^^^^^^^^^^^^^^^ 19 | Type Clash: this expression has type ((bool * bool) * (bool * bool)), 20 | but is expected to have type (bool * bool * bool * bool). 21 | *) 22 | (w1, w2, w3, w4) = (f(b), f(not b)) when a; 23 | x = b when not a; 24 | y = merge a w1 x; 25 | tel 26 | 27 | -------------------------------------------------------------------------------- /tests/ok_tuples.lus: -------------------------------------------------------------------------------- 1 | 2 | node swap (a, b : bool) 3 | returns (x, y : bool); 4 | let 5 | x = true fby b; 6 | y = a; 7 | tel 8 | 9 | node shuffle (a, b, c, d : bool) 10 | returns (w, x, y, z : bool); 11 | let 12 | (w, x) = swap(a, b); 13 | (y, z) = swap(c, d); 14 | tel 15 | 16 | node main (a, b, c, d : bool) 17 | returns (w, x, y, z : bool); 18 | let 19 | /* Accepted by Lustre v6. 20 | Rejected by Heptagon: 21 | > (w, x, y, z) = shuffle(((a, (b, (c)), d))); 22 | > ^^^^^^^^^^^^^^^^^^^^^^^^^^^ 23 | Type Clash: arguments of type (bool * (bool * bool) * bool) were given, 24 | but (bool * bool * bool * bool) was expected. 25 | 26 | What does Scade do? 27 | */ 28 | (w, x, y, z) = shuffle(((a, (b, (c)), d))); 29 | tel 30 | 31 | -------------------------------------------------------------------------------- /tests/ok_parseprec.lus: -------------------------------------------------------------------------------- 1 | 2 | node f1(a : bool; b : int when a) returns (y : int when a); 3 | let 4 | y = b * (2 when a); 5 | tel 6 | 7 | node f2(a : bool; b : int when a) returns (y : int when a); 8 | let 9 | y = b + (1 when a); 10 | tel 11 | 12 | node f3(a : bool; b : int when a) returns (y : bool when a); 13 | let 14 | y = b < 1 when a; (* b < (1 when a) *) 15 | tel 16 | 17 | node f4(a : bool; b : bool when a) returns (y : bool when a); 18 | let 19 | y = b = false when a; (* b = (false when a) *) 20 | tel 21 | 22 | node f5(a : bool; b : bool when a) returns (y : bool when a); 23 | let 24 | y = b and false when a; (* b & (false when a) *) 25 | tel 26 | 27 | node f6(a : bool; b : bool when a) returns (y : bool when a); 28 | let 29 | y = b or false when a; (* b or (false when a) *) 30 | tel 31 | 32 | -------------------------------------------------------------------------------- /tests/ok_parseprec_when.lus: -------------------------------------------------------------------------------- 1 | 2 | node f1(a : bool; b : int when a) returns (y : int when a); 3 | let 4 | y = b * 2; (* b * (2 when a) *) 5 | tel 6 | 7 | node f2(a : bool; b : int when a) returns (y : int when a); 8 | let 9 | y = b + 1; (* b + (1 when a) *) 10 | tel 11 | 12 | node f3(a : bool; b : int when a) returns (y : bool when a); 13 | let 14 | y = b < 1; (* b < (1 when a) *) 15 | tel 16 | 17 | node f4(a : bool; b : bool when a) returns (y : bool when a); 18 | let 19 | y = b = false; (* b = (false when a) *) 20 | tel 21 | 22 | node f5(a : bool; b : bool when a) returns (y : bool when a); 23 | let 24 | y = b and false; (* b & (false when a) *) 25 | tel 26 | 27 | node f6(a : bool; b : bool when a) returns (y : bool when a); 28 | let 29 | y = b or false; (* b or (false when a) *) 30 | tel 31 | 32 | -------------------------------------------------------------------------------- /tools/Makefile: -------------------------------------------------------------------------------- 1 | # Makefile for rat 2 | # TODO: put rules in velus/Makefile instead? 3 | 4 | # avoid some findlib warnings about compiler-libs module names 5 | export OCAMLFIND_IGNORE_DUPS_IN = $(shell ocamlc -where)/compiler-libs 6 | 7 | OCAMLOPT=ocamlfind ocamlopt -package compiler-libs.common -linkpkg 8 | OCAMLLEX=ocamllex 9 | 10 | all: vltohtml rat coq2texlines 11 | 12 | vltohtml: vltohtml.cmx 13 | $(OCAMLOPT) -o $@ $^ 14 | 15 | rat: rat.cmx 16 | $(OCAMLOPT) -o rat rat.cmx 17 | 18 | coq2texlines: coq2texlines.cmx 19 | $(OCAMLOPT) -o coq2texlines coq2texlines.cmx 20 | 21 | %.cmx: %.ml 22 | $(OCAMLOPT) -c $*.ml 23 | 24 | %.ml: %.mll 25 | $(OCAMLLEX) $*.mll 26 | 27 | clean: 28 | rm -f rat 29 | rm -f rat.ml 30 | rm -f rat.o rat.cm? 31 | 32 | cleanall: clean 33 | 34 | # PREFIX=/usr/local 35 | # BINDIR=$(PREFIX)/bin 36 | 37 | # install: 38 | # install rat $(BINDIR)/rat 39 | -------------------------------------------------------------------------------- /tests/ok_clockedcapp.lus: -------------------------------------------------------------------------------- 1 | 2 | node f(x: bool) 3 | returns (y: bool when z; z: bool); 4 | let 5 | z = false fby (not z); 6 | y = x when z; 7 | tel 8 | 9 | (* y :: 'a on x on z z:: 'a on x x :: 'a *) 10 | node g(y: bool when z; z: bool when x; x: bool) 11 | returns (o: bool when x) 12 | let 13 | o = false fby (not z); 14 | tel 15 | 16 | node h(x: bool) 17 | returns (y: bool); 18 | var w: bool when x; 19 | z1: bool when x; y1: bool when z1; 20 | let 21 | y = merge x w false; 22 | (* The correct form is: 23 | w = g(f(true when x), x); 24 | 25 | This example tests whether the compiler infers the missing 26 | "when" across node applications. 27 | 28 | The nested form is not available, as we have simplified the 29 | clock system of the language to remove anonymous clock variables. 30 | *) 31 | (y1, z1) = f(true); 32 | w = g(y1, z1, x); 33 | tel 34 | 35 | -------------------------------------------------------------------------------- /tests/ok_deadcode.lus: -------------------------------------------------------------------------------- 1 | node dead(x : bool) returns (y : int) 2 | var z : int; 3 | let 4 | y = if x then 0 else 1; 5 | z = 1; 6 | tel 7 | 8 | node notdead(x : bool) returns (y : int) 9 | var z : int; 10 | let 11 | y = if x then 0 else z; 12 | z = 1; 13 | tel 14 | 15 | node self(x : bool) returns (y : int) 16 | var z : int; 17 | let 18 | y = if x then 0 else 1; 19 | z = 0 fby (z + 1); 20 | tel 21 | 22 | node cyclic(x : bool) returns (y : int) 23 | var t1, t2 : int; 24 | let 25 | t1 = 0 fby t2; 26 | t2 = 0 fby t1; 27 | y = 1; 28 | tel 29 | 30 | node f(x : bool) returns (y, z : int) 31 | let 32 | (y, z) = (0, 0); 33 | tel 34 | 35 | node app_dead(x : bool) returns (y : int) 36 | var t1, t2 : int; 37 | let 38 | (t1, t2) = f(x); 39 | y = 0; 40 | tel 41 | 42 | node app_onedead(x : bool) returns (y : int) 43 | var t : int; 44 | let 45 | (t, y) = f(x) 46 | tel 47 | -------------------------------------------------------------------------------- /tests/ok_cut_next_cycles.lus: -------------------------------------------------------------------------------- 1 | node f1(a : int) returns (b : int) 2 | var x, y : int; 3 | let 4 | x = 0 fby (y + a); 5 | y = 0 fby (x - a); 6 | b = x + y; 7 | tel 8 | 9 | node f2(a : int) returns (b : int) 10 | var x, y, z : int; 11 | let 12 | x = 0 fby (z + a); 13 | y = 0 fby x; 14 | z = 0 fby y; 15 | b = x; 16 | tel 17 | 18 | node f3(a : int) returns (b : int) 19 | var x1, x2, y1, y2 : int; 20 | let 21 | x1 = 0 fby (y1 + a); 22 | y1 = 0 fby (x1 - a); 23 | x2 = 0 fby (y2 + a); 24 | y2 = 0 fby (x2 - a); 25 | b = x1 + y2; 26 | tel 27 | 28 | node f4(a : int) returns (b : int) 29 | var x, y, z : int; 30 | let 31 | x = 0 fby (y + z); 32 | y = 0 fby (x - a); 33 | z = 0 fby y; 34 | b = z; 35 | tel 36 | 37 | node f5(a : bool) returns (b : bool) 38 | var x, y : bool; 39 | let 40 | x = true fby y; 41 | reset 42 | y = false fby (not y); 43 | every x; 44 | b = x; 45 | tel 46 | -------------------------------------------------------------------------------- /tests/ok_cut_last_cycles.lus: -------------------------------------------------------------------------------- 1 | node twolast(a : int) returns (z : int) 2 | var x, y : int; 3 | let 4 | last x = 0; 5 | last y = 0; 6 | x = last y + 1; 7 | y = last x + 1; 8 | z = x + y; 9 | tel 10 | 11 | node twolastout(a : int) returns (x, y : int) 12 | let 13 | last x = 0; 14 | last y = 0; 15 | x = last y + 1; 16 | y = last x + 1; 17 | tel 18 | 19 | node plus(a : int) returns (y : int) 20 | var x : int; 21 | let 22 | last x = 0; 23 | x = last x + 1; 24 | y = last x + x; 25 | tel 26 | 27 | node drive_sequence(step : bool) returns (motA, motB : bool) 28 | let 29 | last motA = true; 30 | last motB = true; 31 | switch step 32 | | true do (motA, motB) = (not (last motB), last motA) 33 | | false do 34 | end; 35 | tel 36 | 37 | node lastfby(b : int) returns (z : int) 38 | var x, y : int; 39 | let 40 | x = 0 fby last y; 41 | y = x; 42 | last y = 0; 43 | z = x + y; 44 | tel 45 | -------------------------------------------------------------------------------- /.gitlab-ci.yml: -------------------------------------------------------------------------------- 1 | variables: 2 | GIT_SUBMODULE_STRATEGY: recursive 3 | 4 | cache: 5 | paths: 6 | - ./CompCert/ 7 | 8 | stages: 9 | - CompCert 10 | - proof 11 | - build 12 | - test 13 | 14 | CompCert-job: 15 | stage: CompCert 16 | script: 17 | - echo "Hello" 18 | - test -f "./CompCert/Makefile.config" || (cd CompCert/ && ./configure x86_64-linux) 19 | - make -C CompCert -j 20 | 21 | proof-job: 22 | stage: proof 23 | artifacts: 24 | untracked: true 25 | paths: 26 | - ./src/ 27 | script: 28 | - echo "Hello" 29 | - TERM=xterm-mono make clean 30 | - ./configure x86_64-linux --velus-only 31 | - TERM=xterm-mono make -j 4 proof 32 | 33 | build-job: 34 | stage: build 35 | artifacts: 36 | paths: 37 | - ./_build/ 38 | - ./velus 39 | script: 40 | - echo "Hello" 41 | - make -j 4 42 | 43 | test-job: 44 | stage: test 45 | script: 46 | - cd tests/ 47 | - ./runtests.sh 48 | -------------------------------------------------------------------------------- /benchs/colors.lus: -------------------------------------------------------------------------------- 1 | (** 2 | * Adaptation of pattern matching example 3 | * From the Pouzet, Lucid Synchrone Manual V3 4 | * Section 1.4.2 5 | *) 6 | 7 | type color = Blue | Red | Green 8 | type dir = Immobile | Clockwise | Anticlockwise | Undet 9 | 10 | node direction(i : color) returns (d : dir) 11 | var pi, ppi : color; 12 | let 13 | pi = i fby i; 14 | ppi = i fby pi; 15 | switch i 16 | | Blue do 17 | d = case pi of 18 | (Blue => if ppi = Blue then Immobile else Undet) 19 | (Red => Clockwise) 20 | (Green => Anticlockwise); 21 | | Red do 22 | d = case i of 23 | (Red => if ppi = Red then Immobile else Undet) 24 | (Green => Clockwise) 25 | (Blue => Anticlockwise); 26 | | Green do 27 | d = case i of 28 | (Green => if ppi = Green then Immobile else Undet) 29 | (Red => Anticlockwise) 30 | (Blue => Clockwise); 31 | end 32 | tel 33 | -------------------------------------------------------------------------------- /examples/colors.lus: -------------------------------------------------------------------------------- 1 | (** 2 | * Adaptation of pattern matching example 3 | * From the Pouzet, Lucid Synchrone Manual V3 4 | * Section 1.4.2 5 | *) 6 | 7 | type color = Blue | Red | Green 8 | type dir = Immobile | Clockwise | Anticlockwise | Undet 9 | 10 | node direction(i : color) returns (d : dir) 11 | var pi, ppi : color; 12 | let 13 | pi = i fby i; 14 | ppi = i fby pi; 15 | switch i 16 | | Blue do 17 | d = case pi of 18 | (Blue => if ppi = Blue then Immobile else Undet) 19 | (Red => Clockwise) 20 | (Green => Anticlockwise); 21 | | Red do 22 | d = case i of 23 | (Red => if ppi = Red then Immobile else Undet) 24 | (Green => Clockwise) 25 | (Blue => Anticlockwise); 26 | | Green do 27 | d = case i of 28 | (Green => if ppi = Green then Immobile else Undet) 29 | (Red => Anticlockwise) 30 | (Blue => Clockwise); 31 | end 32 | tel 33 | -------------------------------------------------------------------------------- /tools/opam.sh: -------------------------------------------------------------------------------- 1 | #!/usr/bin/env sh 2 | 3 | # Test if VELUS_DIR is set to avoid going into the home directory 4 | if [ -z ${VELUS_DIR+x} ]; then VELUS_DIR=.; fi 5 | 6 | # The architecture to use to configure Compcert 7 | if [ -z ${ARCH+x} ]; then ARCH=ia32-linux; fi 8 | 9 | cd $VELUS_DIR 10 | mkdir opam 11 | opam init --root=opam --compiler=4.02.3 -n 12 | eval `opam config env --root=$VELUS_DIR/opam` 13 | opam repo add coq-released https://coq.inria.fr/opam/released 14 | opam install -y -j20 coq.8.4.6 menhir.20160825 15 | opam pin add coq 8.4.6 # to get the correct version of coqide 16 | make clean 17 | make -C CompCert/ clean 18 | ./CompCert/configure $ARCH -prefix $VELUS_DIR/opam/4.02.3 19 | make -j 20 | echo "To test the velus compiler, go to the examples/ directory and compile all 21 | examples with 'make'." 22 | echo "If you want to use the CoqIDE editor to browse the Coq development, you 23 | can install it with 'opam install coqide'. You may need the libgtksourceview2.0-dev package installed in your system." 24 | -------------------------------------------------------------------------------- /benchs/minus.lus: -------------------------------------------------------------------------------- 1 | (* minus example from the lustre v4 distribution. *) 2 | 3 | node two_vstates(set,vreset,vinit:bool) returns (vstate:bool); 4 | let 5 | vstate = vinit -> (if set and not (false fby vstate) then true 6 | else if vreset and (false fby vstate) then false 7 | else false fby vstate); 8 | tel; 9 | 10 | node one_button(change,vinit: bool) returns (vstate:bool); 11 | let 12 | vstate = vinit -> (if change then not (false fby vstate) 13 | else (false fby vstate)); 14 | tel; 15 | 16 | node two_buttons(von,voff,vinit:bool) returns(vstate:bool); 17 | let 18 | vstate = vinit -> (if von then true 19 | else if voff then false 20 | else (false fby vstate)); 21 | tel; 22 | 23 | node minus (e1,e2,e3,vvinit:bool) returns (ok:bool); 24 | var s1,s2,s3,s4:bool; 25 | let 26 | s1= two_vstates(e1,e2,vvinit); 27 | s2= two_buttons(e1,e2,vvinit); 28 | s3= two_vstates(e3,e3,vvinit); 29 | s4= one_button(e3,vvinit); 30 | ok =(s1=s2) and (s3=s4); 31 | tel; 32 | 33 | -------------------------------------------------------------------------------- /examples/minus.lus: -------------------------------------------------------------------------------- 1 | (* minus example from the lustre v4 distribution. *) 2 | 3 | node two_vstates(set,vreset,vinit:bool) returns (vstate:bool); 4 | let 5 | vstate = vinit -> (if set and not (false fby vstate) then true 6 | else if vreset and (false fby vstate) then false 7 | else false fby vstate); 8 | tel; 9 | 10 | node one_button(change,vinit: bool) returns (vstate:bool); 11 | let 12 | vstate = vinit -> (if change then not (false fby vstate) 13 | else (false fby vstate)); 14 | tel; 15 | 16 | node two_buttons(von,voff,vinit:bool) returns(vstate:bool); 17 | let 18 | vstate = vinit -> (if von then true 19 | else if voff then false 20 | else (false fby vstate)); 21 | tel; 22 | 23 | node minus (e1,e2,e3,vvinit:bool) returns (ok:bool); 24 | var s1,s2,s3,s4:bool; 25 | let 26 | s1= two_vstates(e1,e2,vvinit); 27 | s2= two_buttons(e1,e2,vvinit); 28 | assert not(e1 and e2); 29 | s3= two_vstates(e3,e3,vvinit); 30 | s4= one_button(e3,vvinit); 31 | ok =(s1=s2) and (s3=s4); 32 | tel; 33 | 34 | -------------------------------------------------------------------------------- /benchs/nav.lus: -------------------------------------------------------------------------------- 1 | node euler(x0, u: float64) returns (x: float64); 2 | var i: bool; px: float64; 3 | let 4 | i = true fby false; 5 | x = if i then x0 else (px + 0.1 * u); 6 | px = 0.0 fby x; 7 | tel 8 | 9 | node ins(gps, xv: float64) returns (x: float64; alarm: bool); 10 | var k: int; px: float64; xe: float64 when not alarm; 11 | let 12 | k = 0 fby (k + 1); 13 | alarm = (k >= 50); 14 | xe = euler(gps when not alarm, xv when not alarm); 15 | x = merge alarm (px when alarm) xe; 16 | px = 0. fby x; 17 | tel 18 | 19 | node driver(gps, xv, yv : float64; r : bool) 20 | returns (x, y : float64); 21 | var alarmx, alarmy : bool; 22 | let 23 | x, alarmx = (restart ins every r)(gps, xv); 24 | y, alarmy = (restart ins every r)(gps, yv); 25 | tel 26 | 27 | node nav(gps, xv: float64; s: bool) returns (x: float64; alarm: bool); 28 | var r, c, cm: bool; insr: float64 when not c; alr: bool when not c; 29 | let 30 | insr, alr = (restart ins every r) (gps when not c, xv when not c); 31 | x = merge c (gps when c) insr; 32 | alarm = merge c false alr; 33 | cm = merge c (not s when c) (s when not c); 34 | c = true fby cm; 35 | r = false fby (s and c); 36 | tel 37 | -------------------------------------------------------------------------------- /examples/nav.lus: -------------------------------------------------------------------------------- 1 | node euler(x0, u: float64) returns (x: float64); 2 | var i: bool; px: float64; 3 | let 4 | i = true fby false; 5 | x = if i then x0 else (px + 0.1 * u); 6 | px = 0.0 fby x; 7 | tel 8 | 9 | node ins(gps, xv: float64) returns (x: float64; alarm: bool); 10 | var k: int; px: float64; xe: float64 when not alarm; 11 | let 12 | k = 0 fby (k + 1); 13 | alarm = (k >= 50); 14 | xe = euler(gps when not alarm, xv when not alarm); 15 | x = merge alarm (px when alarm) xe; 16 | px = 0. fby x; 17 | tel 18 | 19 | node driver(gps, xv, yv : float64; r : bool) 20 | returns (x, y : float64); 21 | var alarmx, alarmy : bool; 22 | let 23 | x, alarmx = (restart ins every r)(gps, xv); 24 | y, alarmy = (restart ins every r)(gps, yv); 25 | tel 26 | 27 | node nav(gps, xv: float64; s: bool) returns (x: float64; alarm: bool); 28 | var r, c, cm: bool; insr: float64 when not c; alr: bool when not c; 29 | let 30 | insr, alr = (restart ins every r) (gps when not c, xv when not c); 31 | x = merge c (gps when c) insr; 32 | alarm = merge c false alr; 33 | cm = merge c (not s when c) (s when not c); 34 | c = true fby cm; 35 | r = false fby (s and c); 36 | tel 37 | -------------------------------------------------------------------------------- /tests/runtests.sh: -------------------------------------------------------------------------------- 1 | #!/usr/bin/env sh 2 | 3 | VELUS="../velus ${VELUSARGS}" 4 | 5 | CGREEN='\033[32m' 6 | CRED='\033[31m' 7 | CBLUE='\033[34m' 8 | CDEF='\033[39m' 9 | 10 | OK=0 11 | OK_FAILURE=0 12 | OK_SUCCESS=0 13 | 14 | for f in ok_*.lus 15 | do 16 | printf "%b--%s%b\n" "${CGREEN}" "$f" "${CDEF}" 17 | OK=$(( OK + 1 )) 18 | if $VELUS "$f" >/dev/null; then 19 | OK_SUCCESS=$(( OK_SUCCESS + 1 )) 20 | else 21 | printf "%bfailed%b\n" "${CRED}" "${CDEF}" 22 | OK_FAILURE=$(( OK_FAILURE + 1 )) 23 | fi 24 | done 25 | 26 | KO=0 27 | KO_FAILURE=0 28 | KO_SUCCESS=0 29 | 30 | for f in ko_*.lus 31 | do 32 | printf "%b--%s%b\n" "${CBLUE}" "$f" "${CDEF}" 33 | KO=$(( KO + 1 )) 34 | if $VELUS "$f" 2>&1; then 35 | printf "%bfailed%b\n" "${CRED}" "${CDEF}" 36 | KO_FAILURE=$(( KO_FAILURE + 1 )) 37 | else 38 | KO_SUCCESS=$(( KO_SUCCESS + 1 )) 39 | fi 40 | done 41 | 42 | printf "\n" 43 | printf -- "--%bOK success: %d / %d%b\n" \ 44 | "${CGREEN}" "${OK_SUCCESS}" "${OK}" "${CDEF}" 45 | printf -- "--%bKO success: %d / %d%b\n" \ 46 | "${CBLUE}" "${KO_SUCCESS}" "${KO}" "${CDEF}" 47 | 48 | if [[ $OK != $OK_SUCCESS || $KO != $KO_SUCCESS ]] 49 | then 50 | exit 1 51 | fi 52 | -------------------------------------------------------------------------------- /benchs/chrono.ept: -------------------------------------------------------------------------------- 1 | (* Examples from the paper 2 | "A Conservative Extension of Synchronous Data-flow with State Machines", 3 | Colaço, Pagano, and Pouzet, EMSOFT 2005 *) 4 | 5 | node chrono (stst, rst : bool) returns (last disp_1 : int = 0; 6 | last disp_2 : int = 0); 7 | var last s : int = 0; 8 | last m : int = 0; 9 | run : bool; 10 | let 11 | automaton 12 | state CHRONO do 13 | automaton 14 | state STOP do 15 | s = 0 -> last s; 16 | m = 0 -> last m; 17 | run = false; 18 | unless stst continue START 19 | 20 | state START var d : int; do 21 | d = 0 fby (d + 1); 22 | s = if d < (0 fby d) then (last s + 1) % 60 23 | else last s; 24 | m = if s < last s 25 | then (last m + 1) % 60 26 | else last m; 27 | run = true; 28 | unless stst continue STOP 29 | end 30 | until rst and not run then CHRONO 31 | end; 32 | 33 | automaton 34 | state TIME do 35 | disp_1 = s; 36 | disp_2 = m; 37 | until rst and run then LAP 38 | 39 | state LAP do 40 | until rst then TIME 41 | end; 42 | tel 43 | -------------------------------------------------------------------------------- /examples/chrono.lus: -------------------------------------------------------------------------------- 1 | (* Examples from the paper 2 | "A Conservative Extension of Synchronous Data-flow with State Machines", 3 | Colaço, Pagano, and Pouzet, EMSOFT 2005 *) 4 | 5 | node chrono (stst, rst : bool) returns (disp_1, disp_2 : int); 6 | var s, m : int; run : bool; 7 | let 8 | last s = 0; last m = 0; 9 | automaton 10 | initially CHRONO 11 | state CHRONO do 12 | automaton 13 | initially STOP 14 | state STOP do 15 | s = 0 -> last s; 16 | m = 0 -> last m; 17 | run = false; 18 | unless stst continue START 19 | 20 | state START var d : int; do 21 | d = 0 fby (d + 1); 22 | s = if d < (0 fby d) then (last s + 1) mod 60 23 | else last s; 24 | m = if s < last s 25 | then (last m + 1) mod 60 26 | else last m; 27 | run = true; 28 | unless stst continue STOP 29 | end 30 | until rst and not run then CHRONO 31 | end; 32 | 33 | last disp_1 = 0; last disp_2 = 0; 34 | automaton 35 | initially TIME 36 | state TIME do 37 | disp_1 = s; 38 | disp_2 = m; 39 | until rst and run then LAP 40 | 41 | state LAP do 42 | until rst then TIME 43 | end; 44 | tel 45 | -------------------------------------------------------------------------------- /benchs/chrono.lus: -------------------------------------------------------------------------------- 1 | (* Examples from the paper 2 | "A Conservative Extension of Synchronous Data-flow with State Machines", 3 | Colaço, Pagano, and Pouzet, EMSOFT 2005 *) 4 | 5 | node chrono (stst, rst : bool) returns (disp_1 : int; disp_2 : int); 6 | var s, m : int; run : bool; 7 | let 8 | last s = 0; 9 | last m = 0; 10 | last disp_1 = 0; 11 | last disp_2 = 0; 12 | 13 | automaton 14 | initially CHRONO 15 | state CHRONO do 16 | automaton 17 | initially STOP 18 | state STOP do 19 | s = 0 -> last s; 20 | m = 0 -> last m; 21 | run = false; 22 | unless stst continue START 23 | 24 | state START var d : int; do 25 | d = 0 fby (d + 1); 26 | s = if d < (0 fby d) then (last s + 1) mod 60 27 | else last s; 28 | m = if s < last s 29 | then (last m + 1) mod 60 30 | else last m; 31 | run = true; 32 | unless stst continue STOP 33 | end 34 | until rst and not run then CHRONO 35 | end; 36 | 37 | automaton 38 | initially TIME 39 | state TIME do 40 | disp_1 = s; 41 | disp_2 = m; 42 | until rst and run then LAP 43 | 44 | state LAP do 45 | until rst then TIME 46 | end; 47 | tel 48 | -------------------------------------------------------------------------------- /examples/Makefile: -------------------------------------------------------------------------------- 1 | .PRECIOUS: %.s 2 | 3 | VELUS=../velus 4 | VELUS_OPT=-lib -dsch -dobc 5 | 6 | # CompCert 7 | 8 | ARCH_FLAGS=-mfloat-abi=hard -march=armv7-a -mfpu=vfpv3-d16 9 | 10 | COMPCERT=$(realpath ../CompCert) 11 | CCOMP=$(COMPCERT)/ccomp 12 | CCOMP_OPT=-stdlib $(COMPCERT)/runtime 13 | 14 | EXAMPLES = \ 15 | avgvelocity.lus \ 16 | count.lus \ 17 | rer.lus \ 18 | rer-reset.lus \ 19 | cruise.lus \ 20 | emsoft03.lus \ 21 | emsoft05.lus \ 22 | halbwachs.lus \ 23 | kind_functionalChain.lus \ 24 | landing_gear.lus \ 25 | minus.lus \ 26 | nav.lus \ 27 | pip_ex.lus \ 28 | prodcell.lus \ 29 | tracker.lus \ 30 | ums_verif.lus \ 31 | cocospec_mono_system.lus \ 32 | new_watch.lus \ 33 | stopwatch.lus \ 34 | abro.lus \ 35 | colors.lus \ 36 | chrono.lus \ 37 | stepper-motor.lus 38 | 39 | ## Main targets 40 | 41 | all: velus 42 | 43 | velus: $(EXAMPLES:.lus=.exe) 44 | 45 | cleanall: clean 46 | @rm -f $(EXAMPLES:.lus=.exe) 47 | 48 | clean: 49 | @rm -f $(EXAMPLES:.lus=.light.c) $(EXAMPLES:.lus=.s) 50 | @rm -f $(EXAMPLES:.lus=.sync.c) 51 | @rm -f $(EXAMPLES:.lus=.parsed.lus) $(EXAMPLES:.lus=.n.lus) 52 | @rm -f $(EXAMPLES:.lus=.stc) $(EXAMPLES:.lus=.obc) 53 | @rm -f $(EXAMPLES:.lus=.o) 54 | @rm -f $(EXAMPLES:.lus=.sync.o) 55 | 56 | %.s: %.lus 57 | $(VELUS) $(VELUS_OPT) -sync $< 58 | 59 | %.exe: %.s 60 | $(CCOMP) $(V) $(CCOMP_OPT) $(CCOMP_EXTRA) \ 61 | -o $@ $(@:.exe=.sync.c) $< 62 | -------------------------------------------------------------------------------- /tests/ok_clockedcapp2.lus: -------------------------------------------------------------------------------- 1 | 2 | node f(x: bool; s: bool; t: bool when s) 3 | returns (y: bool when z; z: bool); 4 | let 5 | z = false fby (not z); 6 | y = x when z; 7 | tel 8 | 9 | (* y :: 'a on x on z z:: 'a on x x :: 'a *) 10 | node g(y: bool when z; z: bool when x; x: bool) 11 | returns (o: bool when x) 12 | let 13 | o = false fby (not z); 14 | tel 15 | 16 | node h(x: bool; z: bool when x) 17 | returns (y: bool); 18 | var u: bool when w; 19 | v: bool when w; 20 | w: bool when x; 21 | z1: bool when x; y1: bool when z1; 22 | z2: bool when w; y2: bool when z2; 23 | let 24 | y = merge x w false; 25 | (* The correct form is: 26 | w = g(f(true when x, z, false when x when z), x); 27 | 28 | This example tests whether the compiler infers the missing 29 | "when" across node applications. 30 | 31 | The nested form is not available, as we have simplified the 32 | clock system of the language to remove anonymous clock variables. 33 | *) 34 | (y1, z1) = f(true, z, false); 35 | w = g(y1, z1, x); 36 | 37 | u = true when w; 38 | (* The correct form is: 39 | v = g(f(true when x when w, u, false when x when w when u), x); 40 | 41 | This example tests whether the compiler infers the missing 42 | "when" across node applications. 43 | 44 | The nested form is not available, as we have simplified the 45 | clock system of the language to remove anonymous clock variables. 46 | *) 47 | (y2, z2) = f(true, u, false); 48 | v = g(y2, z2, w); 49 | tel 50 | 51 | -------------------------------------------------------------------------------- /examples/stopwatch.lus: -------------------------------------------------------------------------------- 1 | /* The stopwatch examples from 2 | Caspi, Pilaud, Halbwachs, and Plaice, 3 | “LUSTRE: A declarative language for programming synchronous systems”, 4 | POPL 1987 */ 5 | 6 | node current(d : int; ck : bool; x : int when ck) 7 | returns (y : int); 8 | let 9 | y = merge ck x ((d fby y) when not ck); 10 | tel 11 | 12 | node count (init, incr : int; vreset : bool) 13 | returns (n : int); 14 | let 15 | n = init -> (if vreset then init else ((0 fby n) + incr)); 16 | tel 17 | 18 | node two_states (init, set, vreset : bool) 19 | returns (st : bool); 20 | var pst : bool; 21 | let 22 | st = init -> (if set and not pst then true 23 | else if vreset and pst then false 24 | else pst); 25 | pst = false fby st; 26 | tel 27 | 28 | node simple_stopwatch (start_stop, vreset, hs : bool); 29 | returns (time : int); 30 | var ck, running : bool; 31 | let 32 | time = current(0, ck, count((0, 1, vreset) when ck)); 33 | ck = true -> (hs and running) or vreset; 34 | running = two_states(false, start_stop, start_stop); 35 | tel 36 | 37 | node stopwatch (start_stop, hs, lap : bool); 38 | returns (disp_time : int); 39 | var not_in_lap, running, vreset : bool; int_time : int; 40 | let 41 | disp_time = current(0, not_in_lap, int_time when not_in_lap); 42 | not_in_lap = two_states(true, lap, lap and running); 43 | int_time = simple_stopwatch (start_stop, vreset, hs); 44 | running = two_states(false, start_stop, start_stop); 45 | vreset = lap and (true fby not_in_lap) and (false fby (not running)); 46 | tel 47 | 48 | -------------------------------------------------------------------------------- /benchs/emsoft03.lus: -------------------------------------------------------------------------------- 1 | (* examples from the paper 2 | "clocks as first class abstract types", colaço and pouzet, emsoft 2003 *) 3 | 4 | node sum (x: int) returns (s: int); 5 | var ps : int; 6 | let 7 | ps = 0 fby s; 8 | s = ps + x; 9 | tel 10 | 11 | node bounds (x: int) returns (min, max: int); 12 | var vinit : bool; 13 | pre_min, pre_max : int; 14 | let 15 | vinit = true fby false; 16 | pre_min = 0 fby min; 17 | pre_max = 0 fby max; 18 | min = if vinit then x 19 | else if x < pre_min then x 20 | else pre_min; 21 | max = if vinit then x 22 | else if x > pre_max then x 23 | else pre_max; 24 | tel 25 | 26 | node sample (n: int) returns (ok: bool); 27 | var vinit : bool; 28 | cpt, pre_cpt : int; 29 | let 30 | vinit = true fby false; 31 | cpt = if vinit then 0 32 | else if pre_cpt = n - 1 then 0 33 | else pre_cpt + 1; 34 | pre_cpt = 0 fby cpt; 35 | ok = (cpt = 0); 36 | tel 37 | 38 | node count_down (vreset : bool; n : int) returns (cpt : int); 39 | var vinit : bool; 40 | pre_cpt : int; 41 | let 42 | vinit = true fby false; 43 | pre_cpt = 0 fby (cpt - 1); 44 | cpt = if vreset or vinit then n else pre_cpt; 45 | tel 46 | 47 | node risingedgeretrigger (rer_input : bool; numberofcycle : int) 48 | returns (rer_output : bool); 49 | var clk, c, pre_rer_input, count : bool; 50 | v, pv : int; 51 | r : int when clk; 52 | let 53 | rer_output = (0 < v) and (c or count); 54 | v = merge clk r (pv when not clk); 55 | r = count_down (count when clk, numberofcycle when clk); 56 | pv = 0 fby v; 57 | c = false fby rer_output; 58 | clk = c or count; 59 | count = rer_input and not pre_rer_input; 60 | pre_rer_input = true fby rer_input; 61 | tel 62 | 63 | -------------------------------------------------------------------------------- /examples/emsoft03.lus: -------------------------------------------------------------------------------- 1 | (* examples from the paper 2 | "clocks as first class abstract types", colaço and pouzet, emsoft 2003 *) 3 | 4 | node sum (x: int) returns (s: int); 5 | var ps : int; 6 | let 7 | ps = 0 fby s; 8 | s = ps + x; 9 | tel 10 | 11 | node bounds (x: int) returns (min, max: int); 12 | var vinit : bool; 13 | pre_min, pre_max : int; 14 | let 15 | vinit = true fby false; 16 | pre_min = 0 fby min; 17 | pre_max = 0 fby max; 18 | min = if vinit then x 19 | else if x < pre_min then x 20 | else pre_min; 21 | max = if vinit then x 22 | else if x > pre_max then x 23 | else pre_max; 24 | tel 25 | 26 | node sample (n: int) returns (ok: bool); 27 | var vinit : bool; 28 | cpt, pre_cpt : int; 29 | let 30 | vinit = true fby false; 31 | cpt = if vinit then 0 32 | else if pre_cpt = n - 1 then 0 33 | else pre_cpt + 1; 34 | pre_cpt = 0 fby cpt; 35 | ok = (cpt = 0); 36 | tel 37 | 38 | node count_down (vreset : bool; n : int) returns (cpt : int); 39 | var vinit : bool; 40 | pre_cpt : int; 41 | let 42 | vinit = true fby false; 43 | pre_cpt = 0 fby (cpt - 1); 44 | cpt = if vreset or vinit then n else pre_cpt; 45 | tel 46 | 47 | node risingedgeretrigger (rer_input : bool; numberofcycle : int) 48 | returns (rer_output : bool); 49 | var clk, c, pre_rer_input, count : bool; 50 | v, pv : int; 51 | r : int when clk; 52 | let 53 | rer_output = (0 < v) and (c or count); 54 | v = merge clk r (pv when not clk); 55 | r = count_down (count when clk, numberofcycle when clk); 56 | pv = 0 fby v; 57 | c = false fby rer_output; 58 | clk = c or count; 59 | count = rer_input and not pre_rer_input; 60 | pre_rer_input = true fby rer_input; 61 | tel 62 | 63 | -------------------------------------------------------------------------------- /benchs/buttons.ept: -------------------------------------------------------------------------------- 1 | (* The button example from 2 | Colaco, Pagano, Pouzet, 3 | "Scade 6: A Formal Language for Embedded Critical Software Development" *) 4 | 5 | type bk_color = Grey | Yellow | Green 6 | type fr_color = Black | White 7 | 8 | node button(button, lock, unlock, other : bool) 9 | returns (background : bk_color; foreground : fr_color) 10 | let 11 | automaton 12 | state Unselected do 13 | (background, foreground) = (Grey, White) 14 | unless lock then LockedUnselection 15 | | button then Preselected 16 | 17 | state Preselected do 18 | (background, foreground) = (Yellow, White) 19 | unless lock then LockedSelection 20 | | button or other then Unselected 21 | 22 | state LockedSelection do 23 | (background, foreground) = (Green, White) 24 | unless unlock then Preselected 25 | 26 | state LockedUnselection do 27 | (background, foreground) = (Grey, Black) 28 | unless unlock then Unselected 29 | end 30 | tel 31 | 32 | node buttons(lock : bool; b1, b2, b3 : bool) 33 | returns (b1_bk, b2_bk, b3_bk : bk_color; 34 | b1_fr, b2_fr, b3_fr : fr_color; 35 | lockLight : bool) 36 | var lockSig, unlockSig, buttonPressed : bool; 37 | let 38 | automaton 39 | state LockLow do 40 | lockLight = false; 41 | unless lock then LockHigh 42 | 43 | state LockHigh do 44 | lockLight = true; 45 | unless lock then LockLow 46 | end; 47 | 48 | unlockSig = lockLight and lock; 49 | lockSig = not lockLight and lock; 50 | buttonPressed = b1 or b2 or b3; 51 | (b1_bk, b1_fr) = button(b1, lockSig, unlockSig, buttonPressed); 52 | (b2_bk, b2_fr) = button(b2, lockSig, unlockSig, buttonPressed); 53 | (b3_bk, b3_fr) = button(b3, lockSig, unlockSig, buttonPressed); 54 | tel 55 | -------------------------------------------------------------------------------- /benchs/buttons.lus: -------------------------------------------------------------------------------- 1 | (* The button example from 2 | Colaco, Pagano, Pouzet, 3 | "Scade 6: A Formal Language for Embedded Critical Software Development" *) 4 | 5 | type bk_color = Grey | Yellow | Green 6 | type fr_color = Black | White 7 | 8 | node button(button, lock, unlock, other : bool) 9 | returns (background : bk_color; foreground : fr_color) 10 | let 11 | automaton initially Unselected 12 | state Unselected do 13 | (background, foreground) = (Grey, White) 14 | unless lock then LockedUnselection 15 | | button then Preselected 16 | 17 | state Preselected do 18 | (background, foreground) = (Yellow, White) 19 | unless lock then LockedSelection 20 | | button or other then Unselected 21 | 22 | state LockedSelection do 23 | (background, foreground) = (Green, White) 24 | unless unlock then Preselected 25 | 26 | state LockedUnselection do 27 | (background, foreground) = (Grey, Black) 28 | unless unlock then Unselected 29 | end 30 | tel 31 | 32 | node buttons(lock : bool; b1, b2, b3 : bool) 33 | returns (b1_bk, b2_bk, b3_bk : bk_color; 34 | b1_fr, b2_fr, b3_fr : fr_color; 35 | lockLight : bool) 36 | var lockSig, unlockSig, buttonPressed : bool; 37 | let 38 | automaton initially LockLow 39 | state LockLow do 40 | lockLight = false; 41 | unless lock then LockHigh 42 | 43 | state LockHigh do 44 | lockLight = true; 45 | unless lock then LockLow 46 | end; 47 | 48 | unlockSig = lockLight and lock; 49 | lockSig = not lockLight and lock; 50 | buttonPressed = b1 or b2 or b3; 51 | (b1_bk, b1_fr) = button(b1, lockSig, unlockSig, buttonPressed); 52 | (b2_bk, b2_fr) = button(b2, lockSig, unlockSig, buttonPressed); 53 | (b3_bk, b3_fr) = button(b3, lockSig, unlockSig, buttonPressed); 54 | tel 55 | -------------------------------------------------------------------------------- /tools/pg: -------------------------------------------------------------------------------- 1 | #!/usr/bin/env sh 2 | # Start Proof General with the right -I options 3 | # Use the Makefile to rebuild dependencies if needed 4 | # Recompile the modified file after coqide editing 5 | 6 | update_path_vars() 7 | { 8 | INCLUDES=$1 9 | PREFIX=$2 10 | 11 | AFTERAS= 12 | RECMODE=rec 13 | ISPATH=0 14 | for arg in $INCLUDES; do 15 | case "$arg" in 16 | -as) ;; 17 | -R) 18 | COQPROGARGS="$COQPROGARGS \"$arg\"" 19 | RECMODE= 20 | ISPATH=1 21 | ;; 22 | -I) 23 | COQPROGARGS="$COQPROGARGS \"$arg\"" 24 | RECMODE=nonrec 25 | ISPATH=1 26 | ;; 27 | *) 28 | if [ $ISPATH -eq 1 ]; then 29 | COQPROGARGS="$COQPROGARGS \"$PREFIX$arg\"" 30 | COQLOADPATH="$COQLOADPATH ($RECMODE \"$PREFIX$arg\"" 31 | ISPATH=0 32 | else 33 | COQPROGARGS="$COQPROGARGS $AFTERAS\"$arg\"" 34 | COQLOADPATH="$COQLOADPATH \"$arg\")" 35 | fi 36 | ;; 37 | esac 38 | 39 | case "$arg" in 40 | -as) AFTERAS='"-as" ';; 41 | *) AFTERAS=;; 42 | esac 43 | done 44 | } 45 | 46 | PWD=$(pwd) 47 | COMPCERT_INCLUDES=$(make --no-print-directory -C CompCert print-includes) 48 | 49 | COQPROGNAME=$(which coqtop) 50 | COQPROGARGS="" 51 | COQLOADPATH="" 52 | 53 | update_path_vars "$COMPCERT_INCLUDES" "$PWD/CompCert/" 54 | 55 | COQPROGARGS="\"-R\" \"$PWD\" \"Velus\" $COQPROGARGS" 56 | COQLOADPATH="(\"$PWD\" \"Velus\") $COQLOADPATH" 57 | 58 | #echo "COQPROGARGS=$COQPROGARGS" 59 | #echo 60 | #echo "COQLOADPATH=$COQLOADPATH" 61 | 62 | emacs --eval "(setq coq-prog-name \"$COQPROGNAME\")" \ 63 | --eval "(setq coq-use-project-file nil)" \ 64 | --eval "(setq coq-prog-args '($COQPROGARGS))" \ 65 | --eval "(setq coq-load-path '($COQLOADPATH))" \ 66 | --eval "(setq compile-before-require nil)" \ 67 | "$@" 68 | -------------------------------------------------------------------------------- /flake.lock: -------------------------------------------------------------------------------- 1 | { 2 | "nodes": { 3 | "flake-parts": { 4 | "inputs": { 5 | "nixpkgs-lib": "nixpkgs-lib" 6 | }, 7 | "locked": { 8 | "lastModified": 1743550720, 9 | "narHash": "sha256-hIshGgKZCgWh6AYJpJmRgFdR3WUbkY04o82X05xqQiY=", 10 | "owner": "hercules-ci", 11 | "repo": "flake-parts", 12 | "rev": "c621e8422220273271f52058f618c94e405bb0f5", 13 | "type": "github" 14 | }, 15 | "original": { 16 | "owner": "hercules-ci", 17 | "repo": "flake-parts", 18 | "type": "github" 19 | } 20 | }, 21 | "nixpkgs": { 22 | "locked": { 23 | "lastModified": 1743583204, 24 | "narHash": "sha256-F7n4+KOIfWrwoQjXrL2wD9RhFYLs2/GGe/MQY1sSdlE=", 25 | "owner": "NixOS", 26 | "repo": "nixpkgs", 27 | "rev": "2c8d3f48d33929642c1c12cd243df4cc7d2ce434", 28 | "type": "github" 29 | }, 30 | "original": { 31 | "owner": "NixOS", 32 | "ref": "nixos-unstable", 33 | "repo": "nixpkgs", 34 | "type": "github" 35 | } 36 | }, 37 | "nixpkgs-lib": { 38 | "locked": { 39 | "lastModified": 1743296961, 40 | "narHash": "sha256-b1EdN3cULCqtorQ4QeWgLMrd5ZGOjLSLemfa00heasc=", 41 | "owner": "nix-community", 42 | "repo": "nixpkgs.lib", 43 | "rev": "e4822aea2a6d1cdd36653c134cacfd64c97ff4fa", 44 | "type": "github" 45 | }, 46 | "original": { 47 | "owner": "nix-community", 48 | "repo": "nixpkgs.lib", 49 | "type": "github" 50 | } 51 | }, 52 | "root": { 53 | "inputs": { 54 | "flake-parts": "flake-parts", 55 | "nixpkgs": "nixpkgs" 56 | } 57 | } 58 | }, 59 | "root": "root", 60 | "version": 7 61 | } 62 | -------------------------------------------------------------------------------- /benchs/emsoft05.ept: -------------------------------------------------------------------------------- 1 | (* examples from the paper 2 | "a conservative extension of synchronous data-flow with vstate machines", 3 | colaço, pagano, and pouzet, emsoft 2005 *) 4 | 5 | node two(x : bool) returns (o : int); 6 | var o2 : int when ck; 7 | o_1 : int; 8 | ck, ns : bool; 9 | let 10 | o2 = o_1 when ck; 11 | o = merge ck o2 (0 when not ck); 12 | ns = merge ck (not x when ck) (x when not ck); 13 | o_1 = 0 fby o; 14 | ck = false fby ns; 15 | tel 16 | 17 | node chrono(stst, rst : bool) returns (disp_1, disp_2 : int) 18 | var run, r_2, nr_2, r_1, ns_2, ck, v_3, ck_2 : bool; 19 | v : bool when not ck; 20 | s, m, m_1, s_1, p_disp_2, p_disp_1 : int; 21 | d, v_12 : int when run; 22 | let 23 | r_1 = false fby (rst and not run); 24 | r_2 = false fby nr_2; 25 | ck_2 = if r_1 then false else v_3; 26 | d = if (r_1 when run) then (0 when run) else v_12 + (1 when run); 27 | s = merge run (true -> if d < v_12 28 | then (((s_1 + 1) % 60) when run) 29 | else (s_1 when run)) 30 | (false -> if (r_1 when not run) 31 | then (0 when not run) 32 | else (s_1 when not run)); 33 | run = merge ck_2 (true -> not (stst when ck_2)) 34 | (false -> stst when not ck_2); 35 | m = merge run (true -> if ((s < s_1) when run) 36 | then (((m_1 + 1) % 60) when run) 37 | else (m_1 when run)) 38 | (false -> if (r_1 when not run) 39 | then (0 when not run) 40 | else (m_1 when not run)); 41 | v = (rst and run) when not ck; 42 | disp_1 = merge ck (p_disp_1 when ck) (s when not ck); 43 | disp_2 = merge ck (p_disp_2 when ck) (m when not ck); 44 | ns_2 = merge ck (not rst when ck) v; 45 | nr_2 = merge ck (rst when ck) v; 46 | p_disp_2 = 0 fby disp_2; 47 | p_disp_1 = 0 fby disp_1; 48 | m_1 = 0 fby m; 49 | s_1 = 0 fby s; 50 | ck = false fby ns_2; 51 | v_3 = false fby run; 52 | v_12 = 0 fby d; 53 | tel 54 | 55 | -------------------------------------------------------------------------------- /benchs/emsoft05.lus: -------------------------------------------------------------------------------- 1 | (* examples from the paper 2 | "a conservative extension of synchronous data-flow with vstate machines", 3 | colaço, pagano, and pouzet, emsoft 2005 *) 4 | 5 | node two(x : bool) returns (o : int); 6 | var o2 : int when ck; 7 | o_1 : int; 8 | ck, ns : bool; 9 | let 10 | o2 = o_1 when ck; 11 | o = merge ck o2 (0 when not ck); 12 | ns = merge ck (not x when ck) (x when not ck); 13 | o_1 = 0 fby o; 14 | ck = false fby ns; 15 | tel 16 | 17 | node chrono(stst, rst : bool) returns (disp_1, disp_2 : int) 18 | var run, r_2, nr_2, r_1, ns_2, ck, v_3, ck_2 : bool; 19 | v : bool when not ck; 20 | s, m, m_1, s_1, p_disp_2, p_disp_1 : int; 21 | d, v_12 : int when run; 22 | let 23 | r_1 = false fby (rst and not run); 24 | r_2 = false fby nr_2; 25 | ck_2 = if r_1 then false else v_3; 26 | d = if (r_1 when run) then (0 when run) else v_12 + (1 when run); 27 | s = merge run (true => if d < v_12 28 | then (((s_1 + 1) mod 60) when run) 29 | else (s_1 when run)) 30 | (false => if (r_1 when not run) 31 | then (0 when not run) 32 | else (s_1 when not run)); 33 | run = merge ck_2 (true => not (stst when ck_2)) 34 | (false => stst when not ck_2); 35 | m = merge run (true => if ((s < s_1) when run) 36 | then (((m_1 + 1) mod 60) when run) 37 | else (m_1 when run)) 38 | (false => if (r_1 when not run) 39 | then (0 when not run) 40 | else (m_1 when not run)); 41 | v = (rst and run) when not ck; 42 | disp_1 = merge ck (p_disp_1 when ck) (s when not ck); 43 | disp_2 = merge ck (p_disp_2 when ck) (m when not ck); 44 | ns_2 = merge ck (not rst when ck) v; 45 | nr_2 = merge ck (rst when ck) v; 46 | p_disp_2 = 0 fby disp_2; 47 | p_disp_1 = 0 fby disp_1; 48 | m_1 = 0 fby m; 49 | s_1 = 0 fby s; 50 | ck = false fby ns_2; 51 | v_3 = false fby run; 52 | v_12 = 0 fby d; 53 | tel 54 | 55 | -------------------------------------------------------------------------------- /examples/emsoft05.lus: -------------------------------------------------------------------------------- 1 | (* examples from the paper 2 | "a conservative extension of synchronous data-flow with vstate machines", 3 | colaço, pagano, and pouzet, emsoft 2005 *) 4 | 5 | node two(x : bool) returns (o : int); 6 | var o2 : int when ck; 7 | o_1 : int; 8 | ck, ns : bool; 9 | let 10 | o2 = o_1 when ck; 11 | o = merge ck o2 (0 when not ck); 12 | ns = merge ck (not x when ck) (x when not ck); 13 | o_1 = 0 fby o; 14 | ck = false fby ns; 15 | tel 16 | 17 | node chrono(stst, rst : bool) returns (disp_1, disp_2 : int) 18 | var run, r_2, nr_2, r_1, ns_2, ck, v_3, ck_2 : bool; 19 | v : bool when not ck; 20 | s, m, m_1, s_1, p_disp_2, p_disp_1 : int; 21 | d, v_12 : int when run; 22 | let 23 | r_1 = false fby (rst and not run); 24 | r_2 = false fby nr_2; 25 | ck_2 = if r_1 then false else v_3; 26 | d = if (r_1 when run) then (0 when run) else v_12 + (1 when run); 27 | s = merge run (true => if d < v_12 28 | then (((s_1 + 1) mod 60) when run) 29 | else (s_1 when run)) 30 | (false => if (r_1 when not run) 31 | then (0 when not run) 32 | else (s_1 when not run)); 33 | run = merge ck_2 (true => not (stst when ck_2)) 34 | (false => stst when not ck_2); 35 | m = merge run (true => if ((s < s_1) when run) 36 | then (((m_1 + 1) mod 60) when run) 37 | else (m_1 when run)) 38 | (false => if (r_1 when not run) 39 | then (0 when not run) 40 | else (m_1 when not run)); 41 | v = (rst and run) when not ck; 42 | disp_1 = merge ck (p_disp_1 when ck) (s when not ck); 43 | disp_2 = merge ck (p_disp_2 when ck) (m when not ck); 44 | ns_2 = merge ck (not rst when ck) v; 45 | nr_2 = merge ck (rst when ck) v; 46 | p_disp_2 = 0 fby disp_2; 47 | p_disp_1 = 0 fby disp_1; 48 | m_1 = 0 fby m; 49 | s_1 = 0 fby s; 50 | ck = false fby ns_2; 51 | v_3 = false fby run; 52 | v_12 = 0 fby d; 53 | tel 54 | 55 | -------------------------------------------------------------------------------- /benchs/stepper_motor.ept: -------------------------------------------------------------------------------- 1 | -- Counts time elapsed (in microseconds) 2 | node count_up(inc : int) returns (o : int) 3 | let 4 | o = 0 fby (o + inc); 5 | tel 6 | 7 | -- Returns true after the desired time has passed 8 | node await(goal : int) returns (b : bool) 9 | var c : int; 10 | let c = count_up(50); 11 | b = (c > goal) or (false fby b); 12 | tel 13 | 14 | node pwm(chop : bool) returns (motorENA : bool) 15 | var motENA : bool; 16 | let 17 | motorENA = (not chop) or motENA; 18 | automaton 19 | state Off do 20 | motENA = false; 21 | unless true then On 22 | state On do 23 | motENA = true; 24 | unless true then Off 25 | end 26 | tel 27 | 28 | node drive_sequence(step : bool) 29 | returns (last motorA : bool = true; last motorB : bool = true) 30 | let 31 | switch step 32 | | true do (motorA, motorB) = (not (last motorB), last motorA) 33 | | false do 34 | end; 35 | tel 36 | 37 | node feed_pause(pause : bool) returns (enable, step : bool) 38 | var time : int; 39 | let 40 | reset 41 | time = count_up(50); 42 | every (false fby step); 43 | 44 | automaton 45 | state Feeding do 46 | enable = true; 47 | automaton 48 | state Starting do 49 | step = true -> false; 50 | unless time >= 750 then Moving 51 | state Moving do 52 | step = true -> false; 53 | unless time >= 500 then Moving 54 | end; 55 | unless pause then Holding 56 | 57 | state Holding do 58 | step = false; 59 | automaton 60 | state Waiting do 61 | enable = true; 62 | unless time >= 500 then Modulating 63 | state Modulating do 64 | enable = pwm(true); 65 | end; 66 | unless not pause and time >= 750 then Feeding 67 | | not pause continue Feeding 68 | end 69 | tel 70 | 71 | node stepper_motor(pause : bool) returns (enable, motorA, motorB, step : bool) 72 | let 73 | (enable, step) = feed_pause(pause); 74 | (motorA, motorB) = drive_sequence(step); 75 | tel 76 | -------------------------------------------------------------------------------- /src/Lustre/Unnesting/Normalization.v: -------------------------------------------------------------------------------- 1 | From Coq Require Import String. 2 | From Coq Require Import List Sorting.Permutation. 3 | Import List.ListNotations. 4 | Open Scope list_scope. 5 | 6 | From compcert Require Import common.Errors. 7 | From Velus Require Import Common. 8 | From Velus Require Import Operators. 9 | From Velus Require Import Clocks. 10 | From Velus Require Import StaticEnv. 11 | From Velus Require Import Lustre.LSyntax. 12 | From Velus Require Import Lustre.Normalization.Unnesting Lustre.Normalization.NormFby. 13 | 14 | (** * Complete Normalization *) 15 | 16 | Module Type NORMALIZATION 17 | (Import Ids : IDS) 18 | (Import Op : OPERATORS) 19 | (OpAux : OPERATORS_AUX Ids Op) 20 | (Import Cks : CLOCKS Ids Op OpAux) 21 | (Import Senv : STATICENV Ids Op OpAux Cks) 22 | (Import Syn : LSYNTAX Ids Op OpAux Cks Senv). 23 | 24 | Module Export Unnesting := UnnestingFun Ids Op OpAux Cks Senv Syn. 25 | Module Export NormFby := NormFbyFun Ids Op OpAux Cks Senv Syn Unnesting. 26 | 27 | Definition normalize_global G := 28 | normfby_global (unnest_global G). 29 | 30 | Lemma normalize_global_iface_eq : forall G, 31 | global_iface_eq G (normalize_global G). 32 | Proof. 33 | intros *. 34 | unfold normalize_global. 35 | eapply global_iface_eq_trans. 36 | eapply unnest_global_eq. eapply normfby_global_eq. 37 | Qed. 38 | 39 | Theorem normalize_global_normalized_global : forall G, 40 | wl_global G -> 41 | wx_global G -> 42 | normalized_global (normalize_global G). 43 | Proof. 44 | intros G * Hwl Hwx. 45 | eapply normfby_global_normalized_global. 46 | eapply unnest_global_unnested_global; auto. 47 | Qed. 48 | 49 | End NORMALIZATION. 50 | 51 | Module NormalizationFun 52 | (Ids : IDS) 53 | (Op : OPERATORS) 54 | (OpAux : OPERATORS_AUX Ids Op) 55 | (Cks : CLOCKS Ids Op OpAux) 56 | (Senv : STATICENV Ids Op OpAux Cks) 57 | (Syn : LSYNTAX Ids Op OpAux Cks Senv) 58 | <: NORMALIZATION Ids Op OpAux Cks Senv Syn. 59 | Include NORMALIZATION Ids Op OpAux Cks Senv Syn. 60 | End NormalizationFun. 61 | -------------------------------------------------------------------------------- /examples/stepper-motor.lus: -------------------------------------------------------------------------------- 1 | -- Counts time elapsed (in microseconds) 2 | node count_up(inc : int) returns (o : int) 3 | let 4 | o = 0 fby (o + inc); 5 | tel 6 | 7 | -- Returns true after the desired time has passed 8 | node await(goal : int) returns (b : bool) 9 | var c : int; 10 | let c = count_up(50); 11 | b = (c > goal) or (false fby b); 12 | tel 13 | 14 | node pwm(chop : bool) returns (motorENA : bool) 15 | var motENA : bool; 16 | let 17 | motorENA = (not chop) or motENA; 18 | automaton initially Off 19 | state Off do 20 | motENA = false; 21 | unless await(50) then On 22 | state On do 23 | motENA = true; 24 | unless await(50) then Off 25 | end 26 | tel 27 | 28 | node drive_sequence(step : bool) returns (motA, motB : bool) 29 | let 30 | last motA = true; 31 | last motB = true; 32 | switch step 33 | | true do (motA, motB) = (not (last motB), last motA) 34 | | false do 35 | end; 36 | tel 37 | 38 | node feed_pause(pause : bool) returns (enable, step : bool) 39 | var time : int; 40 | let 41 | reset 42 | time = count_up(50); 43 | every (false fby step); 44 | 45 | automaton initially Feeding 46 | state Feeding do 47 | enable = true; 48 | automaton initially Starting 49 | state Starting do 50 | step = true -> false; 51 | unless false -> time >= 750 then Moving 52 | state Moving do 53 | step = true -> false; 54 | unless time >= 500 then Moving 55 | end; 56 | unless pause then Holding 57 | 58 | state Holding do 59 | step = false; 60 | automaton initially Waiting 61 | state Waiting do 62 | enable = true; 63 | unless time >= 500 then Modulating 64 | state Modulating do 65 | enable = pwm(true); 66 | end; 67 | unless not pause and time >= 750 then Feeding 68 | | not pause continue Feeding 69 | end 70 | tel 71 | 72 | node motor(pause : bool) returns (enable, motorA, motorB, step : bool) 73 | let 74 | (enable, step) = feed_pause(pause); 75 | (motorA, motorB) = drive_sequence(step); 76 | tel 77 | -------------------------------------------------------------------------------- /benchs/stepper_motor.lus: -------------------------------------------------------------------------------- 1 | -- Counts time elapsed (in microseconds) 2 | node count_up(inc : int) returns (o : int) 3 | let 4 | o = 0 fby (o + inc); 5 | tel 6 | 7 | -- Returns true after the desired time has passed 8 | node await(goal : int) returns (b : bool) 9 | var c : int; 10 | let c = count_up(50); 11 | b = (c > goal) or (false fby b); 12 | tel 13 | 14 | node pwm(chop : bool) returns (motorENA : bool) 15 | var motENA : bool; 16 | let 17 | motorENA = (not chop) or motENA; 18 | automaton initially Off 19 | state Off do 20 | motENA = false; 21 | unless true then On 22 | state On do 23 | motENA = true; 24 | unless true then Off 25 | end 26 | tel 27 | 28 | node drive_sequence(step : bool) 29 | returns (motorA, motorB : bool) 30 | let 31 | last motorA = true; 32 | last motorB = true; 33 | switch step 34 | | true do (motorA, motorB) = (not (last motorB), last motorA) 35 | | false do 36 | end; 37 | tel 38 | 39 | node feed_pause(pause : bool) returns (enable, step : bool) 40 | var time : int; 41 | let 42 | reset 43 | time = count_up(50); 44 | every (false fby step); 45 | 46 | automaton initially Feeding 47 | state Feeding do 48 | enable = true; 49 | automaton initially Starting 50 | state Starting do 51 | step = true -> false; 52 | unless time >= 750 then Moving 53 | state Moving do 54 | step = true -> false; 55 | unless time >= 500 then Moving 56 | end; 57 | unless pause then Holding 58 | 59 | state Holding do 60 | step = false; 61 | automaton initially Waiting 62 | state Waiting do 63 | enable = true; 64 | unless time >= 500 then Modulating 65 | state Modulating do 66 | enable = pwm(true); 67 | end; 68 | unless not pause and time >= 750 then Feeding 69 | | not pause continue Feeding 70 | end 71 | tel 72 | 73 | node stepper_motor(pause : bool) returns (enable, motorA, motorB, step : bool) 74 | let 75 | (enable, step) = feed_pause(pause); 76 | (motorA, motorB) = drive_sequence(step); 77 | tel 78 | -------------------------------------------------------------------------------- /variables.mk: -------------------------------------------------------------------------------- 1 | 2 | # Path and directory of this Makefile 3 | # (which may be included from subdirectories) 4 | MKFILE_PATH := $(abspath $(lastword $(MAKEFILE_LIST))) 5 | MKFILE_DIR := $(patsubst %/,%,$(dir $(MKFILE_PATH))) 6 | 7 | SRC_DIR=src 8 | 9 | VELUSMAIN=velusmain 10 | VELUS=velus 11 | 12 | MAKEFILEAUTO=$(MKFILE_DIR)/Makefile.auto 13 | MAKEFILECONFIG=$(MKFILE_DIR)/Makefile.config 14 | COQPROJECT=$(MKFILE_DIR)/_CoqProject 15 | 16 | ifeq ($(filter clean cleanall, $(MAKECMDGOALS)),) 17 | ifeq ($(wildcard $(MAKEFILECONFIG)),) 18 | $(error Please run ./configure first) 19 | endif 20 | include $(MAKEFILECONFIG) 21 | endif 22 | 23 | # CompCert flags 24 | ifeq ($(COMPCERTDIR),) 25 | COMPCERTFLAGS=$(SILENT) -C $(MKFILE_DIR)/CompCert 26 | else 27 | COMPCERTFLAGS=$(SILENT) -C $(COMPCERTDIR) 28 | endif 29 | COMPCERT_INCLUDES=lib cfrontend backend common driver cparser debug $(ARCH) 30 | 31 | PARSERDIR=$(SRC_DIR)/Lustre/Parser 32 | PARSERFLAGS=$(SILENT) -C $(PARSERDIR) 33 | 34 | TOOLSDIR=tools 35 | AUTOMAKE=automake 36 | 37 | EXTRACTION=extraction 38 | EXTRACTED=$(EXTRACTION)/extracted 39 | $(shell mkdir -p $(EXTRACTED) >/dev/null) 40 | 41 | EXAMPLESDIR=examples 42 | EXAMPLESFLAGS=$(SILENT) -C $(EXAMPLESDIR) 43 | 44 | # Menhir includes from CompCert 45 | ifeq ($(filter clean cleanall, $(MAKECMDGOALS)),) 46 | include $(COMPCERTDIR)/Makefile.menhir 47 | endif 48 | export MENHIR 49 | comma:= , 50 | empty:= 51 | space:= $(empty) $(empty) 52 | MENHIR_INCLUDES:= $(subst $(space),$(comma),$(MENHIR_INCLUDES)) 53 | 54 | # ocamlbuild flags 55 | VERBOSITY=-verbose 1 56 | FLAGS=-Is $(SRC_DIR),$(EXTRACTED) -use-ocamlfind -use-menhir \ 57 | -pkgs str,unix,menhirLib,ocamlgraph -no-hygiene $(VERBOSITY) 58 | #-cflags $(MENHIR_INCLUDES)$(WARNINGS) 59 | TARGET=native 60 | BUILDDIR=_build 61 | 62 | # flag to prevent coqc from taking CompCert directories into account (see Makefile.auto) 63 | export OTHERFLAGS=-exclude-dir CompCert 64 | 65 | bold=$(shell tput bold) 66 | blue=$(shell tput setaf 4) 67 | red=$(shell tput setaf 9) 68 | green=$(shell tput setaf 10) 69 | normal=$(shell tput sgr0) 70 | 71 | ifndef VERBOSE 72 | SILENT=-s 73 | #WARNINGS=,-w,-3-20 74 | WARNINGS= 75 | VERBOSITY= 76 | .SILENT: 77 | endif 78 | -------------------------------------------------------------------------------- /examples/stepper-motor/stepper-motor.lus: -------------------------------------------------------------------------------- 1 | -- Counts time elapsed (in microseconds) 2 | node count_up(inc : int) returns (o : int) 3 | let 4 | o = 0 fby (o + inc); 5 | tel 6 | 7 | -- Returns true after the desired time has passed 8 | node await(goal : int) returns (b : bool) 9 | var c : int; 10 | let c = count_up(50); 11 | b = (c > goal) or (false fby b); 12 | tel 13 | 14 | node pwm(chop : bool) returns (motorENA : bool) 15 | var motENA : bool; 16 | let 17 | motorENA = (not chop) or motENA; 18 | automaton initially Off 19 | state Off do 20 | motENA = false; 21 | unless await(50) then On 22 | state On do 23 | motENA = true; 24 | unless await(50) then Off 25 | end 26 | tel 27 | 28 | node drive_sequence(step : bool) returns (motorA, motorB : bool) 29 | var last motA : bool = true; last motB : bool = false; 30 | let 31 | switch step 32 | | true do (motA, motB) = (not (last motB), last motA) 33 | | false do (motA, motB) = (last motA, last motB) 34 | end; 35 | (motorA, motorB) = (motA, motB); 36 | tel 37 | 38 | node feed_pause(pause : bool) returns (enable, step : bool) 39 | var time : int; 40 | let 41 | reset 42 | time = count_up(50); 43 | every (false fby step); 44 | 45 | automaton initially Feeding 46 | state Feeding do 47 | enable = true; 48 | automaton initially Starting 49 | state Starting do 50 | step = true -> false; 51 | unless false -> time >= 750 then Moving 52 | state Moving do 53 | step = true -> false; 54 | unless time >= 500 then Moving 55 | end; 56 | unless pause then Holding 57 | 58 | state Holding do 59 | step = false; 60 | automaton initially Waiting 61 | state Waiting do 62 | enable = true; 63 | unless time >= 500 then Modulating 64 | state Modulating do 65 | enable = pwm(true); 66 | end; 67 | unless not pause and time >= 750 then Feeding 68 | | not pause continue Feeding 69 | end 70 | tel 71 | 72 | node motor(pause : bool) returns (enable, motorA, motorB, step : bool) 73 | let 74 | (enable, step) = feed_pause(pause); 75 | (motorA, motorB) = drive_sequence(step); 76 | tel 77 | -------------------------------------------------------------------------------- /src/Lustre/Complete/LComplete.v: -------------------------------------------------------------------------------- 1 | From Velus Require Import Common. 2 | From Velus Require Import Operators Environment. 3 | From Velus Require Import Clocks. 4 | From Velus Require Import CoindStreams IndexedStreams. 5 | From Velus Require Import Lustre.StaticEnv. 6 | From Velus Require Import Lustre.LSyntax Lustre.LTyping Lustre.LClocking. 7 | From Velus Require Import Lustre.LOrdered. 8 | From Velus Require Import Lustre.LSemantics. 9 | From Velus Require Import Lustre.Complete.Complete. 10 | From Velus Require Import Lustre.Complete.CompTyping. 11 | From Velus Require Import Lustre.Complete.CompClocking. 12 | From Velus Require Import Lustre.Complete.CompCorrectness. 13 | 14 | Module Type LCOMPLETE 15 | (Ids : IDS) 16 | (Op : OPERATORS) 17 | (OpAux : OPERATORS_AUX Ids Op) 18 | (Cks : CLOCKS Ids Op OpAux) 19 | (CStr : COINDSTREAMS Ids Op OpAux Cks) 20 | (Senv : STATICENV Ids Op OpAux Cks) 21 | (Syn : LSYNTAX Ids Op OpAux Cks Senv) 22 | (Typ : LTYPING Ids Op OpAux Cks Senv Syn) 23 | (Clo : LCLOCKING Ids Op OpAux Cks Senv Syn) 24 | (Ord : LORDERED Ids Op OpAux Cks Senv Syn) 25 | (Sem : LSEMANTICS Ids Op OpAux Cks Senv Syn Ord CStr). 26 | Declare Module Export Complete : COMPLETE Ids Op OpAux Cks Senv Syn. 27 | Declare Module Export Typing : COMPTYPING Ids Op OpAux Cks Senv Syn Typ Complete. 28 | Declare Module Export Clocking : COMPCLOCKING Ids Op OpAux Cks Senv Syn Clo Complete. 29 | Declare Module Export Correct : COMPCORRECTNESS Ids Op OpAux Cks CStr Senv Syn Clo Ord Sem Complete. 30 | End LCOMPLETE. 31 | 32 | Module LCompleteFun 33 | (Ids : IDS) 34 | (Op : OPERATORS) 35 | (OpAux : OPERATORS_AUX Ids Op) 36 | (Cks : CLOCKS Ids Op OpAux) 37 | (CStr : COINDSTREAMS Ids Op OpAux Cks) 38 | (Senv : STATICENV Ids Op OpAux Cks) 39 | (Syn : LSYNTAX Ids Op OpAux Cks Senv) 40 | (Typ : LTYPING Ids Op OpAux Cks Senv Syn) 41 | (Clo : LCLOCKING Ids Op OpAux Cks Senv Syn) 42 | (Ord : LORDERED Ids Op OpAux Cks Senv Syn) 43 | (Sem : LSEMANTICS Ids Op OpAux Cks Senv Syn Ord CStr) 44 | <: LCOMPLETE Ids Op OpAux Cks CStr Senv Syn Typ Clo Ord Sem. 45 | Module Export Complete := CompleteFun Ids Op OpAux Cks Senv Syn. 46 | Module Export Typing := CompTypingFun Ids Op OpAux Cks Senv Syn Typ Complete. 47 | Module Export Clocking := CompClockingFun Ids Op OpAux Cks Senv Syn Clo Complete. 48 | Module Export Correct := CompCorrectnessFun Ids Op OpAux Cks CStr Senv Syn Clo Ord Sem Complete. 49 | End LCompleteFun. 50 | -------------------------------------------------------------------------------- /src/Lustre/Denot/SDfunsCoind.v: -------------------------------------------------------------------------------- 1 | Inductive error := error_Ty | error_Cl | error_Op. 2 | 3 | Inductive sampl (A : Type) : Type := abs | pres (a: A) | err (e : error). 4 | Arguments abs {A}. 5 | Arguments pres {A} a. 6 | Arguments err {A} e. 7 | 8 | Require Import Streams. 9 | 10 | Definition AC {A} (rs : Stream (sampl A)) := 11 | map (fun v => match v with pres _ => true | _ => false end) rs. 12 | 13 | Definition const {A} (c : A) (rs : Stream bool) : Stream (sampl A) := 14 | map (fun r:bool => if r then pres c else abs) rs. 15 | 16 | CoFixpoint fby1 {A} (v : A) (xs ys : Stream (sampl A)) : Stream (sampl A) := 17 | match xs with 18 | | Cons abs xs => Cons abs 19 | (* inline (fby1AP (Some _)) *) 20 | (match ys with 21 | | Cons abs ys => fby1 v xs ys 22 | | Cons (err e) _ => map (fun _ => err e) xs 23 | | Cons (pres _) _ => map (fun _ => err error_Cl) xs 24 | end) 25 | | Cons (pres x) xs => Cons (pres v) 26 | (* inline (fby1AP None) *) 27 | (match ys with 28 | | Cons (pres y) _ => fby1 y xs ys 29 | | Cons abs ys => map (fun _ => err error_Cl) xs 30 | | Cons (err e) _ => map (fun _ => err e) xs 31 | end) 32 | | Cons (err e) xs => map (fun _ => err e) xs 33 | end. 34 | 35 | CoFixpoint fby {A} (xs ys : Stream (sampl A)) := 36 | match xs with 37 | | Cons abs xs => Cons abs 38 | (* inline fbyA *) 39 | (match ys with 40 | | Cons abs ys => fby xs ys 41 | | Cons (err e) _ => map (fun _ => err e) xs 42 | | Cons (pres _) _ => map (fun _ => err error_Cl) xs 43 | end) 44 | | Cons (pres v) xs => Cons (pres v) 45 | (* inline (fby1AP None) *) 46 | (match ys with 47 | | Cons (pres y) ys => fby1 y xs ys 48 | | Cons abs ys => map (fun _ => err error_Cl) xs 49 | | Cons (err e) _ => map (fun _ => err e) xs 50 | end) 51 | | Cons (err e) xs => map (fun _ => err error_Cl) xs 52 | end. 53 | 54 | Fail CoFixpoint true_until (rs : Stream (sampl bool)) : Stream (sampl bool) := 55 | match rs with 56 | | Cons (pres r) rs => if r then const false (AC rs) 57 | else fby (const true (AC rs)) (true_until (Cons (pres r) rs)) 58 | | Cons r rs => Cons r (true_until rs) 59 | end. 60 | -------------------------------------------------------------------------------- /src/Obc/Obc.v: -------------------------------------------------------------------------------- 1 | From Velus Require Import Operators. 2 | From Velus Require Export Obc.ObcSyntax. 3 | From Velus Require Export Obc.ObcSemantics. 4 | From Velus Require Export Obc.ObcInvariants. 5 | From Velus Require Export Obc.ObcTyping. 6 | From Velus Require Export Obc.Equiv. 7 | From Velus Require Export Obc.ObcAddDefaults. 8 | From Velus Require Export Obc.Fusion. 9 | From Velus Require Export Obc.ObcSwitchesNormalization. 10 | From Velus Require Export Obc.ObcDeadCode. 11 | From Velus Require Export Obc.ObcInterpreter. 12 | 13 | From Velus Require Import Common. 14 | From Velus Require Import CommonTyping. 15 | 16 | Module Type OBC 17 | (Ids: IDS) 18 | (Op: OPERATORS) 19 | (OpAux: OPERATORS_AUX Ids Op) 20 | (ComTyp: COMMONTYPING Ids Op OpAux). 21 | Declare Module Export Syn: OBCSYNTAX Ids Op OpAux. 22 | Declare Module Export Sem: OBCSEMANTICS Ids Op OpAux Syn. 23 | Declare Module Export Inv: OBCINVARIANTS Ids Op OpAux Syn Sem. 24 | Declare Module Export Typ: OBCTYPING Ids Op OpAux Syn ComTyp Sem. 25 | Declare Module Export Equ: EQUIV Ids Op OpAux Syn ComTyp Sem Typ. 26 | Declare Module Export Fus: FUSION Ids Op OpAux Syn ComTyp Sem Inv Typ Equ. 27 | Declare Module Export SwN: OBCSWITCHESNORMALIZATION Ids Op OpAux Syn ComTyp Sem Inv Typ Equ. 28 | Declare Module Export DCE: OBCDEADCODE Ids Op OpAux Syn ComTyp Sem Inv Typ. 29 | Declare Module Export Def: OBCADDDEFAULTS Ids Op OpAux Syn ComTyp Sem Inv Typ Equ. 30 | Declare Module Export Int: OBCINTERPRETER Ids Op OpAux Syn Sem. 31 | End OBC. 32 | 33 | Module ObcFun 34 | (Ids : IDS) 35 | (Op : OPERATORS) 36 | (OpAux : OPERATORS_AUX Ids Op) 37 | (ComTyp : COMMONTYPING Ids Op OpAux) 38 | <: OBC Ids Op OpAux ComTyp. 39 | Module Export Syn := ObcSyntaxFun Ids Op OpAux. 40 | Module Export Sem := ObcSemanticsFun Ids Op OpAux Syn. 41 | Module Export Inv := ObcInvariantsFun Ids Op OpAux Syn Sem. 42 | Module Export Typ := ObcTypingFun Ids Op OpAux Syn ComTyp Sem. 43 | Module Export Equ := EquivFun Ids Op OpAux Syn ComTyp Sem Typ. 44 | Module Export Fus := FusionFun Ids Op OpAux Syn ComTyp Sem Inv Typ Equ. 45 | Module Export SwN := ObcSwitchesNormalizationFun Ids Op OpAux Syn ComTyp Sem Inv Typ Equ. 46 | Module Export DCE := ObcDeadCodeFun Ids Op OpAux Syn ComTyp Sem Inv Typ. 47 | Module Export Def := ObcAddDefaultsFun Ids Op OpAux Syn ComTyp Sem Inv Typ Equ. 48 | Module Export Int := ObcInterpreterFun Ids Op OpAux Syn Sem. 49 | End ObcFun. 50 | -------------------------------------------------------------------------------- /configure: -------------------------------------------------------------------------------- 1 | #!/usr/bin/env sh 2 | 3 | # https://stackoverflow.com/a/43919044 4 | a="/$0"; a=${a%/*}; a=${a#/}; a=${a:-.}; BASEDIR=$(cd "$a" && pwd) 5 | 6 | # Absolute directories to allow use from subdirectories 7 | coqproject="$BASEDIR/_CoqProject" 8 | compcertdir="$BASEDIR/CompCert" 9 | srcdir="$BASEDIR/src" 10 | flocqdir="$compcertdir/flocq" 11 | menhirlibdir="$compcertdir/MenhirLib" 12 | 13 | # if true, execute CompCert/configure script, that forces to recompile 14 | # the whole submodule 15 | configure_compcert=true 16 | 17 | # Parse command-line arguments 18 | 19 | while : ; do 20 | case "$1" in 21 | "") break;; 22 | -compcertdir|--compcertdir) 23 | compcertdir="$2"; shift;; 24 | -flocqdir|--flocqdir) 25 | flocqdir="$2"; shift;; 26 | -menhirlibdir|--menhirlibdir) 27 | menhirlibdir="$2"; shift;; 28 | -prefix|--prefix) 29 | prefix="-prefix $2"; shift;; 30 | -bindir|--bindir) 31 | bindir="-bindir $2"; shift;; 32 | -libdir|--libdir) 33 | libdir=-"libdir $2"; shift;; 34 | -toolprefix|--toolprefix) 35 | toolprefix=-"toolprefix $2"; shift;; 36 | -no-runtime-lib) 37 | runtime_lib="-no-runtime-lib";; 38 | -no-standard-headers) 39 | standard_headers="-no-standard-headers";; 40 | -clightgen) 41 | clightgen="-clightgen";; 42 | -velus-only|--velus-only) 43 | configure_compcert=false;; 44 | *) 45 | target="$1";; 46 | esac 47 | shift 48 | done 49 | 50 | if $configure_compcert; then 51 | # Configure CompCert and extract relevant values into Makefile.config 52 | (cd "$compcertdir" && 53 | ./configure $prefix $bindir $libdir $toolprefix $runtime_lib \ 54 | $standard_headers $clightgen $target) 55 | fi 56 | 57 | if [ -f "$compcertdir"/Makefile.config ]; then 58 | export "$(grep ARCH= < "$compcertdir"/Makefile.config)" 59 | export "$(grep BITSIZE= < "$compcertdir"/Makefile.config)" 60 | fi 61 | 62 | printf "COMPCERTDIR=%s\\nARCH=%s\\n" "$compcertdir" "$ARCH" > Makefile.config 63 | 64 | # Generate the _CoqProject file 65 | { 66 | printf -- "-R \"%s\" Velus\\n" "$srcdir"; 67 | while read -r subdir; do 68 | printf -- "-R \"%s/%s\" compcert.%s\\n" "$compcertdir" "$subdir" "$subdir" 69 | done "$coqproject" 79 | -------------------------------------------------------------------------------- /src/Lustre/NormFby/LNormFby.v: -------------------------------------------------------------------------------- 1 | From Velus Require Import Common. 2 | From Velus Require Import Operators Environment. 3 | From Velus Require Import Clocks. 4 | From Velus Require Import CoindStreams IndexedStreams. 5 | From Velus Require Import Lustre.StaticEnv. 6 | From Velus Require Import Lustre.LSyntax Lustre.LTyping Lustre.LClocking. 7 | From Velus Require Import Lustre.LOrdered. 8 | From Velus Require Import Lustre.LSemantics LClockedSemantics. 9 | From Velus Require Import Lustre.NormFby.NormFby. 10 | From Velus Require Import Lustre.NormFby.NFTyping. 11 | From Velus Require Import Lustre.NormFby.NFClocking. 12 | From Velus Require Import Lustre.NormFby.NFCorrectness. 13 | 14 | Module Type LNORMFBY 15 | (Ids : IDS) 16 | (Op : OPERATORS) 17 | (OpAux : OPERATORS_AUX Ids Op) 18 | (Cks : CLOCKS Ids Op OpAux) 19 | (CStr : COINDSTREAMS Ids Op OpAux Cks) 20 | (Senv : STATICENV Ids Op OpAux Cks) 21 | (Syn : LSYNTAX Ids Op OpAux Cks Senv) 22 | (Typ : LTYPING Ids Op OpAux Cks Senv Syn) 23 | (Clo : LCLOCKING Ids Op OpAux Cks Senv Syn) 24 | (Ord : LORDERED Ids Op OpAux Cks Senv Syn) 25 | (Sem : LSEMANTICS Ids Op OpAux Cks Senv Syn Ord CStr) 26 | (ClSem : LCLOCKEDSEMANTICS Ids Op OpAux Cks Senv Syn Clo Ord CStr Sem). 27 | Declare Module Export NF : NORMFBY Ids Op OpAux Cks Senv Syn. 28 | Declare Module Export Typing : NFTYPING Ids Op OpAux Cks Senv Syn Typ NF. 29 | Declare Module Export Clocking : NFCLOCKING Ids Op OpAux Cks Senv Syn Clo NF. 30 | Declare Module Export Correct : NFCORRECTNESS Ids Op OpAux Cks CStr Senv Syn Clo Ord Sem ClSem NF. 31 | End LNORMFBY. 32 | 33 | Module LNormFbyFun 34 | (Ids : IDS) 35 | (Op : OPERATORS) 36 | (OpAux : OPERATORS_AUX Ids Op) 37 | (Cks : CLOCKS Ids Op OpAux) 38 | (CStr : COINDSTREAMS Ids Op OpAux Cks) 39 | (Senv : STATICENV Ids Op OpAux Cks) 40 | (Syn : LSYNTAX Ids Op OpAux Cks Senv) 41 | (Typ : LTYPING Ids Op OpAux Cks Senv Syn) 42 | (Clo : LCLOCKING Ids Op OpAux Cks Senv Syn) 43 | (Ord : LORDERED Ids Op OpAux Cks Senv Syn) 44 | (Sem : LSEMANTICS Ids Op OpAux Cks Senv Syn Ord CStr) 45 | (ClSem : LCLOCKEDSEMANTICS Ids Op OpAux Cks Senv Syn Clo Ord CStr Sem) 46 | <: LNORMFBY Ids Op OpAux Cks CStr Senv Syn Typ Clo Ord Sem ClSem. 47 | Module Export NF := NormFbyFun Ids Op OpAux Cks Senv Syn. 48 | Module Export Typing := NFTypingFun Ids Op OpAux Cks Senv Syn Typ NF. 49 | Module Export Clocking := NFClockingFun Ids Op OpAux Cks Senv Syn Clo NF. 50 | Module Export Correct := NFCorrectnessFun Ids Op OpAux Cks CStr Senv Syn Clo Ord Sem ClSem NF. 51 | End LNormFbyFun. 52 | -------------------------------------------------------------------------------- /src/Lustre/NormLast/LNormLast.v: -------------------------------------------------------------------------------- 1 | From Velus Require Import Common. 2 | From Velus Require Import Operators Environment. 3 | From Velus Require Import Clocks. 4 | From Velus Require Import CoindStreams IndexedStreams. 5 | From Velus Require Import Lustre.StaticEnv. 6 | From Velus Require Import Lustre.LSyntax Lustre.LTyping Lustre.LClocking. 7 | From Velus Require Import Lustre.LOrdered. 8 | From Velus Require Import Lustre.LSemantics LClockedSemantics. 9 | From Velus Require Import Lustre.NormLast.NormLast. 10 | From Velus Require Import Lustre.NormLast.NLTyping. 11 | From Velus Require Import Lustre.NormLast.NLClocking. 12 | From Velus Require Import Lustre.NormLast.NLCorrectness. 13 | 14 | Module Type LNORMLAST 15 | (Ids : IDS) 16 | (Op : OPERATORS) 17 | (OpAux : OPERATORS_AUX Ids Op) 18 | (Cks : CLOCKS Ids Op OpAux) 19 | (CStr : COINDSTREAMS Ids Op OpAux Cks) 20 | (Senv : STATICENV Ids Op OpAux Cks) 21 | (Syn : LSYNTAX Ids Op OpAux Cks Senv) 22 | (Typ : LTYPING Ids Op OpAux Cks Senv Syn) 23 | (Clo : LCLOCKING Ids Op OpAux Cks Senv Syn) 24 | (Ord : LORDERED Ids Op OpAux Cks Senv Syn) 25 | (Sem : LSEMANTICS Ids Op OpAux Cks Senv Syn Ord CStr) 26 | (ClSem : LCLOCKEDSEMANTICS Ids Op OpAux Cks Senv Syn Clo Ord CStr Sem). 27 | Declare Module Export NL : NORMLAST Ids Op OpAux Cks Senv Syn. 28 | Declare Module Export Typing : NLTYPING Ids Op OpAux Cks Senv Syn Typ NL. 29 | Declare Module Export Clocking : NLCLOCKING Ids Op OpAux Cks Senv Syn Clo NL. 30 | Declare Module Export Correct : NLCORRECTNESS Ids Op OpAux Cks CStr Senv Syn Clo Ord Sem ClSem NL. 31 | End LNORMLAST. 32 | 33 | Module LNormLastFun 34 | (Ids : IDS) 35 | (Op : OPERATORS) 36 | (OpAux : OPERATORS_AUX Ids Op) 37 | (Cks : CLOCKS Ids Op OpAux) 38 | (CStr : COINDSTREAMS Ids Op OpAux Cks) 39 | (Senv : STATICENV Ids Op OpAux Cks) 40 | (Syn : LSYNTAX Ids Op OpAux Cks Senv) 41 | (Typ : LTYPING Ids Op OpAux Cks Senv Syn) 42 | (Clo : LCLOCKING Ids Op OpAux Cks Senv Syn) 43 | (Ord : LORDERED Ids Op OpAux Cks Senv Syn) 44 | (Sem : LSEMANTICS Ids Op OpAux Cks Senv Syn Ord CStr) 45 | (ClSem : LCLOCKEDSEMANTICS Ids Op OpAux Cks Senv Syn Clo Ord CStr Sem) 46 | <: LNORMLAST Ids Op OpAux Cks CStr Senv Syn Typ Clo Ord Sem ClSem. 47 | Module Export NL := NormLastFun Ids Op OpAux Cks Senv Syn. 48 | Module Export Typing := NLTypingFun Ids Op OpAux Cks Senv Syn Typ NL. 49 | Module Export Clocking := NLClockingFun Ids Op OpAux Cks Senv Syn Clo NL. 50 | Module Export Correct := NLCorrectnessFun Ids Op OpAux Cks CStr Senv Syn Clo Ord Sem ClSem NL. 51 | End LNormLastFun. 52 | -------------------------------------------------------------------------------- /src/Lustre/CompAuto/LCompAuto.v: -------------------------------------------------------------------------------- 1 | From Velus Require Import Common. 2 | From Velus Require Import Operators Environment. 3 | From Velus Require Import Clocks. 4 | From Velus Require Import CoindStreams IndexedStreams. 5 | From Velus Require Import Lustre.StaticEnv. 6 | From Velus Require Import Lustre.LSyntax Lustre.LTyping Lustre.LClocking. 7 | From Velus Require Import Lustre.LOrdered. 8 | From Velus Require Import Lustre.LSemantics LClockedSemantics. 9 | From Velus Require Import Lustre.CompAuto.CompAuto. 10 | From Velus Require Import Lustre.CompAuto.CATyping. 11 | From Velus Require Import Lustre.CompAuto.CAClocking. 12 | From Velus Require Import Lustre.CompAuto.CACorrectness. 13 | 14 | Module Type LCOMPAUTO 15 | (Ids : IDS) 16 | (Op : OPERATORS) 17 | (OpAux : OPERATORS_AUX Ids Op) 18 | (Cks : CLOCKS Ids Op OpAux) 19 | (CStr : COINDSTREAMS Ids Op OpAux Cks) 20 | (Senv : STATICENV Ids Op OpAux Cks) 21 | (Syn : LSYNTAX Ids Op OpAux Cks Senv) 22 | (Typ : LTYPING Ids Op OpAux Cks Senv Syn) 23 | (Clo : LCLOCKING Ids Op OpAux Cks Senv Syn) 24 | (Ord : LORDERED Ids Op OpAux Cks Senv Syn) 25 | (Sem : LSEMANTICS Ids Op OpAux Cks Senv Syn Ord CStr) 26 | (ClSem : LCLOCKEDSEMANTICS Ids Op OpAux Cks Senv Syn Clo Ord CStr Sem). 27 | Declare Module Export CA : COMPAUTO Ids Op OpAux Cks Senv Syn. 28 | Declare Module Export Typing : CATYPING Ids Op OpAux Cks Senv Syn Typ CA. 29 | Declare Module Export Clocking : CACLOCKING Ids Op OpAux Cks Senv Syn Clo CA. 30 | Declare Module Export Correct : CACORRECTNESS Ids Op OpAux Cks CStr Senv Syn Typ Clo Ord Sem ClSem CA. 31 | End LCOMPAUTO. 32 | 33 | Module LCompAutoFun 34 | (Ids : IDS) 35 | (Op : OPERATORS) 36 | (OpAux : OPERATORS_AUX Ids Op) 37 | (Cks : CLOCKS Ids Op OpAux) 38 | (CStr : COINDSTREAMS Ids Op OpAux Cks) 39 | (Senv : STATICENV Ids Op OpAux Cks) 40 | (Syn : LSYNTAX Ids Op OpAux Cks Senv) 41 | (Typ : LTYPING Ids Op OpAux Cks Senv Syn) 42 | (Clo : LCLOCKING Ids Op OpAux Cks Senv Syn) 43 | (Ord : LORDERED Ids Op OpAux Cks Senv Syn) 44 | (Sem : LSEMANTICS Ids Op OpAux Cks Senv Syn Ord CStr) 45 | (ClSem : LCLOCKEDSEMANTICS Ids Op OpAux Cks Senv Syn Clo Ord CStr Sem) 46 | <: LCOMPAUTO Ids Op OpAux Cks CStr Senv Syn Typ Clo Ord Sem ClSem. 47 | Module Export CA := CompAutoFun Ids Op OpAux Cks Senv Syn. 48 | Module Export Typing := CATypingFun Ids Op OpAux Cks Senv Syn Typ CA. 49 | Module Export Clocking := CAClockingFun Ids Op OpAux Cks Senv Syn Clo CA. 50 | Module Export Correct := CACorrectnessFun Ids Op OpAux Cks CStr Senv Syn Typ Clo Ord Sem ClSem CA. 51 | End LCompAutoFun. 52 | -------------------------------------------------------------------------------- /src/Lustre/ClockSwitch/LClockSwitch.v: -------------------------------------------------------------------------------- 1 | From Velus Require Import Common. 2 | From Velus Require Import Operators Environment. 3 | From Velus Require Import Clocks. 4 | From Velus Require Import CoindStreams IndexedStreams. 5 | From Velus Require Import Lustre.StaticEnv. 6 | From Velus Require Import Lustre.LSyntax Lustre.LTyping Lustre.LClocking. 7 | From Velus Require Import Lustre.LOrdered. 8 | From Velus Require Import Lustre.LSemantics LClockedSemantics. 9 | From Velus Require Import Lustre.ClockSwitch.ClockSwitch. 10 | From Velus Require Import Lustre.ClockSwitch.CSTyping. 11 | From Velus Require Import Lustre.ClockSwitch.CSClocking. 12 | From Velus Require Import Lustre.ClockSwitch.CSCorrectness. 13 | 14 | Module Type LCLOCKSWITCH 15 | (Ids : IDS) 16 | (Op : OPERATORS) 17 | (OpAux : OPERATORS_AUX Ids Op) 18 | (Cks : CLOCKS Ids Op OpAux) 19 | (CStr : COINDSTREAMS Ids Op OpAux Cks) 20 | (Senv : STATICENV Ids Op OpAux Cks) 21 | (Syn : LSYNTAX Ids Op OpAux Cks Senv) 22 | (Typ : LTYPING Ids Op OpAux Cks Senv Syn) 23 | (Clo : LCLOCKING Ids Op OpAux Cks Senv Syn) 24 | (Ord : LORDERED Ids Op OpAux Cks Senv Syn) 25 | (Sem : LSEMANTICS Ids Op OpAux Cks Senv Syn Ord CStr) 26 | (ClSem : LCLOCKEDSEMANTICS Ids Op OpAux Cks Senv Syn Clo Ord CStr Sem). 27 | Declare Module Export CS : CLOCKSWITCH Ids Op OpAux Cks Senv Syn. 28 | Declare Module Export CSTyp : CSTYPING Ids Op OpAux Cks Senv Syn Typ CS. 29 | Declare Module Export CSClo : CSCLOCKING Ids Op OpAux Cks Senv Syn Clo CS. 30 | Declare Module Export Correct : CSCORRECTNESS Ids Op OpAux Cks CStr Senv Syn Typ Clo Ord Sem ClSem CS. 31 | End LCLOCKSWITCH. 32 | 33 | Module LClockSwitchFun 34 | (Ids : IDS) 35 | (Op : OPERATORS) 36 | (OpAux : OPERATORS_AUX Ids Op) 37 | (Cks : CLOCKS Ids Op OpAux) 38 | (CStr : COINDSTREAMS Ids Op OpAux Cks) 39 | (Senv : STATICENV Ids Op OpAux Cks) 40 | (Syn : LSYNTAX Ids Op OpAux Cks Senv) 41 | (Typ : LTYPING Ids Op OpAux Cks Senv Syn) 42 | (Clo : LCLOCKING Ids Op OpAux Cks Senv Syn) 43 | (Ord : LORDERED Ids Op OpAux Cks Senv Syn) 44 | (Sem : LSEMANTICS Ids Op OpAux Cks Senv Syn Ord CStr) 45 | (ClSem : LCLOCKEDSEMANTICS Ids Op OpAux Cks Senv Syn Clo Ord CStr Sem) 46 | <: LCLOCKSWITCH Ids Op OpAux Cks CStr Senv Syn Typ Clo Ord Sem ClSem. 47 | Module Export CS := ClockSwitchFun Ids Op OpAux Cks Senv Syn. 48 | Module Export CSTyp := CSTypingFun Ids Op OpAux Cks Senv Syn Typ CS. 49 | Module Export CSClo := CSClockingFun Ids Op OpAux Cks Senv Syn Clo CS. 50 | Module Export Correct := CSCorrectnessFun Ids Op OpAux Cks CStr Senv Syn Typ Clo Ord Sem ClSem CS. 51 | End LClockSwitchFun. 52 | -------------------------------------------------------------------------------- /src/Lustre/InlineLocal/LInlineLocal.v: -------------------------------------------------------------------------------- 1 | From Velus Require Import Common. 2 | From Velus Require Import Operators Environment. 3 | From Velus Require Import Clocks. 4 | From Velus Require Import CoindStreams IndexedStreams. 5 | From Velus Require Import Lustre.StaticEnv. 6 | From Velus Require Import Lustre.LSyntax Lustre.LTyping Lustre.LClocking. 7 | From Velus Require Import Lustre.LOrdered. 8 | From Velus Require Import Lustre.LSemantics LClockedSemantics. 9 | From Velus Require Import Lustre.InlineLocal.InlineLocal. 10 | From Velus Require Import Lustre.InlineLocal.ILTyping. 11 | From Velus Require Import Lustre.InlineLocal.ILClocking. 12 | From Velus Require Import Lustre.InlineLocal.ILCorrectness. 13 | 14 | Module Type LINLINELOCAL 15 | (Ids : IDS) 16 | (Op : OPERATORS) 17 | (OpAux : OPERATORS_AUX Ids Op) 18 | (Cks : CLOCKS Ids Op OpAux) 19 | (CStr : COINDSTREAMS Ids Op OpAux Cks) 20 | (Senv : STATICENV Ids Op OpAux Cks) 21 | (Syn : LSYNTAX Ids Op OpAux Cks Senv) 22 | (Typ : LTYPING Ids Op OpAux Cks Senv Syn) 23 | (Clo : LCLOCKING Ids Op OpAux Cks Senv Syn) 24 | (Ord : LORDERED Ids Op OpAux Cks Senv Syn) 25 | (Sem : LSEMANTICS Ids Op OpAux Cks Senv Syn Ord CStr) 26 | (ClSem : LCLOCKEDSEMANTICS Ids Op OpAux Cks Senv Syn Clo Ord CStr Sem). 27 | Declare Module Export IL : INLINELOCAL Ids Op OpAux Cks Senv Syn. 28 | Declare Module Export Typing : ILTYPING Ids Op OpAux Cks Senv Syn Typ IL. 29 | Declare Module Export Clocking : ILCLOCKING Ids Op OpAux Cks Senv Syn Clo IL. 30 | Declare Module Export Correct : ILCORRECTNESS Ids Op OpAux Cks CStr Senv Syn Typ Clo Ord Sem ClSem IL. 31 | End LINLINELOCAL. 32 | 33 | Module LInlineLocalFun 34 | (Ids : IDS) 35 | (Op : OPERATORS) 36 | (OpAux : OPERATORS_AUX Ids Op) 37 | (Cks : CLOCKS Ids Op OpAux) 38 | (CStr : COINDSTREAMS Ids Op OpAux Cks) 39 | (Senv : STATICENV Ids Op OpAux Cks) 40 | (Syn : LSYNTAX Ids Op OpAux Cks Senv) 41 | (Typ : LTYPING Ids Op OpAux Cks Senv Syn) 42 | (Clo : LCLOCKING Ids Op OpAux Cks Senv Syn) 43 | (Ord : LORDERED Ids Op OpAux Cks Senv Syn) 44 | (Sem : LSEMANTICS Ids Op OpAux Cks Senv Syn Ord CStr) 45 | (ClSem : LCLOCKEDSEMANTICS Ids Op OpAux Cks Senv Syn Clo Ord CStr Sem) 46 | <: LINLINELOCAL Ids Op OpAux Cks CStr Senv Syn Typ Clo Ord Sem ClSem. 47 | Module Export IL := InlineLocalFun Ids Op OpAux Cks Senv Syn. 48 | Module Export Typing := ILTypingFun Ids Op OpAux Cks Senv Syn Typ IL. 49 | Module Export Clocking := ILClockingFun Ids Op OpAux Cks Senv Syn Clo IL. 50 | Module Export Correct := ILCorrectnessFun Ids Op OpAux Cks CStr Senv Syn Typ Clo Ord Sem ClSem IL. 51 | End LInlineLocalFun. 52 | -------------------------------------------------------------------------------- /benchs/stopwatch.ept: -------------------------------------------------------------------------------- 1 | (* The stopwatch example from 2 | Colaco, Pagano, Pouzet, 3 | "Scade 6: A Formal Language for Embedded Critical Software Development" *) 4 | 5 | node stopwatch(stst, rst, set, md : bool) 6 | returns (hh, mm, ss : int; isLap : bool) 7 | var 8 | isStart : bool; -- is chrono started ? 9 | isWatch : bool; -- is in clock mode ? 10 | isSet, isSetEnd : bool; 11 | last m : int = 0; last s : int = 0; last d : int = 0; -- chrono timers 12 | last wh : int = 0; last wm : int = 0; last w : int = 0; last ws : int = 0; -- clock timers 13 | let 14 | w = 0 fby (w + 1) % 100; 15 | ws = 0 -> (if (w < (0 fby w)) 16 | then (0 fby w) + 1 else (0 fby w)) % 60; 17 | 18 | automaton 19 | state Stop do 20 | isStart = false; 21 | (m, s, d) = (last m, last s, last d); 22 | unless stst and not isWatch continue Start 23 | | rst and not isLap and not isWatch then Stop 24 | 25 | state Start do 26 | isStart = true; 27 | d = (last d + 1) % 100; 28 | s = (if d < last d then last s + 1 else last s) % 60; 29 | m = if s < last s then last m + 1 else last m; 30 | unless stst and not isWatch continue Stop 31 | end; 32 | 33 | automaton 34 | state Count do 35 | isSet = false; 36 | isSetEnd = false; 37 | wm = 0 -> (if ws < last ws then last wm + 1 else last wm) % 60; 38 | wh = 0 -> (if wm < last wm then last wh + 1 else last wh) % 24; 39 | until set and isWatch then Set 40 | 41 | state Set do 42 | isSet = true; 43 | automaton 44 | state SetHours do 45 | isSetEnd = false; 46 | wh = (if stst then last wh + 1 else if rst then last wh + 23 else last wh) % 24 47 | until set and isWatch then SetMinutes 48 | state SetMinutes do 49 | isSetEnd = false; 50 | wm = (if stst then last wm + 1 else if rst then last wm + 23 else last wm) % 24 51 | until set and isWatch then SetEnd 52 | state SetEnd do isSetEnd = true 53 | end 54 | until isSetEnd continue Count 55 | end; 56 | 57 | automaton 58 | state DisplayWatch do 59 | isWatch = true; 60 | isLap = false; 61 | (hh, mm, ss) = (wh, wm, ws) 62 | unless md and not isSet continue DisplayStopWatch 63 | state DisplayStopWatch 64 | var last lm : int = 0; last ls : int = 0; last ld : int = 0; do 65 | isWatch = false; 66 | (hh, mm, ss) = (lm, ls, ld); 67 | 68 | automaton 69 | state StopWatch do 70 | isLap = false; 71 | (lm, ls, ld) = (m, s, d) 72 | until rst and isStart then Lap 73 | state Lap do 74 | isLap = true; 75 | until rst then StopWatch 76 | end 77 | 78 | unless md and not isSet continue DisplayWatch 79 | end 80 | tel 81 | -------------------------------------------------------------------------------- /src/CoreExpr/CoreExpr.v: -------------------------------------------------------------------------------- 1 | From Velus Require Export Operators. 2 | From Velus Require Export CommonTyping. 3 | From Velus Require Export Clocks. 4 | From Velus Require Export IndexedStreams. 5 | From Velus Require Export CoreExpr.CESyntax. 6 | From Velus Require Export CoreExpr.CEIsFree. 7 | From Velus Require Export CoreExpr.CESemantics. 8 | From Velus Require Export CoreExpr.CEClocking. 9 | From Velus Require Export CoreExpr.CEClockingSemantics. 10 | From Velus Require Export CoreExpr.CETyping. 11 | From Velus Require Export CoreExpr.CETypingSemantics. 12 | From Velus Require Export CoreExpr.CEProperties. 13 | From Velus Require Export CoreExpr.CEInterpreter. 14 | 15 | From Velus Require Import Common. 16 | 17 | Module Type COREEXPR 18 | (Ids : IDS) 19 | (Op : OPERATORS) 20 | (OpAux : OPERATORS_AUX Ids Op) 21 | (ComTyp: COMMONTYPING Ids Op OpAux) 22 | (Cks : CLOCKS Ids Op OpAux) 23 | (Str : INDEXEDSTREAMS Ids Op OpAux Cks). 24 | Declare Module Export Syn : CESYNTAX Ids Op OpAux Cks. 25 | Declare Module Export IsF : CEISFREE Ids Op OpAux Cks Syn. 26 | Declare Module Export Sem : CESEMANTICS Ids Op OpAux Cks Syn Str. 27 | Declare Module Export Typ : CETYPING Ids Op OpAux Cks Syn. 28 | Declare Module Export TypSem : CETYPINGSEMANTICS Ids Op OpAux ComTyp Cks Syn IsF Str Sem Typ. 29 | Declare Module Export Clo : CECLOCKING Ids Op OpAux Cks Syn. 30 | Declare Module Export CloSem : CECLOCKINGSEMANTICS Ids Op OpAux Cks Syn Str Sem Clo. 31 | Declare Module Export Props : CEPROPERTIES Ids Op OpAux Cks Syn Str Sem Typ IsF. 32 | Declare Module Export Interp : CEINTERPRETER Ids Op OpAux Cks Syn Str Sem. 33 | End COREEXPR. 34 | 35 | Module CoreExprFun 36 | (Ids : IDS) 37 | (Op : OPERATORS) 38 | (OpAux : OPERATORS_AUX Ids Op) 39 | (ComTyp: COMMONTYPING Ids Op OpAux) 40 | (Cks : CLOCKS Ids Op OpAux) 41 | (Str : INDEXEDSTREAMS Ids Op OpAux Cks) 42 | <: COREEXPR Ids Op OpAux ComTyp Cks Str. 43 | Module Export Syn := CESyntaxFun Ids Op OpAux Cks. 44 | Module Export IsF := CEIsFreeFun Ids Op OpAux Cks Syn. 45 | Module Export Sem := CESemanticsFun Ids Op OpAux Cks Syn Str. 46 | Module Export Typ := CETypingFun Ids Op OpAux Cks Syn. 47 | Module Export TypSem := CETypingSemanticsFun Ids Op OpAux ComTyp Cks Syn IsF Str Sem Typ. 48 | Module Export Clo := CEClockingFun Ids Op OpAux Cks Syn. 49 | Module Export CloSem := CEClockingSemanticsFun Ids Op OpAux Cks Syn Str Sem Clo. 50 | Module Export Props := CEProperties Ids Op OpAux Cks Syn Str Sem Typ IsF. 51 | Module Export Interp := CEInterpreterFun Ids Op OpAux Cks Syn Str Sem. 52 | End CoreExprFun. 53 | -------------------------------------------------------------------------------- /benchs/stopwatch.lus: -------------------------------------------------------------------------------- 1 | (* The stopwatch example from 2 | Colaco, Pagano, Pouzet, 3 | "Scade 6: A Formal Language for Embedded Critical Software Development" *) 4 | 5 | node stopwatch(stst, rst, set, md : bool) 6 | returns (hh, mm, ss : int; isLap : bool) 7 | var 8 | isStart : bool; -- is chrono started ? 9 | isWatch : bool; -- is in clock mode ? 10 | isSet, isSetEnd : bool; 11 | m, s, d : int; -- chrono timers 12 | wh, wm, w, ws : int; -- clock timers 13 | let 14 | last m = 0; 15 | last s = 0; 16 | last d = 0; 17 | last wh = 0; 18 | last wm = 0; 19 | last w = 0; 20 | last ws = 0; 21 | w = 0 fby (w + 1) mod 100; 22 | ws = 0 -> (if (w < (0 fby w)) 23 | then (0 fby w) + 1 else (0 fby w)) mod 60; 24 | 25 | automaton initially Stop 26 | state Stop do 27 | isStart = false; 28 | unless stst and not isWatch continue Start 29 | | rst and not isLap and not isWatch then Stop 30 | 31 | state Start do 32 | isStart = true; 33 | d = (last d + 1) mod 100; 34 | s = (if d < last d then last s + 1 else last s) mod 60; 35 | m = if s < last s then last m + 1 else last m; 36 | unless stst and not isWatch continue Stop 37 | end; 38 | 39 | automaton initially Count 40 | state Count do 41 | isSet = false; 42 | isSetEnd = false; 43 | wm = 0 -> (if ws < last ws then last wm + 1 else last wm) mod 60; 44 | wh = 0 -> (if wm < last wm then last wh + 1 else last wh) mod 24; 45 | until set and isWatch then Set 46 | 47 | state Set do 48 | isSet = true; 49 | automaton initially SetHours 50 | state SetHours do 51 | isSetEnd = false; 52 | wh = (if stst then last wh + 1 else if rst then last wh + 23 else last wh) mod 24 53 | until set and isWatch then SetMinutes 54 | state SetMinutes do 55 | isSetEnd = false; 56 | wm = (if stst then last wm + 1 else if rst then last wm + 23 else last wm) mod 24 57 | until set and isWatch then SetEnd 58 | state SetEnd do isSetEnd = true 59 | end 60 | until isSetEnd continue Count 61 | end; 62 | 63 | automaton initially DisplayWatch 64 | state DisplayWatch do 65 | isWatch = true; 66 | isLap = false; 67 | hh, mm, ss = (wh, wm, ws) 68 | unless md and not isSet continue DisplayStopWatch 69 | state DisplayStopWatch 70 | var lm, ls, ld : int; do 71 | last lm = 0; 72 | last ls = 0; 73 | last ld = 0; 74 | isWatch = false; 75 | hh, mm, ss = (lm, ls, ld); 76 | 77 | automaton initially StopWatch 78 | state StopWatch do 79 | isLap = false; 80 | lm, ls, ld = (m, s, d) 81 | until rst and isStart then Lap 82 | state Lap do 83 | isLap = true; 84 | until rst then StopWatch 85 | end 86 | 87 | unless md and not isSet continue DisplayWatch 88 | end 89 | tel 90 | -------------------------------------------------------------------------------- /src/Lustre/Unnesting/LUnnesting.v: -------------------------------------------------------------------------------- 1 | From Velus Require Import Common. 2 | From Velus Require Import Operators Environment. 3 | From Velus Require Import Clocks. 4 | From Velus Require Import CoindStreams IndexedStreams. 5 | From Velus Require Import Lustre.StaticEnv. 6 | From Velus Require Import Lustre.LSyntax Lustre.LTyping Lustre.LClocking. 7 | From Velus Require Import Lustre.LOrdered. 8 | From Velus Require Import Lustre.LSemantics LClockedSemantics. 9 | From Velus Require Import Lustre.Unnesting.Unnesting. 10 | From Velus Require Import Lustre.Unnesting.UTyping. 11 | From Velus Require Import Lustre.Unnesting.UClocking. 12 | From Velus Require Import Lustre.Unnesting.UCorrectness. 13 | (* From Velus Require Import Lustre.Unnesting.Idempotence. *) 14 | 15 | Module Type LUNNESTING 16 | (Ids : IDS) 17 | (Op : OPERATORS) 18 | (OpAux : OPERATORS_AUX Ids Op) 19 | (Cks : CLOCKS Ids Op OpAux) 20 | (CStr : COINDSTREAMS Ids Op OpAux Cks) 21 | (Senv : STATICENV Ids Op OpAux Cks) 22 | (Syn : LSYNTAX Ids Op OpAux Cks Senv) 23 | (Typ : LTYPING Ids Op OpAux Cks Senv Syn) 24 | (Clo : LCLOCKING Ids Op OpAux Cks Senv Syn) 25 | (Ord : LORDERED Ids Op OpAux Cks Senv Syn) 26 | (Sem : LSEMANTICS Ids Op OpAux Cks Senv Syn Ord CStr) 27 | (ClSem : LCLOCKEDSEMANTICS Ids Op OpAux Cks Senv Syn Clo Ord CStr Sem). 28 | Declare Module Export Un : UNNESTING Ids Op OpAux Cks Senv Syn. 29 | Declare Module Export Typing : UTYPING Ids Op OpAux Cks Senv Syn Typ Un. 30 | Declare Module Export Clocking : UCLOCKING Ids Op OpAux Cks Senv Syn Clo Un. 31 | Declare Module Export Correct : UCORRECTNESS Ids Op OpAux Cks CStr Senv Syn Typ Clo Ord Sem ClSem Un. 32 | (* Declare Module Export Idempotence : IDEMPOTENCE Ids Op OpAux Syn Cau Norm. *) 33 | End LUNNESTING. 34 | 35 | Module LUnnestingFun 36 | (Ids : IDS) 37 | (Op : OPERATORS) 38 | (OpAux : OPERATORS_AUX Ids Op) 39 | (Cks : CLOCKS Ids Op OpAux) 40 | (CStr : COINDSTREAMS Ids Op OpAux Cks) 41 | (Senv : STATICENV Ids Op OpAux Cks) 42 | (Syn : LSYNTAX Ids Op OpAux Cks Senv) 43 | (Typ : LTYPING Ids Op OpAux Cks Senv Syn) 44 | (Clo : LCLOCKING Ids Op OpAux Cks Senv Syn) 45 | (Ord : LORDERED Ids Op OpAux Cks Senv Syn) 46 | (Sem : LSEMANTICS Ids Op OpAux Cks Senv Syn Ord CStr) 47 | (ClSem : LCLOCKEDSEMANTICS Ids Op OpAux Cks Senv Syn Clo Ord CStr Sem) 48 | <: LUNNESTING Ids Op OpAux Cks CStr Senv Syn Typ Clo Ord Sem ClSem. 49 | Module Export Un := UnnestingFun Ids Op OpAux Cks Senv Syn. 50 | Module Export Typing := UTypingFun Ids Op OpAux Cks Senv Syn Typ Un. 51 | Module Export Clocking := UClockingFun Ids Op OpAux Cks Senv Syn Clo Un. 52 | Module Export Correct := UCorrectnessFun Ids Op OpAux Cks CStr Senv Syn Typ Clo Ord Sem ClSem Un. 53 | (* Module Export Idempotence := IdempotenceFun Ids Op OpAux Syn Cau Norm. *) 54 | End LUnnestingFun. 55 | -------------------------------------------------------------------------------- /src/CoindIndexed.v: -------------------------------------------------------------------------------- 1 | From Coq Require Import List. 2 | Import List.ListNotations. 3 | Open Scope list_scope. 4 | From Coq Require Import Setoid. 5 | From Coq Require Import Morphisms. 6 | From Coq Require Import Program.Tactics. 7 | 8 | From Velus Require Import Common. 9 | From Velus Require Import FunctionalEnvironment. 10 | From Velus Require Import Operators. 11 | From Velus Require Import Clocks. 12 | From Velus Require Import IndexedStreams. 13 | From Velus Require Import CoindStreams. 14 | From Velus Require Import CoindToIndexed IndexedToCoind. 15 | 16 | Module Type COINDINDEXED 17 | (Import Ids : IDS) 18 | (Import Op : OPERATORS) 19 | (Import OpAux : OPERATORS_AUX Ids Op) 20 | (Import Cks : CLOCKS Ids Op OpAux) 21 | (Import CStr : COINDSTREAMS Ids Op OpAux Cks) 22 | (Import IStr : INDEXEDSTREAMS Ids Op OpAux Cks). 23 | 24 | Module Export CIStr := CoindToIndexedFun Ids Op OpAux Cks CStr IStr. 25 | Module Export ICStr := IndexedToCoindFun Ids Op OpAux Cks IStr CStr. 26 | 27 | Fact tr_stream_eqst {A} : forall (x : Stream A), 28 | ICStr.tr_stream (tr_Stream x) ≡ x. 29 | Proof. 30 | unfold ICStr.tr_stream, ICStr.tr_stream_from, tr_Stream. 31 | intros x. 32 | apply ntheq_eqst; intros n. 33 | rewrite init_from_nth, Nat.add_0_r. 34 | reflexivity. 35 | Qed. 36 | 37 | Fact tr_history_equiv {K}: forall (H: @CStr.history K), 38 | FEnv.Equiv (@EqSt _) (ICStr.tr_history (CIStr.tr_history H)) H. 39 | Proof. 40 | intros H. 41 | unfold CIStr.tr_history, ICStr.tr_history, ICStr.tr_history_from. 42 | intros x. simpl_fenv. 43 | destruct (H x); simpl; constructor. 44 | apply ntheq_eqst. intros n. 45 | rewrite init_from_nth, Nat.add_0_r; auto. 46 | Qed. 47 | 48 | Lemma sem_var_equiv {K} : forall (H: @CStr.history K) x v, 49 | CStr.sem_var H x v <-> 50 | IStr.sem_var (CIStr.tr_history H) x (tr_Stream v). 51 | Proof. 52 | intros; split. 53 | - apply CIStr.sem_var_impl. 54 | - intros Hsem. 55 | apply ICStr.sem_var_impl in Hsem. 56 | rewrite tr_stream_eqst in Hsem. rewrite tr_history_equiv in Hsem. 57 | assumption. 58 | Qed. 59 | 60 | Lemma sem_clock_equiv : forall H b ck bs, 61 | CStr.sem_clock H b ck bs <-> 62 | IStr.sem_clock (tr_Stream b) (CIStr.tr_history H) ck (tr_Stream bs). 63 | Proof. 64 | intros; split. 65 | - apply CIStr.sem_clock_impl. 66 | - intro Hsem. 67 | apply ICStr.sem_clock_impl in Hsem. 68 | repeat rewrite tr_stream_eqst in Hsem. rewrite tr_history_equiv in Hsem. 69 | assumption. 70 | Qed. 71 | 72 | End COINDINDEXED. 73 | 74 | Module CoindIndexedFun 75 | (Ids : IDS) 76 | (Op : OPERATORS) 77 | (OpAux : OPERATORS_AUX Ids Op) 78 | (Cks : CLOCKS Ids Op OpAux) 79 | (CStr : COINDSTREAMS Ids Op OpAux Cks) 80 | (IStr : INDEXEDSTREAMS Ids Op OpAux Cks) 81 | <: COINDINDEXED Ids Op OpAux Cks CStr IStr. 82 | Include COINDINDEXED Ids Op OpAux Cks CStr IStr. 83 | End CoindIndexedFun. 84 | -------------------------------------------------------------------------------- /src/Instantiator.v: -------------------------------------------------------------------------------- 1 | From Velus Require Import ObcToClight.Interface. 2 | From Velus Require Import Ident. 3 | From Velus Require Import Operators. 4 | From Velus Require Import Clocks. 5 | 6 | From Velus Require Import CoindToIndexed IndexedToCoind. 7 | 8 | Module CIStr := CoindToIndexedFun Ids Op OpAux Cks CStr IStr. 9 | Module ICStr := IndexedToCoindFun Ids Op OpAux Cks IStr CStr. 10 | 11 | From Velus Require Import CoreExpr. 12 | 13 | Module CE := CoreExprFun Ids Op OpAux ComTyp Cks IStr. 14 | 15 | From Velus Require Import Lustre. 16 | 17 | Module L := LustreFun Ids Op OpAux Cks CStr. 18 | 19 | From Velus Require Import NLustre. 20 | 21 | Module NL := NLustreFun Ids Op OpAux ComTyp Cks CStr IStr CIStr CE. 22 | 23 | From Velus Require Import Transcription. 24 | 25 | Module TR := TranscriptionFun Ids Op OpAux ComTyp Cks CStr IStr CIStr L CE NL. 26 | 27 | From Velus Require Import Stc. 28 | 29 | Module Stc := StcFun Ids Op OpAux ComTyp Cks IStr CE. 30 | 31 | From Coq Require Import ZArith.BinInt. 32 | From Velus Require Import NLustreToStc.Translation. 33 | From Velus Require Import NLustreToStc.Correctness. 34 | From Velus Require Import NLustreToStc.NL2StcTyping. 35 | From Velus Require Import NLustreToStc.NL2StcClocking. 36 | From Velus Require Import NLustreToStc.NL2StcNormalArgs. 37 | 38 | Module NL2Stc := TranslationFun Ids Op OpAux Cks CE.Syn NL.Syn Stc.Syn NL.Mem. 39 | Module NL2StcCorr := CorrectnessFun Ids Op OpAux ComTyp Cks CStr IStr CIStr CE NL Stc NL2Stc. 40 | Module NL2StcTyping := NL2StcTypingFun Ids Op OpAux ComTyp Cks CStr IStr CIStr CE NL Stc NL2Stc. 41 | Module NL2StcClocking := NL2StcClockingFun Ids Op OpAux ComTyp Cks CStr IStr CIStr CE NL Stc NL2Stc. 42 | Module NL2StcNormalArgs := NL2StcNormalArgsFun Ids Op OpAux ComTyp Cks CStr IStr CIStr CE NL Stc NL2Stc. 43 | 44 | From Velus Require Import StcToObc.Translation. 45 | From Velus Require Import StcToObc.Correctness. 46 | From Velus Require Import StcToObc.Stc2ObcInvariants. 47 | From Velus Require Import StcToObc.Stc2ObcTyping. 48 | 49 | Module Stc2Obc := TranslationFun Ids Op OpAux Cks CE.Syn Stc.Syn Obc.Syn. 50 | Module Stc2ObcInvariants := Stc2ObcInvariantsFun Ids Op OpAux ComTyp Cks IStr CE Stc Obc Stc2Obc. 51 | Module Stc2ObcTyping := Stc2ObcTypingFun Ids Op OpAux ComTyp Cks IStr CE Stc Obc Stc2Obc. 52 | Module Stc2ObcCorr := CorrectnessFun Ids Op OpAux ComTyp Cks IStr CE Stc Obc Stc2Obc Stc2ObcTyping. 53 | 54 | 55 | (** this is a test to instantiate Restr & Rt-Op checks *) 56 | From Velus Require Import Lustre.Denot.Restr. 57 | From Velus Require Import Lustre.Denot.CheckOp. 58 | 59 | Module Restr := RestrFun Ids Op OpAux Cks L.Senv L.Syn. 60 | Module CheckOp := CheckOpFun Ids Op OpAux Cks L.Senv L.Syn. 61 | 62 | Definition check_restr := @Restr.check_global. 63 | Definition check_op := @CheckOp.check_global. 64 | 65 | (** the denotational semantics *) 66 | 67 | From Velus Require Import Lustre.Denot.Denot. 68 | 69 | Module Den := LdenotFun Ids Op OpAux Cks L.Senv L.Syn L.Typ L.Clo L.Cau L.Ord CStr L.Sem Restr CheckOp. 70 | -------------------------------------------------------------------------------- /src/NLustre/ExprInlining/EINormalArgs.v: -------------------------------------------------------------------------------- 1 | From Coq Require Import List. 2 | Import List.ListNotations. 3 | Open Scope list_scope. 4 | 5 | From Coq Require Import Recdef. 6 | From Velus Require Import Common. 7 | From Velus Require Import CommonProgram. 8 | From Velus Require Import Operators. 9 | From Velus Require Import Clocks. 10 | From Velus Require Import Environment. 11 | From Velus Require Import CoreExpr.CESyntax. 12 | From Velus Require Import CoreExpr.CETyping. 13 | From Velus Require Import NLustre.NLSyntax. 14 | From Velus Require Import NLustre.NLTyping. 15 | From Velus Require Import NLustre.NLOrdered. 16 | From Velus Require Import NLustre.NLNormalArgs. 17 | From Velus Require Import NLustre.ExprInlining.EI. 18 | 19 | (** Remove duplicate registers in an NLustre program *) 20 | 21 | Module Type EINORMALARGS 22 | (Import Ids : IDS) 23 | (Import Op : OPERATORS) 24 | (Import OpAux : OPERATORS_AUX Ids Op) 25 | (Import Cks : CLOCKS Ids Op OpAux) 26 | (Import CESyn : CESYNTAX Ids Op OpAux Cks) 27 | (Import CETyp : CETYPING Ids Op OpAux Cks CESyn) 28 | (Import Syn : NLSYNTAX Ids Op OpAux Cks CESyn) 29 | (Import Ord : NLORDERED Ids Op OpAux Cks CESyn Syn) 30 | (Import Typ : NLTYPING Ids Op OpAux Cks CESyn Syn Ord CETyp) 31 | (Import Norm : NLNORMALARGS Ids Op OpAux Cks CESyn CETyp Syn Ord Typ) 32 | (Import EI : EI Ids Op OpAux Cks CESyn Syn). 33 | 34 | Lemma exp_inlining_normal_args_node : forall G n, 35 | normal_args_node G n -> 36 | normal_args_node (exp_inlining G) (exp_inlining_node n). 37 | Proof. 38 | unfold normal_args_node. 39 | intros * Hnormed; simpl. unfold inline_all_possible. 40 | rewrite <-fold_left_rev_right. 41 | induction (rev _) as [|(?&?)]; simpl; auto. 42 | - simpl_Forall. 43 | inv Hnormed; econstructor. 44 | eapply find_node_exp_inlining_forward; eauto. simpl; auto. 45 | - unfold inline_in_equations. simpl_Forall. 46 | take equation and destruct it; simpl; auto. 47 | destruct r; constructor. 48 | Qed. 49 | 50 | Theorem exp_inlining_normal_args : forall G, 51 | normal_args G -> 52 | normal_args (exp_inlining G). 53 | Proof. 54 | unfold normal_args; simpl. 55 | induction 1 as [|?? NAS]; simpl; constructor; auto. 56 | apply exp_inlining_normal_args_node in NAS; auto. 57 | Qed. 58 | 59 | End EINORMALARGS. 60 | 61 | Module EINormalArgsFun 62 | (Ids : IDS) 63 | (Op : OPERATORS) 64 | (OpAux : OPERATORS_AUX Ids Op) 65 | (Cks : CLOCKS Ids Op OpAux) 66 | (CESyn : CESYNTAX Ids Op OpAux Cks) 67 | (CETyp : CETYPING Ids Op OpAux Cks CESyn) 68 | (Syn : NLSYNTAX Ids Op OpAux Cks CESyn) 69 | (Ord : NLORDERED Ids Op OpAux Cks CESyn Syn) 70 | (Typ : NLTYPING Ids Op OpAux Cks CESyn Syn Ord CETyp) 71 | (Norm : NLNORMALARGS Ids Op OpAux Cks CESyn CETyp Syn Ord Typ) 72 | (EI : EI Ids Op OpAux Cks CESyn Syn) 73 | <: EINORMALARGS Ids Op OpAux Cks CESyn CETyp Syn Ord Typ Norm EI. 74 | Include EINORMALARGS Ids Op OpAux Cks CESyn CETyp Syn Ord Typ Norm EI. 75 | End EINormalArgsFun. 76 | -------------------------------------------------------------------------------- /src/Transcription/Transcription.v: -------------------------------------------------------------------------------- 1 | From Velus Require Import Common Ident. 2 | From Velus Require Import Operators Environment. 3 | From Velus Require Import CoindStreams IndexedStreams CoindToIndexed. 4 | From Velus Require Import Lustre.Lustre. 5 | From Velus Require Import CoreExpr.CoreExpr. 6 | From Velus Require Import NLustre.NLustre. 7 | From Velus Require Import Transcription.Tr. 8 | From Velus Require Import Transcription.TrTyping Transcription.TrClocking Transcription.Correctness. 9 | From Velus Require Import Transcription.Completeness. 10 | From Velus Require Import Transcription.TrNormalArgs. 11 | 12 | Module Type TRANSCRIPTION 13 | (Ids : IDS) 14 | (Op : OPERATORS) 15 | (OpAux : OPERATORS_AUX Ids Op) 16 | (ComTyp: COMMONTYPING Ids Op OpAux) 17 | (Cks : CLOCKS Ids Op OpAux) 18 | (CStr : COINDSTREAMS Ids Op OpAux Cks) 19 | (IStr : INDEXEDSTREAMS Ids Op OpAux Cks) 20 | (CIStr : COINDTOINDEXED Ids Op OpAux Cks CStr IStr) 21 | (L : LUSTRE Ids Op OpAux Cks CStr) 22 | (CE : COREEXPR Ids Op OpAux ComTyp Cks IStr) 23 | (NL : NLUSTRE Ids Op OpAux ComTyp Cks CStr IStr CIStr CE). 24 | Declare Module Export Tr : TR Ids Op OpAux Cks L.Senv L.Syn CE.Syn NL.Syn. 25 | Declare Module Export Typing : TRTYPING Ids Op OpAux Cks L.Senv L.Syn L.Typ CE.Syn CE.Typ NL.Syn NL.Ord NL.Typ Tr. 26 | Declare Module Export Clocking : TRCLOCKING Ids Op OpAux Cks L.Senv L.Syn L.Typ L.Clo CE.Syn NL.Syn NL.Ord NL.Mem NL.IsD CE.Clo NL.Clo Tr. 27 | Declare Module Export Correctness : CORRECTNESS Ids Op OpAux Cks L.Senv L.Syn CE.Syn NL.Syn Tr L.Typ L.Clo NL.Ord L.Ord CStr L.Sem L.CkSem NL.CoindSem. 28 | Declare Module Export Completeness : COMPLETENESS Ids Op OpAux Cks L.Senv L.Syn L.Typ CE.Syn NL.Syn Tr. 29 | Declare Module Export NormalArgs : TRNORMALARGS Ids Op OpAux Cks L.Senv L.Syn L.Ord CE.Syn CE.Typ NL.Syn NL.Ord NL.Typ NL.Norm Tr. 30 | End TRANSCRIPTION. 31 | 32 | Module TranscriptionFun 33 | (Ids : IDS) 34 | (Op : OPERATORS) 35 | (OpAux : OPERATORS_AUX Ids Op) 36 | (ComTyp: COMMONTYPING Ids Op OpAux) 37 | (Cks : CLOCKS Ids Op OpAux) 38 | (CStr : COINDSTREAMS Ids Op OpAux Cks) 39 | (IStr : INDEXEDSTREAMS Ids Op OpAux Cks) 40 | (CIStr : COINDTOINDEXED Ids Op OpAux Cks CStr IStr) 41 | (L : LUSTRE Ids Op OpAux Cks CStr) 42 | (CE : COREEXPR Ids Op OpAux ComTyp Cks IStr) 43 | (NL : NLUSTRE Ids Op OpAux ComTyp Cks CStr IStr CIStr CE) 44 | <: TRANSCRIPTION Ids Op OpAux ComTyp Cks CStr IStr CIStr L CE NL. 45 | Module Export Tr := TrFun Ids Op OpAux Cks L.Senv L.Syn CE.Syn NL.Syn. 46 | Module Export Typing := TrTypingFun Ids Op OpAux Cks L.Senv L.Syn L.Typ CE.Syn CE.Typ NL.Syn NL.Ord NL.Typ Tr. 47 | Module Export Clocking := TrClockingFun Ids Op OpAux Cks L.Senv L.Syn L.Typ L.Clo CE.Syn NL.Syn NL.Ord NL.Mem NL.IsD CE.Clo NL.Clo Tr. 48 | Module Export Correctness := CorrectnessFun Ids Op OpAux Cks L.Senv L.Syn CE.Syn NL.Syn Tr L.Typ L.Clo NL.Ord L.Ord CStr L.Sem L.CkSem NL.CoindSem. 49 | Module Export Completeness := CompletenessFun Ids Op OpAux Cks L.Senv L.Syn L.Typ CE.Syn NL.Syn Tr. 50 | Module Export NormalArgs := TrNormalArgsFun Ids Op OpAux Cks L.Senv L.Syn L.Ord CE.Syn CE.Typ NL.Syn NL.Ord NL.Typ NL.Norm Tr. 51 | End TranscriptionFun. 52 | -------------------------------------------------------------------------------- /src/Lustre/Denot/CheckOp.v: -------------------------------------------------------------------------------- 1 | From Coq Require Import Datatypes List. 2 | Import List.ListNotations. 3 | 4 | From Velus Require Import Common. 5 | From Velus Require Import Operators. 6 | From Velus Require Import Clocks. 7 | From Velus Require Import Lustre.StaticEnv. 8 | From Velus Require Import Lustre.LSyntax Lustre.LTyping. 9 | 10 | (** * Little static analysis to decide [OpErr.no_rte] *) 11 | 12 | (* we keep it outside of [OpErr], otherwise the extraction of [check_global] 13 | * recursively extracts the CPO library (because of functors...) *) 14 | 15 | Module Type CHECKOP 16 | (Import Ids : IDS) 17 | (Import Op : OPERATORS) 18 | (Import OpAux : OPERATORS_AUX Ids Op) 19 | (Import Cks : CLOCKS Ids Op OpAux) 20 | (Import Senv : STATICENV Ids Op OpAux Cks) 21 | (Import Syn : LSYNTAX Ids Op OpAux Cks Senv). 22 | 23 | (* true -> cannot fail 24 | * false -> we don't know *) 25 | Fixpoint check_exp (e : exp) : bool := 26 | match e with 27 | | Econst _ => true 28 | | Eenum _ _ => true 29 | | Evar _ _ => true 30 | | Elast _ _ => true (* restr *) 31 | | Eunop op e ann => 32 | match typeof e with 33 | | [ty] => check_unop op None ty && check_exp e 34 | | _ => true 35 | end 36 | | Ebinop op e1 (Econst c) ann => 37 | let ty2 := Tprimitive (ctype_cconst c) in 38 | match typeof e1 with 39 | | [ty1] => check_exp e1 40 | (* soit on arrive à décider avec la valeur c, 41 | soit on vérifie pour toute valeur de type ty2 *) 42 | && (check_binop op None ty1 (Some (Vscalar (sem_cconst c))) ty2 43 | || check_binop op None ty1 None ty2) 44 | | _ => true 45 | end 46 | | Ebinop op e1 e2 ann => 47 | match typeof e1, typeof e2 with 48 | | [ty1], [ty2] => check_binop op None ty1 None ty2 && check_exp e1 && check_exp e2 49 | | _,_ => true 50 | end 51 | | Eextcall _ _ _ => true (* restr *) 52 | | Efby e0s es ann => forallb check_exp e0s && forallb check_exp es 53 | | Earrow e0s es ann => true (* restr *) 54 | | Ewhen es _ t ann => forallb check_exp es 55 | | Emerge _ ess ann => forallb (fun '(t,es) => forallb check_exp es) ess 56 | | Ecase e ess None ann => check_exp e && forallb (fun '(t,es) => forallb check_exp es) ess 57 | | Ecase e ess (Some des) ann => check_exp e && forallb (fun '(t,es) => forallb check_exp es) ess && forallb check_exp des 58 | | Eapp f es er ann => forallb check_exp es && forallb check_exp er 59 | end. 60 | 61 | Definition check_block b := 62 | match b with 63 | | Beq (_, es) => forallb check_exp es 64 | | _ => false 65 | end. 66 | 67 | Definition check_top_block b := 68 | match b with 69 | | Blocal (Scope locs blks) => forallb check_block blks 70 | | _ => false 71 | end. 72 | 73 | Definition check_node {PSyn Prefs} (n : @node PSyn Prefs) := 74 | check_top_block (n_block n). 75 | 76 | Definition check_global {PSyn Prefs} (G : @global PSyn Prefs) := 77 | forallb check_node (nodes G). 78 | 79 | 80 | End CHECKOP. 81 | 82 | Module CheckOpFun 83 | (Ids : IDS) 84 | (Op : OPERATORS) 85 | (OpAux : OPERATORS_AUX Ids Op) 86 | (Cks : CLOCKS Ids Op OpAux) 87 | (Senv : STATICENV Ids Op OpAux Cks) 88 | (Syn : LSYNTAX Ids Op OpAux Cks Senv) 89 | <: CHECKOP Ids Op OpAux Cks Senv Syn. 90 | Include CHECKOP Ids Op OpAux Cks Senv Syn. 91 | End CheckOpFun. 92 | -------------------------------------------------------------------------------- /src/NLustreToStc/NL2StcNormalArgs.v: -------------------------------------------------------------------------------- 1 | From Velus Require Import NLustre. 2 | From Velus Require Import Stc. 3 | 4 | From Velus Require Import NLustreToStc.Translation. 5 | 6 | From Velus Require Import VelusMemory. 7 | From Velus Require Import Common. 8 | From Velus Require Import CoindToIndexed. 9 | From Velus Require Import CommonProgram. 10 | From Velus Require Import CommonTyping. 11 | 12 | From Coq Require Import List. 13 | Import List.ListNotations. 14 | 15 | Module Type NL2STCNORMALARGS 16 | (Import Ids : IDS) 17 | (Import Op : OPERATORS) 18 | (Import OpAux : OPERATORS_AUX Ids Op) 19 | (Import ComTyp: COMMONTYPING Ids Op OpAux) 20 | (Import Cks : CLOCKS Ids Op OpAux) 21 | (Import CStr : COINDSTREAMS Ids Op OpAux Cks) 22 | (Import IStr : INDEXEDSTREAMS Ids Op OpAux Cks) 23 | (Import CIStr : COINDTOINDEXED Ids Op OpAux Cks CStr IStr) 24 | (Import CE : COREEXPR Ids Op OpAux ComTyp Cks IStr) 25 | (Import NL : NLUSTRE Ids Op OpAux ComTyp Cks CStr IStr CIStr CE) 26 | (Import Stc : STC Ids Op OpAux ComTyp Cks IStr CE) 27 | (Import Trans : TRANSLATION Ids Op OpAux Cks CE.Syn NL.Syn Stc.Syn NL.Mem). 28 | 29 | Lemma translate_eqn_normal_args: 30 | forall G env eq, 31 | Norm.normal_args_eq G eq -> 32 | Forall (normal_args_tc (translate G)) (translate_eqn env eq). 33 | Proof. 34 | induction 1 as [| |?????? Find|]; simpl; cases. 35 | all:try constructor; simpl_Forall; eauto with stcsyn. 36 | apply option_map_inv in Find as ((?&?)& Find &?); simpl in *; subst. 37 | apply find_unit_transform_units_forward in Find. 38 | econstructor; eauto. simpl_Forall; auto. 39 | Qed. 40 | 41 | Lemma translate_node_normal_args: 42 | forall G n, 43 | normal_args_node G n -> 44 | normal_args_system (translate G) (translate_node n). 45 | Proof. 46 | intros. 47 | unfold normal_args_node, normal_args_system in *. simpl in *. 48 | simpl_Forall. unfold translate_eqns in *. simpl_In. simpl_Forall. 49 | eapply translate_eqn_normal_args, Forall_forall in H; eauto. 50 | Qed. 51 | 52 | Lemma translate_normal_args: 53 | forall G, 54 | NL.Norm.normal_args G -> 55 | normal_args (translate G). 56 | Proof. 57 | unfold NL.Norm.normal_args, normal_args; simpl. 58 | induction 1 as [|?? NAS]; simpl; constructor; auto. 59 | apply translate_node_normal_args in NAS; auto. 60 | Qed. 61 | 62 | End NL2STCNORMALARGS. 63 | 64 | Module NL2StcNormalArgsFun 65 | (Ids : IDS) 66 | (Op : OPERATORS) 67 | (OpAux : OPERATORS_AUX Ids Op) 68 | (ComTyp: COMMONTYPING Ids Op OpAux) 69 | (Cks : CLOCKS Ids Op OpAux) 70 | (CStr : COINDSTREAMS Ids Op OpAux Cks) 71 | (IStr : INDEXEDSTREAMS Ids Op OpAux Cks) 72 | (CIStr : COINDTOINDEXED Ids Op OpAux Cks CStr IStr) 73 | (CE : COREEXPR Ids Op OpAux ComTyp Cks IStr) 74 | (NL : NLUSTRE Ids Op OpAux ComTyp Cks CStr IStr CIStr CE) 75 | (Stc : STC Ids Op OpAux ComTyp Cks IStr CE) 76 | (Trans : TRANSLATION Ids Op OpAux Cks CE.Syn NL.Syn Stc.Syn NL.Mem) 77 | <: NL2STCNORMALARGS Ids Op OpAux ComTyp Cks CStr IStr CIStr CE NL Stc Trans. 78 | Include NL2STCNORMALARGS Ids Op OpAux ComTyp Cks CStr IStr CIStr CE NL Stc Trans. 79 | End NL2StcNormalArgsFun. 80 | -------------------------------------------------------------------------------- /benchs/halbwachs.ept: -------------------------------------------------------------------------------- 1 | (* lustre examples from "synchronous programming of reactive systems", 2 | nicolas halbwachs, 1993 kluwer academic publishers. *) 3 | 4 | node counter(vinit_value, incr_value: int; vreset: bool) 5 | returns (n: int); 6 | let 7 | n = vinit_value -> (if vreset then vinit_value 8 | else (0 fby n) + incr_value); 9 | tel 10 | 11 | node watchdog1 (set, vreset, deadline: bool) 12 | returns (alarm: bool); 13 | var watchdog_is_on: bool; 14 | let 15 | alarm = deadline and watchdog_is_on; 16 | watchdog_is_on = false -> (if set then true 17 | else if vreset then false 18 | else (false fby watchdog_is_on)); 19 | tel 20 | 21 | node edge (b: bool) returns (edge: bool); 22 | let 23 | edge = false -> (b and not (false fby b)); 24 | tel 25 | 26 | node watchdog2 (set, vreset: bool; delay: int) 27 | returns (alarm: bool); 28 | var remaining_delay: int; deadline: bool; 29 | let 30 | alarm = watchdog1(set, vreset, deadline); 31 | deadline = edge(remaining_delay = 0); 32 | remaining_delay = if set then delay 33 | else (0 fby (remaining_delay - 1)); 34 | tel 35 | 36 | node simple_stopwatch (start_stop, vreset, hs: bool) 37 | returns (time: int; running: bool); 38 | let 39 | time = 0 -> (if hs and running then (0 fby time) + 1 40 | else if vreset then 0 else (0 fby time)); 41 | running = false -> (if start_stop 42 | then not (false fby running) 43 | else (false fby running)); 44 | tel 45 | 46 | node stopwatch (start_stop, vreset, hs: bool) 47 | returns (displayed_time: int; running, frozen: bool); 48 | var internal_time: int; actual_vreset: bool; 49 | let 50 | frozen = false -> 51 | (if vreset and (false fby running) then true 52 | else if vreset and (false fby frozen) then false 53 | else (false fby frozen)); 54 | displayed_time = 55 | merge frozen 56 | (true -> (0 fby displayed_time) when frozen) 57 | (false -> internal_time when not frozen); 58 | (internal_time, running) = 59 | simple_stopwatch(start_stop, actual_vreset, hs); 60 | actual_vreset = 61 | vreset and false fby (not running and not frozen); 62 | tel 63 | 64 | node switch_1(von, voff, vinit: bool) returns (vstate: bool); 65 | let 66 | vstate = vinit -> (if von then true 67 | else if voff then false 68 | else (false fby vstate)); 69 | tel 70 | 71 | node nswitch(von, voff, vinit: bool) returns (vstate: bool); 72 | let 73 | vstate = vinit -> (if von and not (false fby vstate) then true 74 | else if voff and (false fby vstate) then false 75 | else (false fby vstate)); 76 | tel 77 | 78 | node compare(von, voff, vinit: bool) returns (ok: bool); 79 | var vstate, vstate_1 : bool; 80 | let 81 | vstate = nswitch(von, voff, vinit); 82 | vstate_1 = switch_1(von, voff, vinit); 83 | ok = (vstate = vstate_1); 84 | tel 85 | 86 | node watchdog3 (set, vreset, time_unit: bool; 87 | delay: int) 88 | returns (alarm: bool); 89 | var clock: bool; 90 | let 91 | alarm = merge clock 92 | (true => watchdog2(set when clock, 93 | vreset when clock, 94 | delay when clock)) 95 | (false => (false fby alarm) when not clock); 96 | clock = true -> set or vreset or time_unit; 97 | tel 98 | 99 | -------------------------------------------------------------------------------- /benchs/halbwachs.lus: -------------------------------------------------------------------------------- 1 | (* lustre examples from "synchronous programming of reactive systems", 2 | nicolas halbwachs, 1993 kluwer academic publishers. *) 3 | 4 | node counter(vinit_value, incr_value: int; vreset: bool) 5 | returns (n: int); 6 | let 7 | n = vinit_value -> (if vreset then vinit_value 8 | else (0 fby n) + incr_value); 9 | tel 10 | 11 | node watchdog1 (set, vreset, deadline: bool) 12 | returns (alarm: bool); 13 | var watchdog_is_on: bool; 14 | let 15 | alarm = deadline and watchdog_is_on; 16 | watchdog_is_on = false -> (if set then true 17 | else if vreset then false 18 | else (false fby watchdog_is_on)); 19 | tel 20 | 21 | node edge (b: bool) returns (edge: bool); 22 | let 23 | edge = false -> (b and not (false fby b)); 24 | tel 25 | 26 | node watchdog2 (set, vreset: bool; delay: int) 27 | returns (alarm: bool); 28 | var remaining_delay: int; deadline: bool; 29 | let 30 | alarm = watchdog1(set, vreset, deadline); 31 | deadline = edge(remaining_delay = 0); 32 | remaining_delay = if set then delay 33 | else (0 fby (remaining_delay - 1)); 34 | tel 35 | 36 | node simple_stopwatch (start_stop, vreset, hs: bool) 37 | returns (time: int; running: bool); 38 | let 39 | time = 0 -> (if hs and running then (0 fby time) + 1 40 | else if vreset then 0 else (0 fby time)); 41 | running = false -> (if start_stop 42 | then not (false fby running) 43 | else (false fby running)); 44 | tel 45 | 46 | node stopwatch (start_stop, vreset, hs: bool) 47 | returns (displayed_time: int; running, frozen: bool); 48 | var internal_time: int; actual_vreset: bool; 49 | let 50 | frozen = false -> 51 | (if vreset and (false fby running) then true 52 | else if vreset and (false fby frozen) then false 53 | else (false fby frozen)); 54 | displayed_time = 55 | merge frozen 56 | (true => (0 fby displayed_time) when frozen) 57 | (false => internal_time when not frozen); 58 | (internal_time, running) = 59 | simple_stopwatch(start_stop, actual_vreset, hs); 60 | actual_vreset = 61 | vreset and false fby (not running and not frozen); 62 | tel 63 | 64 | node switch_1(von, voff, vinit: bool) returns (vstate: bool); 65 | let 66 | vstate = vinit -> (if von then true 67 | else if voff then false 68 | else (false fby vstate)); 69 | tel 70 | 71 | node nswitch(von, voff, vinit: bool) returns (vstate: bool); 72 | let 73 | vstate = vinit -> (if von and not (false fby vstate) then true 74 | else if voff and (false fby vstate) then false 75 | else (false fby vstate)); 76 | tel 77 | 78 | node compare(von, voff, vinit: bool) returns (ok: bool); 79 | var vstate, vstate_1 : bool; 80 | let 81 | vstate = nswitch(von, voff, vinit); 82 | vstate_1 = switch_1(von, voff, vinit); 83 | ok = (vstate = vstate_1); 84 | tel 85 | 86 | node watchdog3 (set, vreset, time_unit: bool; 87 | delay: int) 88 | returns (alarm: bool); 89 | var clock: bool; 90 | let 91 | alarm = merge clock 92 | (true => watchdog2(set when clock, 93 | vreset when clock, 94 | delay when clock)) 95 | (false => (false fby alarm) when not clock); 96 | clock = true -> set or vreset or time_unit; 97 | tel 98 | 99 | -------------------------------------------------------------------------------- /benchs/ums_verif.lus: -------------------------------------------------------------------------------- 1 | (* ums_verif example from the lustre v4 distribution. *) 2 | 3 | node two_vstates(set,vreset,vinit:bool) returns (vstate:bool); 4 | let 5 | vstate = vinit -> (if set and not (false fby vstate) then true 6 | else if vreset and (false fby vstate) then false 7 | else false fby vstate); 8 | tel 9 | 10 | node edge(x: bool) returns (edge : bool); 11 | let 12 | edge = x -> x and not (false fby x); 13 | tel 14 | 15 | node implies(a,b:bool) returns (implies: bool); 16 | let implies = if a then b else true; tel 17 | 18 | node after (a: bool) returns (x: bool); 19 | let 20 | x = false -> false fby (a or x); 21 | tel 22 | 23 | node always_since (c,a: bool) returns (x: bool); 24 | let 25 | x = if a then c 26 | else if after(a) then c and (false fby x) 27 | else true; 28 | tel 29 | 30 | node once_since (c,a: bool) returns (x: bool); 31 | let 32 | x = if a then c 33 | else if after(a) then c or (false fby x) 34 | else true; 35 | tel 36 | 37 | node always_from_to (c,a,b: bool) returns (x: bool); 38 | let 39 | x = implies (after(a), always_since(c, a) or once_since(b, a)); 40 | tel 41 | 42 | node once_from_to (c,a,b: bool) returns (x: bool); 43 | let 44 | x = implies (after(a) and b, once_since(c, a)); 45 | tel 46 | 47 | node alternating(a,b: bool) returns (x:bool); 48 | var a_forbiden, b_forbiden: bool; 49 | let 50 | a_forbiden = false -> (if (false fby a) and not a then true 51 | else if (false fby x) and not b then false 52 | else (false fby a_forbiden)); 53 | b_forbiden = true -> (if (false fby b) and not b then true 54 | else if (false fby a) and not a then false 55 | else (false fby b_forbiden)); 56 | x = not(a and a_forbiden) and not(b and b_forbiden); 57 | tel 58 | 59 | node not_between_and (a,b,c: bool) returns (x: bool); 60 | let 61 | x = implies(c, not once_since(a,b)); 62 | tel 63 | 64 | node ums(on_a,on_b,on_c,ack_ab,ack_bc: bool) 65 | returns (grant_access,grant_exit, 66 | do_ab,do_bc: bool); 67 | var empty_section, only_on_b: bool; 68 | let 69 | grant_access = empty_section and ack_ab; 70 | grant_exit = only_on_b and ack_bc; 71 | do_ab = not ack_ab and empty_section; 72 | do_bc = not ack_bc and only_on_b; 73 | empty_section = not(on_a or on_b or on_c); 74 | only_on_b = on_b and not(on_a or on_c); 75 | tel 76 | 77 | node ums_verif(on_a,on_b,on_c, 78 | ack_ab,ack_bc: bool) 79 | returns(property: bool); 80 | var 81 | grant_access,grant_exit: bool; 82 | do_ab,do_bc: bool; 83 | no_collision,exclusive_req: bool; 84 | no_derail_ab,no_derail_bc: bool; 85 | empty_section, only_on_b: bool; 86 | let 87 | empty_section = not(on_a or on_b or on_c); 88 | only_on_b = on_b and not(on_a or on_c); 89 | 90 | -- ums call 91 | (grant_access,grant_exit,do_ab,do_bc) = 92 | ums(on_a,on_b,on_c,ack_ab,ack_bc); 93 | 94 | -- properties 95 | no_collision = 96 | implies(grant_access,empty_section); 97 | exclusive_req = 98 | not(do_ab and do_bc); 99 | no_derail_ab = 100 | always_from_to(ack_ab, 101 | grant_access, 102 | only_on_b); 103 | no_derail_bc = 104 | always_from_to(ack_bc, 105 | grant_exit, 106 | empty_section); 107 | property = 108 | no_collision and exclusive_req and 109 | no_derail_ab and no_derail_bc; 110 | tel 111 | 112 | -------------------------------------------------------------------------------- /src/Stc/CutCycles/CCNormalArgs.v: -------------------------------------------------------------------------------- 1 | From Coq Require Import List Permutation. 2 | Import List.ListNotations. 3 | Open Scope list_scope. 4 | 5 | From Velus Require Import Common. 6 | From Velus Require Import Environment. 7 | From Velus Require Import Operators. 8 | From Velus Require Import Clocks. 9 | From Velus Require Import CommonProgram. 10 | From Velus Require Import Fresh. 11 | 12 | From Velus Require Import CoreExpr.CESyntax. 13 | From Velus Require Import CoreExpr.CEIsFree. 14 | From Velus Require Import Stc.StcSyntax. 15 | From Velus Require Import Stc.StcOrdered. 16 | From Velus Require Import Stc.StcIsFree. 17 | From Velus Require Import Stc.StcWellDefined. 18 | From Velus Require Import Stc.CutCycles.CC. 19 | 20 | Module Type CCNORMALARGS 21 | (Import Ids : IDS) 22 | (Import Op : OPERATORS) 23 | (Import OpAux : OPERATORS_AUX Ids Op) 24 | (Import Cks : CLOCKS Ids Op OpAux) 25 | (Import CESyn : CESYNTAX Ids Op OpAux Cks) 26 | (Import Syn : STCSYNTAX Ids Op OpAux Cks CESyn) 27 | (Import Ord : STCORDERED Ids Op OpAux Cks CESyn Syn) 28 | (Import CEF : CEISFREE Ids Op OpAux Cks CESyn) 29 | (Import Free : STCISFREE Ids Op OpAux Cks CESyn Syn CEF) 30 | (Import Wdef : STCWELLDEFINED Ids Op OpAux Cks CESyn Syn Ord CEF Free) 31 | (Import ECC : EXT_CC Ids Op OpAux Cks CESyn Syn) 32 | (Import CC : CC Ids Op OpAux Cks CESyn Syn ECC). 33 | 34 | Lemma rename_exp_noops subl subn : forall ck e, 35 | noops_exp ck e -> 36 | noops_exp ck (rename_exp subl subn e). 37 | Proof. 38 | induction ck; intros * Noops; simpl in *; auto. 39 | destruct e; simpl in *; auto. 40 | - now inv Noops. 41 | - destruct_conjs; auto. 42 | Qed. 43 | 44 | Lemma cut_cycles_system_normal_args G : forall n, 45 | normal_args_system G n -> 46 | normal_args_system (cut_cycles G) (cut_cycles_system n). 47 | Proof. 48 | unfold normal_args_system. 49 | intros * Hn. simpl. 50 | destruct (cut_cycles_tcs _ _ _ _) as (tcs'&st') eqn:Htcs. 51 | unfold cut_cycles_tcs in *. repeat Fresh.Tactics.inv_bind. 52 | rewrite ? Forall_app. repeat split; simpl_Forall. 53 | 1,2:constructor. 54 | inv Hn; simpl; try constructor. 55 | take (find_system _ _ = _) and eapply cut_cycles_find_system in it. 56 | econstructor; eauto. 57 | simpl_Forall; auto using rename_exp_noops. 58 | Qed. 59 | 60 | Theorem cut_cycles_normal_args : forall G, 61 | normal_args G -> 62 | normal_args (cut_cycles G). 63 | Proof. 64 | unfold normal_args. 65 | intros [] Hnorm; simpl in *. 66 | induction Hnorm; simpl; constructor; auto. 67 | eapply cut_cycles_system_normal_args in H; eauto. 68 | Qed. 69 | 70 | End CCNORMALARGS. 71 | 72 | 73 | Module CCNormalArgsFun 74 | (Ids : IDS) 75 | (Op : OPERATORS) 76 | (OpAux : OPERATORS_AUX Ids Op) 77 | (Cks : CLOCKS Ids Op OpAux) 78 | (CESyn : CESYNTAX Ids Op OpAux Cks) 79 | (Syn : STCSYNTAX Ids Op OpAux Cks CESyn) 80 | (Ord : STCORDERED Ids Op OpAux Cks CESyn Syn) 81 | (CEF : CEISFREE Ids Op OpAux Cks CESyn) 82 | (Free : STCISFREE Ids Op OpAux Cks CESyn Syn CEF) 83 | (Wdef : STCWELLDEFINED Ids Op OpAux Cks CESyn Syn Ord CEF Free) 84 | (ECC : EXT_CC Ids Op OpAux Cks CESyn Syn) 85 | (CC : CC Ids Op OpAux Cks CESyn Syn ECC) 86 | <: CCNORMALARGS Ids Op OpAux Cks CESyn Syn Ord CEF Free Wdef ECC CC. 87 | Include CCNORMALARGS Ids Op OpAux Cks CESyn Syn Ord CEF Free Wdef ECC CC. 88 | End CCNormalArgsFun. 89 | -------------------------------------------------------------------------------- /benchs/groupwcet.ml: -------------------------------------------------------------------------------- 1 | #! /usr/bin/env ocaml 2 | 3 | (* 20170409 T.Bourke: collate wcet information for gnuplot *) 4 | 5 | (* Unfortunately, it's not possible to reliably pass "str.cma" as an argument to 6 | ocaml via env. *) 7 | #use "topfind" 8 | #require "str" 9 | 10 | open Printf 11 | 12 | let re_fileext = Str.regexp "\\(.*\\)\\.\\(.*\\)\\.wcet" 13 | let re_wcetline = Str.regexp "WCET\\[\\(.*\\)\\] *= *\\([0-9]*\\) *cycles" 14 | 15 | (* expected number of function timings (per group) *) 16 | let exp_num_functions = 200 17 | 18 | let main_ext = "velus" 19 | let calc_percentages = true 20 | 21 | module Hash = Hashtbl.Make (struct include String let hash = Hashtbl.hash end) 22 | 23 | let wcet = (Hash.create exp_num_functions : int Hash.t Hash.t) 24 | let exts = ref ([] : string list) 25 | 26 | let name_compare s1 s2 = 27 | if s1 = main_ext then (if s2 = main_ext then 0 else -1) 28 | else if s2 = main_ext then 1 29 | else String.compare s1 s2 30 | 31 | let add_ext ext = 32 | if List.mem ext !exts then () 33 | else exts := List.sort name_compare (ext::!exts) 34 | 35 | let wcet_add ext fname v = 36 | let fhash = 37 | try 38 | Hash.find wcet fname 39 | with Not_found -> begin 40 | let n = Hash.create 5 in 41 | Hash.add wcet fname n; n 42 | end 43 | in 44 | Hash.add fhash ext v 45 | 46 | let wcet_list () = 47 | let nms = ref []in 48 | Hash.iter (fun nm _ -> nms := nm::!nms) wcet; 49 | List.sort String.compare !nms 50 | 51 | let read_lines ext fin = 52 | let rec read_line () = 53 | let s = input_line fin in 54 | if Str.string_match re_wcetline s 0 55 | then let fname = String.lowercase_ascii (Str.matched_group 1 s) in 56 | wcet_add ext fname (int_of_string (Str.matched_group 2 s)) 57 | else eprintf "ignoring: %s\n" s; 58 | read_line () 59 | in 60 | try read_line () with End_of_file -> () 61 | 62 | let read_file path = 63 | if Str.string_match re_fileext path 0 64 | then let ext = Str.matched_group 2 path in 65 | (add_ext ext; read_lines ext (open_in path)) 66 | 67 | let print_function fname = 68 | let print_value data = 69 | let mv = try Some (Hash.find data main_ext) with Not_found -> None in 70 | fun ext -> 71 | try 72 | let v = Hash.find data ext in 73 | printf " %d" v; 74 | if calc_percentages && ext <> main_ext then 75 | printf " %s" 76 | (match mv with 77 | | None -> " ?" 78 | | Some mv -> (string_of_int (((v - mv) * 100) / mv))); 79 | with Not_found -> 80 | (printf " ?"; if calc_percentages then printf " ?") 81 | in 82 | try 83 | let data = Hash.find wcet fname in 84 | printf "%s" fname; 85 | List.iter (print_value data) !exts; 86 | printf "\n" 87 | with Not_found -> 88 | eprintf "no data for '%s'\n" fname 89 | 90 | let print_header () = 91 | let double_name ext = 92 | printf " %s" ext; if ext <> main_ext then printf " %%" 93 | in 94 | let print_name = if calc_percentages then double_name else printf " %s" in 95 | printf "function"; 96 | List.iter print_name !exts; 97 | printf "\n" 98 | 99 | let print_data () = 100 | print_header (); 101 | List.iter print_function (wcet_list ()) 102 | 103 | let main () = 104 | if Array.length Sys.argv > 1 then 105 | for i = 1 to Array.length Sys.argv - 1 do 106 | read_file Sys.argv.(i) 107 | done 108 | else Array.iter read_file (Sys.readdir "."); 109 | print_data () 110 | 111 | let () = main ();; 112 | -------------------------------------------------------------------------------- /src/Stc/CutCycles/CutCycles.v: -------------------------------------------------------------------------------- 1 | From Velus Require Import Common. 2 | From Velus Require Import Operators. 3 | From Velus Require Import Clocks. 4 | From Velus Require Import IndexedStreams. 5 | From Velus Require Import CommonTyping. 6 | 7 | From Velus Require Import CoreExpr.CoreExpr. 8 | From Velus Require Import Stc.StcSyntax. 9 | From Velus Require Import Stc.StcOrdered. 10 | From Velus Require Import Stc.StcIsFree. 11 | From Velus Require Import Stc.StcWellDefined. 12 | From Velus Require Import Stc.StcTyping. 13 | From Velus Require Import Stc.StcClocking. 14 | From Velus Require Import Stc.StcSemantics. 15 | 16 | From Velus Require Import Stc.CutCycles.CC. 17 | From Velus Require Import Stc.CutCycles.CCTyping. 18 | From Velus Require Import Stc.CutCycles.CCClocking. 19 | From Velus Require Import Stc.CutCycles.CCNormalArgs. 20 | From Velus Require Import Stc.CutCycles.CCCorrectness. 21 | 22 | Module Type CUTCYCLES 23 | (Ids : IDS) 24 | (Op : OPERATORS) 25 | (OpAux : OPERATORS_AUX Ids Op) 26 | (ComTyp: COMMONTYPING Ids Op OpAux) 27 | (Cks : CLOCKS Ids Op OpAux) 28 | (IStr : INDEXEDSTREAMS Ids Op OpAux Cks) 29 | (CE : COREEXPR Ids Op OpAux ComTyp Cks IStr) 30 | (Syn : STCSYNTAX Ids Op OpAux Cks CE.Syn) 31 | (Ord : STCORDERED Ids Op OpAux Cks CE.Syn Syn) 32 | (IsF : STCISFREE Ids Op OpAux Cks CE.Syn Syn CE.IsF) 33 | (Wdef : STCWELLDEFINED Ids Op OpAux Cks CE.Syn Syn Ord CE.IsF IsF) 34 | (Typ : STCTYPING Ids Op OpAux Cks CE.Syn Syn CE.Typ) 35 | (Clo : STCCLOCKING Ids Op OpAux Cks CE.Syn Syn Ord CE.Clo) 36 | (Sem : STCSEMANTICS Ids Op OpAux Cks CE.Syn Syn Ord IStr CE.Sem) 37 | (ECC : EXT_CC Ids Op OpAux Cks CE.Syn Syn). 38 | Declare Module Export CC : CC Ids Op OpAux Cks CE.Syn Syn ECC. 39 | Declare Module Export CCTyp : CCTYPING Ids Op OpAux Cks CE.Syn Syn Ord CE.Typ Typ CE.Clo Clo ECC CC. 40 | Declare Module Export CCClo : CCCLOCKING Ids Op OpAux Cks CE.Syn Syn Ord CE.Clo Clo ECC CC. 41 | Declare Module Export CCNorm : CCNORMALARGS Ids Op OpAux Cks CE.Syn Syn Ord CE.IsF IsF Wdef ECC CC. 42 | Declare Module Export CCCor : CCCORRECTNESS Ids Op OpAux ComTyp Cks IStr CE Syn Ord Typ Clo Sem ECC CC. 43 | End CUTCYCLES. 44 | 45 | Module CutCyclesFun 46 | (Ids : IDS) 47 | (Op : OPERATORS) 48 | (OpAux : OPERATORS_AUX Ids Op) 49 | (ComTyp: COMMONTYPING Ids Op OpAux) 50 | (Cks : CLOCKS Ids Op OpAux) 51 | (IStr : INDEXEDSTREAMS Ids Op OpAux Cks) 52 | (CE : COREEXPR Ids Op OpAux ComTyp Cks IStr) 53 | (Syn : STCSYNTAX Ids Op OpAux Cks CE.Syn) 54 | (Ord : STCORDERED Ids Op OpAux Cks CE.Syn Syn) 55 | (IsF : STCISFREE Ids Op OpAux Cks CE.Syn Syn CE.IsF) 56 | (Wdef : STCWELLDEFINED Ids Op OpAux Cks CE.Syn Syn Ord CE.IsF IsF) 57 | (Typ : STCTYPING Ids Op OpAux Cks CE.Syn Syn CE.Typ) 58 | (Clo : STCCLOCKING Ids Op OpAux Cks CE.Syn Syn Ord CE.Clo) 59 | (Sem : STCSEMANTICS Ids Op OpAux Cks CE.Syn Syn Ord IStr CE.Sem) 60 | (ECC : EXT_CC Ids Op OpAux Cks CE.Syn Syn) 61 | <: CUTCYCLES Ids Op OpAux ComTyp Cks IStr CE Syn Ord IsF Wdef Typ Clo Sem ECC. 62 | Module Export CC := CCFun Ids Op OpAux Cks CE.Syn Syn ECC. 63 | Module Export CCTyp := CCTypingFun Ids Op OpAux Cks CE.Syn Syn Ord CE.Typ Typ CE.Clo Clo ECC CC. 64 | Module Export CCClo := CCClockingFun Ids Op OpAux Cks CE.Syn Syn Ord CE.Clo Clo ECC CC. 65 | Module Export CCNorm := CCNormalArgsFun Ids Op OpAux Cks CE.Syn Syn Ord CE.IsF IsF Wdef ECC CC. 66 | Module Export CCCor := CCCorrectnessFun Ids Op OpAux ComTyp Cks IStr CE Syn Ord Typ Clo Sem ECC CC. 67 | End CutCyclesFun. 68 | -------------------------------------------------------------------------------- /src/veluscommon.ml: -------------------------------------------------------------------------------- 1 | 2 | (* Shared definitions *) 3 | 4 | type associativity = LtoR | RtoL | NA 5 | 6 | let fmt_coqstring p s = List.iter (Format.pp_print_char p) s 7 | 8 | module type PRINT_OPS = 9 | sig 10 | type ctype 11 | type typ 12 | type cconst 13 | type const 14 | type unop 15 | type binop 16 | type enumtag 17 | 18 | val enumtag_of_int : int -> enumtag 19 | val int_of_enumtag : enumtag -> int 20 | 21 | val print_ctype : Format.formatter -> ctype -> unit 22 | val print_typ : Format.formatter -> typ -> unit 23 | val print_typ_decl : Format.formatter -> typ -> unit 24 | val print_cconst : Format.formatter -> cconst -> unit 25 | val print_const : Format.formatter -> (const * typ) -> unit 26 | val print_enumtag : Format.formatter -> (enumtag * typ) -> unit 27 | val print_unop : Format.formatter -> unop -> typ 28 | -> (Format.formatter -> 'a -> unit) -> 'a -> unit 29 | val print_binop : Format.formatter -> binop -> typ 30 | -> (Format.formatter -> 'a -> unit) -> 'a 31 | -> (Format.formatter -> 'a -> unit) -> 'a 32 | -> unit 33 | 34 | val prec_unop : unop -> int * associativity 35 | val prec_binop : binop -> int * associativity 36 | end 37 | 38 | module type TYPE_FORMATS = 39 | sig 40 | type typ 41 | val type_decl : typ -> string 42 | val type_printf : typ -> string 43 | val type_scanf : typ -> string 44 | end 45 | 46 | let int_of_positive = 47 | let rec go w r = function 48 | | BinNums.Coq_xI p -> go (w lsl 1) (r + w) p 49 | | BinNums.Coq_xO p -> go (w lsl 1) r p 50 | | BinNums.Coq_xH -> r + w 51 | in 52 | go 1 0 53 | 54 | let rec positive_of_int n = 55 | if n = 1 then BinNums.Coq_xH 56 | else if n land 1 = 0 then BinNums.Coq_xO (positive_of_int (n lsr 1)) 57 | else BinNums.Coq_xI (positive_of_int (n lsr 1)) 58 | 59 | let z_of_int n = 60 | if n = 0 then BinNums.Z0 61 | else if n < 0 then BinNums.Zneg (positive_of_int n) 62 | else BinNums.Zpos (positive_of_int n) 63 | 64 | (** Prefixing an identifier with another 65 | There are two properties to verify: 66 | - ~atom (prefix pre x) 67 | - pre <> pre' \/ x <> x' -> prefix pre id <> prefix pre' id' 68 | *) 69 | let prefix pre x = 70 | let open Camlcoq in 71 | (* Both pre and x should be in the table to guarantee injectivity *) 72 | if (not (Hashtbl.mem string_of_atom pre) || not (Hashtbl.mem string_of_atom x)) 73 | then invalid_arg "prefix: both identifier should be in the table"; 74 | (* pre should be an atom to guarantee injectivity *) 75 | let pres = extern_atom pre and xs = extern_atom x in 76 | if String.contains pres '$' then invalid_arg "prefix: should be an atom"; 77 | intern_string (pres^"$"^xs) 78 | 79 | (** Generation of a fresh identifier. 80 | Countrary to prefix, we dont get the prefixed ident from the table : 81 | it's just a number. 82 | If a hint is passed, it will be inserted in the identifier 83 | There are two properties to verify: 84 | - ~atom (gensym pre hint x) 85 | - pre <> pre' \/ x <> x' -> gensym pre hint id <> gensym pre' hint' id' 86 | *) 87 | let gensym pre hint x = 88 | let open Camlcoq in 89 | let pres = extern_atom pre in 90 | (* pre should be an atom to guarantee injectivity *) 91 | if String.contains pres '$' 92 | then invalid_arg "gensym: the prefix should be an atom"; 93 | match hint with 94 | | None -> intern_string (pres^"$"^string_of_int (P.to_int x)) 95 | | Some hint -> intern_string (pres^"$"^extern_atom hint^"$"^string_of_int (P.to_int x)) 96 | -------------------------------------------------------------------------------- /src/Common/CommonTactics.v: -------------------------------------------------------------------------------- 1 | Ltac inv H := inversion H; clear H; subst. 2 | 3 | Ltac cases := 4 | repeat match goal with 5 | | H: context [ match negb ?x with _ => _ end ] |- _ => 6 | destruct x; simpl; try solve [inv H; auto] 7 | | H: context [ match ?x with _ => _ end ] |- _ => 8 | destruct x; try solve [inv H; auto] 9 | | |- context [ match negb ?x with _ => _ end ] => 10 | destruct x; simpl 11 | | |- context [ match ?x with _ => _ end ] => 12 | destruct x 13 | end; auto. 14 | 15 | Ltac cases_eqn E := 16 | repeat match goal with 17 | | H: context [ match negb ?x with _ => _ end ] |- _ => 18 | let E := fresh E in 19 | destruct x eqn: E; simpl; try solve [inv H; auto] 20 | | H: context [ match ?x with _ => _ end ] |- _ => 21 | let E := fresh E in 22 | destruct x eqn: E; try solve [inv H; auto] 23 | | |- context [ match negb ?x with _ => _ end ] => 24 | let E := fresh E in 25 | destruct x eqn: E; simpl 26 | | |- context [ match ?x with _ => _ end ] => 27 | let E := fresh E in 28 | destruct x eqn: E 29 | end; auto. 30 | 31 | Ltac cases_in H := 32 | repeat match type of H with 33 | | context [ match negb ?x with _ => _ end ] => 34 | destruct x; simpl; try solve [inv H; auto] 35 | | context [ match ?x with _ => _ end ] => 36 | destruct x; try solve [inv H; auto] 37 | end; auto. 38 | 39 | Create HintDb conjs. 40 | 41 | Ltac destruct_conjs := 42 | autounfold with conjs in *; 43 | repeat 44 | match goal with 45 | | H: exists _, _ |- _ => destruct H 46 | | H: _ /\ _ |- _ => destruct H 47 | | x: _ * _ |- _ => destruct x 48 | end; simpl in *. 49 | 50 | Lemma option_map_inv: 51 | forall {A B} (f: A -> B) oa b, 52 | option_map f oa = Some b -> 53 | exists a, oa = Some a /\ b = f a. 54 | Proof. 55 | unfold option_map; intros * E. 56 | cases; inv E; eauto. 57 | Qed. 58 | 59 | Lemma option_map_None: 60 | forall {A B} (f: A -> B) oa, 61 | option_map f oa = None <-> oa = None. 62 | Proof. 63 | unfold option_map; intros; cases; intuition; discriminate. 64 | Qed. 65 | 66 | Ltac inv_equalities := 67 | destruct_conjs; subst; 68 | repeat 69 | match goal with 70 | | H: (_, _) = (_, _) |- _ => inv H 71 | | H: option_map _ _ = Some _ |- _ => 72 | let Hf := fresh "Hf" in 73 | let Heq := fresh "Heq" in 74 | apply option_map_inv in H as (?&Hf&Heq); destruct_conjs 75 | | H: option_map _ _ = None |- _ => 76 | apply option_map_None in H 77 | end; subst. 78 | 79 | (* Tactics for manipulating hypotheses without renaming them. 80 | Lighter-weight (but less expressive) than match goal with. 81 | 82 | https://stackoverflow.com/a/55998007/ 83 | 84 | E.g., 85 | take (_ /\ _) and destruct it as (P1 & P2) 86 | take (sem _ _ _) and inversion it. 87 | take (_ \/ _) and rename it into HD. 88 | *) 89 | Tactic Notation "summon" uconstr(ty) "as" ident(id) := 90 | match goal with H : _ |- _ => pose (id := H : ty); clear id; rename H into id end. 91 | 92 | Tactic Notation "take" uconstr(ty) "and" tactic(tac) := 93 | let new_it := fresh "it" 94 | in try (rename it into new_it); 95 | summon ty as it; tac; 96 | try (rename new_it into it). 97 | 98 | Tactic Notation "take" uconstr(ty1) "," uconstr(ty2) "and" tactic(tac) := 99 | let it1 := fresh "it1" in 100 | let it2 := fresh "it2" in 101 | summon ty1 as it1; summon ty2 as it2; tac. 102 | -------------------------------------------------------------------------------- /examples/halbwachs.lus: -------------------------------------------------------------------------------- 1 | (* lustre examples from "synchronous programming of reactive systems", 2 | nicolas halbwachs, 1993 kluwer academic publishers. *) 3 | 4 | node counter(vinit_value, incr_value: int; vreset: bool) 5 | returns (n: int); 6 | let 7 | n = vinit_value -> (if vreset then vinit_value 8 | else (0 fby n) + incr_value); 9 | tel 10 | 11 | node watchdog1 (set, vreset, deadline: bool) 12 | returns (alarm: bool); 13 | var watchdog_is_on: bool; 14 | let 15 | alarm = deadline and watchdog_is_on; 16 | watchdog_is_on = false -> (if set then true 17 | else if vreset then false 18 | else (false fby watchdog_is_on)); 19 | assert not(set and vreset); 20 | tel 21 | 22 | node edge (b: bool) returns (edge: bool); 23 | let 24 | edge = false -> (b and not (false fby b)); 25 | tel 26 | 27 | node watchdog2 (set, vreset: bool; delay: int) 28 | returns (alarm: bool); 29 | var remaining_delay: int; deadline: bool; 30 | let 31 | alarm = watchdog1(set, vreset, deadline); 32 | deadline = edge(remaining_delay = 0); 33 | remaining_delay = if set then delay 34 | else (0 fby (remaining_delay - 1)); 35 | tel 36 | 37 | node simple_stopwatch (start_stop, vreset, hs: bool) 38 | returns (time: int; running: bool); 39 | let 40 | time = 0 -> (if hs and running then (0 fby time) + 1 41 | else if vreset then 0 else (0 fby time)); 42 | running = false -> (if start_stop 43 | then not (false fby running) 44 | else (false fby running)); 45 | tel 46 | 47 | node stopwatch (start_stop, vreset, hs: bool) 48 | returns (displayed_time: int; running, frozen: bool); 49 | var internal_time: int; actual_vreset: bool; 50 | let 51 | frozen = false -> 52 | (if vreset and (false fby running) then true 53 | else if vreset and (false fby frozen) then false 54 | else (false fby frozen)); 55 | displayed_time = 56 | merge frozen 57 | (true => (0 fby displayed_time) when frozen) 58 | (false => internal_time when not frozen); 59 | (internal_time, running) = 60 | simple_stopwatch(start_stop, actual_vreset, hs); 61 | actual_vreset = 62 | vreset and false fby (not running and not frozen); 63 | tel 64 | 65 | node switch_1(von, voff, vinit: bool) returns (vstate: bool); 66 | let 67 | vstate = vinit -> (if von then true 68 | else if voff then false 69 | else (false fby vstate)); 70 | tel 71 | 72 | node nswitch(von, voff, vinit: bool) returns (vstate: bool); 73 | let 74 | vstate = vinit -> (if von and not (false fby vstate) then true 75 | else if voff and (false fby vstate) then false 76 | else (false fby vstate)); 77 | tel 78 | 79 | node compare(von, voff, vinit: bool) returns (ok: bool); 80 | var vstate, vstate_1 : bool; 81 | let 82 | vstate = nswitch(von, voff, vinit); 83 | vstate_1 = switch_1(von, voff, vinit); 84 | ok = (vstate = vstate_1); 85 | assert not(von and voff); 86 | tel 87 | 88 | node watchdog3 (set, vreset, time_unit: bool; 89 | delay: int) 90 | returns (alarm: bool); 91 | var clock: bool; 92 | let 93 | alarm = merge clock 94 | (true => watchdog2(set when clock, 95 | vreset when clock, 96 | delay when clock)) 97 | (false => (false fby alarm) when not clock); 98 | clock = true -> set or vreset or time_unit; 99 | tel 100 | 101 | -------------------------------------------------------------------------------- /src/NLustre/DeadCodeElim/DCENormalArgs.v: -------------------------------------------------------------------------------- 1 | From Coq Require Import List. 2 | Import List.ListNotations. 3 | Open Scope list_scope. 4 | 5 | From Coq Require Import Recdef. 6 | From Velus Require Import Common. 7 | From Velus Require Import CommonProgram. 8 | From Velus Require Import Operators. 9 | From Velus Require Import Clocks. 10 | From Velus Require Import Environment. 11 | From Velus Require Import CoreExpr.CESyntax. 12 | From Velus Require Import CoreExpr.CEIsFree. 13 | From Velus Require Import CoreExpr.CETyping. 14 | From Velus Require Import NLustre.NLSyntax. 15 | From Velus Require Import NLustre.IsFree. 16 | From Velus Require Import NLustre.Memories. 17 | From Velus Require Import NLustre.IsDefined. 18 | From Velus Require Import NLustre.NLOrdered. 19 | From Velus Require Import NLustre.NLTyping. 20 | From Velus Require Import NLustre.NLNormalArgs. 21 | From Velus Require Import NLustre.DeadCodeElim.DCE. 22 | 23 | Module Type DCENORMALARGS 24 | (Import Ids : IDS) 25 | (Import Op : OPERATORS) 26 | (Import OpAux : OPERATORS_AUX Ids Op) 27 | (Import Cks : CLOCKS Ids Op OpAux) 28 | (Import CESyn : CESYNTAX Ids Op OpAux Cks) 29 | (Import CEF : CEISFREE Ids Op OpAux Cks CESyn) 30 | (Import CETyp : CETYPING Ids Op OpAux Cks CESyn) 31 | (Import Syn : NLSYNTAX Ids Op OpAux Cks CESyn) 32 | (Import Free : ISFREE Ids Op OpAux Cks CESyn Syn CEF) 33 | (Import Mem : MEMORIES Ids Op OpAux Cks CESyn Syn) 34 | (Import Def : ISDEFINED Ids Op OpAux Cks CESyn Syn Mem) 35 | (Import Ord : NLORDERED Ids Op OpAux Cks CESyn Syn) 36 | (Import Typ : NLTYPING Ids Op OpAux Cks CESyn Syn Ord CETyp) 37 | (Import Norm : NLNORMALARGS Ids Op OpAux Cks CESyn CETyp Syn Ord Typ) 38 | (Import DCE : DCE Ids Op OpAux Cks CESyn CEF Syn Free Mem Def). 39 | 40 | Lemma dce_node_normal_args G1 G2 : forall n, 41 | global_iface_eq G1 G2 -> 42 | normal_args_node G1 n -> 43 | normal_args_node G2 (dce_node n). 44 | Proof. 45 | unfold normal_args_node. 46 | intros * Heq Hn. simpl. 47 | eapply Forall_filter, Forall_impl; [|eauto]. 48 | intros ? Hnorm _; eauto using global_iface_eq_normal_args_eq. 49 | Qed. 50 | 51 | Theorem dce_normal_args : forall G, 52 | normal_args G -> 53 | normal_args (dce_global G). 54 | Proof. 55 | unfold normal_args. 56 | intros [] Hnorm; simpl in *. 57 | induction Hnorm; simpl; constructor; auto. 58 | eapply dce_node_normal_args; eauto. apply dce_global_iface_eq. 59 | Qed. 60 | 61 | End DCENORMALARGS. 62 | 63 | Module DCENormalArgsFun 64 | (Ids : IDS) 65 | (Op : OPERATORS) 66 | (OpAux : OPERATORS_AUX Ids Op) 67 | (Cks : CLOCKS Ids Op OpAux) 68 | (CESyn : CESYNTAX Ids Op OpAux Cks) 69 | (CEF : CEISFREE Ids Op OpAux Cks CESyn) 70 | (CETyp : CETYPING Ids Op OpAux Cks CESyn) 71 | (Syn : NLSYNTAX Ids Op OpAux Cks CESyn) 72 | (Free : ISFREE Ids Op OpAux Cks CESyn Syn CEF) 73 | (Mem : MEMORIES Ids Op OpAux Cks CESyn Syn) 74 | (Def : ISDEFINED Ids Op OpAux Cks CESyn Syn Mem) 75 | (Ord : NLORDERED Ids Op OpAux Cks CESyn Syn) 76 | (Typ : NLTYPING Ids Op OpAux Cks CESyn Syn Ord CETyp) 77 | (Norm : NLNORMALARGS Ids Op OpAux Cks CESyn CETyp Syn Ord Typ) 78 | (DCE : DCE Ids Op OpAux Cks CESyn CEF Syn Free Mem Def) 79 | <: DCENORMALARGS Ids Op OpAux Cks CESyn CEF CETyp Syn Free Mem Def Ord Typ Norm DCE. 80 | Include DCENORMALARGS Ids Op OpAux Cks CESyn CEF CETyp Syn Free Mem Def Ord Typ Norm DCE. 81 | End DCENormalArgsFun. 82 | -------------------------------------------------------------------------------- /src/NLustre/DupRegRem/DupRegRem.v: -------------------------------------------------------------------------------- 1 | From Velus Require Import Common. 2 | From Velus Require Import Operators. 3 | From Velus Require Import Clocks. 4 | From Velus Require Import IndexedStreams. 5 | From Velus Require Import CommonTyping. 6 | 7 | From Velus Require Import CoreExpr.CoreExpr. 8 | From Velus Require Export NLustre.NLSyntax. 9 | From Velus Require Export NLustre.IsDefined. 10 | From Velus Require Export NLustre.Memories. 11 | From Velus Require Export NLustre.NLIndexedSemantics. 12 | From Velus Require Export NLustre.NLOrdered. 13 | From Velus Require Export NLustre.NLClocking. 14 | From Velus Require Export NLustre.NLTyping. 15 | From Velus Require Export NLustre.NLNormalArgs. 16 | From Velus Require Export NLustre.DupRegRem.DRR. 17 | From Velus Require Export NLustre.DupRegRem.DRRTyping. 18 | From Velus Require Export NLustre.DupRegRem.DRRClocking. 19 | From Velus Require Export NLustre.DupRegRem.DRRNormalArgs. 20 | From Velus Require Export NLustre.DupRegRem.DRRCorrectness. 21 | 22 | Module Type DUPREGREM 23 | (Ids : IDS) 24 | (Op : OPERATORS) 25 | (OpAux : OPERATORS_AUX Ids Op) 26 | (ComTyp: COMMONTYPING Ids Op OpAux) 27 | (Cks : CLOCKS Ids Op OpAux) 28 | (IStr : INDEXEDSTREAMS Ids Op OpAux Cks) 29 | (CE : COREEXPR Ids Op OpAux ComTyp Cks IStr) 30 | (Syn : NLSYNTAX Ids Op OpAux Cks CE.Syn) 31 | (Ord : NLORDERED Ids Op OpAux Cks CE.Syn Syn) 32 | (Typ : NLTYPING Ids Op OpAux Cks CE.Syn Syn Ord CE.Typ) 33 | (Norm : NLNORMALARGS Ids Op OpAux Cks CE.Syn CE.Typ Syn Ord Typ) 34 | (Mem : MEMORIES Ids Op OpAux Cks CE.Syn Syn) 35 | (IsD : ISDEFINED Ids Op OpAux Cks CE.Syn Syn Mem) 36 | (Clo : NLCLOCKING Ids Op OpAux Cks CE.Syn Syn Ord Mem IsD CE.Clo) 37 | (Sem : NLINDEXEDSEMANTICS Ids Op OpAux Cks CE.Syn Syn IStr Ord CE.Sem). 38 | Declare Module Export DRR : DRR Ids Op OpAux Cks CE.Syn Syn. 39 | Declare Module Export DRRTyp : DRRTYPING Ids Op OpAux Cks CE.Syn CE.Typ Syn Ord Typ DRR. 40 | Declare Module Export DRRClo : DRRCLOCKING Ids Op OpAux Cks CE.Syn CE.Clo Syn Ord Mem IsD Clo DRR. 41 | Declare Module Export DRRNorm : DRRNORMALARGS Ids Op OpAux Cks CE.Syn CE.Typ Syn Ord Typ Norm DRR. 42 | Declare Module Export DRRCor : DRRCORRECTNESS Ids Op OpAux Cks IStr CE.Syn CE.Sem Syn Ord Sem DRR. 43 | End DUPREGREM. 44 | 45 | Module DupRegRemFun 46 | (Ids : IDS) 47 | (Op : OPERATORS) 48 | (OpAux : OPERATORS_AUX Ids Op) 49 | (ComTyp: COMMONTYPING Ids Op OpAux) 50 | (Cks : CLOCKS Ids Op OpAux) 51 | (IStr : INDEXEDSTREAMS Ids Op OpAux Cks) 52 | (CE : COREEXPR Ids Op OpAux ComTyp Cks IStr) 53 | (Syn : NLSYNTAX Ids Op OpAux Cks CE.Syn) 54 | (Ord : NLORDERED Ids Op OpAux Cks CE.Syn Syn) 55 | (Typ : NLTYPING Ids Op OpAux Cks CE.Syn Syn Ord CE.Typ) 56 | (Norm : NLNORMALARGS Ids Op OpAux Cks CE.Syn CE.Typ Syn Ord Typ) 57 | (Mem : MEMORIES Ids Op OpAux Cks CE.Syn Syn) 58 | (IsD : ISDEFINED Ids Op OpAux Cks CE.Syn Syn Mem) 59 | (Clo : NLCLOCKING Ids Op OpAux Cks CE.Syn Syn Ord Mem IsD CE.Clo) 60 | (Sem : NLINDEXEDSEMANTICS Ids Op OpAux Cks CE.Syn Syn IStr Ord CE.Sem) 61 | <: DUPREGREM Ids Op OpAux ComTyp Cks IStr CE Syn Ord Typ Norm Mem IsD Clo Sem. 62 | Module Export DRR := DRRFun Ids Op OpAux Cks CE.Syn Syn. 63 | Module Export DRRTyp := DrrTypingFun Ids Op OpAux Cks CE.Syn CE.Typ Syn Ord Typ DRR. 64 | Module Export DRRClo := DrrClockingFun Ids Op OpAux Cks CE.Syn CE.Clo Syn Ord Mem IsD Clo DRR. 65 | Module Export DRRNorm := DrrNormalArgsFun Ids Op OpAux Cks CE.Syn CE.Typ Syn Ord Typ Norm DRR. 66 | Module Export DRRCor := DrrCorrectnessFun Ids Op OpAux Cks IStr CE.Syn CE.Sem Syn Ord Sem DRR. 67 | End DupRegRemFun. 68 | -------------------------------------------------------------------------------- /src/NLustre/ExprInlining/ExprInlining.v: -------------------------------------------------------------------------------- 1 | From Velus Require Import Common. 2 | From Velus Require Import Operators. 3 | From Velus Require Import Clocks. 4 | From Velus Require Import IndexedStreams. 5 | From Velus Require Import CommonTyping. 6 | 7 | From Velus Require Import CoreExpr.CoreExpr. 8 | From Velus Require Export NLustre.NLSyntax. 9 | From Velus Require Export NLustre.IsDefined. 10 | From Velus Require Export NLustre.Memories. 11 | From Velus Require Export NLustre.NLIndexedSemantics. 12 | From Velus Require Export NLustre.NLOrdered. 13 | From Velus Require Export NLustre.NLClocking. 14 | From Velus Require Export NLustre.NLTyping. 15 | From Velus Require Export NLustre.NLNormalArgs. 16 | From Velus Require Export NLustre.ExprInlining.EI. 17 | From Velus Require Export NLustre.ExprInlining.EITyping. 18 | From Velus Require Export NLustre.ExprInlining.EIClocking. 19 | From Velus Require Export NLustre.ExprInlining.EINormalArgs. 20 | From Velus Require Export NLustre.ExprInlining.EICorrectness. 21 | 22 | Module Type EXPRINLINING 23 | (Ids : IDS) 24 | (Op : OPERATORS) 25 | (OpAux : OPERATORS_AUX Ids Op) 26 | (ComTyp: COMMONTYPING Ids Op OpAux) 27 | (Cks : CLOCKS Ids Op OpAux) 28 | (IStr : INDEXEDSTREAMS Ids Op OpAux Cks) 29 | (CE : COREEXPR Ids Op OpAux ComTyp Cks IStr) 30 | (Syn : NLSYNTAX Ids Op OpAux Cks CE.Syn) 31 | (Ord : NLORDERED Ids Op OpAux Cks CE.Syn Syn) 32 | (Typ : NLTYPING Ids Op OpAux Cks CE.Syn Syn Ord CE.Typ) 33 | (Norm : NLNORMALARGS Ids Op OpAux Cks CE.Syn CE.Typ Syn Ord Typ) 34 | (Mem : MEMORIES Ids Op OpAux Cks CE.Syn Syn) 35 | (IsD : ISDEFINED Ids Op OpAux Cks CE.Syn Syn Mem) 36 | (Clo : NLCLOCKING Ids Op OpAux Cks CE.Syn Syn Ord Mem IsD CE.Clo) 37 | (Sem : NLINDEXEDSEMANTICS Ids Op OpAux Cks CE.Syn Syn IStr Ord CE.Sem). 38 | Declare Module Export EI : EI Ids Op OpAux Cks CE.Syn Syn. 39 | Declare Module Export EITyp : EITYPING Ids Op OpAux Cks CE.Syn CE.Typ Syn Ord Typ EI. 40 | Declare Module Export EIClo : EICLOCKING Ids Op OpAux Cks CE.Syn CE.Clo Syn Ord Mem IsD Clo EI. 41 | Declare Module Export EINorm : EINORMALARGS Ids Op OpAux Cks CE.Syn CE.Typ Syn Ord Typ Norm EI. 42 | Declare Module Export EICor : EICORRECTNESS Ids Op OpAux Cks IStr CE.Syn CE.Typ CE.Sem Syn Ord Typ Sem EI EITyp. 43 | End EXPRINLINING. 44 | 45 | Module ExprInliningFun 46 | (Ids : IDS) 47 | (Op : OPERATORS) 48 | (OpAux : OPERATORS_AUX Ids Op) 49 | (ComTyp: COMMONTYPING Ids Op OpAux) 50 | (Cks : CLOCKS Ids Op OpAux) 51 | (IStr : INDEXEDSTREAMS Ids Op OpAux Cks) 52 | (CE : COREEXPR Ids Op OpAux ComTyp Cks IStr) 53 | (Syn : NLSYNTAX Ids Op OpAux Cks CE.Syn) 54 | (Ord : NLORDERED Ids Op OpAux Cks CE.Syn Syn) 55 | (Typ : NLTYPING Ids Op OpAux Cks CE.Syn Syn Ord CE.Typ) 56 | (Norm : NLNORMALARGS Ids Op OpAux Cks CE.Syn CE.Typ Syn Ord Typ) 57 | (Mem : MEMORIES Ids Op OpAux Cks CE.Syn Syn) 58 | (IsD : ISDEFINED Ids Op OpAux Cks CE.Syn Syn Mem) 59 | (Clo : NLCLOCKING Ids Op OpAux Cks CE.Syn Syn Ord Mem IsD CE.Clo) 60 | (Sem : NLINDEXEDSEMANTICS Ids Op OpAux Cks CE.Syn Syn IStr Ord CE.Sem) 61 | <: EXPRINLINING Ids Op OpAux ComTyp Cks IStr CE Syn Ord Typ Norm Mem IsD Clo Sem. 62 | Module Export EI := EIFun Ids Op OpAux Cks CE.Syn Syn. 63 | Module Export EITyp := EITypingFun Ids Op OpAux Cks CE.Syn CE.Typ Syn Ord Typ EI. 64 | Module Export EIClo := EIClockingFun Ids Op OpAux Cks CE.Syn CE.Clo Syn Ord Mem IsD Clo EI. 65 | Module Export EINorm := EINormalArgsFun Ids Op OpAux Cks CE.Syn CE.Typ Syn Ord Typ Norm EI. 66 | Module Export EICor := EICorrectnessFun Ids Op OpAux Cks IStr CE.Syn CE.Typ CE.Sem Syn Ord Typ Sem EI EITyp. 67 | End ExprInliningFun. 68 | -------------------------------------------------------------------------------- /src/CoreExpr/CESyntax.v: -------------------------------------------------------------------------------- 1 | From Velus Require Import Common. 2 | From Velus Require Import Operators. 3 | From Velus Require Import Clocks. 4 | 5 | (** * The core dataflow expresion syntax *) 6 | 7 | Module Type CESYNTAX 8 | (Import Ids : IDS) 9 | (Import Op : OPERATORS) 10 | (Import OpAux: OPERATORS_AUX Ids Op) 11 | (Import Cks : CLOCKS Ids Op OpAux). 12 | 13 | (** ** Expressions *) 14 | 15 | Inductive exp : Type := 16 | | Econst : cconst -> exp 17 | | Eenum : enumtag -> type -> exp 18 | | Evar : ident -> type -> exp 19 | | Elast : ident -> type -> exp 20 | | Ewhen : exp -> (ident * type) -> enumtag -> exp 21 | | Eunop : unop -> exp -> type -> exp 22 | | Ebinop : binop -> exp -> exp -> type -> exp. 23 | 24 | (** ** Control expressions *) 25 | 26 | Inductive cexp : Type := 27 | | Emerge : ident * type -> list cexp -> type -> cexp 28 | | Ecase : exp -> list (option cexp) -> cexp -> cexp 29 | | Eexp : exp -> cexp. 30 | 31 | Inductive rhs : Type := 32 | | Eextcall : ident -> list exp -> ctype -> rhs 33 | | Ecexp : cexp -> rhs. 34 | 35 | Section cexp_ind2. 36 | 37 | Variable P : cexp -> Prop. 38 | 39 | Hypothesis MergeCase: 40 | forall x l t, 41 | List.Forall P l -> 42 | P (Emerge x l t). 43 | 44 | Hypothesis CaseCase: 45 | forall c l d, 46 | List.Forall (fun oce => P (or_default d oce)) l -> 47 | P (Ecase c l d). 48 | 49 | Hypothesis ExpCase: 50 | forall e, 51 | P (Eexp e). 52 | 53 | Fixpoint cexp_ind2 (e : cexp) : P e. 54 | Proof. 55 | destruct e. 56 | - apply MergeCase. 57 | induction l; auto. 58 | - apply CaseCase. 59 | induction l as [|[|]]; auto. 60 | - apply ExpCase. 61 | Defined. 62 | 63 | End cexp_ind2. 64 | 65 | Section cexp_ind2'. 66 | 67 | Variable P : cexp -> Prop. 68 | 69 | Hypothesis MergeCase: 70 | forall x l t, 71 | List.Forall P l -> 72 | P (Emerge x l t). 73 | 74 | Hypothesis CaseCase: 75 | forall c l d, 76 | P d -> 77 | List.Forall (or_default_with True P) l -> 78 | P (Ecase c l d). 79 | 80 | Hypothesis ExpCase: 81 | forall e, 82 | P (Eexp e). 83 | 84 | Fixpoint cexp_ind2' (e : cexp) : P e. 85 | Proof. 86 | destruct e. 87 | - apply MergeCase. 88 | induction l; auto. 89 | - apply CaseCase; auto. 90 | induction l as [|[|]]; constructor; simpl; auto. 91 | - apply ExpCase. 92 | Defined. 93 | 94 | End cexp_ind2'. 95 | 96 | Fixpoint typeof (le: exp): type := 97 | match le with 98 | | Econst c => Tprimitive (ctype_cconst c) 99 | | Eenum _ ty 100 | | Evar _ ty 101 | | Elast _ ty 102 | | Eunop _ _ ty 103 | | Ebinop _ _ _ ty => ty 104 | | Ewhen e _ _ => typeof e 105 | end. 106 | 107 | Fixpoint typeofc (ce: cexp): type := 108 | match ce with 109 | | Emerge _ _ ty => ty 110 | | Ecase _ _ e => typeofc e 111 | | Eexp e => typeof e 112 | end. 113 | 114 | Definition typeofr (r: rhs): type := 115 | match r with 116 | | Eextcall _ _ cty => Tprimitive cty 117 | | Ecexp e => typeofc e 118 | end. 119 | 120 | (** Predicate used in [normal_args] in NLustre and Stc. *) 121 | Fixpoint noops_exp (ck: clock) (e : exp) : Prop := 122 | match ck with 123 | | Cbase => True 124 | | Con ck' _ _ => 125 | match e with 126 | | Econst _ | Eenum _ _ | Evar _ _ => True 127 | | Ewhen e' _ _ => noops_exp ck' e' 128 | | _ => False 129 | end 130 | end. 131 | 132 | End CESYNTAX. 133 | 134 | Module CESyntaxFun 135 | (Ids : IDS) 136 | (Op : OPERATORS) 137 | (OpAux: OPERATORS_AUX Ids Op) 138 | (Cks : CLOCKS Ids Op OpAux) <: CESYNTAX Ids Op OpAux Cks. 139 | Include CESYNTAX Ids Op OpAux Cks. 140 | End CESyntaxFun. 141 | -------------------------------------------------------------------------------- /examples/ums_verif.lus: -------------------------------------------------------------------------------- 1 | (* ums_verif example from the lustre v4 distribution. *) 2 | 3 | node two_vstates(set,vreset,vinit:bool) returns (vstate:bool); 4 | let 5 | vstate = vinit -> (if set and not (false fby vstate) then true 6 | else if vreset and (false fby vstate) then false 7 | else false fby vstate); 8 | tel 9 | 10 | node edge(x: bool) returns (edge : bool); 11 | let 12 | edge = x -> x and not (false fby x); 13 | tel 14 | 15 | node implies(a,b:bool) returns (implies: bool); 16 | let implies = if a then b else true; tel 17 | 18 | node after (a: bool) returns (x: bool); 19 | let 20 | x = false -> false fby (a or x); 21 | tel 22 | 23 | node always_since (c,a: bool) returns (x: bool); 24 | let 25 | x = if a then c 26 | else if after(a) then c and (false fby x) 27 | else true; 28 | tel 29 | 30 | node once_since (c,a: bool) returns (x: bool); 31 | let 32 | x = if a then c 33 | else if after(a) then c or (false fby x) 34 | else true; 35 | tel 36 | 37 | node always_from_to (c,a,b: bool) returns (x: bool); 38 | let 39 | x = implies (after(a), always_since(c, a) or once_since(b, a)); 40 | tel 41 | 42 | node once_from_to (c,a,b: bool) returns (x: bool); 43 | let 44 | x = implies (after(a) and b, once_since(c, a)); 45 | tel 46 | 47 | node alternating(a,b: bool) returns (x:bool); 48 | var a_forbiden, b_forbiden: bool; 49 | let 50 | a_forbiden = false -> (if (false fby a) and not a then true 51 | else if (false fby x) and not b then false 52 | else (false fby a_forbiden)); 53 | b_forbiden = true -> (if (false fby b) and not b then true 54 | else if (false fby a) and not a then false 55 | else (false fby b_forbiden)); 56 | x = not(a and a_forbiden) and not(b and b_forbiden); 57 | tel 58 | 59 | node not_between_and (a,b,c: bool) returns (x: bool); 60 | let 61 | x = implies(c, not once_since(a,b)); 62 | tel 63 | 64 | node ums(on_a,on_b,on_c,ack_ab,ack_bc: bool) 65 | returns (grant_access,grant_exit, 66 | do_ab,do_bc: bool); 67 | var empty_section, only_on_b: bool; 68 | let 69 | grant_access = empty_section and ack_ab; 70 | grant_exit = only_on_b and ack_bc; 71 | do_ab = not ack_ab and empty_section; 72 | do_bc = not ack_bc and only_on_b; 73 | empty_section = not(on_a or on_b or on_c); 74 | only_on_b = on_b and not(on_a or on_c); 75 | tel 76 | 77 | node ums_verif(on_a,on_b,on_c, 78 | ack_ab,ack_bc: bool) 79 | returns(property: bool); 80 | var 81 | grant_access,grant_exit: bool; 82 | do_ab,do_bc: bool; 83 | no_collision,exclusive_req: bool; 84 | no_derail_ab,no_derail_bc: bool; 85 | empty_section, only_on_b: bool; 86 | let 87 | empty_section = not(on_a or on_b or on_c); 88 | only_on_b = on_b and not(on_a or on_c); 89 | 90 | -- assertions 91 | assert not(ack_ab and ack_bc); 92 | assert true -> always_from_to(ack_ab,ack_ab,do_bc); 93 | assert true -> always_from_to(ack_bc,ack_bc,do_ab); 94 | assert empty_section -> true; 95 | assert true -> 96 | implies(edge(not empty_section), 97 | false fby grant_access); 98 | assert true -> 99 | implies(edge(on_c), 100 | false fby grant_exit); 101 | assert true -> implies(edge(not on_a),on_b); 102 | assert true -> implies(edge(not on_b), on_a or on_c); 103 | 104 | -- ums call 105 | (grant_access,grant_exit,do_ab,do_bc) = 106 | ums(on_a,on_b,on_c,ack_ab,ack_bc); 107 | 108 | -- properties 109 | no_collision = 110 | implies(grant_access,empty_section); 111 | exclusive_req = 112 | not(do_ab and do_bc); 113 | no_derail_ab = 114 | always_from_to(ack_ab, 115 | grant_access, 116 | only_on_b); 117 | no_derail_bc = 118 | always_from_to(ack_bc, 119 | grant_exit, 120 | empty_section); 121 | property = 122 | no_collision and exclusive_req and 123 | no_derail_ab and no_derail_bc; 124 | tel 125 | 126 | -------------------------------------------------------------------------------- /src/Lustre/Denot/Denot.v: -------------------------------------------------------------------------------- 1 | From Velus Require Import Lustre.LSyntax. 2 | From Velus Require Import Lustre.LTyping. 3 | From Velus Require Import Lustre.LClocking. 4 | From Velus Require Import Lustre.LOrdered. 5 | From Velus Require Import Lustre.LCausality. 6 | From Velus Require Import Lustre.LSemantics. 7 | From Velus Require Import Lustre.StaticEnv. 8 | From Velus Require Import Common Operators Clocks CoindStreams. 9 | 10 | From Velus Require Export Lustre.Denot.Restr. 11 | From Velus Require Export Lustre.Denot.CheckOp. 12 | From Velus Require Export Lustre.Denot.SD. 13 | From Velus Require Export Lustre.Denot.InftyProof. 14 | From Velus Require Export Lustre.Denot.OpErr. 15 | From Velus Require Export Lustre.Denot.Safe. 16 | From Velus Require Export Lustre.Denot.Abs. 17 | From Velus Require Export Lustre.Denot.Lp. 18 | From Velus Require Export Lustre.Denot.SDtoRel. 19 | (* FIMXE: ResetLs is not part of the functor *) 20 | From Velus Require Export Lustre.Denot.ResetLs. 21 | 22 | (** We put Restr and CheckOp in separate modules for extraction, we don't want 23 | to extract the CPO library, which causes compilation error (DS_bot). *) 24 | 25 | Module Type LDENOT 26 | (Ids : IDS) 27 | (Op : OPERATORS) 28 | (OpAux : OPERATORS_AUX Ids Op) 29 | (Cks : CLOCKS Ids Op OpAux) 30 | (Senv : STATICENV Ids Op OpAux Cks) 31 | (Syn : LSYNTAX Ids Op OpAux Cks Senv) 32 | (Typ : LTYPING Ids Op OpAux Cks Senv Syn) 33 | (Cl : LCLOCKING Ids Op OpAux Cks Senv Syn) 34 | (Caus : LCAUSALITY Ids Op OpAux Cks Senv Syn) 35 | (Lord : LORDERED Ids Op OpAux Cks Senv Syn) 36 | (Str : COINDSTREAMS Ids Op OpAux Cks) 37 | (Sem : LSEMANTICS Ids Op OpAux Cks Senv Syn Lord Str) 38 | (Restr : LRESTR Ids Op OpAux Cks Senv Syn) 39 | (CheckOp : CHECKOP Ids Op OpAux Cks Senv Syn). 40 | 41 | Declare Module Export Sd : SD Ids Op OpAux Cks Senv Syn Lord. 42 | Declare Module Export Inf : LDENOTINF Ids Op OpAux Cks Senv Syn Typ Caus Lord Restr Sd. 43 | Declare Module Export OpErr : OP_ERR Ids Op OpAux Cks Senv Syn Typ Restr Lord Sd CheckOp. 44 | Declare Module Export Safe : LDENOTSAFE Ids Op OpAux Cks Senv Syn Typ Restr Cl Lord Sd CheckOp OpErr. 45 | Declare Module Export Abs : ABS_INDEP Ids Op OpAux Cks Senv Syn Typ Lord Sd. 46 | Declare Module Export Lp : LP Ids Op OpAux Cks Senv Syn Typ Lord Sd. 47 | Declare Module Export SdR : SDTOREL Ids Op OpAux Cks Senv Syn Typ Cl Caus Lord Str Sem Sd Restr Inf CheckOp OpErr Safe Abs Lp. 48 | 49 | End LDENOT. 50 | 51 | Module LdenotFun 52 | (Ids : IDS) 53 | (Op : OPERATORS) 54 | (OpAux : OPERATORS_AUX Ids Op) 55 | (Cks : CLOCKS Ids Op OpAux) 56 | (Senv : STATICENV Ids Op OpAux Cks) 57 | (Syn : LSYNTAX Ids Op OpAux Cks Senv) 58 | (Typ : LTYPING Ids Op OpAux Cks Senv Syn) 59 | (Cl : LCLOCKING Ids Op OpAux Cks Senv Syn) 60 | (Caus : LCAUSALITY Ids Op OpAux Cks Senv Syn) 61 | (Lord : LORDERED Ids Op OpAux Cks Senv Syn) 62 | (Str : COINDSTREAMS Ids Op OpAux Cks) 63 | (Sem : LSEMANTICS Ids Op OpAux Cks Senv Syn Lord Str) 64 | (Restr : LRESTR Ids Op OpAux Cks Senv Syn) 65 | (CheckOp : CHECKOP Ids Op OpAux Cks Senv Syn) 66 | <: LDENOT Ids Op OpAux Cks Senv Syn Typ Cl Caus Lord Str Sem Restr CheckOp. 67 | Module Export Sd := SdFun Ids Op OpAux Cks Senv Syn Lord. 68 | Module Export Inf := LDenotInfFun Ids Op OpAux Cks Senv Syn Typ Caus Lord Restr Sd. 69 | Module Export OpErr := OpErrFun Ids Op OpAux Cks Senv Syn Typ Restr Lord Sd CheckOp. 70 | Module Export Safe := LdenotsafeFun Ids Op OpAux Cks Senv Syn Typ Restr Cl Lord Sd CheckOp OpErr. 71 | Module Export Abs := AbsIndepFun Ids Op OpAux Cks Senv Syn Typ Lord Sd. 72 | Module Export Lp := LpFun Ids Op OpAux Cks Senv Syn Typ Lord Sd. 73 | Module Export SdR := SdtorelFun Ids Op OpAux Cks Senv Syn Typ Cl Caus Lord Str Sem Sd Restr Inf CheckOp OpErr Safe Abs Lp. 74 | End LdenotFun. 75 | --------------------------------------------------------------------------------