Skip to content

Commit 764f83b

Browse files
author
Alex Gryzlov
committed
Merge branch 'smallstep' of https://github.com/jutaro/software-foundations into smallstep
2 parents 290367f + 527982b commit 764f83b

File tree

3 files changed

+890
-41
lines changed

3 files changed

+890
-41
lines changed

src/Maps.lidr

+8
Original file line numberDiff line numberDiff line change
@@ -63,6 +63,14 @@ equality comparison function for \idr{Id} and its fundamental property.
6363
> beq_id (MkId n1) (MkId n2) = decAsBool $ decEq n1 n2
6464
>
6565

66+
> idInjective : {x,y : String} -> (MkId x = MkId y) -> x = y
67+
> idInjective Refl = Refl
68+
69+
> implementation DecEq Id where
70+
> decEq (MkId s1) (MkId s2) with (decEq s1 s2)
71+
> | Yes prf = Yes (cong prf)
72+
> | No contra = No (\h : MkId s1 = MkId s2 => contra (idInjective h))
73+
6674
\todo[inline]{Edit}
6775

6876
(The function \idr{decEq} comes from Idris's string library. If you check its

src/Stlc.lidr

+42-41
Original file line numberDiff line numberDiff line change
@@ -21,6 +21,7 @@ work to deal with these.
2121

2222
> %access public export
2323
> %default total
24+
2425
> %hide Types.Tm
2526
> %hide Types.Ty
2627
> %hide Types.(->>)
@@ -169,18 +170,19 @@ We next formalize the syntax of the STLC.
169170
> infixr 7 #
170171

171172
> data Tm : Type where
172-
> Tvar : String -> Tm
173+
> Tvar : Id -> Tm
173174
> (#) : Tm -> Tm -> Tm
174-
> Tabs : String -> Ty -> Tm -> Tm
175+
> Tabs : Id -> Ty -> Tm -> Tm
175176
> Ttrue : Tm
176177
> Tfalse : Tm
177178
> Tif : Tm -> Tm -> Tm -> Tm
178179

179-
> syntax "(" "\\" [p] ":" [q] "." [r] ")" = Tabs "p" q r
180+
> syntax "(" "\\" [p] ":" [q] "." [r] ")" = Tabs (MkId "p") q r
180181

181182
> syntax "lif" [c] "then" [p] "else" [n] = Tif c p n
182183

183-
> syntax "&" [p] = Tvar "p"
184+
> var : String -> Tm
185+
> var s = Tvar (MkId s)
184186

185187
Note that an abstraction `\x:T.t` (formally, `tabs x T t`) is
186188
always annotated with the type `T` of its :parameter, in contrast
@@ -193,27 +195,27 @@ Some examples...
193195
`idB = \x:Bool. x`
194196

195197
> idB : Tm
196-
> idB = (\x: TBool . &x)
198+
> idB = (\x: TBool . var "x")
197199

198200
`idBB = \x:Bool->Bool. x`
199201

200202
> idBB : Tm
201-
> idBB = (\x: (TBool :=> TBool) . &x)
203+
> idBB = (\x: (TBool :=> TBool) . var "x")
202204

203205
`idBBBB = \x:(Bool->Bool) -> (Bool->Bool). x`
204206

205207
> idBBBB : Tm
206-
> idBBBB = (\x: ((TBool :=> TBool) :=> (TBool :=> TBool)). &x)
208+
> idBBBB = (\x: ((TBool :=> TBool) :=> (TBool :=> TBool)). var "x")
207209

208210
`k = \x:Bool. \y:Bool. x`
209211

210212
> k : Tm
211-
> k = (\x : TBool . (\y : TBool . &x))
213+
> k = (\x : TBool . (\y : TBool . var "x"))
212214

213215
`notB = \x:Bool. if x then false else true`
214216

215217
> notB : Tm
216-
> notB = (\x : TBool . (lif &x then Tfalse else Ttrue))
218+
> notB = (\x : TBool . (lif (var "x") then Tfalse else Ttrue))
217219

218220
=== Operational Semantics
219221

@@ -259,7 +261,7 @@ function is actually applied to an argument. We also make the
259261
second choice here.
260262

261263
> data Value : Tm -> Type where
262-
> V_abs : {x: String} -> {T: Ty} -> {t: Tm} -> Value (Tabs x T t)
264+
> V_abs : {x: Id} -> {T: Ty} -> {t: Tm} -> Value (Tabs x T t)
263265
> V_true : Value Ttrue
264266
> V_false : Value Tfalse
265267

@@ -344,15 +346,15 @@ Here is the definition, informally...
344346

345347
... and formally:
346348

347-
> subst : String -> Tm -> Tm -> Tm
349+
> subst : Id -> Tm -> Tm -> Tm
348350
> subst x s (Tvar x') =
349351
> case decEq x x' of
350-
> Yes _ => s
351-
> No _ => (Tvar x')
352+
> Yes => s
353+
> No _ => Tvar x'
352354
> subst x s (Tabs x' ty t1) =
353-
> Tabs x' ty (case decEq x x' of
354-
> Yes p => t1
355-
> No p => subst x s t1)
355+
> case decEq x x' of
356+
> Yes => t1
357+
> No _ => subst x s t1
356358
> subst x s (t1 # t2) = subst x s t1 # subst x s t2
357359
> subst x s Ttrue = Ttrue
358360
> subst x s Tfalse = Tfalse
@@ -396,7 +398,7 @@ one of the constructors; your job is to fill in the rest of the
396398
constructors and prove that the relation you've defined coincides
397399
with the function given above.
398400

399-
> data Substi : (s:Tm) -> (x:String) -> Tm -> Tm -> Type where
401+
> data Substi : (s:Tm) -> (x:Id) -> Tm -> Tm -> Type where
400402
> S_True : Substi s x Ttrue Ttrue
401403
> S_False : Substi s x Tfalse Tfalse
402404
> S_App : {l', r':Tm} -> Substi s x l l' -> Substi s x r r' -> Substi s x (l # r) (l' # r')
@@ -408,7 +410,7 @@ with the function given above.
408410
> S_Abs2 : Substi s x (Tabs y ty t) (Tabs y ty t)
409411

410412

411-
> substi_correct : (s:Tm) -> (x: String) -> (t : Tm) -> (t' : Tm) ->
413+
> substi_correct : (s:Tm) -> (x: Id) -> (t : Tm) -> (t' : Tm) ->
412414
> (([ x := s ] t) = t') <-> Substi s x t t'
413415
> substi_correct s x t t' = ?substi_correct_rhs1
414416

@@ -481,9 +483,9 @@ Formally:
481483
> (->>) = Step
482484
>
483485
> data Step : Tm -> Tm -> Type where
484-
> ST_AppAbs : {x: String} -> {ty : Ty} -> {t12 : Tm} -> {v2 : Tm} ->
486+
> ST_AppAbs : {x: Id} -> {ty : Ty} -> {t12 : Tm} -> {v2 : Tm} ->
485487
> Value v2 ->
486-
> (Tabs x ty t12) # v2 ->> [ x := v2] t12
488+
> (Tabs x ty t12) # v2 ->> subst x v2 t12
487489
> ST_App1 : {t1, t1', t2: Tm} ->
488490
> t1 ->> t1' ->
489491
> t1 # t2 ->> t1' # t2
@@ -497,7 +499,7 @@ Formally:
497499
> Tif Tfalse t1 t2 ->> t2
498500
> ST_If : {t1, t1', t2, t3: Tm} ->
499501
> t1 ->> t1' ->
500-
> Tif t1 t2 t3 ->> Tif t1' t2 t3
502+
> Tif t1 t2 t3 ->> Tif t1' t2 t3
501503

502504
> infixl 6 ->>*
503505
> (->>*) : Tm -> Tm -> Type
@@ -514,8 +516,7 @@ Example:
514516
idBB idB ->>* idB
515517

516518
> step_example1 : Stlc.idBB # Stlc.idB ->>* Stlc.idB
517-
> step_example1 =
518-
> Multi_step (ST_AppAbs V_abs) Multi_refl
519+
> step_example1 = Multi_step (ST_AppAbs V_abs) Multi_refl -- (ST_AppAbs V_abs) Multi_refl
519520

520521
Example:
521522

@@ -674,11 +675,11 @@ We can read the three-place relation `Gamma |- t ::T` as:
674675
> syntax [context] "|-" [t] "::" [T] "." = Has_type context t T
675676
676677
> data Has_type : Context -> Tm -> Ty -> Type where
677-
> T_Var : {Gamma: Context} -> {x: String} -> {T: Ty} ->
678-
> Gamma (MkId x) = Just T ->
678+
> T_Var : {Gamma: Context} -> {x: Id} -> {T: Ty} ->
679+
> Gamma x = Just T ->
679680
> Gamma |- (Tvar x) :: T .
680-
> T_Abs : {Gamma: Context} -> {x: String} -> {T11, T12: Ty} -> {t12 : Tm} ->
681-
> (Gamma & {{ (MkId x) ==> T11 }}) |- t12 :: T12 . ->
681+
> T_Abs : {Gamma: Context} -> {x: Id} -> {T11, T12: Ty} -> {t12 : Tm} ->
682+
> (Gamma & {{ x ==> T11 }}) |- t12 :: T12 . ->
682683
> Gamma |- (Tabs x T11 t12) :: (T11 :=> T12) .
683684
> T_App : {Gamma: Context} -> {T11, T12: Ty} -> {t1, t2 : Tm} ->
684685
> Gamma |- t1 :: (T11 :=> T12). ->
@@ -696,7 +697,7 @@ We can read the three-place relation `Gamma |- t ::T` as:
696697
697698
==== Examples
698699
699-
> typing_example_1 : empty |- (Tabs "x" TBool (Tvar "x")) :: (TBool :=> TBool) .
700+
> typing_example_1 : empty |- (Tabs (MkId "x") TBool (var "x")) :: (TBool :=> TBool) .
700701
> typing_example_1 = T_Abs (T_Var Refl)
701702
702703
@@ -708,9 +709,9 @@ Another example:
708709
```
709710
710711
> typing_example_2 : empty |-
711-
> (Tabs "x" TBool
712-
> (Tabs "y" (TBool :=> TBool)
713-
> (Tvar "y" # Tvar "y" # Tvar "x"))) ::
712+
> (Tabs (MkId "x") TBool
713+
> (Tabs (MkId "y") (TBool :=> TBool)
714+
> (var "y" # var "y" # var "x"))) ::
714715
> (TBool :=> (TBool :=> TBool) :=> TBool) .
715716
> typing_example_2 =
716717
> T_Abs (T_Abs (T_App (T_Var Refl) (T_App (T_Var Refl) (T_Var Refl))))
@@ -728,10 +729,10 @@ Formally prove the following typing derivation holds:
728729
729730
> typing_example_3 :
730731
> (T : Ty ** empty |-
731-
> (Tabs "x" (TBool :=> TBool)
732-
> (Tabs "y" (TBool :=> TBool)
733-
> (Tabs "z" TBool
734-
> (Tvar "y" # (Tvar "x" # Tvar "z"))))) :: T . )
732+
> (Tabs (MkId "x") (TBool :=> TBool)
733+
> (Tabs (MkId "y") (TBool :=> TBool)
734+
> (Tabs (MkId "z") TBool
735+
> (Tvar (MkId "y") # (Tvar (MkId "x") # Tvar (MkId "z")))))) :: T . )
735736
> typing_example_3 = ?typing_example_3_rhs
736737
737738
$\square$
@@ -747,14 +748,14 @@ to the term `\x:Bool. \y:Bool, x y` -- i.e.,
747748
748749
> forallToExistence : {X : Type} -> {P: X -> Type} ->
749750
> ((a : X) -> Not (P a)) -> Not (a : X ** P a)
750-
> forallToExistence hyp (b ** p2) = hyp b p2
751+
> forallToExistence hyp (a ** p2) = hyp a p2
751752
752753
> typing_nonexample_1 :
753754
> Not (T : Ty **
754755
> empty |-
755-
> (Tabs "x" TBool
756-
> (Tabs "y" TBool
757-
> (Tvar "x" # Tvar y))) :: T . )
756+
> (Tabs (MkId "x") TBool
757+
> (Tabs (MkId "y") TBool
758+
> (Tvar (MkId "x") # Tvar (MkId y)))) :: T . )
758759
> typing_nonexample_1 = forallToExistence
759760
> (\ a , (T_Abs (T_Abs (T_App (T_Var Refl)(T_Var Refl)))) impossible)
760761
@@ -769,8 +770,8 @@ Another nonexample:
769770
> typing_nonexample_3 :
770771
> Not (s : Ty ** t : Ty **
771772
> empty |-
772-
> (Tabs "x" s
773-
> (Tvar "x" # Tvar "x")) :: t . )
773+
> (Tabs (MkId "x") s
774+
> (Tvar (MkId "x") # Tvar (MkId "x"))) :: t . )
774775
> typing_nonexample_3 = ?typing_nonexample_3_rhs
775776
776777
$\square$

0 commit comments

Comments
 (0)