1
|
open Basetypes
|
2
|
open Datatype
|
3
|
open CPS_transformer
|
4
|
open Theta
|
5
|
|
6
|
module Semantics =
|
7
|
functor
|
8
|
(T : TransformerType)
|
9
|
(M : MODEL_T)
|
10
|
->
|
11
|
struct
|
12
|
module Prog = struct
|
13
|
let init, defs, state_vars, globals =
|
14
|
let (Program (init, defs, globals)) = M.model in
|
15
|
let state_vars = SF.states M.model in
|
16
|
init, defs, state_vars, globals
|
17
|
|
18
|
(*let _ = Format.printf "Model definitions@.%a@.####" Simulink.pp_src
|
19
|
defs; () *)
|
20
|
end
|
21
|
|
22
|
module Interp = CPS_interpreter.Interpreter (T)
|
23
|
module KenvTheta = KenvTheta (T)
|
24
|
|
25
|
module Tables = KenvTheta.MemoThetaTables ()
|
26
|
|
27
|
let eval
|
28
|
((modular_entry : bool), (modular_during : bool), (modular_exit : bool))
|
29
|
=
|
30
|
let module Modularity : KenvTheta.ModularType = struct
|
31
|
let modular : type b. (path_t, b, bool) tag_t -> path_t -> b =
|
32
|
fun tag ->
|
33
|
match tag with
|
34
|
| E ->
|
35
|
fun _p _p' _f -> modular_entry
|
36
|
| D ->
|
37
|
fun _p -> modular_during
|
38
|
| X ->
|
39
|
fun _p _f -> modular_exit
|
40
|
end in
|
41
|
let module Thetaify = KenvTheta.ModularThetaify (Tables) (Modularity) in
|
42
|
let module EvalProg = Interp.Evaluation (Thetaify) (Prog) in
|
43
|
(module EvalProg : Interp.EvaluationType)
|
44
|
|
45
|
let compute modular =
|
46
|
let module Eval = (val eval modular) in
|
47
|
Eval.eval_prog
|
48
|
|
49
|
let code_gen modular =
|
50
|
let module Eval = (val eval modular) in
|
51
|
let principal, components = Eval.eval_prog, Eval.eval_components in
|
52
|
List.flatten
|
53
|
(List.map (fun (c, tr) -> T.mkcomponent Ecall c tr) (components Ecall))
|
54
|
@ List.flatten
|
55
|
(List.map
|
56
|
(fun (c, tr) -> T.mkcomponent Dcall c tr)
|
57
|
(components Dcall))
|
58
|
@ List.flatten
|
59
|
(List.map
|
60
|
(fun (c, tr) -> T.mkcomponent Xcall c tr)
|
61
|
(components Xcall))
|
62
|
@ T.mkprincipal principal
|
63
|
end
|