17 req :: nat set (*for each floor, whether the lift is requested*) |
17 req :: nat set (*for each floor, whether the lift is requested*) |
18 up :: bool (*current direction of movement*) |
18 up :: bool (*current direction of movement*) |
19 move :: bool (*whether moving takes precedence over opening*) |
19 move :: bool (*whether moving takes precedence over opening*) |
20 |
20 |
21 consts |
21 consts |
22 min, max :: nat (*least and greatest floors*) |
22 Min, Max :: nat (*least and greatest floors*) |
23 |
23 |
24 rules |
24 rules |
25 min_le_max "min <= max" |
25 Min_le_Max "Min <= Max" |
26 |
26 |
27 (** Linear arithmetic: justified by a separate call to arith_oracle_tac **) |
27 (** Linear arithmetic: justified by a separate call to arith_oracle_tac **) |
28 arith1 "m < fl ==> n - Suc fl < fl - m + (n - m)" |
28 arith1 "m < fl ==> n - Suc fl < fl - m + (n - m)" |
29 arith2 "[| Suc fl < n; m < n |] ==> n - Suc fl < fl - m + (n - m)" |
29 arith2 "[| m<n; m <= fl |] ==> n - Suc fl < fl - m + (n - m)" |
30 |
30 arith3 "[| Suc ix < m |] ==> ix - n < m - Suc ix + (m - n)" |
|
31 arith4 "[| ix < m; n < ix |] ==> ix - n < m - Suc (ix) + (m - n)" |
31 |
32 |
32 constdefs |
33 constdefs |
33 |
34 |
34 (** Abbreviations: the "always" part **) |
35 (** Abbreviations: the "always" part **) |
35 |
36 |
36 above :: state set |
37 above :: state set |
37 "above == {s. EX i. floor s < i & i <= max & i : req s}" |
38 "above == {s. EX i. floor s < i & i <= Max & i : req s}" |
38 |
39 |
39 below :: state set |
40 below :: state set |
40 "below == {s. EX i. min <= i & i < floor s & i : req s}" |
41 "below == {s. EX i. Min <= i & i < floor s & i : req s}" |
41 |
42 |
42 queueing :: state set |
43 queueing :: state set |
43 "queueing == above Un below" |
44 "queueing == above Un below" |
44 |
45 |
45 goingup :: state set |
46 goingup :: state set |
89 & ~(move s & s: queueing)}" |
90 & ~(move s & s: queueing)}" |
90 |
91 |
91 close_act :: "(state*state) set" |
92 close_act :: "(state*state) set" |
92 "close_act == {(s,s'). s' = s (|open := False|) & open s}" |
93 "close_act == {(s,s'). s' = s (|open := False|) & open s}" |
93 |
94 |
94 req_up_act :: "(state*state) set" |
95 req_up :: "(state*state) set" |
95 "req_up_act == |
96 "req_up == |
96 {(s,s'). s' = s (|stop :=False, |
97 {(s,s'). s' = s (|stop :=False, |
97 floor := Suc (floor s), |
98 floor := Suc (floor s), |
98 up := True|) |
99 up := True|) |
99 & s : (ready Int goingup)}" |
100 & s : (ready Int goingup)}" |
100 |
101 |
101 req_down_act :: "(state*state) set" |
102 req_down :: "(state*state) set" |
102 "req_down_act == |
103 "req_down == |
103 {(s,s'). s' = s (|stop :=False, |
104 {(s,s'). s' = s (|stop :=False, |
104 floor := floor s - 1, |
105 floor := floor s - 1, |
105 up := False|) |
106 up := False|) |
106 & s : (ready Int goingdown)}" |
107 & s : (ready Int goingdown)}" |
107 |
108 |
113 move_down :: "(state*state) set" |
114 move_down :: "(state*state) set" |
114 "move_down == |
115 "move_down == |
115 {(s,s'). s' = s (|floor := floor s - 1|) |
116 {(s,s'). s' = s (|floor := floor s - 1|) |
116 & ~ stop s & ~ up s & floor s ~: req s}" |
117 & ~ stop s & ~ up s & floor s ~: req s}" |
117 |
118 |
|
119 button_press :: "(state*state) set" |
|
120 "button_press == |
|
121 {(s,s'). EX n. s' = s (|req := insert n (req s)|) |
|
122 & Min <= n & n <= Max}" |
|
123 |
|
124 |
118 Lprg :: state program |
125 Lprg :: state program |
119 "Lprg == (|Init = {s. floor s = min & ~ up s & move s & stop s & |
126 (*for the moment, we OMIT button_press*) |
|
127 "Lprg == (|Init = {s. floor s = Min & ~ up s & move s & stop s & |
120 ~ open s & req s = {}}, |
128 ~ open s & req s = {}}, |
121 Acts = {id, request_act, open_act, close_act, |
129 Acts = {id, request_act, open_act, close_act, |
122 req_up_act, req_down_act, move_up, move_down}|)" |
130 req_up, req_down, move_up, move_down}|)" |
123 |
131 |
124 |
132 |
125 (** Invariants **) |
133 (** Invariants **) |
126 |
134 |
127 bounded :: state set |
135 bounded :: state set |
128 "bounded == {s. min <= floor s & floor s <= max}" |
136 "bounded == {s. Min <= floor s & floor s <= Max}" |
129 |
137 |
130 open_stop :: state set |
138 open_stop :: state set |
131 "open_stop == {s. open s --> stop s}" |
139 "open_stop == {s. open s --> stop s}" |
132 |
140 |
133 open_move :: state set |
141 open_move :: state set |
136 stop_floor :: state set |
144 stop_floor :: state set |
137 "stop_floor == {s. stop s & ~ move s --> floor s : req s}" |
145 "stop_floor == {s. stop s & ~ move s --> floor s : req s}" |
138 |
146 |
139 moving_up :: state set |
147 moving_up :: state set |
140 "moving_up == {s. ~ stop s & up s --> |
148 "moving_up == {s. ~ stop s & up s --> |
141 (EX f. floor s <= f & f <= max & f : req s)}" |
149 (EX f. floor s <= f & f <= Max & f : req s)}" |
142 |
150 |
143 moving_down :: state set |
151 moving_down :: state set |
144 "moving_down == {s. ~ stop s & ~ up s --> |
152 "moving_down == {s. ~ stop s & ~ up s --> |
145 (EX f. min <= f & f <= floor s & f : req s)}" |
153 (EX f. Min <= f & f <= floor s & f : req s)}" |
146 |
154 |
147 metric :: [nat,state] => nat |
155 metric :: [nat,state] => nat |
148 "metric n s == if up s & floor s < n then n - floor s |
156 "metric == |
149 else if ~ up s & n < floor s then floor s - n |
157 %n s. if up s & floor s < n then n - floor s |
150 else if up s & n < floor s then (max - floor s) + (max-n) |
158 else if ~ up s & n < floor s then floor s - n |
151 else if ~ up s & floor s < n then (floor s - min) + (n-min) |
159 else if up s & n < floor s then (Max - floor s) + (Max-n) |
152 else 0" |
160 else if ~ up s & floor s < n then (floor s - Min) + (n-Min) |
|
161 else 0" |
153 |
162 |
154 locale floor = |
163 locale floor = |
155 fixes |
164 fixes |
156 n :: nat |
165 n :: nat |
157 assumes |
166 assumes |
158 min_le_n "min <= n" |
167 Min_le_n "Min <= n" |
159 n_le_max "n <= max" |
168 n_le_Max "n <= Max" |
160 defines |
169 defines |
161 |
170 |
162 end |
171 end |