Project

General

Profile

Download (1.85 KB) Statistics
| Branch: | Tag: | Revision:
1 eb70bae5 Christophe Garion
open Basetypes
2 2de7fa82 ploc
open Datatype
3
open CPS_transformer
4 eb70bae5 Christophe Garion
open Theta
5 2de7fa82 ploc
6 ca7ff3f7 LĂ©lio Brun
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