1
|
open CPS_transformer
|
2
|
|
3
|
module CodeGenerator : ComparableTransformerType = struct
|
4
|
include TransformerStub
|
5
|
|
6
|
type t = Bot | Act of act_t | Seq of t list | Ite of cond_t * t * t
|
7
|
|
8
|
let null = Seq []
|
9
|
|
10
|
let bot = Bot
|
11
|
|
12
|
let ( >> ) tr1 tr2 =
|
13
|
match tr1, tr2 with
|
14
|
| Seq trl1, Seq trl2 ->
|
15
|
Seq (trl1 @ trl2)
|
16
|
| Seq trl1, _ ->
|
17
|
Seq (trl1 @ [ tr2 ])
|
18
|
| _, Seq trl2 ->
|
19
|
Seq (tr1 :: trl2)
|
20
|
| _ ->
|
21
|
Seq [ tr1; tr2 ]
|
22
|
|
23
|
let ( == ) tr1 tr2 = tr1 = tr2
|
24
|
|
25
|
let eval_act _kenv (action : act_t) =
|
26
|
(*Format.printf "----- action = %a@." Action.pp_act action;*)
|
27
|
Act action
|
28
|
|
29
|
(*if (match trans.event with None -> true | _ -> e = trans.event) &&
|
30
|
trans.condition rho*)
|
31
|
let eval_cond condition ok ko =
|
32
|
(*Format.printf "----- cond = %a@." Condition.pp_cond condition;*)
|
33
|
Ite (condition, ok, ko)
|
34
|
|
35
|
(* let rec pp_transformer fmt tr =
|
36
|
* match tr with
|
37
|
* | Bot -> Format.fprintf fmt "bot"
|
38
|
* | Act a ->
|
39
|
* Format.fprintf fmt "<%a>" pp_act a
|
40
|
* | Seq trl ->
|
41
|
* Format.fprintf fmt "@[<v 0>%a@]"
|
42
|
* (Utils.fprintf_list ~sep:";@ " pp_transformer)
|
43
|
* trl
|
44
|
* | Ite (c, t, e) ->
|
45
|
* Format.fprintf fmt "@[<v 0>if %a@ @[<v 2>then@ %a@]@ @[<v 2>else@ %a@]@ endif@]" pp_cond c pp_transformer t pp_transformer e *)
|
46
|
|
47
|
(* let pp_principal fmt tr =
|
48
|
* Format.fprintf fmt "principal =@.%a" pp_transformer tr *)
|
49
|
|
50
|
(* let pp_component : type c. Format.formatter -> c call_t -> c -> t -> unit =
|
51
|
* fun fmt call -> match call with
|
52
|
* | Ecall -> (fun (p, p', f) tr ->
|
53
|
* Format.fprintf fmt "component %a(%a, %a, %a) =@.@[<v 2>begin@ %a@]@.end" pp_call call pp_path p pp_path p' pp_frontier f pp_transformer tr)
|
54
|
* | Dcall -> (fun p tr ->
|
55
|
* Format.fprintf fmt "component %a(%a) =@.@[<v 2>begin@ %a@]@.end" pp_call call pp_path p pp_transformer tr)
|
56
|
* | Xcall -> (fun (p, f) tr ->
|
57
|
* Format.fprintf fmt "component %a(%a, %a) =@.@[<v 2>begin@ %a@]@.end" pp_call call pp_path p pp_frontier f pp_transformer tr) *)
|
58
|
|
59
|
let mkcomponent _ = assert false
|
60
|
|
61
|
let mkprincipal _ = assert false
|
62
|
(* let mktransformer _ = assert false *)
|
63
|
end
|