8. Sub: Subtyping🔗

8.1. Concepts🔗

We now turn to subtyping, a key feature of - in particular - object-oriented programming languages.

8.1.1. A Motivating Example🔗

Suppose we are writing a program involving two record types defined as follows:

      Person  = {name:String, age:Nat}
      Student = {name:String, age:Nat, gpa:Nat}

In the simply typed lamdba-calculus with records, the term

    (λ r:Person. (r.age)+1) {name="Pat", age=21, gpa=1}

is not typable, since it applies a function that wants a two-field record to an argument that actually provides three fields, while the app rule demands that the domain type of the function being applied must match the type of the argument precisely.

But this is silly: we're passing the function a better argument than it needs! The only thing the body of the function can possibly do with its record argument r is project the field age from it: nothing else is allowed by the type, and the presence or absence of an extra gpa field makes no difference at all. So, intuitively, it seems that this function should be applicable to any record value that has at least an age field.

More generally, a record with more fields is "at least as good in any context" as one with just a subset of these fields, in the sense that any value belonging to the longer record type can be used safely in any context expecting the shorter record type. If the context expects something with the shorter type but we actually give it something with the longer type, nothing bad will happen (formally, the program will not get stuck).

The principle at work here is called subtyping. We say that "σ is a subtype of τ", written σ <: τ, if a value of type σ can safely be used in any context where a value of type τ is expected. The idea of subtyping applies not only to records, but to all of the type constructors in the language -- functions, pairs, etc.

Safe substitution principle:

σ is a subtype of τ, written σ <: τ, if a value of type σ can safely be used in any context where a value of type τ is expected.

8.1.2. Subtyping and Object-Oriented Languages🔗

Subtyping plays a fundamental role in many programming languages -- in particular, it is central to the design of object-oriented languages and their libraries.

An object in Java, C#, etc. can be thought of as a record, some of whose fields are functions ("methods") and some of whose fields are data values ("fields" or "instance variables"). Invoking a method m of an object o on some arguments a₁..an roughly consists of projecting out the m field of o and applying it to a₁..an.

The type of an object is called a class -- or, in some languages, an interface. It describes which methods and which data fields the object offers. Classes and interfaces are related by the subclass and subinterface relations. An object belonging to a subclass (or subinterface) is required to provide all the methods and fields of one belonging to a superclass (or superinterface), plus possibly some more.

The fact that an object from a subclass can be used in place of one from a superclass provides a degree of flexibility that is extremely handy for organizing complex libraries. For example, a GUI toolkit like Java's Swing framework might define an abstract interface Component that collects together the common fields and methods of all objects having a graphical representation that can be displayed on the screen and interact with the user, such as the buttons, checkboxes, and scrollbars of a typical GUI. A method that relies only on this common interface can now be applied to any of these objects.

Of course, real object-oriented languages include many other features besides these. For example, fields can be updated. Fields and methods can be declared "private". Classes can give initializers that are used when constructing objects. Code in subclasses can cooperate with code in superclasses via inheritance. Classes can have static methods and fields. Etc., etc.

To keep things simple here, we won't deal with any of these issues -- in fact, we won't even talk any more about objects or classes. (There is a lot of discussion in Pierce (2002)Benjamin C. Pierce (2002). “Types and Programming Languages”. MIT Press. ., if you are interested.) Instead, we'll study the core concepts behind the subclass / subinterface relation in the simplified setting of the STLC.

8.1.3. The Subsumption Rule🔗

τ₂ Our goal for this chapter is to add subtyping to the simply typed lambda-calculus (with some basic extensions). This involves two steps:

Defining a binary subtype relation between types.
Enriching the typing relation to take subtyping into account.

The second step is actually very simple. We add just a single rule to the typing relation: the so-called rule of subsumption:

                         Γ ⊢ t₁ ⦂ τ₁     τ₁ <: τ₂
                         --------------------------           (sub)
                               Γ ⊢ t₁ ⦂ τ₂

This rule says, intuitively, that it is OK to "forget" some of what we know about a term.

For example, we may know that t₁ is a record with two fields (e.g., τ₁ = {x:α→α, y:β→β}, but choose to forget about one of the fields (τ₂ = {y:β→β}) so that we can pass t₁ to a function that requires just a single-field record.

8.1.4. The Subtype Relation🔗

The first step -- the definition of the relation σ <: τ -- is where all the action is. Let's look at each of the clauses of its definition.

8.1.4.1. Structural Rules🔗

To start off, we impose two "structural rules" that are independent of any particular type constructor: a rule of transitivity, which says intuitively that, if σ is better (richer, safer) than υ and υ is better than τ, then σ is better than τ...

                              σ <: υ    υ <: τ
                              ----------------                        (trans)
                                   σ <: τ

... and a rule of reflexivity, since certainly any type τ is as good as itself:

                                   ------                              (refl)
                                   τ <: τ

8.1.4.2. Products🔗

Now we consider the individual type constructors, one by one, beginning with product types. We consider one pair to be a subtype of another if each of its components is.

                            σ₁ <: τ₁    σ₂ <: τ₂
                            --------------------                        (prod)
                             σ₁ × σ₂ <: τ₁ × τ₂

The subtyping rule for arrows is a little less intuitive. Suppose we have functions f and g with these types:

       f : C → Student
       g : (C→Person) → D

That is, f is a function that yields a record of type Student, and g is a (higher-order) function that expects its argument to be a function yielding a record of type Person. Also suppose that Student is a subtype of Person. Then the application g f is safe even though their types do not match up precisely, because the only thing g can do with f is to apply it to some argument (of type C); the result will actually be a Student, while g will be expecting a Person, but this is safe because the only thing g can then do is to project out the two fields that it knows about (name and age), and these will certainly be among the fields that are present.

This example suggests that the subtyping rule for arrow types should say that two arrow types are in the subtype relation if their results are:

                                  σ₂ <: τ₂
                              ----------------                     (arrow_co)
                            σ₁ → σ₂ <: σ₁ → τ₂

We can generalize this to allow the arguments of the two arrow types to be in the subtype relation as well:

                            τ₁ <: σ₁    σ₂ <: τ₂
                            --------------------                      (arrow)
                              σ₁ → σ₂ <: τ₁ → τ₂

But notice that the argument types are subtypes "the other way round": in order to conclude that σ₁→σ₂ to be a subtype of τ₁→τ₂, it must be the case that τ₁ is a subtype of σ₁. The arrow constructor is said to be contravariant in its first argument and covariant in its second.

Here is an example that illustrates this:

       f : Person → C
       g : (Student → C) → D

The application g f is safe, because the only thing the body of g can do with f is to apply it to some argument of type Student. Since f requires records having (at least) the fields of a Person, this will always work. So Person → C is a subtype of Student → C since Student is a subtype of Person.

The intuition is that, if we have a function f of type σ₁→σ₂, then we know that f accepts elements of type σ₁; clearly, f will also accept elements of any subtype τ₁ of σ₁. The type of f also tells us that it returns elements of type σ₂; we can also view these results belonging to any supertype τ₂ of σ₂. That is, any function f of type σ₁→σ₂ can also be viewed as having type τ₁→τ₂.

Quiz

Suppose we have σ <: τ and υ <: δ. Which of the following subtyping assertions is false?

(A) σ×υ <: τ×δ

(B) τ→υ <: σ→υ

(D) (τ×υ) → δ <: (σ×υ) → δ

(E) σ→υ <: σ→δ

Quiz

Suppose again that we have σ <: τ and υ <: δ. Which of the following is incorrect?

(A) (τ→τ)×υ <: (σ→τ)×δ

(B) τ→υ <: σ→δ

(D) (σ→δ) → δ <: (τ→υ) → δ

(E) σ → (δ→υ) <: σ → (υ→υ)

8.1.4.3. Records🔗

What about subtyping for record types?

The basic intuition is that it is always safe to use a "bigger" record in place of a "smaller" one. That is, given a record type, adding extra fields will always result in a subtype. If some code is expecting a record with fields x and y, it is perfectly safe for it to receive a record with fields x, y, and z; the z field will simply be ignored. For example,

    {name:String, age:Nat, gpa:Nat} <: {name:String, age:Nat}
    {name:String, age:Nat} <: {name:String}
    {name:String} <: {}

This is known as "width subtyping" for records.

We can also create a subtype of a record type by replacing the type of one of its fields with a subtype. If some code is expecting a record with a field x of type τ, it will be happy with a record having a field x of type σ as long as σ is a subtype of τ. For example,

    {x:Student} <: {x:Person}

This is known as "depth subtyping".

Finally, although the fields of a record type are written in a particular order, the order does not really matter. For example,

    {name:String,age:Nat} <: {age:Nat,name:String}

This is known as "permutation subtyping".

We could formalize these requirements in a single subtyping rule for records as follows:

                        ∀ jk in j₁..jn,
                    ∃ ip in i₁..im, such that
                        jk=ip and σp <: τk
                  ----------------------------------                    (rcd)
                  {i₁:σ₁...im:σm} <: {j₁:τ₁...jn:τn}

That is, the record on the left should have all the field labels of the one on the right (and possibly more), while the types of the common fields should be in the subtype relation.

However, this rule is rather heavy and hard to read, so it is often decomposed into three simpler rules, which can be combined using trans to achieve all the same effects.

First, adding fields to the end of a record type gives a subtype:

                               n > m
                 ---------------------------------                 (rcdWidth)
                 {i₁:τ₁...in:τn} <: {i₁:τ₁...im:τm}

We can use rcdWidth to drop later fields of a multi-field record while keeping earlier fields, showing for example that {age:Nat,name:String} <: {age:Nat}.

Second, subtyping can be applied inside the components of a compound record type:

                       σ₁ <: τ₁  ...  σn <: τn
                  ----------------------------------               (rcdDepth)
                  {i₁:σ₁...in:σn} <: {i₁:τ₁...in:τn}

For example, we can use rcdDepth and rcdWidth together to show that {y:Student, x:Nat} <: {y:Person}.

Third, subtyping can reorder fields. For example, we want {name:String, gpa:Nat, age:Nat} <: Person, but we haven't quite achieved this yet: using just rcdDepth and rcdWidth we can only drop fields from the end of a record type. So we add:

         {i₁:σ₁...in:σn} is a permutation of {j₁:τ₁...jn:τn}
         ---------------------------------------------------        (rcdPerm)
                  {i₁:σ₁...in:σn} <: {j₁:τ₁...jn:τn}

It is worth noting that full-blown language designs may choose not to adopt all of these subtyping rules. For example, in Java:

Each class member (field or method) can be assigned a single index, adding new indices "on the right" as more members are added in subclasses (i.e., no permutation for classes).
A class may implement multiple interfaces -- so-called "multiple inheritance" of interfaces (i.e., permutation is allowed for interfaces).
In early versions of Java, a subclass could not change the argument or result types of a method of its superclass (i.e., no depth subtyping or no arrow subtyping, depending how you look at it).

Exercise★★(arrow_sub_wrong) (Manually graded)

Suppose we had incorrectly defined subtyping as covariant on both the right and the left of arrow types:

                            σ₁ <: τ₁    σ₂ <: τ₂
                            --------------------                (arrowWrong)
                            σ₁ → σ₂ <: τ₁ → τ₂

Give a concrete example of functions f and g with the following types...

       f : Student → Nat
       g : (Person → Nat) → Nat

... such that the application g f will get stuck during execution. (Use informal syntax. No need to prove formally that the application gets stuck.)

Answer:

       f = λr:Student. r.gpa
       g = λf:Person→Nat. f {name="Alex",age=20}

8.1.4.4. ⊤🔗

Finally, it is convenient to give the subtype relation a maximum element -- a type that lies above every other type and is inhabited by all (well-typed) values. We do this by adding to the language one new type constant, called ⊤ (pronounced "⊤" and written ⊤), together with a subtyping rule that places it above every other type in the subtype relation:

                                   --------                             (⊤)
                                   σ <: ⊤

The ⊤ type is an analog of the Object type in Java and C#.

8.1.4.5. Summary🔗

In summary, we form the STLC with subtyping by starting with the pure STLC (over some set of base types) and then...

adding a base type ⊤,
adding the rule of subsumption

                         Γ ⊢ t₁ ⦂ τ₁     τ₁ <: τ₂
                         --------------------------------            (sub)
                               Γ ⊢ t₁ ⦂ τ₂

to the typing relation, and

defining a subtype relation as follows:

                              σ <: υ    υ <: τ
                              ----------------                        (trans)
                                   σ <: τ

                                   ------                              (refl)
                                   τ <: τ

                                   --------                             (⊤)
                                   σ <: ⊤

                            σ₁ <: τ₁    σ₂ <: τ₂
                            --------------------                       (prod)
                             σ₁ × σ₂ <: τ₁ × τ₂

                            τ₁ <: σ₁    σ₂ <: τ₂
                            --------------------                      (arrow)
                            σ₁ → σ₂ <: τ₁ → τ₂

                               n > m
                 ---------------------------------                 (rcdWidth)
                 {i₁:τ₁...in:τn} <: {i₁:τ₁...im:τm}

                       σ₁ <: τ₁  ...  σn <: τn
                  ----------------------------------               (rcdDepth)
                  {i₁:σ₁...in:σn} <: {i₁:τ₁...in:τn}

         {i₁:σ₁...in:σn} is a permutation of {j₁:τ₁...jn:τn}
         ---------------------------------------------------        (rcdPerm)
                  {i₁:σ₁...in:σn} <: {j₁:τ₁...jn:τn}

Quiz

Suppose we have σ <: τ and υ <: δ. Which of the following subtyping assertions is false?

(A) σ×υ <: ⊤

(B) {i₁:σ,i₂:τ}→υ <: {i₁:σ,i₂:τ,i₃:δ}→υ

(D) (⊤ → ⊤) → δ <: ⊤ → δ

(E) σ → {i₁:υ,i₂:δ} <: σ → {i₂:δ,i₁:υ}

Quiz

How about these?

(A) {i₁:⊤} <: ⊤

(B) ⊤ → (⊤ → ⊤) <: ⊤ → ⊤

(D) {i₁:τ,i₂:δ,i₃:δ} <: {i₁:σ,i₂:υ} × {i₃:δ}

(E) ⊤ → {i₁:υ,i₂:δ} <: {i₁:σ} → {i₂:δ,i₁:δ}

8.1.5. Exercises🔗

The following "thought exercises" are repeated later as formal exercises.

Exercise★(subtype_instances_tf_1) (Optional)

Suppose we have types σ, τ, υ, and δ with σ <: τ and υ <: δ. Which of the following subtyping assertions are then true? Write true or false after each one. (A, B, and C here are base types like Bool, Nat, etc.

τ→σ <: τ→σ

Answer: True

⊤→υ <: σ→⊤

Answer: True

(C→C) → (A*B) <: (C→C) → (⊤*B)

Answer: True

τ→τ→υ <: σ→σ→V

Answer: True

(τ→τ)→υ <: (σ→σ)→V

Answer: False

((τ→σ)→τ)→υ <: ((σ→τ)→σ)→V

Answer: True

σ*δ <: τ*υ

Answer: False

Exercise★(subtype_order) (Manually graded)

The following types happen to form a linear order with respect to subtyping:

⊤
⊤ → Student
Student → Person
Student → ⊤
Person → Student

Write these types in order from the most specific to the most general.

Answer: ⊤→Student <: Person→Student <: Student→Person <: Student→⊤ <: ⊤

Where does the type ⊤→⊤→Student fit into this order? That is, state how ⊤ → (⊤ → Student) compares with each of the five types above. It may be unrelated to some of them.

Answer: It is less than Student→⊤ (and ⊤) and unrelated to the others.

Exercise★(subtype_instances_tf_2) (Manually graded)

Which of the following statements are true? Write true or false after each one. ∀

      ∀ σ τ,
          σ <: τ  →
          σ→σ   <:  τ→τ
:::solution
      Answer: False
:::

      ∀ σ,
           σ <: υ→υ →
           ∃ τ,
              σ = τ→τ  ∧  τ <: υ

Answer: False

      ∀ σ τ₁ τ₂,
           (σ <: τ₁ → τ₂) →
           ∃ σ₁ σ₂,
              σ = σ₁ → σ₂  ∧  τ₁ <: σ₁  ∧  σ₂ <: τ₂

Answer: True

      ∃ σ, σ <: σ → σ

Answer: False

∃ σ, σ→σ <: σ

Answer: True

      ∀ σ τ₁ τ₂,
           σ <: τ₁×τ₂ →
           ∃ σ₁ σ₂,
              σ = σ₁×σ₂  ∧  σ₁ <: τ₁  ∧  σ₂ <: τ₂

Answer: True

Exercise★(subtype_concepts_tf) (Manually graded)

Which of the following statements are true, and which are false?

There exists a type that is a supertype of every other type.

True

There exists a type that is a subtype of every other type.

False

There exists a pair type that is a supertype of every other pair type.

True

There exists a pair type that is a subtype of every other pair type.

False

There exists an arrow type that is a supertype of every other arrow type.

False

There exists an arrow type that is a subtype of every other arrow type.

False

There is an infinite descending chain of distinct types in the subtype relation---that is, an infinite sequence of types σ₀, σ₁, etc., such that all the σi's are different and each σ(i+1) is a subtype of σi.

True

There is an infinite ascending chain of distinct types in the subtype relation---that is, an infinite sequence of types σ₀, σ₁, etc., such that all the σi's are different and each σ(i+1) is a supertype of σi.

True

Exercise★(proper_subtypes) (Manually graded)

Is the following statement true or false? Briefly explain your answer. (A here and below represents an arbitrary base type.)

    ∀ τ,
         ~(τ = Bool ∨ ∃ n, τ = A) →
         ∃ σ,
            σ <: τ  ∧  σ <> τ

Answer: False. τ = ⊤→Bool is a counterexample.

Exercise★★(small_large_1) (Manually graded)

What is the smallest type τ ("smallest" in the subtype relation) that makes the following assertion true? (Assume we have Unit among the base types and unit as a constant of this type. )

  ∅ ⊢ (λp:τ×⊤. p.fst) ((λz:A,z). unit) ⦂ A→A

  τ = A → A

What is the largest type τ that makes the same assertion true?

  τ = A → A

Exercise★★(small_large_2) (Manually graded)

What is the smallest type τ that makes the following assertion true?

       ∅ ⊢ (λp:(A→A × B→B), p) ((λz:A.z), (λz:B.z)) ⦂ τ

       τ  =  (A→A × B→B)

What is the largest type τ that makes the same assertion true?

       τ  =  ⊤

Exercise★★(small_large_3) (Optional)

What is the smallest type τ that makes the following assertion true?

       a:A ⊢ (λp:(A×τ). (p.snd) (p.fst)) (a. λz:A.z) ⦂ A

       τ = A→A

What is the largest type τ that makes the same assertion true?

The same.

Here's the reasoning in more detail:

Clearly, τ must have the form τ₁→τ₂.

Now we can read off the following constraints from the program:

A <: τ₁ (from the application of p.snd to p.fst)
τ₂ <: A (from the final result type)
(A × A→A) <: (A × τ) (from the outer application)

Inverting the last constraint tells us

       A→A  <:  τ₁→τ₂

and hence

         τ₁ <: A
         A <: τ₂.

         τ = A→A

is both the largest and the smallest type that makes the whole typing statement true.

Quiz

What is the smallest type τ that makes the following assertion true?

    a:A ⊢ (λp:(A×τ). (p.snd) (p.fst)) (a, λz:A. z) ⦂ A

(A) ⊤

(B) A

(D) ⊤→A

(E) A→A

(F) A→⊤

Quiz

What is the largest type τ that makes the following assertion true?

       a:A ⊢ (λp:(A×τ). (p.snd) (p.fst)) (a, λz:A.z) ⦂ A

(A) ⊤

(B) A

(D) ⊤→A

(E) A→A

(F) A→⊤

Quiz

"The type Bool has no proper subtypes." (I.e., the only type smaller than Bool is Bool itself.)

(A) True

(B) False

Quiz

"Suppose σ, τ₁, and τ₂ are types with σ <: τ₁ → τ₂. Then σ itself is an arrow type -- i.e., σ = σ₁ → σ₂ for some σ₁ and σ₂ -- with τ₁ <: σ₁ and σ₂ <: τ₂."

(A) True

(B) False

Exercise★★(small_large_4) (Manually graded)

What is the smallest type τ (if one exists) that makes the following assertion true?

       ∃ σ,
         ∅ ⊢ (λp:(A*τ), (p.snd) (p.fst)) ⦂ σ

There is no smallest such type -- any type of the form A → σ for some type σ will make the assertion true, but there is no smallest one of these (there are infinitely many and they are incomparable).

What is the largest type τ that makes the same assertion true?

       τ  =  A → ⊤

Exercise★★(smallest_1) (Manually graded)

What is the smallest type τ (if one exists) that makes the following assertion true?

      exists σ t,
        ∅ ⊢ (\x:τ, x x) t ⦂ σ

Answer: Any type of the form τ = ⊤→υ will make the assertion true, but there is no smallest one of these: 1⊤→A→A1 and ⊤→B→B are both solutions, but they have no common subtype.

Exercise★★(smallest_2) (Manually graded)

What is the smallest type τ that makes the following assertion true?

      ∅ ⊢ (\x:⊤, x) ((λz:A,z) , (λz:B,z)) ⦂ τ

      τ  =  ⊤

Exercise★★★(count_supertypes) (Optional)

How many supertypes does the record type {x:A, y:C→C} have? That is, how many different types τ are there such that {x:A, y:C→C} <: τ? (We consider two types to be different if they are written differently, even if each is a subtype of the other. For example, {x:A,y:B} and {y:B,x:A} are different.)

Answer: Nineteen!

   { x:A, y:C→C }                 { y:⊤, x:A }
   { x:⊤, y:C→C }               { y:⊤, x:⊤ }
   { x:A, y:C→⊤ }               { x:A }
   { x:⊤, y:C→⊤ }             { x:⊤ }
   { x:A, y:⊤ }                  { y:C→C }
   { x:⊤, y:⊤ }                { y:C→⊤ }
   { y:C→C, x:A }                 { y:⊤ }
   { y:C→C, x:⊤ }               { }
   { y:C→⊤, x:A }               ⊤
   { y:C→⊤, x:⊤ }

Exercise★★(pair_permutation) (Manually graded)

The subtyping rule for product types

                            σ₁ <: τ₁    σ₂ <: τ₂
                            --------------------                        (prod)
                               σ₁*σ₂ <: τ₁*τ₂

intuitively corresponds to the "depth" subtyping rule for records. Extending the analogy, we might consider adding a "permutation" rule

                                   --------------
                                   τ₁*τ₂ <: τ₂*τ₁

for products. Is this a good idea? Briefly explain why or why not.

Answer: No, since it will break preservation: (tru,unit).1 has type Unit according to this rule, but reduces to tru, which does not have type Unit.

8.2. Formal Definitions🔗

namespace StlcSub

open scoped MyGetElem

Most of the definitions needed to formalize what we've discussed above -- in particular, the syntax and operational semantics of the language -- are identical to what we saw in the last chapter. We just need to extend the typing relation with the subsumption rule and add a new inductive definition for the subtyping relation. Let's first do the identical bits.

We include products in the syntax of types and terms, but not, for the moment, anywhere else; the products exercise below will ask you to extend the definitions of the value relation, operational semantics, subtyping relation, and typing relation and to extend the proofs of progress and preservation to fully support products.

8.2.1. Core Definitions🔗

8.2.1.1. Syntax🔗

In the rest of the chapter, we formalize just base types, booleans, arrow types, Unit, and ⊤, omitting record types and leaving product types as an exercise. For the sake of more interesting examples, we'll add an arbitrary set of base types like String, Float, etc. (Since they are just for examples, we won't bother adding any operations over these base types, but we could easily do so.)

inductive Ty : Type where
  | top   : Ty
  | bool  : Ty
  | base  : String → Ty
  | arrow : Ty → Ty → Ty
  | unit  : Ty
  | prod : Ty → Ty → Ty

inductive Tm : Type where
  | var : String → Tm
  | app : Tm → Tm → Tm
  | abs : String → Ty → Tm → Tm
  | tru : Tm
  | fls : Tm
  | ite : Tm → Tm → Tm → Tm
  | unit : Tm
  | pair : Tm → Tm → Tm
  | fst : Tm → Tm
  | snd : Tm → Tm

Notation

syntax:50 stlcTy:51 " × " stlcTy:50 : stlcTy
syntax:50 stlcTy:51 " + " stlcTy:50 : stlcTy
syntax:max " ⊤ " : stlcTy
syntax:51 " [ " stlcTy:50  " ] " : stlcTy

open Lean in
scoped macro_rules (kind := Stlc.tyBracket)
  | `(<{ ~$τ:term }>)    => pure τ
  | `(<{ ($τ:stlcTy) }>) => `(<{ $τ:stlcTy }>)
  | `(<{ ⊤ }>) => `(Ty.top)
  | `(<{ $x:ident }>) =>
      match x.getId.toString with
      | "Bool" => `(Ty.bool)
      | "Unit" => `(Ty.unit)
      | _ => `(Ty.base  $(quote x.getId.toString))
  | `(<{ $τ₁:stlcTy → $τ₂:stlcTy }>)  => `(Ty.arrow <{ $τ₁:stlcTy }> <{ $τ₂:stlcTy }>)
  | `(<{ $τ₁:stlcTy × $τ₂:stlcTy }>)  => `(Ty.prod <{ $τ₁:stlcTy }> <{ $τ₂:stlcTy }>)
  | `(<{ $τ₁:stlcTy -> $τ₂:stlcTy }>) => `(Ty.arrow <{ $τ₁:stlcTy }> <{ $τ₂:stlcTy }>)

Ty.top.prod Ty.top : Ty#check <{ ⊤ × ⊤ }>
Ty.bool.arrow Ty.top : Ty#check <{ Bool → ⊤ }>
(Ty.bool.prod Ty.unit).arrow (Ty.base "Nat") : Ty#check <{ (Bool × Unit) -> Nat }>

scoped syntax:50 "if " stlcTm:51 " then " stlcTm:50 " else " stlcTm:50 : stlcTm

scoped syntax:max " ( " stlcTm:60 " , " stlcTm:60 " ) " : stlcTm

open Lean in
scoped macro_rules (kind := Stlc.tmBracket)
  | `(<{ ~$e:term }>)    => pure e
  | `(<{ ($t:stlcTm) }>) => `(<{ $t:stlcTm }>)
  | `(<{ $x:ident }>) =>
      match x.getId.toString with
      | "Nat"  => Macro.throwErrorAt x "`Nat` is a type, not a term"
      | "Unit"  => Macro.throwErrorAt x "`Unit` is a type, not a term"
      | "fst" => Macro.throwErrorAt x "`fst` must be applied to an argument"
      | "snd" => Macro.throwErrorAt x "`snd` must be applied to an argument"
      | "unit" =>  `(Tm.unit)
      | "true" =>  `(Tm.tru)
      | "false" =>  `(Tm.fls)
      | _      => `(Tm.var $(quote x.getId.toString))
  | `(<{ λ $x : $τ . $t }>) => do
      `(Tm.abs $(← Stlc.varStr x) <{ $τ:stlcTy }> <{ $t:stlcTm }>)
  | `(<{ $t₁:stlcTm $t₂:stlcTm }>) =>
      match t₁ with
      | `(stlcTm| $f:ident) =>
          match f.getId.toString with
          | "fst" => `(Tm.fst <{ $t₂:stlcTm }>)
          | "snd" => `(Tm.snd <{ $t₂:stlcTm }>)
          | _      => `(Tm.app  <{ $t₁:stlcTm }> <{ $t₂:stlcTm }>)
      | _ => `(Tm.app <{ $t₁:stlcTm }> <{ $t₂:stlcTm }>)
  | `(<{ if $c then $t else $e }>) =>
      `(Tm.ite <{ $c:stlcTm }> <{ $t:stlcTm }> <{ $e:stlcTm }>)

  | `(<{ ( $t₁:stlcTm , $t₂:stlcTm ) }>) => `(Tm.pair <{ $t₁:stlcTm }> <{ $t₂:stlcTm }>)

open Lean in
/-- Is `s` usable as a bare variable in `stlcTm` rather than as reserved syntax? -/
def isPlainTmVarName (s : String) : Bool :=
  Stlc.isPlainName s && s != "Bool" && s != "unit" && s != "Unit" && s != "if"

open Lean PrettyPrinter Delaborator SubExpr in
/-- Rebuild `stlcTy` concrete syntax from a `Ty` value. -/
partial def delabTyInner : DelabM (TSyntax `stlcTy) := do
  let stx ←
    match_expr ← getExpr with
    | Ty.bool => `(stlcTy| $(mkIdent `Bool):ident)
    | Ty.unit => `(stlcTy| $(mkIdent `Unit):ident)
    | Ty.top => `(stlcTy| ⊤)
    | Ty.arrow _ _ => do
        let a ← withAppFn <| withAppArg delabTyInner
        let b ← withAppArg delabTyInner
        `(stlcTy| $a → $b)
    | Ty.prod _ _ => do
        let a ← withAppFn <| withAppArg delabTyInner
        let b ← withAppArg delabTyInner
        `(stlcTy| $a × $b)
    | Ty.base _ => do
        let b ← withAppArg delab
        `(stlcTy| ~($b))
    | _ => do
        match ← delab with
        | `($i:ident) => `(stlcTy| $i:ident)
        | e => `(stlcTy| ~$e)
  (⟨·⟩) <$> annotateTermInfo ⟨stx.raw⟩

open Lean PrettyPrinter Delaborator SubExpr in
/-- Rebuild `stlcTm` concrete syntax from a `Tm` value. -/
partial def delabTmInner : DelabM (TSyntax `stlcTm) := do
  let stx ←
    match_expr ← getExpr with
    | Tm.var _ => do
        let x ← withAppArg delab
        match x with
        | `($s:str) =>
            if isPlainTmVarName s.getString then
              `(stlcTm| $(mkIdent (Name.mkSimple s.getString)):ident)
            else
              let var : Term := mkIdent ``Tm.var
              `(stlcTm| ~($var $x))
        | _ =>
            let var : Term := mkIdent ``Tm.var
            `(stlcTm| ~($var $x))
    | Tm.app _ _ => do
        let f ← withAppFn <| withAppArg delabTmInner
        let a ← withAppArg delabTmInner
        `(stlcTm| $f $a)
    | Tm.abs _ _ _ => do
        let x ← withAppFn <| withAppFn <| withAppArg Stlc.delabVarInner
        let τ ← withAppFn <| withAppArg delabTyInner
        let t ← withAppArg delabTmInner
        `(stlcTm| λ $x : $τ . $t)
    | Tm.ite _ _ _ => do
        let c ← withAppFn <| withAppFn <| withAppArg delabTmInner
        let t ← withAppFn <| withAppArg delabTmInner
        let e ← withAppArg delabTmInner
        `(stlcTm| if $c then $t else $e)
    | Tm.pair _ _ => do
        let a ← withAppFn <| withAppArg delabTmInner
        let b ← withAppArg delabTmInner
        `(stlcTm| ( $a , $b ) )
    | Tm.fst _ => do
        let b ← withAppArg delabTmInner
        `(stlcTm| $(mkIdent `fst):ident $b )
    | Tm.snd _ => do
        let b ← withAppArg delabTmInner
        `(stlcTm| $(mkIdent `snd):ident $b )
    | Tm.unit => do
        `(stlcTm| $(mkIdent `unit):ident)
    | Tm.tru => do
      `(stlcTm| $(mkIdent `true):ident)
    | Tm.fls => do
      `(stlcTm| $(mkIdent `false):ident)
    | _ => do
        -- `subst` is defined below, so it is matched by name rather than with
        -- `match_expr`; a substitution prints in its own bracket notation.
        let e ← getExpr
        if e.getAppFn.constName? == some `SltcExtended.subst && e.getAppNumArgs == 3 then
          let x ← withAppFn <| withAppFn <| withAppArg Stlc.delabVarInner
          let s ← withAppFn <| withAppArg delabTmInner
          let t ← withAppArg delabTmInner
          `(stlcTm| [$x := $s] $t)
        else
          match ← delab with
          | `($i:ident) => `(stlcTm| $i:ident)
          | e => `(stlcTm| ~$e)
  (⟨·⟩) <$> annotateTermInfo ⟨stx.raw⟩

open Lean PrettyPrinter Delaborator SubExpr in
@[delab app.StlcSub.Ty.bool, delab app.StlcSub.Ty.arrow, delab app.StlcSub.Ty.unit,
  delab app.StlcSub.Ty.prod, delab app.StlcSub.Ty.base, delab app.StlcSub.Ty.top]
def delabTy : Delab := whenPPOption getPPNotation do
  guard <| match_expr ← getExpr with
    | Ty.bool => true | Ty.arrow _ _ => true
    | Ty.prod _ _ => true | Ty.base _ => true | Ty.top => true
    | Ty.unit => true | _ => false
  match ← delabTyInner with
  | `(stlcTy| ~$e) => pure e
  | e => `(<{ $e:stlcTy }>)

open Lean PrettyPrinter Delaborator SubExpr in
@[delab app.StlcSub.Tm.var, delab app.StlcSub.Tm.app, delab app.StlcSub.Tm.abs,
  delab app.StlcSub.Tm.ite, delab app.StlcSub.Tm.pair,
  delab app.StlcSub.Tm.fst, delab app.StlcSub.Tm.snd, delab app.StlcSub.Tm.unit,
  delab app.StlcSub.Tm.tru, delab app.StlcSub.Tm.fls ]
def delabTm : Delab := whenPPOption getPPNotation do
  guard <| match_expr ← getExpr with
    | Tm.var _ => true | Tm.app _ _ => true | Tm.abs _ _ _ => true
    | Tm.ite _ _ _ => true | Tm.unit => true | Tm.tru => true | Tm.fls => true
    | Tm.pair _ _ => true | Tm.fst _ => true | Tm.snd _ => true
    | _ => false
  match ← delabTmInner with
  | `(stlcTm| ~($e)) => pure e
  | `(stlcTm| ~$e) => pure e
  | e => `(<{ $e:stlcTm }>)

Checks that the extended grammar parses the way it should.

8.2.2. Substitution🔗

The definition of substitution remains exactly the same as for the pure STLC.

section
set_option hygiene false in
local macro_rules (kind := Stlc.tmBracket)
  | `(<{ [$x := $s] $t }>) => do
      `(subst $(← Stlc.varStr x) <{ $s:stlcTm }> <{ $t:stlcTm }>)

def subst (x : String) (s : Tm) (t : Tm) : Tm :=
  match t with
  -- pure STLC
  | .var y =>
      if x = y then s else t
  | <{ λ ~y : ~τ . ~t₁}> =>
      if x = y then t else <{ λ ~y : ~τ . [~x := ~s] ~t₁ }>
  | <{ ~t₁ ~t₂ }> =>
      <{ ([~x := ~s] ~t₁) ([~x := ~s] ~t₂) }>
  -- unit
  | .unit => <{ unit }>
  -- bools
  | <{ true }> => <{ true }>
  | <{ false }> => <{ false }>
  | <{ if ~t₁ then ~t₂ else ~t₃ }> =>
      <{ if [~x := ~s] ~t₁ then [~x := ~s] ~t₂ else [~x := ~s] ~t₃ }>

  -- Complete the following cases when you do the `products` exercise later
  | <{(~t₁, ~t₂)}> =>
      solution!(<{ ([~x := ~s] ~t₁ , [~x := ~s] ~t₂) }>)
  | Tm.fst t =>
      solution!(<{ fst ([~x := ~s] ~t)}>)
  | Tm.snd t =>
      solution!(<{ snd ([~x := ~s] ~t)}>)

end

macro_rules (kind := Stlc.tmBracket)
  | `(<{ [$x := $s] $t }>) => do
      `(subst $(← Stlc.varStr x) <{ $s:stlcTm }> <{ $t:stlcTm }>)

8.2.3. Reduction🔗

Likewise the definitions of IsValue and Step.

inductive Tm.IsValue : Tm → Prop where
  | abs : ∀ x τ₂ t₁,
      IsValue <{λ ~x : ~τ₂ . ~t₁}>
  | tru :
      IsValue <{true}>
  | fls :
      IsValue <{false}>
  | unit :
      IsValue .unit

-- Fill in more rules when you do the `products` exercise later
  | pair : ∀ v₁ v₂,
      IsValue v₁ →
      IsValue v₂ →
      IsValue <{(~v₁, ~v₂)}>

attribute [StlcSubEval] Tm.IsValue.pair

attribute [StlcSubEval] Tm.IsValue.abs Tm.IsValue.tru Tm.IsValue.fls Tm.IsValue.unit

section
set_option hygiene false in
local notation:40 t:41 " ⟶ " t':41 => Step t t'

inductive Step : Tm → Tm → Prop where
  -- pure STLC
  | appAbs (x : String) (τ₂ : Ty) (t₁ v₂ : Tm) :
        v₂.IsValue →
         <{(λ ~x: ~τ₂ . ~t₁) ~v₂}> ⟶ <{ [~x := ~v₂] ~t₁ }>
  | app₁ (t₁ t₁' t₂ : Tm) :
         t₁ ⟶ t₁' →
         <{~t₁ ~t₂}> ⟶ <{~t₁' ~t₂}>
  | app₂ (v₁ t₂ t₂' : Tm) :
        v₁.IsValue →
         t₂ ⟶ t₂' →
         <{~v₁ ~t₂}> ⟶ <{~v₁  ~t₂'}>
  -- booleans
  | ifStep (t₁ t₁' t₂ t₃ : Tm) (h : t₁ ⟶ t₁') :
      <{ if ~t₁ then ~t₂ else ~t₃ }> ⟶ <{ if ~t₁' then ~t₂ else ~t₃ }>
  | ifTrue (t₂ t₃ : Tm) :
      <{ if true then ~t₂ else ~t₃ }> ⟶ t₂
  | ifFalse (t₂ t₃ : Tm) :
      <{ if false then ~t₂ else ~t₃ }> ⟶ t₃

  -- Fill in more rules when you do the `products` exercise later
  | pair₁  (t₁ t₁' t₂ : Tm) :
        t₁ ⟶ t₁' →
        <{ (~t₁, ~t₂) }> ⟶ <{ (~t₁' , ~t₂) }>
  | pair₂ (v₁ t₂ t₂' : Tm) :
        v₁.IsValue →
        t₂ ⟶ t₂' →
        <{ (~v₁, ~t₂) }> ⟶  <{ (~v₁, ~t₂') }>
  | fst₁ (t t' : Tm) :
        t ⟶ t' →
        <{ fst ~t }> ⟶ <{ fst ~t' }>
  | fstPair (v₁ v₂ : Tm) :
        v₁.IsValue →
        v₂.IsValue →
        Tm.fst  <{ (~v₁ , ~v₂) }> ⟶ v₁
  | snd₁ (t t' : Tm) :
        t ⟶ t' →
        <{ snd ~t }> ⟶ <{ snd ~t' }>
  | sndPair (v₁ v₂ : Tm) :
        v₁.IsValue →
        v₂.IsValue →
        Tm.snd  <{ (~v₁, ~v₂) }> ⟶ v₂
end

scoped notation:40 t:41 " ⟶ " t':41 => Step t t'
scoped notation:40 t:41 " ⟶* " t':41 => Multi Step t t'

-- Be sure to add your constructors for pairs to this list later
attribute [StlcSubEval] Step.appAbs Step.app₁ Step.app₂
    Step.ifStep Step.ifTrue Step.ifFalse
    Step.pair₁ Step.pair₂ Step.fst₁ Step.fstPair
    Step.snd₁ Step.sndPair

8.2.4. Subtyping🔗

Now we come to the interesting part. We begin by defining the subtyping relation and developing some of its important technical properties.

The definition of subtyping is just what we sketched in the motivating discussion.

section
set_option hygiene false in
local notation:40 τ:41 " <: " τ':41 => Subtype τ τ'

inductive Subtype : Ty → Ty → Prop where
  | refl {τ : Ty} :
      τ <: τ
  | trans {σ υ τ: Ty}
      (h₁ : σ <: υ)
      (h₂ : υ <: τ) :
      σ <: τ
  | top {σ : Ty} :
      σ <: <{ ⊤ }>
  | arrow { σ₁ σ₂ τ₁ τ₂ : Ty}
      (h₁ : τ₁ <: σ₁)
      (h₂ : σ₂ <: τ₂) :
      <{ ~σ₁→~σ₂ }> <: <{ ~τ₁→~τ₂ }>

-- Fill in more rules when you do the `products` exercise later
  | prod { σ₁ σ₂ τ₁ τ₂ : Ty}
      (h₁ : σ₁ <: τ₁)
      (h₂ : σ₂ <: τ₂) :
      <{ ~σ₁ × ~σ₂ }> <: <{ ~τ₁ × ~τ₂ }>
end

scoped notation:40 τ:41 " <: " τ':41 => Subtype τ τ'

attribute [StlcSubTyping] Subtype.refl Subtype.trans Subtype.top Subtype.arrow
Subtype.prod

Note that we don't need any special rules for base types (Bool and Base): they are automatically subtypes of themselves (by refl) and ⊤ (by top), and that's all we want.

namespace Examples

abbrev A := Ty.base "A"
abbrev B := Ty.base "B"
abbrev C := Ty.base "C"

abbrev String := Ty.base "String"
abbrev Float := Ty.base "Flat"
abbrev Int := Ty.base "Int"

example : <{ ~C → Bool }> <: <{ ~C → ⊤ }> := by⊢ <{ C → Bool }> <: <{ C → ⊤ }>
  solve_by_elim using StlcSubTypingAll goals completed! 🐙

Note that, because the Subtype rules are not "syntax directed" (e.g., given a goal of the form ⊤ <: ⊤, you could apply the top rule, the refl rule, the trans rule), we have to use solve_by_elim here instead of apply_rules.

Exercise★★(subtyping_judgements) (Optional)

Leave this exercise until after you have finished adding product types to the language - see exercise products - at least up to this point in the file.

Recall that, in chapter MoreStlc, the optional section "Encoding Records" describes how records can be encoded as pairs. Using this encoding, define pair types representing the following record types:

    Person := { name : String }
    Student := { name : String ; gpa : Float }
    Employee := { name : String ; ssn : Integer }

def person : Ty := solution!(<{ String × ⊤ }>)
def student : Ty := solution!(<{ String × (⊤ × Float) }>)
def employee : Ty := solution!(<{ String × (Integer × ⊤) }>)

Now use the definition of the subtype relation to prove the following:

example : student <: person := by⊢ student <: person
  solution!
    rw [student,⊢ <{ ~("String") × ⊤ × ~("Float") }> <: person person⊢ <{ ~("String") × ⊤ × ~("Float") }> <: <{ ~("String") × ⊤ }>]⊢ <{ ~("String") × ⊤ × ~("Float") }> <: <{ ~("String") × ⊤ }>; solve_by_elim using StlcSubTypingAll goals completed! 🐙

example : employee <: person := by⊢ employee <: person
  solution!
    rw [employee,⊢ <{ ~("String") × ~("Integer") × ⊤ }> <: person person⊢ <{ ~("String") × ~("Integer") × ⊤ }> <: <{ ~("String") × ⊤ }>]⊢ <{ ~("String") × ~("Integer") × ⊤ }> <: <{ ~("String") × ⊤ }>; solve_by_elim using StlcSubTypingAll goals completed! 🐙

The following facts are mostly easy to prove in Lean. To get full benefit from the exercises, make sure you also understand how to prove them on paper!

Exercise★(subtyping_example_1) (Optional)

example : <{ ⊤ → ~student }> <:  <{ (C → C) → ~person }> := by⊢ <{ ⊤ → student }> <: <{ (~("C") → ~("C")) → person }>
  solution!
    rw [student,⊢ <{ ⊤ → ~("String") × ⊤ × ~("Float") }> <: <{ (~("C") → ~("C")) → person }> person⊢ <{ ⊤ → ~("String") × ⊤ × ~("Float") }> <: <{ (~("C") → ~("C")) → ~("String") × ⊤ }>]⊢ <{ ⊤ → ~("String") × ⊤ × ~("Float") }> <: <{ (~("C") → ~("C")) → ~("String") × ⊤ }>; solve_by_elim using StlcSubTypingAll goals completed! 🐙

Exercise★(subtyping_example_2) (Optional)

example : <{ ⊤ → ~person }> <: <{ ~person → ⊤ }> := by⊢ <{ ⊤ → person }> <: <{ person → ⊤ }>
  solution!
    rw [person⊢ <{ ⊤ → ~("String") × ⊤ }> <: <{ (~("String") × ⊤ ) → ⊤ }>]⊢ <{ ⊤ → ~("String") × ⊤ }> <: <{ (~("String") × ⊤ ) → ⊤ }>; solve_by_elim using StlcSubTypingAll goals completed! 🐙

end Examples

8.2.5. Typing🔗

The only change to the typing relation is the addition of the rule of subsumption, sub.

abbrev Context := PartialMap String Ty

Notation encoding: contexts and judgments

The context grammar stlcCtx is reused as well; only the map it denotes is new, since the types it stores are this language's. As with subst, the judgment rule is introduced twice: local and hygiene-free while the relation is being declared, then again for real.

open Lean in
/-- The `Context` denoted by a context expression. -/
partial def ctxTerm (G : TSyntax `stlcCtx) : MacroM Term :=
  match G with
  | `(stlcCtx| ∅)   => `((∅ : Context))
  | `(stlcCtx| ~$e) => pure e
  | `(stlcCtx| $x:stlcVar ↦ $τ:stlcTy ; $G:stlcCtx) => do
      `(PartialMap.update $(← ctxTerm G) $(← Stlc.varStr x) <{ $τ:stlcTy }>)
  | _ => Macro.throwUnsupported

section StlcExtended
set_option hygiene false in
local macro_rules (kind := Stlc.judgeBracket)
  | `(<{ $G:stlcCtx ⊢ $t:stlcTm ⦂ $τ:stlcTy }>) => do
      `(HasType $(← ctxTerm G) <{ $t:stlcTm }> <{ $τ:stlcTy }>)

inductive HasType : Context → Tm → Ty → Prop where
  -- pure STLC
  | var (Γ : Context) (x : String) (τ₁ : Ty) (h : Γ[x] = some τ₁) :
      <{ ~Γ ⊢ ~(Tm.var x) ⦂ ~τ₁ }>
  | abs (Γ : Context) (x : String) (τ₁ τ₂ : Ty) (t₁ : Tm)
      (h : <{ ~x ↦ ~τ₂ ; ~Γ ⊢ ~t₁ ⦂ ~τ₁ }>) :
      <{ ~Γ ⊢ λ ~x : ~τ₂ . ~t₁ ⦂ ~τ₂ → ~τ₁ }>
  | app (Γ : Context) (τ₁ τ₂ : Ty) (t₁ t₂ : Tm)
      (h₁ : <{ ~Γ ⊢ ~t₁ ⦂ ~τ₂ → ~τ₁ }>) (h₂ : <{ ~Γ ⊢ ~t₂ ⦂ ~τ₂ }>) :
      <{ ~Γ ⊢ ~t₁ ~t₂ ⦂ ~τ₁ }>
  -- booleans
  | tru (Γ : Context) :
      <{ ~Γ ⊢ true ⦂ Bool }>
  | fls (Γ : Context) :
      <{ ~Γ ⊢ false ⦂ Bool }>
  | ite (Γ : Context) (t₁ t₂ t₃ : Tm) (τ : Ty)
      (h₁ : <{ ~Γ ⊢ ~t₁ ⦂ Bool }>) (h₂ : <{ ~Γ ⊢ ~t₂ ⦂ ~τ }>)
      (h₃ : <{ ~Γ ⊢ ~t₃ ⦂ ~τ }>) :
      <{ ~Γ ⊢ if ~t₁ then ~t₂ else ~t₃ ⦂ ~τ }>
  -- unit
  | unit (Γ : Context) :
      <{ ~Γ ⊢ unit ⦂ Unit }>
  -- subsumption
  | sub (Γ : Context) (t₁ : Tm) (τ₁ τ₂ : Ty)
      (ht : <{ ~Γ ⊢ ~t₁ ⦂ ~τ₁ }>)
      (hs : τ₁ <: τ₂) :
      <{ ~Γ ⊢ ~t₁ ⦂ ~τ₂ }>

  -- Fill in more rules when you do the `products` exercise later
  | pair (Γ : Context) (t₁ t₂ : Tm) (τ₁ τ₂ : Ty)
      (h₁ : <{ ~Γ ⊢ ~t₁ ⦂ ~τ₁ }>)
      (h₂ : <{ ~Γ ⊢ ~t₂ ⦂ ~τ₂ }>) :
      <{ ~Γ ⊢ (~t₁, ~t₂) ⦂ ~τ₁ × ~τ₂ }>
  | fst (Γ : Context) (t : Tm) (τ₁ τ₂ : Ty)
      (h : <{ ~Γ ⊢ ~t ⦂ ~τ₁ × ~τ₂ }>) :
      <{ ~Γ ⊢ fst ~t ⦂ ~τ₁ }>
  | snd (Γ : Context) (t : Tm) (τ₁ τ₂ : Ty)
      (h : <{ ~Γ ⊢ ~t ⦂ ~τ₁ × ~τ₂ }>) :
      <{ ~Γ ⊢ snd ~t ⦂ ~τ₂ }>

-- Make sure to add your constructors here
attribute [StlcSubTyping] HasType.var HasType.abs HasType.app
    HasType.ite HasType.tru HasType.fls HasType.unit
    HasType.pair HasType.fst HasType.snd

We deliberately exclude HasType.sub from the list of constructors with the StlcSubTyping. apply_rules using StlcSubTyping will search for derivations without using the subtyping rule; if you want to make use of it in a derivation you will need to do so yourself.

Notation encoding: the judgment, for real

Closing the section retires the hygiene-free rule; the same rule is then declared again, hygienically, for every later use, and a pair of unexpanders prints judgments back in their own notation.

end StlcExtended

scoped macro_rules (kind := Stlc.judgeBracket)
  | `(<{ $G:stlcCtx ⊢ $t:stlcTm ⦂ $τ:stlcTy }>) => do
      `(HasType $(← ctxTerm G) <{ $t:stlcTm }> <{ $τ:stlcTy }>)

open Lean PrettyPrinter in
/-- Rebuild `stlcCtx` syntax from the term syntax of a `Context`, so that a
context prints as `x ↦ Nat ; Γ` rather than as a chain of map updates. -/
partial def unexpandCtx : Term → UnexpandM (TSyntax `stlcCtx)
  | `(∅) => `(stlcCtx| ∅)
  | `($x:str →ₚ $τ) => do
      unexpandCtx (← `($x →ₚ $τ ; ∅))
  | `($x:str →ₚ $τ ; $G) => do
      let G' ← unexpandCtx G
      let x' : TSyntax `stlcVar ←
        if Stlc.isPlainName x.getString then
          `(stlcVar| $(mkIdent (Name.mkSimple x.getString)):ident)
        else `(stlcVar| ~$x)
      match τ with
      | `(<{ $T':stlcTy }>) => `(stlcCtx| $x':stlcVar ↦ $T' ; $G')
      | _                   => `(stlcCtx| $x':stlcVar ↦ ~($τ) ; $G')
  | G => `(stlcCtx| ~($G))

open Lean PrettyPrinter in
@[app_unexpander HasType]
def HasType.unexpand : Unexpander
  | `($_ $G <{ $t:stlcTm }> <{ $τ:stlcTy }>) =>
      do `(<{ $(← unexpandCtx G) ⊢ $t ⦂ $τ }>)
  | `($_ $G <{ $t:stlcTm }> $τ) =>
      do `(<{ $(← unexpandCtx G) ⊢ $t ⦂ ~($τ) }>)
  | `($_ $G $t <{ $τ:stlcTy }>) =>
      do `(<{ $(← unexpandCtx G) ⊢ ~($t) ⦂ $τ }>)
  | `($_ $G $t $τ) =>
      do `(<{ $(← unexpandCtx G) ⊢ ~($t) ⦂ ~($τ) }>)
  | _ => throw ()

namespace Examples

Do the following exercises after you have added product types to the language. For each informal typing judgement, write it as a formal statement in Lean and prove it.

Exercise★(typing_example_0) (Optional)

∅ ⊢ ((λz:A.z), (λz:B,z)) ⦂ (A→A × B→B)

example : <{ ∅ ⊢ ((λz : ~A . z), (λz : ~B . z)) ⦂ ((~A → ~A) × (~B → ~B)) }> := by⊢ <{ ∅ ⊢ ( (λ z : A . z) , (λ z : B . z) ) ⦂ (A → A) × B → B }>
  solution!
    apply_rules using StlcSubTypingAll goals completed! 🐙

Exercise★★(typing_example_1) (Optional)

∅ ⊢ (λx:(⊤ × B→B). snd x) ((λz:A. z), (λz:B. z)) ⦂ B→B

example : <{ ∅ ⊢ (λx: (⊤ × (~B → ~B)). snd x) (((λz: ~A . z), (λz: ~B . z))) ⦂ ( ~B → ~B) }> := by⊢ <{ ∅ ⊢ (λ x : ⊤ × B → B . snd x)  ( (λ z : A . z) , (λ z : B . z) ) ⦂ B → B }>
  solution!
    apply_rules using StlcSubTypingh₂.h₁⊢ <{ ∅ ⊢ λ z : A . z ⦂ ⊤ }>
    apply HasType.subh₂.h₁.ht⊢ <{ ∅ ⊢ λ z : A . z ⦂ ~(?h₂.h₁.τ₁) }>h₂.h₁.hs⊢ ?h₂.h₁.τ₁ <: <{ ⊤ }>h₂.h₁.τ₁⊢ Ty
    ·h₂.h₁.ht⊢ <{ ∅ ⊢ λ z : A . z ⦂ ~(?h₂.h₁.τ₁) }> apply HasType.absh₂.h₁.ht.h⊢ <{ z ↦ ~(A) ; ∅ ⊢ z ⦂ ~(?h₂.h₁.ht.τ₁) }>h₂.h₁.ht.τ₁⊢ Ty; apply HasType.varh₂.h₁.ht.h⊢ ("z" →ₚ A)["z"] = some ?h₂.h₁.ht.τ₁h₂.h₁.ht.τ₁⊢ Ty; rflAll goals completed! 🐙
    ·h₂.h₁.hs⊢ <{ A → A }> <: <{ ⊤ }> apply Subtype.topAll goals completed! 🐙

Exercise★★(typing_example_2) (Optional)

∅ ⊢ (λz:(C→C)→(⊤ × B→B). snd (z (λx:C.x))) (λz:C→C. ((λz:A. z), (λz:B. z))) ⦂ B→B

example :
  <{ ∅ ⊢(λz : (~C → ~C) → (⊤ × ~B → ~B) . snd (z (λx: ~C . x)))
          (λz: ~C → ~C . ((λ z : ~A . z), (λ z : ~B . z))) ⦂ (~B → ~B) }> := by⊢ <{ ∅ ⊢ (λ z : (C → C) → ⊤ × B → B . snd (z (λ x : C . x))) (λ z : C → C . ( (λ z : A . z) , (λ z : B . z) ) ) ⦂ B → B }>
  solution!
    apply_rules using StlcSubTypingh₂.h₁⊢ <{ z ↦ C → C ; ∅ ⊢ λ z : A . z ⦂ ⊤ }>
    apply HasType.subh₂.h₁.ht⊢ <{ z ↦ C → C ; ∅ ⊢ λ z : A . z ⦂ ~(?h₂.h₁.τ₁) }>h₂.h₁.hs⊢ ?h₂.h₁.τ₁ <: <{ ⊤ }>h₂.h₁.τ₁⊢ Ty
    ·h₂.h₁.ht⊢ <{ z ↦ C → C ; ∅ ⊢ λ z : A . z ⦂ ~(?h₂.h₁.τ₁) }> apply HasType.absh₂.h₁.ht.h⊢ <{ z ↦ ~(A) ; z ↦ C → C ; ∅ ⊢ z ⦂ ~(?h₂.h₁.ht.τ₁) }>h₂.h₁.ht.τ₁⊢ Ty; apply HasType.varh₂.h₁.ht.h⊢ ("z" →ₚ A ; "z" →ₚ <{ C → C }>)["z"] = some ?h₂.h₁.ht.τ₁h₂.h₁.ht.τ₁⊢ Ty; rflAll goals completed! 🐙
    ·h₂.h₁.hs⊢ <{ A → A }> <: <{ ⊤ }> apply Subtype.topAll goals completed! 🐙

end Examples

8.3. Properties🔗

The fundamental properties of the system that we want to check are the same as always: progress and preservation. However, their proofs do become a little bit more involved.

8.3.1. Inversion Lemmas for Subtyping🔗

Before we look at the properties of the typing relation, we need to establish a couple of critical structural properties of the subtype relation:

Bool is the only subtype of Bool, and
every subtype of an arrow type is itself an arrow type.

These are called inversion lemmas because they play a similar role in proofs as the inversion tactic: given a hypothesis that there exists a derivation of some subtyping statement σ <: τ and some constraints on the shape of σ and/or τ, each inversion lemma reasons about what this derivation must look like to tell us something further about the shapes of σ and τ and the existence of subtype relations between their parts.

Exercise★★(sub_inversion_bool) (Optional)

theorem sub_inversion_bool (τ : Ty)
    (h : τ <: <{ Bool }>) :
    τ = Ty.bool := byτ:Tyh:τ <: <{ Bool }>⊢ τ = <{ Bool }>
  solution!
    generalize heq : Ty.bool = σ at hτ:Tyσ:Tyheq:<{ Bool }> = σh:τ <: σ⊢ τ = σ
    induction h with (subst_varsprodτ:Tyσ:Tyσ₁✝:Tyσ₂✝:Tyτ₁✝:Tyτ₂✝:Tyh₁✝:σ₁✝ <: τ₁✝h₂✝:σ₂✝ <: τ₂✝h₁_ih✝:<{ Bool }> = τ₁✝ → σ₁✝ = τ₁✝h₂_ih✝:<{ Bool }> = τ₂✝ → σ₂✝ = τ₂✝heq:<{ Bool }> = <{ τ₁✝ × τ₂✝ }>⊢ <{ σ₁✝ × σ₂✝ }> = <{ τ₁✝ × τ₂✝ }>; try contradictionAll goals completed! 🐙)
    | refl =>reflτ:Tyσ:Ty⊢ <{ Bool }> = <{ Bool }> rflAll goals completed! 🐙
    | trans h₁ h₂ ih₁ ih₂ =>transτ:Tyσ:Tyσ✝:Tyυ✝:Tyh₁:σ✝ <: υ✝ih₁:<{ Bool }> = υ✝ → σ✝ = υ✝h₂:υ✝ <: <{ Bool }>ih₂:<{ Bool }> = <{ Bool }> → υ✝ = <{ Bool }>⊢ σ✝ = <{ Bool }>
        rw [ih₁transτ:Tyσ:Tyσ✝:Tyυ✝:Tyh₁:σ✝ <: υ✝ih₁:<{ Bool }> = υ✝ → σ✝ = υ✝h₂:υ✝ <: <{ Bool }>ih₂:<{ Bool }> = <{ Bool }> → υ✝ = <{ Bool }>⊢ υ✝ = <{ Bool }>transτ:Tyσ:Tyσ✝:Tyυ✝:Tyh₁:σ✝ <: υ✝ih₁:<{ Bool }> = υ✝ → σ✝ = υ✝h₂:υ✝ <: <{ Bool }>ih₂:<{ Bool }> = <{ Bool }> → υ✝ = <{ Bool }>⊢ <{ Bool }> = υ✝]transτ:Tyσ:Tyσ✝:Tyυ✝:Tyh₁:σ✝ <: υ✝ih₁:<{ Bool }> = υ✝ → σ✝ = υ✝h₂:υ✝ <: <{ Bool }>ih₂:<{ Bool }> = <{ Bool }> → υ✝ = <{ Bool }>⊢ υ✝ = <{ Bool }>transτ:Tyσ:Tyσ✝:Tyυ✝:Tyh₁:σ✝ <: υ✝ih₁:<{ Bool }> = υ✝ → σ✝ = υ✝h₂:υ✝ <: <{ Bool }>ih₂:<{ Bool }> = <{ Bool }> → υ✝ = <{ Bool }>⊢ <{ Bool }> = υ✝; apply ih₂ rfltransτ:Tyσ:Tyσ✝:Tyυ✝:Tyh₁:σ✝ <: υ✝ih₁:<{ Bool }> = υ✝ → σ✝ = υ✝h₂:υ✝ <: <{ Bool }>ih₂:<{ Bool }> = <{ Bool }> → υ✝ = <{ Bool }>⊢ <{ Bool }> = υ✝
        symmtransτ:Tyσ:Tyσ✝:Tyυ✝:Tyh₁:σ✝ <: υ✝ih₁:<{ Bool }> = υ✝ → σ✝ = υ✝h₂:υ✝ <: <{ Bool }>ih₂:<{ Bool }> = <{ Bool }> → υ✝ = <{ Bool }>⊢ υ✝ = <{ Bool }>; apply ih₂ rflAll goals completed! 🐙

Exercise★★★(sub_inversion_arrow)

theorem sub_inversion_arrow {σ τ₁ τ₂ : Ty}
     (h : σ <: <{ ~τ₁ → ~τ₂ }>) :
     ∃ σ₁ σ₂,
     σ = <{ ~σ₁ → ~σ₂ }> ∧ τ₁ <: σ₁ ∧ σ₂ <: τ₂ := byσ:Tyτ₁:Tyτ₂:Tyh:σ <: <{ τ₁ → τ₂ }>⊢ ∃ σ₁ σ₂, σ = <{ σ₁ → σ₂ }> ∧ τ₁ <: σ₁ ∧ σ₂ <: τ₂
  solution!
    generalize heq : <{ ~τ₁ → ~τ₂ }> = τ at hσ:Tyτ₁:Tyτ₂:Tyτ:Tyheq:<{ τ₁ → τ₂ }> = τh:σ <: τ⊢ ∃ σ₁ σ₂, σ = <{ σ₁ → σ₂ }> ∧ τ₁ <: σ₁ ∧ σ₂ <: τ₂
    induction h generalizing τ₁ τ₂ with (subst_varsprodσ:Tyτ:Tyσ₁✝:Tyσ₂✝:Tyτ₁✝:Tyτ₂✝:Tyh₁✝:σ₁✝ <: τ₁✝h₂✝:σ₂✝ <: τ₂✝h₁_ih✝:∀ {τ₁ τ₂ : Ty}, <{ τ₁ → τ₂ }> = τ₁✝ → ∃ σ₁ σ₂, σ₁✝ = <{ σ₁ → σ₂ }> ∧ τ₁ <: σ₁ ∧ σ₂ <: τ₂h₂_ih✝:∀ {τ₁ τ₂ : Ty}, <{ τ₁ → τ₂ }> = τ₂✝ → ∃ σ₁ σ₂, σ₂✝ = <{ σ₁ → σ₂ }> ∧ τ₁ <: σ₁ ∧ σ₂ <: τ₂τ₁:Tyτ₂:Tyheq:<{ τ₁ → τ₂ }> = <{ τ₁✝ × τ₂✝ }>⊢ ∃ σ₁ σ₂, <{ σ₁✝ × σ₂✝ }> = <{ σ₁ → σ₂ }> ∧ τ₁ <: σ₁ ∧ σ₂ <: τ₂; try contradictionAll goals completed! 🐙)
    | refl =>reflσ:Tyτ:Tyτ₁:Tyτ₂:Ty⊢ ∃ σ₁ σ₂, <{ τ₁ → τ₂ }> = <{ σ₁ → σ₂ }> ∧ τ₁ <: σ₁ ∧ σ₂ <: τ₂
        exists τ₁, τ₂reflσ:Tyτ:Tyτ₁:Tyτ₂:Ty⊢ <{ τ₁ → τ₂ }> = <{ τ₁ → τ₂ }> ∧ τ₁ <: τ₁ ∧ τ₂ <: τ₂; constructorrefl.leftσ:Tyτ:Tyτ₁:Tyτ₂:Ty⊢ <{ τ₁ → τ₂ }> = <{ τ₁ → τ₂ }>refl.rightσ:Tyτ:Tyτ₁:Tyτ₂:Ty⊢ τ₁ <: τ₁ ∧ τ₂ <: τ₂; rflrefl.rightσ:Tyτ:Tyτ₁:Tyτ₂:Ty⊢ τ₁ <: τ₁ ∧ τ₂ <: τ₂
        constructorrefl.right.leftσ:Tyτ:Tyτ₁:Tyτ₂:Ty⊢ τ₁ <: τ₁refl.right.rightσ:Tyτ:Tyτ₁:Tyτ₂:Ty⊢ τ₂ <: τ₂ <;>refl.right.leftσ:Tyτ:Tyτ₁:Tyτ₂:Ty⊢ τ₁ <: τ₁refl.right.rightσ:Tyτ:Tyτ₁:Tyτ₂:Ty⊢ τ₂ <: τ₂ constructorAll goals completed! 🐙
    | @arrow σ₁ σ₂ _ _ h₁ h₂ ih₁ ih₂ =>arrowσ:Tyτ:Tyσ₁:Tyσ₂:Tyτ₁✝:Tyτ₂✝:Tyh₁:τ₁✝ <: σ₁h₂:σ₂ <: τ₂✝ih₁:∀ {τ₁ τ₂ : Ty}, <{ τ₁ → τ₂ }> = σ₁ → ∃ σ₁ σ₂, τ₁✝ = <{ σ₁ → σ₂ }> ∧ τ₁ <: σ₁ ∧ σ₂ <: τ₂ih₂:∀ {τ₁ τ₂ : Ty}, <{ τ₁ → τ₂ }> = τ₂✝ → ∃ σ₁ σ₂_1, σ₂ = <{ σ₁ → σ₂_1 }> ∧ τ₁ <: σ₁ ∧ σ₂_1 <: τ₂τ₁:Tyτ₂:Tyheq:<{ τ₁ → τ₂ }> = <{ τ₁✝ → τ₂✝ }>⊢ ∃ σ₁_1 σ₂_1, <{ σ₁ → σ₂ }> = <{ σ₁_1 → σ₂_1 }> ∧ τ₁ <: σ₁_1 ∧ σ₂_1 <: τ₂
        inversion heqreflσ:Tyτ:Tyσ₁:Tyσ₂:Tyτ₁✝:Tyτ₂✝:Tyh₁:τ₁✝ <: σ₁h₂:σ₂ <: τ₂✝ih₁:∀ {τ₁ τ₂ : Ty}, <{ τ₁ → τ₂ }> = σ₁ → ∃ σ₁ σ₂, τ₁✝ = <{ σ₁ → σ₂ }> ∧ τ₁ <: σ₁ ∧ σ₂ <: τ₂ih₂:∀ {τ₁ τ₂ : Ty}, <{ τ₁ → τ₂ }> = τ₂✝ → ∃ σ₁ σ₂_1, σ₂ = <{ σ₁ → σ₂_1 }> ∧ τ₁ <: σ₁ ∧ σ₂_1 <: τ₂⊢ ∃ σ₁_1 σ₂_1, <{ σ₁ → σ₂ }> = <{ σ₁_1 → σ₂_1 }> ∧ τ₁✝ <: σ₁_1 ∧ σ₂_1 <: τ₂✝; exists σ₁, σ₂All goals completed! 🐙
    | trans h₁ h₂ ih₁ ih₂ =>transσ:Tyτ:Tyσ✝:Tyυ✝:Tyh₁:σ✝ <: υ✝ih₁:∀ {τ₁ τ₂ : Ty}, <{ τ₁ → τ₂ }> = υ✝ → ∃ σ₁ σ₂, σ✝ = <{ σ₁ → σ₂ }> ∧ τ₁ <: σ₁ ∧ σ₂ <: τ₂τ₁:Tyτ₂:Tyh₂:υ✝ <: <{ τ₁ → τ₂ }>ih₂:∀ {τ₁_1 τ₂_1 : Ty}, <{ τ₁_1 → τ₂_1 }> = <{ τ₁ → τ₂ }> → ∃ σ₁ σ₂, υ✝ = <{ σ₁ → σ₂ }> ∧ τ₁_1 <: σ₁ ∧ σ₂ <: τ₂_1⊢ ∃ σ₁ σ₂, σ✝ = <{ σ₁ → σ₂ }> ∧ τ₁ <: σ₁ ∧ σ₂ <: τ₂
        obtain ⟨σ₁, σ₂, _, hs₁, hs₂⟩ := ih₂ rfltransσ:Tyτ:Tyσ✝:Tyυ✝:Tyh₁:σ✝ <: υ✝ih₁:∀ {τ₁ τ₂ : Ty}, <{ τ₁ → τ₂ }> = υ✝ → ∃ σ₁ σ₂, σ✝ = <{ σ₁ → σ₂ }> ∧ τ₁ <: σ₁ ∧ σ₂ <: τ₂τ₁:Tyτ₂:Tyh₂:υ✝ <: <{ τ₁ → τ₂ }>ih₂:∀ {τ₁_1 τ₂_1 : Ty}, <{ τ₁_1 → τ₂_1 }> = <{ τ₁ → τ₂ }> → ∃ σ₁ σ₂, υ✝ = <{ σ₁ → σ₂ }> ∧ τ₁_1 <: σ₁ ∧ σ₂ <: τ₂_1σ₁:Tyσ₂:Tyleft✝:υ✝ = <{ σ₁ → σ₂ }>hs₁:τ₁ <: σ₁hs₂:σ₂ <: τ₂⊢ ∃ σ₁ σ₂, σ✝ = <{ σ₁ → σ₂ }> ∧ τ₁ <: σ₁ ∧ σ₂ <: τ₂; clear ih₂transσ:Tyτ:Tyσ✝:Tyυ✝:Tyh₁:σ✝ <: υ✝ih₁:∀ {τ₁ τ₂ : Ty}, <{ τ₁ → τ₂ }> = υ✝ → ∃ σ₁ σ₂, σ✝ = <{ σ₁ → σ₂ }> ∧ τ₁ <: σ₁ ∧ σ₂ <: τ₂τ₁:Tyτ₂:Tyh₂:υ✝ <: <{ τ₁ → τ₂ }>σ₁:Tyσ₂:Tyleft✝:υ✝ = <{ σ₁ → σ₂ }>hs₁:τ₁ <: σ₁hs₂:σ₂ <: τ₂⊢ ∃ σ₁ σ₂, σ✝ = <{ σ₁ → σ₂ }> ∧ τ₁ <: σ₁ ∧ σ₂ <: τ₂; subst_varstransσ:Tyτ:Tyσ✝:Tyτ₁:Tyτ₂:Tyσ₁:Tyσ₂:Tyhs₁:τ₁ <: σ₁hs₂:σ₂ <: τ₂h₁:σ✝ <: <{ σ₁ → σ₂ }>ih₁:∀ {τ₁ τ₂ : Ty}, <{ τ₁ → τ₂ }> = <{ σ₁ → σ₂ }> → ∃ σ₁ σ₂, σ✝ = <{ σ₁ → σ₂ }> ∧ τ₁ <: σ₁ ∧ σ₂ <: τ₂h₂:<{ σ₁ → σ₂ }> <: <{ τ₁ → τ₂ }>⊢ ∃ σ₁ σ₂, σ✝ = <{ σ₁ → σ₂ }> ∧ τ₁ <: σ₁ ∧ σ₂ <: τ₂
        obtain ⟨σ₁', σ₂', _, hs₁', hs₂'⟩ := ih₁ rfltransσ:Tyτ:Tyσ✝:Tyτ₁:Tyτ₂:Tyσ₁:Tyσ₂:Tyhs₁:τ₁ <: σ₁hs₂:σ₂ <: τ₂h₁:σ✝ <: <{ σ₁ → σ₂ }>ih₁:∀ {τ₁ τ₂ : Ty}, <{ τ₁ → τ₂ }> = <{ σ₁ → σ₂ }> → ∃ σ₁ σ₂, σ✝ = <{ σ₁ → σ₂ }> ∧ τ₁ <: σ₁ ∧ σ₂ <: τ₂h₂:<{ σ₁ → σ₂ }> <: <{ τ₁ → τ₂ }>σ₁':Tyσ₂':Tyleft✝:σ✝ = <{ σ₁' → σ₂' }>hs₁':σ₁ <: σ₁'hs₂':σ₂' <: σ₂⊢ ∃ σ₁ σ₂, σ✝ = <{ σ₁ → σ₂ }> ∧ τ₁ <: σ₁ ∧ σ₂ <: τ₂; subst_varstransσ:Tyτ:Tyτ₁:Tyτ₂:Tyσ₁:Tyσ₂:Tyhs₁:τ₁ <: σ₁hs₂:σ₂ <: τ₂h₂:<{ σ₁ → σ₂ }> <: <{ τ₁ → τ₂ }>σ₁':Tyσ₂':Tyhs₁':σ₁ <: σ₁'hs₂':σ₂' <: σ₂h₁:<{ σ₁' → σ₂' }> <: <{ σ₁ → σ₂ }>ih₁:∀ {τ₁ τ₂ : Ty}, <{ τ₁ → τ₂ }> = <{ σ₁ → σ₂ }> → ∃ σ₁ σ₂, <{ σ₁' → σ₂' }> = <{ σ₁ → σ₂ }> ∧ τ₁ <: σ₁ ∧ σ₂ <: τ₂⊢ ∃ σ₁ σ₂, <{ σ₁' → σ₂' }> = <{ σ₁ → σ₂ }> ∧ τ₁ <: σ₁ ∧ σ₂ <: τ₂; clear ih₁transσ:Tyτ:Tyτ₁:Tyτ₂:Tyσ₁:Tyσ₂:Tyhs₁:τ₁ <: σ₁hs₂:σ₂ <: τ₂h₂:<{ σ₁ → σ₂ }> <: <{ τ₁ → τ₂ }>σ₁':Tyσ₂':Tyhs₁':σ₁ <: σ₁'hs₂':σ₂' <: σ₂h₁:<{ σ₁' → σ₂' }> <: <{ σ₁ → σ₂ }>⊢ ∃ σ₁ σ₂, <{ σ₁' → σ₂' }> = <{ σ₁ → σ₂ }> ∧ τ₁ <: σ₁ ∧ σ₂ <: τ₂
        exists σ₁', σ₂'transσ:Tyτ:Tyτ₁:Tyτ₂:Tyσ₁:Tyσ₂:Tyhs₁:τ₁ <: σ₁hs₂:σ₂ <: τ₂h₂:<{ σ₁ → σ₂ }> <: <{ τ₁ → τ₂ }>σ₁':Tyσ₂':Tyhs₁':σ₁ <: σ₁'hs₂':σ₂' <: σ₂h₁:<{ σ₁' → σ₂' }> <: <{ σ₁ → σ₂ }>⊢ <{ σ₁' → σ₂' }> = <{ σ₁' → σ₂' }> ∧ τ₁ <: σ₁' ∧ σ₂' <: τ₂; constructortrans.leftσ:Tyτ:Tyτ₁:Tyτ₂:Tyσ₁:Tyσ₂:Tyhs₁:τ₁ <: σ₁hs₂:σ₂ <: τ₂h₂:<{ σ₁ → σ₂ }> <: <{ τ₁ → τ₂ }>σ₁':Tyσ₂':Tyhs₁':σ₁ <: σ₁'hs₂':σ₂' <: σ₂h₁:<{ σ₁' → σ₂' }> <: <{ σ₁ → σ₂ }>⊢ <{ σ₁' → σ₂' }> = <{ σ₁' → σ₂' }>trans.rightσ:Tyτ:Tyτ₁:Tyτ₂:Tyσ₁:Tyσ₂:Tyhs₁:τ₁ <: σ₁hs₂:σ₂ <: τ₂h₂:<{ σ₁ → σ₂ }> <: <{ τ₁ → τ₂ }>σ₁':Tyσ₂':Tyhs₁':σ₁ <: σ₁'hs₂':σ₂' <: σ₂h₁:<{ σ₁' → σ₂' }> <: <{ σ₁ → σ₂ }>⊢ τ₁ <: σ₁' ∧ σ₂' <: τ₂; rfltrans.rightσ:Tyτ:Tyτ₁:Tyτ₂:Tyσ₁:Tyσ₂:Tyhs₁:τ₁ <: σ₁hs₂:σ₂ <: τ₂h₂:<{ σ₁ → σ₂ }> <: <{ τ₁ → τ₂ }>σ₁':Tyσ₂':Tyhs₁':σ₁ <: σ₁'hs₂':σ₂' <: σ₂h₁:<{ σ₁' → σ₂' }> <: <{ σ₁ → σ₂ }>⊢ τ₁ <: σ₁' ∧ σ₂' <: τ₂; constructortrans.right.leftσ:Tyτ:Tyτ₁:Tyτ₂:Tyσ₁:Tyσ₂:Tyhs₁:τ₁ <: σ₁hs₂:σ₂ <: τ₂h₂:<{ σ₁ → σ₂ }> <: <{ τ₁ → τ₂ }>σ₁':Tyσ₂':Tyhs₁':σ₁ <: σ₁'hs₂':σ₂' <: σ₂h₁:<{ σ₁' → σ₂' }> <: <{ σ₁ → σ₂ }>⊢ τ₁ <: σ₁'trans.right.rightσ:Tyτ:Tyτ₁:Tyτ₂:Tyσ₁:Tyσ₂:Tyhs₁:τ₁ <: σ₁hs₂:σ₂ <: τ₂h₂:<{ σ₁ → σ₂ }> <: <{ τ₁ → τ₂ }>σ₁':Tyσ₂':Tyhs₁':σ₁ <: σ₁'hs₂':σ₂' <: σ₂h₁:<{ σ₁' → σ₂' }> <: <{ σ₁ → σ₂ }>⊢ σ₂' <: τ₂
        ·trans.right.leftσ:Tyτ:Tyτ₁:Tyτ₂:Tyσ₁:Tyσ₂:Tyhs₁:τ₁ <: σ₁hs₂:σ₂ <: τ₂h₂:<{ σ₁ → σ₂ }> <: <{ τ₁ → τ₂ }>σ₁':Tyσ₂':Tyhs₁':σ₁ <: σ₁'hs₂':σ₂' <: σ₂h₁:<{ σ₁' → σ₂' }> <: <{ σ₁ → σ₂ }>⊢ τ₁ <: σ₁' exact Subtype.trans hs₁ hs₁'All goals completed! 🐙
        ·trans.right.rightσ:Tyτ:Tyτ₁:Tyτ₂:Tyσ₁:Tyσ₂:Tyhs₁:τ₁ <: σ₁hs₂:σ₂ <: τ₂h₂:<{ σ₁ → σ₂ }> <: <{ τ₁ → τ₂ }>σ₁':Tyσ₂':Tyhs₁':σ₁ <: σ₁'hs₂':σ₂' <: σ₂h₁:<{ σ₁' → σ₂' }> <: <{ σ₁ → σ₂ }>⊢ σ₂' <: τ₂ exact Subtype.trans hs₂' hs₂All goals completed! 🐙

There are additional inversion lemmas for the other types:

Unit is the only subtype of Unit, and
Base n is the only subtype of Base n, and
⊤ is the only supertype of ⊤.

Exercise★★(sub_inversion_unit) (Optional)

theorem sub_inversion_unit {τ : Ty} (h : τ <: <{ Unit }>) : τ = Ty.unit := byτ:Tyh:τ <: <{ Unit }>⊢ τ = <{ Unit }>
  solution!
    generalize heq : Ty.unit = σ at hτ:Tyσ:Tyheq:<{ Unit }> = σh:τ <: σ⊢ τ = σ
    induction h with (subst_varsprodτ:Tyσ:Tyσ₁✝:Tyσ₂✝:Tyτ₁✝:Tyτ₂✝:Tyh₁✝:σ₁✝ <: τ₁✝h₂✝:σ₂✝ <: τ₂✝h₁_ih✝:<{ Unit }> = τ₁✝ → σ₁✝ = τ₁✝h₂_ih✝:<{ Unit }> = τ₂✝ → σ₂✝ = τ₂✝heq:<{ Unit }> = <{ τ₁✝ × τ₂✝ }>⊢ <{ σ₁✝ × σ₂✝ }> = <{ τ₁✝ × τ₂✝ }>; try contradictionAll goals completed! 🐙)
    | refl =>reflτ:Tyσ:Ty⊢ <{ Unit }> = <{ Unit }> rflAll goals completed! 🐙
    | trans h₁ h₂ ih₁ ih₂ =>transτ:Tyσ:Tyσ✝:Tyυ✝:Tyh₁:σ✝ <: υ✝ih₁:<{ Unit }> = υ✝ → σ✝ = υ✝h₂:υ✝ <: <{ Unit }>ih₂:<{ Unit }> = <{ Unit }> → υ✝ = <{ Unit }>⊢ σ✝ = <{ Unit }>
        rw [ih₁transτ:Tyσ:Tyσ✝:Tyυ✝:Tyh₁:σ✝ <: υ✝ih₁:<{ Unit }> = υ✝ → σ✝ = υ✝h₂:υ✝ <: <{ Unit }>ih₂:<{ Unit }> = <{ Unit }> → υ✝ = <{ Unit }>⊢ υ✝ = <{ Unit }>transτ:Tyσ:Tyσ✝:Tyυ✝:Tyh₁:σ✝ <: υ✝ih₁:<{ Unit }> = υ✝ → σ✝ = υ✝h₂:υ✝ <: <{ Unit }>ih₂:<{ Unit }> = <{ Unit }> → υ✝ = <{ Unit }>⊢ <{ Unit }> = υ✝]transτ:Tyσ:Tyσ✝:Tyυ✝:Tyh₁:σ✝ <: υ✝ih₁:<{ Unit }> = υ✝ → σ✝ = υ✝h₂:υ✝ <: <{ Unit }>ih₂:<{ Unit }> = <{ Unit }> → υ✝ = <{ Unit }>⊢ υ✝ = <{ Unit }>transτ:Tyσ:Tyσ✝:Tyυ✝:Tyh₁:σ✝ <: υ✝ih₁:<{ Unit }> = υ✝ → σ✝ = υ✝h₂:υ✝ <: <{ Unit }>ih₂:<{ Unit }> = <{ Unit }> → υ✝ = <{ Unit }>⊢ <{ Unit }> = υ✝; apply ih₂ rfltransτ:Tyσ:Tyσ✝:Tyυ✝:Tyh₁:σ✝ <: υ✝ih₁:<{ Unit }> = υ✝ → σ✝ = υ✝h₂:υ✝ <: <{ Unit }>ih₂:<{ Unit }> = <{ Unit }> → υ✝ = <{ Unit }>⊢ <{ Unit }> = υ✝
        symmtransτ:Tyσ:Tyσ✝:Tyυ✝:Tyh₁:σ✝ <: υ✝ih₁:<{ Unit }> = υ✝ → σ✝ = υ✝h₂:υ✝ <: <{ Unit }>ih₂:<{ Unit }> = <{ Unit }> → υ✝ = <{ Unit }>⊢ υ✝ = <{ Unit }>; apply ih₂ rflAll goals completed! 🐙

Exercise★★(sub_inversion_base) (Optional)

theorem sub_inversion_base {τ : Ty} {s : String} (h : τ <: Ty.base s) : τ = Ty.base s := byτ:Tys:Stringh:τ <: (s)⊢ τ = (s)
  solution!
    generalize heq : Ty.base s = σ at hτ:Tys:Stringσ:Tyheq:(s) = σh:τ <: σ⊢ τ = σ
    induction h with (subst_varsprodτ:Tys:Stringσ:Tyσ₁✝:Tyσ₂✝:Tyτ₁✝:Tyτ₂✝:Tyh₁✝:σ₁✝ <: τ₁✝h₂✝:σ₂✝ <: τ₂✝h₁_ih✝:(s) = τ₁✝ → σ₁✝ = τ₁✝h₂_ih✝:(s) = τ₂✝ → σ₂✝ = τ₂✝heq:(s) = <{ τ₁✝ × τ₂✝ }>⊢ <{ σ₁✝ × σ₂✝ }> = <{ τ₁✝ × τ₂✝ }>; try contradictionAll goals completed! 🐙)
    | refl =>reflτ:Tys:Stringσ:Ty⊢ (s) = (s) rflAll goals completed! 🐙
    | trans h₁ h₂ ih₁ ih₂ =>transτ:Tys:Stringσ:Tyσ✝:Tyυ✝:Tyh₁:σ✝ <: υ✝ih₁:(s) = υ✝ → σ✝ = υ✝h₂:υ✝ <: (s)ih₂:(s) = (s) → υ✝ = (s)⊢ σ✝ = (s)
        rw [ih₁transτ:Tys:Stringσ:Tyσ✝:Tyυ✝:Tyh₁:σ✝ <: υ✝ih₁:(s) = υ✝ → σ✝ = υ✝h₂:υ✝ <: (s)ih₂:(s) = (s) → υ✝ = (s)⊢ υ✝ = (s)transτ:Tys:Stringσ:Tyσ✝:Tyυ✝:Tyh₁:σ✝ <: υ✝ih₁:(s) = υ✝ → σ✝ = υ✝h₂:υ✝ <: (s)ih₂:(s) = (s) → υ✝ = (s)⊢ (s) = υ✝]transτ:Tys:Stringσ:Tyσ✝:Tyυ✝:Tyh₁:σ✝ <: υ✝ih₁:(s) = υ✝ → σ✝ = υ✝h₂:υ✝ <: (s)ih₂:(s) = (s) → υ✝ = (s)⊢ υ✝ = (s)transτ:Tys:Stringσ:Tyσ✝:Tyυ✝:Tyh₁:σ✝ <: υ✝ih₁:(s) = υ✝ → σ✝ = υ✝h₂:υ✝ <: (s)ih₂:(s) = (s) → υ✝ = (s)⊢ (s) = υ✝; apply ih₂ rfltransτ:Tys:Stringσ:Tyσ✝:Tyυ✝:Tyh₁:σ✝ <: υ✝ih₁:(s) = υ✝ → σ✝ = υ✝h₂:υ✝ <: (s)ih₂:(s) = (s) → υ✝ = (s)⊢ (s) = υ✝
        symmtransτ:Tys:Stringσ:Tyσ✝:Tyυ✝:Tyh₁:σ✝ <: υ✝ih₁:(s) = υ✝ → σ✝ = υ✝h₂:υ✝ <: (s)ih₂:(s) = (s) → υ✝ = (s)⊢ υ✝ = (s); apply ih₂ rflAll goals completed! 🐙

Exercise★★(sub_inversion_top) (Optional)

theorem sub_inversion_top {τ : Ty} (h : Ty.top <: τ) : τ = Ty.top := byτ:Tyh:<{ ⊤ }> <: τ⊢ τ = <{ ⊤ }>
  solution!
    generalize heq : Ty.top = σ at hτ:Tyσ:Tyheq:<{ ⊤ }> = σh:σ <: τ⊢ τ = σ
    induction h with (subst_varsprodτ:Tyσ:Tyσ₁✝:Tyσ₂✝:Tyτ₁✝:Tyτ₂✝:Tyh₁✝:σ₁✝ <: τ₁✝h₂✝:σ₂✝ <: τ₂✝h₁_ih✝:<{ ⊤ }> = σ₁✝ → τ₁✝ = σ₁✝h₂_ih✝:<{ ⊤ }> = σ₂✝ → τ₂✝ = σ₂✝heq:<{ ⊤ }> = <{ σ₁✝ × σ₂✝ }>⊢ <{ τ₁✝ × τ₂✝ }> = <{ σ₁✝ × σ₂✝ }>; try contradictionAll goals completed! 🐙)
    | refl =>reflτ:Tyσ:Ty⊢ <{ ⊤ }> = <{ ⊤ }> rflAll goals completed! 🐙
    | top =>topτ:Tyσ:Ty⊢ <{ ⊤ }> = <{ ⊤ }> rflAll goals completed! 🐙
    | trans h₁ h₂ ih₁ ih₂ =>transτ:Tyσ:Tyυ✝:Tyτ✝:Tyh₂:υ✝ <: τ✝ih₂:<{ ⊤ }> = υ✝ → τ✝ = υ✝h₁:<{ ⊤ }> <: υ✝ih₁:<{ ⊤ }> = <{ ⊤ }> → υ✝ = <{ ⊤ }>⊢ τ✝ = <{ ⊤ }>
        rw [ih₂transτ:Tyσ:Tyυ✝:Tyτ✝:Tyh₂:υ✝ <: τ✝ih₂:<{ ⊤ }> = υ✝ → τ✝ = υ✝h₁:<{ ⊤ }> <: υ✝ih₁:<{ ⊤ }> = <{ ⊤ }> → υ✝ = <{ ⊤ }>⊢ υ✝ = <{ ⊤ }>transτ:Tyσ:Tyυ✝:Tyτ✝:Tyh₂:υ✝ <: τ✝ih₂:<{ ⊤ }> = υ✝ → τ✝ = υ✝h₁:<{ ⊤ }> <: υ✝ih₁:<{ ⊤ }> = <{ ⊤ }> → υ✝ = <{ ⊤ }>⊢ <{ ⊤ }> = υ✝]transτ:Tyσ:Tyυ✝:Tyτ✝:Tyh₂:υ✝ <: τ✝ih₂:<{ ⊤ }> = υ✝ → τ✝ = υ✝h₁:<{ ⊤ }> <: υ✝ih₁:<{ ⊤ }> = <{ ⊤ }> → υ✝ = <{ ⊤ }>⊢ υ✝ = <{ ⊤ }>transτ:Tyσ:Tyυ✝:Tyτ✝:Tyh₂:υ✝ <: τ✝ih₂:<{ ⊤ }> = υ✝ → τ✝ = υ✝h₁:<{ ⊤ }> <: υ✝ih₁:<{ ⊤ }> = <{ ⊤ }> → υ✝ = <{ ⊤ }>⊢ <{ ⊤ }> = υ✝; apply ih₁ rfltransτ:Tyσ:Tyυ✝:Tyτ✝:Tyh₂:υ✝ <: τ✝ih₂:<{ ⊤ }> = υ✝ → τ✝ = υ✝h₁:<{ ⊤ }> <: υ✝ih₁:<{ ⊤ }> = <{ ⊤ }> → υ✝ = <{ ⊤ }>⊢ <{ ⊤ }> = υ✝
        symmtransτ:Tyσ:Tyυ✝:Tyτ✝:Tyh₂:υ✝ <: τ✝ih₂:<{ ⊤ }> = υ✝ → τ✝ = υ✝h₁:<{ ⊤ }> <: υ✝ih₁:<{ ⊤ }> = <{ ⊤ }> → υ✝ = <{ ⊤ }>⊢ υ✝ = <{ ⊤ }>; apply ih₁ rflAll goals completed! 🐙

When you do the products exercise, add your inversion lemma for products here:

theorem sub_inversion_prod {σ τ₁ τ₂ : Ty} (h : σ <: <{ ~τ₁ × ~τ₂ }>) :
     ∃ σ₁ σ₂, σ = <{ ~σ₁ × ~σ₂ }> ∧ σ₁ <: τ₁ ∧ σ₂ <: τ₂ := byσ:Tyτ₁:Tyτ₂:Tyh:σ <: <{ τ₁ × τ₂ }>⊢ ∃ σ₁ σ₂, σ = <{ σ₁ × σ₂ }> ∧ σ₁ <: τ₁ ∧ σ₂ <: τ₂
  solution!
    generalize heq : <{ ~τ₁ × ~τ₂ }> = V at hσ:Tyτ₁:Tyτ₂:TyV:Tyheq:<{ τ₁ × τ₂ }> = Vh:σ <: V⊢ ∃ σ₁ σ₂, σ = <{ σ₁ × σ₂ }> ∧ σ₁ <: τ₁ ∧ σ₂ <: τ₂
    induction h generalizing τ₁ τ₂ with (subst_varsarrowσ:TyV:Tyσ₁✝:Tyσ₂✝:Tyτ₁✝:Tyτ₂✝:Tyh₁✝:τ₁✝ <: σ₁✝h₂✝:σ₂✝ <: τ₂✝h₁_ih✝:∀ {τ₁ τ₂ : Ty}, <{ τ₁ × τ₂ }> = σ₁✝ → ∃ σ₁ σ₂, τ₁✝ = <{ σ₁ × σ₂ }> ∧ σ₁ <: τ₁ ∧ σ₂ <: τ₂h₂_ih✝:∀ {τ₁ τ₂ : Ty}, <{ τ₁ × τ₂ }> = τ₂✝ → ∃ σ₁ σ₂, σ₂✝ = <{ σ₁ × σ₂ }> ∧ σ₁ <: τ₁ ∧ σ₂ <: τ₂τ₁:Tyτ₂:Tyheq:<{ τ₁ × τ₂ }> = <{ τ₁✝ → τ₂✝ }>⊢ ∃ σ₁ σ₂, <{ σ₁✝ → σ₂✝ }> = <{ σ₁ × σ₂ }> ∧ σ₁ <: τ₁ ∧ σ₂ <: τ₂; try contradictionAll goals completed! 🐙)
    | refl =>reflσ:TyV:Tyτ₁:Tyτ₂:Ty⊢ ∃ σ₁ σ₂, <{ τ₁ × τ₂ }> = <{ σ₁ × σ₂ }> ∧ σ₁ <: τ₁ ∧ σ₂ <: τ₂
        exists τ₁, τ₂reflσ:TyV:Tyτ₁:Tyτ₂:Ty⊢ <{ τ₁ × τ₂ }> = <{ τ₁ × τ₂ }> ∧ τ₁ <: τ₁ ∧ τ₂ <: τ₂; constructorrefl.leftσ:TyV:Tyτ₁:Tyτ₂:Ty⊢ <{ τ₁ × τ₂ }> = <{ τ₁ × τ₂ }>refl.rightσ:TyV:Tyτ₁:Tyτ₂:Ty⊢ τ₁ <: τ₁ ∧ τ₂ <: τ₂; rflrefl.rightσ:TyV:Tyτ₁:Tyτ₂:Ty⊢ τ₁ <: τ₁ ∧ τ₂ <: τ₂
        constructorrefl.right.leftσ:TyV:Tyτ₁:Tyτ₂:Ty⊢ τ₁ <: τ₁refl.right.rightσ:TyV:Tyτ₁:Tyτ₂:Ty⊢ τ₂ <: τ₂ <;>refl.right.leftσ:TyV:Tyτ₁:Tyτ₂:Ty⊢ τ₁ <: τ₁refl.right.rightσ:TyV:Tyτ₁:Tyτ₂:Ty⊢ τ₂ <: τ₂ constructorAll goals completed! 🐙
    | @prod σ₁ σ₂ _ _ h₁ h₂ ih₁ ih₂ =>prodσ:TyV:Tyσ₁:Tyσ₂:Tyτ₁✝:Tyτ₂✝:Tyh₁:σ₁ <: τ₁✝h₂:σ₂ <: τ₂✝ih₁:∀ {τ₁ τ₂ : Ty}, <{ τ₁ × τ₂ }> = τ₁✝ → ∃ σ₁_1 σ₂, σ₁ = <{ σ₁_1 × σ₂ }> ∧ σ₁_1 <: τ₁ ∧ σ₂ <: τ₂ih₂:∀ {τ₁ τ₂ : Ty}, <{ τ₁ × τ₂ }> = τ₂✝ → ∃ σ₁ σ₂_1, σ₂ = <{ σ₁ × σ₂_1 }> ∧ σ₁ <: τ₁ ∧ σ₂_1 <: τ₂τ₁:Tyτ₂:Tyheq:<{ τ₁ × τ₂ }> = <{ τ₁✝ × τ₂✝ }>⊢ ∃ σ₁_1 σ₂_1, <{ σ₁ × σ₂ }> = <{ σ₁_1 × σ₂_1 }> ∧ σ₁_1 <: τ₁ ∧ σ₂_1 <: τ₂
        inversion heqreflσ:TyV:Tyσ₁:Tyσ₂:Tyτ₁✝:Tyτ₂✝:Tyh₁:σ₁ <: τ₁✝h₂:σ₂ <: τ₂✝ih₁:∀ {τ₁ τ₂ : Ty}, <{ τ₁ × τ₂ }> = τ₁✝ → ∃ σ₁_1 σ₂, σ₁ = <{ σ₁_1 × σ₂ }> ∧ σ₁_1 <: τ₁ ∧ σ₂ <: τ₂ih₂:∀ {τ₁ τ₂ : Ty}, <{ τ₁ × τ₂ }> = τ₂✝ → ∃ σ₁ σ₂_1, σ₂ = <{ σ₁ × σ₂_1 }> ∧ σ₁ <: τ₁ ∧ σ₂_1 <: τ₂⊢ ∃ σ₁_1 σ₂_1, <{ σ₁ × σ₂ }> = <{ σ₁_1 × σ₂_1 }> ∧ σ₁_1 <: τ₁✝ ∧ σ₂_1 <: τ₂✝; exists σ₁, σ₂All goals completed! 🐙
    | trans h₁ h₂ ih₁ ih₂ =>transσ:TyV:Tyσ✝:Tyυ✝:Tyh₁:σ✝ <: υ✝ih₁:∀ {τ₁ τ₂ : Ty}, <{ τ₁ × τ₂ }> = υ✝ → ∃ σ₁ σ₂, σ✝ = <{ σ₁ × σ₂ }> ∧ σ₁ <: τ₁ ∧ σ₂ <: τ₂τ₁:Tyτ₂:Tyh₂:υ✝ <: <{ τ₁ × τ₂ }>ih₂:∀ {τ₁_1 τ₂_1 : Ty}, <{ τ₁_1 × τ₂_1 }> = <{ τ₁ × τ₂ }> → ∃ σ₁ σ₂, υ✝ = <{ σ₁ × σ₂ }> ∧ σ₁ <: τ₁_1 ∧ σ₂ <: τ₂_1⊢ ∃ σ₁ σ₂, σ✝ = <{ σ₁ × σ₂ }> ∧ σ₁ <: τ₁ ∧ σ₂ <: τ₂
        obtain ⟨σ₁, σ₂, _, hs₁, hs₂⟩ := ih₂ rfltransσ:TyV:Tyσ✝:Tyυ✝:Tyh₁:σ✝ <: υ✝ih₁:∀ {τ₁ τ₂ : Ty}, <{ τ₁ × τ₂ }> = υ✝ → ∃ σ₁ σ₂, σ✝ = <{ σ₁ × σ₂ }> ∧ σ₁ <: τ₁ ∧ σ₂ <: τ₂τ₁:Tyτ₂:Tyh₂:υ✝ <: <{ τ₁ × τ₂ }>ih₂:∀ {τ₁_1 τ₂_1 : Ty}, <{ τ₁_1 × τ₂_1 }> = <{ τ₁ × τ₂ }> → ∃ σ₁ σ₂, υ✝ = <{ σ₁ × σ₂ }> ∧ σ₁ <: τ₁_1 ∧ σ₂ <: τ₂_1σ₁:Tyσ₂:Tyleft✝:υ✝ = <{ σ₁ × σ₂ }>hs₁:σ₁ <: τ₁hs₂:σ₂ <: τ₂⊢ ∃ σ₁ σ₂, σ✝ = <{ σ₁ × σ₂ }> ∧ σ₁ <: τ₁ ∧ σ₂ <: τ₂; clear ih₂transσ:TyV:Tyσ✝:Tyυ✝:Tyh₁:σ✝ <: υ✝ih₁:∀ {τ₁ τ₂ : Ty}, <{ τ₁ × τ₂ }> = υ✝ → ∃ σ₁ σ₂, σ✝ = <{ σ₁ × σ₂ }> ∧ σ₁ <: τ₁ ∧ σ₂ <: τ₂τ₁:Tyτ₂:Tyh₂:υ✝ <: <{ τ₁ × τ₂ }>σ₁:Tyσ₂:Tyleft✝:υ✝ = <{ σ₁ × σ₂ }>hs₁:σ₁ <: τ₁hs₂:σ₂ <: τ₂⊢ ∃ σ₁ σ₂, σ✝ = <{ σ₁ × σ₂ }> ∧ σ₁ <: τ₁ ∧ σ₂ <: τ₂; subst_varstransσ:TyV:Tyσ✝:Tyτ₁:Tyτ₂:Tyσ₁:Tyσ₂:Tyhs₁:σ₁ <: τ₁hs₂:σ₂ <: τ₂h₁:σ✝ <: <{ σ₁ × σ₂ }>ih₁:∀ {τ₁ τ₂ : Ty}, <{ τ₁ × τ₂ }> = <{ σ₁ × σ₂ }> → ∃ σ₁ σ₂, σ✝ = <{ σ₁ × σ₂ }> ∧ σ₁ <: τ₁ ∧ σ₂ <: τ₂h₂:<{ σ₁ × σ₂ }> <: <{ τ₁ × τ₂ }>⊢ ∃ σ₁ σ₂, σ✝ = <{ σ₁ × σ₂ }> ∧ σ₁ <: τ₁ ∧ σ₂ <: τ₂
        obtain ⟨σ₁', σ₂', _, hs₁', hs₂'⟩ := ih₁ rfltransσ:TyV:Tyσ✝:Tyτ₁:Tyτ₂:Tyσ₁:Tyσ₂:Tyhs₁:σ₁ <: τ₁hs₂:σ₂ <: τ₂h₁:σ✝ <: <{ σ₁ × σ₂ }>ih₁:∀ {τ₁ τ₂ : Ty}, <{ τ₁ × τ₂ }> = <{ σ₁ × σ₂ }> → ∃ σ₁ σ₂, σ✝ = <{ σ₁ × σ₂ }> ∧ σ₁ <: τ₁ ∧ σ₂ <: τ₂h₂:<{ σ₁ × σ₂ }> <: <{ τ₁ × τ₂ }>σ₁':Tyσ₂':Tyleft✝:σ✝ = <{ σ₁' × σ₂' }>hs₁':σ₁' <: σ₁hs₂':σ₂' <: σ₂⊢ ∃ σ₁ σ₂, σ✝ = <{ σ₁ × σ₂ }> ∧ σ₁ <: τ₁ ∧ σ₂ <: τ₂; subst_varstransσ:TyV:Tyτ₁:Tyτ₂:Tyσ₁:Tyσ₂:Tyhs₁:σ₁ <: τ₁hs₂:σ₂ <: τ₂h₂:<{ σ₁ × σ₂ }> <: <{ τ₁ × τ₂ }>σ₁':Tyσ₂':Tyhs₁':σ₁' <: σ₁hs₂':σ₂' <: σ₂h₁:<{ σ₁' × σ₂' }> <: <{ σ₁ × σ₂ }>ih₁:∀ {τ₁ τ₂ : Ty}, <{ τ₁ × τ₂ }> = <{ σ₁ × σ₂ }> → ∃ σ₁ σ₂, <{ σ₁' × σ₂' }> = <{ σ₁ × σ₂ }> ∧ σ₁ <: τ₁ ∧ σ₂ <: τ₂⊢ ∃ σ₁ σ₂, <{ σ₁' × σ₂' }> = <{ σ₁ × σ₂ }> ∧ σ₁ <: τ₁ ∧ σ₂ <: τ₂; clear ih₁transσ:TyV:Tyτ₁:Tyτ₂:Tyσ₁:Tyσ₂:Tyhs₁:σ₁ <: τ₁hs₂:σ₂ <: τ₂h₂:<{ σ₁ × σ₂ }> <: <{ τ₁ × τ₂ }>σ₁':Tyσ₂':Tyhs₁':σ₁' <: σ₁hs₂':σ₂' <: σ₂h₁:<{ σ₁' × σ₂' }> <: <{ σ₁ × σ₂ }>⊢ ∃ σ₁ σ₂, <{ σ₁' × σ₂' }> = <{ σ₁ × σ₂ }> ∧ σ₁ <: τ₁ ∧ σ₂ <: τ₂
        exists σ₁', σ₂'transσ:TyV:Tyτ₁:Tyτ₂:Tyσ₁:Tyσ₂:Tyhs₁:σ₁ <: τ₁hs₂:σ₂ <: τ₂h₂:<{ σ₁ × σ₂ }> <: <{ τ₁ × τ₂ }>σ₁':Tyσ₂':Tyhs₁':σ₁' <: σ₁hs₂':σ₂' <: σ₂h₁:<{ σ₁' × σ₂' }> <: <{ σ₁ × σ₂ }>⊢ <{ σ₁' × σ₂' }> = <{ σ₁' × σ₂' }> ∧ σ₁' <: τ₁ ∧ σ₂' <: τ₂; constructortrans.leftσ:TyV:Tyτ₁:Tyτ₂:Tyσ₁:Tyσ₂:Tyhs₁:σ₁ <: τ₁hs₂:σ₂ <: τ₂h₂:<{ σ₁ × σ₂ }> <: <{ τ₁ × τ₂ }>σ₁':Tyσ₂':Tyhs₁':σ₁' <: σ₁hs₂':σ₂' <: σ₂h₁:<{ σ₁' × σ₂' }> <: <{ σ₁ × σ₂ }>⊢ <{ σ₁' × σ₂' }> = <{ σ₁' × σ₂' }>trans.rightσ:TyV:Tyτ₁:Tyτ₂:Tyσ₁:Tyσ₂:Tyhs₁:σ₁ <: τ₁hs₂:σ₂ <: τ₂h₂:<{ σ₁ × σ₂ }> <: <{ τ₁ × τ₂ }>σ₁':Tyσ₂':Tyhs₁':σ₁' <: σ₁hs₂':σ₂' <: σ₂h₁:<{ σ₁' × σ₂' }> <: <{ σ₁ × σ₂ }>⊢ σ₁' <: τ₁ ∧ σ₂' <: τ₂; rfltrans.rightσ:TyV:Tyτ₁:Tyτ₂:Tyσ₁:Tyσ₂:Tyhs₁:σ₁ <: τ₁hs₂:σ₂ <: τ₂h₂:<{ σ₁ × σ₂ }> <: <{ τ₁ × τ₂ }>σ₁':Tyσ₂':Tyhs₁':σ₁' <: σ₁hs₂':σ₂' <: σ₂h₁:<{ σ₁' × σ₂' }> <: <{ σ₁ × σ₂ }>⊢ σ₁' <: τ₁ ∧ σ₂' <: τ₂; constructortrans.right.leftσ:TyV:Tyτ₁:Tyτ₂:Tyσ₁:Tyσ₂:Tyhs₁:σ₁ <: τ₁hs₂:σ₂ <: τ₂h₂:<{ σ₁ × σ₂ }> <: <{ τ₁ × τ₂ }>σ₁':Tyσ₂':Tyhs₁':σ₁' <: σ₁hs₂':σ₂' <: σ₂h₁:<{ σ₁' × σ₂' }> <: <{ σ₁ × σ₂ }>⊢ σ₁' <: τ₁trans.right.rightσ:TyV:Tyτ₁:Tyτ₂:Tyσ₁:Tyσ₂:Tyhs₁:σ₁ <: τ₁hs₂:σ₂ <: τ₂h₂:<{ σ₁ × σ₂ }> <: <{ τ₁ × τ₂ }>σ₁':Tyσ₂':Tyhs₁':σ₁' <: σ₁hs₂':σ₂' <: σ₂h₁:<{ σ₁' × σ₂' }> <: <{ σ₁ × σ₂ }>⊢ σ₂' <: τ₂
        ·trans.right.leftσ:TyV:Tyτ₁:Tyτ₂:Tyσ₁:Tyσ₂:Tyhs₁:σ₁ <: τ₁hs₂:σ₂ <: τ₂h₂:<{ σ₁ × σ₂ }> <: <{ τ₁ × τ₂ }>σ₁':Tyσ₂':Tyhs₁':σ₁' <: σ₁hs₂':σ₂' <: σ₂h₁:<{ σ₁' × σ₂' }> <: <{ σ₁ × σ₂ }>⊢ σ₁' <: τ₁ exact Subtype.trans hs₁' hs₁All goals completed! 🐙
        ·trans.right.rightσ:TyV:Tyτ₁:Tyτ₂:Tyσ₁:Tyσ₂:Tyhs₁:σ₁ <: τ₁hs₂:σ₂ <: τ₂h₂:<{ σ₁ × σ₂ }> <: <{ τ₁ × τ₂ }>σ₁':Tyσ₂':Tyhs₁':σ₁' <: σ₁hs₂':σ₂' <: σ₂h₁:<{ σ₁' × σ₂' }> <: <{ σ₁ × σ₂ }>⊢ σ₂' <: τ₂ exact Subtype.trans hs₂' hs₂All goals completed! 🐙

8.3.2. Canonical Forms🔗

The proof of the progress theorem -- that a well-typed non-value can always take a step -- doesn't need to change too much: we just need one small refinement. When we're considering the case where the term in question is an application t₁ t₂ where both t₁ and t₂ are values, we need to know that t₁ has the form of a lambda-abstraction, so that we can apply the abs reduction rule. In the ordinary STLC, this is obvious: we know that t₁ has a function type τ₁₁→τ₁₂, and there is only one rule that can be used to give a function type to a value - rule abs - and the form of the conclusion of this rule forces t₁ to be an abstraction.

In the STLC with subtyping, this reasoning doesn't quite work because there's another rule that can be used to show that a value has a function type: subsumption. Fortunately, this possibility doesn't change things much: if the last rule used to show Γ ⊢ t₁ ⦂ τ₁₁→τ₁₂ is subsumption, then there is some sub-derivation whose subject is also t₁, and we can reason by induction until we finally bottom out at a use of abs.

This bit of reasoning is packaged up in the following lemma, which tells us the possible "canonical forms" (i.e., values) of function type.

Exercise★★★(canonical_forms_of_arrow_types) (Optional)

theorem canonical_forms_of_arrow_types {Γ : Context} {t : Tm} {τ₁ τ₂ : Ty}
  (ht : <{ ~Γ ⊢ ~t ⦂ ~τ₁ → ~τ₂ }>)
  (hv : t.IsValue) :
  ∃ x σ₁ t₂, t = <{λ ~x : ~σ₁ . ~t₂}> := byΓ:Contextt:Tmτ₁:Tyτ₂:Tyht:<{ ~(Γ) ⊢ ~(t) ⦂ τ₁ → τ₂ }>hv:t.IsValue⊢ ∃ x σ₁ t₂, t = <{ λ ~x : σ₁ . t₂ }>
  solution!
    generalize heq : <{ ~τ₁ → ~τ₂ }> = τ at htΓ:Contextt:Tmτ₁:Tyτ₂:Tyhv:t.IsValueτ:Tyheq:<{ τ₁ → τ₂ }> = τht:<{ ~(Γ) ⊢ ~(t) ⦂ ~(τ) }>⊢ ∃ x σ₁ t₂, t = <{ λ ~x : σ₁ . t₂ }>
    induction ht generalizing τ₁ τ₂ with (subst_varssndΓ:Contextt:Tmτ:TyΓ✝:Contextt✝:Tmτ₁✝:Tyτ₁:Tyτ₂:Tyhv:<{ snd t✝ }>.IsValueh✝:<{ ~(Γ✝) ⊢ ~(t✝) ⦂ τ₁✝ × τ₁ → τ₂ }>h_ih✝:∀ {τ₁_1 τ₂_1 : Ty}, t✝.IsValue → <{ τ₁_1 → τ₂_1 }> = <{ τ₁✝ × τ₁ → τ₂ }> → ∃ x σ₁ t₂, t✝ = <{ λ ~x : σ₁ . t₂ }>⊢ ∃ x σ₁ t₂, <{ snd t✝ }> = <{ λ ~x : σ₁ . t₂ }>; try contradictionAll goals completed! 🐙)
    | abs Γ x τ₁ τ₂ t₁ h ih =>absΓ✝:Contextt:Tmτ:TyΓ:Contextx:Stringτ₁✝:Tyτ₂✝:Tyt₁:Tmh:<{ ~(x →ₚ τ₂✝ ; Γ) ⊢ ~(t₁) ⦂ ~(τ₁✝) }>ih:∀ {τ₁ τ₂ : Ty}, t₁.IsValue → <{ τ₁ → τ₂ }> = τ₁✝ → ∃ x σ₁ t₂, t₁ = <{ λ ~x : σ₁ . t₂ }>τ₁:Tyτ₂:Tyhv:<{ λ ~x : τ₂✝ . t₁ }>.IsValueheq:<{ τ₁ → τ₂ }> = <{ τ₂✝ → τ₁✝ }>⊢ ∃ x_1 σ₁ t₂, <{ λ ~x : τ₂✝ . t₁ }> = <{ λ ~x_1 : σ₁ . t₂ }> inversion heqreflΓ✝:Contextt:Tmτ:TyΓ:Contextx:Stringτ₁:Tyτ₂:Tyt₁:Tmh:<{ ~(x →ₚ τ₂✝ ; Γ) ⊢ ~(t₁) ⦂ ~(τ₁✝) }>ih:∀ {τ₁ τ₂ : Ty}, t₁.IsValue → <{ τ₁ → τ₂ }> = τ₁✝ → ∃ x σ₁ t₂, t₁ = <{ λ ~x : σ₁ . t₂ }>hv:<{ λ ~x : τ₂✝ . t₁ }>.IsValue⊢ ∃ x_1 σ₁ t₂, <{ λ ~x : τ₂✝ . t₁ }> = <{ λ ~x_1 : σ₁ . t₂ }>; exists x, τ₂, t₁All goals completed! 🐙
    | sub Γ t₁ τ₁ τ₂ ht hs ih =>subΓ✝:Contextt:Tmτ:TyΓ:Contextt₁:Tmτ₁✝:Tyht:<{ ~(Γ) ⊢ ~(t₁) ⦂ ~(τ₁✝) }>ih:∀ {τ₁ τ₂ : Ty}, t₁.IsValue → <{ τ₁ → τ₂ }> = τ₁✝ → ∃ x σ₁ t₂, t₁ = <{ λ ~x : σ₁ . t₂ }>τ₁:Tyτ₂:Tyhv:t₁.IsValuehs:τ₁✝ <: <{ τ₁ → τ₂ }>⊢ ∃ x σ₁ t₂, t₁ = <{ λ ~x : σ₁ . t₂ }>
        obtain ⟨σ₁, σ₂, _, hs₁, hs₂⟩ := sub_inversion_arrow hssubΓ✝:Contextt:Tmτ:TyΓ:Contextt₁:Tmτ₁✝:Tyht:<{ ~(Γ) ⊢ ~(t₁) ⦂ ~(τ₁✝) }>ih:∀ {τ₁ τ₂ : Ty}, t₁.IsValue → <{ τ₁ → τ₂ }> = τ₁✝ → ∃ x σ₁ t₂, t₁ = <{ λ ~x : σ₁ . t₂ }>τ₁:Tyτ₂:Tyhv:t₁.IsValuehs:τ₁✝ <: <{ τ₁ → τ₂ }>σ₁:Tyσ₂:Tyleft✝:τ₁✝ = <{ σ₁ → σ₂ }>hs₁:τ₁ <: σ₁hs₂:σ₂ <: τ₂⊢ ∃ x σ₁ t₂, t₁ = <{ λ ~x : σ₁ . t₂ }>; subst_varssubΓ✝:Contextt:Tmτ:TyΓ:Contextt₁:Tmτ₁:Tyτ₂:Tyhv:t₁.IsValueσ₁:Tyσ₂:Tyhs₁:τ₁ <: σ₁hs₂:σ₂ <: τ₂ht:<{ ~(Γ) ⊢ ~(t₁) ⦂ σ₁ → σ₂ }>ih:∀ {τ₁ τ₂ : Ty}, t₁.IsValue → <{ τ₁ → τ₂ }> = <{ σ₁ → σ₂ }> → ∃ x σ₁ t₂, t₁ = <{ λ ~x : σ₁ . t₂ }>hs:<{ σ₁ → σ₂ }> <: <{ τ₁ → τ₂ }>⊢ ∃ x σ₁ t₂, t₁ = <{ λ ~x : σ₁ . t₂ }>
        exact ih hv rflAll goals completed! 🐙

Similarly, the canonical forms of type Bool are the constants tru and fls

theorem canonical_forms_of_bool {Γ : Context} {t : Tm}
  (ht : <{ ~Γ ⊢ ~t ⦂ Bool }>)
  (hv : t.IsValue) :
  t = Tm.tru ∨ t = Tm.fls := byΓ:Contextt:Tmht:<{ ~(Γ) ⊢ ~(t) ⦂ Bool }>hv:t.IsValue⊢ t = <{ true }> ∨ t = <{ false }>

  generalize heq : Ty.bool = τ at htΓ:Contextt:Tmhv:t.IsValueτ:Tyheq:<{ Bool }> = τht:<{ ~(Γ) ⊢ ~(t) ⦂ ~(τ) }>⊢ t = <{ true }> ∨ t = <{ false }>
  induction ht with (subst_varssndΓ:Contextt:Tmτ:TyΓ✝:Contextt✝:Tmτ₁✝:Tyhv:<{ snd t✝ }>.IsValueh✝:<{ ~(Γ✝) ⊢ ~(t✝) ⦂ τ₁✝ × Bool }>h_ih✝:t✝.IsValue → <{ Bool }> = <{ τ₁✝ × Bool }> → t✝ = <{ true }> ∨ t✝ = <{ false }>⊢ <{ snd t✝ }> = <{ true }> ∨ <{ snd t✝ }> = <{ false }>; first | trivialAll goals completed! 🐙 | try liaAll goals completed! 🐙)
  | sub Γ t₁ τ₁ τ₂ ht hs ih =>subΓ✝:Contextt:Tmτ:TyΓ:Contextt₁:Tmτ₁:Tyht:<{ ~(Γ) ⊢ ~(t₁) ⦂ ~(τ₁) }>ih:t₁.IsValue → <{ Bool }> = τ₁ → t₁ = <{ true }> ∨ t₁ = <{ false }>hv:t₁.IsValuehs:τ₁ <: <{ Bool }>⊢ t₁ = <{ true }> ∨ t₁ = <{ false }>
    apply sub_inversion_bool at hssubΓ✝:Contextt:Tmτ:TyΓ:Contextt₁:Tmτ₁:Tyht:<{ ~(Γ) ⊢ ~(t₁) ⦂ ~(τ₁) }>ih:t₁.IsValue → <{ Bool }> = τ₁ → t₁ = <{ true }> ∨ t₁ = <{ false }>hv:t₁.IsValuehs:τ₁ = <{ Bool }>⊢ t₁ = <{ true }> ∨ t₁ = <{ false }>; subst_varssubΓ✝:Contextt:Tmτ:TyΓ:Contextt₁:Tmhv:t₁.IsValueht:<{ ~(Γ) ⊢ ~(t₁) ⦂ Bool }>ih:t₁.IsValue → <{ Bool }> = <{ Bool }> → t₁ = <{ true }> ∨ t₁ = <{ false }>⊢ t₁ = <{ true }> ∨ t₁ = <{ false }>
    exact ih hv rflAll goals completed! 🐙

When you do the products exercise, add your canonical forms lemma for products here:

theorem canonical_forms_of_product_types {Γ : Context} {t : Tm} {τ₁ τ₂ : Ty}
  (ht : <{ ~Γ ⊢ ~t ⦂ ~τ₁ × ~τ₂ }>)
  (hv : t.IsValue) :
  ∃ t₁ t₂, t = <{ (~t₁, ~t₂) }> := byΓ:Contextt:Tmτ₁:Tyτ₂:Tyht:<{ ~(Γ) ⊢ ~(t) ⦂ τ₁ × τ₂ }>hv:t.IsValue⊢ ∃ t₁ t₂, t = <{ ( t₁ , t₂ ) }>
    generalize heq : <{ ~τ₁ × ~τ₂ }> = τ at htΓ:Contextt:Tmτ₁:Tyτ₂:Tyhv:t.IsValueτ:Tyheq:<{ τ₁ × τ₂ }> = τht:<{ ~(Γ) ⊢ ~(t) ⦂ ~(τ) }>⊢ ∃ t₁ t₂, t = <{ ( t₁ , t₂ ) }>
    induction ht generalizing τ₁ τ₂ with (subst_varssndΓ:Contextt:Tmτ:TyΓ✝:Contextt✝:Tmτ₁✝:Tyτ₁:Tyτ₂:Tyhv:<{ snd t✝ }>.IsValueh✝:<{ ~(Γ✝) ⊢ ~(t✝) ⦂ τ₁✝ × τ₁ × τ₂ }>h_ih✝:∀ {τ₁_1 τ₂_1 : Ty}, t✝.IsValue → <{ τ₁_1 × τ₂_1 }> = <{ τ₁✝ × τ₁ × τ₂ }> → ∃ t₁ t₂, t✝ = <{ ( t₁ , t₂ ) }>⊢ ∃ t₁ t₂, <{ snd t✝ }> = <{ ( t₁ , t₂ ) }>; try contradictionAll goals completed! 🐙)
    | pair Γ t₁ t₂ τ₁ τ₂ h ih =>pairΓ✝:Contextt:Tmτ:TyΓ:Contextt₁:Tmt₂:Tmτ₁✝:Tyτ₂✝:Tyh:<{ ~(Γ) ⊢ ~(t₁) ⦂ ~(τ₁✝) }>ih:<{ ~(Γ) ⊢ ~(t₂) ⦂ ~(τ₂✝) }>h₁_ih✝:∀ {τ₁ τ₂ : Ty}, t₁.IsValue → <{ τ₁ × τ₂ }> = τ₁✝ → ∃ t₁_1 t₂, t₁ = <{ ( t₁_1 , t₂ ) }>h₂_ih✝:∀ {τ₁ τ₂ : Ty}, t₂.IsValue → <{ τ₁ × τ₂ }> = τ₂✝ → ∃ t₁ t₂_1, t₂ = <{ ( t₁ , t₂_1 ) }>τ₁:Tyτ₂:Tyhv:<{ ( t₁ , t₂ ) }>.IsValueheq:<{ τ₁ × τ₂ }> = <{ τ₁✝ × τ₂✝ }>⊢ ∃ t₁_1 t₂_1, <{ ( t₁ , t₂ ) }> = <{ ( t₁_1 , t₂_1 ) }> inversion heqreflΓ✝:Contextt:Tmτ:TyΓ:Contextt₁:Tmt₂:Tmτ₁:Tyτ₂:Tyh:<{ ~(Γ) ⊢ ~(t₁) ⦂ ~(τ₁✝) }>ih:<{ ~(Γ) ⊢ ~(t₂) ⦂ ~(τ₂✝) }>h₁_ih✝:∀ {τ₁ τ₂ : Ty}, t₁.IsValue → <{ τ₁ × τ₂ }> = τ₁✝ → ∃ t₁_1 t₂, t₁ = <{ ( t₁_1 , t₂ ) }>h₂_ih✝:∀ {τ₁ τ₂ : Ty}, t₂.IsValue → <{ τ₁ × τ₂ }> = τ₂✝ → ∃ t₁ t₂_1, t₂ = <{ ( t₁ , t₂_1 ) }>hv:<{ ( t₁ , t₂ ) }>.IsValue⊢ ∃ t₁_1 t₂_1, <{ ( t₁ , t₂ ) }> = <{ ( t₁_1 , t₂_1 ) }>; exists t₁, t₂All goals completed! 🐙
    | sub Γ t₁ τ₁ τ₂ ht hs ih =>subΓ✝:Contextt:Tmτ:TyΓ:Contextt₁:Tmτ₁✝:Tyht:<{ ~(Γ) ⊢ ~(t₁) ⦂ ~(τ₁✝) }>ih:∀ {τ₁ τ₂ : Ty}, t₁.IsValue → <{ τ₁ × τ₂ }> = τ₁✝ → ∃ t₁_1 t₂, t₁ = <{ ( t₁_1 , t₂ ) }>τ₁:Tyτ₂:Tyhv:t₁.IsValuehs:τ₁✝ <: <{ τ₁ × τ₂ }>⊢ ∃ t₁_1 t₂, t₁ = <{ ( t₁_1 , t₂ ) }>
        obtain ⟨σ₁, σ₂, _, hs₁, hs₂⟩ := sub_inversion_prod hssubΓ✝:Contextt:Tmτ:TyΓ:Contextt₁:Tmτ₁✝:Tyht:<{ ~(Γ) ⊢ ~(t₁) ⦂ ~(τ₁✝) }>ih:∀ {τ₁ τ₂ : Ty}, t₁.IsValue → <{ τ₁ × τ₂ }> = τ₁✝ → ∃ t₁_1 t₂, t₁ = <{ ( t₁_1 , t₂ ) }>τ₁:Tyτ₂:Tyhv:t₁.IsValuehs:τ₁✝ <: <{ τ₁ × τ₂ }>σ₁:Tyσ₂:Tyleft✝:τ₁✝ = <{ σ₁ × σ₂ }>hs₁:σ₁ <: τ₁hs₂:σ₂ <: τ₂⊢ ∃ t₁_1 t₂, t₁ = <{ ( t₁_1 , t₂ ) }>; subst_varssubΓ✝:Contextt:Tmτ:TyΓ:Contextt₁:Tmτ₁:Tyτ₂:Tyhv:t₁.IsValueσ₁:Tyσ₂:Tyhs₁:σ₁ <: τ₁hs₂:σ₂ <: τ₂ht:<{ ~(Γ) ⊢ ~(t₁) ⦂ σ₁ × σ₂ }>ih:∀ {τ₁ τ₂ : Ty}, t₁.IsValue → <{ τ₁ × τ₂ }> = <{ σ₁ × σ₂ }> → ∃ t₁_1 t₂, t₁ = <{ ( t₁_1 , t₂ ) }>hs:<{ σ₁ × σ₂ }> <: <{ τ₁ × τ₂ }>⊢ ∃ t₁_1 t₂, t₁ = <{ ( t₁_1 , t₂ ) }>
        exact ih hv rflAll goals completed! 🐙

8.3.3. Progress🔗

The proof of progress now proceeds just like the one for the pure STLC, except that in several places we invoke canonical forms lemmas...

Theorem (Progress): For any term t and type τ, if ∅ ⊢ t ⦂ τ then t is a value or t ⟶ t' for some term t'.

Proof: Let t and τ be given, with ∅ ⊢ t ⦂ τ. Proceed by induction on the typing derivation.

The cases for abs, unit, tru and fls are immediate because abstractions, unit, true, and false are already values. The var case is vacuous because variables cannot be typed in the empty context. The remaining cases are more interesting:

If the last step in the typing derivation uses rule app, then there are terms t₁ t₂ and types τ₁ and τ₂ such that t = t₁ t₂, τ = τ₂, ∅ ⊢ t₁ ⦂ τ₁ → τ₂, and ∅ ⊢ t₂ ⦂ τ₁. Moreover, by the induction hypothesis, either t₁ is a value or it steps, and either t₂ is a value or it steps. There are three possibilities to consider:
- First, suppose t₁ ⟶ t₁' for some term t₁'. Then t₁ t₂ ⟶ t₁' t₂ by app₁'.
- Second, suppose t₁ is a value and t₂ ⟶ t₂' for some term t₂'. Then t₁ t₂ ⟶ t₁ t₂' by rule app₂ because t₁ is a value.
- Third, suppose t₁ and t₂ are both values. By the canonical forms lemma for arrow types, we know that t₁ has the form λ x : σ₁ . t₂ for some x, σ₁, and s₂. But then (λ x : σ₁ . s₂) t₂ ⟶ [x := t₂] s₂ by appAbs, since t₂ is a value.
If the final step of the derivation uses rule if, then there are terms t₁, t₂, and t₃ such that t = if t₁ then t₂ else t₃, with ∅ ⊢ t₁ ⦂ Bool and with ∅ ⊢ t₂ ⦂ τ and ∅ ⊢ t₃ ⦂ τ. Moreover, by the induction hypothesis, either t₁ is a value or it steps.
- If t₁ is a value, then by the canonical forms lemma for booleans, either t₁ = true or t₁ = false. In either case, t can step, using rule ifTrue or ifFalse.
- If t₁ can step, then so can t, by rule if.
If the final step of the derivation is by sub, then there is a type τ₂ such that τ₁ <: τ₂ and ∅ ⊢ t₁ ⦂ τ₁. The desired result is exactly the induction hypothesis for the typing subderivation.

Formally:

theorem progress (t : Tm) (τ : Ty) (h : <{ ∅ ⊢ ~t ⦂ ~τ }>) :
    t.IsValue ∨ ∃ t', t ⟶ t' := byt:Tmτ:Tyh:<{ ∅ ⊢ ~(t) ⦂ ~(τ) }>⊢ t.IsValue ∨ ∃ t', t ⟶ t'
  generalize heq : (∅ : Context) = Γ at ht:Tmτ:TyΓ:Contextheq:∅ = Γh:<{ ~(Γ) ⊢ ~(t) ⦂ ~(τ) }>⊢ t.IsValue ∨ ∃ t', t ⟶ t'
  induction h with (subst_varsunitt:Tmτ:TyΓ:Context⊢ <{ unit }>.IsValue ∨ ∃ t', <{ unit }> ⟶ t'; first
    | contradictionunitt:Tmτ:TyΓ:Context⊢ <{ unit }>.IsValue ∨ ∃ t', <{ unit }> ⟶ t'
    -- discharge cases where `t` is obviously a value
    | try (leftunitt:Tmτ:TyΓ:Context⊢ <{ unit }>.IsValue; constructorAll goals completed! 🐙; doneAll goals completed! 🐙)
  )
  | app Γ τ₁ τ₂ t₁ t₂ h₁ h₂ ih₁ ih₂ =>appt:Tmτ:TyΓ:Contextτ₁:Tyτ₂:Tyt₁:Tmt₂:Tmh₁:<{ ∅ ⊢ ~(t₁) ⦂ τ₂ → τ₁ }>h₂:<{ ∅ ⊢ ~(t₂) ⦂ ~(τ₂) }>ih₁:∅ = ∅ → t₁.IsValue ∨ ∃ t', t₁ ⟶ t'ih₂:∅ = ∅ → t₂.IsValue ∨ ∃ t', t₂ ⟶ t'⊢ <{ t₁ t₂ }>.IsValue ∨ ∃ t', <{ t₁ t₂ }> ⟶ t'
      rightappt:Tmτ:TyΓ:Contextτ₁:Tyτ₂:Tyt₁:Tmt₂:Tmh₁:<{ ∅ ⊢ ~(t₁) ⦂ τ₂ → τ₁ }>h₂:<{ ∅ ⊢ ~(t₂) ⦂ ~(τ₂) }>ih₁:∅ = ∅ → t₁.IsValue ∨ ∃ t', t₁ ⟶ t'ih₂:∅ = ∅ → t₂.IsValue ∨ ∃ t', t₂ ⟶ t'⊢ ∃ t', <{ t₁ t₂ }> ⟶ t'; cases ih₁ rflapp.inlt:Tmτ:TyΓ:Contextτ₁:Tyτ₂:Tyt₁:Tmt₂:Tmh₁:<{ ∅ ⊢ ~(t₁) ⦂ τ₂ → τ₁ }>h₂:<{ ∅ ⊢ ~(t₂) ⦂ ~(τ₂) }>ih₁:∅ = ∅ → t₁.IsValue ∨ ∃ t', t₁ ⟶ t'ih₂:∅ = ∅ → t₂.IsValue ∨ ∃ t', t₂ ⟶ t'h✝:t₁.IsValue⊢ ∃ t', <{ t₁ t₂ }> ⟶ t'app.inrt:Tmτ:TyΓ:Contextτ₁:Tyτ₂:Tyt₁:Tmt₂:Tmh₁:<{ ∅ ⊢ ~(t₁) ⦂ τ₂ → τ₁ }>h₂:<{ ∅ ⊢ ~(t₂) ⦂ ~(τ₂) }>ih₁:∅ = ∅ → t₁.IsValue ∨ ∃ t', t₁ ⟶ t'ih₂:∅ = ∅ → t₂.IsValue ∨ ∃ t', t₂ ⟶ t'h✝:∃ t', t₁ ⟶ t'⊢ ∃ t', <{ t₁ t₂ }> ⟶ t'
      -- t₁ is a value
      case _ ht₁ =>t:Tmτ:TyΓ:Contextτ₁:Tyτ₂:Tyt₁:Tmt₂:Tmh₁:<{ ∅ ⊢ ~(t₁) ⦂ τ₂ → τ₁ }>h₂:<{ ∅ ⊢ ~(t₂) ⦂ ~(τ₂) }>ih₁:∅ = ∅ → t₁.IsValue ∨ ∃ t', t₁ ⟶ t'ih₂:∅ = ∅ → t₂.IsValue ∨ ∃ t', t₂ ⟶ t'ht₁:t₁.IsValue⊢ ∃ t', <{ t₁ t₂ }> ⟶ t'
        cases ih₂ rflinlt:Tmτ:TyΓ:Contextτ₁:Tyτ₂:Tyt₁:Tmt₂:Tmh₁:<{ ∅ ⊢ ~(t₁) ⦂ τ₂ → τ₁ }>h₂:<{ ∅ ⊢ ~(t₂) ⦂ ~(τ₂) }>ih₁:∅ = ∅ → t₁.IsValue ∨ ∃ t', t₁ ⟶ t'ih₂:∅ = ∅ → t₂.IsValue ∨ ∃ t', t₂ ⟶ t'ht₁:t₁.IsValueh✝:t₂.IsValue⊢ ∃ t', <{ t₁ t₂ }> ⟶ t'inrt:Tmτ:TyΓ:Contextτ₁:Tyτ₂:Tyt₁:Tmt₂:Tmh₁:<{ ∅ ⊢ ~(t₁) ⦂ τ₂ → τ₁ }>h₂:<{ ∅ ⊢ ~(t₂) ⦂ ~(τ₂) }>ih₁:∅ = ∅ → t₁.IsValue ∨ ∃ t', t₁ ⟶ t'ih₂:∅ = ∅ → t₂.IsValue ∨ ∃ t', t₂ ⟶ t'ht₁:t₁.IsValueh✝:∃ t', t₂ ⟶ t'⊢ ∃ t', <{ t₁ t₂ }> ⟶ t'
        -- t₂ is a value
        case _ ht₂ =>t:Tmτ:TyΓ:Contextτ₁:Tyτ₂:Tyt₁:Tmt₂:Tmh₁:<{ ∅ ⊢ ~(t₁) ⦂ τ₂ → τ₁ }>h₂:<{ ∅ ⊢ ~(t₂) ⦂ ~(τ₂) }>ih₁:∅ = ∅ → t₁.IsValue ∨ ∃ t', t₁ ⟶ t'ih₂:∅ = ∅ → t₂.IsValue ∨ ∃ t', t₂ ⟶ t'ht₁:t₁.IsValueht₂:t₂.IsValue⊢ ∃ t', <{ t₁ t₂ }> ⟶ t'
          apply canonical_forms_of_arrow_types at h₁t:Tmτ:TyΓ:Contextτ₁:Tyτ₂:Tyt₁:Tmt₂:Tmh₂:<{ ∅ ⊢ ~(t₂) ⦂ ~(τ₂) }>ih₁:∅ = ∅ → t₁.IsValue ∨ ∃ t', t₁ ⟶ t'ih₂:∅ = ∅ → t₂.IsValue ∨ ∃ t', t₂ ⟶ t'ht₁:t₁.IsValueht₂:t₂.IsValueh₁:t₁.IsValue → ∃ x σ₁ t₂, t₁ = <{ λ ~x : σ₁ . t₂ }>⊢ ∃ t', <{ t₁ t₂ }> ⟶ t'
          let ⟨x, σ, v, hv⟩ := h₁ ht₁t:Tmτ:TyΓ:Contextτ₁:Tyτ₂:Tyt₁:Tmt₂:Tmh₂:<{ ∅ ⊢ ~(t₂) ⦂ ~(τ₂) }>ih₁:∅ = ∅ → t₁.IsValue ∨ ∃ t', t₁ ⟶ t'ih₂:∅ = ∅ → t₂.IsValue ∨ ∃ t', t₂ ⟶ t'ht₁:t₁.IsValueht₂:t₂.IsValueh₁:t₁.IsValue → ∃ x σ₁ t₂, t₁ = <{ λ ~x : σ₁ . t₂ }>x:Stringσ:Tyv:Tmhv:t₁ = <{ λ ~x : σ . v }>⊢ ∃ t', <{ t₁ t₂ }> ⟶ t'
          exists <{ [~x := ~t₂] ~v }>t:Tmτ:TyΓ:Contextτ₁:Tyτ₂:Tyt₁:Tmt₂:Tmh₂:<{ ∅ ⊢ ~(t₂) ⦂ ~(τ₂) }>ih₁:∅ = ∅ → t₁.IsValue ∨ ∃ t', t₁ ⟶ t'ih₂:∅ = ∅ → t₂.IsValue ∨ ∃ t', t₂ ⟶ t'ht₁:t₁.IsValueht₂:t₂.IsValueh₁:t₁.IsValue → ∃ x σ₁ t₂, t₁ = <{ λ ~x : σ₁ . t₂ }>x:Stringσ:Tyv:Tmhv:t₁ = <{ λ ~x : σ . v }>⊢ <{ t₁ t₂ }> ⟶ subst x t₂ v; simp [hv]t:Tmτ:TyΓ:Contextτ₁:Tyτ₂:Tyt₁:Tmt₂:Tmh₂:<{ ∅ ⊢ ~(t₂) ⦂ ~(τ₂) }>ih₁:∅ = ∅ → t₁.IsValue ∨ ∃ t', t₁ ⟶ t'ih₂:∅ = ∅ → t₂.IsValue ∨ ∃ t', t₂ ⟶ t'ht₁:t₁.IsValueht₂:t₂.IsValueh₁:t₁.IsValue → ∃ x σ₁ t₂, t₁ = <{ λ ~x : σ₁ . t₂ }>x:Stringσ:Tyv:Tmhv:t₁ = <{ λ ~x : σ . v }>⊢ <{ (λ ~x : σ . v) t₂ }> ⟶ subst x t₂ v
          apply_rules using StlcSubEvalAll goals completed! 🐙
        -- t₂ is not a value
        case _ ht₂ =>t:Tmτ:TyΓ:Contextτ₁:Tyτ₂:Tyt₁:Tmt₂:Tmh₁:<{ ∅ ⊢ ~(t₁) ⦂ τ₂ → τ₁ }>h₂:<{ ∅ ⊢ ~(t₂) ⦂ ~(τ₂) }>ih₁:∅ = ∅ → t₁.IsValue ∨ ∃ t', t₁ ⟶ t'ih₂:∅ = ∅ → t₂.IsValue ∨ ∃ t', t₂ ⟶ t'ht₁:t₁.IsValueht₂:∃ t', t₂ ⟶ t'⊢ ∃ t', <{ t₁ t₂ }> ⟶ t'
          obtain ⟨t₂', ht₂⟩ := ht₂t:Tmτ:TyΓ:Contextτ₁:Tyτ₂:Tyt₁:Tmt₂:Tmh₁:<{ ∅ ⊢ ~(t₁) ⦂ τ₂ → τ₁ }>h₂:<{ ∅ ⊢ ~(t₂) ⦂ ~(τ₂) }>ih₁:∅ = ∅ → t₁.IsValue ∨ ∃ t', t₁ ⟶ t'ih₂:∅ = ∅ → t₂.IsValue ∨ ∃ t', t₂ ⟶ t'ht₁:t₁.IsValuet₂':Tmht₂:t₂ ⟶ t₂'⊢ ∃ t', <{ t₁ t₂ }> ⟶ t'
          exists <{~t₁ ~t₂'}>t:Tmτ:TyΓ:Contextτ₁:Tyτ₂:Tyt₁:Tmt₂:Tmh₁:<{ ∅ ⊢ ~(t₁) ⦂ τ₂ → τ₁ }>h₂:<{ ∅ ⊢ ~(t₂) ⦂ ~(τ₂) }>ih₁:∅ = ∅ → t₁.IsValue ∨ ∃ t', t₁ ⟶ t'ih₂:∅ = ∅ → t₂.IsValue ∨ ∃ t', t₂ ⟶ t'ht₁:t₁.IsValuet₂':Tmht₂:t₂ ⟶ t₂'⊢ <{ t₁ t₂ }> ⟶ <{ t₁ t₂' }>; apply_rules using StlcSubEvalAll goals completed! 🐙
      -- t₁ is not a value
      case _ ht₁ =>t:Tmτ:TyΓ:Contextτ₁:Tyτ₂:Tyt₁:Tmt₂:Tmh₁:<{ ∅ ⊢ ~(t₁) ⦂ τ₂ → τ₁ }>h₂:<{ ∅ ⊢ ~(t₂) ⦂ ~(τ₂) }>ih₁:∅ = ∅ → t₁.IsValue ∨ ∃ t', t₁ ⟶ t'ih₂:∅ = ∅ → t₂.IsValue ∨ ∃ t', t₂ ⟶ t'ht₁:∃ t', t₁ ⟶ t'⊢ ∃ t', <{ t₁ t₂ }> ⟶ t'
        obtain ⟨t₁', ht₁⟩ := ht₁t:Tmτ:TyΓ:Contextτ₁:Tyτ₂:Tyt₁:Tmt₂:Tmh₁:<{ ∅ ⊢ ~(t₁) ⦂ τ₂ → τ₁ }>h₂:<{ ∅ ⊢ ~(t₂) ⦂ ~(τ₂) }>ih₁:∅ = ∅ → t₁.IsValue ∨ ∃ t', t₁ ⟶ t'ih₂:∅ = ∅ → t₂.IsValue ∨ ∃ t', t₂ ⟶ t't₁':Tmht₁:t₁ ⟶ t₁'⊢ ∃ t', <{ t₁ t₂ }> ⟶ t'
        exists <{~t₁' ~t₂}>t:Tmτ:TyΓ:Contextτ₁:Tyτ₂:Tyt₁:Tmt₂:Tmh₁:<{ ∅ ⊢ ~(t₁) ⦂ τ₂ → τ₁ }>h₂:<{ ∅ ⊢ ~(t₂) ⦂ ~(τ₂) }>ih₁:∅ = ∅ → t₁.IsValue ∨ ∃ t', t₁ ⟶ t'ih₂:∅ = ∅ → t₂.IsValue ∨ ∃ t', t₂ ⟶ t't₁':Tmht₁:t₁ ⟶ t₁'⊢ <{ t₁ t₂ }> ⟶ <{ t₁' t₂ }>; apply_rules using StlcSubEvalAll goals completed! 🐙
  | ite Γ t₁ t₂ t₃ τ h₁ h₂ h₃ ih₁ ih₂ ih₃ =>itet:Tmτ✝:TyΓ:Contextt₁:Tmt₂:Tmt₃:Tmτ:Tyh₁:<{ ∅ ⊢ ~(t₁) ⦂ Bool }>h₂:<{ ∅ ⊢ ~(t₂) ⦂ ~(τ) }>h₃:<{ ∅ ⊢ ~(t₃) ⦂ ~(τ) }>ih₁:∅ = ∅ → t₁.IsValue ∨ ∃ t', t₁ ⟶ t'ih₂:∅ = ∅ → t₂.IsValue ∨ ∃ t', t₂ ⟶ t'ih₃:∅ = ∅ → t₃.IsValue ∨ ∃ t', t₃ ⟶ t'⊢ <{ if t₁ then t₂ else t₃ }>.IsValue ∨ ∃ t', <{ if t₁ then t₂ else t₃ }> ⟶ t'
    rightitet:Tmτ✝:TyΓ:Contextt₁:Tmt₂:Tmt₃:Tmτ:Tyh₁:<{ ∅ ⊢ ~(t₁) ⦂ Bool }>h₂:<{ ∅ ⊢ ~(t₂) ⦂ ~(τ) }>h₃:<{ ∅ ⊢ ~(t₃) ⦂ ~(τ) }>ih₁:∅ = ∅ → t₁.IsValue ∨ ∃ t', t₁ ⟶ t'ih₂:∅ = ∅ → t₂.IsValue ∨ ∃ t', t₂ ⟶ t'ih₃:∅ = ∅ → t₃.IsValue ∨ ∃ t', t₃ ⟶ t'⊢ ∃ t', <{ if t₁ then t₂ else t₃ }> ⟶ t'; cases ih₁ rflite.inlt:Tmτ✝:TyΓ:Contextt₁:Tmt₂:Tmt₃:Tmτ:Tyh₁:<{ ∅ ⊢ ~(t₁) ⦂ Bool }>h₂:<{ ∅ ⊢ ~(t₂) ⦂ ~(τ) }>h₃:<{ ∅ ⊢ ~(t₃) ⦂ ~(τ) }>ih₁:∅ = ∅ → t₁.IsValue ∨ ∃ t', t₁ ⟶ t'ih₂:∅ = ∅ → t₂.IsValue ∨ ∃ t', t₂ ⟶ t'ih₃:∅ = ∅ → t₃.IsValue ∨ ∃ t', t₃ ⟶ t'h✝:t₁.IsValue⊢ ∃ t', <{ if t₁ then t₂ else t₃ }> ⟶ t'ite.inrt:Tmτ✝:TyΓ:Contextt₁:Tmt₂:Tmt₃:Tmτ:Tyh₁:<{ ∅ ⊢ ~(t₁) ⦂ Bool }>h₂:<{ ∅ ⊢ ~(t₂) ⦂ ~(τ) }>h₃:<{ ∅ ⊢ ~(t₃) ⦂ ~(τ) }>ih₁:∅ = ∅ → t₁.IsValue ∨ ∃ t', t₁ ⟶ t'ih₂:∅ = ∅ → t₂.IsValue ∨ ∃ t', t₂ ⟶ t'ih₃:∅ = ∅ → t₃.IsValue ∨ ∃ t', t₃ ⟶ t'h✝:∃ t', t₁ ⟶ t'⊢ ∃ t', <{ if t₁ then t₂ else t₃ }> ⟶ t'
    -- t₁ is a value
    case _ ht₁ =>t:Tmτ✝:TyΓ:Contextt₁:Tmt₂:Tmt₃:Tmτ:Tyh₁:<{ ∅ ⊢ ~(t₁) ⦂ Bool }>h₂:<{ ∅ ⊢ ~(t₂) ⦂ ~(τ) }>h₃:<{ ∅ ⊢ ~(t₃) ⦂ ~(τ) }>ih₁:∅ = ∅ → t₁.IsValue ∨ ∃ t', t₁ ⟶ t'ih₂:∅ = ∅ → t₂.IsValue ∨ ∃ t', t₂ ⟶ t'ih₃:∅ = ∅ → t₃.IsValue ∨ ∃ t', t₃ ⟶ t'ht₁:t₁.IsValue⊢ ∃ t', <{ if t₁ then t₂ else t₃ }> ⟶ t'
      apply canonical_forms_of_bool at h₁t:Tmτ✝:TyΓ:Contextt₁:Tmt₂:Tmt₃:Tmτ:Tyh₂:<{ ∅ ⊢ ~(t₂) ⦂ ~(τ) }>h₃:<{ ∅ ⊢ ~(t₃) ⦂ ~(τ) }>ih₁:∅ = ∅ → t₁.IsValue ∨ ∃ t', t₁ ⟶ t'ih₂:∅ = ∅ → t₂.IsValue ∨ ∃ t', t₂ ⟶ t'ih₃:∅ = ∅ → t₃.IsValue ∨ ∃ t', t₃ ⟶ t'ht₁:t₁.IsValueh₁:t₁.IsValue → t₁ = <{ true }> ∨ t₁ = <{ false }>⊢ ∃ t', <{ if t₁ then t₂ else t₃ }> ⟶ t'
      obtain h₁ | h₁ := h₁ ht₁inlt:Tmτ✝:TyΓ:Contextt₁:Tmt₂:Tmt₃:Tmτ:Tyh₂:<{ ∅ ⊢ ~(t₂) ⦂ ~(τ) }>h₃:<{ ∅ ⊢ ~(t₃) ⦂ ~(τ) }>ih₁:∅ = ∅ → t₁.IsValue ∨ ∃ t', t₁ ⟶ t'ih₂:∅ = ∅ → t₂.IsValue ∨ ∃ t', t₂ ⟶ t'ih₃:∅ = ∅ → t₃.IsValue ∨ ∃ t', t₃ ⟶ t'ht₁:t₁.IsValueh₁✝:t₁.IsValue → t₁ = <{ true }> ∨ t₁ = <{ false }>h₁:t₁ = <{ true }>⊢ ∃ t', <{ if t₁ then t₂ else t₃ }> ⟶ t'inrt:Tmτ✝:TyΓ:Contextt₁:Tmt₂:Tmt₃:Tmτ:Tyh₂:<{ ∅ ⊢ ~(t₂) ⦂ ~(τ) }>h₃:<{ ∅ ⊢ ~(t₃) ⦂ ~(τ) }>ih₁:∅ = ∅ → t₁.IsValue ∨ ∃ t', t₁ ⟶ t'ih₂:∅ = ∅ → t₂.IsValue ∨ ∃ t', t₂ ⟶ t'ih₃:∅ = ∅ → t₃.IsValue ∨ ∃ t', t₃ ⟶ t'ht₁:t₁.IsValueh₁✝:t₁.IsValue → t₁ = <{ true }> ∨ t₁ = <{ false }>h₁:t₁ = <{ false }>⊢ ∃ t', <{ if t₁ then t₂ else t₃ }> ⟶ t' <;>inlt:Tmτ✝:TyΓ:Contextt₁:Tmt₂:Tmt₃:Tmτ:Tyh₂:<{ ∅ ⊢ ~(t₂) ⦂ ~(τ) }>h₃:<{ ∅ ⊢ ~(t₃) ⦂ ~(τ) }>ih₁:∅ = ∅ → t₁.IsValue ∨ ∃ t', t₁ ⟶ t'ih₂:∅ = ∅ → t₂.IsValue ∨ ∃ t', t₂ ⟶ t'ih₃:∅ = ∅ → t₃.IsValue ∨ ∃ t', t₃ ⟶ t'ht₁:t₁.IsValueh₁✝:t₁.IsValue → t₁ = <{ true }> ∨ t₁ = <{ false }>h₁:t₁ = <{ true }>⊢ ∃ t', <{ if t₁ then t₂ else t₃ }> ⟶ t'inrt:Tmτ✝:TyΓ:Contextt₁:Tmt₂:Tmt₃:Tmτ:Tyh₂:<{ ∅ ⊢ ~(t₂) ⦂ ~(τ) }>h₃:<{ ∅ ⊢ ~(t₃) ⦂ ~(τ) }>ih₁:∅ = ∅ → t₁.IsValue ∨ ∃ t', t₁ ⟶ t'ih₂:∅ = ∅ → t₂.IsValue ∨ ∃ t', t₂ ⟶ t'ih₃:∅ = ∅ → t₃.IsValue ∨ ∃ t', t₃ ⟶ t'ht₁:t₁.IsValueh₁✝:t₁.IsValue → t₁ = <{ true }> ∨ t₁ = <{ false }>h₁:t₁ = <{ false }>⊢ ∃ t', <{ if t₁ then t₂ else t₃ }> ⟶ t' subst_varsinrt:Tmτ✝:TyΓ:Contextt₂:Tmt₃:Tmτ:Tyh₂:<{ ∅ ⊢ ~(t₂) ⦂ ~(τ) }>h₃:<{ ∅ ⊢ ~(t₃) ⦂ ~(τ) }>ih₂:∅ = ∅ → t₂.IsValue ∨ ∃ t', t₂ ⟶ t'ih₃:∅ = ∅ → t₃.IsValue ∨ ∃ t', t₃ ⟶ t'ih₁:∅ = ∅ → <{ false }>.IsValue ∨ ∃ t', <{ false }> ⟶ t'ht₁:<{ false }>.IsValueh₁:<{ false }>.IsValue → <{ false }> = <{ true }> ∨ <{ false }> = <{ false }>⊢ ∃ t', <{ if false then t₂ else t₃ }> ⟶ t'
      ·inlt:Tmτ✝:TyΓ:Contextt₂:Tmt₃:Tmτ:Tyh₂:<{ ∅ ⊢ ~(t₂) ⦂ ~(τ) }>h₃:<{ ∅ ⊢ ~(t₃) ⦂ ~(τ) }>ih₂:∅ = ∅ → t₂.IsValue ∨ ∃ t', t₂ ⟶ t'ih₃:∅ = ∅ → t₃.IsValue ∨ ∃ t', t₃ ⟶ t'ih₁:∅ = ∅ → <{ true }>.IsValue ∨ ∃ t', <{ true }> ⟶ t'ht₁:<{ true }>.IsValueh₁:<{ true }>.IsValue → <{ true }> = <{ true }> ∨ <{ true }> = <{ false }>⊢ ∃ t', <{ if true then t₂ else t₃ }> ⟶ t' exists t₂inlt:Tmτ✝:TyΓ:Contextt₂:Tmt₃:Tmτ:Tyh₂:<{ ∅ ⊢ ~(t₂) ⦂ ~(τ) }>h₃:<{ ∅ ⊢ ~(t₃) ⦂ ~(τ) }>ih₂:∅ = ∅ → t₂.IsValue ∨ ∃ t', t₂ ⟶ t'ih₃:∅ = ∅ → t₃.IsValue ∨ ∃ t', t₃ ⟶ t'ih₁:∅ = ∅ → <{ true }>.IsValue ∨ ∃ t', <{ true }> ⟶ t'ht₁:<{ true }>.IsValueh₁:<{ true }>.IsValue → <{ true }> = <{ true }> ∨ <{ true }> = <{ false }>⊢ <{ if true then t₂ else t₃ }> ⟶ t₂; apply_rules using StlcSubEvalAll goals completed! 🐙
      ·inrt:Tmτ✝:TyΓ:Contextt₂:Tmt₃:Tmτ:Tyh₂:<{ ∅ ⊢ ~(t₂) ⦂ ~(τ) }>h₃:<{ ∅ ⊢ ~(t₃) ⦂ ~(τ) }>ih₂:∅ = ∅ → t₂.IsValue ∨ ∃ t', t₂ ⟶ t'ih₃:∅ = ∅ → t₃.IsValue ∨ ∃ t', t₃ ⟶ t'ih₁:∅ = ∅ → <{ false }>.IsValue ∨ ∃ t', <{ false }> ⟶ t'ht₁:<{ false }>.IsValueh₁:<{ false }>.IsValue → <{ false }> = <{ true }> ∨ <{ false }> = <{ false }>⊢ ∃ t', <{ if false then t₂ else t₃ }> ⟶ t' exists t₃inrt:Tmτ✝:TyΓ:Contextt₂:Tmt₃:Tmτ:Tyh₂:<{ ∅ ⊢ ~(t₂) ⦂ ~(τ) }>h₃:<{ ∅ ⊢ ~(t₃) ⦂ ~(τ) }>ih₂:∅ = ∅ → t₂.IsValue ∨ ∃ t', t₂ ⟶ t'ih₃:∅ = ∅ → t₃.IsValue ∨ ∃ t', t₃ ⟶ t'ih₁:∅ = ∅ → <{ false }>.IsValue ∨ ∃ t', <{ false }> ⟶ t'ht₁:<{ false }>.IsValueh₁:<{ false }>.IsValue → <{ false }> = <{ true }> ∨ <{ false }> = <{ false }>⊢ <{ if false then t₂ else t₃ }> ⟶ t₃; apply_rules using StlcSubEvalAll goals completed! 🐙
    -- t₁ is not a value
    case _ ht₁ =>t:Tmτ✝:TyΓ:Contextt₁:Tmt₂:Tmt₃:Tmτ:Tyh₁:<{ ∅ ⊢ ~(t₁) ⦂ Bool }>h₂:<{ ∅ ⊢ ~(t₂) ⦂ ~(τ) }>h₃:<{ ∅ ⊢ ~(t₃) ⦂ ~(τ) }>ih₁:∅ = ∅ → t₁.IsValue ∨ ∃ t', t₁ ⟶ t'ih₂:∅ = ∅ → t₂.IsValue ∨ ∃ t', t₂ ⟶ t'ih₃:∅ = ∅ → t₃.IsValue ∨ ∃ t', t₃ ⟶ t'ht₁:∃ t', t₁ ⟶ t'⊢ ∃ t', <{ if t₁ then t₂ else t₃ }> ⟶ t'
      obtain ⟨t₁', ht₁⟩ := ht₁t:Tmτ✝:TyΓ:Contextt₁:Tmt₂:Tmt₃:Tmτ:Tyh₁:<{ ∅ ⊢ ~(t₁) ⦂ Bool }>h₂:<{ ∅ ⊢ ~(t₂) ⦂ ~(τ) }>h₃:<{ ∅ ⊢ ~(t₃) ⦂ ~(τ) }>ih₁:∅ = ∅ → t₁.IsValue ∨ ∃ t', t₁ ⟶ t'ih₂:∅ = ∅ → t₂.IsValue ∨ ∃ t', t₂ ⟶ t'ih₃:∅ = ∅ → t₃.IsValue ∨ ∃ t', t₃ ⟶ t't₁':Tmht₁:t₁ ⟶ t₁'⊢ ∃ t', <{ if t₁ then t₂ else t₃ }> ⟶ t'
      exists <{if ~t₁' then ~t₂ else ~t₃}>t:Tmτ✝:TyΓ:Contextt₁:Tmt₂:Tmt₃:Tmτ:Tyh₁:<{ ∅ ⊢ ~(t₁) ⦂ Bool }>h₂:<{ ∅ ⊢ ~(t₂) ⦂ ~(τ) }>h₃:<{ ∅ ⊢ ~(t₃) ⦂ ~(τ) }>ih₁:∅ = ∅ → t₁.IsValue ∨ ∃ t', t₁ ⟶ t'ih₂:∅ = ∅ → t₂.IsValue ∨ ∃ t', t₂ ⟶ t'ih₃:∅ = ∅ → t₃.IsValue ∨ ∃ t', t₃ ⟶ t't₁':Tmht₁:t₁ ⟶ t₁'⊢ <{ if t₁ then t₂ else t₃ }> ⟶ <{ if t₁' then t₂ else t₃ }>; apply_rules using StlcSubEvalAll goals completed! 🐙
  | sub Γ t₁ τ₁ τ₂ ht hs ih =>subt:Tmτ:TyΓ:Contextt₁:Tmτ₁:Tyτ₂:Tyhs:τ₁ <: τ₂ht:<{ ∅ ⊢ ~(t₁) ⦂ ~(τ₁) }>ih:∅ = ∅ → t₁.IsValue ∨ ∃ t', t₁ ⟶ t'⊢ t₁.IsValue ∨ ∃ t', t₁ ⟶ t' apply ihsubt:Tmτ:TyΓ:Contextt₁:Tmτ₁:Tyτ₂:Tyhs:τ₁ <: τ₂ht:<{ ∅ ⊢ ~(t₁) ⦂ ~(τ₁) }>ih:∅ = ∅ → t₁.IsValue ∨ ∃ t', t₁ ⟶ t'⊢ ∅ = ∅; rflAll goals completed! 🐙
-- Fill in products here later
  | pair Γ t₁ t₂ τ₁ τ₂ h₁ h₂ ih₁ ih₂ =>pairt:Tmτ:TyΓ:Contextt₁:Tmt₂:Tmτ₁:Tyτ₂:Tyh₁:<{ ∅ ⊢ ~(t₁) ⦂ ~(τ₁) }>h₂:<{ ∅ ⊢ ~(t₂) ⦂ ~(τ₂) }>ih₁:∅ = ∅ → t₁.IsValue ∨ ∃ t', t₁ ⟶ t'ih₂:∅ = ∅ → t₂.IsValue ∨ ∃ t', t₂ ⟶ t'⊢ <{ ( t₁ , t₂ ) }>.IsValue ∨ ∃ t', <{ ( t₁ , t₂ ) }> ⟶ t'
      cases ih₁ rflpair.inlt:Tmτ:TyΓ:Contextt₁:Tmt₂:Tmτ₁:Tyτ₂:Tyh₁:<{ ∅ ⊢ ~(t₁) ⦂ ~(τ₁) }>h₂:<{ ∅ ⊢ ~(t₂) ⦂ ~(τ₂) }>ih₁:∅ = ∅ → t₁.IsValue ∨ ∃ t', t₁ ⟶ t'ih₂:∅ = ∅ → t₂.IsValue ∨ ∃ t', t₂ ⟶ t'h✝:t₁.IsValue⊢ <{ ( t₁ , t₂ ) }>.IsValue ∨ ∃ t', <{ ( t₁ , t₂ ) }> ⟶ t'pair.inrt:Tmτ:TyΓ:Contextt₁:Tmt₂:Tmτ₁:Tyτ₂:Tyh₁:<{ ∅ ⊢ ~(t₁) ⦂ ~(τ₁) }>h₂:<{ ∅ ⊢ ~(t₂) ⦂ ~(τ₂) }>ih₁:∅ = ∅ → t₁.IsValue ∨ ∃ t', t₁ ⟶ t'ih₂:∅ = ∅ → t₂.IsValue ∨ ∃ t', t₂ ⟶ t'h✝:∃ t', t₁ ⟶ t'⊢ <{ ( t₁ , t₂ ) }>.IsValue ∨ ∃ t', <{ ( t₁ , t₂ ) }> ⟶ t'
      -- t₁ is a value
      case _ ht₁ =>t:Tmτ:TyΓ:Contextt₁:Tmt₂:Tmτ₁:Tyτ₂:Tyh₁:<{ ∅ ⊢ ~(t₁) ⦂ ~(τ₁) }>h₂:<{ ∅ ⊢ ~(t₂) ⦂ ~(τ₂) }>ih₁:∅ = ∅ → t₁.IsValue ∨ ∃ t', t₁ ⟶ t'ih₂:∅ = ∅ → t₂.IsValue ∨ ∃ t', t₂ ⟶ t'ht₁:t₁.IsValue⊢ <{ ( t₁ , t₂ ) }>.IsValue ∨ ∃ t', <{ ( t₁ , t₂ ) }> ⟶ t'
        cases ih₂ rflinlt:Tmτ:TyΓ:Contextt₁:Tmt₂:Tmτ₁:Tyτ₂:Tyh₁:<{ ∅ ⊢ ~(t₁) ⦂ ~(τ₁) }>h₂:<{ ∅ ⊢ ~(t₂) ⦂ ~(τ₂) }>ih₁:∅ = ∅ → t₁.IsValue ∨ ∃ t', t₁ ⟶ t'ih₂:∅ = ∅ → t₂.IsValue ∨ ∃ t', t₂ ⟶ t'ht₁:t₁.IsValueh✝:t₂.IsValue⊢ <{ ( t₁ , t₂ ) }>.IsValue ∨ ∃ t', <{ ( t₁ , t₂ ) }> ⟶ t'inrt:Tmτ:TyΓ:Contextt₁:Tmt₂:Tmτ₁:Tyτ₂:Tyh₁:<{ ∅ ⊢ ~(t₁) ⦂ ~(τ₁) }>h₂:<{ ∅ ⊢ ~(t₂) ⦂ ~(τ₂) }>ih₁:∅ = ∅ → t₁.IsValue ∨ ∃ t', t₁ ⟶ t'ih₂:∅ = ∅ → t₂.IsValue ∨ ∃ t', t₂ ⟶ t'ht₁:t₁.IsValueh✝:∃ t', t₂ ⟶ t'⊢ <{ ( t₁ , t₂ ) }>.IsValue ∨ ∃ t', <{ ( t₁ , t₂ ) }> ⟶ t'
        -- t₂ is a value
        case _ ht₂ =>t:Tmτ:TyΓ:Contextt₁:Tmt₂:Tmτ₁:Tyτ₂:Tyh₁:<{ ∅ ⊢ ~(t₁) ⦂ ~(τ₁) }>h₂:<{ ∅ ⊢ ~(t₂) ⦂ ~(τ₂) }>ih₁:∅ = ∅ → t₁.IsValue ∨ ∃ t', t₁ ⟶ t'ih₂:∅ = ∅ → t₂.IsValue ∨ ∃ t', t₂ ⟶ t'ht₁:t₁.IsValueht₂:t₂.IsValue⊢ <{ ( t₁ , t₂ ) }>.IsValue ∨ ∃ t', <{ ( t₁ , t₂ ) }> ⟶ t'
          leftt:Tmτ:TyΓ:Contextt₁:Tmt₂:Tmτ₁:Tyτ₂:Tyh₁:<{ ∅ ⊢ ~(t₁) ⦂ ~(τ₁) }>h₂:<{ ∅ ⊢ ~(t₂) ⦂ ~(τ₂) }>ih₁:∅ = ∅ → t₁.IsValue ∨ ∃ t', t₁ ⟶ t'ih₂:∅ = ∅ → t₂.IsValue ∨ ∃ t', t₂ ⟶ t'ht₁:t₁.IsValueht₂:t₂.IsValue⊢ <{ ( t₁ , t₂ ) }>.IsValue; apply_rules using StlcSubEvalAll goals completed! 🐙
        -- t₂ is not a value
        case _ ht₂ =>t:Tmτ:TyΓ:Contextt₁:Tmt₂:Tmτ₁:Tyτ₂:Tyh₁:<{ ∅ ⊢ ~(t₁) ⦂ ~(τ₁) }>h₂:<{ ∅ ⊢ ~(t₂) ⦂ ~(τ₂) }>ih₁:∅ = ∅ → t₁.IsValue ∨ ∃ t', t₁ ⟶ t'ih₂:∅ = ∅ → t₂.IsValue ∨ ∃ t', t₂ ⟶ t'ht₁:t₁.IsValueht₂:∃ t', t₂ ⟶ t'⊢ <{ ( t₁ , t₂ ) }>.IsValue ∨ ∃ t', <{ ( t₁ , t₂ ) }> ⟶ t'
          obtain ⟨t₂', ht₂⟩ := ht₂t:Tmτ:TyΓ:Contextt₁:Tmt₂:Tmτ₁:Tyτ₂:Tyh₁:<{ ∅ ⊢ ~(t₁) ⦂ ~(τ₁) }>h₂:<{ ∅ ⊢ ~(t₂) ⦂ ~(τ₂) }>ih₁:∅ = ∅ → t₁.IsValue ∨ ∃ t', t₁ ⟶ t'ih₂:∅ = ∅ → t₂.IsValue ∨ ∃ t', t₂ ⟶ t'ht₁:t₁.IsValuet₂':Tmht₂:t₂ ⟶ t₂'⊢ <{ ( t₁ , t₂ ) }>.IsValue ∨ ∃ t', <{ ( t₁ , t₂ ) }> ⟶ t'
          rightt:Tmτ:TyΓ:Contextt₁:Tmt₂:Tmτ₁:Tyτ₂:Tyh₁:<{ ∅ ⊢ ~(t₁) ⦂ ~(τ₁) }>h₂:<{ ∅ ⊢ ~(t₂) ⦂ ~(τ₂) }>ih₁:∅ = ∅ → t₁.IsValue ∨ ∃ t', t₁ ⟶ t'ih₂:∅ = ∅ → t₂.IsValue ∨ ∃ t', t₂ ⟶ t'ht₁:t₁.IsValuet₂':Tmht₂:t₂ ⟶ t₂'⊢ ∃ t', <{ ( t₁ , t₂ ) }> ⟶ t'; exists <{(~t₁, ~t₂')}>t:Tmτ:TyΓ:Contextt₁:Tmt₂:Tmτ₁:Tyτ₂:Tyh₁:<{ ∅ ⊢ ~(t₁) ⦂ ~(τ₁) }>h₂:<{ ∅ ⊢ ~(t₂) ⦂ ~(τ₂) }>ih₁:∅ = ∅ → t₁.IsValue ∨ ∃ t', t₁ ⟶ t'ih₂:∅ = ∅ → t₂.IsValue ∨ ∃ t', t₂ ⟶ t'ht₁:t₁.IsValuet₂':Tmht₂:t₂ ⟶ t₂'⊢ <{ ( t₁ , t₂ ) }> ⟶ <{ ( t₁ , t₂' ) }>; apply_rules using StlcSubEvalAll goals completed! 🐙
      -- t₁ is not a value
      case _ ht₁ =>t:Tmτ:TyΓ:Contextt₁:Tmt₂:Tmτ₁:Tyτ₂:Tyh₁:<{ ∅ ⊢ ~(t₁) ⦂ ~(τ₁) }>h₂:<{ ∅ ⊢ ~(t₂) ⦂ ~(τ₂) }>ih₁:∅ = ∅ → t₁.IsValue ∨ ∃ t', t₁ ⟶ t'ih₂:∅ = ∅ → t₂.IsValue ∨ ∃ t', t₂ ⟶ t'ht₁:∃ t', t₁ ⟶ t'⊢ <{ ( t₁ , t₂ ) }>.IsValue ∨ ∃ t', <{ ( t₁ , t₂ ) }> ⟶ t'
        obtain ⟨t₁', ht₁⟩ := ht₁t:Tmτ:TyΓ:Contextt₁:Tmt₂:Tmτ₁:Tyτ₂:Tyh₁:<{ ∅ ⊢ ~(t₁) ⦂ ~(τ₁) }>h₂:<{ ∅ ⊢ ~(t₂) ⦂ ~(τ₂) }>ih₁:∅ = ∅ → t₁.IsValue ∨ ∃ t', t₁ ⟶ t'ih₂:∅ = ∅ → t₂.IsValue ∨ ∃ t', t₂ ⟶ t't₁':Tmht₁:t₁ ⟶ t₁'⊢ <{ ( t₁ , t₂ ) }>.IsValue ∨ ∃ t', <{ ( t₁ , t₂ ) }> ⟶ t'
        rightt:Tmτ:TyΓ:Contextt₁:Tmt₂:Tmτ₁:Tyτ₂:Tyh₁:<{ ∅ ⊢ ~(t₁) ⦂ ~(τ₁) }>h₂:<{ ∅ ⊢ ~(t₂) ⦂ ~(τ₂) }>ih₁:∅ = ∅ → t₁.IsValue ∨ ∃ t', t₁ ⟶ t'ih₂:∅ = ∅ → t₂.IsValue ∨ ∃ t', t₂ ⟶ t't₁':Tmht₁:t₁ ⟶ t₁'⊢ ∃ t', <{ ( t₁ , t₂ ) }> ⟶ t'; exists <{(~t₁', ~t₂)}>t:Tmτ:TyΓ:Contextt₁:Tmt₂:Tmτ₁:Tyτ₂:Tyh₁:<{ ∅ ⊢ ~(t₁) ⦂ ~(τ₁) }>h₂:<{ ∅ ⊢ ~(t₂) ⦂ ~(τ₂) }>ih₁:∅ = ∅ → t₁.IsValue ∨ ∃ t', t₁ ⟶ t'ih₂:∅ = ∅ → t₂.IsValue ∨ ∃ t', t₂ ⟶ t't₁':Tmht₁:t₁ ⟶ t₁'⊢ <{ ( t₁ , t₂ ) }> ⟶ <{ ( t₁' , t₂ ) }>; apply_rules using StlcSubEvalAll goals completed! 🐙
  | fst Γ t τ₁ τ₂ h ih =>fstt✝:Tmτ:TyΓ:Contextt:Tmτ₁:Tyτ₂:Tyh:<{ ∅ ⊢ ~(t) ⦂ τ₁ × τ₂ }>ih:∅ = ∅ → t.IsValue ∨ ∃ t', t ⟶ t'⊢ <{ fst t }>.IsValue ∨ ∃ t', <{ fst t }> ⟶ t'
      rightfstt✝:Tmτ:TyΓ:Contextt:Tmτ₁:Tyτ₂:Tyh:<{ ∅ ⊢ ~(t) ⦂ τ₁ × τ₂ }>ih:∅ = ∅ → t.IsValue ∨ ∃ t', t ⟶ t'⊢ ∃ t', <{ fst t }> ⟶ t'; cases ih rflfst.inlt✝:Tmτ:TyΓ:Contextt:Tmτ₁:Tyτ₂:Tyh:<{ ∅ ⊢ ~(t) ⦂ τ₁ × τ₂ }>ih:∅ = ∅ → t.IsValue ∨ ∃ t', t ⟶ t'h✝:t.IsValue⊢ ∃ t', <{ fst t }> ⟶ t'fst.inrt✝:Tmτ:TyΓ:Contextt:Tmτ₁:Tyτ₂:Tyh:<{ ∅ ⊢ ~(t) ⦂ τ₁ × τ₂ }>ih:∅ = ∅ → t.IsValue ∨ ∃ t', t ⟶ t'h✝:∃ t', t ⟶ t'⊢ ∃ t', <{ fst t }> ⟶ t'
      -- t₁ is a value
      case _ ht₁ =>t✝:Tmτ:TyΓ:Contextt:Tmτ₁:Tyτ₂:Tyh:<{ ∅ ⊢ ~(t) ⦂ τ₁ × τ₂ }>ih:∅ = ∅ → t.IsValue ∨ ∃ t', t ⟶ t'ht₁:t.IsValue⊢ ∃ t', <{ fst t }> ⟶ t'
        apply canonical_forms_of_product_types at ht✝:Tmτ:TyΓ:Contextt:Tmτ₁:Tyτ₂:Tyih:∅ = ∅ → t.IsValue ∨ ∃ t', t ⟶ t'ht₁:t.IsValueh:t.IsValue → ∃ t₁ t₂, t = <{ ( t₁ , t₂ ) }>⊢ ∃ t', <{ fst t }> ⟶ t'
        obtain ⟨v₁, v₂, hv⟩ := h ht₁t✝:Tmτ:TyΓ:Contextt:Tmτ₁:Tyτ₂:Tyih:∅ = ∅ → t.IsValue ∨ ∃ t', t ⟶ t'ht₁:t.IsValueh:t.IsValue → ∃ t₁ t₂, t = <{ ( t₁ , t₂ ) }>v₁:Tmv₂:Tmhv:t = <{ ( v₁ , v₂ ) }>⊢ ∃ t', <{ fst t }> ⟶ t'; rw [hvt✝:Tmτ:TyΓ:Contextt:Tmτ₁:Tyτ₂:Tyih:∅ = ∅ → t.IsValue ∨ ∃ t', t ⟶ t'ht₁:t.IsValueh:t.IsValue → ∃ t₁ t₂, t = <{ ( t₁ , t₂ ) }>v₁:Tmv₂:Tmhv:t = <{ ( v₁ , v₂ ) }>⊢ ∃ t', <{ fst  ( v₁ , v₂ ) }> ⟶ t']t✝:Tmτ:TyΓ:Contextt:Tmτ₁:Tyτ₂:Tyih:∅ = ∅ → t.IsValue ∨ ∃ t', t ⟶ t'ht₁:t.IsValueh:t.IsValue → ∃ t₁ t₂, t = <{ ( t₁ , t₂ ) }>v₁:Tmv₂:Tmhv:t = <{ ( v₁ , v₂ ) }>⊢ ∃ t', <{ fst  ( v₁ , v₂ ) }> ⟶ t'; subst_varst:Tmτ:TyΓ:Contextτ₁:Tyτ₂:Tyv₁:Tmv₂:Tmih:∅ = ∅ → <{ ( v₁ , v₂ ) }>.IsValue ∨ ∃ t', <{ ( v₁ , v₂ ) }> ⟶ t'ht₁:<{ ( v₁ , v₂ ) }>.IsValueh:<{ ( v₁ , v₂ ) }>.IsValue → ∃ t₁ t₂, <{ ( v₁ , v₂ ) }> = <{ ( t₁ , t₂ ) }>⊢ ∃ t', <{ fst  ( v₁ , v₂ ) }> ⟶ t'; inversion ht₁pairt:Tmτ:TyΓ:Contextτ₁:Tyτ₂:Tyv₁:Tmv₂:Tmih:∅ = ∅ → <{ ( v₁ , v₂ ) }>.IsValue ∨ ∃ t', <{ ( v₁ , v₂ ) }> ⟶ t'h:<{ ( v₁ , v₂ ) }>.IsValue → ∃ t₁ t₂, <{ ( v₁ , v₂ ) }> = <{ ( t₁ , t₂ ) }>a✝¹:v₁.IsValuea✝:v₂.IsValue⊢ ∃ t', <{ fst  ( v₁ , v₂ ) }> ⟶ t'
        exists v₁pairt:Tmτ:TyΓ:Contextτ₁:Tyτ₂:Tyv₁:Tmv₂:Tmih:∅ = ∅ → <{ ( v₁ , v₂ ) }>.IsValue ∨ ∃ t', <{ ( v₁ , v₂ ) }> ⟶ t'h:<{ ( v₁ , v₂ ) }>.IsValue → ∃ t₁ t₂, <{ ( v₁ , v₂ ) }> = <{ ( t₁ , t₂ ) }>a✝¹:v₁.IsValuea✝:v₂.IsValue⊢ <{ fst  ( v₁ , v₂ ) }> ⟶ v₁; apply_rules using StlcSubEvalAll goals completed! 🐙
      -- t₁ is not a value
      case _ ht₁ =>t✝:Tmτ:TyΓ:Contextt:Tmτ₁:Tyτ₂:Tyh:<{ ∅ ⊢ ~(t) ⦂ τ₁ × τ₂ }>ih:∅ = ∅ → t.IsValue ∨ ∃ t', t ⟶ t'ht₁:∃ t', t ⟶ t'⊢ ∃ t', <{ fst t }> ⟶ t'
        obtain ⟨t₁', ht₁⟩ := ht₁t✝:Tmτ:TyΓ:Contextt:Tmτ₁:Tyτ₂:Tyh:<{ ∅ ⊢ ~(t) ⦂ τ₁ × τ₂ }>ih:∅ = ∅ → t.IsValue ∨ ∃ t', t ⟶ t't₁':Tmht₁:t ⟶ t₁'⊢ ∃ t', <{ fst t }> ⟶ t'
        exists <{fst ~t₁'}>t✝:Tmτ:TyΓ:Contextt:Tmτ₁:Tyτ₂:Tyh:<{ ∅ ⊢ ~(t) ⦂ τ₁ × τ₂ }>ih:∅ = ∅ → t.IsValue ∨ ∃ t', t ⟶ t't₁':Tmht₁:t ⟶ t₁'⊢ <{ fst t }> ⟶ <{ fst t₁' }>; apply_rules using StlcSubEvalAll goals completed! 🐙
  | snd Γ t τ₁ τ₂ h ih =>sndt✝:Tmτ:TyΓ:Contextt:Tmτ₁:Tyτ₂:Tyh:<{ ∅ ⊢ ~(t) ⦂ τ₁ × τ₂ }>ih:∅ = ∅ → t.IsValue ∨ ∃ t', t ⟶ t'⊢ <{ snd t }>.IsValue ∨ ∃ t', <{ snd t }> ⟶ t'
      rightsndt✝:Tmτ:TyΓ:Contextt:Tmτ₁:Tyτ₂:Tyh:<{ ∅ ⊢ ~(t) ⦂ τ₁ × τ₂ }>ih:∅ = ∅ → t.IsValue ∨ ∃ t', t ⟶ t'⊢ ∃ t', <{ snd t }> ⟶ t'; cases ih rflsnd.inlt✝:Tmτ:TyΓ:Contextt:Tmτ₁:Tyτ₂:Tyh:<{ ∅ ⊢ ~(t) ⦂ τ₁ × τ₂ }>ih:∅ = ∅ → t.IsValue ∨ ∃ t', t ⟶ t'h✝:t.IsValue⊢ ∃ t', <{ snd t }> ⟶ t'snd.inrt✝:Tmτ:TyΓ:Contextt:Tmτ₁:Tyτ₂:Tyh:<{ ∅ ⊢ ~(t) ⦂ τ₁ × τ₂ }>ih:∅ = ∅ → t.IsValue ∨ ∃ t', t ⟶ t'h✝:∃ t', t ⟶ t'⊢ ∃ t', <{ snd t }> ⟶ t'
      -- t₁ is a value
      case _ ht₁ =>t✝:Tmτ:TyΓ:Contextt:Tmτ₁:Tyτ₂:Tyh:<{ ∅ ⊢ ~(t) ⦂ τ₁ × τ₂ }>ih:∅ = ∅ → t.IsValue ∨ ∃ t', t ⟶ t'ht₁:t.IsValue⊢ ∃ t', <{ snd t }> ⟶ t'
        apply canonical_forms_of_product_types at ht✝:Tmτ:TyΓ:Contextt:Tmτ₁:Tyτ₂:Tyih:∅ = ∅ → t.IsValue ∨ ∃ t', t ⟶ t'ht₁:t.IsValueh:t.IsValue → ∃ t₁ t₂, t = <{ ( t₁ , t₂ ) }>⊢ ∃ t', <{ snd t }> ⟶ t'
        obtain ⟨v₁, v₂, hv⟩ := h ht₁t✝:Tmτ:TyΓ:Contextt:Tmτ₁:Tyτ₂:Tyih:∅ = ∅ → t.IsValue ∨ ∃ t', t ⟶ t'ht₁:t.IsValueh:t.IsValue → ∃ t₁ t₂, t = <{ ( t₁ , t₂ ) }>v₁:Tmv₂:Tmhv:t = <{ ( v₁ , v₂ ) }>⊢ ∃ t', <{ snd t }> ⟶ t'; rw [hvt✝:Tmτ:TyΓ:Contextt:Tmτ₁:Tyτ₂:Tyih:∅ = ∅ → t.IsValue ∨ ∃ t', t ⟶ t'ht₁:t.IsValueh:t.IsValue → ∃ t₁ t₂, t = <{ ( t₁ , t₂ ) }>v₁:Tmv₂:Tmhv:t = <{ ( v₁ , v₂ ) }>⊢ ∃ t', <{ snd  ( v₁ , v₂ ) }> ⟶ t']t✝:Tmτ:TyΓ:Contextt:Tmτ₁:Tyτ₂:Tyih:∅ = ∅ → t.IsValue ∨ ∃ t', t ⟶ t'ht₁:t.IsValueh:t.IsValue → ∃ t₁ t₂, t = <{ ( t₁ , t₂ ) }>v₁:Tmv₂:Tmhv:t = <{ ( v₁ , v₂ ) }>⊢ ∃ t', <{ snd  ( v₁ , v₂ ) }> ⟶ t'; subst_varst:Tmτ:TyΓ:Contextτ₁:Tyτ₂:Tyv₁:Tmv₂:Tmih:∅ = ∅ → <{ ( v₁ , v₂ ) }>.IsValue ∨ ∃ t', <{ ( v₁ , v₂ ) }> ⟶ t'ht₁:<{ ( v₁ , v₂ ) }>.IsValueh:<{ ( v₁ , v₂ ) }>.IsValue → ∃ t₁ t₂, <{ ( v₁ , v₂ ) }> = <{ ( t₁ , t₂ ) }>⊢ ∃ t', <{ snd  ( v₁ , v₂ ) }> ⟶ t'; inversion ht₁pairt:Tmτ:TyΓ:Contextτ₁:Tyτ₂:Tyv₁:Tmv₂:Tmih:∅ = ∅ → <{ ( v₁ , v₂ ) }>.IsValue ∨ ∃ t', <{ ( v₁ , v₂ ) }> ⟶ t'h:<{ ( v₁ , v₂ ) }>.IsValue → ∃ t₁ t₂, <{ ( v₁ , v₂ ) }> = <{ ( t₁ , t₂ ) }>a✝¹:v₁.IsValuea✝:v₂.IsValue⊢ ∃ t', <{ snd  ( v₁ , v₂ ) }> ⟶ t'
        exists v₂pairt:Tmτ:TyΓ:Contextτ₁:Tyτ₂:Tyv₁:Tmv₂:Tmih:∅ = ∅ → <{ ( v₁ , v₂ ) }>.IsValue ∨ ∃ t', <{ ( v₁ , v₂ ) }> ⟶ t'h:<{ ( v₁ , v₂ ) }>.IsValue → ∃ t₁ t₂, <{ ( v₁ , v₂ ) }> = <{ ( t₁ , t₂ ) }>a✝¹:v₁.IsValuea✝:v₂.IsValue⊢ <{ snd  ( v₁ , v₂ ) }> ⟶ v₂; apply_rules using StlcSubEvalAll goals completed! 🐙
      -- t₁ is not a value
      case _ ht₁ =>t✝:Tmτ:TyΓ:Contextt:Tmτ₁:Tyτ₂:Tyh:<{ ∅ ⊢ ~(t) ⦂ τ₁ × τ₂ }>ih:∅ = ∅ → t.IsValue ∨ ∃ t', t ⟶ t'ht₁:∃ t', t ⟶ t'⊢ ∃ t', <{ snd t }> ⟶ t'
        obtain ⟨t₁', ht₁⟩ := ht₁t✝:Tmτ:TyΓ:Contextt:Tmτ₁:Tyτ₂:Tyh:<{ ∅ ⊢ ~(t) ⦂ τ₁ × τ₂ }>ih:∅ = ∅ → t.IsValue ∨ ∃ t', t ⟶ t't₁':Tmht₁:t ⟶ t₁'⊢ ∃ t', <{ snd t }> ⟶ t'
        exists <{snd ~t₁'}>t✝:Tmτ:TyΓ:Contextt:Tmτ₁:Tyτ₂:Tyh:<{ ∅ ⊢ ~(t) ⦂ τ₁ × τ₂ }>ih:∅ = ∅ → t.IsValue ∨ ∃ t', t ⟶ t't₁':Tmht₁:t ⟶ t₁'⊢ <{ snd t }> ⟶ <{ snd t₁' }>; apply_rules using StlcSubEvalAll goals completed! 🐙

8.3.4. Inversion Lemmas for Typing🔗

The proof of the preservation theorem also becomes a little more complex with the addition of subtyping. The reason is that, as with the "inversion lemmas for subtyping" above, there are a number of facts about the typing relation that are immediate from the definition in the pure STLC (formally: that can be obtained directly from the inversion tactic) but that require real proofs in the presence of subtyping because there are multiple ways to derive the same HasType statement.

The following inversion lemma tells us that, if we have a derivation of some typing statement Γ ⊢ λ x : σ₁ . t₂ ⦂ τ whose subject is an abstraction, then there must be some subderivation giving a type to the body t₂.

Lemma: If Γ ⊢ λ x : σ₁ . t₂ ⦂ τ, then there is a type σ₂ such that x ↦ σ₁ ; Γ ⊢ t₂ ⦂ σ and σ₁ → σ₂ <: τ.

Notice that the lemma does not say, "then τ itself is an arrow type" -- this is tempting, but false! (Why?)

Proof: Let Γ, x, σ₁, t₂ and τ be given as described. Proceed by induction on the derivation of Γ ⊢ λ x : σ₁ . t₂ ⦂ τ. The cases for var and app are vacuous as those rules cannot be used to give a type to a syntactic abstraction.

If the last step of the derivation is a use of abs then there is a type τ₁₂ such that τ = σ₁ → τ₁₂ and x ↦ σ₁; Γ ⊢ t₂ ⦂ τ₁₂. Picking τ₁₂ for σ₂ gives us what we need, since σ₁ → τ₁₂ <: σ₁ → τ₁₂ follows from rfl.
If the last step of the derivation is a use of sub then there is a type σ such that σ <: τ and Γ ⊢ λx : σ₁, t₂ ⦂ σ. The IH for the typing subderivation tells us that there is some type σ₂ with σ₁ → σ₂ <: σ and x↦σ₁; Γ ⊢ t₂ ⦂ σ₂. Picking type σ₂ gives us what we need, since σ₁ → σ₂ <: τ then follows by trans.

Formally:

theorem typing_inversion_abs {Γ : Context} {x : String} {σ₁ : Ty} {t₂ : Tm} {τ : Ty}
  (h : <{ ~Γ ⊢ λ ~x : ~σ₁ . ~t₂ ⦂ ~τ }>) :
    ∃ σ₂, <{ ~σ₁ → ~σ₂ }> <: τ ∧ <{ ~x ↦ ~σ₁ ; ~Γ ⊢ ~t₂ ⦂ ~σ₂ }> := byΓ:Contextx:Stringσ₁:Tyt₂:Tmτ:Tyh:<{ ~(Γ) ⊢ λ ~x : σ₁ . t₂ ⦂ ~(τ) }>⊢ ∃ σ₂, <{ σ₁ → σ₂ }> <: τ ∧ <{ ~(x →ₚ σ₁ ; Γ) ⊢ ~(t₂) ⦂ ~(σ₂) }>

  generalize heq : <{ λ ~x : ~σ₁ . ~t₂ }> = t at hΓ:Contextx:Stringσ₁:Tyt₂:Tmτ:Tyt:Tmheq:<{ λ ~x : σ₁ . t₂ }> = th:<{ ~(Γ) ⊢ ~(t) ⦂ ~(τ) }>⊢ ∃ σ₂, <{ σ₁ → σ₂ }> <: τ ∧ <{ ~(x →ₚ σ₁ ; Γ) ⊢ ~(t₂) ⦂ ~(σ₂) }>
  induction h with (subst_varssndΓ:Contextx:Stringσ₁:Tyt₂:Tmτ:Tyt:TmΓ✝:Contextt✝:Tmτ₁✝:Tyτ₂✝:Tyh✝:<{ ~(Γ✝) ⊢ ~(t✝) ⦂ τ₁✝ × τ₂✝ }>h_ih✝:<{ λ ~x : σ₁ . t₂ }> = t✝ → ∃ σ₂, <{ σ₁ → σ₂ }> <: <{ τ₁✝ × τ₂✝ }> ∧ <{ ~(x →ₚ σ₁ ; Γ✝) ⊢ ~(t₂) ⦂ ~(σ₂) }>heq:<{ λ ~x : σ₁ . t₂ }> = <{ snd t✝ }>⊢ ∃ σ₂, <{ σ₁ → σ₂ }> <: τ₂✝ ∧ <{ ~(x →ₚ σ₁ ; Γ✝) ⊢ ~(t₂) ⦂ ~(σ₂) }>; try contradictionAll goals completed! 🐙)
  | abs Γ x τ₁ τ₂ t₁ h i =>absΓ✝:Contextx✝:Stringσ₁:Tyt₂:Tmτ:Tyt:TmΓ:Contextx:Stringτ₁:Tyτ₂:Tyt₁:Tmh:<{ ~(x →ₚ τ₂ ; Γ) ⊢ ~(t₁) ⦂ ~(τ₁) }>i:<{ λ ~x✝ : σ₁ . t₂ }> = t₁ → ∃ σ₂, <{ σ₁ → σ₂ }> <: τ₁ ∧ <{ ~(x✝ →ₚ σ₁ ; x →ₚ τ₂ ; Γ) ⊢ ~(t₂) ⦂ ~(σ₂) }>heq:<{ λ ~x✝ : σ₁ . t₂ }> = <{ λ ~x : τ₂ . t₁ }>⊢ ∃ σ₂, <{ σ₁ → σ₂ }> <: <{ τ₂ → τ₁ }> ∧ <{ ~(x✝ →ₚ σ₁ ; Γ) ⊢ ~(t₂) ⦂ ~(σ₂) }>
      inversion heqreflΓ✝:Contextx:Stringσ₁:Tyt₂:Tmτ:Tyt:TmΓ:Contextτ₁:Tyh:<{ ~(x →ₚ σ₁ ; Γ) ⊢ ~(t₂) ⦂ ~(τ₁) }>i:<{ λ ~x : σ₁ . t₂ }> = t₂ → ∃ σ₂, <{ σ₁ → σ₂ }> <: τ₁ ∧ <{ ~(x →ₚ σ₁ ; x →ₚ σ₁ ; Γ) ⊢ ~(t₂) ⦂ ~(σ₂) }>⊢ ∃ σ₂, <{ σ₁ → σ₂ }> <: <{ σ₁ → τ₁ }> ∧ <{ ~(x →ₚ σ₁ ; Γ) ⊢ ~(t₂) ⦂ ~(σ₂) }>; exists τ₁reflΓ✝:Contextx:Stringσ₁:Tyt₂:Tmτ:Tyt:TmΓ:Contextτ₁:Tyh:<{ ~(x →ₚ σ₁ ; Γ) ⊢ ~(t₂) ⦂ ~(τ₁) }>i:<{ λ ~x : σ₁ . t₂ }> = t₂ → ∃ σ₂, <{ σ₁ → σ₂ }> <: τ₁ ∧ <{ ~(x →ₚ σ₁ ; x →ₚ σ₁ ; Γ) ⊢ ~(t₂) ⦂ ~(σ₂) }>⊢ <{ σ₁ → τ₁ }> <: <{ σ₁ → τ₁ }> ∧ <{ ~(x →ₚ σ₁ ; Γ) ⊢ ~(t₂) ⦂ ~(τ₁) }>; solve_by_elim using StlcSubTypingAll goals completed! 🐙
  | sub Γ t₁ τ₁ τ₂ ht hs ih =>subΓ✝:Contextx:Stringσ₁:Tyt₂:Tmτ:Tyt:TmΓ:Contextτ₁:Tyτ₂:Tyhs:τ₁ <: τ₂ht:<{ ~(Γ) ⊢ λ ~x : σ₁ . t₂ ⦂ ~(τ₁) }>ih:<{ λ ~x : σ₁ . t₂ }> = <{ λ ~x : σ₁ . t₂ }> → ∃ σ₂, <{ σ₁ → σ₂ }> <: τ₁ ∧ <{ ~(x →ₚ σ₁ ; Γ) ⊢ ~(t₂) ⦂ ~(σ₂) }>⊢ ∃ σ₂, <{ σ₁ → σ₂ }> <: τ₂ ∧ <{ ~(x →ₚ σ₁ ; Γ) ⊢ ~(t₂) ⦂ ~(σ₂) }>
      obtain ⟨σ₂, hs', ht'⟩ := ih rflsubΓ✝:Contextx:Stringσ₁:Tyt₂:Tmτ:Tyt:TmΓ:Contextτ₁:Tyτ₂:Tyhs:τ₁ <: τ₂ht:<{ ~(Γ) ⊢ λ ~x : σ₁ . t₂ ⦂ ~(τ₁) }>ih:<{ λ ~x : σ₁ . t₂ }> = <{ λ ~x : σ₁ . t₂ }> → ∃ σ₂, <{ σ₁ → σ₂ }> <: τ₁ ∧ <{ ~(x →ₚ σ₁ ; Γ) ⊢ ~(t₂) ⦂ ~(σ₂) }>σ₂:Tyhs':<{ σ₁ → σ₂ }> <: τ₁ht':<{ ~(x →ₚ σ₁ ; Γ) ⊢ ~(t₂) ⦂ ~(σ₂) }>⊢ ∃ σ₂, <{ σ₁ → σ₂ }> <: τ₂ ∧ <{ ~(x →ₚ σ₁ ; Γ) ⊢ ~(t₂) ⦂ ~(σ₂) }>
      exists σ₂subΓ✝:Contextx:Stringσ₁:Tyt₂:Tmτ:Tyt:TmΓ:Contextτ₁:Tyτ₂:Tyhs:τ₁ <: τ₂ht:<{ ~(Γ) ⊢ λ ~x : σ₁ . t₂ ⦂ ~(τ₁) }>ih:<{ λ ~x : σ₁ . t₂ }> = <{ λ ~x : σ₁ . t₂ }> → ∃ σ₂, <{ σ₁ → σ₂ }> <: τ₁ ∧ <{ ~(x →ₚ σ₁ ; Γ) ⊢ ~(t₂) ⦂ ~(σ₂) }>σ₂:Tyhs':<{ σ₁ → σ₂ }> <: τ₁ht':<{ ~(x →ₚ σ₁ ; Γ) ⊢ ~(t₂) ⦂ ~(σ₂) }>⊢ <{ σ₁ → σ₂ }> <: τ₂ ∧ <{ ~(x →ₚ σ₁ ; Γ) ⊢ ~(t₂) ⦂ ~(σ₂) }>; solve_by_elim using StlcSubTypingAll goals completed! 🐙

Exercise★★★(typing_inversion_var) (Optional)

theorem typing_inversion_var {Γ : Context} {x : String} {τ : Ty}
  (h : <{ ~Γ ⊢ ~(.var x) ⦂ ~τ }>) :
  ∃ σ, Γ[x] = some σ ∧ σ <: τ := byΓ:Contextx:Stringτ:Tyh:<{ ~(Γ) ⊢ ~(StlcSub.Tm.var x) ⦂ ~(τ) }>⊢ ∃ σ, Γ[x] = some σ ∧ σ <: τ

  solution!
    generalize heq : Tm.var x = t at hΓ:Contextx:Stringτ:Tyt:Tmheq:StlcSub.Tm.var x = th:<{ ~(Γ) ⊢ ~(t) ⦂ ~(τ) }>⊢ ∃ σ, Γ[x] = some σ ∧ σ <: τ
    induction h with (subst_varssndΓ:Contextx:Stringτ:Tyt:TmΓ✝:Contextt✝:Tmτ₁✝:Tyτ₂✝:Tyh✝:<{ ~(Γ✝) ⊢ ~(t✝) ⦂ τ₁✝ × τ₂✝ }>h_ih✝:StlcSub.Tm.var x = t✝ → ∃ σ, Γ✝[x] = some σ ∧ σ <: <{ τ₁✝ × τ₂✝ }>heq:StlcSub.Tm.var x = <{ snd t✝ }>⊢ ∃ σ, Γ✝[x] = some σ ∧ σ <: τ₂✝; try contradictionAll goals completed! 🐙)
    | var Γ y τ₁ h =>varΓ✝:Contextx:Stringτ:Tyt:TmΓ:Contexty:Stringτ₁:Tyh:Γ[y] = some τ₁heq:StlcSub.Tm.var x = StlcSub.Tm.var y⊢ ∃ σ, Γ[x] = some σ ∧ σ <: τ₁ inversion heqreflΓ✝:Contextx:Stringτ:Tyt:TmΓ:Contextτ₁:Tyh:Γ[x] = some τ₁⊢ ∃ σ, Γ[x] = some σ ∧ σ <: τ₁; solve_by_elim using StlcSubTypingAll goals completed! 🐙
    | sub Γ t₁ τ₁ τ₂ ht hs ih =>subΓ✝:Contextx:Stringτ:Tyt:TmΓ:Contextτ₁:Tyτ₂:Tyhs:τ₁ <: τ₂ht:<{ ~(Γ) ⊢ ~(StlcSub.Tm.var x) ⦂ ~(τ₁) }>ih:StlcSub.Tm.var x = StlcSub.Tm.var x → ∃ σ, Γ[x] = some σ ∧ σ <: τ₁⊢ ∃ σ, Γ[x] = some σ ∧ σ <: τ₂
        obtain ⟨σ₂, hs', ht'⟩ := ih rflsubΓ✝:Contextx:Stringτ:Tyt:TmΓ:Contextτ₁:Tyτ₂:Tyhs:τ₁ <: τ₂ht:<{ ~(Γ) ⊢ ~(StlcSub.Tm.var x) ⦂ ~(τ₁) }>ih:StlcSub.Tm.var x = StlcSub.Tm.var x → ∃ σ, Γ[x] = some σ ∧ σ <: τ₁σ₂:Tyhs':Γ[x] = some σ₂ht':σ₂ <: τ₁⊢ ∃ σ, Γ[x] = some σ ∧ σ <: τ₂
        exists σ₂subΓ✝:Contextx:Stringτ:Tyt:TmΓ:Contextτ₁:Tyτ₂:Tyhs:τ₁ <: τ₂ht:<{ ~(Γ) ⊢ ~(StlcSub.Tm.var x) ⦂ ~(τ₁) }>ih:StlcSub.Tm.var x = StlcSub.Tm.var x → ∃ σ, Γ[x] = some σ ∧ σ <: τ₁σ₂:Tyhs':Γ[x] = some σ₂ht':σ₂ <: τ₁⊢ Γ[x] = some σ₂ ∧ σ₂ <: τ₂; solve_by_elim using StlcSubTypingAll goals completed! 🐙

Exercise★★★(typing_inversion_app) (Optional)

theorem typing_inversion_app {Γ : Context} {t₁ t₂ : Tm} {τ₂ : Ty}
  (h : <{ ~Γ ⊢ ~t₁ ~t₂ ⦂ ~τ₂ }>) :
  ∃ τ₁, <{ ~Γ ⊢ ~t₁ ⦂ ~τ₁ → ~τ₂ }> ∧ <{ ~Γ ⊢ ~t₂ ⦂ ~τ₁ }> := byΓ:Contextt₁:Tmt₂:Tmτ₂:Tyh:<{ ~(Γ) ⊢ t₁ t₂ ⦂ ~(τ₂) }>⊢ ∃ τ₁, <{ ~(Γ) ⊢ ~(t₁) ⦂ τ₁ → τ₂ }> ∧ <{ ~(Γ) ⊢ ~(t₂) ⦂ ~(τ₁) }>
  solution!
    generalize heq : <{ ~t₁ ~t₂ }> = t at hΓ:Contextt₁:Tmt₂:Tmτ₂:Tyt:Tmheq:<{ t₁ t₂ }> = th:<{ ~(Γ) ⊢ ~(t) ⦂ ~(τ₂) }>⊢ ∃ τ₁, <{ ~(Γ) ⊢ ~(t₁) ⦂ τ₁ → τ₂ }> ∧ <{ ~(Γ) ⊢ ~(t₂) ⦂ ~(τ₁) }>
    induction h with (subst_varssndΓ:Contextt₁:Tmt₂:Tmτ₂:Tyt:TmΓ✝:Contextt✝:Tmτ₁✝:Tyτ₂✝:Tyh✝:<{ ~(Γ✝) ⊢ ~(t✝) ⦂ τ₁✝ × τ₂✝ }>h_ih✝:<{ t₁ t₂ }> = t✝ → ∃ τ₁, <{ ~(Γ✝) ⊢ ~(t₁) ⦂ τ₁ → τ₁✝ × τ₂✝ }> ∧ <{ ~(Γ✝) ⊢ ~(t₂) ⦂ ~(τ₁) }>heq:<{ t₁ t₂ }> = <{ snd t✝ }>⊢ ∃ τ₁, <{ ~(Γ✝) ⊢ ~(t₁) ⦂ τ₁ → τ₂✝ }> ∧ <{ ~(Γ✝) ⊢ ~(t₂) ⦂ ~(τ₁) }>; try contradictionAll goals completed! 🐙)
    | app =>appΓ:Contextt₁:Tmt₂:Tmτ₂:Tyt:TmΓ✝:Contextτ₁✝:Tyτ₂✝:Tyt₁✝:Tmt₂✝:Tmh₁✝:<{ ~(Γ✝) ⊢ ~(t₁✝) ⦂ τ₂✝ → τ₁✝ }>h₂✝:<{ ~(Γ✝) ⊢ ~(t₂✝) ⦂ ~(τ₂✝) }>h₁_ih✝:<{ t₁ t₂ }> = t₁✝ → ∃ τ₁, <{ ~(Γ✝) ⊢ ~(t₁) ⦂ τ₁ → τ₂✝ → τ₁✝ }> ∧ <{ ~(Γ✝) ⊢ ~(t₂) ⦂ ~(τ₁) }>h₂_ih✝:<{ t₁ t₂ }> = t₂✝ → ∃ τ₁, <{ ~(Γ✝) ⊢ ~(t₁) ⦂ τ₁ → τ₂✝ }> ∧ <{ ~(Γ✝) ⊢ ~(t₂) ⦂ ~(τ₁) }>heq:<{ t₁ t₂ }> = <{ t₁✝ t₂✝ }>⊢ ∃ τ₁, <{ ~(Γ✝) ⊢ ~(t₁) ⦂ τ₁ → τ₁✝ }> ∧ <{ ~(Γ✝) ⊢ ~(t₂) ⦂ ~(τ₁) }> inversion heqreflΓ:Contextt₁:Tmt₂:Tmτ₂:Tyt:TmΓ✝:Contextτ₁✝:Tyτ₂✝:Tyh₁✝:<{ ~(Γ✝) ⊢ ~(t₁) ⦂ τ₂✝ → τ₁✝ }>h₁_ih✝:<{ t₁ t₂ }> = t₁ → ∃ τ₁, <{ ~(Γ✝) ⊢ ~(t₁) ⦂ τ₁ → τ₂✝ → τ₁✝ }> ∧ <{ ~(Γ✝) ⊢ ~(t₂) ⦂ ~(τ₁) }>h₂✝:<{ ~(Γ✝) ⊢ ~(t₂) ⦂ ~(τ₂✝) }>h₂_ih✝:<{ t₁ t₂ }> = t₂ → ∃ τ₁, <{ ~(Γ✝) ⊢ ~(t₁) ⦂ τ₁ → τ₂✝ }> ∧ <{ ~(Γ✝) ⊢ ~(t₂) ⦂ ~(τ₁) }>⊢ ∃ τ₁, <{ ~(Γ✝) ⊢ ~(t₁) ⦂ τ₁ → τ₁✝ }> ∧ <{ ~(Γ✝) ⊢ ~(t₂) ⦂ ~(τ₁) }>; solve_by_elim using StlcSubTypingAll goals completed! 🐙
    | sub Γ t₁ τ₁ τ₂ ht hs ih =>subΓ✝:Contextt₁:Tmt₂:Tmτ₂✝:Tyt:TmΓ:Contextτ₁:Tyτ₂:Tyhs:τ₁ <: τ₂ht:<{ ~(Γ) ⊢ t₁ t₂ ⦂ ~(τ₁) }>ih:<{ t₁ t₂ }> = <{ t₁ t₂ }> → ∃ τ₁_1, <{ ~(Γ) ⊢ ~(t₁) ⦂ τ₁_1 → τ₁ }> ∧ <{ ~(Γ) ⊢ ~(t₂) ⦂ ~(τ₁_1) }>⊢ ∃ τ₁, <{ ~(Γ) ⊢ ~(t₁) ⦂ τ₁ → τ₂ }> ∧ <{ ~(Γ) ⊢ ~(t₂) ⦂ ~(τ₁) }>
        obtain ⟨σ₂, hs', ht'⟩ := ih rflsubΓ✝:Contextt₁:Tmt₂:Tmτ₂✝:Tyt:TmΓ:Contextτ₁:Tyτ₂:Tyhs:τ₁ <: τ₂ht:<{ ~(Γ) ⊢ t₁ t₂ ⦂ ~(τ₁) }>ih:<{ t₁ t₂ }> = <{ t₁ t₂ }> → ∃ τ₁_1, <{ ~(Γ) ⊢ ~(t₁) ⦂ τ₁_1 → τ₁ }> ∧ <{ ~(Γ) ⊢ ~(t₂) ⦂ ~(τ₁_1) }>σ₂:Tyhs':<{ ~(Γ) ⊢ ~(t₁) ⦂ σ₂ → τ₁ }>ht':<{ ~(Γ) ⊢ ~(t₂) ⦂ ~(σ₂) }>⊢ ∃ τ₁, <{ ~(Γ) ⊢ ~(t₁) ⦂ τ₁ → τ₂ }> ∧ <{ ~(Γ) ⊢ ~(t₂) ⦂ ~(τ₁) }>
        exists σ₂subΓ✝:Contextt₁:Tmt₂:Tmτ₂✝:Tyt:TmΓ:Contextτ₁:Tyτ₂:Tyhs:τ₁ <: τ₂ht:<{ ~(Γ) ⊢ t₁ t₂ ⦂ ~(τ₁) }>ih:<{ t₁ t₂ }> = <{ t₁ t₂ }> → ∃ τ₁_1, <{ ~(Γ) ⊢ ~(t₁) ⦂ τ₁_1 → τ₁ }> ∧ <{ ~(Γ) ⊢ ~(t₂) ⦂ ~(τ₁_1) }>σ₂:Tyhs':<{ ~(Γ) ⊢ ~(t₁) ⦂ σ₂ → τ₁ }>ht':<{ ~(Γ) ⊢ ~(t₂) ⦂ ~(σ₂) }>⊢ <{ ~(Γ) ⊢ ~(t₁) ⦂ σ₂ → τ₂ }> ∧ <{ ~(Γ) ⊢ ~(t₂) ⦂ ~(σ₂) }>; constructorsub.leftΓ✝:Contextt₁:Tmt₂:Tmτ₂✝:Tyt:TmΓ:Contextτ₁:Tyτ₂:Tyhs:τ₁ <: τ₂ht:<{ ~(Γ) ⊢ t₁ t₂ ⦂ ~(τ₁) }>ih:<{ t₁ t₂ }> = <{ t₁ t₂ }> → ∃ τ₁_1, <{ ~(Γ) ⊢ ~(t₁) ⦂ τ₁_1 → τ₁ }> ∧ <{ ~(Γ) ⊢ ~(t₂) ⦂ ~(τ₁_1) }>σ₂:Tyhs':<{ ~(Γ) ⊢ ~(t₁) ⦂ σ₂ → τ₁ }>ht':<{ ~(Γ) ⊢ ~(t₂) ⦂ ~(σ₂) }>⊢ <{ ~(Γ) ⊢ ~(t₁) ⦂ σ₂ → τ₂ }>sub.rightΓ✝:Contextt₁:Tmt₂:Tmτ₂✝:Tyt:TmΓ:Contextτ₁:Tyτ₂:Tyhs:τ₁ <: τ₂ht:<{ ~(Γ) ⊢ t₁ t₂ ⦂ ~(τ₁) }>ih:<{ t₁ t₂ }> = <{ t₁ t₂ }> → ∃ τ₁_1, <{ ~(Γ) ⊢ ~(t₁) ⦂ τ₁_1 → τ₁ }> ∧ <{ ~(Γ) ⊢ ~(t₂) ⦂ ~(τ₁_1) }>σ₂:Tyhs':<{ ~(Γ) ⊢ ~(t₁) ⦂ σ₂ → τ₁ }>ht':<{ ~(Γ) ⊢ ~(t₂) ⦂ ~(σ₂) }>⊢ <{ ~(Γ) ⊢ ~(t₂) ⦂ ~(σ₂) }> <;>sub.leftΓ✝:Contextt₁:Tmt₂:Tmτ₂✝:Tyt:TmΓ:Contextτ₁:Tyτ₂:Tyhs:τ₁ <: τ₂ht:<{ ~(Γ) ⊢ t₁ t₂ ⦂ ~(τ₁) }>ih:<{ t₁ t₂ }> = <{ t₁ t₂ }> → ∃ τ₁_1, <{ ~(Γ) ⊢ ~(t₁) ⦂ τ₁_1 → τ₁ }> ∧ <{ ~(Γ) ⊢ ~(t₂) ⦂ ~(τ₁_1) }>σ₂:Tyhs':<{ ~(Γ) ⊢ ~(t₁) ⦂ σ₂ → τ₁ }>ht':<{ ~(Γ) ⊢ ~(t₂) ⦂ ~(σ₂) }>⊢ <{ ~(Γ) ⊢ ~(t₁) ⦂ σ₂ → τ₂ }>sub.rightΓ✝:Contextt₁:Tmt₂:Tmτ₂✝:Tyt:TmΓ:Contextτ₁:Tyτ₂:Tyhs:τ₁ <: τ₂ht:<{ ~(Γ) ⊢ t₁ t₂ ⦂ ~(τ₁) }>ih:<{ t₁ t₂ }> = <{ t₁ t₂ }> → ∃ τ₁_1, <{ ~(Γ) ⊢ ~(t₁) ⦂ τ₁_1 → τ₁ }> ∧ <{ ~(Γ) ⊢ ~(t₂) ⦂ ~(τ₁_1) }>σ₂:Tyhs':<{ ~(Γ) ⊢ ~(t₁) ⦂ σ₂ → τ₁ }>ht':<{ ~(Γ) ⊢ ~(t₂) ⦂ ~(σ₂) }>⊢ <{ ~(Γ) ⊢ ~(t₂) ⦂ ~(σ₂) }> try assumptionAll goals completed! 🐙
        apply HasType.sub _ _ _ _ hs'sub.leftΓ✝:Contextt₁:Tmt₂:Tmτ₂✝:Tyt:TmΓ:Contextτ₁:Tyτ₂:Tyhs:τ₁ <: τ₂ht:<{ ~(Γ) ⊢ t₁ t₂ ⦂ ~(τ₁) }>ih:<{ t₁ t₂ }> = <{ t₁ t₂ }> → ∃ τ₁_1, <{ ~(Γ) ⊢ ~(t₁) ⦂ τ₁_1 → τ₁ }> ∧ <{ ~(Γ) ⊢ ~(t₂) ⦂ ~(τ₁_1) }>σ₂:Tyhs':<{ ~(Γ) ⊢ ~(t₁) ⦂ σ₂ → τ₁ }>ht':<{ ~(Γ) ⊢ ~(t₂) ⦂ ~(σ₂) }>⊢ <{ σ₂ → τ₁ }> <: <{ σ₂ → τ₂ }>
        solve_by_elim using StlcSubTypingAll goals completed! 🐙

theorem typing_inversion_unit (Γ : Context) (τ : Ty)
  (h : <{ ~Γ ⊢ unit ⦂ ~τ }>) :
  <{ Unit }> <: τ := byΓ:Contextτ:Tyh:<{ ~(Γ) ⊢ unit ⦂ ~(τ) }>⊢ <{ Unit }> <: τ

  generalize heq : Tm.unit = t at hΓ:Contextτ:Tyt:Tmheq:<{ unit }> = th:<{ ~(Γ) ⊢ ~(t) ⦂ ~(τ) }>⊢ <{ Unit }> <: τ
  induction h with (subst_varssndΓ:Contextτ:Tyt:TmΓ✝:Contextt✝:Tmτ₁✝:Tyτ₂✝:Tyh✝:<{ ~(Γ✝) ⊢ ~(t✝) ⦂ τ₁✝ × τ₂✝ }>h_ih✝:<{ unit }> = t✝ → <{ Unit }> <: <{ τ₁✝ × τ₂✝ }>heq:<{ unit }> = <{ snd t✝ }>⊢ <{ Unit }> <: τ₂✝; try contradictionAll goals completed! 🐙)
  | unit =>unitΓ:Contextτ:Tyt:TmΓ✝:Contextheq:<{ unit }> = <{ unit }>⊢ <{ Unit }> <: <{ Unit }> inversion heqreflΓ:Contextτ:Tyt:TmΓ✝:Context⊢ <{ Unit }> <: <{ Unit }>; solve_by_elim using StlcSubTypingAll goals completed! 🐙
  | sub Γ t₁ τ₁ τ₂ ht hs ih =>subΓ✝:Contextτ:Tyt:TmΓ:Contextτ₁:Tyτ₂:Tyhs:τ₁ <: τ₂ht:<{ ~(Γ) ⊢ unit ⦂ ~(τ₁) }>ih:<{ unit }> = <{ unit }> → <{ Unit }> <: τ₁⊢ <{ Unit }> <: τ₂
      specialize ih rflsubΓ✝:Contextτ:Tyt:TmΓ:Contextτ₁:Tyτ₂:Tyhs:τ₁ <: τ₂ht:<{ ~(Γ) ⊢ unit ⦂ ~(τ₁) }>ih:<{ Unit }> <: τ₁⊢ <{ Unit }> <: τ₂
      solve_by_elim using StlcSubTypingAll goals completed! 🐙

-- Add your lemmas for products here when you get to that exercise

theorem typing_inversion_pair {Γ : Context} {t₁ t₂ : Tm} {τ : Ty}
  (h : <{ ~Γ ⊢ (~t₁, ~t₂) ⦂ ~τ }>) :
  ∃ τ₁ τ₂, <{ ~τ₁ × ~τ₂ }> <: τ ∧ <{ ~Γ ⊢ ~t₁ ⦂ ~τ₁ }> ∧ <{ ~Γ ⊢ ~t₂ ⦂ ~τ₂ }> := byΓ:Contextt₁:Tmt₂:Tmτ:Tyh:<{ ~(Γ) ⊢ ( t₁ , t₂ ) ⦂ ~(τ) }>⊢ ∃ τ₁ τ₂, <{ τ₁ × τ₂ }> <: τ ∧ <{ ~(Γ) ⊢ ~(t₁) ⦂ ~(τ₁) }> ∧ <{ ~(Γ) ⊢ ~(t₂) ⦂ ~(τ₂) }>

    generalize heq : <{ (~t₁, ~t₂) }> = t at hΓ:Contextt₁:Tmt₂:Tmτ:Tyt:Tmheq:<{ ( t₁ , t₂ ) }> = th:<{ ~(Γ) ⊢ ~(t) ⦂ ~(τ) }>⊢ ∃ τ₁ τ₂, <{ τ₁ × τ₂ }> <: τ ∧ <{ ~(Γ) ⊢ ~(t₁) ⦂ ~(τ₁) }> ∧ <{ ~(Γ) ⊢ ~(t₂) ⦂ ~(τ₂) }>
    induction h generalizing t₁ t₂ with (subst_varssndΓ:Contextτ:Tyt:TmΓ✝:Contextt✝:Tmτ₁✝:Tyτ₂✝:Tyh✝:<{ ~(Γ✝) ⊢ ~(t✝) ⦂ τ₁✝ × τ₂✝ }>h_ih✝:∀ {t₁ t₂ : Tm},
  <{ ( t₁ , t₂ ) }> = t✝ →
    ∃ τ₁ τ₂, <{ τ₁ × τ₂ }> <: <{ τ₁✝ × τ₂✝ }> ∧ <{ ~(Γ✝) ⊢ ~(t₁) ⦂ ~(τ₁) }> ∧ <{ ~(Γ✝) ⊢ ~(t₂) ⦂ ~(τ₂) }>t₁:Tmt₂:Tmheq:<{ ( t₁ , t₂ ) }> = <{ snd t✝ }>⊢ ∃ τ₁ τ₂, <{ τ₁ × τ₂ }> <: τ₂✝ ∧ <{ ~(Γ✝) ⊢ ~(t₁) ⦂ ~(τ₁) }> ∧ <{ ~(Γ✝) ⊢ ~(t₂) ⦂ ~(τ₂) }>; try contradictionAll goals completed! 🐙)
    | pair Γ t₁ t₂ τ₁ τ₂ h₁ h₂ ih₁ ih₂ =>pairΓ✝:Contextτ:Tyt:TmΓ:Contextt₁✝:Tmt₂✝:Tmτ₁:Tyτ₂:Tyh₁:<{ ~(Γ) ⊢ ~(t₁✝) ⦂ ~(τ₁) }>h₂:<{ ~(Γ) ⊢ ~(t₂✝) ⦂ ~(τ₂) }>ih₁:∀ {t₁ t₂ : Tm},
  <{ ( t₁ , t₂ ) }> = t₁✝ → ∃ τ₁_1 τ₂, <{ τ₁_1 × τ₂ }> <: τ₁ ∧ <{ ~(Γ) ⊢ ~(t₁) ⦂ ~(τ₁_1) }> ∧ <{ ~(Γ) ⊢ ~(t₂) ⦂ ~(τ₂) }>ih₂:∀ {t₁ t₂ : Tm},
  <{ ( t₁ , t₂ ) }> = t₂✝ → ∃ τ₁ τ₂_1, <{ τ₁ × τ₂_1 }> <: τ₂ ∧ <{ ~(Γ) ⊢ ~(t₁) ⦂ ~(τ₁) }> ∧ <{ ~(Γ) ⊢ ~(t₂) ⦂ ~(τ₂_1) }>t₁:Tmt₂:Tmheq:<{ ( t₁ , t₂ ) }> = <{ ( t₁✝ , t₂✝ ) }>⊢ ∃ τ₁_1 τ₂_1, <{ τ₁_1 × τ₂_1 }> <: <{ τ₁ × τ₂ }> ∧ <{ ~(Γ) ⊢ ~(t₁) ⦂ ~(τ₁_1) }> ∧ <{ ~(Γ) ⊢ ~(t₂) ⦂ ~(τ₂_1) }>
        inversion heqreflΓ✝:Contextτ:Tyt:TmΓ:Contextt₁:Tmt₂:Tmτ₁:Tyτ₂:Tyh₁:<{ ~(Γ) ⊢ ~(t₁✝) ⦂ ~(τ₁) }>h₂:<{ ~(Γ) ⊢ ~(t₂✝) ⦂ ~(τ₂) }>ih₁:∀ {t₁ t₂ : Tm},
  <{ ( t₁ , t₂ ) }> = t₁✝ → ∃ τ₁_1 τ₂, <{ τ₁_1 × τ₂ }> <: τ₁ ∧ <{ ~(Γ) ⊢ ~(t₁) ⦂ ~(τ₁_1) }> ∧ <{ ~(Γ) ⊢ ~(t₂) ⦂ ~(τ₂) }>ih₂:∀ {t₁ t₂ : Tm},
  <{ ( t₁ , t₂ ) }> = t₂✝ → ∃ τ₁ τ₂_1, <{ τ₁ × τ₂_1 }> <: τ₂ ∧ <{ ~(Γ) ⊢ ~(t₁) ⦂ ~(τ₁) }> ∧ <{ ~(Γ) ⊢ ~(t₂) ⦂ ~(τ₂_1) }>⊢ ∃ τ₁_1 τ₂_1, <{ τ₁_1 × τ₂_1 }> <: <{ τ₁ × τ₂ }> ∧ <{ ~(Γ) ⊢ ~(t₁) ⦂ ~(τ₁_1) }> ∧ <{ ~(Γ) ⊢ ~(t₂) ⦂ ~(τ₂_1) }>; exists τ₁, τ₂reflΓ✝:Contextτ:Tyt:TmΓ:Contextt₁:Tmt₂:Tmτ₁:Tyτ₂:Tyh₁:<{ ~(Γ) ⊢ ~(t₁✝) ⦂ ~(τ₁) }>h₂:<{ ~(Γ) ⊢ ~(t₂✝) ⦂ ~(τ₂) }>ih₁:∀ {t₁ t₂ : Tm},
  <{ ( t₁ , t₂ ) }> = t₁✝ → ∃ τ₁_1 τ₂, <{ τ₁_1 × τ₂ }> <: τ₁ ∧ <{ ~(Γ) ⊢ ~(t₁) ⦂ ~(τ₁_1) }> ∧ <{ ~(Γ) ⊢ ~(t₂) ⦂ ~(τ₂) }>ih₂:∀ {t₁ t₂ : Tm},
  <{ ( t₁ , t₂ ) }> = t₂✝ → ∃ τ₁ τ₂_1, <{ τ₁ × τ₂_1 }> <: τ₂ ∧ <{ ~(Γ) ⊢ ~(t₁) ⦂ ~(τ₁) }> ∧ <{ ~(Γ) ⊢ ~(t₂) ⦂ ~(τ₂_1) }>⊢ <{ τ₁ × τ₂ }> <: <{ τ₁ × τ₂ }> ∧ <{ ~(Γ) ⊢ ~(t₁) ⦂ ~(τ₁) }> ∧ <{ ~(Γ) ⊢ ~(t₂) ⦂ ~(τ₂) }>; solve_by_elim using StlcSubTypingAll goals completed! 🐙
    | sub Γ t₁ τ₁ τ₂ ht hs ih =>subΓ✝:Contextτ:Tyt:TmΓ:Contextτ₁:Tyτ₂:Tyhs:τ₁ <: τ₂t₁:Tmt₂:Tmht:<{ ~(Γ) ⊢ ( t₁ , t₂ ) ⦂ ~(τ₁) }>ih:∀ {t₁_1 t₂_1 : Tm},
  <{ ( t₁_1 , t₂_1 ) }> = <{ ( t₁ , t₂ ) }> →
    ∃ τ₁_1 τ₂, <{ τ₁_1 × τ₂ }> <: τ₁ ∧ <{ ~(Γ) ⊢ ~(t₁_1) ⦂ ~(τ₁_1) }> ∧ <{ ~(Γ) ⊢ ~(t₂_1) ⦂ ~(τ₂) }>⊢ ∃ τ₁ τ₂_1, <{ τ₁ × τ₂_1 }> <: τ₂ ∧ <{ ~(Γ) ⊢ ~(t₁) ⦂ ~(τ₁) }> ∧ <{ ~(Γ) ⊢ ~(t₂) ⦂ ~(τ₂_1) }>
      obtain ⟨σ₁, σ₂, hs', ht₁, ht₂⟩ := ih rflsubΓ✝:Contextτ:Tyt:TmΓ:Contextτ₁:Tyτ₂:Tyhs:τ₁ <: τ₂t₁:Tmt₂:Tmht:<{ ~(Γ) ⊢ ( t₁ , t₂ ) ⦂ ~(τ₁) }>ih:∀ {t₁_1 t₂_1 : Tm},
  <{ ( t₁_1 , t₂_1 ) }> = <{ ( t₁ , t₂ ) }> →
    ∃ τ₁_1 τ₂, <{ τ₁_1 × τ₂ }> <: τ₁ ∧ <{ ~(Γ) ⊢ ~(t₁_1) ⦂ ~(τ₁_1) }> ∧ <{ ~(Γ) ⊢ ~(t₂_1) ⦂ ~(τ₂) }>σ₁:Tyσ₂:Tyhs':<{ σ₁ × σ₂ }> <: τ₁ht₁:<{ ~(Γ) ⊢ ~(t₁) ⦂ ~(σ₁) }>ht₂:<{ ~(Γ) ⊢ ~(t₂) ⦂ ~(σ₂) }>⊢ ∃ τ₁ τ₂_1, <{ τ₁ × τ₂_1 }> <: τ₂ ∧ <{ ~(Γ) ⊢ ~(t₁) ⦂ ~(τ₁) }> ∧ <{ ~(Γ) ⊢ ~(t₂) ⦂ ~(τ₂_1) }>
      exists σ₁, σ₂subΓ✝:Contextτ:Tyt:TmΓ:Contextτ₁:Tyτ₂:Tyhs:τ₁ <: τ₂t₁:Tmt₂:Tmht:<{ ~(Γ) ⊢ ( t₁ , t₂ ) ⦂ ~(τ₁) }>ih:∀ {t₁_1 t₂_1 : Tm},
  <{ ( t₁_1 , t₂_1 ) }> = <{ ( t₁ , t₂ ) }> →
    ∃ τ₁_1 τ₂, <{ τ₁_1 × τ₂ }> <: τ₁ ∧ <{ ~(Γ) ⊢ ~(t₁_1) ⦂ ~(τ₁_1) }> ∧ <{ ~(Γ) ⊢ ~(t₂_1) ⦂ ~(τ₂) }>σ₁:Tyσ₂:Tyhs':<{ σ₁ × σ₂ }> <: τ₁ht₁:<{ ~(Γ) ⊢ ~(t₁) ⦂ ~(σ₁) }>ht₂:<{ ~(Γ) ⊢ ~(t₂) ⦂ ~(σ₂) }>⊢ <{ σ₁ × σ₂ }> <: τ₂ ∧ <{ ~(Γ) ⊢ ~(t₁) ⦂ ~(σ₁) }> ∧ <{ ~(Γ) ⊢ ~(t₂) ⦂ ~(σ₂) }>; solve_by_elim (maxDepth := 10) using StlcSubTypingAll goals completed! 🐙

theorem typing_inversion_fst {Γ : Context} {t : Tm} {τ: Ty}
  (h : <{ ~Γ ⊢ fst ~t ⦂ ~τ }>) :
  ∃ τ₁ τ₂,
    τ₁ <: τ ∧ <{ ~Γ ⊢ ~t ⦂ ~τ₁ × ~τ₂ }> := byΓ:Contextt:Tmτ:Tyh:<{ ~(Γ) ⊢ fst t ⦂ ~(τ) }>⊢ ∃ τ₁ τ₂, τ₁ <: τ ∧ <{ ~(Γ) ⊢ ~(t) ⦂ τ₁ × τ₂ }>

  generalize heq : <{ fst ~t }> = t' at hΓ:Contextt:Tmτ:Tyt':Tmheq:<{ fst t }> = t'h:<{ ~(Γ) ⊢ ~(t') ⦂ ~(τ) }>⊢ ∃ τ₁ τ₂, τ₁ <: τ ∧ <{ ~(Γ) ⊢ ~(t) ⦂ τ₁ × τ₂ }>
  induction h generalizing t with (subst_varssndΓ:Contextτ:Tyt':TmΓ✝:Contextt✝:Tmτ₁✝:Tyτ₂✝:Tyh✝:<{ ~(Γ✝) ⊢ ~(t✝) ⦂ τ₁✝ × τ₂✝ }>h_ih✝:∀ {t : Tm}, <{ fst t }> = t✝ → ∃ τ₁ τ₂, τ₁ <: <{ τ₁✝ × τ₂✝ }> ∧ <{ ~(Γ✝) ⊢ ~(t) ⦂ τ₁ × τ₂ }>t:Tmheq:<{ fst t }> = <{ snd t✝ }>⊢ ∃ τ₁ τ₂, τ₁ <: τ₂✝ ∧ <{ ~(Γ✝) ⊢ ~(t) ⦂ τ₁ × τ₂ }>; try contradictionAll goals completed! 🐙)
    | fst Γ t τ₁ τ₂ h ih =>fstΓ✝:Contextτ:Tyt':TmΓ:Contextt✝:Tmτ₁:Tyτ₂:Tyh:<{ ~(Γ) ⊢ ~(t✝) ⦂ τ₁ × τ₂ }>ih:∀ {t : Tm}, <{ fst t }> = t✝ → ∃ τ₁_1 τ₂_1, τ₁_1 <: <{ τ₁ × τ₂ }> ∧ <{ ~(Γ) ⊢ ~(t) ⦂ τ₁_1 × τ₂_1 }>t:Tmheq:<{ fst t }> = <{ fst t✝ }>⊢ ∃ τ₁_1 τ₂, τ₁_1 <: τ₁ ∧ <{ ~(Γ) ⊢ ~(t) ⦂ τ₁_1 × τ₂ }>
        inversion heqreflΓ✝:Contextτ:Tyt':TmΓ:Contextt:Tmτ₁:Tyτ₂:Tyh:<{ ~(Γ) ⊢ ~(t✝) ⦂ τ₁ × τ₂ }>ih:∀ {t : Tm}, <{ fst t }> = t✝ → ∃ τ₁_1 τ₂_1, τ₁_1 <: <{ τ₁ × τ₂ }> ∧ <{ ~(Γ) ⊢ ~(t) ⦂ τ₁_1 × τ₂_1 }>⊢ ∃ τ₁_1 τ₂, τ₁_1 <: τ₁ ∧ <{ ~(Γ) ⊢ ~(t) ⦂ τ₁_1 × τ₂ }>; exists τ₁, τ₂reflΓ✝:Contextτ:Tyt':TmΓ:Contextt:Tmτ₁:Tyτ₂:Tyh:<{ ~(Γ) ⊢ ~(t✝) ⦂ τ₁ × τ₂ }>ih:∀ {t : Tm}, <{ fst t }> = t✝ → ∃ τ₁_1 τ₂_1, τ₁_1 <: <{ τ₁ × τ₂ }> ∧ <{ ~(Γ) ⊢ ~(t) ⦂ τ₁_1 × τ₂_1 }>⊢ τ₁ <: τ₁ ∧ <{ ~(Γ) ⊢ ~(t) ⦂ τ₁ × τ₂ }>; solve_by_elim using StlcSubTypingAll goals completed! 🐙
    | sub Γ t₁ τ₁ τ₂ ht hs ih =>subΓ✝:Contextτ:Tyt':TmΓ:Contextτ₁:Tyτ₂:Tyhs:τ₁ <: τ₂t:Tmht:<{ ~(Γ) ⊢ fst t ⦂ ~(τ₁) }>ih:∀ {t_1 : Tm}, <{ fst t_1 }> = <{ fst t }> → ∃ τ₁_1 τ₂, τ₁_1 <: τ₁ ∧ <{ ~(Γ) ⊢ ~(t_1) ⦂ τ₁_1 × τ₂ }>⊢ ∃ τ₁ τ₂_1, τ₁ <: τ₂ ∧ <{ ~(Γ) ⊢ ~(t) ⦂ τ₁ × τ₂_1 }>
      obtain ⟨σ₁, σ₂, hs', ht'⟩ := ih rflsubΓ✝:Contextτ:Tyt':TmΓ:Contextτ₁:Tyτ₂:Tyhs:τ₁ <: τ₂t:Tmht:<{ ~(Γ) ⊢ fst t ⦂ ~(τ₁) }>ih:∀ {t_1 : Tm}, <{ fst t_1 }> = <{ fst t }> → ∃ τ₁_1 τ₂, τ₁_1 <: τ₁ ∧ <{ ~(Γ) ⊢ ~(t_1) ⦂ τ₁_1 × τ₂ }>σ₁:Tyσ₂:Tyhs':σ₁ <: τ₁ht':<{ ~(Γ) ⊢ ~(t) ⦂ σ₁ × σ₂ }>⊢ ∃ τ₁ τ₂_1, τ₁ <: τ₂ ∧ <{ ~(Γ) ⊢ ~(t) ⦂ τ₁ × τ₂_1 }>
      exists σ₁, σ₂subΓ✝:Contextτ:Tyt':TmΓ:Contextτ₁:Tyτ₂:Tyhs:τ₁ <: τ₂t:Tmht:<{ ~(Γ) ⊢ fst t ⦂ ~(τ₁) }>ih:∀ {t_1 : Tm}, <{ fst t_1 }> = <{ fst t }> → ∃ τ₁_1 τ₂, τ₁_1 <: τ₁ ∧ <{ ~(Γ) ⊢ ~(t_1) ⦂ τ₁_1 × τ₂ }>σ₁:Tyσ₂:Tyhs':σ₁ <: τ₁ht':<{ ~(Γ) ⊢ ~(t) ⦂ σ₁ × σ₂ }>⊢ σ₁ <: τ₂ ∧ <{ ~(Γ) ⊢ ~(t) ⦂ σ₁ × σ₂ }>; solve_by_elim using StlcSubTypingAll goals completed! 🐙

theorem typing_inversion_snd {Γ : Context} {t : Tm} {τ: Ty}
  (h : <{ ~Γ ⊢ snd ~t ⦂ ~τ }>) :
  ∃ τ₁ τ₂,
    τ₂ <: τ ∧ <{ ~Γ ⊢ ~t ⦂ ~τ₁ × ~τ₂ }> := byΓ:Contextt:Tmτ:Tyh:<{ ~(Γ) ⊢ snd t ⦂ ~(τ) }>⊢ ∃ τ₁ τ₂, τ₂ <: τ ∧ <{ ~(Γ) ⊢ ~(t) ⦂ τ₁ × τ₂ }>

  generalize heq : <{ snd ~t }> = t' at hΓ:Contextt:Tmτ:Tyt':Tmheq:<{ snd t }> = t'h:<{ ~(Γ) ⊢ ~(t') ⦂ ~(τ) }>⊢ ∃ τ₁ τ₂, τ₂ <: τ ∧ <{ ~(Γ) ⊢ ~(t) ⦂ τ₁ × τ₂ }>
  induction h generalizing t with (subst_varsfstΓ:Contextτ:Tyt':TmΓ✝:Contextt✝:Tmτ₁✝:Tyτ₂✝:Tyh✝:<{ ~(Γ✝) ⊢ ~(t✝) ⦂ τ₁✝ × τ₂✝ }>h_ih✝:∀ {t : Tm}, <{ snd t }> = t✝ → ∃ τ₁ τ₂, τ₂ <: <{ τ₁✝ × τ₂✝ }> ∧ <{ ~(Γ✝) ⊢ ~(t) ⦂ τ₁ × τ₂ }>t:Tmheq:<{ snd t }> = <{ fst t✝ }>⊢ ∃ τ₁ τ₂, τ₂ <: τ₁✝ ∧ <{ ~(Γ✝) ⊢ ~(t) ⦂ τ₁ × τ₂ }>; try contradictionAll goals completed! 🐙)
  | snd Γ t τ₁ τ₂ h ih =>sndΓ✝:Contextτ:Tyt':TmΓ:Contextt✝:Tmτ₁:Tyτ₂:Tyh:<{ ~(Γ) ⊢ ~(t✝) ⦂ τ₁ × τ₂ }>ih:∀ {t : Tm}, <{ snd t }> = t✝ → ∃ τ₁_1 τ₂_1, τ₂_1 <: <{ τ₁ × τ₂ }> ∧ <{ ~(Γ) ⊢ ~(t) ⦂ τ₁_1 × τ₂_1 }>t:Tmheq:<{ snd t }> = <{ snd t✝ }>⊢ ∃ τ₁ τ₂_1, τ₂_1 <: τ₂ ∧ <{ ~(Γ) ⊢ ~(t) ⦂ τ₁ × τ₂_1 }>
      inversion heqreflΓ✝:Contextτ:Tyt':TmΓ:Contextt:Tmτ₁:Tyτ₂:Tyh:<{ ~(Γ) ⊢ ~(t✝) ⦂ τ₁ × τ₂ }>ih:∀ {t : Tm}, <{ snd t }> = t✝ → ∃ τ₁_1 τ₂_1, τ₂_1 <: <{ τ₁ × τ₂ }> ∧ <{ ~(Γ) ⊢ ~(t) ⦂ τ₁_1 × τ₂_1 }>⊢ ∃ τ₁ τ₂_1, τ₂_1 <: τ₂ ∧ <{ ~(Γ) ⊢ ~(t) ⦂ τ₁ × τ₂_1 }>; exists τ₁, τ₂reflΓ✝:Contextτ:Tyt':TmΓ:Contextt:Tmτ₁:Tyτ₂:Tyh:<{ ~(Γ) ⊢ ~(t✝) ⦂ τ₁ × τ₂ }>ih:∀ {t : Tm}, <{ snd t }> = t✝ → ∃ τ₁_1 τ₂_1, τ₂_1 <: <{ τ₁ × τ₂ }> ∧ <{ ~(Γ) ⊢ ~(t) ⦂ τ₁_1 × τ₂_1 }>⊢ τ₂ <: τ₂ ∧ <{ ~(Γ) ⊢ ~(t) ⦂ τ₁ × τ₂ }>; solve_by_elim using StlcSubTypingAll goals completed! 🐙
  | sub Γ t₁ τ₁ τ₂ ht hs ih =>subΓ✝:Contextτ:Tyt':TmΓ:Contextτ₁:Tyτ₂:Tyhs:τ₁ <: τ₂t:Tmht:<{ ~(Γ) ⊢ snd t ⦂ ~(τ₁) }>ih:∀ {t_1 : Tm}, <{ snd t_1 }> = <{ snd t }> → ∃ τ₁_1 τ₂, τ₂ <: τ₁ ∧ <{ ~(Γ) ⊢ ~(t_1) ⦂ τ₁_1 × τ₂ }>⊢ ∃ τ₁ τ₂_1, τ₂_1 <: τ₂ ∧ <{ ~(Γ) ⊢ ~(t) ⦂ τ₁ × τ₂_1 }>
    obtain ⟨σ₁, σ₂, hs', ht'⟩ := ih rflsubΓ✝:Contextτ:Tyt':TmΓ:Contextτ₁:Tyτ₂:Tyhs:τ₁ <: τ₂t:Tmht:<{ ~(Γ) ⊢ snd t ⦂ ~(τ₁) }>ih:∀ {t_1 : Tm}, <{ snd t_1 }> = <{ snd t }> → ∃ τ₁_1 τ₂, τ₂ <: τ₁ ∧ <{ ~(Γ) ⊢ ~(t_1) ⦂ τ₁_1 × τ₂ }>σ₁:Tyσ₂:Tyhs':σ₂ <: τ₁ht':<{ ~(Γ) ⊢ ~(t) ⦂ σ₁ × σ₂ }>⊢ ∃ τ₁ τ₂_1, τ₂_1 <: τ₂ ∧ <{ ~(Γ) ⊢ ~(t) ⦂ τ₁ × τ₂_1 }>
    exists σ₁, σ₂subΓ✝:Contextτ:Tyt':TmΓ:Contextτ₁:Tyτ₂:Tyhs:τ₁ <: τ₂t:Tmht:<{ ~(Γ) ⊢ snd t ⦂ ~(τ₁) }>ih:∀ {t_1 : Tm}, <{ snd t_1 }> = <{ snd t }> → ∃ τ₁_1 τ₂, τ₂ <: τ₁ ∧ <{ ~(Γ) ⊢ ~(t_1) ⦂ τ₁_1 × τ₂ }>σ₁:Tyσ₂:Tyhs':σ₂ <: τ₁ht':<{ ~(Γ) ⊢ ~(t) ⦂ σ₁ × σ₂ }>⊢ σ₂ <: τ₂ ∧ <{ ~(Γ) ⊢ ~(t) ⦂ σ₁ × σ₂ }>; solve_by_elim using StlcSubTypingAll goals completed! 🐙

The inversion lemmas for typing and for subtyping between arrow types can be packaged up as a useful "combination lemma" telling us exactly what we'll actually require below.

theorem abs_arrow {x : String} {t₂ : Tm} {σ₁ τ₁ τ₂ : Ty}
  (h : <{ ∅ ⊢ λ ~x : ~σ₁ . ~t₂ ⦂ ~τ₁ → ~τ₂ }> ) :
  τ₁ <: σ₁ ∧ <{ ~x ↦ ~σ₁ ; ∅ ⊢ ~t₂ ⦂ ~τ₂ }> := byx:Stringt₂:Tmσ₁:Tyτ₁:Tyτ₂:Tyh:<{ ∅ ⊢ λ ~x : σ₁ . t₂ ⦂ τ₁ → τ₂ }>⊢ τ₁ <: σ₁ ∧ <{ ~(x →ₚ σ₁) ⊢ ~(t₂) ⦂ ~(τ₂) }>
    obtain ⟨σ₂, hs, ht⟩ := typing_inversion_abs hx:Stringt₂:Tmσ₁:Tyτ₁:Tyτ₂:Tyh:<{ ∅ ⊢ λ ~x : σ₁ . t₂ ⦂ τ₁ → τ₂ }>σ₂:Tyhs:<{ σ₁ → σ₂ }> <: <{ τ₁ → τ₂ }>ht:<{ ~(x →ₚ σ₁) ⊢ ~(t₂) ⦂ ~(σ₂) }>⊢ τ₁ <: σ₁ ∧ <{ ~(x →ₚ σ₁) ⊢ ~(t₂) ⦂ ~(τ₂) }>; clear hx:Stringt₂:Tmσ₁:Tyτ₁:Tyτ₂:Tyσ₂:Tyhs:<{ σ₁ → σ₂ }> <: <{ τ₁ → τ₂ }>ht:<{ ~(x →ₚ σ₁) ⊢ ~(t₂) ⦂ ~(σ₂) }>⊢ τ₁ <: σ₁ ∧ <{ ~(x →ₚ σ₁) ⊢ ~(t₂) ⦂ ~(τ₂) }>
    obtain ⟨_, _, heq, hs₁, hs₂⟩ := sub_inversion_arrow hsx:Stringt₂:Tmσ₁:Tyτ₁:Tyτ₂:Tyσ₂:Tyhs:<{ σ₁ → σ₂ }> <: <{ τ₁ → τ₂ }>ht:<{ ~(x →ₚ σ₁) ⊢ ~(t₂) ⦂ ~(σ₂) }>w✝¹:Tyw✝:Tyheq:<{ σ₁ → σ₂ }> = <{ w✝¹ → w✝ }>hs₁:τ₁ <: w✝¹hs₂:w✝ <: τ₂⊢ τ₁ <: σ₁ ∧ <{ ~(x →ₚ σ₁) ⊢ ~(t₂) ⦂ ~(τ₂) }>; clear hsx:Stringt₂:Tmσ₁:Tyτ₁:Tyτ₂:Tyσ₂:Tyht:<{ ~(x →ₚ σ₁) ⊢ ~(t₂) ⦂ ~(σ₂) }>w✝¹:Tyw✝:Tyheq:<{ σ₁ → σ₂ }> = <{ w✝¹ → w✝ }>hs₁:τ₁ <: w✝¹hs₂:w✝ <: τ₂⊢ τ₁ <: σ₁ ∧ <{ ~(x →ₚ σ₁) ⊢ ~(t₂) ⦂ ~(τ₂) }>
    inversion heqreflx:Stringt₂:Tmσ₁:Tyτ₁:Tyτ₂:Tyσ₂:Tyht:<{ ~(x →ₚ σ₁) ⊢ ~(t₂) ⦂ ~(σ₂) }>hs₁:τ₁ <: σ₁hs₂:σ₂ <: τ₂⊢ τ₁ <: σ₁ ∧ <{ ~(x →ₚ σ₁) ⊢ ~(t₂) ⦂ ~(τ₂) }>; constructorrefl.leftx:Stringt₂:Tmσ₁:Tyτ₁:Tyτ₂:Tyσ₂:Tyht:<{ ~(x →ₚ σ₁) ⊢ ~(t₂) ⦂ ~(σ₂) }>hs₁:τ₁ <: σ₁hs₂:σ₂ <: τ₂⊢ τ₁ <: σ₁refl.rightx:Stringt₂:Tmσ₁:Tyτ₁:Tyτ₂:Tyσ₂:Tyht:<{ ~(x →ₚ σ₁) ⊢ ~(t₂) ⦂ ~(σ₂) }>hs₁:τ₁ <: σ₁hs₂:σ₂ <: τ₂⊢ <{ ~(x →ₚ σ₁) ⊢ ~(t₂) ⦂ ~(τ₂) }>
    ·refl.leftx:Stringt₂:Tmσ₁:Tyτ₁:Tyτ₂:Tyσ₂:Tyht:<{ ~(x →ₚ σ₁) ⊢ ~(t₂) ⦂ ~(σ₂) }>hs₁:τ₁ <: σ₁hs₂:σ₂ <: τ₂⊢ τ₁ <: σ₁ solve_by_elim using StlcSubTypingAll goals completed! 🐙
    ·refl.rightx:Stringt₂:Tmσ₁:Tyτ₁:Tyτ₂:Tyσ₂:Tyht:<{ ~(x →ₚ σ₁) ⊢ ~(t₂) ⦂ ~(σ₂) }>hs₁:τ₁ <: σ₁hs₂:σ₂ <: τ₂⊢ <{ ~(x →ₚ σ₁) ⊢ ~(t₂) ⦂ ~(τ₂) }> apply HasType.subrefl.right.htx:Stringt₂:Tmσ₁:Tyτ₁:Tyτ₂:Tyσ₂:Tyht:<{ ~(x →ₚ σ₁) ⊢ ~(t₂) ⦂ ~(σ₂) }>hs₁:τ₁ <: σ₁hs₂:σ₂ <: τ₂⊢ <{ ~(x →ₚ σ₁) ⊢ ~(t₂) ⦂ ~(?refl.right.τ₁) }>refl.right.hsx:Stringt₂:Tmσ₁:Tyτ₁:Tyτ₂:Tyσ₂:Tyht:<{ ~(x →ₚ σ₁) ⊢ ~(t₂) ⦂ ~(σ₂) }>hs₁:τ₁ <: σ₁hs₂:σ₂ <: τ₂⊢ ?refl.right.τ₁ <: τ₂refl.right.τ₁x:Stringt₂:Tmσ₁:Tyτ₁:Tyτ₂:Tyσ₂:Tyht:<{ ~(x →ₚ σ₁) ⊢ ~(t₂) ⦂ ~(σ₂) }>hs₁:τ₁ <: σ₁hs₂:σ₂ <: τ₂⊢ Ty <;>refl.right.htx:Stringt₂:Tmσ₁:Tyτ₁:Tyτ₂:Tyσ₂:Tyht:<{ ~(x →ₚ σ₁) ⊢ ~(t₂) ⦂ ~(σ₂) }>hs₁:τ₁ <: σ₁hs₂:σ₂ <: τ₂⊢ <{ ~(x →ₚ σ₁) ⊢ ~(t₂) ⦂ ~(?refl.right.τ₁) }>refl.right.hsx:Stringt₂:Tmσ₁:Tyτ₁:Tyτ₂:Tyσ₂:Tyht:<{ ~(x →ₚ σ₁) ⊢ ~(t₂) ⦂ ~(σ₂) }>hs₁:τ₁ <: σ₁hs₂:σ₂ <: τ₂⊢ ?refl.right.τ₁ <: τ₂refl.right.τ₁x:Stringt₂:Tmσ₁:Tyτ₁:Tyτ₂:Tyσ₂:Tyht:<{ ~(x →ₚ σ₁) ⊢ ~(t₂) ⦂ ~(σ₂) }>hs₁:τ₁ <: σ₁hs₂:σ₂ <: τ₂⊢ Ty solve_by_elim using StlcSubTypingAll goals completed! 🐙

8.3.5. Weakening🔗

The weakening lemma is proved as in pure STLC, with the exception of the sub case, which requires a manual use of the sub rule.

theorem weakening {Γ Γ' : Context} {t : Tm} {τ: Ty}
    (hi : Γ ⊆ Γ')
    (ht : <{ ~Γ ⊢ ~t ⦂ ~τ }>) :
     <{ ~Γ' ⊢ ~t ⦂ ~τ }> := byΓ:ContextΓ':Contextt:Tmτ:Tyhi:Γ ⊆ Γ'ht:<{ ~(Γ) ⊢ ~(t) ⦂ ~(τ) }>⊢ <{ ~(Γ') ⊢ ~(t) ⦂ ~(τ) }>
  induction ht generalizing Γ' with (try apply_rules [PartialMap.update_subset] using StlcSubTypingAll goals completed! 🐙)
  | sub Γ t₁ τ₁ τ₂ ht hs ih =>subΓ✝:Contextt:Tmτ:TyΓ:Contextt₁:Tmτ₁:Tyτ₂:Tyht:<{ ~(Γ) ⊢ ~(t₁) ⦂ ~(τ₁) }>hs:τ₁ <: τ₂ih:∀ {Γ' : Context}, Γ ⊆ Γ' → <{ ~(Γ') ⊢ ~(t₁) ⦂ ~(τ₁) }>Γ':Contexthi:Γ ⊆ Γ'⊢ <{ ~(Γ') ⊢ ~(t₁) ⦂ ~(τ₂) }>
    apply HasType.subsub.htΓ✝:Contextt:Tmτ:TyΓ:Contextt₁:Tmτ₁:Tyτ₂:Tyht:<{ ~(Γ) ⊢ ~(t₁) ⦂ ~(τ₁) }>hs:τ₁ <: τ₂ih:∀ {Γ' : Context}, Γ ⊆ Γ' → <{ ~(Γ') ⊢ ~(t₁) ⦂ ~(τ₁) }>Γ':Contexthi:Γ ⊆ Γ'⊢ <{ ~(Γ') ⊢ ~(t₁) ⦂ ~(?sub.τ₁) }>sub.hsΓ✝:Contextt:Tmτ:TyΓ:Contextt₁:Tmτ₁:Tyτ₂:Tyht:<{ ~(Γ) ⊢ ~(t₁) ⦂ ~(τ₁) }>hs:τ₁ <: τ₂ih:∀ {Γ' : Context}, Γ ⊆ Γ' → <{ ~(Γ') ⊢ ~(t₁) ⦂ ~(τ₁) }>Γ':Contexthi:Γ ⊆ Γ'⊢ ?sub.τ₁ <: τ₂sub.τ₁Γ✝:Contextt:Tmτ:TyΓ:Contextt₁:Tmτ₁:Tyτ₂:Tyht:<{ ~(Γ) ⊢ ~(t₁) ⦂ ~(τ₁) }>hs:τ₁ <: τ₂ih:∀ {Γ' : Context}, Γ ⊆ Γ' → <{ ~(Γ') ⊢ ~(t₁) ⦂ ~(τ₁) }>Γ':Contexthi:Γ ⊆ Γ'⊢ Ty <;>sub.htΓ✝:Contextt:Tmτ:TyΓ:Contextt₁:Tmτ₁:Tyτ₂:Tyht:<{ ~(Γ) ⊢ ~(t₁) ⦂ ~(τ₁) }>hs:τ₁ <: τ₂ih:∀ {Γ' : Context}, Γ ⊆ Γ' → <{ ~(Γ') ⊢ ~(t₁) ⦂ ~(τ₁) }>Γ':Contexthi:Γ ⊆ Γ'⊢ <{ ~(Γ') ⊢ ~(t₁) ⦂ ~(?sub.τ₁) }>sub.hsΓ✝:Contextt:Tmτ:TyΓ:Contextt₁:Tmτ₁:Tyτ₂:Tyht:<{ ~(Γ) ⊢ ~(t₁) ⦂ ~(τ₁) }>hs:τ₁ <: τ₂ih:∀ {Γ' : Context}, Γ ⊆ Γ' → <{ ~(Γ') ⊢ ~(t₁) ⦂ ~(τ₁) }>Γ':Contexthi:Γ ⊆ Γ'⊢ ?sub.τ₁ <: τ₂sub.τ₁Γ✝:Contextt:Tmτ:TyΓ:Contextt₁:Tmτ₁:Tyτ₂:Tyht:<{ ~(Γ) ⊢ ~(t₁) ⦂ ~(τ₁) }>hs:τ₁ <: τ₂ih:∀ {Γ' : Context}, Γ ⊆ Γ' → <{ ~(Γ') ⊢ ~(t₁) ⦂ ~(τ₁) }>Γ':Contexthi:Γ ⊆ Γ'⊢ Ty solve_by_elim using StlcSubTypingAll goals completed! 🐙

theorem weakening_empty {Γ : Context} {t : Tm} {τ: Ty}
    (ht :<{ ∅ ⊢ ~t ⦂ ~τ }>) :
    <{ ~Γ ⊢ ~t ⦂ ~τ }> := byΓ:Contextt:Tmτ:Tyht:<{ ∅ ⊢ ~(t) ⦂ ~(τ) }>⊢ <{ ~(Γ) ⊢ ~(t) ⦂ ~(τ) }>
  apply weakening _ htΓ:Contextt:Tmτ:Tyht:<{ ∅ ⊢ ~(t) ⦂ ~(τ) }>⊢ ∅ ⊆ Γ
  intro _ _ hΓ:Contextt:Tmτ:Tyht:<{ ∅ ⊢ ~(t) ⦂ ~(τ) }>a✝:Stringb✝:Tyh:∅[a✝] = some b✝⊢ Γ[a✝] = some b✝
  rw [PartialMap.getElem_emptyΓ:Contextt:Tmτ:Tyht:<{ ∅ ⊢ ~(t) ⦂ ~(τ) }>a✝:Stringb✝:Tyh:none = some b✝⊢ Γ[a✝] = some b✝] at hΓ:Contextt:Tmτ:Tyht:<{ ∅ ⊢ ~(t) ⦂ ~(τ) }>a✝:Stringb✝:Tyh:none = some b✝⊢ Γ[a✝] = some b✝
  contradictionAll goals completed! 🐙

8.3.6. Substitution🔗

When subtyping is involved proofs are generally easier when done by induction on typing derivations, rather than on terms. The substitution lemma is proved as for pure STLC, but using induction on the typing derivation this time (see Exercise substitution_preserves_typing_from_typing_ind in StlcProp).

theorem substitution_preserves_typing {Γ : Context} {x : String} {τ₁ : Ty} {t v : Tm} {τ : Ty}
    (ht : <{ ~x ↦ ~τ₁ ; ~Γ ⊢ ~t ⦂ ~τ }>)
    (hv : <{ ∅ ⊢ ~v ⦂ ~τ₁ }>) :
    <{ ~Γ ⊢ [~x := ~v] ~t ⦂ ~τ }> := byΓ:Contextx:Stringτ₁:Tyt:Tmv:Tmτ:Tyht:<{ ~(x →ₚ τ₁ ; Γ) ⊢ ~(t) ⦂ ~(τ) }>hv:<{ ∅ ⊢ ~(v) ⦂ ~(τ₁) }>⊢ <{ ~(Γ) ⊢ ~(subst x v t) ⦂ ~(τ) }>

  generalize heq : x →ₚ τ₁ ; Γ = Γ' at htΓ:Contextx:Stringτ₁:Tyt:Tmv:Tmτ:Tyhv:<{ ∅ ⊢ ~(v) ⦂ ~(τ₁) }>Γ':PartialMap String Tyheq:x →ₚ τ₁ ; Γ = Γ'ht:<{ ~(Γ') ⊢ ~(t) ⦂ ~(τ) }>⊢ <{ ~(Γ) ⊢ ~(subst x v t) ⦂ ~(τ) }>
  induction ht generalizing x Γ with (
    subst_varssndτ₁:Tyt:Tmv:Tmτ:Tyhv:<{ ∅ ⊢ ~(v) ⦂ ~(τ₁) }>Γ':PartialMap String Tyt✝:Tmτ₁✝:Tyτ₂✝:TyΓ:Contextx:Stringh✝:<{ ~(x →ₚ τ₁ ; Γ) ⊢ ~(t✝) ⦂ τ₁✝ × τ₂✝ }>h_ih✝:∀ {Γ_1 : Context} {x_1 : String}, x_1 →ₚ τ₁ ; Γ_1 = x →ₚ τ₁ ; Γ → <{ ~(Γ_1) ⊢ ~(subst x_1 v t✝) ⦂ τ₁✝ × τ₂✝ }>⊢ <{ ~(Γ) ⊢ ~(subst x v <{ snd t✝ }>) ⦂ ~(τ₂✝) }>; try rw [substvarτ₁:Tyt:Tmv:Tmτ:Tyhv:<{ ∅ ⊢ ~(v) ⦂ ~(τ₁) }>Γ':PartialMap String Tyy:Stringσ:TyΓ:Contextx:Stringh:(x →ₚ τ₁ ; Γ)[y] = some σ⊢ <{ ~(Γ) ⊢ ~(if x = y then v else StlcSub.Tm.var y) ⦂ ~(σ) }>]fstτ₁:Tyt:Tmv:Tmτ:Tyhv:<{ ∅ ⊢ ~(v) ⦂ ~(τ₁) }>Γ':PartialMap String Tyt✝:Tmτ₁✝:Tyτ₂✝:TyΓ:Contextx:Stringh✝:<{ ~(x →ₚ τ₁ ; Γ) ⊢ ~(t✝) ⦂ τ₁✝ × τ₂✝ }>h_ih✝:∀ {Γ_1 : Context} {x_1 : String}, x_1 →ₚ τ₁ ; Γ_1 = x →ₚ τ₁ ; Γ → <{ ~(Γ_1) ⊢ ~(subst x_1 v t✝) ⦂ τ₁✝ × τ₂✝ }>⊢ <{ ~(Γ) ⊢ fst ~(subst x v t✝) ⦂ ~(τ₁✝) }>sndτ₁:Tyt:Tmv:Tmτ:Tyhv:<{ ∅ ⊢ ~(v) ⦂ ~(τ₁) }>Γ':PartialMap String Tyt✝:Tmτ₁✝:Tyτ₂✝:TyΓ:Contextx:Stringh✝:<{ ~(x →ₚ τ₁ ; Γ) ⊢ ~(t✝) ⦂ τ₁✝ × τ₂✝ }>h_ih✝:∀ {Γ_1 : Context} {x_1 : String}, x_1 →ₚ τ₁ ; Γ_1 = x →ₚ τ₁ ; Γ → <{ ~(Γ_1) ⊢ ~(subst x_1 v t✝) ⦂ τ₁✝ × τ₂✝ }>⊢ <{ ~(Γ) ⊢ snd ~(subst x v t✝) ⦂ ~(τ₂✝) }>; try (apply_rules using StlcSubTypingAll goals completed! 🐙; done))
  | var Γ y σ h =>varτ₁:Tyt:Tmv:Tmτ:Tyhv:<{ ∅ ⊢ ~(v) ⦂ ~(τ₁) }>Γ':PartialMap String Tyy:Stringσ:TyΓ:Contextx:Stringh:(x →ₚ τ₁ ; Γ)[y] = some σ⊢ <{ ~(Γ) ⊢ ~(if x = y then v else StlcSub.Tm.var y) ⦂ ~(σ) }>
      by_cases h₁ : x = yposτ₁:Tyt:Tmv:Tmτ:Tyhv:<{ ∅ ⊢ ~(v) ⦂ ~(τ₁) }>Γ':PartialMap String Tyy:Stringσ:TyΓ:Contextx:Stringh:(x →ₚ τ₁ ; Γ)[y] = some σh₁:x = y⊢ <{ ~(Γ) ⊢ ~(if x = y then v else StlcSub.Tm.var y) ⦂ ~(σ) }>negτ₁:Tyt:Tmv:Tmτ:Tyhv:<{ ∅ ⊢ ~(v) ⦂ ~(τ₁) }>Γ':PartialMap String Tyy:Stringσ:TyΓ:Contextx:Stringh:(x →ₚ τ₁ ; Γ)[y] = some σh₁:¬x = y⊢ <{ ~(Γ) ⊢ ~(if x = y then v else StlcSub.Tm.var y) ⦂ ~(σ) }>
      ·posτ₁:Tyt:Tmv:Tmτ:Tyhv:<{ ∅ ⊢ ~(v) ⦂ ~(τ₁) }>Γ':PartialMap String Tyy:Stringσ:TyΓ:Contextx:Stringh:(x →ₚ τ₁ ; Γ)[y] = some σh₁:x = y⊢ <{ ~(Γ) ⊢ ~(if x = y then v else StlcSub.Tm.var y) ⦂ ~(σ) }> subst h₁posτ₁:Tyt:Tmv:Tmτ:Tyhv:<{ ∅ ⊢ ~(v) ⦂ ~(τ₁) }>Γ':PartialMap String Tyσ:TyΓ:Contextx:Stringh:(x →ₚ τ₁ ; Γ)[x] = some σ⊢ <{ ~(Γ) ⊢ ~(if x = x then v else StlcSub.Tm.var x) ⦂ ~(σ) }>; simp at hposτ₁:Tyt:Tmv:Tmτ:Tyhv:<{ ∅ ⊢ ~(v) ⦂ ~(τ₁) }>Γ':PartialMap String Tyσ:TyΓ:Contextx:Stringh:τ₁ = σ⊢ <{ ~(Γ) ⊢ ~(if x = x then v else StlcSub.Tm.var x) ⦂ ~(σ) }>; subst hposτ₁:Tyt:Tmv:Tmτ:Tyhv:<{ ∅ ⊢ ~(v) ⦂ ~(τ₁) }>Γ':PartialMap String TyΓ:Contextx:String⊢ <{ ~(Γ) ⊢ ~(if x = x then v else StlcSub.Tm.var x) ⦂ ~(τ₁) }>;
        apply weakening_empty at hvposτ₁:Tyt:Tmv:Tmτ:Tyhv✝:<{ ∅ ⊢ ~(v) ⦂ ~(τ₁) }>Γ':PartialMap String TyΓ:Contextx:Stringhv:<{ ~(?Γ) ⊢ ~(v) ⦂ ~(τ₁) }>⊢ <{ ~(Γ) ⊢ ~(if x = x then v else StlcSub.Tm.var x) ⦂ ~(τ₁) }>Γτ₁:Tyt:Tmv:Tmτ:Tyhv:<{ ∅ ⊢ ~(v) ⦂ ~(τ₁) }>Γ':PartialMap String TyΓ:Contextx:String⊢ Context
        simpposτ₁:Tyt:Tmv:Tmτ:Tyhv✝:<{ ∅ ⊢ ~(v) ⦂ ~(τ₁) }>Γ':PartialMap String TyΓ:Contextx:Stringhv:<{ ~(?Γ) ⊢ ~(v) ⦂ ~(τ₁) }>⊢ <{ ~(Γ) ⊢ ~(v) ⦂ ~(τ₁) }>Γτ₁:Tyt:Tmv:Tmτ:Tyhv:<{ ∅ ⊢ ~(v) ⦂ ~(τ₁) }>Γ':PartialMap String TyΓ:Contextx:String⊢ Context; assumptionAll goals completed! 🐙
      ·negτ₁:Tyt:Tmv:Tmτ:Tyhv:<{ ∅ ⊢ ~(v) ⦂ ~(τ₁) }>Γ':PartialMap String Tyy:Stringσ:TyΓ:Contextx:Stringh:(x →ₚ τ₁ ; Γ)[y] = some σh₁:¬x = y⊢ <{ ~(Γ) ⊢ ~(if x = y then v else StlcSub.Tm.var y) ⦂ ~(σ) }> rw [PartialMap.update_neqnegτ₁:Tyt:Tmv:Tmτ:Tyhv:<{ ∅ ⊢ ~(v) ⦂ ~(τ₁) }>Γ':PartialMap String Tyy:Stringσ:TyΓ:Contextx:Stringh:Γ[y] = some σh₁:¬x = y⊢ <{ ~(Γ) ⊢ ~(if x = y then v else StlcSub.Tm.var y) ⦂ ~(σ) }>neg.hτ₁:Tyt:Tmv:Tmτ:Tyhv:<{ ∅ ⊢ ~(v) ⦂ ~(τ₁) }>Γ':PartialMap String Tyy:Stringσ:TyΓ:Contextx:Stringh:(x →ₚ τ₁ ; Γ)[y] = some σh₁:¬x = y⊢ x ≠ y] at hnegτ₁:Tyt:Tmv:Tmτ:Tyhv:<{ ∅ ⊢ ~(v) ⦂ ~(τ₁) }>Γ':PartialMap String Tyy:Stringσ:TyΓ:Contextx:Stringh:Γ[y] = some σh₁:¬x = y⊢ <{ ~(Γ) ⊢ ~(if x = y then v else StlcSub.Tm.var y) ⦂ ~(σ) }>neg.hτ₁:Tyt:Tmv:Tmτ:Tyhv:<{ ∅ ⊢ ~(v) ⦂ ~(τ₁) }>Γ':PartialMap String Tyy:Stringσ:TyΓ:Contextx:Stringh:(x →ₚ τ₁ ; Γ)[y] = some σh₁:¬x = y⊢ x ≠ y <;>negτ₁:Tyt:Tmv:Tmτ:Tyhv:<{ ∅ ⊢ ~(v) ⦂ ~(τ₁) }>Γ':PartialMap String Tyy:Stringσ:TyΓ:Contextx:Stringh:Γ[y] = some σh₁:¬x = y⊢ <{ ~(Γ) ⊢ ~(if x = y then v else StlcSub.Tm.var y) ⦂ ~(σ) }>neg.hτ₁:Tyt:Tmv:Tmτ:Tyhv:<{ ∅ ⊢ ~(v) ⦂ ~(τ₁) }>Γ':PartialMap String Tyy:Stringσ:TyΓ:Contextx:Stringh:(x →ₚ τ₁ ; Γ)[y] = some σh₁:¬x = y⊢ x ≠ y simp_allAll goals completed! 🐙
        apply_rules using StlcSubTypingAll goals completed! 🐙
  | abs _ y _ _ _ h ih =>absτ₁:Tyt:Tmv:Tmτ:Tyhv:<{ ∅ ⊢ ~(v) ⦂ ~(τ₁) }>Γ':PartialMap String Tyy:Stringτ₁✝:Tyτ₂✝:Tyt₁✝:TmΓ:Contextx:Stringh:<{ ~(y →ₚ τ₂✝ ; x →ₚ τ₁ ; Γ) ⊢ ~(t₁✝) ⦂ ~(τ₁✝) }>ih:∀ {Γ_1 : Context} {x_1 : String}, x_1 →ₚ τ₁ ; Γ_1 = y →ₚ τ₂✝ ; x →ₚ τ₁ ; Γ → <{ ~(Γ_1) ⊢ ~(subst x_1 v t₁✝) ⦂ ~(τ₁✝) }>⊢ <{ ~(Γ) ⊢ ~(if x = y then <{ λ ~y : τ₂✝ . t₁✝ }> else <{ λ ~y : τ₂✝ . ~(subst x v t₁✝) }>) ⦂ τ₂✝ → τ₁✝ }>
      by_cases h₁ : x = yposτ₁:Tyt:Tmv:Tmτ:Tyhv:<{ ∅ ⊢ ~(v) ⦂ ~(τ₁) }>Γ':PartialMap String Tyy:Stringτ₁✝:Tyτ₂✝:Tyt₁✝:TmΓ:Contextx:Stringh:<{ ~(y →ₚ τ₂✝ ; x →ₚ τ₁ ; Γ) ⊢ ~(t₁✝) ⦂ ~(τ₁✝) }>ih:∀ {Γ_1 : Context} {x_1 : String}, x_1 →ₚ τ₁ ; Γ_1 = y →ₚ τ₂✝ ; x →ₚ τ₁ ; Γ → <{ ~(Γ_1) ⊢ ~(subst x_1 v t₁✝) ⦂ ~(τ₁✝) }>h₁:x = y⊢ <{ ~(Γ) ⊢ ~(if x = y then <{ λ ~y : τ₂✝ . t₁✝ }> else <{ λ ~y : τ₂✝ . ~(subst x v t₁✝) }>) ⦂ τ₂✝ → τ₁✝ }>negτ₁:Tyt:Tmv:Tmτ:Tyhv:<{ ∅ ⊢ ~(v) ⦂ ~(τ₁) }>Γ':PartialMap String Tyy:Stringτ₁✝:Tyτ₂✝:Tyt₁✝:TmΓ:Contextx:Stringh:<{ ~(y →ₚ τ₂✝ ; x →ₚ τ₁ ; Γ) ⊢ ~(t₁✝) ⦂ ~(τ₁✝) }>ih:∀ {Γ_1 : Context} {x_1 : String}, x_1 →ₚ τ₁ ; Γ_1 = y →ₚ τ₂✝ ; x →ₚ τ₁ ; Γ → <{ ~(Γ_1) ⊢ ~(subst x_1 v t₁✝) ⦂ ~(τ₁✝) }>h₁:¬x = y⊢ <{ ~(Γ) ⊢ ~(if x = y then <{ λ ~y : τ₂✝ . t₁✝ }> else <{ λ ~y : τ₂✝ . ~(subst x v t₁✝) }>) ⦂ τ₂✝ → τ₁✝ }>
      ·posτ₁:Tyt:Tmv:Tmτ:Tyhv:<{ ∅ ⊢ ~(v) ⦂ ~(τ₁) }>Γ':PartialMap String Tyy:Stringτ₁✝:Tyτ₂✝:Tyt₁✝:TmΓ:Contextx:Stringh:<{ ~(y →ₚ τ₂✝ ; x →ₚ τ₁ ; Γ) ⊢ ~(t₁✝) ⦂ ~(τ₁✝) }>ih:∀ {Γ_1 : Context} {x_1 : String}, x_1 →ₚ τ₁ ; Γ_1 = y →ₚ τ₂✝ ; x →ₚ τ₁ ; Γ → <{ ~(Γ_1) ⊢ ~(subst x_1 v t₁✝) ⦂ ~(τ₁✝) }>h₁:x = y⊢ <{ ~(Γ) ⊢ ~(if x = y then <{ λ ~y : τ₂✝ . t₁✝ }> else <{ λ ~y : τ₂✝ . ~(subst x v t₁✝) }>) ⦂ τ₂✝ → τ₁✝ }> simp_all [PartialMap.update_shadow]posτ₁:Tyt:Tmv:Tmτ:Tyhv:<{ ∅ ⊢ ~(v) ⦂ ~(τ₁) }>Γ':PartialMap String Tyy:Stringτ₁✝:Tyτ₂✝:Tyt₁✝:TmΓ:Contextx:Stringh:<{ ~(y →ₚ τ₂✝ ; Γ) ⊢ ~(t₁✝) ⦂ ~(τ₁✝) }>ih:∀ {Γ_1 : Context} {x : String}, x →ₚ τ₁ ; Γ_1 = y →ₚ τ₂✝ ; Γ → <{ ~(Γ_1) ⊢ ~(subst x v t₁✝) ⦂ ~(τ₁✝) }>h₁:x = y⊢ <{ ~(Γ) ⊢ λ ~y : τ₂✝ . t₁✝ ⦂ τ₂✝ → τ₁✝ }>; apply_rules using StlcSubTypingAll goals completed! 🐙
      ·negτ₁:Tyt:Tmv:Tmτ:Tyhv:<{ ∅ ⊢ ~(v) ⦂ ~(τ₁) }>Γ':PartialMap String Tyy:Stringτ₁✝:Tyτ₂✝:Tyt₁✝:TmΓ:Contextx:Stringh:<{ ~(y →ₚ τ₂✝ ; x →ₚ τ₁ ; Γ) ⊢ ~(t₁✝) ⦂ ~(τ₁✝) }>ih:∀ {Γ_1 : Context} {x_1 : String}, x_1 →ₚ τ₁ ; Γ_1 = y →ₚ τ₂✝ ; x →ₚ τ₁ ; Γ → <{ ~(Γ_1) ⊢ ~(subst x_1 v t₁✝) ⦂ ~(τ₁✝) }>h₁:¬x = y⊢ <{ ~(Γ) ⊢ ~(if x = y then <{ λ ~y : τ₂✝ . t₁✝ }> else <{ λ ~y : τ₂✝ . ~(subst x v t₁✝) }>) ⦂ τ₂✝ → τ₁✝ }> simp_allnegτ₁:Tyt:Tmv:Tmτ:Tyhv:<{ ∅ ⊢ ~(v) ⦂ ~(τ₁) }>Γ':PartialMap String Tyy:Stringτ₁✝:Tyτ₂✝:Tyt₁✝:TmΓ:Contextx:Stringh:<{ ~(y →ₚ τ₂✝ ; x →ₚ τ₁ ; Γ) ⊢ ~(t₁✝) ⦂ ~(τ₁✝) }>ih:∀ {Γ_1 : Context} {x_1 : String}, x_1 →ₚ τ₁ ; Γ_1 = y →ₚ τ₂✝ ; x →ₚ τ₁ ; Γ → <{ ~(Γ_1) ⊢ ~(subst x_1 v t₁✝) ⦂ ~(τ₁✝) }>h₁:¬x = y⊢ <{ ~(Γ) ⊢ λ ~y : τ₂✝ . ~(subst x v t₁✝) ⦂ τ₂✝ → τ₁✝ }>; constructornegτ₁:Tyt:Tmv:Tmτ:Tyhv:<{ ∅ ⊢ ~(v) ⦂ ~(τ₁) }>Γ':PartialMap String Tyy:Stringτ₁✝:Tyτ₂✝:Tyt₁✝:TmΓ:Contextx:Stringh:<{ ~(y →ₚ τ₂✝ ; x →ₚ τ₁ ; Γ) ⊢ ~(t₁✝) ⦂ ~(τ₁✝) }>ih:∀ {Γ_1 : Context} {x_1 : String}, x_1 →ₚ τ₁ ; Γ_1 = y →ₚ τ₂✝ ; x →ₚ τ₁ ; Γ → <{ ~(Γ_1) ⊢ ~(subst x_1 v t₁✝) ⦂ ~(τ₁✝) }>h₁:¬x = y⊢ <{ ~(y →ₚ τ₂✝ ; Γ) ⊢ ~(subst x v t₁✝) ⦂ ~(τ₁✝) }>; apply ihnegτ₁:Tyt:Tmv:Tmτ:Tyhv:<{ ∅ ⊢ ~(v) ⦂ ~(τ₁) }>Γ':PartialMap String Tyy:Stringτ₁✝:Tyτ₂✝:Tyt₁✝:TmΓ:Contextx:Stringh:<{ ~(y →ₚ τ₂✝ ; x →ₚ τ₁ ; Γ) ⊢ ~(t₁✝) ⦂ ~(τ₁✝) }>ih:∀ {Γ_1 : Context} {x_1 : String}, x_1 →ₚ τ₁ ; Γ_1 = y →ₚ τ₂✝ ; x →ₚ τ₁ ; Γ → <{ ~(Γ_1) ⊢ ~(subst x_1 v t₁✝) ⦂ ~(τ₁✝) }>h₁:¬x = y⊢ x →ₚ τ₁ ; y →ₚ τ₂✝ ; Γ = y →ₚ τ₂✝ ; x →ₚ τ₁ ; Γ; rw [PartialMap.update_permutenegτ₁:Tyt:Tmv:Tmτ:Tyhv:<{ ∅ ⊢ ~(v) ⦂ ~(τ₁) }>Γ':PartialMap String Tyy:Stringτ₁✝:Tyτ₂✝:Tyt₁✝:TmΓ:Contextx:Stringh:<{ ~(y →ₚ τ₂✝ ; x →ₚ τ₁ ; Γ) ⊢ ~(t₁✝) ⦂ ~(τ₁✝) }>ih:∀ {Γ_1 : Context} {x_1 : String}, x_1 →ₚ τ₁ ; Γ_1 = y →ₚ τ₂✝ ; x →ₚ τ₁ ; Γ → <{ ~(Γ_1) ⊢ ~(subst x_1 v t₁✝) ⦂ ~(τ₁✝) }>h₁:¬x = y⊢ y →ₚ τ₂✝ ; x →ₚ τ₁ ; Γ = y →ₚ τ₂✝ ; x →ₚ τ₁ ; Γnegτ₁:Tyt:Tmv:Tmτ:Tyhv:<{ ∅ ⊢ ~(v) ⦂ ~(τ₁) }>Γ':PartialMap String Tyy:Stringτ₁✝:Tyτ₂✝:Tyt₁✝:TmΓ:Contextx:Stringh:<{ ~(y →ₚ τ₂✝ ; x →ₚ τ₁ ; Γ) ⊢ ~(t₁✝) ⦂ ~(τ₁✝) }>ih:∀ {Γ_1 : Context} {x_1 : String}, x_1 →ₚ τ₁ ; Γ_1 = y →ₚ τ₂✝ ; x →ₚ τ₁ ; Γ → <{ ~(Γ_1) ⊢ ~(subst x_1 v t₁✝) ⦂ ~(τ₁✝) }>h₁:¬x = y⊢ x ≠ y]negτ₁:Tyt:Tmv:Tmτ:Tyhv:<{ ∅ ⊢ ~(v) ⦂ ~(τ₁) }>Γ':PartialMap String Tyy:Stringτ₁✝:Tyτ₂✝:Tyt₁✝:TmΓ:Contextx:Stringh:<{ ~(y →ₚ τ₂✝ ; x →ₚ τ₁ ; Γ) ⊢ ~(t₁✝) ⦂ ~(τ₁✝) }>ih:∀ {Γ_1 : Context} {x_1 : String}, x_1 →ₚ τ₁ ; Γ_1 = y →ₚ τ₂✝ ; x →ₚ τ₁ ; Γ → <{ ~(Γ_1) ⊢ ~(subst x_1 v t₁✝) ⦂ ~(τ₁✝) }>h₁:¬x = y⊢ x ≠ y; liaAll goals completed! 🐙
  | sub Γ t₁ τ₁ τ₂ ht hs ih =>subτ₁✝:Tyt:Tmv:Tmτ:Tyhv:<{ ∅ ⊢ ~(v) ⦂ ~(τ₁) }>Γ':PartialMap String Tyt₁:Tmτ₁:Tyτ₂:Tyhs:τ₁ <: τ₂Γ:Contextx:Stringht:<{ ~(x →ₚ τ₁✝ ; Γ) ⊢ ~(t₁) ⦂ ~(τ₁) }>ih:∀ {Γ_1 : Context} {x_1 : String}, x_1 →ₚ τ₁✝ ; Γ_1 = x →ₚ τ₁✝ ; Γ → <{ ~(Γ_1) ⊢ ~(subst x_1 v t₁) ⦂ ~(τ₁) }>⊢ <{ ~(Γ) ⊢ ~(subst x v t₁) ⦂ ~(τ₂) }>
      apply HasType.subsub.htτ₁✝:Tyt:Tmv:Tmτ:Tyhv:<{ ∅ ⊢ ~(v) ⦂ ~(τ₁) }>Γ':PartialMap String Tyt₁:Tmτ₁:Tyτ₂:Tyhs:τ₁ <: τ₂Γ:Contextx:Stringht:<{ ~(x →ₚ τ₁✝ ; Γ) ⊢ ~(t₁) ⦂ ~(τ₁) }>ih:∀ {Γ_1 : Context} {x_1 : String}, x_1 →ₚ τ₁✝ ; Γ_1 = x →ₚ τ₁✝ ; Γ → <{ ~(Γ_1) ⊢ ~(subst x_1 v t₁) ⦂ ~(τ₁) }>⊢ <{ ~(Γ) ⊢ ~(subst x v t₁) ⦂ ~(?sub.τ₁) }>sub.hsτ₁✝:Tyt:Tmv:Tmτ:Tyhv:<{ ∅ ⊢ ~(v) ⦂ ~(τ₁) }>Γ':PartialMap String Tyt₁:Tmτ₁:Tyτ₂:Tyhs:τ₁ <: τ₂Γ:Contextx:Stringht:<{ ~(x →ₚ τ₁✝ ; Γ) ⊢ ~(t₁) ⦂ ~(τ₁) }>ih:∀ {Γ_1 : Context} {x_1 : String}, x_1 →ₚ τ₁✝ ; Γ_1 = x →ₚ τ₁✝ ; Γ → <{ ~(Γ_1) ⊢ ~(subst x_1 v t₁) ⦂ ~(τ₁) }>⊢ ?sub.τ₁ <: τ₂sub.τ₁τ₁✝:Tyt:Tmv:Tmτ:Tyhv:<{ ∅ ⊢ ~(v) ⦂ ~(τ₁) }>Γ':PartialMap String Tyt₁:Tmτ₁:Tyτ₂:Tyhs:τ₁ <: τ₂Γ:Contextx:Stringht:<{ ~(x →ₚ τ₁✝ ; Γ) ⊢ ~(t₁) ⦂ ~(τ₁) }>ih:∀ {Γ_1 : Context} {x_1 : String}, x_1 →ₚ τ₁✝ ; Γ_1 = x →ₚ τ₁✝ ; Γ → <{ ~(Γ_1) ⊢ ~(subst x_1 v t₁) ⦂ ~(τ₁) }>⊢ Ty <;>sub.htτ₁✝:Tyt:Tmv:Tmτ:Tyhv:<{ ∅ ⊢ ~(v) ⦂ ~(τ₁) }>Γ':PartialMap String Tyt₁:Tmτ₁:Tyτ₂:Tyhs:τ₁ <: τ₂Γ:Contextx:Stringht:<{ ~(x →ₚ τ₁✝ ; Γ) ⊢ ~(t₁) ⦂ ~(τ₁) }>ih:∀ {Γ_1 : Context} {x_1 : String}, x_1 →ₚ τ₁✝ ; Γ_1 = x →ₚ τ₁✝ ; Γ → <{ ~(Γ_1) ⊢ ~(subst x_1 v t₁) ⦂ ~(τ₁) }>⊢ <{ ~(Γ) ⊢ ~(subst x v t₁) ⦂ ~(?sub.τ₁) }>sub.hsτ₁✝:Tyt:Tmv:Tmτ:Tyhv:<{ ∅ ⊢ ~(v) ⦂ ~(τ₁) }>Γ':PartialMap String Tyt₁:Tmτ₁:Tyτ₂:Tyhs:τ₁ <: τ₂Γ:Contextx:Stringht:<{ ~(x →ₚ τ₁✝ ; Γ) ⊢ ~(t₁) ⦂ ~(τ₁) }>ih:∀ {Γ_1 : Context} {x_1 : String}, x_1 →ₚ τ₁✝ ; Γ_1 = x →ₚ τ₁✝ ; Γ → <{ ~(Γ_1) ⊢ ~(subst x_1 v t₁) ⦂ ~(τ₁) }>⊢ ?sub.τ₁ <: τ₂sub.τ₁τ₁✝:Tyt:Tmv:Tmτ:Tyhv:<{ ∅ ⊢ ~(v) ⦂ ~(τ₁) }>Γ':PartialMap String Tyt₁:Tmτ₁:Tyτ₂:Tyhs:τ₁ <: τ₂Γ:Contextx:Stringht:<{ ~(x →ₚ τ₁✝ ; Γ) ⊢ ~(t₁) ⦂ ~(τ₁) }>ih:∀ {Γ_1 : Context} {x_1 : String}, x_1 →ₚ τ₁✝ ; Γ_1 = x →ₚ τ₁✝ ; Γ → <{ ~(Γ_1) ⊢ ~(subst x_1 v t₁) ⦂ ~(τ₁) }>⊢ Ty solve_by_elim using StlcSubTypingAll goals completed! 🐙

8.3.7. Preservation🔗

The proof of preservation now proceeds pretty much as in earlier chapters, using the substitution lemma at the appropriate point and the inversion lemma from above to extract structural information from typing assumptions.

Theorem (Preservation): If t, t' are terms and τ is a type such that ∅ ⊢ t ⦂ τ and t ⟶ t', then ∅ ⊢ t' ⦂ τ.

Proof: Let t and τ be given such that ∅ ⊢ t ⦂ τ. We proceed by induction on the structure of this typing derivation. The abs, unit, tru, and fls cases are vacuous because abstractions and constants don't step. Case var is vacuous as well, since the context is empty.

If the final step of the derivation is by app, then there are terms t₁ and t₂ and types τ₁ and τ₂ such that t = t₁ t₂, τ = τ₂, ∅ ⊢ t₁ ⦂ τ₁ → τ₂, and ∅ ⊢ t₂ ⦂ τ₁.

By the definition of the step relation, there are three ways t₁ t₂ can step. Cases app₁' and app₂ follow immediately by the induction hypotheses for the typing subderivations and a use of app.

Suppose instead t₁ t₂ steps by appAbs. Then t₁ = λ x:σ . τ₁₂ for some type σ and term τ₁₂, and t' = [x:=t₂] τ₁₂.

By lemma abs_arrow, we have τ₁ <: σ and x:σ₁ ⊢ t₂ ⦂ τ₂. It then follows by the substitution lemma (substitution_preserves_typing) that ∅ ⊢ [x:=t₂] τ₁₂ ⦂ τ₂ as desired.
If the final step of the derivation uses rule if, then there are terms t₁, t₂, and t₃ such that t = if t₁ then t₂ else t₃, with ∅ ⊢ t₁ ⦂ Bool and with ∅ ⊢ t₂ ⦂ τ and ∅ ⊢ t₃ ⦂ τ. Moreover, by the induction hypothesis, if t₁ steps to t₁' then ∅ ⊢ t₁' : Bool. There are three cases to consider, depending on which rule was used to show t ⟶ t'.
- If t ⟶ t' by rule if, then t' = if t₁' then t₂ else t₃ with t₁ ⟶ t₁'. By the induction hypothesis, ∅ ⊢ t₁' ⦂ Bool, and so ∅ ⊢ t' ⦂ τ by if.
- If t ⟶ t' by rule ifTrue or ifFalse, then either t' = t₂ or t' = t₃, and ∅ ⊢ t' ⦂ τ follows by assumption.
If the final step of the derivation is by sub, then there is a type σ such that σ <: τ and ∅ ⊢ t ⦂ σ. The result is immediate by the induction hypothesis for the typing subderivation and an application of sub.

Qed.

theorem preservation {t t' : Tm} {τ : Ty}
  (ht : <{ ∅ ⊢ ~t ⦂ ~τ }>)
  (hs : t ⟶ t') :
  <{ ∅ ⊢ ~t' ⦂ ~τ }> := byt:Tmt':Tmτ:Tyht:<{ ∅ ⊢ ~(t) ⦂ ~(τ) }>hs:t ⟶ t'⊢ <{ ∅ ⊢ ~(t') ⦂ ~(τ) }>

  generalize heq : (∅ : Context) = Γ at htt:Tmt':Tmτ:Tyhs:t ⟶ t'Γ:Contextheq:∅ = Γht:<{ ~(Γ) ⊢ ~(t) ⦂ ~(τ) }>⊢ <{ ~(Γ) ⊢ ~(t') ⦂ ~(τ) }>
  induction ht generalizing t' with (subst_varsunitt:Tmτ:TyΓ:Contextt':Tmhs:<{ unit }> ⟶ t'⊢ <{ ∅ ⊢ ~(t') ⦂ Unit }>; first
    -- discharge the goals where `t` doesn't step
    | inversion hsAll goals completed! 🐙 <;>pair₁t:Tmτ:TyΓ:Contextt₁:Tmt₂:Tmτ₁:Tyτ₂:Tyh₁:<{ ∅ ⊢ ~(t₁) ⦂ ~(τ₁) }>h₂:<{ ∅ ⊢ ~(t₂) ⦂ ~(τ₂) }>ih₁:∀ {t' : Tm}, t₁ ⟶ t' → ∅ = ∅ → <{ ∅ ⊢ ~(t') ⦂ ~(τ₁) }>ih₂:∀ {t' : Tm}, t₂ ⟶ t' → ∅ = ∅ → <{ ∅ ⊢ ~(t') ⦂ ~(τ₂) }>t₁'✝:Tma✝:t₁ ⟶ t₁'✝⊢ <{ ∅ ⊢ ( t₁'✝ , t₂ ) ⦂ τ₁ × τ₂ }>pair₂t:Tmτ:TyΓ:Contextt₁:Tmt₂:Tmτ₁:Tyτ₂:Tyh₁:<{ ∅ ⊢ ~(t₁) ⦂ ~(τ₁) }>h₂:<{ ∅ ⊢ ~(t₂) ⦂ ~(τ₂) }>ih₁:∀ {t' : Tm}, t₁ ⟶ t' → ∅ = ∅ → <{ ∅ ⊢ ~(t') ⦂ ~(τ₁) }>ih₂:∀ {t' : Tm}, t₂ ⟶ t' → ∅ = ∅ → <{ ∅ ⊢ ~(t') ⦂ ~(τ₂) }>t₂'✝:Tma✝¹:t₁.IsValuea✝:t₂ ⟶ t₂'✝⊢ <{ ∅ ⊢ ( t₁ , t₂'✝ ) ⦂ τ₁ × τ₂ }> constructorpair₂.htt:Tmτ:TyΓ:Contextt₁:Tmt₂:Tmτ₁:Tyτ₂:Tyh₁:<{ ∅ ⊢ ~(t₁) ⦂ ~(τ₁) }>h₂:<{ ∅ ⊢ ~(t₂) ⦂ ~(τ₂) }>ih₁:∀ {t' : Tm}, t₁ ⟶ t' → ∅ = ∅ → <{ ∅ ⊢ ~(t') ⦂ ~(τ₁) }>ih₂:∀ {t' : Tm}, t₂ ⟶ t' → ∅ = ∅ → <{ ∅ ⊢ ~(t') ⦂ ~(τ₂) }>t₂'✝:Tma✝¹:t₁.IsValuea✝:t₂ ⟶ t₂'✝⊢ <{ ∅ ⊢ ( t₁ , t₂'✝ ) ⦂ ~(?pair₂.τ₁) }>pair₂.hst:Tmτ:TyΓ:Contextt₁:Tmt₂:Tmτ₁:Tyτ₂:Tyh₁:<{ ∅ ⊢ ~(t₁) ⦂ ~(τ₁) }>h₂:<{ ∅ ⊢ ~(t₂) ⦂ ~(τ₂) }>ih₁:∀ {t' : Tm}, t₁ ⟶ t' → ∅ = ∅ → <{ ∅ ⊢ ~(t') ⦂ ~(τ₁) }>ih₂:∀ {t' : Tm}, t₂ ⟶ t' → ∅ = ∅ → <{ ∅ ⊢ ~(t') ⦂ ~(τ₂) }>t₂'✝:Tma✝¹:t₁.IsValuea✝:t₂ ⟶ t₂'✝⊢ ?pair₂.τ₁ <: <{ τ₁ × τ₂ }>pair₂.τ₁t:Tmτ:TyΓ:Contextt₁:Tmt₂:Tmτ₁:Tyτ₂:Tyh₁:<{ ∅ ⊢ ~(t₁) ⦂ ~(τ₁) }>h₂:<{ ∅ ⊢ ~(t₂) ⦂ ~(τ₂) }>ih₁:∀ {t' : Tm}, t₁ ⟶ t' → ∅ = ∅ → <{ ∅ ⊢ ~(t') ⦂ ~(τ₁) }>ih₂:∀ {t' : Tm}, t₂ ⟶ t' → ∅ = ∅ → <{ ∅ ⊢ ~(t') ⦂ ~(τ₂) }>t₂'✝:Tma✝¹:t₁.IsValuea✝:t₂ ⟶ t₂'✝⊢ Ty <;>pair₁.htt:Tmτ:TyΓ:Contextt₁:Tmt₂:Tmτ₁:Tyτ₂:Tyh₁:<{ ∅ ⊢ ~(t₁) ⦂ ~(τ₁) }>h₂:<{ ∅ ⊢ ~(t₂) ⦂ ~(τ₂) }>ih₁:∀ {t' : Tm}, t₁ ⟶ t' → ∅ = ∅ → <{ ∅ ⊢ ~(t') ⦂ ~(τ₁) }>ih₂:∀ {t' : Tm}, t₂ ⟶ t' → ∅ = ∅ → <{ ∅ ⊢ ~(t') ⦂ ~(τ₂) }>t₁'✝:Tma✝:t₁ ⟶ t₁'✝⊢ <{ ∅ ⊢ ( t₁'✝ , t₂ ) ⦂ ~(?pair₁.τ₁) }>pair₁.hst:Tmτ:TyΓ:Contextt₁:Tmt₂:Tmτ₁:Tyτ₂:Tyh₁:<{ ∅ ⊢ ~(t₁) ⦂ ~(τ₁) }>h₂:<{ ∅ ⊢ ~(t₂) ⦂ ~(τ₂) }>ih₁:∀ {t' : Tm}, t₁ ⟶ t' → ∅ = ∅ → <{ ∅ ⊢ ~(t') ⦂ ~(τ₁) }>ih₂:∀ {t' : Tm}, t₂ ⟶ t' → ∅ = ∅ → <{ ∅ ⊢ ~(t') ⦂ ~(τ₂) }>t₁'✝:Tma✝:t₁ ⟶ t₁'✝⊢ ?pair₁.τ₁ <: <{ τ₁ × τ₂ }>pair₁.τ₁t:Tmτ:TyΓ:Contextt₁:Tmt₂:Tmτ₁:Tyτ₂:Tyh₁:<{ ∅ ⊢ ~(t₁) ⦂ ~(τ₁) }>h₂:<{ ∅ ⊢ ~(t₂) ⦂ ~(τ₂) }>ih₁:∀ {t' : Tm}, t₁ ⟶ t' → ∅ = ∅ → <{ ∅ ⊢ ~(t') ⦂ ~(τ₁) }>ih₂:∀ {t' : Tm}, t₂ ⟶ t' → ∅ = ∅ → <{ ∅ ⊢ ~(t') ⦂ ~(τ₂) }>t₁'✝:Tma✝:t₁ ⟶ t₁'✝⊢ Typair₂.htt:Tmτ:TyΓ:Contextt₁:Tmt₂:Tmτ₁:Tyτ₂:Tyh₁:<{ ∅ ⊢ ~(t₁) ⦂ ~(τ₁) }>h₂:<{ ∅ ⊢ ~(t₂) ⦂ ~(τ₂) }>ih₁:∀ {t' : Tm}, t₁ ⟶ t' → ∅ = ∅ → <{ ∅ ⊢ ~(t') ⦂ ~(τ₁) }>ih₂:∀ {t' : Tm}, t₂ ⟶ t' → ∅ = ∅ → <{ ∅ ⊢ ~(t') ⦂ ~(τ₂) }>t₂'✝:Tma✝¹:t₁.IsValuea✝:t₂ ⟶ t₂'✝⊢ <{ ∅ ⊢ ( t₁ , t₂'✝ ) ⦂ ~(?pair₂.τ₁) }>pair₂.hst:Tmτ:TyΓ:Contextt₁:Tmt₂:Tmτ₁:Tyτ₂:Tyh₁:<{ ∅ ⊢ ~(t₁) ⦂ ~(τ₁) }>h₂:<{ ∅ ⊢ ~(t₂) ⦂ ~(τ₂) }>ih₁:∀ {t' : Tm}, t₁ ⟶ t' → ∅ = ∅ → <{ ∅ ⊢ ~(t') ⦂ ~(τ₁) }>ih₂:∀ {t' : Tm}, t₂ ⟶ t' → ∅ = ∅ → <{ ∅ ⊢ ~(t') ⦂ ~(τ₂) }>t₂'✝:Tma✝¹:t₁.IsValuea✝:t₂ ⟶ t₂'✝⊢ ?pair₂.τ₁ <: <{ τ₁ × τ₂ }>pair₂.τ₁t:Tmτ:TyΓ:Contextt₁:Tmt₂:Tmτ₁:Tyτ₂:Tyh₁:<{ ∅ ⊢ ~(t₁) ⦂ ~(τ₁) }>h₂:<{ ∅ ⊢ ~(t₂) ⦂ ~(τ₂) }>ih₁:∀ {t' : Tm}, t₁ ⟶ t' → ∅ = ∅ → <{ ∅ ⊢ ~(t') ⦂ ~(τ₁) }>ih₂:∀ {t' : Tm}, t₂ ⟶ t' → ∅ = ∅ → <{ ∅ ⊢ ~(t') ⦂ ~(τ₂) }>t₂'✝:Tma✝¹:t₁.IsValuea✝:t₂ ⟶ t₂'✝⊢ Ty simp_allpair₂.τ₁t:Tmτ:TyΓ:Contextt₁:Tmt₂:Tmτ₁:Tyτ₂:Tyh₁:<{ ∅ ⊢ ~(t₁) ⦂ ~(τ₁) }>h₂:<{ ∅ ⊢ ~(t₂) ⦂ ~(τ₂) }>t₂'✝:Tmih₁:∀ {t' : Tm}, t₁ ⟶ t' → <{ ∅ ⊢ ~(t') ⦂ ~(τ₁) }>ih₂:∀ {t' : Tm}, t₂ ⟶ t' → <{ ∅ ⊢ ~(t') ⦂ ~(τ₂) }>a✝¹:t₁.IsValuea✝:t₂ ⟶ t₂'✝⊢ Ty; doneAll goals completed! 🐙
    | try (inversion hspair₁t:Tmτ:TyΓ:Contextt₁:Tmt₂:Tmτ₁:Tyτ₂:Tyh₁:<{ ∅ ⊢ ~(t₁) ⦂ ~(τ₁) }>h₂:<{ ∅ ⊢ ~(t₂) ⦂ ~(τ₂) }>ih₁:∀ {t' : Tm}, t₁ ⟶ t' → ∅ = ∅ → <{ ∅ ⊢ ~(t') ⦂ ~(τ₁) }>ih₂:∀ {t' : Tm}, t₂ ⟶ t' → ∅ = ∅ → <{ ∅ ⊢ ~(t') ⦂ ~(τ₂) }>t₁'✝:Tma✝:t₁ ⟶ t₁'✝⊢ <{ ∅ ⊢ ( t₁'✝ , t₂ ) ⦂ τ₁ × τ₂ }>pair₂t:Tmτ:TyΓ:Contextt₁:Tmt₂:Tmτ₁:Tyτ₂:Tyh₁:<{ ∅ ⊢ ~(t₁) ⦂ ~(τ₁) }>h₂:<{ ∅ ⊢ ~(t₂) ⦂ ~(τ₂) }>ih₁:∀ {t' : Tm}, t₁ ⟶ t' → ∅ = ∅ → <{ ∅ ⊢ ~(t') ⦂ ~(τ₁) }>ih₂:∀ {t' : Tm}, t₂ ⟶ t' → ∅ = ∅ → <{ ∅ ⊢ ~(t') ⦂ ~(τ₂) }>t₂'✝:Tma✝¹:t₁.IsValuea✝:t₂ ⟶ t₂'✝⊢ <{ ∅ ⊢ ( t₁ , t₂'✝ ) ⦂ τ₁ × τ₂ }>; apply_rules using StlcSubTypingpair₂t:Tmτ:TyΓ:Contextt₁:Tmt₂:Tmτ₁:Tyτ₂:Tyh₁:<{ ∅ ⊢ ~(t₁) ⦂ ~(τ₁) }>h₂:<{ ∅ ⊢ ~(t₂) ⦂ ~(τ₂) }>ih₁:∀ {t' : Tm}, t₁ ⟶ t' → ∅ = ∅ → <{ ∅ ⊢ ~(t') ⦂ ~(τ₁) }>ih₂:∀ {t' : Tm}, t₂ ⟶ t' → ∅ = ∅ → <{ ∅ ⊢ ~(t') ⦂ ~(τ₂) }>t₂'✝:Tma✝¹:t₁.IsValuea✝:t₂ ⟶ t₂'✝⊢ <{ ∅ ⊢ ( t₁ , t₂'✝ ) ⦂ τ₁ × τ₂ }>; doneAll goals completed! 🐙))
  | app Γ τ₁' τ₂' t₁' t₂ h₁ h₂ ih₁ ih₂ =>appt:Tmτ:TyΓ:Contextτ₁':Tyτ₂':Tyt₁':Tmt₂:Tmt':Tmhs:<{ t₁' t₂ }> ⟶ t'h₁:<{ ∅ ⊢ ~(t₁') ⦂ τ₂' → τ₁' }>h₂:<{ ∅ ⊢ ~(t₂) ⦂ ~(τ₂') }>ih₁:∀ {t' : Tm}, t₁' ⟶ t' → ∅ = ∅ → <{ ∅ ⊢ ~(t') ⦂ τ₂' → τ₁' }>ih₂:∀ {t' : Tm}, t₂ ⟶ t' → ∅ = ∅ → <{ ∅ ⊢ ~(t') ⦂ ~(τ₂') }>⊢ <{ ∅ ⊢ ~(t') ⦂ ~(τ₁') }>
    inversion hs with (try (constructorapp₂.h₁t:Tmτ:TyΓ:Contextτ₁':Tyτ₂':Tyt₁':Tmt₂:Tmh₁:<{ ∅ ⊢ ~(t₁') ⦂ τ₂' → τ₁' }>h₂:<{ ∅ ⊢ ~(t₂) ⦂ ~(τ₂') }>ih₁:∀ {t' : Tm}, t₁' ⟶ t' → ∅ = ∅ → <{ ∅ ⊢ ~(t') ⦂ τ₂' → τ₁' }>ih₂:∀ {t' : Tm}, t₂ ⟶ t' → ∅ = ∅ → <{ ∅ ⊢ ~(t') ⦂ ~(τ₂') }>t₂'✝:Tma✝¹:t₁'.IsValuea✝:t₂ ⟶ t₂'✝⊢ <{ ∅ ⊢ ~(t₁') ⦂ ~?app₂.τ₂ → τ₁' }>app₂.h₂t:Tmτ:TyΓ:Contextτ₁':Tyτ₂':Tyt₁':Tmt₂:Tmh₁:<{ ∅ ⊢ ~(t₁') ⦂ τ₂' → τ₁' }>h₂:<{ ∅ ⊢ ~(t₂) ⦂ ~(τ₂') }>ih₁:∀ {t' : Tm}, t₁' ⟶ t' → ∅ = ∅ → <{ ∅ ⊢ ~(t') ⦂ τ₂' → τ₁' }>ih₂:∀ {t' : Tm}, t₂ ⟶ t' → ∅ = ∅ → <{ ∅ ⊢ ~(t') ⦂ ~(τ₂') }>t₂'✝:Tma✝¹:t₁'.IsValuea✝:t₂ ⟶ t₂'✝⊢ <{ ∅ ⊢ ~(t₂'✝) ⦂ ~(?app₂.τ₂) }>app₂.τ₂t:Tmτ:TyΓ:Contextτ₁':Tyτ₂':Tyt₁':Tmt₂:Tmh₁:<{ ∅ ⊢ ~(t₁') ⦂ τ₂' → τ₁' }>h₂:<{ ∅ ⊢ ~(t₂) ⦂ ~(τ₂') }>ih₁:∀ {t' : Tm}, t₁' ⟶ t' → ∅ = ∅ → <{ ∅ ⊢ ~(t') ⦂ τ₂' → τ₁' }>ih₂:∀ {t' : Tm}, t₂ ⟶ t' → ∅ = ∅ → <{ ∅ ⊢ ~(t') ⦂ ~(τ₂') }>t₂'✝:Tma✝¹:t₁'.IsValuea✝:t₂ ⟶ t₂'✝⊢ Ty <;>app₂.h₁t:Tmτ:TyΓ:Contextτ₁':Tyτ₂':Tyt₁':Tmt₂:Tmh₁:<{ ∅ ⊢ ~(t₁') ⦂ τ₂' → τ₁' }>h₂:<{ ∅ ⊢ ~(t₂) ⦂ ~(τ₂') }>ih₁:∀ {t' : Tm}, t₁' ⟶ t' → ∅ = ∅ → <{ ∅ ⊢ ~(t') ⦂ τ₂' → τ₁' }>ih₂:∀ {t' : Tm}, t₂ ⟶ t' → ∅ = ∅ → <{ ∅ ⊢ ~(t') ⦂ ~(τ₂') }>t₂'✝:Tma✝¹:t₁'.IsValuea✝:t₂ ⟶ t₂'✝⊢ <{ ∅ ⊢ ~(t₁') ⦂ ~?app₂.τ₂ → τ₁' }>app₂.h₂t:Tmτ:TyΓ:Contextτ₁':Tyτ₂':Tyt₁':Tmt₂:Tmh₁:<{ ∅ ⊢ ~(t₁') ⦂ τ₂' → τ₁' }>h₂:<{ ∅ ⊢ ~(t₂) ⦂ ~(τ₂') }>ih₁:∀ {t' : Tm}, t₁' ⟶ t' → ∅ = ∅ → <{ ∅ ⊢ ~(t') ⦂ τ₂' → τ₁' }>ih₂:∀ {t' : Tm}, t₂ ⟶ t' → ∅ = ∅ → <{ ∅ ⊢ ~(t') ⦂ ~(τ₂') }>t₂'✝:Tma✝¹:t₁'.IsValuea✝:t₂ ⟶ t₂'✝⊢ <{ ∅ ⊢ ~(t₂'✝) ⦂ ~(?app₂.τ₂) }>app₂.τ₂t:Tmτ:TyΓ:Contextτ₁':Tyτ₂':Tyt₁':Tmt₂:Tmh₁:<{ ∅ ⊢ ~(t₁') ⦂ τ₂' → τ₁' }>h₂:<{ ∅ ⊢ ~(t₂) ⦂ ~(τ₂') }>ih₁:∀ {t' : Tm}, t₁' ⟶ t' → ∅ = ∅ → <{ ∅ ⊢ ~(t') ⦂ τ₂' → τ₁' }>ih₂:∀ {t' : Tm}, t₂ ⟶ t' → ∅ = ∅ → <{ ∅ ⊢ ~(t') ⦂ ~(τ₂') }>t₂'✝:Tma✝¹:t₁'.IsValuea✝:t₂ ⟶ t₂'✝⊢ Ty apply_rulesAll goals completed! 🐙; done))
    | appAbs _ τ₂ t₁ h =>
        obtain ⟨h₁, h₂⟩ := abs_arrow h₁appAbst:Tmτ:TyΓ:Contextτ₁':Tyτ₂':Tyt₂:Tmh₂✝:<{ ∅ ⊢ ~(t₂) ⦂ ~(τ₂') }>ih₂:∀ {t' : Tm}, t₂ ⟶ t' → ∅ = ∅ → <{ ∅ ⊢ ~(t') ⦂ ~(τ₂') }>x✝:Stringτ₂:Tyt₁:Tmh₁✝:<{ ∅ ⊢ λ ~x✝ : τ₂ . t₁ ⦂ τ₂' → τ₁' }>ih₁:∀ {t' : Tm}, <{ λ ~x✝ : τ₂ . t₁ }> ⟶ t' → ∅ = ∅ → <{ ∅ ⊢ ~(t') ⦂ τ₂' → τ₁' }>h:t₂.IsValueh₁:τ₂' <: τ₂h₂:<{ ~(x✝ →ₚ τ₂) ⊢ ~(t₁) ⦂ ~(τ₁') }>⊢ <{ ∅ ⊢ ~(subst x✝ t₂ t₁) ⦂ ~(τ₁') }>
        apply substitution_preserves_typing (τ₁:=τ₂)appAbs.htt:Tmτ:TyΓ:Contextτ₁':Tyτ₂':Tyt₂:Tmh₂✝:<{ ∅ ⊢ ~(t₂) ⦂ ~(τ₂') }>ih₂:∀ {t' : Tm}, t₂ ⟶ t' → ∅ = ∅ → <{ ∅ ⊢ ~(t') ⦂ ~(τ₂') }>x✝:Stringτ₂:Tyt₁:Tmh₁✝:<{ ∅ ⊢ λ ~x✝ : τ₂ . t₁ ⦂ τ₂' → τ₁' }>ih₁:∀ {t' : Tm}, <{ λ ~x✝ : τ₂ . t₁ }> ⟶ t' → ∅ = ∅ → <{ ∅ ⊢ ~(t') ⦂ τ₂' → τ₁' }>h:t₂.IsValueh₁:τ₂' <: τ₂h₂:<{ ~(x✝ →ₚ τ₂) ⊢ ~(t₁) ⦂ ~(τ₁') }>⊢ <{ ~(x✝ →ₚ τ₂) ⊢ ~(t₁) ⦂ ~(τ₁') }>appAbs.hvt:Tmτ:TyΓ:Contextτ₁':Tyτ₂':Tyt₂:Tmh₂✝:<{ ∅ ⊢ ~(t₂) ⦂ ~(τ₂') }>ih₂:∀ {t' : Tm}, t₂ ⟶ t' → ∅ = ∅ → <{ ∅ ⊢ ~(t') ⦂ ~(τ₂') }>x✝:Stringτ₂:Tyt₁:Tmh₁✝:<{ ∅ ⊢ λ ~x✝ : τ₂ . t₁ ⦂ τ₂' → τ₁' }>ih₁:∀ {t' : Tm}, <{ λ ~x✝ : τ₂ . t₁ }> ⟶ t' → ∅ = ∅ → <{ ∅ ⊢ ~(t') ⦂ τ₂' → τ₁' }>h:t₂.IsValueh₁:τ₂' <: τ₂h₂:<{ ~(x✝ →ₚ τ₂) ⊢ ~(t₁) ⦂ ~(τ₁') }>⊢ <{ ∅ ⊢ ~(t₂) ⦂ ~(τ₂) }>
        ·appAbs.htt:Tmτ:TyΓ:Contextτ₁':Tyτ₂':Tyt₂:Tmh₂✝:<{ ∅ ⊢ ~(t₂) ⦂ ~(τ₂') }>ih₂:∀ {t' : Tm}, t₂ ⟶ t' → ∅ = ∅ → <{ ∅ ⊢ ~(t') ⦂ ~(τ₂') }>x✝:Stringτ₂:Tyt₁:Tmh₁✝:<{ ∅ ⊢ λ ~x✝ : τ₂ . t₁ ⦂ τ₂' → τ₁' }>ih₁:∀ {t' : Tm}, <{ λ ~x✝ : τ₂ . t₁ }> ⟶ t' → ∅ = ∅ → <{ ∅ ⊢ ~(t') ⦂ τ₂' → τ₁' }>h:t₂.IsValueh₁:τ₂' <: τ₂h₂:<{ ~(x✝ →ₚ τ₂) ⊢ ~(t₁) ⦂ ~(τ₁') }>⊢ <{ ~(x✝ →ₚ τ₂) ⊢ ~(t₁) ⦂ ~(τ₁') }> assumptionAll goals completed! 🐙
        ·appAbs.hvt:Tmτ:TyΓ:Contextτ₁':Tyτ₂':Tyt₂:Tmh₂✝:<{ ∅ ⊢ ~(t₂) ⦂ ~(τ₂') }>ih₂:∀ {t' : Tm}, t₂ ⟶ t' → ∅ = ∅ → <{ ∅ ⊢ ~(t') ⦂ ~(τ₂') }>x✝:Stringτ₂:Tyt₁:Tmh₁✝:<{ ∅ ⊢ λ ~x✝ : τ₂ . t₁ ⦂ τ₂' → τ₁' }>ih₁:∀ {t' : Tm}, <{ λ ~x✝ : τ₂ . t₁ }> ⟶ t' → ∅ = ∅ → <{ ∅ ⊢ ~(t') ⦂ τ₂' → τ₁' }>h:t₂.IsValueh₁:τ₂' <: τ₂h₂:<{ ~(x✝ →ₚ τ₂) ⊢ ~(t₁) ⦂ ~(τ₁') }>⊢ <{ ∅ ⊢ ~(t₂) ⦂ ~(τ₂) }> apply HasType.subappAbs.hv.htt:Tmτ:TyΓ:Contextτ₁':Tyτ₂':Tyt₂:Tmh₂✝:<{ ∅ ⊢ ~(t₂) ⦂ ~(τ₂') }>ih₂:∀ {t' : Tm}, t₂ ⟶ t' → ∅ = ∅ → <{ ∅ ⊢ ~(t') ⦂ ~(τ₂') }>x✝:Stringτ₂:Tyt₁:Tmh₁✝:<{ ∅ ⊢ λ ~x✝ : τ₂ . t₁ ⦂ τ₂' → τ₁' }>ih₁:∀ {t' : Tm}, <{ λ ~x✝ : τ₂ . t₁ }> ⟶ t' → ∅ = ∅ → <{ ∅ ⊢ ~(t') ⦂ τ₂' → τ₁' }>h:t₂.IsValueh₁:τ₂' <: τ₂h₂:<{ ~(x✝ →ₚ τ₂) ⊢ ~(t₁) ⦂ ~(τ₁') }>⊢ <{ ∅ ⊢ ~(t₂) ⦂ ~(?appAbs.hv.τ₁) }>appAbs.hv.hst:Tmτ:TyΓ:Contextτ₁':Tyτ₂':Tyt₂:Tmh₂✝:<{ ∅ ⊢ ~(t₂) ⦂ ~(τ₂') }>ih₂:∀ {t' : Tm}, t₂ ⟶ t' → ∅ = ∅ → <{ ∅ ⊢ ~(t') ⦂ ~(τ₂') }>x✝:Stringτ₂:Tyt₁:Tmh₁✝:<{ ∅ ⊢ λ ~x✝ : τ₂ . t₁ ⦂ τ₂' → τ₁' }>ih₁:∀ {t' : Tm}, <{ λ ~x✝ : τ₂ . t₁ }> ⟶ t' → ∅ = ∅ → <{ ∅ ⊢ ~(t') ⦂ τ₂' → τ₁' }>h:t₂.IsValueh₁:τ₂' <: τ₂h₂:<{ ~(x✝ →ₚ τ₂) ⊢ ~(t₁) ⦂ ~(τ₁') }>⊢ ?appAbs.hv.τ₁ <: τ₂appAbs.hv.τ₁t:Tmτ:TyΓ:Contextτ₁':Tyτ₂':Tyt₂:Tmh₂✝:<{ ∅ ⊢ ~(t₂) ⦂ ~(τ₂') }>ih₂:∀ {t' : Tm}, t₂ ⟶ t' → ∅ = ∅ → <{ ∅ ⊢ ~(t') ⦂ ~(τ₂') }>x✝:Stringτ₂:Tyt₁:Tmh₁✝:<{ ∅ ⊢ λ ~x✝ : τ₂ . t₁ ⦂ τ₂' → τ₁' }>ih₁:∀ {t' : Tm}, <{ λ ~x✝ : τ₂ . t₁ }> ⟶ t' → ∅ = ∅ → <{ ∅ ⊢ ~(t') ⦂ τ₂' → τ₁' }>h:t₂.IsValueh₁:τ₂' <: τ₂h₂:<{ ~(x✝ →ₚ τ₂) ⊢ ~(t₁) ⦂ ~(τ₁') }>⊢ Ty <;>appAbs.hv.htt:Tmτ:TyΓ:Contextτ₁':Tyτ₂':Tyt₂:Tmh₂✝:<{ ∅ ⊢ ~(t₂) ⦂ ~(τ₂') }>ih₂:∀ {t' : Tm}, t₂ ⟶ t' → ∅ = ∅ → <{ ∅ ⊢ ~(t') ⦂ ~(τ₂') }>x✝:Stringτ₂:Tyt₁:Tmh₁✝:<{ ∅ ⊢ λ ~x✝ : τ₂ . t₁ ⦂ τ₂' → τ₁' }>ih₁:∀ {t' : Tm}, <{ λ ~x✝ : τ₂ . t₁ }> ⟶ t' → ∅ = ∅ → <{ ∅ ⊢ ~(t') ⦂ τ₂' → τ₁' }>h:t₂.IsValueh₁:τ₂' <: τ₂h₂:<{ ~(x✝ →ₚ τ₂) ⊢ ~(t₁) ⦂ ~(τ₁') }>⊢ <{ ∅ ⊢ ~(t₂) ⦂ ~(?appAbs.hv.τ₁) }>appAbs.hv.hst:Tmτ:TyΓ:Contextτ₁':Tyτ₂':Tyt₂:Tmh₂✝:<{ ∅ ⊢ ~(t₂) ⦂ ~(τ₂') }>ih₂:∀ {t' : Tm}, t₂ ⟶ t' → ∅ = ∅ → <{ ∅ ⊢ ~(t') ⦂ ~(τ₂') }>x✝:Stringτ₂:Tyt₁:Tmh₁✝:<{ ∅ ⊢ λ ~x✝ : τ₂ . t₁ ⦂ τ₂' → τ₁' }>ih₁:∀ {t' : Tm}, <{ λ ~x✝ : τ₂ . t₁ }> ⟶ t' → ∅ = ∅ → <{ ∅ ⊢ ~(t') ⦂ τ₂' → τ₁' }>h:t₂.IsValueh₁:τ₂' <: τ₂h₂:<{ ~(x✝ →ₚ τ₂) ⊢ ~(t₁) ⦂ ~(τ₁') }>⊢ ?appAbs.hv.τ₁ <: τ₂appAbs.hv.τ₁t:Tmτ:TyΓ:Contextτ₁':Tyτ₂':Tyt₂:Tmh₂✝:<{ ∅ ⊢ ~(t₂) ⦂ ~(τ₂') }>ih₂:∀ {t' : Tm}, t₂ ⟶ t' → ∅ = ∅ → <{ ∅ ⊢ ~(t') ⦂ ~(τ₂') }>x✝:Stringτ₂:Tyt₁:Tmh₁✝:<{ ∅ ⊢ λ ~x✝ : τ₂ . t₁ ⦂ τ₂' → τ₁' }>ih₁:∀ {t' : Tm}, <{ λ ~x✝ : τ₂ . t₁ }> ⟶ t' → ∅ = ∅ → <{ ∅ ⊢ ~(t') ⦂ τ₂' → τ₁' }>h:t₂.IsValueh₁:τ₂' <: τ₂h₂:<{ ~(x✝ →ₚ τ₂) ⊢ ~(t₁) ⦂ ~(τ₁') }>⊢ Ty apply_rules using StlcSubTypingAll goals completed! 🐙
  | ite Γ t₁ t₂ t₃ τ h₁ h₂ h₃ ih₁ ih₂ ih₃ =>itet:Tmτ✝:TyΓ:Contextt₁:Tmt₂:Tmt₃:Tmτ:Tyt':Tmhs:<{ if t₁ then t₂ else t₃ }> ⟶ t'h₁:<{ ∅ ⊢ ~(t₁) ⦂ Bool }>h₂:<{ ∅ ⊢ ~(t₂) ⦂ ~(τ) }>h₃:<{ ∅ ⊢ ~(t₃) ⦂ ~(τ) }>ih₁:∀ {t' : Tm}, t₁ ⟶ t' → ∅ = ∅ → <{ ∅ ⊢ ~(t') ⦂ Bool }>ih₂:∀ {t' : Tm}, t₂ ⟶ t' → ∅ = ∅ → <{ ∅ ⊢ ~(t') ⦂ ~(τ) }>ih₃:∀ {t' : Tm}, t₃ ⟶ t' → ∅ = ∅ → <{ ∅ ⊢ ~(t') ⦂ ~(τ) }>⊢ <{ ∅ ⊢ ~(t') ⦂ ~(τ) }>
    inversion hs with (try (constructorifFalse.htt:Tmτ✝:TyΓ:Contextt₂:Tmt₃:Tmτ:Tyh₂:<{ ∅ ⊢ ~(t₂) ⦂ ~(τ) }>h₃:<{ ∅ ⊢ ~(t₃) ⦂ ~(τ) }>ih₂:∀ {t' : Tm}, t₂ ⟶ t' → ∅ = ∅ → <{ ∅ ⊢ ~(t') ⦂ ~(τ) }>ih₃:∀ {t' : Tm}, t₃ ⟶ t' → ∅ = ∅ → <{ ∅ ⊢ ~(t') ⦂ ~(τ) }>h₁:<{ ∅ ⊢ false ⦂ Bool }>ih₁:∀ {t' : Tm}, <{ false }> ⟶ t' → ∅ = ∅ → <{ ∅ ⊢ ~(t') ⦂ Bool }>⊢ <{ ∅ ⊢ ~(t₃) ⦂ ~(?ifFalse.τ₁) }>ifFalse.hst:Tmτ✝:TyΓ:Contextt₂:Tmt₃:Tmτ:Tyh₂:<{ ∅ ⊢ ~(t₂) ⦂ ~(τ) }>h₃:<{ ∅ ⊢ ~(t₃) ⦂ ~(τ) }>ih₂:∀ {t' : Tm}, t₂ ⟶ t' → ∅ = ∅ → <{ ∅ ⊢ ~(t') ⦂ ~(τ) }>ih₃:∀ {t' : Tm}, t₃ ⟶ t' → ∅ = ∅ → <{ ∅ ⊢ ~(t') ⦂ ~(τ) }>h₁:<{ ∅ ⊢ false ⦂ Bool }>ih₁:∀ {t' : Tm}, <{ false }> ⟶ t' → ∅ = ∅ → <{ ∅ ⊢ ~(t') ⦂ Bool }>⊢ ?ifFalse.τ₁ <: τifFalse.τ₁t:Tmτ✝:TyΓ:Contextt₂:Tmt₃:Tmτ:Tyh₂:<{ ∅ ⊢ ~(t₂) ⦂ ~(τ) }>h₃:<{ ∅ ⊢ ~(t₃) ⦂ ~(τ) }>ih₂:∀ {t' : Tm}, t₂ ⟶ t' → ∅ = ∅ → <{ ∅ ⊢ ~(t') ⦂ ~(τ) }>ih₃:∀ {t' : Tm}, t₃ ⟶ t' → ∅ = ∅ → <{ ∅ ⊢ ~(t') ⦂ ~(τ) }>h₁:<{ ∅ ⊢ false ⦂ Bool }>ih₁:∀ {t' : Tm}, <{ false }> ⟶ t' → ∅ = ∅ → <{ ∅ ⊢ ~(t') ⦂ Bool }>⊢ Ty <;>ifFalse.htt:Tmτ✝:TyΓ:Contextt₂:Tmt₃:Tmτ:Tyh₂:<{ ∅ ⊢ ~(t₂) ⦂ ~(τ) }>h₃:<{ ∅ ⊢ ~(t₃) ⦂ ~(τ) }>ih₂:∀ {t' : Tm}, t₂ ⟶ t' → ∅ = ∅ → <{ ∅ ⊢ ~(t') ⦂ ~(τ) }>ih₃:∀ {t' : Tm}, t₃ ⟶ t' → ∅ = ∅ → <{ ∅ ⊢ ~(t') ⦂ ~(τ) }>h₁:<{ ∅ ⊢ false ⦂ Bool }>ih₁:∀ {t' : Tm}, <{ false }> ⟶ t' → ∅ = ∅ → <{ ∅ ⊢ ~(t') ⦂ Bool }>⊢ <{ ∅ ⊢ ~(t₃) ⦂ ~(?ifFalse.τ₁) }>ifFalse.hst:Tmτ✝:TyΓ:Contextt₂:Tmt₃:Tmτ:Tyh₂:<{ ∅ ⊢ ~(t₂) ⦂ ~(τ) }>h₃:<{ ∅ ⊢ ~(t₃) ⦂ ~(τ) }>ih₂:∀ {t' : Tm}, t₂ ⟶ t' → ∅ = ∅ → <{ ∅ ⊢ ~(t') ⦂ ~(τ) }>ih₃:∀ {t' : Tm}, t₃ ⟶ t' → ∅ = ∅ → <{ ∅ ⊢ ~(t') ⦂ ~(τ) }>h₁:<{ ∅ ⊢ false ⦂ Bool }>ih₁:∀ {t' : Tm}, <{ false }> ⟶ t' → ∅ = ∅ → <{ ∅ ⊢ ~(t') ⦂ Bool }>⊢ ?ifFalse.τ₁ <: τifFalse.τ₁t:Tmτ✝:TyΓ:Contextt₂:Tmt₃:Tmτ:Tyh₂:<{ ∅ ⊢ ~(t₂) ⦂ ~(τ) }>h₃:<{ ∅ ⊢ ~(t₃) ⦂ ~(τ) }>ih₂:∀ {t' : Tm}, t₂ ⟶ t' → ∅ = ∅ → <{ ∅ ⊢ ~(t') ⦂ ~(τ) }>ih₃:∀ {t' : Tm}, t₃ ⟶ t' → ∅ = ∅ → <{ ∅ ⊢ ~(t') ⦂ ~(τ) }>h₁:<{ ∅ ⊢ false ⦂ Bool }>ih₁:∀ {t' : Tm}, <{ false }> ⟶ t' → ∅ = ∅ → <{ ∅ ⊢ ~(t') ⦂ Bool }>⊢ Ty solve_by_elim using StlcSubEvalAll goals completed! 🐙))
  | sub Γ t₁ τ₁ τ₂ ht hs ih =>subt:Tmτ:TyΓ:Contextt₁:Tmτ₁:Tyτ₂:Tyhs✝:τ₁ <: τ₂t':Tmhs:t₁ ⟶ t'ht:<{ ∅ ⊢ ~(t₁) ⦂ ~(τ₁) }>ih:∀ {t' : Tm}, t₁ ⟶ t' → ∅ = ∅ → <{ ∅ ⊢ ~(t') ⦂ ~(τ₁) }>⊢ <{ ∅ ⊢ ~(t') ⦂ ~(τ₂) }>
      apply HasType.subsub.htt:Tmτ:TyΓ:Contextt₁:Tmτ₁:Tyτ₂:Tyhs✝:τ₁ <: τ₂t':Tmhs:t₁ ⟶ t'ht:<{ ∅ ⊢ ~(t₁) ⦂ ~(τ₁) }>ih:∀ {t' : Tm}, t₁ ⟶ t' → ∅ = ∅ → <{ ∅ ⊢ ~(t') ⦂ ~(τ₁) }>⊢ <{ ∅ ⊢ ~(t') ⦂ ~(?sub.τ₁) }>sub.hst:Tmτ:TyΓ:Contextt₁:Tmτ₁:Tyτ₂:Tyhs✝:τ₁ <: τ₂t':Tmhs:t₁ ⟶ t'ht:<{ ∅ ⊢ ~(t₁) ⦂ ~(τ₁) }>ih:∀ {t' : Tm}, t₁ ⟶ t' → ∅ = ∅ → <{ ∅ ⊢ ~(t') ⦂ ~(τ₁) }>⊢ ?sub.τ₁ <: τ₂sub.τ₁t:Tmτ:TyΓ:Contextt₁:Tmτ₁:Tyτ₂:Tyhs✝:τ₁ <: τ₂t':Tmhs:t₁ ⟶ t'ht:<{ ∅ ⊢ ~(t₁) ⦂ ~(τ₁) }>ih:∀ {t' : Tm}, t₁ ⟶ t' → ∅ = ∅ → <{ ∅ ⊢ ~(t') ⦂ ~(τ₁) }>⊢ Ty <;>sub.htt:Tmτ:TyΓ:Contextt₁:Tmτ₁:Tyτ₂:Tyhs✝:τ₁ <: τ₂t':Tmhs:t₁ ⟶ t'ht:<{ ∅ ⊢ ~(t₁) ⦂ ~(τ₁) }>ih:∀ {t' : Tm}, t₁ ⟶ t' → ∅ = ∅ → <{ ∅ ⊢ ~(t') ⦂ ~(τ₁) }>⊢ <{ ∅ ⊢ ~(t') ⦂ ~(?sub.τ₁) }>sub.hst:Tmτ:TyΓ:Contextt₁:Tmτ₁:Tyτ₂:Tyhs✝:τ₁ <: τ₂t':Tmhs:t₁ ⟶ t'ht:<{ ∅ ⊢ ~(t₁) ⦂ ~(τ₁) }>ih:∀ {t' : Tm}, t₁ ⟶ t' → ∅ = ∅ → <{ ∅ ⊢ ~(t') ⦂ ~(τ₁) }>⊢ ?sub.τ₁ <: τ₂sub.τ₁t:Tmτ:TyΓ:Contextt₁:Tmτ₁:Tyτ₂:Tyhs✝:τ₁ <: τ₂t':Tmhs:t₁ ⟶ t'ht:<{ ∅ ⊢ ~(t₁) ⦂ ~(τ₁) }>ih:∀ {t' : Tm}, t₁ ⟶ t' → ∅ = ∅ → <{ ∅ ⊢ ~(t') ⦂ ~(τ₁) }>⊢ Ty solve_by_elim using StlcSubTypingAll goals completed! 🐙
  | fst Γ t τ₁ τ₂ h ih  =>fstt✝:Tmτ:TyΓ:Contextt:Tmτ₁:Tyτ₂:Tyt':Tmhs:<{ fst t }> ⟶ t'h:<{ ∅ ⊢ ~(t) ⦂ τ₁ × τ₂ }>ih:∀ {t' : Tm}, t ⟶ t' → ∅ = ∅ → <{ ∅ ⊢ ~(t') ⦂ τ₁ × τ₂ }>⊢ <{ ∅ ⊢ ~(t') ⦂ ~(τ₁) }>
      inversion hs with (try solve_by_elim using StlcSubTypingAll goals completed! 🐙)
      | fstPair =>
          obtain ⟨σ₁, σ₂, hs', ht₁, ht₂⟩ := typing_inversion_pair hfstPairt:Tmτ:TyΓ:Contextτ₁:Tyτ₂:Tyt':Tmv₂✝:Tma✝¹:v₂✝.IsValuea✝:t'.IsValueh:<{ ∅ ⊢ ( t' , v₂✝ ) ⦂ τ₁ × τ₂ }>ih:∀ {t'_1 : Tm}, <{ ( t' , v₂✝ ) }> ⟶ t'_1 → ∅ = ∅ → <{ ∅ ⊢ ~(t'_1) ⦂ τ₁ × τ₂ }>σ₁:Tyσ₂:Tyhs':<{ σ₁ × σ₂ }> <: <{ τ₁ × τ₂ }>ht₁:<{ ∅ ⊢ ~(t') ⦂ ~(σ₁) }>ht₂:<{ ∅ ⊢ ~(v₂✝) ⦂ ~(σ₂) }>⊢ <{ ∅ ⊢ ~(t') ⦂ ~(τ₁) }>
          obtain ⟨σ₁, σ₂, heq, hs₁, hs₂⟩ := sub_inversion_prod hs'fstPairt:Tmτ:TyΓ:Contextτ₁:Tyτ₂:Tyt':Tmv₂✝:Tma✝¹:v₂✝.IsValuea✝:t'.IsValueh:<{ ∅ ⊢ ( t' , v₂✝ ) ⦂ τ₁ × τ₂ }>ih:∀ {t'_1 : Tm}, <{ ( t' , v₂✝ ) }> ⟶ t'_1 → ∅ = ∅ → <{ ∅ ⊢ ~(t'_1) ⦂ τ₁ × τ₂ }>σ₁✝:Tyσ₂✝:Tyhs':<{ σ₁ × σ₂ }> <: <{ τ₁ × τ₂ }>ht₁:<{ ∅ ⊢ ~(t') ⦂ ~(σ₁) }>ht₂:<{ ∅ ⊢ ~(v₂✝) ⦂ ~(σ₂) }>σ₁:Tyσ₂:Tyheq:<{ σ₁✝ × σ₂✝ }> = <{ σ₁ × σ₂ }>hs₁:σ₁ <: τ₁hs₂:σ₂ <: τ₂⊢ <{ ∅ ⊢ ~(t') ⦂ ~(τ₁) }>
          inversion heqreflt:Tmτ:TyΓ:Contextτ₁:Tyτ₂:Tyt':Tmv₂✝:Tma✝¹:v₂✝.IsValuea✝:t'.IsValueh:<{ ∅ ⊢ ( t' , v₂✝ ) ⦂ τ₁ × τ₂ }>ih:∀ {t'_1 : Tm}, <{ ( t' , v₂✝ ) }> ⟶ t'_1 → ∅ = ∅ → <{ ∅ ⊢ ~(t'_1) ⦂ τ₁ × τ₂ }>σ₁:Tyσ₂:Tyhs':<{ σ₁ × σ₂ }> <: <{ τ₁ × τ₂ }>ht₁:<{ ∅ ⊢ ~(t') ⦂ ~(σ₁) }>ht₂:<{ ∅ ⊢ ~(v₂✝) ⦂ ~(σ₂) }>hs₁:σ₁ <: τ₁hs₂:σ₂ <: τ₂⊢ <{ ∅ ⊢ ~(t') ⦂ ~(τ₁) }>; apply HasType.subrefl.htt:Tmτ:TyΓ:Contextτ₁:Tyτ₂:Tyt':Tmv₂✝:Tma✝¹:v₂✝.IsValuea✝:t'.IsValueh:<{ ∅ ⊢ ( t' , v₂✝ ) ⦂ τ₁ × τ₂ }>ih:∀ {t'_1 : Tm}, <{ ( t' , v₂✝ ) }> ⟶ t'_1 → ∅ = ∅ → <{ ∅ ⊢ ~(t'_1) ⦂ τ₁ × τ₂ }>σ₁:Tyσ₂:Tyhs':<{ σ₁ × σ₂ }> <: <{ τ₁ × τ₂ }>ht₁:<{ ∅ ⊢ ~(t') ⦂ ~(σ₁) }>ht₂:<{ ∅ ⊢ ~(v₂✝) ⦂ ~(σ₂) }>hs₁:σ₁ <: τ₁hs₂:σ₂ <: τ₂⊢ <{ ∅ ⊢ ~(t') ⦂ ~(?refl.τ₁) }>refl.hst:Tmτ:TyΓ:Contextτ₁:Tyτ₂:Tyt':Tmv₂✝:Tma✝¹:v₂✝.IsValuea✝:t'.IsValueh:<{ ∅ ⊢ ( t' , v₂✝ ) ⦂ τ₁ × τ₂ }>ih:∀ {t'_1 : Tm}, <{ ( t' , v₂✝ ) }> ⟶ t'_1 → ∅ = ∅ → <{ ∅ ⊢ ~(t'_1) ⦂ τ₁ × τ₂ }>σ₁:Tyσ₂:Tyhs':<{ σ₁ × σ₂ }> <: <{ τ₁ × τ₂ }>ht₁:<{ ∅ ⊢ ~(t') ⦂ ~(σ₁) }>ht₂:<{ ∅ ⊢ ~(v₂✝) ⦂ ~(σ₂) }>hs₁:σ₁ <: τ₁hs₂:σ₂ <: τ₂⊢ ?refl.τ₁ <: τ₁refl.τ₁t:Tmτ:TyΓ:Contextτ₁:Tyτ₂:Tyt':Tmv₂✝:Tma✝¹:v₂✝.IsValuea✝:t'.IsValueh:<{ ∅ ⊢ ( t' , v₂✝ ) ⦂ τ₁ × τ₂ }>ih:∀ {t'_1 : Tm}, <{ ( t' , v₂✝ ) }> ⟶ t'_1 → ∅ = ∅ → <{ ∅ ⊢ ~(t'_1) ⦂ τ₁ × τ₂ }>σ₁:Tyσ₂:Tyhs':<{ σ₁ × σ₂ }> <: <{ τ₁ × τ₂ }>ht₁:<{ ∅ ⊢ ~(t') ⦂ ~(σ₁) }>ht₂:<{ ∅ ⊢ ~(v₂✝) ⦂ ~(σ₂) }>hs₁:σ₁ <: τ₁hs₂:σ₂ <: τ₂⊢ Ty <;>refl.htt:Tmτ:TyΓ:Contextτ₁:Tyτ₂:Tyt':Tmv₂✝:Tma✝¹:v₂✝.IsValuea✝:t'.IsValueh:<{ ∅ ⊢ ( t' , v₂✝ ) ⦂ τ₁ × τ₂ }>ih:∀ {t'_1 : Tm}, <{ ( t' , v₂✝ ) }> ⟶ t'_1 → ∅ = ∅ → <{ ∅ ⊢ ~(t'_1) ⦂ τ₁ × τ₂ }>σ₁:Tyσ₂:Tyhs':<{ σ₁ × σ₂ }> <: <{ τ₁ × τ₂ }>ht₁:<{ ∅ ⊢ ~(t') ⦂ ~(σ₁) }>ht₂:<{ ∅ ⊢ ~(v₂✝) ⦂ ~(σ₂) }>hs₁:σ₁ <: τ₁hs₂:σ₂ <: τ₂⊢ <{ ∅ ⊢ ~(t') ⦂ ~(?refl.τ₁) }>refl.hst:Tmτ:TyΓ:Contextτ₁:Tyτ₂:Tyt':Tmv₂✝:Tma✝¹:v₂✝.IsValuea✝:t'.IsValueh:<{ ∅ ⊢ ( t' , v₂✝ ) ⦂ τ₁ × τ₂ }>ih:∀ {t'_1 : Tm}, <{ ( t' , v₂✝ ) }> ⟶ t'_1 → ∅ = ∅ → <{ ∅ ⊢ ~(t'_1) ⦂ τ₁ × τ₂ }>σ₁:Tyσ₂:Tyhs':<{ σ₁ × σ₂ }> <: <{ τ₁ × τ₂ }>ht₁:<{ ∅ ⊢ ~(t') ⦂ ~(σ₁) }>ht₂:<{ ∅ ⊢ ~(v₂✝) ⦂ ~(σ₂) }>hs₁:σ₁ <: τ₁hs₂:σ₂ <: τ₂⊢ ?refl.τ₁ <: τ₁refl.τ₁t:Tmτ:TyΓ:Contextτ₁:Tyτ₂:Tyt':Tmv₂✝:Tma✝¹:v₂✝.IsValuea✝:t'.IsValueh:<{ ∅ ⊢ ( t' , v₂✝ ) ⦂ τ₁ × τ₂ }>ih:∀ {t'_1 : Tm}, <{ ( t' , v₂✝ ) }> ⟶ t'_1 → ∅ = ∅ → <{ ∅ ⊢ ~(t'_1) ⦂ τ₁ × τ₂ }>σ₁:Tyσ₂:Tyhs':<{ σ₁ × σ₂ }> <: <{ τ₁ × τ₂ }>ht₁:<{ ∅ ⊢ ~(t') ⦂ ~(σ₁) }>ht₂:<{ ∅ ⊢ ~(v₂✝) ⦂ ~(σ₂) }>hs₁:σ₁ <: τ₁hs₂:σ₂ <: τ₂⊢ Ty assumptionAll goals completed! 🐙
  | snd Γ t τ₁ τ₂ h ih  =>sndt✝:Tmτ:TyΓ:Contextt:Tmτ₁:Tyτ₂:Tyt':Tmhs:<{ snd t }> ⟶ t'h:<{ ∅ ⊢ ~(t) ⦂ τ₁ × τ₂ }>ih:∀ {t' : Tm}, t ⟶ t' → ∅ = ∅ → <{ ∅ ⊢ ~(t') ⦂ τ₁ × τ₂ }>⊢ <{ ∅ ⊢ ~(t') ⦂ ~(τ₂) }>
      inversion hs with (try solve_by_elim using StlcSubTypingAll goals completed! 🐙)
      | sndPair =>
          obtain ⟨σ₁, σ₂, hs', ht₁, ht₂⟩ := typing_inversion_pair hsndPairt:Tmτ:TyΓ:Contextτ₁:Tyτ₂:Tyt':Tmv₁✝:Tma✝¹:v₁✝.IsValuea✝:t'.IsValueh:<{ ∅ ⊢ ( v₁✝ , t' ) ⦂ τ₁ × τ₂ }>ih:∀ {t'_1 : Tm}, <{ ( v₁✝ , t' ) }> ⟶ t'_1 → ∅ = ∅ → <{ ∅ ⊢ ~(t'_1) ⦂ τ₁ × τ₂ }>σ₁:Tyσ₂:Tyhs':<{ σ₁ × σ₂ }> <: <{ τ₁ × τ₂ }>ht₁:<{ ∅ ⊢ ~(v₁✝) ⦂ ~(σ₁) }>ht₂:<{ ∅ ⊢ ~(t') ⦂ ~(σ₂) }>⊢ <{ ∅ ⊢ ~(t') ⦂ ~(τ₂) }>
          obtain ⟨σ₁, σ₂, heq, hs₁, hs₂⟩ := sub_inversion_prod hs'sndPairt:Tmτ:TyΓ:Contextτ₁:Tyτ₂:Tyt':Tmv₁✝:Tma✝¹:v₁✝.IsValuea✝:t'.IsValueh:<{ ∅ ⊢ ( v₁✝ , t' ) ⦂ τ₁ × τ₂ }>ih:∀ {t'_1 : Tm}, <{ ( v₁✝ , t' ) }> ⟶ t'_1 → ∅ = ∅ → <{ ∅ ⊢ ~(t'_1) ⦂ τ₁ × τ₂ }>σ₁✝:Tyσ₂✝:Tyhs':<{ σ₁ × σ₂ }> <: <{ τ₁ × τ₂ }>ht₁:<{ ∅ ⊢ ~(v₁✝) ⦂ ~(σ₁) }>ht₂:<{ ∅ ⊢ ~(t') ⦂ ~(σ₂) }>σ₁:Tyσ₂:Tyheq:<{ σ₁✝ × σ₂✝ }> = <{ σ₁ × σ₂ }>hs₁:σ₁ <: τ₁hs₂:σ₂ <: τ₂⊢ <{ ∅ ⊢ ~(t') ⦂ ~(τ₂) }>
          inversion heqreflt:Tmτ:TyΓ:Contextτ₁:Tyτ₂:Tyt':Tmv₁✝:Tma✝¹:v₁✝.IsValuea✝:t'.IsValueh:<{ ∅ ⊢ ( v₁✝ , t' ) ⦂ τ₁ × τ₂ }>ih:∀ {t'_1 : Tm}, <{ ( v₁✝ , t' ) }> ⟶ t'_1 → ∅ = ∅ → <{ ∅ ⊢ ~(t'_1) ⦂ τ₁ × τ₂ }>σ₁:Tyσ₂:Tyhs':<{ σ₁ × σ₂ }> <: <{ τ₁ × τ₂ }>ht₁:<{ ∅ ⊢ ~(v₁✝) ⦂ ~(σ₁) }>ht₂:<{ ∅ ⊢ ~(t') ⦂ ~(σ₂) }>hs₁:σ₁ <: τ₁hs₂:σ₂ <: τ₂⊢ <{ ∅ ⊢ ~(t') ⦂ ~(τ₂) }>; apply HasType.subrefl.htt:Tmτ:TyΓ:Contextτ₁:Tyτ₂:Tyt':Tmv₁✝:Tma✝¹:v₁✝.IsValuea✝:t'.IsValueh:<{ ∅ ⊢ ( v₁✝ , t' ) ⦂ τ₁ × τ₂ }>ih:∀ {t'_1 : Tm}, <{ ( v₁✝ , t' ) }> ⟶ t'_1 → ∅ = ∅ → <{ ∅ ⊢ ~(t'_1) ⦂ τ₁ × τ₂ }>σ₁:Tyσ₂:Tyhs':<{ σ₁ × σ₂ }> <: <{ τ₁ × τ₂ }>ht₁:<{ ∅ ⊢ ~(v₁✝) ⦂ ~(σ₁) }>ht₂:<{ ∅ ⊢ ~(t') ⦂ ~(σ₂) }>hs₁:σ₁ <: τ₁hs₂:σ₂ <: τ₂⊢ <{ ∅ ⊢ ~(t') ⦂ ~(?refl.τ₁) }>refl.hst:Tmτ:TyΓ:Contextτ₁:Tyτ₂:Tyt':Tmv₁✝:Tma✝¹:v₁✝.IsValuea✝:t'.IsValueh:<{ ∅ ⊢ ( v₁✝ , t' ) ⦂ τ₁ × τ₂ }>ih:∀ {t'_1 : Tm}, <{ ( v₁✝ , t' ) }> ⟶ t'_1 → ∅ = ∅ → <{ ∅ ⊢ ~(t'_1) ⦂ τ₁ × τ₂ }>σ₁:Tyσ₂:Tyhs':<{ σ₁ × σ₂ }> <: <{ τ₁ × τ₂ }>ht₁:<{ ∅ ⊢ ~(v₁✝) ⦂ ~(σ₁) }>ht₂:<{ ∅ ⊢ ~(t') ⦂ ~(σ₂) }>hs₁:σ₁ <: τ₁hs₂:σ₂ <: τ₂⊢ ?refl.τ₁ <: τ₂refl.τ₁t:Tmτ:TyΓ:Contextτ₁:Tyτ₂:Tyt':Tmv₁✝:Tma✝¹:v₁✝.IsValuea✝:t'.IsValueh:<{ ∅ ⊢ ( v₁✝ , t' ) ⦂ τ₁ × τ₂ }>ih:∀ {t'_1 : Tm}, <{ ( v₁✝ , t' ) }> ⟶ t'_1 → ∅ = ∅ → <{ ∅ ⊢ ~(t'_1) ⦂ τ₁ × τ₂ }>σ₁:Tyσ₂:Tyhs':<{ σ₁ × σ₂ }> <: <{ τ₁ × τ₂ }>ht₁:<{ ∅ ⊢ ~(v₁✝) ⦂ ~(σ₁) }>ht₂:<{ ∅ ⊢ ~(t') ⦂ ~(σ₂) }>hs₁:σ₁ <: τ₁hs₂:σ₂ <: τ₂⊢ Ty <;>refl.htt:Tmτ:TyΓ:Contextτ₁:Tyτ₂:Tyt':Tmv₁✝:Tma✝¹:v₁✝.IsValuea✝:t'.IsValueh:<{ ∅ ⊢ ( v₁✝ , t' ) ⦂ τ₁ × τ₂ }>ih:∀ {t'_1 : Tm}, <{ ( v₁✝ , t' ) }> ⟶ t'_1 → ∅ = ∅ → <{ ∅ ⊢ ~(t'_1) ⦂ τ₁ × τ₂ }>σ₁:Tyσ₂:Tyhs':<{ σ₁ × σ₂ }> <: <{ τ₁ × τ₂ }>ht₁:<{ ∅ ⊢ ~(v₁✝) ⦂ ~(σ₁) }>ht₂:<{ ∅ ⊢ ~(t') ⦂ ~(σ₂) }>hs₁:σ₁ <: τ₁hs₂:σ₂ <: τ₂⊢ <{ ∅ ⊢ ~(t') ⦂ ~(?refl.τ₁) }>refl.hst:Tmτ:TyΓ:Contextτ₁:Tyτ₂:Tyt':Tmv₁✝:Tma✝¹:v₁✝.IsValuea✝:t'.IsValueh:<{ ∅ ⊢ ( v₁✝ , t' ) ⦂ τ₁ × τ₂ }>ih:∀ {t'_1 : Tm}, <{ ( v₁✝ , t' ) }> ⟶ t'_1 → ∅ = ∅ → <{ ∅ ⊢ ~(t'_1) ⦂ τ₁ × τ₂ }>σ₁:Tyσ₂:Tyhs':<{ σ₁ × σ₂ }> <: <{ τ₁ × τ₂ }>ht₁:<{ ∅ ⊢ ~(v₁✝) ⦂ ~(σ₁) }>ht₂:<{ ∅ ⊢ ~(t') ⦂ ~(σ₂) }>hs₁:σ₁ <: τ₁hs₂:σ₂ <: τ₂⊢ ?refl.τ₁ <: τ₂refl.τ₁t:Tmτ:TyΓ:Contextτ₁:Tyτ₂:Tyt':Tmv₁✝:Tma✝¹:v₁✝.IsValuea✝:t'.IsValueh:<{ ∅ ⊢ ( v₁✝ , t' ) ⦂ τ₁ × τ₂ }>ih:∀ {t'_1 : Tm}, <{ ( v₁✝ , t' ) }> ⟶ t'_1 → ∅ = ∅ → <{ ∅ ⊢ ~(t'_1) ⦂ τ₁ × τ₂ }>σ₁:Tyσ₂:Tyhs':<{ σ₁ × σ₂ }> <: <{ τ₁ × τ₂ }>ht₁:<{ ∅ ⊢ ~(v₁✝) ⦂ ~(σ₁) }>ht₂:<{ ∅ ⊢ ~(t') ⦂ ~(σ₂) }>hs₁:σ₁ <: τ₁hs₂:σ₂ <: τ₂⊢ Ty assumptionAll goals completed! 🐙
  | pair Γ t₁ t₂ τ₁ τ₂ h₁ h₂ ih₁ ih₂ =>pairt:Tmτ:TyΓ:Contextt₁:Tmt₂:Tmτ₁:Tyτ₂:Tyt':Tmhs:<{ ( t₁ , t₂ ) }> ⟶ t'h₁:<{ ∅ ⊢ ~(t₁) ⦂ ~(τ₁) }>h₂:<{ ∅ ⊢ ~(t₂) ⦂ ~(τ₂) }>ih₁:∀ {t' : Tm}, t₁ ⟶ t' → ∅ = ∅ → <{ ∅ ⊢ ~(t') ⦂ ~(τ₁) }>ih₂:∀ {t' : Tm}, t₂ ⟶ t' → ∅ = ∅ → <{ ∅ ⊢ ~(t') ⦂ ~(τ₂) }>⊢ <{ ∅ ⊢ ~(t') ⦂ τ₁ × τ₂ }>
      inversion hs with solve_by_elim using StlcSubTypingAll goals completed! 🐙

This formalization of the STLC with subtyping omits record types for brevity. If we want to deal with them more seriously, we have two choices.

First, we can treat them as part of the core language, writing down proper syntax, typing, and subtyping rules for them.

On the other hand, if we are treating them as a derived form that is desugared in the parser, then we shouldn't need any new rules: we should just check that the existing rules for subtyping product and Unit types give rise to reasonable rules for record subtyping via this encoding. To do this, we just need to make one small change to the encoding described earlier: instead of using Unit as the base case in the encoding of tuples and the "don't care" placeholder in the encoding of records, we use ⊤. So:

    {a:Nat, b:Nat} --⟶ {Nat,Nat}       i.e., (Nat,(Nat,⊤))
    {c:Nat, a:Nat} --⟶ {Nat,⊤,Nat}   i.e., (Nat,(⊤,(Nat,⊤)))

The encoding of record values doesn't change at all. It is easy (and instructive) to check that the subtyping rules above are validated by the encoding.

Exercise★★(variations) (Manually graded)

Each part of this problem suggests a different way of changing the definition of the STLC with Unit and subtyping. (These changes are not cumulative: each part starts from the original language.) In each part, list which properties (Progress, Preservation, both, or neither) become false. If a property becomes false, give a counterexample.

Suppose we add the following typing rule:

                           <{ Γ ⊢ t ⦂ σ₁→σ₂ }>
                    σ₁ <: τ₁     τ₁ <: σ₁      σ₂ <: τ₂
                    -----------------------------------     (funny₁)
                           <{ Γ ⊢ t ⦂ τ₁→τ₂ }>

Answer: NONE

Suppose we add the following reduction rule:

                             --------------------          (funny₂)
                             unit ⟶ (\x:⊤. x)

Answer: Preservation fails. For example, unit has type Unit but steps to (\x:⊤. x), which does not have type Unit.

Suppose we add the following subtyping rule:

                              ----------------            (funny₃)
                               Unit <: ⊤→⊤

Answer: Progress fails. For example, unit (\x:⊤,⊤) is well typed but stuck.

Suppose we add the following subtyping rule:

                               ----------------            (funny₄)
                               ⊤→⊤ <: Unit

Answer: NONE

Suppose we add the following reduction rule:

                             ---------------------        (funny₅)
                             (unit t) ⟶ (t unit)

Answer: NONE

Suppose we add the same reduction rule and a new typing rule:

                             ---------------------        (funny₅)
                             (unit t) ⟶ (t unit)

                           ---------------------------     (funny₆)
                           ∅ ⊢ unit ⦂ ⊤→⊤

Answer: Preservation fails. For example, 1unit (x:A,x)1 has type ⊤, but it steps to (\x:A,x) unit, which is ill typed,

Suppose we change the arrow subtyping rule to:

                          σ₁ <: τ₁   σ₂ <: τ₂
                          -------------------              (arrow')
                          σ₁→σ₂ <: τ₁→τ₂

Answer: Preservation fails. For example, (\x:Unit*Unit, x.fst) unithas type Unit, but steps to unit.fst which is ill typed. (In order to type (\x:Unit*Unit, x.fst) unit we use sub twice; once to give unit the type ⊤, and once to give \x:Unit*Unit, x.fst the type ⊤ → Unit using S_Arrow').

8.3.7.1. Exercise: Adding Products🔗

Exercise★★★★★(products) (Manually graded)

Adding pairs, projections, and product types to the system we have defined is a relatively straightforward matter. Carry out this extension by modifying the definitions and proofs above:

Constructors for pairs, first and second projections, and product types have already been added to the definitions of Ty and Tm. Also, the definition of substitution has been extended.
Extend the surrounding definitions accordingly (refer to chapter MoreStlc):
value relation
operational semantics
typing relation
Extend the subtyping relation with this rule:

                        σ₁ <: τ₁    σ₂ <: τ₂
                        --------------------   (prod)
                         σ₁ × σ₂ <: τ₁ × τ₂

Extend the proofs of progress, preservation, and all their supporting lemmas to deal with the new constructs. (You'll also need to add a couple of completely new lemmas.)

The solution can be found in-line earlier in this chapter.

8.3.8. Formalized "Thought Exercises"🔗

The following are formal exercises based on the previous "thought exercises."

namespace FormalThoughtExercises
open Examples
abbrev p := "p"
abbrev a := "a"

abbrev tf p := p ∨ ¬p

Exercise★(formal_subtype_instances_tf_1a) (Optional)

theorem formal_subtype_instances_tf_1a:
  tf (∀ σ τ υ δ, σ <: τ → υ <: δ → <{ ~τ → ~σ }> <: <{ ~τ → ~σ }>) := by⊢ tf (∀ (σ τ υ δ : Ty), σ <: τ → υ <: δ → <{ τ → σ }> <: <{ τ → σ }>)
  solution!
    left⊢ ∀ (σ τ υ δ : Ty), σ <: τ → υ <: δ → <{ τ → σ }> <: <{ τ → σ }>; intro σ τ υ δ h₁ h₂σ:Tyτ:Tyυ:Tyδ:Tyh₁:σ <: τh₂:υ <: δ⊢ <{ τ → σ }> <: <{ τ → σ }>; solve_by_elim using StlcSubTypingAll goals completed! 🐙

Exercise★(formal_subtype_instances_tf_1b) (Optional)

theorem formal_subtype_instances_tf_1b:
  tf (∀ σ τ υ δ, σ <: τ → υ <: δ → <{ ⊤ → ~υ }> <: <{ ~σ → ⊤ }>) := by⊢ tf (∀ (σ τ υ δ : Ty), σ <: τ → υ <: δ → <{ ⊤ → υ }> <: <{ σ → ⊤ }>)
  solution!
    left⊢ ∀ (σ τ υ δ : Ty), σ <: τ → υ <: δ → <{ ⊤ → υ }> <: <{ σ → ⊤ }>; intro σ τ υ δ h₁ h₂σ:Tyτ:Tyυ:Tyδ:Tyh₁:σ <: τh₂:υ <: δ⊢ <{ ⊤ → υ }> <: <{ σ → ⊤ }>; solve_by_elim using StlcSubTypingAll goals completed! 🐙

Exercise★(formal_subtype_instances_tf_1c) (Optional)

theorem formal_subtype_instances_tf_1c:
  tf (∀ σ τ υ δ, σ <: τ → υ <: δ →
         <{ (~C → ~C)→(~A × ~B) }> <: <{ (~C → ~C)→(⊤ × ~B) }>) := by⊢ tf (∀ (σ τ υ δ : Ty), σ <: τ → υ <: δ → <{ (C → C) → A × B }> <: <{ (C → C) → ⊤ × B }>)
  solution!
    left⊢ ∀ (σ τ υ δ : Ty), σ <: τ → υ <: δ → <{ (C → C) → A × B }> <: <{ (C → C) → ⊤ × B }>; intro σ τ υ δ h₁ h₂σ:Tyτ:Tyυ:Tyδ:Tyh₁:σ <: τh₂:υ <: δ⊢ <{ (C → C) → A × B }> <: <{ (C → C) → ⊤ × B }>; solve_by_elim using StlcSubTypingAll goals completed! 🐙

Exercise★(formal_subtype_instances_tf_1d) (Optional)

theorem formal_subtype_instances_tf_1d:
  tf (∀ σ τ υ δ, σ <: τ → υ <: δ → <{ ~τ → (~τ → ~υ) }> <: <{ ~σ → (~σ → ~δ) }>) := by⊢ tf (∀ (σ τ υ δ : Ty), σ <: τ → υ <: δ → <{ τ → τ → υ }> <: <{ σ → σ → δ }>)
  solution!
    left⊢ ∀ (σ τ υ δ : Ty), σ <: τ → υ <: δ → <{ τ → τ → υ }> <: <{ σ → σ → δ }>; intro σ τ υ δ h₁ h₂σ:Tyτ:Tyυ:Tyδ:Tyh₁:σ <: τh₂:υ <: δ⊢ <{ τ → τ → υ }> <: <{ σ → σ → δ }>; solve_by_elim using StlcSubTypingAll goals completed! 🐙

Exercise★(formal_subtype_instances_tf_1e) (Optional)

theorem formal_subtype_instances_tf_1e:
  tf (∀ σ τ υ δ, σ <: τ → υ <: δ → <{ (~τ → ~τ) → ~υ }> <: <{ (~σ → ~σ)→ ~δ }>) := by⊢ tf (∀ (σ τ υ δ : Ty), σ <: τ → υ <: δ → <{ (τ → τ) → υ }> <: <{ (σ → σ) → δ }>)
  solution!
    right⊢ ¬∀ (σ τ υ δ : Ty), σ <: τ → υ <: δ → <{ (τ → τ) → υ }> <: <{ (σ → σ) → δ }>; intro contracontra:∀ (σ τ υ δ : Ty), σ <: τ → υ <: δ → <{ (τ → τ) → υ }> <: <{ (σ → σ) → δ }>⊢ False
    have h : <{ (⊤ → ⊤) → Bool }> <: <{ (Bool → Bool) → ⊤ }> := by⊢ tf (∀ (σ τ υ δ : Ty), σ <: τ → υ <: δ → <{ (τ → τ) → υ }> <: <{ (σ → σ) → δ }>)
      solve_by_elim using StlcSubTypingcontra:∀ (σ τ υ δ : Ty), σ <: τ → υ <: δ → <{ (τ → τ) → υ }> <: <{ (σ → σ) → δ }>h:<{ ( ⊤ → ⊤ ) → Bool }> <: <{ (Bool → Bool) → ⊤ }>⊢ False
    obtain ⟨_, _, h₁, h₂, _⟩ := sub_inversion_arrow hcontra:∀ (σ τ υ δ : Ty), σ <: τ → υ <: δ → <{ (τ → τ) → υ }> <: <{ (σ → σ) → δ }>h:<{ ( ⊤ → ⊤ ) → Bool }> <: <{ (Bool → Bool) → ⊤ }>w✝¹:Tyw✝:Tyh₁:<{ ( ⊤ → ⊤ ) → Bool }> = <{ w✝¹ → w✝ }>h₂:<{ Bool → Bool }> <: w✝¹right✝:w✝ <: <{ ⊤ }>⊢ False
    inversion h₁reflcontra:∀ (σ τ υ δ : Ty), σ <: τ → υ <: δ → <{ (τ → τ) → υ }> <: <{ (σ → σ) → δ }>h:<{ ( ⊤ → ⊤ ) → Bool }> <: <{ (Bool → Bool) → ⊤ }>h₂:<{ Bool → Bool }> <: <{ ⊤ → ⊤ }>right✝:<{ Bool }> <: <{ ⊤ }>⊢ False
    obtain ⟨_, _, h₁, h₂, _⟩ := sub_inversion_arrow h₂reflcontra:∀ (σ τ υ δ : Ty), σ <: τ → υ <: δ → <{ (τ → τ) → υ }> <: <{ (σ → σ) → δ }>h:<{ ( ⊤ → ⊤ ) → Bool }> <: <{ (Bool → Bool) → ⊤ }>h₂✝:<{ Bool → Bool }> <: <{ ⊤ → ⊤ }>right✝¹:<{ Bool }> <: <{ ⊤ }>w✝¹:Tyw✝:Tyh₁:<{ Bool → Bool }> = <{ w✝¹ → w✝ }>h₂:<{ ⊤ }> <: w✝¹right✝:w✝ <: <{ ⊤ }>⊢ False
    inversion h₁reflcontra:∀ (σ τ υ δ : Ty), σ <: τ → υ <: δ → <{ (τ → τ) → υ }> <: <{ (σ → σ) → δ }>h:<{ ( ⊤ → ⊤ ) → Bool }> <: <{ (Bool → Bool) → ⊤ }>h₂✝:<{ Bool → Bool }> <: <{ ⊤ → ⊤ }>right✝¹:<{ Bool }> <: <{ ⊤ }>h₂:<{ ⊤ }> <: <{ Bool }>right✝:<{ Bool }> <: <{ ⊤ }>⊢ False
    apply sub_inversion_bool at h₂reflcontra:∀ (σ τ υ δ : Ty), σ <: τ → υ <: δ → <{ (τ → τ) → υ }> <: <{ (σ → σ) → δ }>h:<{ ( ⊤ → ⊤ ) → Bool }> <: <{ (Bool → Bool) → ⊤ }>h₂✝:<{ Bool → Bool }> <: <{ ⊤ → ⊤ }>right✝¹:<{ Bool }> <: <{ ⊤ }>right✝:<{ Bool }> <: <{ ⊤ }>h₂:<{ ⊤ }> = <{ Bool }>⊢ False; contradictionAll goals completed! 🐙

Exercise★(formal_subtype_instances_tf_1f) (Optional)

theorem formal_subtype_instances_tf_1f:
  tf (∀ σ τ υ δ, σ <: τ → υ <: δ → <{ ((~τ → ~σ) → ~τ)→ ~υ }> <: <{ ((~σ → ~τ)→ ~σ) → ~δ }>) := by⊢ tf (∀ (σ τ υ δ : Ty), σ <: τ → υ <: δ → <{ ((τ → σ) → τ) → υ }> <: <{ ((σ → τ) → σ) → δ }>)
  solution!
    left⊢ ∀ (σ τ υ δ : Ty), σ <: τ → υ <: δ → <{ ((τ → σ) → τ) → υ }> <: <{ ((σ → τ) → σ) → δ }>; intro σ τ υ δ h₁ h₂σ:Tyτ:Tyυ:Tyδ:Tyh₁:σ <: τh₂:υ <: δ⊢ <{ ((τ → σ) → τ) → υ }> <: <{ ((σ → τ) → σ) → δ }>; solve_by_elim (maxDepth:=10) using StlcSubTypingAll goals completed! 🐙

Exercise★(formal_subtype_instances_tf_1g) (Optional)

theorem formal_subtype_instances_tf_1g:
  tf (∀ σ τ υ δ, σ <: τ → υ <: δ → <{ ~σ × ~δ }> <: <{ ~τ × ~υ }>) := by⊢ tf (∀ (σ τ υ δ : Ty), σ <: τ → υ <: δ → <{ σ × δ }> <: <{ τ × υ }>)

  solution!
    right⊢ ¬∀ (σ τ υ δ : Ty), σ <: τ → υ <: δ → <{ σ × δ }> <: <{ τ × υ }>; intro contracontra:∀ (σ τ υ δ : Ty), σ <: τ → υ <: δ → <{ σ × δ }> <: <{ τ × υ }>⊢ False
    have h : <{ Bool × ⊤ }> <: <{ ⊤ × Bool }> := by⊢ tf (∀ (σ τ υ δ : Ty), σ <: τ → υ <: δ → <{ σ × δ }> <: <{ τ × υ }>) solve_by_elim using StlcSubTypingcontra:∀ (σ τ υ δ : Ty), σ <: τ → υ <: δ → <{ σ × δ }> <: <{ τ × υ }>h:<{ Bool × ⊤ }> <: <{ ⊤ × Bool }>⊢ False
    obtain ⟨_, _, h₁, _, h₃⟩ := sub_inversion_prod hcontra:∀ (σ τ υ δ : Ty), σ <: τ → υ <: δ → <{ σ × δ }> <: <{ τ × υ }>h:<{ Bool × ⊤ }> <: <{ ⊤ × Bool }>w✝¹:Tyw✝:Tyh₁:<{ Bool × ⊤ }> = <{ w✝¹ × w✝ }>left✝:w✝¹ <: <{ ⊤ }>h₃:w✝ <: <{ Bool }>⊢ False
    inversion h₁reflcontra:∀ (σ τ υ δ : Ty), σ <: τ → υ <: δ → <{ σ × δ }> <: <{ τ × υ }>h:<{ Bool × ⊤ }> <: <{ ⊤ × Bool }>left✝:<{ Bool }> <: <{ ⊤ }>h₃:<{ ⊤ }> <: <{ Bool }>⊢ False; apply sub_inversion_bool at h₃reflcontra:∀ (σ τ υ δ : Ty), σ <: τ → υ <: δ → <{ σ × δ }> <: <{ τ × υ }>h:<{ Bool × ⊤ }> <: <{ ⊤ × Bool }>left✝:<{ Bool }> <: <{ ⊤ }>h₃:<{ ⊤ }> = <{ Bool }>⊢ False; contradictionAll goals completed! 🐙

Exercise★★(formal_subtype_instances_tf_2a) (Optional)

theorem formal_subtype_instances_tf_2a:
  tf (∀ σ τ, σ <: τ →  <{ ~σ → ~σ }> <: <{ ~τ → ~τ }>) := by⊢ tf (∀ (σ τ : Ty), σ <: τ → <{ σ → σ }> <: <{ τ → τ }>)

  solution!
    right⊢ ¬∀ (σ τ : Ty), σ <: τ → <{ σ → σ }> <: <{ τ → τ }>; intro contracontra:∀ (σ τ : Ty), σ <: τ → <{ σ → σ }> <: <{ τ → τ }>⊢ False
    have h : <{ Bool→Bool }> <: <{ ⊤→⊤ }> := by⊢ tf (∀ (σ τ : Ty), σ <: τ → <{ σ → σ }> <: <{ τ → τ }>) solve_by_elim using StlcSubTypingcontra:∀ (σ τ : Ty), σ <: τ → <{ σ → σ }> <: <{ τ → τ }>h:<{ Bool → Bool }> <: <{ ⊤ → ⊤ }>⊢ False
    obtain ⟨_, _, h₁, h₂, h₃⟩ := sub_inversion_arrow hcontra:∀ (σ τ : Ty), σ <: τ → <{ σ → σ }> <: <{ τ → τ }>h:<{ Bool → Bool }> <: <{ ⊤ → ⊤ }>w✝¹:Tyw✝:Tyh₁:<{ Bool → Bool }> = <{ w✝¹ → w✝ }>h₂:<{ ⊤ }> <: w✝¹h₃:w✝ <: <{ ⊤ }>⊢ False
    inversion h₁reflcontra:∀ (σ τ : Ty), σ <: τ → <{ σ → σ }> <: <{ τ → τ }>h:<{ Bool → Bool }> <: <{ ⊤ → ⊤ }>h₂:<{ ⊤ }> <: <{ Bool }>h₃:<{ Bool }> <: <{ ⊤ }>⊢ False; apply sub_inversion_bool at h₂reflcontra:∀ (σ τ : Ty), σ <: τ → <{ σ → σ }> <: <{ τ → τ }>h:<{ Bool → Bool }> <: <{ ⊤ → ⊤ }>h₃:<{ Bool }> <: <{ ⊤ }>h₂:<{ ⊤ }> = <{ Bool }>⊢ False; contradictionAll goals completed! 🐙

Exercise★★(formal_subtype_instances_tf_2b) (Optional)

theorem formal_subtype_instances_tf_2b:
  tf (∀ σ, σ <: <{ ~A → ~A }> → ∃ τ, σ = <{ ~τ → ~τ }> ∧ τ <: A) := by⊢ tf (∀ (σ : Ty), σ <: <{ A → A }> → ∃ τ, σ = <{ τ → τ }> ∧ τ <: A)

  solution!
    right⊢ ¬∀ (σ : Ty), σ <: <{ A → A }> → ∃ τ, σ = <{ τ → τ }> ∧ τ <: A; intros contracontra:∀ (σ : Ty), σ <: <{ A → A }> → ∃ τ, σ = <{ τ → τ }> ∧ τ <: A⊢ False
    obtain ⟨τ, h₁, h₂⟩ := contra <{ ⊤→ ~A }> (bycontra:∀ (σ : Ty), σ <: <{ A → A }> → ∃ τ, σ = <{ τ → τ }> ∧ τ <: A⊢ <{ ⊤ → A }> <: <{ A → A }> solve_by_elim using StlcSubTypingAll goals completed! 🐙)contra:∀ (σ : Ty), σ <: <{ A → A }> → ∃ τ, σ = <{ τ → τ }> ∧ τ <: Aτ:Tyh₁:<{ ⊤ → A }> = <{ τ → τ }>h₂:τ <: A⊢ False
    inversion h₁All goals completed! 🐙

Exercise★★(formal_subtype_instances_tf_2d) (Optional)

Hint: Assert a generalization of the statement to be proved and use induction on a type (rather than on a subtyping derviation).

theorem formal_subtype_instances_tf_2d: tf (∃ σ, σ <: <{ ~σ → ~σ }>) := by⊢ tf (∃ σ, σ <: <{ σ → σ }>)

  solution!
    have h : ∀ σ τ, ¬ σ <: <{ ~τ → ~σ }> := by
      intro σ τ contraσ:Tyτ:Tycontra:σ <: <{ τ → σ }>⊢ False
      induction σ generalizing τ with (
          obtain ⟨σ₁, σ₁, h₁, h₂, h₃⟩ := sub_inversion_arrow contraproda✝¹:Tya✝:Tya_ih✝¹:∀ (τ : Ty), a✝¹ <: <{ τ → a✝¹ }> → Falsea_ih✝:∀ (τ : Ty), a✝ <: <{ τ → a✝ }> → Falseτ:Tycontra:<{ a✝¹ × a✝ }> <: <{ τ → a✝¹ × a✝ }>σ₁✝:Tyσ₁:Tyh₁:<{ a✝¹ × a✝ }> = <{ σ₁✝ → σ₁ }>h₂:τ <: σ₁✝h₃:σ₁ <: <{ a✝¹ × a✝ }>⊢ False; try contradictionAll goals completed! 🐙)
      | arrow τ₁ τ₂ ih₁ ih₂ =>arrowτ₁:Tyτ₂:Tyih₁:∀ (τ : Ty), τ₁ <: <{ τ → τ₁ }> → Falseih₂:∀ (τ : Ty), τ₂ <: <{ τ → τ₂ }> → Falseτ:Tycontra:<{ τ₁ → τ₂ }> <: <{ τ → τ₁ → τ₂ }>σ₁✝:Tyσ₁:Tyh₁:<{ τ₁ → τ₂ }> = <{ σ₁✝ → σ₁ }>h₂:τ <: σ₁✝h₃:σ₁ <: <{ τ₁ → τ₂ }>⊢ False
        inversion h₁reflτ₁:Tyτ₂:Tyih₁:∀ (τ : Ty), τ₁ <: <{ τ → τ₁ }> → Falseih₂:∀ (τ : Ty), τ₂ <: <{ τ → τ₂ }> → Falseτ:Tycontra:<{ τ₁ → τ₂ }> <: <{ τ → τ₁ → τ₂ }>h₂:τ <: τ₁h₃:τ₂ <: <{ τ₁ → τ₂ }>⊢ False; apply ih₂refl.contraτ₁:Tyτ₂:Tyih₁:∀ (τ : Ty), τ₁ <: <{ τ → τ₁ }> → Falseih₂:∀ (τ : Ty), τ₂ <: <{ τ → τ₂ }> → Falseτ:Tycontra:<{ τ₁ → τ₂ }> <: <{ τ → τ₁ → τ₂ }>h₂:τ <: τ₁h₃:τ₂ <: <{ τ₁ → τ₂ }>⊢ τ₂ <: <{ ~?refl.τ → τ₂ }>refl.ττ₁:Tyτ₂:Tyih₁:∀ (τ : Ty), τ₁ <: <{ τ → τ₁ }> → Falseih₂:∀ (τ : Ty), τ₂ <: <{ τ → τ₂ }> → Falseτ:Tycontra:<{ τ₁ → τ₂ }> <: <{ τ → τ₁ → τ₂ }>h₂:τ <: τ₁h₃:τ₂ <: <{ τ₁ → τ₂ }>⊢ Ty; apply h₃h:∀ (σ τ : Ty), ¬σ <: <{ τ → σ }>⊢ tf (∃ σ, σ <: <{ σ → σ }>)
    righth:∀ (σ τ : Ty), ¬σ <: <{ τ → σ }>⊢ ¬∃ σ, σ <: <{ σ → σ }>; intro contrah:∀ (σ τ : Ty), ¬σ <: <{ τ → σ }>contra:∃ σ, σ <: <{ σ → σ }>⊢ False
    obtain ⟨σ, contra⟩ := contrah:∀ (σ τ : Ty), ¬σ <: <{ τ → σ }>σ:Tycontra:σ <: <{ σ → σ }>⊢ False
    apply h at contrah:∀ (σ τ : Ty), ¬σ <: <{ τ → σ }>σ:Tycontra:False⊢ False; assumptionAll goals completed! 🐙

Exercise★★(formal_subtype_instances_tf_2e) (Optional)

theorem formal_subtype_instances_tf_2e: tf (∃ σ, <{ ~σ → ~σ }> <: σ) := by⊢ tf (∃ σ, <{ σ → σ }> <: σ)
  solution!
    left⊢ ∃ σ, <{ σ → σ }> <: σ; exists Ty.top⊢ <{ ⊤ → ⊤ }> <: <{ ⊤ }>; solve_by_elim using StlcSubTypingAll goals completed! 🐙

Exercise★★(formal_subtype_concepts_tfa) (Optional)

theorem formal_subtype_concepts_tfa: tf (∃ τ, ∀ σ, σ <: τ) := by⊢ tf (∃ τ, ∀ (σ : Ty), σ <: τ)
  solution!
    left⊢ ∃ τ, ∀ (σ : Ty), σ <: τ; exists Ty.top⊢ ∀ (σ : Ty), σ <: <{ ⊤ }>; solve_by_elim using StlcSubTypingAll goals completed! 🐙

Exercise★★(formal_subtype_concepts_tfb) (Optional)

theorem formal_subtype_concepts_tfb: tf (∃ τ, ∀ σ, τ <: σ) := by⊢ tf (∃ τ, ∀ (σ : Ty), τ <: σ)
  solution!
    right⊢ ¬∃ τ, ∀ (σ : Ty), τ <: σ; intro contracontra:∃ τ, ∀ (σ : Ty), τ <: σ⊢ False
    obtain ⟨σ, contra⟩ := contraσ:Tycontra:∀ (σ_1 : Ty), σ <: σ_1⊢ False
    have h : σ = Ty.bool := by⊢ tf (∃ τ, ∀ (σ : Ty), τ <: σ)
      apply sub_inversion_boolσ:Tycontra:∀ (σ_1 : Ty), σ <: σ_1⊢ σ <: <{ Bool }>; apply contraσ:Tycontra:∀ (σ_1 : Ty), σ <: σ_1h:σ = <{ Bool }>⊢ False
    have h₂ : σ = Ty.unit := by⊢ tf (∃ τ, ∀ (σ : Ty), τ <: σ)
      apply sub_inversion_unitσ:Tycontra:∀ (σ_1 : Ty), σ <: σ_1h:σ = <{ Bool }>⊢ σ <: <{ Unit }>; apply contraσ:Tycontra:∀ (σ_1 : Ty), σ <: σ_1h:σ = <{ Bool }>h₂:σ = <{ Unit }>⊢ False
    subst_varscontra:∀ (σ : Ty), <{ Bool }> <: σh₂:<{ Bool }> = <{ Unit }>⊢ False; contradictionAll goals completed! 🐙

Exercise★★(formal_subtype_concepts_tfc) (Optional)

theorem formal_subtype_concepts_tfc:
  tf (∃ τ₁ τ₂, ∀ σ₁ σ₂, <{ ~σ₁ ×  ~σ₂ }> <: <{ ~τ₁ × ~τ₂ }>) := by⊢ tf (∃ τ₁ τ₂, ∀ (σ₁ σ₂ : Ty), <{ σ₁ × σ₂ }> <: <{ τ₁ × τ₂ }>)
  solution!
    left⊢ ∃ τ₁ τ₂, ∀ (σ₁ σ₂ : Ty), <{ σ₁ × σ₂ }> <: <{ τ₁ × τ₂ }>; exists Ty.top, Ty.top⊢ ∀ (σ₁ σ₂ : Ty), <{ σ₁ × σ₂ }> <: <{ ⊤ × ⊤ }>; solve_by_elim using StlcSubTypingAll goals completed! 🐙

Exercise★★(formal_subtype_concepts_tfd) (Optional)

theorem formal_subtype_concepts_tfd:
  tf (∃ τ₁ τ₂, ∀ σ₁ σ₂, <{ ~τ₁ × ~τ₂ }> <: <{ ~σ₁ × ~σ₂ }>) := by⊢ tf (∃ τ₁ τ₂, ∀ (σ₁ σ₂ : Ty), <{ τ₁ × τ₂ }> <: <{ σ₁ × σ₂ }>)
  solution!
    right⊢ ¬∃ τ₁ τ₂, ∀ (σ₁ σ₂ : Ty), <{ τ₁ × τ₂ }> <: <{ σ₁ × σ₂ }>; intro contracontra:∃ τ₁ τ₂, ∀ (σ₁ σ₂ : Ty), <{ τ₁ × τ₂ }> <: <{ σ₁ × σ₂ }>⊢ False
    obtain ⟨τ₁, τ₂, h⟩ := contraτ₁:Tyτ₂:Tyh:∀ (σ₁ σ₂ : Ty), <{ τ₁ × τ₂ }> <: <{ σ₁ × σ₂ }>⊢ False
    obtain ⟨_, _, h₁, h₂, _⟩ := sub_inversion_prod (h <{ Bool }> <{ Bool }>)τ₁:Tyτ₂:Tyh:∀ (σ₁ σ₂ : Ty), <{ τ₁ × τ₂ }> <: <{ σ₁ × σ₂ }>w✝¹:Tyw✝:Tyh₁:<{ τ₁ × τ₂ }> = <{ w✝¹ × w✝ }>h₂:w✝¹ <: <{ Bool }>right✝:w✝ <: <{ Bool }>⊢ False
    inversion h₁reflτ₁:Tyτ₂:Tyh:∀ (σ₁ σ₂ : Ty), <{ τ₁ × τ₂ }> <: <{ σ₁ × σ₂ }>h₂:τ₁ <: <{ Bool }>right✝:τ₂ <: <{ Bool }>⊢ False
    obtain ⟨_, _, h₃, h₄, _⟩ := sub_inversion_prod (h <{ Unit }> <{ Unit }>)reflτ₁:Tyτ₂:Tyh:∀ (σ₁ σ₂ : Ty), <{ τ₁ × τ₂ }> <: <{ σ₁ × σ₂ }>h₂:τ₁ <: <{ Bool }>right✝¹:τ₂ <: <{ Bool }>w✝¹:Tyw✝:Tyh₃:<{ τ₁ × τ₂ }> = <{ w✝¹ × w✝ }>h₄:w✝¹ <: <{ Unit }>right✝:w✝ <: <{ Unit }>⊢ False
    inversion h₃reflτ₁:Tyτ₂:Tyh:∀ (σ₁ σ₂ : Ty), <{ τ₁ × τ₂ }> <: <{ σ₁ × σ₂ }>h₂:τ₁ <: <{ Bool }>right✝¹:τ₂ <: <{ Bool }>h₄:τ₁ <: <{ Unit }>right✝:τ₂ <: <{ Unit }>⊢ False
    apply sub_inversion_bool at h₂reflτ₁:Tyτ₂:Tyh:∀ (σ₁ σ₂ : Ty), <{ τ₁ × τ₂ }> <: <{ σ₁ × σ₂ }>right✝¹:τ₂ <: <{ Bool }>h₄:τ₁ <: <{ Unit }>right✝:τ₂ <: <{ Unit }>h₂:τ₁ = <{ Bool }>⊢ False; apply sub_inversion_unit at h₄reflτ₁:Tyτ₂:Tyh:∀ (σ₁ σ₂ : Ty), <{ τ₁ × τ₂ }> <: <{ σ₁ × σ₂ }>right✝¹:τ₂ <: <{ Bool }>right✝:τ₂ <: <{ Unit }>h₂:τ₁ = <{ Bool }>h₄:τ₁ = <{ Unit }>⊢ False
    subst_varsreflτ₂:Tyright✝¹:τ₂ <: <{ Bool }>right✝:τ₂ <: <{ Unit }>h:∀ (σ₁ σ₂ : Ty), <{ Bool × τ₂ }> <: <{ σ₁ × σ₂ }>h₄:<{ Bool }> = <{ Unit }>⊢ False; contradictionAll goals completed! 🐙

Exercise★★(formal_subtype_concepts_tfe) (Optional)

theorem formal_subtype_concepts_tfe:
  tf (∃ τ₁ τ₂, ∀ σ₁ σ₂, <{ ~σ₁ → ~σ₂ }> <: <{ ~τ₁→ ~τ₂ }>) := by⊢ tf (∃ τ₁ τ₂, ∀ (σ₁ σ₂ : Ty), <{ σ₁ → σ₂ }> <: <{ τ₁ → τ₂ }>)

  solution!
    right⊢ ¬∃ τ₁ τ₂, ∀ (σ₁ σ₂ : Ty), <{ σ₁ → σ₂ }> <: <{ τ₁ → τ₂ }>; intro contracontra:∃ τ₁ τ₂, ∀ (σ₁ σ₂ : Ty), <{ σ₁ → σ₂ }> <: <{ τ₁ → τ₂ }>⊢ False
    obtain ⟨τ₁, τ₂, h⟩ := contraτ₁:Tyτ₂:Tyh:∀ (σ₁ σ₂ : Ty), <{ σ₁ → σ₂ }> <: <{ τ₁ → τ₂ }>⊢ False
    obtain ⟨_, _, h₁, h₂, _⟩ := sub_inversion_arrow (h <{ Bool }> <{ Bool }>)τ₁:Tyτ₂:Tyh:∀ (σ₁ σ₂ : Ty), <{ σ₁ → σ₂ }> <: <{ τ₁ → τ₂ }>w✝¹:Tyw✝:Tyh₁:<{ Bool → Bool }> = <{ w✝¹ → w✝ }>h₂:τ₁ <: w✝¹right✝:w✝ <: τ₂⊢ False
    inversion h₁reflτ₁:Tyτ₂:Tyh:∀ (σ₁ σ₂ : Ty), <{ σ₁ → σ₂ }> <: <{ τ₁ → τ₂ }>h₂:τ₁ <: <{ Bool }>right✝:<{ Bool }> <: τ₂⊢ False
    obtain ⟨_, _, h₃, h₄, _⟩ := sub_inversion_arrow (h <{ Unit }> <{ Unit }>)reflτ₁:Tyτ₂:Tyh:∀ (σ₁ σ₂ : Ty), <{ σ₁ → σ₂ }> <: <{ τ₁ → τ₂ }>h₂:τ₁ <: <{ Bool }>right✝¹:<{ Bool }> <: τ₂w✝¹:Tyw✝:Tyh₃:<{ Unit → Unit }> = <{ w✝¹ → w✝ }>h₄:τ₁ <: w✝¹right✝:w✝ <: τ₂⊢ False
    inversion h₃reflτ₁:Tyτ₂:Tyh:∀ (σ₁ σ₂ : Ty), <{ σ₁ → σ₂ }> <: <{ τ₁ → τ₂ }>h₂:τ₁ <: <{ Bool }>right✝¹:<{ Bool }> <: τ₂h₄:τ₁ <: <{ Unit }>right✝:<{ Unit }> <: τ₂⊢ False
    apply sub_inversion_bool at h₂reflτ₁:Tyτ₂:Tyh:∀ (σ₁ σ₂ : Ty), <{ σ₁ → σ₂ }> <: <{ τ₁ → τ₂ }>right✝¹:<{ Bool }> <: τ₂h₄:τ₁ <: <{ Unit }>right✝:<{ Unit }> <: τ₂h₂:τ₁ = <{ Bool }>⊢ False; apply sub_inversion_unit at h₄reflτ₁:Tyτ₂:Tyh:∀ (σ₁ σ₂ : Ty), <{ σ₁ → σ₂ }> <: <{ τ₁ → τ₂ }>right✝¹:<{ Bool }> <: τ₂right✝:<{ Unit }> <: τ₂h₂:τ₁ = <{ Bool }>h₄:τ₁ = <{ Unit }>⊢ False
    subst_varsreflτ₂:Tyright✝¹:<{ Bool }> <: τ₂right✝:<{ Unit }> <: τ₂h:∀ (σ₁ σ₂ : Ty), <{ σ₁ → σ₂ }> <: <{ Bool → τ₂ }>h₄:<{ Bool }> = <{ Unit }>⊢ False; contradictionAll goals completed! 🐙

Exercise★★(formal_subtype_concepts_tff) (Optional)

theorem formal_subtype_concepts_tff :
  tf (∃ τ₁ τ₂, ∀ σ₁ σ₂, <{ ~τ₁ → ~τ₂ }> <: <{ ~σ₁ → ~σ₂ }>) := by⊢ tf (∃ τ₁ τ₂, ∀ (σ₁ σ₂ : Ty), <{ τ₁ → τ₂ }> <: <{ σ₁ → σ₂ }>)

  solution!
    right⊢ ¬∃ τ₁ τ₂, ∀ (σ₁ σ₂ : Ty), <{ τ₁ → τ₂ }> <: <{ σ₁ → σ₂ }>; intro contracontra:∃ τ₁ τ₂, ∀ (σ₁ σ₂ : Ty), <{ τ₁ → τ₂ }> <: <{ σ₁ → σ₂ }>⊢ False
    obtain ⟨τ₁, τ₂, h⟩ := contraτ₁:Tyτ₂:Tyh:∀ (σ₁ σ₂ : Ty), <{ τ₁ → τ₂ }> <: <{ σ₁ → σ₂ }>⊢ False
    obtain ⟨_, _, h₁, h₂, h₃⟩ := sub_inversion_arrow (h <{ Bool }> <{ Bool }>)τ₁:Tyτ₂:Tyh:∀ (σ₁ σ₂ : Ty), <{ τ₁ → τ₂ }> <: <{ σ₁ → σ₂ }>w✝¹:Tyw✝:Tyh₁:<{ τ₁ → τ₂ }> = <{ w✝¹ → w✝ }>h₂:<{ Bool }> <: w✝¹h₃:w✝ <: <{ Bool }>⊢ False
    inversion h₁reflτ₁:Tyτ₂:Tyh:∀ (σ₁ σ₂ : Ty), <{ τ₁ → τ₂ }> <: <{ σ₁ → σ₂ }>h₂:<{ Bool }> <: τ₁h₃:τ₂ <: <{ Bool }>⊢ False
    obtain ⟨_, _, h₄, h₅, h₆⟩ := sub_inversion_arrow (h <{ Unit }> <{ Unit }>)reflτ₁:Tyτ₂:Tyh:∀ (σ₁ σ₂ : Ty), <{ τ₁ → τ₂ }> <: <{ σ₁ → σ₂ }>h₂:<{ Bool }> <: τ₁h₃:τ₂ <: <{ Bool }>w✝¹:Tyw✝:Tyh₄:<{ τ₁ → τ₂ }> = <{ w✝¹ → w✝ }>h₅:<{ Unit }> <: w✝¹h₆:w✝ <: <{ Unit }>⊢ False
    inversion h₄reflτ₁:Tyτ₂:Tyh:∀ (σ₁ σ₂ : Ty), <{ τ₁ → τ₂ }> <: <{ σ₁ → σ₂ }>h₂:<{ Bool }> <: τ₁h₃:τ₂ <: <{ Bool }>h₅:<{ Unit }> <: τ₁h₆:τ₂ <: <{ Unit }>⊢ False
    apply sub_inversion_bool at h₃reflτ₁:Tyτ₂:Tyh:∀ (σ₁ σ₂ : Ty), <{ τ₁ → τ₂ }> <: <{ σ₁ → σ₂ }>h₂:<{ Bool }> <: τ₁h₅:<{ Unit }> <: τ₁h₆:τ₂ <: <{ Unit }>h₃:τ₂ = <{ Bool }>⊢ False; apply sub_inversion_unit at h₆reflτ₁:Tyτ₂:Tyh:∀ (σ₁ σ₂ : Ty), <{ τ₁ → τ₂ }> <: <{ σ₁ → σ₂ }>h₂:<{ Bool }> <: τ₁h₅:<{ Unit }> <: τ₁h₃:τ₂ = <{ Bool }>h₆:τ₂ = <{ Unit }>⊢ False
    subst_varsreflτ₁:Tyh₂:<{ Bool }> <: τ₁h₅:<{ Unit }> <: τ₁h:∀ (σ₁ σ₂ : Ty), <{ τ₁ → Bool }> <: <{ σ₁ → σ₂ }>h₆:<{ Bool }> = <{ Unit }>⊢ False; contradictionAll goals completed! 🐙

Exercise★★(formal_subtype_concepts_tfg) (Optional)

def inf_desc_chain (n: Nat) : Ty :=
  match n with
    | 0 => <{ ⊤ }>
    | n + 1 => <{ ⊤ → ~(inf_desc_chain n) }>

theorem formal_subtype_concepts_tfg:
  tf (∃ f : Nat → Ty,
         (∀ i j, i ≠ j → f i ≠ f j) ∧
         (∀ i, f (i + 1) <: f i)) := by⊢ tf (∃ f, (∀ (i j : Nat), i ≠ j → f i ≠ f j) ∧ ∀ (i : Nat), f (i + 1) <: f i)
  solution!
    left⊢ ∃ f, (∀ (i j : Nat), i ≠ j → f i ≠ f j) ∧ ∀ (i : Nat), f (i + 1) <: f i; exists inf_desc_chain⊢ (∀ (i j : Nat), i ≠ j → inf_desc_chain i ≠ inf_desc_chain j) ∧ ∀ (i : Nat), inf_desc_chain (i + 1) <: inf_desc_chain i; constructorleft⊢ ∀ (i j : Nat), i ≠ j → inf_desc_chain i ≠ inf_desc_chain jright⊢ ∀ (i : Nat), inf_desc_chain (i + 1) <: inf_desc_chain i
    ·left⊢ ∀ (i j : Nat), i ≠ j → inf_desc_chain i ≠ inf_desc_chain j intro i j hlefti:Natj:Nath:i ≠ j⊢ inf_desc_chain i ≠ inf_desc_chain j; induction i generalizing j with (intro contraleft.succi':Natih:∀ (j : Nat), i' ≠ j → inf_desc_chain i' ≠ inf_desc_chain jj:Nath:i' + 1 ≠ jcontra:inf_desc_chain (i' + 1) = inf_desc_chain j⊢ False)
      | zero =>left.zeroj:Nath:0 ≠ jcontra:inf_desc_chain 0 = inf_desc_chain j⊢ False
          cases jleft.zero.zeroh:0 ≠ 0contra:inf_desc_chain 0 = inf_desc_chain 0⊢ Falseleft.zero.succn✝:Nath:0 ≠ n✝ + 1contra:inf_desc_chain 0 = inf_desc_chain (n✝ + 1)⊢ False; contradictionleft.zero.succn✝:Nath:0 ≠ n✝ + 1contra:inf_desc_chain 0 = inf_desc_chain (n✝ + 1)⊢ False
          simp only [inf_desc_chain] at contraleft.zero.succn✝:Nath:0 ≠ n✝ + 1contra:<{ ⊤ }> = <{ ⊤ → ~(inf_desc_chain n✝) }>⊢ False; contradictionAll goals completed! 🐙
      | succ i' ih =>left.succi':Natih:∀ (j : Nat), i' ≠ j → inf_desc_chain i' ≠ inf_desc_chain jj:Nath:i' + 1 ≠ jcontra:inf_desc_chain (i' + 1) = inf_desc_chain j⊢ False
          cases j with
          | zero =>left.succ.zeroi':Natih:∀ (j : Nat), i' ≠ j → inf_desc_chain i' ≠ inf_desc_chain jh:i' + 1 ≠ 0contra:inf_desc_chain (i' + 1) = inf_desc_chain 0⊢ False contradictionAll goals completed! 🐙
          | succ j' =>left.succ.succi':Natih:∀ (j : Nat), i' ≠ j → inf_desc_chain i' ≠ inf_desc_chain jj':Nath:i' + 1 ≠ j' + 1contra:inf_desc_chain (i' + 1) = inf_desc_chain (j' + 1)⊢ False
              have h' : i' ≠ j' := by⊢ tf (∃ f, (∀ (i j : Nat), i ≠ j → f i ≠ f j) ∧ ∀ (i : Nat), f (i + 1) <: f i) lialeft.succ.succi':Natih:∀ (j : Nat), i' ≠ j → inf_desc_chain i' ≠ inf_desc_chain jj':Nath:i' + 1 ≠ j' + 1contra:inf_desc_chain (i' + 1) = inf_desc_chain (j' + 1)h':i' ≠ j'⊢ False
              apply ih at h'left.succ.succi':Natih:∀ (j : Nat), i' ≠ j → inf_desc_chain i' ≠ inf_desc_chain jj':Nath:i' + 1 ≠ j' + 1contra:inf_desc_chain (i' + 1) = inf_desc_chain (j' + 1)h':inf_desc_chain i' ≠ inf_desc_chain j'⊢ False
              simp only [inf_desc_chain] at contraleft.succ.succi':Natih:∀ (j : Nat), i' ≠ j → inf_desc_chain i' ≠ inf_desc_chain jj':Nath:i' + 1 ≠ j' + 1contra:<{ ⊤ → ~(inf_desc_chain i') }> = <{ ⊤ → ~(inf_desc_chain j') }>h':inf_desc_chain i' ≠ inf_desc_chain j'⊢ False
              inversion contrarefli':Natih:∀ (j : Nat), i' ≠ j → inf_desc_chain i' ≠ inf_desc_chain jj':Nath:i' + 1 ≠ j' + 1contra:<{ ⊤ → ~(inf_desc_chain i') }> = <{ ⊤ → ~(inf_desc_chain j') }>h':inf_desc_chain i' ≠ inf_desc_chain j'h✝:contra ≍ ⋯a_eq✝:inf_desc_chain j' = inf_desc_chain i'⊢ False; liaAll goals completed! 🐙
    ·right⊢ ∀ (i : Nat), inf_desc_chain (i + 1) <: inf_desc_chain i intro irighti:Nat⊢ inf_desc_chain (i + 1) <: inf_desc_chain i; induction i with solve_by_elim using StlcSubTypingAll goals completed! 🐙

Exercise★★(formal_subtype_concepts_tfh) (Optional)

theorem formal_subtype_concepts_tfh:
  tf (∃ f : Nat → Ty, (∀ i j, i ≠ j → f i ≠ f j) ∧ (∀ i, f i <: f (i + 1))) := by⊢ tf (∃ f, (∀ (i j : Nat), i ≠ j → f i ≠ f j) ∧ ∀ (i : Nat), f i <: f (i + 1))
  solution!
    left⊢ ∃ f, (∀ (i j : Nat), i ≠ j → f i ≠ f j) ∧ ∀ (i : Nat), f i <: f (i + 1); exists (fun n => <{ ~(inf_desc_chain n) → ⊤ }>)⊢ (∀ (i j : Nat), i ≠ j → (fun n => <{ ~(inf_desc_chain n) → ⊤ }>) i ≠ (fun n => <{ ~(inf_desc_chain n) → ⊤ }>) j) ∧
  ∀ (i : Nat), (fun n => <{ ~(inf_desc_chain n) → ⊤ }>) i <: (fun n => <{ ~(inf_desc_chain n) → ⊤ }>) (i + 1); constructorleft⊢ ∀ (i j : Nat), i ≠ j → (fun n => <{ ~(inf_desc_chain n) → ⊤ }>) i ≠ (fun n => <{ ~(inf_desc_chain n) → ⊤ }>) jright⊢ ∀ (i : Nat), (fun n => <{ ~(inf_desc_chain n) → ⊤ }>) i <: (fun n => <{ ~(inf_desc_chain n) → ⊤ }>) (i + 1)
    ·left⊢ ∀ (i j : Nat), i ≠ j → (fun n => <{ ~(inf_desc_chain n) → ⊤ }>) i ≠ (fun n => <{ ~(inf_desc_chain n) → ⊤ }>) j intro i j hlefti:Natj:Nath:i ≠ j⊢ (fun n => <{ ~(inf_desc_chain n) → ⊤ }>) i ≠ (fun n => <{ ~(inf_desc_chain n) → ⊤ }>) j; induction i generalizing j with (intro contraleft.succi':Natih:∀ (j : Nat), i' ≠ j → (fun n => <{ ~(inf_desc_chain n) → ⊤ }>) i' ≠ (fun n => <{ ~(inf_desc_chain n) → ⊤ }>) jj:Nath:i' + 1 ≠ jcontra:(fun n => <{ ~(inf_desc_chain n) → ⊤ }>) (i' + 1) = (fun n => <{ ~(inf_desc_chain n) → ⊤ }>) j⊢ False)
      | zero =>left.zeroj:Nath:0 ≠ jcontra:(fun n => <{ ~(inf_desc_chain n) → ⊤ }>) 0 = (fun n => <{ ~(inf_desc_chain n) → ⊤ }>) j⊢ False
          cases jleft.zero.zeroh:0 ≠ 0contra:(fun n => <{ ~(inf_desc_chain n) → ⊤ }>) 0 = (fun n => <{ ~(inf_desc_chain n) → ⊤ }>) 0⊢ Falseleft.zero.succn✝:Nath:0 ≠ n✝ + 1contra:(fun n => <{ ~(inf_desc_chain n) → ⊤ }>) 0 = (fun n => <{ ~(inf_desc_chain n) → ⊤ }>) (n✝ + 1)⊢ False; contradictionleft.zero.succn✝:Nath:0 ≠ n✝ + 1contra:(fun n => <{ ~(inf_desc_chain n) → ⊤ }>) 0 = (fun n => <{ ~(inf_desc_chain n) → ⊤ }>) (n✝ + 1)⊢ False
          simp only [inf_desc_chain] at contraleft.zero.succn✝:Nath:0 ≠ n✝ + 1contra:<{ ⊤ → ⊤ }> = <{ ( ⊤ → ~(inf_desc_chain n✝)) → ⊤ }>⊢ False; inversion contraAll goals completed! 🐙
      | succ i' ih =>left.succi':Natih:∀ (j : Nat), i' ≠ j → (fun n => <{ ~(inf_desc_chain n) → ⊤ }>) i' ≠ (fun n => <{ ~(inf_desc_chain n) → ⊤ }>) jj:Nath:i' + 1 ≠ jcontra:(fun n => <{ ~(inf_desc_chain n) → ⊤ }>) (i' + 1) = (fun n => <{ ~(inf_desc_chain n) → ⊤ }>) j⊢ False
          cases j with
          | zero =>left.succ.zeroi':Natih:∀ (j : Nat), i' ≠ j → (fun n => <{ ~(inf_desc_chain n) → ⊤ }>) i' ≠ (fun n => <{ ~(inf_desc_chain n) → ⊤ }>) jh:i' + 1 ≠ 0contra:(fun n => <{ ~(inf_desc_chain n) → ⊤ }>) (i' + 1) = (fun n => <{ ~(inf_desc_chain n) → ⊤ }>) 0⊢ False simp only [inf_desc_chain] at contraleft.succ.zeroi':Natih:∀ (j : Nat), i' ≠ j → (fun n => <{ ~(inf_desc_chain n) → ⊤ }>) i' ≠ (fun n => <{ ~(inf_desc_chain n) → ⊤ }>) jh:i' + 1 ≠ 0contra:<{ ( ⊤ → ~(inf_desc_chain i')) → ⊤ }> = <{ ⊤ → ⊤ }>⊢ False; inversion contraAll goals completed! 🐙
          | succ j' =>left.succ.succi':Natih:∀ (j : Nat), i' ≠ j → (fun n => <{ ~(inf_desc_chain n) → ⊤ }>) i' ≠ (fun n => <{ ~(inf_desc_chain n) → ⊤ }>) jj':Nath:i' + 1 ≠ j' + 1contra:(fun n => <{ ~(inf_desc_chain n) → ⊤ }>) (i' + 1) = (fun n => <{ ~(inf_desc_chain n) → ⊤ }>) (j' + 1)⊢ False
              have h' : i' ≠ j' := by⊢ tf (∃ f, (∀ (i j : Nat), i ≠ j → f i ≠ f j) ∧ ∀ (i : Nat), f i <: f (i + 1)) lialeft.succ.succi':Natih:∀ (j : Nat), i' ≠ j → (fun n => <{ ~(inf_desc_chain n) → ⊤ }>) i' ≠ (fun n => <{ ~(inf_desc_chain n) → ⊤ }>) jj':Nath:i' + 1 ≠ j' + 1contra:(fun n => <{ ~(inf_desc_chain n) → ⊤ }>) (i' + 1) = (fun n => <{ ~(inf_desc_chain n) → ⊤ }>) (j' + 1)h':i' ≠ j'⊢ False
              apply ih at h'left.succ.succi':Natih:∀ (j : Nat), i' ≠ j → (fun n => <{ ~(inf_desc_chain n) → ⊤ }>) i' ≠ (fun n => <{ ~(inf_desc_chain n) → ⊤ }>) jj':Nath:i' + 1 ≠ j' + 1contra:(fun n => <{ ~(inf_desc_chain n) → ⊤ }>) (i' + 1) = (fun n => <{ ~(inf_desc_chain n) → ⊤ }>) (j' + 1)h':(fun n => <{ ~(inf_desc_chain n) → ⊤ }>) i' ≠ (fun n => <{ ~(inf_desc_chain n) → ⊤ }>) j'⊢ False
              simp only [inf_desc_chain] at contraleft.succ.succi':Natih:∀ (j : Nat), i' ≠ j → (fun n => <{ ~(inf_desc_chain n) → ⊤ }>) i' ≠ (fun n => <{ ~(inf_desc_chain n) → ⊤ }>) jj':Nath:i' + 1 ≠ j' + 1contra:<{ ( ⊤ → ~(inf_desc_chain i')) → ⊤ }> = <{ ( ⊤ → ~(inf_desc_chain j')) → ⊤ }>h':(fun n => <{ ~(inf_desc_chain n) → ⊤ }>) i' ≠ (fun n => <{ ~(inf_desc_chain n) → ⊤ }>) j'⊢ False
              inversion contrarefli':Natih:∀ (j : Nat), i' ≠ j → (fun n => <{ ~(inf_desc_chain n) → ⊤ }>) i' ≠ (fun n => <{ ~(inf_desc_chain n) → ⊤ }>) jj':Nath:i' + 1 ≠ j' + 1contra:<{ ( ⊤ → ~(inf_desc_chain i')) → ⊤ }> = <{ ( ⊤ → ~(inf_desc_chain j')) → ⊤ }>h':(fun n => <{ ~(inf_desc_chain n) → ⊤ }>) i' ≠ (fun n => <{ ~(inf_desc_chain n) → ⊤ }>) j'h✝:contra ≍ ⋯a_eq✝:inf_desc_chain j' = inf_desc_chain i'⊢ False; liaAll goals completed! 🐙
    ·right⊢ ∀ (i : Nat), (fun n => <{ ~(inf_desc_chain n) → ⊤ }>) i <: (fun n => <{ ~(inf_desc_chain n) → ⊤ }>) (i + 1) intro irighti:Nat⊢ (fun n => <{ ~(inf_desc_chain n) → ⊤ }>) i <: (fun n => <{ ~(inf_desc_chain n) → ⊤ }>) (i + 1); induction i with
      | zero =>right.zero⊢ (fun n => <{ ~(inf_desc_chain n) → ⊤ }>) 0 <: (fun n => <{ ~(inf_desc_chain n) → ⊤ }>) (0 + 1) solve_by_elim using StlcSubTypingAll goals completed! 🐙
      | succ i' ih =>right.succi':Natih:(fun n => <{ ~(inf_desc_chain n) → ⊤ }>) i' <: (fun n => <{ ~(inf_desc_chain n) → ⊤ }>) (i' + 1)⊢ (fun n => <{ ~(inf_desc_chain n) → ⊤ }>) (i' + 1) <: (fun n => <{ ~(inf_desc_chain n) → ⊤ }>) (i' + 1 + 1)
        obtain ⟨_, _, h₁, h₂, h₃⟩ := sub_inversion_arrow ihright.succi':Natih:(fun n => <{ ~(inf_desc_chain n) → ⊤ }>) i' <: (fun n => <{ ~(inf_desc_chain n) → ⊤ }>) (i' + 1)w✝¹:Tyw✝:Tyh₁:(fun n => <{ ~(inf_desc_chain n) → ⊤ }>) i' = <{ w✝¹ → w✝ }>h₂:inf_desc_chain (i' + 1) <: w✝¹h₃:w✝ <: <{ ⊤ }>⊢ (fun n => <{ ~(inf_desc_chain n) → ⊤ }>) (i' + 1) <: (fun n => <{ ~(inf_desc_chain n) → ⊤ }>) (i' + 1 + 1)
        inversion h₁refli':Natih:(fun n => <{ ~(inf_desc_chain n) → ⊤ }>) i' <: (fun n => <{ ~(inf_desc_chain n) → ⊤ }>) (i' + 1)h₂:inf_desc_chain (i' + 1) <: inf_desc_chain i'h₃:<{ ⊤ }> <: <{ ⊤ }>⊢ (fun n => <{ ~(inf_desc_chain n) → ⊤ }>) (i' + 1) <: (fun n => <{ ~(inf_desc_chain n) → ⊤ }>) (i' + 1 + 1); solve_by_elim using StlcSubTypingAll goals completed! 🐙

Exercise★★★(formal_proper_subtypes) (Optional)

theorem formal_proper_subtypes:
  tf (∀ τ,
         ¬(τ = Ty.bool ∨ (∃ n, τ = Ty.base n) ∨ τ = Ty.unit) →
         ∃ σ, σ <: τ ∧ σ ≠ τ) := by⊢ tf (∀ (τ : Ty), ¬(τ = <{ Bool }> ∨ (∃ n, τ = (n)) ∨ τ = <{ Unit }>) → ∃ σ, σ <: τ ∧ σ ≠ τ)
  solution!
    right⊢ ¬∀ (τ : Ty), ¬(τ = <{ Bool }> ∨ (∃ n, τ = (n)) ∨ τ = <{ Unit }>) → ∃ σ, σ <: τ ∧ σ ≠ τ; intro contracontra:∀ (τ : Ty), ¬(τ = <{ Bool }> ∨ (∃ n, τ = (n)) ∨ τ = <{ Unit }>) → ∃ σ, σ <: τ ∧ σ ≠ τ⊢ False
    have h : ∃ σ : Ty, σ <: <{ ⊤ → Bool }> ∧ σ ≠ <{ ⊤ → Bool }> := by⊢ tf (∀ (τ : Ty), ¬(τ = <{ Bool }> ∨ (∃ n, τ = (n)) ∨ τ = <{ Unit }>) → ∃ σ, σ <: τ ∧ σ ≠ τ)
      apply contracontra:∀ (τ : Ty), ¬(τ = <{ Bool }> ∨ (∃ n, τ = (n)) ∨ τ = <{ Unit }>) → ∃ σ, σ <: τ ∧ σ ≠ τ⊢ ¬(<{ ⊤ → Bool }> = <{ Bool }> ∨ (∃ n, <{ ⊤ → Bool }> = (n)) ∨ <{ ⊤ → Bool }> = <{ Unit }>); intro contracontra✝:∀ (τ : Ty), ¬(τ = <{ Bool }> ∨ (∃ n, τ = (n)) ∨ τ = <{ Unit }>) → ∃ σ, σ <: τ ∧ σ ≠ τcontra:<{ ⊤ → Bool }> = <{ Bool }> ∨ (∃ n, <{ ⊤ → Bool }> = (n)) ∨ <{ ⊤ → Bool }> = <{ Unit }>⊢ False
      obtain h | ⟨_, h⟩ | h := contrainlcontra:∀ (τ : Ty), ¬(τ = <{ Bool }> ∨ (∃ n, τ = (n)) ∨ τ = <{ Unit }>) → ∃ σ, σ <: τ ∧ σ ≠ τh:<{ ⊤ → Bool }> = <{ Bool }>⊢ Falseinr.inlcontra:∀ (τ : Ty), ¬(τ = <{ Bool }> ∨ (∃ n, τ = (n)) ∨ τ = <{ Unit }>) → ∃ σ, σ <: τ ∧ σ ≠ τw✝:_root_.Stringh:<{ ⊤ → Bool }> = (w✝)⊢ Falseinr.inrcontra:∀ (τ : Ty), ¬(τ = <{ Bool }> ∨ (∃ n, τ = (n)) ∨ τ = <{ Unit }>) → ∃ σ, σ <: τ ∧ σ ≠ τh:<{ ⊤ → Bool }> = <{ Unit }>⊢ False <;>inlcontra:∀ (τ : Ty), ¬(τ = <{ Bool }> ∨ (∃ n, τ = (n)) ∨ τ = <{ Unit }>) → ∃ σ, σ <: τ ∧ σ ≠ τh:<{ ⊤ → Bool }> = <{ Bool }>⊢ Falseinr.inlcontra:∀ (τ : Ty), ¬(τ = <{ Bool }> ∨ (∃ n, τ = (n)) ∨ τ = <{ Unit }>) → ∃ σ, σ <: τ ∧ σ ≠ τw✝:_root_.Stringh:<{ ⊤ → Bool }> = (w✝)⊢ Falseinr.inrcontra:∀ (τ : Ty), ¬(τ = <{ Bool }> ∨ (∃ n, τ = (n)) ∨ τ = <{ Unit }>) → ∃ σ, σ <: τ ∧ σ ≠ τh:<{ ⊤ → Bool }> = <{ Unit }>⊢ False contradictioncontra:∀ (τ : Ty), ¬(τ = <{ Bool }> ∨ (∃ n, τ = (n)) ∨ τ = <{ Unit }>) → ∃ σ, σ <: τ ∧ σ ≠ τh:∃ σ, σ <: <{ ⊤ → Bool }> ∧ σ ≠ <{ ⊤ → Bool }>⊢ False
    obtain ⟨σ, h₁, h₂⟩ := hcontra:∀ (τ : Ty), ¬(τ = <{ Bool }> ∨ (∃ n, τ = (n)) ∨ τ = <{ Unit }>) → ∃ σ, σ <: τ ∧ σ ≠ τσ:Tyh₁:σ <: <{ ⊤ → Bool }>h₂:σ ≠ <{ ⊤ → Bool }>⊢ False
    obtain ⟨_, _, h₁, h₂, h₃⟩ := sub_inversion_arrow h₁contra:∀ (τ : Ty), ¬(τ = <{ Bool }> ∨ (∃ n, τ = (n)) ∨ τ = <{ Unit }>) → ∃ σ, σ <: τ ∧ σ ≠ τσ:Tyh₁✝:σ <: <{ ⊤ → Bool }>h₂✝:σ ≠ <{ ⊤ → Bool }>w✝¹:Tyw✝:Tyh₁:σ = <{ w✝¹ → w✝ }>h₂:<{ ⊤ }> <: w✝¹h₃:w✝ <: <{ Bool }>⊢ False
    apply sub_inversion_bool at h₃contra:∀ (τ : Ty), ¬(τ = <{ Bool }> ∨ (∃ n, τ = (n)) ∨ τ = <{ Unit }>) → ∃ σ, σ <: τ ∧ σ ≠ τσ:Tyh₁✝:σ <: <{ ⊤ → Bool }>h₂✝:σ ≠ <{ ⊤ → Bool }>w✝¹:Tyw✝:Tyh₁:σ = <{ w✝¹ → w✝ }>h₂:<{ ⊤ }> <: w✝¹h₃:w✝ = <{ Bool }>⊢ False
    apply sub_inversion_top at h₂contra:∀ (τ : Ty), ¬(τ = <{ Bool }> ∨ (∃ n, τ = (n)) ∨ τ = <{ Unit }>) → ∃ σ, σ <: τ ∧ σ ≠ τσ:Tyh₁✝:σ <: <{ ⊤ → Bool }>h₂✝:σ ≠ <{ ⊤ → Bool }>w✝¹:Tyw✝:Tyh₁:σ = <{ w✝¹ → w✝ }>h₃:w✝ = <{ Bool }>h₂:w✝¹ = <{ ⊤ }>⊢ False
    subst_varscontra:∀ (τ : Ty), ¬(τ = <{ Bool }> ∨ (∃ n, τ = (n)) ∨ τ = <{ Unit }>) → ∃ σ, σ <: τ ∧ σ ≠ τh₁:<{ ⊤ → Bool }> <: <{ ⊤ → Bool }>h₂:<{ ⊤ → Bool }> ≠ <{ ⊤ → Bool }>⊢ False; apply h₂contra:∀ (τ : Ty), ¬(τ = <{ Bool }> ∨ (∃ n, τ = (n)) ∨ τ = <{ Unit }>) → ∃ σ, σ <: τ ∧ σ ≠ τh₁:<{ ⊤ → Bool }> <: <{ ⊤ → Bool }>h₂:<{ ⊤ → Bool }> ≠ <{ ⊤ → Bool }>⊢ <{ ⊤ → Bool }> = <{ ⊤ → Bool }>; rflAll goals completed! 🐙

end FormalThoughtExercises

end StlcSub

Source revision: 9e5dba0, committed 2026-09-25 03:12 UTC