├── .latex └── Latex-Macros.md ├── Ch03 ├── Arith.idr ├── Exercise_3_5_14.idr ├── Exercise_3_5_17.idr ├── Exercises.md └── Relations.idr ├── Ch04 ├── Eval.idr ├── NaturalInduction.idr └── SubTerm.idr ├── Ch05 ├── EvalLambdaCalculus.idr ├── Exercise_5_2_1.idr ├── Exercise_5_2_10.idr ├── Exercise_5_2_11.idr ├── Exercise_5_2_2.idr ├── Exercise_5_2_3.idr ├── Exercise_5_2_4.idr ├── Exercise_5_2_5.idr ├── Exercise_5_2_7.idr ├── Exercise_5_2_8.idr ├── Exercises.md ├── LambdaCalculus.idr ├── LambdaCalculusWithArith.idr └── VarArg.idr ├── LICENSE ├── Makefile ├── README.md └── tapl.ipkg /.latex/Latex-Macros.md: -------------------------------------------------------------------------------- 1 | --- 2 | header-includes: 3 | - \usepackage{amssymb,amsthm} 4 | - \usepackage[sans]{dsfont} 5 | - \usepackage{mathpartir} 6 | - \usepackage[all,cmtip]{xy} 7 | - \theoremstyle{definition} 8 | - \newcommand\noop[1]{#1} 9 | - \noop{\newtheorem{thm}{Theorem}} 10 | - \noop{\newtheorem{lemma}[thm]{Lemma}} 11 | - \noop{\newtheorem{defn}[thm]{Definition}} 12 | - \noop{\newtheorem{rmk}[thm]{Remark}} 13 | - \noop{\newtheorem{cor}[thm]{Corollary}} 14 | - \newcommand{\bbf}[1]{\mathds{#1}} 15 | - \newcommand{\N}{\bbf{N}} 16 | - \newcommand{\car}{\texttt{car}} 17 | - \newcommand{\cdr}{\texttt{cdr}} 18 | --- 19 | -------------------------------------------------------------------------------- /Ch03/Arith.idr: -------------------------------------------------------------------------------- 1 | module Ch03.Arith 2 | 3 | import public Ch03.Relations 4 | 5 | %default total 6 | %access public export 7 | 8 | ---------------------------- 9 | -- Term syntax 10 | ---------------------------- 11 | 12 | namespace Terms 13 | data Term = True 14 | | False 15 | | IfThenElse Term Term Term 16 | | Zero 17 | | Succ Term 18 | | Pred Term 19 | | IsZero Term 20 | 21 | namespace Values 22 | mutual 23 | Value : Type 24 | Value = Either BoolValue NumValue 25 | 26 | data BoolValue = True | False 27 | data NumValue = Zero | Succ NumValue 28 | 29 | ||| Converts a boolean value to its corresponding term 30 | bv2t : BoolValue -> Term 31 | bv2t True = True 32 | bv2t False = False 33 | 34 | ||| Converts a numeric value to its corresponding term 35 | nv2t : NumValue -> Term 36 | nv2t Zero = Zero 37 | nv2t (Succ x) = Succ (nv2t x) 38 | 39 | ||| Converts a value to its corresponding term 40 | v2t : Value -> Term 41 | v2t (Left bv) = bv2t bv 42 | v2t (Right nv) = nv2t nv 43 | 44 | namespace IsValue 45 | ||| Propositional type describing that a term "is" indeed a value 46 | data IsValue : Term -> Type where 47 | ConvertedFrom : (v : Value) -> IsValue (v2t v) 48 | 49 | namespace IsNumValue 50 | ||| Propositional type describing that a term "is" indeed a numeric value 51 | data IsNumValue : Term -> Type where 52 | ConvertedFrom : (nv : NumValue) -> IsNumValue (v2t (Right nv)) 53 | 54 | namespace IsBoolValue 55 | ||| Propositional type describing that a term "is" indeed a boolean value 56 | data IsBoolValue : Term -> Type where 57 | ConvertedFrom : (bv : BoolValue) -> IsBoolValue (v2t (Left bv)) 58 | 59 | ---------------------------- 60 | -- Evaluation rules 61 | ---------------------------- 62 | 63 | ||| Propositional type describing that the first term one-step-evaluates to the second 64 | ||| 65 | ||| Explicitly, an inhabitant of `EvalsTo t1 t2` is a proof that `t1` evaluates to `t2` in one step. 66 | data EvalsTo : Term -> Term -> Type where 67 | EIfTrue : EvalsTo (IfThenElse True t2 t3) t2 68 | EIfFalse : EvalsTo (IfThenElse False t2 t3) t3 69 | EIf : EvalsTo t1 t1' -> EvalsTo (IfThenElse t1 t2 t3) (IfThenElse t1' t2 t3) 70 | ESucc : EvalsTo t1 t2 -> EvalsTo (Succ t1) (Succ t2) 71 | EPredZero : EvalsTo (Pred Zero) Zero 72 | EPredSucc : {pf : IsNumValue nv1} -> EvalsTo (Pred (Succ nv1)) nv1 73 | EPred : EvalsTo t1 t2 -> EvalsTo (Pred t1) (Pred t2) 74 | EIsZeroZero : EvalsTo (IsZero Zero) True 75 | EIsZeroSucc : {pf : IsNumValue nv1} -> EvalsTo (IsZero (Succ nv1)) False 76 | EIsZero : EvalsTo t1 t2 -> EvalsTo (IsZero t1) (IsZero t2) 77 | 78 | ||| Propositional type describing that the first term evaluates to the second in a finite number of steps 79 | ||| 80 | ||| Explicitly, an inhabitant of `EvalToStar t1 t2` is a proof that there is a finite sequence 81 | ||| 82 | ||| t1 = s_0, s_1, ..., s_n = t2 83 | ||| 84 | ||| of terms (where `0 <= n`), such that `s_i` one-step-evaluates to `s_{i+1}`. 85 | EvalsToStar : Term -> Term -> Type 86 | EvalsToStar = ReflSymmClos EvalsTo 87 | 88 | ---------------------------- 89 | -- Big Step Evaluation rules 90 | ---------------------------- 91 | 92 | ||| Propositional type describing that the first term big-step evaluates to the second 93 | data BigEvalsTo : Term -> Term -> Type where 94 | BValue : {pf : IsValue v} -> BigEvalsTo v v 95 | BIfTrue : {pf : IsValue v2} -> 96 | BigEvalsTo t1 True -> 97 | BigEvalsTo t2 v2 -> 98 | BigEvalsTo (IfThenElse t1 t2 t3) v2 99 | BIfFalse : {pf : IsValue v3} -> 100 | BigEvalsTo t1 False -> 101 | BigEvalsTo t3 v3 -> 102 | BigEvalsTo (IfThenElse t1 t2 t3) v3 103 | BSucc : {pf : IsNumValue nv1} -> 104 | BigEvalsTo t1 nv1 -> 105 | BigEvalsTo (Succ t1) (Succ nv1) 106 | BPredZero : BigEvalsTo t1 Zero -> 107 | BigEvalsTo (Pred t1) Zero 108 | BPredSucc : {pf : IsNumValue nv1} -> 109 | BigEvalsTo t1 (Succ nv1) -> 110 | BigEvalsTo (Pred t1) nv1 111 | BIsZeroZero : BigEvalsTo t1 Zero -> 112 | BigEvalsTo (IsZero t1) True 113 | BIsZeroSucc : {pf : IsNumValue nv1} -> 114 | BigEvalsTo t1 (Succ nv1) -> 115 | BigEvalsTo (IsZero t1) False 116 | 117 | -------------------------------------------------------------------------------- 118 | -- Some properties of values and evaluation 119 | -------------------------------------------------------------------------------- 120 | 121 | ||| A numeric value is also a value 122 | numValueIsValue : IsNumValue t -> IsValue t 123 | numValueIsValue {t = (v2t (Right nv))} (ConvertedFrom nv) = IsValue.ConvertedFrom (Right nv) 124 | 125 | ||| The successor of a numeric value is a numeric value 126 | succNumValueIsNumValue : IsNumValue t -> IsNumValue (Succ t) 127 | succNumValueIsNumValue {t = (v2t (Right nv))} (ConvertedFrom nv) = ConvertedFrom (Succ nv) 128 | 129 | ||| A boolean value is also a value 130 | boolValueIsValue : IsBoolValue t -> IsValue t 131 | boolValueIsValue {t = (v2t (Left bv))} (ConvertedFrom bv) = IsValue.ConvertedFrom (Left bv) 132 | 133 | numValueEither : IsNumValue t -> Either (t = Zero) (t' : Term ** (IsNumValue t', t = Succ t')) 134 | numValueEither (ConvertedFrom nv) = case nv of 135 | Zero => Left Refl 136 | (Succ nv') => Right (nv2t nv' ** (ConvertedFrom nv', Refl)) 137 | 138 | boolValueEither : IsBoolValue t -> Either (t = True) (t = False) 139 | boolValueEither (ConvertedFrom True) = Left Refl 140 | boolValueEither (ConvertedFrom False) = Right Refl 141 | 142 | zeroNotBool : IsBoolValue Zero -> Void 143 | zeroNotBool (ConvertedFrom True) impossible 144 | zeroNotBool (ConvertedFrom False) impossible 145 | 146 | succNotTrue : {t : Term} -> (Succ t = True) -> Void 147 | succNotTrue Refl impossible 148 | 149 | succNotFalse : {t : Term} -> (Succ t = False) -> Void 150 | succNotFalse Refl impossible 151 | 152 | succNotBool : IsBoolValue (Succ t) -> Void 153 | succNotBool {t} x = case boolValueEither x of 154 | (Left l) => succNotTrue l 155 | (Right r) => succNotFalse r 156 | 157 | ||| A value can't be both numeric and boolean at the same time. 158 | numNotBool : IsNumValue t -> IsBoolValue t -> Void 159 | numNotBool x y = case numValueEither x of 160 | (Left Refl) => zeroNotBool y 161 | (Right (_ ** (_, Refl))) => succNotBool y 162 | 163 | ||| Proof that values don't evaluate to anything in the `E`-calculus. 164 | valuesDontEvaluate : {pf : IsValue v} -> EvalsTo v t -> Void 165 | valuesDontEvaluate {pf = (ConvertedFrom (Left bv))} {v = (bv2t bv)} x = case bv of 166 | True => (case x of 167 | EIfTrue impossible 168 | EIfFalse impossible 169 | (EIf _) impossible 170 | (ESucc _) impossible 171 | EPredZero impossible 172 | EPredSucc impossible 173 | (EPred _) impossible 174 | EIsZeroZero impossible 175 | EIsZeroSucc impossible 176 | (EIsZero _) impossible) 177 | False => (case x of 178 | EIfTrue impossible 179 | EIfFalse impossible 180 | (EIf _) impossible 181 | (ESucc _) impossible 182 | EPredZero impossible 183 | EPredSucc impossible 184 | (EPred _) impossible 185 | EIsZeroZero impossible 186 | EIsZeroSucc impossible 187 | (EIsZero _) impossible) 188 | valuesDontEvaluate {pf = (ConvertedFrom (Right nv))} {v = (nv2t nv)} x = case nv of 189 | Zero => (case x of 190 | EIfTrue impossible 191 | EIfFalse impossible 192 | (EIf _) impossible 193 | (ESucc _) impossible 194 | EPredZero impossible 195 | EPredSucc impossible 196 | (EPred _) impossible 197 | EIsZeroZero impossible 198 | EIsZeroSucc impossible 199 | (EIsZero _) impossible) 200 | (Succ nv) => (case x of 201 | (ESucc y) => valuesDontEvaluate {pf=ConvertedFrom (Right nv)} y) 202 | 203 | ||| Proof that the only derivation of a value term in the reflexive transitive of the `E`-evaluation rules 204 | ||| is the trivial derivation. 205 | valuesAreNormal : {pf : IsValue v} -> (r : EvalsToStar v t) -> (r = (Refl {rel=EvalsTo} {x=v})) 206 | valuesAreNormal (Refl {x}) = Refl 207 | valuesAreNormal {pf} (Cons x y) with (valuesDontEvaluate {pf=pf} x) 208 | valuesAreNormal {pf} (Cons x y) | with_pat impossible 209 | 210 | ||| Proof that a value is either 211 | ||| 212 | ||| 1. `True` 213 | ||| 2. `False` 214 | ||| 3. `Zero` 215 | ||| 4. `Succ nv`, with `nv` a numeric value 216 | valueIsEither : (v : Term) -> {pf : IsValue v} -> Either (v = True) (Either (v = False) (Either (v = Zero) (nv : Term ** ((v = Succ nv), IsNumValue nv)))) 217 | valueIsEither (bv2t x) {pf = (ConvertedFrom (Left x))} = case x of 218 | True => Left Refl 219 | False => Right (Left Refl) 220 | valueIsEither (nv2t x) {pf = (ConvertedFrom (Right x))} = case x of 221 | Zero => Right (Right (Left Refl)) 222 | (Succ y) => Right (Right (Right (nv2t y ** (Refl, ConvertedFrom y)))) 223 | 224 | ||| Proof that a term of the form `Succ t` is only a value if `t` is a numeric value. 225 | succIsValueIf : IsValue (Succ t) -> IsNumValue t 226 | succIsValueIf (ConvertedFrom (Left Values.True)) impossible 227 | succIsValueIf (ConvertedFrom (Left Values.False)) impossible 228 | succIsValueIf (ConvertedFrom (Right Values.Zero)) impossible 229 | succIsValueIf (ConvertedFrom (Right (Succ nv))) = ConvertedFrom nv 230 | 231 | ||| Proof that a term of the form `Pred t` is never a value. 232 | predNotValue : IsValue (Pred t) -> Void 233 | predNotValue (ConvertedFrom (Left Values.True)) impossible 234 | predNotValue (ConvertedFrom (Left Values.False)) impossible 235 | predNotValue (ConvertedFrom (Right Values.Zero)) impossible 236 | predNotValue (ConvertedFrom (Right (Values.Succ nv))) impossible 237 | 238 | ||| Proof that a term of the form `IsZero t` is never a value. 239 | isZeroNotValue : IsValue (IsZero t) -> Void 240 | isZeroNotValue (ConvertedFrom (Left Values.True)) impossible 241 | isZeroNotValue (ConvertedFrom (Left Values.False)) impossible 242 | isZeroNotValue (ConvertedFrom (Right Values.Zero)) impossible 243 | isZeroNotValue (ConvertedFrom (Right (Values.Succ nv))) impossible 244 | 245 | ||| Proof that a value only evaluates to itself under the reflexive transitive closure of 246 | ||| the `E`-evaluation rules. 247 | valuesAreNormal' : {pf : IsValue v} -> 248 | EvalsToStar v t -> 249 | (t = v) 250 | valuesAreNormal' {pf} x with (valuesAreNormal {pf=pf} x) 251 | valuesAreNormal' {pf} x | with_pat = case with_pat of 252 | Refl => Refl 253 | 254 | ||| Proof that a term of the form `IfThenElse x y z` is never a value. 255 | ifThenElseNotNormal : (pf : IsValue (IfThenElse x y z)) -> Void 256 | ifThenElseNotNormal {x} {y} {z} pf with (valueIsEither (IfThenElse x y z) {pf=pf}) 257 | ifThenElseNotNormal {x} {y} {z} pf | (Left l) = case l of 258 | Refl impossible 259 | ifThenElseNotNormal {x} {y} {z} pf | (Right (Left l)) = case l of 260 | Refl impossible 261 | ifThenElseNotNormal {x} {y} {z} pf | (Right (Right (Left l))) = case l of 262 | Refl impossible 263 | ifThenElseNotNormal {x} {y} {z} pf | (Right (Right (Right (nv ** (pf1, pf2))))) = case pf1 of 264 | Refl impossible 265 | ---------------------------- 266 | -- Miscellanea 267 | ---------------------------- 268 | 269 | t1 : Term 270 | t1 = IfThenElse False Zero (Succ Zero) 271 | 272 | t2 : Term 273 | t2 = IsZero (Pred (Succ Zero)) 274 | 275 | toString : Term -> String 276 | toString True = "true" 277 | toString False = "false" 278 | toString (IfThenElse x y z) = "if " ++ toString x ++ 279 | " then " ++ toString y ++ 280 | " else " ++ toString z 281 | toString Zero = "0" 282 | toString (Succ x) = "succ (" ++ toString x ++ ")" 283 | toString (Pred x) = "pred (" ++ toString x ++ ")" 284 | toString (IsZero x) = "iszero (" ++ toString x ++ ")" 285 | 286 | eval : Term -> Value 287 | eval True = Left True 288 | eval False = Left True 289 | eval (IfThenElse x y z) = case eval x of 290 | (Left r) => case r of 291 | True => eval y 292 | False => eval z 293 | (Right l) => ?eval_rhs_1 294 | eval Zero = Right Zero 295 | eval (Succ x) = case eval x of 296 | Left l => ?eval_rhs_4 297 | Right r => Right (Succ r) 298 | eval (Pred x) = case eval x of 299 | Left l => ?eval_rhs_5 300 | Right r => case r of 301 | Zero => Right Zero 302 | Succ x => Right x 303 | eval (IsZero x) = case x of 304 | Zero => Left True 305 | Succ y => Left False 306 | _ => ?eval_rhs2 307 | 308 | ||| The size of a term is the number of constructors it contains. 309 | size : Term -> Nat 310 | size True = 1 311 | size False = 1 312 | size (IfThenElse x y z) = (size x) + (size y) + (size z) + 1 313 | size Zero = 1 314 | size (Succ x) = S (size x) 315 | size (Pred x) = S (size x) 316 | size (IsZero x) = S (size x) 317 | 318 | ||| The depth of a term is depth of its derivation tree. 319 | depth : Term -> Nat 320 | depth True = 1 321 | depth False = 1 322 | depth (IfThenElse x y z) = (max (depth x) (max (depth y) (depth z))) + 1 323 | depth Zero = 1 324 | depth (Succ x) = S (depth x) 325 | depth (Pred x) = S (depth x) 326 | depth (IsZero x) = S (depth x) 327 | -------------------------------------------------------------------------------- /Ch03/Exercise_3_5_14.idr: -------------------------------------------------------------------------------- 1 | module Ch03.Exercise_3_5_14 2 | 3 | import Ch03.Arith 4 | 5 | %default total 6 | 7 | numValueProofIs : {t : Term} -> 8 | (pf : IsNumValue t) -> 9 | (nv : NumValue ** (t = nv2t nv, pf = ConvertedFrom nv)) 10 | numValueProofIs {t = (v2t (Right nv))} (ConvertedFrom nv) = (nv ** (Refl, Refl)) 11 | 12 | zeroNotSucc : {t : Term} -> 13 | (Zero = Succ t) -> Void 14 | zeroNotSucc Refl impossible 15 | 16 | succ_inj : {t1, t2 : Term} -> 17 | (Succ t1 = Succ t2) -> 18 | (t1 = t2) 19 | succ_inj Refl = Refl 20 | 21 | nv2t_inj : {nv1, nv2 : NumValue} -> 22 | (nv2t nv1 = nv2t nv2) -> 23 | (nv1 = nv2) 24 | nv2t_inj {nv1=Zero} {nv2=Zero} prf = Refl 25 | nv2t_inj {nv1=Zero} {nv2=Succ x} prf = absurd (zeroNotSucc prf) 26 | nv2t_inj {nv1=Succ x} {nv2=Zero} prf = absurd (zeroNotSucc (sym prf)) 27 | nv2t_inj {nv1=Succ x} {nv2=Succ y} prf = cong (nv2t_inj (succ_inj prf)) 28 | 29 | numValueProofsUnique : {t : Term} -> 30 | (pf1 : IsNumValue t) -> 31 | (pf2 : IsNumValue t) -> 32 | (pf1 = pf2) 33 | numValueProofsUnique pf1 pf2 with (numValueProofIs pf1) 34 | numValueProofsUnique pf1 pf2 | (nv ** (pf_t, pf_pf)) with (numValueProofIs pf2) 35 | numValueProofsUnique pf1 pf2 | (nv ** (pf_t, pf_pf)) | (nv' ** (pf_t', pf_pf')) = case nv2t_inj {nv1=nv} {nv2=nv'} (trans (sym pf_t) pf_t') of 36 | Refl => trans pf_pf (sym pf_pf') 37 | uniqueEval : (t : Term) -> 38 | (r : EvalsTo t t') -> 39 | (r' : EvalsTo t t'') -> 40 | (r = r') 41 | uniqueEval True EIfTrue _ impossible 42 | uniqueEval True EIfFalse _ impossible 43 | uniqueEval True (EIf _) _ impossible 44 | uniqueEval True (ESucc _) _ impossible 45 | uniqueEval True EPredZero _ impossible 46 | uniqueEval True EPredSucc _ impossible 47 | uniqueEval True (EPred _) _ impossible 48 | uniqueEval True EIsZeroZero _ impossible 49 | uniqueEval True EIsZeroSucc _ impossible 50 | uniqueEval True (EIsZero _) _ impossible 51 | uniqueEval False EIfTrue _ impossible 52 | uniqueEval False EIfFalse _ impossible 53 | uniqueEval False (EIf _) _ impossible 54 | uniqueEval False (ESucc _) _ impossible 55 | uniqueEval False EPredZero _ impossible 56 | uniqueEval False EPredSucc _ impossible 57 | uniqueEval False (EPred _) _ impossible 58 | uniqueEval False EIsZeroZero _ impossible 59 | uniqueEval False EIsZeroSucc _ impossible 60 | uniqueEval False (EIsZero _) _ impossible 61 | uniqueEval (IfThenElse True y z) EIfTrue EIfTrue = Refl 62 | uniqueEval (IfThenElse True y z) EIfTrue (EIf x) impossible 63 | uniqueEval (IfThenElse False y z) EIfFalse EIfFalse = Refl 64 | uniqueEval (IfThenElse False y z) EIfFalse (EIf x) impossible 65 | uniqueEval (IfThenElse True y z) (EIf w) EIfTrue impossible 66 | uniqueEval (IfThenElse False y z) (EIf w) EIfFalse impossible 67 | uniqueEval (IfThenElse x y z) (EIf w) (EIf s) = case uniqueEval x w s of 68 | Refl => Refl 69 | uniqueEval Zero EIfTrue _ impossible 70 | uniqueEval Zero EIfFalse _ impossible 71 | uniqueEval Zero (EIf _) _ impossible 72 | uniqueEval Zero (ESucc _) _ impossible 73 | uniqueEval Zero EPredZero _ impossible 74 | uniqueEval Zero EPredSucc _ impossible 75 | uniqueEval Zero (EPred _) _ impossible 76 | uniqueEval Zero EIsZeroZero _ impossible 77 | uniqueEval Zero EIsZeroSucc _ impossible 78 | uniqueEval Zero (EIsZero _) _ impossible 79 | uniqueEval (Succ x) (ESucc y) (ESucc z) = case uniqueEval x y z of 80 | Refl => Refl 81 | uniqueEval (Pred Zero) EPredZero EPredZero = Refl 82 | uniqueEval (Pred Zero) EPredZero (EPred x) impossible 83 | uniqueEval (Pred (Succ t')) (EPredSucc {pf=pf1}) (EPredSucc {pf=pf2}) = case numValueProofsUnique pf1 pf2 of 84 | Refl => Refl 85 | uniqueEval (Pred (Succ t')) (EPredSucc {pf}) (EPred x) = absurd (valuesDontEvaluate {pf=(numValueIsValue (succNumValueIsNumValue pf))} x) 86 | uniqueEval (Pred Zero) (EPred y) EPredZero = absurd (valuesDontEvaluate {pf=IsValue.ConvertedFrom (Right Zero)} y) 87 | uniqueEval (Pred (Succ t')) (EPred y) (EPredSucc {pf}) = absurd (valuesDontEvaluate {pf=(numValueIsValue (succNumValueIsNumValue pf))} y) 88 | 89 | uniqueEval (Pred x) (EPred y) (EPred z) = case uniqueEval x y z of 90 | Refl => Refl 91 | uniqueEval (IsZero Zero) EIsZeroZero EIsZeroZero = Refl 92 | uniqueEval (IsZero Zero) EIsZeroZero (EIsZero x) impossible 93 | uniqueEval (IsZero (Succ nv1)) (EIsZeroSucc {pf=pf1}) (EIsZeroSucc {pf=pf2}) = case numValueProofsUnique pf1 pf2 of 94 | Refl => Refl 95 | uniqueEval (IsZero (Succ nv1)) (EIsZeroSucc {pf}) (EIsZero x) = absurd (valuesDontEvaluate {pf=(numValueIsValue (succNumValueIsNumValue pf))} x) 96 | uniqueEval (IsZero Zero) (EIsZero y) EIsZeroZero impossible 97 | uniqueEval (IsZero (Succ nv1)) (EIsZero y) (EIsZeroSucc {pf}) = absurd (valuesDontEvaluate {pf=(numValueIsValue (succNumValueIsNumValue pf))} y) 98 | uniqueEval (IsZero x) (EIsZero y) (EIsZero z) = case uniqueEval x y z of 99 | Refl => Refl 100 | 101 | ||| Proof that the one-step evaluation rules of the arithmetic language are deterministic (Ex. 3.5.14). 102 | detVal : {t,t',t'' : Term} -> 103 | EvalsTo t t' -> 104 | EvalsTo t t'' -> 105 | (t' = t'') 106 | detVal {t} pf pf' = case uniqueEval t pf pf' of 107 | Refl => Refl 108 | -------------------------------------------------------------------------------- /Ch03/Exercise_3_5_17.idr: -------------------------------------------------------------------------------- 1 | module Ch03.Exercise_3_5_17 2 | 3 | import Ch03.Arith 4 | 5 | %default total 6 | 7 | -------------------------------------------------------------------------------- 8 | -- Exercise 3.5.17 9 | -------------------------------------------------------------------------------- 10 | 11 | ||| Big step evaluation rules expressed in terms of reflexive-transitive closure 12 | ||| of small-step evaluation rules 13 | data BInE : Term -> Term -> Type where 14 | BInEValue : {pf : IsValue v} -> BInE v v 15 | BInEIfTrue : {pf : IsValue v2} -> 16 | {t1, t2, t3 : Term} -> 17 | EvalsToStar t1 True -> 18 | EvalsToStar t2 v2 -> 19 | BInE (IfThenElse t1 t2 t3) v2 20 | BInEIfFalse : {pf : IsValue v3} -> 21 | {t1, t2, t3 : Term} -> 22 | EvalsToStar t1 False -> 23 | EvalsToStar t3 v3 -> 24 | BInE (IfThenElse t1 t2 t3) v3 25 | BInESucc : {pf : IsNumValue nv1} -> 26 | {t1 : Term} -> 27 | EvalsToStar t1 nv1 -> 28 | BInE (Succ t1) (Succ nv1) 29 | BInEPredZero : {t1 : Term} -> 30 | EvalsToStar t1 Zero -> 31 | BInE (Pred t1) Zero 32 | BInEPredSucc : {t1 : Term} -> 33 | {pf : IsNumValue nv1} -> 34 | EvalsToStar t1 (Succ nv1) -> 35 | BInE (Pred t1) nv1 36 | BInEIsZeroZero : {t1 : Term} -> 37 | EvalsToStar t1 Zero -> 38 | BInE (IsZero t1) True 39 | BInEIsZeroSucc : {t1 : Term} -> 40 | {pf : IsNumValue nv1} -> 41 | EvalsToStar t1 (Succ nv1) -> 42 | BInE (IsZero t1) False 43 | 44 | ||| Given a (one-step) derivation in the `BInE`-calculus, computes its corresponding derivation 45 | ||| in the `E`-calculus. 46 | from_BInE_to_E : BInE t v -> EvalsToStar t v 47 | from_BInE_to_E BInEValue = Refl 48 | from_BInE_to_E (BInEIfTrue {t2} {t3} x y) = map {func=(\t => IfThenElse t t2 t3)} EIf x 49 | ++ Cons EIfTrue y 50 | from_BInE_to_E (BInEIfFalse {t2} {t3} x y) = map {func=(\t => IfThenElse t t2 t3)} EIf x 51 | ++ Cons EIfFalse y 52 | from_BInE_to_E (BInESucc x) = map ESucc x 53 | from_BInE_to_E (BInEPredZero x) = map EPred x ++ weaken EPredZero 54 | from_BInE_to_E (BInEPredSucc {pf} x) = map EPred x ++ weaken (EPredSucc {pf=pf}) 55 | from_BInE_to_E (BInEIsZeroZero x) = map EIsZero x ++ weaken EIsZeroZero 56 | from_BInE_to_E (BInEIsZeroSucc {pf} x) = map EIsZero x ++ weaken (EIsZeroSucc {pf=pf}) 57 | 58 | -------------------------------------------------------------------------------- 59 | -- Sublemmas of `from_E_to_BInE` 60 | -------------------------------------------------------------------------------- 61 | 62 | lemma_EIfTrue : {t2, t3 : Term} -> 63 | {pf : IsValue v} -> 64 | (d' : EvalsToStar t2 v) -> 65 | (r : BInE (IfThenElse True t2 t3) v ** Cons EIfTrue d' = from_BInE_to_E r) 66 | lemma_EIfTrue {pf} d' = (BInEIfTrue {pf=pf} Refl d' ** Refl) 67 | 68 | lemma_EIfFalse : {t2, t3 : Term} -> 69 | {pf : IsValue v} -> 70 | (d' : EvalsToStar t3 v) -> 71 | (r : BInE (IfThenElse False t2 t3) v ** Cons EIfFalse d' = from_BInE_to_E r) 72 | lemma_EIfFalse {pf} d' = (BInEIfFalse {pf=pf} Refl d' ** Refl) 73 | 74 | lemma_EIf : {t1, t2, t3 : Term} -> 75 | {pf : IsValue v} -> 76 | {x : EvalsTo t1 t1'} -> 77 | (d' : EvalsToStar (IfThenElse t1' t2 t3) v) -> 78 | (r' : BInE (IfThenElse t1' t2 t3) v ** d' = from_BInE_to_E r') -> 79 | (r : BInE (IfThenElse t1 t2 t3) v ** Cons (EIf x) d' = from_BInE_to_E r) 80 | lemma_EIf {pf} {x} d' (r' ** pf') = case r' of 81 | BInEValue {pf} => absurd (ifThenElseNotNormal pf) 82 | BInEIfTrue d1 d2 => (BInEIfTrue {pf=pf} (Cons x d1) d2 ** cong pf') 83 | BInEIfFalse d1 d2 => (BInEIfFalse {pf=pf} (Cons x d1) d2 ** cong pf') 84 | 85 | lemma_ESucc : {t1 : Term} -> 86 | {pf : IsValue v} -> 87 | (x : EvalsTo t1 t1') -> 88 | (r' : BInE (Succ t1') v ** d' = from_BInE_to_E r') -> 89 | (r : BInE (Succ t1) v ** Cons (ESucc x) d' = from_BInE_to_E r) 90 | lemma_ESucc {pf} x (r' ** pf') = case r' of 91 | BInEValue => case succIsValueIf pf of 92 | nv_pf@(ConvertedFrom nv) => (BInESucc {pf=nv_pf} (weaken x) ** cong pf') 93 | BInESucc {pf} d'' => (BInESucc {pf=pf} (Cons x d'') ** cong pf') 94 | 95 | lemma_EPred : {t1, t1' : Term} -> 96 | {pf : IsValue v} -> 97 | (x : EvalsTo t1 t1') -> 98 | (r' : BInE (Pred t1') v ** d' = from_BInE_to_E r') -> 99 | (r : BInE (Pred t1) v ** Cons (EPred x) d' = from_BInE_to_E r) 100 | lemma_EPred {pf} x (r' ** pf') = case r' of 101 | BInEValue {pf=pf_val} => absurd (predNotValue pf_val) 102 | BInEPredZero y => (BInEPredZero (Cons x y) ** cong pf') 103 | BInEPredSucc {pf=pf_v} y => (BInEPredSucc {pf=pf_v} (Cons x y) ** cong pf') 104 | 105 | lemma_EIsZero : {t1, t1', v : Term} -> 106 | {pf : IsValue v} -> 107 | (x : EvalsTo t1 t1') -> 108 | (r' : BInE (IsZero t1') v ** d' = from_BInE_to_E r') -> 109 | (r : BInE (IsZero t1) v ** Cons (EIsZero x) d' = from_BInE_to_E r) 110 | lemma_EIsZero {pf} x (r' ** pf') = case r' of 111 | BInEValue {pf=pf_val} => absurd (isZeroNotValue pf_val) 112 | BInEIsZeroZero y => (BInEIsZeroZero (Cons x y) ** cong pf') 113 | BInEIsZeroSucc {pf=pf_v} y => (BInEIsZeroSucc {pf=pf_v} (Cons x y) ** cong pf') 114 | 115 | ||| Deconstructs a derivation of a term `t` to a value `v` in the `E`-calculus into a (one-step) derivation 116 | ||| in the `BInE`-calculus. 117 | from_E_to_BInE : {pf : IsValue v} -> 118 | (d : EvalsToStar t v) -> (r : BInE t v ** d = from_BInE_to_E r) 119 | from_E_to_BInE {pf} {t = True} Refl = (BInEValue {pf=ConvertedFrom (Left True)} {v=True} ** Refl) 120 | from_E_to_BInE {pf} {t = True} (Cons x y) = absurd (valuesDontEvaluate {pf=ConvertedFrom (Left True)} x) 121 | from_E_to_BInE {pf} {t = False} Refl = (BInEValue {pf=ConvertedFrom (Left False)} {v=False} ** Refl) 122 | from_E_to_BInE {pf} {t = False} (Cons x y) = absurd (valuesDontEvaluate {pf=ConvertedFrom (Left False)} x) 123 | from_E_to_BInE {pf} {t = (IfThenElse x y z)} Refl = absurd (ifThenElseNotNormal pf) 124 | from_E_to_BInE {pf} {t = (IfThenElse x y z)} (Cons w s) = case w of 125 | EIfTrue => lemma_EIfTrue {pf=pf} s 126 | EIfFalse => lemma_EIfFalse {pf=pf} s 127 | (EIf r) => lemma_EIf {pf=pf} s (from_E_to_BInE {pf=pf} s) 128 | from_E_to_BInE {pf} {t = Zero} d = case valuesAreNormal' {pf=ConvertedFrom (Right Zero)} d of 129 | Refl => case d of 130 | Refl => (BInEValue {pf=ConvertedFrom (Right Zero)} ** Refl) 131 | (Cons x y) => absurd (valuesDontEvaluate {pf=ConvertedFrom (Right Zero)} x) 132 | from_E_to_BInE {pf} {t = (Succ x)} Refl = case succIsValueIf pf of 133 | ConvertedFrom nv => (BInEValue {pf=ConvertedFrom (Right (Succ nv))} ** Refl) 134 | from_E_to_BInE {pf} {t = (Succ x)} (Cons y z) = case y of 135 | ESucc y' => lemma_ESucc {pf=pf} y' (from_E_to_BInE {pf=pf} z) 136 | from_E_to_BInE {pf} {t = (Pred x)} Refl = absurd (predNotValue pf) 137 | from_E_to_BInE {pf} {t = (Pred x)} (Cons y z) = case y of 138 | EPredZero => case valuesAreNormal {pf=ConvertedFrom (Right Zero)} z of 139 | Refl => (BInEPredZero Refl ** Refl) 140 | EPredSucc {nv1} {pf=pf_nv} => case valuesAreNormal {pf=numValueIsValue pf_nv} z of 141 | Refl => (BInEPredSucc {pf=pf_nv} Refl ** Refl) 142 | EPred y' => lemma_EPred {pf=pf} y' (from_E_to_BInE {pf=pf} z) 143 | from_E_to_BInE {pf} {t = (IsZero x)} Refl = absurd (isZeroNotValue pf) 144 | from_E_to_BInE {pf} {t = (IsZero x)} (Cons y z) = case y of 145 | EIsZeroZero => case valuesAreNormal {pf=ConvertedFrom (Left True)} z of 146 | Refl => (BInEIsZeroZero Refl ** Refl) 147 | EIsZeroSucc => case valuesAreNormal {pf=ConvertedFrom (Left False)} z of 148 | Refl => (BInEIsZeroSucc Refl ** Refl) 149 | EIsZero y' => lemma_EIsZero {pf=pf} y' (from_E_to_BInE {pf=pf} z) 150 | 151 | ||| Converts a derivation in `BInE`-calculus to a derivation in the `B`-calculus. 152 | from_BInE_to_B : {pf : IsValue v} -> BInE t v -> BigEvalsTo t v 153 | from_BInE_to_B {pf} BInEValue = BValue {pf=pf} 154 | from_BInE_to_B {pf} (BInEIfTrue y z) = let pf_true = ConvertedFrom (Left True) 155 | y' = fst (from_E_to_BInE {pf=pf_true} y) 156 | z' = fst (from_E_to_BInE {pf=pf} z) in 157 | BIfTrue {pf=pf} (from_BInE_to_B {pf=pf_true} y') (from_BInE_to_B {pf=pf} z') 158 | from_BInE_to_B {pf} (BInEIfFalse y z) = let pf_false = ConvertedFrom (Left False) 159 | y' = fst (from_E_to_BInE {pf=pf_false} y) 160 | z' = fst (from_E_to_BInE {pf=pf} z) in 161 | BIfFalse {pf=pf} (from_BInE_to_B {pf=pf_false} y') (from_BInE_to_B {pf=pf} z') 162 | from_BInE_to_B {pf} (BInESucc {pf=pf_nv} y) = let y' = fst (from_E_to_BInE {pf=numValueIsValue pf_nv} y) in 163 | BSucc {pf=pf_nv} (from_BInE_to_B {pf=numValueIsValue pf_nv} y') 164 | from_BInE_to_B {pf} (BInEPredZero x) = let pf_zero = ConvertedFrom (Right Zero) 165 | x' = fst (from_E_to_BInE {pf=pf_zero} x) in 166 | BPredZero (from_BInE_to_B {pf=pf_zero} x') 167 | from_BInE_to_B {pf} (BInEPredSucc {pf=pf_v} y) = let pf_succ = numValueIsValue (succNumValueIsNumValue pf_v) 168 | y' = fst (from_E_to_BInE {pf=pf_succ} y) in 169 | BPredSucc {pf=pf_v} (from_BInE_to_B {pf=pf_succ} y') 170 | from_BInE_to_B {pf} (BInEIsZeroZero x) = let pf_zero = ConvertedFrom (Right Zero) 171 | x' = fst (from_E_to_BInE {pf=pf_zero} x) in 172 | BIsZeroZero (from_BInE_to_B {pf=pf_zero} x') 173 | from_BInE_to_B {pf} (BInEIsZeroSucc {pf=pf_v} y) = let pf_succ = numValueIsValue (succNumValueIsNumValue pf_v) 174 | y' = fst (from_E_to_BInE {pf=pf_succ} y) in 175 | BIsZeroSucc {pf=pf_v} (from_BInE_to_B {pf=pf_succ} y') 176 | 177 | ||| Proof that if a term `t` evaluates to a value `v` under the reflexive transitive 178 | ||| closure of the small-step evaluation rules, then it also evaluates to it under the 179 | ||| big-step evaluation rules. 180 | starImpliesBig : {pf : IsValue v} -> EvalsToStar t v -> BigEvalsTo t v 181 | starImpliesBig {pf} d = from_BInE_to_B {pf=pf} (fst (from_E_to_BInE {pf=pf} d)) 182 | 183 | ||| Proof that if a term `t` evaluates to a value `v` under the big-step evaluation rules, 184 | ||| then it also evaluates to it under the reflexive transitive closure of the small-step 185 | ||| rules. 186 | bigImpliesStar : {pf : IsValue v} -> BigEvalsTo t v -> EvalsToStar t v 187 | bigImpliesStar {pf} BValue = Refl 188 | bigImpliesStar {pf} (BIfTrue y z) = let y' = bigImpliesStar {pf=ConvertedFrom (Left True)} y 189 | z' = bigImpliesStar {pf=pf} z in 190 | from_BInE_to_E (BInEIfTrue {pf=pf} y' z') 191 | bigImpliesStar {pf} (BIfFalse y z) = let y' = bigImpliesStar {pf=ConvertedFrom (Left False)} y 192 | z' = bigImpliesStar {pf=pf} z in 193 | from_BInE_to_E (BInEIfFalse {pf=pf} y' z') 194 | bigImpliesStar {pf} (BSucc {pf=pf_nv} y) = let y' = bigImpliesStar {pf=numValueIsValue pf_nv} y in 195 | from_BInE_to_E (BInESucc {pf=pf_nv} y') 196 | bigImpliesStar {pf} (BPredZero x) = let x' = bigImpliesStar {pf=pf} x in 197 | from_BInE_to_E (BInEPredZero x') 198 | bigImpliesStar {pf} (BPredSucc {pf=pf_nv} y) = let y' = bigImpliesStar {pf=numValueIsValue (succNumValueIsNumValue pf_nv)} y in 199 | from_BInE_to_E (BInEPredSucc {pf=pf_nv} y') 200 | bigImpliesStar {pf} (BIsZeroZero x) = let x' = bigImpliesStar {pf=ConvertedFrom (Right Zero)} x in 201 | from_BInE_to_E (BInEIsZeroZero x') 202 | bigImpliesStar {pf} (BIsZeroSucc {pf=pf_nv} y) = let y' = bigImpliesStar {pf=numValueIsValue (succNumValueIsNumValue pf_nv)} y in 203 | from_BInE_to_E (BInEIsZeroSucc {pf=pf_nv} y') 204 | -------------------------------------------------------------------------------- /Ch03/Exercises.md: -------------------------------------------------------------------------------- 1 | # Exercises Chapter Three 2 | 3 | ## 3.2.4 4 | 5 | In general, if $s_n = \# S_n$ denotes the number of elements of $S_n$, then 6 | 7 | $$ s_{n+1} = 3 + 3\cdot s_n + s_n^3 $$ 8 | 9 | This formula holds because each expression can be parsed *uniquely*. We get 10 | 11 | \begin{align*} 12 | s_0 & = 0 \\ 13 | s_1 & = 3 \\ 14 | s_2 & = 3 + 9 + 27 = 39 \\ 15 | s_3 & = 3 + 3\cdot 39 + (39)^3 = 156 16 | \end{align*} 17 | 18 | ## 3.2.5 19 | 20 | That the sequence $S_i$ is cumulative (i.e. *monotone*) is not completely 21 | obvious, contrary to intuition, as the elements of $S_{i+1}$ are defined in 22 | terms of *constructors* that take elements of $S_i$ as arguments. In 23 | particular, if $S_i$ just was some arbitrary set and $S_{i+1}$ was defined in 24 | according to the inductive rule, then $S_i$ certainly wouldn't be a subset of 25 | $S_{i+1}$. 26 | 27 | What we need really need to exploit to show this is that we know the 28 | structure of $S_i$. In particular, we need to exploit the fact that $S_0 29 | = \emptyset$. 30 | 31 | \begin{lemma} If $S_i \subseteq S_{i+1}$, then $S_{i+1} \subseteq S_{i+2}$. 32 | \end{lemma} 33 | \begin{proof} 34 | Each element of $S_{i+2}$ is of the form 35 | $$f x_1 \ldots x_n$$ 36 | where $f$ is some constructor and the $x_j$ are some terms lying in 37 | $S_{i+1}$. The same description holds for $S_{i+1}$ but with the $x_j$ lying 38 | in $S_i$. Since $S_i \subseteq S_{i+1}$ by assumption, it follows that 39 | $$ S_{i+1} \subseteq S_{i+2} $$ 40 | \end{proof} 41 | 42 | \begin{cor} For all $i$ 43 | $$S_i \subseteq S_{i+1}$$ 44 | \end{cor} 45 | \begin{proof} By induction over $i$. It's trivially true for $i=0$, and the 46 | lemma above takes care of the induction step. 47 | \end{proof} 48 | 49 | ## 3.3.4 50 | 51 | \begin{proof}[Proof of the Principles of Induction on Terms] 52 | The first two principles follow quite easily from the last one (structural 53 | induction), hence we content ourselves with its proof. Using the description 54 | of the set $S$ of terms as a union 55 | $$ S = \bigcup_i S_i $$ 56 | we proceed by induction over $i \in \N$. So let $P(s)$ be some predicate, 57 | and let the assumption of the principle of structure induction hold. We then 58 | show that 59 | $$ \text{$P(s)$ holds for all $s \in S_i$}$$ 60 | by induction over $i$. 61 | 62 | For $i = 0$, there is nothing to prove. For the induction step assume that 63 | $P(s)$ holds for all $s \in S_i$. We need to show that $P(s)$ for all $s \in 64 | S_{i+1}$. But this follows immediately, since all the immediate subterms of 65 | a terms $s \in S_{i+1}$ lie in $S_i$ by construction. 66 | \end{proof} 67 | 68 | ## 3.5.5 69 | 70 | The induction principle used in the proof of Theorem 3.5.4 can be viewed as an 71 | instance of the principle of *induction over well-founded partially ordered 72 | sets*, with the set in question "the set of derivations" and the partial order 73 | being the "subtree relation". 74 | 75 | However that's not very precise, so let us make it so and get rid of those 76 | scare quotes. 77 | 78 | First of all, let's agree that we have fixed an alphabet $\Sigma$ containing all 79 | letters $\texttt{a}, \ldots, \texttt{z}, \texttt{A}, \ldots, \texttt{Z}$ as well 80 | as the symbol $\rightarrow$. On the set of strings (of finite length) there is 81 | a concatenation operation, which we will denote by placing two strings 82 | together, e.g. if $t_1$ and $t_2$ are metavariables denoting the strings 83 | \texttt{my} and \texttt{lady}, then 84 | $$t_1\texttt{fair}t_2$$ 85 | denotes the string \texttt{myfairlady}. Note that this notation is a priori 86 | ambiguous, since an expression like \texttt{xy} can be either read as the 87 | concatenation of the strings \texttt{x} and \texttt{y}, or as the string 88 | \texttt{xy}; but, since both of these denote the same string, this ambiguity is 89 | only in the sense, not the denotation. 90 | 91 | Second, let's agree that an $n$-fold ($n \geq 1$) cartesian product of sets 92 | $$X_1 \times \ldots \times X_n$$ 93 | is defined inductively in terms of an $n-1$-fold cartesian product and the 94 | usual (binary) cartesian product as 95 | $$X_1 \times \ldots \times X_n \equiv X_1\times (X_2\times \ldots X_n)$$ 96 | , where by definition the $0$-fold cartesian product is equal to 97 | $$() \equiv \{\texttt{nil}\}$$ 98 | and the set $\texttt{nil} \equiv \emptyset$ is not a pair^[Why not?]. 99 | 100 | Note that according to this definition, *the $2$-fold cartesian product is 101 | different from the (binary) cartesian product*, and the $1$-fold cartesian 102 | product of a set $X$ is not equal to $X$ but to 103 | $$X \times ().$$ 104 | 105 | This may seem like a silly definition, but this is the standard way to 106 | introduce lists in the context of programming languages, and moreover it is the 107 | *correct* way if you want to be able to talk about the $i$-th element of an 108 | $n$-tuple without knowing a priori whether $n = i$ or $n > i$. 109 | 110 | With that being said, $n$-tuples are accordingly defined via induction by the 111 | definitional equality 112 | $$(x_1, \ldots, x_n) \equiv (x_1, (x_2,\ldots, x_n))$$ 113 | and the convention that the $0$-tuple (not to be confused with the $0$-fold 114 | cartesian product) is equal to 115 | $$() \equiv \texttt{nil}$$ 116 | In particular, a $1$-fold tuple is equal to 117 | $$(x) \equiv (x,\texttt{nil})$$ 118 | 119 | With these definition made, we have operators $\car$ and 120 | $\cdr$ operating on sets, whose values on pairs are defined to be 121 | $$\car((x,y)) = x,\quad \cdr((x,y)) = y$$ 122 | In particular, we get 123 | $$\car(\cdr((x,y,z)) = y,\quad \car(\cdr(\cdr((x,y,z))))) = z$$ 124 | 125 | Let us now consider the set $\mathcal{T}$ of terms in the sublanguage of 126 | boolean expressions, and let us define the set of potential reduction expressions 127 | (as a sublanguage of the language defined above): 128 | 129 | \begin{defn} 130 | The set $\mathcal{RDE}$ of potential reduction expressions is given by 131 | $$\mathcal{RDE} := \{ t_1\rightarrow t_2 \ :\ t_1, t_2 \in \mathcal{T}\}$$ 132 | \end{defn} 133 | 134 | Our goal is to define the set of derivations as the set of inductive sets of 135 | the form 136 | 137 | $$d = (r, e, d_1, \ldots, d_1)$$ 138 | 139 | where $r \in \{ \texttt{E-IfTrue}, \texttt{E-IfFalse}, \texttt{E-If}\}$ is 140 | a derivation rule, $e$ is a reduction expression, and $d_1$, \ldots, $d_n$ 141 | are derivations which derive reduction expressions $e_1$, \ldots, $e_n$. 142 | 143 | \begin{defn} 144 | The set $\mathcal{D}$ of derivations (of reduction expressions) is the 145 | smallest set such that it contains 146 | \begin{itemize} 147 | \item $(\texttt{E-IfTrue}, \texttt{if true then }t_1\texttt{ else 148 | }t_2\rightarrow t_1)$ 149 | \end{itemize} 150 | and 151 | \begin{itemize} 152 | \item $(\texttt{E-IfFalse}, \texttt{if false then }t_1\texttt{ else 153 | }t_2\rightarrow t_2)$ 154 | \end{itemize} 155 | for all $t_1, t_2 \in \mathcal{T}$, and 156 | \begin{itemize} 157 | \item $(\texttt{E-If}, \texttt{if }t\texttt{ then }t_1\texttt{ else 158 | }t_2\rightarrow\texttt{if }t'\texttt{ then }t_1\texttt{ else }t_2,d)$ 159 | \end{itemize} 160 | for all $t,t',t_1, t_2 \in \mathcal{T}$ and all $d \in \mathcal{D}$ for which 161 | $$\texttt{car}(\texttt{cdr}(d)) = t\rightarrow t'.$$ 162 | \end{defn} 163 | 164 | \begin{rmk} 165 | Note that it follows immediately from the definition that every element of 166 | $\mathcal{D}$ has the form 167 | $$(r,e,d_1,\ldots d_n)$$ 168 | where $r \in \{\texttt{E-IfTrue}, \texttt{E-IfFalse}, \texttt{E-If}\}$ and $e 169 | \in \mathcal{RDE}$. The element $e$ is to be interpreted as the \textit{conclusion} of 170 | the derivation and the $d_i$ as the \textit{premises} (or 171 | \textit{subderivations}). In particular, the elements where $n = 0$ correspond 172 | to the axioms. 173 | \end{rmk} 174 | 175 | We can now endow $\mathcal{D}$ with a well-founded partial order relation: 176 | 177 | \begin{defn} 178 | Given $d, d' \in \mathcal{D}$, we put 179 | $$d' \prec d \quad \Leftrightarrow\quad \exists d_1,\ldots,d_n \in \mathcal{D},\ 1 \leq i \leq n\ \ d = (r,e,d_1,\ldots,d_n),\ d' = d_i$$ 180 | and when $d' \prec d$, we say $d'$ is an \textbf{immediate subderivation} of 181 | $d$. 182 | 183 | Moreover, we define the relation $<$ to be the transitive hull of $\prec$, 184 | and when $d' < d$ we say that $d'$ is a \textbf{subderivation} of $d$. 185 | \end{defn} 186 | 187 | \begin{rmk} 188 | Note that in the above definition of $\prec$, the number $n$ and the elements 189 | $r,e,d_1,\ldots,d_n$ are uniquely determined by $d$ and the relation $d 190 | = (r,e,d_1,\ldots,d_n)$. 191 | 192 | This is not completely obvious, because a priori we 193 | could expand an expression like $(r,e,d)$ further into $(r,e,d_1,\ldots,d_n)$ 194 | if $d$ would expand like $d = (d_1,\ldots,d_n)$. However, for $d \in 195 | \mathcal{D}$ we always have $\car(d) \in 196 | \{\texttt{E-IfTrue},\texttt{E-IfFalse},\texttt{E-If}\}$, and the latter set 197 | is disjoint from $\mathcal{D}$ (because ...?). 198 | \end{rmk} 199 | 200 | \begin{lemma} 201 | The relations $<$ and $\prec$ are well-founded. 202 | \end{lemma} 203 | \begin{proof} 204 | Note that we eventually want to show that $<$ is a partial order (i.e. antisymmetric and irreflexive), but we won't use this in this proof (in fact, we want to deduce these properties using the well-foundedness). 205 | 206 | What we need to show that is that every \textit{non-empty} subset of $\mathcal{D}$ has a least element 207 | in the order $<$, or equivalently, that there cannot be a strictly descending 208 | infinite chain 209 | $$ \ldots < d_2 < d_1 < d_0$$ 210 | This is of course equivalent to showing that there is no infinite descending 211 | chain 212 | $$ \ldots \prec d_2 \prec d_1 \prec d_0$$ 213 | (since $<$ was defined to be the transitive hull of $\prec$). But, to see that 214 | such an infinite descending chain cannot exist it suffcies to remark that if 215 | $d' \prec d$, then 216 | $$\texttt{length}(\car(\cdr(d)) \geq \max_{i=1,\ldots,n} 217 | \ \texttt{length}(\car(\cdr(d'_i))) + 1$$ 218 | where $d' = (r,e,d'_1,\ldots,d'_n)$ and $\texttt{length}(l)$ denotes the lenght 219 | of a string $l$. 220 | \end{proof} 221 | 222 | We can now finally formulate an induction principle for $\mathcal{D}$. 223 | 224 | \begin{thm} 225 | Let $P$ be a predicate defined at least on elements $d \in \mathcal{D}$. If 226 | $$d = (r,e,d_1,\ldots,d_n) \in \mathcal{D},\ \forall i\ P(d_i) \quad 227 | \Rightarrow \quad P(d)$$ 228 | for all $d \in \mathcal{D}$, then $P(d)$ for all $d \in \mathcal{D}$. 229 | \end{thm} 230 | \begin{proof} 231 | Consider the subset 232 | $$\Omega = \{ d \in \mathcal{D}\ :\ \neg P(p) \}$$ 233 | If this was non-empty, there'd be a minimal element $d$ for the relation 234 | $\prec$. Writing $d = (e,r,d_1,\ldots,d_n)$, it would follow that $P(d_i)$ for 235 | all $i$ (since $d_i \prec d$). Thus it would follow that $P(d)$ by assumption, 236 | contradicting that $\neg P(d)$. 237 | \end{proof} 238 | 239 | From this we can also easily derive a principle for inductive definitions 240 | 241 | \begin{thm} 242 | Let $Y$ be a set and for every $r \in \{\texttt{E-IfTrue},\texttt{E-IfFalse},\texttt{E-If}\}$ let 243 | $g_r: \mathcal{RDE} \times Y^{n(r)} \rightarrow Y$ be a function, where $n(r)$ equals 244 | the ``arity'' of $r$ (i.e. $n = 0$ unless $e = \texttt{E-If}$, where $n = n1$). 245 | 246 | Then there exists a unique function $f: \mathcal{D} \longrightarrow Y$ such 247 | that for $d = (r,e,d_1,\ldots,d_n) \in \mathcal{D}$ we have 248 | $$f(d) = g_r(e,f(d_1), \ldots, f(d_n))$$ 249 | \end{thm} 250 | \begin{proof} 251 | Uniqueness follows quite easily by taking two function $f,f'$ and considering 252 | the set 253 | $$\Omega = \{ d \in \mathcal{D}\ :\ f(d) \neq f'(d)\}$$ 254 | where they disagree. Existence follows from a similar argument by considering 255 | \textit{partially} defined functions satisfying the desired equations and by 256 | first showing (by the same argument) that they must agree on the intersection of 257 | their domains of definition, then showing that every $d \in D$ occurs in the 258 | domain of definition of some such partially defined function, and then defining 259 | $f$ to be the union of all these partially defined functions. 260 | 261 | The only nontrivial part of this argument is showing that each $d \in 262 | \mathcal{D}$ occurs in the domain of definition of such a function. Assuming 263 | that's not the case would mean assuming the set 264 | $$\Omega' = \{ d \in \mathcal{D}\ :\ \text{$d$ does not occur in the d.o.d. of 265 | some $f$}\}$$ 266 | is non-empty. But then it would contain an element $d$ minimal with respect to 267 | $\prec$, and writing $d = (r,e,d_1,\ldots,d_n)$, we could (by assumption) find 268 | functions $f_1,\ldots,f_n$ having $d_1,\ldots,d_n$ in their domain of definition 269 | (respectively), so we can find a function $f$ having all the $d_i$ in its 270 | domain of definition, and we are then reduced to showing that 271 | $$f' := f \cup \{(d, g(e,f(d_1),\ldots,f(d_n)))\}$$ 272 | defines a partially defined function on $\mathcal{D}$ having values in $Y$ and 273 | satisfying the required equation. But that's easy to see (but lengthy to spell 274 | out), and so we are done. 275 | \end{proof} 276 | 277 | Note that even though the argument of the above proof seems sort-of vacuous, it 278 | really isn't since we are at least showing that the minimal elements of 279 | $\mathcal{D}$ (i.e. the axioms) are in the domain of definition of some 280 | partially defined function. 281 | 282 | Using inductive construction, we can now define the depth of a derivation: 283 | 284 | \begin{defn} 285 | The depth $\texttt{depth}(d)$ of a derivation $d \in \mathcal{D}$ is defined 286 | inductively by 287 | $$\texttt{depth}(d) = 1 + \max_{i=1,\ldots,n}\ \texttt{depth}(d_i)$$ 288 | where $d = (r,e,d_1,\ldots,d_n)$. 289 | \end{defn} 290 | 291 | \begin{lemma} 292 | If $d' < d$, then 293 | $$\texttt{depth}(d') < \texttt{depth}(d)$$ 294 | \end{lemma} 295 | \begin{proof} 296 | It suffices to show this for $\prec$ instead of $<$, and for $\prec$ it follows 297 | immediately from the definition. 298 | \end{proof} 299 | 300 | \begin{cor} 301 | The relation $<$ is antisymmetric and irreflexive. 302 | \end{cor} 303 | \hfill\qedsymbol 304 | 305 | ## 3.5.10 306 | 307 | \begin{gather*} \inferrule*[right=\texttt{Impl}]{t \rightarrow t'}{t \rightarrow^\ast t'} \\[1em] 308 | \inferrule*[right=\texttt{Refl}]{ }{t \rightarrow^\ast t}\hskip 1.5em 309 | \inferrule*[right=\texttt{Trans}]{t \rightarrow^\ast t' \\ t'\rightarrow^\ast t''}{t 310 | \rightarrow^\ast t''} 311 | \end{gather*} 312 | 313 | ## 3.5.13 314 | 315 | 1. First, let's abbreviate 316 | 317 | \begin{align*}\text{(\textbf{DetEval})} & \equiv \text{3.5.4} && (= \text{Deterministic evaluation}) \\ 318 | \text{(\textbf{ValsNorm})} & \equiv \text{3.5.7} && (= \text{values are normal forms}) \\ 319 | \text{(\textbf{NormVals})} & \equiv \text{3.5.8} && (= \text{normal forms are values}) \\ 320 | \text{(\textbf{NormUnq})} & \equiv \text{3.5.11} && (= \text{normal forms are unique}) \\ 321 | \text{(\textbf{NormEx})} & \equiv \text{3.5.12} && (= \text{normal forms exist}) 322 | \end{align*} 323 | because who can remember what theorem x.y.z was? Then let's recall that we 324 | have the (trivial) implication 325 | $$\text{(\textbf{DetEval})} \Rightarrow \text{(\textbf{NormUnq})}.$$ 326 | Moreover, since a term that is normal for a given set of inference rules is 327 | trivially so for every subset of those rules, it follows that adding new 328 | inference rules preserves the validity of (**NormVals**), in particular that 329 | rule stays valid by adding (\texttt{E-Funny1}). 330 | 331 | Property (**DetEval**) is of course invalidated by adding 332 | (\texttt{E-Funny1}), since it competes with (\texttt{E-IfTrue}). Moreover, 333 | (**NormUnq**) also goes down the drain because 334 | $$\texttt{if true then true else false} \rightarrow true$$ 335 | by (\texttt{E-IfTrue}) but also 336 | $$\texttt{if true then true else false} \rightarrow false$$ 337 | by (\texttt{E-Funny1}) and because (**ValsNorm**) does in fact stay valid. 338 | The latter holds of course because we could only possibly break 339 | (**ValsNorm**) by introducing an inference rule whose conclusion is 340 | something of the form $v \rightarrow t$ (i.e. with a value before the 341 | reduction arrow). 342 | 343 | As mentioned in the text, property (**NormEx**) holds for trivial reasons as 344 | long as we can find a map $f:\mathcal{T} \rightarrow S$ from terms into a set 345 | endowed with a well-founded partial order $<$ such that 346 | \begin{align*} t \rightarrow t' \text{ derivable} & \quad \Rightarrow\quad f(t) < f(t') 347 | \hfill \tag{$\ast$} 348 | \end{align*} 349 | For our very simple boolean language, we can take $S = \N$ and $f(t) 350 | = \texttt{length}(t)$, and property $(\ast)$ is not spoiled by introducing 351 | (\texttt{E-Funny1}). 352 | 353 | 2. Let's now consider the effects of introducing 354 | 355 | $$\inferrule*[right=\texttt{E-Funny2}]{t_2 \rightarrow t_2'}{\texttt{if }t_1\texttt{ then }t_2\texttt{ else }t_3\rightarrow\texttt{if }t_1\texttt{ then }t_2'\texttt{ else }t_3}$$ 356 | 357 | instead of (\texttt{E-Funny1}). 358 | 359 | By the same reasoning as before, it follows that (**NormVals**), 360 | (**ValsNorm**) and (**NormEx**) stay true. 361 | 362 | Property (**DetEval**) is invalidated, since given $t \rightarrow t'$ we can 363 | both derive 364 | $$\text{if }t\texttt{ then }t\texttt{ else }t_3\rightarrow\texttt{if }t'\texttt{ then }t\texttt{ else }t_3$$ 365 | , using (\texttt{E-If}), and 366 | $$\text{if }t\texttt{ then }t\texttt{ else }t_3\rightarrow\texttt{if }t\texttt{ then }t'\texttt{ else }t_3$$ 367 | , using (\texttt{E-Funny2}). 368 | 369 | So it remains to ask, does (**NormUnq**) remain valid? Intuition suggests 370 | that it does, despite (**DetEval**) failing, because the rule 371 | (\texttt{E-Funny2}) only says that we can evaluate the consequences of an 372 | `if then else` rules before evaluating the conditional, which seems 373 | harmless. 374 | 375 | But to *prove* this, we shall need some version of the *Church-Rosser 376 | property*. Namely, letting $t\hookrightarrow t'$ denote the 377 | one-step-derivability relation generated by the system enlarged by 378 | (\texttt{E-Funny2}) and correspondingly $t\hookrightarrow^\ast t'$ its 379 | reflexive and transitive closure, we claim that: 380 | 381 | \begin{lemma} 382 | Given $t$ and $t'$ such that $t \hookrightarrow^\ast t'$, we can always find 383 | $t''$ such that $t' \rightarrow^\ast t''$ and $t \rightarrow^\ast t''$: 384 | $$\xymatrix{ t \ar@^{(->}[r]^{\ast} \ar[rd]^{\ast} & \ar[d]^{\ast} t' \\ 385 | & t''}$$ 386 | \end{lemma} 387 | \begin{proof} 388 | It suffices to prove this for $\hookrightarrow$ instead of 389 | $\hookrightarrow^\ast$ because the general case can be reduced to this one 390 | by induction, i.e. if $t_1 \hookrightarrow^\ast t_2$ and $t_2 \hookrightarrow 391 | t_3$ then we can apply induction hypothesis to find $t_2'$ such that $t_1 392 | \rightarrow^\ast t_2'$ and $t_2 \rightarrow^\ast t_2'$. Moreover, the base of the 393 | induction gives $t_3'$ such that $t_2 \rightarrow^\ast t_3'$ and $t_3 \rightarrow^\ast 394 | t_3'$. We can then apply the Church-Rosser property for $\rightarrow$ (which 395 | is trivial because of (\textbf{DetEval})) to find $t''$ such that $t_2' 396 | \rightarrow^\ast t''$ and $t_3' \rightarrow^\ast t''$: 397 | $$\xymatrix{t_1 \ar[rd]^\ast \ar@^{(->}[r]^\ast & t_2 \ar[d]^\ast \ar[rd]^\ast \ar@^{(->}[r] & t_3 \ar[d]^\ast \\ 398 | & t_2' \ar[rd]^\ast & t_3' \ar[d]^\ast \\ 399 | & & t'' 400 | }$$ 401 | Now to prove the version of the lemma for the one-step-evaluation relation 402 | $\hookrightarrow$, we will use induction on the derivation of $t 403 | \hookrightarrow t'$. The base in this version of induction corresponds to 404 | proving the statement for relations $t \hookrightarrow t'$ derived from 405 | inferences rules without premises (i.e. axioms): those are precisely 406 | (\texttt{E-IfTrue}) and (\texttt{E-IfFalse}). In these cases, we also have 407 | $t \rightarrow t'$ and we can simply take $t'' = t'$. 408 | 409 | In the induction step, we take a derivation of $t \hookrightarrow t'$ and 410 | assume that the statement holds for the premises of the last rule of this 411 | derivation. Now, the last rule is either (\texttt{E-If}) or 412 | (\texttt{E-Funny2}), both having exactly one premise. In the first case, it 413 | follows immediately that also $t \rightarrow t'$ and we can again simply 414 | take $t'' = t'$. 415 | 416 | Let us now consider the case where the last rule is (\texttt{E-Funny2}). 417 | Then 418 | \footnote{I'm 419 | sorry for the confusing notation here: in the context of the equation below, 420 | $t \rightarrow t'$ simply denotes a string. This is not to be confused with 421 | the statement $t \rightarrow t'$, which says that $t$ and $t'$ are related 422 | by the one-step-evaluation relation (in the smaller ruleset), which in turn 423 | means that the string $t \rightarrow t'$ can be derived. In particular, the 424 | statement $t \hookrightarrow t'$ doesn't mean that the string $t 425 | \hookrightarrow t'$ can be derived ($\hookrightarrow$ isn't even in our 426 | alphabet), it means that the string $t \rightarrow t'$ can be derived in the 427 | enlarged ruleset.} 428 | $$t \rightarrow t' = \texttt{if }t_1\texttt{ then }t_2\texttt{ else }t_3 429 | \rightarrow \texttt{if }t_1\texttt{ then }t_2'\texttt{ else }t_3$$ 430 | i.e. 431 | $$t = \texttt{if }t_1\texttt{ then }t_2\texttt{ else }t_3$$ 432 | and 433 | $$t' = \texttt{if }t_1\texttt{ then }t_2'\texttt{ else }t_3.$$ 434 | Here $t_2 \rightarrow t_2'$ is the conclusion of the subderivation ending 435 | in the promise of the last rule. By induction assumption, the lemma holds 436 | for that subderivation and therefore we can find $t_2''$ such that 437 | $t_2 \rightarrow^\ast t_2''$ and $t_2' \rightarrow^\ast t_2''$. 438 | 439 | But by (**NormEx**) and (**NormVals**) for the smaller ruleset, we know that 440 | either $t_1 \rightarrow^\ast \texttt{true}$ or $t_1 \rightarrow^\ast 441 | \texttt{false}$. Using repeated application of (\texttt{E-If}), it therefore 442 | follows that 443 | $$t' \rightarrow^\ast \texttt{if true then }t_2'\texttt{ else }t_3$$ 444 | or 445 | $$t' \rightarrow^\ast \texttt{if false then }t_2'\texttt{ else }t_3$$ 446 | respectively. We can then apply (\texttt{E-IfTrue}) and 447 | (\texttt{E-IfFalse}), respectively, to obtain that 448 | $$t' \rightarrow^\ast t''$$ 449 | where 450 | $$t'' = t_2' \quad \text{or}\quad t'' = t_3$$ 451 | On the other hand, we can also derive that (respectively) 452 | $$t \rightarrow^\ast \texttt{if true then }t_2\texttt{ else }t_3 \rightarrow t_2$$ 453 | or 454 | $$t \rightarrow^\ast \texttt{if false then }t_2\texttt{ else }t_3 \rightarrow t_3$$ 455 | , and so $t \rightarrow^\ast t''$ in both cases. 456 | \end{proof} 457 | 458 | \begin{cor} 459 | Property $(\textit{NormUnq})$ holds in the enlarged system. 460 | \end{cor} 461 | \begin{proof} 462 | If $t$ is a term and $u$ is a normal form in the enlarged system such that 463 | $t \hookrightarrow^\ast u$, then we can apply the lemma to conclude the 464 | existence of $t''$ such that $u \rightarrow^\ast u$ and $t \rightarrow^\ast 465 | t''$. However, since $u$ is a normal form it follows that $t'' = u$. Since 466 | (**NormUnq**) holds in the smaller system, it therefore follows that it 467 | holds for the larger one also. 468 | \end{proof} 469 | 470 | ## Exercise 3.5.14 471 | 472 | We need to show that property (**DetEval**) also holds for the (one-step) 473 | evaluation relation $t \rightarrow t'$ for the full language of arithmetic 474 | expressions. That is, we need to show that 475 | 476 | $$t \rightarrow t' \text{ and } t \rightarrow t'' \quad \Rightarrow\quad t' = t''$$ 477 | 478 | As before, the proof comes down to showing a stronger property, namely that 479 | given any term `t` there is at most one one-step evaluation rule expression $t 480 | \rightarrow t'$ beginning with `t`. For example, in the Idris version of the 481 | arithmetic language I defined this statement would correspond to the following 482 | type: 483 | 484 | (r : EvalsTo t t') -> (r' : EvalsTo t t'') -> (r = r') 485 | 486 | From this one easily that (**DetEval**) holds, which corresponds to the 487 | following Idris type: 488 | 489 | EvalsTo t t' -> EvalsTo t t'' -> (t' = t'') 490 | 491 | A complete formalization of this exercise in Idris can be found in 492 | `Exercise_3_5_14.idr`. Suffice it to say that the proof of the stronger 493 | statement comes down to a simple case-distinction. One minor complication in 494 | the formal proof of this statement is that in order to prove `r' = r''` in 495 | certain cases, one is forced to reason about *equality of proofs* (more 496 | specifically, equality between proofs of type `IsNumValue t`). 497 | 498 | ## Exercise 3.5.16 499 | 500 | \begin{lemma} 501 | A term $t$ in the arithmetic language evaluates to a stuck term if 502 | and only if it evaluates to $\texttt{wrong}$ when viewed as a term 503 | in the augmented language. 504 | \end{lemma} 505 | \begin{proof} 506 | We first show the direction "$\Rightarrow$". For this, we may w.l.o.g. assume 507 | that $t$ is already stuck. Now, if $t$ is not a value then that means that it 508 | is of one of the following forms 509 | 510 | \begin{enumerate} 511 | \item $t = \texttt{if }t_1\texttt{ then }t_2\texttt{ else }t_3$ 512 | \item $t = \texttt{iszero }t_1$ 513 | \item $t = \texttt{pred }t_1$ 514 | \item $t = \texttt{succ }t_1$ 515 | \end{enumerate} 516 | 517 | Moreover since $t$ is normal, it follows that all the sub-terms $t_i$ are also 518 | normal, thus they are either values or stuck. More precisely, in each 519 | respective case that 520 | 521 | \begin{enumerate} 522 | \item $t_1$ is either a numeric value or stuck. 523 | \item $t_1$ is either a boolean value or stuck. 524 | \item $t_1$ is either a boolean value or stuck. 525 | \item $t_1$ is either a boolean value or stuck. 526 | \end{enumerate} 527 | 528 | If $t_1$ is stuck, then using induction we can conclude that $t_1$ evaluates to 529 | $\texttt{wrong}$ in the augmented language. It then follows that $t$ evaluates 530 | to $\texttt{wrong}$ in the augmented language (using the rules $\texttt{E-If}$, 531 | $\texttt{E-IsZero}$, $\texttt{E-Pred}$, and $\texttt{E-Succ}$ respectively). 532 | 533 | On the other hand, in the case where $t_1$ is a value it is also a "bad" value 534 | in the sense of the augmented language, i.e. $t_1$ is a "bad boolean" in the 535 | first case and a "bad numeric value" in the other cases. Thus, we may 536 | immediately apply the rules $\texttt{E-If-Wrong}$, $\texttt{E-IsZero-Wrong}$, 537 | $\texttt{E-Pred-Wrong}$, and $\texttt{E-Succ-Wrong}$ to derive 538 | $\texttt{wrong}$. 539 | 540 | Let us now show the direction "$\Leftarrow$". For this direction, we need to 541 | make use of the fact\footnote{I won't prove this.} that evaluation in the 542 | augmented language is still deterministic. From this it follows that we may 543 | assume w.l.o.g. that $t$ is already fully evaluated in the arithmetic language, 544 | and we need to show that $t$ is not a value. 545 | 546 | But if $t$ is fully evaluated in the arithmetic language but evaluates to 547 | something in the augmented language, then it follows that we can apply one of 548 | the "\texttt{-Wrong}" rules to it. Using a simple case distinction it then 549 | follows that $t$ is not a value. 550 | \end{proof} 551 | -------------------------------------------------------------------------------- /Ch03/Relations.idr: -------------------------------------------------------------------------------- 1 | module Ch03.Relations 2 | 3 | %default total 4 | %access public export 5 | 6 | ||| Type representing the reflexive transitive closure of a relation 7 | ||| 8 | ||| Given a relational type `rel : ty -> ty -> Type`, `ReflSymmClos rel` is its reflexive and 9 | ||| transitive closure. 10 | data ReflSymmClos : (rel : ty -> ty -> Type) -> ty -> ty -> Type where 11 | Refl : ReflSymmClos rel x x 12 | --Snoc : ReflSymmClos rel t t' -> (rel t' t'') -> ReflSymmClos rel t t'' 13 | Cons : (rel t t') -> ReflSymmClos rel t' t'' -> ReflSymmClos rel t t'' 14 | 15 | ||| Appends two (appendable) elements of the reflexive-transitive closure of `rel` together, 16 | ||| thus realizing the transitivity of said closure 17 | (++) : ReflSymmClos rel t t' -> 18 | ReflSymmClos rel t' t'' -> 19 | ReflSymmClos rel t t'' 20 | (++) Refl y = y 21 | (++) (Cons x z) y = Cons x (z ++ y) 22 | 23 | ||| Given `rel t1 t2`, returns the associated relation in the reflexive transitive closure, 24 | ||| thus realizing the "closure part" of said closure 25 | weaken : rel t1 t2 -> ReflSymmClos rel t1 t2 26 | weaken x = Cons x Refl 27 | 28 | ||| Dual version of the `Cons` constructor for convenience. 29 | snoc : ReflSymmClos rel t t' -> (rel t' t'') -> ReflSymmClos rel t t'' 30 | snoc p p' = p ++ (weaken p') 31 | 32 | ||| Given a function `f` defined on relations of type `rel`, applies that to a relation in the 33 | ||| reflexive-transitive closure of `rel` 34 | map : {func : ty -> ty} -> (f : {t1 : ty} -> {t2 : ty} -> rel t1 t2 -> rel (func t1) (func t2)) -> 35 | (ReflSymmClos rel t1 t2) -> 36 | (ReflSymmClos rel (func t1) (func t2)) 37 | map {func} f Refl = Refl 38 | map {func} f (Cons x y) = Cons (f x) (map f y) 39 | -------------------------------------------------------------------------------- /Ch04/Eval.idr: -------------------------------------------------------------------------------- 1 | module Ch04.Eval 2 | 3 | import Ch03.Arith 4 | import Ch04.NaturalInduction 5 | import Data.Fin 6 | 7 | %default total 8 | 9 | mutual 10 | namespace IsBadBool 11 | ||| Propositional type describing that a term is a "bad boolean". 12 | data IsBadBool : Term -> Type where 13 | IsStuckTerm : {pf : IsStuck t} -> IsBadBool t 14 | IsNat : {pf : IsNumValue t} -> IsBadBool t 15 | 16 | namespace IsBadNat 17 | ||| Propositional type describing that a term is a "bad nat". 18 | data IsBadNat : Term -> Type where 19 | IsStuckTerm : {pf : IsStuck t} -> IsBadNat t 20 | IsBool : {pf : IsBoolValue t} -> IsBadNat t 21 | 22 | ||| Propositional type describing that a term is stuck. 23 | data IsStuck : Term -> Type where 24 | EIfWrong : {t1,t2,t3 : Term} -> 25 | {pf : IsBadBool t1} -> 26 | IsStuck (IfThenElse t1 t2 t3) 27 | ESuccWrong : {t : Term} -> 28 | {pf : IsBadNat t} -> 29 | IsStuck (Succ t) 30 | EPredWrong : {t : Term} -> 31 | {pf : IsBadNat t} -> 32 | IsStuck (Pred t) 33 | EIsZeroWrong : {t : Term} -> 34 | {pf : IsBadNat t} -> 35 | IsStuck (IsZero t) 36 | 37 | -- We are using an ad hoc definition of what it means to be stuck, 38 | -- which is not exactly the one used in the book (normal but not a value). 39 | -- This is for convenience. (TODO: Fix this maybe.) 40 | ||| Propositional type describing that a term is fully evaluated. 41 | FullyEvaluated : Term -> Type 42 | FullyEvaluated t = Either (IsStuck t) (IsValue t) 43 | 44 | ||| Propositional type describing that a term is normal. 45 | Normal : Term -> Type 46 | Normal t = (t' : Term) -> EvalsTo t t' -> Void 47 | 48 | -------------------------------------------------------------------------------- 49 | -- Helper lemmas for `fully_evaluated_is_normal`. 50 | -------------------------------------------------------------------------------- 51 | 52 | true_is_normal : Normal True 53 | true_is_normal = \_, r => case r of 54 | EIfTrue impossible 55 | EIfFalse impossible 56 | (EIf _) impossible 57 | (ESucc _) impossible 58 | EPredZero impossible 59 | EPredSucc impossible 60 | (EPred _) impossible 61 | EIsZeroZero impossible 62 | EIsZeroSucc impossible 63 | (EIsZero _) impossible 64 | 65 | false_is_normal : Normal False 66 | false_is_normal = \_, r => case r of 67 | EIfTrue impossible 68 | EIfFalse impossible 69 | (EIf _) impossible 70 | (ESucc _) impossible 71 | EPredZero impossible 72 | EPredSucc impossible 73 | (EPred _) impossible 74 | EIsZeroZero impossible 75 | EIsZeroSucc impossible 76 | (EIsZero _) impossible 77 | 78 | zero_is_normal : Normal Zero 79 | zero_is_normal = \_, r => case r of 80 | EIfTrue impossible 81 | EIfFalse impossible 82 | (EIf _) impossible 83 | (ESucc _) impossible 84 | EPredZero impossible 85 | EPredSucc impossible 86 | (EPred _) impossible 87 | EIsZeroZero impossible 88 | EIsZeroSucc impossible 89 | (EIsZero _) impossible 90 | 91 | num_values_are_normal_helper : (nv : NumValue) -> Normal (nv2t nv) 92 | num_values_are_normal_helper nv = case nv of 93 | Zero => zero_is_normal 94 | (Succ nv') => \_, r => case r of 95 | (ESucc r') => (num_values_are_normal_helper nv') _ r' 96 | 97 | num_values_are_normal : (t : Term) -> {pf : IsNumValue t} -> Normal t 98 | num_values_are_normal (nv2t nv) {pf=ConvertedFrom nv} = num_values_are_normal_helper nv 99 | 100 | 101 | values_are_normal : (t : Term) -> {pf : IsValue t} -> Normal t 102 | values_are_normal (bv2t bv) {pf=ConvertedFrom (Left bv)} = case bv of 103 | True => true_is_normal 104 | False => false_is_normal 105 | values_are_normal (nv2t nv) {pf=ConvertedFrom (Right nv)} = num_values_are_normal (nv2t nv) {pf=ConvertedFrom nv} 106 | 107 | num_value_not_bool_value : (nv : NumValue) -> Not (IsBoolValue (nv2t nv)) 108 | num_value_not_bool_value Zero = \pf_bv => case pf_bv of 109 | ConvertedFrom True impossible 110 | ConvertedFrom False impossible 111 | num_value_not_bool_value (Succ nv) = \pf_bv => case pf_bv of 112 | (ConvertedFrom True) impossible 113 | (ConvertedFrom False) impossible 114 | 115 | num_value_not_stuck : (nv : NumValue) -> Not (IsStuck (nv2t nv)) 116 | num_value_not_stuck Zero = \pf_bad => case pf_bad of 117 | EIfWrong impossible 118 | ESuccWrong impossible 119 | EPredWrong impossible 120 | EIsZeroWrong impossible 121 | num_value_not_stuck (Succ nv) = \pf_bad => case pf_bad of 122 | ESuccWrong {pf=pf_succ_wrong} => case pf_succ_wrong of 123 | IsStuckTerm {pf=pf_stuck} => absurd ((num_value_not_stuck nv) pf_stuck) 124 | IsBool {pf=pf_bool} => absurd ((num_value_not_bool_value nv) pf_bool) 125 | 126 | num_value_not_bad_nat : (nv : NumValue) -> Not (IsBadNat (nv2t nv)) 127 | num_value_not_bad_nat nv = \pf_bad => case pf_bad of 128 | IsStuckTerm {pf=pf_stuck} => absurd ((num_value_not_stuck nv) pf_stuck) 129 | IsBool {pf=pf_bool} => absurd ((num_value_not_bool_value nv) pf_bool) 130 | 131 | values_not_stuck : {t : Term} -> {pf : IsValue t} -> Not (IsStuck t) 132 | values_not_stuck {t = (bv2t bv)} {pf = (ConvertedFrom (Left bv))} = \pf_stuck => case bv of 133 | True => case pf_stuck of 134 | EIfWrong impossible 135 | ESuccWrong impossible 136 | EPredWrong impossible 137 | EIsZeroWrong impossible 138 | False => case pf_stuck of 139 | EIfWrong impossible 140 | ESuccWrong impossible 141 | EPredWrong impossible 142 | EIsZeroWrong impossible 143 | values_not_stuck {t = (nv2t nv)} {pf = (ConvertedFrom (Right nv))} = num_value_not_stuck nv 144 | 145 | bool_not_bad_bool : {t : Term} -> {pf : IsBoolValue t} -> Not (IsBadBool t) 146 | bool_not_bad_bool {pf} = \x => case x of 147 | IsStuckTerm {pf=pf_stuck} => (values_not_stuck {pf=boolValueIsValue pf}) pf_stuck 148 | IsNat {pf=pf_nat} => numNotBool pf_nat pf 149 | 150 | nat_not_bad_nat : {t : Term} -> {pf : IsNumValue t} -> Not (IsBadNat t) 151 | nat_not_bad_nat {pf} = \x => case x of 152 | IsStuckTerm {pf=pf_stuck} => (values_not_stuck {pf=numValueIsValue pf}) pf_stuck 153 | IsBool {pf=pf_bool} => numNotBool pf pf_bool 154 | 155 | stuck_is_normal : IsStuck t -> Normal t 156 | stuck_is_normal (EIfWrong {pf}) = \_, r => case r of 157 | EIfTrue => (bool_not_bad_bool {pf=ConvertedFrom True}) pf 158 | EIfFalse => (bool_not_bad_bool {pf=ConvertedFrom False}) pf 159 | (EIf {t1} r') => case pf of 160 | IsStuckTerm {pf=pf_stuck} => stuck_is_normal pf_stuck _ r' 161 | IsNat {pf=pf_num} => values_are_normal t1 {pf=numValueIsValue pf_num} _ r' 162 | stuck_is_normal (ESuccWrong {t} {pf}) = \_, r => case r of 163 | (ESucc r') => case pf of 164 | IsStuckTerm {pf=pf_stuck} => stuck_is_normal pf_stuck _ r' 165 | IsBool {pf=pf_bool} => values_are_normal t {pf=boolValueIsValue pf_bool} _ r' 166 | stuck_is_normal (EPredWrong {t} {pf}) = \_, r => case r of 167 | EPredZero => nat_not_bad_nat {pf=ConvertedFrom Zero} pf 168 | EPredSucc {nv1=nv} {pf=pf_num} => nat_not_bad_nat {pf=succNumValueIsNumValue pf_num} pf 169 | (EPred r') => case pf of 170 | IsStuckTerm {pf=pf_stuck} => stuck_is_normal pf_stuck _ r' 171 | IsBool {pf=pf_bool} => values_are_normal t {pf=boolValueIsValue pf_bool} _ r' 172 | stuck_is_normal (EIsZeroWrong {t} {pf}) = \_, r => case r of 173 | EIsZeroZero => nat_not_bad_nat {pf=ConvertedFrom Zero} pf 174 | EIsZeroSucc {nv1=nv} {pf=pf_num} => nat_not_bad_nat {pf=succNumValueIsNumValue pf_num} pf 175 | (EIsZero r') => case pf of 176 | IsStuckTerm {pf=pf_stuck} => stuck_is_normal pf_stuck _ r' 177 | IsBool {pf=pf_bool} => values_are_normal t {pf=boolValueIsValue pf_bool} _ r' 178 | 179 | ||| Proof that a fully evaluated term is also normal. 180 | fully_evaluated_is_normal : FullyEvaluated t -> Normal t 181 | fully_evaluated_is_normal (Left pf_stuck) = stuck_is_normal pf_stuck 182 | fully_evaluated_is_normal {t} (Right pf_value) = values_are_normal t {pf=pf_value} 183 | 184 | ----------------------------------------------------------------------- 185 | -- Helper lemmas for `normal_is_fully_evaluated`. 186 | ----------------------------------------------------------------------- 187 | 188 | if_subterm_of_normal_is_normal : {x,y,z : Term} -> Normal (IfThenElse x y z) -> Normal x 189 | if_subterm_of_normal_is_normal pf = \_, r => absurd (pf _ (EIf r)) 190 | 191 | succ_subterm_of_normal_is_normal : {t : Term} -> Normal (Succ t) -> Normal t 192 | succ_subterm_of_normal_is_normal pf = \_, r => absurd (pf _ (ESucc r)) 193 | 194 | pred_subterm_of_normal_is_normal : {t : Term} -> Normal (Pred t) -> Normal t 195 | pred_subterm_of_normal_is_normal pf = \_, r => absurd (pf _ (EPred r)) 196 | 197 | is_zero_subterm_of_normal_is_normal : {t : Term} -> Normal (IsZero t) -> Normal t 198 | is_zero_subterm_of_normal_is_normal pf = \_, r => absurd (pf _ (EIsZero r)) 199 | 200 | succ_of_fully_evaluated_is_fully_evaluated : {t : Term} -> FullyEvaluated t -> FullyEvaluated (Succ t) 201 | succ_of_fully_evaluated_is_fully_evaluated {t} (Left pf_stuck) = Left (ESuccWrong {pf=IsStuckTerm {pf=pf_stuck}}) 202 | succ_of_fully_evaluated_is_fully_evaluated {t} (Right pf_val) = case pf_val of 203 | ConvertedFrom (Left bv) => Left (ESuccWrong {pf=IsBool {pf=ConvertedFrom bv}}) 204 | ConvertedFrom (Right nv) => Right (numValueIsValue $ succNumValueIsNumValue (ConvertedFrom nv)) 205 | 206 | ||| Proof that a normal term is also fully evaluated. 207 | normal_is_fully_evaluated : Normal t -> FullyEvaluated t 208 | normal_is_fully_evaluated {t=True} _ = Right (ConvertedFrom (Left True)) 209 | normal_is_fully_evaluated {t=False} _ = Right (ConvertedFrom (Left False)) 210 | normal_is_fully_evaluated {t=IfThenElse t1 t2 t3} pf_normal = case normal_is_fully_evaluated (if_subterm_of_normal_is_normal pf_normal) of 211 | (Left pf_stuck) => Left (EIfWrong {pf=IsStuckTerm {pf=pf_stuck}}) 212 | (Right pf_val) => case pf_val of 213 | (ConvertedFrom (Left bv)) => case bv of 214 | True => absurd (pf_normal _ EIfTrue) 215 | False => absurd (pf_normal _ EIfFalse) 216 | (ConvertedFrom (Right nv)) => Left (EIfWrong {pf=IsNat {pf=ConvertedFrom nv}}) 217 | normal_is_fully_evaluated {t=Zero} _ = Right (ConvertedFrom (Right Zero)) 218 | normal_is_fully_evaluated {t=Succ t'} pf_normal = succ_of_fully_evaluated_is_fully_evaluated $ 219 | normal_is_fully_evaluated $ 220 | succ_subterm_of_normal_is_normal pf_normal 221 | normal_is_fully_evaluated {t=Pred t'} pf_normal = case normal_is_fully_evaluated $ pred_subterm_of_normal_is_normal pf_normal of 222 | Left pf_stuck => Left (EPredWrong {pf=IsStuckTerm {pf=pf_stuck}}) 223 | Right pf_val => case pf_val of 224 | (ConvertedFrom (Left bv)) => Left (EPredWrong {pf=IsBool {pf=ConvertedFrom bv}}) 225 | (ConvertedFrom (Right Zero)) => absurd (pf_normal _ EPredZero) 226 | (ConvertedFrom (Right (Succ nv))) => absurd (pf_normal _ (EPredSucc {pf=ConvertedFrom nv})) 227 | normal_is_fully_evaluated {t=IsZero t'} pf_normal = case normal_is_fully_evaluated $ is_zero_subterm_of_normal_is_normal pf_normal of 228 | Left pf_stuck => Left (EIsZeroWrong {pf=IsStuckTerm {pf=pf_stuck}}) 229 | Right pf_val => case pf_val of 230 | (ConvertedFrom (Left bv)) => Left (EIsZeroWrong {pf=IsBool {pf=ConvertedFrom bv}}) 231 | (ConvertedFrom (Right Zero)) => absurd (pf_normal _ EIsZeroZero) 232 | (ConvertedFrom (Right (Succ nv))) => absurd (pf_normal _ (EIsZeroSucc {pf=ConvertedFrom nv})) 233 | 234 | -------------------------------------------------------------------------------- 235 | -- Definition of the evaluation function. 236 | -------------------------------------------------------------------------------- 237 | 238 | eval_reduces_size_lemma1 : {n,m : Nat} -> 239 | LTE (S n) (S ((n + m) + 1)) 240 | eval_reduces_size_lemma1 {n = Z} = LTESucc LTEZero 241 | eval_reduces_size_lemma1 {n = (S k)} = LTESucc (eval_reduces_size_lemma1 {n=k}) 242 | 243 | eval_reduces_size_lemma2 : {n,m : Nat} -> 244 | LTE (S m) (S ((n + m) + 1)) 245 | eval_reduces_size_lemma2 {n} {m} = rewrite plusCommutative n m in 246 | eval_reduces_size_lemma1 247 | 248 | eval_reduces_size_lemma3 : {n,m,l : Nat} -> 249 | LTE n m -> 250 | LTE (l+n) (l+m) 251 | eval_reduces_size_lemma3 {l = Z} pf = pf 252 | eval_reduces_size_lemma3 {l = (S k)} pf = LTESucc (eval_reduces_size_lemma3 pf) 253 | 254 | eval_reduces_size_lemma3' : {n,m,l : Nat} -> 255 | LTE n m -> 256 | LTE (n+l) (m+l) 257 | eval_reduces_size_lemma3' {n} {m} {l} pf = rewrite plusCommutative n l in 258 | rewrite plusCommutative m l in 259 | eval_reduces_size_lemma3 pf 260 | 261 | data ElementaryMonotoneFunction : (Nat -> Nat) -> Type where 262 | IsConstant : {c : Nat} -> ElementaryMonotoneFunction (const c) 263 | IsIdentity : ElementaryMonotoneFunction (\n => n) --TODO: Figure out why using `id {a=Nat}` fails to type check 264 | IsSum : {f,g : Nat -> Nat} -> 265 | ElementaryMonotoneFunction f -> 266 | ElementaryMonotoneFunction g -> 267 | ElementaryMonotoneFunction (\n => (f n) + (g n)) 268 | 269 | namespace ElementaryStrictlyMonotoneFunction 270 | data ElementaryStrictlyMonotoneFunction : (Nat -> Nat) -> Type where 271 | IsIdentity : ElementaryStrictlyMonotoneFunction (\n => n) 272 | IsSumLeft : {f,g : Nat -> Nat} -> 273 | ElementaryStrictlyMonotoneFunction f -> 274 | ElementaryMonotoneFunction g -> 275 | ElementaryStrictlyMonotoneFunction (\n => (f n) + (g n)) 276 | IsSumRight : {f,g : Nat -> Nat} -> 277 | ElementaryMonotoneFunction f -> 278 | ElementaryStrictlyMonotoneFunction g -> 279 | ElementaryStrictlyMonotoneFunction (\n => (f n) + (g n)) 280 | 281 | interface Monotone (P : (Nat -> Nat) -> Type) where 282 | monotone : (x, y : Nat) -> 283 | {f : Nat -> Nat} -> 284 | {pf : P f} -> 285 | LTE x y -> 286 | LTE (f x) (f y) 287 | 288 | interface StrictlyMonotone (P : (Nat -> Nat) -> Type) where 289 | strictly_monotone : (x, y : Nat) -> 290 | {f : Nat -> Nat} -> 291 | {pf : P f} -> 292 | LT x y -> 293 | LT (f x) (f y) 294 | 295 | Monotone ElementaryMonotoneFunction where 296 | monotone x y {f = (const c)} {pf = (IsConstant {c=c})} pf_assum = lteRefl 297 | monotone x y {f = (\n => n)} {pf = IsIdentity} pf_assum = pf_assum 298 | monotone x y {f = (\n => ((f n) + (g n)))} {pf = (IsSum {f} {g} pf_f pf_g)} pf_assum = let pf_assum_f = monotone x y {f=f} {pf=pf_f} pf_assum 299 | pf_assum_g = monotone x y {f=g} {pf=pf_g} pf_assum 300 | temp1 = eval_reduces_size_lemma3 {l=f x} pf_assum_g 301 | temp2 = eval_reduces_size_lemma3' {l=g y} pf_assum_f in 302 | lteTransitive temp1 temp2 303 | 304 | StrictlyMonotone ElementaryStrictlyMonotoneFunction where 305 | strictly_monotone x y {f = (\n => n)} {pf = IsIdentity} pf_assum = pf_assum 306 | strictly_monotone x y {f = (\n => ((f n) + (g n)))} {pf = (IsSumLeft {f} {g} pf_f pf_g)} pf_assum = let pf_assum_f = strictly_monotone x y {f=f} {pf=pf_f} pf_assum 307 | pf_assum' = lteTransitive (lteSuccRight lteRefl) pf_assum 308 | pf_assum_g = monotone x y {f=g} {pf=pf_g} pf_assum' 309 | temp1 = eval_reduces_size_lemma3 {l=f y} pf_assum_g 310 | temp2 = eval_reduces_size_lemma3' {l=g x} pf_assum_f in 311 | lteTransitive temp2 temp1 312 | strictly_monotone x y {f = (\n => ((f n) + (g n)))} {pf = (IsSumRight {f} {g} pf_f pf_g)} pf_assum = let pf_assum_g = strictly_monotone x y {f=g} {pf=pf_g} pf_assum 313 | pf_assum' = lteTransitive (lteSuccRight lteRefl) pf_assum 314 | pf_assum_f = monotone x y {f=f} {pf=pf_f} pf_assum' 315 | temp1 = eval_reduces_size_lemma3 {l=f x} pf_assum_g 316 | temp2 = eval_reduces_size_lemma3' {l=g y} pf_assum_f in 317 | rewrite plusSuccRightSucc (f x) (g x) in 318 | lteTransitive temp1 temp2 319 | 320 | -- Note: We need to define `if_then_else_size_f` explicitly using a lambda expression 321 | -- (instead of pattern matching) because otherwise `pf_if_then_else_size_f` below will 322 | -- fail to type check. 323 | if_then_else_size_f : {n2, n3 : Nat} -> Nat -> Nat 324 | if_then_else_size_f {n2} {n3} = \n => ((n + n2) + n3) + 1 325 | 326 | pf_if_then_else_size_f : {n2, n3 : Nat} -> 327 | ElementaryStrictlyMonotoneFunction (if_then_else_size_f {n2=n2} {n3=n3}) 328 | pf_if_then_else_size_f {n2} {n3} = IsSumLeft (IsSumLeft (IsSumLeft IsIdentity (IsConstant {c=n2})) (IsConstant {c=n3})) (IsConstant {c=1}) 329 | 330 | succ_size_f : Nat -> Nat 331 | succ_size_f = \n => S n 332 | 333 | pf_succ_size_f : ElementaryStrictlyMonotoneFunction Ch04.Eval.succ_size_f 334 | pf_succ_size_f = IsSumRight (IsConstant {c=1}) IsIdentity 335 | 336 | pred_size_f : Nat -> Nat 337 | pred_size_f = \n => S n 338 | 339 | pf_pred_size_f : ElementaryStrictlyMonotoneFunction Ch04.Eval.pred_size_f 340 | pf_pred_size_f = IsSumRight (IsConstant {c=1}) IsIdentity 341 | 342 | is_zero_size_f : Nat -> Nat 343 | is_zero_size_f = \n => S n 344 | 345 | pf_is_zero_size_f : ElementaryStrictlyMonotoneFunction Ch04.Eval.is_zero_size_f 346 | pf_is_zero_size_f = IsSumRight (IsConstant {c=1}) IsIdentity 347 | 348 | ||| Proof that evaluation reduces size. 349 | eval_reduces_size : {t,t' : Term} -> EvalsTo t t' -> LT (size t') (size t) 350 | eval_reduces_size {t = (IfThenElse True t2 t3)} {t' = t2} EIfTrue = eval_reduces_size_lemma1 351 | eval_reduces_size {t = (IfThenElse False t2 t3)} {t' = t3} EIfFalse = eval_reduces_size_lemma2 352 | eval_reduces_size {t = (IfThenElse t1 t2 t3)} {t' = (IfThenElse t1' t2 t3)} (EIf x) = let pf = eval_reduces_size x in 353 | strictly_monotone (size t1') (size t1) {pf=pf_if_then_else_size_f} pf 354 | eval_reduces_size {t = (Succ t1)} {t' = (Succ t2)} (ESucc x) = let pf = eval_reduces_size x in 355 | strictly_monotone (size t2) (size t1) {pf=pf_succ_size_f} pf 356 | eval_reduces_size {t = (Pred Zero)} {t' = Zero} EPredZero = lteRefl 357 | eval_reduces_size {t = (Pred (Succ t'))} {t' = t'} EPredSucc = LTESucc (lteSuccRight lteRefl) 358 | eval_reduces_size {t = (Pred t1)} {t' = (Pred t2)} (EPred x) = let pf = eval_reduces_size x in 359 | strictly_monotone (size t2) (size t1) {pf=pf_pred_size_f} pf 360 | eval_reduces_size {t = (IsZero Zero)} {t' = True} EIsZeroZero = lteRefl 361 | eval_reduces_size {t = (IsZero (Succ nv1))} {t' = False} EIsZeroSucc = LTESucc (LTESucc LTEZero) 362 | eval_reduces_size {t = (IsZero t1)} {t' = (IsZero t2)} (EIsZero x) = let pf = eval_reduces_size x in 363 | strictly_monotone (size t2) (size t1) {pf=pf_is_zero_size_f} pf 364 | 365 | ||| Proof that a term is either normal or evaluates to something. Note that this would be 366 | ||| a triviality if we were to assume the law of the excluded middle. 367 | either_normal_or_evals : (t : Term) -> Either (Normal t) (t' : Term ** EvalsTo t t') 368 | either_normal_or_evals True = Left true_is_normal 369 | either_normal_or_evals False = Left false_is_normal 370 | either_normal_or_evals (IfThenElse t1 t2 t3) = case either_normal_or_evals t1 of 371 | Left pf_normal => case normal_is_fully_evaluated pf_normal of 372 | Left pf_stuck => Left (fully_evaluated_is_normal $ 373 | Left (EIfWrong {pf=IsStuckTerm {pf=pf_stuck}})) 374 | Right pf_val => case pf_val of 375 | (ConvertedFrom (Left True)) => Right (t2 ** EIfTrue) 376 | (ConvertedFrom (Left False)) => Right (t3 ** EIfFalse) 377 | (ConvertedFrom (Right nv)) => Left (fully_evaluated_is_normal $ 378 | Left (EIfWrong {pf=IsNat {pf=ConvertedFrom nv}})) 379 | Right (t1' ** r) => Right ((IfThenElse t1' t2 t3) ** EIf r) 380 | either_normal_or_evals Zero = Left zero_is_normal 381 | either_normal_or_evals (Succ t) = case either_normal_or_evals t of 382 | Left pf_normal => Left (fully_evaluated_is_normal $ 383 | succ_of_fully_evaluated_is_fully_evaluated $ 384 | normal_is_fully_evaluated pf_normal) 385 | Right (t' ** r) => Right ((Succ t') ** (ESucc r)) 386 | either_normal_or_evals (Pred t) = case either_normal_or_evals t of 387 | Left pf_normal => case normal_is_fully_evaluated pf_normal of 388 | Left pf_stuck => Left (fully_evaluated_is_normal $ 389 | Left (EPredWrong {pf=IsStuckTerm {pf=pf_stuck}})) 390 | Right pf_val => case pf_val of 391 | (ConvertedFrom (Left bv)) => Left (fully_evaluated_is_normal $ 392 | Left (EPredWrong {pf=IsBool {pf=ConvertedFrom bv}})) 393 | (ConvertedFrom (Right Zero)) => Right (Zero ** EPredZero) 394 | (ConvertedFrom (Right (Succ nv))) => Right ((nv2t nv) ** EPredSucc {pf=ConvertedFrom nv}) 395 | Right (t' ** r) => Right (_ ** (EPred r)) 396 | either_normal_or_evals (IsZero t) = case either_normal_or_evals t of 397 | Left pf_normal => case normal_is_fully_evaluated pf_normal of 398 | Left pf_stuck => Left (fully_evaluated_is_normal $ 399 | Left (EIsZeroWrong {pf=IsStuckTerm {pf=pf_stuck}})) 400 | Right pf_val => case pf_val of 401 | (ConvertedFrom (Left bv)) => Left (fully_evaluated_is_normal $ 402 | Left (EIsZeroWrong {pf=IsBool {pf=ConvertedFrom bv}})) 403 | (ConvertedFrom (Right Zero)) => Right (True ** EIsZeroZero) 404 | (ConvertedFrom (Right (Succ nv))) => Right (False ** EIsZeroSucc {pf=ConvertedFrom nv}) 405 | Right (t' ** r) => Right (_ ** (EIsZero r)) 406 | 407 | ||| Given a term, returns its value. 408 | smallStep_eval : (t : Term) -> (v : Term ** (EvalsToStar t v, FullyEvaluated v)) 409 | smallStep_eval t = (inductive_construction size' f) (t ** Refl) where 410 | a : Type 411 | a = (t' : Term ** EvalsToStar t t') 412 | 413 | b : Type 414 | b = (t' : Term ** (EvalsToStar t t', FullyEvaluated t')) 415 | 416 | size' : a -> Nat 417 | size' (t' ** _) = size t' 418 | 419 | f : (x : a) -> Either b (x' : a ** LT (size' x') (size' x)) 420 | f (t' ** p) = case either_normal_or_evals t' of 421 | Left pf_normal => Left (t' ** (p, normal_is_fully_evaluated pf_normal)) 422 | Right (t'' ** p') => Right ((t'' ** (snoc p p')) ** eval_reduces_size p') 423 | 424 | 425 | -------------------------------------------------------------------------------- /Ch04/NaturalInduction.idr: -------------------------------------------------------------------------------- 1 | module Ch04.NaturalInduction 2 | 3 | -- TODO: Figure out how to implement the function below (if it's at all possible). 4 | 5 | --natural_induction_principle : {a,b : Type} -> 6 | -- (size : a -> Nat) -> 7 | -- (f : (x : a) -> Either b (x' : a ** LT (size x') (size x))) -> 8 | -- (g : (a -> b) ** (x : a) -> (case f x of 9 | -- Left y => (g x = y) 10 | -- Right (y ** _) => (g x = g y))) 11 | 12 | lemma : {x : Nat} -> 13 | LTE x 0 -> 14 | (x = 0) 15 | lemma {x = Z} pf = Refl 16 | lemma {x = (S k)} pf = absurd (succNotLTEzero pf) 17 | 18 | public export 19 | inductive_construction : {a,b : Type} -> 20 | (size : a -> Nat) -> 21 | (f : (x : a) -> Either b (x' : a ** LT (size x') (size x))) -> 22 | a -> b 23 | inductive_construction {a} {b} size f x = helper x (size x) lteRefl where 24 | helper : (x : a) -> (k : Nat) -> LTE (size x) k -> b 25 | helper x k bound = case f x of 26 | Left y => y 27 | Right (x' ** pf) => case k of 28 | Z => let temp = replace (lemma bound) pf in 29 | absurd (succNotLTEzero temp) 30 | (S j) => helper x' j (fromLteSucc (lteTransitive pf bound)) 31 | -------------------------------------------------------------------------------- /Ch04/SubTerm.idr: -------------------------------------------------------------------------------- 1 | module Ch04.SubTerm 2 | 3 | import Ch03.Arith 4 | 5 | ||| Propositional type describing that one term is an direct subterm of another one. 6 | data DirectSubTerm : Term -> Term -> Type where 7 | IsIfTerm : (x : Term) -> DirectSubTerm x (IfThenElse x y z) 8 | IsThenTerm : (y : Term) -> DirectSubTerm y (IfThenElse x y z) 9 | IsElseTerm : (z : Term) -> DirectSubTerm z (IfThenElse x y z) 10 | IsSuccSubTerm : (x : Term) -> DirectSubTerm x (Succ x) 11 | IsPredSubTerm : (x : Term) -> DirectSubTerm x (Pred x) 12 | 13 | ||| Propositional type describing that one term is a subterm of another one. 14 | data SubTerm : Term -> Term -> Type where 15 | IsSubTermOfDirectSubTerm : SubTerm x y -> DirectSubTerm y z -> SubTerm x z 16 | IsEqual : SubTerm x x 17 | -------------------------------------------------------------------------------- /Ch05/EvalLambdaCalculus.idr: -------------------------------------------------------------------------------- 1 | module Ch05.EvalLambdaCalculus 2 | 3 | import Ch05.LambdaCalculus 4 | 5 | %default total 6 | 7 | ----------------------------------------------------------------------- 8 | -- Evaluating the "evil" lambda calculus, one parentheses at a time. 9 | ----------------------------------------------------------------------- 10 | 11 | -- Remark: Defining the evaluation rules for the toy language of 12 | -- arithmetic expressions was very straightforward (even though 13 | -- implementing the evaluation function turned out to be quite 14 | -- involved, since we needed to prove totality.) 15 | -- 16 | -- However, for the lambda calculus it isn't because of the problem 17 | -- of variable capture. The book only makes some vagues hand gestures 18 | -- suggesting we work with "terms up to alpha-conversion" and then 19 | -- proceeds to give a prescription of substitution that is only partially 20 | -- defined on terms. 21 | -- 22 | -- To give sense to this vague suggestion, we might be tempted to 23 | -- introduce a parametrized type `AlphaConverts t1 t2` that 24 | -- says when two terms can be derived from each other by alpha 25 | -- conversion (renaming of bound variables). Of course, the operation 26 | -- of alpha conversion is a special case of variable substitution so 27 | -- it seems we get stuck in a vicious circle. 28 | -- Supposing that we won't, we might then proceed to form something 29 | -- like a quotient type by forcing the existence of a function 30 | -- 31 | -- AlphaConverts t1 t2 -> (t1 = t2) 32 | -- 33 | -- (e.g. using believe_me). But that would be serious messing with 34 | -- the type checker, so I don't like it. 35 | -- 36 | -- So, I think I proceed as follows: 37 | -- Define substitution using mutual recursion between a partially defined 38 | -- substitution operation and an alpha-conversion operation that converts any 39 | -- term to a term accepted by the partially defined substitution function. 40 | 41 | -- TODO: Fix the definition below. 42 | data AlphaConverts : Term -> Term -> Type where 43 | RenameLambda : {x, y : Variable} -> 44 | {t : Term} -> 45 | Not (OccursFree x t) -> 46 | Not (OccursFree y t) -> 47 | AlphaConverts (Abs x t) (Abs y t) 48 | ConvertBody : AlphaConverts t t' -> 49 | AlphaConverts (Abs x t) (Abs x t') 50 | ConvertsFun : AlphaConverts f f' -> 51 | AlphaConverts (App f x) (App f' x) 52 | ConvertsArg : AlphaConverts x x' -> 53 | AlphaConverts (App f x) (App f x') 54 | -------------------------------------------------------------------------------- /Ch05/Exercise_5_2_1.idr: -------------------------------------------------------------------------------- 1 | module Ch05.Exercise_5_2_1 2 | 3 | import Ch05.LambdaCalculus 4 | 5 | %default total 6 | 7 | or : Term 8 | or = Abs 0 (Abs 1 (App (App (Var 0) tru) (Var 1))) 9 | 10 | not : Term 11 | not = Abs 0 (Abs 1 (Abs 2 (App (App (Var 0) (Var 2)) (Var 1)))) 12 | 13 | -------------------------------------------------------------------------------- /Ch05/Exercise_5_2_10.idr: -------------------------------------------------------------------------------- 1 | module Exercise_5_2_10 2 | 3 | import Ch05.LambdaCalculusWithArith 4 | 5 | %default total 6 | 7 | ||| Terms representing a function converting primitive natural numbers 8 | ||| into Church numerals. 9 | churchnat : Term 10 | churchnat = fix . g where 11 | g : Term 12 | g = lambda 0 13 | (\f => lambda 1 14 | (\n => IfThenElse (IsZero n) 15 | church_zero 16 | (scc . (f . (Pred n))))) 17 | -------------------------------------------------------------------------------- /Ch05/Exercise_5_2_11.idr: -------------------------------------------------------------------------------- 1 | module Exercise_5_2_11 2 | 3 | import Ch05.LambdaCalculusWithArith 4 | 5 | %default total 6 | 7 | -- The implementation below is the simple (and naive) one 8 | ||| Term representing a function that, given a list of Church numerals (encoded as in ex. 5.2.8), 9 | ||| will return their sum 10 | listsum_naive : Term 11 | listsum_naive = lambda 0 12 | (\l => l . plus . church_zero) 13 | 14 | -- The implementation below uses the fix-point combinator 15 | ||| Term representing a function that, given a list of Church numerals (encoded as in ex. 5.2.8), 16 | ||| will return their sum 17 | listsum : Term 18 | listsum = fix . g where 19 | g : Term 20 | g = lambda 0 21 | (\f => (lambda 1 22 | (\l => IfThenElse (realbool . (isnil . l)) 23 | church_zero 24 | (plus . (head . l) . (f . (tail . l)))))) 25 | -------------------------------------------------------------------------------- /Ch05/Exercise_5_2_2.idr: -------------------------------------------------------------------------------- 1 | module Ch05.Exercise_5_2_2 2 | 3 | import Ch05.LambdaCalculus 4 | 5 | %default total 6 | 7 | ||| Alternative version of the Church numeral successor 8 | scc' : Term 9 | scc' = Abs 0 (Abs 1 (Abs 2 (App (App (Var 0) (Var 1)) (App (Var 1) (Var 2))))) 10 | -------------------------------------------------------------------------------- /Ch05/Exercise_5_2_3.idr: -------------------------------------------------------------------------------- 1 | module Ch05.Exercise_5_2_3 2 | 3 | import Ch05.LambdaCalculus 4 | 5 | %default total 6 | 7 | ||| Alternative (more concise) way to define multiplication of Church numerals 8 | times' : Term 9 | times' = Abs 0 (Abs 1 ((Var 0) . (Var 1))) 10 | -------------------------------------------------------------------------------- /Ch05/Exercise_5_2_4.idr: -------------------------------------------------------------------------------- 1 | module Ch05.Exercise_5_2_4 2 | 3 | import Ch05.LambdaCalculus 4 | 5 | %default total 6 | 7 | ||| `pow m n` is `m` raised to the power `n` 8 | pow : Term 9 | pow = Abs 0 (Abs 1 ((Var 1) . (times . (Var 0))) . church_one) 10 | 11 | -------------------------------------------------------------------------------- /Ch05/Exercise_5_2_5.idr: -------------------------------------------------------------------------------- 1 | module Ch05.Exercise_5_2_5 2 | 3 | import Ch05.LambdaCalculus 4 | 5 | %default total 6 | 7 | ||| `sub m n` yields the result of subtracting `n` from `m` (Church numerals). 8 | ||| 9 | ||| More precisely, it yields the smallest church numeral `z` such that 10 | ||| 11 | ||| m <= n+z 12 | public export 13 | sub : Term 14 | sub = let m = Var 0 15 | n = Var 1 in 16 | Abs 0 (Abs 1 (n . prd) . m) 17 | -------------------------------------------------------------------------------- /Ch05/Exercise_5_2_7.idr: -------------------------------------------------------------------------------- 1 | module Ch05.Exercise_5_2_7 2 | 3 | import Ch05.LambdaCalculus 4 | import Ch05.Exercise_5_2_5 5 | 6 | %default total 7 | 8 | ||| `le m n` tests whether `m` is less than or equal to `n` 9 | le : Term 10 | le = let m = Var 0 11 | n = Var 1 in 12 | Abs 0 (Abs 1 (iszro . (sub . m . n))) 13 | 14 | ||| Test whether two Church numerals are equal 15 | equal : Term 16 | equal = let m = Var 0 17 | n = Var 1 18 | m_le_n = le . m . n 19 | n_le_m = le . n . m in 20 | Abs 0 (Abs 1 (and . m_le_n . n_le_m)) 21 | -------------------------------------------------------------------------------- /Ch05/Exercise_5_2_8.idr: -------------------------------------------------------------------------------- 1 | module Ch05.Exercise_5_2_8 2 | 3 | import Ch05.LambdaCalculus 4 | 5 | %default total 6 | 7 | -- Lists are represented by their corresponding fold function. That is, a list 8 | -- [x, y, z] is identified with the function 9 | -- 10 | -- f |-> ( c |-> f x (f y (f z c))) ) 11 | -- 12 | -- Where f is any 2-ary function (since the untyped lambda calculus is untyped, of 13 | -- course we can't talk about arities). 14 | 15 | ||| The term representing the empty list 16 | nil : Term 17 | nil = Abs 0 (Abs 1 (Var 1))--?nil_rhs 18 | 19 | ||| The term representing the cons combinator 20 | cons : Term 21 | cons = let car = Var 0 -- not to be confused with the car combinator below 22 | cdr = Var 1 -- --------------------------- cdr ---------------- 23 | f = Var 2 24 | c = Var 3 in 25 | Abs 0 (Abs 1 (Abs 2 (Abs 3 (f . car . (cdr . f . c))))) 26 | 27 | ||| Checks whether a list is nil 28 | isnil : Term 29 | isnil = let l = Var 0 30 | f = Abs 1 (Abs 2 fls) in 31 | Abs 0 (l . f . tru) 32 | 33 | ||| The term representing the "car" combinator 34 | head : Term 35 | head = let l = Var 0 in 36 | Abs 0 l . fst . nil 37 | 38 | ||| The term representing the "cdr" combinator 39 | tail : Term 40 | tail = let l = Var 0 41 | x = Var 1 42 | y = Var 2 43 | f = Abs 1 (Abs 2 pair . (snd . y) . (cons . x . (snd . y))) 44 | c = pair . nil . nil in 45 | Abs 0 (fst . (l . f . c)) 46 | -------------------------------------------------------------------------------- /Ch05/Exercises.md: -------------------------------------------------------------------------------- 1 | # Exercises Chapter Five 2 | 3 | ## 5.2.1 4 | 5 | \begin{align*} \texttt{or} & = \lambda \texttt{x.} \lambda \texttt{y.x tru y} 6 | \\ 7 | \texttt{not} & = \lambda \texttt{f.}\lambda \texttt{x.} \lambda \texttt{y.f 8 | y x} 9 | \end{align*} 10 | 11 | ## 5.2.2 12 | 13 | $$\texttt{scc'} = \lambda \texttt{n.}\lambda \texttt{f.}\lambda \texttt{z. (n 14 | f) (f z)}$$ 15 | 16 | ## 5.2.3 17 | 18 | $$\texttt{times'} = \lambda \texttt{m.} \lambda \texttt{n.mn}$$ 19 | 20 | ## 5.2.4 21 | 22 | $$\texttt{pow} = \lambda \texttt{m.}\lambda \texttt{n. (n (times m))} 23 | \texttt{c}_1$$ 24 | 25 | ## 5.2.5 26 | 27 | $$\texttt{sub} = \lambda \texttt{m.}\lambda \texttt{n.n prd m}$$ 28 | 29 | ## 5.2.6 30 | 31 | Given a term $t$, let $\tau(t)$ denote the minimal number of steps in which $t$ 32 | can be reduced to normal form (using call-by-value reductions). 33 | 34 | Then for any $n 35 | \in \N$ and normal terms $f$ and $x$ we have 36 | 37 | $$ \tau(\texttt{c}_n f x) \leq 2 + \tau(\underbrace{f \ldots f}_{\text{$n$ 38 | times}} x))$$ 39 | 40 | $$ \tau(\texttt{sub}\ \texttt{c}_m\ \texttt{c}_n) \leq 2+\tau(\texttt{c}_n\ 41 | \texttt{prd} \ \texttt{c}_m) \leq 4 + \tau(\underbrace{\texttt{prd} \ldots 42 | \texttt{prd}}_{\text{$n$ times}} \texttt{c}_m)$$ 43 | 44 | Now 45 | 46 | $$\tau(\texttt{prd}\ \texttt{c}_n) \leq 3 + \tau(\texttt{fst}\ 47 | (\underbrace{\texttt{ss} \ldots \texttt{ss}}_{\text{$n$ times}} \ \texttt{zz})) = O(n)$$ 48 | 49 | So 50 | 51 | $$\tau(\texttt{sub}\ \texttt{c}_m\ \texttt{c}_n) \leq 4 + \tau(\texttt{prd}\ 52 | \texttt{c}_m) + \tau(\texttt{prd}\ \texttt{c}_{m-1}) + \ldots 53 | + \tau(\texttt{prd}\ \texttt{c}_{\text{max}(0, m-n)}) = O(m^2 + n)$$ 54 | 55 | ## 5.2.7 56 | 57 | $$\texttt{equal} = \lambda \texttt{m.}\lambda \texttt{n.and (iszro (m prd n)) (iszro (n prd 58 | m))}$$ 59 | 60 | ## 5.2.8 61 | 62 | \begin{align*} 63 | \texttt{nil} & = \lambda \texttt{f.}\lambda \texttt{c.c} \\ 64 | % 65 | \texttt{cons} & = \lambda \texttt{x.} \lambda \texttt{xs.} \lambda 66 | \texttt{f.}\lambda \texttt{c.f x (xs f c)} \\ 67 | % 68 | \texttt{isnil} & = \lambda \texttt{l.l (}\lambda \texttt{x.}\lambda 69 | \texttt{c.fls}\texttt{) tru} \\ 70 | % 71 | \texttt{head} & = \lambda \texttt{l.l fst nil} \\ 72 | % 73 | \texttt{tail} & = \lambda \texttt{l.fst (l (} \lambda \texttt{x.}\lambda 74 | \texttt{c.pair (snd c) (cons x (snd c))} \texttt{) (pair nil nil))} 75 | \end{align*} 76 | 77 | ## 5.2.9 78 | 79 | The "if then else"-function for Church booleans is defined as 80 | 81 | $$\texttt{test} = \lambda \texttt{b.} \lambda \texttt{x.}\lambda \texttt{y.b 82 | x y}$$ 83 | 84 | In words, one applies the Church boolean \texttt{b} to the "then branch" \texttt{x} and 85 | the "else branch" \texttt{y} as a function. 86 | 87 | Now, the problem is that with the call-by-value evaluation strategy, we are 88 | always evaluating function arguments *first* before we apply them to 89 | a function. But since the "else value" in the definition of the factorial 90 | function recursively calls itself, trying to evaluate this term to a value 91 | would lead to an infinite regress. 92 | 93 | This problem is evaded if we use the "baked-in" boolean and their if-then-else 94 | "function", or rather *expression*, because the evaluation rules 95 | \texttt{E-IfTrue}, \texttt{E-IfFalse} and \texttt{E-If} together mean that we 96 | never evaluate the branches before we evaluate the condition, and we only 97 | evaluate that branch that is taken. 98 | 99 | To avoid this problem and still use the Church booleans, we can use the generic 100 | trick to prevent premature evaluation (which works under the call-by-value 101 | convention) by wrapping the branches in lambda abstraction: 102 | 103 | \begin{align*} 104 | \texttt{factorial} & = \lambda \texttt{n.(fix g) n tru} \\ 105 | % 106 | \texttt{g} & = \lambda \texttt{f.} \lambda \texttt{n.(test (iszro n) }\lambda \texttt{z.c}_1\texttt{ }\lambda \texttt{z.r) id} \\ 107 | % 108 | \texttt{r} & = \texttt{times n (f (prd n))} 109 | \end{align*} 110 | 111 | Wrapping both branches in lambda abstraction (with dummy variable \texttt{z}) 112 | we prevent them from being evaluated before evaluation of \texttt{test}; 113 | afterwards, we supply the dummy value \texttt{id} to get the value back. 114 | 115 | **Note:** This trick of wrapping values in lambda forms can also used to create lazy 116 | versions of common data structures in languages (like potentially infinite lists) that don't support lazy 117 | evaluation out-of-the-box (like Common Lisp e.g.). 118 | 119 | ## 5.2.10 120 | 121 | $$\texttt{churchnat} = \texttt{fix 122 | }\lambda\texttt{f.}\lambda\texttt{n.if (iszero n) c}_0\texttt{ (scc (f (pred 123 | n)))}$$ 124 | 125 | ## 5.3.3 126 | 127 | Let $t$ be a term in the untyped lambda calculus and let $FV(t)$ denote the set 128 | of variables occuring freely in $t$. Then 129 | 130 | $$\# FV(t) \leq size(t)$$ 131 | 132 | Here $size(t)$ is the size of the term $t$ (this isn't actually defined in the 133 | book for the lambda calculus), i.e. the number of nodes in its abstract syntax 134 | tree, i.e. the number of constructors occuring in it. 135 | More precisely, we have 136 | 137 | \begin{align*} 138 | size(x) & = 1 \\ 139 | size(\lambda x.y) & = 1 + size(y) \\ 140 | size(f x) & = 1 + size(f) + size(x) 141 | \end{align*} 142 | 143 | To show this, we proceed by structural induction over $t$. 144 | 145 | When $t = x$ is a variable, we have $FV(t) = \{x\}$ and $size(t) = 1$. When $t 146 | = \lambda x.y$, we distinguish two cases. In the first case, $x \not\in FV(y)$ 147 | and $FV(t) = FV(y)$, thus 148 | 149 | $$\# FV(t) = \# FV(y) \leq size(y) < 1+size(y) = size(t)$$ 150 | 151 | In the second case, $x \in FV(y)$ and 152 | 153 | $$\# FV(t) = \# FV(y) - 1 \leq size(y) - 1 < size(y) + 1 = size(t)$$ 154 | 155 | Now when $t = (f x)$, then 156 | 157 | $$\# FV(t) \leq \# FV(f) + \# FV(x) \leq size(f) + size(x) < 1 + size(f) 158 | + size(x) = size(t)$$ 159 | -------------------------------------------------------------------------------- /Ch05/LambdaCalculus.idr: -------------------------------------------------------------------------------- 1 | module Ch05.LambdaCalculus 2 | 3 | import Ch03.Relations 4 | 5 | %access public export 6 | 7 | ||| The type of variables 8 | Variable : Type 9 | Variable = Nat 10 | 11 | ||| The type of terms in the untyped lambda calculus 12 | data Term = Var Variable 13 | | Abs Variable Term 14 | | App Term Term 15 | 16 | ||| Convenient infix notation for construction of function application terms 17 | (.) : Term -> Term -> Term 18 | (.) = App 19 | 20 | -- TODO: Can we get rid of the argument `n`? 21 | ||| Convenience function for constructing lambda terms 22 | lambda : Nat -> (Term -> Term) -> Term 23 | lambda n f = Abs n (f (Var n)) 24 | 25 | MultiAppArgType : (numArgs : Nat) -> Type 26 | MultiAppArgType Z = Term 27 | MultiAppArgType (S k) = Term -> MultiAppArgType k 28 | 29 | -- K_0 = id : a -> a 30 | -- K : a -> b -> a 31 | -- K_2 : a -> b -> b -> a 32 | -- K_n : a -> b ... -> b -> a 33 | -- 34 | -- K f t 35 | -- K_2 f t1 t2 := K (K f t1) t2 36 | -- 37 | -- K_{n+1} : a -> b -> .. -> b -> (b -> a) 38 | -- K_{n+1} f x1 ... x{n+1} = K (K_n f x1 ... x_n) x_{n+1} 39 | 40 | ||| Convenience version of the `App` constructor that allows for a variable number of arguments. 41 | multi_app : {numArgs : Nat} -> (MultiAppArgType numArgs -> Term) 42 | multi_app {numArgs = Z} = \f => f 43 | multi_app {numArgs = (S k)} = ?hole--(\f : Term => App f t) . (multi_app {numArgs=k}) 44 | 45 | data DirectSubterm : Term -> Term -> Type where 46 | IsAbsBody : {x : Variable} -> 47 | {t : Term} -> 48 | DirectSubterm t (Abs x t) 49 | IsAppFun : {f, x : Term} -> 50 | DirectSubterm f (App f x) 51 | 52 | IsAppArg : {f, x : Term} -> 53 | DirectSubterm x (App f x) 54 | 55 | 56 | Subterm : Term -> Term -> Type 57 | Subterm = ReflSymmClos DirectSubterm 58 | 59 | -- vars (x) = {x} 60 | -- vars (lambda x . t) = {x} \cup vars (t) 61 | -- vars (f t) = vars(f) \cup vars(t) 62 | -- 63 | -- bound_vars (x) = {} 64 | -- bound_vars (lambda x . t) = \{x\} \cup bound_vars(t) 65 | -- bound_vars (f t) = bound_vars(f) \cup bound_vars(t) 66 | -- 67 | -- free_vars (x) = {} 68 | -- free_vars (lambda x . t) = free_vars(t) - \{x\} 69 | -- free_vars (f t) = free_vars(f) \cup free_vars(t) 70 | -- 71 | 72 | 73 | 74 | namespace Occurs 75 | ||| Propositional type describing that a variable occurs in a term. 76 | data Occurs : Variable -> Term -> Type where 77 | IsVar : (x : Variable) -> 78 | Occurs x (Var x) 79 | 80 | namespace OccursFree 81 | ||| Propositional type describing that a variable occurs freely in a term. 82 | data OccursFree : Variable -> Term -> Type where 83 | IsVar : (x : Variable) -> 84 | OccursFree x (Var x) 85 | InBody : {x,y : Variable} -> 86 | {t : Term} -> 87 | Not (x = y) -> 88 | OccursFree x t -> 89 | OccursFree x (Abs y t) 90 | InAppFun : {x : Variable} -> 91 | {f, t : Term} -> 92 | OccursFree x f -> 93 | OccursFree x (App f t) 94 | InAppArg : {x : Variable} -> 95 | {f, t : Term} -> 96 | OccursFree x t -> 97 | OccursFree x (App f t) 98 | 99 | Closed : Term -> Type 100 | Closed t = (x : Variable) -> Not (OccursFree x t) 101 | 102 | namespace OccursBound 103 | ||| Propositional type describing that a variable occurs bound in a term. 104 | data OccursBound : Variable -> Term -> Type where 105 | 106 | 107 | ||| The identity combinator. 108 | id : Term 109 | id = Abs 0 (Var 0) 110 | 111 | ||| Proof that the identity combinator is closed. 112 | id_is_closed : Closed Ch05.LambdaCalculus.id 113 | id_is_closed x pf_occurs_free = case pf_occurs_free of 114 | (InBody pf_ne pf_in_t) => case pf_in_t of 115 | (IsVar Z) => pf_ne Refl 116 | 117 | -------------------------------------------------------------------------------- 118 | -- Booleans 119 | -------------------------------------------------------------------------------- 120 | 121 | ||| The Church boolean true 122 | tru : Term 123 | tru = Abs 1 (Abs 0 (Var 1)) 124 | 125 | ||| The Church boolean false 126 | fls : Term 127 | fls = Abs 1 (Abs 0 (Var 0)) 128 | 129 | ||| Church encoding of the if-then-else operator 130 | test : Term 131 | test = Abs 2 (Abs 1 (Abs 0 (App (App (Var 2) (Var 1)) (Var 0)))) 132 | 133 | ||| Logical AND operator for Church booleans. 134 | and : Term 135 | and = Abs 0 (Abs 1 (App (App (Var 0) (Var 1)) fls)) 136 | 137 | -------------------------------------------------------------------------------- 138 | -- Pairs 139 | -------------------------------------------------------------------------------- 140 | 141 | ||| Church pair constructor 142 | pair : Term 143 | pair = Abs 0 (Abs 1 (Abs 2 (App (App (Var 2) (Var 0)) (Var 1)))) 144 | 145 | ||| Projection onto the first component of a pair 146 | fst : Term 147 | fst = Abs 0 (Abs 1 (Var 0)) 148 | 149 | ||| Projection onto the second component of a pair 150 | snd : Term 151 | snd = Abs 0 (Abs 1 (Var 1)) 152 | 153 | -------------------------------------------------------------------------------- 154 | -- Numerals 155 | -------------------------------------------------------------------------------- 156 | 157 | ||| The Church numeral zero. 158 | church_zero : Term 159 | church_zero = Abs 1 (Abs 0 (Var 0)) 160 | 161 | ||| The Church numeral one. 162 | church_one : Term 163 | church_one = Abs 1 (Abs 0 (App (Var 1) (Var 0))) 164 | 165 | ||| The Church numeral two. 166 | church_two : Term 167 | church_two = Abs 1 (Abs 0 (App (Var 1) (App (Var 1) (Var 0)))) 168 | 169 | ||| The successors function for Church numerals 170 | scc : Term 171 | scc = Abs 0 (Abs 1 (Abs 2 (App (Var 1) (App (App (Var 0) (Var 1)) (Var 2))))) 172 | 173 | ||| Addition of Church numerals 174 | plus : Term 175 | plus = Abs 0 (Abs 1 (Abs 2 (Abs 3 ((Var 0) . (Var 2)) . (((Var 1) . (Var 2)) . (Var 3))))) 176 | 177 | ||| Multiplication of Church numerals 178 | times : Term 179 | times = Abs 0 (Abs 1 ((Var 0) . (plus . (Var 1))) . church_zero) 180 | 181 | ||| Tests whether a Church numeral is zero or not 182 | iszro : Term 183 | iszro = Abs 0 ((Var 0) . (Abs 0 fls)) . tru 184 | 185 | ||| The predecessor function on Church numerals 186 | prd : Term 187 | prd = let zz = pair . church_zero . church_zero 188 | ss = Abs 0 (pair . (snd . (Var 0)) . (scc . (snd . (Var 0)))) in 189 | Abs 0 (fst . ((Var 0) . ss) . zz) 190 | 191 | -------------------------------------------------------------------------------- 192 | -- Lists 193 | -------------------------------------------------------------------------------- 194 | 195 | -- See Ch05.Exercise_5_2_8 196 | 197 | -------------------------------------------------------------------------------- 198 | -- Self-replicating terms 199 | -------------------------------------------------------------------------------- 200 | 201 | ||| The (?) simplest self-replicating term in the lambda calculus 202 | omega : Term 203 | omega = let x = Var 0 204 | f = Abs 0 (x . x) in 205 | f . f 206 | 207 | ||| The call-by-value version of the fix-point combinator (i.e. Y combinator) 208 | fix : Term 209 | fix = let f = Var 0 210 | x = Var 1 211 | y = Var 2 212 | t = Abs 1 f . (Abs 2 (x . x . y)) in 213 | Abs 0 (t . t) 214 | -------------------------------------------------------------------------------- /Ch05/LambdaCalculusWithArith.idr: -------------------------------------------------------------------------------- 1 | module Ch05.LambdaCalculusWithArith 2 | 3 | import Ch03.Relations 4 | 5 | %default total 6 | %access public export 7 | 8 | -------------------------------------------------------------------------------- 9 | -- The lambda calculus extended by native arithmetic expressions. 10 | -------------------------------------------------------------------------------- 11 | -- 12 | -- Remark: It kinda sucks to have to repeat the definitions of the lambda 13 | -- calculus and the language of arithmetic expressions. In particular because 14 | -- in the book Pierce doesn't even bother to write down the language and simply 15 | -- waves his hands. So you expect to be able to just formally combine the two 16 | -- languages. 17 | -- However, I don't know a convenient way to do that since Idris has no subtyping. 18 | -- It would be possible to define something like 19 | -- 20 | -- data Term = Lambda Ch05.LambdaCalculus.Term 21 | -- | Arith Ch03.Arith.Term 22 | -- 23 | -- but that would be kinda awkward. 24 | -- 25 | -- TL;DR: I'm just gonna repeat definitions as that seems simpler. 26 | -------------------------------------------------------------------------------- 27 | 28 | ||| The type of variables 29 | Variable : Type 30 | Variable = Nat 31 | 32 | -- Pierce doesn't bother to actually define this calculus (neither in the book 33 | -- nor the software available at https://www.cis.upenn.edu/~bcpierce/tapl). 34 | -- So I'm using the simplest, most naive definition I can imagine here. 35 | ||| Terms in the lambda calculus extended by arithmetic expressions. 36 | data Term = True 37 | | False 38 | | IfThenElse Term Term Term 39 | | Zero 40 | | Succ Term 41 | | Pred Term 42 | | IsZero Term 43 | | Var Variable 44 | | Abs Variable Term 45 | | App Term Term 46 | 47 | ||| Convenient infix notation for construction of function application terms 48 | (.) : Term -> Term -> Term 49 | (.) = App 50 | 51 | -- TODO: Can we get rid of the argument `n`? 52 | ||| Convenience function for constructing lambda terms 53 | lambda : Nat -> (Term -> Term) -> Term 54 | lambda n f = Abs n (f (Var n)) 55 | 56 | 57 | ----------------------------------------------------------------------- 58 | -- The stuff below is literally copy pasted from Ch05.LambdaCalculus 59 | 60 | -------------------------------------------------------------------------------- 61 | -- Booleans 62 | -------------------------------------------------------------------------------- 63 | 64 | ||| The Church boolean true 65 | tru : Term 66 | tru = Abs 1 (Abs 0 (Var 1)) 67 | 68 | ||| The Church boolean false 69 | fls : Term 70 | fls = Abs 1 (Abs 0 (Var 0)) 71 | 72 | ||| Church encoding of the if-then-else operator 73 | test : Term 74 | test = Abs 2 (Abs 1 (Abs 0 (App (App (Var 2) (Var 1)) (Var 0)))) 75 | 76 | ||| Logical AND operator for Church booleans. 77 | and : Term 78 | and = Abs 0 (Abs 1 (App (App (Var 0) (Var 1)) fls)) 79 | 80 | -------------------------------------------------------------------------------- 81 | -- Pairs 82 | -------------------------------------------------------------------------------- 83 | 84 | ||| Church pair constructor 85 | pair : Term 86 | pair = Abs 0 (Abs 1 (Abs 2 (App (App (Var 2) (Var 0)) (Var 1)))) 87 | 88 | ||| Projection onto the first component of a pair 89 | fst : Term 90 | fst = Abs 0 (Abs 1 (Var 0)) 91 | 92 | ||| Projection onto the second component of a pair 93 | snd : Term 94 | snd = Abs 0 (Abs 1 (Var 1)) 95 | 96 | -------------------------------------------------------------------------------- 97 | -- Numerals 98 | -------------------------------------------------------------------------------- 99 | 100 | ||| The Church numeral zero. 101 | church_zero : Term 102 | church_zero = Abs 1 (Abs 0 (Var 0)) 103 | 104 | ||| The Church numeral one. 105 | church_one : Term 106 | church_one = Abs 1 (Abs 0 (App (Var 1) (Var 0))) 107 | 108 | ||| The Church numeral two. 109 | church_two : Term 110 | church_two = Abs 1 (Abs 0 (App (Var 1) (App (Var 1) (Var 0)))) 111 | 112 | ||| The successors function for Church numerals 113 | scc : Term 114 | scc = Abs 0 (Abs 1 (Abs 2 (App (Var 1) (App (App (Var 0) (Var 1)) (Var 2))))) 115 | 116 | ||| Addition of Church numerals 117 | plus : Term 118 | plus = Abs 0 (Abs 1 (Abs 2 (Abs 3 ((Var 0) . (Var 2)) . (((Var 1) . (Var 2)) . (Var 3))))) 119 | 120 | ||| Multiplication of Church numerals 121 | times : Term 122 | times = Abs 0 (Abs 1 ((Var 0) . (plus . (Var 1))) . church_zero) 123 | 124 | ||| Tests whether a Church numeral is zero or not 125 | iszro : Term 126 | iszro = Abs 0 ((Var 0) . (Abs 0 fls)) . tru 127 | 128 | ||| The predecessor function on Church numerals 129 | prd : Term 130 | prd = let zz = pair . church_zero . church_zero 131 | ss = Abs 0 (pair . (snd . (Var 0)) . (scc . (snd . (Var 0)))) in 132 | Abs 0 (fst . ((Var 0) . ss) . zz) 133 | 134 | -------------------------------------------------------------------------------- 135 | -- Lists 136 | -------------------------------------------------------------------------------- 137 | 138 | -- See Ch05.Exercise_5_2_8 139 | 140 | -------------------------------------------------------------------------------- 141 | -- Self-replicating terms 142 | -------------------------------------------------------------------------------- 143 | 144 | ||| The (?) simplest self-replicating term in the lambda calculus 145 | omega : Term 146 | omega = let x = Var 0 147 | f = Abs 0 (x . x) in 148 | f . f 149 | 150 | ||| The call-by-value version of the fix-point combinator (i.e. Y combinator) 151 | fix : Term 152 | fix = let f = Var 0 153 | x = Var 1 154 | y = Var 2 155 | t = Abs 1 f . (Abs 2 (x . x . y)) in 156 | Abs 0 (t . t) 157 | 158 | 159 | ----------------------------------------------------------------------- 160 | -- Copy pasted exercises 161 | 162 | ||| `sub m n` yields the result of subtracting `n` from `m` (Church numerals). 163 | ||| 164 | ||| More precisely, it yields the smallest church numeral `z` such that 165 | ||| 166 | ||| m <= n+z 167 | sub : Term 168 | sub = let m = Var 0 169 | n = Var 1 in 170 | Abs 0 (Abs 1 (n . prd) . m) 171 | 172 | ||| `le m n` tests whether `m` is less than or equal to `n` 173 | le : Term 174 | le = let m = Var 0 175 | n = Var 1 in 176 | Abs 0 (Abs 1 (iszro . (sub . m . n))) 177 | 178 | ||| Test whether two Church numerals are equal 179 | equal : Term 180 | equal = let m = Var 0 181 | n = Var 1 182 | m_le_n = le . m . n 183 | n_le_m = le . n . m in 184 | Abs 0 (Abs 1 (and . m_le_n . n_le_m)) 185 | 186 | ----------------------------------------------------------------------- 187 | -- Stuff below is lifted wholesale from exercise 5.2.8 188 | 189 | -- Lists are represented by their corresponding fold function. That is, a list 190 | -- [x, y, z] is identified with the function 191 | -- 192 | -- f |-> ( c |-> f x (f y (f z c))) ) 193 | -- 194 | -- Where f is any 2-ary function (since the untyped lambda calculus is untyped, of 195 | -- course we can't talk about arities). 196 | 197 | ||| The term representing the empty list 198 | nil : Term 199 | nil = Abs 0 (Abs 1 (Var 1))--?nil_rhs 200 | 201 | ||| The term representing the cons combinator 202 | cons : Term 203 | cons = let car = Var 0 -- not to be confused with the car combinator below 204 | cdr = Var 1 -- --------------------------- cdr ---------------- 205 | f = Var 2 206 | c = Var 3 in 207 | Abs 0 (Abs 1 (Abs 2 (Abs 3 (f . car . (cdr . f . c))))) 208 | 209 | ||| Checks whether a list is nil 210 | isnil : Term 211 | isnil = let l = Var 0 212 | f = Abs 1 (Abs 2 fls) in 213 | Abs 0 (l . f . tru) 214 | 215 | ||| The term representing the "car" combinator 216 | head : Term 217 | head = let l = Var 0 in 218 | Abs 0 l . fst . nil 219 | 220 | ||| The term representing the "cdr" combinator 221 | tail : Term 222 | tail = let l = Var 0 223 | x = Var 1 224 | y = Var 2 225 | f = Abs 1 (Abs 2 pair . (snd . y) . (cons . x . (snd . y))) 226 | c = pair . nil . nil in 227 | Abs 0 (fst . (l . f . c)) 228 | 229 | ----------------------------------------------------------------------- 230 | -- Stuff below is not copy pasted. 231 | 232 | ||| Term representing a function converting Church booleans into "real" booleans. 233 | realbool : Term 234 | realbool = lambda 0 235 | (\b => b . True . False) 236 | 237 | ||| Term representing a function converting "real" booleans to Church booleans. 238 | churchbool : Term 239 | churchbool = lambda 0 240 | (\b => IfThenElse b tru fls) 241 | 242 | ||| Term representing a function of two arguments returning a "real" boolean 243 | ||| specifying whether they are equal or not, at least if both arguments provided 244 | ||| are Church numerals. 245 | realeq : Term 246 | realeq = lambda 0 247 | (\m => lambda 1 248 | (\n => (equal . m . n) . True . False)) 249 | 250 | ||| Term representing a function converting a Church numeral into a primitive natural number 251 | realnat : Term 252 | realnat = lambda 0 253 | (\n => n . (lambda 1 (\x => Succ x)) . church_zero) -- TODO: Rename church_zero to c0 etc. 254 | -------------------------------------------------------------------------------- /Ch05/VarArg.idr: -------------------------------------------------------------------------------- 1 | module Ch05.VarArg 2 | 3 | import Data.Vect 4 | 5 | -------------------------------------------------------------------------------- 6 | -- Auxillary stuff for defining functions with a variable # of args 7 | -------------------------------------------------------------------------------- 8 | 9 | ||| Type of vectors of fixed length of elements of varying types 10 | data VarVect : (n : Nat) -> Vect n Type -> Type where 11 | VarNil : VarVect Z [] 12 | VarCons : (a : Type) -> 13 | (x : a) -> 14 | VarVect n as -> 15 | VarVect (S n) (a :: as) 16 | 17 | VarArgType : (numArgs : Nat) -> 18 | Vect numArgs Type -> 19 | Type 20 | VarArgType Z [] = ?VarArgType_rhs_1 21 | VarArgType (S k) (a :: as) = a -> VarArgType k as 22 | 23 | 24 | 25 | -- Suppose we want to define a function 26 | -- 27 | -- f : a_1 -> a_2 -> ... -> a_n -> b 28 | -- 29 | -- for some [a_1, ..., a_n] : Vect n Type. Then there are two ways to do that: 30 | -- 31 | -- One: Starting from the knowledge of 32 | -- 33 | -- \x1, ... x(n-1) => f x1 ... x(n-1) xn 34 | -- 35 | -- for arbitrary but fixed `xn`, we define `f`. 36 | -------------------------------------------------------------------------------- /LICENSE: -------------------------------------------------------------------------------- 1 | MIT License 2 | 3 | Copyright (c) 2019 Nicolas Alexander Schmidt 4 | 5 | Permission is hereby granted, free of charge, to any person obtaining a copy 6 | of this software and associated documentation files (the "Software"), to deal 7 | in the Software without restriction, including without limitation the rights 8 | to use, copy, modify, merge, publish, distribute, sublicense, and/or sell 9 | copies of the Software, and to permit persons to whom the Software is 10 | furnished to do so, subject to the following conditions: 11 | 12 | The above copyright notice and this permission notice shall be included in all 13 | copies or substantial portions of the Software. 14 | 15 | THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR 16 | IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, 17 | FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE 18 | AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER 19 | LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, 20 | OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE 21 | SOFTWARE. 22 | -------------------------------------------------------------------------------- /Makefile: -------------------------------------------------------------------------------- 1 | PANDOC = pandoc 2 | PANDOC_INCLUDES = .latex/Latex-Macros.md 3 | PANDOC_DIRECTIVES = --variable=indent 4 | SUBDIRS = $(wildcard */) 5 | SOURCES = $(wildcard $(addsuffix *.md, $(SUBDIRS))) 6 | OBJ = $(patsubst %.md, %.pdf, $(SOURCES)) 7 | 8 | all: $(OBJ) 9 | 10 | clean: 11 | rm -f $(OBJ) 12 | 13 | %.pdf: %.md 14 | $(PANDOC) $(PANDOC_DIRECTIVES) $(PANDOC_INCLUDES) $< -o $@ 15 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | # Types and Programming Languages -- Exercises 2 | 3 | Solutions to the exercises in and miscellaneous material for the book "Types 4 | and Programming Languages" by Benjamin C. Pierce. 5 | 6 | ## Requirements 7 | 8 | * `latex` distribution (e.g. [TeX Live](https://tug.org/texlive/)) 9 | * [`pandoc`](http://pandoc.org/) 10 | * [`GNU Make`](https://www.gnu.org/software/make/) 11 | * [`idris`](https://www.idris-lang.org/) (if you want to run the miscellaneous 12 | programs) 13 | 14 | ## Installation 15 | 16 | git clone https://github.com/mr-infty/tapl.git 17 | cd tapl 18 | 19 | ## Usage 20 | 21 | Run 22 | 23 | make 24 | 25 | to typeset the exercise solutions. These are organized into subdirectories 26 | `ch-03`, `ch-04`, ... corresponding to chapters. 27 | 28 | Some chapters are also accompanied by Idris programs (`*.idr`) that I wrote to 29 | test my understanding. These probably aren't too well documented. Read at your 30 | own risk. 31 | -------------------------------------------------------------------------------- /tapl.ipkg: -------------------------------------------------------------------------------- 1 | package tapl 2 | 3 | modules = Ch03.Arith, 4 | , Ch03.Exercise_3_5_14 5 | , Ch03.Exercise_3_5_17 6 | --------------------------------------------------------------------------------