Project

General

Profile

Statistics
| Branch: | Tag: | Revision:

lustrec / tools / stateflow / src / semantics / CPS / cPS.ml @ 2de7fa82

History | View | Annotate | Download (1.66 KB)

1
open Basetypes 
2
open Datatype
3
open CPS_transformer
4
open Theta 
5

    
6
module Semantics = functor (T: TransformerType) (M: MODEL_T) ->
7
struct
8
  
9
module Prog =
10
struct
11
  let init = fst M.model
12
  let defs = snd M.model
13
  let vars = SF.states M.model
14
(*let _ = Format.printf "Model definitions@.%a@.####" Simulink.pp_src defs; () *)
15
end
16

    
17

    
18
module Interp = CPS_interpreter.Interpreter (T)
19
module KenvTheta = KenvTheta (T)
20
module Tables = KenvTheta.MemoThetaTables ()
21

    
22
let eval ((modular_entry:bool), (modular_during:bool), (modular_exit:bool)) =
23
  let module Modularity : KenvTheta.ModularType =
24
      struct
25
	let modular : type b. (path_t, b, bool) tag_t -> path_t -> b =
26
			fun tag ->
27
			  match tag with
28
			  | E -> (fun p p' f -> modular_entry)
29
			  | D -> (fun p      -> modular_during)
30
			  | X -> (fun p f    -> modular_exit)
31
      end
32
  in
33
  let module Thetaify = KenvTheta.ModularThetaify (Tables) (Modularity) in
34
  let module EvalProg = Interp.Evaluation (Thetaify) (Prog) in
35
  (module EvalProg: Interp.EvaluationType)
36
  
37
let compute modular  =
38
  let module Eval = (val (eval modular)) in
39
  Eval.eval_prog 
40
    
41
let code_gen fmt modular  =
42
  let module Eval = (val (eval modular)) in
43
  let principal, components =  Eval.eval_prog, Eval.eval_components in
44
  Format.fprintf fmt "%a@." T.pp_principal principal;
45

    
46
  List.iter
47
    (fun (c, tr) -> Format.fprintf fmt "@.%a@." (fun fmt -> T.pp_component fmt Ecall c) tr)
48
    (components Ecall);
49
  List.iter
50
    (fun (c, tr) -> Format.fprintf fmt "@.%a@." (fun fmt -> T.pp_component fmt Dcall c) tr)
51
    (components Dcall);
52
  List.iter
53
    (fun (c, tr) -> Format.fprintf fmt "@.%a@." (fun fmt -> T.pp_component fmt Xcall c) tr)
54
    (components Xcall);
55

    
56
  ()
57

    
58
end