From c903c1df31641a0196d3119928a273290fe2d158 Mon Sep 17 00:00:00 2001 From: jutaro Date: Wed, 5 Sep 2018 12:12:01 +0200 Subject: [PATCH 01/30] Started to port Smallstep. --- src/Smallstep.lidr | 1681 ++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 1681 insertions(+) create mode 100644 src/Smallstep.lidr diff --git a/src/Smallstep.lidr b/src/Smallstep.lidr new file mode 100644 index 0000000..b964db1 --- /dev/null +++ b/src/Smallstep.lidr @@ -0,0 +1,1681 @@ += Library Smallstep + +== Smallstep: Small-step Operational Semantics + +> module Smallstep +> %access public export +> %default total + +The evaluators we have seen so far (for [aexp]s, [bexp]s, +commands, ...) have been formulated in a "big-step" style: they +specify how a given expression can be evaluated to its final +value (or a command plus a store to a final store) "all in one big +step." + +This style is simple and natural for many purposes -- indeed, +Gilles Kahn, who popularized it, called it _natural semantics_. +But there are some things it does not do well. In particular, it +does not give us a natural way of talking about _concurrent_ +programming languages, where the semantics of a program -- i.e., +the essence of how it behaves -- is not just which input states +get mapped to which output states, but also includes the +intermediate states that it passes through along the way, since +these states can also be observed by concurrently executing code. + +Another shortcoming of the big-step style is more technical, but +critical in many situations. Suppose we want to define a variant +of Imp where variables could hold _either_ numbers _or_ lists of +numbers. In the syntax of this extended language, it will be +possible to write strange expressions like [2 + nil], and our +semantics for arithmetic expressions will then need to say +something about how such expressions behave. One possibility is +to maintain the convention that every arithmetic expressions +evaluates to some number by choosing some way of viewing a list as +a number -- e.g., by specifying that a list should be interpreted +as [0] when it occurs in a context expecting a number. But this +is really a bit of a hack. + +A much more natural approach is simply to say that the behavior of +an expression like [2+nil] is _undefined_ -- i.e., it doesn't +evaluate to any result at all. And we can easily do this: we just +have to formulate [aeval] and [beval] as [Inductive] propositions +rather than Fixpoints, so that we can make them partial functions +instead of total ones. + +Now, however, we encounter a serious deficiency. In this +language, a command might fail to map a given starting state to +any ending state for _two quite different reasons_: either because +the execution gets into an infinite loop or because, at some +point, the program tries to do an operation that makes no sense, +such as adding a number to a list, so that none of the evaluation +rules can be applied. + +These two outcomes -- nontermination vs. getting stuck in an +erroneous configuration -- should not be confused. In particular, we +want to _allow_ the first (permitting the possibility of infinite +loops is the price we pay for the convenience of programming with +general looping constructs like [while]) but _prevent_ the +second (which is just wrong), for example by adding some form of +_typechecking_ to the language. Indeed, this will be a major +topic for the rest of the course. As a first step, we need a way +of presenting the semantics that allows us to distinguish +nontermination from erroneous "stuck states." + +So, for lots of reasons, we'd often like to have a finer-grained +way of defining and reasoning about program behaviors. This is +the topic of the present chapter. Our goal is to replace the +"big-step" [eval] relation with a "small-step" relation that +specifies, for a given program, how the "atomic steps" of +computation are performed. + +== A Toy Language + +To save space in the discussion, let's go back to an +incredibly simple language containing just constants and +addition. (We use single letters -- [C] and [P] (for Constant and +Plus) -- as constructor names, for brevity.) At the end of the +chapter, we'll see how to apply the same techniques to the full +Imp language. + +> data Tm : Type where +> C : Nat -> Tm -- Constant +> P : Tm -> Tm -> Tm -- Plus + +(** Here is a standard evaluator for this language, written in + the big-step style that we've been using up to this point. *) + +> evalF : (t : Tm) -> Nat +> evalF (C n) = n +> evalF (P a1 a2) = evalF a1 + evalF a2 + +(** Here is the same evaluator, written in exactly the same + style, but formulated as an inductively defined relation. Again, + we use the notation [t \\ n] for "[t] evaluates to [n]." *) +(** + + -------- (E_Const) + C n \\ n + + t1 \\ n1 + t2 \\ n2 + ------------------ (E_Plus) + P t1 t2 \\ n1 + n2 +*) + +> mutual +> infixl 6 # +> (#) : Tm -> Nat -> Type +> (#) = Eval +> +> data Eval : Tm -> Nat -> Type where +> E_Const : C n # n +> E_Plus : t1 # n1 -> t2 # n2 -> P t1 t2 # n1 + n2 +> + +> namespace SimpleArith1 + +(** Now, here is the corresponding _small-step_ evaluation relation. *) +(** + ------------------------------- (ST_PlusConstConst) + P (C n1) (C n2) ==> C (n1 + n2) + + t1 ==> t1' + -------------------- (ST_Plus1) + P t1 t2 ==> P t1' t2 + + t2 ==> t2' + --------------------------- (ST_Plus2) + P (C n1) t2 ==> P (C n1) t2' +*) + +> mutual +> infixl 6 >=> +> (>=>) : Tm -> Tm -> Type +> (>=>) = Step +> +> data Step : Tm -> Tm -> Type where +> ST_PlusConstConst : P (C n1) (C n2) >=> C (n1 + n2) +> ST_Plus1 : t1 >=> t1' -> P t1 t2 >=> P t1' t2 +> ST_Plus2 : t2 >=> t2' -> P (C n1) t2 >=> P (C n1) t2' +> + +(** Things to notice: + + - We are defining just a single reduction step, in which + one [P] node is replaced by its value. + + - Each step finds the _leftmost_ [P] node that is ready to + go (both of its operands are constants) and rewrites it in + place. The first rule tells how to rewrite this [P] node + itself; the other two rules tell how to find it. + + - A term that is just a constant cannot take a step. *) + +(** Let's pause and check a couple of examples of reasoning with + the [step] relation... *) + +(** If [t1] can take a step to [t1'], then [P t1 t2] steps + to [P t1' t2]: *) + +> test_step_1 : +> P +> (P (C 0) (C 3)) +> (P (C 2) (C 4)) +> >=> +> P +> (C (0 + 3)) +> (P (C 2) (C 4)) +> test_step_1 = ST_Plus1 ST_PlusConstConst + +(** **** Exercise: 1 star (test_step_2) *) +(** Right-hand sides of sums can take a step only when the + left-hand side is finished: if [t2] can take a step to [t2'], + then [P (C n) t2] steps to [P (C n) + t2']: *) + +> test_step_2 : +> P +> (C 0) +> (P +> (C 2) +> (P (C 0) (C 3))) +> >=> +> P +> (C 0) +> (P +> (C 2) +> (C (0 + 3))) +> test_step_2 = ST_Plus2 (ST_Plus2 ST_PlusConstConst) + + +(* ################################################################# *) +(** * Relations *) + +(** We will be working with several different single-step relations, + so it is helpful to generalize a bit and state a few definitions + and theorems about relations in general. (The optional chapter + [Rel.v] develops some of these ideas in a bit more detail; it may + be useful if the treatment here is too dense.) + + A _binary relation_ on a set [X] is a family of propositions + parameterized by two elements of [X] -- i.e., a proposition about + pairs of elements of [X]. *) + +> Relation : Type -> Type +> Relation t = t -> t -> Type + +(** Our main examples of such relations in this chapter will be + the single-step reduction relation, [==>], and its multi-step + variant, [==>*] (defined below), but there are many other + examples -- e.g., the "equals," "less than," "less than or equal + to," and "is the square of" relations on numbers, and the "prefix + of" relation on lists and strings. *) + +(** One simple property of the [==>] relation is that, like the + big-step evaluation relation for Imp, it is _deterministic_. + + _Theorem_: For each [t], there is at most one [t'] such that [t] + steps to [t'] ([t ==> t'] is provable). This is the + same as saying that [==>] is deterministic. *) + +(** _Proof sketch_: We show that if [x] steps to both [y1] and + [y2], then [y1] and [y2] are equal, by induction on a derivation + of [step x y1]. There are several cases to consider, depending on + the last rule used in this derivation and the last rule in the + given derivation of [step x y2]. + + - If both are [ST_PlusConstConst], the result is immediate. + + - The cases when both derivations end with [ST_Plus1] or + [ST_Plus2] follow by the induction hypothesis. + + - It cannot happen that one is [ST_PlusConstConst] and the other + is [ST_Plus1] or [ST_Plus2], since this would imply that [x] + has the form [P t1 t2] where both [t1] and [t2] are + constants (by [ST_PlusConstConst]) _and_ one of [t1] or [t2] + has the form [P _]. + + - Similarly, it cannot happen that one is [ST_Plus1] and the + other is [ST_Plus2], since this would imply that [x] has the + form [P t1 t2] where [t1] has both the form [P t11 t12] and the + form [C n]. [] *) + +(** Formally: *) + + +> deterministic : {xt: Type} -> (r: Relation xt) -> Type +> deterministic {xt} r = {x, y1, y2: xt} -> r x y1 -> r x y2 -> y1 = y2 + +> namespace SimpleArith2 + +> step_deterministic : deterministic Step +> step_deterministic ST_PlusConstConst hyp = +> case hyp of +> ST_PlusConstConst => Refl +> ST_Plus1 _ impossible +> ST_Plus2 _ impossible +> step_deterministic (ST_Plus1 l) hyp = +> case hyp of +> ST_PlusConstConst impossible +> ST_Plus1 l' => rewrite step_deterministic l l' in Refl +> ST_Plus2 _ impossible +> step_deterministic (ST_Plus2 r) hyp = +> case hyp of +> ST_PlusConstConst impossible +> ST_Plus1 _ impossible +> ST_Plus2 r' => rewrite step_deterministic r r' in Refl + +(* ================================================================= *) +(** ** Values *) + +(** Next, it will be useful to slightly reformulate the + definition of single-step reduction by stating it in terms of + "values." *) + +(** It is useful to think of the [==>] relation as defining an + _abstract machine_: + + - At any moment, the _state_ of the machine is a term. + + - A _step_ of the machine is an atomic unit of computation -- + here, a single "add" operation. + + - The _halting states_ of the machine are ones where there is no + more computation to be done. *) + +(** We can then execute a term [t] as follows: + + - Take [t] as the starting state of the machine. + + - Repeatedly use the [==>] relation to find a sequence of + machine states, starting with [t], where each state steps to + the next. + + - When no more reduction is possible, "read out" the final state + of the machine as the result of execution. *) + +(** Intuitively, it is clear that the final states of the + machine are always terms of the form [C n] for some [n]. + We call such terms _values_. *) + +> data Value : Tm -> Type where +> V_const : (n : Nat) -> Value (C n) +> + +(** Having introduced the idea of values, we can use it in the + definition of the [==>] relation to write [ST_Plus2] rule in a + slightly more elegant way: *) + +(** + ------------------------------- (ST_PlusConstConst) + P (C n1) (C n2) ==> C (n1 + n2) + + t1 ==> t1' + -------------------- (ST_Plus1) + P t1 t2 ==> P t1' t2 + + value v1 + t2 ==> t2' + -------------------- (ST_Plus2) + P v1 t2 ==> P v1 t2' +*) +(** Again, the variable names here carry important information: + by convention, [v1] ranges only over values, while [t1] and [t2] + range over arbitrary terms. (Given this convention, the explicit + [value] hypothesis is arguably redundant. We'll keep it for now, + to maintain a close correspondence between the informal and Coq + versions of the rules, but later on we'll drop it in informal + rules for brevity.) *) + +(** Here are the formal rules: *) + +> mutual +> infixl 6 >>> +> (>>>) : Tm -> Tm -> Type +> (>>>) = Smallstep.Step +> +> data Step : Tm -> Tm -> Type where +> ST_PlusConstConst : P (C n1) (C n2) >>> C (n1 + n2) +> ST_Plus1 : t1 >>> t1' -> P t1 t2 >>> P t1' t2 +> ST_Plus2 : Value v1 -> t2 >>> t2' -> P v1 t2 >>> P v1 t2' + +(** **** Exercise: 3 stars, recommended (redo_determinism) *) +(** As a sanity check on this change, let's re-verify determinism. + + _Proof sketch_: We must show that if [x] steps to both [y1] and + [y2], then [y1] and [y2] are equal. Consider the final rules used + in the derivations of [step x y1] and [step x y2]. + + - If both are [ST_PlusConstConst], the result is immediate. + + - It cannot happen that one is [ST_PlusConstConst] and the other + is [ST_Plus1] or [ST_Plus2], since this would imply that [x] has + the form [P t1 t2] where both [t1] and [t2] are constants (by + [ST_PlusConstConst]) _and_ one of [t1] or [t2] has the form [P _]. + + - Similarly, it cannot happen that one is [ST_Plus1] and the other + is [ST_Plus2], since this would imply that [x] has the form [P + t1 t2] where [t1] both has the form [P t11 t12] and is a + value (hence has the form [C n]). + + - The cases when both derivations end with [ST_Plus1] or + [ST_Plus2] follow by the induction hypothesis. [] *) + +(** Most of this proof is the same as the one above. But to get + maximum benefit from the exercise you should try to write your + formal version from scratch and just use the earlier one if you + get stuck. *) + +Theorem step_deterministic : + deterministic step. +Proof. + (* FILL IN HERE *) Admitted. +(** [] *) + +(* ================================================================= *) +(** ** Strong Progress and Normal Forms *) + +(** The definition of single-step reduction for our toy language + is fairly simple, but for a larger language it would be easy to + forget one of the rules and accidentally create a situation where + some term cannot take a step even though it has not been + completely reduced to a value. The following theorem shows that + we did not, in fact, make such a mistake here. *) + +(** _Theorem_ (_Strong Progress_): If [t] is a term, then either [t] + is a value or else there exists a term [t'] such that [t ==> t']. *) + +(** _Proof_: By induction on [t]. + + - Suppose [t = C n]. Then [t] is a value. + + - Suppose [t = P t1 t2], where (by the IH) [t1] either is a value + or can step to some [t1'], and where [t2] is either a value or + can step to some [t2']. We must show [P t1 t2] is either a value + or steps to some [t']. + + - If [t1] and [t2] are both values, then [t] can take a step, by + [ST_PlusConstConst]. + + - If [t1] is a value and [t2] can take a step, then so can [t], + by [ST_Plus2]. + + - If [t1] can take a step, then so can [t], by [ST_Plus1]. [] + + Or, formally: *) + +> strong_progress : (t: Tm) -> Either (Value t) (t': Tm ** Smallstep.Step t t') +> strong_progress (C n) = Left (V_const n) +> strong_progress (P (C n) r) = Right $ +> case r of +> (C n') => (C (n + n') ** ST_PlusConstConst) +> (P l' r') => case strong_progress (P l' r') of +> Right (r ** prf1) => (P (C n) r ** ST_Plus2 (V_const n) prf1) +> Left (V_const (Smallstep.P l r)) impossible +> strong_progress (P (P l' r') r) = Right $ +> case strong_progress (P l' r') of +> Right (l ** prf1) => (P l r ** ST_Plus1 prf1) +> Left (V_const (Smallstep.P l r)) impossible + +(** This important property is called _strong progress_, because + every term either is a value or can "make progress" by stepping to + some other term. (The qualifier "strong" distinguishes it from a + more refined version that we'll see in later chapters, called + just _progress_.) *) + +(** The idea of "making progress" can be extended to tell us something + interesting about values: in this language, values are exactly the + terms that _cannot_ make progress in this sense. + + To state this observation formally, let's begin by giving a name + to terms that cannot make progress. We'll call them _normal + forms_. *) + +> normal_form : {X:Type} -> Relation X -> X -> Type +> normal_form r t = Not (t' ** r t t') + +(** Note that this definition specifies what it is to be a normal form + for an _arbitrary_ relation [R] over an arbitrary set [X], not + just for the particular single-step reduction relation over terms + that we are interested in at the moment. We'll re-use the same + terminology for talking about other relations later in the + course. *) + +(** We can use this terminology to generalize the observation we made + in the strong progress theorem: in this language, normal forms and + values are actually the same thing. *) + +> value_is_nf : (v : Tm) -> Value v -> normal_form Smallstep.Step v +> value_is_nf (C n) prf = notStepCN +> where notStepCN: (t' : Tm ** Smallstep.Step (C n) t') -> Void +> notStepCN (t' ** c) impossible +> value_is_nf (P l r) prf = void (notValueP prf) +> where notValueP: Not (Value (P l r)) +> notValueP (V_const _) impossible + +> nf_is_value : (v : Tm) -> normal_form Smallstep.Step v -> Value v +> nf_is_value (C n) prf = V_const n +> nf_is_value (P l r) prf = +> case strong_progress (P l r) of +> Left va => va +> Right pa => void (prf pa) + +> iff : {p,q : Type} -> Type +> iff {p} {q} = (p -> q, q -> p) + +> syntax [p] "<->" [q] = iff {p} {q} + +> nf_same_as_value : (normal_form Smallstep.Step t) <-> (Value t) +> nf_same_as_value {t} = (nf_is_value t,value_is_nf t) + +(** Why is this interesting? + + Because [value] is a syntactic concept -- it is defined by looking + at the form of a term -- while [normal_form] is a semantic one -- + it is defined by looking at how the term steps. It is not obvious + that these concepts should coincide! *) + +(** Indeed, we could easily have written the definitions so that they + would _not_ coincide. *) + +(** **** Exercise: 3 stars, optional (value_not_same_as_normal_form1) *) +(** We might, for example, mistakenly define [value] so that it + includes some terms that are not finished reducing. *) +(** (Even if you don't work this exercise and the following ones + in Coq, make sure you can think of an example of such a term.) *) + +Module Temp1. + +Inductive value : tm -> Prop := +| v_const : forall n, value (C n) +| v_funny : forall t1 n2, (* <---- *) + value (P t1 (C n2)). + +Reserved Notation " t '==>' t' " (at level 40). + +Inductive step : tm -> tm -> Prop := + | ST_PlusConstConst : forall n1 n2, + P (C n1) (C n2) ==> C (n1 + n2) + | ST_Plus1 : forall t1 t1' t2, + t1 ==> t1' -> + P t1 t2 ==> P t1' t2 + | ST_Plus2 : forall v1 t2 t2', + value v1 -> + t2 ==> t2' -> + P v1 t2 ==> P v1 t2' + + where " t '==>' t' " := (step t t'). + +Lemma value_not_same_as_normal_form : + exists v, value v /\ ~ normal_form step v. +Proof. + (* FILL IN HERE *) Admitted. +End Temp1. + +(** [] *) + +(** **** Exercise: 2 stars, optional (value_not_same_as_normal_form2) *) +(** Alternatively, we might mistakenly define [step] so that it + permits something designated as a value to reduce further. *) + +Module Temp2. + +Inductive value : tm -> Prop := +| v_const : forall n, value (C n). + +Reserved Notation " t '==>' t' " (at level 40). + +Inductive step : tm -> tm -> Prop := + | ST_Funny : forall n, (* <---- *) + C n ==> P (C n) (C 0) + | ST_PlusConstConst : forall n1 n2, + P (C n1) (C n2) ==> C (n1 + n2) + | ST_Plus1 : forall t1 t1' t2, + t1 ==> t1' -> + P t1 t2 ==> P t1' t2 + | ST_Plus2 : forall v1 t2 t2', + value v1 -> + t2 ==> t2' -> + P v1 t2 ==> P v1 t2' + + where " t '==>' t' " := (step t t'). + +Lemma value_not_same_as_normal_form : + exists v, value v /\ ~ normal_form step v. +Proof. + (* FILL IN HERE *) Admitted. + +End Temp2. +(** [] *) + +(** **** Exercise: 3 stars, optional (value_not_same_as_normal_form3) *) +(** Finally, we might define [value] and [step] so that there is some + term that is not a value but that cannot take a step in the [step] + relation. Such terms are said to be _stuck_. In this case this is + caused by a mistake in the semantics, but we will also see + situations where, even in a correct language definition, it makes + sense to allow some terms to be stuck. *) + +Module Temp3. + +Inductive value : tm -> Prop := + | v_const : forall n, value (C n). + +Reserved Notation " t '==>' t' " (at level 40). + +Inductive step : tm -> tm -> Prop := + | ST_PlusConstConst : forall n1 n2, + P (C n1) (C n2) ==> C (n1 + n2) + | ST_Plus1 : forall t1 t1' t2, + t1 ==> t1' -> + P t1 t2 ==> P t1' t2 + + where " t '==>' t' " := (step t t'). + +(** (Note that [ST_Plus2] is missing.) *) + +Lemma value_not_same_as_normal_form : + exists t, ~ value t /\ normal_form step t. +Proof. + (* FILL IN HERE *) Admitted. + +End Temp3. +(** [] *) + +(* ----------------------------------------------------------------- *) +(** *** Additional Exercises *) + +Module Temp4. + +(** Here is another very simple language whose terms, instead of being + just addition expressions and numbers, are just the booleans true + and false and a conditional expression... *) + +Inductive tm : Type := + | ttrue : tm + | tfalse : tm + | tif : tm -> tm -> tm -> tm. + +Inductive value : tm -> Prop := + | v_true : value ttrue + | v_false : value tfalse. + +Reserved Notation " t '==>' t' " (at level 40). + +Inductive step : tm -> tm -> Prop := + | ST_IfTrue : forall t1 t2, + tif ttrue t1 t2 ==> t1 + | ST_IfFalse : forall t1 t2, + tif tfalse t1 t2 ==> t2 + | ST_If : forall t1 t1' t2 t3, + t1 ==> t1' -> + tif t1 t2 t3 ==> tif t1' t2 t3 + + where " t '==>' t' " := (step t t'). + +(** **** Exercise: 1 star (smallstep_bools) *) +(** Which of the following propositions are provable? (This is just a + thought exercise, but for an extra challenge feel free to prove + your answers in Coq.) *) + +Definition bool_step_prop1 := + tfalse ==> tfalse. + +(* FILL IN HERE *) + +Definition bool_step_prop2 := + tif + ttrue + (tif ttrue ttrue ttrue) + (tif tfalse tfalse tfalse) + ==> + ttrue. + +(* FILL IN HERE *) + +Definition bool_step_prop3 := + tif + (tif ttrue ttrue ttrue) + (tif ttrue ttrue ttrue) + tfalse + ==> + tif + ttrue + (tif ttrue ttrue ttrue) + tfalse. + +(* FILL IN HERE *) +(** [] *) + +(** **** Exercise: 3 stars, optional (progress_bool) *) +(** Just as we proved a progress theorem for plus expressions, we can + do so for boolean expressions, as well. *) + +Theorem strong_progress : forall t, + value t \/ (exists t', t ==> t'). +Proof. + (* FILL IN HERE *) Admitted. +(** [] *) + +(** **** Exercise: 2 stars, optional (step_deterministic) *) +Theorem step_deterministic : + deterministic step. +Proof. + (* FILL IN HERE *) Admitted. +(** [] *) + +Module Temp5. + +(** **** Exercise: 2 stars (smallstep_bool_shortcut) *) +(** Suppose we want to add a "short circuit" to the step relation for + boolean expressions, so that it can recognize when the [then] and + [else] branches of a conditional are the same value (either + [ttrue] or [tfalse]) and reduce the whole conditional to this + value in a single step, even if the guard has not yet been reduced + to a value. For example, we would like this proposition to be + provable: + + tif + (tif ttrue ttrue ttrue) + tfalse + tfalse + ==> + tfalse. +*) + +(** Write an extra clause for the step relation that achieves this + effect and prove [bool_step_prop4]. *) + +Reserved Notation " t '==>' t' " (at level 40). + +Inductive step : tm -> tm -> Prop := + | ST_IfTrue : forall t1 t2, + tif ttrue t1 t2 ==> t1 + | ST_IfFalse : forall t1 t2, + tif tfalse t1 t2 ==> t2 + | ST_If : forall t1 t1' t2 t3, + t1 ==> t1' -> + tif t1 t2 t3 ==> tif t1' t2 t3 + (* FILL IN HERE *) + + where " t '==>' t' " := (step t t'). + +Definition bool_step_prop4 := + tif + (tif ttrue ttrue ttrue) + tfalse + tfalse + ==> + tfalse. + +Example bool_step_prop4_holds : + bool_step_prop4. +Proof. + (* FILL IN HERE *) Admitted. +(** [] *) + +(** **** Exercise: 3 stars, optional (properties_of_altered_step) *) +(** It can be shown that the determinism and strong progress theorems + for the step relation in the lecture notes also hold for the + definition of step given above. After we add the clause + [ST_ShortCircuit]... + + - Is the [step] relation still deterministic? Write yes or no and + briefly (1 sentence) explain your answer. + + Optional: prove your answer correct in Coq. *) + +(* FILL IN HERE *) +(** + - Does a strong progress theorem hold? Write yes or no and + briefly (1 sentence) explain your answer. + + Optional: prove your answer correct in Coq. +*) + +(* FILL IN HERE *) +(** + - In general, is there any way we could cause strong progress to + fail if we took away one or more constructors from the original + step relation? Write yes or no and briefly (1 sentence) explain + your answer. + +(* FILL IN HERE *) +*) +(** [] *) + +End Temp5. +End Temp4. + +-- Multi-Step Reduction + +We've been working so far with the _single-step reduction_ +relation [==>], which formalizes the individual steps of an +abstract machine for executing programs. + +We can use the same machine to reduce programs to completion -- to +find out what final result they yield. This can be formalized as +follows: + +- First, we define a _multi-step reduction relation_ [==>*], which + relates terms [t] and [t'] if [t] can reach [t'] by any number + (including zero) of single reduction steps. + +- Then we define a "result" of a term [t] as a normal form that + [t] can reach by multi-step reduction. + + +Since we'll want to reuse the idea of multi-step reduction many +times, let's take a little extra trouble and define it +generically. + +Given a relation [R], we define a relation [multi R], called the +multi-step closure of [R]_ as follows. + +> data Multi: {X: Type} -> (R: Relation X) -> (x: X) -> (y : X) -> Type where +> Multi_refl : {X: Type} -> {R: Relation X} -> {x : X} -> Multi R x x +> Multi_step : {X: Type} -> {R: Relation X} -> {x, y, z : X} -> R x y -> Multi R y z -> Multi R x z. + +Inductive multi {X:Type} (R: relation X) : relation X := + | multi_refl : forall (x : X), multi R x x + | multi_step : forall (x y z : X), + R x y -> + multi R y z -> + multi R x z. + +(In the [Rel] chapter of _Logical Foundations_ and +the Coq standard library, this relation is called +[clos_refl_trans_1n]. We give it a shorter name here for the sake +of readability.) + +The effect of this definition is that [multi R] relates two +elements [x] and [y] if + + - [x = y], or + - [R x y], or + - there is some nonempty sequence [z1], [z2], ..., [zn] such that + + R x z1 + R z1 z2 + ... + R zn y. + + Thus, if [R] describes a single-step of computation, then [z1]...[zn] + is the sequence of intermediate steps of computation between [x] and + [y]. *) + +(** We write [==>*] for the [multi step] relation on terms. *) + +Notation " t '==>*' t' " := (multi step t t') (at level 40). + +> syntax [t] "==>*" [t'] = Multi Smallstep.Step t t' + +(** The relation [multi R] has several crucial properties. + + First, it is obviously _reflexive_ (that is, [forall x, multi R x + x]). In the case of the [==>*] (i.e., [multi step]) relation, the + intuition is that a term can execute to itself by taking zero + steps of execution. + + Second, it contains [R] -- that is, single-step executions are a + particular case of multi-step executions. (It is this fact that + justifies the word "closure" in the term "multi-step closure of + [R].") *) + +Theorem multi_R : forall (X:Type) (R:relation X) (x y : X), + R x y -> (multi R) x y. +Proof. + intros X R x y H. + apply multi_step with y. apply H. apply multi_refl. Qed. + +> multi_R: {X: Type} -> {R: Relation X} -> (x,y: X) -> R x y -> (Multi R) x y +> multi_R x y h = Multi_step h (Multi_refl) + +(** Third, [multi R] is _transitive_. *) + +> multi_trans: {X:Type} -> {R: Relation X} -> (x, y, z : X) -> +> Multi R x y -> Multi R y z -> Multi R x z +> multi_trans _ _ _ m1 m2 = +> case m1 of +> Multi_refl => m2 +> Multi_step r _ => Multi_step r Multi_refl + +Theorem multi_trans : + forall (X:Type) (R: relation X) (x y z : X), + multi R x y -> + multi R y z -> + multi R x z. +Proof. + intros X R x y z G H. + induction G. + - (* multi_refl *) assumption. + - (* multi_step *) + apply multi_step with y. assumption. + apply IHG. assumption. Qed. + +(** In particular, for the [multi step] relation on terms, if + [t1==>*t2] and [t2==>*t3], then [t1==>*t3]. *) + +(* ================================================================= *) +(** ** Examples *) + +(** Here's a specific instance of the [multi step] relation: *) + +> test_multistep_1: +> (P +> (P (C 0) (C 3)) +> (P (C 2) (C 4))) +> ==>* +> C ((0 + 3) + (2 + 4)) +> test_multistep_1 = +> let z = C ((0 + 3) + (2 + 4)) +> in Multi_step {z=z} (ST_Plus1 ST_PlusConstConst) +> (Multi_step {z=z} (ST_Plus2 (V_const 3) ST_PlusConstConst) +> (Multi_step ST_PlusConstConst Multi_refl)) + +Lemma test_multistep_1: + P + (P (C 0) (C 3)) + (P (C 2) (C 4)) + ==>* + C ((0 + 3) + (2 + 4)). +Proof. + apply multi_step with + (P (C (0 + 3)) + (P (C 2) (C 4))). + apply ST_Plus1. apply ST_PlusConstConst. + apply multi_step with + (P (C (0 + 3)) + (C (2 + 4))). + apply ST_Plus2. apply v_const. + apply ST_PlusConstConst. + apply multi_R. + apply ST_PlusConstConst. Qed. + +(** Here's an alternate proof of the same fact that uses [eapply] to + avoid explicitly constructing all the intermediate terms. *) + +Lemma test_multistep_1': + P + (P (C 0) (C 3)) + (P (C 2) (C 4)) + ==>* + C ((0 + 3) + (2 + 4)). +Proof. + eapply multi_step. apply ST_Plus1. apply ST_PlusConstConst. + eapply multi_step. apply ST_Plus2. apply v_const. + apply ST_PlusConstConst. + eapply multi_step. apply ST_PlusConstConst. + apply multi_refl. Qed. + +(** **** Exercise: 1 star, optional (test_multistep_2) *) +Lemma test_multistep_2: + C 3 ==>* C 3. +Proof. + (* FILL IN HERE *) Admitted. +(** [] *) + +(** **** Exercise: 1 star, optional (test_multistep_3) *) +Lemma test_multistep_3: + P (C 0) (C 3) + ==>* + P (C 0) (C 3). +Proof. + (* FILL IN HERE *) Admitted. +(** [] *) + +(** **** Exercise: 2 stars (test_multistep_4) *) +Lemma test_multistep_4: + P + (C 0) + (P + (C 2) + (P (C 0) (C 3))) + ==>* + P + (C 0) + (C (2 + (0 + 3))). +Proof. + (* FILL IN HERE *) Admitted. +(** [] *) + +(* ================================================================= *) +(** ** Normal Forms Again *) + +(** If [t] reduces to [t'] in zero or more steps and [t'] is a + normal form, we say that "[t'] is a normal form of [t]." *) + +Definition step_normal_form := normal_form step. + +> -- step_normal : (x: Tm) -> (prf: Not (t' ** Smallstep.Step x t')) -> normal_form Smallstep.Step x + +> -- data normal_form : {X:Type} -> Relation X -> X -> Type where +> -- Normal : {X:Type} -> (R: Relation X) -> (t: X) -> (prf: Not (t' ** R t t')) -> normal_form R t + +> step_normal_form : (t : Tm) -> Type +> step_normal_form = normal_form Smallstep.Step + + +> normal_form_of : Tm -> Tm -> Type +> normal_form_of t t' = ((t ==>* t'), step_normal_form t') + + +(** We have already seen that, for our language, single-step reduction is + deterministic -- i.e., a given term can take a single step in + at most one way. It follows from this that, if [t] can reach + a normal form, then this normal form is unique. In other words, we + can actually pronounce [normal_form t t'] as "[t'] is _the_ + normal form of [t]." *) + +(** **** Exercise: 3 stars, optional (normal_forms_unique) *) +Theorem normal_forms_unique: + deterministic normal_form_of. +Proof. + (* We recommend using this initial setup as-is! *) + unfold deterministic. unfold normal_form_of. + intros x y1 y2 P1 P2. + inversion P1 as [P11 P12]; clear P1. + inversion P2 as [P21 P22]; clear P2. + generalize dependent y2. + (* FILL IN HERE *) Admitted. +(** [] *) + +> notAndLemmaLeft : Not x -> Not (x,y) +> notAndLemmaLeft nx (l,r) = nx l + +> notStepEqual : Not (Smallstep.Step x x) +> notStepEqual Smallstep.ST_PlusConstConst impossible +> notStepEqual (ST_Plus1 h) = notStepEqual h +> notStepEqual (ST_Plus2 s h) = notStepEqual h + +> normal_forms_unique : deterministic Smallstep.normal_form_of +> normal_forms_unique h h' = +> (\ (l,r) => (\ (l',r') => +> case l of +> Multi_refl => +> case l' of +> Multi_refl => Refl +> Multi_step {y} single mult => void (r (y ** single)) +> Multi_step {x} {y} {z} single mult => +> case l' of +> Multi_refl => void (r' (y ** single)) +> Multi_step {x} {y=y1} {z=z1} single' mult' => ?holeXX +> ) h') h + +(** Indeed, something stronger is true for this language (though not + for all languages): the reduction of _any_ term [t] will + eventually reach a normal form -- i.e., [normal_form_of] is a + _total_ function. Formally, we say the [step] relation is + _normalizing_. *) + +Definition normalizing {X:Type} (R:relation X) := + forall t, exists t', + (multi R) t t' /\ normal_form R t'. + +> normalizing : {X: Type} -> (R: Relation X) -> Type +> normalizing {X=x} {R=r} = (t: x) -> (t' : x ** ((Multi r) t t', normal_form r t')) + +(** To prove that [step] is normalizing, we need a couple of lemmas. + + First, we observe that, if [t] reduces to [t'] in many steps, then + the same sequence of reduction steps within [t] is also possible + when [t] appears as the left-hand child of a [P] node, and + similarly when [t] appears as the right-hand child of a [P] + node whose left-hand child is a value. *) + +> multistep_congr_1 : {t1, t1', t2: Tm} -> (t1 ==>* t1') -> ((P t1 t2) ==>* P t1' t2) +> multistep_congr_1 {t1} {t1'} {t2} mult = +> case mult of +> Multi_refl => Multi_refl +> Multi_step step mult => Multi_step (ST_Plus1 step) Multi_refl + + +(** **** Exercise: 2 stars (multistep_congr_2) *) + +> multistep_congr_2 : {t1, t2', t2: Tm} -> (Value t1) -> (t2 ==>* t2') -> ((P t1 t2) ==>* P t1 t2') +> multistep_congr_2 {t2'} {t2} (V_const i) mult = +> case mult of +> Multi_refl => Multi_refl +> Multi_step step mult => Multi_step (ST_Plus2 (V_const i) step) Multi_refl + +Lemma multistep_congr_2 : forall t1 t2 t2', + value t1 -> + t2 ==>* t2' -> + P t1 t2 ==>* P t1 t2'. +Proof. + (* FILL IN HERE *) Admitted. +(** [] *) + +(** With these lemmas in hand, the main proof is a straightforward + induction. + + _Theorem_: The [step] function is normalizing -- i.e., for every + [t] there exists some [t'] such that [t] steps to [t'] and [t'] is + a normal form. + + _Proof sketch_: By induction on terms. There are two cases to + consider: + + - [t = C n] for some [n]. Here [t] doesn't take a step, and we + have [t' = t]. We can derive the left-hand side by reflexivity + and the right-hand side by observing (a) that values are normal + forms (by [nf_same_as_value]) and (b) that [t] is a value (by + [v_const]). + + - [t = P t1 t2] for some [t1] and [t2]. By the IH, [t1] and [t2] + have normal forms [t1'] and [t2']. Recall that normal forms are + values (by [nf_same_as_value]); we know that [t1' = C n1] and + [t2' = C n2], for some [n1] and [n2]. We can combine the [==>*] + derivations for [t1] and [t2] using [multi_congr_1] and + [multi_congr_2] to prove that [P t1 t2] reduces in many steps to + [C (n1 + n2)]. + + It is clear that our choice of [t' = C (n1 + n2)] is a value, + which is in turn a normal form. [] *) + +> step_normalizing : normalizing Smallstep.Step +> step_normalizing (C n) = (C n ** (Multi_refl, notStepCN)) +> where notStepCN: (t' : Tm ** Smallstep.Step (C n) t') -> Void +> notStepCN (t' ** c) impossible +> step_normalizing (P l r) = +> let (t1 ** (ih1l,ih1r)) = step_normalizing l +> (t2 ** (ih2l,ih2r)) = step_normalizing r +> interm : ((P l r) ==>* P _ r) = multistep_congr_1 ih1l +> in case interm of +> Multi_refl => ?hole --(C n ** (Multi_refl, notStepCN)) + +-- \ e => (e ** (?hole1, ?hole2)) ?hole0 + + +Theorem step_normalizing : + normalizing step. +Proof. + unfold normalizing. + induction t. + - (* C *) + exists (C n). + split. + + (* l *) apply multi_refl. + + (* r *) + (* We can use [rewrite] with "iff" statements, not + just equalities: *) + rewrite nf_same_as_value. apply v_const. + - (* P *) + destruct IHt1 as [t1' [H11 H12]]. + destruct IHt2 as [t2' [H21 H22]]. + rewrite nf_same_as_value in H12. rewrite nf_same_as_value in H22. + inversion H12 as [n1 H]. inversion H22 as [n2 H']. + rewrite <- H in H11. + rewrite <- H' in H21. + exists (C (n1 + n2)). + split. + + (* l *) + apply multi_trans with (P (C n1) t2). + * apply multistep_congr_1. apply H11. + * apply multi_trans with + (P (C n1) (C n2)). + { apply multistep_congr_2. apply v_const. apply H21. } + { apply multi_R. apply ST_PlusConstConst. } + + (* r *) + rewrite nf_same_as_value. apply v_const. Qed. + +(* ================================================================= *) +(** ** Equivalence of Big-Step and Small-Step *) + +(** Having defined the operational semantics of our tiny programming + language in two different ways (big-step and small-step), it makes + sense to ask whether these definitions actually define the same + thing! They do, though it takes a little work to show it. The + details are left as an exercise. *) + +(** **** Exercise: 3 stars (eval__multistep) *) +Theorem eval__multistep : forall t n, + t \\ n -> t ==>* C n. + +(** The key ideas in the proof can be seen in the following picture: + + P t1 t2 ==> (by ST_Plus1) + P t1' t2 ==> (by ST_Plus1) + P t1'' t2 ==> (by ST_Plus1) + ... + P (C n1) t2 ==> (by ST_Plus2) + P (C n1) t2' ==> (by ST_Plus2) + P (C n1) t2'' ==> (by ST_Plus2) + ... + P (C n1) (C n2) ==> (by ST_PlusConstConst) + C (n1 + n2) + + That is, the multistep reduction of a term of the form [P t1 t2] + proceeds in three phases: + - First, we use [ST_Plus1] some number of times to reduce [t1] + to a normal form, which must (by [nf_same_as_value]) be a + term of the form [C n1] for some [n1]. + - Next, we use [ST_Plus2] some number of times to reduce [t2] + to a normal form, which must again be a term of the form [C + n2] for some [n2]. + - Finally, we use [ST_PlusConstConst] one time to reduce [P (C + n1) (C n2)] to [C (n1 + n2)]. *) + +(** To formalize this intuition, you'll need to use the congruence + lemmas from above (you might want to review them now, so that + you'll be able to recognize when they are useful), plus some basic + properties of [==>*]: that it is reflexive, transitive, and + includes [==>]. *) + +Proof. + (* FILL IN HERE *) Admitted. +(** [] *) + +(** **** Exercise: 3 stars, advanced (eval__multistep_inf) *) +(** Write a detailed informal version of the proof of [eval__multistep]. + +(* FILL IN HERE *) +*) +(** [] *) + +(** For the other direction, we need one lemma, which establishes a + relation between single-step reduction and big-step evaluation. *) + +(** **** Exercise: 3 stars (step__eval) *) +Lemma step__eval : forall t t' n, + t ==> t' -> + t' \\ n -> + t \\ n. +Proof. + intros t t' n Hs. generalize dependent n. + (* FILL IN HERE *) Admitted. +(** [] *) + +(** The fact that small-step reduction implies big-step evaluation is + now straightforward to prove, once it is stated correctly. + + The proof proceeds by induction on the multi-step reduction + sequence that is buried in the hypothesis [normal_form_of t t']. *) + +(** Make sure you understand the statement before you start to + work on the proof. *) + +(** **** Exercise: 3 stars (multistep__eval) *) +Theorem multistep__eval : forall t t', + normal_form_of t t' -> exists n, t' = C n /\ t \\ n. +Proof. + (* FILL IN HERE *) Admitted. +(** [] *) + +(* ================================================================= *) +(** ** Additional Exercises *) + +(** **** Exercise: 3 stars, optional (interp_tm) *) +(** Remember that we also defined big-step evaluation of terms as a + function [evalF]. Prove that it is equivalent to the existing + semantics. (Hint: we just proved that [eval] and [multistep] are + equivalent, so logically it doesn't matter which you choose. + One will be easier than the other, though!) *) + +Theorem evalF_eval : forall t n, + evalF t = n <-> t \\ n. +Proof. + (* FILL IN HERE *) Admitted. +(** [] *) + +(** **** Exercise: 4 stars (combined_properties) *) +(** We've considered arithmetic and conditional expressions + separately. This exercise explores how the two interact. *) + +Module Combined. + +Inductive tm : Type := + | C : nat -> tm + | P : tm -> tm -> tm + | ttrue : tm + | tfalse : tm + | tif : tm -> tm -> tm -> tm. + +Inductive value : tm -> Prop := + | v_const : forall n, value (C n) + | v_true : value ttrue + | v_false : value tfalse. + +Reserved Notation " t '==>' t' " (at level 40). + +Inductive step : tm -> tm -> Prop := + | ST_PlusConstConst : forall n1 n2, + P (C n1) (C n2) ==> C (n1 + n2) + | ST_Plus1 : forall t1 t1' t2, + t1 ==> t1' -> + P t1 t2 ==> P t1' t2 + | ST_Plus2 : forall v1 t2 t2', + value v1 -> + t2 ==> t2' -> + P v1 t2 ==> P v1 t2' + | ST_IfTrue : forall t1 t2, + tif ttrue t1 t2 ==> t1 + | ST_IfFalse : forall t1 t2, + tif tfalse t1 t2 ==> t2 + | ST_If : forall t1 t1' t2 t3, + t1 ==> t1' -> + tif t1 t2 t3 ==> tif t1' t2 t3 + + where " t '==>' t' " := (step t t'). + +(** Earlier, we separately proved for both plus- and if-expressions... + + - that the step relation was deterministic, and + + - a strong progress lemma, stating that every term is either a + value or can take a step. + + Formally prove or disprove these two properties for the combined + language. (That is, state a theorem saying that the property + holds or does not hold, and prove your theorem.) *) + +(* FILL IN HERE *) + +End Combined. +(** [] *) + +(* ################################################################# *) +(** * Small-Step Imp *) + +(** Now for a more serious example: a small-step version of the Imp + operational semantics. *) + +(** The small-step reduction relations for arithmetic and + boolean expressions are straightforward extensions of the tiny + language we've been working up to now. To make them easier to + read, we introduce the symbolic notations [==>a] and [==>b] for + the arithmetic and boolean step relations. *) + +Inductive aval : aexp -> Prop := + | av_num : forall n, aval (ANum n). + +(** We are not actually going to bother to define boolean + values, since they aren't needed in the definition of [==>b] + below (why?), though they might be if our language were a bit + larger (why?). *) + +Reserved Notation " t '/' st '==>a' t' " + (at level 40, st at level 39). + +Inductive astep : state -> aexp -> aexp -> Prop := + | AS_Id : forall st i, + AId i / st ==>a ANum (st i) + | AS_Plus : forall st n1 n2, + APlus (ANum n1) (ANum n2) / st ==>a ANum (n1 + n2) + | AS_Plus1 : forall st a1 a1' a2, + a1 / st ==>a a1' -> + (APlus a1 a2) / st ==>a (APlus a1' a2) + | AS_Plus2 : forall st v1 a2 a2', + aval v1 -> + a2 / st ==>a a2' -> + (APlus v1 a2) / st ==>a (APlus v1 a2') + | AS_Minus : forall st n1 n2, + (AMinus (ANum n1) (ANum n2)) / st ==>a (ANum (minus n1 n2)) + | AS_Minus1 : forall st a1 a1' a2, + a1 / st ==>a a1' -> + (AMinus a1 a2) / st ==>a (AMinus a1' a2) + | AS_Minus2 : forall st v1 a2 a2', + aval v1 -> + a2 / st ==>a a2' -> + (AMinus v1 a2) / st ==>a (AMinus v1 a2') + | AS_Mult : forall st n1 n2, + (AMult (ANum n1) (ANum n2)) / st ==>a (ANum (mult n1 n2)) + | AS_Mult1 : forall st a1 a1' a2, + a1 / st ==>a a1' -> + (AMult a1 a2) / st ==>a (AMult a1' a2) + | AS_Mult2 : forall st v1 a2 a2', + aval v1 -> + a2 / st ==>a a2' -> + (AMult v1 a2) / st ==>a (AMult v1 a2') + + where " t '/' st '==>a' t' " := (astep st t t'). + +Reserved Notation " t '/' st '==>b' t' " + (at level 40, st at level 39). + +Inductive bstep : state -> bexp -> bexp -> Prop := +| BS_Eq : forall st n1 n2, + (BEq (ANum n1) (ANum n2)) / st ==>b + (if (beq_nat n1 n2) then BTrue else BFalse) +| BS_Eq1 : forall st a1 a1' a2, + a1 / st ==>a a1' -> + (BEq a1 a2) / st ==>b (BEq a1' a2) +| BS_Eq2 : forall st v1 a2 a2', + aval v1 -> + a2 / st ==>a a2' -> + (BEq v1 a2) / st ==>b (BEq v1 a2') +| BS_LtEq : forall st n1 n2, + (BLe (ANum n1) (ANum n2)) / st ==>b + (if (leb n1 n2) then BTrue else BFalse) +| BS_LtEq1 : forall st a1 a1' a2, + a1 / st ==>a a1' -> + (BLe a1 a2) / st ==>b (BLe a1' a2) +| BS_LtEq2 : forall st v1 a2 a2', + aval v1 -> + a2 / st ==>a a2' -> + (BLe v1 a2) / st ==>b (BLe v1 a2') +| BS_NotTrue : forall st, + (BNot BTrue) / st ==>b BFalse +| BS_NotFalse : forall st, + (BNot BFalse) / st ==>b BTrue +| BS_NotStep : forall st b1 b1', + b1 / st ==>b b1' -> + (BNot b1) / st ==>b (BNot b1') +| BS_AndTrueTrue : forall st, + (BAnd BTrue BTrue) / st ==>b BTrue +| BS_AndTrueFalse : forall st, + (BAnd BTrue BFalse) / st ==>b BFalse +| BS_AndFalse : forall st b2, + (BAnd BFalse b2) / st ==>b BFalse +| BS_AndTrueStep : forall st b2 b2', + b2 / st ==>b b2' -> + (BAnd BTrue b2) / st ==>b (BAnd BTrue b2') +| BS_AndStep : forall st b1 b1' b2, + b1 / st ==>b b1' -> + (BAnd b1 b2) / st ==>b (BAnd b1' b2) + +where " t '/' st '==>b' t' " := (bstep st t t'). + +(** The semantics of commands is the interesting part. We need two + small tricks to make it work: + + - We use [SKIP] as a "command value" -- i.e., a command that + has reached a normal form. + + - An assignment command reduces to [SKIP] (and an updated + state). + + - The sequencing command waits until its left-hand + subcommand has reduced to [SKIP], then throws it away so + that reduction can continue with the right-hand + subcommand. + + - We reduce a [WHILE] command by transforming it into a + conditional followed by the same [WHILE]. *) + +(** (There are other ways of achieving the effect of the latter + trick, but they all share the feature that the original [WHILE] + command needs to be saved somewhere while a single copy of the loop + body is being reduced.) *) + +Reserved Notation " t '/' st '==>' t' '/' st' " + (at level 40, st at level 39, t' at level 39). + +Inductive cstep : (com * state) -> (com * state) -> Prop := + | CS_AssStep : forall st i a a', + a / st ==>a a' -> + (i ::= a) / st ==> (i ::= a') / st + | CS_Ass : forall st i n, + (i ::= (ANum n)) / st ==> SKIP / (st & { i --> n }) + | CS_SeqStep : forall st c1 c1' st' c2, + c1 / st ==> c1' / st' -> + (c1 ;; c2) / st ==> (c1' ;; c2) / st' + | CS_SeqFinish : forall st c2, + (SKIP ;; c2) / st ==> c2 / st + | CS_IfTrue : forall st c1 c2, + IFB BTrue THEN c1 ELSE c2 FI / st ==> c1 / st + | CS_IfFalse : forall st c1 c2, + IFB BFalse THEN c1 ELSE c2 FI / st ==> c2 / st + | CS_IfStep : forall st b b' c1 c2, + b / st ==>b b' -> + IFB b THEN c1 ELSE c2 FI / st + ==> (IFB b' THEN c1 ELSE c2 FI) / st + | CS_While : forall st b c1, + (WHILE b DO c1 END) / st + ==> (IFB b THEN (c1;; (WHILE b DO c1 END)) ELSE SKIP FI) / st + + where " t '/' st '==>' t' '/' st' " := (cstep (t,st) (t',st')). + +(* ################################################################# *) +(** * Concurrent Imp *) + +(** Finally, to show the power of this definitional style, let's + enrich Imp with a new form of command that runs two subcommands in + parallel and terminates when both have terminated. To reflect the + unpredictability of scheduling, the actions of the subcommands may + be interleaved in any order, but they share the same memory and + can communicate by reading and writing the same variables. *) + +Module CImp. + +Inductive com : Type := + | CSkip : com + | CAss : string -> aexp -> com + | CSeq : com -> com -> com + | CIf : bexp -> com -> com -> com + | CWhile : bexp -> com -> com + (* New: *) + | CPar : com -> com -> com. + +Notation "'SKIP'" := + CSkip. +Notation "x '::=' a" := + (CAss x a) (at level 60). +Notation "c1 ;; c2" := + (CSeq c1 c2) (at level 80, right associativity). +Notation "'WHILE' b 'DO' c 'END'" := + (CWhile b c) (at level 80, right associativity). +Notation "'IFB' b 'THEN' c1 'ELSE' c2 'FI'" := + (CIf b c1 c2) (at level 80, right associativity). +Notation "'PAR' c1 'WITH' c2 'END'" := + (CPar c1 c2) (at level 80, right associativity). + +Inductive cstep : (com * state) -> (com * state) -> Prop := + (* Old part *) + | CS_AssStep : forall st i a a', + a / st ==>a a' -> + (i ::= a) / st ==> (i ::= a') / st + | CS_Ass : forall st i n, + (i ::= (ANum n)) / st ==> SKIP / st & { i --> n } + | CS_SeqStep : forall st c1 c1' st' c2, + c1 / st ==> c1' / st' -> + (c1 ;; c2) / st ==> (c1' ;; c2) / st' + | CS_SeqFinish : forall st c2, + (SKIP ;; c2) / st ==> c2 / st + | CS_IfTrue : forall st c1 c2, + (IFB BTrue THEN c1 ELSE c2 FI) / st ==> c1 / st + | CS_IfFalse : forall st c1 c2, + (IFB BFalse THEN c1 ELSE c2 FI) / st ==> c2 / st + | CS_IfStep : forall st b b' c1 c2, + b /st ==>b b' -> + (IFB b THEN c1 ELSE c2 FI) / st + ==> (IFB b' THEN c1 ELSE c2 FI) / st + | CS_While : forall st b c1, + (WHILE b DO c1 END) / st + ==> (IFB b THEN (c1;; (WHILE b DO c1 END)) ELSE SKIP FI) / st + (* New part: *) + | CS_Par1 : forall st c1 c1' c2 st', + c1 / st ==> c1' / st' -> + (PAR c1 WITH c2 END) / st ==> (PAR c1' WITH c2 END) / st' + | CS_Par2 : forall st c1 c2 c2' st', + c2 / st ==> c2' / st' -> + (PAR c1 WITH c2 END) / st ==> (PAR c1 WITH c2' END) / st' + | CS_ParDone : forall st, + (PAR SKIP WITH SKIP END) / st ==> SKIP / st + where " t '/' st '==>' t' '/' st' " := (cstep (t,st) (t',st')). + +Definition cmultistep := multi cstep. + +Notation " t '/' st '==>*' t' '/' st' " := + (multi cstep (t,st) (t',st')) + (at level 40, st at level 39, t' at level 39). + +(** Among the many interesting properties of this language is the fact + that the following program can terminate with the variable [X] set + to any value. *) + +Definition par_loop : com := + PAR + Y ::= 1 + WITH + WHILE Y = 0 DO + X ::= X + 1 + END + END. + +(** In particular, it can terminate with [X] set to [0]: *) + +Example par_loop_example_0: + exists st', + par_loop / { --> 0 } ==>* SKIP / st' + /\ st' X = 0. +Proof. + eapply ex_intro. split. + unfold par_loop. + eapply multi_step. apply CS_Par1. + apply CS_Ass. + eapply multi_step. apply CS_Par2. apply CS_While. + eapply multi_step. apply CS_Par2. apply CS_IfStep. + apply BS_Eq1. apply AS_Id. + eapply multi_step. apply CS_Par2. apply CS_IfStep. + apply BS_Eq. simpl. + eapply multi_step. apply CS_Par2. apply CS_IfFalse. + eapply multi_step. apply CS_ParDone. + eapply multi_refl. + reflexivity. Qed. + +(** It can also terminate with [X] set to [2]: *) + +Example par_loop_example_2: + exists st', + par_loop / { --> 0 } ==>* SKIP / st' + /\ st' X = 2. +Proof. + eapply ex_intro. split. + eapply multi_step. apply CS_Par2. apply CS_While. + eapply multi_step. apply CS_Par2. apply CS_IfStep. + apply BS_Eq1. apply AS_Id. + eapply multi_step. apply CS_Par2. apply CS_IfStep. + apply BS_Eq. simpl. + eapply multi_step. apply CS_Par2. apply CS_IfTrue. + eapply multi_step. apply CS_Par2. apply CS_SeqStep. + apply CS_AssStep. apply AS_Plus1. apply AS_Id. + eapply multi_step. apply CS_Par2. apply CS_SeqStep. + apply CS_AssStep. apply AS_Plus. + eapply multi_step. apply CS_Par2. apply CS_SeqStep. + apply CS_Ass. + eapply multi_step. apply CS_Par2. apply CS_SeqFinish. + + eapply multi_step. apply CS_Par2. apply CS_While. + eapply multi_step. apply CS_Par2. apply CS_IfStep. + apply BS_Eq1. apply AS_Id. + eapply multi_step. apply CS_Par2. apply CS_IfStep. + apply BS_Eq. simpl. + eapply multi_step. apply CS_Par2. apply CS_IfTrue. + eapply multi_step. apply CS_Par2. apply CS_SeqStep. + apply CS_AssStep. apply AS_Plus1. apply AS_Id. + eapply multi_step. apply CS_Par2. apply CS_SeqStep. + apply CS_AssStep. apply AS_Plus. + eapply multi_step. apply CS_Par2. apply CS_SeqStep. + apply CS_Ass. + + eapply multi_step. apply CS_Par1. apply CS_Ass. + eapply multi_step. apply CS_Par2. apply CS_SeqFinish. + eapply multi_step. apply CS_Par2. apply CS_While. + eapply multi_step. apply CS_Par2. apply CS_IfStep. + apply BS_Eq1. apply AS_Id. + eapply multi_step. apply CS_Par2. apply CS_IfStep. + apply BS_Eq. simpl. + eapply multi_step. apply CS_Par2. apply CS_IfFalse. + eapply multi_step. apply CS_ParDone. + eapply multi_refl. + reflexivity. Qed. + +(** More generally... *) + +(** **** Exercise: 3 stars, optional (par_body_n__Sn) *) +Lemma par_body_n__Sn : forall n st, + st X = n /\ st Y = 0 -> + par_loop / st ==>* par_loop / st & { X --> S n}. +Proof. + (* FILL IN HERE *) Admitted. +(** [] *) + +(** **** Exercise: 3 stars, optional (par_body_n) *) +Lemma par_body_n : forall n st, + st X = 0 /\ st Y = 0 -> + exists st', + par_loop / st ==>* par_loop / st' /\ st' X = n /\ st' Y = 0. +Proof. + (* FILL IN HERE *) Admitted. +(** [] *) + +(** ... the above loop can exit with [X] having any value + whatsoever. *) + +Theorem par_loop_any_X: + forall n, exists st', + par_loop / { --> 0 } ==>* SKIP / st' + /\ st' X = n. +Proof. + intros n. + destruct (par_body_n n { --> 0 }). + split; unfold t_update; reflexivity. + + rename x into st. + inversion H as [H' [HX HY]]; clear H. + exists (st & { Y --> 1 }). split. + eapply multi_trans with (par_loop,st). apply H'. + eapply multi_step. apply CS_Par1. apply CS_Ass. + eapply multi_step. apply CS_Par2. apply CS_While. + eapply multi_step. apply CS_Par2. apply CS_IfStep. + apply BS_Eq1. apply AS_Id. rewrite t_update_eq. + eapply multi_step. apply CS_Par2. apply CS_IfStep. + apply BS_Eq. simpl. + eapply multi_step. apply CS_Par2. apply CS_IfFalse. + eapply multi_step. apply CS_ParDone. + apply multi_refl. + + rewrite t_update_neq. assumption. intro X; inversion X. +Qed. + +End CImp. + +(* ################################################################# *) +(** * A Small-Step Stack Machine *) + +(** Our last example is a small-step semantics for the stack machine + example from the [Imp] chapter of _Logical Foundations_. *) + +Definition stack := list nat. +Definition prog := list sinstr. + +Inductive stack_step : state -> prog * stack -> prog * stack -> Prop := + | SS_Push : forall st stk n p', + stack_step st (SPush n :: p', stk) (p', n :: stk) + | SS_Load : forall st stk i p', + stack_step st (SLoad i :: p', stk) (p', st i :: stk) + | SS_Plus : forall st stk n m p', + stack_step st (SPlus :: p', n::m::stk) (p', (m+n)::stk) + | SS_Minus : forall st stk n m p', + stack_step st (SMinus :: p', n::m::stk) (p', (m-n)::stk) + | SS_Mult : forall st stk n m p', + stack_step st (SMult :: p', n::m::stk) (p', (m*n)::stk). + +Theorem stack_step_deterministic : forall st, + deterministic (stack_step st). +Proof. + unfold deterministic. intros st x y1 y2 H1 H2. + induction H1; inversion H2; reflexivity. +Qed. + +Definition stack_multistep st := multi (stack_step st). + +(** **** Exercise: 3 stars, advanced (compiler_is_correct) *) +(** Remember the definition of [compile] for [aexp] given in the + [Imp] chapter of _Logical Foundations_. We want now to + prove [compile] correct with respect to the stack machine. + + State what it means for the compiler to be correct according to + the stack machine small step semantics and then prove it. *) + +Definition compiler_is_correct_statement : Prop + (* REPLACE THIS LINE WITH ":= _your_definition_ ." *). Admitted. + +Theorem compiler_is_correct : compiler_is_correct_statement. +Proof. +(* FILL IN HERE *) Admitted. +(** [] *) + + +(** $Date$ *) From dd2630f1e1a77ecbbbec6c59dc1b8a7adfbcf9ff Mon Sep 17 00:00:00 2001 From: jutaro Date: Wed, 5 Sep 2018 18:32:51 +0200 Subject: [PATCH 02/30] normalizing_step. --- src/Smallstep.lidr | 48 ++++++++++++++++++++++++++++++++++++---------- 1 file changed, 38 insertions(+), 10 deletions(-) diff --git a/src/Smallstep.lidr b/src/Smallstep.lidr index b964db1..7006ef4 100644 --- a/src/Smallstep.lidr +++ b/src/Smallstep.lidr @@ -833,9 +833,9 @@ Proof. (** Third, [multi R] is _transitive_. *) -> multi_trans: {X:Type} -> {R: Relation X} -> (x, y, z : X) -> +> multi_trans: {X:Type} -> {R: Relation X} -> {x, y, z : X} -> > Multi R x y -> Multi R y z -> Multi R x z -> multi_trans _ _ _ m1 m2 = +> multi_trans m1 m2 = > case m1 of > Multi_refl => m2 > Multi_step r _ => Multi_step r Multi_refl @@ -1073,19 +1073,47 @@ Proof. It is clear that our choice of [t' = C (n1 + n2)] is a value, which is in turn a normal form. [] *) + +-- > normalizing : {X: Type} -> (R: Relation X) -> Type +-- > normalizing {X=x} {R=r} = (t: x) -> (t' : x ** ((Multi r) t t', normal_form r t')) + + > step_normalizing : normalizing Smallstep.Step > step_normalizing (C n) = (C n ** (Multi_refl, notStepCN)) > where notStepCN: (t' : Tm ** Smallstep.Step (C n) t') -> Void > notStepCN (t' ** c) impossible > step_normalizing (P l r) = -> let (t1 ** (ih1l,ih1r)) = step_normalizing l -> (t2 ** (ih2l,ih2r)) = step_normalizing r -> interm : ((P l r) ==>* P _ r) = multistep_congr_1 ih1l -> in case interm of -> Multi_refl => ?hole --(C n ** (Multi_refl, notStepCN)) - --- \ e => (e ** (?hole1, ?hole2)) ?hole0 - +> let (_ ** (ih1l,(ih1r))) = step_normalizing l +> (_ ** (ih2l,(ih2r))) = step_normalizing r +> ih1v = (fst nf_same_as_value) ih1r +> ih2v = (fst nf_same_as_value) ih2r +> n1 = lemma_get ih1v +> n2 = lemma_get ih2v +> (n1**p1) = lemma_deconstruct ih1v +> (n2**p2) = lemma_deconstruct ih2v +> m1 = replace p1 ih1l +> m2 = replace p2 ih2l + +> reduction : ((P l r) ==>* (C (plus n1 n2))) = +> let left_transform = multistep_congr_1 m1 +> right_transform = +> let leftT = multistep_congr_2 (V_const n1) m2 +> rightT = Multi_step ST_PlusConstConst Multi_refl +> conc2 = multi_trans {x=P (C n1) r} {y=P (C n1) (C n2)} {z=C (plus n1 n2)} +> in conc2 leftT rightT +> conc1 = multi_trans {x=P l r} {y=P (C n1) r} {z=C (plus n1 n2)} +> in conc1 left_transform right_transform + +> normal_form : ((t'1 : Tm ** Smallstep.Step (C (plus n1 n2)) t'1) -> Void) = +> (snd nf_same_as_value) (V_const (plus n1 n2)) + +> in (C (n1 + n2) ** (reduction, normal_form)) +> where +> lemma_get : Value v -> Nat +> lemma_get (V_const n) = n + +> lemma_deconstruct : Value v -> (n : Nat ** v = C n) +> lemma_deconstruct v@(V_const n) = (n ** Refl) Theorem step_normalizing : normalizing step. From dda41dd5fb32987ec528bae61c01ffc0a3bd8a9d Mon Sep 17 00:00:00 2001 From: jutaro Date: Fri, 7 Sep 2018 16:24:56 +0200 Subject: [PATCH 03/30] Nothing really --- src/Smallstep.lidr | 41 +++++++++++++++++++++++++---------------- 1 file changed, 25 insertions(+), 16 deletions(-) diff --git a/src/Smallstep.lidr b/src/Smallstep.lidr index 7006ef4..f1b155c 100644 --- a/src/Smallstep.lidr +++ b/src/Smallstep.lidr @@ -244,26 +244,26 @@ Imp language. > deterministic : {xt: Type} -> (r: Relation xt) -> Type -> deterministic {xt} r = {x, y1, y2: xt} -> r x y1 -> r x y2 -> y1 = y2 +> deterministic {xt} r = (x, y1, y2: xt) -> r x y1 -> r x y2 -> y1 = y2 > namespace SimpleArith2 > step_deterministic : deterministic Step -> step_deterministic ST_PlusConstConst hyp = +> step_deterministic _ _ _ ST_PlusConstConst hyp = > case hyp of > ST_PlusConstConst => Refl > ST_Plus1 _ impossible > ST_Plus2 _ impossible -> step_deterministic (ST_Plus1 l) hyp = +> step_deterministic _ _ _ (ST_Plus1 l) hyp = > case hyp of > ST_PlusConstConst impossible -> ST_Plus1 l' => rewrite step_deterministic l l' in Refl +> ST_Plus1 l' => rewrite step_deterministic _ _ _ l l' in Refl > ST_Plus2 _ impossible -> step_deterministic (ST_Plus2 r) hyp = +> step_deterministic _ _ _ (ST_Plus2 r) hyp = > case hyp of > ST_PlusConstConst impossible > ST_Plus1 _ impossible -> ST_Plus2 r' => rewrite step_deterministic r r' in Refl +> ST_Plus2 r' => rewrite step_deterministic _ _ _ r r' in Refl (* ================================================================= *) (** ** Values *) @@ -774,7 +774,7 @@ multi-step closure of [R]_ as follows. > data Multi: {X: Type} -> (R: Relation X) -> (x: X) -> (y : X) -> Type where > Multi_refl : {X: Type} -> {R: Relation X} -> {x : X} -> Multi R x x -> Multi_step : {X: Type} -> {R: Relation X} -> {x, y, z : X} -> R x y -> Multi R y z -> Multi R x z. +> Multi_step : {X: Type} -> {R: Relation X} -> {x, y, z : X} -> R x y -> Multi R y z -> Multi R x z. Inductive multi {X:Type} (R: relation X) : relation X := | multi_refl : forall (x : X), multi R x x @@ -989,18 +989,27 @@ Proof. > notStepEqual (ST_Plus2 s h) = notStepEqual h > normal_forms_unique : deterministic Smallstep.normal_form_of -> normal_forms_unique h h' = -> (\ (l,r) => (\ (l',r') => +> normal_forms_unique x z1 z2 (l,r) (l2,r2) = > case l of > Multi_refl => -> case l' of +> case l2 of > Multi_refl => Refl -> Multi_step {y} single mult => void (r (y ** single)) -> Multi_step {x} {y} {z} single mult => -> case l' of -> Multi_refl => void (r' (y ** single)) -> Multi_step {x} {y=y1} {z=z1} single' mult' => ?holeXX -> ) h') h +> Multi_step {x} {y=y'} single mult => void (r (y' ** single)) +> Multi_step {x} {y} single mult => +> case l2 of +> Multi_refl => void (r2 (y ** single)) +> Multi_step {x} {y=y'} single' mult' => ?hole + +-- > let indHyp1 = step_deterministic x y y' -- single single' +-- > indHyp2 = normal_forms_unique y z1 z2 +-- > in ?hole + +-- > deterministic : {xt: Type} -> (r: Relation xt) -> Type +-- > deterministic {xt} r = (x, y1, y2: xt) -> r x y1 -> r x y2 -> y1 = y2 + +> -- normal_form_of : Tm -> Tm -> Type +> -- normal_form_of t t' = ((t ==>* t'), step_normal_form t') + (** Indeed, something stronger is true for this language (though not for all languages): the reduction of _any_ term [t] will From 3d81a1b0338bf59eba9dbe99f5482d49fdc6b18a Mon Sep 17 00:00:00 2001 From: jutaro Date: Thu, 13 Sep 2018 13:25:46 +0200 Subject: [PATCH 04/30] eval__multistep --- src/Smallstep.lidr | 47 ++++++++++++++++++++++++++-------------------- 1 file changed, 27 insertions(+), 20 deletions(-) diff --git a/src/Smallstep.lidr b/src/Smallstep.lidr index f1b155c..579b1da 100644 --- a/src/Smallstep.lidr +++ b/src/Smallstep.lidr @@ -243,27 +243,27 @@ Imp language. (** Formally: *) -> deterministic : {xt: Type} -> (r: Relation xt) -> Type -> deterministic {xt} r = (x, y1, y2: xt) -> r x y1 -> r x y2 -> y1 = y2 +> deterministic : {xt: Type} -> {x: xt} -> {y1: xt} -> {y2: xt} -> (r: Relation xt) -> Type +> deterministic {xt} {x} {y1} {y2} r = r x y1 -> r x y2 -> y1 = y2 > namespace SimpleArith2 > step_deterministic : deterministic Step -> step_deterministic _ _ _ ST_PlusConstConst hyp = +> step_deterministic ST_PlusConstConst hyp = > case hyp of > ST_PlusConstConst => Refl > ST_Plus1 _ impossible > ST_Plus2 _ impossible -> step_deterministic _ _ _ (ST_Plus1 l) hyp = +> step_deterministic (ST_Plus1 l) hyp = > case hyp of > ST_PlusConstConst impossible -> ST_Plus1 l' => rewrite step_deterministic _ _ _ l l' in Refl +> ST_Plus1 l' => rewrite step_deterministic l l' in Refl > ST_Plus2 _ impossible -> step_deterministic _ _ _ (ST_Plus2 r) hyp = +> step_deterministic (ST_Plus2 r) hyp = > case hyp of > ST_PlusConstConst impossible > ST_Plus1 _ impossible -> ST_Plus2 r' => rewrite step_deterministic _ _ _ r r' in Refl +> ST_Plus2 r' => rewrite step_deterministic r r' in Refl (* ================================================================= *) (** ** Values *) @@ -988,8 +988,8 @@ Proof. > notStepEqual (ST_Plus1 h) = notStepEqual h > notStepEqual (ST_Plus2 s h) = notStepEqual h -> normal_forms_unique : deterministic Smallstep.normal_form_of -> normal_forms_unique x z1 z2 (l,r) (l2,r2) = +> normal_forms_unique : deterministic {x} {y1} {y2} Smallstep.normal_form_of +> normal_forms_unique (l,r) (l2,r2) = > case l of > Multi_refl => > case l2 of @@ -998,14 +998,13 @@ Proof. > Multi_step {x} {y} single mult => > case l2 of > Multi_refl => void (r2 (y ** single)) -> Multi_step {x} {y=y'} single' mult' => ?hole - --- > let indHyp1 = step_deterministic x y y' -- single single' --- > indHyp2 = normal_forms_unique y z1 z2 --- > in ?hole +> Multi_step {x} {y=y'} single' mult' => +> let -- indHyp1 = step_deterministic single single' +> -- indHyp2 = normal_forms_unique y z1 z2 +> in ?hole -- > deterministic : {xt: Type} -> (r: Relation xt) -> Type --- > deterministic {xt} r = (x, y1, y2: xt) -> r x y1 -> r x y2 -> y1 = y2 +-- > deterministic {xt} r = {x, y1, y2: xt) -> r x y1 -> r x y2 -> y1 = y2 > -- normal_form_of : Tm -> Tm -> Type > -- normal_form_of t t' = ((t ==>* t'), step_normal_form t') @@ -1041,12 +1040,13 @@ Definition normalizing {X:Type} (R:relation X) := (** **** Exercise: 2 stars (multistep_congr_2) *) -> multistep_congr_2 : {t1, t2', t2: Tm} -> (Value t1) -> (t2 ==>* t2') -> ((P t1 t2) ==>* P t1 t2') -> multistep_congr_2 {t2'} {t2} (V_const i) mult = +> multistep_congr_2 : {t1, t2', t2: Tm} -> {v:Value t1} -> (t2 ==>* t2') -> ((P t1 t2) ==>* P t1 t2') +> multistep_congr_2 {t2'} {t2} {v=V_const i} mult = > case mult of > Multi_refl => Multi_refl > Multi_step step mult => Multi_step (ST_Plus2 (V_const i) step) Multi_refl + Lemma multistep_congr_2 : forall t1 t2 t2', value t1 -> t2 ==>* t2' -> @@ -1106,7 +1106,7 @@ Proof. > reduction : ((P l r) ==>* (C (plus n1 n2))) = > let left_transform = multistep_congr_1 m1 > right_transform = -> let leftT = multistep_congr_2 (V_const n1) m2 +> let leftT = multistep_congr_2 {v=V_const n1} m2 > rightT = Multi_step ST_PlusConstConst Multi_refl > conc2 = multi_trans {x=P (C n1) r} {y=P (C n1) (C n2)} {z=C (plus n1 n2)} > in conc2 leftT rightT @@ -1166,8 +1166,15 @@ Proof. details are left as an exercise. *) (** **** Exercise: 3 stars (eval__multistep) *) -Theorem eval__multistep : forall t n, - t \\ n -> t ==>* C n. + +> eval__multistep : {t: Tm} -> {n: Nat} -> t # n -> t ==>* C n +> eval__multistep hyp = +> case hyp of +> E_Const => Multi_refl +> E_Plus l r => +> let hypl = multistep_congr_1 (eval__multistep l) +> hypr = multistep_congr_2 {v = V_const _}(eval__multistep r) +> in multi_trans (multi_trans hypl hypr)(Multi_step Smallstep.ST_PlusConstConst Multi_refl) (** The key ideas in the proof can be seen in the following picture: From 5739aaaa5a93992e4542da048c9c85737b636948 Mon Sep 17 00:00:00 2001 From: jutaro Date: Wed, 19 Sep 2018 13:29:08 +0200 Subject: [PATCH 05/30] Started with text and exercises. --- src/Smallstep.lidr | 926 +++++++++++++++++++++++---------------------- 1 file changed, 464 insertions(+), 462 deletions(-) diff --git a/src/Smallstep.lidr b/src/Smallstep.lidr index 579b1da..1051c08 100644 --- a/src/Smallstep.lidr +++ b/src/Smallstep.lidr @@ -6,7 +6,9 @@ > %access public export > %default total -The evaluators we have seen so far (for [aexp]s, [bexp]s, + + +The evaluators we have seen so far (for `aexp`s, `bexp`s, commands, ...) have been formulated in a "big-step" style: they specify how a given expression can be evaluated to its final value (or a command plus a store to a final store) "all in one big @@ -26,19 +28,19 @@ Another shortcoming of the big-step style is more technical, but critical in many situations. Suppose we want to define a variant of Imp where variables could hold _either_ numbers _or_ lists of numbers. In the syntax of this extended language, it will be -possible to write strange expressions like [2 + nil], and our +possible to write strange expressions like `2 + nil`, and our semantics for arithmetic expressions will then need to say something about how such expressions behave. One possibility is to maintain the convention that every arithmetic expressions evaluates to some number by choosing some way of viewing a list as a number -- e.g., by specifying that a list should be interpreted -as [0] when it occurs in a context expecting a number. But this +as `0` when it occurs in a context expecting a number. But this is really a bit of a hack. A much more natural approach is simply to say that the behavior of -an expression like [2+nil] is _undefined_ -- i.e., it doesn't +an expression like `2+nil` is _undefined_ -- i.e., it doesn't evaluate to any result at all. And we can easily do this: we just -have to formulate [aeval] and [beval] as [Inductive] propositions +have to formulate `aeval` and `beval` as `Inductive` propositions rather than Fixpoints, so that we can make them partial functions instead of total ones. @@ -54,7 +56,7 @@ These two outcomes -- nontermination vs. getting stuck in an erroneous configuration -- should not be confused. In particular, we want to _allow_ the first (permitting the possibility of infinite loops is the price we pay for the convenience of programming with -general looping constructs like [while]) but _prevent_ the +general looping constructs like `while`) but _prevent_ the second (which is just wrong), for example by adding some form of _typechecking_ to the language. Indeed, this will be a major topic for the rest of the course. As a first step, we need a way @@ -64,7 +66,7 @@ nontermination from erroneous "stuck states." So, for lots of reasons, we'd often like to have a finer-grained way of defining and reasoning about program behaviors. This is the topic of the present chapter. Our goal is to replace the -"big-step" [eval] relation with a "small-step" relation that +"big-step" `eval` relation with a "small-step" relation that specifies, for a given program, how the "atomic steps" of computation are performed. @@ -72,7 +74,7 @@ computation are performed. To save space in the discussion, let's go back to an incredibly simple language containing just constants and -addition. (We use single letters -- [C] and [P] (for Constant and +addition. (We use single letters -- `C` and `P` (for Constant and Plus) -- as constructor names, for brevity.) At the end of the chapter, we'll see how to apply the same techniques to the full Imp language. @@ -81,97 +83,110 @@ Imp language. > C : Nat -> Tm -- Constant > P : Tm -> Tm -> Tm -- Plus -(** Here is a standard evaluator for this language, written in - the big-step style that we've been using up to this point. *) +Here is a standard evaluator for this language, written in + the big-step style that we've been using up to this point. > evalF : (t : Tm) -> Nat > evalF (C n) = n > evalF (P a1 a2) = evalF a1 + evalF a2 -(** Here is the same evaluator, written in exactly the same +Here is the same evaluator, written in exactly the same style, but formulated as an inductively defined relation. Again, - we use the notation [t \\ n] for "[t] evaluates to [n]." *) -(** + we use the notation `t >>> n` for "`t` evaluates to `n`." - -------- (E_Const) - C n \\ n +\[ + \begin{prooftree} + \infer0[\idr{E_Const}]{\idr{C n >>> n}} + \end{prooftree} + \newline +\] - t1 \\ n1 - t2 \\ n2 - ------------------ (E_Plus) - P t1 t2 \\ n1 + n2 -*) +\[ + \begin{prooftree} + \hypo{\idr{t1 >>> n1}} + \hypo{\idr{t1 >>> n2}} + \infer2[\idr{E_Plus}]{\idr{P t1 t2 >>> n1 + n2}} + \end{prooftree} +\] + +> infixl 6 >>> > mutual -> infixl 6 # -> (#) : Tm -> Nat -> Type -> (#) = Eval +> (>>>) : Tm -> Nat -> Type +> (>>>) = Eval > > data Eval : Tm -> Nat -> Type where -> E_Const : C n # n -> E_Plus : t1 # n1 -> t2 # n2 -> P t1 t2 # n1 + n2 +> E_Const : C n >>> n +> E_Plus : t1 >>> n1 -> t2 >>> n2 -> P t1 t2 >>> n1 + n2 > -> namespace SimpleArith1 -(** Now, here is the corresponding _small-step_ evaluation relation. *) -(** - ------------------------------- (ST_PlusConstConst) - P (C n1) (C n2) ==> C (n1 + n2) +Now, here is the corresponding _small-step_ evaluation relation. - t1 ==> t1' - -------------------- (ST_Plus1) - P t1 t2 ==> P t1' t2 +\[ + \begin{prooftree} + \infer0[\idr{ST_PlusConstConst'}]{\idr{P (C n1) (C n2) ->> C (n1 + n2)}} + \end{prooftree} +\] - t2 ==> t2' - --------------------------- (ST_Plus2) - P (C n1) t2 ==> P (C n1) t2' -*) +\[ + \begin{prooftree} + \hypo{\idr{t1 ->> t1'}} + \infer1[\idr{ST_Plus1'}]{\idr{P t1 t2 ->> P t1' t2}} + \end{prooftree} +\] + +\[ + \begin{prooftree} + \hypo{\idr{t2 ->> t2'}} + \infer1[\idr{ST_Plus2'}]{\idr{P (C n1) t2 ->> P (C n1) t2'}} + \end{prooftree} +\] -> mutual -> infixl 6 >=> -> (>=>) : Tm -> Tm -> Type -> (>=>) = Step +> mutual +> infixl 6 ->> +> (->>) : Tm -> Tm -> Type +> (->>) = Step' > -> data Step : Tm -> Tm -> Type where -> ST_PlusConstConst : P (C n1) (C n2) >=> C (n1 + n2) -> ST_Plus1 : t1 >=> t1' -> P t1 t2 >=> P t1' t2 -> ST_Plus2 : t2 >=> t2' -> P (C n1) t2 >=> P (C n1) t2' +> data Step' : Tm -> Tm -> Type where +> ST_PlusConstConst' : P (C n1) (C n2) ->> C (n1 + n2) +> ST_Plus1' : t1 ->> t1' -> P t1 t2 ->> P t1' t2 +> ST_Plus2' : t2 ->> t2' -> P (C n1) t2 ->> P (C n1) t2' > -(** Things to notice: +Things to notice: - - We are defining just a single reduction step, in which - one [P] node is replaced by its value. +- We are defining just a single reduction step, in which + one `P` node is replaced by its value. - - Each step finds the _leftmost_ [P] node that is ready to - go (both of its operands are constants) and rewrites it in - place. The first rule tells how to rewrite this [P] node - itself; the other two rules tell how to find it. +- Each step finds the _leftmost_ `P` node that is ready to + go (both of its operands are constants) and rewrites it in + place. The first rule tells how to rewrite this `P` node + itself; the other two rules tell how to find it. - - A term that is just a constant cannot take a step. *) +- A term that is just a constant cannot take a step. -(** Let's pause and check a couple of examples of reasoning with - the [step] relation... *) +Let's pause and check a couple of examples of reasoning with + the `step` relation... -(** If [t1] can take a step to [t1'], then [P t1 t2] steps - to [P t1' t2]: *) +If `t1` can take a step to `t1'`, then `P t1 t2` steps + to `P t1' t2`: > test_step_1 : > P > (P (C 0) (C 3)) > (P (C 2) (C 4)) -> >=> +> ->> > P > (C (0 + 3)) > (P (C 2) (C 4)) -> test_step_1 = ST_Plus1 ST_PlusConstConst +> test_step_1 = ST_Plus1' ST_PlusConstConst' + -(** **** Exercise: 1 star (test_step_2) *) -(** Right-hand sides of sums can take a step only when the - left-hand side is finished: if [t2] can take a step to [t2'], - then [P (C n) t2] steps to [P (C n) - t2']: *) +==== Exercise: 1 star (test_step_2) +Right-hand sides of sums can take a step only when the + left-hand side is finished: if `t2` can take a step to `t2'`, + then `P (C n) t2` steps to `P (C n) t2'`: > test_step_2 : > P @@ -179,271 +194,277 @@ Imp language. > (P > (C 2) > (P (C 0) (C 3))) -> >=> +> ->> > P > (C 0) > (P > (C 2) > (C (0 + 3))) -> test_step_2 = ST_Plus2 (ST_Plus2 ST_PlusConstConst) +> test_step_2 = ?test_step_2_rhs +== Relations -(* ################################################################# *) -(** * Relations *) - -(** We will be working with several different single-step relations, +We will be working with several different single-step relations, so it is helpful to generalize a bit and state a few definitions and theorems about relations in general. (The optional chapter - [Rel.v] develops some of these ideas in a bit more detail; it may - be useful if the treatment here is too dense.) + `Rel.lidr` develops some of these ideas in a bit more detail; it may + be useful if the treatment here is too dense. - A _binary relation_ on a set [X] is a family of propositions - parameterized by two elements of [X] -- i.e., a proposition about - pairs of elements of [X]. *) +A _binary relation_ on a set `X` is a family of propositions +parameterized by two elements of `X` -- i.e., a proposition about +pairs of elements of `X`. > Relation : Type -> Type > Relation t = t -> t -> Type -(** Our main examples of such relations in this chapter will be - the single-step reduction relation, [==>], and its multi-step - variant, [==>*] (defined below), but there are many other +Our main examples of such relations in this chapter will be + the single-step reduction relation, `->>`, and its multi-step + variant, `->>*` (defined below), but there are many other examples -- e.g., the "equals," "less than," "less than or equal to," and "is the square of" relations on numbers, and the "prefix - of" relation on lists and strings. *) + of" relation on lists and strings. -(** One simple property of the [==>] relation is that, like the +One simple property of the `->>` relation is that, like the big-step evaluation relation for Imp, it is _deterministic_. - _Theorem_: For each [t], there is at most one [t'] such that [t] - steps to [t'] ([t ==> t'] is provable). This is the - same as saying that [==>] is deterministic. *) +_Theorem_: For each `t`, there is at most one `t'` such that `t` +steps to `t'` (`t ->> t'` is provable). This is the +same as saying that `->>` is deterministic. -(** _Proof sketch_: We show that if [x] steps to both [y1] and - [y2], then [y1] and [y2] are equal, by induction on a derivation - of [step x y1]. There are several cases to consider, depending on +_Proof sketch_: We show that if `x` steps to both `y1` and + `y2`, then `y1` and `y2` are equal, by induction on a derivation + of `step x y1`. There are several cases to consider, depending on the last rule used in this derivation and the last rule in the - given derivation of [step x y2]. + given derivation of `step x y2`. - - If both are [ST_PlusConstConst], the result is immediate. +- If both are `ST_PlusConstConst'`, the result is immediate. - - The cases when both derivations end with [ST_Plus1] or - [ST_Plus2] follow by the induction hypothesis. +- The cases when both derivations end with `ST_Plus1` or + `ST_Plus2` follow by the induction hypothesis. - - It cannot happen that one is [ST_PlusConstConst] and the other - is [ST_Plus1] or [ST_Plus2], since this would imply that [x] - has the form [P t1 t2] where both [t1] and [t2] are - constants (by [ST_PlusConstConst]) _and_ one of [t1] or [t2] - has the form [P _]. +- It cannot happen that one is `ST_PlusConstConst'` and the other + is `ST_Plus1` or `ST_Plus2'`, since this would imply that `x` + has the form `P t1 t2` where both `t1` and `t2` are + constants (by `ST_PlusConstConst'`) _and_ one of `t1` or `t2` + has the form `P _`. - - Similarly, it cannot happen that one is [ST_Plus1] and the - other is [ST_Plus2], since this would imply that [x] has the - form [P t1 t2] where [t1] has both the form [P t11 t12] and the - form [C n]. [] *) +- Similarly, it cannot happen that one is `ST_Plus1'` and the + other is `ST_Plus2'`, since this would imply that `x` has the + form `P t1 t2` where `t1` has both the form `P t11 t12` and the + form `C n`. -(** Formally: *) +Formally: > deterministic : {xt: Type} -> {x: xt} -> {y1: xt} -> {y2: xt} -> (r: Relation xt) -> Type > deterministic {xt} {x} {y1} {y2} r = r x y1 -> r x y2 -> y1 = y2 -> namespace SimpleArith2 - -> step_deterministic : deterministic Step -> step_deterministic ST_PlusConstConst hyp = -> case hyp of -> ST_PlusConstConst => Refl -> ST_Plus1 _ impossible -> ST_Plus2 _ impossible -> step_deterministic (ST_Plus1 l) hyp = -> case hyp of -> ST_PlusConstConst impossible -> ST_Plus1 l' => rewrite step_deterministic l l' in Refl -> ST_Plus2 _ impossible -> step_deterministic (ST_Plus2 r) hyp = -> case hyp of -> ST_PlusConstConst impossible -> ST_Plus1 _ impossible -> ST_Plus2 r' => rewrite step_deterministic r r' in Refl -(* ================================================================= *) -(** ** Values *) +> step_deterministic : deterministic Step' +> step_deterministic ST_PlusConstConst' hyp = +> case hyp of +> ST_PlusConstConst' => Refl +> ST_Plus1' _ impossible +> ST_Plus2' _ impossible +> step_deterministic (ST_Plus1' l) hyp = +> case hyp of +> ST_PlusConstConst' impossible +> ST_Plus1' l' => rewrite step_deterministic l l' in Refl +> ST_Plus2' _ impossible +> step_deterministic (ST_Plus2' r) hyp = +> case hyp of +> ST_PlusConstConst' impossible +> ST_Plus1' _ impossible +> ST_Plus2' r' => rewrite step_deterministic r r' in Refl + + +== Values -(** Next, it will be useful to slightly reformulate the +Next, it will be useful to slightly reformulate the definition of single-step reduction by stating it in terms of - "values." *) + "values." -(** It is useful to think of the [==>] relation as defining an +It is useful to think of the `->>` relation as defining an _abstract machine_: - - At any moment, the _state_ of the machine is a term. +- At any moment, the _state_ of the machine is a term. - - A _step_ of the machine is an atomic unit of computation -- - here, a single "add" operation. +- A _step_ of the machine is an atomic unit of computation -- + here, a single "add" operation. - - The _halting states_ of the machine are ones where there is no - more computation to be done. *) +- The _halting states_ of the machine are ones where there is no + more computation to be done. *) -(** We can then execute a term [t] as follows: +We can then execute a term `t` as follows: - - Take [t] as the starting state of the machine. +- Take `t` as the starting state of the machine. - - Repeatedly use the [==>] relation to find a sequence of - machine states, starting with [t], where each state steps to - the next. +- Repeatedly use the `->>` relation to find a sequence of + machine states, starting with `t`, where each state steps to + the next. - - When no more reduction is possible, "read out" the final state - of the machine as the result of execution. *) +- When no more reduction is possible, "read out" the final state + of the machine as the result of execution. -(** Intuitively, it is clear that the final states of the - machine are always terms of the form [C n] for some [n]. - We call such terms _values_. *) +Intuitively, it is clear that the final states of the + machine are always terms of the form `C n` for some `n`. + We call such terms _values_. > data Value : Tm -> Type where > V_const : (n : Nat) -> Value (C n) > -(** Having introduced the idea of values, we can use it in the - definition of the [==>] relation to write [ST_Plus2] rule in a - slightly more elegant way: *) - -(** - ------------------------------- (ST_PlusConstConst) - P (C n1) (C n2) ==> C (n1 + n2) - - t1 ==> t1' - -------------------- (ST_Plus1) - P t1 t2 ==> P t1' t2 - - value v1 - t2 ==> t2' - -------------------- (ST_Plus2) - P v1 t2 ==> P v1 t2' -*) -(** Again, the variable names here carry important information: - by convention, [v1] ranges only over values, while [t1] and [t2] +Having introduced the idea of values, we can use it in the + definition of the `>>-` relation to write `ST_Plus2` rule in a + slightly more elegant way: + + +\[ + \begin{prooftree} + \infer0[\idr{ST_PlusConstConst}]{\idr{P (C n1) (C n2) >>- C (n1 + n2)}} + \end{prooftree} +\] + +\[ + \begin{prooftree} + \hypo{\idr{t1 >>- t1'}} + \infer1[\idr{ST_Plus1}]{\idr{P t1 t2 >>- P t1' t2}} + \end{prooftree} +\] + +\[ + \begin{prooftree} + \hypo{\idr{value v1}} + \hypo{\idr{t2 >>- t2'}} + \infer2[\idr{ST_Plus2}]{\idr{P v1 t2 >>- P v1 t2'}} + \end{prooftree} +\] + +Again, the variable names here carry important information: + by convention, `v1` ranges only over values, while `t1` and `t2` range over arbitrary terms. (Given this convention, the explicit - [value] hypothesis is arguably redundant. We'll keep it for now, + `value` hypothesis is arguably redundant. We'll keep it for now, to maintain a close correspondence between the informal and Coq versions of the rules, but later on we'll drop it in informal - rules for brevity.) *) + rules for brevity.) -(** Here are the formal rules: *) +Here are the formal rules: > mutual -> infixl 6 >>> -> (>>>) : Tm -> Tm -> Type -> (>>>) = Smallstep.Step +> infixl 6 >>- +> (>>-) : Tm -> Tm -> Type +> (>>-) = Step > > data Step : Tm -> Tm -> Type where -> ST_PlusConstConst : P (C n1) (C n2) >>> C (n1 + n2) -> ST_Plus1 : t1 >>> t1' -> P t1 t2 >>> P t1' t2 -> ST_Plus2 : Value v1 -> t2 >>> t2' -> P v1 t2 >>> P v1 t2' +> ST_PlusConstConst : P (C n1) (C n2) >>- C (n1 + n2) +> ST_Plus1 : t1 >>- t1' -> P t1 t2 >>- P t1' t2 +> ST_Plus2 : Value v1 -> t2 >>- t2' -> P v1 t2 >>- P v1 t2' -(** **** Exercise: 3 stars, recommended (redo_determinism) *) -(** As a sanity check on this change, let's re-verify determinism. +==== Exercise: 3 stars, recommended (redo_determinism) - _Proof sketch_: We must show that if [x] steps to both [y1] and - [y2], then [y1] and [y2] are equal. Consider the final rules used - in the derivations of [step x y1] and [step x y2]. +As a sanity check on this change, let's re-verify determinism. - - If both are [ST_PlusConstConst], the result is immediate. +_Proof sketch_: We must show that if `x` steps to both `y1` and +`y2`, then `y1` and `y2` are equal. Consider the final rules used +in the derivations of `step x y1` and `step x y2`. - - It cannot happen that one is [ST_PlusConstConst] and the other - is [ST_Plus1] or [ST_Plus2], since this would imply that [x] has - the form [P t1 t2] where both [t1] and [t2] are constants (by - [ST_PlusConstConst]) _and_ one of [t1] or [t2] has the form [P _]. +- If both are `ST_PlusConstConst`, the result is immediate. - - Similarly, it cannot happen that one is [ST_Plus1] and the other - is [ST_Plus2], since this would imply that [x] has the form [P - t1 t2] where [t1] both has the form [P t11 t12] and is a - value (hence has the form [C n]). +- It cannot happen that one is `ST_PlusConstConst` and the other + is `ST_Plus1` or `ST_Plus2`, since this would imply that `x` has + the form `P t1 t2` where both `t1` and `t2` are constants (by + `ST_PlusConstConst`) _and_ one of `t1` or `t2` has the form `P _`. - - The cases when both derivations end with [ST_Plus1] or - [ST_Plus2] follow by the induction hypothesis. [] *) +- Similarly, it cannot happen that one is `ST_Plus1` and the other + is `ST_Plus2`, since this would imply that `x` has the form `P + t1 t2` where `t1` both has the form `P t11 t12` and is a + value (hence has the form `C n`). -(** Most of this proof is the same as the one above. But to get +- The cases when both derivations end with `ST_Plus1` or + `ST_Plus2` follow by the induction hypothesis. + +Most of this proof is the same as the one above. But to get maximum benefit from the exercise you should try to write your formal version from scratch and just use the earlier one if you - get stuck. *) + get stuck. -Theorem step_deterministic : - deterministic step. -Proof. - (* FILL IN HERE *) Admitted. -(** [] *) +> step_deterministic' : deterministic Step +> step_deterministic' = ?step_deterministic_rhs +> -(* ================================================================= *) -(** ** Strong Progress and Normal Forms *) -(** The definition of single-step reduction for our toy language +== Strong Progress and Normal Forms + +The definition of single-step reduction for our toy language is fairly simple, but for a larger language it would be easy to forget one of the rules and accidentally create a situation where some term cannot take a step even though it has not been completely reduced to a value. The following theorem shows that - we did not, in fact, make such a mistake here. *) + we did not, in fact, make such a mistake here. + +_Theorem_ (_Strong Progress_): If `t` is a term, then either `t` + is a value or else there exists a term `t'` such that `t >>- t'`. -(** _Theorem_ (_Strong Progress_): If [t] is a term, then either [t] - is a value or else there exists a term [t'] such that [t ==> t']. *) +_Proof_: By induction on `t`. -(** _Proof_: By induction on [t]. +- Suppose `t = C n`. Then `t` is a value. - - Suppose [t = C n]. Then [t] is a value. +- Suppose `t = P t1 t2`, where (by the IH) `t1` either is a value + or can step to some `t1'`, and where `t2` is either a value or + can step to some `t2'`. We must show `P t1 t2` is either a value + or steps to some `t'`. - - Suppose [t = P t1 t2], where (by the IH) [t1] either is a value - or can step to some [t1'], and where [t2] is either a value or - can step to some [t2']. We must show [P t1 t2] is either a value - or steps to some [t']. + - If `t1` and `t2` are both values, then `t` can take a step, by + `ST_PlusConstConst`. - - If [t1] and [t2] are both values, then [t] can take a step, by - [ST_PlusConstConst]. + - If `t1` is a value and `t2` can take a step, then so can `t`, + by `ST_Plus2`. - - If [t1] is a value and [t2] can take a step, then so can [t], - by [ST_Plus2]. + - If `t1` can take a step, then so can `t`, by `ST_Plus1`. - - If [t1] can take a step, then so can [t], by [ST_Plus1]. [] +Or, formally: - Or, formally: *) +> strong_progress : (t: Tm) -> Either (Value t) (t': Tm ** Smallstep.Step t t') -> strong_progress : (t: Tm) -> Either (Value t) (t': Tm ** Smallstep.Step t t') -> strong_progress (C n) = Left (V_const n) -> strong_progress (P (C n) r) = Right $ +> strong_progress (C n) = Left (V_const n) +> strong_progress (P (C n) r) = Right $ > case r of > (C n') => (C (n + n') ** ST_PlusConstConst) > (P l' r') => case strong_progress (P l' r') of > Right (r ** prf1) => (P (C n) r ** ST_Plus2 (V_const n) prf1) > Left (V_const (Smallstep.P l r)) impossible -> strong_progress (P (P l' r') r) = Right $ +> strong_progress (P (P l' r') r) = Right $ > case strong_progress (P l' r') of > Right (l ** prf1) => (P l r ** ST_Plus1 prf1) > Left (V_const (Smallstep.P l r)) impossible -(** This important property is called _strong progress_, because +This important property is called _strong progress_, because every term either is a value or can "make progress" by stepping to some other term. (The qualifier "strong" distinguishes it from a more refined version that we'll see in later chapters, called - just _progress_.) *) + just _progress_.) -(** The idea of "making progress" can be extended to tell us something +The idea of "making progress" can be extended to tell us something interesting about values: in this language, values are exactly the terms that _cannot_ make progress in this sense. - To state this observation formally, let's begin by giving a name +To state this observation formally, let's begin by giving a name to terms that cannot make progress. We'll call them _normal - forms_. *) + forms_. > normal_form : {X:Type} -> Relation X -> X -> Type > normal_form r t = Not (t' ** r t t') -(** Note that this definition specifies what it is to be a normal form - for an _arbitrary_ relation [R] over an arbitrary set [X], not +Note that this definition specifies what it is to be a normal form + for an _arbitrary_ relation `R` over an arbitrary set `X`, not just for the particular single-step reduction relation over terms that we are interested in at the moment. We'll re-use the same terminology for talking about other relations later in the - course. *) + course. -(** We can use this terminology to generalize the observation we made +We can use this terminology to generalize the observation we made in the strong progress theorem: in this language, normal forms and - values are actually the same thing. *) + values are actually the same thing. > value_is_nf : (v : Tm) -> Value v -> normal_form Smallstep.Step v > value_is_nf (C n) prf = notStepCN @@ -468,119 +489,96 @@ Proof. > nf_same_as_value : (normal_form Smallstep.Step t) <-> (Value t) > nf_same_as_value {t} = (nf_is_value t,value_is_nf t) -(** Why is this interesting? +Why is this interesting? - Because [value] is a syntactic concept -- it is defined by looking - at the form of a term -- while [normal_form] is a semantic one -- - it is defined by looking at how the term steps. It is not obvious - that these concepts should coincide! *) +Because `value` is a syntactic concept -- it is defined by looking +at the form of a term -- while `normal_form` is a semantic one -- +it is defined by looking at how the term steps. It is not obvious +that these concepts should coincide! -(** Indeed, we could easily have written the definitions so that they - would _not_ coincide. *) +Indeed, we could easily have written the definitions so that they + would _not_ coincide. -(** **** Exercise: 3 stars, optional (value_not_same_as_normal_form1) *) -(** We might, for example, mistakenly define [value] so that it - includes some terms that are not finished reducing. *) -(** (Even if you don't work this exercise and the following ones - in Coq, make sure you can think of an example of such a term.) *) +==== Exercise: 3 stars, optional (value_not_same_as_normal_form1) -Module Temp1. +We might, for example, mistakenly define `value` so that it + includes some terms that are not finished reducing. -Inductive value : tm -> Prop := -| v_const : forall n, value (C n) -| v_funny : forall t1 n2, (* <---- *) - value (P t1 (C n2)). +(Even if you don't work this exercise and the following ones + in Idris, make sure you can think of an example of such a term.) -Reserved Notation " t '==>' t' " (at level 40). -Inductive step : tm -> tm -> Prop := - | ST_PlusConstConst : forall n1 n2, - P (C n1) (C n2) ==> C (n1 + n2) - | ST_Plus1 : forall t1 t1' t2, - t1 ==> t1' -> - P t1 t2 ==> P t1' t2 - | ST_Plus2 : forall v1 t2 t2', - value v1 -> - t2 ==> t2' -> - P v1 t2 ==> P v1 t2' +> data Value' : Tm -> Type where +> V_const' : {n: Nat} -> Value' (C n) +> V_funny : {t1: Tm} -> {n2: Nat} -> Value' (P t1 (C n2)) - where " t '==>' t' " := (step t t'). - -Lemma value_not_same_as_normal_form : - exists v, value v /\ ~ normal_form step v. -Proof. - (* FILL IN HERE *) Admitted. -End Temp1. - -(** [] *) - -(** **** Exercise: 2 stars, optional (value_not_same_as_normal_form2) *) -(** Alternatively, we might mistakenly define [step] so that it - permits something designated as a value to reduce further. *) - -Module Temp2. - -Inductive value : tm -> Prop := -| v_const : forall n, value (C n). - -Reserved Notation " t '==>' t' " (at level 40). - -Inductive step : tm -> tm -> Prop := - | ST_Funny : forall n, (* <---- *) - C n ==> P (C n) (C 0) - | ST_PlusConstConst : forall n1 n2, - P (C n1) (C n2) ==> C (n1 + n2) - | ST_Plus1 : forall t1 t1' t2, - t1 ==> t1' -> - P t1 t2 ==> P t1' t2 - | ST_Plus2 : forall v1 t2 t2', - value v1 -> - t2 ==> t2' -> - P v1 t2 ==> P v1 t2' +> mutual +> infixl 6 >>>- +> (>>>-) : Tm -> Tm -> Type +> (>>>-) = Step'' +> +> data Step'' : Tm -> Tm -> Type where +> ST_PlusConstConst'' : P (C n1) (C n2) >>>- C (n1 + n2) +> ST_Plus1'' : +> t1 >>>- t1' -> +> P t1 t2 >>>- P t1' t2 +> ST_Plus2'' : +> Value' v1 -> +> t2 >>>- t2' -> +> P v1 t2 >>>- P v1 t2' - where " t '==>' t' " := (step t t'). +> value_not_same_as_normal_form : (v : Tm ** (Value' v, Not (normal_form Step'' v))) +> value_not_same_as_normal_form = ?value_not_same_as_normal_form_rhs -Lemma value_not_same_as_normal_form : - exists v, value v /\ ~ normal_form step v. -Proof. - (* FILL IN HERE *) Admitted. +==== Exercise: 2 stars, optional (value_not_same_as_normal_form2) -End Temp2. -(** [] *) +Alternatively, we might mistakenly define `step` so that it + permits something designated as a value to reduce further. -(** **** Exercise: 3 stars, optional (value_not_same_as_normal_form3) *) -(** Finally, we might define [value] and [step] so that there is some - term that is not a value but that cannot take a step in the [step] +> mutual +> infixl 6 ->>>- +> (->>>-) : Tm -> Tm -> Type +> (->>>-) = Step''' +> +> data Step''' : Tm -> Tm -> Type where +> ST_Funny : C n ->>>- P (C n) (C 0) +> ST_PlusConstConst''' : P (C n1) (C n2) ->>>- C (n1 + n2) +> ST_Plus1''' : +> t1 ->>>- t1' -> +> P t1 t2 ->>>- P t1' t2 +> ST_Plus2''' : +> Value' v1 -> +> t2 ->>>- t2' -> +> P v1 t2 ->>>- P v1 t2' + +> value_not_same_as_normal_form''' : (v : Tm ** (Value v, Not (normal_form Step''' v))) +> value_not_same_as_normal_form''' = ?value_not_same_as_normal_form_rhs''' + +==== Exercise: 3 stars, optional (value_not_same_as_normal_form3) + +Finally, we might define `value` and `step` so that there is some + term that is not a value but that cannot take a step in the `step` relation. Such terms are said to be _stuck_. In this case this is caused by a mistake in the semantics, but we will also see situations where, even in a correct language definition, it makes - sense to allow some terms to be stuck. *) - -Module Temp3. + sense to allow some terms to be stuck. -Inductive value : tm -> Prop := - | v_const : forall n, value (C n). - -Reserved Notation " t '==>' t' " (at level 40). - -Inductive step : tm -> tm -> Prop := - | ST_PlusConstConst : forall n1 n2, - P (C n1) (C n2) ==> C (n1 + n2) - | ST_Plus1 : forall t1 t1' t2, - t1 ==> t1' -> - P t1 t2 ==> P t1' t2 +> mutual +> infixl 6 ->>- +> (->>-) : Tm -> Tm -> Type +> (->>-) = Step'''' +> +> data Step'''' : Tm -> Tm -> Type where +> ST_PlusConstConst'''' : P (C n1) (C n2) ->>- C (n1 + n2) +> ST_Plus1'''' : +> t1 ->>- t1' -> +> P t1 t2 ->>- P t1' t2 - where " t '==>' t' " := (step t t'). +(Note that `ST_Plus2` is missing.) -(** (Note that [ST_Plus2] is missing.) *) +> value_not_same_as_normal_form'''' : (t : Tm ** (Not (Value t), normal_form Step'''' t)) +> value_not_same_as_normal_form'''' = ?value_not_same_as_normal_form_rhs'''' -Lemma value_not_same_as_normal_form : - exists t, ~ value t /\ normal_form step t. -Proof. - (* FILL IN HERE *) Admitted. - -End Temp3. -(** [] *) (* ----------------------------------------------------------------- *) (** *** Additional Exercises *) @@ -600,18 +598,18 @@ Inductive value : tm -> Prop := | v_true : value ttrue | v_false : value tfalse. -Reserved Notation " t '==>' t' " (at level 40). +Reserved Notation " t '->>' t' " (at level 40). Inductive step : tm -> tm -> Prop := | ST_IfTrue : forall t1 t2, - tif ttrue t1 t2 ==> t1 + tif ttrue t1 t2 ->> t1 | ST_IfFalse : forall t1 t2, - tif tfalse t1 t2 ==> t2 + tif tfalse t1 t2 ->> t2 | ST_If : forall t1 t1' t2 t3, - t1 ==> t1' -> - tif t1 t2 t3 ==> tif t1' t2 t3 + t1 ->> t1' -> + tif t1 t2 t3 ->> tif t1' t2 t3 - where " t '==>' t' " := (step t t'). + where " t '->>' t' " := (step t t'). (** **** Exercise: 1 star (smallstep_bools) *) (** Which of the following propositions are provable? (This is just a @@ -619,7 +617,7 @@ Inductive step : tm -> tm -> Prop := your answers in Coq.) *) Definition bool_step_prop1 := - tfalse ==> tfalse. + tfalse ->> tfalse. (* FILL IN HERE *) @@ -628,7 +626,7 @@ Definition bool_step_prop2 := ttrue (tif ttrue ttrue ttrue) (tif tfalse tfalse tfalse) - ==> + ->> ttrue. (* FILL IN HERE *) @@ -638,7 +636,7 @@ Definition bool_step_prop3 := (tif ttrue ttrue ttrue) (tif ttrue ttrue ttrue) tfalse - ==> + ->> tif ttrue (tif ttrue ttrue ttrue) @@ -652,7 +650,7 @@ Definition bool_step_prop3 := do so for boolean expressions, as well. *) Theorem strong_progress : forall t, - value t \/ (exists t', t ==> t'). + value t \/ (exists t', t ->> t'). Proof. (* FILL IN HERE *) Admitted. (** [] *) @@ -668,9 +666,9 @@ Module Temp5. (** **** Exercise: 2 stars (smallstep_bool_shortcut) *) (** Suppose we want to add a "short circuit" to the step relation for - boolean expressions, so that it can recognize when the [then] and - [else] branches of a conditional are the same value (either - [ttrue] or [tfalse]) and reduce the whole conditional to this + boolean expressions, so that it can recognize when the `then` and + `else` branches of a conditional are the same value (either + `ttrue` or `tfalse`) and reduce the whole conditional to this value in a single step, even if the guard has not yet been reduced to a value. For example, we would like this proposition to be provable: @@ -679,33 +677,33 @@ Module Temp5. (tif ttrue ttrue ttrue) tfalse tfalse - ==> + ->> tfalse. *) (** Write an extra clause for the step relation that achieves this - effect and prove [bool_step_prop4]. *) + effect and prove `bool_step_prop4`. *) -Reserved Notation " t '==>' t' " (at level 40). +Reserved Notation " t '->>' t' " (at level 40). Inductive step : tm -> tm -> Prop := | ST_IfTrue : forall t1 t2, - tif ttrue t1 t2 ==> t1 + tif ttrue t1 t2 ->> t1 | ST_IfFalse : forall t1 t2, - tif tfalse t1 t2 ==> t2 + tif tfalse t1 t2 ->> t2 | ST_If : forall t1 t1' t2 t3, - t1 ==> t1' -> - tif t1 t2 t3 ==> tif t1' t2 t3 + t1 ->> t1' -> + tif t1 t2 t3 ->> tif t1' t2 t3 (* FILL IN HERE *) - where " t '==>' t' " := (step t t'). + where " t '->>' t' " := (step t t'). Definition bool_step_prop4 := tif (tif ttrue ttrue ttrue) tfalse tfalse - ==> + ->> tfalse. Example bool_step_prop4_holds : @@ -718,9 +716,9 @@ Proof. (** It can be shown that the determinism and strong progress theorems for the step relation in the lecture notes also hold for the definition of step given above. After we add the clause - [ST_ShortCircuit]... + `ST_ShortCircuit`... - - Is the [step] relation still deterministic? Write yes or no and + - Is the `step` relation still deterministic? Write yes or no and briefly (1 sentence) explain your answer. Optional: prove your answer correct in Coq. *) @@ -747,17 +745,19 @@ Proof. End Temp5. End Temp4. --- Multi-Step Reduction +> {-} + +==== Multi-Step Reduction We've been working so far with the _single-step reduction_ -relation [==>], which formalizes the individual steps of an +relation [->>], which formalizes the individual steps of an abstract machine for executing programs. We can use the same machine to reduce programs to completion -- to find out what final result they yield. This can be formalized as follows: -- First, we define a _multi-step reduction relation_ [==>*], which +- First, we define a _multi-step reduction relation_ [->>*], which relates terms [t] and [t'] if [t] can reach [t'] by any number (including zero) of single reduction steps. @@ -804,16 +804,16 @@ elements [x] and [y] if is the sequence of intermediate steps of computation between [x] and [y]. *) -(** We write [==>*] for the [multi step] relation on terms. *) +(** We write [->>*] for the [multi step] relation on terms. *) -Notation " t '==>*' t' " := (multi step t t') (at level 40). +Notation " t '->>*' t' " := (multi step t t') (at level 40). -> syntax [t] "==>*" [t'] = Multi Smallstep.Step t t' +> syntax [t] "->>*" [t'] = Multi Smallstep.Step t t' (** The relation [multi R] has several crucial properties. First, it is obviously _reflexive_ (that is, [forall x, multi R x - x]). In the case of the [==>*] (i.e., [multi step]) relation, the + x]). In the case of the [->>*] (i.e., [multi step]) relation, the intuition is that a term can execute to itself by taking zero steps of execution. @@ -854,7 +854,7 @@ Proof. apply IHG. assumption. Qed. (** In particular, for the [multi step] relation on terms, if - [t1==>*t2] and [t2==>*t3], then [t1==>*t3]. *) + [t1->>*t2] and [t2->>*t3], then [t1->>*t3]. *) (* ================================================================= *) (** ** Examples *) @@ -865,7 +865,7 @@ Proof. > (P > (P (C 0) (C 3)) > (P (C 2) (C 4))) -> ==>* +> ->>* > C ((0 + 3) + (2 + 4)) > test_multistep_1 = > let z = C ((0 + 3) + (2 + 4)) @@ -877,7 +877,7 @@ Lemma test_multistep_1: P (P (C 0) (C 3)) (P (C 2) (C 4)) - ==>* + ->>* C ((0 + 3) + (2 + 4)). Proof. apply multi_step with @@ -899,7 +899,7 @@ Lemma test_multistep_1': P (P (C 0) (C 3)) (P (C 2) (C 4)) - ==>* + ->>* C ((0 + 3) + (2 + 4)). Proof. eapply multi_step. apply ST_Plus1. apply ST_PlusConstConst. @@ -910,7 +910,7 @@ Proof. (** **** Exercise: 1 star, optional (test_multistep_2) *) Lemma test_multistep_2: - C 3 ==>* C 3. + C 3 ->>* C 3. Proof. (* FILL IN HERE *) Admitted. (** [] *) @@ -918,7 +918,7 @@ Proof. (** **** Exercise: 1 star, optional (test_multistep_3) *) Lemma test_multistep_3: P (C 0) (C 3) - ==>* + ->>* P (C 0) (C 3). Proof. (* FILL IN HERE *) Admitted. @@ -931,7 +931,7 @@ Lemma test_multistep_4: (P (C 2) (P (C 0) (C 3))) - ==>* + ->>* P (C 0) (C (2 + (0 + 3))). @@ -957,7 +957,7 @@ Definition step_normal_form := normal_form step. > normal_form_of : Tm -> Tm -> Type -> normal_form_of t t' = ((t ==>* t'), step_normal_form t') +> normal_form_of t t' = ((t ->>* t'), step_normal_form t') (** We have already seen that, for our language, single-step reduction is @@ -1007,7 +1007,7 @@ Proof. -- > deterministic {xt} r = {x, y1, y2: xt) -> r x y1 -> r x y2 -> y1 = y2 > -- normal_form_of : Tm -> Tm -> Type -> -- normal_form_of t t' = ((t ==>* t'), step_normal_form t') +> -- normal_form_of t t' = ((t ->>* t'), step_normal_form t') (** Indeed, something stronger is true for this language (though not @@ -1031,7 +1031,7 @@ Definition normalizing {X:Type} (R:relation X) := similarly when [t] appears as the right-hand child of a [P] node whose left-hand child is a value. *) -> multistep_congr_1 : {t1, t1', t2: Tm} -> (t1 ==>* t1') -> ((P t1 t2) ==>* P t1' t2) +> multistep_congr_1 : {t1, t1', t2: Tm} -> (t1 ->>* t1') -> ((P t1 t2) ->>* P t1' t2) > multistep_congr_1 {t1} {t1'} {t2} mult = > case mult of > Multi_refl => Multi_refl @@ -1040,7 +1040,7 @@ Definition normalizing {X:Type} (R:relation X) := (** **** Exercise: 2 stars (multistep_congr_2) *) -> multistep_congr_2 : {t1, t2', t2: Tm} -> {v:Value t1} -> (t2 ==>* t2') -> ((P t1 t2) ==>* P t1 t2') +> multistep_congr_2 : {t1, t2', t2: Tm} -> {v:Value t1} -> (t2 ->>* t2') -> ((P t1 t2) ->>* P t1 t2') > multistep_congr_2 {t2'} {t2} {v=V_const i} mult = > case mult of > Multi_refl => Multi_refl @@ -1049,8 +1049,8 @@ Definition normalizing {X:Type} (R:relation X) := Lemma multistep_congr_2 : forall t1 t2 t2', value t1 -> - t2 ==>* t2' -> - P t1 t2 ==>* P t1 t2'. + t2 ->>* t2' -> + P t1 t2 ->>* P t1 t2'. Proof. (* FILL IN HERE *) Admitted. (** [] *) @@ -1074,7 +1074,7 @@ Proof. - [t = P t1 t2] for some [t1] and [t2]. By the IH, [t1] and [t2] have normal forms [t1'] and [t2']. Recall that normal forms are values (by [nf_same_as_value]); we know that [t1' = C n1] and - [t2' = C n2], for some [n1] and [n2]. We can combine the [==>*] + [t2' = C n2], for some [n1] and [n2]. We can combine the [->>*] derivations for [t1] and [t2] using [multi_congr_1] and [multi_congr_2] to prove that [P t1 t2] reduces in many steps to [C (n1 + n2)]. @@ -1103,7 +1103,7 @@ Proof. > m1 = replace p1 ih1l > m2 = replace p2 ih2l -> reduction : ((P l r) ==>* (C (plus n1 n2))) = +> reduction : ((P l r) ->>* (C (plus n1 n2))) = > let left_transform = multistep_congr_1 m1 > right_transform = > let leftT = multistep_congr_2 {v=V_const n1} m2 @@ -1167,7 +1167,7 @@ Proof. (** **** Exercise: 3 stars (eval__multistep) *) -> eval__multistep : {t: Tm} -> {n: Nat} -> t # n -> t ==>* C n +> eval__multistep : {t: Tm} -> {n: Nat} -> t # n -> t ->>* C n > eval__multistep hyp = > case hyp of > E_Const => Multi_refl @@ -1178,15 +1178,15 @@ Proof. (** The key ideas in the proof can be seen in the following picture: - P t1 t2 ==> (by ST_Plus1) - P t1' t2 ==> (by ST_Plus1) - P t1'' t2 ==> (by ST_Plus1) + P t1 t2 ->> (by ST_Plus1) + P t1' t2 ->> (by ST_Plus1) + P t1'' t2 ->> (by ST_Plus1) ... - P (C n1) t2 ==> (by ST_Plus2) - P (C n1) t2' ==> (by ST_Plus2) - P (C n1) t2'' ==> (by ST_Plus2) + P (C n1) t2 ->> (by ST_Plus2) + P (C n1) t2' ->> (by ST_Plus2) + P (C n1) t2'' ->> (by ST_Plus2) ... - P (C n1) (C n2) ==> (by ST_PlusConstConst) + P (C n1) (C n2) ->> (by ST_PlusConstConst) C (n1 + n2) That is, the multistep reduction of a term of the form [P t1 t2] @@ -1203,8 +1203,8 @@ Proof. (** To formalize this intuition, you'll need to use the congruence lemmas from above (you might want to review them now, so that you'll be able to recognize when they are useful), plus some basic - properties of [==>*]: that it is reflexive, transitive, and - includes [==>]. *) + properties of [->>*]: that it is reflexive, transitive, and + includes [->>]. *) Proof. (* FILL IN HERE *) Admitted. @@ -1222,7 +1222,7 @@ Proof. (** **** Exercise: 3 stars (step__eval) *) Lemma step__eval : forall t t' n, - t ==> t' -> + t ->> t' -> t' \\ n -> t \\ n. Proof. @@ -1280,27 +1280,27 @@ Inductive value : tm -> Prop := | v_true : value ttrue | v_false : value tfalse. -Reserved Notation " t '==>' t' " (at level 40). +Reserved Notation " t '->>' t' " (at level 40). Inductive step : tm -> tm -> Prop := | ST_PlusConstConst : forall n1 n2, - P (C n1) (C n2) ==> C (n1 + n2) + P (C n1) (C n2) ->> C (n1 + n2) | ST_Plus1 : forall t1 t1' t2, - t1 ==> t1' -> - P t1 t2 ==> P t1' t2 + t1 ->> t1' -> + P t1 t2 ->> P t1' t2 | ST_Plus2 : forall v1 t2 t2', value v1 -> - t2 ==> t2' -> - P v1 t2 ==> P v1 t2' + t2 ->> t2' -> + P v1 t2 ->> P v1 t2' | ST_IfTrue : forall t1 t2, - tif ttrue t1 t2 ==> t1 + tif ttrue t1 t2 ->> t1 | ST_IfFalse : forall t1 t2, - tif tfalse t1 t2 ==> t2 + tif tfalse t1 t2 ->> t2 | ST_If : forall t1 t1' t2 t3, - t1 ==> t1' -> - tif t1 t2 t3 ==> tif t1' t2 t3 + t1 ->> t1' -> + tif t1 t2 t3 ->> tif t1' t2 t3 - where " t '==>' t' " := (step t t'). + where " t '->>' t' " := (step t t'). (** Earlier, we separately proved for both plus- and if-expressions... @@ -1327,98 +1327,98 @@ End Combined. (** The small-step reduction relations for arithmetic and boolean expressions are straightforward extensions of the tiny language we've been working up to now. To make them easier to - read, we introduce the symbolic notations [==>a] and [==>b] for + read, we introduce the symbolic notations [->>a] and [->>b] for the arithmetic and boolean step relations. *) Inductive aval : aexp -> Prop := | av_num : forall n, aval (ANum n). (** We are not actually going to bother to define boolean - values, since they aren't needed in the definition of [==>b] + values, since they aren't needed in the definition of [->>b] below (why?), though they might be if our language were a bit larger (why?). *) -Reserved Notation " t '/' st '==>a' t' " +Reserved Notation " t '/' st '->>a' t' " (at level 40, st at level 39). Inductive astep : state -> aexp -> aexp -> Prop := | AS_Id : forall st i, - AId i / st ==>a ANum (st i) + AId i / st ->>a ANum (st i) | AS_Plus : forall st n1 n2, - APlus (ANum n1) (ANum n2) / st ==>a ANum (n1 + n2) + APlus (ANum n1) (ANum n2) / st ->>a ANum (n1 + n2) | AS_Plus1 : forall st a1 a1' a2, - a1 / st ==>a a1' -> - (APlus a1 a2) / st ==>a (APlus a1' a2) + a1 / st ->>a a1' -> + (APlus a1 a2) / st ->>a (APlus a1' a2) | AS_Plus2 : forall st v1 a2 a2', aval v1 -> - a2 / st ==>a a2' -> - (APlus v1 a2) / st ==>a (APlus v1 a2') + a2 / st ->>a a2' -> + (APlus v1 a2) / st ->>a (APlus v1 a2') | AS_Minus : forall st n1 n2, - (AMinus (ANum n1) (ANum n2)) / st ==>a (ANum (minus n1 n2)) + (AMinus (ANum n1) (ANum n2)) / st ->>a (ANum (minus n1 n2)) | AS_Minus1 : forall st a1 a1' a2, - a1 / st ==>a a1' -> - (AMinus a1 a2) / st ==>a (AMinus a1' a2) + a1 / st ->>a a1' -> + (AMinus a1 a2) / st ->>a (AMinus a1' a2) | AS_Minus2 : forall st v1 a2 a2', aval v1 -> - a2 / st ==>a a2' -> - (AMinus v1 a2) / st ==>a (AMinus v1 a2') + a2 / st ->>a a2' -> + (AMinus v1 a2) / st ->>a (AMinus v1 a2') | AS_Mult : forall st n1 n2, - (AMult (ANum n1) (ANum n2)) / st ==>a (ANum (mult n1 n2)) + (AMult (ANum n1) (ANum n2)) / st ->>a (ANum (mult n1 n2)) | AS_Mult1 : forall st a1 a1' a2, - a1 / st ==>a a1' -> - (AMult a1 a2) / st ==>a (AMult a1' a2) + a1 / st ->>a a1' -> + (AMult a1 a2) / st ->>a (AMult a1' a2) | AS_Mult2 : forall st v1 a2 a2', aval v1 -> - a2 / st ==>a a2' -> - (AMult v1 a2) / st ==>a (AMult v1 a2') + a2 / st ->>a a2' -> + (AMult v1 a2) / st ->>a (AMult v1 a2') - where " t '/' st '==>a' t' " := (astep st t t'). + where " t '/' st '->>a' t' " := (astep st t t'). -Reserved Notation " t '/' st '==>b' t' " +Reserved Notation " t '/' st '->>b' t' " (at level 40, st at level 39). Inductive bstep : state -> bexp -> bexp -> Prop := | BS_Eq : forall st n1 n2, - (BEq (ANum n1) (ANum n2)) / st ==>b + (BEq (ANum n1) (ANum n2)) / st ->>b (if (beq_nat n1 n2) then BTrue else BFalse) | BS_Eq1 : forall st a1 a1' a2, - a1 / st ==>a a1' -> - (BEq a1 a2) / st ==>b (BEq a1' a2) + a1 / st ->>a a1' -> + (BEq a1 a2) / st ->>b (BEq a1' a2) | BS_Eq2 : forall st v1 a2 a2', aval v1 -> - a2 / st ==>a a2' -> - (BEq v1 a2) / st ==>b (BEq v1 a2') + a2 / st ->>a a2' -> + (BEq v1 a2) / st ->>b (BEq v1 a2') | BS_LtEq : forall st n1 n2, - (BLe (ANum n1) (ANum n2)) / st ==>b + (BLe (ANum n1) (ANum n2)) / st ->>b (if (leb n1 n2) then BTrue else BFalse) | BS_LtEq1 : forall st a1 a1' a2, - a1 / st ==>a a1' -> - (BLe a1 a2) / st ==>b (BLe a1' a2) + a1 / st ->>a a1' -> + (BLe a1 a2) / st ->>b (BLe a1' a2) | BS_LtEq2 : forall st v1 a2 a2', aval v1 -> - a2 / st ==>a a2' -> - (BLe v1 a2) / st ==>b (BLe v1 a2') + a2 / st ->>a a2' -> + (BLe v1 a2) / st ->>b (BLe v1 a2') | BS_NotTrue : forall st, - (BNot BTrue) / st ==>b BFalse + (BNot BTrue) / st ->>b BFalse | BS_NotFalse : forall st, - (BNot BFalse) / st ==>b BTrue + (BNot BFalse) / st ->>b BTrue | BS_NotStep : forall st b1 b1', - b1 / st ==>b b1' -> - (BNot b1) / st ==>b (BNot b1') + b1 / st ->>b b1' -> + (BNot b1) / st ->>b (BNot b1') | BS_AndTrueTrue : forall st, - (BAnd BTrue BTrue) / st ==>b BTrue + (BAnd BTrue BTrue) / st ->>b BTrue | BS_AndTrueFalse : forall st, - (BAnd BTrue BFalse) / st ==>b BFalse + (BAnd BTrue BFalse) / st ->>b BFalse | BS_AndFalse : forall st b2, - (BAnd BFalse b2) / st ==>b BFalse + (BAnd BFalse b2) / st ->>b BFalse | BS_AndTrueStep : forall st b2 b2', - b2 / st ==>b b2' -> - (BAnd BTrue b2) / st ==>b (BAnd BTrue b2') + b2 / st ->>b b2' -> + (BAnd BTrue b2) / st ->>b (BAnd BTrue b2') | BS_AndStep : forall st b1 b1' b2, - b1 / st ==>b b1' -> - (BAnd b1 b2) / st ==>b (BAnd b1' b2) + b1 / st ->>b b1' -> + (BAnd b1 b2) / st ->>b (BAnd b1' b2) -where " t '/' st '==>b' t' " := (bstep st t t'). +where " t '/' st '->>b' t' " := (bstep st t t'). (** The semantics of commands is the interesting part. We need two small tricks to make it work: @@ -1442,33 +1442,33 @@ where " t '/' st '==>b' t' " := (bstep st t t'). command needs to be saved somewhere while a single copy of the loop body is being reduced.) *) -Reserved Notation " t '/' st '==>' t' '/' st' " +Reserved Notation " t '/' st '->>' t' '/' st' " (at level 40, st at level 39, t' at level 39). Inductive cstep : (com * state) -> (com * state) -> Prop := | CS_AssStep : forall st i a a', - a / st ==>a a' -> - (i ::= a) / st ==> (i ::= a') / st + a / st ->>a a' -> + (i ::= a) / st ->> (i ::= a') / st | CS_Ass : forall st i n, - (i ::= (ANum n)) / st ==> SKIP / (st & { i --> n }) + (i ::= (ANum n)) / st ->> SKIP / (st & { i --> n }) | CS_SeqStep : forall st c1 c1' st' c2, - c1 / st ==> c1' / st' -> - (c1 ;; c2) / st ==> (c1' ;; c2) / st' + c1 / st ->> c1' / st' -> + (c1 ;; c2) / st ->> (c1' ;; c2) / st' | CS_SeqFinish : forall st c2, - (SKIP ;; c2) / st ==> c2 / st + (SKIP ;; c2) / st ->> c2 / st | CS_IfTrue : forall st c1 c2, - IFB BTrue THEN c1 ELSE c2 FI / st ==> c1 / st + IFB BTrue THEN c1 ELSE c2 FI / st ->> c1 / st | CS_IfFalse : forall st c1 c2, - IFB BFalse THEN c1 ELSE c2 FI / st ==> c2 / st + IFB BFalse THEN c1 ELSE c2 FI / st ->> c2 / st | CS_IfStep : forall st b b' c1 c2, - b / st ==>b b' -> + b / st ->>b b' -> IFB b THEN c1 ELSE c2 FI / st - ==> (IFB b' THEN c1 ELSE c2 FI) / st + ->> (IFB b' THEN c1 ELSE c2 FI) / st | CS_While : forall st b c1, (WHILE b DO c1 END) / st - ==> (IFB b THEN (c1;; (WHILE b DO c1 END)) ELSE SKIP FI) / st + ->> (IFB b THEN (c1;; (WHILE b DO c1 END)) ELSE SKIP FI) / st - where " t '/' st '==>' t' '/' st' " := (cstep (t,st) (t',st')). + where " t '/' st '->>' t' '/' st' " := (cstep (t,st) (t',st')). (* ################################################################# *) (** * Concurrent Imp *) @@ -1507,40 +1507,40 @@ Notation "'PAR' c1 'WITH' c2 'END'" := Inductive cstep : (com * state) -> (com * state) -> Prop := (* Old part *) | CS_AssStep : forall st i a a', - a / st ==>a a' -> - (i ::= a) / st ==> (i ::= a') / st + a / st ->>a a' -> + (i ::= a) / st ->> (i ::= a') / st | CS_Ass : forall st i n, - (i ::= (ANum n)) / st ==> SKIP / st & { i --> n } + (i ::= (ANum n)) / st ->> SKIP / st & { i --> n } | CS_SeqStep : forall st c1 c1' st' c2, - c1 / st ==> c1' / st' -> - (c1 ;; c2) / st ==> (c1' ;; c2) / st' + c1 / st ->> c1' / st' -> + (c1 ;; c2) / st ->> (c1' ;; c2) / st' | CS_SeqFinish : forall st c2, - (SKIP ;; c2) / st ==> c2 / st + (SKIP ;; c2) / st ->> c2 / st | CS_IfTrue : forall st c1 c2, - (IFB BTrue THEN c1 ELSE c2 FI) / st ==> c1 / st + (IFB BTrue THEN c1 ELSE c2 FI) / st ->> c1 / st | CS_IfFalse : forall st c1 c2, - (IFB BFalse THEN c1 ELSE c2 FI) / st ==> c2 / st + (IFB BFalse THEN c1 ELSE c2 FI) / st ->> c2 / st | CS_IfStep : forall st b b' c1 c2, - b /st ==>b b' -> + b /st ->>b b' -> (IFB b THEN c1 ELSE c2 FI) / st - ==> (IFB b' THEN c1 ELSE c2 FI) / st + ->> (IFB b' THEN c1 ELSE c2 FI) / st | CS_While : forall st b c1, (WHILE b DO c1 END) / st - ==> (IFB b THEN (c1;; (WHILE b DO c1 END)) ELSE SKIP FI) / st + ->> (IFB b THEN (c1;; (WHILE b DO c1 END)) ELSE SKIP FI) / st (* New part: *) | CS_Par1 : forall st c1 c1' c2 st', - c1 / st ==> c1' / st' -> - (PAR c1 WITH c2 END) / st ==> (PAR c1' WITH c2 END) / st' + c1 / st ->> c1' / st' -> + (PAR c1 WITH c2 END) / st ->> (PAR c1' WITH c2 END) / st' | CS_Par2 : forall st c1 c2 c2' st', - c2 / st ==> c2' / st' -> - (PAR c1 WITH c2 END) / st ==> (PAR c1 WITH c2' END) / st' + c2 / st ->> c2' / st' -> + (PAR c1 WITH c2 END) / st ->> (PAR c1 WITH c2' END) / st' | CS_ParDone : forall st, - (PAR SKIP WITH SKIP END) / st ==> SKIP / st - where " t '/' st '==>' t' '/' st' " := (cstep (t,st) (t',st')). + (PAR SKIP WITH SKIP END) / st ->> SKIP / st + where " t '/' st '->>' t' '/' st' " := (cstep (t,st) (t',st')). Definition cmultistep := multi cstep. -Notation " t '/' st '==>*' t' '/' st' " := +Notation " t '/' st '->>*' t' '/' st' " := (multi cstep (t,st) (t',st')) (at level 40, st at level 39, t' at level 39). @@ -1561,7 +1561,7 @@ Definition par_loop : com := Example par_loop_example_0: exists st', - par_loop / { --> 0 } ==>* SKIP / st' + par_loop / { --> 0 } ->>* SKIP / st' /\ st' X = 0. Proof. eapply ex_intro. split. @@ -1582,7 +1582,7 @@ Proof. Example par_loop_example_2: exists st', - par_loop / { --> 0 } ==>* SKIP / st' + par_loop / { --> 0 } ->>* SKIP / st' /\ st' X = 2. Proof. eapply ex_intro. split. @@ -1630,7 +1630,7 @@ Proof. (** **** Exercise: 3 stars, optional (par_body_n__Sn) *) Lemma par_body_n__Sn : forall n st, st X = n /\ st Y = 0 -> - par_loop / st ==>* par_loop / st & { X --> S n}. + par_loop / st ->>* par_loop / st & { X --> S n}. Proof. (* FILL IN HERE *) Admitted. (** [] *) @@ -1639,7 +1639,7 @@ Proof. Lemma par_body_n : forall n st, st X = 0 /\ st Y = 0 -> exists st', - par_loop / st ==>* par_loop / st' /\ st' X = n /\ st' Y = 0. + par_loop / st ->>* par_loop / st' /\ st' X = n /\ st' Y = 0. Proof. (* FILL IN HERE *) Admitted. (** [] *) @@ -1649,7 +1649,7 @@ Proof. Theorem par_loop_any_X: forall n, exists st', - par_loop / { --> 0 } ==>* SKIP / st' + par_loop / { --> 0 } ->>* SKIP / st' /\ st' X = n. Proof. intros n. @@ -1723,3 +1723,5 @@ Proof. (** $Date$ *) + +> -} From 21524b60a7dc478fe7006e7d33317cf2ceb1d565 Mon Sep 17 00:00:00 2001 From: jutaro Date: Thu, 20 Sep 2018 00:39:05 +0200 Subject: [PATCH 06/30] Adding Exercises. --- src/Smallstep.lidr | 642 +++++++++++++++++---------------------------- 1 file changed, 240 insertions(+), 402 deletions(-) diff --git a/src/Smallstep.lidr b/src/Smallstep.lidr index 1051c08..02e385e 100644 --- a/src/Smallstep.lidr +++ b/src/Smallstep.lidr @@ -5,8 +5,7 @@ > module Smallstep > %access public export > %default total - - +> %hide Language.Reflection.P The evaluators we have seen so far (for `aexp`s, `bexp`s, commands, ...) have been formulated in a "big-step" style: they @@ -278,7 +277,7 @@ Formally: > ST_Plus2' r' => rewrite step_deterministic r r' in Refl -== Values +=== Values Next, it will be useful to slightly reformulate the definition of single-step reduction by stating it in terms of @@ -393,7 +392,7 @@ Most of this proof is the same as the one above. But to get > -== Strong Progress and Normal Forms +=== Strong Progress and Normal Forms The definition of single-step reduction for our toy language is fairly simple, but for a larger language it would be easy to @@ -424,7 +423,7 @@ _Proof_: By induction on `t`. Or, formally: -> strong_progress : (t: Tm) -> Either (Value t) (t': Tm ** Smallstep.Step t t') +> strong_progress : (t: Tm) -> Either (Value t) (t': Tm ** Step t t') > strong_progress (C n) = Left (V_const n) > strong_progress (P (C n) r) = Right $ @@ -432,11 +431,11 @@ Or, formally: > (C n') => (C (n + n') ** ST_PlusConstConst) > (P l' r') => case strong_progress (P l' r') of > Right (r ** prf1) => (P (C n) r ** ST_Plus2 (V_const n) prf1) -> Left (V_const (Smallstep.P l r)) impossible +> Left (V_const (P l r)) impossible > strong_progress (P (P l' r') r) = Right $ > case strong_progress (P l' r') of > Right (l ** prf1) => (P l r ** ST_Plus1 prf1) -> Left (V_const (Smallstep.P l r)) impossible +> Left (V_const (P l r)) impossible This important property is called _strong progress_, because every term either is a value or can "make progress" by stepping to @@ -466,15 +465,15 @@ We can use this terminology to generalize the observation we made in the strong progress theorem: in this language, normal forms and values are actually the same thing. -> value_is_nf : (v : Tm) -> Value v -> normal_form Smallstep.Step v +> value_is_nf : (v : Tm) -> Value v -> normal_form Step v > value_is_nf (C n) prf = notStepCN -> where notStepCN: (t' : Tm ** Smallstep.Step (C n) t') -> Void +> where notStepCN: (t' : Tm ** Step (C n) t') -> Void > notStepCN (t' ** c) impossible > value_is_nf (P l r) prf = void (notValueP prf) > where notValueP: Not (Value (P l r)) > notValueP (V_const _) impossible -> nf_is_value : (v : Tm) -> normal_form Smallstep.Step v -> Value v +> nf_is_value : (v : Tm) -> normal_form Step v -> Value v > nf_is_value (C n) prf = V_const n > nf_is_value (P l r) prf = > case strong_progress (P l r) of @@ -486,7 +485,7 @@ We can use this terminology to generalize the observation we made > syntax [p] "<->" [q] = iff {p} {q} -> nf_same_as_value : (normal_form Smallstep.Step t) <-> (Value t) +> nf_same_as_value : (normal_form Step t) <-> (Value t) > nf_same_as_value {t} = (nf_is_value t,value_is_nf t) Why is this interesting? @@ -580,92 +579,80 @@ Finally, we might define `value` and `step` so that there is some > value_not_same_as_normal_form'''' = ?value_not_same_as_normal_form_rhs'''' -(* ----------------------------------------------------------------- *) -(** *** Additional Exercises *) +=== Additional Exercises -Module Temp4. - -(** Here is another very simple language whose terms, instead of being +Here is another very simple language whose terms, instead of being just addition expressions and numbers, are just the booleans true - and false and a conditional expression... *) + and false and a conditional expression... -Inductive tm : Type := - | ttrue : tm - | tfalse : tm - | tif : tm -> tm -> tm -> tm. +> data TmB : Type where +> Ttrue : TmB +> Tfalse : TmB +> Tif : TmB -> TmB -> TmB -> TmB -Inductive value : tm -> Prop := - | v_true : value ttrue - | v_false : value tfalse. +> data ValueB : TmB -> Type where +> V_true : ValueB Ttrue +> V_false : ValueB Tfalse -Reserved Notation " t '->>' t' " (at level 40). -Inductive step : tm -> tm -> Prop := - | ST_IfTrue : forall t1 t2, - tif ttrue t1 t2 ->> t1 - | ST_IfFalse : forall t1 t2, - tif tfalse t1 t2 ->> t2 - | ST_If : forall t1 t1' t2 t3, - t1 ->> t1' -> - tif t1 t2 t3 ->> tif t1' t2 t3 +> mutual +> infixl 6 ->- +> (->-) : TmB -> TmB -> Type +> (->-) = StepB +> +> data StepB : TmB -> TmB -> Type where +> ST_IfTrue : Tif Ttrue t1 t2 ->- t1 +> ST_IfFalse : Tif Tfalse t1 t2 ->- t2 +> ST_If : t1 ->- t1' -> Tif t1 t2 t3 ->- Tif t1' t2 t3 - where " t '->>' t' " := (step t t'). -(** **** Exercise: 1 star (smallstep_bools) *) -(** Which of the following propositions are provable? (This is just a +==== Exercise: 1 star (smallstep_bools) + +Which of the following propositions are provable? (This is just a thought exercise, but for an extra challenge feel free to prove - your answers in Coq.) *) + your answers in Idris.) -Definition bool_step_prop1 := - tfalse ->> tfalse. +> bool_step_prop1 : Tfalse ->- Tfalse +> bool_step_prop1 = ?bool_step_prop1_rhs -(* FILL IN HERE *) +> bool_step_prop2 : +> Tif +> Ttrue +> (Tif Ttrue Ttrue Ttrue) +> (Tif Tfalse Tfalse Tfalse) +> ->- +> Ttrue +> bool_step_prop2 = ?bool_step_prop2_rhs -Definition bool_step_prop2 := - tif - ttrue - (tif ttrue ttrue ttrue) - (tif tfalse tfalse tfalse) - ->> - ttrue. +> bool_step_prop3 : +> Tif +> (Tif Ttrue Ttrue Ttrue) +> (Tif Ttrue Ttrue Ttrue) +> Tfalse +> ->- +> Tif +> Ttrue +> (Tif Ttrue Ttrue Ttrue) +> Tfalse +> bool_step_prop3 = ?bool_step_prop3_rhs -(* FILL IN HERE *) -Definition bool_step_prop3 := - tif - (tif ttrue ttrue ttrue) - (tif ttrue ttrue ttrue) - tfalse - ->> - tif - ttrue - (tif ttrue ttrue ttrue) - tfalse. +==== Exercise: 3 stars, optional (progress_bool) -(* FILL IN HERE *) -(** [] *) +Just as we proved a progress theorem for plus expressions, we can + do so for boolean expressions, as well. -(** **** Exercise: 3 stars, optional (progress_bool) *) -(** Just as we proved a progress theorem for plus expressions, we can - do so for boolean expressions, as well. *) +> strong_progressB : {t : TmB} -> (ValueB t, (t': TmB ** t ->- t')) +> strong_progressB = ?strong_progressB_rhs -Theorem strong_progress : forall t, - value t \/ (exists t', t ->> t'). -Proof. - (* FILL IN HERE *) Admitted. -(** [] *) +==== Exercise: 2 stars, optional (step_deterministic) -(** **** Exercise: 2 stars, optional (step_deterministic) *) -Theorem step_deterministic : - deterministic step. -Proof. - (* FILL IN HERE *) Admitted. -(** [] *) +> step_deterministicB : deterministic StepB +> step_deterministicB = ?step_deterministicB_rhs -Module Temp5. +==== Exercise: 2 stars (smallstep_bool_shortcut) -(** **** Exercise: 2 stars (smallstep_bool_shortcut) *) -(** Suppose we want to add a "short circuit" to the step relation for +Suppose we want to add a "short circuit" to the step relation for boolean expressions, so that it can recognize when the `then` and `else` branches of a conditional are the same value (either `ttrue` or `tfalse`) and reduce the whole conditional to this @@ -673,198 +660,155 @@ Module Temp5. to a value. For example, we would like this proposition to be provable: - tif - (tif ttrue ttrue ttrue) - tfalse - tfalse - ->> - tfalse. -*) - -(** Write an extra clause for the step relation that achieves this - effect and prove `bool_step_prop4`. *) +```idris + tif + (tif ttrue ttrue ttrue) + tfalse + tfalse + ->> + tfalse. +``` -Reserved Notation " t '->>' t' " (at level 40). +Write an extra clause for the step relation that achieves this + effect and prove `bool_step_prop4`. -Inductive step : tm -> tm -> Prop := - | ST_IfTrue : forall t1 t2, - tif ttrue t1 t2 ->> t1 - | ST_IfFalse : forall t1 t2, - tif tfalse t1 t2 ->> t2 - | ST_If : forall t1 t1' t2 t3, - t1 ->> t1' -> - tif t1 t2 t3 ->> tif t1' t2 t3 - (* FILL IN HERE *) +> mutual +> infixl 6 ->-> +> (->->) : TmB -> TmB -> Type +> (->->) = StepB' +> +> data StepB' : TmB -> TmB -> Type where +> ST_IfTrue' : Tif Ttrue t1 t2 ->-> t1 +> ST_IfFalse' : Tif Tfalse t1 t2 ->-> t2 +> ST_If' : t1 ->-> t1' -> Tif t1 t2 t3 ->-> Tif t1' t2 t3 - where " t '->>' t' " := (step t t'). +> bool_step_prop4 : +> Tif +> (Tif Ttrue Ttrue Ttrue) +> Tfalse +> Tfalse +> ->-> +> Tfalse -Definition bool_step_prop4 := - tif - (tif ttrue ttrue ttrue) - tfalse - tfalse - ->> - tfalse. +> bool_step_prop4_holds : bool_step_prop4 +> bool_step_prop4_holds = ?bool_step_prop4_holds_rhs -Example bool_step_prop4_holds : - bool_step_prop4. -Proof. - (* FILL IN HERE *) Admitted. -(** [] *) -(** **** Exercise: 3 stars, optional (properties_of_altered_step) *) -(** It can be shown that the determinism and strong progress theorems +==== Exercise: 3 stars, optional (properties_of_altered_step) +It can be shown that the determinism and strong progress theorems for the step relation in the lecture notes also hold for the definition of step given above. After we add the clause `ST_ShortCircuit`... - - Is the `step` relation still deterministic? Write yes or no and - briefly (1 sentence) explain your answer. +- Is the `step` relation still deterministic? Write yes or no and + briefly (1 sentence) explain your answer. - Optional: prove your answer correct in Coq. *) +Optional: prove your answer correct in Idris. -(* FILL IN HERE *) -(** - - Does a strong progress theorem hold? Write yes or no and - briefly (1 sentence) explain your answer. +- Does a strong progress theorem hold? Write yes or no and + briefly (1 sentence) explain your answer. - Optional: prove your answer correct in Coq. -*) + Optional: prove your answer correct in Idris. -(* FILL IN HERE *) -(** - - In general, is there any way we could cause strong progress to +In general, is there any way we could cause strong progress to fail if we took away one or more constructors from the original step relation? Write yes or no and briefly (1 sentence) explain your answer. -(* FILL IN HERE *) -*) -(** [] *) - -End Temp5. -End Temp4. - -> {-} - -==== Multi-Step Reduction +== Multi-Step Reduction We've been working so far with the _single-step reduction_ -relation [->>], which formalizes the individual steps of an +relation `->>`, which formalizes the individual steps of an abstract machine for executing programs. We can use the same machine to reduce programs to completion -- to find out what final result they yield. This can be formalized as follows: -- First, we define a _multi-step reduction relation_ [->>*], which - relates terms [t] and [t'] if [t] can reach [t'] by any number +- First, we define a _multi-step reduction relation_ `->>*`, which + relates terms `t` and `t'` if `t` can reach `t'` by any number (including zero) of single reduction steps. -- Then we define a "result" of a term [t] as a normal form that - [t] can reach by multi-step reduction. - +- Then we define a "result" of a term `t` as a normal form that + `t` can reach by multi-step reduction. Since we'll want to reuse the idea of multi-step reduction many times, let's take a little extra trouble and define it generically. -Given a relation [R], we define a relation [multi R], called the -multi-step closure of [R]_ as follows. - -> data Multi: {X: Type} -> (R: Relation X) -> (x: X) -> (y : X) -> Type where -> Multi_refl : {X: Type} -> {R: Relation X} -> {x : X} -> Multi R x x -> Multi_step : {X: Type} -> {R: Relation X} -> {x, y, z : X} -> R x y -> Multi R y z -> Multi R x z. +Given a relation `R`, we define a relation `multi R`, called the +multi-step closure of `R`_ as follows. -Inductive multi {X:Type} (R: relation X) : relation X := - | multi_refl : forall (x : X), multi R x x - | multi_step : forall (x y z : X), - R x y -> - multi R y z -> - multi R x z. +> mutual +> infixl 6 ->>* +> (->>*) : Tm -> Tm -> Type +> (->>*) t t' = Multi Step t t' +> +> data Multi: {X: Type} -> (R: Relation X) -> Relation X where +> Multi_refl : {X: Type} -> {R: Relation X} -> {x : X} -> Multi R x x +> Multi_step : {X: Type} -> {R: Relation X} -> {x, y, z : X} -> +> R x y -> Multi R y z -> Multi R x z -(In the [Rel] chapter of _Logical Foundations_ and -the Coq standard library, this relation is called -[clos_refl_trans_1n]. We give it a shorter name here for the sake +(In the `Rel` chapter of _Logical Foundations_ this relation is called +`clos_refl_trans_1n`. We give it a shorter name here for the sake of readability.) -The effect of this definition is that [multi R] relates two -elements [x] and [y] if +The effect of this definition is that `multi R` relates two +elements `x` and `y` if - - [x = y], or - - [R x y], or - - there is some nonempty sequence [z1], [z2], ..., [zn] such that +- `x = y`, or +- `R x y`, or +- there is some nonempty sequence `z1`, `z2`, ..., `zn` such that - R x z1 - R z1 z2 - ... - R zn y. + R x z1 + R z1 z2 + ... + R zn y. - Thus, if [R] describes a single-step of computation, then [z1]...[zn] - is the sequence of intermediate steps of computation between [x] and - [y]. *) +Thus, if `R` describes a single-step of computation, then `z1`...`zn` +is the sequence of intermediate steps of computation between `x` and +`y`. -(** We write [->>*] for the [multi step] relation on terms. *) +We write `->>*` for the `multi step` relation on terms. -Notation " t '->>*' t' " := (multi step t t') (at level 40). +The relation `multi R` has several crucial properties. -> syntax [t] "->>*" [t'] = Multi Smallstep.Step t t' +First, it is obviously _reflexive_ (that is, `forall x, multi R x +x`). In the case of the `->>*` (i.e., `multi step`) relation, the +intuition is that a term can execute to itself by taking zero +steps of execution. -(** The relation [multi R] has several crucial properties. +Second, it contains `R` -- that is, single-step executions are a +particular case of multi-step executions. (It is this fact that +justifies the word "closure" in the term "multi-step closure of +`R`.") - First, it is obviously _reflexive_ (that is, [forall x, multi R x - x]). In the case of the [->>*] (i.e., [multi step]) relation, the - intuition is that a term can execute to itself by taking zero - steps of execution. - Second, it contains [R] -- that is, single-step executions are a - particular case of multi-step executions. (It is this fact that - justifies the word "closure" in the term "multi-step closure of - [R].") *) - -Theorem multi_R : forall (X:Type) (R:relation X) (x y : X), - R x y -> (multi R) x y. -Proof. - intros X R x y H. - apply multi_step with y. apply H. apply multi_refl. Qed. - -> multi_R: {X: Type} -> {R: Relation X} -> (x,y: X) -> R x y -> (Multi R) x y +> multi_R : {X: Type} -> {R: Relation X} -> (x,y: X) -> R x y -> (Multi R) x y > multi_R x y h = Multi_step h (Multi_refl) -(** Third, [multi R] is _transitive_. *) +Third, `multi R` is _transitive_. > multi_trans: {X:Type} -> {R: Relation X} -> {x, y, z : X} -> > Multi R x y -> Multi R y z -> Multi R x z > multi_trans m1 m2 = > case m1 of > Multi_refl => m2 -> Multi_step r _ => Multi_step r Multi_refl +> Multi_step r mx => +> let indHyp = multi_trans mx m2 +> in Multi_step r indHyp -Theorem multi_trans : - forall (X:Type) (R: relation X) (x y z : X), - multi R x y -> - multi R y z -> - multi R x z. -Proof. - intros X R x y z G H. - induction G. - - (* multi_refl *) assumption. - - (* multi_step *) - apply multi_step with y. assumption. - apply IHG. assumption. Qed. +In particular, for the `multi step` relation on terms, if + `t1->>*t2` and `t2->>*t3`, then `t1->>*t3`. -(** In particular, for the [multi step] relation on terms, if - [t1->>*t2] and [t2->>*t3], then [t1->>*t3]. *) +=== Examples -(* ================================================================= *) -(** ** Examples *) - -(** Here's a specific instance of the [multi step] relation: *) +Here's a specific instance of the `multi step` relation: > test_multistep_1: -> (P +> P > (P (C 0) (C 3)) -> (P (C 2) (C 4))) +> (P (C 2) (C 4)) > ->>* > C ((0 + 3) + (2 + 4)) > test_multistep_1 = @@ -873,122 +817,67 @@ Proof. > (Multi_step {z=z} (ST_Plus2 (V_const 3) ST_PlusConstConst) > (Multi_step ST_PlusConstConst Multi_refl)) -Lemma test_multistep_1: - P - (P (C 0) (C 3)) - (P (C 2) (C 4)) - ->>* - C ((0 + 3) + (2 + 4)). -Proof. - apply multi_step with - (P (C (0 + 3)) - (P (C 2) (C 4))). - apply ST_Plus1. apply ST_PlusConstConst. - apply multi_step with - (P (C (0 + 3)) - (C (2 + 4))). - apply ST_Plus2. apply v_const. - apply ST_PlusConstConst. - apply multi_R. - apply ST_PlusConstConst. Qed. - -(** Here's an alternate proof of the same fact that uses [eapply] to - avoid explicitly constructing all the intermediate terms. *) - -Lemma test_multistep_1': - P - (P (C 0) (C 3)) - (P (C 2) (C 4)) - ->>* - C ((0 + 3) + (2 + 4)). -Proof. - eapply multi_step. apply ST_Plus1. apply ST_PlusConstConst. - eapply multi_step. apply ST_Plus2. apply v_const. - apply ST_PlusConstConst. - eapply multi_step. apply ST_PlusConstConst. - apply multi_refl. Qed. - -(** **** Exercise: 1 star, optional (test_multistep_2) *) -Lemma test_multistep_2: - C 3 ->>* C 3. -Proof. - (* FILL IN HERE *) Admitted. -(** [] *) -(** **** Exercise: 1 star, optional (test_multistep_3) *) -Lemma test_multistep_3: - P (C 0) (C 3) - ->>* - P (C 0) (C 3). -Proof. - (* FILL IN HERE *) Admitted. -(** [] *) +==== Exercise: 1 star, optional (test_multistep_2) -(** **** Exercise: 2 stars (test_multistep_4) *) -Lemma test_multistep_4: - P - (C 0) - (P - (C 2) - (P (C 0) (C 3))) - ->>* - P - (C 0) - (C (2 + (0 + 3))). -Proof. - (* FILL IN HERE *) Admitted. -(** [] *) +> test_multistep_2: C 3 ->>* C 3 +> test_multistep_2 = ?test_multistep_2_rhs -(* ================================================================= *) -(** ** Normal Forms Again *) +==== Exercise: 1 star, optional (test_multistep_3) -(** If [t] reduces to [t'] in zero or more steps and [t'] is a - normal form, we say that "[t'] is a normal form of [t]." *) +> test_multistep_3: +> P (C 0) (C 3) +> ->>* +> P (C 0) (C 3) +> test_multistep_3 = ?test_multistep_3_rhs -Definition step_normal_form := normal_form step. +==== Exercise: 2 stars (test_multistep_4) -> -- step_normal : (x: Tm) -> (prf: Not (t' ** Smallstep.Step x t')) -> normal_form Smallstep.Step x +> test_multistep_4: +> P +> (C 0) +> (P +> (C 2) +> (P (C 0) (C 3))) +> ->>* +> P +> (C 0) +> (C (2 + (0 + 3))) +> test_multistep_4 = ?test_multistep_4_rhs -> -- data normal_form : {X:Type} -> Relation X -> X -> Type where -> -- Normal : {X:Type} -> (R: Relation X) -> (t: X) -> (prf: Not (t' ** R t t')) -> normal_form R t +=== Normal Forms Again -> step_normal_form : (t : Tm) -> Type -> step_normal_form = normal_form Smallstep.Step +If `t` reduces to `t'` in zero or more steps and `t'` is a + normal form, we say that "`t'` is a normal form of `t`." +> step_normal_form : (t : Tm) -> Type +> step_normal_form = normal_form Step > normal_form_of : Tm -> Tm -> Type -> normal_form_of t t' = ((t ->>* t'), step_normal_form t') +> normal_form_of t t' = (t ->>* t', step_normal_form t') - -(** We have already seen that, for our language, single-step reduction is +We have already seen that, for our language, single-step reduction is deterministic -- i.e., a given term can take a single step in - at most one way. It follows from this that, if [t] can reach + at most one way. It follows from this that, if `t` can reach a normal form, then this normal form is unique. In other words, we - can actually pronounce [normal_form t t'] as "[t'] is _the_ - normal form of [t]." *) + can actually pronounce `normal_form t t'` as "`t'` is _the_ + normal form of `t`." -(** **** Exercise: 3 stars, optional (normal_forms_unique) *) -Theorem normal_forms_unique: - deterministic normal_form_of. -Proof. - (* We recommend using this initial setup as-is! *) - unfold deterministic. unfold normal_form_of. - intros x y1 y2 P1 P2. - inversion P1 as [P11 P12]; clear P1. - inversion P2 as [P21 P22]; clear P2. - generalize dependent y2. - (* FILL IN HERE *) Admitted. -(** [] *) +==== Exercise: 3 stars, optional (normal_forms_unique) +> normal_forms_unique : deterministic Smallstep.normal_form_of +> normal_forms_unique (l,r) (l2,r2) = ?normal_forms_unique_rhs + +> {- > notAndLemmaLeft : Not x -> Not (x,y) > notAndLemmaLeft nx (l,r) = nx l -> notStepEqual : Not (Smallstep.Step x x) -> notStepEqual Smallstep.ST_PlusConstConst impossible +> notStepEqual : Not (Step x x) +> notStepEqual ST_PlusConstConst impossible > notStepEqual (ST_Plus1 h) = notStepEqual h > notStepEqual (ST_Plus2 s h) = notStepEqual h -> normal_forms_unique : deterministic {x} {y1} {y2} Smallstep.normal_form_of +> normal_forms_unique : deterministic {x} {y1} {y2} normal_form_of > normal_forms_unique (l,r) (l2,r2) = > case l of > Multi_refl => @@ -1002,94 +891,70 @@ Proof. > let -- indHyp1 = step_deterministic single single' > -- indHyp2 = normal_forms_unique y z1 z2 > in ?hole +> -} --- > deterministic : {xt: Type} -> (r: Relation xt) -> Type --- > deterministic {xt} r = {x, y1, y2: xt) -> r x y1 -> r x y2 -> y1 = y2 - -> -- normal_form_of : Tm -> Tm -> Type -> -- normal_form_of t t' = ((t ->>* t'), step_normal_form t') - - -(** Indeed, something stronger is true for this language (though not - for all languages): the reduction of _any_ term [t] will - eventually reach a normal form -- i.e., [normal_form_of] is a - _total_ function. Formally, we say the [step] relation is - _normalizing_. *) -Definition normalizing {X:Type} (R:relation X) := - forall t, exists t', - (multi R) t t' /\ normal_form R t'. +Indeed, something stronger is true for this language (though not + for all languages): the reduction of _any_ term `t` will + eventually reach a normal form -- i.e., `normal_form_of` is a + _total_ function. Formally, we say the `step` relation is + _normalizing_. -> normalizing : {X: Type} -> (R: Relation X) -> Type -> normalizing {X=x} {R=r} = (t: x) -> (t' : x ** ((Multi r) t t', normal_form r t')) +> normalizing : {x: Type} -> (r: Relation x) -> Type +> normalizing {x} {r} = (t: x) -> (t' : x ** (Multi r t t', normal_form r t')) -(** To prove that [step] is normalizing, we need a couple of lemmas. +To prove that `step` is normalizing, we need a couple of lemmas. - First, we observe that, if [t] reduces to [t'] in many steps, then - the same sequence of reduction steps within [t] is also possible - when [t] appears as the left-hand child of a [P] node, and - similarly when [t] appears as the right-hand child of a [P] - node whose left-hand child is a value. *) +First, we observe that, if `t` reduces to `t'` in many steps, then +the same sequence of reduction steps within `t` is also possible +when `t` appears as the left-hand child of a `P` node, and +similarly when `t` appears as the right-hand child of a `P` +node whose left-hand child is a value. -> multistep_congr_1 : {t1, t1', t2: Tm} -> (t1 ->>* t1') -> ((P t1 t2) ->>* P t1' t2) -> multistep_congr_1 {t1} {t1'} {t2} mult = +> multistep_congr_1 : (t1 ->>* t1') -> ((P t1 t2) ->>* P t1' t2) +> multistep_congr_1 mult = > case mult of > Multi_refl => Multi_refl -> Multi_step step mult => Multi_step (ST_Plus1 step) Multi_refl +> Multi_step step mult' => +> let indHyp = multistep_congr_1 mult' +> in Multi_step (ST_Plus1 step) indHyp -(** **** Exercise: 2 stars (multistep_congr_2) *) +==== Exercise: 2 stars (multistep_congr_2) -> multistep_congr_2 : {t1, t2', t2: Tm} -> {v:Value t1} -> (t2 ->>* t2') -> ((P t1 t2) ->>* P t1 t2') -> multistep_congr_2 {t2'} {t2} {v=V_const i} mult = -> case mult of -> Multi_refl => Multi_refl -> Multi_step step mult => Multi_step (ST_Plus2 (V_const i) step) Multi_refl - - -Lemma multistep_congr_2 : forall t1 t2 t2', - value t1 -> - t2 ->>* t2' -> - P t1 t2 ->>* P t1 t2'. -Proof. - (* FILL IN HERE *) Admitted. -(** [] *) +> multistep_congr_2 : {v:Value t1} -> (t2 ->>* t2') -> ((P t1 t2) ->>* P t1 t2') +> multistep_congr_2 {v=V_const i} mult = ?multistep_congr_2_rhs -(** With these lemmas in hand, the main proof is a straightforward +With these lemmas in hand, the main proof is a straightforward induction. - _Theorem_: The [step] function is normalizing -- i.e., for every - [t] there exists some [t'] such that [t] steps to [t'] and [t'] is +_Theorem_: The `step` function is normalizing -- i.e., for every + `t` there exists some `t'` such that `t` steps to `t'` and `t'` is a normal form. - _Proof sketch_: By induction on terms. There are two cases to +_Proof sketch_: By induction on terms. There are two cases to consider: - - [t = C n] for some [n]. Here [t] doesn't take a step, and we - have [t' = t]. We can derive the left-hand side by reflexivity - and the right-hand side by observing (a) that values are normal - forms (by [nf_same_as_value]) and (b) that [t] is a value (by - [v_const]). - - - [t = P t1 t2] for some [t1] and [t2]. By the IH, [t1] and [t2] - have normal forms [t1'] and [t2']. Recall that normal forms are - values (by [nf_same_as_value]); we know that [t1' = C n1] and - [t2' = C n2], for some [n1] and [n2]. We can combine the [->>*] - derivations for [t1] and [t2] using [multi_congr_1] and - [multi_congr_2] to prove that [P t1 t2] reduces in many steps to - [C (n1 + n2)]. - - It is clear that our choice of [t' = C (n1 + n2)] is a value, - which is in turn a normal form. [] *) +- `t = C n` for some `n`. Here `t` doesn't take a step, and we + have `t' = t`. We can derive the left-hand side by reflexivity + and the right-hand side by observing (a) that values are normal + forms (by `nf_same_as_value`) and (b) that `t` is a value (by + `v_const`). +- `t = P t1 t2` for some `t1` and `t2`. By the IH, `t1` and `t2` + have normal forms `t1'` and `t2'`. Recall that normal forms are + values (by `nf_same_as_value`); we know that `t1' = C n1` and + `t2' = C n2`, for some `n1` and `n2`. We can combine the `->>*` + derivations for `t1` and `t2` using `multi_congr_1` and + `multi_congr_2` to prove that `P t1 t2` reduces in many steps to + `C (n1 + n2)`. --- > normalizing : {X: Type} -> (R: Relation X) -> Type --- > normalizing {X=x} {R=r} = (t: x) -> (t' : x ** ((Multi r) t t', normal_form r t')) + It is clear that our choice of `t' = C (n1 + n2)` is a value, + which is in turn a normal form. `` *) - -> step_normalizing : normalizing Smallstep.Step +> step_normalizing : normalizing Step > step_normalizing (C n) = (C n ** (Multi_refl, notStepCN)) -> where notStepCN: (t' : Tm ** Smallstep.Step (C n) t') -> Void +> where notStepCN: (t' : Tm ** Step (C n) t') -> Void > notStepCN (t' ** c) impossible > step_normalizing (P l r) = > let (_ ** (ih1l,(ih1r))) = step_normalizing l @@ -1113,7 +978,7 @@ Proof. > conc1 = multi_trans {x=P l r} {y=P (C n1) r} {z=C (plus n1 n2)} > in conc1 left_transform right_transform -> normal_form : ((t'1 : Tm ** Smallstep.Step (C (plus n1 n2)) t'1) -> Void) = +> normal_form : ((t'1 : Tm ** Step (C (plus n1 n2)) t'1) -> Void) = > (snd nf_same_as_value) (V_const (plus n1 n2)) > in (C (n1 + n2) ** (reduction, normal_form)) @@ -1124,37 +989,7 @@ Proof. > lemma_deconstruct : Value v -> (n : Nat ** v = C n) > lemma_deconstruct v@(V_const n) = (n ** Refl) -Theorem step_normalizing : - normalizing step. -Proof. - unfold normalizing. - induction t. - - (* C *) - exists (C n). - split. - + (* l *) apply multi_refl. - + (* r *) - (* We can use [rewrite] with "iff" statements, not - just equalities: *) - rewrite nf_same_as_value. apply v_const. - - (* P *) - destruct IHt1 as [t1' [H11 H12]]. - destruct IHt2 as [t2' [H21 H22]]. - rewrite nf_same_as_value in H12. rewrite nf_same_as_value in H22. - inversion H12 as [n1 H]. inversion H22 as [n2 H']. - rewrite <- H in H11. - rewrite <- H' in H21. - exists (C (n1 + n2)). - split. - + (* l *) - apply multi_trans with (P (C n1) t2). - * apply multistep_congr_1. apply H11. - * apply multi_trans with - (P (C n1) (C n2)). - { apply multistep_congr_2. apply v_const. apply H21. } - { apply multi_R. apply ST_PlusConstConst. } - + (* r *) - rewrite nf_same_as_value. apply v_const. Qed. +> {- (* ================================================================= *) (** ** Equivalence of Big-Step and Small-Step *) @@ -1174,7 +1009,7 @@ Proof. > E_Plus l r => > let hypl = multistep_congr_1 (eval__multistep l) > hypr = multistep_congr_2 {v = V_const _}(eval__multistep r) -> in multi_trans (multi_trans hypl hypr)(Multi_step Smallstep.ST_PlusConstConst Multi_refl) +> in multi_trans (multi_trans hypl hypr)(Multi_step ST_PlusConstConst Multi_refl) (** The key ideas in the proof can be seen in the following picture: @@ -1318,6 +1153,7 @@ Inductive step : tm -> tm -> Prop := End Combined. (** [] *) + From 14a5458593810d9535e0cee4a9db53986111ed04 Mon Sep 17 00:00:00 2001 From: jutaro Date: Thu, 20 Sep 2018 19:47:18 +0200 Subject: [PATCH 07/30] Exercises --- src/Smallstep.lidr | 267 ++++++++++++++++++++------------------------- 1 file changed, 121 insertions(+), 146 deletions(-) diff --git a/src/Smallstep.lidr b/src/Smallstep.lidr index 02e385e..659141b 100644 --- a/src/Smallstep.lidr +++ b/src/Smallstep.lidr @@ -989,174 +989,151 @@ _Proof sketch_: By induction on terms. There are two cases to > lemma_deconstruct : Value v -> (n : Nat ** v = C n) > lemma_deconstruct v@(V_const n) = (n ** Refl) -> {- -(* ================================================================= *) -(** ** Equivalence of Big-Step and Small-Step *) +=== Equivalence of Big-Step and Small-Step -(** Having defined the operational semantics of our tiny programming +Having defined the operational semantics of our tiny programming language in two different ways (big-step and small-step), it makes sense to ask whether these definitions actually define the same thing! They do, though it takes a little work to show it. The - details are left as an exercise. *) + details are left as an exercise. -(** **** Exercise: 3 stars (eval__multistep) *) +==== Exercise: 3 stars (eval__multistep) -> eval__multistep : {t: Tm} -> {n: Nat} -> t # n -> t ->>* C n -> eval__multistep hyp = -> case hyp of -> E_Const => Multi_refl -> E_Plus l r => -> let hypl = multistep_congr_1 (eval__multistep l) -> hypr = multistep_congr_2 {v = V_const _}(eval__multistep r) -> in multi_trans (multi_trans hypl hypr)(Multi_step ST_PlusConstConst Multi_refl) - -(** The key ideas in the proof can be seen in the following picture: - - P t1 t2 ->> (by ST_Plus1) - P t1' t2 ->> (by ST_Plus1) - P t1'' t2 ->> (by ST_Plus1) - ... - P (C n1) t2 ->> (by ST_Plus2) - P (C n1) t2' ->> (by ST_Plus2) - P (C n1) t2'' ->> (by ST_Plus2) - ... - P (C n1) (C n2) ->> (by ST_PlusConstConst) - C (n1 + n2) - - That is, the multistep reduction of a term of the form [P t1 t2] - proceeds in three phases: - - First, we use [ST_Plus1] some number of times to reduce [t1] - to a normal form, which must (by [nf_same_as_value]) be a - term of the form [C n1] for some [n1]. - - Next, we use [ST_Plus2] some number of times to reduce [t2] - to a normal form, which must again be a term of the form [C - n2] for some [n2]. - - Finally, we use [ST_PlusConstConst] one time to reduce [P (C - n1) (C n2)] to [C (n1 + n2)]. *) - -(** To formalize this intuition, you'll need to use the congruence +> eval__multistep: {t: Tm} -> {n: Nat} -> t >>> n -> t ->>* C n +> eval__multistep hyp = ?eval__multistep_rhs + +The key ideas in the proof can be seen in the following picture: + +``` + P t1 t2 ->> (by ST_Plus1) + P t1' t2 ->> (by ST_Plus1) + P t1'' t2 ->> (by ST_Plus1) + ... + P (C n1) t2 ->> (by ST_Plus2) + P (C n1) t2' ->> (by ST_Plus2) + P (C n1) t2'' ->> (by ST_Plus2) + ... + P (C n1) (C n2) ->> (by ST_PlusConstConst) + C (n1 + n2) +``` + +That is, the multistep reduction of a term of the form [P t1 t2] +proceeds in three phases: + +- First, we use [ST_Plus1] some number of times to reduce [t1] + to a normal form, which must (by [nf_same_as_value]) be a + term of the form [C n1] for some [n1]. +- Next, we use [ST_Plus2] some number of times to reduce [t2] + to a normal form, which must again be a term of the form [C + n2] for some [n2]. +- Finally, we use [ST_PlusConstConst] one time to reduce [P (C + n1) (C n2)] to [C (n1 + n2)]. + +To formalize this intuition, you'll need to use the congruence lemmas from above (you might want to review them now, so that you'll be able to recognize when they are useful), plus some basic properties of [->>*]: that it is reflexive, transitive, and - includes [->>]. *) + includes [->>]. -Proof. - (* FILL IN HERE *) Admitted. -(** [] *) -(** **** Exercise: 3 stars, advanced (eval__multistep_inf) *) -(** Write a detailed informal version of the proof of [eval__multistep]. +==== Exercise: 3 stars, advanced (eval__multistep_inf) + +Write a detailed informal version of the proof of [eval__multistep] (* FILL IN HERE *) -*) -(** [] *) -(** For the other direction, we need one lemma, which establishes a - relation between single-step reduction and big-step evaluation. *) +For the other direction, we need one lemma, which establishes a + relation between single-step reduction and big-step evaluation. -(** **** Exercise: 3 stars (step__eval) *) -Lemma step__eval : forall t t' n, - t ->> t' -> - t' \\ n -> - t \\ n. -Proof. - intros t t' n Hs. generalize dependent n. - (* FILL IN HERE *) Admitted. -(** [] *) +==== Exercise: 3 stars (step__eval) -(** The fact that small-step reduction implies big-step evaluation is +> step__eval : {t, t': Tm} -> {n: Nat} -> +> t ->> t' -> +> t' >>> n -> +> t >>> n +> step__eval h1 h2 = ?step__eval_rhs + +The fact that small-step reduction implies big-step evaluation is now straightforward to prove, once it is stated correctly. - The proof proceeds by induction on the multi-step reduction - sequence that is buried in the hypothesis [normal_form_of t t']. *) +The proof proceeds by induction on the multi-step reduction + sequence that is buried in the hypothesis [normal_form_of t t']. -(** Make sure you understand the statement before you start to - work on the proof. *) +Make sure you understand the statement before you start to + work on the proof. -(** **** Exercise: 3 stars (multistep__eval) *) -Theorem multistep__eval : forall t t', - normal_form_of t t' -> exists n, t' = C n /\ t \\ n. -Proof. - (* FILL IN HERE *) Admitted. -(** [] *) +==== Exercise: 3 stars (multistep__eval) + +> multistep__eval : {t, t': Tm} -> +> normal_form_of t t' -> (n : Nat ** (t' = C n, t >>> n)) +> multistep__eval hyp = ?multistep__eval_rhs -(* ================================================================= *) -(** ** Additional Exercises *) -(** **** Exercise: 3 stars, optional (interp_tm) *) -(** Remember that we also defined big-step evaluation of terms as a - function [evalF]. Prove that it is equivalent to the existing - semantics. (Hint: we just proved that [eval] and [multistep] are +=== Additional Exercises + +==== Exercise: 3 stars, optional (interp_tm) + +Remember that we also defined big-step evaluation of terms as a + function `evalF`. Prove that it is equivalent to the existing + semantics. (Hint: we just proved that `eval` and `multistep` are equivalent, so logically it doesn't matter which you choose. - One will be easier than the other, though!) *) + One will be easier than the other, though!) -Theorem evalF_eval : forall t n, - evalF t = n <-> t \\ n. -Proof. - (* FILL IN HERE *) Admitted. -(** [] *) +> evalF_eval : {t: Tm} -> {n: Nat} -> ((evalF t = n) <-> (t >>> n)) + +==== Exercise: 4 stars (combined_properties) + +We've considered arithmetic and conditional expressions + separately. This exercise explores how the two interact. + + +> data TmC : Type where +> CC : Nat -> TmC +> PC : TmC -> TmC -> TmC +> TtrueC : TmC +> TfalseC : TmC +> TifC : TmC -> TmC -> TmC -> TmC + +> data ValueC : TmC -> Type where +> V_constC : {n: Nat} -> ValueC (CC n) +> V_trueC : ValueC TtrueC +> V_falseC : ValueC TfalseC + + +> mutual +> infixl 6 >>-> +> (>>->) : TmC -> TmC -> Type +> (>>->) = StepC +> +> data StepC : TmC -> TmC -> Type where +> ST_PlusConstConstC : PC (CC n1) (CC n2) >>-> CC (n1 + n2) +> ST_Plus1C : t1 >>-> t1' -> PC t1 t2 >>-> PC t1' t2 +> ST_Plus2C : ValueC v1 -> t2 >>-> t2' -> PC v1 t2 >>-> PC v1 t2' +> ST_IfTrueC : TifC TtrueC t1 t2 >>-> t1 +> ST_IfFalseC : TifC TfalseC t1 t2 >>-> t2 +> ST_IfC : t1 >>-> t1' -> TifC t1 t2 t3 >>-> TifC t1' t2 t3 + + +Earlier, we separately proved for both plus- and if-expressions... + +- that the step relation was deterministic, and + +- a strong progress lemma, stating that every term is either a + value or can take a step. -(** **** Exercise: 4 stars (combined_properties) *) -(** We've considered arithmetic and conditional expressions - separately. This exercise explores how the two interact. *) - -Module Combined. - -Inductive tm : Type := - | C : nat -> tm - | P : tm -> tm -> tm - | ttrue : tm - | tfalse : tm - | tif : tm -> tm -> tm -> tm. - -Inductive value : tm -> Prop := - | v_const : forall n, value (C n) - | v_true : value ttrue - | v_false : value tfalse. - -Reserved Notation " t '->>' t' " (at level 40). - -Inductive step : tm -> tm -> Prop := - | ST_PlusConstConst : forall n1 n2, - P (C n1) (C n2) ->> C (n1 + n2) - | ST_Plus1 : forall t1 t1' t2, - t1 ->> t1' -> - P t1 t2 ->> P t1' t2 - | ST_Plus2 : forall v1 t2 t2', - value v1 -> - t2 ->> t2' -> - P v1 t2 ->> P v1 t2' - | ST_IfTrue : forall t1 t2, - tif ttrue t1 t2 ->> t1 - | ST_IfFalse : forall t1 t2, - tif tfalse t1 t2 ->> t2 - | ST_If : forall t1 t1' t2 t3, - t1 ->> t1' -> - tif t1 t2 t3 ->> tif t1' t2 t3 - - where " t '->>' t' " := (step t t'). - -(** Earlier, we separately proved for both plus- and if-expressions... - - - that the step relation was deterministic, and - - - a strong progress lemma, stating that every term is either a - value or can take a step. - - Formally prove or disprove these two properties for the combined - language. (That is, state a theorem saying that the property - holds or does not hold, and prove your theorem.) *) +Formally prove or disprove these two properties for the combined +language. (That is, state a theorem saying that the property +holds or does not hold, and prove your theorem.) (* FILL IN HERE *) -End Combined. -(** [] *) + n }) + (i ::= (ANum n)) / st ->> SKIP / (st & { i ==> n }) | CS_SeqStep : forall st c1 c1' st' c2, c1 / st ->> c1' / st' -> (c1 ;; c2) / st ->> (c1' ;; c2) / st' @@ -1346,7 +1324,7 @@ Inductive cstep : (com * state) -> (com * state) -> Prop := a / st ->>a a' -> (i ::= a) / st ->> (i ::= a') / st | CS_Ass : forall st i n, - (i ::= (ANum n)) / st ->> SKIP / st & { i --> n } + (i ::= (ANum n)) / st ->> SKIP / st & { i ==> n } | CS_SeqStep : forall st c1 c1' st' c2, c1 / st ->> c1' / st' -> (c1 ;; c2) / st ->> (c1' ;; c2) / st' @@ -1397,7 +1375,7 @@ Definition par_loop : com := Example par_loop_example_0: exists st', - par_loop / { --> 0 } ->>* SKIP / st' + par_loop / { ==> 0 } ->>* SKIP / st' /\ st' X = 0. Proof. eapply ex_intro. split. @@ -1418,7 +1396,7 @@ Proof. Example par_loop_example_2: exists st', - par_loop / { --> 0 } ->>* SKIP / st' + par_loop / { ==> 0 } ->>* SKIP / st' /\ st' X = 2. Proof. eapply ex_intro. split. @@ -1466,7 +1444,7 @@ Proof. (** **** Exercise: 3 stars, optional (par_body_n__Sn) *) Lemma par_body_n__Sn : forall n st, st X = n /\ st Y = 0 -> - par_loop / st ->>* par_loop / st & { X --> S n}. + par_loop / st ->>* par_loop / st & { X ==> S n}. Proof. (* FILL IN HERE *) Admitted. (** [] *) @@ -1485,16 +1463,16 @@ Proof. Theorem par_loop_any_X: forall n, exists st', - par_loop / { --> 0 } ->>* SKIP / st' + par_loop / { ==> 0 } ->>* SKIP / st' /\ st' X = n. Proof. intros n. - destruct (par_body_n n { --> 0 }). + destruct (par_body_n n { ==> 0 }). split; unfold t_update; reflexivity. rename x into st. inversion H as [H' [HX HY]]; clear H. - exists (st & { Y --> 1 }). split. + exists (st & { Y ==> 1 }). split. eapply multi_trans with (par_loop,st). apply H'. eapply multi_step. apply CS_Par1. apply CS_Ass. eapply multi_step. apply CS_Par2. apply CS_While. @@ -1557,9 +1535,6 @@ Proof. (* FILL IN HERE *) Admitted. (** [] *) - (** $Date$ *) -> -} - --> From f145647eddb9d7ff61c075a0b48ebe2c8e38e2d1 Mon Sep 17 00:00:00 2001 From: jutaro Date: Thu, 20 Sep 2018 19:53:44 +0200 Subject: [PATCH 08/30] Fixes --- src/Smallstep.lidr | 51 ++++++++++++---------------------------------- 1 file changed, 13 insertions(+), 38 deletions(-) diff --git a/src/Smallstep.lidr b/src/Smallstep.lidr index 659141b..d0b0d00 100644 --- a/src/Smallstep.lidr +++ b/src/Smallstep.lidr @@ -868,31 +868,6 @@ We have already seen that, for our language, single-step reduction is > normal_forms_unique : deterministic Smallstep.normal_form_of > normal_forms_unique (l,r) (l2,r2) = ?normal_forms_unique_rhs -> {- -> notAndLemmaLeft : Not x -> Not (x,y) -> notAndLemmaLeft nx (l,r) = nx l - -> notStepEqual : Not (Step x x) -> notStepEqual ST_PlusConstConst impossible -> notStepEqual (ST_Plus1 h) = notStepEqual h -> notStepEqual (ST_Plus2 s h) = notStepEqual h - -> normal_forms_unique : deterministic {x} {y1} {y2} normal_form_of -> normal_forms_unique (l,r) (l2,r2) = -> case l of -> Multi_refl => -> case l2 of -> Multi_refl => Refl -> Multi_step {x} {y=y'} single mult => void (r (y' ** single)) -> Multi_step {x} {y} single mult => -> case l2 of -> Multi_refl => void (r2 (y ** single)) -> Multi_step {x} {y=y'} single' mult' => -> let -- indHyp1 = step_deterministic single single' -> -- indHyp2 = normal_forms_unique y z1 z2 -> in ?hole -> -} - Indeed, something stronger is true for this language (though not for all languages): the reduction of _any_ term `t` will @@ -1018,28 +993,28 @@ The key ideas in the proof can be seen in the following picture: C (n1 + n2) ``` -That is, the multistep reduction of a term of the form [P t1 t2] +That is, the multistep reduction of a term of the form `P t1 t2` proceeds in three phases: -- First, we use [ST_Plus1] some number of times to reduce [t1] - to a normal form, which must (by [nf_same_as_value]) be a - term of the form [C n1] for some [n1]. -- Next, we use [ST_Plus2] some number of times to reduce [t2] - to a normal form, which must again be a term of the form [C - n2] for some [n2]. -- Finally, we use [ST_PlusConstConst] one time to reduce [P (C - n1) (C n2)] to [C (n1 + n2)]. +- First, we use `ST_Plus1` some number of times to reduce `t1` + to a normal form, which must (by `nf_same_as_value`) be a + term of the form `C n1` for some `n1`. +- Next, we use `ST_Plus2` some number of times to reduce `t2` + to a normal form, which must again be a term of the form `C + n2` for some `n2`. +- Finally, we use `ST_PlusConstConst` one time to reduce `P (C + n1) (C n2)` to `C (n1 + n2)`. To formalize this intuition, you'll need to use the congruence lemmas from above (you might want to review them now, so that you'll be able to recognize when they are useful), plus some basic - properties of [->>*]: that it is reflexive, transitive, and - includes [->>]. + properties of `->>*`: that it is reflexive, transitive, and + includes `->>`. ==== Exercise: 3 stars, advanced (eval__multistep_inf) -Write a detailed informal version of the proof of [eval__multistep] +Write a detailed informal version of the proof of `eval__multistep` (* FILL IN HERE *) @@ -1058,7 +1033,7 @@ The fact that small-step reduction implies big-step evaluation is now straightforward to prove, once it is stated correctly. The proof proceeds by induction on the multi-step reduction - sequence that is buried in the hypothesis [normal_form_of t t']. + sequence that is buried in the hypothesis `normal_form_of t t'`. Make sure you understand the statement before you start to work on the proof. From b03b894267a4bcef97e980738bb6fdfdb87a8533 Mon Sep 17 00:00:00 2001 From: jutaro Date: Sat, 22 Sep 2018 08:09:33 +0200 Subject: [PATCH 09/30] Add Types.lidr. --- src/Types.lidr | 780 +++++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 780 insertions(+) create mode 100644 src/Types.lidr diff --git a/src/Types.lidr b/src/Types.lidr new file mode 100644 index 0000000..a7b8a1e --- /dev/null +++ b/src/Types.lidr @@ -0,0 +1,780 @@ += Types + +== Types: Type Systems + +> module Types +> import Smallstep +> %hide Smallstep.(->>) +> %hide Smallstep.Tm + +> %access public export +> %default total + + +Our next major topic is _type systems_ -- static program + analyses that classify expressions according to the "shapes" of + their results. We'll begin with a typed version of the simplest + imaginable language, to introduce the basic ideas of types and + typing rules and the fundamental theorems about type systems: + _type preservation_ and _progress_. In chapter `Stlc` we'll move + on to the _simply typed lambda-calculus_, which lives at the core + of every modern functional programming language (including + Coq!). + +== Typed Arithmetic Expressions + +To motivate the discussion of type systems, let's begin as + usual with a tiny toy language. We want it to have the potential + for programs to go wrong because of runtime type errors, so we + need something a tiny bit more complex than the language of + constants and addition that we used in chapter `Smallstep`: a + single kind of data (e.g., numbers) is too simple, but just two + kinds (numbers and booleans) gives us enough material to tell an + interesting story. + +The language definition is completely routine. + +=== Syntax + +Here is the syntax, informally: + +``` + t ::= true + | false + | if t then t else t + | 0 + | succ t + | pred t + | iszero t +``` + +And here it is formally: + +> data Tm : Type where +> Ttrue : Tm +> Tfalse : Tm +> Tif : Tm -> Tm -> Tm -> Tm +> Tzero : Tm +> Tsucc : Tm -> Tm +> Tpred : Tm -> Tm +> Tiszero : Tm -> Tm + +_Values_ are `true`, `false`, and numeric values... + +> data Bvalue : Tm -> Type where +> Bv_true : Bvalue Ttrue +> Bv_false : Bvalue Tfalse +> +> data Nvalue : Tm -> Type where +> Nv_zero : Nvalue Tzero +> Nv_succ : {t: Tm} -> Nvalue t -> Nvalue (Tsucc t) +> +> data Value : Tm -> Type where +> V_bool : Bvalue t -> Value t +> V_nat : Nvalue t -> Value t + +=== Operational Semantics + +Here is the single-step relation, first informally... + +\` + \begin{prooftree} + \infer0`\idr{ST_IfTrue}`{\idr{if true then t1 else t2 ->> t1}} + \end{prooftree} + \newline +\` + +\` + \begin{prooftree} + \infer0`\idr{ST_IfFalse}`{\idr{if false then t1 else t2 ->> t2}} + \end{prooftree} + \newline +\` + +\` + \begin{prooftree} + \hypo{\idr{t1 ->> t1'}} + \infer1`\idr{ST_If}`{\idr{if t1 then t2 else t3 ->> if t1' then t2 else t3}} + \end{prooftree} +\` + +\` + \begin{prooftree} + \hypo{\idr{t1 ->> t1'}} + \infer1`\idr{ST_Succ}`{\idr{succ t1 ->> succ t1'}} + \end{prooftree} +\` + +\` + \begin{prooftree} + \infer0`\idr{ST_PredZero}`{\idr{pred 0 ->> 0}} + \end{prooftree} + \newline +\` + +\` + \begin{prooftree} + \hypo{\idr{numeric value v1}} + \infer1`\idr{ST_PredSucc}`{\idr{pred (succ v1) ->> v1}} + \end{prooftree} +\` + +\` + \begin{prooftree} + \hypo{\idr{t1 ->> t1'}} + \infer1`\idr{ST_Pred}`{\idr{pred t1 ->> pred t1'}} + \end{prooftree} +\` + +\` + \begin{prooftree} + \infer0`\idr{ST_IszeroZero}`{\idr{iszero 0 ->> true}} + \end{prooftree} + \newline +\` + +\` + \begin{prooftree} + \hypo{\idr{numeric value v1}} + \infer1`\idr{ST_IszeroSucc}`{\idr{iszero (succ v1) ->> false}} + \end{prooftree} +\` + +\` + \begin{prooftree} + \hypo{\idr{t1 ->> t1'}} + \infer1`\idr{ST_Iszero}`{\idr{iszero t1 ->> iszero t1'}} + \end{prooftree} +\` + +... and then formally: + + +> mutual +> infixl 6 ->> +> (->>) : Tm -> Tm -> Type +> (->>) = Types.Step +> +> data Step : Tm -> Tm -> Type where +> ST_IfTrue : Tif Ttrue t1 t2 ->> t1 +> ST_IfFalse : Tif Tfalse t1 t2 ->> t2 +> ST_If : t1 ->> t1' -> Tif t1 t2 t3 ->> Tif t1' t2 t3 +> ST_Succ : t1 ->> t1' -> Tsucc t1 ->> Tsucc t1' +> ST_PredZero : Tpred tzero ->> tzero +> ST_PredSucc : Nvalue t1 -> Tpred (Tsucc t1) ->> t1 +> ST_Pred : t1 ->> t1' -> Tpred t1 ->> Tpred t1' +> ST_IszeroZero : Tiszero Tzero ->> Ttrue +> ST_IszeroSucc : Nvalue t1 -> Tiszero (Tsucc t1) ->> Tfalse +> ST_Iszero : t1 ->> t1' -> Tiszero t1 ->> Tiszero t1' + + +Notice that the `step` relation doesn't care about whether +expressions make global sense -- it just checks that the operation +in the _next_ reduction step is being applied to the right kinds +of operands. For example, the term `succ true` (i.e., +`tsucc ttrue` in the formal syntax) cannot take a step, but the +almost as obviously nonsensical term + + succ (if true then true else true) + +can take a step (once, before becoming stuck). *) + +=== Normal Forms and Values + +The first interesting thing to notice about this `step` relation +is that the strong progress theorem from the `Smallstep` chapter +fails here. That is, there are terms that are normal forms (they +can't take a step) but not values (because we have not included +them in our definition of possible "results of reduction"). Such +terms are _stuck_. + +> step_normal_form : (t : Tm) -> Type +> step_normal_form = normal_form Types.Step + +> stuck : (t : Tm) -> Type +> stuck t = (step_normal_form t, Not (Value t)) + +==== Exercise: 2 stars (some_term_is_stuck) + + +> some_term_is_stuck : (t ** stuck t) +> some_term_is_stuck = ?some_term_is_stuck_rhs + +(** However, although values and normal forms are _not_ the same in this + language, the set of values is included in the set of normal + forms. This is important because it shows we did not accidentally + define things so that some value could still take a step. *) + +(** **** Exercise: 3 stars (value_is_nf) *) +Lemma value_is_nf : forall t, + value t -> step_normal_form t. +Proof. + (* FILL IN HERE *) Admitted. + +(** (Hint: You will reach a point in this proof where you need to + use an induction to reason about a term that is known to be a + numeric value. This induction can be performed either over the + term itself or over the evidence that it is a numeric value. The + proof goes through in either case, but you will find that one way + is quite a bit shorter than the other. For the sake of the + exercise, try to complete the proof both ways.) *) +(** `` *) + +(** **** Exercise: 3 stars, optional (step_deterministic) *) +(** Use `value_is_nf` to show that the `step` relation is also + deterministic. *) + +Theorem step_deterministic: + deterministic step. +Proof with eauto. + (* FILL IN HERE *) Admitted. +(** `` *) + + From cf20302b802baf8dfa0ade48db4b043af5bfbe59 Mon Sep 17 00:00:00 2001 From: jutaro Date: Sun, 23 Sep 2018 09:24:33 +0200 Subject: [PATCH 10/30] Types up to progress. --- src/Types.lidr | 404 ++++++++++++++++++++++++------------------------- 1 file changed, 201 insertions(+), 203 deletions(-) diff --git a/src/Types.lidr b/src/Types.lidr index a7b8a1e..bfa7ae4 100644 --- a/src/Types.lidr +++ b/src/Types.lidr @@ -6,20 +6,24 @@ > import Smallstep > %hide Smallstep.(->>) > %hide Smallstep.Tm +> %hide Smallstep.Ttrue +> %hide Smallstep.Tfalse + + > %access public export > %default total Our next major topic is _type systems_ -- static program - analyses that classify expressions according to the "shapes" of - their results. We'll begin with a typed version of the simplest - imaginable language, to introduce the basic ideas of types and - typing rules and the fundamental theorems about type systems: - _type preservation_ and _progress_. In chapter `Stlc` we'll move - on to the _simply typed lambda-calculus_, which lives at the core - of every modern functional programming language (including - Coq!). +analyses that classify expressions according to the "shapes" of +their results. We'll begin with a typed version of the simplest +imaginable language, to introduce the basic ideas of types and +typing rules and the fundamental theorems about type systems: +_type preservation_ and _progress_. In chapter `Stlc` we'll move +on to the _simply typed lambda-calculus_, which lives at the core +of every modern functional programming language (including +Idris!). == Typed Arithmetic Expressions @@ -77,75 +81,75 @@ _Values_ are `true`, `false`, and numeric values... Here is the single-step relation, first informally... -\` +\[ \begin{prooftree} - \infer0`\idr{ST_IfTrue}`{\idr{if true then t1 else t2 ->> t1}} + \infer0[\idr{ST_IfTrue}]{\idr{if true then t1 else t2 ->> t1}} \end{prooftree} \newline -\` +\] -\` +\[ \begin{prooftree} - \infer0`\idr{ST_IfFalse}`{\idr{if false then t1 else t2 ->> t2}} + \infer0[\idr{ST_IfFalse}]{\idr{if false then t1 else t2 ->> t2}} \end{prooftree} \newline -\` +\] -\` +\[ \begin{prooftree} \hypo{\idr{t1 ->> t1'}} - \infer1`\idr{ST_If}`{\idr{if t1 then t2 else t3 ->> if t1' then t2 else t3}} + \infer1[\idr{ST_If}]{\idr{if t1 then t2 else t3 ->> if t1' then t2 else t3}} \end{prooftree} -\` +\] -\` +\[ \begin{prooftree} \hypo{\idr{t1 ->> t1'}} - \infer1`\idr{ST_Succ}`{\idr{succ t1 ->> succ t1'}} + \infer1[\idr{ST_Succ}]{\idr{succ t1 ->> succ t1'}} \end{prooftree} -\` +\] -\` +\[ \begin{prooftree} - \infer0`\idr{ST_PredZero}`{\idr{pred 0 ->> 0}} + \infer0[\idr{ST_PredZero}]{\idr{pred 0 ->> 0}} \end{prooftree} \newline -\` +\] -\` +\[ \begin{prooftree} \hypo{\idr{numeric value v1}} - \infer1`\idr{ST_PredSucc}`{\idr{pred (succ v1) ->> v1}} + \infer1[\idr{ST_PredSucc}]{\idr{pred (succ v1) ->> v1}} \end{prooftree} -\` +\] -\` +\[ \begin{prooftree} \hypo{\idr{t1 ->> t1'}} - \infer1`\idr{ST_Pred}`{\idr{pred t1 ->> pred t1'}} + \infer1[\idr{ST_Pred}]{\idr{pred t1 ->> pred t1'}} \end{prooftree} -\` +\] -\` +\[ \begin{prooftree} - \infer0`\idr{ST_IszeroZero}`{\idr{iszero 0 ->> true}} + \infer0[\idr{ST_IszeroZero}]{\idr{iszero 0 ->> true}} \end{prooftree} \newline -\` +\] -\` +\[ \begin{prooftree} \hypo{\idr{numeric value v1}} - \infer1`\idr{ST_IszeroSucc}`{\idr{iszero (succ v1) ->> false}} + \infer1[\idr{ST_IszeroSucc}]{\idr{iszero (succ v1) ->> false}} \end{prooftree} -\` +\] -\` +\[ \begin{prooftree} \hypo{\idr{t1 ->> t1'}} - \infer1`\idr{ST_Iszero}`{\idr{iszero t1 ->> iszero t1'}} + \infer1[\idr{ST_Iszero}]{\idr{iszero t1 ->> iszero t1'}} \end{prooftree} -\` +\] ... and then formally: @@ -156,16 +160,16 @@ Here is the single-step relation, first informally... > (->>) = Types.Step > > data Step : Tm -> Tm -> Type where -> ST_IfTrue : Tif Ttrue t1 t2 ->> t1 -> ST_IfFalse : Tif Tfalse t1 t2 ->> t2 -> ST_If : t1 ->> t1' -> Tif t1 t2 t3 ->> Tif t1' t2 t3 -> ST_Succ : t1 ->> t1' -> Tsucc t1 ->> Tsucc t1' +> ST_IfTrue : {t1, t2: Tm} -> Tif Ttrue t1 t2 ->> t1 +> ST_IfFalse : {t1, t2: Tm} -> Tif Tfalse t1 t2 ->> t2 +> ST_If : {t1, t2, t3, t1': Tm} -> t1 ->> t1' -> Tif t1 t2 t3 ->> Tif t1' t2 t3 +> ST_Succ : {t1, t1': Tm} -> t1 ->> t1' -> Tsucc t1 ->> Tsucc t1' > ST_PredZero : Tpred tzero ->> tzero -> ST_PredSucc : Nvalue t1 -> Tpred (Tsucc t1) ->> t1 -> ST_Pred : t1 ->> t1' -> Tpred t1 ->> Tpred t1' +> ST_PredSucc : {t1 :Tm} -> Nvalue t1 -> Tpred (Tsucc t1) ->> t1 +> ST_Pred : {t1, t1': Tm} -> t1 ->> t1' -> Tpred t1 ->> Tpred t1' > ST_IszeroZero : Tiszero Tzero ->> Ttrue -> ST_IszeroSucc : Nvalue t1 -> Tiszero (Tsucc t1) ->> Tfalse -> ST_Iszero : t1 ->> t1' -> Tiszero t1 ->> Tiszero t1' +> ST_IszeroSucc : {t1: Tm} -> Nvalue t1 -> Tiszero (Tsucc t1) ->> Tfalse +> ST_Iszero : {t1, t1': Tm} -> t1 ->> t1' -> Tiszero t1 ->> Tiszero t1' Notice that the `step` relation doesn't care about whether @@ -177,7 +181,7 @@ almost as obviously nonsensical term succ (if true then true else true) -can take a step (once, before becoming stuck). *) +can take a step (once, before becoming stuck). === Normal Forms and Values @@ -200,182 +204,174 @@ terms are _stuck_. > some_term_is_stuck : (t ** stuck t) > some_term_is_stuck = ?some_term_is_stuck_rhs -(** However, although values and normal forms are _not_ the same in this - language, the set of values is included in the set of normal - forms. This is important because it shows we did not accidentally - define things so that some value could still take a step. *) +However, although values and normal forms are _not_ the same in this +language, the set of values is included in the set of normal +forms. This is important because it shows we did not accidentally +define things so that some value could still take a step. -(** **** Exercise: 3 stars (value_is_nf) *) -Lemma value_is_nf : forall t, - value t -> step_normal_form t. -Proof. - (* FILL IN HERE *) Admitted. +==== Exercise: 3 stars (value_is_nf) -(** (Hint: You will reach a point in this proof where you need to - use an induction to reason about a term that is known to be a - numeric value. This induction can be performed either over the - term itself or over the evidence that it is a numeric value. The - proof goes through in either case, but you will find that one way - is quite a bit shorter than the other. For the sake of the - exercise, try to complete the proof both ways.) *) -(** `` *) +> value_is_nf : {t: Tm} -> Value t -> step_normal_form t +> value_is_nf = ?value_is_nf_rhs -(** **** Exercise: 3 stars, optional (step_deterministic) *) -(** Use `value_is_nf` to show that the `step` relation is also - deterministic. *) +==== Exercise: 3 stars, optional (step_deterministic) -Theorem step_deterministic: - deterministic step. -Proof with eauto. - (* FILL IN HERE *) Admitted. -(** `` *) +Use `value_is_nf` to show that the `step` relation is also + deterministic. - + (* ================================================================= *) (** ** Additional Exercises *) From 409ff78a7ad2e316b98cbdb0ab5db8456d45fcd2 Mon Sep 17 00:00:00 2001 From: jutaro Date: Wed, 26 Sep 2018 11:30:03 +0200 Subject: [PATCH 14/30] Types exercises and formatting. --- src/Smallstep.lidr | 62 ++++++++++---- src/Types.lidr | 202 ++++++++++++++++++++++++--------------------- 2 files changed, 155 insertions(+), 109 deletions(-) diff --git a/src/Smallstep.lidr b/src/Smallstep.lidr index d0b0d00..cf68029 100644 --- a/src/Smallstep.lidr +++ b/src/Smallstep.lidr @@ -201,6 +201,8 @@ Right-hand sides of sums can take a step only when the > (C (0 + 3))) > test_step_2 = ?test_step_2_rhs +$\square$ + == Relations We will be working with several different single-step relations, @@ -391,6 +393,7 @@ Most of this proof is the same as the one above. But to get > step_deterministic' = ?step_deterministic_rhs > +$\square$ === Strong Progress and Normal Forms @@ -529,6 +532,8 @@ We might, for example, mistakenly define `value` so that it > value_not_same_as_normal_form : (v : Tm ** (Value' v, Not (normal_form Step'' v))) > value_not_same_as_normal_form = ?value_not_same_as_normal_form_rhs +$\square$ + ==== Exercise: 2 stars, optional (value_not_same_as_normal_form2) Alternatively, we might mistakenly define `step` so that it @@ -553,6 +558,8 @@ Alternatively, we might mistakenly define `step` so that it > value_not_same_as_normal_form''' : (v : Tm ** (Value v, Not (normal_form Step''' v))) > value_not_same_as_normal_form''' = ?value_not_same_as_normal_form_rhs''' +$\square$ + ==== Exercise: 3 stars, optional (value_not_same_as_normal_form3) Finally, we might define `value` and `step` so that there is some @@ -578,6 +585,8 @@ Finally, we might define `value` and `step` so that there is some > value_not_same_as_normal_form'''' : (t : Tm ** (Not (Value t), normal_form Step'''' t)) > value_not_same_as_normal_form'''' = ?value_not_same_as_normal_form_rhs'''' +$\square$ + === Additional Exercises @@ -636,6 +645,8 @@ Which of the following propositions are provable? (This is just a > Tfalse > bool_step_prop3 = ?bool_step_prop3_rhs +$\square$ + ==== Exercise: 3 stars, optional (progress_bool) @@ -693,6 +704,8 @@ Write an extra clause for the step relation that achieves this > bool_step_prop4_holds : bool_step_prop4 > bool_step_prop4_holds = ?bool_step_prop4_holds_rhs +$\square$ + ==== Exercise: 3 stars, optional (properties_of_altered_step) It can be shown that the determinism and strong progress theorems @@ -711,9 +724,11 @@ Optional: prove your answer correct in Idris. Optional: prove your answer correct in Idris. In general, is there any way we could cause strong progress to - fail if we took away one or more constructors from the original - step relation? Write yes or no and briefly (1 sentence) explain - your answer. +fail if we took away one or more constructors from the original +step relation? Write yes or no and briefly (1 sentence) explain +your answer. + +$\square$ == Multi-Step Reduction @@ -823,6 +838,8 @@ Here's a specific instance of the `multi step` relation: > test_multistep_2: C 3 ->>* C 3 > test_multistep_2 = ?test_multistep_2_rhs +$\square$ + ==== Exercise: 1 star, optional (test_multistep_3) > test_multistep_3: @@ -831,6 +848,8 @@ Here's a specific instance of the `multi step` relation: > P (C 0) (C 3) > test_multistep_3 = ?test_multistep_3_rhs +$\square$ + ==== Exercise: 2 stars (test_multistep_4) > test_multistep_4: @@ -845,6 +864,8 @@ Here's a specific instance of the `multi step` relation: > (C (2 + (0 + 3))) > test_multistep_4 = ?test_multistep_4_rhs +$\square$ + === Normal Forms Again If `t` reduces to `t'` in zero or more steps and `t'` is a @@ -868,6 +889,7 @@ We have already seen that, for our language, single-step reduction is > normal_forms_unique : deterministic Smallstep.normal_form_of > normal_forms_unique (l,r) (l2,r2) = ?normal_forms_unique_rhs +$\square$ Indeed, something stronger is true for this language (though not for all languages): the reduction of _any_ term `t` will @@ -900,6 +922,8 @@ node whose left-hand child is a value. > multistep_congr_2 : {v:Value t1} -> (t2 ->>* t2') -> ((P t1 t2) ->>* P t1 t2') > multistep_congr_2 {v=V_const i} mult = ?multistep_congr_2_rhs +$\square$ + With these lemmas in hand, the main proof is a straightforward induction. @@ -978,6 +1002,8 @@ Having defined the operational semantics of our tiny programming > eval__multistep: {t: Tm} -> {n: Nat} -> t >>> n -> t ->>* C n > eval__multistep hyp = ?eval__multistep_rhs +$\square$ + The key ideas in the proof can be seen in the following picture: ``` @@ -1016,7 +1042,7 @@ To formalize this intuition, you'll need to use the congruence Write a detailed informal version of the proof of `eval__multistep` -(* FILL IN HERE *) +$\square$ For the other direction, we need one lemma, which establishes a relation between single-step reduction and big-step evaluation. @@ -1029,14 +1055,16 @@ For the other direction, we need one lemma, which establishes a > t >>> n > step__eval h1 h2 = ?step__eval_rhs +$\square$ + The fact that small-step reduction implies big-step evaluation is - now straightforward to prove, once it is stated correctly. +now straightforward to prove, once it is stated correctly. The proof proceeds by induction on the multi-step reduction - sequence that is buried in the hypothesis `normal_form_of t t'`. +sequence that is buried in the hypothesis `normal_form_of t t'`. Make sure you understand the statement before you start to - work on the proof. +work on the proof. ==== Exercise: 3 stars (multistep__eval) @@ -1044,24 +1072,27 @@ Make sure you understand the statement before you start to > normal_form_of t t' -> (n : Nat ** (t' = C n, t >>> n)) > multistep__eval hyp = ?multistep__eval_rhs +$\square$ === Additional Exercises ==== Exercise: 3 stars, optional (interp_tm) Remember that we also defined big-step evaluation of terms as a - function `evalF`. Prove that it is equivalent to the existing - semantics. (Hint: we just proved that `eval` and `multistep` are - equivalent, so logically it doesn't matter which you choose. - One will be easier than the other, though!) +function `evalF`. Prove that it is equivalent to the existing +semantics. (Hint: we just proved that `eval` and `multistep` are +equivalent, so logically it doesn't matter which you choose. +One will be easier than the other, though!) > evalF_eval : {t: Tm} -> {n: Nat} -> ((evalF t = n) <-> (t >>> n)) +> evalF_eval = ?evalF_eval_rhs + +$\square$ ==== Exercise: 4 stars (combined_properties) We've considered arithmetic and conditional expressions - separately. This exercise explores how the two interact. - +separately. This exercise explores how the two interact. > data TmC : Type where > CC : Nat -> TmC @@ -1075,7 +1106,6 @@ We've considered arithmetic and conditional expressions > V_trueC : ValueC TtrueC > V_falseC : ValueC TfalseC - > mutual > infixl 6 >>-> > (>>->) : TmC -> TmC -> Type @@ -1101,7 +1131,7 @@ Formally prove or disprove these two properties for the combined language. (That is, state a theorem saying that the property holds or does not hold, and prove your theorem.) -(* FILL IN HERE *) +$\square$ diff --git a/src/Types.lidr b/src/Types.lidr index 1b5811e..b3bada1 100644 --- a/src/Types.lidr +++ b/src/Types.lidr @@ -200,10 +200,11 @@ terms are _stuck_. ==== Exercise: 2 stars (some_term_is_stuck) - > some_term_is_stuck : (t ** stuck t) > some_term_is_stuck = ?some_term_is_stuck_rhs +$\square$ + However, although values and normal forms are _not_ the same in this language, the set of values is included in the set of normal forms. This is important because it shows we did not accidentally @@ -214,6 +215,8 @@ define things so that some value could still take a step. > value_is_nf : {t: Tm} -> Value t -> step_normal_form t > value_is_nf = ?value_is_nf_rhs +$\square$ + ==== Exercise: 3 stars, optional (step_deterministic) Use `value_is_nf` to show that the `step` relation is also @@ -222,6 +225,7 @@ Use `value_is_nf` to show that the `step` relation is also > step_deterministic : deterministic step > step_deterministic = ?step_deterministic_rhs +$\square$ == Typing @@ -336,6 +340,8 @@ not calculate the type of its normal form. > Has_type (Tsucc t) TNat -> |- t . TNat > succ_hastype_nat__hastype_nat = ?succ_hastype_nat__hastype_nat_rhs +$\square$ + === Canonical forms The following two lemmas capture the fundamental property that the @@ -387,6 +393,8 @@ Complete the formal proof of the `progress` property. (Make sure > Right (t' ** hr) => Right ((Tif t' t2 t3) ** ST_If hr) > progress t = ?progress_rhs +$\square$ + ==== Exercise: 3 stars, advanced (finish_progress_informal) Complete the corresponding informal proof: @@ -412,7 +420,7 @@ _Proof_: By induction on a derivation of `|- t \in T`. - If `t1` itself can take a step, then, by `ST_If`, so can `t`. - - (* FILL IN HERE *) +$\square$ This theorem is more interesting than the strong progress theorem that we saw in the `Smallstep` chapter, where _all_ normal forms @@ -450,6 +458,8 @@ Complete the formal proof of the `preservation` property. (Again, make sure you understand the informal proof fragment in the following exercise first.) +$\square$ + ==== Exercise: 3 stars, advanced (finish_preservation_informal) Complete the following informal proof: @@ -478,7 +488,7 @@ _Proof_: By induction on a derivation of `|- t \in T`. by the IH, `|- t1' \in Bool`. The `T_If` rule then gives us `|- if t1' then t2 else t3 \in T`, as required. -- (* FILL IN HERE *) +$\square$ ==== Exercise: 3 stars (preservation_alternate_proof) @@ -499,6 +509,7 @@ relation is reduced. This terminology comes from thinking of typing statements as sentences, where the term is the subject and the type is the predicate. +$\square$ === Type Soundness @@ -641,133 +652,140 @@ Tactic Notation "normalize" := --> -(* ================================================================= *) -(** ** Additional Exercises *) +=== Additional Exercises -(** **** Exercise: 2 stars, recommended (subject_expansion) *) -(** Having seen the subject reduction property, one might - wonder whether the opposity property -- subject _expansion_ -- - also holds. That is, is it always the case that, if `t ==> t'` - and `|- t' \in T`, then `|- t \in T`? If so, prove it. If - not, give a counter-example. (You do not need to prove your - counter-example in Coq, but feel free to do so.) +==== Exercise: 2 stars, recommended (subject_expansion) - (* FILL IN HERE *) -*) -(** `` *) +Having seen the subject reduction property, one might +wonder whether the opposity property -- subject _expansion_ -- +also holds. That is, is it always the case that, if `t ==> t'` +and `|- t' \in T`, then `|- t \in T`? If so, prove it. If +not, give a counter-example. (You do not need to prove your +counter-example in Idris, but feel free to do so.) + +$\square$ + +==== Exercise: 2 stars (variation1) + +Suppose, that we add this new rule to the typing relation: -(** **** Exercise: 2 stars (variation1) *) -(** Suppose, that we add this new rule to the typing relation: +```idris + T_SuccBool : {t: Tm} -> + HasType t TBool -> + |- Tsucc t . TBool +``` - | T_SuccBool : forall t, - |- t \in TBool -> - |- tsucc t \in TBool +Which of the following properties remain true in the presence of +this rule? For each one, write either "remains true" or +else "becomes false." If a property becomes false, give a +counterexample. + - Determinism of `step` - Which of the following properties remain true in the presence of - this rule? For each one, write either "remains true" or - else "becomes false." If a property becomes false, give a - counterexample. - - Determinism of `step` + - Progress - - Progress + - Preservation - - Preservation +$\square$ +==== Exercise: 2 stars (variation2) - `` *) +Suppose, instead, that we add this new rule to the `step` relation: -(** **** Exercise: 2 stars (variation2) *) -(** Suppose, instead, that we add this new rule to the `step` relation: +```idris + ST_Funny1 : {t2, t3: Tm} -> + (tif ttrue t2 t3) ->>* t3 +``` - | ST_Funny1 : forall t2 t3, - (tif ttrue t2 t3) ==> t3 +Which of the above properties become false in the presence of +this rule? For each one that does, give a counter-example. - Which of the above properties become false in the presence of - this rule? For each one that does, give a counter-example. +$\square$ +==== Exercise: 2 stars, optional (variation3) - `` *) +Suppose instead that we add this rule: -(** **** Exercise: 2 stars, optional (variation3) *) -(** Suppose instead that we add this rule: +```idris + ST_Funny2 : {t1, t2, t2', t3: Tm} -> + t2 ->>* t2' -> + (tif t1 t2 t3) ->>* (tif t1 t2' t3) +``` - | ST_Funny2 : forall t1 t2 t2' t3, - t2 ==> t2' -> - (tif t1 t2 t3) ==> (tif t1 t2' t3) +Which of the above properties become false in the presence of +this rule? For each one that does, give a counter-example. - Which of the above properties become false in the presence of - this rule? For each one that does, give a counter-example. +$\square$ +==== Exercise: 2 stars, optional (variation4) - `` *) +Suppose instead that we add this rule: + +```idris + ST_Funny3 : + (tpred tfalse) ->>* (tpred (tpred tfalse)) +``` -(** **** Exercise: 2 stars, optional (variation4) *) -(** Suppose instead that we add this rule: +Which of the above properties become false in the presence of +this rule? For each one that does, give a counter-example. - | ST_Funny3 : - (tpred tfalse) ==> (tpred (tpred tfalse)) +$\square$ - Which of the above properties become false in the presence of - this rule? For each one that does, give a counter-example. +==== Exercise: 2 stars, optional (variation5) +Suppose instead that we add this rule: - `` *) +```idris + T_Funny4 : + |- Tzero . TBool +``` -(** **** Exercise: 2 stars, optional (variation5) *) -(** Suppose instead that we add this rule: +Which of the above properties become false in the presence of +this rule? For each one that does, give a counter-example. - | T_Funny4 : - |- tzero \in TBool +$\square$ - Which of the above properties become false in the presence of - this rule? For each one that does, give a counter-example. +==== Exercise: 2 stars, optional (variation6) +Suppose instead that we add this rule: - `` *) +```idris + T_Funny5 : + |- Tpred Tzero . TBool +``` -(** **** Exercise: 2 stars, optional (variation6) *) -(** Suppose instead that we add this rule: +Which of the above properties become false in the presence of +this rule? For each one that does, give a counter-example. - | T_Funny5 : - |- tpred tzero \in TBool +$\square$ - Which of the above properties become false in the presence of - this rule? For each one that does, give a counter-example. +==== Exercise: 3 stars, optional (more_variations) +Make up some exercises of your own along the same lines as +the ones above. Try to find ways of selectively breaking +properties -- i.e., ways of changing the definitions that +break just one of the properties and leave the others alone. - `` *) +$\square$ -(** **** Exercise: 3 stars, optional (more_variations) *) -(** Make up some exercises of your own along the same lines as - the ones above. Try to find ways of selectively breaking - properties -- i.e., ways of changing the definitions that - break just one of the properties and leave the others alone. -*) -(** `` *) +==== Exercise: 1 star (remove_predzero) -(** **** Exercise: 1 star (remove_predzero) *) -(** The reduction rule `ST_PredZero` is a bit counter-intuitive: we - might feel that it makes more sense for the predecessor of zero to - be undefined, rather than being defined to be zero. Can we - achieve this simply by removing the rule from the definition of - `step`? Would doing so create any problems elsewhere? +The reduction rule `ST_PredZero` is a bit counter-intuitive: we +might feel that it makes more sense for the predecessor of zero to +be undefined, rather than being defined to be zero. Can we +achieve this simply by removing the rule from the definition of +`step`? Would doing so create any problems elsewhere? -(* FILL IN HERE *) -*) -(** `` *) +$\square$ -(** **** Exercise: 4 stars, advanced (prog_pres_bigstep) *) -(** Suppose our evaluation relation is defined in the big-step style. - State appropriate analogs of the progress and preservation - properties. (You do not need to prove them.) +==== Exercise: 4 stars, advanced (prog_pres_bigstep) - Can you see any limitations of either of your properties? - Do they allow for nonterminating commands? - Why might we prefer the small-step semantics for stating - preservation and progress? +Suppose our evaluation relation is defined in the big-step style. +State appropriate analogs of the progress and preservation +properties. (You do not need to prove them.) -(* FILL IN HERE *) -*) -(** `` *) +Can you see any limitations of either of your properties? +Do they allow for nonterminating commands? +Why might we prefer the small-step semantics for stating +preservation and progress? ---> +$\square$ From ff80c26fd9dcb00d49fdf3954e79babe706aed0b Mon Sep 17 00:00:00 2001 From: jutaro Date: Wed, 26 Sep 2018 16:53:14 +0200 Subject: [PATCH 15/30] Use operator instead of syntax for iff. --- src/Smallstep.lidr | 9 ++++++--- 1 file changed, 6 insertions(+), 3 deletions(-) diff --git a/src/Smallstep.lidr b/src/Smallstep.lidr index cf68029..3f910fa 100644 --- a/src/Smallstep.lidr +++ b/src/Smallstep.lidr @@ -483,10 +483,13 @@ We can use this terminology to generalize the observation we made > Left va => va > Right pa => void (prf pa) -> iff : {p,q : Type} -> Type -> iff {p} {q} = (p -> q, q -> p) +> iff : (p,q : Type) -> Type +> iff p q = (p -> q, q -> p) + +> infixl 6 <-> +> (<->) : (p: Type) -> (q:Type) -> Type +> (<->) = iff -> syntax [p] "<->" [q] = iff {p} {q} > nf_same_as_value : (normal_form Step t) <-> (Value t) > nf_same_as_value {t} = (nf_is_value t,value_is_nf t) From 2d443783325e9ecb506d01ec0c3d3a942bae13d0 Mon Sep 17 00:00:00 2001 From: jutaro Date: Wed, 26 Sep 2018 16:54:01 +0200 Subject: [PATCH 16/30] Add STLC.lidr. --- src/Stlc.lidr | 807 ++++++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 807 insertions(+) create mode 100644 src/Stlc.lidr diff --git a/src/Stlc.lidr b/src/Stlc.lidr new file mode 100644 index 0000000..c26f9ec --- /dev/null +++ b/src/Stlc.lidr @@ -0,0 +1,807 @@ += Stlc + +== Stlc : The Simply Typed Lambda-Calculus + +The simply typed lambda-calculus (STLC) is a tiny core +calculus embodying the key concept of _functional abstraction_, +which shows up in pretty much every real-world programming +language in some form (functions, procedures, methods, etc.). + +We will follow exactly the same pattern as in the previous chapter +when formalizing this calculus (syntax, small-step semantics, +typing rules) and its main properties (progress and preservation). +The new technical challenges arise from the mechanisms of +_variable binding_ and _substitution_. It which will take some +work to deal with these. + +> module Stlc +> import Smallstep +> import Types + +> %access public export +> %default total +> %hide Types.Tm +> %hide Types.Ty + + + +=== Overview + +The STLC is built on some collection of _base types_: +booleans, numbers, strings, etc. The exact choice of base types +doesn't matter much -- the construction of the language and its +theoretical properties work out the same no matter what we +choose -- so for the sake of brevity let's take just `Bool` for +the moment. At the end of the chapter we'll see how to add more +base types, and in later chapters we'll enrich the pure STLC with +other useful constructs like pairs, records, subtyping, and +mutable state. + +Starting from boolean constants and conditionals, we add three +things: + - variables + - function abstractions + - application + +This gives us the following collection of abstract syntax +constructors (written out first in informal BNF notation -- we'll +formalize it below). + +``` + t ::= x variable + | \x:T1.t2 abstraction + | t1 t2 application + | true constant true + | false constant false + | if t1 then t2 else t3 conditional +``` + +The `\` symbol in a function abstraction `\x:T1.t2` is generally +written as a Greek letter "lambda" (hence the name of the +calculus). The variable `x` is called the _parameter_ to the +function; the term `t2` is its _body_. The annotation `:T1` +specifies the type of arguments that the function can be applied +to. + +Some examples: + +- `\x:Bool. x` + + The identity function for booleans. + +- `(\x:Bool. x) true` + + The identity function for booleans, applied to the boolean `true`. + +- `\x:Bool. if x then false else true` + + The boolean "not" function. + +- `\x:Bool. true` + + The constant function that takes every (boolean) argument to + `true`. + +- `\x:Bool. \y:Bool. x` + + A two-argument function that takes two booleans and returns + the first one. (As in Coq, a two-argument function is really + a one-argument function whose body is also a one-argument + function.) + +- `(\x:Bool. \y:Bool. x) false true` + + A two-argument function that takes two booleans and returns + the first one, applied to the booleans `false` and `true`. + + As in Coq, application associates to the left -- i.e., this + expression is parsed as `((\x:Bool. \y:Bool. x) false) true`. + +- `\f:Bool->Bool. f (f true)` + + A higher-order function that takes a _function_ `f` (from + booleans to booleans) as an argument, applies `f` to `true`, + and applies `f` again to the result. + +- `(\f:Bool->Bool. f (f true)) (\x:Bool. false)` + + The same higher-order function, applied to the constantly + `false` function. + +As the last several examples show, the STLC is a language of +_higher-order_ functions: we can write down functions that take +other functions as arguments and/or return other functions as +results. + +The STLC doesn't provide any primitive syntax for defining _named_ +functions -- all functions are "anonymous." We'll see in chapter +`MoreStlc` that it is easy to add named functions to what we've +got -- indeed, the fundamental naming and binding mechanisms are +exactly the same. + +The _types_ of the STLC include `Bool`, which classifies the +boolean constants `true` and `false` as well as more complex +computations that yield booleans, plus _arrow types_ that classify +functions. + +``` + T ::= Bool + | T1 -> T2 +``` + +For example: + + - `\x:Bool. false` has type `Bool->Bool` + + - `\x:Bool. x` has type `Bool->Bool` + + - `(\x:Bool. x) true` has type `Bool` + + - `\x:Bool. \y:Bool. x` has type `Bool->Bool->Bool` + (i.e., `Bool -> (Bool->Bool)`) + + - `(\x:Bool. \y:Bool. x) false` has type `Bool->Bool` + + - `(\x:Bool. \y:Bool. x) false true` has type `Bool` *) + + +=== Syntax + +We next formalize the syntax of the STLC. + +==== Types + +> data Ty : Type where +> TBool : Ty +> TArrow : Ty -> Ty -> Ty + +> infixr 0 :=> +> (:=>) : Ty -> Ty -> Ty +> (:=>) = TArrow + + +==== Terms + +> infixl 1 # + +> data Tm : Type where +> Tvar : String -> Tm +> (#) : Tm -> Tm -> Tm +> Tabs : String -> Ty -> Tm -> Tm +> Ttrue : Tm +> Tfalse : Tm +> Tif : Tm -> Tm -> Tm -> Tm + +> syntax "(" "\\" [p] ":" [q] "." [r] ")" = Tabs "p" q r + +> syntax "lif" [c] "then" [p] "else" [n] = Tif c p n + +> syntax "&" [p] = Tvar "p" + +Note that an abstraction `\x:T.t` (formally, `tabs x T t`) is +always annotated with the type `T` of its :parameter, in contrast +to Idris (and other functional languages like ML, Haskell, etc.), +which use type inference to fill in missing annotations. We're +not considering type inference here. + +Some examples... + +`idB = \x:Bool. x` + +> idB : Tm +> idB = (\ x : TBool . &x) + +`idBB = \x:Bool->Bool. x` + +> idBB : Tm +> idBB = (\x: (TBool :=> TBool) . &x) + +`idBBBB = \x:(Bool->Bool) -> (Bool->Bool). x` + +> idBBB : Tm +> idBBB = (\x: ((TBool :=> TBool) :=> (TBool :=> TBool)). &x) + +`k = \x:Bool. \y:Bool. x` + +> k : Tm +> k = (\x : TBool . (\y : TBool . &x)) + +`notB = \x:Bool. if x then false else true` + +> notB : Tm +> notB = (\x : TBool . (lif &x then Tfalse else Ttrue)) + +=== Operational Semantics + +To define the small-step semantics of STLC terms, we begin, +as always, by defining the set of values. Next, we define the +critical notions of _free variables_ and _substitution_, which are +used in the reduction rule for application expressions. And +finally we give the small-step relation itself. + +==== Values + +To define the values of the STLC, we have a few cases to consider. + +First, for the boolean part of the language, the situation is +clear: `true` and `false` are the only values. An `if` +expression is never a value. + +Second, an application is clearly not a value: It represents a +function being invoked on some argument, which clearly still has +work left to do. + +Third, for abstractions, we have a choice: + + - We can say that `\x:T. t1` is a value only when `t1` is a + value -- i.e., only if the function's body has been + reduced (as much as it can be without knowing what argument it + is going to be applied to). + + - Or we can say that `\x:T. t1` is always a value, no matter + whether `t1` is one or not -- in other words, we can say that + reduction stops at abstractions. + +Our usual way of evaluating expressions in Idris makes the first +choice -- for example, + + Compute (fun x:bool => 3 + 4) + + yields `fun x:bool => 7`. + +Most real-world functional programming languages make the second +choice -- reduction of a function's body only begins when the +function is actually applied to an argument. We also make the +second choice here. + +> data Value : Tm -> Type where +> V_abs : {x: String} -> {T: Ty} -> {t: Tm} -> Value (Tabs x T t) +> V_true : Value Ttrue +> V_false : Value Tfalse + +Finally, we must consider what constitutes a _complete_ program. + +Intuitively, a "complete program" must not refer to any undefined +variables. We'll see shortly how to define the _free_ variables +in a STLC term. A complete program is _closed_ -- that is, it +contains no free variables. + +(Conversely, a term with free variables is often called an _open +term_.) + +Having made the choice not to reduce under abstractions, we don't +need to worry about whether variables are values, since we'll +always be reducing programs "from the outside in," and that means +the `step` relation will always be working with closed terms. + +==== Substitution + +Now we come to the heart of the STLC: the operation of +substituting one term for a variable in another term. This +operation is used below to define the operational semantics of +function application, where we will need to substitute the +argument term for the function parameter in the function's body. +For example, we reduce + + (\x:Bool. if x then true else x) false + +to + + if false then true else false + +by substituting `false` for the parameter `x` in the body of the +function. + +In general, we need to be able to substitute some given term `s` +for occurrences of some variable `x` in another term `t`. In +informal discussions, this is usually written ` `x:=s`t ` and +pronounced "substitute `x` with `s` in `t`." + +Here are some examples: + + - ``x:=true` (if x then x else false)` + yields `if true then true else false` + + - ``x:=true` x` yields `true` + + - ``x:=true` (if x then x else y)` yields `if true then true else y` + + - ``x:=true` y` yields `y` + + - ``x:=true` false` yields `false` (vacuous substitution) + + - ``x:=true` (\y:Bool. if y then x else false)` + yields `\y:Bool. if y then true else false` + + - ``x:=true` (\y:Bool. x)` yields `\y:Bool. true` + + - ``x:=true` (\y:Bool. y)` yields `\y:Bool. y` + + - ``x:=true` (\x:Bool. x)` yields `\x:Bool. x` + +The last example is very important: substituting `x` with `true` in +`\x:Bool. x` does _not_ yield `\x:Bool. true`! The reason for +this is that the `x` in the body of `\x:Bool. x` is _bound_ by the +abstraction: it is a new, local name that just happens to be +spelled the same as some global name `x`. + +Here is the definition, informally... + + `x:=s`x = s + `x:=s`y = y if x <> y + `x:=s`(\x:T11. t12) = \x:T11. t12 + `x:=s`(\y:T11. t12) = \y:T11. `x:=s`t12 if x <> y + `x:=s`(t1 t2) = (`x:=s`t1) (`x:=s`t2) + `x:=s`true = true + `x:=s`false = false + `x:=s`(if t1 then t2 else t3) = + if `x:=s`t1 then `x:=s`t2 else `x:=s`t3 + +... and formally: + +> mutual + +Fixpoint subst (x:string) (s:Tm) (t:Tm) : Tm := + match t with + | tvar x' => + if beq_string x x' then s else t + | tabs x' T t1 => + tabs x' T (if beq_string x x' then t1 else (`x:=s` t1)) + | tapp t1 t2 => + tapp (`x:=s` t1) (`x:=s` t2) + | ttrue => + ttrue + | tfalse => + tfalse + | tif t1 t2 t3 => + tif (`x:=s` t1) (`x:=s` t2) (`x:=s` t3) + end + +where "'`' x ':=' s '`' t" := (subst x s t). + +(** _Technical note_: Substitution becomes trickier to define if we + consider the case where `s`, the term being substituted for a + variable in some other term, may itself contain free variables. + Since we are only interested here in defining the `step` relation + on _closed_ terms (i.e., terms like `\x:Bool. x` that include + binders for all of the variables they mention), we can avoid this + extra complexity here, but it must be dealt with when formalizing + richer languages. *) + +(** For example, using the definition of substitution above to + substitute the _open_ term `s = \x:Bool. r`, where `r` is a _free_ + reference to some global resource, for the variable `z` in the + term `t = \r:Bool. z`, where `r` is a bound variable, we would get + `\r:Bool. \x:Bool. r`, where the free reference to `r` in `s` has + been "captured" by the binder at the beginning of `t`. + + Why would this be bad? Because it violates the principle that the + names of bound variables do not matter. For example, if we rename + the bound variable in `t`, e.g., let `t' = \w:Bool. z`, then + ``x:=s`t'` is `\w:Bool. \x:Bool. r`, which does not behave the + same as ``x:=s`t = \r:Bool. \x:Bool. r`. That is, renaming a + bound variable changes how `t` behaves under substitution. *) + +(** See, for example, `Aydemir 2008` for further discussion + of this issue. *) + +(** **** Exercise: 3 stars (substi_correct) *) +(** The definition that we gave above uses Coq's `Fixpoint` facility + to define substitution as a _function_. Suppose, instead, we + wanted to define substitution as an inductive _relation_ `substi`. + We've begun the definition by providing the `Inductive` header and + one of the constructors; your job is to fill in the rest of the + constructors and prove that the relation you've defined coincides + with the function given above. *) + +Inductive substi (s:Tm) (x:string) : Tm -> Tm -> Prop := + | s_var1 : + substi s x (tvar x) s + (* FILL IN HERE *) +. + +Hint Constructors substi. + +Theorem substi_correct : forall s x t t', + `x:=s`t = t' <-> substi s x t t'. +Proof. + (* FILL IN HERE *) Admitted. +(** `` *) + +(* ================================================================= *) +(** ** Reduction *) + +(** The small-step reduction relation for STLC now follows the + same pattern as the ones we have seen before. Intuitively, to + reduce a function application, we first reduce its left-hand + side (the function) until it becomes an abstraction; then we + reduce its right-hand side (the argument) until it is also a + value; and finally we substitute the argument for the bound + variable in the body of the abstraction. This last rule, written + informally as + + (\x:T.t12) v2 ==> `x:=v2`t12 + + is traditionally called "beta-reduction". *) + +(** + value v2 + ---------------------------- (ST_AppAbs) + (\x:T.t12) v2 ==> `x:=v2`t12 + + t1 ==> t1' + ---------------- (ST_App1) + t1 t2 ==> t1' t2 + + value v1 + t2 ==> t2' + ---------------- (ST_App2) + v1 t2 ==> v1 t2' +*) +(** ... plus the usual rules for conditionals: + + -------------------------------- (ST_IfTrue) + (if true then t1 else t2) ==> t1 + + --------------------------------- (ST_IfFalse) + (if false then t1 else t2) ==> t2 + + t1 ==> t1' + ---------------------------------------------------- (ST_If) + (if t1 then t2 else t3) ==> (if t1' then t2 else t3) +*) + +(** Formally: *) + +Reserved Notation "t1 '==>' t2" (at level 40). + +Inductive step : Tm -> Tm -> Prop := + | ST_AppAbs : forall x T t12 v2, + value v2 -> + (tapp (tabs x T t12) v2) ==> `x:=v2`t12 + | ST_App1 : forall t1 t1' t2, + t1 ==> t1' -> + tapp t1 t2 ==> tapp t1' t2 + | ST_App2 : forall v1 t2 t2', + value v1 -> + t2 ==> t2' -> + tapp v1 t2 ==> tapp v1 t2' + | ST_IfTrue : forall t1 t2, + (tif ttrue t1 t2) ==> t1 + | ST_IfFalse : forall t1 t2, + (tif tfalse t1 t2) ==> t2 + | ST_If : forall t1 t1' t2 t3, + t1 ==> t1' -> + (tif t1 t2 t3) ==> (tif t1' t2 t3) + +where "t1 '==>' t2" := (step t1 t2). + +Hint Constructors step. + +Notation multistep := (multi step). +Notation "t1 '==>*' t2" := (multistep t1 t2) (at level 40). + +(* ================================================================= *) +(** ** Examples *) + +(** Example: + + (\x:Bool->Bool. x) (\x:Bool. x) ==>* \x:Bool. x + + i.e., + + idBB idB ==>* idB +*) + +Lemma step_example1 : + (tapp idBB idB) ==>* idB. +Proof. + eapply multi_step. + apply ST_AppAbs. + apply v_abs. + simpl. + apply multi_refl. Qed. + +(** Example: + + (\x:Bool->Bool. x) ((\x:Bool->Bool. x) (\x:Bool. x)) + ==>* \x:Bool. x + + i.e., + + (idBB (idBB idB)) ==>* idB. +*) + +Lemma step_example2 : + (tapp idBB (tapp idBB idB)) ==>* idB. +Proof. + eapply multi_step. + apply ST_App2. auto. + apply ST_AppAbs. auto. + eapply multi_step. + apply ST_AppAbs. simpl. auto. + simpl. apply multi_refl. Qed. + +(** Example: + + (\x:Bool->Bool. x) + (\x:Bool. if x then false else true) + true + ==>* false + + i.e., + + (idBB notB) ttrue ==>* tfalse. +*) + +Lemma step_example3 : + tapp (tapp idBB notB) ttrue ==>* tfalse. +Proof. + eapply multi_step. + apply ST_App1. apply ST_AppAbs. auto. simpl. + eapply multi_step. + apply ST_AppAbs. auto. simpl. + eapply multi_step. + apply ST_IfTrue. apply multi_refl. Qed. + +(** Example: + + (\x:Bool -> Bool. x) + ((\x:Bool. if x then false else true) true) + ==>* false + + i.e., + + idBB (notB ttrue) ==>* tfalse. + + (Note that this term doesn't actually typecheck; even so, we can + ask how it reduces.) +*) + +Lemma step_example4 : + tapp idBB (tapp notB ttrue) ==>* tfalse. +Proof. + eapply multi_step. + apply ST_App2. auto. + apply ST_AppAbs. auto. simpl. + eapply multi_step. + apply ST_App2. auto. + apply ST_IfTrue. + eapply multi_step. + apply ST_AppAbs. auto. simpl. + apply multi_refl. Qed. + +(** We can use the `normalize` tactic defined in the `Types` chapter + to simplify these proofs. *) + +Lemma step_example1' : + (tapp idBB idB) ==>* idB. +Proof. normalize. Qed. + +Lemma step_example2' : + (tapp idBB (tapp idBB idB)) ==>* idB. +Proof. normalize. Qed. + +Lemma step_example3' : + tapp (tapp idBB notB) ttrue ==>* tfalse. +Proof. normalize. Qed. + +Lemma step_example4' : + tapp idBB (tapp notB ttrue) ==>* tfalse. +Proof. normalize. Qed. + +(** **** Exercise: 2 stars (step_example5) *) +(** Try to do this one both with and without `normalize`. *) + +Lemma step_example5 : + tapp (tapp idBBBB idBB) idB + ==>* idB. +Proof. + (* FILL IN HERE *) Admitted. + +Lemma step_example5_with_normalize : + tapp (tapp idBBBB idBB) idB + ==>* idB. +Proof. + (* FILL IN HERE *) Admitted. +(** `` *) + +(* ################################################################# *) +(** * Typing *) + +(** Next we consider the typing relation of the STLC. *) + +(* ================================================================= *) +(** ** Contexts *) + +(** _Question_: What is the type of the term "`x y`"? + + _Answer_: It depends on the types of `x` and `y`! + + I.e., in order to assign a type to a term, we need to know + what assumptions we should make about the types of its free + variables. + + This leads us to a three-place _typing judgment_, informally + written `Gamma |- t \in T`, where `Gamma` is a + "typing context" -- a mapping from variables to their types. *) + +(** Following the usual notation for partial maps, we could write `Gamma + & {{x:T}}` for "update the partial function `Gamma` to also map + `x` to `T`." *) + +Definition context := partial_map ty. + +(* ================================================================= *) +(** ** Typing Relation *) + +(** + Gamma x = T + -------------- (T_Var) + Gamma |- x \in T + + Gamma & {{ x --> T11 }} |- t12 \in T12 + -------------------------------------- (T_Abs) + Gamma |- \x:T11.t12 \in T11->T12 + + Gamma |- t1 \in T11->T12 + Gamma |- t2 \in T11 + ---------------------- (T_App) + Gamma |- t1 t2 \in T12 + + -------------------- (T_True) + Gamma |- true \in Bool + + --------------------- (T_False) + Gamma |- false \in Bool + + Gamma |- t1 \in Bool Gamma |- t2 \in T Gamma |- t3 \in T + -------------------------------------------------------- (T_If) + Gamma |- if t1 then t2 else t3 \in T + + + We can read the three-place relation `Gamma |- t \in T` as: + "under the assumptions in Gamma, the term `t` has the type `T`." *) + +Reserved Notation "Gamma '|-' t '\in' T" (at level 40). + +Inductive has_type : context -> tm -> ty -> Prop := + | T_Var : forall Gamma x T, + Gamma x = Some T -> + Gamma |- tvar x \in T + | T_Abs : forall Gamma x T11 T12 t12, + Gamma & {{x --> T11}} |- t12 \in T12 -> + Gamma |- tabs x T11 t12 \in TArrow T11 T12 + | T_App : forall T11 T12 Gamma t1 t2, + Gamma |- t1 \in TArrow T11 T12 -> + Gamma |- t2 \in T11 -> + Gamma |- tapp t1 t2 \in T12 + | T_True : forall Gamma, + Gamma |- ttrue \in TBool + | T_False : forall Gamma, + Gamma |- tfalse \in TBool + | T_If : forall t1 t2 t3 T Gamma, + Gamma |- t1 \in TBool -> + Gamma |- t2 \in T -> + Gamma |- t3 \in T -> + Gamma |- tif t1 t2 t3 \in T + +where "Gamma '|-' t '\in' T" := (has_type Gamma t T). + +Hint Constructors has_type. + +(* ================================================================= *) +(** ** Examples *) + +Example typing_example_1 : + empty |- tabs x TBool (tvar x) \in TArrow TBool TBool. +Proof. + apply T_Abs. apply T_Var. reflexivity. Qed. + +(** Note that since we added the `has_type` constructors to the hints + database, auto can actually solve this one immediately. *) + +Example typing_example_1' : + empty |- tabs x TBool (tvar x) \in TArrow TBool TBool. +Proof. auto. Qed. + +(** Another example: + + empty |- \x:A. \y:A->A. y (y x) + \in A -> (A->A) -> A. +*) + +Example typing_example_2 : + empty |- + (tabs x TBool + (tabs y (TArrow TBool TBool) + (tapp (tvar y) (tapp (tvar y) (tvar x))))) \in + (TArrow TBool (TArrow (TArrow TBool TBool) TBool)). +Proof with auto using update_eq. + apply T_Abs. + apply T_Abs. + eapply T_App. apply T_Var... + eapply T_App. apply T_Var... + apply T_Var... +Qed. + +(** **** Exercise: 2 stars, optional (typing_example_2_full) *) +(** Prove the same result without using `auto`, `eauto`, or + `eapply` (or `...`). *) + +Example typing_example_2_full : + empty |- + (tabs x TBool + (tabs y (TArrow TBool TBool) + (tapp (tvar y) (tapp (tvar y) (tvar x))))) \in + (TArrow TBool (TArrow (TArrow TBool TBool) TBool)). +Proof. + (* FILL IN HERE *) Admitted. +(** `` *) + +(** **** Exercise: 2 stars (typing_example_3) *) +(** Formally prove the following typing derivation holds: *) +(** + empty |- \x:Bool->B. \y:Bool->Bool. \z:Bool. + y (x z) + \in T. +*) + +Example typing_example_3 : + exists T, + empty |- + (tabs x (TArrow TBool TBool) + (tabs y (TArrow TBool TBool) + (tabs z TBool + (tapp (tvar y) (tapp (tvar x) (tvar z)))))) \in + T. +Proof with auto. + (* FILL IN HERE *) Admitted. +(** `` *) + +(** We can also show that terms are _not_ typable. For example, let's + formally check that there is no typing derivation assigning a type + to the term `\x:Bool. \y:Bool, x y` -- i.e., + + ~ exists T, + empty |- \x:Bool. \y:Bool, x y \in T. +*) + +Example typing_nonexample_1 : + ~ exists T, + empty |- + (tabs x TBool + (tabs y TBool + (tapp (tvar x) (tvar y)))) \in + T. +Proof. + intros Hc. inversion Hc. + (* The `clear` tactic is useful here for tidying away bits of + the context that we're not going to need again. *) + inversion H. subst. clear H. + inversion H5. subst. clear H5. + inversion H4. subst. clear H4. + inversion H2. subst. clear H2. + inversion H5. subst. clear H5. + inversion H1. Qed. + +(** **** Exercise: 3 stars, optional (typing_nonexample_3) *) +(** Another nonexample: + + ~ (exists S, exists T, + empty |- \x:S. x x \in T). +*) + +Example typing_nonexample_3 : + ~ (exists S, exists T, + empty |- + (tabs x S + (tapp (tvar x) (tvar x))) \in + T). +Proof. + (* FILL IN HERE *) Admitted. +(** `` *) + +End STLC. + +(** $Date$ *) From 86bb04a2e39c2861340e8cebd69b8d2ec88cc3b4 Mon Sep 17 00:00:00 2001 From: jutaro Date: Wed, 26 Sep 2018 19:19:30 +0200 Subject: [PATCH 17/30] Changed syntax for Has_type. --- src/Types.lidr | 54 +++++++++++++++++++++++++------------------------- 1 file changed, 27 insertions(+), 27 deletions(-) diff --git a/src/Types.lidr b/src/Types.lidr index b3bada1..026a14f 100644 --- a/src/Types.lidr +++ b/src/Types.lidr @@ -302,28 +302,28 @@ is always empty. \newline \] -> syntax "|-" [p] "." [q] = Has_type p q +> syntax "|-" [p] ":" [q] "."= Has_type p q > data Has_type : Tm -> Ty -> Type where -> T_True : |- Ttrue . TBool -> T_False : |- Tfalse . TBool +> T_True : |- Ttrue : TBool . +> T_False : |- Tfalse : TBool . > T_If : {t1, t2, t3: Tm} -> {T: Ty} -> -> Has_type t1 TBool -> -> Has_type t2 T -> -> Has_type t3 T -> -> |- (Tif t1 t2 t3) . T -> T_Zero : |- Tzero . TNat +> |- t1 : TBool . -> +> |- t2 : T . -> +> |- t3 : T . -> +> |- (Tif t1 t2 t3) : T . +> T_Zero : |- Tzero : TNat . > T_Succ : {t1 : Tm} -> -> Has_type t1 TNat -> -> |- (Tsucc t1) . TNat +> |- t1 : TNat . -> +> |- (Tsucc t1) : TNat . > T_Pred : {t1 : Tm} -> -> Has_type t1 TNat -> -> |- (Tpred t1) . TNat +> |- t1 : TNat . -> +> |- (Tpred t1) : TNat . > T_Iszero : {t1 : Tm} -> -> Has_type t1 TNat -> -> |- (Tiszero t1) . TBool +> |- t1 : TNat . -> +> |- (Tiszero t1) : TBool . -> has_type_1 : |- (Tif Tfalse Tzero (Tsucc Tzero)) . TNat +> has_type_1 : |- (Tif Tfalse Tzero (Tsucc Tzero)) : TNat . > has_type_1 = T_If (T_False) (T_Zero) (T_Succ T_Zero) It's important to realize that the typing relation is a @@ -331,13 +331,13 @@ _conservative_ (or _static_) approximation: it does not consider what happens when the term is reduced -- in particular, it does not calculate the type of its normal form. -> has_type_not : Not (Has_type (Tif Tfalse Tzero Ttrue) TBool) +> has_type_not : Not ( |- (Tif Tfalse Tzero Ttrue) : TBool . ) > has_type_not (T_If (T_False) (T_Zero) (T_True)) impossible ==== Exercise: 1 star, optional (succ_hastype_nat__hastype_nat) > succ_hastype_nat__hastype_nat : {t : Tm} -> -> Has_type (Tsucc t) TNat -> |- t . TNat +> |- (Tsucc t) : TNat . -> |- t : TNat . > succ_hastype_nat__hastype_nat = ?succ_hastype_nat__hastype_nat_rhs $\square$ @@ -348,21 +348,21 @@ The following two lemmas capture the fundamental property that the definitions of boolean and numeric values agree with the typing relation. -> bool_canonical : {t: Tm} -> Has_type t TBool -> Value t -> Bvalue t +> bool_canonical : {t: Tm} -> |- t : TBool . -> Value t -> Bvalue t > bool_canonical {t} ht v = > case v of > V_bool b => b > V_nat n => void (lemma n ht) -> where lemma : {t:Tm} -> Nvalue t -> Not (Has_type t TBool) +> where lemma : {t:Tm} -> Nvalue t -> Not ( |- t : TBool . ) > lemma {t=Tzero} n T_Zero impossible > lemma {t=Tsucc n'} n (T_Succ n') impossible -> nat_canonical : {t: Tm} -> Has_type t TNat -> Value t -> Nvalue t +> nat_canonical : {t: Tm} -> |- t : TNat . -> Value t -> Nvalue t > nat_canonical {t} ht v = > case v of > V_nat n => n > V_bool b => void (lemma b ht) -> where lemma : {t:Tm} -> Bvalue t -> Not (Has_type t TNat) +> where lemma : {t:Tm} -> Bvalue t -> Not ( |- t : TNat . ) > lemma {t=Ttrue} n T_True impossible > lemma {t=Tfalse} n T_False impossible @@ -373,7 +373,7 @@ that well-typed normal forms are not stuck -- or conversely, if a term is well typed, then either it is a value or it can take at least one step. We call this _progress_. -> progress : {t: Tm} -> {ty: Ty} -> Has_type t ty -> Either (Value t) (t' ** t ->> t') +> progress : {t: Tm} -> {ty: Ty} -> |- t : ty . -> Either (Value t) (t' ** t ->> t') ==== Exercise: 3 stars (finish_progress) @@ -434,7 +434,7 @@ The second critical property of typing is that, when a well-typed term takes a step, the result is also a well-typed term. > preservation : {t, t': Tm} -> {T: Ty} -> -> Has_type t T -> t ->> t' -> |- t' . T +> |- t : T . -> t ->> t' -> |- t' : T . ==== Exercise: 2 stars (finish_preservation) @@ -500,17 +500,17 @@ each one is doing. The set-up for this proof is similar, but not exactly the same. > preservation' : {t, t': Tm} -> {T: Ty} -> -> Has_type t T -> t ->> t' -> |- t' . T +> |- t : T . -> t ->> t' -> |- t' : T . > preservation' h1 h2 = ?preservation'_rhs +$\square$ + The preservation theorem is often called _subject reduction_, because it tells us what happens when the "subject" of the typing relation is reduced. This terminology comes from thinking of typing statements as sentences, where the term is the subject and the type is the predicate. -$\square$ - === Type Soundness Putting progress and preservation together, we see that a @@ -525,7 +525,7 @@ well-typed term can never reach a stuck state. > multistep = Multi Step > soundness : {t, t': Tm} -> {T: Ty} -> -> Has_type t T -> +> |- t : T . -> > t ->>* t' -> > Not (stuck t') > soundness ht Multi_refl (sl,sr) = From 430277dba3a8e3a4f577ac3cb9b9145c5c35d53c Mon Sep 17 00:00:00 2001 From: jutaro Date: Wed, 26 Sep 2018 19:19:47 +0200 Subject: [PATCH 18/30] Started Stlc. --- src/Stlc.lidr | 124 ++++++++++++++++++++++++++------------------------ 1 file changed, 64 insertions(+), 60 deletions(-) diff --git a/src/Stlc.lidr b/src/Stlc.lidr index c26f9ec..45babf3 100644 --- a/src/Stlc.lidr +++ b/src/Stlc.lidr @@ -340,67 +340,71 @@ Here is the definition, informally... ... and formally: > mutual +> +> subst : String -> Tm -> Tm -> Tm +> subst x s t = +> case t of +> Tvar x' => if x == x' then s else t +> Tabs x' ty t1 => +> Tabs x' ty (if x == x' then t1 else subst x s t1) +> t1 # t2 => subst x s t1 # subst x s t2 +> Ttrue => Ttrue +> Tfalse => Tfalse +> Tif t1 t2 t3 => Tif (subst x s t1) (subst x s t2) (subst x s t3) + +> infixl 5 := +> (:=) : String -> Tm -> Tm -> Tm +> (:=) x s = subst x s + +_Technical note_: Substitution becomes trickier to define if we +consider the case where `s`, the term being substituted for a +variable in some other term, may itself contain free variables. +Since we are only interested here in defining the `step` relation +on _closed_ terms (i.e., terms like `\x:Bool. x` that include +binders for all of the variables they mention), we can avoid this +extra complexity here, but it must be dealt with when formalizing +richer languages. + +For example, using the definition of substitution above to +substitute the _open_ term `s = \x:Bool. r`, where `r` is a _free_ +reference to some global resource, for the variable `z` in the +term `t = \r:Bool. z`, where `r` is a bound variable, we would get +`\r:Bool. \x:Bool. r`, where the free reference to `r` in `s` has +been "captured" by the binder at the beginning of `t`. + +Why would this be bad? Because it violates the principle that the +names of bound variables do not matter. For example, if we rename +the bound variable in `t`, e.g., let `t' = \w:Bool. z`, then +``x:=s`t'` is `\w:Bool. \x:Bool. r`, which does not behave the +same as ``x:=s`t = \r:Bool. \x:Bool. r`. That is, renaming a +bound variable changes how `t` behaves under substitution. *) + +See, for example, `Aydemir 2008` for further discussion +of this issue. + +==== Exercise: 3 stars (substi_correct) + +The definition that we gave above uses Idris recursive facility +to define substitution as a _function_. Suppose, instead, we +wanted to define substitution as an inductive _relation_ `substi`. +We've begun the definition by providing the `Inductive` header and +one of the constructors; your job is to fill in the rest of the +constructors and prove that the relation you've defined coincides +with the function given above. + +-- > data substi : Tm -> Tm -> Type where -- (s:Tm) (x:string) : := +-- > S_Var1 : (s:Tm) -> (x:string) -> substi s x (Tvar x) s +-- > S_Var1 : (s:Tm) -> (x:string) -> substi s x (Tvar x) s +-- +-- +-- > Tvar x' => if x == x' then s else t +-- > Tabs x' ty t1 => +-- > Tabs x' ty (if x == x' then t1 else subst x s t1) +-- > t1 # t2 => subst x s t1 # subst x s t2 +-- > Ttrue => Ttrue +-- > Tfalse => Tfalse +-- > Tif t1 t2 t3 => Tif (subst x s t1) (subst x s t2) (subst x s t3) -Fixpoint subst (x:string) (s:Tm) (t:Tm) : Tm := - match t with - | tvar x' => - if beq_string x x' then s else t - | tabs x' T t1 => - tabs x' T (if beq_string x x' then t1 else (`x:=s` t1)) - | tapp t1 t2 => - tapp (`x:=s` t1) (`x:=s` t2) - | ttrue => - ttrue - | tfalse => - tfalse - | tif t1 t2 t3 => - tif (`x:=s` t1) (`x:=s` t2) (`x:=s` t3) - end - -where "'`' x ':=' s '`' t" := (subst x s t). - -(** _Technical note_: Substitution becomes trickier to define if we - consider the case where `s`, the term being substituted for a - variable in some other term, may itself contain free variables. - Since we are only interested here in defining the `step` relation - on _closed_ terms (i.e., terms like `\x:Bool. x` that include - binders for all of the variables they mention), we can avoid this - extra complexity here, but it must be dealt with when formalizing - richer languages. *) - -(** For example, using the definition of substitution above to - substitute the _open_ term `s = \x:Bool. r`, where `r` is a _free_ - reference to some global resource, for the variable `z` in the - term `t = \r:Bool. z`, where `r` is a bound variable, we would get - `\r:Bool. \x:Bool. r`, where the free reference to `r` in `s` has - been "captured" by the binder at the beginning of `t`. - - Why would this be bad? Because it violates the principle that the - names of bound variables do not matter. For example, if we rename - the bound variable in `t`, e.g., let `t' = \w:Bool. z`, then - ``x:=s`t'` is `\w:Bool. \x:Bool. r`, which does not behave the - same as ``x:=s`t = \r:Bool. \x:Bool. r`. That is, renaming a - bound variable changes how `t` behaves under substitution. *) - -(** See, for example, `Aydemir 2008` for further discussion - of this issue. *) - -(** **** Exercise: 3 stars (substi_correct) *) -(** The definition that we gave above uses Coq's `Fixpoint` facility - to define substitution as a _function_. Suppose, instead, we - wanted to define substitution as an inductive _relation_ `substi`. - We've begun the definition by providing the `Inductive` header and - one of the constructors; your job is to fill in the rest of the - constructors and prove that the relation you've defined coincides - with the function given above. *) - -Inductive substi (s:Tm) (x:string) : Tm -> Tm -> Prop := - | s_var1 : - substi s x (tvar x) s - (* FILL IN HERE *) -. - -Hint Constructors substi. Theorem substi_correct : forall s x t t', `x:=s`t = t' <-> substi s x t t'. From 64fd826b4e35867effc6114e70216470531aecdb Mon Sep 17 00:00:00 2001 From: jutaro Date: Sat, 29 Sep 2018 13:04:03 +0200 Subject: [PATCH 19/30] Substitution. --- src/Smallstep.lidr | 2 +- src/Stlc.lidr | 88 ++++++++++++++++++++++------------------------ 2 files changed, 43 insertions(+), 47 deletions(-) diff --git a/src/Smallstep.lidr b/src/Smallstep.lidr index 3f910fa..cd2c025 100644 --- a/src/Smallstep.lidr +++ b/src/Smallstep.lidr @@ -486,7 +486,7 @@ We can use this terminology to generalize the observation we made > iff : (p,q : Type) -> Type > iff p q = (p -> q, q -> p) -> infixl 6 <-> +> infixl 9 <-> > (<->) : (p: Type) -> (q:Type) -> Type > (<->) = iff diff --git a/src/Stlc.lidr b/src/Stlc.lidr index 45babf3..2065728 100644 --- a/src/Stlc.lidr +++ b/src/Stlc.lidr @@ -327,34 +327,33 @@ spelled the same as some global name `x`. Here is the definition, informally... - `x:=s`x = s - `x:=s`y = y if x <> y - `x:=s`(\x:T11. t12) = \x:T11. t12 - `x:=s`(\y:T11. t12) = \y:T11. `x:=s`t12 if x <> y - `x:=s`(t1 t2) = (`x:=s`t1) (`x:=s`t2) - `x:=s`true = true - `x:=s`false = false - `x:=s`(if t1 then t2 else t3) = - if `x:=s`t1 then `x:=s`t2 else `x:=s`t3 + [x:=s]x = s + [x:=s]y = y if x <> y + [x:=s](\x:T11. t12) = \x:T11. t12 + [x:=s](\y:T11. t12) = \y:T11. [x:=s]t12 if x <> y + [x:=s](t1 t2) = ([x:=s]t1) ([x:=s]t2) + [x:=s]true = true + [x:=s]false = false + [x:=s](if t1 then t2 else t3) = + if [x:=s]t1 then [x:=s]t2 else [x:=s]t3 ... and formally: -> mutual -> > subst : String -> Tm -> Tm -> Tm -> subst x s t = -> case t of -> Tvar x' => if x == x' then s else t -> Tabs x' ty t1 => -> Tabs x' ty (if x == x' then t1 else subst x s t1) -> t1 # t2 => subst x s t1 # subst x s t2 -> Ttrue => Ttrue -> Tfalse => Tfalse -> Tif t1 t2 t3 => Tif (subst x s t1) (subst x s t2) (subst x s t3) - -> infixl 5 := -> (:=) : String -> Tm -> Tm -> Tm -> (:=) x s = subst x s +> subst x s (Tvar x') = +> case decEq x x' of +> Yes _ => s +> No _ => (Tvar x') +> subst x s (Tabs x' ty t1) = +> Tabs x' ty (case decEq x x' of +> Yes p => t1 +> No p => subst x s t1) +> subst x s (t1 # t2) = subst x s t1 # subst x s t2 +> subst x s Ttrue = Ttrue +> subst x s Tfalse = Tfalse +> subst x s (Tif t1 t2 t3) = Tif (subst x s t1) (subst x s t2) (subst x s t3) + +> syntax "[" [p] ":=" [q] "]" [r] = subst p q r _Technical note_: Substitution becomes trickier to define if we consider the case where `s`, the term being substituted for a @@ -375,9 +374,9 @@ been "captured" by the binder at the beginning of `t`. Why would this be bad? Because it violates the principle that the names of bound variables do not matter. For example, if we rename the bound variable in `t`, e.g., let `t' = \w:Bool. z`, then -``x:=s`t'` is `\w:Bool. \x:Bool. r`, which does not behave the -same as ``x:=s`t = \r:Bool. \x:Bool. r`. That is, renaming a -bound variable changes how `t` behaves under substitution. *) +``x:=s[t'] is `\w:Bool. \x:Bool. r`, which does not behave the +same as `[x:=s]t = \r:Bool. \x:Bool. r`. That is, renaming a +bound variable changes how `t` behaves under substitution. See, for example, `Aydemir 2008` for further discussion of this issue. @@ -392,25 +391,22 @@ one of the constructors; your job is to fill in the rest of the constructors and prove that the relation you've defined coincides with the function given above. --- > data substi : Tm -> Tm -> Type where -- (s:Tm) (x:string) : := --- > S_Var1 : (s:Tm) -> (x:string) -> substi s x (Tvar x) s --- > S_Var1 : (s:Tm) -> (x:string) -> substi s x (Tvar x) s --- --- --- > Tvar x' => if x == x' then s else t --- > Tabs x' ty t1 => --- > Tabs x' ty (if x == x' then t1 else subst x s t1) --- > t1 # t2 => subst x s t1 # subst x s t2 --- > Ttrue => Ttrue --- > Tfalse => Tfalse --- > Tif t1 t2 t3 => Tif (subst x s t1) (subst x s t2) (subst x s t3) - - -Theorem substi_correct : forall s x t t', - `x:=s`t = t' <-> substi s x t t'. -Proof. - (* FILL IN HERE *) Admitted. -(** `` *) +> data Substi : (s:Tm) -> (x:String) -> Tm -> Tm -> Type where +> S_True : Substi s x Ttrue Ttrue +> S_False : Substi s x Tfalse Tfalse +> S_App : {l', r':Tm} -> Substi s x l l' -> Substi s x r r' -> Substi s x (l # r) (l' # r') +> S_If : {b', p',n':Tm} -> Substi s x b b' -> Substi s x p p' +> -> Substi s x n n' -> Substi s x (Tif b p n) (Tif b' p' n') +> S_Var1 : Substi s x (Tvar x) s +> S_Var2 : Substi s x (Tvar y) (Tvar y) +> S_Abs1 : Substi s x t t' -> Substi s x (Tabs x' ty t) (Tabs x' ty t') +> S_Abs2 : Substi s x (Tabs y ty t) (Tabs y ty t) + + +> substi_correct : (s:Tm) -> (x: String) -> (t : Tm) -> (t' : Tm) -> +> (([ x := s ] t) = t') <-> Substi s x t t' +> substi_correct s x t t' = ?substi_correct_rhs1 + (* ================================================================= *) (** ** Reduction *) From b9749fbcc71311ae6a77366c43a4cc4d3237d0bd Mon Sep 17 00:00:00 2001 From: jutaro Date: Sun, 30 Sep 2018 13:15:01 +0200 Subject: [PATCH 20/30] Started Reduction. --- src/Stlc.lidr | 229 ++++++++++++++++++++++++++------------------------ 1 file changed, 121 insertions(+), 108 deletions(-) diff --git a/src/Stlc.lidr b/src/Stlc.lidr index 2065728..2be2818 100644 --- a/src/Stlc.lidr +++ b/src/Stlc.lidr @@ -22,6 +22,9 @@ work to deal with these. > %default total > %hide Types.Tm > %hide Types.Ty +> %hide Types.(->>) + + @@ -162,7 +165,7 @@ We next formalize the syntax of the STLC. ==== Terms -> infixl 1 # +> infixl 7 # > data Tm : Type where > Tvar : String -> Tm @@ -408,112 +411,122 @@ with the function given above. > substi_correct s x t t' = ?substi_correct_rhs1 -(* ================================================================= *) -(** ** Reduction *) - -(** The small-step reduction relation for STLC now follows the - same pattern as the ones we have seen before. Intuitively, to - reduce a function application, we first reduce its left-hand - side (the function) until it becomes an abstraction; then we - reduce its right-hand side (the argument) until it is also a - value; and finally we substitute the argument for the bound - variable in the body of the abstraction. This last rule, written - informally as - - (\x:T.t12) v2 ==> `x:=v2`t12 - - is traditionally called "beta-reduction". *) - -(** - value v2 - ---------------------------- (ST_AppAbs) - (\x:T.t12) v2 ==> `x:=v2`t12 - - t1 ==> t1' - ---------------- (ST_App1) - t1 t2 ==> t1' t2 - - value v1 - t2 ==> t2' - ---------------- (ST_App2) - v1 t2 ==> v1 t2' -*) -(** ... plus the usual rules for conditionals: - - -------------------------------- (ST_IfTrue) - (if true then t1 else t2) ==> t1 - - --------------------------------- (ST_IfFalse) - (if false then t1 else t2) ==> t2 - - t1 ==> t1' - ---------------------------------------------------- (ST_If) - (if t1 then t2 else t3) ==> (if t1' then t2 else t3) -*) - -(** Formally: *) - -Reserved Notation "t1 '==>' t2" (at level 40). - -Inductive step : Tm -> Tm -> Prop := - | ST_AppAbs : forall x T t12 v2, - value v2 -> - (tapp (tabs x T t12) v2) ==> `x:=v2`t12 - | ST_App1 : forall t1 t1' t2, - t1 ==> t1' -> - tapp t1 t2 ==> tapp t1' t2 - | ST_App2 : forall v1 t2 t2', - value v1 -> - t2 ==> t2' -> - tapp v1 t2 ==> tapp v1 t2' - | ST_IfTrue : forall t1 t2, - (tif ttrue t1 t2) ==> t1 - | ST_IfFalse : forall t1 t2, - (tif tfalse t1 t2) ==> t2 - | ST_If : forall t1 t1' t2 t3, - t1 ==> t1' -> - (tif t1 t2 t3) ==> (tif t1' t2 t3) - -where "t1 '==>' t2" := (step t1 t2). - -Hint Constructors step. - -Notation multistep := (multi step). -Notation "t1 '==>*' t2" := (multistep t1 t2) (at level 40). - -(* ================================================================= *) -(** ** Examples *) - -(** Example: - - (\x:Bool->Bool. x) (\x:Bool. x) ==>* \x:Bool. x +== Reduction + +The small-step reduction relation for STLC now follows the +same pattern as the ones we have seen before. Intuitively, to +reduce a function application, we first reduce its left-hand +side (the function) until it becomes an abstraction; then we +reduce its right-hand side (the argument) until it is also a +value; and finally we substitute the argument for the bound +variable in the body of the abstraction. This last rule, written +informally as + + (\x:T.t12) v2 ->> [x:=v2] t12 + +is traditionally called "beta-reduction". + + +\[ + \begin{prooftree} + \hypo{\idr{value v2}} + \infer1[\idr{ST_AppAbs}]{\idr{(\x:T.t12) v2 ->> [x:=v2] t12}} + \end{prooftree} +\] + +\[ + \begin{prooftree} + \hypo{\idr{t1 ->> t1'}} + \infer1[\idr{ST_App1}]{\idr{t1 t2 ->> t1' t2} + \end{prooftree} +\] + +\[ + \begin{prooftree} + \hypo{\idr{value v1}} + \hypo{\idr{t2 ->> t2'}} + \infer2[\idr{ST_App2}]{\idr{v1 t2 ->> v1 t2'} + \end{prooftree} +\] + +... plus the usual rules for conditionals: + +\[ + \begin{prooftree} + \infer0[\idr{ST_IfTrue}]{\idr{(if true then t1 else t2) ->> t1} + \end{prooftree} +\] + +\[ + \begin{prooftree} + \infer0[\idr{ST_IfFalse}]{\idr{(if false then t1 else t2) ->> t2} + \end{prooftree} +\] + +\[ + \begin{prooftree} + \hypo{\idr{t1 ->> t1'}} + \infer1[\idr{ST_If}]{\idr{(if t1 then t2 else t3) ->> (if t1' then t2 else t3)} + \end{prooftree} +\] + +Formally: + +> mutual +> infixl 6 ->> +> (->>) : Tm -> Tm -> Type +> (->>) = Step +> +> data Step : Tm -> Tm -> Type where +> ST_AppAbs : {x: String} -> {ty : Ty} -> {t12 : Tm} -> {v2 : Tm} -> +> Value v2 -> +> (Tabs x ty t12) # v2 ->> [ x := v2] t12 +> ST_App1 : {t1, t1', t2: Tm} -> +> t1 ->> t1' -> +> t1 # t2 ->> t1' # t2 +> ST_App2 : {v1, t2, t2' : Tm} -> +> Value v1 -> +> t2 ->> t2' -> +> v1 # t2 ->> v1 # t2' +> ST_IfTrue : {t1, t2: Tm} -> +> Tif Ttrue t1 t2 ->> t1 +> ST_IfFalse : {t1, t2: Tm} -> +> Tif Tfalse t1 t2 ->> t2 +> ST_If : {t1, t1', t2, t3: Tm} -> +> t1 ->> t1' -> +> Tif t1 t2 t3 ->> Tif t1' t2 t3 + +> infixl 6 ->>* +> (->>*) : Tm -> Tm -> Type +> (->>*) t t' = Multi Step t t' + +=== Examples + +Example: + + (\x:Bool->Bool. x) (\x:Bool. x) ->>* \x:Bool. x i.e., - idBB idB ==>* idB -*) + idBB idB ->>* idB -Lemma step_example1 : - (tapp idBB idB) ==>* idB. -Proof. - eapply multi_step. - apply ST_AppAbs. - apply v_abs. - simpl. - apply multi_refl. Qed. +> step_example1 : Stlc.idBB # Stlc.idB ->>* Stlc.idB +> step_example1 = +> Multi_step (ST_AppAbs V_abs) Multi_refl -(** Example: +Example: (\x:Bool->Bool. x) ((\x:Bool->Bool. x) (\x:Bool. x)) - ==>* \x:Bool. x + ->>* \x:Bool. x i.e., - (idBB (idBB idB)) ==>* idB. -*) + (idBB (idBB idB)) ->>* idB. + +> step_example2 : Stlc.idBB # (Stlc.idBB # Stlc.idB) ->>* Stlc.idB +> step_example2 = +> Multi_step (ST_App2 V_abs ?hole1 ) (Multi_step (ST_AppAbs V_abs) ?hole3) -Lemma step_example2 : - (tapp idBB (tapp idBB idB)) ==>* idB. Proof. eapply multi_step. apply ST_App2. auto. @@ -527,15 +540,15 @@ Proof. (\x:Bool->Bool. x) (\x:Bool. if x then false else true) true - ==>* false + ->>* false i.e., - (idBB notB) ttrue ==>* tfalse. + (idBB notB) ttrue ->>* tfalse. *) Lemma step_example3 : - tapp (tapp idBB notB) ttrue ==>* tfalse. + tapp (tapp idBB notB) ttrue ->>* tfalse. Proof. eapply multi_step. apply ST_App1. apply ST_AppAbs. auto. simpl. @@ -548,18 +561,18 @@ Proof. (\x:Bool -> Bool. x) ((\x:Bool. if x then false else true) true) - ==>* false + ->>* false i.e., - idBB (notB ttrue) ==>* tfalse. + idBB (notB ttrue) ->>* tfalse. (Note that this term doesn't actually typecheck; even so, we can ask how it reduces.) *) Lemma step_example4 : - tapp idBB (tapp notB ttrue) ==>* tfalse. + tapp idBB (tapp notB ttrue) ->>* tfalse. Proof. eapply multi_step. apply ST_App2. auto. @@ -575,19 +588,19 @@ Proof. to simplify these proofs. *) Lemma step_example1' : - (tapp idBB idB) ==>* idB. + (tapp idBB idB) ->>* idB. Proof. normalize. Qed. Lemma step_example2' : - (tapp idBB (tapp idBB idB)) ==>* idB. + (tapp idBB (tapp idBB idB)) ->>* idB. Proof. normalize. Qed. Lemma step_example3' : - tapp (tapp idBB notB) ttrue ==>* tfalse. + tapp (tapp idBB notB) ttrue ->>* tfalse. Proof. normalize. Qed. Lemma step_example4' : - tapp idBB (tapp notB ttrue) ==>* tfalse. + tapp idBB (tapp notB ttrue) ->>* tfalse. Proof. normalize. Qed. (** **** Exercise: 2 stars (step_example5) *) @@ -595,13 +608,13 @@ Proof. normalize. Qed. Lemma step_example5 : tapp (tapp idBBBB idBB) idB - ==>* idB. + ->>* idB. Proof. (* FILL IN HERE *) Admitted. Lemma step_example5_with_normalize : tapp (tapp idBBBB idBB) idB - ==>* idB. + ->>* idB. Proof. (* FILL IN HERE *) Admitted. (** `` *) From 52b51877ed10de60c54e8fc95d43f40c4d052d66 Mon Sep 17 00:00:00 2001 From: jutaro Date: Mon, 1 Oct 2018 14:51:18 +0200 Subject: [PATCH 21/30] Typing of Stlc. --- src/Stlc.lidr | 382 +++++++++++++++++++++++--------------------------- 1 file changed, 174 insertions(+), 208 deletions(-) diff --git a/src/Stlc.lidr b/src/Stlc.lidr index 2be2818..e1737bd 100644 --- a/src/Stlc.lidr +++ b/src/Stlc.lidr @@ -17,12 +17,19 @@ work to deal with these. > module Stlc > import Smallstep > import Types +> import Maps > %access public export > %default total > %hide Types.Tm > %hide Types.Ty > %hide Types.(->>) +> %hide Types.(->>*) +> %hide Smallstep.(->>) +> %hide Smallstep.(->>*) +> %hide Types.Has_type + + @@ -165,7 +172,7 @@ We next formalize the syntax of the STLC. ==== Terms -> infixl 7 # +> infixr 7 # > data Tm : Type where > Tvar : String -> Tm @@ -201,8 +208,8 @@ Some examples... `idBBBB = \x:(Bool->Bool) -> (Bool->Bool). x` -> idBBB : Tm -> idBBB = (\x: ((TBool :=> TBool) :=> (TBool :=> TBool)). &x) +> idBBBB : Tm +> idBBBB = (\x: ((TBool :=> TBool) :=> (TBool :=> TBool)). &x) `k = \x:Bool. \y:Bool. x` @@ -286,41 +293,41 @@ function application, where we will need to substitute the argument term for the function parameter in the function's body. For example, we reduce - (\x:Bool. if x then true else x) false + (\x:Bool. if x then true else x) false to - if false then true else false + if false then true else false by substituting `false` for the parameter `x` in the body of the function. In general, we need to be able to substitute some given term `s` for occurrences of some variable `x` in another term `t`. In -informal discussions, this is usually written ` `x:=s`t ` and +informal discussions, this is usually written ` [x:=s]t ` and pronounced "substitute `x` with `s` in `t`." Here are some examples: - - ``x:=true` (if x then x else false)` + - `[x:=true] (if x then x else false)` yields `if true then true else false` - - ``x:=true` x` yields `true` + - `[x:=true] x` yields `true` - - ``x:=true` (if x then x else y)` yields `if true then true else y` + - `[x:=true] (if x then x else y)` yields `if true then true else y` - - ``x:=true` y` yields `y` + - `[x:=true] y` yields `y` - - ``x:=true` false` yields `false` (vacuous substitution) + - `[x:=true] false` yields `false` (vacuous substitution) - - ``x:=true` (\y:Bool. if y then x else false)` + - `[x:=true] (\y:Bool. if y then x else false)` yields `\y:Bool. if y then true else false` - - ``x:=true` (\y:Bool. x)` yields `\y:Bool. true` + - `[x:=true] (\y:Bool. x)` yields `\y:Bool. true` - - ``x:=true` (\y:Bool. y)` yields `\y:Bool. y` + - `[x:=true] (\y:Bool. y)` yields `\y:Bool. y` - - ``x:=true` (\x:Bool. x)` yields `\x:Bool. x` + - `[x:=true] (\x:Bool. x)` yields `\x:Bool. x` The last example is very important: substituting `x` with `true` in `\x:Bool. x` does _not_ yield `\x:Bool. true`! The reason for @@ -330,14 +337,15 @@ spelled the same as some global name `x`. Here is the definition, informally... - [x:=s]x = s - [x:=s]y = y if x <> y - [x:=s](\x:T11. t12) = \x:T11. t12 - [x:=s](\y:T11. t12) = \y:T11. [x:=s]t12 if x <> y - [x:=s](t1 t2) = ([x:=s]t1) ([x:=s]t2) - [x:=s]true = true - [x:=s]false = false - [x:=s](if t1 then t2 else t3) = + + [x:=s]x = s + [x:=s]y = y if x <> y + [x:=s](\x:T11. t12) = \x:T11. t12 + [x:=s](\y:T11. t12) = \y:T11. [x:=s]t12 if x <> y + [x:=s](t1 t2) = ([x:=s]t1) ([x:=s]t2) + [x:=s]true = true + [x:=s]false = false + [x:=s](if t1 then t2 else t3) = if [x:=s]t1 then [x:=s]t2 else [x:=s]t3 ... and formally: @@ -377,7 +385,7 @@ been "captured" by the binder at the beginning of `t`. Why would this be bad? Because it violates the principle that the names of bound variables do not matter. For example, if we rename the bound variable in `t`, e.g., let `t' = \w:Bool. z`, then -``x:=s[t'] is `\w:Bool. \x:Bool. r`, which does not behave the +`[x:=s]t` is `\w:Bool. \x:Bool. r`, which does not behave the same as `[x:=s]t = \r:Bool. \x:Bool. r`. That is, renaming a bound variable changes how `t` behaves under substitution. @@ -437,7 +445,7 @@ is traditionally called "beta-reduction". \[ \begin{prooftree} \hypo{\idr{t1 ->> t1'}} - \infer1[\idr{ST_App1}]{\idr{t1 t2 ->> t1' t2} + \infer1[\idr{ST_App1}]{\idr{t1 t2 ->> t1' t2}} \end{prooftree} \] @@ -445,7 +453,7 @@ is traditionally called "beta-reduction". \begin{prooftree} \hypo{\idr{value v1}} \hypo{\idr{t2 ->> t2'}} - \infer2[\idr{ST_App2}]{\idr{v1 t2 ->> v1 t2'} + \infer2[\idr{ST_App2}]{\idr{v1 t2 ->> v1 t2'}} \end{prooftree} \] @@ -453,20 +461,20 @@ is traditionally called "beta-reduction". \[ \begin{prooftree} - \infer0[\idr{ST_IfTrue}]{\idr{(if true then t1 else t2) ->> t1} + \infer0[\idr{ST_IfTrue}]{\idr{(if true then t1 else t2) ->> t1}} \end{prooftree} \] \[ \begin{prooftree} - \infer0[\idr{ST_IfFalse}]{\idr{(if false then t1 else t2) ->> t2} + \infer0[\idr{ST_IfFalse}]{\idr{(if false then t1 else t2) ->> t2}} \end{prooftree} \] \[ \begin{prooftree} \hypo{\idr{t1 ->> t1'}} - \infer1[\idr{ST_If}]{\idr{(if t1 then t2 else t3) ->> (if t1' then t2 else t3)} + \infer1[\idr{ST_If}]{\idr{(if t1 then t2 else t3) ->> (if t1' then t2 else t3)}} \end{prooftree} \] @@ -525,17 +533,10 @@ Example: > step_example2 : Stlc.idBB # (Stlc.idBB # Stlc.idB) ->>* Stlc.idB > step_example2 = -> Multi_step (ST_App2 V_abs ?hole1 ) (Multi_step (ST_AppAbs V_abs) ?hole3) - -Proof. - eapply multi_step. - apply ST_App2. auto. - apply ST_AppAbs. auto. - eapply multi_step. - apply ST_AppAbs. simpl. auto. - simpl. apply multi_refl. Qed. +> Multi_step (ST_App2 V_abs (ST_AppAbs V_abs)) +> (Multi_step (ST_AppAbs V_abs) Multi_refl) -(** Example: +Example: (\x:Bool->Bool. x) (\x:Bool. if x then false else true) @@ -545,44 +546,31 @@ Proof. i.e., (idBB notB) ttrue ->>* tfalse. -*) -Lemma step_example3 : - tapp (tapp idBB notB) ttrue ->>* tfalse. -Proof. - eapply multi_step. - apply ST_App1. apply ST_AppAbs. auto. simpl. - eapply multi_step. - apply ST_AppAbs. auto. simpl. - eapply multi_step. - apply ST_IfTrue. apply multi_refl. Qed. +> step_example3 : (Stlc.idBB # Stlc.notB) # Ttrue ->>* Tfalse +> step_example3 = Multi_step (ST_App1 (ST_AppAbs V_abs)) +> (Multi_step (ST_AppAbs V_true) +> (Multi_step ST_IfTrue Multi_refl)) -(** Example: +Example: - (\x:Bool -> Bool. x) - ((\x:Bool. if x then false else true) true) - ->>* false + (\x:Bool -> Bool. x) + ((\x:Bool. if x then false else true) true) + ->>* false - i.e., + i.e., - idBB (notB ttrue) ->>* tfalse. + idBB (notB ttrue) ->>* tfalse. - (Note that this term doesn't actually typecheck; even so, we can - ask how it reduces.) -*) +(Note that this term doesn't actually typecheck; even so, we can +ask how it reduces.) -Lemma step_example4 : - tapp idBB (tapp notB ttrue) ->>* tfalse. -Proof. - eapply multi_step. - apply ST_App2. auto. - apply ST_AppAbs. auto. simpl. - eapply multi_step. - apply ST_App2. auto. - apply ST_IfTrue. - eapply multi_step. - apply ST_AppAbs. auto. simpl. - apply multi_refl. Qed. +> step_example4 : Stlc.idBB # (Stlc.notB # Ttrue) ->>* Tfalse +> step_example4 = Multi_step (ST_App2 V_abs (ST_AppAbs V_true)) +> (Multi_step (ST_App2 V_abs ST_IfTrue) +> (Multi_step (ST_AppAbs V_false) Multi_refl)) + + -Lemma step_example5 : - tapp (tapp idBBBB idBB) idB - ->>* idB. -Proof. - (* FILL IN HERE *) Admitted. - -Lemma step_example5_with_normalize : - tapp (tapp idBBBB idBB) idB - ->>* idB. -Proof. - (* FILL IN HERE *) Admitted. -(** `` *) +==== Exercise: 2 stars (step_example5) -(* ################################################################# *) -(** * Typing *) +Try to do this one both with and without `normalize`. -(** Next we consider the typing relation of the STLC. *) +> step_example5 : +> (Stlc.idBBBB # Stlc.idBB) # Stlc.idB ->>* Stlc.idB +> step_example5 = ?step_example5_rhs -(* ================================================================= *) -(** ** Contexts *) -(** _Question_: What is the type of the term "`x y`"? +=== Typing - _Answer_: It depends on the types of `x` and `y`! +Next we consider the typing relation of the STLC. - I.e., in order to assign a type to a term, we need to know - what assumptions we should make about the types of its free - variables. +==== Contexts - This leads us to a three-place _typing judgment_, informally - written `Gamma |- t \in T`, where `Gamma` is a - "typing context" -- a mapping from variables to their types. *) +_Question_: What is the type of the term "`x y`" -(** Following the usual notation for partial maps, we could write `Gamma - & {{x:T}}` for "update the partial function `Gamma` to also map - `x` to `T`." *) +_Answer_: It depends on the types of `x` and `y`! -Definition context := partial_map ty. +I.e., in order to assign a type to a term, we need to know +what assumptions we should make about the types of its free +variables. -(* ================================================================= *) -(** ** Typing Relation *) +This leads us to a three-place _typing judgment_, informally +written `Gamma |- t \in T`, where `Gamma` is a +"typing context" -- a mapping from variables to their types. -(** - Gamma x = T - -------------- (T_Var) - Gamma |- x \in T +Following the usual notation for partial maps, we could write `Gamma +& {{x:T}}` for "update the partial function `Gamma` to also map +`x` to `T`." - Gamma & {{ x --> T11 }} |- t12 \in T12 - -------------------------------------- (T_Abs) - Gamma |- \x:T11.t12 \in T11->T12 +> Context : Type +> Context = PartialMap Ty - Gamma |- t1 \in T11->T12 - Gamma |- t2 \in T11 - ---------------------- (T_App) - Gamma |- t1 t2 \in T12 +> syntax [context] "&" "{{" [x] "==>" [y] "}}" = update x y context - -------------------- (T_True) - Gamma |- true \in Bool +==== Typing Relation - --------------------- (T_False) - Gamma |- false \in Bool +\[ + \begin{prooftree} + \hypo{\idr{Gamma x = T}} + \infer1[\idr{T_Var}]{\idr{Gamma |- x \in T}} + \end{prooftree} +\] - Gamma |- t1 \in Bool Gamma |- t2 \in T Gamma |- t3 \in T - -------------------------------------------------------- (T_If) - Gamma |- if t1 then t2 else t3 \in T +\[ + \begin{prooftree} + \hypo{\idr{Gamma & {{ x --> T11 }} |- t12 \in T12}} + \infer1[\idr{T_Abs}]{\idr{Gamma |- \x:T11.t12 \in T11->T12}} + \end{prooftree} +\] +\[ + \begin{prooftree} + \hypo{\idr{Gamma |- t1 \in T11->T12}} + \hypo{\idr{Gamma |- t2 \in T11}} + \infer2[\idr{T_App}]{\idr{Gamma |- t1 t2 \in T12}} + \end{prooftree} +\] - We can read the three-place relation `Gamma |- t \in T` as: - "under the assumptions in Gamma, the term `t` has the type `T`." *) +\[ + \begin{prooftree} + \infer0[\idr{T_True}]{\idr{Gamma |- true \in Bool}} + \end{prooftree} +\] -Reserved Notation "Gamma '|-' t '\in' T" (at level 40). +\[ + \begin{prooftree} + \infer0[\idr{T_False}]{\idr{Gamma |- false \in Bool}} + \end{prooftree} +\] -Inductive has_type : context -> tm -> ty -> Prop := - | T_Var : forall Gamma x T, - Gamma x = Some T -> - Gamma |- tvar x \in T - | T_Abs : forall Gamma x T11 T12 t12, - Gamma & {{x --> T11}} |- t12 \in T12 -> - Gamma |- tabs x T11 t12 \in TArrow T11 T12 - | T_App : forall T11 T12 Gamma t1 t2, - Gamma |- t1 \in TArrow T11 T12 -> - Gamma |- t2 \in T11 -> - Gamma |- tapp t1 t2 \in T12 - | T_True : forall Gamma, - Gamma |- ttrue \in TBool - | T_False : forall Gamma, - Gamma |- tfalse \in TBool - | T_If : forall t1 t2 t3 T Gamma, - Gamma |- t1 \in TBool -> - Gamma |- t2 \in T -> - Gamma |- t3 \in T -> - Gamma |- tif t1 t2 t3 \in T +\[ + \begin{prooftree} + \hypo{\idr{Gamma |- t1 \in Bool}} + \hypo{\idr{Gamma |- t2 \in T}} + \hypo{\idr{Gamma |- t3 \in T}} + \infer3[\idr{T_If}]{\idr{Gamma |- if t1 then t2 else t3 \in T}} + \end{prooftree} +\] -where "Gamma '|-' t '\in' T" := (has_type Gamma t T). +We can read the three-place relation `Gamma |- t \in T` as: +"under the assumptions in Gamma, the term `t` has the type `T`." *) -Hint Constructors has_type. +> syntax [context] "|-" [t] "::" [T] "." = Has_type context t T -(* ================================================================= *) -(** ** Examples *) +> data Has_type : Context -> Tm -> Ty -> Type where +> T_Var : {Gamma: Context} -> {x: String} -> {T: Ty} -> +> Gamma (MkId x) = Just T -> +> Gamma |- (Tvar x) :: T . +> T_Abs : {Gamma: Context} -> {x: String} -> {T11, T12: Ty} -> {t12 : Tm} -> +> (Gamma & {{ (MkId x) ==> T11 }}) |- t12 :: T12 . -> +> Gamma |- (Tabs x T11 t12) :: (T11 :=> T12) . +> T_App : {Gamma: Context} -> {T11, T12: Ty} -> {t1, t2 : Tm} -> +> Gamma |- t1 :: (T11 :=> T12) . -> +> Gamma |- t2 :: T11 . -> +> Gamma |- (t1 # t2) :: T12 . +> T_True : {Gamma: Context} -> +> Gamma |- Ttrue :: TBool . +> T_False : {Gamma: Context} -> +> Gamma |- Tfalse :: TBool . +> T_If : {Gamma: Context} -> {T : Ty} -> {t1, t2, t3 : Tm} -> +> Gamma |- t1 :: TBool . -> +> Gamma |- t2 :: T . -> +> Gamma |- t3 :: T . -> +> Gamma |- (Tif t1 t2 t3) :: T . -Example typing_example_1 : - empty |- tabs x TBool (tvar x) \in TArrow TBool TBool. -Proof. - apply T_Abs. apply T_Var. reflexivity. Qed. +==== Examples -(** Note that since we added the `has_type` constructors to the hints - database, auto can actually solve this one immediately. *) +> typing_example_1 : empty |- (Tabs "x" TBool (Tvar "x")) :: (TBool :=> TBool) . +> typing_example_1 = T_Abs (T_Var Refl) -Example typing_example_1' : - empty |- tabs x TBool (tvar x) \in TArrow TBool TBool. -Proof. auto. Qed. -(** Another example: +Another example: +``` empty |- \x:A. \y:A->A. y (y x) \in A -> (A->A) -> A. -*) +``` -Example typing_example_2 : - empty |- - (tabs x TBool - (tabs y (TArrow TBool TBool) - (tapp (tvar y) (tapp (tvar y) (tvar x))))) \in - (TArrow TBool (TArrow (TArrow TBool TBool) TBool)). -Proof with auto using update_eq. - apply T_Abs. - apply T_Abs. - eapply T_App. apply T_Var... - eapply T_App. apply T_Var... - apply T_Var... -Qed. - -(** **** Exercise: 2 stars, optional (typing_example_2_full) *) -(** Prove the same result without using `auto`, `eauto`, or - `eapply` (or `...`). *) - -Example typing_example_2_full : - empty |- - (tabs x TBool - (tabs y (TArrow TBool TBool) - (tapp (tvar y) (tapp (tvar y) (tvar x))))) \in - (TArrow TBool (TArrow (TArrow TBool TBool) TBool)). -Proof. - (* FILL IN HERE *) Admitted. -(** `` *) +> typing_example_2 : empty |- +> (Tabs "x" TBool +> (Tabs "y" (TBool :=> TBool) +> (Tvar "y" # Tvar "y" # Tvar "x"))) :: +> (TBool :=> (TBool :=> TBool) :=> TBool) . +> typing_example_2 = T_Abs (T_Abs (T_App (T_Var Refl) (T_App (T_Var Refl) (T_Var Refl)))) -(** **** Exercise: 2 stars (typing_example_3) *) -(** Formally prove the following typing derivation holds: *) -(** - empty |- \x:Bool->B. \y:Bool->Bool. \z:Bool. + +==== Exercise: 2 stars (typing_example_3) + +Formally prove the following typing derivation holds: + +``` + empty |- \x:Bool->B. \y:Bool->Bool. \z:Bool. y (x z) \in T. -*) +``` -Example typing_example_3 : - exists T, - empty |- - (tabs x (TArrow TBool TBool) - (tabs y (TArrow TBool TBool) - (tabs z TBool - (tapp (tvar y) (tapp (tvar x) (tvar z)))))) \in - T. -Proof with auto. - (* FILL IN HERE *) Admitted. -(** `` *) +> typing_example_3 : (T : Ty ** +> empty |- +> (Tabs x (TBool :=> TBool) +> (Tabs y (TBool :=> TBool) +> (Tabs z TBool +> (Tvar y # (Tvar x # Tvar z))))) :: T . ) +> typing_example_3 = ?typing_example_3_rhs -(** We can also show that terms are _not_ typable. For example, let's - formally check that there is no typing derivation assigning a type - to the term `\x:Bool. \y:Bool, x y` -- i.e., +We can also show that terms are _not_ typable. For example, let's +formally check that there is no typing derivation assigning a type +to the term `\x:Bool. \y:Bool, x y` -- i.e., +``` ~ exists T, empty |- \x:Bool. \y:Bool, x y \in T. -*) +``` Example typing_nonexample_1 : ~ exists T, @@ -816,5 +784,3 @@ Proof. (** `` *) End STLC. - -(** $Date$ *) From b92be2835764447608b25282840a0904e9e6dc5a Mon Sep 17 00:00:00 2001 From: jutaro Date: Tue, 2 Oct 2018 08:56:40 +0200 Subject: [PATCH 22/30] Finished with Stlc. --- src/Stlc.lidr | 130 +++++++++++++++++++++++--------------------------- 1 file changed, 60 insertions(+), 70 deletions(-) diff --git a/src/Stlc.lidr b/src/Stlc.lidr index e1737bd..dc69637 100644 --- a/src/Stlc.lidr +++ b/src/Stlc.lidr @@ -29,12 +29,6 @@ work to deal with these. > %hide Smallstep.(->>*) > %hide Types.Has_type - - - - - - === Overview The STLC is built on some collection of _base types_: @@ -199,7 +193,7 @@ Some examples... `idB = \x:Bool. x` > idB : Tm -> idB = (\ x : TBool . &x) +> idB = (\x: TBool . &x) `idBB = \x:Bool->Bool. x` @@ -418,6 +412,7 @@ with the function given above. > (([ x := s ] t) = t') <-> Substi s x t t' > substi_correct s x t t' = ?substi_correct_rhs1 +$\square$ == Reduction @@ -595,12 +590,11 @@ Proof. normalize. Qed. ==== Exercise: 2 stars (step_example5) -Try to do this one both with and without `normalize`. - > step_example5 : > (Stlc.idBBBB # Stlc.idBB) # Stlc.idB ->>* Stlc.idB > step_example5 = ?step_example5_rhs +$\square$ === Typing @@ -617,7 +611,7 @@ what assumptions we should make about the types of its free variables. This leads us to a three-place _typing judgment_, informally -written `Gamma |- t \in T`, where `Gamma` is a +written `Gamma |- t ::T`, where `Gamma` is a "typing context" -- a mapping from variables to their types. Following the usual notation for partial maps, we could write `Gamma @@ -634,47 +628,47 @@ Following the usual notation for partial maps, we could write `Gamma \[ \begin{prooftree} \hypo{\idr{Gamma x = T}} - \infer1[\idr{T_Var}]{\idr{Gamma |- x \in T}} + \infer1[\idr{T_Var}]{\idr{Gamma |- x ::T}} \end{prooftree} \] \[ \begin{prooftree} - \hypo{\idr{Gamma & {{ x --> T11 }} |- t12 \in T12}} - \infer1[\idr{T_Abs}]{\idr{Gamma |- \x:T11.t12 \in T11->T12}} + \hypo{\idr{Gamma & {{ x --> T11 }} |- t12 :: T12}} + \infer1[\idr{T_Abs}]{\idr{Gamma |- \x:T11.t12 ::T11->T12}} \end{prooftree} \] \[ \begin{prooftree} - \hypo{\idr{Gamma |- t1 \in T11->T12}} - \hypo{\idr{Gamma |- t2 \in T11}} - \infer2[\idr{T_App}]{\idr{Gamma |- t1 t2 \in T12}} + \hypo{\idr{Gamma |- t1 ::T11->T12}} + \hypo{\idr{Gamma |- t2 ::T11}} + \infer2[\idr{T_App}]{\idr{Gamma |- t1 t2 ::T12}} \end{prooftree} \] \[ \begin{prooftree} - \infer0[\idr{T_True}]{\idr{Gamma |- true \in Bool}} + \infer0[\idr{T_True}]{\idr{Gamma |- true ::Bool}} \end{prooftree} \] \[ \begin{prooftree} - \infer0[\idr{T_False}]{\idr{Gamma |- false \in Bool}} + \infer0[\idr{T_False}]{\idr{Gamma |- false ::Bool}} \end{prooftree} \] \[ \begin{prooftree} - \hypo{\idr{Gamma |- t1 \in Bool}} - \hypo{\idr{Gamma |- t2 \in T}} - \hypo{\idr{Gamma |- t3 \in T}} - \infer3[\idr{T_If}]{\idr{Gamma |- if t1 then t2 else t3 \in T}} + \hypo{\idr{Gamma |- t1 ::Bool}} + \hypo{\idr{Gamma |- t2 ::T}} + \hypo{\idr{Gamma |- t3 ::T}} + \infer3[\idr{T_If}]{\idr{Gamma |- if t1 then t2 else t3 ::T}} \end{prooftree} \] -We can read the three-place relation `Gamma |- t \in T` as: +We can read the three-place relation `Gamma |- t ::T` as: "under the assumptions in Gamma, the term `t` has the type `T`." *) > syntax [context] "|-" [t] "::" [T] "." = Has_type context t T @@ -687,7 +681,7 @@ We can read the three-place relation `Gamma |- t \in T` as: > (Gamma & {{ (MkId x) ==> T11 }}) |- t12 :: T12 . -> > Gamma |- (Tabs x T11 t12) :: (T11 :=> T12) . > T_App : {Gamma: Context} -> {T11, T12: Ty} -> {t1, t2 : Tm} -> -> Gamma |- t1 :: (T11 :=> T12) . -> +> Gamma |- t1 :: (T11 :=> T12). -> > Gamma |- t2 :: T11 . -> > Gamma |- (t1 # t2) :: T12 . > T_True : {Gamma: Context} -> @@ -710,7 +704,7 @@ Another example: ``` empty |- \x:A. \y:A->A. y (y x) - \in A -> (A->A) -> A. + ::A -> (A->A) -> A. ``` > typing_example_2 : empty |- @@ -718,7 +712,8 @@ Another example: > (Tabs "y" (TBool :=> TBool) > (Tvar "y" # Tvar "y" # Tvar "x"))) :: > (TBool :=> (TBool :=> TBool) :=> TBool) . -> typing_example_2 = T_Abs (T_Abs (T_App (T_Var Refl) (T_App (T_Var Refl) (T_Var Refl)))) +> typing_example_2 = +> T_Abs (T_Abs (T_App (T_Var Refl) (T_App (T_Var Refl) (T_Var Refl)))) ==== Exercise: 2 stars (typing_example_3) @@ -728,59 +723,54 @@ Formally prove the following typing derivation holds: ``` empty |- \x:Bool->B. \y:Bool->Bool. \z:Bool. y (x z) - \in T. + ::T. ``` -> typing_example_3 : (T : Ty ** -> empty |- -> (Tabs x (TBool :=> TBool) -> (Tabs y (TBool :=> TBool) -> (Tabs z TBool -> (Tvar y # (Tvar x # Tvar z))))) :: T . ) +> typing_example_3 : +> (T : Ty ** empty |- +> (Tabs "x" (TBool :=> TBool) +> (Tabs "y" (TBool :=> TBool) +> (Tabs "z" TBool +> (Tvar "y" # (Tvar "x" # Tvar "z"))))) :: T . ) > typing_example_3 = ?typing_example_3_rhs +$\square$ + We can also show that terms are _not_ typable. For example, let's formally check that there is no typing derivation assigning a type to the term `\x:Bool. \y:Bool, x y` -- i.e., ``` ~ exists T, - empty |- \x:Bool. \y:Bool, x y \in T. + empty |- \x:Bool. \y:Bool, x y ::T. ``` -Example typing_nonexample_1 : - ~ exists T, - empty |- - (tabs x TBool - (tabs y TBool - (tapp (tvar x) (tvar y)))) \in - T. -Proof. - intros Hc. inversion Hc. - (* The `clear` tactic is useful here for tidying away bits of - the context that we're not going to need again. *) - inversion H. subst. clear H. - inversion H5. subst. clear H5. - inversion H4. subst. clear H4. - inversion H2. subst. clear H2. - inversion H5. subst. clear H5. - inversion H1. Qed. - -(** **** Exercise: 3 stars, optional (typing_nonexample_3) *) -(** Another nonexample: - - ~ (exists S, exists T, - empty |- \x:S. x x \in T). -*) - -Example typing_nonexample_3 : - ~ (exists S, exists T, - empty |- - (tabs x S - (tapp (tvar x) (tvar x))) \in - T). -Proof. - (* FILL IN HERE *) Admitted. -(** `` *) - -End STLC. +> forallToExistence : {X : Type} -> {P: X -> Type} -> +> ((a : X) -> Not (P a)) -> Not (a : X ** P a) +> forallToExistence hyp (b ** p2) = hyp b p2 + +> typing_nonexample_1 : +> Not (T : Ty ** +> empty |- +> (Tabs "x" TBool +> (Tabs "y" TBool +> (Tvar "x" # Tvar y))) :: T . ) +> typing_nonexample_1 = forallToExistence +> (\ a , (T_Abs (T_Abs (T_App (T_Var Refl)(T_Var Refl)))) impossible) + +==== Exercise: 3 stars, optional (typing_nonexample_3) + +Another nonexample: + +``` ~ (exists S, exists T, + empty |- \x:S. x x ::T). +``` + +> typing_nonexample_3 : +> Not (s : Ty ** t : Ty ** +> empty |- +> (Tabs "x" s +> (Tvar "x" # Tvar "x")) :: t . ) +> typing_nonexample_3 = ?typing_nonexample_3_rhs + +$\square$ From 9615a1b1397b6e7471dcc4ae1da13d0094c87a7c Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?J=C3=BCrgen=20Nicklisch-Franken?= Date: Thu, 18 Oct 2018 18:08:38 +0200 Subject: [PATCH 23/30] Started StlcProp --- src/Stlc.lidr | 5 +- src/StlcProp.lidr | 844 ++++++++++++++++++++++++++++++++++++++++++++++ 2 files changed, 847 insertions(+), 2 deletions(-) create mode 100644 src/StlcProp.lidr diff --git a/src/Stlc.lidr b/src/Stlc.lidr index dc69637..fccfbad 100644 --- a/src/Stlc.lidr +++ b/src/Stlc.lidr @@ -21,6 +21,7 @@ work to deal with these. > %access public export > %default total + > %hide Types.Tm > %hide Types.Ty > %hide Types.(->>) @@ -497,7 +498,7 @@ Formally: > Tif Tfalse t1 t2 ->> t2 > ST_If : {t1, t1', t2, t3: Tm} -> > t1 ->> t1' -> -> Tif t1 t2 t3 ->> Tif t1' t2 t3 +> Tif t1 t2 t3 ->> Tif t1' t2 t3 > infixl 6 ->>* > (->>*) : Tm -> Tm -> Type @@ -747,7 +748,7 @@ to the term `\x:Bool. \y:Bool, x y` -- i.e., > forallToExistence : {X : Type} -> {P: X -> Type} -> > ((a : X) -> Not (P a)) -> Not (a : X ** P a) -> forallToExistence hyp (b ** p2) = hyp b p2 +> forallToExistence hyp (a ** p2) = hyp a p2 > typing_nonexample_1 : > Not (T : Ty ** diff --git a/src/StlcProp.lidr b/src/StlcProp.lidr new file mode 100644 index 0000000..10026e2 --- /dev/null +++ b/src/StlcProp.lidr @@ -0,0 +1,844 @@ += StlcProp + +== StlcProp: Properties of STLC + +> module StlcProp +> import Maps +> import Types +> import Smallstep +> import Stlc + +> %access public export +> %default total + +In this chapter, we develop the fundamental theory of the Simply +Typed Lambda Calculus -- in particular, the type safety +theorem. + +== Canonical Forms + +As we saw for the simple calculus in the `Types` chapter, the +first step in establishing basic properties of reduction and types +is to identify the possible _canonical forms_ (i.e., well-typed +closed values) belonging to each type. For `Bool`, these are the +boolean values `ttrue` and `tfalse`; for arrow types, they are +lambda-abstractions. + +> canonical_forms_bool : {t : Tm} -> +> empty |- t :: TBool . -> +> Value t -> +> (t = Ttrue) `Either` (t = Tfalse) + +> canonical_forms_bool {t=Ttrue} tb vt = Left Refl +> canonical_forms_bool {t=Tfalse} tb vt = Right Refl + + +> canonical_forms_fun : {t: Tm} -> {ty1, ty2: Ty} -> +> empty |- t :: (ty1 :=> ty2) . -> +> Value t -> +> (x : String ** u : Tm ** t = Tabs x ty1 u) + +> canonical_forms_fun {t = Ttrue} T_True _ impossible +> canonical_forms_fun {t = Tfalse} T_False _ impossible +> canonical_forms_fun {t = Tabs x ty t1} {ty1} tt vt = +> case tt of +> T_Abs {x} {t12} pre => (x ** t12 ** Refl) + + +== Progress + +The _progress_ theorem tells us that closed, well-typed +terms are not stuck: either a well-typed term is a value, or it +can take a reduction step. The proof is a relatively +straightforward extension of the progress proof we saw in the +`Types` chapter. We'll give the proof in English first, then +the formal version. + +> progress : {t : Tm} -> {ty: Ty} -> +> (empty {a=Ty}) |- t :: ty . -> +> (Value t) `Either` (t': Tm ** t ->> t') + +_Proof_: By induction on the derivation of `|- t \in T` + + - The last rule of the derivation cannot be `T_Var`, since a + variable is never well typed in an empty context. + + - The `T_True`, `T_False`, and `T_Abs` cases are trivial, since in + each of these cases we can see by inspecting the rule that `t` + is a value. + + - If the last rule of the derivation is `T_App`, then `t` has the + form `t1 t2` for some `t1` and `t2`, where `|- t1 \in T2 -> T` + and `|- t2 \in T2` for some type `T2`. By the induction + hypothesis, either `t1` is a value or it can take a reduction + step. + + - If `t1` is a value, then consider `t2`, which by the other + induction hypothesis must also either be a value or take a + step. + + - Suppose `t2` is a value. Since `t1` is a value with an + arrow type, it must be a lambda abstraction; hence `t1 + t2` can take a step by `ST_AppAbs`. + + - Otherwise, `t2` can take a step, and hence so can `t1 + t2` by `ST_App2`. + + - If `t1` can take a step, then so can `t1 t2` by `ST_App1`. + + - If the last rule of the derivation is `T_If`, then `t = if t1 + then t2 else t3`, where `t1` has type `Bool`. By the IH, `t1` + either is a value or takes a step. + + - If `t1` is a value, then since it has type `Bool` it must be + either `true` or `false`. If it is `true`, then `t` steps + to `t2`; otherwise it steps to `t3`. + + - Otherwise, `t1` takes a step, and therefore so does `t` (by + `ST_If`). + + +> progress {t=Tvar x} (T_Var Refl) impossible +> progress {t=Ttrue} _ = Left V_true +> progress {t=Tfalse} _ = Left V_false +> progress {t=Tabs x ty t1} _ = Left V_abs +> progress {t=tl # tr} (T_App hl hr) = +> let indHypl = StlcProp.progress {t=tl} hl +> in case indHypl of +> Right (t' ** hyp) => Right (t' # tr ** ST_App1 hyp) +> Left vl => +> let indHypR = StlcProp.progress {t=tr} hr +> in case indHypR of +> Right (t' ** hyp) => Right (tl # t' ** ST_App2 vl hyp) +> Left vr => +> case vl of +> V_abs {x} {t=tl} => Right (subst x tr tl ** ST_AppAbs vr) +> progress {t=Tif tb tp tn} {ty} _ = ?hole + + +(** **** Exercise: 3 stars, advanced (progress_from_term_ind) *) +(** Show that progress can also be proved by induction on terms + instead of induction on typing derivations. *) + +Theorem progress' : forall t T, + empty |- t \in T -> + value t \/ exists t', t ==> t'. +Proof. + intros t. + induction t; intros T Ht; auto. + (* FILL IN HERE *) Admitted. +(** `` *) + +(* ################################################################# *) +(** * Preservation *) + +(** The other half of the type soundness property is the + preservation of types during reduction. For this part, we'll need + to develop some technical machinery for reasoning about variables + and substitution. Working from top to bottom (from the high-level + property we are actually interested in to the lowest-level + technical lemmas that are needed by various cases of the more + interesting proofs), the story goes like this: + + - The _preservation theorem_ is proved by induction on a typing + derivation, pretty much as we did in the `Types` chapter. + The one case that is significantly different is the one for + the `ST_AppAbs` rule, whose definition uses the substitution + operation. To see that this step preserves typing, we need to + know that the substitution itself does. So we prove a... + + - _substitution lemma_, stating that substituting a (closed) + term `s` for a variable `x` in a term `t` preserves the type + of `t`. The proof goes by induction on the form of `t` and + requires looking at all the different cases in the definition + of substitition. This time, the tricky cases are the ones for + variables and for function abstractions. In both, we discover + that we need to take a term `s` that has been shown to be + well-typed in some context `Gamma` and consider the same term + `s` in a slightly different context `Gamma'`. For this we + prove a... + + - _context invariance_ lemma, showing that typing is preserved + under "inessential changes" to the context `Gamma` -- in + particular, changes that do not affect any of the free + variables of the term. And finally, for this, we need a + careful definition of... + + - the _free variables_ in a term -- i.e., variables that are + used in the term and where these uses are _not_ in the scope of + an enclosing function abstraction binding a variable of the + same name. + + To make Coq happy, we need to formalize the story in the opposite + order... *) + +(* ================================================================= *) +(** ** Free Occurrences *) + +(** A variable `x` _appears free in_ a term _t_ if `t` contains some + occurrence of `x` that is not under an abstraction labeled `x`. + For example: + - `y` appears free, but `x` does not, in `\x:T->U. x y` + - both `x` and `y` appear free in `(\x:T->U. x y) x` + - no variables appear free in `\x:T->U. \y:T. x y` + + Formally: *) + +Inductive appears_free_in : string -> tm -> Prop := + | afi_var : forall x, + appears_free_in x (tvar x) + | afi_app1 : forall x t1 t2, + appears_free_in x t1 -> + appears_free_in x (tapp t1 t2) + | afi_app2 : forall x t1 t2, + appears_free_in x t2 -> + appears_free_in x (tapp t1 t2) + | afi_abs : forall x y T11 t12, + y <> x -> + appears_free_in x t12 -> + appears_free_in x (tabs y T11 t12) + | afi_if1 : forall x t1 t2 t3, + appears_free_in x t1 -> + appears_free_in x (tif t1 t2 t3) + | afi_if2 : forall x t1 t2 t3, + appears_free_in x t2 -> + appears_free_in x (tif t1 t2 t3) + | afi_if3 : forall x t1 t2 t3, + appears_free_in x t3 -> + appears_free_in x (tif t1 t2 t3). + +Hint Constructors appears_free_in. + +(** The _free variables_ of a term are just the variables that appear + free in it. A term with no free variables is said to be + _closed_. *) + +Definition closed (t:tm) := + forall x, ~ appears_free_in x t. + +(** An _open_ term is one that may contain free variables. (I.e., every + term is an open term; the closed terms are a subset of the open ones. + "Open" really means "possibly containing free variables.") *) + +(** **** Exercise: 1 star (afi) *) +(** In the space below, write out the rules of the `appears_free_in` + relation in informal inference-rule notation. (Use whatever + notational conventions you like -- the point of the exercise is + just for you to think a bit about the meaning of each rule.) + Although this is a rather low-level, technical definition, + understanding it is crucial to understanding substitution and its + properties, which are really the crux of the lambda-calculus. *) + +(* FILL IN HERE *) +(** `` *) + +(* ================================================================= *) +(** ** Substitution *) + +(** To prove that substitution preserves typing, we first need a + technical lemma connecting free variables and typing contexts: If + a variable `x` appears free in a term `t`, and if we know `t` is + well typed in context `Gamma`, then it must be the case that + `Gamma` assigns a type to `x`. *) + +Lemma free_in_context : forall x t T Gamma, + appears_free_in x t -> + Gamma |- t \in T -> + exists T', Gamma x = Some T'. + +(** _Proof_: We show, by induction on the proof that `x` appears free + in `t`, that, for all contexts `Gamma`, if `t` is well typed + under `Gamma`, then `Gamma` assigns some type to `x`. + + - If the last rule used is `afi_var`, then `t = x`, and from the + assumption that `t` is well typed under `Gamma` we have + immediately that `Gamma` assigns a type to `x`. + + - If the last rule used is `afi_app1`, then `t = t1 t2` and `x` + appears free in `t1`. Since `t` is well typed under `Gamma`, + we can see from the typing rules that `t1` must also be, and + the IH then tells us that `Gamma` assigns `x` a type. + + - Almost all the other cases are similar: `x` appears free in a + subterm of `t`, and since `t` is well typed under `Gamma`, we + know the subterm of `t` in which `x` appears is well typed + under `Gamma` as well, and the IH gives us exactly the + conclusion we want. + + - The only remaining case is `afi_abs`. In this case `t = + \y:T11.t12` and `x` appears free in `t12`, and we also know + that `x` is different from `y`. The difference from the + previous cases is that, whereas `t` is well typed under + `Gamma`, its body `t12` is well typed under `(Gamma & {{y-->T11}}`, + so the IH allows us to conclude that `x` is assigned some type + by the extended context `(Gamma & {{y-->T11}}`. To conclude that + `Gamma` assigns a type to `x`, we appeal to lemma + `update_neq`, noting that `x` and `y` are different + variables. *) + +Proof. + intros x t T Gamma H H0. generalize dependent Gamma. + generalize dependent T. + induction H; + intros; try solve `inversion H0; eauto`. + - (* afi_abs *) + inversion H1; subst. + apply IHappears_free_in in H7. + rewrite update_neq in H7; assumption. +Qed. + +(** Next, we'll need the fact that any term `t` that is well typed in + the empty context is closed (it has no free variables). *) + +(** **** Exercise: 2 stars, optional (typable_empty__closed) *) +Corollary typable_empty__closed : forall t T, + empty |- t \in T -> + closed t. +Proof. + (* FILL IN HERE *) Admitted. +(** `` *) + +(** Sometimes, when we have a proof `Gamma |- t : T`, we will need to + replace `Gamma` by a different context `Gamma'`. When is it safe + to do this? Intuitively, it must at least be the case that + `Gamma'` assigns the same types as `Gamma` to all the variables + that appear free in `t`. In fact, this is the only condition that + is needed. *) + +Lemma context_invariance : forall Gamma Gamma' t T, + Gamma |- t \in T -> + (forall x, appears_free_in x t -> Gamma x = Gamma' x) -> + Gamma' |- t \in T. + +(** _Proof_: By induction on the derivation of `Gamma |- t \in T`. + + - If the last rule in the derivation was `T_Var`, then `t = x` + and `Gamma x = T`. By assumption, `Gamma' x = T` as well, and + hence `Gamma' |- t \in T` by `T_Var`. + + - If the last rule was `T_Abs`, then `t = \y:T11. t12`, with `T + = T11 -> T12` and `Gamma & {{y-->T11}} |- t12 \in T12`. The + induction hypothesis is that, for any context `Gamma''`, if + `Gamma & {{y-->T11}}` and `Gamma''` assign the same types to + all the free variables in `t12`, then `t12` has type `T12` + under `Gamma''`. Let `Gamma'` be a context which agrees with + `Gamma` on the free variables in `t`; we must show `Gamma' |- + \y:T11. t12 \in T11 -> T12`. + + By `T_Abs`, it suffices to show that `Gamma' & {{y-->T11}} |- + t12 \in T12`. By the IH (setting `Gamma'' = Gamma' & + {{y:T11}}`), it suffices to show that `Gamma & {{y-->T11}}` + and `Gamma' & {{y-->T11}}` agree on all the variables that + appear free in `t12`. + + Any variable occurring free in `t12` must be either `y` or + some other variable. `Gamma & {{y-->T11}}` and `Gamma' & + {{y-->T11}}` clearly agree on `y`. Otherwise, note that any + variable other than `y` that occurs free in `t12` also occurs + free in `t = \y:T11. t12`, and by assumption `Gamma` and + `Gamma'` agree on all such variables; hence so do `Gamma & + {{y-->T11}}` and `Gamma' & {{y-->T11}}`. + + - If the last rule was `T_App`, then `t = t1 t2`, with `Gamma |- + t1 \in T2 -> T` and `Gamma |- t2 \in T2`. One induction + hypothesis states that for all contexts `Gamma'`, if `Gamma'` + agrees with `Gamma` on the free variables in `t1`, then `t1` + has type `T2 -> T` under `Gamma'`; there is a similar IH for + `t2`. We must show that `t1 t2` also has type `T` under + `Gamma'`, given the assumption that `Gamma'` agrees with + `Gamma` on all the free variables in `t1 t2`. By `T_App`, it + suffices to show that `t1` and `t2` each have the same type + under `Gamma'` as under `Gamma`. But all free variables in + `t1` are also free in `t1 t2`, and similarly for `t2`; hence + the desired result follows from the induction hypotheses. *) + +Proof with eauto. + intros. + generalize dependent Gamma'. + induction H; intros; auto. + - (* T_Var *) + apply T_Var. rewrite <- H0... + - (* T_Abs *) + apply T_Abs. + apply IHhas_type. intros x1 Hafi. + (* the only tricky step... the `Gamma'` we use to + instantiate is `Gamma & {{x-->T11}}` *) + unfold update. unfold t_update. destruct (beq_string x0 x1) eqn: Hx0x1... + rewrite beq_string_false_iff in Hx0x1. auto. + - (* T_App *) + apply T_App with T11... +Qed. + +(** Now we come to the conceptual heart of the proof that reduction + preserves types -- namely, the observation that _substitution_ + preserves types. *) + +(** Formally, the so-called _substitution lemma_ says this: + Suppose we have a term `t` with a free variable `x`, and suppose + we've assigned a type `T` to `t` under the assumption that `x` has + some type `U`. Also, suppose that we have some other term `v` and + that we've shown that `v` has type `U`. Then, since `v` satisfies + the assumption we made about `x` when typing `t`, we can + substitute `v` for each of the occurrences of `x` in `t` and + obtain a new term that still has type `T`. *) + +(** _Lemma_: If `Gamma & {{x-->U}} |- t \in T` and `|- v \in U`, + then `Gamma |- `x:=v`t \in T`. *) + +Lemma substitution_preserves_typing : forall Gamma x U t v T, + Gamma & {{x-->U}} |- t \in T -> + empty |- v \in U -> + Gamma |- `x:=v`t \in T. + +(** One technical subtlety in the statement of the lemma is that + we assume `v` has type `U` in the _empty_ context -- in other + words, we assume `v` is closed. This assumption considerably + simplifies the `T_Abs` case of the proof (compared to assuming + `Gamma |- v \in U`, which would be the other reasonable assumption + at this point) because the context invariance lemma then tells us + that `v` has type `U` in any context at all -- we don't have to + worry about free variables in `v` clashing with the variable being + introduced into the context by `T_Abs`. + + The substitution lemma can be viewed as a kind of commutation + property. Intuitively, it says that substitution and typing can + be done in either order: we can either assign types to the terms + `t` and `v` separately (under suitable contexts) and then combine + them using substitution, or we can substitute first and then + assign a type to ` `x:=v` t ` -- the result is the same either + way. + + _Proof_: We show, by induction on `t`, that for all `T` and + `Gamma`, if `Gamma & {{x-->U}} |- t \in T` and `|- v \in U`, then + `Gamma |- `x:=v`t \in T`. + + - If `t` is a variable there are two cases to consider, + depending on whether `t` is `x` or some other variable. + + - If `t = x`, then from the fact that `Gamma & {{x-->U}} |- + x \in T` we conclude that `U = T`. We must show that + ``x:=v`x = v` has type `T` under `Gamma`, given the + assumption that `v` has type `U = T` under the empty + context. This follows from context invariance: if a + closed term has type `T` in the empty context, it has that + type in any context. + + - If `t` is some variable `y` that is not equal to `x`, then + we need only note that `y` has the same type under `Gamma + & {{x-->U}}` as under `Gamma`. + + - If `t` is an abstraction `\y:T11. t12`, then the IH tells us, + for all `Gamma'` and `T'`, that if `Gamma' & {{x-->U} |- t12 + \in T'` and `|- v \in U`, then `Gamma' |- `x:=v`t12 \in T'`. + + The substitution in the conclusion behaves differently + depending on whether `x` and `y` are the same variable. + + First, suppose `x = y`. Then, by the definition of + substitution, ``x:=v`t = t`, so we just need to show `Gamma |- + t \in T`. But we know `Gamma & {{x-->U}} |- t : T`, and, + since `y` does not appear free in `\y:T11. t12`, the context + invariance lemma yields `Gamma |- t \in T`. + + Second, suppose `x <> y`. We know `Gamma & {{x-->U; y-->T11}} + |- t12 \in T12` by inversion of the typing relation, from + which `Gamma & {{y-->T11; x-->U}} |- t12 \in T12` follows by + the context invariance lemma, so the IH applies, giving us + `Gamma & {{y-->T11}} |- `x:=v`t12 \in T12`. By `T_Abs`, + `Gamma |- \y:T11. `x:=v`t12 \in T11->T12`, and by the + definition of substitution (noting that `x <> y`), `Gamma |- + \y:T11. `x:=v`t12 \in T11->T12` as required. + + - If `t` is an application `t1 t2`, the result follows + straightforwardly from the definition of substitution and the + induction hypotheses. + + - The remaining cases are similar to the application case. + + _Technical note_: This proof is a rare case where an induction on + terms, rather than typing derivations, yields a simpler argument. + The reason for this is that the assumption `Gamma & {{x-->U}} |- t + \in T` is not completely generic, in the sense that one of the + "slots" in the typing relation -- namely the context -- is not + just a variable, and this means that Coq's native induction tactic + does not give us the induction hypothesis that we want. It is + possible to work around this, but the needed generalization is a + little tricky. The term `t`, on the other hand, is completely + generic. *) + +Proof with eauto. + intros Gamma x U t v T Ht Ht'. + generalize dependent Gamma. generalize dependent T. + induction t; intros T Gamma H; + (* in each case, we'll want to get at the derivation of H *) + inversion H; subst; simpl... + - (* tvar *) + rename s into y. destruct (beq_stringP x y) as `Hxy|Hxy`. + + (* x=y *) + subst. + rewrite update_eq in H2. + inversion H2; subst. + eapply context_invariance. eassumption. + apply typable_empty__closed in Ht'. unfold closed in Ht'. + intros. apply (Ht' x0) in H0. inversion H0. + + (* x<>y *) + apply T_Var. rewrite update_neq in H2... + - (* tabs *) + rename s into y. rename t into T. apply T_Abs. + destruct (beq_stringP x y) as `Hxy | Hxy`. + + (* x=y *) + subst. rewrite update_shadow in H5. apply H5. + + (* x<>y *) + apply IHt. eapply context_invariance... + intros z Hafi. unfold update, t_update. + destruct (beq_stringP y z) as `Hyz | Hyz`; subst; trivial. + rewrite <- beq_string_false_iff in Hxy. + rewrite Hxy... +Qed. + +(* ================================================================= *) +(** ** Main Theorem *) + +(** We now have the tools we need to prove preservation: if a closed + term `t` has type `T` and takes a step to `t'`, then `t'` + is also a closed term with type `T`. In other words, the small-step + reduction relation preserves types. *) + +Theorem preservation : forall t t' T, + empty |- t \in T -> + t ==> t' -> + empty |- t' \in T. + +(** _Proof_: By induction on the derivation of `|- t \in T`. + + - We can immediately rule out `T_Var`, `T_Abs`, `T_True`, and + `T_False` as the final rules in the derivation, since in each of + these cases `t` cannot take a step. + + - If the last rule in the derivation is `T_App`, then `t = t1 + t2`. There are three cases to consider, one for each rule that + could be used to show that `t1 t2` takes a step to `t'`. + + - If `t1 t2` takes a step by `ST_App1`, with `t1` stepping to + `t1'`, then by the IH `t1'` has the same type as `t1`, and + hence `t1' t2` has the same type as `t1 t2`. + + - The `ST_App2` case is similar. + + - If `t1 t2` takes a step by `ST_AppAbs`, then `t1 = + \x:T11.t12` and `t1 t2` steps to ``x:=t2`t12`; the + desired result now follows from the fact that substitution + preserves types. + + - If the last rule in the derivation is `T_If`, then `t = if t1 + then t2 else t3`, and there are again three cases depending on + how `t` steps. + + - If `t` steps to `t2` or `t3`, the result is immediate, since + `t2` and `t3` have the same type as `t`. + + - Otherwise, `t` steps by `ST_If`, and the desired conclusion + follows directly from the induction hypothesis. *) + +Proof with eauto. + remember (@empty ty) as Gamma. + intros t t' T HT. generalize dependent t'. + induction HT; + intros t' HE; subst Gamma; subst; + try solve `inversion HE; subst; auto`. + - (* T_App *) + inversion HE; subst... + (* Most of the cases are immediate by induction, + and `eauto` takes care of them *) + + (* ST_AppAbs *) + apply substitution_preserves_typing with T11... + inversion HT1... +Qed. + +(** **** Exercise: 2 stars, recommended (subject_expansion_stlc) *) +(** An exercise in the `Types` chapter asked about the _subject + expansion_ property for the simple language of arithmetic and + boolean expressions. Does this property hold for STLC? That is, + is it always the case that, if `t ==> t'` and `has_type t' T`, + then `empty |- t \in T`? If so, prove it. If not, give a + counter-example not involving conditionals. + + You can state your counterexample informally + in words, with a brief explanation. + +(* FILL IN HERE *) +*) +(** `` *) + +(* ################################################################# *) +(** * Type Soundness *) + +(** **** Exercise: 2 stars, optional (type_soundness) *) +(** Put progress and preservation together and show that a well-typed + term can _never_ reach a stuck state. *) + +Definition stuck (t:tm) : Prop := + (normal_form step) t /\ ~ value t. + +Corollary soundness : forall t t' T, + empty |- t \in T -> + t ==>* t' -> + ~(stuck t'). +Proof. + intros t t' T Hhas_type Hmulti. unfold stuck. + intros `Hnf Hnot_val`. unfold normal_form in Hnf. + induction Hmulti. + (* FILL IN HERE *) Admitted. +(** `` *) + +(* ################################################################# *) +(** * Uniqueness of Types *) + +(** **** Exercise: 3 stars (types_unique) *) +(** Another nice property of the STLC is that types are unique: a + given term (in a given context) has at most one type. *) +(** Formalize this statement as a theorem called + `unique_types`, and prove your theorem. *) + +(* FILL IN HERE *) +(** `` *) + +(* ################################################################# *) +(** * Additional Exercises *) + +(** **** Exercise: 1 star (progress_preservation_statement) *) +(** Without peeking at their statements above, write down the progress + and preservation theorems for the simply typed lambda-calculus (as + Coq theorems). + You can write `Admitted` for the proofs. *) +(* FILL IN HERE *) +(** `` *) + +(** **** Exercise: 2 stars (stlc_variation1) *) +(** Suppose we add a new term `zap` with the following reduction rule + + --------- (ST_Zap) + t ==> zap + +and the following typing rule: + + ---------------- (T_Zap) + Gamma |- zap : T + + Which of the following properties of the STLC remain true in + the presence of these rules? For each property, write either + "remains true" or "becomes false." If a property becomes + false, give a counterexample. + + - Determinism of `step` +(* FILL IN HERE *) + - Progress +(* FILL IN HERE *) + - Preservation +(* FILL IN HERE *) +*) +(** `` *) + +(** **** Exercise: 2 stars (stlc_variation2) *) +(** Suppose instead that we add a new term `foo` with the following + reduction rules: + + ----------------- (ST_Foo1) + (\x:A. x) ==> foo + + ------------ (ST_Foo2) + foo ==> true + + Which of the following properties of the STLC remain true in + the presence of this rule? For each one, write either + "remains true" or else "becomes false." If a property becomes + false, give a counterexample. + + - Determinism of `step` +(* FILL IN HERE *) + - Progress +(* FILL IN HERE *) + - Preservation +(* FILL IN HERE *) +*) +(** `` *) + +(** **** Exercise: 2 stars (stlc_variation3) *) +(** Suppose instead that we remove the rule `ST_App1` from the `step` + relation. Which of the following properties of the STLC remain + true in the presence of this rule? For each one, write either + "remains true" or else "becomes false." If a property becomes + false, give a counterexample. + + - Determinism of `step` +(* FILL IN HERE *) + - Progress +(* FILL IN HERE *) + - Preservation +(* FILL IN HERE *) +*) +(** `` *) + +(** **** Exercise: 2 stars, optional (stlc_variation4) *) +(** Suppose instead that we add the following new rule to the + reduction relation: + + ---------------------------------- (ST_FunnyIfTrue) + (if true then t1 else t2) ==> true + + Which of the following properties of the STLC remain true in + the presence of this rule? For each one, write either + "remains true" or else "becomes false." If a property becomes + false, give a counterexample. + + - Determinism of `step` +(* FILL IN HERE *) + - Progress +(* FILL IN HERE *) + - Preservation +(* FILL IN HERE *) +*) +(** `` *) + +(** **** Exercise: 2 stars, optional (stlc_variation5) *) +(** Suppose instead that we add the following new rule to the typing + relation: + + Gamma |- t1 \in Bool->Bool->Bool + Gamma |- t2 \in Bool + ------------------------------ (T_FunnyApp) + Gamma |- t1 t2 \in Bool + + Which of the following properties of the STLC remain true in + the presence of this rule? For each one, write either + "remains true" or else "becomes false." If a property becomes + false, give a counterexample. + + - Determinism of `step` +(* FILL IN HERE *) + - Progress +(* FILL IN HERE *) + - Preservation +(* FILL IN HERE *) +*) +(** `` *) + +(** **** Exercise: 2 stars, optional (stlc_variation6) *) +(** Suppose instead that we add the following new rule to the typing + relation: + + Gamma |- t1 \in Bool + Gamma |- t2 \in Bool + --------------------- (T_FunnyApp') + Gamma |- t1 t2 \in Bool + + Which of the following properties of the STLC remain true in + the presence of this rule? For each one, write either + "remains true" or else "becomes false." If a property becomes + false, give a counterexample. + + - Determinism of `step` +(* FILL IN HERE *) + - Progress +(* FILL IN HERE *) + - Preservation +(* FILL IN HERE *) +*) +(** `` *) + +(** **** Exercise: 2 stars, optional (stlc_variation7) *) +(** Suppose we add the following new rule to the typing relation + of the STLC: + + ------------------- (T_FunnyAbs) + |- \x:Bool.t \in Bool + + Which of the following properties of the STLC remain true in + the presence of this rule? For each one, write either + "remains true" or else "becomes false." If a property becomes + false, give a counterexample. + + - Determinism of `step` +(* FILL IN HERE *) + - Progress +(* FILL IN HERE *) + - Preservation +(* FILL IN HERE *) +*) +(** `` *) + +End STLCProp. + +(* ================================================================= *) +(** ** Exercise: STLC with Arithmetic *) + +(** To see how the STLC might function as the core of a real + programming language, let's extend it with a concrete base + type of numbers and some constants and primitive + operators. *) + +Module STLCArith. +Import STLC. + +(** To types, we add a base type of natural numbers (and remove + booleans, for brevity). *) + +Inductive ty : Type := + | TArrow : ty -> ty -> ty + | TNat : ty. + +(** To terms, we add natural number constants, along with + successor, predecessor, multiplication, and zero-testing. *) + +Inductive tm : Type := + | tvar : string -> tm + | tapp : tm -> tm -> tm + | tabs : string -> ty -> tm -> tm + | tnat : nat -> tm + | tsucc : tm -> tm + | tpred : tm -> tm + | tmult : tm -> tm -> tm + | tif0 : tm -> tm -> tm -> tm. + +(** **** Exercise: 4 stars (stlc_arith) *) +(** Finish formalizing the definition and properties of the STLC + extended with arithmetic. This is a longer exercise. Specifically: + + 1. Copy the core definitions for STLC that we went through, + as well as the key lemmas and theorems, and paste them + into the file at this point. Do not copy examples, exercises, + etc. (In particular, make sure you don't copy any of the `` + comments at the end of exercises, to avoid confusing the + autograder.) + + You should copy over five definitions: + - Fixpoint susbt + - Inductive value + - Inductive step + - Inductive has_type + - Inductive appears_free_in + + And five theorems, with their proofs: + - Lemma context_invariance + - Lemma free_in_context + - Lemma substitution_preserves_typing + - Theorem preservation + - Theorem progress + + It will be helpful to also copy over "Reserved Notation", + "Notation", and "Hint Constructors" for these things. + + 2. Edit and extend the five definitions (subst, value, step, + has_type, and appears_free_in) so they are appropriate + for the new STLC extended with arithmetic. + + 3. Extend the proofs of all the five properties of the original + STLC to deal with the new syntactic forms. Make sure Coq + accepts the whole file. *) + +(* FILL IN HERE *) +(** `` *) + +End STLCArith. + +(** $Date$ *) From feae903a61e879299d3e5bcd15975c94f18a0045 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?J=C3=BCrgen=20Nicklisch-Franken?= Date: Fri, 19 Oct 2018 11:28:47 +0200 Subject: [PATCH 24/30] Use Id instead of String. --- src/Maps.lidr | 8 ++++++ src/Stlc.lidr | 78 +++++++++++++++++++++++++-------------------------- 2 files changed, 47 insertions(+), 39 deletions(-) diff --git a/src/Maps.lidr b/src/Maps.lidr index eb4bf08..6aeba8f 100644 --- a/src/Maps.lidr +++ b/src/Maps.lidr @@ -63,6 +63,14 @@ equality comparison function for \idr{Id} and its fundamental property. > beq_id (MkId n1) (MkId n2) = decAsBool $ decEq n1 n2 > +> idInjective : {x,y : String} -> (MkId x = MkId y) -> x = y +> idInjective Refl = Refl + +> implementation DecEq Id where +> decEq (MkId s1) (MkId s2) with (decEq s1 s2) +> | Yes prf = Yes (cong prf) +> | No contra = No (\h : MkId s1 = MkId s2 => contra (idInjective h)) + \todo[inline]{Edit} (The function \idr{decEq} comes from Idris's string library. If you check its diff --git a/src/Stlc.lidr b/src/Stlc.lidr index fccfbad..e16978f 100644 --- a/src/Stlc.lidr +++ b/src/Stlc.lidr @@ -170,18 +170,19 @@ We next formalize the syntax of the STLC. > infixr 7 # > data Tm : Type where -> Tvar : String -> Tm +> Tvar : Id -> Tm > (#) : Tm -> Tm -> Tm -> Tabs : String -> Ty -> Tm -> Tm +> Tabs : Id -> Ty -> Tm -> Tm > Ttrue : Tm > Tfalse : Tm > Tif : Tm -> Tm -> Tm -> Tm -> syntax "(" "\\" [p] ":" [q] "." [r] ")" = Tabs "p" q r +> syntax "(" "\\" [p] ":" [q] "." [r] ")" = Tabs (MkId "p") q r > syntax "lif" [c] "then" [p] "else" [n] = Tif c p n -> syntax "&" [p] = Tvar "p" +> var : String -> Tm +> var s = Tvar (MkId s) Note that an abstraction `\x:T.t` (formally, `tabs x T t`) is always annotated with the type `T` of its :parameter, in contrast @@ -194,27 +195,27 @@ Some examples... `idB = \x:Bool. x` > idB : Tm -> idB = (\x: TBool . &x) +> idB = (\x: TBool . var "x") `idBB = \x:Bool->Bool. x` > idBB : Tm -> idBB = (\x: (TBool :=> TBool) . &x) +> idBB = (\x: (TBool :=> TBool) . var "x") `idBBBB = \x:(Bool->Bool) -> (Bool->Bool). x` > idBBBB : Tm -> idBBBB = (\x: ((TBool :=> TBool) :=> (TBool :=> TBool)). &x) +> idBBBB = (\x: ((TBool :=> TBool) :=> (TBool :=> TBool)). var "x") `k = \x:Bool. \y:Bool. x` > k : Tm -> k = (\x : TBool . (\y : TBool . &x)) +> k = (\x : TBool . (\y : TBool . var "x")) `notB = \x:Bool. if x then false else true` > notB : Tm -> notB = (\x : TBool . (lif &x then Tfalse else Ttrue)) +> notB = (\x : TBool . (lif (var "x") then Tfalse else Ttrue)) === Operational Semantics @@ -260,7 +261,7 @@ function is actually applied to an argument. We also make the second choice here. > data Value : Tm -> Type where -> V_abs : {x: String} -> {T: Ty} -> {t: Tm} -> Value (Tabs x T t) +> V_abs : {x: Id} -> {T: Ty} -> {t: Tm} -> Value (Tabs x T t) > V_true : Value Ttrue > V_false : Value Tfalse @@ -345,15 +346,15 @@ Here is the definition, informally... ... and formally: -> subst : String -> Tm -> Tm -> Tm +> subst : Id -> Tm -> Tm -> Tm > subst x s (Tvar x') = > case decEq x x' of -> Yes _ => s -> No _ => (Tvar x') +> Yes => s +> No _ => Tvar x' > subst x s (Tabs x' ty t1) = -> Tabs x' ty (case decEq x x' of -> Yes p => t1 -> No p => subst x s t1) +> case decEq x x' of +> Yes => t1 +> No _ => subst x s t1 > subst x s (t1 # t2) = subst x s t1 # subst x s t2 > subst x s Ttrue = Ttrue > subst x s Tfalse = Tfalse @@ -397,7 +398,7 @@ one of the constructors; your job is to fill in the rest of the constructors and prove that the relation you've defined coincides with the function given above. -> data Substi : (s:Tm) -> (x:String) -> Tm -> Tm -> Type where +> data Substi : (s:Tm) -> (x:Id) -> Tm -> Tm -> Type where > S_True : Substi s x Ttrue Ttrue > S_False : Substi s x Tfalse Tfalse > S_App : {l', r':Tm} -> Substi s x l l' -> Substi s x r r' -> Substi s x (l # r) (l' # r') @@ -409,7 +410,7 @@ with the function given above. > S_Abs2 : Substi s x (Tabs y ty t) (Tabs y ty t) -> substi_correct : (s:Tm) -> (x: String) -> (t : Tm) -> (t' : Tm) -> +> substi_correct : (s:Tm) -> (x: Id) -> (t : Tm) -> (t' : Tm) -> > (([ x := s ] t) = t') <-> Substi s x t t' > substi_correct s x t t' = ?substi_correct_rhs1 @@ -482,9 +483,9 @@ Formally: > (->>) = Step > > data Step : Tm -> Tm -> Type where -> ST_AppAbs : {x: String} -> {ty : Ty} -> {t12 : Tm} -> {v2 : Tm} -> +> ST_AppAbs : {x: Id} -> {ty : Ty} -> {t12 : Tm} -> {v2 : Tm} -> > Value v2 -> -> (Tabs x ty t12) # v2 ->> [ x := v2] t12 +> (Tabs x ty t12) # v2 ->> subst x v2 t12 > ST_App1 : {t1, t1', t2: Tm} -> > t1 ->> t1' -> > t1 # t2 ->> t1' # t2 @@ -515,8 +516,7 @@ Example: idBB idB ->>* idB > step_example1 : Stlc.idBB # Stlc.idB ->>* Stlc.idB -> step_example1 = -> Multi_step (ST_AppAbs V_abs) Multi_refl +> step_example1 = Multi_step (ST_AppAbs V_abs) Multi_refl -- (ST_AppAbs V_abs) Multi_refl Example: @@ -675,11 +675,11 @@ We can read the three-place relation `Gamma |- t ::T` as: > syntax [context] "|-" [t] "::" [T] "." = Has_type context t T > data Has_type : Context -> Tm -> Ty -> Type where -> T_Var : {Gamma: Context} -> {x: String} -> {T: Ty} -> -> Gamma (MkId x) = Just T -> +> T_Var : {Gamma: Context} -> {x: Id} -> {T: Ty} -> +> Gamma x = Just T -> > Gamma |- (Tvar x) :: T . -> T_Abs : {Gamma: Context} -> {x: String} -> {T11, T12: Ty} -> {t12 : Tm} -> -> (Gamma & {{ (MkId x) ==> T11 }}) |- t12 :: T12 . -> +> T_Abs : {Gamma: Context} -> {x: Id} -> {T11, T12: Ty} -> {t12 : Tm} -> +> (Gamma & {{ x ==> T11 }}) |- t12 :: T12 . -> > Gamma |- (Tabs x T11 t12) :: (T11 :=> T12) . > T_App : {Gamma: Context} -> {T11, T12: Ty} -> {t1, t2 : Tm} -> > Gamma |- t1 :: (T11 :=> T12). -> @@ -697,7 +697,7 @@ We can read the three-place relation `Gamma |- t ::T` as: ==== Examples -> typing_example_1 : empty |- (Tabs "x" TBool (Tvar "x")) :: (TBool :=> TBool) . +> typing_example_1 : empty |- (Tabs (MkId "x") TBool (var "x")) :: (TBool :=> TBool) . > typing_example_1 = T_Abs (T_Var Refl) @@ -709,9 +709,9 @@ Another example: ``` > typing_example_2 : empty |- -> (Tabs "x" TBool -> (Tabs "y" (TBool :=> TBool) -> (Tvar "y" # Tvar "y" # Tvar "x"))) :: +> (Tabs (MkId "x") TBool +> (Tabs (MkId "y") (TBool :=> TBool) +> (var "y" # var "y" # var "x"))) :: > (TBool :=> (TBool :=> TBool) :=> TBool) . > typing_example_2 = > T_Abs (T_Abs (T_App (T_Var Refl) (T_App (T_Var Refl) (T_Var Refl)))) @@ -729,10 +729,10 @@ Formally prove the following typing derivation holds: > typing_example_3 : > (T : Ty ** empty |- -> (Tabs "x" (TBool :=> TBool) -> (Tabs "y" (TBool :=> TBool) -> (Tabs "z" TBool -> (Tvar "y" # (Tvar "x" # Tvar "z"))))) :: T . ) +> (Tabs (MkId "x") (TBool :=> TBool) +> (Tabs (MkId "y") (TBool :=> TBool) +> (Tabs (MkId "z") TBool +> (Tvar (MkId "y") # (Tvar (MkId "x") # Tvar (MkId "z")))))) :: T . ) > typing_example_3 = ?typing_example_3_rhs $\square$ @@ -753,9 +753,9 @@ to the term `\x:Bool. \y:Bool, x y` -- i.e., > typing_nonexample_1 : > Not (T : Ty ** > empty |- -> (Tabs "x" TBool -> (Tabs "y" TBool -> (Tvar "x" # Tvar y))) :: T . ) +> (Tabs (MkId "x") TBool +> (Tabs (MkId "y") TBool +> (Tvar (MkId "x") # Tvar (MkId y)))) :: T . ) > typing_nonexample_1 = forallToExistence > (\ a , (T_Abs (T_Abs (T_App (T_Var Refl)(T_Var Refl)))) impossible) @@ -770,8 +770,8 @@ Another nonexample: > typing_nonexample_3 : > Not (s : Ty ** t : Ty ** > empty |- -> (Tabs "x" s -> (Tvar "x" # Tvar "x")) :: t . ) +> (Tabs (MkId "x") s +> (Tvar (MkId "x") # Tvar (MkId "x"))) :: t . ) > typing_nonexample_3 = ?typing_nonexample_3_rhs $\square$ From 527982baf7e3b986bdac5fb95dd813964964e0cb Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?J=C3=BCrgen=20Nicklisch-Franken?= Date: Fri, 19 Oct 2018 14:53:04 +0200 Subject: [PATCH 25/30] Substitution --- src/StlcProp.lidr | 354 +++++++++++++++++++++++----------------------- 1 file changed, 175 insertions(+), 179 deletions(-) diff --git a/src/StlcProp.lidr b/src/StlcProp.lidr index 10026e2..9d4a1d0 100644 --- a/src/StlcProp.lidr +++ b/src/StlcProp.lidr @@ -10,6 +10,10 @@ > %access public export > %default total +> %hide Smallstep.Tm +> %hide Types.progress + + In this chapter, we develop the fundamental theory of the Simply Typed Lambda Calculus -- in particular, the type safety @@ -36,7 +40,7 @@ lambda-abstractions. > canonical_forms_fun : {t: Tm} -> {ty1, ty2: Ty} -> > empty |- t :: (ty1 :=> ty2) . -> > Value t -> -> (x : String ** u : Tm ** t = Tabs x ty1 u) +> (x : Id ** u : Tm ** t = Tabs x ty1 u) > canonical_forms_fun {t = Ttrue} T_True _ impossible > canonical_forms_fun {t = Tfalse} T_False _ impossible @@ -103,194 +107,186 @@ _Proof_: By induction on the derivation of `|- t \in T` > progress {t=Tfalse} _ = Left V_false > progress {t=Tabs x ty t1} _ = Left V_abs > progress {t=tl # tr} (T_App hl hr) = -> let indHypl = StlcProp.progress {t=tl} hl +> let indHypl = progress {t=tl} hl > in case indHypl of -> Right (t' ** hyp) => Right (t' # tr ** ST_App1 hyp) +> Right (t' ** step) => Right (t' # tr ** ST_App1 step) > Left vl => -> let indHypR = StlcProp.progress {t=tr} hr +> let indHypR = progress {t=tr} hr > in case indHypR of -> Right (t' ** hyp) => Right (tl # t' ** ST_App2 vl hyp) +> Right (t' ** step) => Right (tl # t' ** ST_App2 vl step) > Left vr => > case vl of > V_abs {x} {t=tl} => Right (subst x tr tl ** ST_AppAbs vr) -> progress {t=Tif tb tp tn} {ty} _ = ?hole - - -(** **** Exercise: 3 stars, advanced (progress_from_term_ind) *) -(** Show that progress can also be proved by induction on terms - instead of induction on typing derivations. *) - -Theorem progress' : forall t T, - empty |- t \in T -> - value t \/ exists t', t ==> t'. -Proof. - intros t. - induction t; intros T Ht; auto. - (* FILL IN HERE *) Admitted. -(** `` *) - -(* ################################################################# *) -(** * Preservation *) - -(** The other half of the type soundness property is the - preservation of types during reduction. For this part, we'll need - to develop some technical machinery for reasoning about variables - and substitution. Working from top to bottom (from the high-level - property we are actually interested in to the lowest-level - technical lemmas that are needed by various cases of the more - interesting proofs), the story goes like this: - - - The _preservation theorem_ is proved by induction on a typing - derivation, pretty much as we did in the `Types` chapter. - The one case that is significantly different is the one for - the `ST_AppAbs` rule, whose definition uses the substitution - operation. To see that this step preserves typing, we need to - know that the substitution itself does. So we prove a... - - - _substitution lemma_, stating that substituting a (closed) - term `s` for a variable `x` in a term `t` preserves the type - of `t`. The proof goes by induction on the form of `t` and - requires looking at all the different cases in the definition - of substitition. This time, the tricky cases are the ones for - variables and for function abstractions. In both, we discover - that we need to take a term `s` that has been shown to be - well-typed in some context `Gamma` and consider the same term - `s` in a slightly different context `Gamma'`. For this we - prove a... - - - _context invariance_ lemma, showing that typing is preserved - under "inessential changes" to the context `Gamma` -- in - particular, changes that do not affect any of the free - variables of the term. And finally, for this, we need a - careful definition of... - - - the _free variables_ in a term -- i.e., variables that are - used in the term and where these uses are _not_ in the scope of - an enclosing function abstraction binding a variable of the - same name. - - To make Coq happy, we need to formalize the story in the opposite - order... *) - -(* ================================================================= *) -(** ** Free Occurrences *) - -(** A variable `x` _appears free in_ a term _t_ if `t` contains some - occurrence of `x` that is not under an abstraction labeled `x`. - For example: - - `y` appears free, but `x` does not, in `\x:T->U. x y` - - both `x` and `y` appear free in `(\x:T->U. x y) x` - - no variables appear free in `\x:T->U. \y:T. x y` - - Formally: *) - -Inductive appears_free_in : string -> tm -> Prop := - | afi_var : forall x, - appears_free_in x (tvar x) - | afi_app1 : forall x t1 t2, - appears_free_in x t1 -> - appears_free_in x (tapp t1 t2) - | afi_app2 : forall x t1 t2, - appears_free_in x t2 -> - appears_free_in x (tapp t1 t2) - | afi_abs : forall x y T11 t12, - y <> x -> - appears_free_in x t12 -> - appears_free_in x (tabs y T11 t12) - | afi_if1 : forall x t1 t2 t3, - appears_free_in x t1 -> - appears_free_in x (tif t1 t2 t3) - | afi_if2 : forall x t1 t2 t3, - appears_free_in x t2 -> - appears_free_in x (tif t1 t2 t3) - | afi_if3 : forall x t1 t2 t3, - appears_free_in x t3 -> - appears_free_in x (tif t1 t2 t3). - -Hint Constructors appears_free_in. - -(** The _free variables_ of a term are just the variables that appear - free in it. A term with no free variables is said to be - _closed_. *) - -Definition closed (t:tm) := - forall x, ~ appears_free_in x t. - -(** An _open_ term is one that may contain free variables. (I.e., every - term is an open term; the closed terms are a subset of the open ones. - "Open" really means "possibly containing free variables.") *) - -(** **** Exercise: 1 star (afi) *) -(** In the space below, write out the rules of the `appears_free_in` - relation in informal inference-rule notation. (Use whatever - notational conventions you like -- the point of the exercise is - just for you to think a bit about the meaning of each rule.) - Although this is a rather low-level, technical definition, - understanding it is crucial to understanding substitution and its - properties, which are really the crux of the lambda-calculus. *) +> progress {t=Tif tb tp tn} (T_If hb hp hr) = +> let indHyp = progress {t=tb} hb +> in case indHyp of +> Left vl => +> case vl of +> V_true => Right (tp ** ST_IfTrue) +> V_false => Right (tn ** ST_IfFalse) +> Right (t' ** step) => Right (Tif t' tp tn ** ST_If step) + +== Preservation + +The other half of the type soundness property is the +preservation of types during reduction. For this part, we'll need +to develop some technical machinery for reasoning about variables +and substitution. Working from top to bottom (from the high-level +property we are actually interested in to the lowest-level +technical lemmas that are needed by various cases of the more +interesting proofs), the story goes like this: + + - The _preservation theorem_ is proved by induction on a typing + derivation, pretty much as we did in the `Types` chapter. + The one case that is significantly different is the one for + the `ST_AppAbs` rule, whose definition uses the substitution + operation. To see that this step preserves typing, we need to + know that the substitution itself does. So we prove a... + + - _substitution lemma_, stating that substituting a (closed) + term `s` for a variable `x` in a term `t` preserves the type + of `t`. The proof goes by induction on the form of `t` and + requires looking at all the different cases in the definition + of substitition. This time, the tricky cases are the ones for + variables and for function abstractions. In both, we discover + that we need to take a term `s` that has been shown to be + well-typed in some context `Gamma` and consider the same term + `s` in a slightly different context `Gamma'`. For this we + prove a... + + - _context invariance_ lemma, showing that typing is preserved + under "inessential changes" to the context `Gamma` -- in + particular, changes that do not affect any of the free + variables of the term. And finally, for this, we need a + careful definition of... + + - the _free variables_ in a term -- i.e., variables that are + used in the term and where these uses are _not_ in the scope of + an enclosing function abstraction binding a variable of the + same name. + +To make Idris happy, we need to formalize the story in the opposite +order... + +=== Free Occurrences + +A variable `x` _appears free in_ a term _t_ if `t` contains some +occurrence of `x` that is not under an abstraction labeled `x`. +For example: + - `y` appears free, but `x` does not, in `\x:T->U. x y` + - both `x` and `y` appear free in `(\x:T->U. x y) x` + - no variables appear free in `\x:T->U. \y:T. x y` + +Formally: + +> data Appears_free_in : Id -> Tm -> Type where +> Afi_var : {x : Id} -> +> Appears_free_in x (Tvar x) +> Afi_app1 : {x : Id} -> {t1, t2: Tm} -> +> Appears_free_in x t1 -> +> Appears_free_in x (t1 # t2) +> Afi_app2 : {x : Id} -> {t1, t2: Tm} -> +> Appears_free_in x t2 -> +> Appears_free_in x (t1 # t2) +> Afi_abs : {x,y : Id} -> {t12: Tm} -> {T11: Ty} -> +> Not (y = x) -> +> Appears_free_in x t12 -> +> Appears_free_in x (Tabs y T11 t12) +> Afi_if1 : {x : Id} -> {t1, t2, t3: Tm} -> +> Appears_free_in x t1 -> +> Appears_free_in x (Tif t1 t2 t3) +> Afi_if2 : {x : Id} -> {t1, t2, t3: Tm} -> +> Appears_free_in x t2 -> +> Appears_free_in x (Tif t1 t2 t3) +> Afi_if3 : {x : Id} -> {t1, t2, t3: Tm} -> +> Appears_free_in x t3 -> +> Appears_free_in x (Tif t1 t2 t3) + + +The _free variables_ of a term are just the variables that appear +free in it. A term with no free variables is said to be _closed_. + +> closed: Tm -> Type +> closed t = Not (x: Id ** Appears_free_in x t) + +An _open_ term is one that may contain free variables. (I.e., every +term is an open term; the closed terms are a subset of the open ones. +"Open" really means "possibly containing free variables.") + +==== Exercise: 1 star (afi) + +In the space below, write out the rules of the `appears_free_in` +relation in informal inference-rule notation. (Use whatever +notational conventions you like -- the point of the exercise is +just for you to think a bit about the meaning of each rule.) +Although this is a rather low-level, technical definition, +understanding it is crucial to understanding substitution and its +properties, which are really the crux of the lambda-calculus. (* FILL IN HERE *) -(** `` *) - -(* ================================================================= *) -(** ** Substitution *) - -(** To prove that substitution preserves typing, we first need a - technical lemma connecting free variables and typing contexts: If - a variable `x` appears free in a term `t`, and if we know `t` is - well typed in context `Gamma`, then it must be the case that - `Gamma` assigns a type to `x`. *) - -Lemma free_in_context : forall x t T Gamma, - appears_free_in x t -> - Gamma |- t \in T -> - exists T', Gamma x = Some T'. - -(** _Proof_: We show, by induction on the proof that `x` appears free - in `t`, that, for all contexts `Gamma`, if `t` is well typed - under `Gamma`, then `Gamma` assigns some type to `x`. - - - If the last rule used is `afi_var`, then `t = x`, and from the - assumption that `t` is well typed under `Gamma` we have - immediately that `Gamma` assigns a type to `x`. - - - If the last rule used is `afi_app1`, then `t = t1 t2` and `x` - appears free in `t1`. Since `t` is well typed under `Gamma`, - we can see from the typing rules that `t1` must also be, and - the IH then tells us that `Gamma` assigns `x` a type. - - - Almost all the other cases are similar: `x` appears free in a - subterm of `t`, and since `t` is well typed under `Gamma`, we - know the subterm of `t` in which `x` appears is well typed - under `Gamma` as well, and the IH gives us exactly the - conclusion we want. - - - The only remaining case is `afi_abs`. In this case `t = - \y:T11.t12` and `x` appears free in `t12`, and we also know - that `x` is different from `y`. The difference from the - previous cases is that, whereas `t` is well typed under - `Gamma`, its body `t12` is well typed under `(Gamma & {{y-->T11}}`, - so the IH allows us to conclude that `x` is assigned some type - by the extended context `(Gamma & {{y-->T11}}`. To conclude that - `Gamma` assigns a type to `x`, we appeal to lemma - `update_neq`, noting that `x` and `y` are different - variables. *) - -Proof. - intros x t T Gamma H H0. generalize dependent Gamma. - generalize dependent T. - induction H; - intros; try solve `inversion H0; eauto`. - - (* afi_abs *) - inversion H1; subst. - apply IHappears_free_in in H7. - rewrite update_neq in H7; assumption. -Qed. -(** Next, we'll need the fact that any term `t` that is well typed in - the empty context is closed (it has no free variables). *) +=== Substitution + +To prove that substitution preserves typing, we first need a +technical lemma connecting free variables and typing contexts: If +a variable `x` appears free in a term `t`, and if we know `t` is +well typed in context `Gamma`, then it must be the case that +`Gamma` assigns a type to `x`. *) + +-- > free_in_context : {x : Id} -> {t: Tm} -> {ty: Ty} -> {gamma: Context} -> +-- > Appears_free_in x t -> +-- > gamma |- t :: T . -> +-- > (t' : Ty ** gamma x = Just t') + +_Proof_: We show, by induction on the proof that `x` appears free +in `t`, that, for all contexts `Gamma`, if `t` is well typed +under `Gamma`, then `Gamma` assigns some type to `x`. + + - If the last rule used is `afi_var`, then `t = x`, and from the + assumption that `t` is well typed under `Gamma` we have + immediately that `Gamma` assigns a type to `x`. + + - If the last rule used is `afi_app1`, then `t = t1 t2` and `x` + appears free in `t1`. Since `t` is well typed under `Gamma`, + we can see from the typing rules that `t1` must also be, and + the IH then tells us that `Gamma` assigns `x` a type. + + - Almost all the other cases are similar: `x` appears free in a + subterm of `t`, and since `t` is well typed under `Gamma`, we + know the subterm of `t` in which `x` appears is well typed + under `Gamma` as well, and the IH gives us exactly the + conclusion we want. + + - The only remaining case is `afi_abs`. In this case `t = + \y:T11.t12` and `x` appears free in `t12`, and we also know + that `x` is different from `y`. The difference from the + previous cases is that, whereas `t` is well typed under + `Gamma`, its body `t12` is well typed under `(Gamma & {{y-->T11}}`, + so the IH allows us to conclude that `x` is assigned some type + by the extended context `(Gamma & {{y-->T11}}`. To conclude that + `Gamma` assigns a type to `x`, we appeal to lemma + `update_neq`, noting that `x` and `y` are different + variables. *) + +> free_in_context : {x : Id} -> {t: Tm} -> {ty: Ty} -> {gamma: Context} -> +> Appears_free_in x t -> +> gamma |- t :: ty . -> +> (t' : Ty ** gamma x = Just t') +> free_in_context {ty} Afi_var (T_Var h1) = (ty ** h1) +> free_in_context {t = t1 # t2} (Afi_app1 h) (T_App h1 h2) = free_in_context h h1 +> free_in_context {t = t1 # t2} (Afi_app2 h) (T_App h1 h2) = free_in_context h h2 +> free_in_context {t = Tif tb tp tn} (Afi_if1 h) (T_If h1 h2 h3) = free_in_context h h1 +> free_in_context {t = Tif tb tp tn} (Afi_if2 h) (T_If h1 h2 h3) = free_in_context h h2 +> free_in_context {t = Tif tb tp tn} (Afi_if3 h) (T_If h1 h2 h3) = free_in_context h h3 +> free_in_context {x} {gamma} {t = Tabs id ty tm} (Afi_abs h1 h2) (T_Abs h) = +> let (ty ** ih) = free_in_context h2 h +> in (ty ** rewrite (sym (update_neq {m=gamma} {v=ty} h1)) in ih) + +Next, we'll need the fact that any term `t` that is well typed in +the empty context is closed (it has no free variables). + +==== Exercise: 2 stars, optional (typable_empty__closed) -(** **** Exercise: 2 stars, optional (typable_empty__closed) *) Corollary typable_empty__closed : forall t T, empty |- t \in T -> closed t. From 290367fdb6b79f3161305a51a24d6dfd438d1dbb Mon Sep 17 00:00:00 2001 From: Alex Gryzlov Date: Wed, 7 Nov 2018 20:06:41 +0200 Subject: [PATCH 26/30] WIP review --- src/Smallstep.lidr | 629 ++++++++++++++++++++++++--------------------- 1 file changed, 338 insertions(+), 291 deletions(-) diff --git a/src/Smallstep.lidr b/src/Smallstep.lidr index cd2c025..8cc0eb5 100644 --- a/src/Smallstep.lidr +++ b/src/Smallstep.lidr @@ -3,9 +3,12 @@ == Smallstep: Small-step Operational Semantics > module Smallstep +> +> %hide Language.Reflection.P +> > %access public export > %default total -> %hide Language.Reflection.P +> The evaluators we have seen so far (for `aexp`s, `bexp`s, commands, ...) have been formulated in a "big-step" style: they @@ -69,6 +72,7 @@ the topic of the present chapter. Our goal is to replace the specifies, for a given program, how the "atomic steps" of computation are performed. + == A Toy Language To save space in the discussion, let's go back to an @@ -81,6 +85,7 @@ Imp language. > data Tm : Type where > C : Nat -> Tm -- Constant > P : Tm -> Tm -> Tm -- Plus +> Here is a standard evaluator for this language, written in the big-step style that we've been using up to this point. @@ -88,10 +93,11 @@ Here is a standard evaluator for this language, written in > evalF : (t : Tm) -> Nat > evalF (C n) = n > evalF (P a1 a2) = evalF a1 + evalF a2 +> -Here is the same evaluator, written in exactly the same - style, but formulated as an inductively defined relation. Again, - we use the notation `t >>> n` for "`t` evaluates to `n`." +Here is the same evaluator, written in exactly the same style, +but formulated as an inductively defined relation. Again, we use +the notation `t >>> n` for "`t` evaluates to `n`." \[ \begin{prooftree} @@ -109,7 +115,7 @@ Here is the same evaluator, written in exactly the same \] > infixl 6 >>> - +> > mutual > (>>>) : Tm -> Nat -> Type > (>>>) = Eval @@ -119,7 +125,6 @@ Here is the same evaluator, written in exactly the same > E_Plus : t1 >>> n1 -> t2 >>> n2 -> P t1 t2 >>> n1 + n2 > - Now, here is the corresponding _small-step_ evaluation relation. \[ @@ -166,50 +171,54 @@ Things to notice: - A term that is just a constant cannot take a step. Let's pause and check a couple of examples of reasoning with - the `step` relation... +the `step` relation... If `t1` can take a step to `t1'`, then `P t1 t2` steps - to `P t1' t2`: - -> test_step_1 : -> P -> (P (C 0) (C 3)) -> (P (C 2) (C 4)) -> ->> -> P -> (C (0 + 3)) -> (P (C 2) (C 4)) -> test_step_1 = ST_Plus1' ST_PlusConstConst' +to `P t1' t2`: + +> test_step_1 : +> P +> (P (C 0) (C 3)) +> (P (C 2) (C 4)) +> ->> +> P +> (C (0 + 3)) +> (P (C 2) (C 4)) +> test_step_1 = ST_Plus1' ST_PlusConstConst' +> ==== Exercise: 1 star (test_step_2) -Right-hand sides of sums can take a step only when the - left-hand side is finished: if `t2` can take a step to `t2'`, - then `P (C n) t2` steps to `P (C n) t2'`: -> test_step_2 : -> P -> (C 0) -> (P -> (C 2) -> (P (C 0) (C 3))) -> ->> -> P -> (C 0) -> (P -> (C 2) -> (C (0 + 3))) -> test_step_2 = ?test_step_2_rhs +Right-hand sides of sums can take a step only when the left-hand side +is finished: if `t2` can take a step to `t2'`, then `P (C n) t2` steps +to `P (C n) t2'`: + +> test_step_2 : +> P +> (C 0) +> (P +> (C 2) +> (P (C 0) (C 3))) +> ->> +> P +> (C 0) +> (P +> (C 2) +> (C (0 + 3))) +> test_step_2 = ?test_step_2_rhs +> $\square$ + == Relations We will be working with several different single-step relations, - so it is helpful to generalize a bit and state a few definitions - and theorems about relations in general. (The optional chapter - `Rel.lidr` develops some of these ideas in a bit more detail; it may - be useful if the treatment here is too dense. +so it is helpful to generalize a bit and state a few definitions +and theorems about relations in general. (The optional chapter +`Rel.lidr` develops some of these ideas in a bit more detail; it may +be useful if the treatment here is too dense. A _binary relation_ on a set `X` is a family of propositions parameterized by two elements of `X` -- i.e., a proposition about @@ -217,26 +226,27 @@ pairs of elements of `X`. > Relation : Type -> Type > Relation t = t -> t -> Type +> Our main examples of such relations in this chapter will be - the single-step reduction relation, `->>`, and its multi-step - variant, `->>*` (defined below), but there are many other - examples -- e.g., the "equals," "less than," "less than or equal - to," and "is the square of" relations on numbers, and the "prefix - of" relation on lists and strings. +the single-step reduction relation, `->>`, and its multi-step +variant, `->>*` (defined below), but there are many other +examples -- e.g., the "equals," "less than," "less than or equal +to," and "is the square of" relations on numbers, and the "prefix +of" relation on lists and strings. One simple property of the `->>` relation is that, like the - big-step evaluation relation for Imp, it is _deterministic_. +big-step evaluation relation for Imp, it is _deterministic_. _Theorem_: For each `t`, there is at most one `t'` such that `t` steps to `t'` (`t ->> t'` is provable). This is the same as saying that `->>` is deterministic. _Proof sketch_: We show that if `x` steps to both `y1` and - `y2`, then `y1` and `y2` are equal, by induction on a derivation - of `step x y1`. There are several cases to consider, depending on - the last rule used in this derivation and the last rule in the - given derivation of `step x y2`. +`y2`, then `y1` and `y2` are equal, by induction on a derivation +of `step x y1`. There are several cases to consider, depending on +the last rule used in this derivation and the last rule in the +given derivation of `step x y2`. - If both are `ST_PlusConstConst'`, the result is immediate. @@ -256,27 +266,36 @@ _Proof sketch_: We show that if `x` steps to both `y1` and Formally: +> Uninhabited (Step' (C _) _) where +> uninhabited ST_PlusConstConst' impossible +> uninhabited (ST_Plus1' _) impossible +> uninhabited (ST_Plus2' _) impossible +> +> deterministic : {xt : Type} -> (r : Relation xt) -> Type +> deterministic {xt} r = {x : xt} -> {y1 : xt} -> {y2 : xt} -> r x y1 -> r x y2 -> y1 = y2 +> +> step_deterministic : deterministic Step' +> step_deterministic ST_PlusConstConst' ST_PlusConstConst' = Refl +> step_deterministic ST_PlusConstConst' (ST_Plus1' _) impossible +> step_deterministic ST_PlusConstConst' (ST_Plus2' _) impossible +> step_deterministic (ST_Plus1' l) ST_PlusConstConst' impossible +> step_deterministic (ST_Plus1' l) (ST_Plus1' l') = rewrite step_deterministic l l' in Refl +> step_deterministic (ST_Plus1' l) (ST_Plus2' _) impossible +> step_deterministic (ST_Plus2' r) ST_PlusConstConst' impossible +> step_deterministic (ST_Plus2' r) (ST_Plus1' _) impossible +> step_deterministic (ST_Plus2' r) (ST_Plus2' r') = rewrite step_deterministic r r' in Refl +> -> deterministic : {xt: Type} -> {x: xt} -> {y1: xt} -> {y2: xt} -> (r: Relation xt) -> Type -> deterministic {xt} {x} {y1} {y2} r = r x y1 -> r x y2 -> y1 = y2 - +\todo[inline]{Matching on implicit shortens the proof} -> step_deterministic : deterministic Step' -> step_deterministic ST_PlusConstConst' hyp = -> case hyp of -> ST_PlusConstConst' => Refl -> ST_Plus1' _ impossible -> ST_Plus2' _ impossible -> step_deterministic (ST_Plus1' l) hyp = -> case hyp of -> ST_PlusConstConst' impossible -> ST_Plus1' l' => rewrite step_deterministic l l' in Refl -> ST_Plus2' _ impossible -> step_deterministic (ST_Plus2' r) hyp = -> case hyp of -> ST_PlusConstConst' impossible -> ST_Plus1' _ impossible -> ST_Plus2' r' => rewrite step_deterministic r r' in Refl +> step_deterministic_alt : deterministic Step' +> step_deterministic_alt {x=P (C _) (C _)} ST_PlusConstConst' ST_PlusConstConst' = Refl +> step_deterministic_alt {x=P _ _} (ST_Plus1' s1) (ST_Plus1' s2) = +> rewrite step_deterministic s1 s2 in Refl +> step_deterministic_alt {x=P (C _) _} (ST_Plus2' s1) (ST_Plus1' s2) = absurd s2 +> step_deterministic_alt {x=P (C _) _} (ST_Plus2' s1) (ST_Plus2' s2) = +> rewrite step_deterministic s1 s2 in Refl +> === Values @@ -308,16 +327,19 @@ We can then execute a term `t` as follows: of the machine as the result of execution. Intuitively, it is clear that the final states of the - machine are always terms of the form `C n` for some `n`. - We call such terms _values_. +machine are always terms of the form `C n` for some `n`. +We call such terms _values_. > data Value : Tm -> Type where > V_const : (n : Nat) -> Value (C n) > +> Uninhabited (Value (P _ _)) where +> uninhabited V_const impossible +> Having introduced the idea of values, we can use it in the - definition of the `>>-` relation to write `ST_Plus2` rule in a - slightly more elegant way: +definition of the `>>-` relation to write `ST_Plus2` rule in a +slightly more elegant way: \[ @@ -342,12 +364,12 @@ Having introduced the idea of values, we can use it in the \] Again, the variable names here carry important information: - by convention, `v1` ranges only over values, while `t1` and `t2` - range over arbitrary terms. (Given this convention, the explicit - `value` hypothesis is arguably redundant. We'll keep it for now, - to maintain a close correspondence between the informal and Coq - versions of the rules, but later on we'll drop it in informal - rules for brevity.) +by convention, `v1` ranges only over values, while `t1` and `t2` +range over arbitrary terms. (Given this convention, the explicit +`value` hypothesis is arguably redundant. We'll keep it for now, +to maintain a close correspondence between the informal and Idris +versions of the rules, but later on we'll drop it in informal +rules for brevity.) Here are the formal rules: @@ -360,6 +382,7 @@ Here are the formal rules: > ST_PlusConstConst : P (C n1) (C n2) >>- C (n1 + n2) > ST_Plus1 : t1 >>- t1' -> P t1 t2 >>- P t1' t2 > ST_Plus2 : Value v1 -> t2 >>- t2' -> P v1 t2 >>- P v1 t2' +> ==== Exercise: 3 stars, recommended (redo_determinism) @@ -385,10 +408,15 @@ in the derivations of `step x y1` and `step x y2`. `ST_Plus2` follow by the induction hypothesis. Most of this proof is the same as the one above. But to get - maximum benefit from the exercise you should try to write your - formal version from scratch and just use the earlier one if you - get stuck. - +maximum benefit from the exercise you should try to write your +formal version from scratch and just use the earlier one if you +get stuck. + +> Uninhabited (Step (C _) _) where +> uninhabited ST_PlusConstConst impossible +> uninhabited (ST_Plus1 _) impossible +> uninhabited (ST_Plus2 _ _) impossible +> > step_deterministic' : deterministic Step > step_deterministic' = ?step_deterministic_rhs > @@ -398,14 +426,14 @@ $\square$ === Strong Progress and Normal Forms The definition of single-step reduction for our toy language - is fairly simple, but for a larger language it would be easy to - forget one of the rules and accidentally create a situation where - some term cannot take a step even though it has not been - completely reduced to a value. The following theorem shows that - we did not, in fact, make such a mistake here. +is fairly simple, but for a larger language it would be easy to +forget one of the rules and accidentally create a situation where +some term cannot take a step even though it has not been +completely reduced to a value. The following theorem shows that +we did not, in fact, make such a mistake here. _Theorem_ (_Strong Progress_): If `t` is a term, then either `t` - is a value or else there exists a term `t'` such that `t >>- t'`. +is a value or else there exists a term `t'` such that `t >>- t'`. _Proof_: By induction on `t`. @@ -426,73 +454,67 @@ _Proof_: By induction on `t`. Or, formally: -> strong_progress : (t: Tm) -> Either (Value t) (t': Tm ** Step t t') - +> strong_progress : (t : Tm) -> Either (Value t) (t' : Tm ** Step t t') > strong_progress (C n) = Left (V_const n) -> strong_progress (P (C n) r) = Right $ -> case r of -> (C n') => (C (n + n') ** ST_PlusConstConst) -> (P l' r') => case strong_progress (P l' r') of -> Right (r ** prf1) => (P (C n) r ** ST_Plus2 (V_const n) prf1) -> Left (V_const (P l r)) impossible -> strong_progress (P (P l' r') r) = Right $ -> case strong_progress (P l' r') of -> Right (l ** prf1) => (P l r ** ST_Plus1 prf1) -> Left (V_const (P l r)) impossible +> strong_progress (P (C n) (C n')) = Right (C (n + n') ** ST_PlusConstConst) +> strong_progress (P (C n) (P l r)) = +> case strong_progress (P l r) of +> Right (r' ** prf) => Right (P (C n) r' ** ST_Plus2 (V_const n) prf) +> Left (V_const (P _ _)) impossible +> strong_progress (P (P l r) r') = +> case strong_progress (P l r) of +> Right (l' ** prf) => Right (P l' r' ** ST_Plus1 prf) +> Left (V_const (P _ _)) impossible +> This important property is called _strong progress_, because - every term either is a value or can "make progress" by stepping to - some other term. (The qualifier "strong" distinguishes it from a - more refined version that we'll see in later chapters, called - just _progress_.) +every term either is a value or can "make progress" by stepping to +some other term. (The qualifier "strong" distinguishes it from a +more refined version that we'll see in later chapters, called +just _progress_.) The idea of "making progress" can be extended to tell us something - interesting about values: in this language, values are exactly the - terms that _cannot_ make progress in this sense. +interesting about values: in this language, values are exactly the +terms that _cannot_ make progress in this sense. To state this observation formally, let's begin by giving a name - to terms that cannot make progress. We'll call them _normal - forms_. +to terms that cannot make progress. We'll call them _normal forms_. -> normal_form : {X:Type} -> Relation X -> X -> Type -> normal_form r t = Not (t' ** r t t') +> normal_form : {t : Type} -> Relation t -> t -> Type +> normal_form r x = Not (x' ** r x x') +> Note that this definition specifies what it is to be a normal form - for an _arbitrary_ relation `R` over an arbitrary set `X`, not - just for the particular single-step reduction relation over terms - that we are interested in at the moment. We'll re-use the same - terminology for talking about other relations later in the - course. +for an _arbitrary_ relation `R` over an arbitrary set `X`, not +just for the particular single-step reduction relation over terms +that we are interested in at the moment. We'll re-use the same +terminology for talking about other relations later in the course. We can use this terminology to generalize the observation we made - in the strong progress theorem: in this language, normal forms and - values are actually the same thing. +in the strong progress theorem: in this language, normal forms and +values are actually the same thing. > value_is_nf : (v : Tm) -> Value v -> normal_form Step v -> value_is_nf (C n) prf = notStepCN -> where notStepCN: (t' : Tm ** Step (C n) t') -> Void -> notStepCN (t' ** c) impossible -> value_is_nf (P l r) prf = void (notValueP prf) -> where notValueP: Not (Value (P l r)) -> notValueP (V_const _) impossible - +> value_is_nf (C n) prf = \(_ ** step) => uninhabited step +> value_is_nf (P l r) prf = absurd prf +> > nf_is_value : (v : Tm) -> normal_form Step v -> Value v > nf_is_value (C n) prf = V_const n > nf_is_value (P l r) prf = > case strong_progress (P l r) of > Left va => va > Right pa => void (prf pa) - -> iff : (p,q : Type) -> Type +> +> iff : (p, q : Type) -> Type -- TODO copied from "Logic.lidr" > iff p q = (p -> q, q -> p) - +> > infixl 9 <-> -> (<->) : (p: Type) -> (q:Type) -> Type +> (<->) : (p : Type) -> (q : Type) -> Type > (<->) = iff - - +> > nf_same_as_value : (normal_form Step t) <-> (Value t) -> nf_same_as_value {t} = (nf_is_value t,value_is_nf t) +> nf_same_as_value {t} = (nf_is_value t, value_is_nf t) +> Why is this interesting? @@ -502,21 +524,21 @@ it is defined by looking at how the term steps. It is not obvious that these concepts should coincide! Indeed, we could easily have written the definitions so that they - would _not_ coincide. +would _not_ coincide. + ==== Exercise: 3 stars, optional (value_not_same_as_normal_form1) We might, for example, mistakenly define `value` so that it - includes some terms that are not finished reducing. +includes some terms that are not finished reducing. (Even if you don't work this exercise and the following ones - in Idris, make sure you can think of an example of such a term.) - +in Idris, make sure you can think of an example of such a term.) > data Value' : Tm -> Type where -> V_const' : {n: Nat} -> Value' (C n) -> V_funny : {t1: Tm} -> {n2: Nat} -> Value' (P t1 (C n2)) - +> V_const' : {n : Nat} -> Value' (C n) +> V_funny : {t1 : Tm} -> {n2 : Nat} -> Value' (P t1 (C n2)) +> > mutual > infixl 6 >>>- > (>>>-) : Tm -> Tm -> Type @@ -531,16 +553,18 @@ We might, for example, mistakenly define `value` so that it > Value' v1 -> > t2 >>>- t2' -> > P v1 t2 >>>- P v1 t2' - +> > value_not_same_as_normal_form : (v : Tm ** (Value' v, Not (normal_form Step'' v))) > value_not_same_as_normal_form = ?value_not_same_as_normal_form_rhs +> $\square$ + ==== Exercise: 2 stars, optional (value_not_same_as_normal_form2) Alternatively, we might mistakenly define `step` so that it - permits something designated as a value to reduce further. +permits something designated as a value to reduce further. > mutual > infixl 6 ->>>- @@ -557,20 +581,21 @@ Alternatively, we might mistakenly define `step` so that it > Value' v1 -> > t2 ->>>- t2' -> > P v1 t2 ->>>- P v1 t2' - +> > value_not_same_as_normal_form''' : (v : Tm ** (Value v, Not (normal_form Step''' v))) > value_not_same_as_normal_form''' = ?value_not_same_as_normal_form_rhs''' $\square$ + ==== Exercise: 3 stars, optional (value_not_same_as_normal_form3) Finally, we might define `value` and `step` so that there is some - term that is not a value but that cannot take a step in the `step` - relation. Such terms are said to be _stuck_. In this case this is - caused by a mistake in the semantics, but we will also see - situations where, even in a correct language definition, it makes - sense to allow some terms to be stuck. +term that is not a value but that cannot take a step in the `step` +relation. Such terms are said to be _stuck_. In this case this is +caused by a mistake in the semantics, but we will also see +situations where, even in a correct language definition, it makes +sense to allow some terms to be stuck. > mutual > infixl 6 ->>- @@ -582,11 +607,13 @@ Finally, we might define `value` and `step` so that there is some > ST_Plus1'''' : > t1 ->>- t1' -> > P t1 t2 ->>- P t1' t2 +> (Note that `ST_Plus2` is missing.) > value_not_same_as_normal_form'''' : (t : Tm ** (Not (Value t), normal_form Step'''' t)) > value_not_same_as_normal_form'''' = ?value_not_same_as_normal_form_rhs'''' +> $\square$ @@ -594,19 +621,18 @@ $\square$ === Additional Exercises Here is another very simple language whose terms, instead of being - just addition expressions and numbers, are just the booleans true - and false and a conditional expression... +just addition expressions and numbers, are just the booleans true +and false and a conditional expression... > data TmB : Type where > Ttrue : TmB > Tfalse : TmB > Tif : TmB -> TmB -> TmB -> TmB - +> > data ValueB : TmB -> Type where > V_true : ValueB Ttrue > V_false : ValueB Tfalse - - +> > mutual > infixl 6 ->- > (->-) : TmB -> TmB -> Type @@ -616,17 +642,18 @@ Here is another very simple language whose terms, instead of being > ST_IfTrue : Tif Ttrue t1 t2 ->- t1 > ST_IfFalse : Tif Tfalse t1 t2 ->- t2 > ST_If : t1 ->- t1' -> Tif t1 t2 t3 ->- Tif t1' t2 t3 +> ==== Exercise: 1 star (smallstep_bools) Which of the following propositions are provable? (This is just a - thought exercise, but for an extra challenge feel free to prove - your answers in Idris.) +thought exercise, but for an extra challenge feel free to prove +your answers in Idris.) > bool_step_prop1 : Tfalse ->- Tfalse > bool_step_prop1 = ?bool_step_prop1_rhs - +> > bool_step_prop2 : > Tif > Ttrue @@ -635,7 +662,7 @@ Which of the following propositions are provable? (This is just a > ->- > Ttrue > bool_step_prop2 = ?bool_step_prop2_rhs - +> > bool_step_prop3 : > Tif > (Tif Ttrue Ttrue Ttrue) @@ -647,6 +674,7 @@ Which of the following propositions are provable? (This is just a > (Tif Ttrue Ttrue Ttrue) > Tfalse > bool_step_prop3 = ?bool_step_prop3_rhs +> $\square$ @@ -654,25 +682,29 @@ $\square$ ==== Exercise: 3 stars, optional (progress_bool) Just as we proved a progress theorem for plus expressions, we can - do so for boolean expressions, as well. +do so for boolean expressions, as well. + +> strong_progressB : (t : TmB) -> Either (ValueB t) (t': TmB ** t ->- t') +> strong_progressB t = ?strong_progressB_rhs +> -> strong_progressB : {t : TmB} -> (ValueB t, (t': TmB ** t ->- t')) -> strong_progressB = ?strong_progressB_rhs ==== Exercise: 2 stars, optional (step_deterministic) > step_deterministicB : deterministic StepB > step_deterministicB = ?step_deterministicB_rhs +> + ==== Exercise: 2 stars (smallstep_bool_shortcut) Suppose we want to add a "short circuit" to the step relation for - boolean expressions, so that it can recognize when the `then` and - `else` branches of a conditional are the same value (either - `ttrue` or `tfalse`) and reduce the whole conditional to this - value in a single step, even if the guard has not yet been reduced - to a value. For example, we would like this proposition to be - provable: +boolean expressions, so that it can recognize when the `then` and +`else` branches of a conditional are the same value (either +`ttrue` or `tfalse`) and reduce the whole conditional to this +value in a single step, even if the guard has not yet been reduced +to a value. For example, we would like this proposition to be +provable: ```idris tif @@ -684,7 +716,7 @@ Suppose we want to add a "short circuit" to the step relation for ``` Write an extra clause for the step relation that achieves this - effect and prove `bool_step_prop4`. +effect and prove `bool_step_prop4`. > mutual > infixl 6 ->-> @@ -695,26 +727,30 @@ Write an extra clause for the step relation that achieves this > ST_IfTrue' : Tif Ttrue t1 t2 ->-> t1 > ST_IfFalse' : Tif Tfalse t1 t2 ->-> t2 > ST_If' : t1 ->-> t1' -> Tif t1 t2 t3 ->-> Tif t1' t2 t3 - -> bool_step_prop4 : +> -- FILL IN HERE +> +> bool_step_prop4 : Type +> bool_step_prop4 = > Tif > (Tif Ttrue Ttrue Ttrue) > Tfalse > Tfalse > ->-> > Tfalse - -> bool_step_prop4_holds : bool_step_prop4 +> +> bool_step_prop4_holds : Smallstep.bool_step_prop4 > bool_step_prop4_holds = ?bool_step_prop4_holds_rhs +> $\square$ ==== Exercise: 3 stars, optional (properties_of_altered_step) + It can be shown that the determinism and strong progress theorems - for the step relation in the lecture notes also hold for the - definition of step given above. After we add the clause - `ST_ShortCircuit`... +for the step relation in the lecture notes also hold for the +definition of step given above. After we add the clause +`ST_ShortCircuit`... - Is the `step` relation still deterministic? Write yes or no and briefly (1 sentence) explain your answer. @@ -722,9 +758,9 @@ It can be shown that the determinism and strong progress theorems Optional: prove your answer correct in Idris. - Does a strong progress theorem hold? Write yes or no and - briefly (1 sentence) explain your answer. + briefly (1 sentence) explain your answer. - Optional: prove your answer correct in Idris. +Optional: prove your answer correct in Idris. In general, is there any way we could cause strong progress to fail if we took away one or more constructors from the original @@ -733,6 +769,7 @@ your answer. $\square$ + == Multi-Step Reduction We've been working so far with the _single-step reduction_ @@ -754,98 +791,113 @@ Since we'll want to reuse the idea of multi-step reduction many times, let's take a little extra trouble and define it generically. -Given a relation `R`, we define a relation `multi R`, called the -multi-step closure of `R`_ as follows. - -> mutual -> infixl 6 ->>* -> (->>*) : Tm -> Tm -> Type -> (->>*) t t' = Multi Step t t' +Given a relation `r`, we define a relation `Multi r`, called the +_multi-step closure of `r`_ as follows. + +> data Multi: {t : Type} -> (r : Relation t) -> Relation t where +> Multi_refl : {x : t} -> Multi r x x +> Multi_step : {x, y, z : t} -> +> r x y -> Multi r y z -> Multi r x z +> +> infixl 6 ->>* +> (->>*) : Tm -> Tm -> Type +> (->>*) = Multi Step > -> data Multi: {X: Type} -> (R: Relation X) -> Relation X where -> Multi_refl : {X: Type} -> {R: Relation X} -> {x : X} -> Multi R x x -> Multi_step : {X: Type} -> {R: Relation X} -> {x, y, z : X} -> -> R x y -> Multi R y z -> Multi R x z (In the `Rel` chapter of _Logical Foundations_ this relation is called `clos_refl_trans_1n`. We give it a shorter name here for the sake of readability.) -The effect of this definition is that `multi R` relates two +The effect of this definition is that `Multi r` relates two elements `x` and `y` if - `x = y`, or -- `R x y`, or +- `r x y`, or - there is some nonempty sequence `z1`, `z2`, ..., `zn` such that - R x z1 - R z1 z2 + r x z1 + r z1 z2 ... - R zn y. + r zn y. -Thus, if `R` describes a single-step of computation, then `z1`...`zn` +Thus, if `r` describes a single-step of computation, then `z1`...`zn` is the sequence of intermediate steps of computation between `x` and `y`. -We write `->>*` for the `multi step` relation on terms. +We write `->>*` for the `Multi Step` relation on terms. -The relation `multi R` has several crucial properties. +The relation `Multi r` has several crucial properties. -First, it is obviously _reflexive_ (that is, `forall x, multi R x -x`). In the case of the `->>*` (i.e., `multi step`) relation, the +First, it is obviously _reflexive_ (that is, `forall x, Multi r x +x`). In the case of the `->>*` (i.e., `Multi Step`) relation, the intuition is that a term can execute to itself by taking zero steps of execution. -Second, it contains `R` -- that is, single-step executions are a +Second, it contains `r` -- that is, single-step executions are a particular case of multi-step executions. (It is this fact that justifies the word "closure" in the term "multi-step closure of -`R`.") - +`r`.") -> multi_R : {X: Type} -> {R: Relation X} -> (x,y: X) -> R x y -> (Multi R) x y +> multi_R : {t : Type} -> {r : Relation t} -> (x, y : t) -> r x y -> (Multi r) x y > multi_R x y h = Multi_step h (Multi_refl) +> Third, `multi R` is _transitive_. -> multi_trans: {X:Type} -> {R: Relation X} -> {x, y, z : X} -> -> Multi R x y -> Multi R y z -> Multi R x z -> multi_trans m1 m2 = -> case m1 of -> Multi_refl => m2 -> Multi_step r mx => -> let indHyp = multi_trans mx m2 -> in Multi_step r indHyp +> multi_trans : {t : Type} -> {r : Relation t} -> {x, y, z : t} -> +> Multi r x y -> Multi r y z -> Multi r x z +> multi_trans Multi_refl m2 = m2 +> multi_trans (Multi_step r mx) m2 = +> let indHyp = multi_trans mx m2 in +> Multi_step r indHyp +> + +In particular, for the `Multi Step` relation on terms, if +`t1->>*t2` and `t2->>*t3`, then `t1->>*t3`. -In particular, for the `multi step` relation on terms, if - `t1->>*t2` and `t2->>*t3`, then `t1->>*t3`. === Examples -Here's a specific instance of the `multi step` relation: +Here's a specific instance of the `Multi Step` relation: -> test_multistep_1: +> test_multistep_1 : > P > (P (C 0) (C 3)) > (P (C 2) (C 4)) > ->>* > C ((0 + 3) + (2 + 4)) > test_multistep_1 = -> let z = C ((0 + 3) + (2 + 4)) -> in Multi_step {z=z} (ST_Plus1 ST_PlusConstConst) -> (Multi_step {z=z} (ST_Plus2 (V_const 3) ST_PlusConstConst) -> (Multi_step ST_PlusConstConst Multi_refl)) +> Multi_step {y=P (C (0 + 3)) (P (C 2) (C 4))} (ST_Plus1 ST_PlusConstConst) +> (Multi_step {y=P (C (0 + 3)) (C (2 + 4))} (ST_Plus2 (V_const 3) ST_PlusConstConst) +> (Multi_step ST_PlusConstConst Multi_refl)) +> + +In fact, Idris can infer all implicits itself here: + +> test_multistep_1' : +> P +> (P (C 0) (C 3)) +> (P (C 2) (C 4)) +> ->>* +> C ((0 + 3) + (2 + 4)) +> test_multistep_1' = +> Multi_step (ST_Plus1 ST_PlusConstConst) +> (Multi_step (ST_Plus2 (V_const 3) ST_PlusConstConst) +> (Multi_step ST_PlusConstConst Multi_refl)) +> ==== Exercise: 1 star, optional (test_multistep_2) -> test_multistep_2: C 3 ->>* C 3 +> test_multistep_2 : C 3 ->>* C 3 > test_multistep_2 = ?test_multistep_2_rhs $\square$ + ==== Exercise: 1 star, optional (test_multistep_3) -> test_multistep_3: +> test_multistep_3 : > P (C 0) (C 3) > ->>* > P (C 0) (C 3) @@ -853,9 +905,10 @@ $\square$ $\square$ + ==== Exercise: 2 stars (test_multistep_4) -> test_multistep_4: +> test_multistep_4 : > P > (C 0) > (P @@ -869,39 +922,47 @@ $\square$ $\square$ + === Normal Forms Again If `t` reduces to `t'` in zero or more steps and `t'` is a - normal form, we say that "`t'` is a normal form of `t`." +normal form, we say that "`t'` is a normal form of `t`." > step_normal_form : (t : Tm) -> Type > step_normal_form = normal_form Step - +> > normal_form_of : Tm -> Tm -> Type > normal_form_of t t' = (t ->>* t', step_normal_form t') +> We have already seen that, for our language, single-step reduction is - deterministic -- i.e., a given term can take a single step in - at most one way. It follows from this that, if `t` can reach - a normal form, then this normal form is unique. In other words, we - can actually pronounce `normal_form t t'` as "`t'` is _the_ - normal form of `t`." +deterministic -- i.e., a given term can take a single step in +at most one way. It follows from this that, if `t` can reach +a normal form, then this normal form is unique. In other words, we +can actually pronounce `normal_form t t'` as "`t'` is _the_ +normal form of `t`." + ==== Exercise: 3 stars, optional (normal_forms_unique) +\todo[inline]{The result will likely not pass the totality checker, as it +currently has trouble looking under tuples, just use `assert_total`} + > normal_forms_unique : deterministic Smallstep.normal_form_of > normal_forms_unique (l,r) (l2,r2) = ?normal_forms_unique_rhs +> $\square$ Indeed, something stronger is true for this language (though not - for all languages): the reduction of _any_ term `t` will - eventually reach a normal form -- i.e., `normal_form_of` is a - _total_ function. Formally, we say the `step` relation is - _normalizing_. +for all languages): the reduction of _any_ term `t` will +eventually reach a normal form -- i.e., `normal_form_of` is a +_total_ function. Formally, we say the `step` relation is +_normalizing_. -> normalizing : {x: Type} -> (r: Relation x) -> Type -> normalizing {x} {r} = (t: x) -> (t' : x ** (Multi r t t', normal_form r t')) +> normalizing : {x : Type} -> (r : Relation x) -> Type +> normalizing {x} {r} = (t : x) -> (t' : x ** (Multi r t t', normal_form r t')) +> To prove that `step` is normalizing, we need a couple of lemmas. @@ -912,30 +973,30 @@ similarly when `t` appears as the right-hand child of a `P` node whose left-hand child is a value. > multistep_congr_1 : (t1 ->>* t1') -> ((P t1 t2) ->>* P t1' t2) -> multistep_congr_1 mult = -> case mult of -> Multi_refl => Multi_refl -> Multi_step step mult' => -> let indHyp = multistep_congr_1 mult' -> in Multi_step (ST_Plus1 step) indHyp +> multistep_congr_1 Multi_refl = Multi_refl +> multistep_congr_1 (Multi_step step mult') = +> let indHyp = multistep_congr_1 mult' in +> Multi_step (ST_Plus1 step) indHyp +> ==== Exercise: 2 stars (multistep_congr_2) -> multistep_congr_2 : {v:Value t1} -> (t2 ->>* t2') -> ((P t1 t2) ->>* P t1 t2') -> multistep_congr_2 {v=V_const i} mult = ?multistep_congr_2_rhs +> multistep_congr_2 : {v : Value t1} -> (t2 ->>* t2') -> ((P t1 t2) ->>* P t1 t2') +> multistep_congr_2 {v} mult = ?multistep_congr_2_rhs +> $\square$ With these lemmas in hand, the main proof is a straightforward - induction. +induction. _Theorem_: The `step` function is normalizing -- i.e., for every - `t` there exists some `t'` such that `t` steps to `t'` and `t'` is - a normal form. +`t` there exists some `t'` such that `t` steps to `t'` and `t'` is +a normal form. _Proof sketch_: By induction on terms. There are two cases to - consider: +consider: - `t = C n` for some `n`. Here `t` doesn't take a step, and we have `t' = t`. We can derive the left-hand side by reflexivity @@ -955,55 +1016,38 @@ _Proof sketch_: By induction on terms. There are two cases to which is in turn a normal form. `` *) > step_normalizing : normalizing Step -> step_normalizing (C n) = (C n ** (Multi_refl, notStepCN)) -> where notStepCN: (t' : Tm ** Step (C n) t') -> Void -> notStepCN (t' ** c) impossible -> step_normalizing (P l r) = -> let (_ ** (ih1l,(ih1r))) = step_normalizing l -> (_ ** (ih2l,(ih2r))) = step_normalizing r -> ih1v = (fst nf_same_as_value) ih1r -> ih2v = (fst nf_same_as_value) ih2r -> n1 = lemma_get ih1v -> n2 = lemma_get ih2v -> (n1**p1) = lemma_deconstruct ih1v -> (n2**p2) = lemma_deconstruct ih2v -> m1 = replace p1 ih1l -> m2 = replace p2 ih2l - -> reduction : ((P l r) ->>* (C (plus n1 n2))) = -> let left_transform = multistep_congr_1 m1 -> right_transform = -> let leftT = multistep_congr_2 {v=V_const n1} m2 -> rightT = Multi_step ST_PlusConstConst Multi_refl -> conc2 = multi_trans {x=P (C n1) r} {y=P (C n1) (C n2)} {z=C (plus n1 n2)} -> in conc2 leftT rightT -> conc1 = multi_trans {x=P l r} {y=P (C n1) r} {z=C (plus n1 n2)} -> in conc1 left_transform right_transform - -> normal_form : ((t'1 : Tm ** Step (C (plus n1 n2)) t'1) -> Void) = -> (snd nf_same_as_value) (V_const (plus n1 n2)) - -> in (C (n1 + n2) ** (reduction, normal_form)) -> where -> lemma_get : Value v -> Nat -> lemma_get (V_const n) = n - -> lemma_deconstruct : Value v -> (n : Nat ** v = C n) -> lemma_deconstruct v@(V_const n) = (n ** Refl) +> step_normalizing (C n) = (C n ** (Multi_refl, \(_**sc) => uninhabited sc)) +> step_normalizing (P l r) = +> let +> (_ ** (ih1l,ih1r)) = step_normalizing l +> (_ ** (ih2l,ih2r)) = step_normalizing r +> V_const n1 = (fst nf_same_as_value) ih1r +> V_const n2 = (fst nf_same_as_value) ih2r +> reduction : ((P l r) ->>* (C (n1 + n2))) = +> multi_trans {y=P (C n1) r} +> (multistep_congr_1 ih1l) +> (multi_trans {y=P (C n1) (C n2)} +> (multistep_congr_2 {v=V_const n1} ih2l) +> (Multi_step ST_PlusConstConst Multi_refl) +> ) +> normal_form : Not (t : Tm ** Step (C (n1 + n2)) t) = +> (snd nf_same_as_value) (V_const (n1 + n2)) +> in +> (C (n1 + n2) ** (reduction, normal_form)) +> === Equivalence of Big-Step and Small-Step Having defined the operational semantics of our tiny programming - language in two different ways (big-step and small-step), it makes - sense to ask whether these definitions actually define the same - thing! They do, though it takes a little work to show it. The - details are left as an exercise. +language in two different ways (big-step and small-step), it makes +sense to ask whether these definitions actually define the same +thing! They do, though it takes a little work to show it. The +details are left as an exercise. ==== Exercise: 3 stars (eval__multistep) -> eval__multistep: {t: Tm} -> {n: Nat} -> t >>> n -> t ->>* C n -> eval__multistep hyp = ?eval__multistep_rhs +> eval__multistep : {t : Tm} -> {n : Nat} -> t >>> n -> t ->>* C n $\square$ @@ -1035,10 +1079,12 @@ proceeds in three phases: n1) (C n2)` to `C (n1 + n2)`. To formalize this intuition, you'll need to use the congruence - lemmas from above (you might want to review them now, so that - you'll be able to recognize when they are useful), plus some basic - properties of `->>*`: that it is reflexive, transitive, and - includes `->>`. +lemmas from above (you might want to review them now, so that +you'll be able to recognize when they are useful), plus some basic +properties of `->>*`: that it is reflexive, transitive, and +includes `->>`. + +> eval__multistep hyp = ?eval__multistep_rhs ==== Exercise: 3 stars, advanced (eval__multistep_inf) @@ -1048,15 +1094,16 @@ Write a detailed informal version of the proof of `eval__multistep` $\square$ For the other direction, we need one lemma, which establishes a - relation between single-step reduction and big-step evaluation. +relation between single-step reduction and big-step evaluation. ==== Exercise: 3 stars (step__eval) -> step__eval : {t, t': Tm} -> {n: Nat} -> -> t ->> t' -> +> step__eval : {t, t' : Tm} -> {n : Nat} -> +> t >>- t' -> > t' >>> n -> > t >>> n -> step__eval h1 h2 = ?step__eval_rhs +> step__eval step eval = ?step__eval_rhs +> $\square$ From 5043995f54b64fa5290384e9af9410256f9b1aa8 Mon Sep 17 00:00:00 2001 From: Alex Gryzlov Date: Thu, 8 Nov 2018 17:22:02 +0200 Subject: [PATCH 27/30] rewrap text, WIP concurrent Imp --- software_foundations.ipkg | 1 + src/Smallstep.lidr | 1166 ++++++++++++++++--------------------- 2 files changed, 519 insertions(+), 648 deletions(-) diff --git a/software_foundations.ipkg b/software_foundations.ipkg index b94469b..9b4518a 100644 --- a/software_foundations.ipkg +++ b/software_foundations.ipkg @@ -12,6 +12,7 @@ modules = Basics , Rel , Imp , ImpParser + , Smallstep brief = "Software Foundations in Idris" version = 0.0.1.0 diff --git a/src/Smallstep.lidr b/src/Smallstep.lidr index 8cc0eb5..cf9821c 100644 --- a/src/Smallstep.lidr +++ b/src/Smallstep.lidr @@ -10,94 +10,82 @@ > %default total > -The evaluators we have seen so far (for `aexp`s, `bexp`s, -commands, ...) have been formulated in a "big-step" style: they -specify how a given expression can be evaluated to its final -value (or a command plus a store to a final store) "all in one big -step." - -This style is simple and natural for many purposes -- indeed, -Gilles Kahn, who popularized it, called it _natural semantics_. -But there are some things it does not do well. In particular, it -does not give us a natural way of talking about _concurrent_ -programming languages, where the semantics of a program -- i.e., -the essence of how it behaves -- is not just which input states -get mapped to which output states, but also includes the -intermediate states that it passes through along the way, since -these states can also be observed by concurrently executing code. - -Another shortcoming of the big-step style is more technical, but -critical in many situations. Suppose we want to define a variant -of Imp where variables could hold _either_ numbers _or_ lists of -numbers. In the syntax of this extended language, it will be -possible to write strange expressions like `2 + nil`, and our -semantics for arithmetic expressions will then need to say -something about how such expressions behave. One possibility is -to maintain the convention that every arithmetic expressions -evaluates to some number by choosing some way of viewing a list as -a number -- e.g., by specifying that a list should be interpreted -as `0` when it occurs in a context expecting a number. But this -is really a bit of a hack. - -A much more natural approach is simply to say that the behavior of -an expression like `2+nil` is _undefined_ -- i.e., it doesn't -evaluate to any result at all. And we can easily do this: we just -have to formulate `aeval` and `beval` as `Inductive` propositions -rather than Fixpoints, so that we can make them partial functions -instead of total ones. - -Now, however, we encounter a serious deficiency. In this -language, a command might fail to map a given starting state to -any ending state for _two quite different reasons_: either because -the execution gets into an infinite loop or because, at some -point, the program tries to do an operation that makes no sense, -such as adding a number to a list, so that none of the evaluation -rules can be applied. - -These two outcomes -- nontermination vs. getting stuck in an -erroneous configuration -- should not be confused. In particular, we -want to _allow_ the first (permitting the possibility of infinite -loops is the price we pay for the convenience of programming with -general looping constructs like `while`) but _prevent_ the -second (which is just wrong), for example by adding some form of -_typechecking_ to the language. Indeed, this will be a major -topic for the rest of the course. As a first step, we need a way -of presenting the semantics that allows us to distinguish -nontermination from erroneous "stuck states." - -So, for lots of reasons, we'd often like to have a finer-grained -way of defining and reasoning about program behaviors. This is -the topic of the present chapter. Our goal is to replace the -"big-step" `eval` relation with a "small-step" relation that -specifies, for a given program, how the "atomic steps" of +The evaluators we have seen so far (for `aexp`s, `bexp`s, commands, ...) have +been formulated in a "big-step" style: they specify how a given expression can +be evaluated to its final value (or a command plus a store to a final store) +"all in one big step." + +This style is simple and natural for many purposes -- indeed, Gilles Kahn, who +popularized it, called it _natural semantics_. But there are some things it does +not do well. In particular, it does not give us a natural way of talking about +_concurrent_ programming languages, where the semantics of a program -- i.e., +the essence of how it behaves -- is not just which input states get mapped to +which output states, but also includes the intermediate states that it passes +through along the way, since these states can also be observed by concurrently +executing code. + +Another shortcoming of the big-step style is more technical, but critical in +many situations. Suppose we want to define a variant of Imp where variables +could hold _either_ numbers _or_ lists of numbers. In the syntax of this +extended language, it will be possible to write strange expressions like `2 + +nil`, and our semantics for arithmetic expressions will then need to say +something about how such expressions behave. One possibility is to maintain the +convention that every arithmetic expressions evaluates to some number by +choosing some way of viewing a list as a number -- e.g., by specifying that a +list should be interpreted as `0` when it occurs in a context expecting a +number. But this is really a bit of a hack. + +A much more natural approach is simply to say that the behavior of an expression +like `2+nil` is _undefined_ -- i.e., it doesn't evaluate to any result at all. +And we can easily do this: we just have to formulate `aeval` and `beval` as +`Inductive` propositions rather than Fixpoints, so that we can make them partial +functions instead of total ones. + +Now, however, we encounter a serious deficiency. In this language, a command +might fail to map a given starting state to any ending state for _two quite +different reasons_: either because the execution gets into an infinite loop or +because, at some point, the program tries to do an operation that makes no +sense, such as adding a number to a list, so that none of the evaluation rules +can be applied. + +These two outcomes -- nontermination vs. getting stuck in an erroneous +configuration -- should not be confused. In particular, we want to _allow_ the +first (permitting the possibility of infinite loops is the price we pay for the +convenience of programming with general looping constructs like `while`) but +_prevent_ the second (which is just wrong), for example by adding some form of +_typechecking_ to the language. Indeed, this will be a major topic for the rest +of the course. As a first step, we need a way of presenting the semantics that +allows us to distinguish nontermination from erroneous "stuck states." + +So, for lots of reasons, we'd often like to have a finer-grained way of defining +and reasoning about program behaviors. This is the topic of the present chapter. +Our goal is to replace the "big-step" `eval` relation with a "small-step" +relation that specifies, for a given program, how the "atomic steps" of computation are performed. - == A Toy Language -To save space in the discussion, let's go back to an -incredibly simple language containing just constants and -addition. (We use single letters -- `C` and `P` (for Constant and -Plus) -- as constructor names, for brevity.) At the end of the -chapter, we'll see how to apply the same techniques to the full -Imp language. +To save space in the discussion, let's go back to an incredibly simple language +containing just constants and addition. (We use single letters -- `C` and `P` +(for Constant and Plus) -- as constructor names, for brevity.) At the end of the +chapter, we'll see how to apply the same techniques to the full Imp language. > data Tm : Type where > C : Nat -> Tm -- Constant > P : Tm -> Tm -> Tm -- Plus > -Here is a standard evaluator for this language, written in - the big-step style that we've been using up to this point. +Here is a standard evaluator for this language, written in the big-step style +that we've been using up to this point. > evalF : (t : Tm) -> Nat -> evalF (C n) = n +> evalF (C n) = n > evalF (P a1 a2) = evalF a1 + evalF a2 > -Here is the same evaluator, written in exactly the same style, -but formulated as an inductively defined relation. Again, we use -the notation `t >>> n` for "`t` evaluates to `n`." +Here is the same evaluator, written in exactly the same style, but formulated as +an inductively defined relation. Again, we use the notation `t >>> n` for "`t` +evaluates to `n`." \[ \begin{prooftree} @@ -160,21 +148,19 @@ Now, here is the corresponding _small-step_ evaluation relation. Things to notice: -- We are defining just a single reduction step, in which - one `P` node is replaced by its value. +- We are defining just a single reduction step, in which one `P` node is + replaced by its value. -- Each step finds the _leftmost_ `P` node that is ready to - go (both of its operands are constants) and rewrites it in - place. The first rule tells how to rewrite this `P` node - itself; the other two rules tell how to find it. +- Each step finds the _leftmost_ `P` node that is ready to go (both of its + operands are constants) and rewrites it in place. The first rule tells how to + rewrite this `P` node itself; the other two rules tell how to find it. - A term that is just a constant cannot take a step. -Let's pause and check a couple of examples of reasoning with -the `step` relation... +Let's pause and check a couple of examples of reasoning with the `step` +relation... -If `t1` can take a step to `t1'`, then `P t1 t2` steps -to `P t1' t2`: +If `t1` can take a step to `t1'`, then `P t1 t2` steps to `P t1' t2`: > test_step_1 : > P @@ -190,9 +176,9 @@ to `P t1' t2`: ==== Exercise: 1 star (test_step_2) -Right-hand sides of sums can take a step only when the left-hand side -is finished: if `t2` can take a step to `t2'`, then `P (C n) t2` steps -to `P (C n) t2'`: +Right-hand sides of sums can take a step only when the left-hand side is +finished: if `t2` can take a step to `t2'`, then `P (C n) t2` steps to `P (C n) +t2'`: > test_step_2 : > P @@ -214,132 +200,126 @@ $\square$ == Relations -We will be working with several different single-step relations, -so it is helpful to generalize a bit and state a few definitions -and theorems about relations in general. (The optional chapter -`Rel.lidr` develops some of these ideas in a bit more detail; it may -be useful if the treatment here is too dense. +We will be working with several different single-step relations, so it is +helpful to generalize a bit and state a few definitions and theorems about +relations in general. (The optional chapter `Rel.lidr` develops some of these +ideas in a bit more detail; it may be useful if the treatment here is too dense. -A _binary relation_ on a set `X` is a family of propositions -parameterized by two elements of `X` -- i.e., a proposition about -pairs of elements of `X`. +A _binary relation_ on a set `X` is a family of propositions parameterized by +two elements of `X` -- i.e., a proposition about pairs of elements of `X`. > Relation : Type -> Type > Relation t = t -> t -> Type > -Our main examples of such relations in this chapter will be -the single-step reduction relation, `->>`, and its multi-step -variant, `->>*` (defined below), but there are many other -examples -- e.g., the "equals," "less than," "less than or equal -to," and "is the square of" relations on numbers, and the "prefix -of" relation on lists and strings. +Our main examples of such relations in this chapter will be the single-step +reduction relation, `->>`, and its multi-step variant, `->>*` (defined below), +but there are many other examples -- e.g., the "equals," "less than," "less than +or equal to," and "is the square of" relations on numbers, and the "prefix of" +relation on lists and strings. -One simple property of the `->>` relation is that, like the -big-step evaluation relation for Imp, it is _deterministic_. +One simple property of the `->>` relation is that, like the big-step evaluation +relation for Imp, it is _deterministic_. -_Theorem_: For each `t`, there is at most one `t'` such that `t` -steps to `t'` (`t ->> t'` is provable). This is the -same as saying that `->>` is deterministic. +_Theorem_: For each `t`, there is at most one `t'` such that `t` steps to `t'` +(`t ->> t'` is provable). This is the same as saying that `->>` is +deterministic. -_Proof sketch_: We show that if `x` steps to both `y1` and -`y2`, then `y1` and `y2` are equal, by induction on a derivation -of `step x y1`. There are several cases to consider, depending on -the last rule used in this derivation and the last rule in the -given derivation of `step x y2`. +_Proof sketch_: We show that if `x` steps to both `y1` and `y2`, then `y1` and +`y2` are equal, by induction on a derivation of `step x y1`. There are several +cases to consider, depending on the last rule used in this derivation and the +last rule in the given derivation of `step x y2`. - If both are `ST_PlusConstConst'`, the result is immediate. -- The cases when both derivations end with `ST_Plus1` or - `ST_Plus2` follow by the induction hypothesis. +- The cases when both derivations end with `ST_Plus1` or `ST_Plus2` follow by + the induction hypothesis. -- It cannot happen that one is `ST_PlusConstConst'` and the other - is `ST_Plus1` or `ST_Plus2'`, since this would imply that `x` - has the form `P t1 t2` where both `t1` and `t2` are - constants (by `ST_PlusConstConst'`) _and_ one of `t1` or `t2` - has the form `P _`. +- It cannot happen that one is `ST_PlusConstConst'` and the other is `ST_Plus1` + or `ST_Plus2'`, since this would imply that `x` has the form `P t1 t2` where + both `t1` and `t2` are constants (by `ST_PlusConstConst'`) _and_ one of `t1` + or `t2` has the form `P _`. -- Similarly, it cannot happen that one is `ST_Plus1'` and the - other is `ST_Plus2'`, since this would imply that `x` has the - form `P t1 t2` where `t1` has both the form `P t11 t12` and the - form `C n`. +- Similarly, it cannot happen that one is `ST_Plus1'` and the other is + `ST_Plus2'`, since this would imply that `x` has the form `P t1 t2` where `t1` + has both the form `P t11 t12` and the form `C n`. Formally: > Uninhabited (Step' (C _) _) where > uninhabited ST_PlusConstConst' impossible -> uninhabited (ST_Plus1' _) impossible -> uninhabited (ST_Plus2' _) impossible +> uninhabited (ST_Plus1' _) impossible +> uninhabited (ST_Plus2' _) impossible > > deterministic : {xt : Type} -> (r : Relation xt) -> Type -> deterministic {xt} r = {x : xt} -> {y1 : xt} -> {y2 : xt} -> r x y1 -> r x y2 -> y1 = y2 +> deterministic {xt} r = {x : xt} -> {y1 : xt} -> {y2 : xt} +> -> r x y1 -> r x y2 -> y1 = y2 > > step_deterministic : deterministic Step' -> step_deterministic ST_PlusConstConst' ST_PlusConstConst' = Refl -> step_deterministic ST_PlusConstConst' (ST_Plus1' _) impossible -> step_deterministic ST_PlusConstConst' (ST_Plus2' _) impossible -> step_deterministic (ST_Plus1' l) ST_PlusConstConst' impossible -> step_deterministic (ST_Plus1' l) (ST_Plus1' l') = rewrite step_deterministic l l' in Refl -> step_deterministic (ST_Plus1' l) (ST_Plus2' _) impossible -> step_deterministic (ST_Plus2' r) ST_PlusConstConst' impossible -> step_deterministic (ST_Plus2' r) (ST_Plus1' _) impossible -> step_deterministic (ST_Plus2' r) (ST_Plus2' r') = rewrite step_deterministic r r' in Refl +> step_deterministic ST_PlusConstConst' ST_PlusConstConst' = Refl +> step_deterministic ST_PlusConstConst' (ST_Plus1' s2) = absurd s2 +> step_deterministic ST_PlusConstConst' (ST_Plus2' s2) = absurd s2 +> step_deterministic (ST_Plus1' s1) ST_PlusConstConst' = absurd s1 +> step_deterministic (ST_Plus1' s1) (ST_Plus1' s2) = +> rewrite step_deterministic s1 s2 in Refl +> step_deterministic (ST_Plus1' s1) (ST_Plus2' s2) = absurd s1 +> step_deterministic (ST_Plus2' s1) ST_PlusConstConst' = absurd s1 +> step_deterministic (ST_Plus2' s1) (ST_Plus1' s2) = absurd s2 +> step_deterministic (ST_Plus2' s1) (ST_Plus2' s2) = +> rewrite step_deterministic s1 s2 in Refl > \todo[inline]{Matching on implicit shortens the proof} -> step_deterministic_alt : deterministic Step' -> step_deterministic_alt {x=P (C _) (C _)} ST_PlusConstConst' ST_PlusConstConst' = Refl -> step_deterministic_alt {x=P _ _} (ST_Plus1' s1) (ST_Plus1' s2) = -> rewrite step_deterministic s1 s2 in Refl -> step_deterministic_alt {x=P (C _) _} (ST_Plus2' s1) (ST_Plus1' s2) = absurd s2 -> step_deterministic_alt {x=P (C _) _} (ST_Plus2' s1) (ST_Plus2' s2) = -> rewrite step_deterministic s1 s2 in Refl +> step_deterministic_2 : deterministic Step' +> step_deterministic_2 {x=P (C _) (C _)} ST_PlusConstConst' ST_PlusConstConst' = +> Refl +> step_deterministic_2 {x=P _ _} (ST_Plus1' s1) (ST_Plus1' s2) = +> rewrite step_deterministic_2 s1 s2 in Refl +> step_deterministic_2 {x=P (C _) _} (ST_Plus2' s1) (ST_Plus1' s2) = +> absurd s2 +> step_deterministic_2 {x=P (C _) _} (ST_Plus2' s1) (ST_Plus2' s2) = +> rewrite step_deterministic_2 s1 s2 in Refl > === Values -Next, it will be useful to slightly reformulate the - definition of single-step reduction by stating it in terms of - "values." +Next, it will be useful to slightly reformulate the definition of single-step +reduction by stating it in terms of "values." -It is useful to think of the `->>` relation as defining an - _abstract machine_: +It is useful to think of the `->>` relation as defining an _abstract machine_: - At any moment, the _state_ of the machine is a term. -- A _step_ of the machine is an atomic unit of computation -- - here, a single "add" operation. +- A _step_ of the machine is an atomic unit of computation -- here, a single + "add" operation. -- The _halting states_ of the machine are ones where there is no - more computation to be done. *) +- The _halting states_ of the machine are ones where there is no more + computation to be done. We can then execute a term `t` as follows: - Take `t` as the starting state of the machine. -- Repeatedly use the `->>` relation to find a sequence of - machine states, starting with `t`, where each state steps to - the next. +- Repeatedly use the `->>` relation to find a sequence of machine states, + starting with `t`, where each state steps to the next. -- When no more reduction is possible, "read out" the final state - of the machine as the result of execution. +- When no more reduction is possible, "read out" the final state of the machine + as the result of execution. -Intuitively, it is clear that the final states of the -machine are always terms of the form `C n` for some `n`. -We call such terms _values_. +Intuitively, it is clear that the final states of the machine are always terms +of the form `C n` for some `n`. We call such terms _values_. > data Value : Tm -> Type where > V_const : (n : Nat) -> Value (C n) > > Uninhabited (Value (P _ _)) where -> uninhabited V_const impossible +> uninhabited V_const impossible > -Having introduced the idea of values, we can use it in the -definition of the `>>-` relation to write `ST_Plus2` rule in a -slightly more elegant way: +Having introduced the idea of values, we can use it in the definition of the +`>>-` relation to write `ST_Plus2` rule in a slightly more elegant way: \[ @@ -363,13 +343,12 @@ slightly more elegant way: \end{prooftree} \] -Again, the variable names here carry important information: -by convention, `v1` ranges only over values, while `t1` and `t2` -range over arbitrary terms. (Given this convention, the explicit -`value` hypothesis is arguably redundant. We'll keep it for now, -to maintain a close correspondence between the informal and Idris -versions of the rules, but later on we'll drop it in informal -rules for brevity.) +Again, the variable names here carry important information: by convention, `v1` +ranges only over values, while `t1` and `t2` range over arbitrary terms. (Given +this convention, the explicit `value` hypothesis is arguably redundant. We'll +keep it for now, to maintain a close correspondence between the informal and +Idris versions of the rules, but later on we'll drop it in informal rules for +brevity.) Here are the formal rules: @@ -388,33 +367,31 @@ Here are the formal rules: As a sanity check on this change, let's re-verify determinism. -_Proof sketch_: We must show that if `x` steps to both `y1` and -`y2`, then `y1` and `y2` are equal. Consider the final rules used -in the derivations of `step x y1` and `step x y2`. +_Proof sketch_: We must show that if `x` steps to both `y1` and `y2`, then `y1` +and `y2` are equal. Consider the final rules used in the derivations of `step x +y1` and `step x y2`. - If both are `ST_PlusConstConst`, the result is immediate. -- It cannot happen that one is `ST_PlusConstConst` and the other - is `ST_Plus1` or `ST_Plus2`, since this would imply that `x` has - the form `P t1 t2` where both `t1` and `t2` are constants (by - `ST_PlusConstConst`) _and_ one of `t1` or `t2` has the form `P _`. +- It cannot happen that one is `ST_PlusConstConst` and the other is `ST_Plus1` + or `ST_Plus2`, since this would imply that `x` has the form `P t1 t2` where + both `t1` and `t2` are constants (by `ST_PlusConstConst`) _and_ one of `t1` or + `t2` has the form `P _`. -- Similarly, it cannot happen that one is `ST_Plus1` and the other - is `ST_Plus2`, since this would imply that `x` has the form `P - t1 t2` where `t1` both has the form `P t11 t12` and is a - value (hence has the form `C n`). +- Similarly, it cannot happen that one is `ST_Plus1` and the other is + `ST_Plus2`, since this would imply that `x` has the form `P t1 t2` where `t1` + both has the form `P t11 t12` and is a value (hence has the form `C n`). -- The cases when both derivations end with `ST_Plus1` or - `ST_Plus2` follow by the induction hypothesis. +- The cases when both derivations end with `ST_Plus1` or `ST_Plus2` follow by + the induction hypothesis. -Most of this proof is the same as the one above. But to get -maximum benefit from the exercise you should try to write your -formal version from scratch and just use the earlier one if you -get stuck. +Most of this proof is the same as the one above. But to get maximum benefit from +the exercise you should try to write your formal version from scratch and just +use the earlier one if you get stuck. > Uninhabited (Step (C _) _) where > uninhabited ST_PlusConstConst impossible -> uninhabited (ST_Plus1 _) impossible +> uninhabited (ST_Plus1 _) impossible > uninhabited (ST_Plus2 _ _) impossible > > step_deterministic' : deterministic Step @@ -423,32 +400,30 @@ get stuck. $\square$ + === Strong Progress and Normal Forms -The definition of single-step reduction for our toy language -is fairly simple, but for a larger language it would be easy to -forget one of the rules and accidentally create a situation where -some term cannot take a step even though it has not been -completely reduced to a value. The following theorem shows that +The definition of single-step reduction for our toy language is fairly simple, +but for a larger language it would be easy to forget one of the rules and +accidentally create a situation where some term cannot take a step even though +it has not been completely reduced to a value. The following theorem shows that we did not, in fact, make such a mistake here. -_Theorem_ (_Strong Progress_): If `t` is a term, then either `t` -is a value or else there exists a term `t'` such that `t >>- t'`. +_Theorem_ (_Strong Progress_): If `t` is a term, then either `t` is a value or +else there exists a term `t'` such that `t >>- t'`. _Proof_: By induction on `t`. - Suppose `t = C n`. Then `t` is a value. -- Suppose `t = P t1 t2`, where (by the IH) `t1` either is a value - or can step to some `t1'`, and where `t2` is either a value or - can step to some `t2'`. We must show `P t1 t2` is either a value - or steps to some `t'`. +- Suppose `t = P t1 t2`, where (by the IH) `t1` either is a value or can step to +some `t1'`, and where `t2` is either a value or can step to some `t2'`. We must +show `P t1 t2` is either a value or steps to some `t'`. - If `t1` and `t2` are both values, then `t` can take a step, by `ST_PlusConstConst`. - - If `t1` is a value and `t2` can take a step, then so can `t`, - by `ST_Plus2`. + - If `t1` is a value and `t2` can take a step, then so can `t`, by `ST_Plus2`. - If `t1` can take a step, then so can `t`, by `ST_Plus1`. @@ -457,42 +432,41 @@ Or, formally: > strong_progress : (t : Tm) -> Either (Value t) (t' : Tm ** Step t t') > strong_progress (C n) = Left (V_const n) > strong_progress (P (C n) (C n')) = Right (C (n + n') ** ST_PlusConstConst) -> strong_progress (P (C n) (P l r)) = +> strong_progress (P (C n) (P l r)) = > case strong_progress (P l r) of > Right (r' ** prf) => Right (P (C n) r' ** ST_Plus2 (V_const n) prf) > Left (V_const (P _ _)) impossible -> strong_progress (P (P l r) r') = +> strong_progress (P (P l r) r') = > case strong_progress (P l r) of > Right (l' ** prf) => Right (P l' r' ** ST_Plus1 prf) > Left (V_const (P _ _)) impossible > -This important property is called _strong progress_, because -every term either is a value or can "make progress" by stepping to -some other term. (The qualifier "strong" distinguishes it from a -more refined version that we'll see in later chapters, called -just _progress_.) +This important property is called _strong progress_, because every term either +is a value or can "make progress" by stepping to some other term. (The +qualifier "strong" distinguishes it from a more refined version that we'll see +in later chapters, called just _progress_.) -The idea of "making progress" can be extended to tell us something -interesting about values: in this language, values are exactly the -terms that _cannot_ make progress in this sense. +The idea of "making progress" can be extended to tell us something interesting +about values: in this language, values are exactly the terms that _cannot_ make +progress in this sense. -To state this observation formally, let's begin by giving a name -to terms that cannot make progress. We'll call them _normal forms_. +To state this observation formally, let's begin by giving a name to terms that +cannot make progress. We'll call them _normal forms_. > normal_form : {t : Type} -> Relation t -> t -> Type > normal_form r x = Not (x' ** r x x') > -Note that this definition specifies what it is to be a normal form -for an _arbitrary_ relation `R` over an arbitrary set `X`, not -just for the particular single-step reduction relation over terms -that we are interested in at the moment. We'll re-use the same -terminology for talking about other relations later in the course. +Note that this definition specifies what it is to be a normal form for an +_arbitrary_ relation `R` over an arbitrary set `X`, not just for the particular +single-step reduction relation over terms that we are interested in at the +moment. We'll re-use the same terminology for talking about other relations +later in the course. -We can use this terminology to generalize the observation we made -in the strong progress theorem: in this language, normal forms and -values are actually the same thing. +We can use this terminology to generalize the observation we made in the strong +progress theorem: in this language, normal forms and values are actually the +same thing. > value_is_nf : (v : Tm) -> Value v -> normal_form Step v > value_is_nf (C n) prf = \(_ ** step) => uninhabited step @@ -518,22 +492,21 @@ values are actually the same thing. Why is this interesting? -Because `value` is a syntactic concept -- it is defined by looking -at the form of a term -- while `normal_form` is a semantic one -- -it is defined by looking at how the term steps. It is not obvious -that these concepts should coincide! +Because `value` is a syntactic concept -- it is defined by looking at the form +of a term -- while `normal_form` is a semantic one -- it is defined by looking +at how the term steps. It is not obvious that these concepts should coincide! -Indeed, we could easily have written the definitions so that they -would _not_ coincide. +Indeed, we could easily have written the definitions so that they would _not_ +coincide. ==== Exercise: 3 stars, optional (value_not_same_as_normal_form1) -We might, for example, mistakenly define `value` so that it -includes some terms that are not finished reducing. +We might, for example, mistakenly define `value` so that it includes some terms +that are not finished reducing. -(Even if you don't work this exercise and the following ones -in Idris, make sure you can think of an example of such a term.) +(Even if you don't work this exercise and the following ones in Idris, make sure +you can think of an example of such a term.) > data Value' : Tm -> Type where > V_const' : {n : Nat} -> Value' (C n) @@ -563,8 +536,8 @@ $\square$ ==== Exercise: 2 stars, optional (value_not_same_as_normal_form2) -Alternatively, we might mistakenly define `step` so that it -permits something designated as a value to reduce further. +Alternatively, we might mistakenly define `step` so that it permits something +designated as a value to reduce further. > mutual > infixl 6 ->>>- @@ -584,18 +557,18 @@ permits something designated as a value to reduce further. > > value_not_same_as_normal_form''' : (v : Tm ** (Value v, Not (normal_form Step''' v))) > value_not_same_as_normal_form''' = ?value_not_same_as_normal_form_rhs''' +> $\square$ ==== Exercise: 3 stars, optional (value_not_same_as_normal_form3) -Finally, we might define `value` and `step` so that there is some -term that is not a value but that cannot take a step in the `step` -relation. Such terms are said to be _stuck_. In this case this is -caused by a mistake in the semantics, but we will also see -situations where, even in a correct language definition, it makes -sense to allow some terms to be stuck. +Finally, we might define `value` and `step` so that there is some term that is +not a value but that cannot take a step in the `step` relation. Such terms are +said to be _stuck_. In this case this is caused by a mistake in the semantics, +but we will also see situations where, even in a correct language definition, it +makes sense to allow some terms to be stuck. > mutual > infixl 6 ->>- @@ -620,9 +593,9 @@ $\square$ === Additional Exercises -Here is another very simple language whose terms, instead of being -just addition expressions and numbers, are just the booleans true -and false and a conditional expression... +Here is another very simple language whose terms, instead of being just addition +expressions and numbers, are just the booleans true and false and a conditional +expression... > data TmB : Type where > Ttrue : TmB @@ -647,9 +620,8 @@ and false and a conditional expression... ==== Exercise: 1 star (smallstep_bools) -Which of the following propositions are provable? (This is just a -thought exercise, but for an extra challenge feel free to prove -your answers in Idris.) +Which of the following propositions are provable? (This is just a thought +exercise, but for an extra challenge feel free to prove your answers in Idris.) > bool_step_prop1 : Tfalse ->- Tfalse > bool_step_prop1 = ?bool_step_prop1_rhs @@ -681,8 +653,8 @@ $\square$ ==== Exercise: 3 stars, optional (progress_bool) -Just as we proved a progress theorem for plus expressions, we can -do so for boolean expressions, as well. +Just as we proved a progress theorem for plus expressions, we can do so for +boolean expressions, as well. > strong_progressB : (t : TmB) -> Either (ValueB t) (t': TmB ** t ->- t') > strong_progressB t = ?strong_progressB_rhs @@ -698,25 +670,23 @@ do so for boolean expressions, as well. ==== Exercise: 2 stars (smallstep_bool_shortcut) -Suppose we want to add a "short circuit" to the step relation for -boolean expressions, so that it can recognize when the `then` and -`else` branches of a conditional are the same value (either -`ttrue` or `tfalse`) and reduce the whole conditional to this -value in a single step, even if the guard has not yet been reduced -to a value. For example, we would like this proposition to be -provable: +Suppose we want to add a "short circuit" to the step relation for boolean +expressions, so that it can recognize when the `then` and `else` branches of a +conditional are the same value (either `Ttrue` or `Tfalse`) and reduce the whole +conditional to this value in a single step, even if the guard has not yet been +reduced to a value. For example, we would like this proposition to be provable: ```idris - tif - (tif ttrue ttrue ttrue) - tfalse - tfalse + Tif + (Tif Ttrue Ttrue Ttrue) + Tfalse + Tfalse ->> - tfalse. + Tfalse ``` -Write an extra clause for the step relation that achieves this -effect and prove `bool_step_prop4`. +Write an extra clause for the step relation that achieves this effect and prove +`bool_step_prop4`. > mutual > infixl 6 ->-> @@ -737,7 +707,7 @@ effect and prove `bool_step_prop4`. > Tfalse > ->-> > Tfalse -> +> > bool_step_prop4_holds : Smallstep.bool_step_prop4 > bool_step_prop4_holds = ?bool_step_prop4_holds_rhs > @@ -747,69 +717,64 @@ $\square$ ==== Exercise: 3 stars, optional (properties_of_altered_step) -It can be shown that the determinism and strong progress theorems -for the step relation in the lecture notes also hold for the -definition of step given above. After we add the clause -`ST_ShortCircuit`... +It can be shown that the determinism and strong progress theorems for the step +relation in the lecture notes also hold for the definition of step given above. +After we add the clause `ST_ShortCircuit`... -- Is the `step` relation still deterministic? Write yes or no and - briefly (1 sentence) explain your answer. +- Is the `step` relation still deterministic? Write yes or no and briefly (1 + sentence) explain your answer. Optional: prove your answer correct in Idris. -- Does a strong progress theorem hold? Write yes or no and - briefly (1 sentence) explain your answer. +- Does a strong progress theorem hold? Write yes or no and briefly (1 sentence) + explain your answer. Optional: prove your answer correct in Idris. -In general, is there any way we could cause strong progress to -fail if we took away one or more constructors from the original -step relation? Write yes or no and briefly (1 sentence) explain -your answer. +In general, is there any way we could cause strong progress to fail if we took +away one or more constructors from the original step relation? Write yes or no +and briefly (1 sentence) explain your answer. $\square$ == Multi-Step Reduction -We've been working so far with the _single-step reduction_ -relation `->>`, which formalizes the individual steps of an -abstract machine for executing programs. +We've been working so far with the _single-step reduction_ relation `->>`, which +formalizes the individual steps of an abstract machine for executing programs. -We can use the same machine to reduce programs to completion -- to -find out what final result they yield. This can be formalized as -follows: +We can use the same machine to reduce programs to completion -- to find out what +final result they yield. This can be formalized as follows: -- First, we define a _multi-step reduction relation_ `->>*`, which - relates terms `t` and `t'` if `t` can reach `t'` by any number - (including zero) of single reduction steps. +- First, we define a _multi-step reduction relation_ `->>*`, which relates terms + `t` and `t'` if `t` can reach `t'` by any number (including zero) of single + reduction steps. -- Then we define a "result" of a term `t` as a normal form that - `t` can reach by multi-step reduction. +- Then we define a "result" of a term `t` as a normal form that `t` can reach by + multi-step reduction. -Since we'll want to reuse the idea of multi-step reduction many -times, let's take a little extra trouble and define it -generically. +Since we'll want to reuse the idea of multi-step reduction many times, let's +take a little extra trouble and define it generically. -Given a relation `r`, we define a relation `Multi r`, called the -_multi-step closure of `r`_ as follows. +Given a relation `r`, we define a relation `Multi r`, called the _multi-step +closure of `r`_ as follows. -> data Multi: {t : Type} -> (r : Relation t) -> Relation t where +> data Multi : {t : Type} -> (r : Relation t) -> Relation t where > Multi_refl : {x : t} -> Multi r x x > Multi_step : {x, y, z : t} -> -> r x y -> Multi r y z -> Multi r x z -> +> r x y -> Multi r y z -> Multi r x z +> > infixl 6 ->>* > (->>*) : Tm -> Tm -> Type > (->>*) = Multi Step > (In the `Rel` chapter of _Logical Foundations_ this relation is called -`clos_refl_trans_1n`. We give it a shorter name here for the sake -of readability.) +`clos_refl_trans_1n`. We give it a shorter name here for the sake of +readability.) -The effect of this definition is that `Multi r` relates two -elements `x` and `y` if +The effect of this definition is that `Multi r` relates two elements `x` and `y` +if - `x = y`, or - `r x y`, or @@ -820,25 +785,23 @@ elements `x` and `y` if ... r zn y. -Thus, if `r` describes a single-step of computation, then `z1`...`zn` -is the sequence of intermediate steps of computation between `x` and -`y`. +Thus, if `r` describes a single-step of computation, then `z1`...`zn` is the +sequence of intermediate steps of computation between `x` and `y`. We write `->>*` for the `Multi Step` relation on terms. The relation `Multi r` has several crucial properties. -First, it is obviously _reflexive_ (that is, `forall x, Multi r x -x`). In the case of the `->>*` (i.e., `Multi Step`) relation, the -intuition is that a term can execute to itself by taking zero -steps of execution. +First, it is obviously _reflexive_ (that is, `forall x, Multi r x x`). In the +case of the `->>*` (i.e., `Multi Step`) relation, the intuition is that a term +can execute to itself by taking zero steps of execution. -Second, it contains `r` -- that is, single-step executions are a -particular case of multi-step executions. (It is this fact that -justifies the word "closure" in the term "multi-step closure of -`r`.") +Second, it contains `r` -- that is, single-step executions are a particular case +of multi-step executions. (It is this fact that justifies the word "closure" in +the term "multi-step closure of `r`.") -> multi_R : {t : Type} -> {r : Relation t} -> (x, y : t) -> r x y -> (Multi r) x y +> multi_R : {t : Type} -> {r : Relation t} +> -> (x, y : t) -> r x y -> (Multi r) x y > multi_R x y h = Multi_step h (Multi_refl) > @@ -848,12 +811,12 @@ Third, `multi R` is _transitive_. > Multi r x y -> Multi r y z -> Multi r x z > multi_trans Multi_refl m2 = m2 > multi_trans (Multi_step r mx) m2 = -> let indHyp = multi_trans mx m2 in +> let indHyp = multi_trans mx m2 in > Multi_step r indHyp > -In particular, for the `Multi Step` relation on terms, if -`t1->>*t2` and `t2->>*t3`, then `t1->>*t3`. +In particular, for the `Multi Step` relation on terms, if `t1->>*t2` and +`t2->>*t3`, then `t1->>*t3`. === Examples @@ -869,8 +832,8 @@ Here's a specific instance of the `Multi Step` relation: > test_multistep_1 = > Multi_step {y=P (C (0 + 3)) (P (C 2) (C 4))} (ST_Plus1 ST_PlusConstConst) > (Multi_step {y=P (C (0 + 3)) (C (2 + 4))} (ST_Plus2 (V_const 3) ST_PlusConstConst) -> (Multi_step ST_PlusConstConst Multi_refl)) -> +> (Multi_step ST_PlusConstConst Multi_refl)) +> In fact, Idris can infer all implicits itself here: @@ -883,7 +846,7 @@ In fact, Idris can infer all implicits itself here: > test_multistep_1' = > Multi_step (ST_Plus1 ST_PlusConstConst) > (Multi_step (ST_Plus2 (V_const 3) ST_PlusConstConst) -> (Multi_step ST_PlusConstConst Multi_refl)) +> (Multi_step ST_PlusConstConst Multi_refl)) > @@ -902,6 +865,7 @@ $\square$ > ->>* > P (C 0) (C 3) > test_multistep_3 = ?test_multistep_3_rhs +> $\square$ @@ -919,14 +883,15 @@ $\square$ > (C 0) > (C (2 + (0 + 3))) > test_multistep_4 = ?test_multistep_4_rhs +> $\square$ === Normal Forms Again -If `t` reduces to `t'` in zero or more steps and `t'` is a -normal form, we say that "`t'` is a normal form of `t`." +If `t` reduces to `t'` in zero or more steps and `t'` is a normal form, we say +that "`t'` is a normal form of `t`." > step_normal_form : (t : Tm) -> Type > step_normal_form = normal_form Step @@ -936,16 +901,15 @@ normal form, we say that "`t'` is a normal form of `t`." > We have already seen that, for our language, single-step reduction is -deterministic -- i.e., a given term can take a single step in -at most one way. It follows from this that, if `t` can reach -a normal form, then this normal form is unique. In other words, we -can actually pronounce `normal_form t t'` as "`t'` is _the_ -normal form of `t`." +deterministic -- i.e., a given term can take a single step in at most one way. +It follows from this that, if `t` can reach a normal form, then this normal form +is unique. In other words, we can actually pronounce `normal_form t t'` as +"`t'` is _the_ normal form of `t`." ==== Exercise: 3 stars, optional (normal_forms_unique) -\todo[inline]{The result will likely not pass the totality checker, as it +\todo[inline]{The result will likely not pass the totality checker, as it currently has trouble looking under tuples, just use `assert_total`} > normal_forms_unique : deterministic Smallstep.normal_form_of @@ -954,11 +918,10 @@ currently has trouble looking under tuples, just use `assert_total`} $\square$ -Indeed, something stronger is true for this language (though not -for all languages): the reduction of _any_ term `t` will -eventually reach a normal form -- i.e., `normal_form_of` is a -_total_ function. Formally, we say the `step` relation is -_normalizing_. +Indeed, something stronger is true for this language (though not for all +languages): the reduction of _any_ term `t` will eventually reach a normal form +-- i.e., `normal_form_of` is a _total_ function. Formally, we say the `step` +relation is _normalizing_. > normalizing : {x : Type} -> (r : Relation x) -> Type > normalizing {x} {r} = (t : x) -> (t' : x ** (Multi r t t', normal_form r t')) @@ -966,16 +929,15 @@ _normalizing_. To prove that `step` is normalizing, we need a couple of lemmas. -First, we observe that, if `t` reduces to `t'` in many steps, then -the same sequence of reduction steps within `t` is also possible -when `t` appears as the left-hand child of a `P` node, and -similarly when `t` appears as the right-hand child of a `P` -node whose left-hand child is a value. +First, we observe that, if `t` reduces to `t'` in many steps, then the same +sequence of reduction steps within `t` is also possible when `t` appears as the +left-hand child of a `P` node, and similarly when `t` appears as the right-hand +child of a `P` node whose left-hand child is a value. > multistep_congr_1 : (t1 ->>* t1') -> ((P t1 t2) ->>* P t1' t2) > multistep_congr_1 Multi_refl = Multi_refl > multistep_congr_1 (Multi_step step mult') = -> let indHyp = multistep_congr_1 mult' in +> let indHyp = multistep_congr_1 mult' in > Multi_step (ST_Plus1 step) indHyp > @@ -988,62 +950,56 @@ node whose left-hand child is a value. $\square$ -With these lemmas in hand, the main proof is a straightforward -induction. +With these lemmas in hand, the main proof is a straightforward induction. -_Theorem_: The `step` function is normalizing -- i.e., for every -`t` there exists some `t'` such that `t` steps to `t'` and `t'` is -a normal form. +_Theorem_: The `step` function is normalizing -- i.e., for every `t` there +exists some `t'` such that `t` steps to `t'` and `t'` is a normal form. -_Proof sketch_: By induction on terms. There are two cases to -consider: +_Proof sketch_: By induction on terms. There are two cases to consider: -- `t = C n` for some `n`. Here `t` doesn't take a step, and we - have `t' = t`. We can derive the left-hand side by reflexivity - and the right-hand side by observing (a) that values are normal - forms (by `nf_same_as_value`) and (b) that `t` is a value (by - `v_const`). +- `t = C n` for some `n`. Here `t` doesn't take a step, and we have `t' = t`. + We can derive the left-hand side by reflexivity and the right-hand side by + observing (a) that values are normal forms (by `nf_same_as_value`) and (b) + that `t` is a value (by `v_const`). -- `t = P t1 t2` for some `t1` and `t2`. By the IH, `t1` and `t2` - have normal forms `t1'` and `t2'`. Recall that normal forms are - values (by `nf_same_as_value`); we know that `t1' = C n1` and - `t2' = C n2`, for some `n1` and `n2`. We can combine the `->>*` - derivations for `t1` and `t2` using `multi_congr_1` and - `multi_congr_2` to prove that `P t1 t2` reduces in many steps to - `C (n1 + n2)`. +- `t = P t1 t2` for some `t1` and `t2`. By the IH, `t1` and `t2` have normal + forms `t1'` and `t2'`. Recall that normal forms are values (by + `nf_same_as_value`); we know that `t1' = C n1` and `t2' = C n2`, for some `n1` + and `n2`. We can combine the `->>*` derivations for `t1` and `t2` using + `multi_congr_1` and `multi_congr_2` to prove that `P t1 t2` reduces in many + steps to `C (n1 + n2)`. - It is clear that our choice of `t' = C (n1 + n2)` is a value, - which is in turn a normal form. `` *) +It is clear that our choice of `t' = C (n1 + n2)` is a value, which is in turn a +normal form. > step_normalizing : normalizing Step > step_normalizing (C n) = (C n ** (Multi_refl, \(_**sc) => uninhabited sc)) -> step_normalizing (P l r) = -> let +> step_normalizing (P l r) = +> let > (_ ** (ih1l,ih1r)) = step_normalizing l > (_ ** (ih2l,ih2r)) = step_normalizing r > V_const n1 = (fst nf_same_as_value) ih1r > V_const n2 = (fst nf_same_as_value) ih2r -> reduction : ((P l r) ->>* (C (n1 + n2))) = -> multi_trans {y=P (C n1) r} +> reduction : ((P l r) ->>* (C (n1 + n2))) = +> multi_trans {y=P (C n1) r} > (multistep_congr_1 ih1l) > (multi_trans {y=P (C n1) (C n2)} > (multistep_congr_2 {v=V_const n1} ih2l) > (Multi_step ST_PlusConstConst Multi_refl) > ) -> normal_form : Not (t : Tm ** Step (C (n1 + n2)) t) = +> normal_form : Not (t : Tm ** Step (C (n1 + n2)) t) = > (snd nf_same_as_value) (V_const (n1 + n2)) -> in +> in > (C (n1 + n2) ** (reduction, normal_form)) > === Equivalence of Big-Step and Small-Step -Having defined the operational semantics of our tiny programming -language in two different ways (big-step and small-step), it makes -sense to ask whether these definitions actually define the same -thing! They do, though it takes a little work to show it. The -details are left as an exercise. +Having defined the operational semantics of our tiny programming language in two +different ways (big-step and small-step), it makes sense to ask whether these +definitions actually define the same thing! They do, though it takes a little +work to show it. The details are left as an exercise. ==== Exercise: 3 stars (eval__multistep) @@ -1066,23 +1022,22 @@ The key ideas in the proof can be seen in the following picture: C (n1 + n2) ``` -That is, the multistep reduction of a term of the form `P t1 t2` -proceeds in three phases: +That is, the multistep reduction of a term of the form `P t1 t2` proceeds in +three phases: -- First, we use `ST_Plus1` some number of times to reduce `t1` - to a normal form, which must (by `nf_same_as_value`) be a - term of the form `C n1` for some `n1`. -- Next, we use `ST_Plus2` some number of times to reduce `t2` - to a normal form, which must again be a term of the form `C - n2` for some `n2`. -- Finally, we use `ST_PlusConstConst` one time to reduce `P (C - n1) (C n2)` to `C (n1 + n2)`. +- First, we use `ST_Plus1` some number of times to reduce `t1` to a normal form, + which must (by `nf_same_as_value`) be a term of the form `C n1` for some `n1`. -To formalize this intuition, you'll need to use the congruence -lemmas from above (you might want to review them now, so that -you'll be able to recognize when they are useful), plus some basic -properties of `->>*`: that it is reflexive, transitive, and -includes `->>`. +- Next, we use `ST_Plus2` some number of times to reduce `t2` to a normal form, + which must again be a term of the form `C n2` for some `n2`. + +- Finally, we use `ST_PlusConstConst` one time to reduce `P (C n1) (C n2)` to `C + (n1 + n2)`. + +To formalize this intuition, you'll need to use the congruence lemmas from above +(you might want to review them now, so that you'll be able to recognize when +they are useful), plus some basic properties of `->>*`: that it is reflexive, +transitive, and includes `->>`. > eval__multistep hyp = ?eval__multistep_rhs @@ -1093,8 +1048,9 @@ Write a detailed informal version of the proof of `eval__multistep` $\square$ -For the other direction, we need one lemma, which establishes a -relation between single-step reduction and big-step evaluation. +For the other direction, we need one lemma, which establishes a relation between +single-step reduction and big-step evaluation. + ==== Exercise: 3 stars (step__eval) @@ -1107,42 +1063,49 @@ relation between single-step reduction and big-step evaluation. $\square$ -The fact that small-step reduction implies big-step evaluation is -now straightforward to prove, once it is stated correctly. +The fact that small-step reduction implies big-step evaluation is now +straightforward to prove, once it is stated correctly. + +The proof proceeds by induction on the multi-step reduction sequence that is +buried in the hypothesis `normal_form_of t t'`. -The proof proceeds by induction on the multi-step reduction -sequence that is buried in the hypothesis `normal_form_of t t'`. +Make sure you understand the statement before you start to work on the proof. -Make sure you understand the statement before you start to -work on the proof. ==== Exercise: 3 stars (multistep__eval) -> multistep__eval : {t, t': Tm} -> +\todo[inline]{The proof will likely not pass the totality checker, use +`assert_total`} + +> multistep__eval : {t, t' : Tm} -> > normal_form_of t t' -> (n : Nat ** (t' = C n, t >>> n)) > multistep__eval hyp = ?multistep__eval_rhs +> $\square$ + === Additional Exercises + ==== Exercise: 3 stars, optional (interp_tm) -Remember that we also defined big-step evaluation of terms as a -function `evalF`. Prove that it is equivalent to the existing -semantics. (Hint: we just proved that `eval` and `multistep` are -equivalent, so logically it doesn't matter which you choose. -One will be easier than the other, though!) +Remember that we also defined big-step evaluation of terms as a function +`evalF`. Prove that it is equivalent to the existing semantics. (Hint: we just +proved that `Eval` and `Multi Step` are equivalent, so logically it doesn't +matter which you choose. One will be easier than the other, though!) -> evalF_eval : {t: Tm} -> {n: Nat} -> ((evalF t = n) <-> (t >>> n)) +> evalF_eval : {t : Tm} -> {n : Nat} -> ((evalF t = n) <-> (t >>> n)) > evalF_eval = ?evalF_eval_rhs +> $\square$ + ==== Exercise: 4 stars (combined_properties) -We've considered arithmetic and conditional expressions -separately. This exercise explores how the two interact. +We've considered arithmetic and conditional expressions separately. This +exercise explores how the two interact. > data TmC : Type where > CC : Nat -> TmC @@ -1150,12 +1113,12 @@ separately. This exercise explores how the two interact. > TtrueC : TmC > TfalseC : TmC > TifC : TmC -> TmC -> TmC -> TmC - +> > data ValueC : TmC -> Type where -> V_constC : {n: Nat} -> ValueC (CC n) +> V_constC : {n : Nat} -> ValueC (CC n) > V_trueC : ValueC TtrueC > V_falseC : ValueC TfalseC - +> > mutual > infixl 6 >>-> > (>>->) : TmC -> TmC -> Type @@ -1168,197 +1131,117 @@ separately. This exercise explores how the two interact. > ST_IfTrueC : TifC TtrueC t1 t2 >>-> t1 > ST_IfFalseC : TifC TfalseC t1 t2 >>-> t2 > ST_IfC : t1 >>-> t1' -> TifC t1 t2 t3 >>-> TifC t1' t2 t3 - +> Earlier, we separately proved for both plus- and if-expressions... - that the step relation was deterministic, and -- a strong progress lemma, stating that every term is either a - value or can take a step. +- a strong progress lemma, stating that every term is either a value or can take +a step. -Formally prove or disprove these two properties for the combined -language. (That is, state a theorem saying that the property -holds or does not hold, and prove your theorem.) +Formally prove or disprove these two properties for the combined language. (That +is, state a theorem saying that the property holds or does not hold, and prove +your theorem.) $\square$ - +$\square$ From 0b0214d2182eabb01dbc207e332f5ee7c58fbc52 Mon Sep 17 00:00:00 2001 From: Alex Gryzlov Date: Tue, 27 Nov 2018 19:49:01 +0200 Subject: [PATCH 28/30] add small-step Imp & concurrent Imp --- src/Smallstep.lidr | 375 ++++++++++++++++++++++----------------------- 1 file changed, 182 insertions(+), 193 deletions(-) diff --git a/src/Smallstep.lidr b/src/Smallstep.lidr index cf9821c..d8a03df 100644 --- a/src/Smallstep.lidr +++ b/src/Smallstep.lidr @@ -4,6 +4,9 @@ > module Smallstep > +> import Maps +> import Imp +> > %hide Language.Reflection.P > > %access public export @@ -1157,42 +1160,42 @@ straightforward extensions of the tiny language we've been working up to now. To make them easier to read, we introduce the symbolic notations `->>a` and `->>b` for the arithmetic and boolean step relations. - data AVal : AExp -> Type where - Av_num : AVal (ANum n) - +> data AVal : AExp -> Type where +> Av_num : AVal (ANum n) +> We are not actually going to bother to define boolean values, since they aren't needed in the definition of `->>b` below (why?), though they might be if our language were a bit larger (why?). - data AStep : AExp -> State -> AExp -> Type where - AS_Id : AStep (AId i) st (ANum (st i)) - AS_Plus : AStep (APlus (ANum n1) (ANum n2)) st (ANum (n1 + n2)) - AS_Plus1 : AStep a1 st a1' -> AStep (APlus a1 a2) st (APlus a1' a2) - AS_Plus2 : AVal v1 -> AStep a2 st a2' -> AStep (APlus v1 a2) st (APlus v1 a2') - AS_Minus : AStep (AMinus (ANum n1) (ANum n2)) st (ANum (minus n1 n2)) - AS_Minus1 : AStep a1 st a1' -> AStep (AMinus a1 a2) st (AMinus a1' a2) - AS_Minus2 : AVal v1 -> AStep a2 st a2' -> AStep (AMinus v1 a2) st (AMinus v1 a2') - AS_Mult : AStep (AMult (ANum n1) (ANum n2)) st (ANum (mult n1 n2)) - AS_Mult1 : AStep a1 st a1' -> AStep (AMult a1 a2) st (AMult a1' a2) - AS_Mult2 : AVal v1 -> AStep a2 st a2' -> AStep (AMult v1 a2) st (AMult v1 a2') - - data BStep : BExp -> State -> BExp -> Type where - BS_Eq : BStep (BEq (ANum n1) (ANum n2)) st (if (n1==n2) then BTrue else BFalse) - BS_Eq1 : AStep a1 st a1' -> BStep (BEq a1 a2) st (BEq a1' a2) - BS_Eq2 : AVal v1 -> AStep a2 st a2' -> BStep (BEq v1 a2) st (BEq v1 a2') - BS_LtEq : BStep (BLe (ANum n1) (ANum n2)) st (if (n1<=n2) then BTrue else BFalse) - BS_LtEq1 : AStep a1 st a1' -> BStep (BLe a1 a2) st (BLe a1' a2) - BS_LtEq2 : AVal v1 -> AStep a2 st a2' -> BStep (BLe v1 a2) st (BLe v1 a2') - BS_NotTrue : BStep (BNot BTrue) st BFalse - BS_NotFalse : BStep (BNot BFalse) st BTrue - BS_NotStep : BStep b1 st b1' -> BStep (BNot b1) st (BNot b1') - BS_AndTrueTrue : BStep (BAnd BTrue BTrue) st BTrue - BS_AndTrueFalse : BStep (BAnd BTrue BFalse) st BFalse - BS_AndFalse : BStep (BAnd BFalse b2) st BFalse - BS_AndTrueStep : BStep b2 st b2' -> BStep (BAnd BTrue b2) st (BAnd BTrue b2') - BS_AndStep : BStep b1 st b1' -> BStep (BAnd b1 b2) st (BAnd b1' b2) - +> data AStep : AExp -> State -> AExp -> Type where +> AS_Id : AStep (AId i) st (ANum (st i)) +> AS_Plus : AStep (APlus (ANum n1) (ANum n2)) st (ANum (n1 + n2)) +> AS_Plus1 : AStep a1 st a1' -> AStep (APlus a1 a2) st (APlus a1' a2) +> AS_Plus2 : AVal v1 -> AStep a2 st a2' -> AStep (APlus v1 a2) st (APlus v1 a2') +> AS_Minus : AStep (AMinus (ANum n1) (ANum n2)) st (ANum (minus n1 n2)) +> AS_Minus1 : AStep a1 st a1' -> AStep (AMinus a1 a2) st (AMinus a1' a2) +> AS_Minus2 : AVal v1 -> AStep a2 st a2' -> AStep (AMinus v1 a2) st (AMinus v1 a2') +> AS_Mult : AStep (AMult (ANum n1) (ANum n2)) st (ANum (mult n1 n2)) +> AS_Mult1 : AStep a1 st a1' -> AStep (AMult a1 a2) st (AMult a1' a2) +> AS_Mult2 : AVal v1 -> AStep a2 st a2' -> AStep (AMult v1 a2) st (AMult v1 a2') +> +> data BStep : BExp -> State -> BExp -> Type where +> BS_Eq : BStep (BEq (ANum n1) (ANum n2)) st (if (n1==n2) then BTrue else BFalse) +> BS_Eq1 : AStep a1 st a1' -> BStep (BEq a1 a2) st (BEq a1' a2) +> BS_Eq2 : AVal v1 -> AStep a2 st a2' -> BStep (BEq v1 a2) st (BEq v1 a2') +> BS_LtEq : BStep (BLe (ANum n1) (ANum n2)) st (if (n1<=n2) then BTrue else BFalse) +> BS_LtEq1 : AStep a1 st a1' -> BStep (BLe a1 a2) st (BLe a1' a2) +> BS_LtEq2 : AVal v1 -> AStep a2 st a2' -> BStep (BLe v1 a2) st (BLe v1 a2') +> BS_NotTrue : BStep (BNot BTrue) st BFalse +> BS_NotFalse : BStep (BNot BFalse) st BTrue +> BS_NotStep : BStep b1 st b1' -> BStep (BNot b1) st (BNot b1') +> BS_AndTrueTrue : BStep (BAnd BTrue BTrue) st BTrue +> BS_AndTrueFalse : BStep (BAnd BTrue BFalse) st BFalse +> BS_AndFalse : BStep (BAnd BFalse b2) st BFalse +> BS_AndTrueStep : BStep b2 st b2' -> BStep (BAnd BTrue b2) st (BAnd BTrue b2') +> BS_AndStep : BStep b1 st b1' -> BStep (BAnd b1 b2) st (BAnd b1' b2) +> The semantics of commands is the interesting part. We need two small tricks to make it work: @@ -1213,16 +1216,24 @@ make it work: share the feature that the original `WHILE` command needs to be saved somewhere while a single copy of the loop body is being reduced.) - data CStep : Com -> State -> Com -> State -> Type where - CS_AssStep : AStep a st a' -> CStep (CAss i a) st (CAss i a') st - CS_Ass : CStep (CAss i (ANum n)) st CSkip (t_update i n st) - CS_SeqStep : CStep c1 st c1' st' -> CStep (CSeq c1 c2) st (CSeq c1' c2) st' - CS_SeqFinish : CStep (CSeq CSkip c2) st c2 st - CS_IfTrue : CStep (CIf BTrue c1 c2) st c1 st - CS_IfFalse : CStep (CIf BFalse c1 c2) st c2 st - CS_IfStep : BStep b st b' -> CStep (CIf b c1 c2) st (CIf b' c1 c2) st - CS_While : CStep (CWhile b c1) st (CIf b (CSeq c1 (CWhile b c1)) CSkip) st - +> data CStep : (Com, State) -> (Com, State) -> Type where +> CS_AssStep : AStep a st a' -> CStep (CAss i a , st) +> (CAss i a', st) +> CS_Ass : CStep (CAss i (ANum n), st ) +> (CSkip , t_update i n st) +> CS_SeqStep : CStep (c1, st) (c1', st') -> CStep (CSeq c1 c2, st ) +> (CSeq c1' c2, st') +> CS_SeqFinish : CStep (CSeq CSkip c2, st) +> (c2 , st) +> CS_IfTrue : CStep (CIf BTrue c1 c2, st) +> (c1 , st) +> CS_IfFalse : CStep (CIf BFalse c1 c2, st) +> (c2 , st) +> CS_IfStep : BStep b st b' -> CStep (CIf b c1 c2, st) +> (CIf b' c1 c2, st) +> CS_While : CStep (CWhile b c1 , st) +> (CIf b (CSeq c1 (CWhile b c1)) CSkip, st) +> == Concurrent Imp @@ -1233,185 +1244,163 @@ both have terminated. To reflect the unpredictability of scheduling, the actions of the subcommands may be interleaved in any order, but they share the same memory and can communicate by reading and writing the same variables. - data ComC : Type where - CSkipC : ComC - CAssC : Id -> AExp -> ComC - CSeqC : ComC -> ComC -> ComC - CIfC : BExp -> ComC -> ComC -> ComC - CWhileC : BExp -> ComC -> ComC - -- New: - CParC : ComC -> ComC -> ComC - - -Notation "'SKIP'" := - CSkip. -Notation "x '::=' a" := - (CAss x a) (at level 60). -Notation "c1 ;; c2" := - (CSeq c1 c2) (at level 80, right associativity). -Notation "'WHILE' b 'DO' c 'END'" := - (CWhile b c) (at level 80, right associativity). -Notation "'IFB' b 'THEN' c1 'ELSE' c2 'FI'" := - (CIf b c1 c2) (at level 80, right associativity). -Notation "'PAR' c1 'WITH' c2 'END'" := - (CPar c1 c2) (at level 80, right associativity). - - data CStepC : ComC -> State -> ComC -> State -> Type where - -- Old part - CS_AssStepC : AStep a st a' -> CStepC (CAssC i a) st (CAssC i a') st - CS_AssC : CStepC (CAssC i (ANum n)) st CSkipC (t_update i n st) - CS_SeqStepC : CStepC c1 st c1' st' -> CStepC (CSeqC c1 c2) st (CSeqC c1' c2) st' - CS_SeqFinishC : CStepC (CSeqC CSkipC c2) st c2 st - CS_IfTrueC : CStepC (CIfC BTrue c1 c2) st c1 st - CS_IfFalseC : CStepC (CIfC BFalse c1 c2) st c2 st - CS_IfStepC : BStep b st b' -> CStepC (CIfC b c1 c2) st (CIfC b' c1 c2) st - CS_WhileC : CStepC (CWhileC b c1) st (CIfC b (CSeqC c1 (CWhileC b c1)) CSkipC) st - -- New part: - CS_Par1 : CStepC c1 st c1' st' -> CStepC (CParC c1 c2) st (CParC c1' c2) st' - CS_Par2 : CStepC c2 st c2' st' -> CStepC (CParC c1 c2) st (CParC c1 c2') st' - CS_ParDone : CStepC (CParC CSkipC CSkipC) st CSkipC st - - -CMultistep : Type -CMultistep = Multi CStepC - -Notation " t '/' st '->>*' t' '/' st' " := - (multi cstep (t,st) (t',st')) - (at level 40, st at level 39, t' at level 39). +> data ComC : Type where +> CSkipC : ComC +> CAssC : Id -> AExp -> ComC +> CSeqC : ComC -> ComC -> ComC +> CIfC : BExp -> ComC -> ComC -> ComC +> CWhileC : BExp -> ComC -> ComC +> -- New: +> CParC : ComC -> ComC -> ComC +> + +\todo[inline]{Add syntax sugar} + +> data CStepC : (ComC, State) -> (ComC, State) -> Type where +> -- Old part +> CS_AssStepC : AStep a st a' -> CStepC (CAssC i a , st) +> (CAssC i a', st) +> CS_AssC : CStepC (CAssC i (ANum n), st) +> (CSkipC , t_update i n st) +> CS_SeqStepC : CStepC (c1, st) (c1', st') -> CStepC (CSeqC c1 c2, st ) +> (CSeqC c1' c2, st') +> CS_SeqFinishC : CStepC (CSeqC CSkipC c2, st) +> (c2 , st) +> CS_IfTrueC : CStepC (CIfC BTrue c1 c2, st) +> (c1 , st) +> CS_IfFalseC : CStepC (CIfC BFalse c1 c2, st) +> (c2 , st) +> CS_IfStepC : BStep b st b' -> CStepC (CIfC b c1 c2, st) +> (CIfC b' c1 c2, st) +> CS_WhileC : CStepC (CWhileC b c1 , st) +> (CIfC b (CSeqC c1 (CWhileC b c1)) CSkipC, st) +> -- New part: +> CS_Par1 : CStepC (c1, st) (c1', st') -> CStepC (CParC c1 c2, st ) +> (CParC c1' c2, st') +> CS_Par2 : CStepC (c2, st) (c2', st') -> CStepC (CParC c1 c2 , st ) +> (CParC c1 c2', st') +> CS_ParDone : CStepC (CParC CSkipC CSkipC, st) +> (CSkipC , st) +> +> MultiCStepC : (ComC, State) -> (ComC, State) -> Type +> MultiCStepC = Multi CStepC +> Among the many interesting properties of this language is the fact that the following program can terminate with the variable `X` set to any value - par_loop : ComC - par_loop = CParC - (CAssC Y (ANum 1)) - (CWhileC - (BEq (AId Y) (ANum 0)) - (CAssC X (APlus (AId X) (ANum 1))) - ) +> par_loop : ComC +> par_loop = CParC +> (CAssC Y (ANum 1)) +> (CWhileC +> (BEq (AId Y) (ANum 0)) +> (CAssC X (APlus (AId X) (ANum 1))) +> ) +> In particular, it can terminate with `X` set to `0`: -Example par_loop_example_0: - exists st', - par_loop / { ==> 0 } ->>* SKIP / st' - /\ st' X = 0. -Proof. - eapply ex_intro. split. - unfold par_loop. - eapply multi_step. apply CS_Par1. - apply CS_Ass. - eapply multi_step. apply CS_Par2. apply CS_While. - eapply multi_step. apply CS_Par2. apply CS_IfStep. - apply BS_Eq1. apply AS_Id. - eapply multi_step. apply CS_Par2. apply CS_IfStep. - apply BS_Eq. simpl. - eapply multi_step. apply CS_Par2. apply CS_IfFalse. - eapply multi_step. apply CS_ParDone. - eapply multi_refl. - reflexivity. Qed. +> par_loop_example_0 : (st' ** ( MultiCStepC (Smallstep.par_loop, Imp.empty_state) (CSkipC, st') +> , st' X = 0 +> )) +> par_loop_example_0 = +> (t_update Y 1 (t_empty 0) ** +> ( +> Multi_step (CS_Par1 CS_AssC) $ +> Multi_step (CS_Par2 CS_WhileC) $ +> Multi_step (CS_Par2 $ CS_IfStepC $ BS_Eq1 AS_Id) $ +> Multi_step (CS_Par2 $ CS_IfStepC $ BS_Eq) $ +> Multi_step (CS_Par2 $ CS_IfFalseC) $ +> Multi_step CS_ParDone $ +> Multi_refl +> +> , Refl +> ) +> ) +> It can also terminate with `X` set to `2`: -Example par_loop_example_2: - exists st', - par_loop / { ==> 0 } ->>* SKIP / st' - /\ st' X = 2. -Proof. - eapply ex_intro. split. - eapply multi_step. apply CS_Par2. apply CS_While. - eapply multi_step. apply CS_Par2. apply CS_IfStep. - apply BS_Eq1. apply AS_Id. - eapply multi_step. apply CS_Par2. apply CS_IfStep. - apply BS_Eq. simpl. - eapply multi_step. apply CS_Par2. apply CS_IfTrue. - eapply multi_step. apply CS_Par2. apply CS_SeqStep. - apply CS_AssStep. apply AS_Plus1. apply AS_Id. - eapply multi_step. apply CS_Par2. apply CS_SeqStep. - apply CS_AssStep. apply AS_Plus. - eapply multi_step. apply CS_Par2. apply CS_SeqStep. - apply CS_Ass. - eapply multi_step. apply CS_Par2. apply CS_SeqFinish. - - eapply multi_step. apply CS_Par2. apply CS_While. - eapply multi_step. apply CS_Par2. apply CS_IfStep. - apply BS_Eq1. apply AS_Id. - eapply multi_step. apply CS_Par2. apply CS_IfStep. - apply BS_Eq. simpl. - eapply multi_step. apply CS_Par2. apply CS_IfTrue. - eapply multi_step. apply CS_Par2. apply CS_SeqStep. - apply CS_AssStep. apply AS_Plus1. apply AS_Id. - eapply multi_step. apply CS_Par2. apply CS_SeqStep. - apply CS_AssStep. apply AS_Plus. - eapply multi_step. apply CS_Par2. apply CS_SeqStep. - apply CS_Ass. - - eapply multi_step. apply CS_Par1. apply CS_Ass. - eapply multi_step. apply CS_Par2. apply CS_SeqFinish. - eapply multi_step. apply CS_Par2. apply CS_While. - eapply multi_step. apply CS_Par2. apply CS_IfStep. - apply BS_Eq1. apply AS_Id. - eapply multi_step. apply CS_Par2. apply CS_IfStep. - apply BS_Eq. simpl. - eapply multi_step. apply CS_Par2. apply CS_IfFalse. - eapply multi_step. apply CS_ParDone. - eapply multi_refl. - reflexivity. Qed. +> par_loop_example_2 : (st' ** ( MultiCStepC (Smallstep.par_loop, Imp.empty_state) (CSkipC, st') +> , st' X = 2 +> )) +> par_loop_example_2 = +> (t_update Y 1 (t_update X 2 (t_update X 1 (t_empty 0))) ** +> ( +> Multi_step (CS_Par2 CS_WhileC) $ +> Multi_step (CS_Par2 $ CS_IfStepC $ BS_Eq1 AS_Id) $ +> Multi_step (CS_Par2 $ CS_IfStepC $ BS_Eq) $ +> Multi_step (CS_Par2 $ CS_IfTrueC) $ +> Multi_step (CS_Par2 $ CS_SeqStepC $ CS_AssStepC $ AS_Plus1 AS_Id) $ +> Multi_step (CS_Par2 $ CS_SeqStepC $ CS_AssStepC AS_Plus) $ +> Multi_step (CS_Par2 $ CS_SeqStepC $ CS_AssC) $ +> Multi_step (CS_Par2 CS_SeqFinishC) $ +> +> Multi_step (CS_Par2 CS_WhileC) $ +> Multi_step (CS_Par2 $ CS_IfStepC $ BS_Eq1 AS_Id) $ +> Multi_step (CS_Par2 $ CS_IfStepC $ BS_Eq) $ +> Multi_step (CS_Par2 $ CS_IfTrueC) $ +> Multi_step (CS_Par2 $ CS_SeqStepC $ CS_AssStepC $ AS_Plus1 AS_Id) $ +> Multi_step (CS_Par2 $ CS_SeqStepC $ CS_AssStepC AS_Plus) $ +> Multi_step (CS_Par2 $ CS_SeqStepC $ CS_AssC) $ +> Multi_step (CS_Par2 CS_SeqFinishC) $ +> +> Multi_step (CS_Par1 CS_AssC) $ +> Multi_step (CS_Par2 CS_WhileC) $ +> Multi_step (CS_Par2 $ CS_IfStepC $ BS_Eq1 AS_Id) $ +> Multi_step (CS_Par2 $ CS_IfStepC $ BS_Eq) $ +> Multi_step (CS_Par2 $ CS_IfFalseC) $ +> Multi_step CS_ParDone $ +> Multi_refl +> +> , Refl +> ) +> ) +> More generally... ==== Exercise: 3 stars, optional (par_body_n__Sn) -Lemma par_body_n__Sn : forall n st, - st X = n /\ st Y = 0 -> - par_loop / st ->>* par_loop / st & { X ==> S n}. -Proof. - (* FILL IN HERE *) Admitted. +> par_body_n_Sn : (n : Nat) -> st X = n -> st Y = 0 -> MultiCStepC (Smallstep.par_loop, st) +> (Smallstep.par_loop, t_update X (S n) st) +> par_body_n_Sn n stx sty = ?par_body_n_Sn_rhs +> $\square$ ==== Exercise: 3 stars, optional (par_body_n) -Lemma par_body_n : forall n st, - st X = 0 /\ st Y = 0 -> - exists st', - par_loop / st ->>* par_loop / st' /\ st' X = n /\ st' Y = 0. -Proof. - (* FILL IN HERE *) Admitted. +> par_body_n : (n : Nat) -> st X = 0 -> st Y = 0 -> (st' ** ( MultiCStepC (Smallstep.par_loop, st) +> (Smallstep.par_loop, st') +> , st' X = n +> , st' Y = 0 +> )) +> par_body_n n {st} stx sty = ?par_body_n_rhs +> $\square$ ... the above loop can exit with `X` having any value whatsoever. -Theorem par_loop_any_X: - forall n, exists st', - par_loop / { ==> 0 } ->>* SKIP / st' - /\ st' X = n. -Proof. - intros n. - destruct (par_body_n n { ==> 0 }). - split; unfold t_update; reflexivity. - - rename x into st. - inversion H as [H' [HX HY]]; clear H. - exists (st & { Y ==> 1 }). split. - eapply multi_trans with (par_loop,st). apply H'. - eapply multi_step. apply CS_Par1. apply CS_Ass. - eapply multi_step. apply CS_Par2. apply CS_While. - eapply multi_step. apply CS_Par2. apply CS_IfStep. - apply BS_Eq1. apply AS_Id. rewrite t_update_eq. - eapply multi_step. apply CS_Par2. apply CS_IfStep. - apply BS_Eq. simpl. - eapply multi_step. apply CS_Par2. apply CS_IfFalse. - eapply multi_step. apply CS_ParDone. - apply multi_refl. - - rewrite t_update_neq. assumption. intro X; inversion X. -Qed. - -End CImp. +> par_loop_any_X : (n : Nat) -> (st' ** ( MultiCStepC (Smallstep.par_loop, Imp.empty_state) (CSkipC, st') +> , st' X = n +> )) +> par_loop_any_X n = +> let (st1 ** (ms, stx, sty)) = par_body_n n {st=Imp.empty_state} Refl Refl in +> (t_update Y 1 st1 ** ( multi_trans ms $ +> Multi_step (CS_Par1 CS_AssC) $ +> Multi_step (CS_Par2 CS_WhileC) $ +> Multi_step (CS_Par2 $ CS_IfStepC $ BS_Eq1 AS_Id) $ +> Multi_step (CS_Par2 $ CS_IfStepC $ BS_Eq) $ +> Multi_step (CS_Par2 $ CS_IfFalseC) $ +> Multi_step CS_ParDone $ +> Multi_refl +> , stx +> )) +> == A Small-Step Stack Machine From 43f0f5be4d2140a61b863ca28fe139ad520f2491 Mon Sep 17 00:00:00 2001 From: Alex Gryzlov Date: Wed, 28 Nov 2018 14:06:41 +0200 Subject: [PATCH 29/30] finish smallstep --- src/Smallstep.lidr | 305 ++++++++++++++++++++++++--------------------- 1 file changed, 166 insertions(+), 139 deletions(-) diff --git a/src/Smallstep.lidr b/src/Smallstep.lidr index d8a03df..d89c17b 100644 --- a/src/Smallstep.lidr +++ b/src/Smallstep.lidr @@ -1162,39 +1162,63 @@ for the arithmetic and boolean step relations. > data AVal : AExp -> Type where > Av_num : AVal (ANum n) -> +> We are not actually going to bother to define boolean values, since they aren't needed in the definition of `->>b` below (why?), though they might be if our language were a bit larger (why?). > data AStep : AExp -> State -> AExp -> Type where -> AS_Id : AStep (AId i) st (ANum (st i)) -> AS_Plus : AStep (APlus (ANum n1) (ANum n2)) st (ANum (n1 + n2)) -> AS_Plus1 : AStep a1 st a1' -> AStep (APlus a1 a2) st (APlus a1' a2) -> AS_Plus2 : AVal v1 -> AStep a2 st a2' -> AStep (APlus v1 a2) st (APlus v1 a2') -> AS_Minus : AStep (AMinus (ANum n1) (ANum n2)) st (ANum (minus n1 n2)) -> AS_Minus1 : AStep a1 st a1' -> AStep (AMinus a1 a2) st (AMinus a1' a2) -> AS_Minus2 : AVal v1 -> AStep a2 st a2' -> AStep (AMinus v1 a2) st (AMinus v1 a2') -> AS_Mult : AStep (AMult (ANum n1) (ANum n2)) st (ANum (mult n1 n2)) -> AS_Mult1 : AStep a1 st a1' -> AStep (AMult a1 a2) st (AMult a1' a2) -> AS_Mult2 : AVal v1 -> AStep a2 st a2' -> AStep (AMult v1 a2) st (AMult v1 a2') +> AS_Id : AStep (AId i) +> st (ANum (st i)) +> AS_Plus : AStep (APlus (ANum n1) (ANum n2)) +> st (ANum (n1 + n2)) +> AS_Plus1 : AStep a1 st a1' -> AStep (APlus a1 a2) +> st (APlus a1' a2) +> AS_Plus2 : AVal v1 -> AStep a2 st a2' -> AStep (APlus v1 a2) +> st (APlus v1 a2') +> AS_Minus : AStep (AMinus (ANum n1) (ANum n2)) +> st (ANum (minus n1 n2)) +> AS_Minus1 : AStep a1 st a1' -> AStep (AMinus a1 a2) +> st (AMinus a1' a2) +> AS_Minus2 : AVal v1 -> AStep a2 st a2' -> AStep (AMinus v1 a2) +> st (AMinus v1 a2') +> AS_Mult : AStep (AMult (ANum n1) (ANum n2)) +> st (ANum (mult n1 n2)) +> AS_Mult1 : AStep a1 st a1' -> AStep (AMult a1 a2) +> st (AMult a1' a2) +> AS_Mult2 : AVal v1 -> AStep a2 st a2' -> AStep (AMult v1 a2) +> st (AMult v1 a2') > > data BStep : BExp -> State -> BExp -> Type where -> BS_Eq : BStep (BEq (ANum n1) (ANum n2)) st (if (n1==n2) then BTrue else BFalse) -> BS_Eq1 : AStep a1 st a1' -> BStep (BEq a1 a2) st (BEq a1' a2) -> BS_Eq2 : AVal v1 -> AStep a2 st a2' -> BStep (BEq v1 a2) st (BEq v1 a2') -> BS_LtEq : BStep (BLe (ANum n1) (ANum n2)) st (if (n1<=n2) then BTrue else BFalse) -> BS_LtEq1 : AStep a1 st a1' -> BStep (BLe a1 a2) st (BLe a1' a2) -> BS_LtEq2 : AVal v1 -> AStep a2 st a2' -> BStep (BLe v1 a2) st (BLe v1 a2') -> BS_NotTrue : BStep (BNot BTrue) st BFalse -> BS_NotFalse : BStep (BNot BFalse) st BTrue -> BS_NotStep : BStep b1 st b1' -> BStep (BNot b1) st (BNot b1') -> BS_AndTrueTrue : BStep (BAnd BTrue BTrue) st BTrue -> BS_AndTrueFalse : BStep (BAnd BTrue BFalse) st BFalse -> BS_AndFalse : BStep (BAnd BFalse b2) st BFalse -> BS_AndTrueStep : BStep b2 st b2' -> BStep (BAnd BTrue b2) st (BAnd BTrue b2') -> BS_AndStep : BStep b1 st b1' -> BStep (BAnd b1 b2) st (BAnd b1' b2) +> BS_Eq : BStep (BEq (ANum n1) (ANum n2)) +> st (if (n1==n2) then BTrue else BFalse) +> BS_Eq1 : AStep a1 st a1' -> BStep (BEq a1 a2) +> st (BEq a1' a2) +> BS_Eq2 : AVal v1 -> AStep a2 st a2' -> BStep (BEq v1 a2) +> st (BEq v1 a2') +> BS_LtEq : BStep (BLe (ANum n1) (ANum n2)) +> st (if (n1<=n2) then BTrue else BFalse) +> BS_LtEq1 : AStep a1 st a1' -> BStep (BLe a1 a2) +> st (BLe a1' a2) +> BS_LtEq2 : AVal v1 -> AStep a2 st a2' -> BStep (BLe v1 a2) +> st (BLe v1 a2') +> BS_NotTrue : BStep (BNot BTrue) +> st BFalse +> BS_NotFalse : BStep (BNot BFalse) +> st BTrue +> BS_NotStep : BStep b1 st b1' -> BStep (BNot b1) +> st (BNot b1') +> BS_AndTrueTrue : BStep (BAnd BTrue BTrue) +> st BTrue +> BS_AndTrueFalse : BStep (BAnd BTrue BFalse) +> st BFalse +> BS_AndFalse : BStep (BAnd BFalse b2) +> st BFalse +> BS_AndTrueStep : BStep b2 st b2' -> BStep (BAnd BTrue b2) +> st (BAnd BTrue b2') +> BS_AndStep : BStep b1 st b1' -> BStep (BAnd b1 b2) +> st (BAnd b1' b2) > The semantics of commands is the interesting part. We need two small tricks to @@ -1217,23 +1241,23 @@ share the feature that the original `WHILE` command needs to be saved somewhere while a single copy of the loop body is being reduced.) > data CStep : (Com, State) -> (Com, State) -> Type where -> CS_AssStep : AStep a st a' -> CStep (CAss i a , st) +> CS_AssStep : AStep a st a' -> CStep (CAss i a , st) > (CAss i a', st) -> CS_Ass : CStep (CAss i (ANum n), st ) +> CS_Ass : CStep (CAss i (ANum n), st ) > (CSkip , t_update i n st) -> CS_SeqStep : CStep (c1, st) (c1', st') -> CStep (CSeq c1 c2, st ) +> CS_SeqStep : CStep (c1, st) (c1', st') -> CStep (CSeq c1 c2, st ) > (CSeq c1' c2, st') -> CS_SeqFinish : CStep (CSeq CSkip c2, st) +> CS_SeqFinish : CStep (CSeq CSkip c2, st) > (c2 , st) -> CS_IfTrue : CStep (CIf BTrue c1 c2, st) +> CS_IfTrue : CStep (CIf BTrue c1 c2, st) > (c1 , st) -> CS_IfFalse : CStep (CIf BFalse c1 c2, st) +> CS_IfFalse : CStep (CIf BFalse c1 c2, st) > (c2 , st) -> CS_IfStep : BStep b st b' -> CStep (CIf b c1 c2, st) +> CS_IfStep : BStep b st b' -> CStep (CIf b c1 c2, st) > (CIf b' c1 c2, st) -> CS_While : CStep (CWhile b c1 , st) +> CS_While : CStep (CWhile b c1 , st) > (CIf b (CSeq c1 (CWhile b c1)) CSkip, st) -> +> == Concurrent Imp @@ -1252,36 +1276,36 @@ same memory and can communicate by reading and writing the same variables. > CWhileC : BExp -> ComC -> ComC > -- New: > CParC : ComC -> ComC -> ComC -> +> \todo[inline]{Add syntax sugar} > data CStepC : (ComC, State) -> (ComC, State) -> Type where -> -- Old part -> CS_AssStepC : AStep a st a' -> CStepC (CAssC i a , st) +> -- Old part +> CS_AssStepC : AStep a st a' -> CStepC (CAssC i a , st) > (CAssC i a', st) -> CS_AssC : CStepC (CAssC i (ANum n), st) +> CS_AssC : CStepC (CAssC i (ANum n), st) > (CSkipC , t_update i n st) -> CS_SeqStepC : CStepC (c1, st) (c1', st') -> CStepC (CSeqC c1 c2, st ) +> CS_SeqStepC : CStepC (c1, st) (c1', st') -> CStepC (CSeqC c1 c2, st ) > (CSeqC c1' c2, st') -> CS_SeqFinishC : CStepC (CSeqC CSkipC c2, st) +> CS_SeqFinishC : CStepC (CSeqC CSkipC c2, st) > (c2 , st) -> CS_IfTrueC : CStepC (CIfC BTrue c1 c2, st) +> CS_IfTrueC : CStepC (CIfC BTrue c1 c2, st) > (c1 , st) -> CS_IfFalseC : CStepC (CIfC BFalse c1 c2, st) +> CS_IfFalseC : CStepC (CIfC BFalse c1 c2, st) > (c2 , st) -> CS_IfStepC : BStep b st b' -> CStepC (CIfC b c1 c2, st) +> CS_IfStepC : BStep b st b' -> CStepC (CIfC b c1 c2, st) > (CIfC b' c1 c2, st) -> CS_WhileC : CStepC (CWhileC b c1 , st) +> CS_WhileC : CStepC (CWhileC b c1 , st) > (CIfC b (CSeqC c1 (CWhileC b c1)) CSkipC, st) -> -- New part: -> CS_Par1 : CStepC (c1, st) (c1', st') -> CStepC (CParC c1 c2, st ) +> -- New part: +> CS_Par1 : CStepC (c1, st) (c1', st') -> CStepC (CParC c1 c2, st ) > (CParC c1' c2, st') -> CS_Par2 : CStepC (c2, st) (c2', st') -> CStepC (CParC c1 c2 , st ) +> CS_Par2 : CStepC (c2, st) (c2', st') -> CStepC (CParC c1 c2 , st ) > (CParC c1 c2', st') -> CS_ParDone : CStepC (CParC CSkipC CSkipC, st) +> CS_ParDone : CStepC (CParC CSkipC CSkipC, st) > (CSkipC , st) -> +> > MultiCStepC : (ComC, State) -> (ComC, State) -> Type > MultiCStepC = Multi CStepC > @@ -1290,81 +1314,83 @@ Among the many interesting properties of this language is the fact that the following program can terminate with the variable `X` set to any value > par_loop : ComC -> par_loop = CParC -> (CAssC Y (ANum 1)) -> (CWhileC -> (BEq (AId Y) (ANum 0)) +> par_loop = CParC +> (CAssC Y (ANum 1)) +> (CWhileC +> (BEq (AId Y) (ANum 0)) > (CAssC X (APlus (AId X) (ANum 1))) > ) -> +> In particular, it can terminate with `X` set to `0`: -> par_loop_example_0 : (st' ** ( MultiCStepC (Smallstep.par_loop, Imp.empty_state) (CSkipC, st') +> par_loop_example_0 : (st' ** ( MultiCStepC (Smallstep.par_loop, Imp.empty_state) +> (CSkipC, st') > , st' X = 0 > )) -> par_loop_example_0 = -> (t_update Y 1 (t_empty 0) ** -> ( -> Multi_step (CS_Par1 CS_AssC) $ -> Multi_step (CS_Par2 CS_WhileC) $ -> Multi_step (CS_Par2 $ CS_IfStepC $ BS_Eq1 AS_Id) $ -> Multi_step (CS_Par2 $ CS_IfStepC $ BS_Eq) $ -> Multi_step (CS_Par2 $ CS_IfFalseC) $ -> Multi_step CS_ParDone $ +> par_loop_example_0 = +> (t_update Y 1 (t_empty 0) ** +> ( +> Multi_step (CS_Par1 CS_AssC) $ +> Multi_step (CS_Par2 CS_WhileC) $ +> Multi_step (CS_Par2 $ CS_IfStepC $ BS_Eq1 AS_Id) $ +> Multi_step (CS_Par2 $ CS_IfStepC $ BS_Eq) $ +> Multi_step (CS_Par2 $ CS_IfFalseC) $ +> Multi_step CS_ParDone $ > Multi_refl -> +> > , Refl > ) > ) -> +> It can also terminate with `X` set to `2`: -> par_loop_example_2 : (st' ** ( MultiCStepC (Smallstep.par_loop, Imp.empty_state) (CSkipC, st') +> par_loop_example_2 : (st' ** ( MultiCStepC (Smallstep.par_loop, Imp.empty_state) +> (CSkipC, st') > , st' X = 2 > )) -> par_loop_example_2 = -> (t_update Y 1 (t_update X 2 (t_update X 1 (t_empty 0))) ** -> ( -> Multi_step (CS_Par2 CS_WhileC) $ -> Multi_step (CS_Par2 $ CS_IfStepC $ BS_Eq1 AS_Id) $ -> Multi_step (CS_Par2 $ CS_IfStepC $ BS_Eq) $ -> Multi_step (CS_Par2 $ CS_IfTrueC) $ -> Multi_step (CS_Par2 $ CS_SeqStepC $ CS_AssStepC $ AS_Plus1 AS_Id) $ -> Multi_step (CS_Par2 $ CS_SeqStepC $ CS_AssStepC AS_Plus) $ -> Multi_step (CS_Par2 $ CS_SeqStepC $ CS_AssC) $ -> Multi_step (CS_Par2 CS_SeqFinishC) $ -> -> Multi_step (CS_Par2 CS_WhileC) $ -> Multi_step (CS_Par2 $ CS_IfStepC $ BS_Eq1 AS_Id) $ -> Multi_step (CS_Par2 $ CS_IfStepC $ BS_Eq) $ -> Multi_step (CS_Par2 $ CS_IfTrueC) $ -> Multi_step (CS_Par2 $ CS_SeqStepC $ CS_AssStepC $ AS_Plus1 AS_Id) $ -> Multi_step (CS_Par2 $ CS_SeqStepC $ CS_AssStepC AS_Plus) $ -> Multi_step (CS_Par2 $ CS_SeqStepC $ CS_AssC) $ -> Multi_step (CS_Par2 CS_SeqFinishC) $ -> -> Multi_step (CS_Par1 CS_AssC) $ -> Multi_step (CS_Par2 CS_WhileC) $ -> Multi_step (CS_Par2 $ CS_IfStepC $ BS_Eq1 AS_Id) $ -> Multi_step (CS_Par2 $ CS_IfStepC $ BS_Eq) $ -> Multi_step (CS_Par2 $ CS_IfFalseC) $ -> Multi_step CS_ParDone $ +> par_loop_example_2 = +> (t_update Y 1 (t_update X 2 (t_update X 1 (t_empty 0))) ** +> ( +> Multi_step (CS_Par2 CS_WhileC) $ +> Multi_step (CS_Par2 $ CS_IfStepC $ BS_Eq1 AS_Id) $ +> Multi_step (CS_Par2 $ CS_IfStepC $ BS_Eq) $ +> Multi_step (CS_Par2 $ CS_IfTrueC) $ +> Multi_step (CS_Par2 $ CS_SeqStepC $ CS_AssStepC $ AS_Plus1 AS_Id) $ +> Multi_step (CS_Par2 $ CS_SeqStepC $ CS_AssStepC AS_Plus) $ +> Multi_step (CS_Par2 $ CS_SeqStepC $ CS_AssC) $ +> Multi_step (CS_Par2 CS_SeqFinishC) $ +> +> Multi_step (CS_Par2 CS_WhileC) $ +> Multi_step (CS_Par2 $ CS_IfStepC $ BS_Eq1 AS_Id) $ +> Multi_step (CS_Par2 $ CS_IfStepC $ BS_Eq) $ +> Multi_step (CS_Par2 $ CS_IfTrueC) $ +> Multi_step (CS_Par2 $ CS_SeqStepC $ CS_AssStepC $ AS_Plus1 AS_Id) $ +> Multi_step (CS_Par2 $ CS_SeqStepC $ CS_AssStepC AS_Plus) $ +> Multi_step (CS_Par2 $ CS_SeqStepC $ CS_AssC) $ +> Multi_step (CS_Par2 CS_SeqFinishC) $ +> +> Multi_step (CS_Par1 CS_AssC) $ +> Multi_step (CS_Par2 CS_WhileC) $ +> Multi_step (CS_Par2 $ CS_IfStepC $ BS_Eq1 AS_Id) $ +> Multi_step (CS_Par2 $ CS_IfStepC $ BS_Eq) $ +> Multi_step (CS_Par2 $ CS_IfFalseC) $ +> Multi_step CS_ParDone $ > Multi_refl -> +> > , Refl > ) > ) -> +> More generally... ==== Exercise: 3 stars, optional (par_body_n__Sn) -> par_body_n_Sn : (n : Nat) -> st X = n -> st Y = 0 -> MultiCStepC (Smallstep.par_loop, st) -> (Smallstep.par_loop, t_update X (S n) st) +> par_body_n_Sn : (n : Nat) -> st X = n -> st Y = 0 -> MultiCStepC (Smallstep.par_loop, st) +> (Smallstep.par_loop, t_update X (S n) st) > par_body_n_Sn n stx sty = ?par_body_n_Sn_rhs > @@ -1373,7 +1399,7 @@ $\square$ ==== Exercise: 3 stars, optional (par_body_n) -> par_body_n : (n : Nat) -> st X = 0 -> st Y = 0 -> (st' ** ( MultiCStepC (Smallstep.par_loop, st) +> par_body_n : (n : Nat) -> st X = 0 -> st Y = 0 -> (st' ** ( MultiCStepC (Smallstep.par_loop, st) > (Smallstep.par_loop, st') > , st' X = n > , st' Y = 0 @@ -1385,22 +1411,23 @@ $\square$ ... the above loop can exit with `X` having any value whatsoever. -> par_loop_any_X : (n : Nat) -> (st' ** ( MultiCStepC (Smallstep.par_loop, Imp.empty_state) (CSkipC, st') +> par_loop_any_X : (n : Nat) -> (st' ** ( MultiCStepC (Smallstep.par_loop, Imp.empty_state) +> (CSkipC, st') > , st' X = n > )) -> par_loop_any_X n = -> let (st1 ** (ms, stx, sty)) = par_body_n n {st=Imp.empty_state} Refl Refl in -> (t_update Y 1 st1 ** ( multi_trans ms $ -> Multi_step (CS_Par1 CS_AssC) $ -> Multi_step (CS_Par2 CS_WhileC) $ -> Multi_step (CS_Par2 $ CS_IfStepC $ BS_Eq1 AS_Id) $ -> Multi_step (CS_Par2 $ CS_IfStepC $ BS_Eq) $ -> Multi_step (CS_Par2 $ CS_IfFalseC) $ -> Multi_step CS_ParDone $ +> par_loop_any_X n = +> let (st1 ** (ms, stx, sty)) = par_body_n n {st=Imp.empty_state} Refl Refl in +> (t_update Y 1 st1 ** ( multi_trans ms $ +> Multi_step (CS_Par1 CS_AssC) $ +> Multi_step (CS_Par2 CS_WhileC) $ +> Multi_step (CS_Par2 $ CS_IfStepC $ BS_Eq1 AS_Id) $ +> Multi_step (CS_Par2 $ CS_IfStepC $ BS_Eq) $ +> Multi_step (CS_Par2 $ CS_IfFalseC) $ +> Multi_step CS_ParDone $ > Multi_refl > , stx > )) -> +> == A Small-Step Stack Machine @@ -1408,29 +1435,29 @@ $\square$ Our last example is a small-step semantics for the stack machine example from the `Imp` chapter of _Logical Foundations_. -Definition stack := list nat. -Definition prog := list sinstr. - -Inductive stack_step : state -> prog * stack -> prog * stack -> Prop := - | SS_Push : forall st stk n p', - stack_step st (SPush n :: p', stk) (p', n :: stk) - | SS_Load : forall st stk i p', - stack_step st (SLoad i :: p', stk) (p', st i :: stk) - | SS_Plus : forall st stk n m p', - stack_step st (SPlus :: p', n::m::stk) (p', (m+n)::stk) - | SS_Minus : forall st stk n m p', - stack_step st (SMinus :: p', n::m::stk) (p', (m-n)::stk) - | SS_Mult : forall st stk n m p', - stack_step st (SMult :: p', n::m::stk) (p', (m*n)::stk). - -Theorem stack_step_deterministic : forall st, - deterministic (stack_step st). -Proof. - unfold deterministic. intros st x y1 y2 H1 H2. - induction H1; inversion H2; reflexivity. -Qed. - -Definition stack_multistep st := multi (stack_step st). +> Stack : Type +> Stack = List Nat +> +> Prog : Type +> Prog = List SInstr +> +> data StackStep : State -> (Prog, Stack) -> (Prog, Stack) -> Type where +> SS_Push : StackStep st (SPush n :: p, stk) (p, n :: stk) +> SS_Load : StackStep st (SLoad i :: p, stk ) (p, st i :: stk) +> SS_Plus : StackStep st (SPlus :: p, n::m::stk) (p, m + n :: stk) +> SS_Minus : StackStep st (SMinus :: p, n::m::stk) (p, (m `minus` n):: stk) +> SS_Mult : StackStep st (SMult :: p, n::m::stk) (p, m * n :: stk) +> +> stack_step_deterministic : deterministic (StackStep st) +> stack_step_deterministic SS_Push SS_Push = Refl +> stack_step_deterministic SS_Load SS_Load = Refl +> stack_step_deterministic SS_Plus SS_Plus = Refl +> stack_step_deterministic SS_Minus SS_Minus = Refl +> stack_step_deterministic SS_Mult SS_Mult = Refl +> +> StackMultistep : State -> (Prog, Stack) -> (Prog, Stack) -> Type +> StackMultistep st = Multi (StackStep st) +> ==== Exercise: 3 stars, advanced (compiler_is_correct) @@ -1442,11 +1469,11 @@ the stack machine. State what it means for the compiler to be correct according to the stack machine small step semantics and then prove it. -Definition compiler_is_correct_statement : Prop - (* REPLACE THIS LINE WITH ":= _your_definition_ ." *). Admitted. - -Theorem compiler_is_correct : compiler_is_correct_statement. -Proof. -(* FILL IN HERE *) Admitted. +> Compiler_is_correct_statement : Type +> Compiler_is_correct_statement = ?compiler_is_correct_statement_rhs +> +> compiler_is_correct : Compiler_is_correct_statement +> compiler_is_correct = ?compiler_is_correct_rhs +> $\square$ From 6464d890b10165304fc971720aab27164fd4fb5f Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?J=C3=BCrgen=20Nicklisch-Franken?= Date: Thu, 10 Jan 2019 11:05:19 +0100 Subject: [PATCH 30/30] Preservation proof --- src/Stlc.lidr | 40 ++-- src/StlcProp.lidr | 519 ++++++++++++++++++++++------------------------ 2 files changed, 272 insertions(+), 287 deletions(-) diff --git a/src/Stlc.lidr b/src/Stlc.lidr index e16978f..a82fea8 100644 --- a/src/Stlc.lidr +++ b/src/Stlc.lidr @@ -516,7 +516,7 @@ Example: idBB idB ->>* idB > step_example1 : Stlc.idBB # Stlc.idB ->>* Stlc.idB -> step_example1 = Multi_step (ST_AppAbs V_abs) Multi_refl -- (ST_AppAbs V_abs) Multi_refl +> step_example1 = Multi_step (ST_AppAbs V_abs) Multi_refl Example: @@ -635,7 +635,7 @@ Following the usual notation for partial maps, we could write `Gamma \[ \begin{prooftree} - \hypo{\idr{Gamma & {{ x --> T11 }} |- t12 :: T12}} + \hypo{\idr{Gamma & {{ x ==> T11 }} |- t12 :: T12}} \infer1[\idr{T_Abs}]{\idr{Gamma |- \x:T11.t12 ::T11->T12}} \end{prooftree} \] @@ -672,32 +672,32 @@ Following the usual notation for partial maps, we could write `Gamma We can read the three-place relation `Gamma |- t ::T` as: "under the assumptions in Gamma, the term `t` has the type `T`." *) -> syntax [context] "|-" [t] "::" [T] "." = Has_type context t T +> syntax [context] "|-" [t] "::" [T] = Has_type context t T > data Has_type : Context -> Tm -> Ty -> Type where > T_Var : {Gamma: Context} -> {x: Id} -> {T: Ty} -> > Gamma x = Just T -> -> Gamma |- (Tvar x) :: T . +> (Gamma |- (Tvar x) :: T) > T_Abs : {Gamma: Context} -> {x: Id} -> {T11, T12: Ty} -> {t12 : Tm} -> -> (Gamma & {{ x ==> T11 }}) |- t12 :: T12 . -> -> Gamma |- (Tabs x T11 t12) :: (T11 :=> T12) . +> ((Gamma & {{ x ==> T11 }}) |- t12 :: T12) -> +> Gamma |- (Tabs x T11 t12) :: (T11 :=> T12) > T_App : {Gamma: Context} -> {T11, T12: Ty} -> {t1, t2 : Tm} -> -> Gamma |- t1 :: (T11 :=> T12). -> -> Gamma |- t2 :: T11 . -> -> Gamma |- (t1 # t2) :: T12 . +> (Gamma |- t1 :: (T11 :=> T12)) -> +> (Gamma |- t2 :: T11) -> +> Gamma |- (t1 # t2) :: T12 > T_True : {Gamma: Context} -> -> Gamma |- Ttrue :: TBool . +> Gamma |- Ttrue :: TBool > T_False : {Gamma: Context} -> -> Gamma |- Tfalse :: TBool . +> Gamma |- Tfalse :: TBool > T_If : {Gamma: Context} -> {T : Ty} -> {t1, t2, t3 : Tm} -> -> Gamma |- t1 :: TBool . -> -> Gamma |- t2 :: T . -> -> Gamma |- t3 :: T . -> -> Gamma |- (Tif t1 t2 t3) :: T . +> (Gamma |- t1 :: TBool) -> +> (Gamma |- t2 :: T) -> +> (Gamma |- t3 :: T) -> +> Gamma |- (Tif t1 t2 t3) :: T ==== Examples -> typing_example_1 : empty |- (Tabs (MkId "x") TBool (var "x")) :: (TBool :=> TBool) . +> typing_example_1 : empty |- (Tabs (MkId "x") TBool (var "x")) :: (TBool :=> TBool) > typing_example_1 = T_Abs (T_Var Refl) @@ -712,7 +712,7 @@ Another example: > (Tabs (MkId "x") TBool > (Tabs (MkId "y") (TBool :=> TBool) > (var "y" # var "y" # var "x"))) :: -> (TBool :=> (TBool :=> TBool) :=> TBool) . +> (TBool :=> (TBool :=> TBool) :=> TBool) > typing_example_2 = > T_Abs (T_Abs (T_App (T_Var Refl) (T_App (T_Var Refl) (T_Var Refl)))) @@ -732,7 +732,7 @@ Formally prove the following typing derivation holds: > (Tabs (MkId "x") (TBool :=> TBool) > (Tabs (MkId "y") (TBool :=> TBool) > (Tabs (MkId "z") TBool -> (Tvar (MkId "y") # (Tvar (MkId "x") # Tvar (MkId "z")))))) :: T . ) +> (Tvar (MkId "y") # (Tvar (MkId "x") # Tvar (MkId "z")))))) :: T) > typing_example_3 = ?typing_example_3_rhs $\square$ @@ -755,7 +755,7 @@ to the term `\x:Bool. \y:Bool, x y` -- i.e., > empty |- > (Tabs (MkId "x") TBool > (Tabs (MkId "y") TBool -> (Tvar (MkId "x") # Tvar (MkId y)))) :: T . ) +> (Tvar (MkId "x") # Tvar (MkId y)))) :: T) > typing_nonexample_1 = forallToExistence > (\ a , (T_Abs (T_Abs (T_App (T_Var Refl)(T_Var Refl)))) impossible) @@ -771,7 +771,7 @@ Another nonexample: > Not (s : Ty ** t : Ty ** > empty |- > (Tabs (MkId "x") s -> (Tvar (MkId "x") # Tvar (MkId "x"))) :: t . ) +> (Tvar (MkId "x") # Tvar (MkId "x"))) :: t) > typing_nonexample_3 = ?typing_nonexample_3_rhs $\square$ diff --git a/src/StlcProp.lidr b/src/StlcProp.lidr index 9d4a1d0..8af6c2a 100644 --- a/src/StlcProp.lidr +++ b/src/StlcProp.lidr @@ -4,16 +4,10 @@ > module StlcProp > import Maps -> import Types -> import Smallstep > import Stlc > %access public export > %default total -> %hide Smallstep.Tm -> %hide Types.progress - - In this chapter, we develop the fundamental theory of the Simply Typed Lambda Calculus -- in particular, the type safety @@ -29,21 +23,17 @@ boolean values `ttrue` and `tfalse`; for arrow types, they are lambda-abstractions. > canonical_forms_bool : {t : Tm} -> -> empty |- t :: TBool . -> +> (empty |- t :: TBool) -> > Value t -> > (t = Ttrue) `Either` (t = Tfalse) - > canonical_forms_bool {t=Ttrue} tb vt = Left Refl > canonical_forms_bool {t=Tfalse} tb vt = Right Refl > canonical_forms_fun : {t: Tm} -> {ty1, ty2: Ty} -> -> empty |- t :: (ty1 :=> ty2) . -> +> (empty |- t :: (ty1 :=> ty2)) -> > Value t -> > (x : Id ** u : Tm ** t = Tabs x ty1 u) - -> canonical_forms_fun {t = Ttrue} T_True _ impossible -> canonical_forms_fun {t = Tfalse} T_False _ impossible > canonical_forms_fun {t = Tabs x ty t1} {ty1} tt vt = > case tt of > T_Abs {x} {t12} pre => (x ** t12 ** Refl) @@ -55,14 +45,13 @@ The _progress_ theorem tells us that closed, well-typed terms are not stuck: either a well-typed term is a value, or it can take a reduction step. The proof is a relatively straightforward extension of the progress proof we saw in the -`Types` chapter. We'll give the proof in English first, then -the formal version. +`Types` chapter. > progress : {t : Tm} -> {ty: Ty} -> -> (empty {a=Ty}) |- t :: ty . -> +> ((empty {a=Ty}) |- t :: ty) -> > (Value t) `Either` (t': Tm ** t ->> t') -_Proof_: By induction on the derivation of `|- t \in T` +_Proof_: By induction on the derivation of `|- t :: T` - The last rule of the derivation cannot be `T_Var`, since a variable is never well typed in an empty context. @@ -72,8 +61,8 @@ _Proof_: By induction on the derivation of `|- t \in T` is a value. - If the last rule of the derivation is `T_App`, then `t` has the - form `t1 t2` for some `t1` and `t2`, where `|- t1 \in T2 -> T` - and `|- t2 \in T2` for some type `T2`. By the induction + form `t1 t2` for some `t1` and `t2`, where `|- t1 :: T2 -> T` + and `|- t2 :: T2` for some type `T2`. By the induction hypothesis, either `t1` is a value or it can take a reduction step. @@ -233,10 +222,10 @@ a variable `x` appears free in a term `t`, and if we know `t` is well typed in context `Gamma`, then it must be the case that `Gamma` assigns a type to `x`. *) --- > free_in_context : {x : Id} -> {t: Tm} -> {ty: Ty} -> {gamma: Context} -> --- > Appears_free_in x t -> --- > gamma |- t :: T . -> --- > (t' : Ty ** gamma x = Just t') +> free_in_context : {x : Id} -> {t: Tm} -> {ty: Ty} -> {gamma: Context} -> +> Appears_free_in x t -> +> (gamma |- t :: ty) -> +> (t' : Ty ** gamma x = Just t') _Proof_: We show, by induction on the proof that `x` appears free in `t`, that, for all contexts `Gamma`, if `t` is well typed @@ -261,17 +250,13 @@ under `Gamma`, then `Gamma` assigns some type to `x`. \y:T11.t12` and `x` appears free in `t12`, and we also know that `x` is different from `y`. The difference from the previous cases is that, whereas `t` is well typed under - `Gamma`, its body `t12` is well typed under `(Gamma & {{y-->T11}}`, + `Gamma`, its body `t12` is well typed under `(Gamma & {{y==>T11}}`, so the IH allows us to conclude that `x` is assigned some type - by the extended context `(Gamma & {{y-->T11}}`. To conclude that + by the extended context `(Gamma & {{y==>T11}}`. To conclude that `Gamma` assigns a type to `x`, we appeal to lemma `update_neq`, noting that `x` and `y` are different variables. *) -> free_in_context : {x : Id} -> {t: Tm} -> {ty: Ty} -> {gamma: Context} -> -> Appears_free_in x t -> -> gamma |- t :: ty . -> -> (t' : Ty ** gamma x = Just t') > free_in_context {ty} Afi_var (T_Var h1) = (ty ** h1) > free_in_context {t = t1 # t2} (Afi_app1 h) (T_App h1 h2) = free_in_context h h1 > free_in_context {t = t1 # t2} (Afi_app2 h) (T_App h1 h2) = free_in_context h h2 @@ -287,180 +272,181 @@ the empty context is closed (it has no free variables). ==== Exercise: 2 stars, optional (typable_empty__closed) -Corollary typable_empty__closed : forall t T, - empty |- t \in T -> - closed t. -Proof. - (* FILL IN HERE *) Admitted. -(** `` *) - -(** Sometimes, when we have a proof `Gamma |- t : T`, we will need to - replace `Gamma` by a different context `Gamma'`. When is it safe - to do this? Intuitively, it must at least be the case that - `Gamma'` assigns the same types as `Gamma` to all the variables - that appear free in `t`. In fact, this is the only condition that - is needed. *) - -Lemma context_invariance : forall Gamma Gamma' t T, - Gamma |- t \in T -> - (forall x, appears_free_in x t -> Gamma x = Gamma' x) -> - Gamma' |- t \in T. - -(** _Proof_: By induction on the derivation of `Gamma |- t \in T`. - - - If the last rule in the derivation was `T_Var`, then `t = x` - and `Gamma x = T`. By assumption, `Gamma' x = T` as well, and - hence `Gamma' |- t \in T` by `T_Var`. - - - If the last rule was `T_Abs`, then `t = \y:T11. t12`, with `T - = T11 -> T12` and `Gamma & {{y-->T11}} |- t12 \in T12`. The - induction hypothesis is that, for any context `Gamma''`, if - `Gamma & {{y-->T11}}` and `Gamma''` assign the same types to - all the free variables in `t12`, then `t12` has type `T12` - under `Gamma''`. Let `Gamma'` be a context which agrees with - `Gamma` on the free variables in `t`; we must show `Gamma' |- - \y:T11. t12 \in T11 -> T12`. - - By `T_Abs`, it suffices to show that `Gamma' & {{y-->T11}} |- - t12 \in T12`. By the IH (setting `Gamma'' = Gamma' & - {{y:T11}}`), it suffices to show that `Gamma & {{y-->T11}}` - and `Gamma' & {{y-->T11}}` agree on all the variables that - appear free in `t12`. - - Any variable occurring free in `t12` must be either `y` or - some other variable. `Gamma & {{y-->T11}}` and `Gamma' & - {{y-->T11}}` clearly agree on `y`. Otherwise, note that any - variable other than `y` that occurs free in `t12` also occurs - free in `t = \y:T11. t12`, and by assumption `Gamma` and - `Gamma'` agree on all such variables; hence so do `Gamma & - {{y-->T11}}` and `Gamma' & {{y-->T11}}`. - - - If the last rule was `T_App`, then `t = t1 t2`, with `Gamma |- - t1 \in T2 -> T` and `Gamma |- t2 \in T2`. One induction - hypothesis states that for all contexts `Gamma'`, if `Gamma'` - agrees with `Gamma` on the free variables in `t1`, then `t1` - has type `T2 -> T` under `Gamma'`; there is a similar IH for - `t2`. We must show that `t1 t2` also has type `T` under - `Gamma'`, given the assumption that `Gamma'` agrees with - `Gamma` on all the free variables in `t1 t2`. By `T_App`, it - suffices to show that `t1` and `t2` each have the same type - under `Gamma'` as under `Gamma`. But all free variables in - `t1` are also free in `t1 t2`, and similarly for `t2`; hence - the desired result follows from the induction hypotheses. *) - -Proof with eauto. - intros. - generalize dependent Gamma'. - induction H; intros; auto. - - (* T_Var *) - apply T_Var. rewrite <- H0... - - (* T_Abs *) - apply T_Abs. - apply IHhas_type. intros x1 Hafi. - (* the only tricky step... the `Gamma'` we use to - instantiate is `Gamma & {{x-->T11}}` *) - unfold update. unfold t_update. destruct (beq_string x0 x1) eqn: Hx0x1... - rewrite beq_string_false_iff in Hx0x1. auto. - - (* T_App *) - apply T_App with T11... -Qed. - -(** Now we come to the conceptual heart of the proof that reduction - preserves types -- namely, the observation that _substitution_ - preserves types. *) - -(** Formally, the so-called _substitution lemma_ says this: - Suppose we have a term `t` with a free variable `x`, and suppose - we've assigned a type `T` to `t` under the assumption that `x` has - some type `U`. Also, suppose that we have some other term `v` and - that we've shown that `v` has type `U`. Then, since `v` satisfies - the assumption we made about `x` when typing `t`, we can - substitute `v` for each of the occurrences of `x` in `t` and - obtain a new term that still has type `T`. *) - -(** _Lemma_: If `Gamma & {{x-->U}} |- t \in T` and `|- v \in U`, - then `Gamma |- `x:=v`t \in T`. *) - -Lemma substitution_preserves_typing : forall Gamma x U t v T, - Gamma & {{x-->U}} |- t \in T -> - empty |- v \in U -> - Gamma |- `x:=v`t \in T. - -(** One technical subtlety in the statement of the lemma is that - we assume `v` has type `U` in the _empty_ context -- in other - words, we assume `v` is closed. This assumption considerably - simplifies the `T_Abs` case of the proof (compared to assuming - `Gamma |- v \in U`, which would be the other reasonable assumption - at this point) because the context invariance lemma then tells us - that `v` has type `U` in any context at all -- we don't have to - worry about free variables in `v` clashing with the variable being - introduced into the context by `T_Abs`. - - The substitution lemma can be viewed as a kind of commutation - property. Intuitively, it says that substitution and typing can - be done in either order: we can either assign types to the terms - `t` and `v` separately (under suitable contexts) and then combine - them using substitution, or we can substitute first and then - assign a type to ` `x:=v` t ` -- the result is the same either - way. - - _Proof_: We show, by induction on `t`, that for all `T` and - `Gamma`, if `Gamma & {{x-->U}} |- t \in T` and `|- v \in U`, then - `Gamma |- `x:=v`t \in T`. - - - If `t` is a variable there are two cases to consider, - depending on whether `t` is `x` or some other variable. - - - If `t = x`, then from the fact that `Gamma & {{x-->U}} |- - x \in T` we conclude that `U = T`. We must show that - ``x:=v`x = v` has type `T` under `Gamma`, given the - assumption that `v` has type `U = T` under the empty - context. This follows from context invariance: if a - closed term has type `T` in the empty context, it has that - type in any context. - - - If `t` is some variable `y` that is not equal to `x`, then - we need only note that `y` has the same type under `Gamma - & {{x-->U}}` as under `Gamma`. - - - If `t` is an abstraction `\y:T11. t12`, then the IH tells us, - for all `Gamma'` and `T'`, that if `Gamma' & {{x-->U} |- t12 - \in T'` and `|- v \in U`, then `Gamma' |- `x:=v`t12 \in T'`. - - The substitution in the conclusion behaves differently - depending on whether `x` and `y` are the same variable. - - First, suppose `x = y`. Then, by the definition of - substitution, ``x:=v`t = t`, so we just need to show `Gamma |- - t \in T`. But we know `Gamma & {{x-->U}} |- t : T`, and, - since `y` does not appear free in `\y:T11. t12`, the context - invariance lemma yields `Gamma |- t \in T`. - - Second, suppose `x <> y`. We know `Gamma & {{x-->U; y-->T11}} - |- t12 \in T12` by inversion of the typing relation, from - which `Gamma & {{y-->T11; x-->U}} |- t12 \in T12` follows by - the context invariance lemma, so the IH applies, giving us - `Gamma & {{y-->T11}} |- `x:=v`t12 \in T12`. By `T_Abs`, - `Gamma |- \y:T11. `x:=v`t12 \in T11->T12`, and by the - definition of substitution (noting that `x <> y`), `Gamma |- - \y:T11. `x:=v`t12 \in T11->T12` as required. - - - If `t` is an application `t1 t2`, the result follows - straightforwardly from the definition of substitution and the - induction hypotheses. - - - The remaining cases are similar to the application case. - - _Technical note_: This proof is a rare case where an induction on - terms, rather than typing derivations, yields a simpler argument. - The reason for this is that the assumption `Gamma & {{x-->U}} |- t - \in T` is not completely generic, in the sense that one of the - "slots" in the typing relation -- namely the context -- is not - just a variable, and this means that Coq's native induction tactic - does not give us the induction hypothesis that we want. It is - possible to work around this, but the needed generalization is a - little tricky. The term `t`, on the other hand, is completely - generic. *) +> typable_empty__closed : {t: Tm} -> {ty : Ty} -> +> (empty |- t :: ty) -> +> closed t +> typable_empty__closed hyp = ?typable_empty__closed_rhs + +Sometimes, when we have a proof `Gamma |- t : T`, we will need to +replace `Gamma` by a different context `Gamma'`. When is it safe +to do this? Intuitively, it must at least be the case that +`Gamma'` assigns the same types as `Gamma` to all the variables +that appear free in `t`. In fact, this is the only condition that +is needed. + +> context_invariance : {gamma, gamma': Context} -> {t: Tm} -> {ty: Ty} -> +> (gamma |- t :: ty) -> +> ((x: Id) -> Appears_free_in x t -> gamma x = gamma' x) -> +> gamma' |- t :: ty + +_Proof_: By induction on the derivation of `Gamma |- t :: T`. + + - If the last rule in the derivation was `T_Var`, then `t = x` + and `Gamma x = T`. By assumption, `Gamma' x = T` as well, and + hence `Gamma' |- t :: T` by `T_Var`. + + - If the last rule was `T_Abs`, then `t = \y:T11. t12`, with `T + = T11 -> T12` and `Gamma & {{y==>T11}} |- t12 :: T12`. The + induction hypothesis is that, for any context `Gamma''`, if + `Gamma & {{y==>T11}}` and `Gamma''` assign the same types to + all the free variables in `t12`, then `t12` has type `T12` + under `Gamma''`. Let `Gamma'` be a context which agrees with + `Gamma` on the free variables in `t`; we must show `Gamma' |- + \y:T11. t12 :: T11 -> T12`. + + By `T_Abs`, it suffices to show that `Gamma' & {{y==>T11}} |- + t12 :: T12`. By the IH (setting `Gamma'' = Gamma' & + {{y:T11}}`), it suffices to show that `Gamma & {{y==>T11}}` + and `Gamma' & {{y==>T11}}` agree on all the variables that + appear free in `t12`. + + Any variable occurring free in `t12` must be either `y` or + some other variable. `Gamma & {{y==>T11}}` and `Gamma' & + {{y==>T11}}` clearly agree on `y`. Otherwise, note that any + variable other than `y` that occurs free in `t12` also occurs + free in `t = \y:T11. t12`, and by assumption `Gamma` and + `Gamma'` agree on all such variables; hence so do `Gamma & + {{y==>T11}}` and `Gamma' & {{y==>T11}}`. + + - If the last rule was `T_App`, then `t = t1 t2`, with `Gamma |- + t1 :: T2 -> T` and `Gamma |- t2 :: T2`. One induction + hypothesis states that for all contexts `Gamma'`, if `Gamma'` + agrees with `Gamma` on the free variables in `t1`, then `t1` + has type `T2 -> T` under `Gamma'`; there is a similar IH for + `t2`. We must show that `t1 t2` also has type `T` under + `Gamma'`, given the assumption that `Gamma'` agrees with + `Gamma` on all the free variables in `t1 t2`. By `T_App`, it + suffices to show that `t1` and `t2` each have the same type + under `Gamma'` as under `Gamma`. But all free variables in + `t1` are also free in `t1 t2`, and similarly for `t2`; hence + the desired result follows from the induction hypotheses. *) + +> context_invariance T_True freeEq = T_True +> context_invariance T_False freeEq = T_False +> context_invariance {t= Tvar id} (T_Var h) freeEq = +> let hyp = freeEq id (Afi_var {x=id}) +> in T_Var (rewrite sym hyp in h) +> context_invariance {gamma'} {t = Tabs id ty tm} (T_Abs h) freeEq = ?context_invariance_rhs +> context_invariance {gamma} {gamma'} {t = tl # tr} (T_App tyl tyr) freeEq = ?context_invariance_rhs2 +> context_invariance {t = Tif cond pos neg} (T_If condt post negt) freeEq = +> let -- dhyp = Afi_if1 {t1 =cond} {t2 = pos} {t3= neg} ?hyp1 +> hypCond = context_invariance {t=cond} condt _ +> hypPos = context_invariance {t=pos} post ?hypPos +> hypNeg = context_invariance {t=neg} negt ?hypNeg +> in T_If hypCond hypPos hypNeg + +Now we come to the conceptual heart of the proof that reduction +preserves types -- namely, the observation that _substitution_ +preserves types. + +Formally, the so-called _substitution lemma_ says this: +Suppose we have a term `t` with a free variable `x`, and suppose +we've assigned a type `T` to `t` under the assumption that `x` has +some type `U`. Also, suppose that we have some other term `v` and +that we've shown that `v` has type `U`. Then, since `v` satisfies +the assumption we made about `x` when typing `t`, we can +substitute `v` for each of the occurrences of `x` in `t` and +obtain a new term that still has type `T`. + +_Lemma_: If `Gamma & {{x==>U}} |- t :: T` and `|- v :: U`, + then `Gamma |- [x:=v]t :: T` . + +> substitution_preserves_typing : {gamma: Context} -> {x: Id} -> {t, v : Tm} -> {uty, tty: Ty} -> +> ((gamma & {{x ==> uty}}) |- t :: tty) -> +> (empty |- v :: uty) -> +> gamma |- ([x:=v] t) :: tty +> substitution_preserves_typing {x} {t=Tvar id} (T_Var st1) st2 with (decEq x id) +> | Yes prf = let af = 0 -- \ id af => +> in ?hole0 -- context_invariance st2 ?hole00 +> | No contra = let hyp = 0 -- update_neq {v} contra +> in ?hole1 +> substitution_preserves_typing st1 st2 = ?substitution_preserves_typing_rhs + +(One technical subtlety in the statement of the lemma is that +we assume `v` has type `U` in the _empty_ context -- in other +words, we assume `v` is closed. This assumption considerably +simplifies the `T_Abs` case of the proof (compared to assuming +`Gamma |- v :: U`, which would be the other reasonable assumption +at this point) because the context invariance lemma then tells us +that `v` has type `U` in any context at all -- we don't have to +worry about free variables in `v` clashing with the variable being +introduced into the context by `T_Abs`. + +The substitution lemma can be viewed as a kind of commutation +property. Intuitively, it says that substitution and typing can +be done in either order: we can either assign types to the terms +`t` and `v` separately (under suitable contexts) and then combine +them using substitution, or we can substitute first and then +assign a type to ` [x:=v] t ` -- the result is the same either +way. + +_Proof_: We show, by induction on `t`, that for all `T` and +`Gamma`, if `Gamma & {{x==>U}} |- t :: T` and `|- v :: U`, then +`Gamma |- [x:=v] t :: T`. + + - If `t` is a variable there are two cases to consider, + depending on whether `t` is `x` or some other variable. + + - If `t = x`, then from the fact that `Gamma & {{x==>U}} |- + x :: T` we conclude that `U = T`. We must show that + `[x:=v]x = v` has type `T` under `Gamma`, given the + assumption that `v` has type `U = T` under the empty + context. This follows from context invariance: if a + closed term has type `T` in the empty context, it has that + type in any context. + + - If `t` is some variable `y` that is not equal to `x`, then + we need only note that `y` has the same type under `Gamma + & {{x==>U}}` as under `Gamma`. + + - If `t` is an abstraction `\y:T11. t12`, then the IH tells us, + for all `Gamma'` and `T'`, that if `Gamma' & {{x==>U} |- t12 + :: T'` and `|- v :: U`, then `Gamma' |- [x:=v] t12 :: T'`. + + The substitution in the conclusion behaves differently + depending on whether `x` and `y` are the same variable. + + First, suppose `x = y`. Then, by the definition of + substitution, `[x:=v]t = t`, so we just need to show `Gamma |- + t :: T`. But we know `Gamma & {{x==>U}} |- t : T`, and, + since `y` does not appear free in `\y:T11. t12`, the context + invariance lemma yields `Gamma |- t :: T`. + + Second, suppose `x <> y`. We know `Gamma & {{x==>U; y==>T11}} + |- t12 :: T12` by inversion of the typing relation, from + which `Gamma & {{y==>T11; x==>U}} |- t12 :: T12` follows by + the context invariance lemma, so the IH applies, giving us + `Gamma & {{y==>T11}} |- [x:=v]t12 :: T12`. By `T_Abs`, + `Gamma |- \y:T11. [x:=v]t12 :: T11->T12`, and by the + definition of substitution (noting that `x <> y`), `Gamma |- + \y:T11. [x:=v]t12 :: T11->T12` as required. + + - If `t` is an application `t1 t2`, the result follows + straightforwardly from the definition of substitution and the + induction hypotheses. + + - The remaining cases are similar to the application case. + +_Technical note_: This proof is a rare case where an induction on +terms, rather than typing derivations, yields a simpler argument. +The reason for this is that the assumption `Gamma & {{x==>U}} |- t +:: T` is not completely generic, in the sense that one of the +"slots" in the typing relation -- namely the context -- is not +just a variable, and this means that Coq's native induction tactic +does not give us the induction hypothesis that we want. It is +possible to work around this, but the needed generalization is a +little tricky. The term `t`, on the other hand, is completely +generic. Proof with eauto. intros Gamma x U t v T Ht Ht'. @@ -492,79 +478,78 @@ Proof with eauto. rewrite Hxy... Qed. -(* ================================================================= *) -(** ** Main Theorem *) +=== Main Theorem -(** We now have the tools we need to prove preservation: if a closed - term `t` has type `T` and takes a step to `t'`, then `t'` - is also a closed term with type `T`. In other words, the small-step - reduction relation preserves types. *) +We now have the tools we need to prove preservation: if a closed +term `t` has type `T` and takes a step to `t'`, then `t'` +is also a closed term with type `T`. In other words, the small-step +reduction relation preserves types. -Theorem preservation : forall t t' T, - empty |- t \in T -> - t ==> t' -> - empty |- t' \in T. +> preservation : {t, t' : Tm} -> {ty: Ty} -> +> (empty |- t :: ty) -> +> t ->> t' -> +> empty |- t' :: ty -(** _Proof_: By induction on the derivation of `|- t \in T`. +_Proof_: By induction on the derivation of `|- t :: T`. - - We can immediately rule out `T_Var`, `T_Abs`, `T_True`, and - `T_False` as the final rules in the derivation, since in each of - these cases `t` cannot take a step. + - We can immediately rule out `T_Var`, `T_Abs`, `T_True`, and + `T_False` as the final rules in the derivation, since in each of + these cases `t` cannot take a step. - - If the last rule in the derivation is `T_App`, then `t = t1 - t2`. There are three cases to consider, one for each rule that - could be used to show that `t1 t2` takes a step to `t'`. + - If the last rule in the derivation is `T_App`, then `t = t1 + t2`. There are three cases to consider, one for each rule that + could be used to show that `t1 t2` takes a step to `t'`. - - If `t1 t2` takes a step by `ST_App1`, with `t1` stepping to - `t1'`, then by the IH `t1'` has the same type as `t1`, and - hence `t1' t2` has the same type as `t1 t2`. + - If `t1 t2` takes a step by `ST_App1`, with `t1` stepping to + `t1'`, then by the IH `t1'` has the same type as `t1`, and + hence `t1' t2` has the same type as `t1 t2`. - - The `ST_App2` case is similar. + - The `ST_App2` case is similar. - - If `t1 t2` takes a step by `ST_AppAbs`, then `t1 = - \x:T11.t12` and `t1 t2` steps to ``x:=t2`t12`; the - desired result now follows from the fact that substitution - preserves types. + - If `t1 t2` takes a step by `ST_AppAbs`, then `t1 = + \x:T11.t12` and `t1 t2` steps to ``x:=t2`t12`; the + desired result now follows from the fact that substitution + preserves types. - - If the last rule in the derivation is `T_If`, then `t = if t1 - then t2 else t3`, and there are again three cases depending on - how `t` steps. + - If the last rule in the derivation is `T_If`, then `t = if t1 + then t2 else t3`, and there are again three cases depending on + how `t` steps. - - If `t` steps to `t2` or `t3`, the result is immediate, since - `t2` and `t3` have the same type as `t`. + - If `t` steps to `t2` or `t3`, the result is immediate, since + `t2` and `t3` have the same type as `t`. - - Otherwise, `t` steps by `ST_If`, and the desired conclusion - follows directly from the induction hypothesis. *) + - Otherwise, `t` steps by `ST_If`, and the desired conclusion + follows directly from the induction hypothesis. *) -Proof with eauto. - remember (@empty ty) as Gamma. - intros t t' T HT. generalize dependent t'. - induction HT; - intros t' HE; subst Gamma; subst; - try solve `inversion HE; subst; auto`. - - (* T_App *) - inversion HE; subst... - (* Most of the cases are immediate by induction, - and `eauto` takes care of them *) - + (* ST_AppAbs *) - apply substitution_preserves_typing with T11... - inversion HT1... -Qed. +> preservation {t= lt # rt} (T_App tal tar) (ST_App1 red) = +> let indHyp = preservation {t=lt} tal red +> in T_App indHyp tar +> preservation {t= lt # rt} (T_App tal tar) (ST_App2 val red) = +> let indHyp = preservation {t=rt} tar red +> in T_App tal indHyp +> preservation {t= (Tabs x ty lt) # rt} (T_App (T_Abs tabs) tar) (ST_AppAbs val) = +> substitution_preserves_typing {x} {t=lt} {v=rt} tabs tar +> preservation {t= Tif cond pos neg} (T_If condht posht neght) (ST_If val) = +> let indHyp = preservation {t=cond} condht val +> in T_If indHyp posht neght +> preservation {t= Tif Ttrue pos neg} (T_If condht posht neght) ST_IfTrue = posht +> preservation {t= Tif Tfalse pos neg} (T_If condht posht neght) ST_IfFalse = neght + +==== Exercise: 2 stars, recommended (subject_expansion_stlc) -(** **** Exercise: 2 stars, recommended (subject_expansion_stlc) *) -(** An exercise in the `Types` chapter asked about the _subject - expansion_ property for the simple language of arithmetic and - boolean expressions. Does this property hold for STLC? That is, - is it always the case that, if `t ==> t'` and `has_type t' T`, - then `empty |- t \in T`? If so, prove it. If not, give a - counter-example not involving conditionals. +An exercise in the `Types` chapter asked about the _subject +expansion_ property for the simple language of arithmetic and +boolean expressions. Does this property hold for STLC? That is, +is it always the case that, if `t ==> t'` and `has_type t' T`, +then `empty |- t :: T`? If so, prove it. If not, give a +counter-example not involving conditionals. - You can state your counterexample informally - in words, with a brief explanation. +You can state your counterexample informally +in words, with a brief explanation. (* FILL IN HERE *) -*) -(** `` *) + + (* ################################################################# *) (** * Type Soundness *) @@ -577,7 +562,7 @@ Definition stuck (t:tm) : Prop := (normal_form step) t /\ ~ value t. Corollary soundness : forall t t' T, - empty |- t \in T -> + empty |- t :: T -> t ==>* t' -> ~(stuck t'). Proof. @@ -700,10 +685,10 @@ and the following typing rule: (** Suppose instead that we add the following new rule to the typing relation: - Gamma |- t1 \in Bool->Bool->Bool - Gamma |- t2 \in Bool + Gamma |- t1 :: Bool->Bool->Bool + Gamma |- t2 :: Bool ------------------------------ (T_FunnyApp) - Gamma |- t1 t2 \in Bool + Gamma |- t1 t2 :: Bool Which of the following properties of the STLC remain true in the presence of this rule? For each one, write either @@ -723,10 +708,10 @@ and the following typing rule: (** Suppose instead that we add the following new rule to the typing relation: - Gamma |- t1 \in Bool - Gamma |- t2 \in Bool + Gamma |- t1 :: Bool + Gamma |- t2 :: Bool --------------------- (T_FunnyApp') - Gamma |- t1 t2 \in Bool + Gamma |- t1 t2 :: Bool Which of the following properties of the STLC remain true in the presence of this rule? For each one, write either @@ -747,7 +732,7 @@ and the following typing rule: of the STLC: ------------------- (T_FunnyAbs) - |- \x:Bool.t \in Bool + |- \x:Bool.t :: Bool Which of the following properties of the STLC remain true in the presence of this rule? For each one, write either