Project

General

Profile

Download (2.12 KB) Statistics
| Branch: | Tag: | Revision:
1
open Lustrec
2
open Basetypes
3
open ActiveStates
4
open CPS_transformer
5

    
6
module CodeGenerator : ComparableTransformerType =
7
struct
8
  include TransformerStub
9

    
10
  type t =
11
  | Bot
12
  | Act of act_t
13
  | Seq of t list
14
  | Ite of cond_t * t * t
15

    
16
  let null = Seq []
17

    
18
  let bot = Bot
19
 
20
  let ( >> ) tr1 tr2 =
21
    match tr1, tr2 with
22
    | Seq trl1, Seq trl2 -> Seq (trl1@trl2)
23
    | Seq trl1, _        -> Seq (trl1@[tr2])
24
    | _       , Seq trl2 -> Seq (tr1::trl2)
25
    | _                  -> Seq ([tr1;tr2])
26

    
27
  let rec ( == ) tr1 tr2 = tr1 = tr2
28

    
29
  let eval_act kenv (action : act_t) =
30
    (*Format.printf "----- action = %a@." Action.pp_act action;*)
31
    Act action
32

    
33
  (*if (match trans.event with None -> true | _ -> e = trans.event) && trans.condition rho*)
34
  let rec eval_cond condition ok ko =
35
    (*Format.printf "----- cond = %a@." Condition.pp_cond condition;*)
36
    Ite (condition, ok, ko)
37
    
38
  let rec pp_transformer fmt tr =
39
    match tr with
40
    | Bot           -> Format.fprintf fmt "bot"
41
    | Act a         ->
42
       Format.fprintf fmt "<%a>" pp_act a
43
    | Seq trl       ->
44
       Format.fprintf fmt "@[<v 0>%a@]"
45
	 (Utils.fprintf_list ~sep:";@ " pp_transformer)
46
	 trl
47
    | Ite (c, t, e) ->
48
       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
49

    
50
  let pp_principal fmt tr =
51
    Format.fprintf fmt "principal =@.%a" pp_transformer tr
52
      
53
  let pp_component : type c. Format.formatter -> c call_t -> c -> t -> unit =
54
    fun fmt call -> match call with
55
    | Ecall -> (fun (p, p', f) tr ->
56
      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)
57
    | Dcall -> (fun p tr ->
58
      Format.fprintf fmt "component %a(%a) =@.@[<v 2>begin@ %a@]@.end" pp_call call pp_path p pp_transformer tr)
59
    | Xcall -> (fun (p, f) tr ->
60
      Format.fprintf fmt "component %a(%a, %a) =@.@[<v 2>begin@ %a@]@.end" pp_call call pp_path p pp_frontier f pp_transformer tr)
61

    
62
		     let mkcomponent _  = assert false
63
		     let mkprincipal _  = assert false
64
		     let mktransformer _  = assert false
65
		       
66
end
67

    
(3-3/10)