Prototyping type normalizaton (#466)

* Added type normalization

prototyping/Luau/FunctionTypes.agda

@@ -0,0 +1,38 @@
+{-# OPTIONS --rewriting #-}
+
+open import FFI.Data.Either using (Either; Left; Right)
+open import Luau.Type using (Type; nil; number; string; boolean; never; unknown; _⇒_; _∪_; _∩_)
+open import Luau.TypeNormalization using (normalize)
+
+module Luau.FunctionTypes where
+
+-- The domain of a normalized type
+srcⁿ : Type → Type
+srcⁿ (S ⇒ T) = S
+srcⁿ (S ∩ T) = srcⁿ S ∪ srcⁿ T
+srcⁿ never = unknown
+srcⁿ T = never
+
+-- To get the domain of a type, we normalize it first We need to do
+-- this, since if we try to use it on non-normalized types, we get
+--
+-- src(number ∩ string) = src(number) ∪ src(string) = never ∪ never
+-- src(never) = unknown
+--
+-- so src doesn't respect type equivalence.
+src : Type → Type
+src (S ⇒ T) = S
+src T = srcⁿ(normalize T)
+
+-- The codomain of a type
+tgt : Type → Type
+tgt nil = never
+tgt (S ⇒ T) = T
+tgt never = never
+tgt unknown = unknown
+tgt number = never
+tgt boolean = never
+tgt string = never
+tgt (S ∪ T) = (tgt S) ∪ (tgt T)
+tgt (S ∩ T) = (tgt S) ∩ (tgt T)
+

prototyping/Luau/StrictMode.agda

@@ -5,7 +5,8 @@ module Luau.StrictMode where
 open import Agda.Builtin.Equality using (_≡_)
 open import FFI.Data.Maybe using (just; nothing)
 open import Luau.Syntax using (Expr; Stat; Block; BinaryOperator; yes; nil; addr; var; binexp; var_∈_; _⟨_⟩∈_; function_is_end; _$_; block_is_end; local_←_; _∙_; done; return; name; +; -; *; /; <; >; <=; >=; ··)
-open import Luau.Type using (Type; nil; number; string; boolean; _⇒_; _∪_; _∩_; src; tgt)
+open import Luau.FunctionTypes using (src; tgt)
+open import Luau.Type using (Type; nil; number; string; boolean; _⇒_; _∪_; _∩_)
 open import Luau.Subtyping using (_≮:_)
 open import Luau.Heap using (Heap; function_is_end) renaming (_[_] to _[_]ᴴ)
 open import Luau.VarCtxt using (VarCtxt; ∅; _⋒_; _↦_; _⊕_↦_; _⊝_) renaming (_[_] to _[_]ⱽ)

prototyping/Luau/Subtyping.agda

@@ -25,7 +25,6 @@ data Language where
   function : ∀ {T U} → Language (T ⇒ U) function
   function-ok : ∀ {T U u} → (Language U u) → Language (T ⇒ U) (function-ok u)
   function-err : ∀ {T U t} → (¬Language T t) → Language (T ⇒ U) (function-err t)
-  scalar-function-err : ∀ {S t} → (Scalar S) → Language S (function-err t)
   left : ∀ {T U t} → Language T t → Language (T ∪ U) t
   right : ∀ {T U u} → Language U u → Language (T ∪ U) u
   _,_ : ∀ {T U t} → Language T t → Language U t → Language (T ∩ U) t
@@ -36,6 +35,7 @@ data ¬Language where
   scalar-scalar : ∀ {S T} → (s : Scalar S) → (Scalar T) → (S ≢ T) → ¬Language T (scalar s)
   scalar-function : ∀ {S} → (Scalar S) → ¬Language S function
   scalar-function-ok : ∀ {S u} → (Scalar S) → ¬Language S (function-ok u)
+  scalar-function-err : ∀ {S t} → (Scalar S) → ¬Language S (function-err t)
   function-scalar : ∀ {S T U} (s : Scalar S) → ¬Language (T ⇒ U) (scalar s)
   function-ok : ∀ {T U u} → (¬Language U u) → ¬Language (T ⇒ U) (function-ok u)
   function-err : ∀ {T U t} → (Language T t) → ¬Language (T ⇒ U) (function-err t)

prototyping/Luau/Type.agda

@@ -24,6 +24,8 @@ data Scalar : Type → Set where
   string : Scalar string
   nil : Scalar nil
 
+skalar = number ∪ (string ∪ (nil ∪ boolean))
+
 lhs : Type → Type
 lhs (T ⇒ _) = T
 lhs (T ∪ _) = T
@@ -146,28 +148,6 @@ just T ≡ᴹᵀ just U with T ≡ᵀ U
 (just T ≡ᴹᵀ just T) | yes refl = yes refl
 (just T ≡ᴹᵀ just U) | no p = no (λ q → p (just-inv q))
 
-src : Type → Type
-src nil = never
-src number = never
-src boolean = never
-src string = never
-src (S ⇒ T) = S
-src (S ∪ T) = (src S) ∩ (src T)
-src (S ∩ T) = (src S) ∪ (src T)
-src never = unknown
-src unknown = never
-
-tgt : Type → Type
-tgt nil = never
-tgt (S ⇒ T) = T
-tgt never = never
-tgt unknown = unknown
-tgt number = never
-tgt boolean = never
-tgt string = never
-tgt (S ∪ T) = (tgt S) ∪ (tgt T)
-tgt (S ∩ T) = (tgt S) ∩ (tgt T)
-
 optional : Type → Type
 optional nil = nil
 optional (T ∪ nil) = (T ∪ nil)

prototyping/Luau/TypeCheck.agda

@@ -7,8 +7,9 @@ open import FFI.Data.Maybe using (Maybe; just)
 open import Luau.Syntax using (Expr; Stat; Block; BinaryOperator; yes; nil; addr; number; bool; string; val; var; var_∈_; _⟨_⟩∈_; function_is_end; _$_; block_is_end; binexp; local_←_; _∙_; done; return; name; +; -; *; /; <; >; ==; ~=; <=; >=; ··)
 open import Luau.Var using (Var)
 open import Luau.Addr using (Addr)
+open import Luau.FunctionTypes using (src; tgt)
 open import Luau.Heap using (Heap; Object; function_is_end) renaming (_[_] to _[_]ᴴ)
-open import Luau.Type using (Type; nil; unknown; number; boolean; string; _⇒_; src; tgt)
+open import Luau.Type using (Type; nil; unknown; number; boolean; string; _⇒_)
 open import Luau.VarCtxt using (VarCtxt; ∅; _⋒_; _↦_; _⊕_↦_; _⊝_) renaming (_[_] to _[_]ⱽ)
 open import FFI.Data.Vector using (Vector)
 open import FFI.Data.Maybe using (Maybe; just; nothing)

prototyping/Luau/TypeNormalization.agda

@@ -0,0 +1,69 @@
+module Luau.TypeNormalization where
+
+open import Luau.Type using (Type; nil; number; string; boolean; never; unknown; _⇒_; _∪_; _∩_)
+
+-- The top non-function type
+¬function : Type
+¬function = number ∪ (string ∪ (nil ∪ boolean))
+
+-- Unions and intersections of normalized types
+_∪ᶠ_ : Type → Type → Type
+_∪ⁿˢ_ : Type → Type → Type
+_∩ⁿˢ_ : Type → Type → Type
+_∪ⁿ_ : Type → Type → Type
+_∩ⁿ_ : Type → Type → Type
+
+-- Union of function types
+(F₁ ∩ F₂) ∪ᶠ G = (F₁ ∪ᶠ G) ∩ (F₂ ∪ᶠ G)
+F ∪ᶠ (G₁ ∩ G₂) = (F ∪ᶠ G₁) ∩ (F ∪ᶠ G₂)
+(R ⇒ S) ∪ᶠ (T ⇒ U) = (R ∩ⁿ T) ⇒ (S ∪ⁿ U)
+F ∪ᶠ G = F ∪ G
+
+-- Union of normalized types
+S ∪ⁿ (T₁ ∪ T₂) = (S ∪ⁿ T₁) ∪ T₂
+S ∪ⁿ unknown = unknown
+S ∪ⁿ never = S
+unknown ∪ⁿ T = unknown
+never ∪ⁿ T = T
+(S₁ ∪ S₂) ∪ⁿ G = (S₁ ∪ⁿ G) ∪ S₂
+F ∪ⁿ G = F ∪ᶠ G
+
+-- Intersection of normalized types
+S ∩ⁿ (T₁ ∪ T₂) = (S ∩ⁿ T₁) ∪ⁿˢ (S ∩ⁿˢ T₂)
+S ∩ⁿ unknown = S
+S ∩ⁿ never = never
+(S₁ ∪ S₂) ∩ⁿ G = (S₁ ∩ⁿ G)
+unknown ∩ⁿ G = G
+never ∩ⁿ G = never
+F ∩ⁿ G = F ∩ G
+
+-- Intersection of normalized types with a scalar
+(S₁ ∪ nil) ∩ⁿˢ nil = nil
+(S₁ ∪ boolean) ∩ⁿˢ boolean = boolean
+(S₁ ∪ number) ∩ⁿˢ number = number
+(S₁ ∪ string) ∩ⁿˢ string = string
+(S₁ ∪ S₂) ∩ⁿˢ T = S₁ ∩ⁿˢ T
+unknown ∩ⁿˢ T = T
+F ∩ⁿˢ T = never
+
+-- Union of normalized types with an optional scalar
+S ∪ⁿˢ never = S
+unknown ∪ⁿˢ T = unknown
+(S₁ ∪ nil) ∪ⁿˢ nil = S₁ ∪ nil
+(S₁ ∪ boolean) ∪ⁿˢ boolean = S₁ ∪ boolean
+(S₁ ∪ number) ∪ⁿˢ number = S₁ ∪ number
+(S₁ ∪ string) ∪ⁿˢ string = S₁ ∪ string
+(S₁ ∪ S₂) ∪ⁿˢ T = (S₁ ∪ⁿˢ T) ∪ S₂
+F ∪ⁿˢ T = F ∪ T
+
+-- Normalize!
+normalize : Type → Type
+normalize nil = never ∪ nil
+normalize (S ⇒ T) = (normalize S ⇒ normalize T)
+normalize never = never
+normalize unknown = unknown
+normalize boolean = never ∪ boolean
+normalize number = never ∪ number
+normalize string = never ∪ string
+normalize (S ∪ T) = normalize S ∪ⁿ normalize T
+normalize (S ∩ T) = normalize S ∩ⁿ normalize T

prototyping/Properties.agda

@@ -4,10 +4,13 @@ module Properties where
 
 import Properties.Contradiction
 import Properties.Dec
+import Properties.DecSubtyping
 import Properties.Equality
 import Properties.Functions
+import Properties.FunctionTypes
 import Properties.Remember
 import Properties.Step
 import Properties.StrictMode
 import Properties.Subtyping
 import Properties.TypeCheck
+import Properties.TypeNormalization

prototyping/Properties/DecSubtyping.agda

@@ -0,0 +1,70 @@
+{-# OPTIONS --rewriting #-}
+
+module Properties.DecSubtyping where
+
+open import Agda.Builtin.Equality using (_≡_; refl)
+open import FFI.Data.Either using (Either; Left; Right; mapLR; swapLR; cond)
+open import Luau.FunctionTypes using (src; srcⁿ; tgt)
+open import Luau.Subtyping using (_<:_; _≮:_; Tree; Language; ¬Language; witness; unknown; never; scalar; function; scalar-function; scalar-function-ok; scalar-function-err; scalar-scalar; function-scalar; function-ok; function-err; left; right; _,_)
+open import Luau.Type using (Type; Scalar; nil; number; string; boolean; never; unknown; _⇒_; _∪_; _∩_)
+open import Properties.Contradiction using (CONTRADICTION; ¬)
+open import Properties.Functions using (_∘_)
+open import Properties.Subtyping using (<:-refl; <:-trans; ≮:-trans-<:; <:-trans-≮:; <:-never; <:-unknown; <:-∪-left; <:-∪-right; <:-∪-lub;  ≮:-∪-left; ≮:-∪-right; <:-∩-left; <:-∩-right; <:-∩-glb;  ≮:-∩-left; ≮:-∩-right; dec-language; scalar-<:; <:-everything; <:-function; ≮:-function-left; ≮:-function-right)
+open import Properties.TypeNormalization using (FunType; Normal; never; unknown; _∩_; _∪_; _⇒_; normal; <:-normalize; normalize-<:)
+open import Properties.FunctionTypes using (fun-¬scalar; ¬fun-scalar; fun-function; src-unknown-≮:; tgt-never-≮:; src-tgtᶠ-<:)
+open import Properties.Equality using (_≢_)
+
+-- Honest this terminates, since src and tgt reduce the depth of nested arrows
+{-# TERMINATING #-}
+dec-subtypingˢⁿ : ∀ {T U} → Scalar T → Normal U → Either (T ≮: U) (T <: U)
+dec-subtypingᶠ : ∀ {T U} → FunType T → FunType U → Either (T ≮: U) (T <: U)
+dec-subtypingᶠⁿ : ∀ {T U} → FunType T → Normal U → Either (T ≮: U) (T <: U)
+dec-subtypingⁿ : ∀ {T U} → Normal T → Normal U → Either (T ≮: U) (T <: U)
+dec-subtyping : ∀ T U → Either (T ≮: U) (T <: U)
+
+dec-subtypingˢⁿ T U with dec-language _ (scalar T)
+dec-subtypingˢⁿ T U | Left p = Left (witness (scalar T) (scalar T) p)
+dec-subtypingˢⁿ T U | Right p = Right (scalar-<: T p)
+
+dec-subtypingᶠ {T = T} _ (U ⇒ V) with dec-subtypingⁿ U (normal (src T)) | dec-subtypingⁿ (normal (tgt T)) V
+dec-subtypingᶠ {T = T} _ (U ⇒ V) | Left p | q = Left (≮:-trans-<: (src-unknown-≮: (≮:-trans-<: p (<:-normalize (src T)))) (<:-function <:-refl <:-unknown))
+dec-subtypingᶠ {T = T} _ (U ⇒ V) | Right p | Left q = Left (≮:-trans-<: (tgt-never-≮: (<:-trans-≮: (normalize-<: (tgt T)) q)) (<:-trans (<:-function <:-never <:-refl) <:-∪-right))
+dec-subtypingᶠ T (U ⇒ V) | Right p | Right q = Right (src-tgtᶠ-<: T (<:-trans p (normalize-<: _)) (<:-trans (<:-normalize _) q))
+
+dec-subtypingᶠ T (U ∩ V) with dec-subtypingᶠ T U | dec-subtypingᶠ T V
+dec-subtypingᶠ T (U ∩ V) | Left p | q = Left (≮:-∩-left p)
+dec-subtypingᶠ T (U ∩ V) | Right p | Left q = Left (≮:-∩-right q)
+dec-subtypingᶠ T (U ∩ V) | Right p | Right q = Right (<:-∩-glb p q)
+
+dec-subtypingᶠⁿ T never = Left (witness function (fun-function T) never)
+dec-subtypingᶠⁿ T unknown = Right <:-unknown
+dec-subtypingᶠⁿ T (U ⇒ V) = dec-subtypingᶠ T (U ⇒ V)
+dec-subtypingᶠⁿ T (U ∩ V) = dec-subtypingᶠ T (U ∩ V)
+dec-subtypingᶠⁿ T (U ∪ V) with dec-subtypingᶠⁿ T U
+dec-subtypingᶠⁿ T (U ∪ V) | Left (witness t p q) = Left (witness t p (q , ¬fun-scalar V T p))
+dec-subtypingᶠⁿ T (U ∪ V) | Right p = Right (<:-trans p <:-∪-left)
+
+dec-subtypingⁿ never U = Right <:-never
+dec-subtypingⁿ unknown unknown = Right <:-refl
+dec-subtypingⁿ unknown U with dec-subtypingᶠⁿ (never ⇒ unknown) U
+dec-subtypingⁿ unknown U | Left p = Left (<:-trans-≮: <:-unknown p)
+dec-subtypingⁿ unknown U | Right p₁ with dec-subtypingˢⁿ number U
+dec-subtypingⁿ unknown U | Right p₁ | Left p = Left (<:-trans-≮: <:-unknown p)
+dec-subtypingⁿ unknown U | Right p₁ | Right p₂ with dec-subtypingˢⁿ string U
+dec-subtypingⁿ unknown U | Right p₁ | Right p₂ | Left p = Left (<:-trans-≮: <:-unknown p)
+dec-subtypingⁿ unknown U | Right p₁ | Right p₂ | Right p₃ with dec-subtypingˢⁿ nil U
+dec-subtypingⁿ unknown U | Right p₁ | Right p₂ | Right p₃ | Left p = Left (<:-trans-≮: <:-unknown p)
+dec-subtypingⁿ unknown U | Right p₁ | Right p₂ | Right p₃ | Right p₄ with dec-subtypingˢⁿ boolean U
+dec-subtypingⁿ unknown U | Right p₁ | Right p₂ | Right p₃ | Right p₄ | Left p = Left (<:-trans-≮: <:-unknown p)
+dec-subtypingⁿ unknown U | Right p₁ | Right p₂ | Right p₃ | Right p₄ | Right p₅ = Right (<:-trans <:-everything (<:-∪-lub p₁ (<:-∪-lub p₂ (<:-∪-lub p₃ (<:-∪-lub p₄ p₅)))))
+dec-subtypingⁿ (S ⇒ T) U = dec-subtypingᶠⁿ (S ⇒ T) U
+dec-subtypingⁿ (S ∩ T) U = dec-subtypingᶠⁿ (S ∩ T) U
+dec-subtypingⁿ (S ∪ T) U with dec-subtypingⁿ S U | dec-subtypingˢⁿ T U
+dec-subtypingⁿ (S ∪ T) U | Left p | q = Left (≮:-∪-left p)
+dec-subtypingⁿ (S ∪ T) U | Right p | Left q = Left (≮:-∪-right q)
+dec-subtypingⁿ (S ∪ T) U | Right p | Right q = Right (<:-∪-lub p q)
+
+dec-subtyping T U with dec-subtypingⁿ (normal T) (normal U)
+dec-subtyping T U | Left p = Left (<:-trans-≮: (normalize-<: T) (≮:-trans-<: p (<:-normalize U)))
+dec-subtyping T U | Right p = Right (<:-trans (<:-normalize T) (<:-trans p (normalize-<: U)))
+

prototyping/Properties/FunctionTypes.agda

@@ -0,0 +1,150 @@
+{-# OPTIONS --rewriting #-}
+
+module Properties.FunctionTypes where
+
+open import FFI.Data.Either using (Either; Left; Right; mapLR; swapLR; cond)
+open import Luau.FunctionTypes using (srcⁿ; src; tgt)
+open import Luau.Subtyping using (_<:_; _≮:_; Tree; Language; ¬Language; witness; unknown; never; scalar; function; scalar-function; scalar-function-ok; scalar-function-err; scalar-scalar; function-scalar; function-ok; function-err; left; right; _,_)
+open import Luau.Type using (Type; Scalar; nil; number; string; boolean; never; unknown; _⇒_; _∪_; _∩_; skalar)
+open import Properties.Contradiction using (CONTRADICTION; ¬; ⊥)
+open import Properties.Functions using (_∘_)
+open import Properties.Subtyping using (<:-refl; ≮:-refl; <:-trans-≮:; skalar-scalar; <:-impl-⊇; skalar-function-ok; language-comp)
+open import Properties.TypeNormalization using (FunType; Normal; never; unknown; _∩_; _∪_; _⇒_; normal; <:-normalize; normalize-<:)
+
+-- Properties of src
+function-err-srcⁿ : ∀ {T t} → (FunType T) → (¬Language (srcⁿ T) t) → Language T (function-err t)
+function-err-srcⁿ (S ⇒ T) p = function-err p
+function-err-srcⁿ (S ∩ T) (p₁ , p₂) = (function-err-srcⁿ S p₁ , function-err-srcⁿ T p₂)
+
+¬function-err-srcᶠ : ∀ {T t} → (FunType T) → (Language (srcⁿ T) t) → ¬Language T (function-err t)
+¬function-err-srcᶠ (S ⇒ T) p = function-err p
+¬function-err-srcᶠ (S ∩ T) (left p) = left (¬function-err-srcᶠ S p)
+¬function-err-srcᶠ (S ∩ T) (right p) = right (¬function-err-srcᶠ T p)
+
+¬function-err-srcⁿ : ∀ {T t} → (Normal T) → (Language (srcⁿ T) t) → ¬Language T (function-err t)
+¬function-err-srcⁿ never p = never
+¬function-err-srcⁿ unknown (scalar ())
+¬function-err-srcⁿ (S ⇒ T) p = function-err p
+¬function-err-srcⁿ (S ∩ T) (left p) = left (¬function-err-srcᶠ S p)
+¬function-err-srcⁿ (S ∩ T) (right p) = right (¬function-err-srcᶠ T p)
+¬function-err-srcⁿ (S ∪ T) (scalar ())
+
+¬function-err-src : ∀ {T t} → (Language (src T) t) → ¬Language T (function-err t)
+¬function-err-src {T = S ⇒ T} p = function-err p
+¬function-err-src {T = nil} p = scalar-function-err nil
+¬function-err-src {T = never} p = never
+¬function-err-src {T = unknown} (scalar ())
+¬function-err-src {T = boolean} p = scalar-function-err boolean
+¬function-err-src {T = number} p = scalar-function-err number
+¬function-err-src {T = string} p = scalar-function-err string
+¬function-err-src {T = S ∪ T} p = <:-impl-⊇ (<:-normalize (S ∪ T)) _ (¬function-err-srcⁿ (normal (S ∪ T)) p)
+¬function-err-src {T = S ∩ T} p = <:-impl-⊇ (<:-normalize (S ∩ T)) _ (¬function-err-srcⁿ (normal (S ∩ T)) p)
+
+src-¬function-errᶠ : ∀ {T t} → (FunType T) → Language T (function-err t) → (¬Language (srcⁿ T) t)
+src-¬function-errᶠ (S ⇒ T) (function-err p) = p
+src-¬function-errᶠ (S ∩ T) (p₁ , p₂) = (src-¬function-errᶠ S p₁ , src-¬function-errᶠ T p₂)
+
+src-¬function-errⁿ : ∀ {T t} → (Normal T) → Language T (function-err t) → (¬Language (srcⁿ T) t)
+src-¬function-errⁿ unknown p = never
+src-¬function-errⁿ (S ⇒ T) (function-err p) = p
+src-¬function-errⁿ (S ∩ T) (p₁ , p₂) = (src-¬function-errᶠ S p₁ , src-¬function-errᶠ T p₂)
+src-¬function-errⁿ (S ∪ T) p = never
+
+src-¬function-err : ∀ {T t} → Language T (function-err t) → (¬Language (src T) t)
+src-¬function-err {T = S ⇒ T} (function-err p) = p
+src-¬function-err {T = unknown} p = never
+src-¬function-err {T = S ∪ T} p = src-¬function-errⁿ (normal (S ∪ T)) (<:-normalize (S ∪ T) _ p)
+src-¬function-err {T = S ∩ T} p = src-¬function-errⁿ (normal (S ∩ T)) (<:-normalize (S ∩ T) _ p)
+
+fun-¬scalar : ∀ {S T} (s : Scalar S) → FunType T → ¬Language T (scalar s)
+fun-¬scalar s (S ⇒ T) = function-scalar s
+fun-¬scalar s (S ∩ T) = left (fun-¬scalar s S)
+
+¬fun-scalar : ∀ {S T t} (s : Scalar S) → FunType T → Language T t → ¬Language S t
+¬fun-scalar s (S ⇒ T) function = scalar-function s
+¬fun-scalar s (S ⇒ T) (function-ok p) = scalar-function-ok s
+¬fun-scalar s (S ⇒ T) (function-err p) = scalar-function-err s
+¬fun-scalar s (S ∩ T) (p₁ , p₂) = ¬fun-scalar s T p₂
+
+fun-function : ∀ {T} → FunType T → Language T function
+fun-function (S ⇒ T) = function
+fun-function (S ∩ T) = (fun-function S , fun-function T)
+
+srcⁿ-¬scalar : ∀ {S T t} (s : Scalar S) → Normal T → Language T (scalar s) → (¬Language (srcⁿ T) t)
+srcⁿ-¬scalar s never (scalar ())
+srcⁿ-¬scalar s unknown p = never
+srcⁿ-¬scalar s (S ⇒ T) (scalar ())
+srcⁿ-¬scalar s (S ∩ T) (p₁ , p₂) = CONTRADICTION (language-comp (scalar s) (fun-¬scalar s S) p₁)
+srcⁿ-¬scalar s (S ∪ T) p = never
+
+src-¬scalar : ∀ {S T t} (s : Scalar S) → Language T (scalar s) → (¬Language (src T) t)
+src-¬scalar {T = nil} s p = never
+src-¬scalar {T = T ⇒ U} s (scalar ())
+src-¬scalar {T = never} s (scalar ())
+src-¬scalar {T = unknown} s p = never
+src-¬scalar {T = boolean} s p = never
+src-¬scalar {T = number} s p = never
+src-¬scalar {T = string} s p = never
+src-¬scalar {T = T ∪ U} s p = srcⁿ-¬scalar s (normal (T ∪ U)) (<:-normalize (T ∪ U) (scalar s) p)
+src-¬scalar {T = T ∩ U} s p = srcⁿ-¬scalar s (normal (T ∩ U)) (<:-normalize (T ∩ U) (scalar s) p)
+
+srcⁿ-unknown-≮: : ∀ {T U} → (Normal U) → (T ≮: srcⁿ U) → (U ≮: (T ⇒ unknown))
+srcⁿ-unknown-≮: never (witness t p q) = CONTRADICTION (language-comp t q unknown)
+srcⁿ-unknown-≮: unknown (witness t p q) = witness (function-err t) unknown (function-err p)
+srcⁿ-unknown-≮: (U ⇒ V) (witness t p q) = witness (function-err t) (function-err q) (function-err p)
+srcⁿ-unknown-≮: (U ∩ V) (witness t p q) = witness (function-err t) (function-err-srcⁿ (U ∩ V) q) (function-err p)
+srcⁿ-unknown-≮: (U ∪ V) (witness t p q) = witness (scalar V) (right (scalar V)) (function-scalar V)
+
+src-unknown-≮: : ∀ {T U} → (T ≮: src U) → (U ≮: (T ⇒ unknown))
+src-unknown-≮: {U = nil} (witness t p q) = witness (scalar nil) (scalar nil) (function-scalar nil)
+src-unknown-≮: {U = T ⇒ U} (witness t p q) = witness (function-err t) (function-err q) (function-err p)
+src-unknown-≮: {U = never} (witness t p q) = CONTRADICTION (language-comp t q unknown)
+src-unknown-≮: {U = unknown} (witness t p q) = witness (function-err t) unknown (function-err p)
+src-unknown-≮: {U = boolean} (witness t p q) = witness (scalar boolean) (scalar boolean) (function-scalar boolean)
+src-unknown-≮: {U = number} (witness t p q) = witness (scalar number) (scalar number) (function-scalar number)
+src-unknown-≮: {U = string} (witness t p q) = witness (scalar string) (scalar string) (function-scalar string)
+src-unknown-≮: {U = T ∪ U} p = <:-trans-≮: (normalize-<: (T ∪ U)) (srcⁿ-unknown-≮: (normal (T ∪ U)) p)
+src-unknown-≮: {U = T ∩ U} p = <:-trans-≮: (normalize-<: (T ∩ U)) (srcⁿ-unknown-≮: (normal (T ∩ U)) p)
+
+unknown-src-≮: : ∀ {S T U} → (U ≮: S) → (T ≮: (U ⇒ unknown)) → (U ≮: src T)
+unknown-src-≮: (witness t x x₁) (witness (scalar s) p (function-scalar s)) = witness t x (src-¬scalar s p)
+unknown-src-≮: r (witness (function-ok (scalar s)) p (function-ok (scalar-scalar s () q)))
+unknown-src-≮: r (witness (function-ok (function-ok _)) p (function-ok (scalar-function-ok ())))
+unknown-src-≮: r (witness (function-err t) p (function-err q)) = witness t q (src-¬function-err p)
+
+-- Properties of tgt
+tgt-function-ok : ∀ {T t} → (Language (tgt T) t) → Language T (function-ok t)
+tgt-function-ok {T = nil} (scalar ())
+tgt-function-ok {T = T₁ ⇒ T₂} p = function-ok p
+tgt-function-ok {T = never} (scalar ())
+tgt-function-ok {T = unknown} p = unknown
+tgt-function-ok {T = boolean} (scalar ())
+tgt-function-ok {T = number} (scalar ())
+tgt-function-ok {T = string} (scalar ())
+tgt-function-ok {T = T₁ ∪ T₂} (left p) = left (tgt-function-ok p)
+tgt-function-ok {T = T₁ ∪ T₂} (right p) = right (tgt-function-ok p)
+tgt-function-ok {T = T₁ ∩ T₂} (p₁ , p₂) = (tgt-function-ok p₁ , tgt-function-ok p₂)
+
+function-ok-tgt : ∀ {T t} → Language T (function-ok t) → (Language (tgt T) t)
+function-ok-tgt (function-ok p) = p
+function-ok-tgt (left p) = left (function-ok-tgt p)
+function-ok-tgt (right p) = right (function-ok-tgt p)
+function-ok-tgt (p₁ , p₂) = (function-ok-tgt p₁ , function-ok-tgt p₂)
+function-ok-tgt unknown = unknown
+
+tgt-never-≮: : ∀ {T U} → (tgt T ≮: U) → (T ≮: (skalar ∪ (never ⇒ U)))
+tgt-never-≮: (witness t p q) = witness (function-ok t) (tgt-function-ok p) (skalar-function-ok , function-ok q)
+
+never-tgt-≮: : ∀ {T U} → (T ≮: (skalar ∪ (never ⇒ U))) → (tgt T ≮: U)
+never-tgt-≮: (witness (scalar s) p (q₁ , q₂)) = CONTRADICTION (≮:-refl (witness (scalar s) (skalar-scalar s) q₁))
+never-tgt-≮: (witness function p (q₁ , scalar-function ()))
+never-tgt-≮: (witness (function-ok t) p (q₁ , function-ok q₂)) = witness t (function-ok-tgt p) q₂
+never-tgt-≮: (witness (function-err (scalar s)) p (q₁ , function-err (scalar ())))
+
+src-tgtᶠ-<: : ∀ {T U V} → (FunType T) → (U <: src T) → (tgt T <: V) → (T <: (U ⇒ V))
+src-tgtᶠ-<: T p q (scalar s) r = CONTRADICTION (language-comp (scalar s) (fun-¬scalar s T) r)
+src-tgtᶠ-<: T p q function r = function
+src-tgtᶠ-<: T p q (function-ok s) r = function-ok (q s (function-ok-tgt r))
+src-tgtᶠ-<: T p q (function-err s) r = function-err (<:-impl-⊇ p s (src-¬function-err r))
+
+

prototyping/Properties/StrictMode.agda

@@ -11,7 +11,8 @@ open import Luau.StrictMode using (Warningᴱ; Warningᴮ; Warningᴼ; Warning
 open import Luau.Substitution using (_[_/_]ᴮ; _[_/_]ᴱ; _[_/_]ᴮunless_; var_[_/_]ᴱwhenever_)
 open import Luau.Subtyping using (_≮:_; witness; unknown; never; scalar; function; scalar-function; scalar-function-ok; scalar-function-err; scalar-scalar; function-scalar; function-ok; function-err; left; right; _,_; Tree; Language; ¬Language)
 open import Luau.Syntax using (Expr; yes; var; val; var_∈_; _⟨_⟩∈_; _$_; addr; number; bool; string; binexp; nil; function_is_end; block_is_end; done; return; local_←_; _∙_; fun; arg; name; ==; ~=)
-open import Luau.Type using (Type; nil; number; boolean; string; _⇒_; never; unknown; _∩_; _∪_; src; tgt; _≡ᵀ_; _≡ᴹᵀ_)
+open import Luau.FunctionTypes using (src; tgt)
+open import Luau.Type using (Type; nil; number; boolean; string; _⇒_; never; unknown; _∩_; _∪_; _≡ᵀ_; _≡ᴹᵀ_)
 open import Luau.TypeCheck using (_⊢ᴮ_∈_; _⊢ᴱ_∈_; _⊢ᴴᴮ_▷_∈_; _⊢ᴴᴱ_▷_∈_; nil; var; addr; app; function; block; done; return; local; orUnknown; srcBinOp; tgtBinOp)
 open import Luau.Var using (_≡ⱽ_)
 open import Luau.Addr using (_≡ᴬ_)
@@ -22,7 +23,8 @@ open import Properties.Equality using (_≢_; sym; cong; trans; subst₁)
 open import Properties.Dec using (Dec; yes; no)
 open import Properties.Contradiction using (CONTRADICTION; ¬)
 open import Properties.Functions using (_∘_)
-open import Properties.Subtyping using (unknown-≮:; ≡-trans-≮:; ≮:-trans-≡; never-tgt-≮:; tgt-never-≮:; src-unknown-≮:; unknown-src-≮:; ≮:-trans; ≮:-refl; scalar-≢-impl-≮:; function-≮:-scalar; scalar-≮:-function; function-≮:-never; unknown-≮:-scalar; scalar-≮:-never; unknown-≮:-never)
+open import Properties.FunctionTypes using (never-tgt-≮:; tgt-never-≮:; src-unknown-≮:; unknown-src-≮:)
+open import Properties.Subtyping using (unknown-≮:; ≡-trans-≮:; ≮:-trans-≡; ≮:-trans; ≮:-refl; scalar-≢-impl-≮:; function-≮:-scalar; scalar-≮:-function; function-≮:-never; unknown-≮:-scalar; scalar-≮:-never; unknown-≮:-never)
 open import Properties.TypeCheck using (typeOfᴼ; typeOfᴹᴼ; typeOfⱽ; typeOfᴱ; typeOfᴮ; typeCheckᴱ; typeCheckᴮ; typeCheckᴼ; typeCheckᴴ)
 open import Luau.OpSem using (_⟦_⟧_⟶_; _⊢_⟶*_⊣_; _⊢_⟶ᴮ_⊣_; _⊢_⟶ᴱ_⊣_; app₁; app₂; function; beta; return; block; done; local; subst; binOp₀; binOp₁; binOp₂; refl; step; +; -; *; /; <; >; ==; ~=; <=; >=; ··)
 open import Luau.RuntimeError using (BinOpError; RuntimeErrorᴱ; RuntimeErrorᴮ; FunctionMismatch; BinOpMismatch₁; BinOpMismatch₂; UnboundVariable; SEGV; app₁; app₂; bin₁; bin₂; block; local; return; +; -; *; /; <; >; <=; >=; ··)

prototyping/Properties/Subtyping.agda

@@ -4,9 +4,10 @@ module Properties.Subtyping where
 
 open import Agda.Builtin.Equality using (_≡_; refl)
 open import FFI.Data.Either using (Either; Left; Right; mapLR; swapLR; cond)
+open import FFI.Data.Maybe using (Maybe; just; nothing)
 open import Luau.Subtyping using (_<:_; _≮:_; Tree; Language; ¬Language; witness; unknown; never; scalar; function; scalar-function; scalar-function-ok; scalar-function-err; scalar-scalar; function-scalar; function-ok; function-err; left; right; _,_)
-open import Luau.Type using (Type; Scalar; nil; number; string; boolean; never; unknown; _⇒_; _∪_; _∩_; src; tgt)
+open import Luau.Type using (Type; Scalar; nil; number; string; boolean; never; unknown; _⇒_; _∪_; _∩_; skalar)
-open import Properties.Contradiction using (CONTRADICTION; ¬)
+open import Properties.Contradiction using (CONTRADICTION; ¬; ⊥)
 open import Properties.Equality using (_≢_)
 open import Properties.Functions using (_∘_)
 open import Properties.Product using (_×_; _,_)
@@ -19,28 +20,28 @@ dec-language nil (scalar string) = Left (scalar-scalar string nil (λ ()))
 dec-language nil (scalar nil) = Right (scalar nil)
 dec-language nil function = Left (scalar-function nil)
 dec-language nil (function-ok t) = Left (scalar-function-ok nil)
-dec-language nil (function-err t) = Right (scalar-function-err nil)
+dec-language nil (function-err t) = Left (scalar-function-err nil)
 dec-language boolean (scalar number) = Left (scalar-scalar number boolean (λ ()))
 dec-language boolean (scalar boolean) = Right (scalar boolean)
 dec-language boolean (scalar string) = Left (scalar-scalar string boolean (λ ()))
 dec-language boolean (scalar nil) = Left (scalar-scalar nil boolean (λ ()))
 dec-language boolean function = Left (scalar-function boolean)
 dec-language boolean (function-ok t) = Left (scalar-function-ok boolean)
-dec-language boolean (function-err t) = Right (scalar-function-err boolean)
+dec-language boolean (function-err t) = Left (scalar-function-err boolean)
 dec-language number (scalar number) = Right (scalar number)
 dec-language number (scalar boolean) = Left (scalar-scalar boolean number (λ ()))
 dec-language number (scalar string) = Left (scalar-scalar string number (λ ()))
 dec-language number (scalar nil) = Left (scalar-scalar nil number (λ ()))
 dec-language number function = Left (scalar-function number)
 dec-language number (function-ok t) = Left (scalar-function-ok number)
-dec-language number (function-err t) = Right (scalar-function-err number)
+dec-language number (function-err t) = Left (scalar-function-err number)
 dec-language string (scalar number) = Left (scalar-scalar number string (λ ()))
 dec-language string (scalar boolean) = Left (scalar-scalar boolean string (λ ()))
 dec-language string (scalar string) = Right (scalar string)
 dec-language string (scalar nil) = Left (scalar-scalar nil string (λ ()))
 dec-language string function = Left (scalar-function string)
 dec-language string (function-ok t) = Left (scalar-function-ok string)
-dec-language string (function-err t) = Right (scalar-function-err string)
+dec-language string (function-err t) = Left (scalar-function-err string)
 dec-language (T₁ ⇒ T₂) (scalar s) = Left (function-scalar s)
 dec-language (T₁ ⇒ T₂) function = Right function
 dec-language (T₁ ⇒ T₂) (function-ok t) = mapLR function-ok function-ok (dec-language T₂ t)
@@ -73,6 +74,11 @@ language-comp (function-err t) (function-err p) (function-err q) = language-comp
 <:-impl-¬≮: : ∀ {T U} → (T <: U) → ¬(T ≮: U)
 <:-impl-¬≮: p (witness t q r) = language-comp t r (p t q)
 
+<:-impl-⊇ : ∀ {T U} → (T <: U) → ∀ t → ¬Language U t → ¬Language T t
+<:-impl-⊇ {T} p t q with dec-language T t
+<:-impl-⊇ {_} p t q | Left r = r
+<:-impl-⊇ {_} p t q | Right r = CONTRADICTION (language-comp t q (p t r))
+
 -- reflexivity
 ≮:-refl : ∀ {T} → ¬(T ≮: T)
 ≮:-refl (witness t p q) = language-comp t q p
@@ -91,10 +97,162 @@ language-comp (function-err t) (function-err p) (function-err q) = language-comp
 ≮:-trans {T = T} (witness t p q) = mapLR (witness t p) (λ z → witness t z q) (dec-language T t)
 
 <:-trans : ∀ {S T U} → (S <: T) → (T <: U) → (S <: U)
-<:-trans p q = ¬≮:-impl-<: (cond (<:-impl-¬≮: p) (<:-impl-¬≮: q) ∘ ≮:-trans)
+<:-trans p q t r = q t (p t r)
+
+<:-trans-≮: : ∀ {S T U} → (S <: T) → (S ≮: U) → (T ≮: U)
+<:-trans-≮: p (witness t q r) = witness t (p t q) r
+
+≮:-trans-<: : ∀ {S T U} → (S ≮: U) → (T <: U) → (S ≮: T)
+≮:-trans-<: (witness t p q) r = witness t p (<:-impl-⊇ r t q)
+
+-- Properties of union
+
+<:-union : ∀ {R S T U} → (R <: T) → (S <: U) → ((R ∪ S) <: (T ∪ U))
+<:-union p q t (left r) = left (p t r)
+<:-union p q t (right r) = right (q t r)
+
+<:-∪-left : ∀ {S T} → S <: (S ∪ T)
+<:-∪-left t p = left p
+
+<:-∪-right : ∀ {S T} → T <: (S ∪ T)
+<:-∪-right t p = right p
+
+<:-∪-lub : ∀ {S T U} → (S <: U) → (T <: U) → ((S ∪ T) <: U)
+<:-∪-lub p q t (left r) = p t r
+<:-∪-lub p q t (right r) = q t r
+
+<:-∪-symm : ∀ {T U} → (T ∪ U) <: (U ∪ T)
+<:-∪-symm t (left p) = right p
+<:-∪-symm t (right p) = left p
+
+<:-∪-assocl : ∀ {S T U} → (S ∪ (T ∪ U)) <: ((S ∪ T) ∪ U)
+<:-∪-assocl t (left p) = left (left p)
+<:-∪-assocl t (right (left p)) = left (right p)
+<:-∪-assocl t (right (right p)) = right p
+
+<:-∪-assocr : ∀ {S T U} → ((S ∪ T) ∪ U) <: (S ∪ (T ∪ U))
+<:-∪-assocr t (left (left p)) = left p
+<:-∪-assocr t (left (right p)) = right (left p)
+<:-∪-assocr t (right p) = right (right p)
+
+≮:-∪-left : ∀ {S T U} → (S ≮: U) → ((S ∪ T) ≮: U)
+≮:-∪-left (witness t p q) = witness t (left p) q
+
+≮:-∪-right : ∀ {S T U} → (T ≮: U) → ((S ∪ T) ≮: U)
+≮:-∪-right (witness t p q) = witness t (right p) q
+
+-- Properties of intersection
+
+<:-intersect : ∀ {R S T U} → (R <: T) → (S <: U) → ((R ∩ S) <: (T ∩ U))
+<:-intersect p q t (r₁ , r₂) = (p t r₁ , q t r₂)
+
+<:-∩-left : ∀ {S T} → (S ∩ T) <: S
+<:-∩-left t (p , _) = p
+
+<:-∩-right : ∀ {S T} → (S ∩ T) <: T
+<:-∩-right t (_ , p) = p
+
+<:-∩-glb : ∀ {S T U} → (S <: T) → (S <: U) → (S <: (T ∩ U))
+<:-∩-glb p q t r = (p t r , q t r)
+
+<:-∩-symm : ∀ {T U} → (T ∩ U) <: (U ∩ T)
+<:-∩-symm t (p₁ , p₂) = (p₂ , p₁)
+
+≮:-∩-left : ∀ {S T U} → (S ≮: T) → (S ≮: (T ∩ U))
+≮:-∩-left (witness t p q) = witness t p (left q)
+
+≮:-∩-right : ∀ {S T U} → (S ≮: U) → (S ≮: (T ∩ U))
+≮:-∩-right (witness t p q) = witness t p (right q)
+
+-- Distribution properties
+<:-∩-distl-∪ : ∀ {S T U} → (S ∩ (T ∪ U)) <: ((S ∩ T) ∪ (S ∩ U))
+<:-∩-distl-∪ t (p₁ , left p₂) = left (p₁ , p₂)
+<:-∩-distl-∪ t (p₁ , right p₂) = right (p₁ , p₂)
+
+∩-distl-∪-<: : ∀ {S T U} → ((S ∩ T) ∪ (S ∩ U)) <: (S ∩ (T ∪ U))
+∩-distl-∪-<: t (left (p₁ , p₂)) = (p₁ , left p₂)
+∩-distl-∪-<: t (right (p₁ , p₂)) = (p₁ , right p₂)
+
+<:-∩-distr-∪ : ∀ {S T U} → ((S ∪ T) ∩ U) <:  ((S ∩ U) ∪ (T ∩ U))
+<:-∩-distr-∪ t (left p₁ , p₂) = left (p₁ , p₂)
+<:-∩-distr-∪ t (right p₁ , p₂) = right (p₁ , p₂)
+
+∩-distr-∪-<: : ∀ {S T U} → ((S ∩ U) ∪ (T ∩ U)) <: ((S ∪ T) ∩ U)
+∩-distr-∪-<: t (left (p₁ , p₂)) = (left p₁ , p₂)
+∩-distr-∪-<: t (right (p₁ , p₂)) = (right p₁ , p₂)
+
+<:-∪-distl-∩ : ∀ {S T U} → (S ∪ (T ∩ U)) <: ((S ∪ T) ∩ (S ∪ U))
+<:-∪-distl-∩ t (left p) = (left p , left p)
+<:-∪-distl-∩ t (right (p₁ , p₂)) = (right p₁ , right p₂)
+
+∪-distl-∩-<: : ∀ {S T U} → ((S ∪ T) ∩ (S ∪ U)) <: (S ∪ (T ∩ U))
+∪-distl-∩-<: t (left p₁ , p₂) = left p₁
+∪-distl-∩-<: t (right p₁ , left p₂) = left p₂
+∪-distl-∩-<: t (right p₁ , right p₂) = right (p₁ , p₂)
+
+<:-∪-distr-∩ : ∀ {S T U} → ((S ∩ T) ∪ U) <: ((S ∪ U) ∩ (T ∪ U))
+<:-∪-distr-∩ t (left (p₁ , p₂)) = left p₁ , left p₂
+<:-∪-distr-∩ t (right p) = (right p , right p)
+
+∪-distr-∩-<: : ∀ {S T U} → ((S ∪ U) ∩ (T ∪ U)) <: ((S ∩ T) ∪ U)
+∪-distr-∩-<: t (left p₁ , left p₂) = left (p₁ , p₂)
+∪-distr-∩-<: t (left p₁ , right p₂) = right p₂
+∪-distr-∩-<: t (right p₁ , p₂) = right p₁
+
+-- Properties of functions
+<:-function : ∀ {R S T U} → (R <: S) → (T <: U) → (S ⇒ T) <: (R ⇒ U)
+<:-function p q function function = function
+<:-function p q (function-ok t) (function-ok r) = function-ok (q t r)
+<:-function p q (function-err s) (function-err r) = function-err (<:-impl-⊇ p s r)
+
+<:-function-∩-∪ : ∀ {R S T U} → ((R ⇒ T) ∩ (S ⇒ U)) <: ((R ∪ S) ⇒ (T ∪ U))
+<:-function-∩-∪ function (function , function) = function
+<:-function-∩-∪ (function-ok t) (function-ok p₁ , function-ok p₂) = function-ok (right p₂)
+<:-function-∩-∪ (function-err _) (function-err p₁ , function-err q₂) = function-err (p₁ , q₂)
+
+<:-function-∩ : ∀ {S T U} → ((S ⇒ T) ∩ (S ⇒ U)) <: (S ⇒ (T ∩ U))
+<:-function-∩ function (function , function) = function
+<:-function-∩ (function-ok t) (function-ok p₁ , function-ok p₂) = function-ok (p₁ , p₂)
+<:-function-∩ (function-err s) (function-err p₁ , function-err p₂) = function-err p₂
+
+<:-function-∪ : ∀ {R S T U} → ((R ⇒ S) ∪ (T ⇒ U)) <: ((R ∩ T) ⇒ (S ∪ U))
+<:-function-∪ function (left function) = function
+<:-function-∪ (function-ok t) (left (function-ok p)) = function-ok (left p)
+<:-function-∪ (function-err s) (left (function-err p)) = function-err (left p)
+<:-function-∪ (scalar s) (left (scalar ()))
+<:-function-∪ function (right function) = function
+<:-function-∪ (function-ok t) (right (function-ok p)) = function-ok (right p)
+<:-function-∪ (function-err s) (right (function-err x)) = function-err (right x)
+<:-function-∪ (scalar s) (right (scalar ()))
+
+<:-function-∪-∩ : ∀ {R S T U} → ((R ∩ S) ⇒ (T ∪ U)) <: ((R ⇒ T) ∪ (S ⇒ U))
+<:-function-∪-∩ function function = left function
+<:-function-∪-∩ (function-ok t) (function-ok (left p)) = left (function-ok p)
+<:-function-∪-∩ (function-ok t) (function-ok (right p)) = right (function-ok p)
+<:-function-∪-∩ (function-err s) (function-err (left p)) = left (function-err p)
+<:-function-∪-∩ (function-err s) (function-err (right p)) = right (function-err p)
+
+≮:-function-left : ∀ {R S T U} → (R ≮: S) → (S ⇒ T) ≮: (R ⇒ U)
+≮:-function-left (witness t p q) = witness (function-err t) (function-err q) (function-err p)
+
+≮:-function-right : ∀ {R S T U} → (T ≮: U) → (S ⇒ T) ≮: (R ⇒ U)
+≮:-function-right (witness t p q) = witness (function-ok t) (function-ok p) (function-ok q)
 
 -- Properties of scalars
-skalar = number ∪ (string ∪ (nil ∪ boolean))
+skalar-function-ok : ∀ {t} → (¬Language skalar (function-ok t))
+skalar-function-ok = (scalar-function-ok number , (scalar-function-ok string , (scalar-function-ok nil , scalar-function-ok boolean)))
+
+scalar-<: : ∀ {S T} → (s : Scalar S) → Language T (scalar s) → (S <: T)
+scalar-<: number p (scalar number) (scalar number) = p
+scalar-<: boolean p (scalar boolean) (scalar boolean) = p
+scalar-<: string p (scalar string) (scalar string) = p
+scalar-<: nil p (scalar nil) (scalar nil) = p
+
+scalar-∩-function-<:-never : ∀ {S T U} → (Scalar S) → ((T ⇒ U) ∩ S) <: never
+scalar-∩-function-<:-never number .(scalar number) (() , scalar number)
+scalar-∩-function-<:-never boolean .(scalar boolean) (() , scalar boolean)
+scalar-∩-function-<:-never string .(scalar string) (() , scalar string)
+scalar-∩-function-<:-never nil .(scalar nil) (() , scalar nil)
 
 function-≮:-scalar : ∀ {S T U} → (Scalar U) → ((S ⇒ T) ≮: U)
 function-≮:-scalar s = witness function function (scalar-function s)
@@ -111,28 +269,8 @@ scalar-≮:-never s = witness (scalar s) (scalar s) never
 scalar-≢-impl-≮: : ∀ {T U} → (Scalar T) → (Scalar U) → (T ≢ U) → (T ≮: U)
 scalar-≢-impl-≮: s₁ s₂ p = witness (scalar s₁) (scalar s₁) (scalar-scalar s₁ s₂ p)
 
--- Properties of tgt
+scalar-≢-∩-<:-never : ∀ {T U V} → (Scalar T) → (Scalar U) → (T ≢ U) → (T ∩ U) <: V
-tgt-function-ok : ∀ {T t} → (Language (tgt T) t) → Language T (function-ok t)
+scalar-≢-∩-<:-never s t p u (scalar s₁ , scalar s₂) = CONTRADICTION (p refl)
-tgt-function-ok {T = nil} (scalar ())
-tgt-function-ok {T = T₁ ⇒ T₂} p = function-ok p
-tgt-function-ok {T = never} (scalar ())
-tgt-function-ok {T = unknown} p = unknown
-tgt-function-ok {T = boolean} (scalar ())
-tgt-function-ok {T = number} (scalar ())
-tgt-function-ok {T = string} (scalar ())
-tgt-function-ok {T = T₁ ∪ T₂} (left p) = left (tgt-function-ok p)
-tgt-function-ok {T = T₁ ∪ T₂} (right p) = right (tgt-function-ok p)
-tgt-function-ok {T = T₁ ∩ T₂} (p₁ , p₂) = (tgt-function-ok p₁ , tgt-function-ok p₂)
-
-function-ok-tgt : ∀ {T t} → Language T (function-ok t) → (Language (tgt T) t)
-function-ok-tgt (function-ok p) = p
-function-ok-tgt (left p) = left (function-ok-tgt p)
-function-ok-tgt (right p) = right (function-ok-tgt p)
-function-ok-tgt (p₁ , p₂) = (function-ok-tgt p₁ , function-ok-tgt p₂)
-function-ok-tgt unknown = unknown
-
-skalar-function-ok : ∀ {t} → (¬Language skalar (function-ok t))
-skalar-function-ok = (scalar-function-ok number , (scalar-function-ok string , (scalar-function-ok nil , scalar-function-ok boolean)))
 
 skalar-scalar : ∀ {T} (s : Scalar T) → (Language skalar (scalar s))
 skalar-scalar number = left (scalar number)
@@ -140,72 +278,6 @@ skalar-scalar boolean = right (right (right (scalar boolean)))
 skalar-scalar string = right (left (scalar string))
 skalar-scalar nil = right (right (left (scalar nil)))
 
-tgt-never-≮: : ∀ {T U} → (tgt T ≮: U) → (T ≮: (skalar ∪ (never ⇒ U)))
-tgt-never-≮: (witness t p q) = witness (function-ok t) (tgt-function-ok p) (skalar-function-ok , function-ok q)
-
-never-tgt-≮: : ∀ {T U} → (T ≮: (skalar ∪ (never ⇒ U))) → (tgt T ≮: U)
-never-tgt-≮: (witness (scalar s) p (q₁ , q₂)) = CONTRADICTION (≮:-refl (witness (scalar s) (skalar-scalar s) q₁))
-never-tgt-≮: (witness function p (q₁ , scalar-function ()))
-never-tgt-≮: (witness (function-ok t) p (q₁ , function-ok q₂)) = witness t (function-ok-tgt p) q₂
-never-tgt-≮: (witness (function-err (scalar s)) p (q₁ , function-err (scalar ())))
-
--- Properties of src
-function-err-src : ∀ {T t} → (¬Language (src T) t) → Language T (function-err t)
-function-err-src {T = nil} never = scalar-function-err nil
-function-err-src {T = T₁ ⇒ T₂} p = function-err p
-function-err-src {T = never} (scalar-scalar number () p)
-function-err-src {T = never} (scalar-function-ok ())
-function-err-src {T = unknown} never = unknown
-function-err-src {T = boolean} p = scalar-function-err boolean
-function-err-src {T = number} p = scalar-function-err number
-function-err-src {T = string} p = scalar-function-err string
-function-err-src {T = T₁ ∪ T₂} (left p) = left (function-err-src p)
-function-err-src {T = T₁ ∪ T₂} (right p) = right (function-err-src p)
-function-err-src {T = T₁ ∩ T₂} (p₁ , p₂) = function-err-src p₁ , function-err-src p₂
-
-¬function-err-src : ∀ {T t} → (Language (src T) t) → ¬Language T (function-err t)
-¬function-err-src {T = nil} (scalar ())
-¬function-err-src {T = T₁ ⇒ T₂} p = function-err p
-¬function-err-src {T = never} unknown = never
-¬function-err-src {T = unknown} (scalar ())
-¬function-err-src {T = boolean} (scalar ())
-¬function-err-src {T = number} (scalar ())
-¬function-err-src {T = string} (scalar ())
-¬function-err-src {T = T₁ ∪ T₂} (p₁ , p₂) = (¬function-err-src p₁ , ¬function-err-src p₂)
-¬function-err-src {T = T₁ ∩ T₂} (left p) = left (¬function-err-src p)
-¬function-err-src {T = T₁ ∩ T₂} (right p) = right (¬function-err-src p)
-
-src-¬function-err : ∀ {T t} → Language T (function-err t) → (¬Language (src T) t)
-src-¬function-err {T = nil} p = never
-src-¬function-err {T = T₁ ⇒ T₂} (function-err p) = p
-src-¬function-err {T = never} (scalar-function-err ())
-src-¬function-err {T = unknown} p = never
-src-¬function-err {T = boolean} p = never
-src-¬function-err {T = number} p = never
-src-¬function-err {T = string} p = never
-src-¬function-err {T = T₁ ∪ T₂} (left p) = left (src-¬function-err p)
-src-¬function-err {T = T₁ ∪ T₂} (right p) = right (src-¬function-err p)
-src-¬function-err {T = T₁ ∩ T₂} (p₁ , p₂) = (src-¬function-err p₁ , src-¬function-err p₂)
-
-src-¬scalar : ∀ {S T t} (s : Scalar S) → Language T (scalar s) → (¬Language (src T) t)
-src-¬scalar number (scalar number) = never
-src-¬scalar boolean (scalar boolean) = never
-src-¬scalar string (scalar string) = never
-src-¬scalar nil (scalar nil) = never
-src-¬scalar s (left p) = left (src-¬scalar s p)
-src-¬scalar s (right p) = right (src-¬scalar s p)
-src-¬scalar s (p₁ , p₂) = (src-¬scalar s p₁ , src-¬scalar s p₂)
-src-¬scalar s unknown = never
-
-src-unknown-≮: : ∀ {T U} → (T ≮: src U) → (U ≮: (T ⇒ unknown))
-src-unknown-≮: (witness t p q) = witness (function-err t) (function-err-src q) (¬function-err-src p)
-
-unknown-src-≮: : ∀ {S T U} → (U ≮: S) → (T ≮: (U ⇒ unknown)) → (U ≮: src T)
-unknown-src-≮: (witness t x x₁) (witness (scalar s) p (function-scalar s)) = witness t x (src-¬scalar s p)
-unknown-src-≮: r (witness (function-ok (scalar s)) p (function-ok (scalar-scalar s () q)))
-unknown-src-≮: r (witness (function-ok (function-ok _)) p (function-ok (scalar-function-ok ())))
-unknown-src-≮: r (witness (function-err t) p (function-err q)) = witness t q (src-¬function-err p)
-
 -- Properties of unknown and never
 unknown-≮: : ∀ {T U} → (T ≮: U) → (unknown ≮: U)
 unknown-≮: (witness t p q) = witness t unknown q
@@ -219,6 +291,28 @@ unknown-≮:-never = witness (scalar nil) unknown never
 function-≮:-never : ∀ {T U} → ((T ⇒ U) ≮: never)
 function-≮:-never = witness function function never
 
+<:-never : ∀ {T} → (never <: T)
+<:-never t (scalar ())
+
+≮:-never-left : ∀ {S T U} → (S <: (T ∪ U)) → (S ≮: T) → (S ∩ U) ≮: never
+≮:-never-left p (witness t q₁ q₂) with p t q₁
+≮:-never-left p (witness t q₁ q₂) | left r = CONTRADICTION (language-comp t q₂ r)
+≮:-never-left p (witness t q₁ q₂) | right r = witness t (q₁ , r) never
+
+≮:-never-right : ∀ {S T U} → (S <: (T ∪ U)) → (S ≮: U) → (S ∩ T) ≮: never
+≮:-never-right p (witness t q₁ q₂) with p t q₁
+≮:-never-right p (witness t q₁ q₂) | left r = witness t (q₁ , r) never
+≮:-never-right p (witness t q₁ q₂) | right r = CONTRADICTION (language-comp t q₂ r)
+
+<:-unknown : ∀ {T} → (T <: unknown)
+<:-unknown t p = unknown
+
+<:-everything : unknown <: ((never ⇒ unknown) ∪ skalar)
+<:-everything (scalar s) p = right (skalar-scalar s)
+<:-everything function p = left function
+<:-everything (function-ok t) p = left (function-ok unknown)
+<:-everything (function-err s) p = left (function-err never)
+
 -- A Gentle Introduction To Semantic Subtyping (https://www.cduce.org/papers/gentle.pdf)
 -- defines a "set-theoretic" model (sec 2.5)
 -- Unfortunately we don't quite have this property, due to uninhabited types,
@@ -234,13 +328,21 @@ _⊗_ : ∀ {A B : Set} → (A → Set) → (B → Set) → ((A × B) → Set)
 Comp : ∀ {A : Set} → (A → Set) → (A → Set)
 Comp P a = ¬(P a)
 
+Lift : ∀ {A : Set} → (A → Set) → (Maybe A → Set)
+Lift P nothing = ⊥
+Lift P (just a) = P a
+
 set-theoretic-if : ∀ {S₁ T₁ S₂ T₂} →
 
   -- This is the "if" part of being a set-theoretic model
+  -- though it uses the definition from Frisch's thesis
+  -- rather than from the Gentle Introduction. The difference
+  -- being the presence of Lift, (written D_Ω in Defn 4.2 of
+  -- https://www.cduce.org/papers/frisch_phd.pdf).
   (Language (S₁ ⇒ T₁) ⊆ Language (S₂ ⇒ T₂)) →
-  (∀ Q → Q ⊆ Comp((Language S₁) ⊗ Comp(Language T₁)) → Q ⊆ Comp((Language S₂) ⊗ Comp(Language T₂)))
+  (∀ Q → Q ⊆ Comp((Language S₁) ⊗ Comp(Lift(Language T₁))) → Q ⊆ Comp((Language S₂) ⊗ Comp(Lift(Language T₂))))
 
-set-theoretic-if {S₁} {T₁} {S₂} {T₂} p Q q (t , u) Qtu (S₂t , ¬T₂u) = q (t , u) Qtu (S₁t , ¬T₁u) where
+set-theoretic-if {S₁} {T₁} {S₂} {T₂} p Q q (t , just u) Qtu (S₂t , ¬T₂u) = q (t , just u) Qtu (S₁t , ¬T₁u) where
 
   S₁t : Language S₁ t
   S₁t with dec-language S₁ t
@@ -252,6 +354,14 @@ set-theoretic-if {S₁} {T₁} {S₂} {T₂} p Q q (t , u) Qtu (S₂t , ¬T₂u)
   ¬T₁u T₁u with p (function-ok u) (function-ok T₁u)
   ¬T₁u T₁u | function-ok T₂u = ¬T₂u T₂u
 
+set-theoretic-if {S₁} {T₁} {S₂} {T₂} p Q q (t , nothing) Qt- (S₂t , _) = q (t , nothing) Qt- (S₁t , λ ()) where
+
+  S₁t : Language S₁ t
+  S₁t with dec-language S₁ t
+  S₁t | Left ¬S₁t with p (function-err t) (function-err ¬S₁t)
+  S₁t | Left ¬S₁t | function-err ¬S₂t = CONTRADICTION (language-comp t ¬S₂t S₂t)
+  S₁t | Right r = r
+
 not-quite-set-theoretic-only-if : ∀ {S₁ T₁ S₂ T₂} →
 
   -- We don't quite have that this is a set-theoretic model
@@ -260,32 +370,33 @@ not-quite-set-theoretic-only-if : ∀ {S₁ T₁ S₂ T₂} →
   ∀ s₂ t₂ → Language S₂ s₂ → ¬Language T₂ t₂ →
 
   -- This is the "only if" part of being a set-theoretic model
-  (∀ Q → Q ⊆ Comp((Language S₁) ⊗ Comp(Language T₁)) → Q ⊆ Comp((Language S₂) ⊗ Comp(Language T₂))) →
+  (∀ Q → Q ⊆ Comp((Language S₁) ⊗ Comp(Lift(Language T₁))) → Q ⊆ Comp((Language S₂) ⊗ Comp(Lift(Language T₂)))) →
   (Language (S₁ ⇒ T₁) ⊆ Language (S₂ ⇒ T₂))
 
 not-quite-set-theoretic-only-if {S₁} {T₁} {S₂} {T₂} s₂ t₂ S₂s₂ ¬T₂t₂ p = r where
 
-  Q : (Tree × Tree) → Set
+  Q : (Tree × Maybe Tree) → Set
-  Q (t , u) = Either (¬Language S₁ t) (Language T₁ u)
+  Q (t , just u) = Either (¬Language S₁ t) (Language T₁ u)
+  Q (t , nothing) = ¬Language S₁ t
 
-  q : Q ⊆ Comp((Language S₁) ⊗ Comp(Language T₁))
+  q : Q ⊆ Comp((Language S₁) ⊗ Comp(Lift(Language T₁)))
-  q (t , u) (Left ¬S₁t) (S₁t , ¬T₁u) = language-comp t ¬S₁t S₁t
+  q (t , just u) (Left ¬S₁t) (S₁t , ¬T₁u) = language-comp t ¬S₁t S₁t
-  q (t , u) (Right T₂u) (S₁t , ¬T₁u) = ¬T₁u T₂u
+  q (t , just u) (Right T₂u) (S₁t , ¬T₁u) = ¬T₁u T₂u
+  q (t , nothing) ¬S₁t (S₁t , _) = language-comp t ¬S₁t S₁t
 
   r : Language (S₁ ⇒ T₁) ⊆ Language (S₂ ⇒ T₂)
   r function function = function
-  r (function-err t) (function-err ¬S₁t) with dec-language S₂ t
+  r (function-err s) (function-err ¬S₁s) with dec-language S₂ s
-  r (function-err t) (function-err ¬S₁t) | Left ¬S₂t = function-err ¬S₂t
+  r (function-err s) (function-err ¬S₁s) | Left ¬S₂s = function-err ¬S₂s
-  r (function-err t) (function-err ¬S₁t) | Right S₂t = CONTRADICTION (p Q q (t , t₂) (Left ¬S₁t) (S₂t , language-comp t₂ ¬T₂t₂))
+  r (function-err s) (function-err ¬S₁s) | Right S₂s = CONTRADICTION (p Q q (s , nothing) ¬S₁s (S₂s , λ ()))
   r (function-ok t) (function-ok T₁t) with dec-language T₂ t
-  r (function-ok t) (function-ok T₁t) | Left ¬T₂t = CONTRADICTION (p Q q (s₂ , t) (Right T₁t) (S₂s₂ ,  language-comp t ¬T₂t))
+  r (function-ok t) (function-ok T₁t) | Left ¬T₂t = CONTRADICTION (p Q q (s₂ , just t) (Right T₁t) (S₂s₂ , language-comp t ¬T₂t))
   r (function-ok t) (function-ok T₁t) | Right T₂t = function-ok T₂t
 
 -- A counterexample when the argument type is empty.
 
-set-theoretic-counterexample-one : (∀ Q → Q ⊆ Comp((Language never) ⊗ Comp(Language number)) → Q ⊆ Comp((Language never) ⊗ Comp(Language string)))
+set-theoretic-counterexample-one : (∀ Q → Q ⊆ Comp((Language never) ⊗ Comp(Lift(Language number))) → Q ⊆ Comp((Language never) ⊗ Comp(Lift(Language string))))
 set-theoretic-counterexample-one Q q ((scalar s) , u) Qtu (scalar () , p)
-set-theoretic-counterexample-one Q q ((function-err t) , u) Qtu (scalar-function-err () , p)
 
 set-theoretic-counterexample-two : (never ⇒ number) ≮: (never ⇒ string)
 set-theoretic-counterexample-two = witness

prototyping/Properties/TypeCheck.agda

@@ -8,7 +8,8 @@ open import FFI.Data.Maybe using (Maybe; just; nothing)
 open import FFI.Data.Either using (Either)
 open import Luau.TypeCheck using (_⊢ᴱ_∈_; _⊢ᴮ_∈_; ⊢ᴼ_; ⊢ᴴ_; _⊢ᴴᴱ_▷_∈_; _⊢ᴴᴮ_▷_∈_; nil; var; addr; number; bool; string; app; function; block; binexp; done; return; local; nothing; orUnknown; tgtBinOp)
 open import Luau.Syntax using (Block; Expr; Value; BinaryOperator; yes; nil; addr; number; bool; string; val; var; binexp; _$_; function_is_end; block_is_end; _∙_; return; done; local_←_; _⟨_⟩; _⟨_⟩∈_; var_∈_; name; fun; arg; +; -; *; /; <; >; ==; ~=; <=; >=)
-open import Luau.Type using (Type; nil; unknown; never; number; boolean; string; _⇒_; src; tgt)
+open import Luau.FunctionTypes using (src; tgt)
+open import Luau.Type using (Type; nil; unknown; never; number; boolean; string; _⇒_)
 open import Luau.RuntimeType using (RuntimeType; nil; number; function; string; valueType)
 open import Luau.VarCtxt using (VarCtxt; ∅; _↦_; _⊕_↦_; _⋒_; _⊝_) renaming (_[_] to _[_]ⱽ)
 open import Luau.Addr using (Addr)

prototyping/Properties/TypeNormalization.agda

@@ -0,0 +1,376 @@
+{-# OPTIONS --rewriting #-}
+
+module Properties.TypeNormalization where
+
+open import Luau.Type using (Type; Scalar; nil; number; string; boolean; never; unknown; _⇒_; _∪_; _∩_)
+open import Luau.Subtyping using (scalar-function-err)
+open import Luau.TypeNormalization using (_∪ⁿ_; _∩ⁿ_; _∪ᶠ_; _∪ⁿˢ_; _∩ⁿˢ_; normalize)
+open import Luau.Subtyping using (_<:_)
+open import Properties.Subtyping using (<:-trans; <:-refl; <:-unknown; <:-never; <:-∪-left; <:-∪-right; <:-∪-lub; <:-∩-left; <:-∩-right; <:-∩-glb; <:-∩-symm; <:-function; <:-function-∪-∩; <:-function-∩-∪; <:-function-∪; <:-everything; <:-union; <:-∪-assocl; <:-∪-assocr; <:-∪-symm; <:-intersect;  ∪-distl-∩-<:; ∪-distr-∩-<:; <:-∪-distr-∩; <:-∪-distl-∩; ∩-distl-∪-<:; <:-∩-distl-∪; <:-∩-distr-∪; scalar-∩-function-<:-never; scalar-≢-∩-<:-never)
+
+-- Notmal forms for types
+data FunType : Type → Set
+data Normal : Type → Set
+
+data FunType where
+  _⇒_ : ∀ {S T} → Normal S → Normal T → FunType (S ⇒ T)
+  _∩_ : ∀ {F G} → FunType F → FunType G → FunType (F ∩ G)
+
+data Normal where
+  never : Normal never
+  unknown : Normal unknown
+  _⇒_ : ∀ {S T} → Normal S → Normal T → Normal (S ⇒ T)
+  _∩_ : ∀ {F G} → FunType F → FunType G → Normal (F ∩ G)
+  _∪_ : ∀ {S T} → Normal S → Scalar T → Normal (S ∪ T)
+
+data OptScalar : Type → Set where
+  never : OptScalar never
+  number : OptScalar number
+  boolean : OptScalar boolean
+  string : OptScalar string
+  nil : OptScalar nil
+
+-- Normalization produces normal types
+normal : ∀ T → Normal (normalize T)
+normalᶠ : ∀ {F} → FunType F → Normal F
+normal-∪ⁿ : ∀ {S T} → Normal S → Normal T → Normal (S ∪ⁿ T)
+normal-∩ⁿ : ∀ {S T} → Normal S → Normal T → Normal (S ∩ⁿ T)
+normal-∪ⁿˢ : ∀ {S T} → Normal S → OptScalar T → Normal (S ∪ⁿˢ T)
+normal-∩ⁿˢ : ∀ {S T} → Normal S → Scalar T → OptScalar (S ∩ⁿˢ T)
+normal-∪ᶠ : ∀ {F G} → FunType F → FunType G → FunType (F ∪ᶠ G)
+
+normal nil = never ∪ nil
+normal (S ⇒ T) = normalᶠ ((normal S) ⇒ (normal T))
+normal never = never
+normal unknown = unknown
+normal boolean = never ∪ boolean
+normal number = never ∪ number
+normal string = never ∪ string
+normal (S ∪ T) = normal-∪ⁿ (normal S) (normal T)
+normal (S ∩ T) = normal-∩ⁿ (normal S) (normal T)
+
+normalᶠ (S ⇒ T) = S ⇒ T
+normalᶠ (F ∩ G) = F ∩ G
+
+normal-∪ⁿ S (T₁ ∪ T₂) = (normal-∪ⁿ S T₁) ∪ T₂
+normal-∪ⁿ S never = S
+normal-∪ⁿ S unknown = unknown
+normal-∪ⁿ never (T ⇒ U) = T ⇒ U
+normal-∪ⁿ never (G₁ ∩ G₂) = G₁ ∩ G₂
+normal-∪ⁿ unknown (T ⇒ U) = unknown
+normal-∪ⁿ unknown (G₁ ∩ G₂) = unknown
+normal-∪ⁿ (R ⇒ S) (T ⇒ U) = normalᶠ (normal-∪ᶠ (R ⇒ S) (T ⇒ U))
+normal-∪ⁿ (R ⇒ S) (G₁ ∩ G₂) = normalᶠ (normal-∪ᶠ (R ⇒ S) (G₁ ∩ G₂))
+normal-∪ⁿ (F₁ ∩ F₂) (T ⇒ U) = normalᶠ (normal-∪ᶠ (F₁ ∩ F₂) (T ⇒ U))
+normal-∪ⁿ (F₁ ∩ F₂) (G₁ ∩ G₂) = normalᶠ (normal-∪ᶠ (F₁ ∩ F₂) (G₁ ∩ G₂))
+normal-∪ⁿ (S₁ ∪ S₂) (T₁ ⇒ T₂) = normal-∪ⁿ S₁ (T₁ ⇒ T₂) ∪ S₂
+normal-∪ⁿ (S₁ ∪ S₂) (G₁ ∩ G₂) = normal-∪ⁿ S₁ (G₁ ∩ G₂) ∪ S₂
+
+normal-∩ⁿ S never = never
+normal-∩ⁿ S unknown = S
+normal-∩ⁿ S (T ∪ U) = normal-∪ⁿˢ (normal-∩ⁿ S T) (normal-∩ⁿˢ S U )
+normal-∩ⁿ never (T ⇒ U) = never
+normal-∩ⁿ unknown (T ⇒ U) = T ⇒ U
+normal-∩ⁿ (R ⇒ S) (T ⇒ U) = (R ⇒ S) ∩ (T ⇒ U)
+normal-∩ⁿ (R ∩ S) (T ⇒ U) = (R ∩ S) ∩ (T ⇒ U)
+normal-∩ⁿ (R ∪ S) (T ⇒ U) = normal-∩ⁿ R (T ⇒ U)
+normal-∩ⁿ never (T ∩ U) = never
+normal-∩ⁿ unknown (T ∩ U) = T ∩ U
+normal-∩ⁿ (R ⇒ S) (T ∩ U) = (R ⇒ S) ∩ (T ∩ U)
+normal-∩ⁿ (R ∩ S) (T ∩ U) = (R ∩ S) ∩ (T ∩ U)
+normal-∩ⁿ (R ∪ S) (T ∩ U) = normal-∩ⁿ R (T ∩ U)
+
+normal-∪ⁿˢ S never = S
+normal-∪ⁿˢ never number = never ∪ number
+normal-∪ⁿˢ unknown number = unknown
+normal-∪ⁿˢ (R ⇒ S) number = (R ⇒ S) ∪ number
+normal-∪ⁿˢ (R ∩ S) number = (R ∩ S) ∪ number
+normal-∪ⁿˢ (R ∪ number) number = R ∪ number
+normal-∪ⁿˢ (R ∪ boolean) number = normal-∪ⁿˢ R number ∪ boolean
+normal-∪ⁿˢ (R ∪ string) number = normal-∪ⁿˢ R number ∪ string
+normal-∪ⁿˢ (R ∪ nil) number = normal-∪ⁿˢ R number ∪ nil
+normal-∪ⁿˢ never boolean = never ∪ boolean
+normal-∪ⁿˢ unknown boolean = unknown
+normal-∪ⁿˢ (R ⇒ S) boolean = (R ⇒ S) ∪ boolean
+normal-∪ⁿˢ (R ∩ S) boolean = (R ∩ S) ∪ boolean
+normal-∪ⁿˢ (R ∪ number) boolean = normal-∪ⁿˢ R boolean ∪ number
+normal-∪ⁿˢ (R ∪ boolean) boolean = R ∪ boolean
+normal-∪ⁿˢ (R ∪ string) boolean = normal-∪ⁿˢ R boolean ∪ string
+normal-∪ⁿˢ (R ∪ nil) boolean = normal-∪ⁿˢ R boolean ∪ nil
+normal-∪ⁿˢ never string = never ∪ string
+normal-∪ⁿˢ unknown string = unknown
+normal-∪ⁿˢ (R ⇒ S) string = (R ⇒ S) ∪ string
+normal-∪ⁿˢ (R ∩ S) string = (R ∩ S) ∪ string
+normal-∪ⁿˢ (R ∪ number) string = normal-∪ⁿˢ R string ∪ number
+normal-∪ⁿˢ (R ∪ boolean) string = normal-∪ⁿˢ R string ∪ boolean
+normal-∪ⁿˢ (R ∪ string) string = R ∪ string
+normal-∪ⁿˢ (R ∪ nil) string = normal-∪ⁿˢ R string ∪ nil
+normal-∪ⁿˢ never nil = never ∪ nil
+normal-∪ⁿˢ unknown nil = unknown
+normal-∪ⁿˢ (R ⇒ S) nil = (R ⇒ S) ∪ nil
+normal-∪ⁿˢ (R ∩ S) nil = (R ∩ S) ∪ nil
+normal-∪ⁿˢ (R ∪ number) nil = normal-∪ⁿˢ R nil ∪ number
+normal-∪ⁿˢ (R ∪ boolean) nil = normal-∪ⁿˢ R nil ∪ boolean
+normal-∪ⁿˢ (R ∪ string) nil = normal-∪ⁿˢ R nil ∪ string
+normal-∪ⁿˢ (R ∪ nil) nil = R ∪ nil
+
+normal-∩ⁿˢ never number = never
+normal-∩ⁿˢ never boolean = never
+normal-∩ⁿˢ never string = never
+normal-∩ⁿˢ never nil = never
+normal-∩ⁿˢ unknown number = number
+normal-∩ⁿˢ unknown boolean = boolean
+normal-∩ⁿˢ unknown string = string
+normal-∩ⁿˢ unknown nil = nil
+normal-∩ⁿˢ (R ⇒ S) number = never
+normal-∩ⁿˢ (R ⇒ S) boolean = never
+normal-∩ⁿˢ (R ⇒ S) string = never
+normal-∩ⁿˢ (R ⇒ S) nil = never
+normal-∩ⁿˢ (R ∩ S) number = never
+normal-∩ⁿˢ (R ∩ S) boolean = never
+normal-∩ⁿˢ (R ∩ S) string = never
+normal-∩ⁿˢ (R ∩ S) nil = never
+normal-∩ⁿˢ (R ∪ number) number = number
+normal-∩ⁿˢ (R ∪ boolean) number = normal-∩ⁿˢ R number
+normal-∩ⁿˢ (R ∪ string) number = normal-∩ⁿˢ R number
+normal-∩ⁿˢ (R ∪ nil) number = normal-∩ⁿˢ R number
+normal-∩ⁿˢ (R ∪ number) boolean = normal-∩ⁿˢ R boolean
+normal-∩ⁿˢ (R ∪ boolean) boolean = boolean
+normal-∩ⁿˢ (R ∪ string) boolean = normal-∩ⁿˢ R boolean
+normal-∩ⁿˢ (R ∪ nil) boolean = normal-∩ⁿˢ R boolean
+normal-∩ⁿˢ (R ∪ number) string = normal-∩ⁿˢ R string
+normal-∩ⁿˢ (R ∪ boolean) string = normal-∩ⁿˢ R string
+normal-∩ⁿˢ (R ∪ string) string = string
+normal-∩ⁿˢ (R ∪ nil) string = normal-∩ⁿˢ R string
+normal-∩ⁿˢ (R ∪ number) nil = normal-∩ⁿˢ R nil
+normal-∩ⁿˢ (R ∪ boolean) nil = normal-∩ⁿˢ R nil
+normal-∩ⁿˢ (R ∪ string) nil = normal-∩ⁿˢ R nil
+normal-∩ⁿˢ (R ∪ nil) nil = nil
+
+normal-∪ᶠ (R ⇒ S) (T ⇒ U) = (normal-∩ⁿ R T) ⇒ (normal-∪ⁿ S U)
+normal-∪ᶠ (R ⇒ S) (G ∩ H) = normal-∪ᶠ (R ⇒ S) G ∩ normal-∪ᶠ (R ⇒ S) H
+normal-∪ᶠ (E ∩ F) G = normal-∪ᶠ E G ∩ normal-∪ᶠ F G
+
+scalar-∩-fun-<:-never : ∀ {F S} → FunType F → Scalar S → (F ∩ S) <: never
+scalar-∩-fun-<:-never (T ⇒ U) S = scalar-∩-function-<:-never S
+scalar-∩-fun-<:-never (F ∩ G) S = <:-trans (<:-intersect <:-∩-left <:-refl) (scalar-∩-fun-<:-never F S)
+
+flipper : ∀ {S T U} → ((S ∪ T) ∪ U) <: ((S ∪ U) ∪ T)
+flipper = <:-trans <:-∪-assocr (<:-trans (<:-union <:-refl <:-∪-symm) <:-∪-assocl)
+
+∩-<:-∩ⁿ :  ∀ {S T} → Normal S → Normal T → (S ∩ T) <: (S ∩ⁿ T)
+∩ⁿ-<:-∩ :  ∀ {S T} → Normal S → Normal T → (S ∩ⁿ T) <: (S ∩ T)
+∩-<:-∩ⁿˢ :  ∀ {S T} → Normal S → Scalar T → (S ∩ T) <: (S ∩ⁿˢ T)
+∩ⁿˢ-<:-∩ :  ∀ {S T} → Normal S → Scalar T → (S ∩ⁿˢ T) <: (S ∩ T)
+∪ᶠ-<:-∪ : ∀ {F G} → FunType F → FunType G → (F ∪ᶠ G) <: (F ∪ G)
+∪ⁿ-<:-∪ : ∀ {S T} → Normal S → Normal T → (S ∪ⁿ T) <: (S ∪ T)
+∪-<:-∪ⁿ : ∀ {S T} → Normal S → Normal T → (S ∪ T) <: (S ∪ⁿ T)
+∪ⁿˢ-<:-∪ : ∀ {S T} → Normal S → OptScalar T → (S ∪ⁿˢ T) <: (S ∪ T)
+∪-<:-∪ⁿˢ : ∀ {S T} → Normal S → OptScalar T → (S ∪ T) <: (S ∪ⁿˢ T)
+
+∩-<:-∩ⁿ S never = <:-∩-right
+∩-<:-∩ⁿ S unknown = <:-∩-left
+∩-<:-∩ⁿ S (T ∪ U) = <:-trans <:-∩-distl-∪ (<:-trans (<:-union (∩-<:-∩ⁿ S T) (∩-<:-∩ⁿˢ S U)) (∪-<:-∪ⁿˢ (normal-∩ⁿ S T) (normal-∩ⁿˢ S U)) )
+∩-<:-∩ⁿ never (T ⇒ U) = <:-∩-left
+∩-<:-∩ⁿ unknown (T ⇒ U) = <:-∩-right
+∩-<:-∩ⁿ (R ⇒ S) (T ⇒ U) = <:-refl
+∩-<:-∩ⁿ (R ∩ S) (T ⇒ U) = <:-refl
+∩-<:-∩ⁿ (R ∪ S) (T ⇒ U) = <:-trans <:-∩-distr-∪ (<:-trans (<:-union (∩-<:-∩ⁿ R (T ⇒ U)) (<:-trans <:-∩-symm (∩-<:-∩ⁿˢ (T ⇒ U) S))) (<:-∪-lub <:-refl <:-never))
+∩-<:-∩ⁿ never (T ∩ U) = <:-∩-left
+∩-<:-∩ⁿ unknown (T ∩ U) = <:-∩-right
+∩-<:-∩ⁿ (R ⇒ S) (T ∩ U) = <:-refl
+∩-<:-∩ⁿ (R ∩ S) (T ∩ U) = <:-refl
+∩-<:-∩ⁿ (R ∪ S) (T ∩ U) = <:-trans <:-∩-distr-∪ (<:-trans (<:-union (∩-<:-∩ⁿ R (T ∩ U)) (<:-trans <:-∩-symm (∩-<:-∩ⁿˢ (T ∩ U) S))) (<:-∪-lub <:-refl <:-never))
+
+∩ⁿ-<:-∩ S never = <:-never
+∩ⁿ-<:-∩ S unknown = <:-∩-glb <:-refl <:-unknown
+∩ⁿ-<:-∩ S (T ∪ U) = <:-trans (∪ⁿˢ-<:-∪ (normal-∩ⁿ S T) (normal-∩ⁿˢ S U)) (<:-trans (<:-union (∩ⁿ-<:-∩ S T) (∩ⁿˢ-<:-∩ S U)) ∩-distl-∪-<:)
+∩ⁿ-<:-∩ never (T ⇒ U) = <:-never
+∩ⁿ-<:-∩ unknown (T ⇒ U) = <:-∩-glb <:-unknown <:-refl
+∩ⁿ-<:-∩ (R ⇒ S) (T ⇒ U) = <:-refl
+∩ⁿ-<:-∩ (R ∩ S) (T ⇒ U) = <:-refl
+∩ⁿ-<:-∩ (R ∪ S) (T ⇒ U) = <:-trans (∩ⁿ-<:-∩ R (T ⇒ U)) (<:-∩-glb (<:-trans <:-∩-left <:-∪-left) <:-∩-right)
+∩ⁿ-<:-∩ never (T ∩ U) = <:-never
+∩ⁿ-<:-∩ unknown (T ∩ U) = <:-∩-glb <:-unknown <:-refl
+∩ⁿ-<:-∩ (R ⇒ S) (T ∩ U) = <:-refl
+∩ⁿ-<:-∩ (R ∩ S) (T ∩ U) = <:-refl
+∩ⁿ-<:-∩ (R ∪ S) (T ∩ U) = <:-trans (∩ⁿ-<:-∩ R (T ∩ U)) (<:-∩-glb (<:-trans <:-∩-left <:-∪-left) <:-∩-right)
+
+∩-<:-∩ⁿˢ never number = <:-∩-left
+∩-<:-∩ⁿˢ never boolean = <:-∩-left
+∩-<:-∩ⁿˢ never string = <:-∩-left
+∩-<:-∩ⁿˢ never nil = <:-∩-left
+∩-<:-∩ⁿˢ unknown T = <:-∩-right
+∩-<:-∩ⁿˢ (R ⇒ S) T = scalar-∩-fun-<:-never (R ⇒ S) T
+∩-<:-∩ⁿˢ (F ∩ G) T = scalar-∩-fun-<:-never (F ∩ G) T
+∩-<:-∩ⁿˢ (R ∪ number) number = <:-∩-right
+∩-<:-∩ⁿˢ (R ∪ boolean) number = <:-trans <:-∩-distr-∪ (<:-∪-lub (∩-<:-∩ⁿˢ R number) (scalar-≢-∩-<:-never boolean number (λ ())))
+∩-<:-∩ⁿˢ (R ∪ string) number = <:-trans <:-∩-distr-∪ (<:-∪-lub (∩-<:-∩ⁿˢ R number) (scalar-≢-∩-<:-never string number (λ ())))
+∩-<:-∩ⁿˢ (R ∪ nil) number = <:-trans <:-∩-distr-∪ (<:-∪-lub (∩-<:-∩ⁿˢ R number) (scalar-≢-∩-<:-never nil number (λ ())))
+∩-<:-∩ⁿˢ (R ∪ number) boolean = <:-trans <:-∩-distr-∪ (<:-∪-lub (∩-<:-∩ⁿˢ R boolean) (scalar-≢-∩-<:-never number boolean (λ ())))
+∩-<:-∩ⁿˢ (R ∪ boolean) boolean = <:-∩-right
+∩-<:-∩ⁿˢ (R ∪ string) boolean = <:-trans <:-∩-distr-∪ (<:-∪-lub (∩-<:-∩ⁿˢ R boolean) (scalar-≢-∩-<:-never string boolean (λ ())))
+∩-<:-∩ⁿˢ (R ∪ nil) boolean = <:-trans <:-∩-distr-∪ (<:-∪-lub (∩-<:-∩ⁿˢ R boolean) (scalar-≢-∩-<:-never nil boolean (λ ())))
+∩-<:-∩ⁿˢ (R ∪ number) string = <:-trans <:-∩-distr-∪ (<:-∪-lub (∩-<:-∩ⁿˢ R string) (scalar-≢-∩-<:-never number string (λ ())))
+∩-<:-∩ⁿˢ (R ∪ boolean) string = <:-trans <:-∩-distr-∪ (<:-∪-lub (∩-<:-∩ⁿˢ R string) (scalar-≢-∩-<:-never boolean string (λ ())))
+∩-<:-∩ⁿˢ (R ∪ string) string = <:-∩-right
+∩-<:-∩ⁿˢ (R ∪ nil) string = <:-trans <:-∩-distr-∪ (<:-∪-lub (∩-<:-∩ⁿˢ R string) (scalar-≢-∩-<:-never nil string (λ ())))
+∩-<:-∩ⁿˢ (R ∪ number) nil = <:-trans <:-∩-distr-∪ (<:-∪-lub (∩-<:-∩ⁿˢ R nil) (scalar-≢-∩-<:-never number nil (λ ())))
+∩-<:-∩ⁿˢ (R ∪ boolean) nil = <:-trans <:-∩-distr-∪ (<:-∪-lub (∩-<:-∩ⁿˢ R nil) (scalar-≢-∩-<:-never boolean nil (λ ())))
+∩-<:-∩ⁿˢ (R ∪ string) nil = <:-trans <:-∩-distr-∪ (<:-∪-lub (∩-<:-∩ⁿˢ R nil) (scalar-≢-∩-<:-never string nil (λ ())))
+∩-<:-∩ⁿˢ (R ∪ nil) nil = <:-∩-right
+
+∩ⁿˢ-<:-∩ never T = <:-never
+∩ⁿˢ-<:-∩ unknown T = <:-∩-glb <:-unknown <:-refl
+∩ⁿˢ-<:-∩ (R ⇒ S) T = <:-never
+∩ⁿˢ-<:-∩ (F ∩ G) T = <:-never
+∩ⁿˢ-<:-∩ (R ∪ number) number = <:-∩-glb <:-∪-right <:-refl
+∩ⁿˢ-<:-∩ (R ∪ boolean) number = <:-trans (∩ⁿˢ-<:-∩ R number) (<:-intersect <:-∪-left <:-refl)
+∩ⁿˢ-<:-∩ (R ∪ string) number = <:-trans (∩ⁿˢ-<:-∩ R number) (<:-intersect <:-∪-left <:-refl)
+∩ⁿˢ-<:-∩ (R ∪ nil) number = <:-trans (∩ⁿˢ-<:-∩ R number) (<:-intersect <:-∪-left <:-refl)
+∩ⁿˢ-<:-∩ (R ∪ number) boolean = <:-trans (∩ⁿˢ-<:-∩ R boolean) (<:-intersect <:-∪-left <:-refl)
+∩ⁿˢ-<:-∩ (R ∪ boolean) boolean = <:-∩-glb <:-∪-right <:-refl
+∩ⁿˢ-<:-∩ (R ∪ string) boolean = <:-trans (∩ⁿˢ-<:-∩ R boolean) (<:-intersect <:-∪-left <:-refl)
+∩ⁿˢ-<:-∩ (R ∪ nil) boolean = <:-trans (∩ⁿˢ-<:-∩ R boolean) (<:-intersect <:-∪-left <:-refl)
+∩ⁿˢ-<:-∩ (R ∪ number) string = <:-trans (∩ⁿˢ-<:-∩ R string) (<:-intersect <:-∪-left <:-refl)
+∩ⁿˢ-<:-∩ (R ∪ boolean) string = <:-trans (∩ⁿˢ-<:-∩ R string) (<:-intersect <:-∪-left <:-refl)
+∩ⁿˢ-<:-∩ (R ∪ string) string = <:-∩-glb <:-∪-right <:-refl
+∩ⁿˢ-<:-∩ (R ∪ nil) string = <:-trans (∩ⁿˢ-<:-∩ R string) (<:-intersect <:-∪-left <:-refl)
+∩ⁿˢ-<:-∩ (R ∪ number) nil = <:-trans (∩ⁿˢ-<:-∩ R nil) (<:-intersect <:-∪-left <:-refl)
+∩ⁿˢ-<:-∩ (R ∪ boolean) nil = <:-trans (∩ⁿˢ-<:-∩ R nil) (<:-intersect <:-∪-left <:-refl)
+∩ⁿˢ-<:-∩ (R ∪ string) nil = <:-trans (∩ⁿˢ-<:-∩ R nil) (<:-intersect <:-∪-left <:-refl)
+∩ⁿˢ-<:-∩ (R ∪ nil) nil = <:-∩-glb <:-∪-right <:-refl
+
+∪ᶠ-<:-∪ (R ⇒ S) (T ⇒ U) = <:-trans (<:-function (∩-<:-∩ⁿ R T) (∪ⁿ-<:-∪ S U)) <:-function-∪-∩
+∪ᶠ-<:-∪ (R ⇒ S) (G ∩ H) = <:-trans (<:-intersect (∪ᶠ-<:-∪ (R ⇒ S) G) (∪ᶠ-<:-∪ (R ⇒ S) H)) ∪-distl-∩-<:
+∪ᶠ-<:-∪ (E ∩ F) G = <:-trans (<:-intersect (∪ᶠ-<:-∪ E G) (∪ᶠ-<:-∪ F G)) ∪-distr-∩-<:
+
+∪-<:-∪ᶠ : ∀ {F G} → FunType F → FunType G → (F ∪ G) <: (F ∪ᶠ G)
+∪-<:-∪ᶠ (R ⇒ S) (T ⇒ U) = <:-trans <:-function-∪ (<:-function (∩ⁿ-<:-∩ R T) (∪-<:-∪ⁿ S U))
+∪-<:-∪ᶠ (R ⇒ S) (G ∩ H) = <:-trans <:-∪-distl-∩ (<:-intersect (∪-<:-∪ᶠ (R ⇒ S) G) (∪-<:-∪ᶠ (R ⇒ S) H))
+∪-<:-∪ᶠ (E ∩ F) G = <:-trans <:-∪-distr-∩ (<:-intersect (∪-<:-∪ᶠ E G) (∪-<:-∪ᶠ F G))
+
+∪ⁿˢ-<:-∪ S never = <:-∪-left
+∪ⁿˢ-<:-∪ never number = <:-refl
+∪ⁿˢ-<:-∪ never boolean = <:-refl
+∪ⁿˢ-<:-∪ never string = <:-refl
+∪ⁿˢ-<:-∪ never nil = <:-refl
+∪ⁿˢ-<:-∪ unknown number = <:-∪-left
+∪ⁿˢ-<:-∪ unknown boolean = <:-∪-left
+∪ⁿˢ-<:-∪ unknown string = <:-∪-left
+∪ⁿˢ-<:-∪ unknown nil = <:-∪-left
+∪ⁿˢ-<:-∪ (R ⇒ S) number = <:-refl
+∪ⁿˢ-<:-∪ (R ⇒ S) boolean = <:-refl
+∪ⁿˢ-<:-∪ (R ⇒ S) string = <:-refl
+∪ⁿˢ-<:-∪ (R ⇒ S) nil = <:-refl
+∪ⁿˢ-<:-∪ (R ∩ S) number = <:-refl
+∪ⁿˢ-<:-∪ (R ∩ S) boolean = <:-refl
+∪ⁿˢ-<:-∪ (R ∩ S) string = <:-refl
+∪ⁿˢ-<:-∪ (R ∩ S) nil = <:-refl
+∪ⁿˢ-<:-∪ (R ∪ number) number = <:-union <:-∪-left <:-refl
+∪ⁿˢ-<:-∪ (R ∪ boolean) number = <:-trans (<:-union (∪ⁿˢ-<:-∪ R number) <:-refl) flipper
+∪ⁿˢ-<:-∪ (R ∪ string) number = <:-trans (<:-union (∪ⁿˢ-<:-∪ R number) <:-refl) flipper
+∪ⁿˢ-<:-∪ (R ∪ nil) number = <:-trans (<:-union (∪ⁿˢ-<:-∪ R number) <:-refl) flipper
+∪ⁿˢ-<:-∪ (R ∪ number) boolean = <:-trans (<:-union (∪ⁿˢ-<:-∪ R boolean) <:-refl) flipper
+∪ⁿˢ-<:-∪ (R ∪ boolean) boolean = <:-union <:-∪-left <:-refl
+∪ⁿˢ-<:-∪ (R ∪ string) boolean = <:-trans (<:-union (∪ⁿˢ-<:-∪ R boolean) <:-refl) flipper
+∪ⁿˢ-<:-∪ (R ∪ nil) boolean = <:-trans (<:-union (∪ⁿˢ-<:-∪ R boolean) <:-refl) flipper
+∪ⁿˢ-<:-∪ (R ∪ number) string = <:-trans (<:-union (∪ⁿˢ-<:-∪ R string) <:-refl) flipper
+∪ⁿˢ-<:-∪ (R ∪ boolean) string = <:-trans (<:-union (∪ⁿˢ-<:-∪ R string) <:-refl) flipper
+∪ⁿˢ-<:-∪ (R ∪ string) string = <:-union <:-∪-left <:-refl
+∪ⁿˢ-<:-∪ (R ∪ nil) string = <:-trans (<:-union (∪ⁿˢ-<:-∪ R string) <:-refl) flipper
+∪ⁿˢ-<:-∪ (R ∪ number) nil = <:-trans (<:-union (∪ⁿˢ-<:-∪ R nil) <:-refl) flipper
+∪ⁿˢ-<:-∪ (R ∪ boolean) nil = <:-trans (<:-union (∪ⁿˢ-<:-∪ R nil) <:-refl) flipper
+∪ⁿˢ-<:-∪ (R ∪ string) nil = <:-trans (<:-union (∪ⁿˢ-<:-∪ R nil) <:-refl) flipper
+∪ⁿˢ-<:-∪ (R ∪ nil) nil = <:-union <:-∪-left <:-refl
+
+∪-<:-∪ⁿˢ T never = <:-∪-lub <:-refl <:-never
+∪-<:-∪ⁿˢ never number = <:-refl
+∪-<:-∪ⁿˢ never boolean = <:-refl
+∪-<:-∪ⁿˢ never string = <:-refl
+∪-<:-∪ⁿˢ never nil = <:-refl
+∪-<:-∪ⁿˢ unknown number = <:-unknown
+∪-<:-∪ⁿˢ unknown boolean = <:-unknown
+∪-<:-∪ⁿˢ unknown string = <:-unknown
+∪-<:-∪ⁿˢ unknown nil = <:-unknown
+∪-<:-∪ⁿˢ (R ⇒ S) number = <:-refl
+∪-<:-∪ⁿˢ (R ⇒ S) boolean = <:-refl
+∪-<:-∪ⁿˢ (R ⇒ S) string = <:-refl
+∪-<:-∪ⁿˢ (R ⇒ S) nil = <:-refl
+∪-<:-∪ⁿˢ (R ∩ S) number = <:-refl
+∪-<:-∪ⁿˢ (R ∩ S) boolean = <:-refl
+∪-<:-∪ⁿˢ (R ∩ S) string = <:-refl
+∪-<:-∪ⁿˢ (R ∩ S) nil = <:-refl
+∪-<:-∪ⁿˢ (R ∪ number) number = <:-∪-lub <:-refl <:-∪-right
+∪-<:-∪ⁿˢ (R ∪ boolean) number = <:-trans flipper (<:-union (∪-<:-∪ⁿˢ R number) <:-refl)
+∪-<:-∪ⁿˢ (R ∪ string) number = <:-trans flipper (<:-union (∪-<:-∪ⁿˢ R number) <:-refl)
+∪-<:-∪ⁿˢ (R ∪ nil) number = <:-trans flipper (<:-union (∪-<:-∪ⁿˢ R number) <:-refl)
+∪-<:-∪ⁿˢ (R ∪ number) boolean = <:-trans flipper (<:-union (∪-<:-∪ⁿˢ R boolean) <:-refl)
+∪-<:-∪ⁿˢ (R ∪ boolean) boolean = <:-∪-lub <:-refl <:-∪-right
+∪-<:-∪ⁿˢ (R ∪ string) boolean = <:-trans flipper (<:-union (∪-<:-∪ⁿˢ R boolean) <:-refl)
+∪-<:-∪ⁿˢ (R ∪ nil) boolean = <:-trans flipper (<:-union (∪-<:-∪ⁿˢ R boolean) <:-refl)
+∪-<:-∪ⁿˢ (R ∪ number) string = <:-trans flipper (<:-union (∪-<:-∪ⁿˢ R string) <:-refl)
+∪-<:-∪ⁿˢ (R ∪ boolean) string = <:-trans flipper (<:-union (∪-<:-∪ⁿˢ R string) <:-refl)
+∪-<:-∪ⁿˢ (R ∪ string) string = <:-∪-lub <:-refl <:-∪-right
+∪-<:-∪ⁿˢ (R ∪ nil) string = <:-trans flipper (<:-union (∪-<:-∪ⁿˢ R string) <:-refl)
+∪-<:-∪ⁿˢ (R ∪ number) nil = <:-trans flipper (<:-union (∪-<:-∪ⁿˢ R nil) <:-refl)
+∪-<:-∪ⁿˢ (R ∪ boolean) nil = <:-trans flipper (<:-union (∪-<:-∪ⁿˢ R nil) <:-refl)
+∪-<:-∪ⁿˢ (R ∪ string) nil = <:-trans flipper (<:-union (∪-<:-∪ⁿˢ R nil) <:-refl)
+∪-<:-∪ⁿˢ (R ∪ nil) nil = <:-∪-lub <:-refl <:-∪-right
+
+∪ⁿ-<:-∪ S never = <:-∪-left
+∪ⁿ-<:-∪ S unknown = <:-∪-right
+∪ⁿ-<:-∪ never (T ⇒ U) = <:-∪-right
+∪ⁿ-<:-∪ unknown (T ⇒ U) = <:-∪-left
+∪ⁿ-<:-∪ (R ⇒ S) (T ⇒ U) = ∪ᶠ-<:-∪ (R ⇒ S) (T ⇒ U)
+∪ⁿ-<:-∪ (R ∩ S) (T ⇒ U) = ∪ᶠ-<:-∪ (R ∩ S) (T ⇒ U)
+∪ⁿ-<:-∪ (R ∪ S) (T ⇒ U) = <:-trans (<:-union (∪ⁿ-<:-∪ R (T ⇒ U)) <:-refl) (<:-∪-lub (<:-∪-lub (<:-trans <:-∪-left <:-∪-left) <:-∪-right) (<:-trans <:-∪-right <:-∪-left))
+∪ⁿ-<:-∪ never (T ∩ U) = <:-∪-right
+∪ⁿ-<:-∪ unknown (T ∩ U) = <:-∪-left
+∪ⁿ-<:-∪ (R ⇒ S) (T ∩ U) = ∪ᶠ-<:-∪ (R ⇒ S) (T ∩ U)
+∪ⁿ-<:-∪ (R ∩ S) (T ∩ U) = ∪ᶠ-<:-∪ (R ∩ S) (T ∩ U)
+∪ⁿ-<:-∪ (R ∪ S) (T ∩ U) = <:-trans (<:-union (∪ⁿ-<:-∪ R (T ∩ U)) <:-refl) (<:-∪-lub (<:-∪-lub (<:-trans <:-∪-left <:-∪-left) <:-∪-right) (<:-trans <:-∪-right <:-∪-left))
+∪ⁿ-<:-∪ S (T ∪ U) = <:-∪-lub (<:-trans (∪ⁿ-<:-∪ S T) (<:-union <:-refl <:-∪-left)) (<:-trans <:-∪-right <:-∪-right)
+
+∪-<:-∪ⁿ S never = <:-∪-lub <:-refl <:-never
+∪-<:-∪ⁿ S unknown = <:-unknown
+∪-<:-∪ⁿ never (T ⇒ U) = <:-∪-lub <:-never <:-refl
+∪-<:-∪ⁿ unknown (T ⇒ U) = <:-unknown
+∪-<:-∪ⁿ (R ⇒ S) (T ⇒ U) = ∪-<:-∪ᶠ (R ⇒ S) (T ⇒ U)
+∪-<:-∪ⁿ (R ∩ S) (T ⇒ U) = ∪-<:-∪ᶠ (R ∩ S) (T ⇒ U)
+∪-<:-∪ⁿ (R ∪ S) (T ⇒ U) =  <:-trans <:-∪-assocr (<:-trans (<:-union <:-refl <:-∪-symm) (<:-trans <:-∪-assocl (<:-union (∪-<:-∪ⁿ R (T ⇒ U)) <:-refl)))
+∪-<:-∪ⁿ never (T ∩ U) = <:-∪-lub <:-never <:-refl
+∪-<:-∪ⁿ unknown (T ∩ U) = <:-unknown
+∪-<:-∪ⁿ (R ⇒ S) (T ∩ U) = ∪-<:-∪ᶠ (R ⇒ S) (T ∩ U)
+∪-<:-∪ⁿ (R ∩ S) (T ∩ U) = ∪-<:-∪ᶠ (R ∩ S) (T ∩ U)
+∪-<:-∪ⁿ (R ∪ S) (T ∩ U) = <:-trans <:-∪-assocr (<:-trans (<:-union <:-refl <:-∪-symm) (<:-trans <:-∪-assocl (<:-union (∪-<:-∪ⁿ R (T ∩ U)) <:-refl)))
+∪-<:-∪ⁿ never (T ∪ U) = <:-trans <:-∪-assocl (<:-union (∪-<:-∪ⁿ never T) <:-refl)
+∪-<:-∪ⁿ unknown (T ∪ U) = <:-trans <:-∪-assocl (<:-union (∪-<:-∪ⁿ unknown T) <:-refl)
+∪-<:-∪ⁿ (R ⇒ S) (T ∪ U) = <:-trans <:-∪-assocl (<:-union (∪-<:-∪ⁿ (R ⇒ S) T) <:-refl)
+∪-<:-∪ⁿ (R ∩ S) (T ∪ U) = <:-trans <:-∪-assocl (<:-union (∪-<:-∪ⁿ (R ∩ S) T) <:-refl)
+∪-<:-∪ⁿ (R ∪ S) (T ∪ U) = <:-trans <:-∪-assocl (<:-union (∪-<:-∪ⁿ (R ∪ S) T) <:-refl)
+
+normalize-<: : ∀ T → normalize T <: T
+<:-normalize : ∀ T → T <: normalize T
+
+<:-normalize nil = <:-∪-right
+<:-normalize (S ⇒ T) = <:-function (normalize-<: S) (<:-normalize T)
+<:-normalize never = <:-refl
+<:-normalize unknown = <:-refl
+<:-normalize boolean = <:-∪-right
+<:-normalize number = <:-∪-right
+<:-normalize string = <:-∪-right
+<:-normalize (S ∪ T) = <:-trans (<:-union (<:-normalize S) (<:-normalize T)) (∪-<:-∪ⁿ (normal S) (normal T))
+<:-normalize (S ∩ T) = <:-trans (<:-intersect (<:-normalize S) (<:-normalize T)) (∩-<:-∩ⁿ (normal S) (normal T))
+
+normalize-<: nil = <:-∪-lub <:-never <:-refl
+normalize-<: (S ⇒ T) = <:-function (<:-normalize S) (normalize-<: T)
+normalize-<: never = <:-refl
+normalize-<: unknown = <:-refl
+normalize-<: boolean = <:-∪-lub <:-never <:-refl
+normalize-<: number = <:-∪-lub <:-never <:-refl
+normalize-<: string = <:-∪-lub <:-never <:-refl
+normalize-<: (S ∪ T) = <:-trans (∪ⁿ-<:-∪ (normal S) (normal T)) (<:-union (normalize-<: S) (normalize-<: T))
+normalize-<: (S ∩ T) = <:-trans (∩ⁿ-<:-∩ (normal S) (normal T)) (<:-intersect (normalize-<: S) (normalize-<: T))
+
+