├── .gitignore ├── Make ├── configure.sh ├── LICENSE ├── Makefile ├── Maps.v ├── README.md └── TAL.v /.gitignore: -------------------------------------------------------------------------------- 1 | *.vo 2 | *.glob 3 | *.v.d 4 | *.aux 5 | -------------------------------------------------------------------------------- /Make: -------------------------------------------------------------------------------- 1 | -R . "" 2 | ./LibTactics.v 3 | ./Maps.v 4 | ./TAL.v 5 | -------------------------------------------------------------------------------- /configure.sh: -------------------------------------------------------------------------------- 1 | #!/bin/sh 2 | 3 | coq_makefile -f Make -o Makefile 4 | -------------------------------------------------------------------------------- /LICENSE: -------------------------------------------------------------------------------- 1 | MIT License 2 | 3 | Copyright (c) 2016 Ankit Kumar 4 | 5 | Permission is hereby granted, free of charge, to any person obtaining a copy 6 | of this software and associated documentation files (the "Software"), to deal 7 | in the Software without restriction, including without limitation the rights 8 | to use, copy, modify, merge, publish, distribute, sublicense, and/or sell 9 | copies of the Software, and to permit persons to whom the Software is 10 | furnished to do so, subject to the following conditions: 11 | 12 | The above copyright notice and this permission notice shall be included in all 13 | copies or substantial portions of the Software. 14 | 15 | THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR 16 | IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, 17 | FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE 18 | AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER 19 | LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, 20 | OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE 21 | SOFTWARE. 22 | -------------------------------------------------------------------------------- /Makefile: -------------------------------------------------------------------------------- 1 | ############################################################################# 2 | ## v # The Coq Proof Assistant ## 3 | ## $@ 201 | printf 'cd "$${DSTROOT}"$(COQLIBINSTALL)/ && rm -f $(VOFILES) $(VFILES) $(GLOBFILES) $(NATIVEFILES) $(CMOFILES) $(CMIFILES) $(CMAFILES) && find . -type d -and -empty -delete\ncd "$${DSTROOT}"$(COQLIBINSTALL) && find "" -maxdepth 0 -and -empty -exec rmdir -p \{\} \;\n' >> "$@" 202 | printf 'cd "$${DSTROOT}"$(COQDOCINSTALL)/$(INSTALLDEFAULTROOT) \\\n' >> "$@" 203 | printf '&& rm -f $(shell find "html" -maxdepth 1 -and -type f -print)\n' >> "$@" 204 | printf 'cd "$${DSTROOT}"$(COQDOCINSTALL) && find $(INSTALLDEFAULTROOT)/html -maxdepth 0 -and -empty -exec rmdir -p \{\} \;\n' >> "$@" 205 | chmod +x $@ 206 | 207 | uninstall: uninstall_me.sh 208 | sh $< 209 | 210 | clean:: 211 | rm -f $(OBJFILES) $(OBJFILES:.o=.native) $(NATIVEFILES) 212 | find . -name .coq-native -type d -empty -delete 213 | rm -f $(VOFILES) $(VOFILES:.vo=.vio) $(GFILES) $(VFILES:.v=.v.d) $(VFILES:=.beautified) $(VFILES:=.old) 214 | rm -f all.ps all-gal.ps all.pdf all-gal.pdf all.glob $(VFILES:.v=.glob) $(VFILES:.v=.tex) $(VFILES:.v=.g.tex) all-mli.tex 215 | - rm -rf html mlihtml uninstall_me.sh 216 | 217 | cleanall:: clean 218 | rm -f $(patsubst %.v,.%.aux,$(VFILES)) 219 | 220 | archclean:: 221 | rm -f *.cmx *.o 222 | 223 | printenv: 224 | @"$(COQBIN)coqtop" -config 225 | @echo 'CAMLC = $(CAMLC)' 226 | @echo 'CAMLOPTC = $(CAMLOPTC)' 227 | @echo 'PP = $(PP)' 228 | @echo 'COQFLAGS = $(COQFLAGS)' 229 | @echo 'COQLIBINSTALL = $(COQLIBINSTALL)' 230 | @echo 'COQDOCINSTALL = $(COQDOCINSTALL)' 231 | 232 | Makefile: Make 233 | mv -f $@ $@.bak 234 | "$(COQBIN)coq_makefile" -f $< -o $@ 235 | 236 | 237 | ################### 238 | # # 239 | # Implicit rules. # 240 | # # 241 | ################### 242 | 243 | $(VOFILES): %.vo: %.v 244 | $(COQC) $(COQDEBUG) $(COQFLAGS) $* 245 | 246 | $(GLOBFILES): %.glob: %.v 247 | $(COQC) $(COQDEBUG) $(COQFLAGS) $* 248 | 249 | $(VFILES:.v=.vio): %.vio: %.v 250 | $(COQC) -quick $(COQDEBUG) $(COQFLAGS) $* 251 | 252 | $(GFILES): %.g: %.v 253 | $(GALLINA) $< 254 | 255 | $(VFILES:.v=.tex): %.tex: %.v 256 | $(COQDOC) $(COQDOCFLAGS) -latex $< -o $@ 257 | 258 | $(HTMLFILES): %.html: %.v %.glob 259 | $(COQDOC) $(COQDOCFLAGS) -html $< -o $@ 260 | 261 | $(VFILES:.v=.g.tex): %.g.tex: %.v 262 | $(COQDOC) $(COQDOCFLAGS) -latex -g $< -o $@ 263 | 264 | $(GHTMLFILES): %.g.html: %.v %.glob 265 | $(COQDOC) $(COQDOCFLAGS) -html -g $< -o $@ 266 | 267 | $(addsuffix .d,$(VFILES)): %.v.d: %.v 268 | $(COQDEP) $(COQLIBS) "$<" > "$@" || ( RV=$$?; rm -f "$@"; exit $${RV} ) 269 | 270 | $(addsuffix .beautified,$(VFILES)): %.v.beautified: 271 | $(COQC) $(COQDEBUG) $(COQFLAGS) -beautify $* 272 | 273 | # WARNING 274 | # 275 | # This Makefile has been automagically generated 276 | # Edit at your own risks ! 277 | # 278 | # END OF WARNING 279 | 280 | -------------------------------------------------------------------------------- /Maps.v: -------------------------------------------------------------------------------- 1 | (** * Maps: Total and Partial Maps - using from B-Pierce's Software Foundations code*) 2 | 3 | (** Maps (or dictionaries) are ubiquitous data structures, both in 4 | software construction generally and in the theory of programming 5 | languages in particular; we're going to need them in many places 6 | in the coming chapters. They also make a nice case study using 7 | ideas we've seen in previous chapters, including building data 8 | structures out of higher-order functions (from [Basics] and 9 | [Poly]) and the use of reflection to streamline proofs (from 10 | [IndProp]). 11 | 12 | We'll define two flavors of maps: _total_ maps, which include a 13 | "default" element to be returned when a key being looked up 14 | doesn't exist, and _partial_ maps, which return an [option] to 15 | indicate success or failure. The latter is defined in terms of 16 | the former, using [None] as the default element. *) 17 | 18 | (* ################################################################# *) 19 | (** * The Coq Standard Library *) 20 | 21 | Require Import Coq.Arith.Arith. 22 | Require Import Coq.Bool.Bool. 23 | Require Import Coq.Logic.FunctionalExtensionality. 24 | 25 | (** Documentation for the standard library can be found at 26 | http://coq.inria.fr/library/. *) 27 | 28 | Inductive id : Type := 29 | | Id : nat -> id. 30 | 31 | Definition beq_id id1 id2 := 32 | match id1,id2 with 33 | | Id n1, Id n2 => beq_nat n1 n2 34 | end. 35 | 36 | Theorem beq_id_refl : forall id, beq_id id id = true. 37 | Proof. 38 | intros [n]. simpl. rewrite <- beq_nat_refl. 39 | reflexivity. Qed. 40 | 41 | (** The following useful property of [beq_id] follows from an 42 | analogous lemma about numbers: *) 43 | 44 | Theorem beq_id_true_iff : forall id1 id2 : id, 45 | beq_id id1 id2 = true <-> id1 = id2. 46 | Proof. 47 | intros [n1] [n2]. 48 | unfold beq_id. 49 | rewrite beq_nat_true_iff. 50 | split. 51 | - (* -> *) intros H. rewrite H. reflexivity. 52 | - (* <- *) intros H. inversion H. reflexivity. 53 | Qed. 54 | 55 | (** Similarly: *) 56 | 57 | Theorem beq_id_false_iff : forall x y : id, 58 | beq_id x y = false 59 | <-> x <> y. 60 | Proof. 61 | intros x y. rewrite <- beq_id_true_iff. 62 | rewrite not_true_iff_false. reflexivity. Qed. 63 | 64 | (** This useful variant follows just by rewriting: *) 65 | 66 | Theorem false_beq_id : forall x y : id, 67 | x <> y 68 | -> beq_id x y = false. 69 | Proof. 70 | intros x y. rewrite beq_id_false_iff. 71 | intros H. apply H. Qed. 72 | 73 | (* ################################################################# *) 74 | (** * Total Maps *) 75 | 76 | Definition total_map (A:Type) := id -> A. 77 | 78 | Definition t_empty {A:Type} (v : A) : total_map A := 79 | (fun _ => v). 80 | 81 | (** [update] function takes a map [m], a key [x], and a value [v] and returns a new map that takes [x] to [v] and takes every other key to whatever [m] does. *) 82 | 83 | Definition t_update {A:Type} (m : total_map A) 84 | (x : id) (v : A) := 85 | fun x' => if beq_id x x' then v else m x'. 86 | 87 | Definition examplemap := 88 | t_update (t_update (t_empty false) (Id 1) false) 89 | (Id 3) true. 90 | 91 | (** This completes the definition of total maps. Note that we don't 92 | need to define a [find] operation because it is just function 93 | application! *) 94 | 95 | Example update_example1 : examplemap (Id 0) = false. 96 | Proof. reflexivity. Qed. 97 | 98 | Example update_example2 : examplemap (Id 1) = false. 99 | Proof. reflexivity. Qed. 100 | 101 | Example update_example3 : examplemap (Id 2) = false. 102 | Proof. reflexivity. Qed. 103 | 104 | Example update_example4 : examplemap (Id 3) = true. 105 | Proof. reflexivity. Qed. 106 | 107 | (** **** Exercise: 1 star, optional (t_apply_empty) *) 108 | (** First, the empty map returns its default element for all keys: *) 109 | Lemma t_apply_empty: forall A x v, @t_empty A v x = v. 110 | Proof. 111 | intros. 112 | trivial. 113 | Qed. 114 | 115 | (** **** Exercise: 2 stars, optional (t_update_eq) *) 116 | (** Next, if we update a map [m] at a key [x] with a new value [v] 117 | and then look up [x] in the map resulting from the [update], we 118 | get back [v]: *) 119 | 120 | Lemma t_update_eq : forall A (m: total_map A) x v, 121 | (t_update m x v) x = v. 122 | Proof. 123 | intros. 124 | unfold t_update. 125 | rewrite beq_id_refl. 126 | reflexivity. 127 | Qed. 128 | 129 | (** **** Exercise: 2 stars, optional (t_update_neq) *) 130 | (** On the other hand, if we update a map [m] at a key [x1] and then 131 | look up a _different_ key [x2] in the resulting map, we get the 132 | same result that [m] would have given: *) 133 | 134 | Theorem t_update_neq : forall (X:Type) v x1 x2 135 | (m : total_map X), 136 | x1 <> x2 -> 137 | (t_update m x1 v) x2 = m x2. 138 | Proof. 139 | intros X v [x1] [x2] m H. 140 | unfold t_update. 141 | rewrite -> false_beq_id. 142 | trivial. 143 | exact H. 144 | Qed. 145 | (** [] *) 146 | 147 | (** **** Exercise: 2 stars, optional (t_update_shadow) *) 148 | (** If we update a map [m] at a key [x] with a value [v1] and then 149 | update again with the same key [x] and another value [v2], the 150 | resulting map behaves the same (gives the same result when applied 151 | to any key) as the simpler map obtained by performing just 152 | the second [update] on [m]: *) 153 | 154 | Lemma t_update_shadow : forall A (m: total_map A) v1 v2 x, 155 | t_update (t_update m x v1) x v2 156 | = t_update m x v2. 157 | Proof. 158 | intros A m v1 v2 x. 159 | unfold t_update. 160 | extensionality i. 161 | remember (beq_id x i) as e; induction e. 162 | trivial. 163 | trivial. 164 | Qed. 165 | 166 | (** [] *) 167 | 168 | (** **** Exercise: 2 stars (beq_idP) *) 169 | (** Use the proof of [beq_natP] in chapter [IndProp] as a template to 170 | prove the following: *) 171 | 172 | Lemma beq_idP : forall x y, reflect (x = y) (beq_id x y). 173 | Proof. 174 | intros. 175 | apply iff_reflect. 176 | rewrite beq_id_true_iff. 177 | reflexivity. 178 | Qed. 179 | (** [] *) 180 | 181 | (** Now, given [id]s [x1] and [x2], we can use the [destruct (beq_idP 182 | x1 x2)] to simultaneously perform case analysis on the result of 183 | [beq_id x1 x2] and generate hypotheses about the equality (in the 184 | sense of [=]) of [x1] and [x2]. *) 185 | 186 | (** **** Exercise: 2 stars (t_update_same) *) 187 | (** Using the example in chapter [IndProp] as a template, use 188 | [beq_idP] to prove the following theorem, which states that if we 189 | update a map to assign key [x] the same value as it already has in 190 | [m], then the result is equal to [m]: *) 191 | 192 | Theorem t_update_same : forall X x (m : total_map X), 193 | t_update m x (m x) = m. 194 | Proof. 195 | intros. 196 | unfold t_update. 197 | extensionality i. 198 | remember (beq_id x i) as e; induction e. 199 | symmetry in Heqe. 200 | apply beq_id_true_iff in Heqe. 201 | rewrite Heqe. 202 | reflexivity. 203 | reflexivity. 204 | Qed. 205 | (** [] *) 206 | 207 | (** **** Exercise: 3 stars, recommended (t_update_permute) *) 208 | (** Use [beq_idP] to prove one final property of the [update] 209 | function: If we update a map [m] at two distinct keys, it doesn't 210 | matter in which order we do the updates. *) 211 | 212 | Theorem t_update_permute : forall (X:Type) v1 v2 x1 x2 213 | (m : total_map X), 214 | x2 <> x1 -> 215 | (t_update (t_update m x2 v2) x1 v1) 216 | = (t_update (t_update m x1 v1) x2 v2). 217 | Proof. 218 | intros. 219 | unfold t_update. 220 | extensionality i. 221 | remember (beq_id x1 i) as e; induction e. 222 | symmetry in Heqe. 223 | apply beq_id_true_iff in Heqe. 224 | rewrite <- Heqe. 225 | rewrite -> false_beq_id. 226 | reflexivity. 227 | exact H. 228 | reflexivity. 229 | Qed. 230 | (** [] *) 231 | 232 | (* ################################################################# *) 233 | (** * Partial maps *) 234 | 235 | (** Finally, we define _partial maps_ on top of total maps. A partial 236 | map with elements of type [A] is simply a total map with elements 237 | of type [option A] and default element [None]. *) 238 | 239 | Definition partial_map (A:Type) := total_map (option A). 240 | 241 | Definition empty {A:Type} : partial_map A := 242 | t_empty None. 243 | 244 | Definition update {A:Type} (m : partial_map A) 245 | (x : id) (v : A) := 246 | t_update m x (Some v). 247 | 248 | (** We can now lift all of the basic lemmas about total maps to 249 | partial maps. *) 250 | 251 | Lemma apply_empty : forall A x, @empty A x = None. 252 | Proof. 253 | intros. unfold empty. rewrite t_apply_empty. 254 | reflexivity. 255 | Qed. 256 | 257 | Lemma update_eq : forall A (m: partial_map A) x v, 258 | (update m x v) x = Some v. 259 | Proof. 260 | intros. unfold update. rewrite t_update_eq. 261 | reflexivity. 262 | Qed. 263 | 264 | Theorem update_neq : forall (X:Type) v x1 x2 265 | (m : partial_map X), 266 | x2 <> x1 -> 267 | (update m x2 v) x1 = m x1. 268 | Proof. 269 | intros X v x1 x2 m H. 270 | unfold update. rewrite t_update_neq. reflexivity. 271 | apply H. Qed. 272 | 273 | Lemma update_shadow : forall A (m: partial_map A) v1 v2 x, 274 | update (update m x v1) x v2 = update m x v2. 275 | Proof. 276 | intros A m v1 v2 x1. unfold update. rewrite t_update_shadow. 277 | reflexivity. 278 | Qed. 279 | 280 | Theorem update_same : forall X v x (m : partial_map X), 281 | m x = Some v -> 282 | update m x v = m. 283 | Proof. 284 | intros X v x m H. unfold update. rewrite <- H. 285 | apply t_update_same. 286 | Qed. 287 | 288 | Theorem update_permute : forall (X:Type) v1 v2 x1 x2 289 | (m : partial_map X), 290 | x2 <> x1 -> 291 | (update (update m x2 v2) x1 v1) 292 | = (update (update m x1 v1) x2 v2). 293 | Proof. 294 | intros X v1 v2 x1 x2 m. unfold update. 295 | apply t_update_permute. 296 | Qed. 297 | 298 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | Based on paper by Greg Morrisett , TAL-0 is the design of a RISC-style typed assembly language which focuses on control-flow safety. This post provides a mechanized metatheory, particularly a machine checked proof of soundness of the TAL-0 type system as proposed by the author in section 4.2.10 of the book Advanced Topics in Types and Programming Languages. 2 | 3 | The TAL-0 language runs on an abstract machine which is represented by 3 components : 4 | 5 | 1. A heap H which is a finite, partial map from labels to heap values 6 | 7 | 2. a register file R which is a total map from registers to values, and 8 | 9 | 3. a current instruction sequence I. 10 | 11 | An example state of the abstact machine is shown below: 12 | 13 | 14 | We denote addresses of instructions stored in the heap as labels. Unlike a typical machine where labels are resolved to some machine address, which are integers, we maintain a distinction between labels and arbitrary integers, as this complies with our goal to state and prove the control-flow safety i.e. we can only branch to a valid label, and not to any arbitrary integer. This will ensure that the machine never gets stuck while trying to do some invalid operation. 15 | 16 | TAL-0 does not have expressions. It has operands on which instructions (like ADD, MOV etc.) operate. Some instructions act on Registers like "JMP R(d)". We use “value” to refer to an operand that is not a register. Such values include ANum (integer), ALab (label pointing to an instruction sequence in the heap) or AReg (value stored in a register, not the register itself). Following are the definitions for such values : 17 | 18 | ```coq 19 | Inductive val : Type := 20 | | ANum : nat -> val 21 | | AReg : nat -> val 22 | | ALab : nat -> val. 23 | ``` 24 | 25 | aeval function returns nat stored in the value. 26 | ``` 27 | Fixpoint aeval (a : val) (R : registers) : nat := 28 | match a with 29 | | ANum n => n 30 | | AReg d => R (Id d) 31 | | ALab l => l 32 | end. 33 | ``` 34 | State of the machine is defined using the triple H (Heap), R(Register File) and Is(Current executing instruction sequence) : 35 | ```coq 36 | Inductive st : Type := 37 | | St : heaps -> registers -> instr_seq -> st. 38 | ``` 39 | 40 | Instructions are defined as follows : 41 | ```coq 42 | Inductive instr : Type := 43 | | IMov : forall d : nat, 44 | val -> instr 45 | | IAdd : forall d s : nat, 46 | instr 47 | | ISub : forall d v : nat, 48 | instr 49 | | IIf : forall d : nat, 50 | val -> instr. 51 | ``` 52 | And instruction sequences are defined in such a way that a sequence always has to end in a JMP. 53 | ```coq 54 | Inductive instr_seq : Type := 55 | | ISeq : instr -> instr_seq -> instr_seq 56 | | IJmp : val -> instr_seq. 57 | ``` 58 | 59 | Evaluation of instructions is supposed to change the Machine State and 60 | thus some of its components H, R or Is. These changes are recorded as 61 | relations between initial and final state of the machine. 62 | ```coq 63 | Inductive ieval : st -> st -> Prop := 64 | | R_IMov : forall H R I d a, 65 | ieval (St H R (R(d) := a ;; I)) (St H (t_update R (Id d) a) I) 66 | | R_IAdd : forall H R I d s, 67 | ieval (St H R (R(d) +:= R(s) ;; I)) (St H (t_update R (Id d) (aeval (AReg d) R + aeval (AReg s) R)) I) 68 | | R_ISub : forall H R I d v, 69 | ieval (St H R (R(d) -:= v ;; I)) (St H (t_update R (Id d) (aeval (AReg d) R - aeval (ANum v) R)) I) 70 | | R_IJmp_Succ : forall H R I' a l, 71 | l = (aeval a R) -> H (Id l) = Some I' -> ieval (St H R (JMP l)) (St H R I') 72 | | R_IJmpR_Succ : forall H R I' r, 73 | H (Id (R (Id r))) = Some I' -> ieval (St H R (JMP R(r))) (St H R I') 74 | | R_IJmp_Fail : forall H R I a, 75 | H (Id (aeval a R)) = None -> ieval (St H R I) (St H R I) 76 | | R_IIf_EQ : forall H R I I2 r v, 77 | aeval (AReg r) R = 0 -> (H (Id v)) = Some I2 -> ieval (St H R (JIF R(r) v ;; I)) (St H R I2) 78 | | R_IIf_NEQ : forall H R I r v, 79 | aeval (AReg r) R <> 0 -> ieval (St H R (JIF R(r) v ;; I)) (St H R I) 80 | | R_ISeq : forall st st' st'', 81 | ieval st st' -> ieval st' st'' -> ieval st st''. 82 | ``` 83 | 84 | 85 | ##The Type System of TAL-0 86 | 87 | The types consist of 88 | 89 | 1. int -> represents arbitrary integer stored in a register 90 | 91 | 2. reg -> a type constructor. Takes as input, the type of the register, to which this register is pointing. 92 | 93 | 3. code -> takes as input a typing context Gamma, and gives type (code Gamma) which is the type of an instruction sequence that expects type of the Register file to be Gamma before it begins execution 94 | 95 | 4. arrow -> represents type of a single instruction (excluding JMP), which expects register file of type Gamma1 before execution, and changes it to Gamma2 after it has executed. 96 | 97 | 5. True (T in unicode) -> It is the super type. It is used to represent the type of a register in R, which contains the label of the instruction currently executing. Because in such a case, we have the equation : Gamma (r) = code Gamma, which in the absence of subtyping or polymorphic types can't be solved. Hence T is assigned the type for such a register as it subsumes all types including itself. When we jump through a register of type T, we forget the type assigned to it, and reassign T to it. Morrisett's paper uses the polymorphic type for due to some more benefits it affords. However we have used T type for its simplicity. 98 | 99 | ```coq 100 | Inductive ty : Type := 101 | | int : ty 102 | | reg : ty -> ty 103 | | code : partial_map ty -> ty 104 | | arrow : partial_map ty -> partial_map ty -> ty 105 | | True : ty. 106 | ``` 107 | 108 | Contexts are mappings between values and types. For values in Heaps, 109 | their corresponding types are found in Psi, and for values in 110 | Registers, their corresponding types are found in Gamma. 111 | ```coq 112 | Definition context := partial_map ty. 113 | ``` 114 | #Typing Rules 115 | 116 | Psi is a partial map containing types of instruction sequences. As all 117 | instruction sequences end in a JMP statement, all valid values in Psi 118 | are Some (code Gamma) where Gamma is the initial type state of 119 | register expected by that instruction sequence. Now, typing rules may 120 | require presence of either both Psi and Gamma, or only Psi or 121 | neither. Hence, we introduce a combined context structure, that 122 | handles all the 3 cases. 123 | 124 | ```coq 125 | Inductive cmbnd_ctx := 126 | | EmptyCtx : cmbnd_ctx 127 | | PsiCtx : context -> cmbnd_ctx 128 | | PsiGammaCtx : context -> context -> cmbnd_ctx. 129 | ``` 130 | 131 | 133 | 134 | (the above image is taken from Morrisett's paper, defining the typing rules for TAL-0) 135 | 136 | Typing rules for arithmetic expressions : 137 | ```coq 138 | Inductive ahas_type : cmbnd_ctx -> val -> ty -> Prop := 139 | | S_Int : forall Ψ n, 140 | ahas_type (PsiCtx Ψ) (ANum n) int 141 | | S_Lab : forall Ψ Γ l v R, 142 | Ψ (Id l) = Some (code Γ) -> l = aeval (ALab v) R -> ahas_type (PsiCtx Ψ) (ALab v) (code Γ) 143 | | S_Reg : forall Ψ Γ r, 144 | Γ (Id r) = Some (reg int) -> ahas_type (PsiGammaCtx Ψ Γ) (AReg r) (reg int) 145 | | S_RegV : forall Ψ Γ r, 146 | ahas_type (PsiGammaCtx Ψ Γ) (AReg r) (reg (code Γ)) 147 | | S_RegT : forall Ψ Γ r, 148 | ahas_type (PsiGammaCtx Ψ Γ) (AReg r) True 149 | | S_Val : forall Ψ Γ a tau, 150 | ahas_type (PsiCtx Ψ) a tau -> ahas_type (PsiGammaCtx Ψ Γ) a tau. 151 | ``` 152 | 153 | Typing rules for instructions : 154 | ```coq 155 | Inductive ihas_type : cmbnd_ctx -> instr -> ty -> Prop := 156 | | S_Mov : forall Ψ Γ R d a tau, 157 | ahas_type (PsiGammaCtx Ψ Γ) a tau -> ahas_type (PsiGammaCtx Ψ Γ) (AReg d) (reg tau) -> (update Γ (Id d) (reg tau)) = Γ -> ihas_type (PsiCtx Ψ) (R(d) := aeval a R) (arrow Γ Γ) 158 | | S_Add : forall Ψ Γ d s, 159 | ahas_type (PsiGammaCtx Ψ Γ) (AReg s) (reg int) -> ahas_type (PsiGammaCtx Ψ Γ) (AReg d) (reg int) -> update Γ (Id d) (reg int) = Γ -> ihas_type (PsiCtx Ψ) (R(d) +:= R(s)) (arrow Γ Γ) 160 | | S_Sub : forall Ψ Γ s a v, 161 | ahas_type (PsiGammaCtx Ψ Γ) a int -> ahas_type (PsiGammaCtx Ψ Γ) (AReg s) (reg int) -> a = ANum v -> ihas_type (PsiCtx Ψ) (R(s) -:= v) (arrow Γ Γ) 162 | | S_If : forall Ψ Γ r v, 163 | ahas_type (PsiGammaCtx Ψ Γ) (AReg r) (reg int) -> ahas_type (PsiGammaCtx Ψ Γ) (ALab v) (code Γ) -> ihas_type (PsiCtx Ψ) (JIF R(r) v) (arrow Γ Γ). 164 | ``` 165 | 166 | Typing rules for instruction sequences : 167 | ```coq 168 | | S_Jmp : forall Ψ Γ v, 169 | ahas_type (PsiGammaCtx Ψ Γ) (ALab v) (code Γ) -> iseq_has_type (PsiCtx Ψ) (JMP v) (code Γ) 170 | | S_JmpT : forall Ψ Γ v, 171 | ahas_type (PsiGammaCtx Ψ Γ) (AReg v) True -> iseq_has_type (PsiCtx Ψ) (JMP R(v)) (code Γ) 172 | | S_Seq : forall Ψ i1 i2 Γ Γ2, 173 | ihas_type (PsiCtx Ψ) i1 (arrow Γ Γ2) -> iseq_has_type (PsiCtx Ψ) i2 (code Γ2) -> iseq_has_type (PsiCtx Ψ) (ISeq i1 i2) (code Γ). 174 | ``` 175 | 176 | #Typing of Heaps, Registers and validity of machine 177 | We say that machine is OK, i.e. in a valid state iff H has type Psi, R 178 | has type Gamma and current instruction sequence being executed has type "code Gamma". 179 | ```coq 180 | Inductive Rhas_type : cmbnd_ctx -> registers -> context -> Prop := 181 | | S_Regfile : forall Ψ Γ R r tau a, 182 | (Γ (Id r)) = Some tau -> aeval a R = R (Id r) -> ahas_type (PsiGammaCtx Ψ Γ) a tau -> Rhas_type (PsiCtx Ψ) R Γ. 183 | 184 | Inductive Hhas_type : cmbnd_ctx -> heaps -> context -> Prop := 185 | | S_Heap : forall Ψ H, 186 | (forall l tau, exists is, Ψ (Id l) = Some tau /\ H (Id l) = Some is /\ iseq_has_type (PsiCtx Ψ) is tau) -> Hhas_type EmptyCtx H Ψ. 187 | 188 | Inductive M_ok : cmbnd_ctx -> heaps -> registers -> instr_seq -> Prop := 189 | | S_Mach : forall H R Is Ψ Γ, 190 | Hhas_type EmptyCtx H Ψ -> Rhas_type (PsiCtx Ψ) R Γ -> iseq_has_type (PsiCtx Ψ) Is (code Γ) -> M_ok EmptyCtx H R Is. 191 | ``` 192 | 193 | Some canonical values lemmas we will need in proving Soundness of the 194 | type system. 195 | ```coq 196 | Lemma Canonical_Values_Int : forall H Ψ Γ v tau, 197 | Hhas_type EmptyCtx H Ψ -> ahas_type (PsiGammaCtx Ψ Γ) v tau -> tau = int -> exists n, v = ANum n. 198 | 199 | Lemma Canonical_Values_Reg :forall H Ψ Γ r R, Hhas_type EmptyCtx H Ψ -> Rhas_type (PsiCtx Ψ) R Γ -> ahas_type (PsiGammaCtx Ψ Γ) (AReg r) (reg int) -> exists (n : nat), R (Id r) = n. 200 | 201 | Lemma Canonical_Values_label1 : forall H Ψ Γ v, 202 | Hhas_type EmptyCtx H Ψ -> ahas_type (PsiGammaCtx Ψ Γ) (ALab v) (code Γ) -> Ψ (Id v) = Some (code Γ) -> exists is, H (Id v) = Some is /\ iseq_has_type (PsiCtx Ψ) is (code Γ). 203 | 204 | Lemma Canonical_Values_label2 : forall H Ψ Γ R r, 205 | Hhas_type EmptyCtx H Ψ -> ahas_type (PsiGammaCtx Ψ Γ) (AReg r) True -> exists is, H (Id (R (Id r))) = Some is /\ iseq_has_type (PsiCtx Ψ) is (code Γ). 206 | ``` 207 | 208 | Proving safety of the type system requires proving 209 | 210 | 1. Progress : A well typed machine state (M_ok M(H,R,Is)) doesn't get 211 | stuck. eg. It will never try to jump to an arbitrary integer, which we 212 | wanted as part of control flow safety. 213 | 2. Preservation : After each transition to a new machine state 214 | M'(H',R',Is'), the new state is also well typed. 215 | 216 | Hence the soundness theorem is stated as follows : 217 | ```coq 218 | Theorem Soundness : forall H R Is, 219 | M_ok EmptyCtx H R Is -> exists H' R' Is', ieval (St H R Is) (St H' R' Is') /\ M_ok EmptyCtx H' R' Is'. 220 | ``` 221 | 222 | I would like to thank [Chris Casinghino][tyc] for his feedback on the first version of this post. 223 | 224 | 225 | [src]:https://github.com/ankitku/TAL0 226 | 227 | [tyc]:http://tyconmismatch.com/ 228 | 229 | 230 | -------------------------------------------------------------------------------- /TAL.v: -------------------------------------------------------------------------------- 1 | (** * TAL-0 Typed Assembly Language *) 2 | 3 | (** Based on paper by Greg Morrisett , TAL-0 is the design of a RISC-style typed assembly language which focuses on control-flow safety. This post provides a mechanized metatheory, particularly a machine checked proof of soundness of the TAL-0 type system as proposed by the author in section 4.2.10 of the book Advanced Topics in Types and Programming Languages. *) 4 | 5 | (** The TAL-0 language runs on an abstract machine which is represented by 3 components : 6 | 7 | 1. A heap H which is a finite, partial map from labels to heap values 8 | 9 | 2. a register file R which is a total map from registers to values, and 10 | 11 | 3. a current instruction sequence I. 12 | *) 13 | 14 | Require Import Bool Arith Vector. 15 | Require Import LibTactics Maps. 16 | 17 | Definition registers := total_map nat. 18 | Definition empty_regs : registers := t_empty 0. 19 | 20 | Inductive val : Type := 21 | | ANum : nat -> val 22 | | AReg : nat -> val 23 | | ALab : nat -> val. 24 | 25 | (** We denote addresses of instructions stored in the heap as labels. Unlike a typical machine where labels are resolved to some machine address, which are integers, we maintain a distinction between labels and arbit integers, as this complies with our goal to state and prove the control-flow safety i.e. we can only branch to a valid label, and not to any arbit integer. This will ensure that the machine never gets stuck while trying to do some invalid operation. *) 26 | (*define relations for aeval , ieval*) 27 | Fixpoint aeval (a : val) (R : registers) : nat := 28 | match a with 29 | | ANum n => n 30 | | AReg d => R (Id d) 31 | | ALab l => l 32 | end. 33 | 34 | 35 | Inductive instr : Type := 36 | | IMov : forall d : nat, 37 | val -> instr 38 | | IAdd : forall d s : nat, 39 | instr 40 | | ISub : forall d v : nat, 41 | instr 42 | | IIf : forall d : nat, 43 | val -> instr. 44 | 45 | Inductive instr_seq : Type := 46 | | ISeq : instr -> instr_seq -> instr_seq 47 | | IJmp : val -> instr_seq. 48 | 49 | (** Simple Notations are chosen for the sake of clarity while writing programs.*) 50 | Notation "'R(' d ')' ':=' a" := 51 | (IMov d (ANum a)) (at level 60). 52 | Notation "'R(' d ')' '+:=' 'R(' s ')'" := 53 | (IAdd d s) (at level 60). 54 | Notation "'R(' s ')' '-:=' v" := 55 | (ISub s v) (at level 60). 56 | Notation "i1 ;; i2" := 57 | (ISeq i1 i2) (at level 80, right associativity). 58 | Notation "'JIF' 'R(' d ')' v" := 59 | (IIf d (ANum v)) (at level 70). 60 | Notation "'JMP' v" := 61 | (IJmp (ALab v)) (at level 80). 62 | Notation "'JMP' 'R(' r ')'" := 63 | (IJmp (AReg r)) (at level 80). 64 | 65 | Check JIF R(1) 2. 66 | Check R(1) := 10. 67 | Check R(2) +:= R(1). 68 | Check R(2) -:= 1. 69 | Check R(2) +:= R(1) ;; R(2) -:= 1 ;; JMP 2. 70 | Check JMP 2. 71 | Check JMP R(2). 72 | 73 | 74 | Definition heaps := partial_map instr_seq. 75 | Definition empty_heap : heaps := empty. 76 | 77 | (* Machine State *) 78 | Inductive st : Type := 79 | | St : heaps -> registers -> instr_seq -> st. 80 | 81 | (** Evaluation of instructions is supposed to change the Machine State and thus some of its components H, R or I. These changes are posed as relations between initial and final state of the machine. *) 82 | Inductive ieval : st -> st -> Prop := 83 | | R_IMov : forall H R I d a, 84 | ieval (St H R (R(d) := a ;; I)) (St H (t_update R (Id d) a) I) 85 | | R_IAdd : forall H R I d s, 86 | ieval (St H R (R(d) +:= R(s) ;; I)) (St H (t_update R (Id d) (aeval (AReg d) R + aeval (AReg s) R)) I) 87 | | R_ISub : forall H R I d v, 88 | ieval (St H R (R(d) -:= v ;; I)) (St H (t_update R (Id d) (aeval (AReg d) R - aeval (ANum v) R)) I) 89 | | R_IJmp_Succ : forall H R I' a l, 90 | l = (aeval a R) -> H (Id l) = Some I' -> ieval (St H R (JMP l)) (St H R I') 91 | | R_IJmpR_Succ : forall H R I' r, 92 | H (Id (R (Id r))) = Some I' -> ieval (St H R (JMP R(r))) (St H R I') 93 | | R_IJmp_Fail : forall H R I a, 94 | H (Id (aeval a R)) = None -> ieval (St H R I) (St H R I) 95 | | R_IIf_EQ : forall H R I I2 r v, 96 | aeval (AReg r) R = 0 -> (H (Id v)) = Some I2 -> ieval (St H R (JIF R(r) v ;; I)) (St H R I2) 97 | | R_IIf_NEQ : forall H R I r v, 98 | aeval (AReg r) R <> 0 -> ieval (St H R (JIF R(r) v ;; I)) (St H R I) 99 | | R_ISeq : forall st st' st'', 100 | ieval st st' -> ieval st' st'' -> ieval st st''. 101 | 102 | (** Example of a program fragment that multiplies 2 numbers stored in registers 1 and 2 and stores their product in register 3, before finally looping in its final state register 4. *) 103 | Definition init_heap := update (update (update empty_heap (Id 1) (R(3) := 0 ;; JMP 2)) (Id 2) (JIF R(1) 3 ;; R(2) +:= R(3) ;; R(1) -:= 1 ;; JMP 2) ) (Id 3) (JMP R(4)). 104 | 105 | Definition init_regs : registers := (t_update (t_update (t_update (t_update (t_update empty_regs (Id 5) 1) (Id 6) 2) (Id 7) 3) (Id 1) 1) (Id 2) 2). 106 | Definition final_regs : registers := (t_update (t_update (t_update (t_update (t_update (t_update empty_regs (Id 5) 1) (Id 6) 2) (Id 4) 1) (Id 1) 0) (Id 2) 2) (Id 3) 2). 107 | 108 | Eval compute in init_heap (Id (init_regs (Id 6))). 109 | 110 | (* jump to a label proof *) 111 | Example ieval_example1 : ieval (St init_heap init_regs 112 | (R(3) := 0 ;; JMP 2)) 113 | (St init_heap (t_update init_regs (Id 3) 0) 114 | (JIF R(1) 3 ;; R(2) +:= R(3) ;; R(1) -:= 1 ;; JMP 2)). 115 | Proof. 116 | apply R_ISeq with (St init_heap (t_update init_regs (Id 3) 0) (IJmp (ALab 2))). 117 | apply R_IMov. 118 | apply R_IJmp_Succ with (a := ALab 2). 119 | simpl. 120 | reflexivity. 121 | unfold init_heap. 122 | rewrite update_neq. 123 | rewrite update_eq. 124 | reflexivity. 125 | rewrite <- beq_id_false_iff; trivial. 126 | Qed. 127 | 128 | 129 | (** The types consist of 130 | 1. int -> represents arbit integer stored in a register 131 | 132 | 2. reg -> a type constructor. Takes as input, the type of the register, to which this register is pointing. 133 | 134 | 3. code -> takes as input a typing context Γ, and gives type (code Γ) which is the type of an instruction sequence that expects type of the Register file to be Γ before it begins execution 135 | 136 | 4. arrow -> represents type of a single instruction (excluding JMP), which expects register file of type Γ1 before execution, and changes it to Γ2 after it has executed. 137 | 138 | 5. T -> It is the super type. It is used to represent the type of a register in R, which contains the label of the instruction currently executing. Because in such a case, we have the equation : Γ (r) = code Γ, which in the absence of subtyping or polymorphic types can't be solved. Hence T is assigned the type for such a register as it subsumes all types including itself. When we jump through a register of type T, we forget the type assigned to it, and reassign T to it. 139 | Morrisett's paper uses the polymorphic type for due to some more benefits it affords. However we have used T type for its simplicity. 140 | *) 141 | 142 | Inductive ty : Type := 143 | | int : ty 144 | | reg : ty -> ty 145 | | code : partial_map ty -> ty 146 | | arrow : partial_map ty -> partial_map ty -> ty 147 | | True : ty. 148 | 149 | 150 | Definition context := partial_map ty. 151 | 152 | (* register file types *) 153 | Definition empty_Gamma : context := empty. 154 | 155 | (* heap types *) 156 | Definition empty_Psi : context := empty. 157 | 158 | (** The Typing Rules *) 159 | (** Ψ is a partial map containing types of instruction sequences. As all instruction sequences end in a JMP statement, all valid values in Ψ are Some (code Γ) where Γ is the initial type state of register expected by that instruction sequence. Now, typing rules may require presence of either both Ψ and Γ, or only Ψ or neither. Hence, we introduce a combined context structure, that handles all the 3 cases. *) 160 | Inductive cmbnd_ctx := 161 | | EmptyCtx : cmbnd_ctx 162 | | PsiCtx : context -> cmbnd_ctx 163 | | PsiGammaCtx : context -> context -> cmbnd_ctx. 164 | 165 | (** Typing rules for arithmetic expressions *) 166 | Inductive ahas_type : cmbnd_ctx -> val -> ty -> Prop := 167 | | S_Int : forall Ψ n, 168 | ahas_type (PsiCtx Ψ) (ANum n) int 169 | | S_Lab : forall Ψ Γ l v R, 170 | Ψ (Id l) = Some (code Γ) -> l = aeval (ALab v) R -> ahas_type (PsiCtx Ψ) (ALab v) (code Γ) 171 | | S_Reg : forall Ψ Γ r, 172 | Γ (Id r) = Some (reg int) -> ahas_type (PsiGammaCtx Ψ Γ) (AReg r) (reg int) 173 | | S_RegV : forall Ψ Γ r, 174 | ahas_type (PsiGammaCtx Ψ Γ) (AReg r) (reg (code Γ)) 175 | | S_RegT : forall Ψ Γ r, 176 | ahas_type (PsiGammaCtx Ψ Γ) (AReg r) True 177 | | S_Val : forall Ψ Γ a tau, 178 | ahas_type (PsiCtx Ψ) a tau -> ahas_type (PsiGammaCtx Ψ Γ) a tau. 179 | 180 | Hint Constructors ahas_type. 181 | 182 | (** Typing rules for instructions *) 183 | Inductive ihas_type : cmbnd_ctx -> instr -> ty -> Prop := 184 | | S_Mov : forall Ψ Γ R d a tau, 185 | ahas_type (PsiGammaCtx Ψ Γ) a tau -> ahas_type (PsiGammaCtx Ψ Γ) (AReg d) (reg tau) -> (update Γ (Id d) (reg tau)) = Γ -> ihas_type (PsiCtx Ψ) (R(d) := aeval a R) (arrow Γ Γ) 186 | | S_Add : forall Ψ Γ d s, 187 | ahas_type (PsiGammaCtx Ψ Γ) (AReg s) (reg int) -> ahas_type (PsiGammaCtx Ψ Γ) (AReg d) (reg int) -> update Γ (Id d) (reg int) = Γ -> ihas_type (PsiCtx Ψ) (R(d) +:= R(s)) (arrow Γ Γ) 188 | | S_Sub : forall Ψ Γ s a v, 189 | ahas_type (PsiGammaCtx Ψ Γ) a int -> ahas_type (PsiGammaCtx Ψ Γ) (AReg s) (reg int) -> a = ANum v -> ihas_type (PsiCtx Ψ) (R(s) -:= v) (arrow Γ Γ) 190 | | S_If : forall Ψ Γ r v, 191 | ahas_type (PsiGammaCtx Ψ Γ) (AReg r) (reg int) -> ahas_type (PsiGammaCtx Ψ Γ) (ALab v) (code Γ) -> ihas_type (PsiCtx Ψ) (JIF R(r) v) (arrow Γ Γ). 192 | Hint Constructors ihas_type. 193 | 194 | 195 | Inductive iseq_has_type : cmbnd_ctx -> instr_seq -> ty -> Prop := 196 | | S_Jmp : forall Ψ Γ v, 197 | ahas_type (PsiGammaCtx Ψ Γ) (ALab v) (code Γ) -> iseq_has_type (PsiCtx Ψ) (JMP v) (code Γ) 198 | | S_JmpT : forall Ψ Γ v, 199 | ahas_type (PsiGammaCtx Ψ Γ) (AReg v) True -> iseq_has_type (PsiCtx Ψ) (JMP R(v)) (code Γ) 200 | | S_Seq : forall Ψ i1 i2 Γ Γ2, 201 | ihas_type (PsiCtx Ψ) i1 (arrow Γ Γ2) -> iseq_has_type (PsiCtx Ψ) i2 (code Γ2) -> iseq_has_type (PsiCtx Ψ) (ISeq i1 i2) (code Γ). Hint Constructors iseq_has_type. 202 | 203 | 204 | 205 | Definition init_Gamma : context := update (update (update (update empty_Gamma (Id 1) (reg int)) (Id 2) (reg int)) (Id 3) (reg int)) (Id 4) True. 206 | Check init_Gamma. 207 | Hint Unfold init_Gamma. 208 | 209 | Definition init_Psi : context := update (update (update empty_Psi (Id 1) (code init_Gamma))(Id 3) (code init_Gamma)) (Id 2) (code init_Gamma). 210 | Hint Unfold init_Psi. 211 | 212 | 213 | Ltac match_map := repeat (try rewrite update_neq; try rewrite update_eq; try reflexivity). 214 | Ltac inequality := (rewrite <- beq_id_false_iff; trivial). 215 | Ltac crush_map := match_map ; inequality; try reflexivity. 216 | 217 | Ltac rewrite_hyp := 218 | match goal with 219 | | [ H : ?n = _ |- context[?n] ] => rewrite H 220 | end. 221 | 222 | Ltac crush_generic := 223 | repeat match goal with 224 | | [ H : ?T |- ?T ] => exact T 225 | | [ |- ?T = ?T ] => reflexivity 226 | | [ |- True ] => constructor 227 | | [ |- _ /\ _ ] => constructor 228 | | [ |- _ /\ _ -> _ ] => intro 229 | | [ H : _ /\ _ |- _ ] => destruct H 230 | | [ |- nat -> _ ] => intro 231 | | _ => rewrite_hyp || eauto || jauto 232 | end. 233 | 234 | Ltac crush := 235 | repeat (crush_generic; match goal with 236 | | [ |- update _ _ _ _ = _ ] => crush_map 237 | | [ |- init_Gamma _ = _ ] => unfold init_Gamma 238 | | [ |- init_Psi _ = _ ] => unfold init_Psi 239 | | [ |- ieval _ _ ] => constructor; auto 240 | | [ |- ihas_type _ _ _] => constructor; auto 241 | | [ |- ?T -> False ] => assert T 242 | | _ => try subst; trivial 243 | end). 244 | 245 | 246 | 247 | Example heap_2_type : forall I (R : registers), (init_heap (Id 2)) = Some I -> iseq_has_type (PsiCtx init_Psi) I (code init_Gamma). 248 | Proof. 249 | intros. 250 | unfold init_heap in H. 251 | rewrite update_neq in H. 252 | rewrite update_eq in H. 253 | symmetry in H. 254 | inversion H. 255 | apply S_Seq with (Γ2 := init_Gamma). 256 | crush. 257 | constructor; auto. 258 | apply S_Lab with (l := 3) (R := R). 259 | crush. 260 | trivial. 261 | apply S_Seq with (Γ2 := init_Gamma). 262 | constructor; auto. 263 | crush. 264 | apply update_same. 265 | crush. 266 | apply S_Seq with (Γ2 := init_Gamma). 267 | unfold init_Psi. 268 | apply S_Sub with (a := ANum 1). 269 | unfold init_Psi. 270 | constructor; auto. 271 | constructor; auto. 272 | constructor; auto. 273 | constructor; auto. 274 | constructor; auto. 275 | apply S_Lab with (l := 2) (R := R). 276 | crush. 277 | trivial. 278 | trivial. 279 | rewrite <- beq_id_false_iff. 280 | trivial. 281 | Qed. 282 | 283 | (** Typing rule for register file *) 284 | Inductive Rhas_type : cmbnd_ctx -> registers -> context -> Prop := 285 | | S_Regfile : forall Ψ Γ R r tau a, 286 | (Γ (Id r)) = Some tau -> aeval a R = R (Id r) -> ahas_type (PsiGammaCtx Ψ Γ) a tau -> Rhas_type (PsiCtx Ψ) R Γ. 287 | 288 | Hint Constructors Rhas_type. 289 | 290 | (** Typing rule for Heap *) 291 | Inductive Hhas_type : cmbnd_ctx -> heaps -> context -> Prop := 292 | | S_Heap : forall Ψ H, 293 | (forall l tau, exists is, Ψ (Id l) = Some tau /\ H (Id l) = Some is /\ iseq_has_type (PsiCtx Ψ) is tau) -> Hhas_type EmptyCtx H Ψ. 294 | 295 | Hint Constructors Hhas_type. 296 | 297 | (** Typing rule for a valid Machine State *) 298 | Inductive M_ok : cmbnd_ctx -> heaps -> registers -> instr_seq -> Prop := 299 | | S_Mach : forall H R Is Ψ Γ, 300 | Hhas_type EmptyCtx H Ψ -> Rhas_type (PsiCtx Ψ) R Γ -> iseq_has_type (PsiCtx Ψ) Is (code Γ) -> M_ok EmptyCtx H R Is. 301 | 302 | Hint Constructors M_ok. 303 | 304 | (** We will require some Canonical Values Lemmas in our proof of Soundness *) 305 | Lemma Canonical_Values_Int : forall H Ψ Γ v tau, 306 | Hhas_type EmptyCtx H Ψ -> ahas_type (PsiGammaCtx Ψ Γ) v tau -> tau = int -> exists n, v = ANum n. 307 | Proof. 308 | intros. 309 | subst. 310 | inversion H1. 311 | inversion H6. 312 | exists n. 313 | crush. 314 | Qed. 315 | 316 | 317 | Lemma Canonical_Values_Reg :forall H Ψ Γ r R, 318 | Hhas_type EmptyCtx H Ψ -> Rhas_type (PsiCtx Ψ) R Γ -> ahas_type (PsiGammaCtx Ψ Γ) (AReg r) (reg int) -> exists (n : nat), R (Id r) = n. 319 | Proof. 320 | intros. 321 | exists (R (Id r)). 322 | crush. 323 | Qed. 324 | 325 | Lemma Canonical_Values_label1 : forall H Ψ Γ v, 326 | Hhas_type EmptyCtx H Ψ -> ahas_type (PsiGammaCtx Ψ Γ) (ALab v) (code Γ) -> Ψ (Id v) = Some (code Γ) -> exists is, H (Id v) = Some is /\ iseq_has_type (PsiCtx Ψ) is (code Γ). 327 | Proof. 328 | intros. 329 | inversion H0. 330 | inversion H1. 331 | inversion H7. 332 | simpl in H5. 333 | specialize H4 with ( l := v) (tau := code Γ). 334 | destruct H4 as [i G]. 335 | exists i. 336 | crush. 337 | Qed. 338 | 339 | Lemma Canonical_Values_label2 : forall H Ψ Γ R r, 340 | Hhas_type EmptyCtx H Ψ -> ahas_type (PsiGammaCtx Ψ Γ) (AReg r) True -> exists is, H (Id (R (Id r))) = Some is /\ iseq_has_type (PsiCtx Ψ) is (code Γ). 341 | Proof. 342 | intros. 343 | inversion H0. 344 | inversion H1. 345 | specialize H3 with ( l := R (Id r)) (tau := (code Γ)). 346 | destruct H3 as [i G]. 347 | exists i. 348 | apply G. 349 | specialize H3 with ( l := R (Id r)) (tau := (code Γ)). 350 | destruct H3 as [i G]. 351 | exists i. 352 | crush. 353 | Qed. 354 | 355 | (** Finally the proof of Soundness *) 356 | Theorem Soundness : forall H R Is, 357 | M_ok EmptyCtx H R Is -> exists H' R' Is', ieval (St H R Is) (St H' R' Is') /\ M_ok EmptyCtx H' R' Is'. 358 | Proof. 359 | intros. 360 | inversion H0 ; induction Is; inverts H4. 361 | induction i; inversion H12; 362 | try match goal with 363 | | [H : Γ = Γ2 |- _ ] => symmetry in H 364 | end; 365 | try subst. 366 | 367 | 368 | (* ISeq IMov I *) 369 | exists H (t_update R (Id d) (aeval a R1)) Is. 370 | crush. 371 | apply S_Mach with (Ψ := Ψ) (Γ := Γ). 372 | crush. 373 | apply S_Regfile with (r := d) (tau := reg tau) (a := AReg d). 374 | rewrite <- H16. 375 | rewrite update_eq. 376 | crush. 377 | crush. 378 | crush. 379 | crush. 380 | 381 | (* ISeq IAdd I *) 382 | exists H (t_update R (Id d) (aeval (AReg d) R + aeval (AReg s) R)) Is. 383 | split. 384 | crush. 385 | apply S_Mach with (Ψ := Ψ) (Γ := Γ). 386 | crush. 387 | apply S_Regfile with (a := AReg d) (r := d) (tau := reg int). 388 | rewrite <- H16; apply update_eq. 389 | crush. 390 | crush. 391 | crush. 392 | 393 | (* ISeq ISub I *) 394 | exists H (t_update R (Id d) (aeval (AReg d) R - aeval (ANum v) R)) Is. 395 | split. 396 | crush. 397 | apply S_Mach with (Ψ := Ψ) (Γ := Γ). 398 | crush. 399 | apply S_Regfile with (a := AReg d) (r := d) (tau := reg int). 400 | inversion H15. 401 | crush. 402 | crush. 403 | inversion H15. 404 | crush. 405 | inversion H7. 406 | trivial. 407 | crush. 408 | crush. 409 | 410 | (* ISeq IIf I *) 411 | inversion H12. 412 | inversion H9. 413 | inversion H18. 414 | subst. 415 | simpl in H22. 416 | 417 | remember (R (Id d)) as rd; destruct rd. 418 | pose proof Canonical_Values_label1 H Ψ Γ v0 H2 H9 H22 as CVL1. 419 | destruct CVL1 as [Is' G]. 420 | exists H R Is'. 421 | crush. 422 | 423 | exists H R Is. 424 | 425 | split. 426 | apply R_IIf_NEQ. 427 | simpl. 428 | symmetry in Heqrd; rewrite Heqrd. 429 | apply beq_nat_false_iff. 430 | trivial. 431 | crush. 432 | 433 | (*IJmp*) 434 | inversion H11; inversion H12. 435 | simpl in H17. 436 | subst. 437 | pose proof Canonical_Values_label1 H Ψ Γ v0 H2 H11 H16 as CVL1. 438 | destruct CVL1 as [Is G]. 439 | 440 | exists H R Is. 441 | crush. 442 | apply R_IJmp_Succ with (a := ALab v0). 443 | crush. 444 | crush. 445 | 446 | (*IJmpT*) 447 | pose proof Canonical_Values_label2 H Ψ Γ R v0 H2 H11 as CVL3. 448 | destruct CVL3 as [Is G]. 449 | 450 | exists H R Is. 451 | crush. 452 | Qed. 453 | --------------------------------------------------------------------------------