Project

General

Profile

Statistics
| Branch: | Tag: | Revision:

lustrec / src / backends / OCaml / example.ml @ 650a0ec8

History | View | Annotate | Download (3.27 KB)

1
(* Example for the linear controller
2

    
3
   x = 1.5 pre x + 0.7 pre y + 1.6 u
4
   y = pre x
5

    
6
We obtain the machine 
7
machine top
8
    mem      : __top_2: real, __top_3: real
9
    instances: (ni_0, _arrow<>)
10
    init     : reset ni_0
11
    step     :
12
      inputs : in0: real
13
      outputs: x: real, y: real
14
      locals : __top_1: bool
15
      checks : 
16
      instrs : __top_1 = ni_0 (true, false)
17
               case(__top_1) {
18
                 false:
19
                   y<-l- __top_3
20
                   x<-l- + (- ( * (1.5, __top_3), * (0.7, __top_2)), * (1.6, in0))
21
                 true:
22
                   y<-l- 0.
23
                   x<-l- 0.
24
                 }
25
               __top_3<-s- x __top_2<-s- y
26

    
27
*)
28
        
29

    
30
class ['expr_t] arrow = 
31
object
32
      val mutable init = true;
33
      method reset () = init <- true
34
      method step a b :'expr_t = 
35
	let res = if init then a else b in
36
	init <- false;
37
	res
38
    end
39

    
40
module Bool = 
41
struct
42
  type t = True | False | Maybe
43
end
44

    
45
module type DOMAIN = sig
46
  type t
47
  val of_float : float -> t
48
  val of_float_float : float -> float -> t
49
  val eq : t -> t -> Bool.t
50
  val lt : t -> t -> Bool.t
51
  val le : t -> t -> Bool.t
52
  val add : t -> t -> t
53
  val sub : t -> t -> t
54
  val mul : t -> t -> t
55
  val div : t -> t -> t
56
  val neg : t -> t
57
  val abs : t -> t
58
  val sin : t -> t
59
  val cos : t -> t
60
  val exp : t -> t
61
  val pow : t -> t -> t
62
  val npow : t -> int -> t
63
  val sqrt : t -> t
64
  val log : t -> t
65
  val ite : Bool.t -> t -> t -> t
66
  val pp: Format.formatter -> t -> unit
67
end
68

    
69
module DFloat = 
70
struct
71
  type t = float
72
  let of_float x = x
73
  let of_float_float a b = a +. (Random.float (b -. a)) 
74
  let comp op x y = if op x y then Bool.True else Bool.False
75
  let eq = comp (=)
76
  let lt = comp (<)
77
  let le = comp (<=)
78
  let add = (+.)
79
  let sub = (-.)
80
  let mul = ( *.)
81
  let div = (/.)
82
  let neg = (~-.)
83
  let abs = abs_float
84
  let sin = sin
85
  let cos = cos
86
  let exp = exp
87
  let pow = ( **)
88
  let npow x i = x ** (float_of_int i)
89
  let sqrt = sqrt
90
  let log = log
91
  let ite g a b = match g with | Bool.True -> a | Bool.False -> b | _ -> assert false
92
  let pp = Format.pp_print_float
93

    
94
end
95

    
96
module Env = Map.Make(struct type t =string let compare = compare end)
97
module Name = 
98
  functor (D: DOMAIN) ->
99
struct
100
  
101
(*  type mem = D.t Env.t * D.t Env.t *)    
102

    
103
  class top =
104
  object
105
    (* Default value for local memories *)
106
    val mutable __top_2 = D.of_float 0.;
107
    val mutable __top_3 = D.of_float 0.;
108
    (* Node instances *)
109
    val ni_0 = new arrow;
110
     
111
    method reset () = 
112
      __top_2 <- D.of_float 0.;
113
      __top_3 <- D.of_float 0.;
114
      ni_0#reset ()
115

    
116
    method step in0 =
117
      let __top_1 = ni_0#step true false in
118
      let y = 
119
	match __top_1 with
120
	| false -> __top_3
121
	| true -> D.of_float 0.
122
      in
123
      let x = 
124
	match __top_1 with
125
	| false -> D.add (D.sub (D.mul (D.of_float 1.5) __top_3) (D.mul (D.of_float 0.7) __top_2)) (D.mul (D.of_float 1.6) in0)
126
	| true -> D.of_float 0.
127
      in
128
      __top_3 <- x;
129
      __top_2 <- y;
130
      x, y (* list outputs *)
131

    
132
  end
133

    
134
  let main () = 
135
    let top_obj = new top in
136
    top_obj#reset ();
137
    while true do
138
      let in0 = D.of_float (read_float ()) in
139
      let x, y = top_obj#step in0 in
140
      Format.printf "in0: %a -> x: %a, y: %a@." D.pp in0 D.pp x D.pp y
141
    done
142
end
143

    
144
 
145

    
146
module NameTop = Name (DFloat)
147
let _ = NameTop.main ()