src/HOL/UNITY/Lift.thy
changeset 5357 6efb2b87610c
parent 5340 d75c03cf77b5
child 5426 566f47250bd0
equal deleted inserted replaced
5356:6ef114ba5b55 5357:6efb2b87610c
    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