Remove prototyping/ and prototyping.yml (#688)

Superseded by https://github.com/luau-lang/agda-typeck

.github/workflows/prototyping.yml

@@ -1,68 +0,0 @@
-name: prototyping
-
-on:
-  pull_request:
-    paths:
-      - '.github/workflows/prototyping.yml'
-      - 'prototyping/**'
-
-jobs:
-  linux:
-    strategy:
-      matrix:
-        agda: [2.6.2.2]
-        hackageDate: ["2022-04-07"]
-        hackageTime: ["23:06:28"]
-    name: prototyping
-    runs-on: ubuntu-latest
-    steps:
-    - uses: actions/checkout@v1
-    - uses: actions/cache@v2
-      with:
-        path: ~/.cabal/store
-        key: "prototyping-${{ runner.os }}-${{ matrix.agda }}-${{ matrix.hackageDate }}-${{ matrix.hackageTime }}"
-    - uses: actions/cache@v2
-      id: luau-ast-cache
-      with:
-        path: ./build
-        key: prototyping-${{ runner.os }}-${{ hashFiles('Ast/**', 'Analysis/**', 'CLI/Ast.cpp', 'CLI/FileUtils.*')}}
-    - name: install cabal
-      run: sudo apt-get install -y cabal-install
-    - name: cabal update
-      working-directory: prototyping
-      run: cabal v2-update "hackage.haskell.org,${{ matrix.hackageDate }}T${{ matrix.hackageTime }}Z"
-    - name: cabal install
-      working-directory: prototyping
-      run: |
-        cabal install --lib scientific vector aeson --package-env .
-        cabal install --allow-newer Agda-${{ matrix.agda }}
-    - name: check targets
-      working-directory: prototyping
-      run: |
-        ~/.cabal/bin/agda Everything.agda
-    - name: build executables
-      working-directory: prototyping
-      run: |
-        ~/.cabal/bin/agda --compile PrettyPrinter.agda
-        ~/.cabal/bin/agda --compile Interpreter.agda
-    - name: cmake configure
-      if: steps.luau-ast-cache.outputs.cache-hit != 'true'
-      run: |
-        mkdir -p build
-        cd build
-        cmake build ../
-    - name: cmake build luau-ast
-      if: steps.luau-ast-cache.outputs.cache-hit != 'true'
-      run: |
-        cmake --build ./build --target Luau.Ast.CLI
-    - name: run tests
-      working-directory: prototyping
-      run: |
-        mkdir test-failures
-        python tests.py -l ../build/luau-ast --write-diff-failures --diff-failure-location test-failures/
-    - uses: actions/upload-artifact@v2
-      if: failure()
-      with:
-        name: test failures
-        path: prototyping/test-failures
-        retention-days: 5

prototyping/.gitignore

@@ -1,10 +0,0 @@
-*~
-*.agdai
-Main
-MAlonzo
-PrettyPrinter
-Interpreter
-!Tests/Interpreter
-!Tests/PrettyPrinter
-.ghc.*
-test-failures/

prototyping/Everything.agda

@@ -1,8 +0,0 @@
-{-# OPTIONS --rewriting #-}
-
-module Everything where
-
-import Examples
-import Properties
-import PrettyPrinter
-import Interpreter

prototyping/Examples.agda

@@ -1,7 +0,0 @@
-{-# OPTIONS --rewriting #-}
-module Examples where
-
-import Examples.Syntax
-import Examples.OpSem
-import Examples.Run
-import Examples.Type

prototyping/Examples/OpSem.agda

@@ -1,10 +0,0 @@
-{-# OPTIONS --rewriting #-}
-
-module Examples.OpSem where
-
-open import Luau.OpSem using (_⊢_⟶ᴱ_⊣_; _⊢_⟶ᴮ_⊣_; subst)
-open import Luau.Syntax using (Block; var; val; nil; local_←_; _∙_; done; return; block_is_end)
-open import Luau.Heap using (∅)
-
-ex1 : ∅ ⊢ (local (var "x") ← val nil ∙ return (var "x") ∙ done) ⟶ᴮ (return (val nil) ∙ done) ⊣ ∅
-ex1 = subst nil

prototyping/Examples/Run.agda

@@ -1,23 +0,0 @@
-{-# OPTIONS --rewriting #-}
-
-module Examples.Run where
-
-open import Agda.Builtin.Equality using (_≡_; refl)
-open import Agda.Builtin.Bool using (true; false)
-open import Luau.Syntax using (nil; var; _$_; function_is_end; return; _∙_; done; _⟨_⟩; number; binexp; +; <; val; bool; ~=; string)
-open import Luau.Run using (run; return)
-
-ex1 : (run (function "id" ⟨ var "x" ⟩ is return (var "x") ∙ done end ∙ return (var "id" $ val nil) ∙ done) ≡ return nil _)
-ex1 = refl
-
-ex2 : (run (function "fn" ⟨ var "x" ⟩ is return (val (number 123.0)) ∙ done end ∙ return (var "fn" $ val nil) ∙ done) ≡ return (number 123.0) _)
-ex2 = refl
-
-ex3 : (run (function "fn" ⟨ var "x" ⟩ is return (binexp (val (number 1.0)) + (val (number 2.0))) ∙ done end ∙ return (var "fn" $ val nil) ∙ done) ≡ return (number 3.0) _)
-ex3 = refl
-
-ex4 : (run (function "fn" ⟨ var "x" ⟩ is return (binexp (val (number 1.0)) < (val (number 2.0))) ∙ done end ∙ return (var "fn" $ val nil) ∙ done) ≡ return (bool true) _)
-ex4 = refl
-
-ex5 : (run (function "fn" ⟨ var "x" ⟩ is return (binexp (val (string "foo")) ~= (val (string "bar"))) ∙ done end ∙ return (var "fn" $ val nil) ∙ done) ≡ return (bool true) _)
-ex5 = refl

prototyping/Examples/Syntax.agda

@@ -1,24 +0,0 @@
-module Examples.Syntax where
-
-open import Agda.Builtin.Equality using (_≡_; refl)
-open import FFI.Data.String using (_++_)
-open import Luau.Syntax using (var; _$_; return; val; nil; function_is_end; local_←_; done; _∙_; _⟨_⟩)
-open import Luau.Syntax.ToString using (exprToString; blockToString)
-
-ex1 : exprToString(function "" ⟨ var "x" ⟩ is return (var "f" $ var "x") ∙ done end) ≡
-  "function(x)\n" ++
-  "  return f(x)\n" ++
-  "end"
-ex1 = refl
-
-ex2 : blockToString(local var "x" ← (val nil) ∙ return (var "x") ∙ done) ≡
-  "local x = nil\n" ++
-  "return x"
-ex2 = refl
-
-ex3 : blockToString(function "f" ⟨ var "x" ⟩ is return (var "x") ∙ done end ∙ return (var "f") ∙ done) ≡
-  "local function f(x)\n" ++
-  "  return x\n" ++
-  "end\n" ++
-  "return f"
-ex3 = refl

prototyping/Examples/Type.agda

@@ -1,28 +0,0 @@
-module Examples.Type where
-
-open import Agda.Builtin.Equality using (_≡_; refl)
-open import FFI.Data.String using (_++_)
-open import Luau.Type using (nil; _∪_; _∩_; _⇒_)
-open import Luau.Type.ToString using (typeToString)
-
-ex1 : typeToString(nil) ≡ "nil"
-ex1 = refl
-
-ex2 : typeToString(nil ⇒ nil) ≡ "(nil) -> nil"
-ex2 = refl
-
-ex3 : typeToString(nil ⇒ (nil ⇒ nil)) ≡ "(nil) -> (nil) -> nil"
-ex3 = refl
-
-ex4 : typeToString(nil ∪ (nil ⇒ (nil ⇒ nil))) ≡ "((nil) -> (nil) -> nil)?"
-ex4 = refl
-
-ex5 : typeToString(nil ⇒ ((nil ⇒ nil) ∪ nil)) ≡ "(nil) -> ((nil) -> nil)?"
-ex5 = refl
-
-ex6 : typeToString((nil ⇒ nil) ∪ (nil ⇒ (nil ⇒ nil))) ≡ "((nil) -> nil | (nil) -> (nil) -> nil)"
-ex6 = refl
-
-ex7 : typeToString((nil ⇒ nil) ∪ ((nil ⇒ (nil ⇒ nil)) ∪ nil)) ≡ "((nil) -> nil | (nil) -> (nil) -> nil)?"
-ex7 = refl
-

prototyping/FFI/Data/Aeson.agda

@@ -1,77 +0,0 @@
-{-# OPTIONS --rewriting #-}
-
-module FFI.Data.Aeson where
-
-open import Agda.Builtin.Equality using (_≡_)
-open import Agda.Builtin.Equality.Rewrite using ()
-open import Agda.Builtin.Bool using (Bool)
-open import Agda.Builtin.String using (String)
-
-open import FFI.Data.ByteString using (ByteString)
-open import FFI.Data.HaskellString using (HaskellString; pack)
-open import FFI.Data.Maybe using (Maybe; just; nothing)
-open import FFI.Data.Either using (Either; mapL)
-open import FFI.Data.Scientific using (Scientific)
-open import FFI.Data.Vector using (Vector)
-
-open import Properties.Equality using (_≢_)
-
-{-# FOREIGN GHC import qualified Data.Aeson #-}
-{-# FOREIGN GHC import qualified Data.Aeson.Key #-}
-{-# FOREIGN GHC import qualified Data.Aeson.KeyMap #-}
-
-postulate
-  KeyMap : Set → Set
-  Key : Set
-  fromString : String → Key
-  toString : Key → String
-  empty : ∀ {A} → KeyMap A
-  singleton : ∀ {A} → Key → A → (KeyMap A)
-  insert : ∀ {A} → Key → A → (KeyMap A) → (KeyMap A)
-  delete : ∀ {A} → Key → (KeyMap A) → (KeyMap A)
-  unionWith : ∀ {A} → (A → A → A) → (KeyMap A) → (KeyMap A) → (KeyMap A)
-  lookup : ∀ {A} → Key -> KeyMap A -> Maybe A
-{-# POLARITY KeyMap ++ #-}
-{-# COMPILE GHC KeyMap = type Data.Aeson.KeyMap.KeyMap #-}
-{-# COMPILE GHC Key = type Data.Aeson.Key.Key #-}
-{-# COMPILE GHC fromString = Data.Aeson.Key.fromText #-}
-{-# COMPILE GHC toString = Data.Aeson.Key.toText #-}
-{-# COMPILE GHC empty = \_ -> Data.Aeson.KeyMap.empty #-}
-{-# COMPILE GHC singleton = \_ -> Data.Aeson.KeyMap.singleton #-}
-{-# COMPILE GHC insert = \_ -> Data.Aeson.KeyMap.insert #-}
-{-# COMPILE GHC delete = \_ -> Data.Aeson.KeyMap.delete #-}
-{-# COMPILE GHC unionWith = \_ -> Data.Aeson.KeyMap.unionWith #-}
-{-# COMPILE GHC lookup = \_ -> Data.Aeson.KeyMap.lookup #-}
-
-postulate lookup-insert : ∀ {A} k v (m : KeyMap A) → (lookup k (insert k v m) ≡ just v)
-postulate lookup-empty : ∀ {A} k → (lookup {A} k empty ≡ nothing)
-postulate lookup-insert-not : ∀ {A} j k v (m : KeyMap A) → (j ≢ k) → (lookup k m ≡ lookup k (insert j v m))
-postulate singleton-insert-empty : ∀ {A} k (v : A) → (singleton k v ≡ insert k v empty)
-postulate insert-swap : ∀ {A} j k (v w : A) m → (j ≢ k) → insert j v (insert k w m) ≡ insert k w (insert j v m)
-postulate insert-over : ∀ {A} j k (v w : A) m → (j ≡ k) → insert j v (insert k w m) ≡ insert j v m
-postulate to-from : ∀ k → toString(fromString k) ≡ k
-postulate from-to : ∀ k → fromString(toString k) ≡ k
-
-{-# REWRITE lookup-insert lookup-empty singleton-insert-empty #-}
-
-data Value : Set where
-  object : KeyMap Value → Value
-  array : Vector Value → Value
-  string : String → Value
-  number : Scientific → Value
-  bool : Bool → Value
-  null : Value
-{-# COMPILE GHC Value = data Data.Aeson.Value (Data.Aeson.Object|Data.Aeson.Array|Data.Aeson.String|Data.Aeson.Number|Data.Aeson.Bool|Data.Aeson.Null) #-}
-
-Object = KeyMap Value
-Array = Vector Value
-
-postulate
-  decode : ByteString → Maybe Value
-  eitherHDecode : ByteString → Either HaskellString Value
-{-# COMPILE GHC decode = Data.Aeson.decodeStrict #-}
-{-# COMPILE GHC eitherHDecode = Data.Aeson.eitherDecodeStrict #-}
-
-eitherDecode : ByteString → Either String Value
-eitherDecode bytes = mapL pack (eitherHDecode bytes)
-

prototyping/FFI/Data/ByteString.agda

@@ -1,7 +0,0 @@
-module FFI.Data.ByteString where
-
-{-# FOREIGN GHC import qualified Data.ByteString #-}
-
-postulate ByteString : Set
-{-# COMPILE GHC ByteString = type Data.ByteString.ByteString #-}
-

prototyping/FFI/Data/Either.agda

@@ -1,28 +0,0 @@
-module FFI.Data.Either where
-
-{-# FOREIGN GHC import qualified Data.Either #-}
-
-data Either (A B : Set) : Set where
-  Left : A → Either A B
-  Right : B → Either A B
-{-# COMPILE GHC Either = data Data.Either.Either (Data.Either.Left|Data.Either.Right) #-}
-
-swapLR : ∀ {A B} → Either A B → Either B A
-swapLR (Left x) = Right x
-swapLR (Right x) = Left x
-
-mapL : ∀ {A B C} → (A → B) → Either A C → Either B C
-mapL f (Left x) = Left (f x)
-mapL f (Right x) = Right x
-
-mapR : ∀ {A B C} → (B → C) → Either A B → Either A C
-mapR f (Left x) = Left x
-mapR f (Right x) = Right (f x)
-
-mapLR : ∀ {A B C D} → (A → B) → (C → D) → Either A C → Either B D
-mapLR f g (Left x) = Left (f x)
-mapLR f g (Right x) = Right (g x)
-
-cond : ∀ {A B C : Set} → (A → C) → (B → C) → (Either A B) → C
-cond f g (Left x) = f x
-cond f g (Right x) = g x

prototyping/FFI/Data/HaskellInt.agda

@@ -1,14 +0,0 @@
-module FFI.Data.HaskellInt where
-
-open import Agda.Builtin.Int using (Int)
-
-{-# FOREIGN GHC import qualified Data.Int #-}
-
-postulate HaskellInt : Set
-{-# COMPILE GHC HaskellInt = type Data.Int.Int #-}
-
-postulate
-  intToHaskellInt : Int → HaskellInt
-  haskellIntToInt : HaskellInt → Int
-{-# COMPILE GHC intToHaskellInt = fromIntegral #-}
-{-# COMPILE GHC haskellIntToInt = fromIntegral #-}

prototyping/FFI/Data/HaskellString.agda

@@ -1,16 +0,0 @@
-module FFI.Data.HaskellString where
-
-open import Agda.Builtin.String using (String)
-
-{-# FOREIGN GHC import qualified Data.String #-}
-{-# FOREIGN GHC import qualified Data.Text #-}
-
-postulate HaskellString : Set
-{-# COMPILE GHC HaskellString = type Data.String.String #-}
-
-postulate pack : HaskellString → String
-{-# COMPILE GHC pack = Data.Text.pack #-}
-
-postulate unpack : String → HaskellString
-{-# COMPILE GHC unpack = Data.Text.unpack #-}
-

prototyping/FFI/Data/Maybe.agda

@@ -1,14 +0,0 @@
-module FFI.Data.Maybe where
-
-open import Agda.Builtin.Equality using (_≡_; refl)
-
-{-# FOREIGN GHC import qualified Data.Maybe #-}
-
-data Maybe (A : Set) : Set where
-  nothing : Maybe A
-  just : A → Maybe A
-{-# COMPILE GHC Maybe = data Data.Maybe.Maybe (Data.Maybe.Nothing|Data.Maybe.Just) #-}
-
-just-inv : ∀ {A} {x y : A} → (just x ≡ just y) → (x ≡ y)
-just-inv refl = refl
-

prototyping/FFI/Data/Scientific.agda

@@ -1,21 +0,0 @@
-module FFI.Data.Scientific where
-
-open import Agda.Builtin.Float using (Float)
-open import FFI.Data.String using (String)
-open import FFI.Data.HaskellString using (HaskellString; pack; unpack)
-
-{-# FOREIGN GHC import qualified Data.Scientific #-}
-{-# FOREIGN GHC import qualified Text.Show #-}
-
-postulate Scientific : Set
-{-# COMPILE GHC Scientific = type Data.Scientific.Scientific #-}
-
-postulate
-  showHaskell : Scientific → HaskellString
-  toFloat : Scientific → Float
-
-{-# COMPILE GHC showHaskell = \x -> Text.Show.show x #-}
-{-# COMPILE GHC toFloat = \x -> Data.Scientific.toRealFloat x #-}
-
-show : Scientific → String
-show x = pack (showHaskell x)

prototyping/FFI/Data/String.agda

@@ -1,8 +0,0 @@
-module FFI.Data.String where
-
-import Agda.Builtin.String
-
-String = Agda.Builtin.String.String
-
-infixr 5 _++_
-_++_ = Agda.Builtin.String.primStringAppend

prototyping/FFI/Data/Text/Encoding.agda

@@ -1,10 +0,0 @@
-module FFI.Data.Text.Encoding where
-
-open import Agda.Builtin.String using (String)
-
-open import FFI.Data.ByteString using (ByteString)
-
-{-# FOREIGN GHC import qualified Data.Text.Encoding #-}
-
-postulate encodeUtf8 : String → ByteString
-{-# COMPILE GHC encodeUtf8 = Data.Text.Encoding.encodeUtf8 #-}

prototyping/FFI/Data/Vector.agda

@@ -1,53 +0,0 @@
-{-# OPTIONS --rewriting #-}
-
-module FFI.Data.Vector where
-
-open import Agda.Builtin.Equality using (_≡_)
-open import Agda.Builtin.Equality.Rewrite using ()
-open import Agda.Builtin.Int using (Int; pos; negsuc)
-open import Agda.Builtin.Nat using (Nat)
-open import Agda.Builtin.Bool using (Bool; false; true)
-open import FFI.Data.HaskellInt using (HaskellInt; haskellIntToInt; intToHaskellInt)
-open import FFI.Data.Maybe using (Maybe; just; nothing)
-open import Properties.Equality using (_≢_)
-
-{-# FOREIGN GHC import qualified Data.Vector #-}
-
-postulate Vector : Set → Set
-{-# POLARITY Vector ++ #-}
-{-# COMPILE GHC Vector = type Data.Vector.Vector #-}
-
-postulate
-  empty : ∀ {A} → (Vector A)
-  null : ∀ {A} → (Vector A) → Bool
-  unsafeHead : ∀ {A} → (Vector A) → A
-  unsafeTail : ∀ {A} → (Vector A) → (Vector A)
-  length : ∀ {A} → (Vector A) → Nat
-  lookup : ∀ {A} → (Vector A) → Nat → (Maybe A)
-  snoc : ∀ {A} → (Vector A) → A → (Vector A)
-{-# COMPILE GHC empty = \_ -> Data.Vector.empty #-}
-{-# COMPILE GHC null = \_ -> Data.Vector.null #-}
-{-# COMPILE GHC unsafeHead = \_ -> Data.Vector.unsafeHead #-}
-{-# COMPILE GHC unsafeTail = \_ -> Data.Vector.unsafeTail #-}
-{-# COMPILE GHC length = \_ -> (fromIntegral . Data.Vector.length) #-}
-{-# COMPILE GHC lookup = \_ v -> ((v Data.Vector.!?) . fromIntegral) #-}
-{-# COMPILE GHC snoc = \_ -> Data.Vector.snoc #-}
-
-postulate length-empty : ∀ {A} → (length (empty {A}) ≡ 0)
-postulate lookup-empty : ∀ {A} n → (lookup (empty {A}) n ≡ nothing)
-postulate lookup-snoc : ∀ {A} (x : A) (v : Vector A) → (lookup (snoc v x) (length v) ≡ just x)
-postulate lookup-length : ∀ {A} (v : Vector A) → (lookup v (length v) ≡ nothing)
-postulate lookup-snoc-empty : ∀ {A} (x : A) → (lookup (snoc empty x) 0 ≡ just x)
-postulate lookup-snoc-not : ∀ {A n} (x : A) (v : Vector A) → (n ≢ length v) → (lookup v n ≡ lookup (snoc v x) n)
-
-{-# REWRITE length-empty lookup-snoc lookup-length lookup-snoc-empty lookup-empty #-}
-
-head : ∀ {A} → (Vector A) → (Maybe A)
-head vec with null vec
-head vec | false = just (unsafeHead vec)
-head vec | true = nothing
-
-tail : ∀ {A} → (Vector A) → Vector A
-tail vec with null vec
-tail vec | false = unsafeTail vec
-tail vec | true = empty

prototyping/FFI/IO.agda

@@ -1,34 +0,0 @@
-module FFI.IO where
-
-open import Agda.Builtin.IO using (IO)
-open import Agda.Builtin.Unit using (⊤)
-open import Agda.Builtin.String using (String)
-
-open import FFI.Data.HaskellString using (HaskellString; pack ; unpack)
-
-infixl 1 _>>=_
-infixl 1 _>>_
-
-postulate
-  return : ∀ {a} {A : Set a} → A → IO A
-  _>>=_  : ∀ {a b} {A : Set a} {B : Set b} → IO A → (A → IO B) → IO B
-  fmap : ∀ {a b} {A : Set a} {B : Set b} → (A → B) → IO A → IO B
-
-{-# COMPILE GHC return = \_ _ -> return    #-}
-{-# COMPILE GHC _>>=_  = \_ _ _ _ -> (>>=) #-}
-{-# COMPILE GHC fmap  = \_ _ _ _ -> fmap #-}
-
-postulate getHContents : IO HaskellString
-{-# COMPILE GHC getHContents = getContents #-}
-
-postulate putHStrLn : HaskellString → IO ⊤
-{-# COMPILE GHC putHStrLn = putStrLn #-}
-
-getContents : IO String
-getContents = fmap pack getHContents
-
-putStrLn : String → IO ⊤
-putStrLn txt = putHStrLn (unpack txt)
-
-_>>_ : ∀ {a} {A : Set a} → IO ⊤ → IO A → IO A
-a >> b = a >>= (λ _ → b )

prototyping/FFI/System/Exit.agda

@@ -1,29 +0,0 @@
-module FFI.System.Exit where
-
-open import Agda.Builtin.Int using (Int)
-open import Agda.Builtin.IO using (IO)
-open import Agda.Builtin.Unit using (⊤)
-
-data ExitCode : Set where
-  ExitSuccess : ExitCode
-  ExitFailure : Int → ExitCode
-
-{-# FOREIGN GHC data AgdaExitCode = AgdaExitSuccess | AgdaExitFailure Integer #-}
-{-# COMPILE GHC ExitCode = data AgdaExitCode (AgdaExitSuccess | AgdaExitFailure) #-}
-
-{-# FOREIGN GHC import qualified System.Exit #-}
-
-{-# FOREIGN GHC
-toExitCode :: AgdaExitCode -> System.Exit.ExitCode
-toExitCode AgdaExitSuccess = System.Exit.ExitSuccess
-toExitCode (AgdaExitFailure n) = System.Exit.ExitFailure (fromIntegral n)
-
-fromExitCode :: System.Exit.ExitCode -> AgdaExitCode
-fromExitCode System.Exit.ExitSuccess = AgdaExitSuccess
-fromExitCode (System.Exit.ExitFailure n) = AgdaExitFailure (fromIntegral n)
-#-}
-
-postulate
-  exitWith : ExitCode → IO ⊤
-
-{-# COMPILE GHC exitWith = System.Exit.exitWith . toExitCode #-}

prototyping/Interpreter.agda

@@ -1,50 +0,0 @@
-{-# OPTIONS --rewriting #-}
-
-module Interpreter where
-
-open import Agda.Builtin.IO using (IO)
-open import Agda.Builtin.Int using (pos)
-open import Agda.Builtin.Unit using (⊤)
-
-open import FFI.IO using (getContents; putStrLn; _>>=_; _>>_)
-open import FFI.Data.Aeson using (Value; eitherDecode)
-open import FFI.Data.Either using (Left; Right)
-open import FFI.Data.Maybe using (just; nothing)
-open import FFI.Data.String using (String; _++_)
-open import FFI.Data.Text.Encoding using (encodeUtf8)
-open import FFI.System.Exit using (exitWith; ExitFailure)
-
-open import Luau.StrictMode.ToString using (warningToStringᴮ)
-open import Luau.Syntax using (Block; yes; maybe; isAnnotatedᴮ)
-open import Luau.Syntax.FromJSON using (blockFromJSON)
-open import Luau.Syntax.ToString using (blockToString; valueToString)
-open import Luau.Run using (run; return; done; error)
-open import Luau.RuntimeError.ToString using (errToStringᴮ)
-
-open import Properties.StrictMode using (wellTypedProgramsDontGoWrong)
-
-runBlock′ : ∀ a → Block a → IO ⊤
-runBlock′ a block with run block
-runBlock′ a block | return V D = putStrLn ("\nRAN WITH RESULT: " ++ valueToString V)
-runBlock′ a block | done D = putStrLn ("\nRAN")
-runBlock′ maybe block | error E D = putStrLn ("\nRUNTIME ERROR:\n" ++ errToStringᴮ _ E)
-runBlock′ yes block | error E D with wellTypedProgramsDontGoWrong _ block _ D E
-runBlock′ yes block | error E D | W = putStrLn ("\nRUNTIME ERROR:\n" ++ errToStringᴮ _ E ++ "\n\nTYPE ERROR:\n" ++ warningToStringᴮ _ W)
-
-runBlock : Block maybe → IO ⊤
-runBlock B with isAnnotatedᴮ B
-runBlock B | nothing = putStrLn ("UNANNOTATED PROGRAM:\n" ++ blockToString B) >> runBlock′ maybe B
-runBlock B | just B′ = putStrLn ("ANNOTATED PROGRAM:\n" ++ blockToString B) >> runBlock′ yes B′
-
-runJSON : Value → IO ⊤
-runJSON value with blockFromJSON(value)
-runJSON value | (Left err) = putStrLn ("LUAU ERROR: " ++ err) >> exitWith (ExitFailure (pos 1))
-runJSON value | (Right block) = runBlock block
-
-runString : String → IO ⊤
-runString txt with eitherDecode (encodeUtf8 txt)
-runString txt | (Left err) = putStrLn ("JSON ERROR: " ++ err) >> exitWith (ExitFailure (pos 1))
-runString txt | (Right value) = runJSON value
-
-main : IO ⊤
-main = getContents >>= runString

prototyping/Luau/Addr.agda

@@ -1,18 +0,0 @@
-module Luau.Addr where
-
-open import Agda.Builtin.Bool using (true; false)
-open import Agda.Builtin.Equality using (_≡_)
-open import Agda.Builtin.Nat using (Nat; _==_)
-open import Agda.Builtin.String using (String)
-open import Agda.Builtin.TrustMe using (primTrustMe)
-open import Properties.Dec using (Dec; yes; no)
-open import Properties.Equality using (_≢_)
-
-Addr : Set
-Addr = Nat
-
-_≡ᴬ_ : (a b : Addr) → Dec (a ≡ b)
-a ≡ᴬ b with a == b
-a ≡ᴬ b | false = no p where postulate p : (a ≢ b)
-a ≡ᴬ b | true = yes primTrustMe
-

prototyping/Luau/Addr/ToString.agda

@@ -1,8 +0,0 @@
-module Luau.Addr.ToString where
-
-open import Agda.Builtin.String using (String; primStringAppend)
-open import Luau.Addr using (Addr)
-open import Agda.Builtin.Int using (Int; primShowInteger; pos)
-
-addrToString : Addr → String
-addrToString a = primStringAppend "a" (primShowInteger (pos a))

prototyping/Luau/Heap.agda

@@ -1,49 +0,0 @@
-{-# OPTIONS --rewriting #-}
-
-module Luau.Heap where
-
-open import Agda.Builtin.Equality using (_≡_; refl)
-open import FFI.Data.Maybe using (Maybe; just; nothing)
-open import FFI.Data.Vector using (Vector; length; snoc; empty; lookup-snoc-not)
-open import Luau.Addr using (Addr; _≡ᴬ_)
-open import Luau.Var using (Var)
-open import Luau.Syntax using (Block; Expr; Annotated; FunDec; nil; function_is_end)
-open import Properties.Equality using (_≢_; trans)
-open import Properties.Remember using (remember; _,_)
-open import Properties.Dec using (yes; no)
-
--- Heap-allocated objects
-data Object (a : Annotated) : Set where
-
-  function_is_end : FunDec a → Block a → Object a
-
-Heap : Annotated → Set
-Heap a = Vector (Object a)
-
-data _≡_⊕_↦_ {a} : Heap a → Heap a → Addr → Object a → Set where
-
-  defn : ∀ {H val} →
-
-    -----------------------------------
-    (snoc H val) ≡ H ⊕ (length H) ↦ val
-
-_[_] : ∀ {a} → Heap a → Addr → Maybe (Object a)
-_[_] = FFI.Data.Vector.lookup
-
-∅ : ∀ {a} → Heap a
-∅ = empty
-
-data AllocResult a (H : Heap a) (V : Object a) : Set where
-  ok : ∀ b H′ → (H′ ≡ H ⊕ b ↦ V) → AllocResult a H V
-
-alloc : ∀ {a} H V → AllocResult a H V
-alloc H V = ok (length H) (snoc H V) defn
-
-next : ∀ {a} → Heap a → Addr
-next = length
-
-allocated : ∀ {a} → Heap a → Object a → Heap a
-allocated = snoc
-
-lookup-not-allocated : ∀ {a} {H H′ : Heap a} {b c O} → (H′ ≡ H ⊕ b ↦ O) → (c ≢ b) → (H [ c ] ≡ H′ [ c ])
-lookup-not-allocated {H = H} {O = O} defn p = lookup-snoc-not O H p

prototyping/Luau/OpSem.agda

@@ -1,143 +0,0 @@
-{-# OPTIONS --rewriting #-}
-
-module Luau.OpSem where
-
-open import Agda.Builtin.Equality using (_≡_)
-open import Agda.Builtin.Float using (Float; primFloatPlus; primFloatMinus; primFloatTimes; primFloatDiv; primFloatEquality; primFloatLess; primFloatInequality)
-open import Agda.Builtin.Bool using (Bool; true; false)
-open import Agda.Builtin.String using (primStringEquality; primStringAppend)
-open import Utility.Bool using (not; _or_; _and_)
-open import Agda.Builtin.Nat using () renaming (_==_ to _==ᴬ_)
-open import FFI.Data.Maybe using (Maybe; just; nothing)
-open import Luau.Heap using (Heap; _≡_⊕_↦_; _[_]; function_is_end)
-open import Luau.Substitution using (_[_/_]ᴮ)
-open import Luau.Syntax using (Value; Expr; Stat; Block; nil; addr; val; var; function_is_end; _$_; block_is_end; local_←_; _∙_; done; return; name; fun; arg; binexp; BinaryOperator; +; -; *; /; <; >; ==; ~=; <=; >=; ··; number; bool; string)
-open import Luau.RuntimeType using (RuntimeType; valueType)
-open import Properties.Product using (_×_; _,_)
-
-evalEqOp : Value → Value → Bool
-evalEqOp Value.nil Value.nil = true
-evalEqOp (addr x) (addr y) = (x ==ᴬ y)
-evalEqOp (number x) (number y) = primFloatEquality x y
-evalEqOp (bool true) (bool y) = y
-evalEqOp (bool false) (bool y) = not y
-evalEqOp _ _ = false
-
-evalNeqOp : Value → Value → Bool
-evalNeqOp (number x) (number y) = primFloatInequality x y
-evalNeqOp x y = not (evalEqOp x y)
-
-data _⟦_⟧_⟶_ : Value → BinaryOperator → Value → Value → Set where
-  + : ∀ m n → (number m) ⟦ + ⟧ (number n) ⟶ number (primFloatPlus m n)
-  - : ∀ m n → (number m) ⟦ - ⟧ (number n) ⟶ number (primFloatMinus m n)
-  / : ∀ m n → (number m) ⟦ / ⟧ (number n) ⟶ number (primFloatTimes m n)
-  * : ∀ m n → (number m) ⟦ * ⟧ (number n) ⟶ number (primFloatDiv m n)
-  < : ∀ m n → (number m) ⟦ < ⟧ (number n) ⟶ bool (primFloatLess m n)
-  > : ∀ m n → (number m) ⟦ > ⟧ (number n) ⟶ bool (primFloatLess n m)
-  <= : ∀ m n → (number m) ⟦ <= ⟧ (number n) ⟶ bool ((primFloatLess m n) or (primFloatEquality m n))
-  >= : ∀ m n → (number m) ⟦ >= ⟧ (number n) ⟶ bool ((primFloatLess n m) or (primFloatEquality m n))
-  == : ∀ v w → v ⟦ == ⟧ w ⟶ bool (evalEqOp v w)
-  ~= : ∀ v w → v ⟦ ~= ⟧ w ⟶ bool (evalNeqOp v w)
-  ·· : ∀ x y → (string x) ⟦ ·· ⟧ (string y) ⟶ string (primStringAppend x y)
-
-data _⊢_⟶ᴮ_⊣_ {a} : Heap a → Block a → Block a → Heap a → Set
-data _⊢_⟶ᴱ_⊣_ {a} : Heap a → Expr a → Expr a → Heap a → Set
-
-data _⊢_⟶ᴱ_⊣_  where
-
-  function : ∀ a {H H′ F B} →
-
-    H′ ≡ H ⊕ a ↦ (function F is B end) →
-    -------------------------------------------
-    H ⊢ (function F is B end) ⟶ᴱ val(addr a) ⊣ H′
-
-  app₁ : ∀ {H H′ M M′ N} →
-  
-    H ⊢ M ⟶ᴱ M′ ⊣ H′ →
-    -----------------------------
-    H ⊢ (M $ N) ⟶ᴱ (M′ $ N) ⊣ H′
-
-  app₂ : ∀ v {H H′ N N′} →
-
-    H ⊢ N ⟶ᴱ N′ ⊣ H′ →
-    -----------------------------
-    H ⊢ (val v $ N) ⟶ᴱ (val v $ N′) ⊣ H′
-
-  beta : ∀ O v {H a F B} →
-
-    (O ≡ function F is B end) →
-    H [ a ] ≡ just(O) →
-    -----------------------------------------------------------------------------
-    H ⊢ (val (addr a) $ val v) ⟶ᴱ (block (fun F) is (B [ v / name(arg F) ]ᴮ) end) ⊣ H
-
-  block : ∀ {H H′ B B′ b} →
- 
-    H ⊢ B ⟶ᴮ B′ ⊣ H′ →
-    ----------------------------------------------------
-    H ⊢ (block b is B end) ⟶ᴱ (block b is B′ end) ⊣ H′
-
-  return : ∀ v {H B b} →
-
-    --------------------------------------------------------
-    H ⊢ (block b is return (val v) ∙ B end) ⟶ᴱ val v ⊣ H
-
-  done : ∀ {H b} →
- 
-    --------------------------------------------
-    H ⊢ (block b is done end) ⟶ᴱ (val nil) ⊣ H
-  
-  binOp₀ : ∀ {H op v₁ v₂ w} →
-
-    v₁ ⟦ op ⟧ v₂ ⟶ w → 
-    --------------------------------------------------
-    H ⊢ (binexp (val v₁) op (val v₂)) ⟶ᴱ (val w) ⊣ H
-
-  binOp₁ : ∀ {H H′ x x′ op y} →
-
-    H ⊢ x ⟶ᴱ x′ ⊣ H′ →
-    ---------------------------------------------
-    H ⊢ (binexp x op y) ⟶ᴱ (binexp x′ op y) ⊣ H′
-  
-  binOp₂ : ∀ {H H′ x op y y′} →
-
-    H ⊢ y ⟶ᴱ y′ ⊣ H′ →
-    ---------------------------------------------
-    H ⊢ (binexp x op y) ⟶ᴱ (binexp x op y′) ⊣ H′
-
-data _⊢_⟶ᴮ_⊣_  where
-
-  local : ∀ {H H′ x M M′ B} →
-  
-    H ⊢ M ⟶ᴱ M′ ⊣ H′ →
-    -------------------------------------------------
-    H ⊢ (local x ← M ∙ B) ⟶ᴮ (local x ← M′ ∙ B) ⊣ H′
-
-  subst : ∀ v {H x B} →
-  
-    ------------------------------------------------------
-    H ⊢ (local x ← val v ∙ B) ⟶ᴮ (B [ v / name x ]ᴮ) ⊣ H
-
-  function : ∀ a {H H′ F B C} →
-  
-    H′ ≡ H ⊕ a ↦ (function F is C end) →
-    --------------------------------------------------------------
-    H ⊢ (function F is C end ∙ B) ⟶ᴮ (B [ addr a / name(fun F) ]ᴮ) ⊣ H′
-
-  return : ∀ {H H′ M M′ B} →
-  
-    H ⊢ M ⟶ᴱ M′ ⊣ H′ →
-    --------------------------------------------
-    H ⊢ (return M ∙ B) ⟶ᴮ (return M′ ∙ B) ⊣ H′
-
-data _⊢_⟶*_⊣_ {a} : Heap a → Block a → Block a → Heap a → Set where
-
-  refl : ∀ {H B} →
-
-    ----------------
-    H ⊢ B ⟶* B ⊣ H
-    
-  step : ∀ {H H′ H″ B B′ B″} →
-    H ⊢ B ⟶ᴮ B′ ⊣ H′ →
-    H′ ⊢ B′ ⟶* B″ ⊣ H″ →
-    ------------------
-    H ⊢ B ⟶* B″ ⊣ H″

prototyping/Luau/ResolveOverloads.agda

@@ -1,98 +0,0 @@
-{-# OPTIONS --rewriting #-}
-
-module Luau.ResolveOverloads where
-
-open import FFI.Data.Either using (Left; Right)
-open import Luau.Subtyping using (_<:_; _≮:_; Language; witness; scalar; unknown; never; function-ok)
-open import Luau.Type using (Type ; _⇒_; _∩_; _∪_; unknown; never)
-open import Luau.TypeSaturation using (saturate)
-open import Luau.TypeNormalization using (normalize)
-open import Properties.Contradiction using (CONTRADICTION)
-open import Properties.DecSubtyping using (dec-subtyping; dec-subtypingⁿ; <:-impl-<:ᵒ)
-open import Properties.Functions using (_∘_)
-open import Properties.Subtyping using (<:-refl; <:-trans; <:-trans-≮:; ≮:-trans-<:; <:-∩-left; <:-∩-right; <:-∩-glb; <:-impl-¬≮:; <:-unknown; <:-function; function-≮:-never; <:-never; unknown-≮:-function; scalar-≮:-function; ≮:-∪-right; scalar-≮:-never; <:-∪-left; <:-∪-right)
-open import Properties.TypeNormalization using (Normal; FunType; normal; _⇒_; _∩_; _∪_; never; unknown; <:-normalize; normalize-<:; fun-≮:-never; unknown-≮:-fun; scalar-≮:-fun)
-open import Properties.TypeSaturation using (Overloads; Saturated; _⊆ᵒ_; _<:ᵒ_; normal-saturate; saturated; <:-saturate; saturate-<:; defn; here; left; right)
-
--- 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)
-
--- Calculate the result of applying a function type `F` to an argument type `V`.
--- We do this by finding an overload of `F` that has the most precise type,
--- that is an overload `(Sʳ ⇒ Tʳ)` where `V <: Sʳ` and moreover
--- for any other such overload `(S ⇒ T)` we have that `Tʳ <: T`.
-
--- For example if `F` is `(number -> number) & (nil -> nil) & (number? -> number?)`
--- then to resolve `F` with argument type `number`, we pick the `number -> number`
--- overload, but if the argument is `number?`, we pick `number? -> number?`./
-
--- Not all types have such a most precise overload, but saturated ones do.
-
-data ResolvedTo F G V : Set where
-
-  yes : ∀ Sʳ Tʳ →
-
-    Overloads F (Sʳ ⇒ Tʳ) →
-    (V <: Sʳ) → 
-    (∀ {S T} → Overloads G (S ⇒ T) → (V <: S) → (Tʳ <: T)) →
-    --------------------------------------------
-    ResolvedTo F G V
-
-  no :
-
-    (∀ {S T} → Overloads G (S ⇒ T) → (V ≮: S)) →
-    --------------------------------------------
-    ResolvedTo F G V
-
-Resolved : Type → Type → Set
-Resolved F V = ResolvedTo F F V
-
-target : ∀ {F V} → Resolved F V → Type
-target (yes _ T _ _ _) = T
-target (no _) = unknown
-
--- We can resolve any saturated function type
-resolveˢ : ∀ {F G V} → FunType G → Saturated F → Normal V → (G ⊆ᵒ F) → ResolvedTo F G V
-resolveˢ (Sⁿ ⇒ Tⁿ) (defn sat-∩ sat-∪) Vⁿ G⊆F with dec-subtypingⁿ Vⁿ Sⁿ
-resolveˢ (Sⁿ ⇒ Tⁿ) (defn sat-∩ sat-∪) Vⁿ G⊆F | Left V≮:S = no (λ { here → V≮:S })
-resolveˢ (Sⁿ ⇒ Tⁿ) (defn sat-∩ sat-∪) Vⁿ G⊆F | Right V<:S = yes _ _ (G⊆F here) V<:S (λ { here _ → <:-refl })
-resolveˢ (Gᶠ ∩ Hᶠ) (defn sat-∩ sat-∪) Vⁿ G⊆F with resolveˢ Gᶠ (defn sat-∩ sat-∪) Vⁿ (G⊆F ∘ left) | resolveˢ Hᶠ (defn sat-∩ sat-∪) Vⁿ (G⊆F ∘ right)
-resolveˢ (Gᶠ ∩ Hᶠ) (defn sat-∩ sat-∪) Vⁿ G⊆F | yes S₁ T₁ o₁ V<:S₁ tgt₁ | yes S₂ T₂ o₂ V<:S₂ tgt₂ with sat-∩ o₁ o₂
-resolveˢ (Gᶠ ∩ Hᶠ) (defn sat-∩ sat-∪) Vⁿ G⊆F | yes S₁ T₁ o₁ V<:S₁ tgt₁ | yes S₂ T₂ o₂ V<:S₂ tgt₂ | defn o p₁ p₂ =
-  yes _ _ o (<:-trans (<:-∩-glb V<:S₁ V<:S₂) p₁) (λ { (left o) p → <:-trans p₂ (<:-trans <:-∩-left (tgt₁ o p)) ; (right o) p → <:-trans p₂ (<:-trans <:-∩-right (tgt₂ o p)) })
-resolveˢ (Gᶠ ∩ Hᶠ) (defn sat-∩ sat-∪) Vⁿ G⊆F | yes S₁ T₁ o₁ V<:S₁ tgt₁ | no src₂ =
-  yes _ _ o₁ V<:S₁ (λ { (left o) p → tgt₁ o p ; (right o) p → CONTRADICTION (<:-impl-¬≮: p (src₂ o)) })
-resolveˢ (Gᶠ ∩ Hᶠ) (defn sat-∩ sat-∪) Vⁿ G⊆F | no src₁ | yes S₂ T₂ o₂ V<:S₂ tgt₂ =
-  yes _ _ o₂ V<:S₂ (λ { (left o) p → CONTRADICTION (<:-impl-¬≮: p (src₁ o)) ; (right o) p → tgt₂ o p })
-resolveˢ (Gᶠ ∩ Hᶠ) (defn sat-∩ sat-∪) Vⁿ G⊆F | no src₁ | no src₂ =
-  no (λ { (left o) → src₁ o ; (right o) → src₂ o })
-
--- Which means we can resolve any normalized type, by saturating it first
-resolveᶠ : ∀ {F V} → FunType F → Normal V → Type
-resolveᶠ Fᶠ Vⁿ = target (resolveˢ (normal-saturate Fᶠ) (saturated Fᶠ) Vⁿ (λ o → o))
-
-resolveⁿ : ∀ {F V} → Normal F → Normal V → Type
-resolveⁿ (Sⁿ ⇒ Tⁿ) Vⁿ = resolveᶠ (Sⁿ ⇒ Tⁿ) Vⁿ
-resolveⁿ (Fᶠ ∩ Gᶠ) Vⁿ = resolveᶠ (Fᶠ ∩ Gᶠ) Vⁿ
-resolveⁿ (Sⁿ ∪ Tˢ) Vⁿ = unknown
-resolveⁿ unknown Vⁿ = unknown
-resolveⁿ never Vⁿ = never
-
--- Which means we can resolve any type, by normalizing it first
-resolve : Type → Type → Type
-resolve F V = resolveⁿ (normal F) (normal V)

prototyping/Luau/Run.agda

@@ -1,29 +0,0 @@
-{-# OPTIONS --rewriting #-}
-
-module Luau.Run where
-
-open import Agda.Builtin.Equality using (_≡_; refl)
-open import Luau.Heap using (Heap; ∅)
-open import Luau.Syntax using (Block; val; return; _∙_; done)
-open import Luau.OpSem using (_⊢_⟶*_⊣_; refl; step)
-open import Properties.Step using (stepᴮ; step; return; done; error)
-open import Luau.RuntimeError using (RuntimeErrorᴮ)
-
-data RunResult {a} (H : Heap a) (B : Block a) : Set where
-  return : ∀ v {B′ H′} → (H ⊢ B ⟶* (return (val v) ∙ B′) ⊣ H′) → RunResult H B
-  done : ∀ {H′} → (H ⊢ B ⟶* done ⊣ H′) → RunResult H B
-  error : ∀ {B′ H′} → (RuntimeErrorᴮ H′ B′) → (H ⊢ B ⟶* B′ ⊣ H′) → RunResult H B
-
-{-# TERMINATING #-}
-run′ : ∀ {a} H B → RunResult {a} H B
-run′ H B with stepᴮ H B
-run′ H B | step H′ B′ D with run′ H′ B′
-run′ H B | step H′ B′ D | return V D′  = return V (step D D′)
-run′ H B | step H′ B′ D | done D′ = done (step D D′)
-run′ H B | step H′ B′ D | error E D′ = error E (step D D′)
-run′ H _ | return V refl = return V refl
-run′ H _ | done refl = done refl
-run′ H B | error E = error E refl
-
-run : ∀ {a} B → RunResult {a} ∅ B
-run = run′ ∅

prototyping/Luau/RuntimeError.agda

@@ -1,41 +0,0 @@
-{-# OPTIONS --rewriting #-}
-
-module Luau.RuntimeError where
-
-open import Agda.Builtin.Equality using (_≡_)
-open import Luau.Heap using (Heap; _[_])
-open import FFI.Data.Maybe using (just; nothing)
-open import FFI.Data.String using (String)
-open import Luau.Syntax using (BinaryOperator; Block; Expr; nil; var; val; addr; block_is_end; _$_; local_←_; return; done; _∙_; number; string; binexp; +; -; *; /; <; >; <=; >=; ··)
-open import Luau.RuntimeType using (RuntimeType; valueType; function; number; string)
-open import Properties.Equality using (_≢_)
-
-data BinOpError : BinaryOperator → RuntimeType → Set where
-  + : ∀ {t} → (t ≢ number) → BinOpError + t
-  - : ∀ {t} → (t ≢ number) → BinOpError - t
-  * : ∀ {t} → (t ≢ number) → BinOpError * t
-  / : ∀ {t} → (t ≢ number) → BinOpError / t
-  < : ∀ {t} → (t ≢ number) → BinOpError < t
-  > : ∀ {t} → (t ≢ number) → BinOpError > t
-  <= : ∀ {t} → (t ≢ number) → BinOpError <= t
-  >= : ∀ {t} → (t ≢ number) → BinOpError >= t
-  ·· : ∀ {t} → (t ≢ string) → BinOpError ·· t
-  
-data RuntimeErrorᴮ {a} (H : Heap a) : Block a → Set
-data RuntimeErrorᴱ {a} (H : Heap a) : Expr a → Set
-
-data RuntimeErrorᴱ H where
-  FunctionMismatch : ∀ v w → (valueType v ≢ function) → RuntimeErrorᴱ H (val v $ val w)
-  BinOpMismatch₁ : ∀ v w {op} → (BinOpError op (valueType v)) → RuntimeErrorᴱ H (binexp (val v) op (val w))
-  BinOpMismatch₂ : ∀ v w {op} → (BinOpError op (valueType w)) → RuntimeErrorᴱ H (binexp (val v) op (val w))
-  UnboundVariable : ∀ {x} → RuntimeErrorᴱ H (var x)
-  SEGV : ∀ {a} → (H [ a ] ≡ nothing) → RuntimeErrorᴱ H (val (addr a))
-  app₁ : ∀ {M N} → RuntimeErrorᴱ H M → RuntimeErrorᴱ H (M $ N)
-  app₂ : ∀ {M N} → RuntimeErrorᴱ H N → RuntimeErrorᴱ H (M $ N)
-  block : ∀ {b B} → RuntimeErrorᴮ H B → RuntimeErrorᴱ H (block b is B end)
-  bin₁ : ∀ {M N op} → RuntimeErrorᴱ H M → RuntimeErrorᴱ H (binexp M op N)
-  bin₂ : ∀ {M N op} → RuntimeErrorᴱ H N → RuntimeErrorᴱ H (binexp M op N)
-
-data RuntimeErrorᴮ H where
-  local : ∀ {x M B} → RuntimeErrorᴱ H M → RuntimeErrorᴮ H (local x ← M ∙ B)
-  return : ∀ {M B} → RuntimeErrorᴱ H M → RuntimeErrorᴮ H (return M ∙ B)

prototyping/Luau/RuntimeError/ToString.agda

@@ -1,31 +0,0 @@
-{-# OPTIONS --rewriting #-}
-
-module Luau.RuntimeError.ToString where
-
-open import Agda.Builtin.Float using (primShowFloat)
-open import FFI.Data.String using (String; _++_)
-open import Luau.RuntimeError using (RuntimeErrorᴮ; RuntimeErrorᴱ; local; return; FunctionMismatch; BinOpMismatch₁; BinOpMismatch₂; UnboundVariable; SEGV; app₁; app₂; block; bin₁; bin₂)
-open import Luau.RuntimeType.ToString using (runtimeTypeToString)
-open import Luau.Addr.ToString using (addrToString)
-open import Luau.Syntax.ToString using (valueToString; exprToString)
-open import Luau.Var.ToString using (varToString)
-open import Luau.Syntax using (var; val; addr; binexp; block_is_end; local_←_; return; _∙_; name; _$_; ··)
-
-errToStringᴱ : ∀ {a H} M → RuntimeErrorᴱ {a} H M → String
-errToStringᴮ : ∀ {a H} B → RuntimeErrorᴮ {a} H B → String
-
-errToStringᴱ (var x) (UnboundVariable) = "variable " ++ varToString x ++ " is unbound"
-errToStringᴱ (val (addr a)) (SEGV p) = "address " ++ addrToString a ++ " is unallocated"
-errToStringᴱ (M $ N) (FunctionMismatch v w p) = "value " ++ (valueToString v) ++ " is not a function"
-errToStringᴱ (M $ N) (app₁ E) = errToStringᴱ M E
-errToStringᴱ (M $ N) (app₂ E) = errToStringᴱ N E
-errToStringᴱ (binexp M ·· N) (BinOpMismatch₁ v w p) = "value " ++ (valueToString v) ++ " is not a string"
-errToStringᴱ (binexp M ·· N) (BinOpMismatch₂ v w p) = "value " ++ (valueToString w) ++ " is not a string"
-errToStringᴱ (binexp M op N) (BinOpMismatch₁ v w p) = "value " ++ (valueToString v) ++ " is not a number"
-errToStringᴱ (binexp M op N) (BinOpMismatch₂ v w p) = "value " ++ (valueToString w) ++ " is not a number"
-errToStringᴱ (binexp M op N) (bin₁ E) = errToStringᴱ M E
-errToStringᴱ (binexp M op N) (bin₂ E) = errToStringᴱ N E
-errToStringᴱ (block b is B end) (block E) = errToStringᴮ B E ++ "\n  in call of function " ++ varToString (name b)
-
-errToStringᴮ (local x ← M ∙ B) (local E) = errToStringᴱ M E ++ "\n  in definition of " ++ varToString (name x) 
-errToStringᴮ (return M ∙ B) (return E) = errToStringᴱ M E ++ "\n  in return statement"

prototyping/Luau/RuntimeType.agda

@@ -1,17 +0,0 @@
-module Luau.RuntimeType where
-
-open import Luau.Syntax using (Value; nil; addr; number; bool; string)
-
-data RuntimeType : Set where
-  function : RuntimeType
-  number : RuntimeType
-  nil : RuntimeType
-  boolean : RuntimeType
-  string : RuntimeType
-
-valueType : Value → RuntimeType
-valueType nil = nil
-valueType (addr a) = function
-valueType (number n) = number
-valueType (bool b) = boolean
-valueType (string x) = string

prototyping/Luau/RuntimeType/ToString.agda

@@ -1,11 +0,0 @@
-module Luau.RuntimeType.ToString where
-
-open import FFI.Data.String using (String)
-open import Luau.RuntimeType using (RuntimeType; function; number; nil; boolean; string)
-
-runtimeTypeToString : RuntimeType → String
-runtimeTypeToString function = "function"
-runtimeTypeToString number = "number"
-runtimeTypeToString nil = "nil"
-runtimeTypeToString boolean = "boolean"
-runtimeTypeToString string = "string"

prototyping/Luau/StrictMode.agda

@@ -1,194 +0,0 @@
-{-# OPTIONS --rewriting #-}
-
-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; _⇒_; _∪_; _∩_)
-open import Luau.ResolveOverloads using (src; resolve)
-open import Luau.Subtyping using (_≮:_)
-open import Luau.Heap using (Heap; function_is_end) renaming (_[_] to _[_]ᴴ)
-open import Luau.VarCtxt using (VarCtxt; ∅; _⋒_; _↦_; _⊕_↦_; _⊝_) renaming (_[_] to _[_]ⱽ)
-open import Luau.TypeCheck using (_⊢ᴮ_∈_; _⊢ᴱ_∈_; ⊢ᴴ_; ⊢ᴼ_; _⊢ᴴᴱ_▷_∈_; _⊢ᴴᴮ_▷_∈_; var; addr; app; binexp; block; return; local; function; srcBinOp)
-open import Properties.Contradiction using (¬)
-open import Properties.TypeCheck using (typeCheckᴮ)
-open import Properties.Product using (_,_)
-
-data Warningᴱ (H : Heap yes) {Γ} : ∀ {M T} → (Γ ⊢ᴱ M ∈ T) → Set
-data Warningᴮ (H : Heap yes) {Γ} : ∀ {B T} → (Γ ⊢ᴮ B ∈ T) → Set
-
-data Warningᴱ H {Γ} where
-
-  UnallocatedAddress : ∀ {a T} →
-
-    (H [ a ]ᴴ ≡ nothing) →
-    ---------------------
-    Warningᴱ H (addr {a} T)
-
-  UnboundVariable : ∀ {x T p} →
-
-    (Γ [ x ]ⱽ ≡ nothing) →
-    ------------------------
-    Warningᴱ H (var {x} {T} p)
-
-  FunctionCallMismatch : ∀ {M N T U} {D₁ : Γ ⊢ᴱ M ∈ T} {D₂ : Γ ⊢ᴱ N ∈ U} →
-
-    (U ≮: src T) →
-    -----------------
-    Warningᴱ H (app D₁ D₂)
-  
-  app₁ : ∀ {M N T U} {D₁ : Γ ⊢ᴱ M ∈ T} {D₂ : Γ ⊢ᴱ N ∈ U} →
-
-    Warningᴱ H D₁ →
-    -----------------
-    Warningᴱ H (app D₁ D₂)
-
-  app₂ : ∀ {M N T U} {D₁ : Γ ⊢ᴱ M ∈ T} {D₂ : Γ ⊢ᴱ N ∈ U} →
-
-    Warningᴱ H D₂ →
-    -----------------
-    Warningᴱ H (app D₁ D₂)
-
-  BinOpMismatch₁ : ∀ {op M N T U} {D₁ : Γ ⊢ᴱ M ∈ T} {D₂ : Γ ⊢ᴱ N ∈ U} →
-
-    (T ≮: srcBinOp op) →
-    ------------------------------
-    Warningᴱ H (binexp {op} D₁ D₂)
-
-  BinOpMismatch₂ : ∀ {op M N T U} {D₁ : Γ ⊢ᴱ M ∈ T} {D₂ : Γ ⊢ᴱ N ∈ U} →
-
-    (U ≮: srcBinOp op) →
-    ------------------------------
-    Warningᴱ H (binexp {op} D₁ D₂)
-
-  bin₁ : ∀ {op M N T U} {D₁ : Γ ⊢ᴱ M ∈ T} {D₂ : Γ ⊢ᴱ N ∈ U} →
-
-    Warningᴱ H D₁ →    
-    ------------------------------
-    Warningᴱ H (binexp {op} D₁ D₂)
-
-  bin₂ : ∀ {op M N T U} {D₁ : Γ ⊢ᴱ M ∈ T} {D₂ : Γ ⊢ᴱ N ∈ U} →
-
-    Warningᴱ H D₂ →    
-    ------------------------------
-    Warningᴱ H (binexp {op} D₁ D₂)
-    
-  FunctionDefnMismatch : ∀ {f x B T U V} {D : (Γ ⊕ x ↦ T) ⊢ᴮ B ∈ V} →
-
-    (V ≮: U) →
-    -------------------------
-    Warningᴱ H (function {f} {U = U} D)
-
-  function₁ : ∀ {f x B T U V} {D : (Γ ⊕ x ↦ T) ⊢ᴮ B ∈ V} →
-
-    Warningᴮ H D →
-    -------------------------
-    Warningᴱ H (function {f} {U = U} D)
-
-  BlockMismatch : ∀ {b B T U} {D : Γ ⊢ᴮ B ∈ U} →
-
-    (U ≮: T) →
-    ------------------------------
-    Warningᴱ H (block {b} {T = T} D)
-
-  block₁ : ∀ {b B T U} {D : Γ ⊢ᴮ B ∈ U} →
-
-    Warningᴮ H D →
-    ------------------------------
-    Warningᴱ H (block {b} {T = T} D)
-
-data Warningᴮ H {Γ} where
-
-  return : ∀ {M B T U} {D₁ : Γ ⊢ᴱ M ∈ T} {D₂ : Γ ⊢ᴮ B ∈ U} →
-
-    Warningᴱ H D₁ →
-    ------------------
-    Warningᴮ H (return D₁ D₂)
-
-  LocalVarMismatch : ∀ {x M B T U V} {D₁ : Γ ⊢ᴱ M ∈ U} {D₂ : (Γ ⊕ x ↦ T) ⊢ᴮ B ∈ V} →
-
-    (U ≮: T) →
-    --------------------
-    Warningᴮ H (local D₁ D₂)
-
-  local₁ : ∀ {x M B T U V} {D₁ : Γ ⊢ᴱ M ∈ U} {D₂ : (Γ ⊕ x ↦ T) ⊢ᴮ B ∈ V} →
-
-    Warningᴱ H D₁ →
-    --------------------
-    Warningᴮ H (local D₁ D₂)
-
-  local₂ : ∀ {x M B T U V} {D₁ : Γ ⊢ᴱ M ∈ U} {D₂ : (Γ ⊕ x ↦ T) ⊢ᴮ B ∈ V} →
-
-    Warningᴮ H D₂ →
-    --------------------
-    Warningᴮ H (local D₁ D₂)
-
-  FunctionDefnMismatch : ∀ {f x B C T U V W} {D₁ : (Γ ⊕ x ↦ T) ⊢ᴮ C ∈ V} {D₂ : (Γ ⊕ f ↦ (T ⇒ U)) ⊢ᴮ B ∈ W} →
-
-    (V ≮: U) →
-    -------------------------------------
-    Warningᴮ H (function D₁ D₂)
-
-  function₁ : ∀ {f x B C T U V W} {D₁ : (Γ ⊕ x ↦ T) ⊢ᴮ C ∈ V} {D₂ : (Γ ⊕ f ↦ (T ⇒ U)) ⊢ᴮ B ∈ W} →
-
-    Warningᴮ H D₁ →
-    --------------------
-    Warningᴮ H (function D₁ D₂)
-
-  function₂ : ∀ {f x B C T U V W} {D₁ : (Γ ⊕ x ↦ T) ⊢ᴮ C ∈ V} {D₂ : (Γ ⊕ f ↦ (T ⇒ U)) ⊢ᴮ B ∈ W} →
-
-    Warningᴮ H D₂ →
-    --------------------
-    Warningᴮ H (function D₁ D₂)
-
-data Warningᴼ (H : Heap yes) : ∀ {V} → (⊢ᴼ V) → Set where
-
-  FunctionDefnMismatch : ∀ {f x B T U V} {D : (x ↦ T) ⊢ᴮ B ∈ V} →
-
-    (V ≮: U) →
-    ---------------------------------
-    Warningᴼ H (function {f} {U = U} D)
-
-  function₁ : ∀ {f x B T U V} {D : (x ↦ T) ⊢ᴮ B ∈ V} →
-
-    Warningᴮ H D →
-    ---------------------------------
-    Warningᴼ H (function {f} {U = U} D)
-
-data Warningᴴ H (D : ⊢ᴴ H) : Set where
-
-  addr : ∀ a {O} →
-
-    (p : H [ a ]ᴴ ≡ O) →
-    Warningᴼ H (D a p) →
-    ---------------
-    Warningᴴ H D
-
-data Warningᴴᴱ H {Γ M T} : (Γ ⊢ᴴᴱ H ▷ M ∈ T) → Set where
-
-  heap : ∀ {D₁ : ⊢ᴴ H} {D₂ : Γ ⊢ᴱ M ∈ T} →
-
-    Warningᴴ H D₁ →
-    -----------------
-    Warningᴴᴱ H (D₁ , D₂)
-
-  expr : ∀ {D₁ : ⊢ᴴ H} {D₂ : Γ ⊢ᴱ M ∈ T} →
-
-    Warningᴱ H D₂ →
-    ---------------------
-    Warningᴴᴱ H (D₁ , D₂)
-
-data Warningᴴᴮ H {Γ B T} : (Γ ⊢ᴴᴮ H ▷ B ∈ T) → Set where
-
-  heap : ∀ {D₁ : ⊢ᴴ H} {D₂ : Γ ⊢ᴮ B ∈ T} →
-
-    Warningᴴ H D₁ →
-    -----------------
-    Warningᴴᴮ H (D₁ , D₂)
-
-  block : ∀ {D₁ : ⊢ᴴ H} {D₂ : Γ ⊢ᴮ B ∈ T} →
-
-    Warningᴮ H D₂ →
-    ---------------------
-    Warningᴴᴮ H (D₁ , D₂)

prototyping/Luau/StrictMode/ToString.agda

@@ -1,61 +0,0 @@
-{-# OPTIONS --rewriting #-}
-
-module Luau.StrictMode.ToString where
-
-open import Agda.Builtin.Nat using (Nat; suc)
-open import FFI.Data.String using (String; _++_)
-open import Luau.Subtyping using (_≮:_; Tree; witness; scalar; function; function-ok; function-err; function-tgt)
-open import Luau.StrictMode using (Warningᴱ; Warningᴮ; UnallocatedAddress; UnboundVariable; FunctionCallMismatch; FunctionDefnMismatch; BlockMismatch; app₁; app₂; BinOpMismatch₁; BinOpMismatch₂; bin₁; bin₂; block₁; return; LocalVarMismatch; local₁; local₂; function₁; function₂; heap; expr; block; addr)
-open import Luau.Syntax using (Expr; val; yes; var; var_∈_; _⟨_⟩∈_; _$_; addr; number; binexp; nil; function_is_end; block_is_end; done; return; local_←_; _∙_; fun; arg; name)
-open import Luau.Type using (number; boolean; string; nil)
-open import Luau.TypeCheck using (_⊢ᴮ_∈_; _⊢ᴱ_∈_)
-open import Luau.Addr.ToString using (addrToString)
-open import Luau.Var.ToString using (varToString)
-open import Luau.Type.ToString using (typeToString)
-open import Luau.Syntax.ToString using (binOpToString)
-
-tmp : Nat → String
-tmp 0 = "w"
-tmp 1 = "x"
-tmp 2 = "y"
-tmp 3 = "z"
-tmp (suc (suc (suc n))) = tmp n ++ "'"
-
-treeToString : Tree → Nat → String → String
-treeToString (scalar number) n v = v ++ " is a number"
-treeToString (scalar boolean) n v = v ++ " is a boolean"
-treeToString (scalar string) n v = v ++ " is a string"
-treeToString (scalar nil) n v = v ++ " is nil"
-treeToString function n v = v ++ " is a function"
-treeToString (function-ok s t) n v = treeToString t (suc n) (v ++ "(" ++ w ++ ")") ++ " when\n  " ++ treeToString s (suc n) w where w = tmp n
-treeToString (function-err t) n v = v ++ "(" ++ w ++ ") can error when\n  " ++ treeToString t (suc n) w where w = tmp n
-treeToString (function-tgt t) n v = treeToString t n (v ++ "()")
-
-subtypeWarningToString : ∀ {T U} → (T ≮: U) → String
-subtypeWarningToString (witness t p q) = "\n  because provided type contains v, where " ++ treeToString t 0 "v"
-
-warningToStringᴱ : ∀ {H Γ T} M → {D : Γ ⊢ᴱ M ∈ T} → Warningᴱ H D → String
-warningToStringᴮ : ∀ {H Γ T} B → {D : Γ ⊢ᴮ B ∈ T} → Warningᴮ H D → String
-
-warningToStringᴱ (var x) (UnboundVariable p) = "Unbound variable " ++ varToString x
-warningToStringᴱ (val (addr a)) (UnallocatedAddress p) = "Unallocated address " ++ addrToString a
-warningToStringᴱ (M $ N) (FunctionCallMismatch {T = T} {U = U} p) = "Function has type " ++ typeToString T ++ " but argument has type " ++ typeToString U ++ subtypeWarningToString p
-warningToStringᴱ (M $ N) (app₁ W) = warningToStringᴱ M W
-warningToStringᴱ (M $ N) (app₂ W) = warningToStringᴱ N W
-warningToStringᴱ (function f ⟨ var x ∈ T ⟩∈ U is B end) (FunctionDefnMismatch {V = V} p) = "Function expresion " ++ varToString f ++ " has return type " ++ typeToString U ++ " but body returns " ++ typeToString V ++ subtypeWarningToString p
-warningToStringᴱ (function f ⟨ var x ∈ T ⟩∈ U is B end) (function₁ W) = warningToStringᴮ B W ++ "\n  in function expression " ++ varToString f
-warningToStringᴱ block var b ∈ T is B end (BlockMismatch {U = U} p) =  "Block " ++ varToString b ++ " has type " ++ typeToString T ++ " but body returns " ++ typeToString U ++ subtypeWarningToString p
-warningToStringᴱ block var b ∈ T is B end (block₁ W) = warningToStringᴮ B W ++ "\n  in block " ++ varToString b
-warningToStringᴱ (binexp M op N) (BinOpMismatch₁ {T = T} p) = "Binary operator " ++ binOpToString op ++ " lhs has type " ++ typeToString T ++ subtypeWarningToString p
-warningToStringᴱ (binexp M op N) (BinOpMismatch₂ {U = U} p) = "Binary operator " ++ binOpToString op ++ " rhs has type " ++ typeToString U ++ subtypeWarningToString p
-warningToStringᴱ (binexp M op N) (bin₁ W) = warningToStringᴱ M W
-warningToStringᴱ (binexp M op N) (bin₂ W) = warningToStringᴱ N W
-
-warningToStringᴮ (function f ⟨ var x ∈ T ⟩∈ U is C end ∙ B) (FunctionDefnMismatch {V = V} p) = "Function declaration " ++ varToString f ++ " has return type " ++ typeToString U ++ " but body returns " ++ typeToString V ++ subtypeWarningToString p
-warningToStringᴮ (function f ⟨ var x ∈ T ⟩∈ U is C end ∙ B) (function₁ W) = warningToStringᴮ C W ++ "\n  in function declaration " ++ varToString f
-warningToStringᴮ (function f ⟨ var x ∈ T ⟩∈ U is C end ∙ B) (function₂ W) = warningToStringᴮ B W
-warningToStringᴮ (local var x ∈ T ← M ∙ B) (LocalVarMismatch {U = U} p) =  "Local variable " ++ varToString x ++ " has type " ++ typeToString T ++ " but expression has type " ++ typeToString U ++ subtypeWarningToString p
-warningToStringᴮ (local var x ∈ T ← M ∙ B) (local₁ W) = warningToStringᴱ M W ++ "\n  in local variable declaration " ++ varToString x
-warningToStringᴮ (local var x ∈ T ← M ∙ B) (local₂ W) = warningToStringᴮ B W
-warningToStringᴮ (return M ∙ B) (return W) = warningToStringᴱ M W ++ "\n  in return statement"
-

prototyping/Luau/Substitution.agda

@@ -1,28 +0,0 @@
-module Luau.Substitution where
-
-open import Luau.Syntax using (Value; Expr; Stat; Block; val; nil; bool; addr; var; function_is_end; _$_; block_is_end; local_←_; _∙_; done; return; _⟨_⟩ ; name; fun; arg; number; binexp)
-open import Luau.Var using (Var; _≡ⱽ_)
-open import Properties.Dec using (Dec; yes; no)
-
-_[_/_]ᴱ : ∀ {a} → Expr a → Value → Var → Expr a
-_[_/_]ᴮ : ∀ {a} → Block a → Value → Var → Block a
-var_[_/_]ᴱwhenever_ : ∀ {a P} → Var → Value → Var → (Dec P) → Expr a
-_[_/_]ᴮunless_ : ∀ {a P} → Block a → Value → Var → (Dec P) → Block a
-
-val w [ v / x ]ᴱ = val w
-var y [ v / x ]ᴱ = var y [ v / x ]ᴱwhenever (x ≡ⱽ y)
-(M $ N) [ v / x ]ᴱ = (M [ v / x ]ᴱ) $ (N [ v / x ]ᴱ)
-function F is C end [ v / x ]ᴱ = function F is C [ v / x ]ᴮunless (x ≡ⱽ name(arg F)) end
-block b is C end [ v / x ]ᴱ = block b is C [ v / x ]ᴮ end
-(binexp e₁ op e₂) [ v / x ]ᴱ = binexp (e₁ [ v / x ]ᴱ) op (e₂ [ v / x ]ᴱ)
-
-(function F is C end ∙ B) [ v / x ]ᴮ = function F is (C [ v / x ]ᴮunless (x ≡ⱽ name(arg F))) end ∙ (B [ v / x ]ᴮunless (x ≡ⱽ name(fun F)))
-(local y ← M ∙ B) [ v / x ]ᴮ = local y ← (M [ v / x ]ᴱ) ∙ (B [ v / x ]ᴮunless (x ≡ⱽ name y))
-(return M ∙ B) [ v / x ]ᴮ = return (M [ v / x ]ᴱ) ∙ (B [ v / x ]ᴮ)
-done [ v / x ]ᴮ = done
-
-var y [ v / x ]ᴱwhenever yes p = val v
-var y [ v / x ]ᴱwhenever no p = var y
-
-B [ v / x ]ᴮunless yes p = B
-B [ v / x ]ᴮunless no p = B [ v / x ]ᴮ

prototyping/Luau/Subtyping.agda

@@ -1,67 +0,0 @@
-{-# OPTIONS --rewriting #-}
-
-open import Luau.Type using (Type; Scalar; nil; number; string; boolean; never; unknown; _⇒_; _∪_; _∩_)
-open import Properties.Equality using (_≢_)
-
-module Luau.Subtyping where
-
--- An implementation of semantic subtyping
-
--- We think of types as languages of trees
-
-data Tree : Set where
-
-  scalar : ∀ {T} → Scalar T → Tree
-  function : Tree
-  function-ok : Tree → Tree → Tree
-  function-err : Tree → Tree
-  function-tgt : Tree → Tree
-
-data Language : Type → Tree → Set
-data ¬Language : Type → Tree → Set
-
-data Language where
-
-  scalar : ∀ {T} → (s : Scalar T) → Language T (scalar s)
-  function : ∀ {T U} → Language (T ⇒ U) function
-  function-ok₁ : ∀ {T U t u} → (¬Language T t) → Language (T ⇒ U) (function-ok t u)
-  function-ok₂ : ∀ {T U t u} → (Language U u) → Language (T ⇒ U) (function-ok t u)
-  function-err : ∀ {T U t} → (¬Language T t) → Language (T ⇒ U) (function-err t)
-  function-tgt : ∀ {T U t} → (Language U t) → Language (T ⇒ U) (function-tgt 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
-  unknown : ∀ {t} → Language unknown t
-
-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 t u} → (Scalar S) → ¬Language S (function-ok t u)
-  scalar-function-err : ∀ {S t} → (Scalar S) → ¬Language S (function-err t)
-  scalar-function-tgt : ∀ {S t} → (Scalar S) → ¬Language S (function-tgt t)
-  function-scalar : ∀ {S T U} (s : Scalar S) → ¬Language (T ⇒ U) (scalar s)
-  function-ok : ∀ {T U t u} → (Language T t) → (¬Language U u) → ¬Language (T ⇒ U) (function-ok t u)
-  function-err : ∀ {T U t} → (Language T t) → ¬Language (T ⇒ U) (function-err t)
-  function-tgt : ∀ {T U t} → (¬Language U t) → ¬Language (T ⇒ U) (function-tgt t)
-  _,_ : ∀ {T U t} → ¬Language T t → ¬Language U t → ¬Language (T ∪ U) t
-  left : ∀ {T U t} → ¬Language T t → ¬Language (T ∩ U) t
-  right : ∀ {T U u} → ¬Language U u → ¬Language (T ∩ U) u
-  never : ∀ {t} → ¬Language never t
-
--- Subtyping as language inclusion
-
-_<:_ : Type → Type → Set
-(T <: U) = ∀ t → (Language T t) → (Language U t)
-
--- For warnings, we are interested in failures of subtyping,
--- which is whrn there is a tree in T's language that isn't in U's.
-
-data _≮:_ (T U : Type) : Set where
-
-  witness : ∀ t →
-
-    Language T t →
-    ¬Language U t →
-    -----------------
-    T ≮: U

prototyping/Luau/Syntax.agda

@@ -1,110 +0,0 @@
-module Luau.Syntax where
-
-open import Agda.Builtin.Equality using (_≡_)
-open import Agda.Builtin.Bool using (Bool; true; false)
-open import Agda.Builtin.Float using (Float)
-open import Agda.Builtin.String using (String)
-open import Luau.Var using (Var)
-open import Luau.Addr using (Addr)
-open import Luau.Type using (Type)
-open import FFI.Data.Maybe using (Maybe; just; nothing)
-
-infixr 5 _∙_
-
-data Annotated : Set where
-  maybe : Annotated
-  yes : Annotated
-
-data VarDec : Annotated → Set where
-  var : Var → VarDec maybe
-  var_∈_ : ∀ {a} → Var → Type → VarDec a
-
-name : ∀ {a} → VarDec a → Var
-name (var x) = x
-name (var x ∈ T) = x
-
-data FunDec : Annotated → Set where
-  _⟨_⟩∈_ : ∀ {a} → Var → VarDec a → Type → FunDec a
-  _⟨_⟩ : Var → VarDec maybe → FunDec maybe
-
-fun : ∀ {a} → FunDec a → VarDec a
-fun (f ⟨ x ⟩∈ T) = (var f ∈ T)
-fun (f ⟨ x ⟩) = (var f)
-
-arg : ∀ {a} → FunDec a → VarDec a
-arg (f ⟨ x ⟩∈ T) = x
-arg (f ⟨ x ⟩) = x
-
-data BinaryOperator : Set where
-  + : BinaryOperator
-  - : BinaryOperator
-  * : BinaryOperator
-  / : BinaryOperator
-  < : BinaryOperator
-  > : BinaryOperator
-  == : BinaryOperator
-  ~= : BinaryOperator
-  <= : BinaryOperator
-  >= : BinaryOperator
-  ·· : BinaryOperator
-
-data Value : Set where
-  nil : Value
-  addr : Addr → Value
-  number : Float → Value
-  bool : Bool → Value
-  string : String → Value
-
-data Block (a : Annotated) : Set
-data Stat (a : Annotated) : Set
-data Expr (a : Annotated) : Set
-
-data Block a where
-  _∙_ : Stat a → Block a → Block a
-  done : Block a
-
-data Stat a where
-  function_is_end : FunDec a → Block a → Stat a
-  local_←_ : VarDec a → Expr a → Stat a
-  return : Expr a → Stat a
-
-data Expr a where
-  var : Var → Expr a
-  val : Value → Expr a
-  _$_ : Expr a → Expr a → Expr a
-  function_is_end : FunDec a → Block a → Expr a
-  block_is_end : VarDec a → Block a → Expr a
-  binexp : Expr a → BinaryOperator → Expr a → Expr a
-
-isAnnotatedᴱ : ∀ {a} → Expr a → Maybe (Expr yes)
-isAnnotatedᴮ : ∀ {a} → Block a → Maybe (Block yes)
-
-isAnnotatedᴱ (var x) = just (var x)
-isAnnotatedᴱ (val v) = just (val v)
-isAnnotatedᴱ (M $ N) with isAnnotatedᴱ M | isAnnotatedᴱ N
-isAnnotatedᴱ (M $ N) | just M′ | just N′ = just (M′ $ N′)
-isAnnotatedᴱ (M $ N) | _ | _ = nothing
-isAnnotatedᴱ (function f ⟨ var x ∈ T ⟩∈ U is B end) with isAnnotatedᴮ B
-isAnnotatedᴱ (function f ⟨ var x ∈ T ⟩∈ U is B end) | just B′ = just (function f ⟨ var x ∈ T ⟩∈ U is B′ end)
-isAnnotatedᴱ (function f ⟨ var x ∈ T ⟩∈ U is B end) | _ = nothing
-isAnnotatedᴱ (function _ is B end) = nothing
-isAnnotatedᴱ (block var b ∈ T is B end) with isAnnotatedᴮ B
-isAnnotatedᴱ (block var b ∈ T is B end) | just B′ = just (block var b ∈ T is B′ end)
-isAnnotatedᴱ (block var b ∈ T is B end) | _ = nothing
-isAnnotatedᴱ (block _ is B end) = nothing
-isAnnotatedᴱ (binexp M op N) with isAnnotatedᴱ M | isAnnotatedᴱ N
-isAnnotatedᴱ (binexp M op N) | just M′ | just N′ = just (binexp M′ op N′)
-isAnnotatedᴱ (binexp M op N) | _ | _ = nothing
-
-isAnnotatedᴮ (function f ⟨ var x ∈ T ⟩∈ U is C end ∙ B) with isAnnotatedᴮ B | isAnnotatedᴮ C
-isAnnotatedᴮ (function f ⟨ var x ∈ T ⟩∈ U is C end ∙ B) | just B′ | just C′ = just (function f ⟨ var x ∈ T ⟩∈ U is C′ end ∙ B′)
-isAnnotatedᴮ (function f ⟨ var x ∈ T ⟩∈ U is C end ∙ B) | _ | _ = nothing
-isAnnotatedᴮ (function _ is C end ∙ B) = nothing
-isAnnotatedᴮ (local var x ∈ T ← M ∙ B) with isAnnotatedᴱ M | isAnnotatedᴮ B
-isAnnotatedᴮ (local var x ∈ T ← M ∙ B) | just M′ | just B′ = just (local var x ∈ T ← M′ ∙ B′)
-isAnnotatedᴮ (local var x ∈ T ← M ∙ B) | _ | _ = nothing
-isAnnotatedᴮ (local _ ← M ∙ B) = nothing
-isAnnotatedᴮ (return M ∙ B) with isAnnotatedᴱ M | isAnnotatedᴮ B
-isAnnotatedᴮ (return M ∙ B) | just M′ | just B′ = just (return M′ ∙ B′)
-isAnnotatedᴮ (return M ∙ B) | _ | _ = nothing
-isAnnotatedᴮ done = just done

prototyping/Luau/Syntax/FromJSON.agda

@@ -1,201 +0,0 @@
-{-# OPTIONS --rewriting #-}
-
-module Luau.Syntax.FromJSON where
-
-open import Luau.Syntax using (Block; Stat ; Expr; _$_; val; nil; bool; number; var; var_∈_; function_is_end; _⟨_⟩; _⟨_⟩∈_; local_←_; return; done; _∙_; maybe; VarDec;  binexp; BinaryOperator; +; -; *; /; ==; ~=; <; >; <=; >=; ··; string)
-open import Luau.Type.FromJSON using (typeFromJSON)
-
-open import Agda.Builtin.List using (List; _∷_; [])
-open import Agda.Builtin.Bool using (true; false)
-
-open import FFI.Data.Aeson using (Value; Array; Object; object; array; string; fromString; lookup)
-open import FFI.Data.Either using (Either; Left; Right)
-open import FFI.Data.Maybe using (Maybe; nothing; just)
-open import FFI.Data.Scientific using (toFloat)
-open import FFI.Data.String using (String; _++_)
-open import FFI.Data.Vector using (head; tail; null; empty)
-
-args = fromString "args"
-body = fromString "body"
-func = fromString "func"
-lokal = fromString "local"
-list = fromString "list"
-name = fromString "name"
-type = fromString "type"
-value = fromString "value"
-values = fromString "values"
-vars = fromString "vars"
-op = fromString "op"
-left = fromString "left"
-right = fromString "right"
-returnAnnotation = fromString "returnAnnotation"
-types = fromString "types"
-
-data Lookup : Set where
-  _,_ : String → Value → Lookup
-  nil : Lookup
-
-lookupIn : List String → Object → Lookup
-lookupIn [] obj = nil
-lookupIn (key ∷ keys) obj with lookup (fromString key) obj
-lookupIn (key ∷ keys) obj | nothing = lookupIn keys obj
-lookupIn (key ∷ keys) obj | just value = (key , value)
-
-binOpFromJSON : Value → Either String BinaryOperator
-binOpFromString : String → Either String BinaryOperator
-varDecFromJSON : Value → Either String (VarDec maybe)
-varDecFromObject : Object → Either String (VarDec maybe)
-exprFromJSON : Value → Either String (Expr maybe)
-exprFromObject : Object → Either String (Expr maybe)
-statFromJSON : Value → Either String (Stat maybe)
-statFromObject : Object → Either String (Stat maybe)
-blockFromJSON : Value → Either String (Block maybe)
-blockFromArray : Array → Either String (Block maybe)
-
-binOpFromJSON (string s) = binOpFromString s
-binOpFromJSON _ = Left "Binary operator not a string"
-
-binOpFromString "Add" = Right +
-binOpFromString "Sub" = Right -
-binOpFromString "Mul" = Right *
-binOpFromString "Div" = Right /
-binOpFromString "CompareEq" = Right ==
-binOpFromString "CompareNe" = Right ~=
-binOpFromString "CompareLt" = Right <
-binOpFromString "CompareLe" = Right <=
-binOpFromString "CompareGt" = Right >
-binOpFromString "CompareGe" = Right >=
-binOpFromString "Concat" = Right ··
-binOpFromString s = Left ("'" ++ s ++ "' is not a valid operator")
-
-varDecFromJSON (object arg) = varDecFromObject arg
-varDecFromJSON _ = Left "VarDec not an object"
-
-varDecFromObject obj with lookup name obj | lookup type obj
-varDecFromObject obj | just (string name) | nothing = Right (var name)
-varDecFromObject obj | just (string name) | just Value.null = Right (var name)
-varDecFromObject obj | just (string name) | just tyValue with typeFromJSON tyValue
-varDecFromObject obj | just (string name) | just tyValue | Right ty = Right (var name ∈ ty)
-varDecFromObject obj | just (string name) | just tyValue | Left err = Left err
-varDecFromObject obj | just _ | _ = Left "AstLocal name is not a string"
-varDecFromObject obj | nothing | _ = Left "AstLocal missing name"
-
-exprFromJSON (object obj) = exprFromObject obj
-exprFromJSON _ = Left "AstExpr not an object"
-
-exprFromObject obj with lookup type obj
-exprFromObject obj | just (string "AstExprCall") with lookup func obj | lookup args obj
-exprFromObject obj | just (string "AstExprCall") | just value | just (array arr) with head arr
-exprFromObject obj | just (string "AstExprCall") | just value | just (array arr) | just value2 with exprFromJSON value | exprFromJSON value2
-exprFromObject obj | just (string "AstExprCall") | just value | just (array arr) | just value2 | Right fun | Right arg = Right (fun $ arg)
-exprFromObject obj | just (string "AstExprCall") | just value | just (array arr) | just value2 | Left err | _ = Left err
-exprFromObject obj | just (string "AstExprCall") | just value | just (array arr) | just value2 | _ | Left err = Left err
-exprFromObject obj | just (string "AstExprCall") | just value | just (array arr) | nothing = Left ("AstExprCall empty args")
-exprFromObject obj | just (string "AstExprCall") | just value | just _ = Left ("AstExprCall args not an array")
-exprFromObject obj | just (string "AstExprCall") | nothing | _  = Left ("AstExprCall missing func")
-exprFromObject obj | just (string "AstExprCall") | _ | nothing  = Left ("AstExprCall missing args")
-exprFromObject obj | just (string "AstExprConstantNil") = Right (val nil)
-exprFromObject obj | just (string "AstExprFunction") with lookup args obj | lookup body obj | lookup returnAnnotation obj
-exprFromObject obj | just (string "AstExprFunction") | just (array arr) | just blockValue | rtn with head arr | blockFromJSON blockValue
-exprFromObject obj | just (string "AstExprFunction") | just (array arr) | just blockValue | rtn | just argValue | Right B with varDecFromJSON argValue
-exprFromObject obj | just (string "AstExprFunction") | just (array arr) | just blockValue | just (object rtnObj) | just argValue | Right B | Right arg with lookup types rtnObj
-exprFromObject obj | just (string "AstExprFunction") | just (array arr) | just blockValue | just (object rtnObj) | just argValue | Right B | Right arg | just (array rtnTypes) with head rtnTypes
-exprFromObject obj | just (string "AstExprFunction") | just (array arr) | just blockValue | just (object rtnObj) | just argValue | Right B | Right arg | just (array rtnTypes) | just rtnType with typeFromJSON rtnType
-exprFromObject obj | just (string "AstExprFunction") | just (array arr) | just blockValue | just (object rtnObj) | just argValue | Right B | Right arg | just (array rtnTypes) | just rtnType | Left err = Left err
-exprFromObject obj | just (string "AstExprFunction") | just (array arr) | just blockValue | just (object rtnObj) | just argValue | Right B | Right arg | just (array rtnTypes) | just rtnType | Right T = Right (function "" ⟨ arg ⟩∈ T is B end)
-exprFromObject obj | just (string "AstExprFunction") | just (array arr) | just blockValue | just (object rtnObj) | just argValue | Right B | Right arg | just (array rtnTypes) | nothing = Right (function "" ⟨ arg ⟩ is B end)
-exprFromObject obj | just (string "AstExprFunction") | just (array arr) | just blockValue | just (object rtnObj) | just argValue | Right B | Right arg | just _ = Left "returnAnnotation types not an array"
-exprFromObject obj | just (string "AstExprFunction") | just (array arr) | just blockValue | just (object rtnObj) | just argValue | Right B | Right arg | nothing = Left "returnAnnotation missing types"
-exprFromObject obj | just (string "AstExprFunction") | just (array arr) | just blockValue | just _ | just argValue | Right B | Right arg  = Left "returnAnnotation not an object"
-exprFromObject obj | just (string "AstExprFunction") | just (array arr) | just blockValue | nothing | just argValue | Right B | Right arg = Right (function "" ⟨ arg ⟩ is B end)
-exprFromObject obj | just (string "AstExprFunction") | just (array arr) | just blockValue | rtn | just argValue | Right B | Left err = Left err
-exprFromObject obj | just (string "AstExprFunction") | just (array arr) | just blockValue | rtn | nothing | Right B = Left "Unsupported AstExprFunction empty args"
-exprFromObject obj | just (string "AstExprFunction") | just (array arr) | just blockValue | rtn | _ | Left err = Left err
-exprFromObject obj | just (string "AstExprFunction") | just _ | just _ | rtn = Left "AstExprFunction args not an array"
-exprFromObject obj | just (string "AstExprFunction") | nothing | _ | rtn = Left "AstExprFunction missing args"
-exprFromObject obj | just (string "AstExprFunction") | _ | nothing | rtn = Left "AstExprFunction missing body"
-exprFromObject obj | just (string "AstExprLocal") with lookup lokal obj
-exprFromObject obj | just (string "AstExprLocal") | just x with varDecFromJSON x
-exprFromObject obj | just (string "AstExprLocal") | just x | Right x′ = Right (var (Luau.Syntax.name x′))
-exprFromObject obj | just (string "AstExprLocal") | just x | Left err = Left err
-exprFromObject obj | just (string "AstExprLocal") | nothing = Left "AstExprLocal missing local"
-exprFromObject obj | just (string "AstExprConstantNumber") with lookup value obj
-exprFromObject obj | just (string "AstExprConstantNumber") | just (FFI.Data.Aeson.Value.number x) = Right (val (number (toFloat x)))
-exprFromObject obj | just (string "AstExprConstantNumber") | just _ = Left "AstExprConstantNumber value is not a number"
-exprFromObject obj | just (string "AstExprConstantNumber") | nothing = Left "AstExprConstantNumber missing value"
-exprFromObject obj | just (string "AstExprConstantString") with lookup value obj
-exprFromObject obj | just (string "AstExprConstantString") | just (string x) = Right (val (string x))
-exprFromObject obj | just (string "AstExprConstantString") | just _ = Left "AstExprConstantString value is not a string"
-exprFromObject obj | just (string "AstExprConstantString") | nothing = Left "AstExprConstantString missing value"
-exprFromObject obj | just (string "AstExprConstantBool") with lookup value obj
-exprFromObject obj | just (string "AstExprConstantBool") | just (FFI.Data.Aeson.Value.bool b) = Right (val (bool b))
-exprFromObject obj | just (string "AstExprConstantBool") | just _ = Left "AstExprConstantBool value is not a bool"
-exprFromObject obj | just (string "AstExprConstantBool") | nothing = Left "AstExprConstantBool missing value"
-exprFromObject obj | just (string "AstExprBinary") with lookup op obj | lookup left obj | lookup right obj
-exprFromObject obj | just (string "AstExprBinary") | just o | just l | just r with binOpFromJSON o | exprFromJSON l | exprFromJSON r
-exprFromObject obj | just (string "AstExprBinary") | just o | just l | just r | Right o′ | Right l′ | Right r′ = Right (binexp l′ o′ r′)
-exprFromObject obj | just (string "AstExprBinary") | just o | just l | just r | Left err | _ | _ = Left err
-exprFromObject obj | just (string "AstExprBinary") | just o | just l | just r | _ | Left err | _ = Left err
-exprFromObject obj | just (string "AstExprBinary") | just o | just l | just r | _ | _ | Left err = Left err
-exprFromObject obj | just (string "AstExprBinary") | nothing | _ | _ = Left "Missing 'op' in AstExprBinary"
-exprFromObject obj | just (string "AstExprBinary") | _ | nothing | _ = Left "Missing 'left' in AstExprBinary"
-exprFromObject obj | just (string "AstExprBinary") | _ | _ | nothing = Left "Missing 'right' in AstExprBinary"
-exprFromObject obj | just (string ty) = Left ("TODO: Unsupported AstExpr " ++ ty)
-exprFromObject obj | just _ = Left "AstExpr type not a string"
-exprFromObject obj | nothing = Left "AstExpr missing type"
-
-{-# NON_TERMINATING #-}
-statFromJSON (object obj) = statFromObject obj
-statFromJSON _ = Left "AstStat not an object"
-
-statFromObject obj with lookup type obj
-statFromObject obj | just(string "AstStatLocal") with lookup vars obj | lookup values obj
-statFromObject obj | just(string "AstStatLocal") | just(array arr1) | just(array arr2) with head(arr1) | head(arr2)
-statFromObject obj | just(string "AstStatLocal") | just(array arr1) | just(array arr2) | just(x) | just(value) with varDecFromJSON(x) | exprFromJSON(value)
-statFromObject obj | just(string "AstStatLocal") | just(array arr1) | just(array arr2) | just(x) | just(value) | Right x′ | Right M = Right (local x′ ← M)
-statFromObject obj | just(string "AstStatLocal") | just(array arr1) | just(array arr2) | just(x) | just(value) | Left err | _ = Left err
-statFromObject obj | just(string "AstStatLocal") | just(array arr1) | just(array arr2) | just(x) | just(value) | _ | Left err = Left err
-statFromObject obj | just(string "AstStatLocal") | just(array arr1) | just(array arr2) | just(x) | nothing = Left "AstStatLocal empty values"
-statFromObject obj | just(string "AstStatLocal") | just(array arr1) | just(array arr2) | nothing | _ = Left "AstStatLocal empty vars"
-statFromObject obj | just(string "AstStatLocal") | just(array arr1) | just(_) = Left "AstStatLocal values not an array"
-statFromObject obj | just(string "AstStatLocal") | just(_) | just(_) = Left "AstStatLocal vars not an array"
-statFromObject obj | just(string "AstStatLocal") | just(_) | nothing = Left "AstStatLocal missing values"
-statFromObject obj | just(string "AstStatLocal") | nothing | _ = Left "AstStatLocal missing vars"
-statFromObject obj | just(string "AstStatLocalFunction") with lookup name obj | lookup func obj
-statFromObject obj | just(string "AstStatLocalFunction") | just fnName | just value with varDecFromJSON fnName | exprFromJSON value
-statFromObject obj | just(string "AstStatLocalFunction") | just fnName | just value | Right fnVar | Right (function "" ⟨ x ⟩ is B end) = Right (function (Luau.Syntax.name fnVar) ⟨ x ⟩ is B end)
-statFromObject obj | just(string "AstStatLocalFunction") | just fnName | just value | Right fnVar | Right (function "" ⟨ x ⟩∈ T is B end) = Right (function (Luau.Syntax.name fnVar) ⟨ x ⟩∈ T is B end)
-statFromObject obj | just(string "AstStatLocalFunction") | just fnName | just value | Left err | _ = Left err
-statFromObject obj | just(string "AstStatLocalFunction") | just fnName | just value | _ | Left err = Left err
-statFromObject obj | just(string "AstStatLocalFunction") | just _ | just _ | Right _ | Right _ = Left "AstStatLocalFunction func is not an AstExprFunction"
-statFromObject obj | just(string "AstStatLocalFunction") | nothing | _ = Left "AstStatFunction missing name"
-statFromObject obj | just(string "AstStatLocalFunction") | _ | nothing = Left "AstStatFunction missing func"
-statFromObject obj | just(string "AstStatReturn") with lookup list obj
-statFromObject obj | just(string "AstStatReturn") | just(array arr) with head arr
-statFromObject obj | just(string "AstStatReturn") | just(array arr) | just value with exprFromJSON value
-statFromObject obj | just(string "AstStatReturn") | just(array arr) | just value | Right M = Right (return M)
-statFromObject obj | just(string "AstStatReturn") | just(array arr) | just value | Left err = Left err
-statFromObject obj | just(string "AstStatReturn") | just(array arr) | nothing = Left "AstStatReturn empty list"
-statFromObject obj | just(string "AstStatReturn") | just(_) = Left "AstStatReturn list not an array"
-statFromObject obj | just(string "AstStatReturn") | nothing = Left "AstStatReturn missing list"
-statFromObject obj | just (string ty) = Left ("TODO: Unsupported AstStat " ++ ty)
-statFromObject obj | just _ = Left "AstStat type not a string"
-statFromObject obj | nothing = Left "AstStat missing type"
-
-blockFromJSON (array arr) = blockFromArray arr
-blockFromJSON (object obj) with lookup type obj | lookup body obj
-blockFromJSON (object obj) | just (string "AstStatBlock") | just value = blockFromJSON value
-blockFromJSON (object obj) | just (string "AstStatBlock") | nothing = Left "AstStatBlock missing body"
-blockFromJSON (object obj) | just (string ty) | _ = Left ("Unsupported AstBlock " ++ ty)
-blockFromJSON (object obj) | just _ | _ = Left "AstStatBlock type not a string"
-blockFromJSON (object obj) | nothing | _ = Left "AstStatBlock missing type"
-blockFromJSON _ = Left "AstBlock not an array or AstStatBlock object"
-
-blockFromArray arr with head arr
-blockFromArray arr | nothing = Right done
-blockFromArray arr | just value with statFromJSON value
-blockFromArray arr | just value | Left err = Left err
-blockFromArray arr | just value | Right S with blockFromArray(tail arr)
-blockFromArray arr | just value | Right S | Left err = Left (err)
-blockFromArray arr | just value | Right S | Right B  = Right (S ∙ B)
-   

prototyping/Luau/Syntax/ToString.agda

@@ -1,83 +0,0 @@
-module Luau.Syntax.ToString where
-
-open import Agda.Builtin.Bool using (true; false)
-open import Agda.Builtin.Float using (primShowFloat)
-open import Agda.Builtin.String using (primShowString)
-open import Luau.Syntax using (Value; Block; Stat; Expr; VarDec; FunDec; nil; bool; val; var; var_∈_; addr; _$_; function_is_end; return; local_←_; _∙_; done; block_is_end; _⟨_⟩; _⟨_⟩∈_; number; BinaryOperator; +; -; *; /; <; >; ==; ~=; <=; >=; ··; binexp; string)
-open import FFI.Data.String using (String; _++_)
-open import Luau.Addr.ToString using (addrToString)
-open import Luau.Type.ToString using (typeToString)
-open import Luau.Var.ToString using (varToString)
-
-varDecToString : ∀ {a} → VarDec a → String
-varDecToString (var x) = varToString x
-varDecToString (var x ∈ T) =  varToString x ++ " : " ++ typeToString T
-
-funDecToString : ∀ {a} → FunDec a → String
-funDecToString ("" ⟨ x ⟩∈ T) = "function(" ++ varDecToString x ++ "): " ++ typeToString T
-funDecToString ("" ⟨ x ⟩) = "function(" ++ varDecToString x ++ ")"
-funDecToString (f ⟨ x ⟩∈ T) = "function " ++ varToString f ++ "(" ++ varDecToString x ++ "): " ++ typeToString T
-funDecToString (f ⟨ x ⟩) = "function " ++ varToString f ++ "(" ++ varDecToString x ++ ")"
-
-binOpToString : BinaryOperator → String
-binOpToString + = "+"
-binOpToString - = "-"
-binOpToString * = "*"
-binOpToString / = "/"
-binOpToString < = "<"
-binOpToString > = ">"
-binOpToString == = "=="
-binOpToString ~= = "~="
-binOpToString <= = "<="
-binOpToString >= = ">="
-binOpToString ·· = ".."
-
-valueToString : Value → String
-valueToString nil = "nil"
-valueToString (addr a) = addrToString a
-valueToString (number x) = primShowFloat x
-valueToString (bool false) = "false"
-valueToString (bool true) = "true"
-valueToString (string x) = primShowString x
-
-exprToString′ : ∀ {a} → String → Expr a → String
-statToString′ : ∀ {a} → String → Stat a → String
-blockToString′ : ∀ {a} → String → Block a → String
-
-exprToString′ lb (val v) =
-  valueToString(v)
-exprToString′ lb (var x) =
-  varToString(x)
-exprToString′ lb (M $ N) =
-  (exprToString′ lb M) ++ "(" ++ (exprToString′ lb N) ++ ")"
-exprToString′ lb (function F is B end) =
-  funDecToString F ++ lb ++
-  "  " ++ (blockToString′ (lb ++ "  ") B) ++ lb ++
-  "end"
-exprToString′ lb (block b is B end) =
-  "(" ++ varDecToString b ++ "()" ++ lb ++
-  "  " ++ (blockToString′ (lb ++ "  ") B) ++ lb ++
-  "end)()"
-exprToString′ lb (binexp x op y) = exprToString′ lb x ++ " " ++ binOpToString op ++ " " ++ exprToString′ lb y
-
-statToString′ lb (function F is B end) =
-  "local " ++ funDecToString F ++ lb ++
-  "  " ++ (blockToString′ (lb ++ "  ") B) ++ lb ++
-  "end"
-statToString′ lb (local x ← M) =
-  "local " ++ varDecToString x ++ " = " ++ (exprToString′ lb M)
-statToString′ lb (return M) =
-  "return " ++ (exprToString′ lb M)
-
-blockToString′ lb (S ∙ done) = statToString′ lb S
-blockToString′ lb (S ∙ B) = statToString′ lb S ++ lb ++ blockToString′ lb B
-blockToString′ lb (done) = ""
-
-exprToString : ∀ {a} → Expr a → String
-exprToString = exprToString′ "\n"
-
-statToString : ∀ {a} → Stat a → String
-statToString = statToString′ "\n"
-
-blockToString : ∀ {a} → Block a → String
-blockToString = blockToString′ "\n"

prototyping/Luau/Type.agda

@@ -1,164 +0,0 @@
-module Luau.Type where
-
-open import FFI.Data.Maybe using (Maybe; just; nothing; just-inv)
-open import Agda.Builtin.Equality using (_≡_; refl)
-open import Properties.Dec using (Dec; yes; no)
-open import Properties.Equality using (cong)
-open import FFI.Data.Maybe using (Maybe; just; nothing)
-
-data Type : Set where
-  nil : Type
-  _⇒_ : Type → Type → Type
-  never : Type
-  unknown : Type
-  boolean : Type
-  number : Type
-  string : Type
-  _∪_ : Type → Type → Type
-  _∩_ : Type → Type → Type
-
-data Scalar : Type → Set where
-
-  number : Scalar number
-  boolean : Scalar boolean
-  string : Scalar string
-  nil : Scalar nil
-
-skalar = number ∪ (string ∪ (nil ∪ boolean))
-
-lhs : Type → Type
-lhs (T ⇒ _) = T
-lhs (T ∪ _) = T
-lhs (T ∩ _) = T
-lhs nil = nil
-lhs never = never
-lhs unknown = unknown
-lhs number = number
-lhs boolean = boolean
-lhs string = string
-
-rhs : Type → Type
-rhs (_ ⇒ T) = T
-rhs (_ ∪ T) = T
-rhs (_ ∩ T) = T
-rhs nil = nil
-rhs never = never
-rhs unknown = unknown
-rhs number = number
-rhs boolean = boolean
-rhs string = string
-
-_≡ᵀ_ : ∀ (T U : Type) → Dec(T ≡ U)
-nil ≡ᵀ nil = yes refl
-nil ≡ᵀ (S ⇒ T) = no (λ ())
-nil ≡ᵀ never = no (λ ())
-nil ≡ᵀ unknown = no (λ ())
-nil ≡ᵀ number = no (λ ())
-nil ≡ᵀ boolean = no (λ ())
-nil ≡ᵀ (S ∪ T) = no (λ ())
-nil ≡ᵀ (S ∩ T) = no (λ ())
-nil ≡ᵀ string = no (λ ())
-(S ⇒ T) ≡ᵀ string = no (λ ())
-never ≡ᵀ string = no (λ ())
-unknown ≡ᵀ string = no (λ ())
-boolean ≡ᵀ string = no (λ ())
-number ≡ᵀ string = no (λ ())
-(S ∪ T) ≡ᵀ string = no (λ ())
-(S ∩ T) ≡ᵀ string = no (λ ())
-(S ⇒ T) ≡ᵀ nil = no (λ ())
-(S ⇒ T) ≡ᵀ (U ⇒ V) with (S ≡ᵀ U) | (T ≡ᵀ V) 
-(S ⇒ T) ≡ᵀ (S ⇒ T) | yes refl | yes refl = yes refl
-(S ⇒ T) ≡ᵀ (U ⇒ V) | _ | no p = no (λ q → p (cong rhs q))
-(S ⇒ T) ≡ᵀ (U ⇒ V) | no p | _ = no (λ q → p (cong lhs q))
-(S ⇒ T) ≡ᵀ never = no (λ ())
-(S ⇒ T) ≡ᵀ unknown = no (λ ())
-(S ⇒ T) ≡ᵀ number = no (λ ())
-(S ⇒ T) ≡ᵀ boolean = no (λ ())
-(S ⇒ T) ≡ᵀ (U ∪ V) = no (λ ())
-(S ⇒ T) ≡ᵀ (U ∩ V) = no (λ ())
-never ≡ᵀ nil = no (λ ())
-never ≡ᵀ (U ⇒ V) = no (λ ())
-never ≡ᵀ never = yes refl
-never ≡ᵀ unknown = no (λ ())
-never ≡ᵀ number = no (λ ())
-never ≡ᵀ boolean = no (λ ())
-never ≡ᵀ (U ∪ V) = no (λ ())
-never ≡ᵀ (U ∩ V) = no (λ ())
-unknown ≡ᵀ nil = no (λ ())
-unknown ≡ᵀ (U ⇒ V) = no (λ ())
-unknown ≡ᵀ never = no (λ ())
-unknown ≡ᵀ unknown = yes refl
-unknown ≡ᵀ number = no (λ ())
-unknown ≡ᵀ boolean = no (λ ())
-unknown ≡ᵀ (U ∪ V) = no (λ ())
-unknown ≡ᵀ (U ∩ V) = no (λ ())
-number ≡ᵀ nil = no (λ ())
-number ≡ᵀ (T ⇒ U) = no (λ ())
-number ≡ᵀ never = no (λ ())
-number ≡ᵀ unknown = no (λ ())
-number ≡ᵀ number = yes refl
-number ≡ᵀ boolean = no (λ ())
-number ≡ᵀ (T ∪ U) = no (λ ())
-number ≡ᵀ (T ∩ U) = no (λ ())
-boolean ≡ᵀ nil = no (λ ())
-boolean ≡ᵀ (T ⇒ U) = no (λ ())
-boolean ≡ᵀ never = no (λ ())
-boolean ≡ᵀ unknown = no (λ ())
-boolean ≡ᵀ boolean = yes refl
-boolean ≡ᵀ number = no (λ ())
-boolean ≡ᵀ (T ∪ U) = no (λ ())
-boolean ≡ᵀ (T ∩ U) = no (λ ())
-string ≡ᵀ nil = no (λ ())
-string ≡ᵀ (x ⇒ x₁) = no (λ ())
-string ≡ᵀ never = no (λ ())
-string ≡ᵀ unknown = no (λ ())
-string ≡ᵀ boolean = no (λ ())
-string ≡ᵀ number = no (λ ())
-string ≡ᵀ string = yes refl
-string ≡ᵀ (U ∪ V) = no (λ ())
-string ≡ᵀ (U ∩ V) = no (λ ())
-(S ∪ T) ≡ᵀ nil = no (λ ())
-(S ∪ T) ≡ᵀ (U ⇒ V) = no (λ ())
-(S ∪ T) ≡ᵀ never = no (λ ())
-(S ∪ T) ≡ᵀ unknown = no (λ ())
-(S ∪ T) ≡ᵀ number = no (λ ())
-(S ∪ T) ≡ᵀ boolean = no (λ ())
-(S ∪ T) ≡ᵀ (U ∪ V) with (S ≡ᵀ U) | (T ≡ᵀ V) 
-(S ∪ T) ≡ᵀ (S ∪ T) | yes refl | yes refl = yes refl
-(S ∪ T) ≡ᵀ (U ∪ V) | _ | no p = no (λ q → p (cong rhs q))
-(S ∪ T) ≡ᵀ (U ∪ V) | no p | _ = no (λ q → p (cong lhs q))
-(S ∪ T) ≡ᵀ (U ∩ V) = no (λ ())
-(S ∩ T) ≡ᵀ nil = no (λ ())
-(S ∩ T) ≡ᵀ (U ⇒ V) = no (λ ())
-(S ∩ T) ≡ᵀ never = no (λ ())
-(S ∩ T) ≡ᵀ unknown = no (λ ())
-(S ∩ T) ≡ᵀ number = no (λ ())
-(S ∩ T) ≡ᵀ boolean = no (λ ())
-(S ∩ T) ≡ᵀ (U ∪ V) = no (λ ())
-(S ∩ T) ≡ᵀ (U ∩ V) with (S ≡ᵀ U) | (T ≡ᵀ V) 
-(S ∩ T) ≡ᵀ (U ∩ V) | yes refl | yes refl = yes refl
-(S ∩ T) ≡ᵀ (U ∩ V) | _ | no p = no (λ q → p (cong rhs q))
-(S ∩ T) ≡ᵀ (U ∩ V) | no p | _ = no (λ q → p (cong lhs q))
-
-_≡ᴹᵀ_ : ∀ (T U : Maybe Type) → Dec(T ≡ U)
-nothing ≡ᴹᵀ nothing = yes refl
-nothing ≡ᴹᵀ just U = no (λ ())
-just T ≡ᴹᵀ nothing = no (λ ())
-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))
-
-optional : Type → Type
-optional nil = nil
-optional (T ∪ nil) = (T ∪ nil)
-optional T = (T ∪ nil)
-
-normalizeOptional : Type → Type
-normalizeOptional (S ∪ T) with normalizeOptional S | normalizeOptional T
-normalizeOptional (S ∪ T) | (S′ ∪ nil) | (T′ ∪ nil) = (S′ ∪ T′) ∪ nil
-normalizeOptional (S ∪ T) | S′         | (T′ ∪ nil) = (S′ ∪ T′) ∪ nil
-normalizeOptional (S ∪ T) | (S′ ∪ nil) | T′         = (S′ ∪ T′) ∪ nil
-normalizeOptional (S ∪ T) | S′         | nil        = optional S′
-normalizeOptional (S ∪ T) | nil        | T′         = optional T′
-normalizeOptional (S ∪ T) | S′         | T′         = S′ ∪ T′
-normalizeOptional T = T

prototyping/Luau/Type/FromJSON.agda

@@ -1,72 +0,0 @@
-{-# OPTIONS --rewriting #-}
-
-module Luau.Type.FromJSON where
-
-open import Luau.Type using (Type; nil; _⇒_; _∪_; _∩_; unknown; never; number; string)
-
-open import Agda.Builtin.List using (List; _∷_; [])
-open import Agda.Builtin.Bool using (true; false)
-
-open import FFI.Data.Aeson using (Value; Array; Object; object; array; string; fromString; lookup)
-open import FFI.Data.Either using (Either; Left; Right)
-open import FFI.Data.Maybe using (Maybe; nothing; just)
-open import FFI.Data.String using (String; _++_)
-open import FFI.Data.Vector using (head; tail; null; empty)
-
-name = fromString "name"
-type = fromString "type"
-argTypes = fromString "argTypes"
-returnTypes = fromString "returnTypes"
-types = fromString "types"
-
-{-# TERMINATING #-}
-typeFromJSON : Value → Either String Type
-compoundFromArray : (Type → Type → Type) → Array → Either String Type
-
-typeFromJSON (object o) with lookup type o
-typeFromJSON (object o) | just (string "AstTypeFunction") with lookup argTypes o | lookup returnTypes o
-typeFromJSON (object o) | just (string "AstTypeFunction") | just (object argsSet) | just (object retsSet) with lookup types argsSet | lookup types retsSet
-typeFromJSON (object o) | just (string "AstTypeFunction") | just (object argsSet) | just (object retsSet) | just (array args) | just (array rets) with head args | head rets
-typeFromJSON (object o) | just (string "AstTypeFunction") | just (object argsSet) | just (object retsSet) | just (array args) | just (array rets) | just argValue | just retValue with typeFromJSON argValue | typeFromJSON retValue
-typeFromJSON (object o) | just (string "AstTypeFunction") | just (object argsSet) | just (object retsSet) | just (array args) | just (array rets) | just argValue | just retValue | Right arg | Right ret = Right (arg ⇒ ret)
-typeFromJSON (object o) | just (string "AstTypeFunction") | just (object argsSet) | just (object retsSet) | just (array args) | just (array rets) | just argValue | just retValue | Left err | _ = Left err
-typeFromJSON (object o) | just (string "AstTypeFunction") | just (object argsSet) | just (object retsSet) | just (array args) | just (array rets) | just argValue | just retValue | _ | Left err = Left err
-typeFromJSON (object o) | just (string "AstTypeFunction") | just (object argsSet) | just (object retsSet) | just (array args) | just (array rets) | _ | nothing = Left "No return type"
-typeFromJSON (object o) | just (string "AstTypeFunction") | just (object argsSet) | just (object retsSet) | just (array args) | just (array rets) | nothing | _ = Left "No argument type"
-typeFromJSON (object o) | just (string "AstTypeFunction") | just (object argsSet) | just (object retsSet) | just _ | _ = Left "argTypes.types is not an array"
-typeFromJSON (object o) | just (string "AstTypeFunction") | just (object argsSet) | just (object retsSet) | _ | just _ = Left "retTypes.types is not an array"
-typeFromJSON (object o) | just (string "AstTypeFunction") | just (object argsSet) | just (object retsSet) | nothing | _ = Left "argTypes.types does not exist"
-typeFromJSON (object o) | just (string "AstTypeFunction") | _ | just _ = Left "argTypes is not an object"
-typeFromJSON (object o) | just (string "AstTypeFunction") | just _ | _ = Left "returnTypes is not an object"
-typeFromJSON (object o) | just (string "AstTypeFunction") | nothing | nothing = Left "Missing argTypes and returnTypes"
-
-typeFromJSON (object o) | just (string "AstTypeReference") with lookup name o
-typeFromJSON (object o) | just (string "AstTypeReference") | just (string "nil") = Right nil
-typeFromJSON (object o) | just (string "AstTypeReference") | just (string "any") = Right unknown -- not quite right
-typeFromJSON (object o) | just (string "AstTypeReference") | just (string "unknown") = Right unknown
-typeFromJSON (object o) | just (string "AstTypeReference") | just (string "never") = Right never
-typeFromJSON (object o) | just (string "AstTypeReference") | just (string "number") = Right number
-typeFromJSON (object o) | just (string "AstTypeReference") | just (string "string") = Right string
-typeFromJSON (object o) | just (string "AstTypeReference") | _ = Left "Unknown referenced type"
-
-typeFromJSON (object o) | just (string "AstTypeUnion") with lookup types o
-typeFromJSON (object o) | just (string "AstTypeUnion") | just (array types) = compoundFromArray _∪_ types
-typeFromJSON (object o) | just (string "AstTypeUnion") | _ = Left "`types` field must be an array"
-
-typeFromJSON (object o) | just (string "AstTypeIntersection") with lookup types o
-typeFromJSON (object o) | just (string "AstTypeIntersection") | just (array types) = compoundFromArray _∩_ types
-typeFromJSON (object o) | just (string "AstTypeIntersection") | _ = Left "`types` field must be an array"
-
-typeFromJSON (object o) | just (string ty) = Left ("Unsupported type " ++ ty)
-typeFromJSON (object o) | just _ = Left "`type` field must be a string"
-typeFromJSON (object o) | nothing = Left "No `type` field"
-typeFromJSON _ = Left "Unsupported JSON type"
-
-compoundFromArray ctor ts with head ts | tail ts
-compoundFromArray ctor ts | just hd | tl with null tl
-compoundFromArray ctor ts | just hd | tl | true = typeFromJSON hd
-compoundFromArray ctor ts | just hd | tl | false with typeFromJSON hd | compoundFromArray ctor tl
-compoundFromArray ctor ts | just hd | tl | false | Right hdTy | Right tlTy = Right (ctor hdTy tlTy)
-compoundFromArray ctor ts | just hd | tl | false | Left err | _ = Left err
-compoundFromArray ctor ts | just hd | tl | false | _ | Left Err = Left Err
-compoundFromArray ctor ts | nothing | empty = Left "Empty types array?"

prototyping/Luau/Type/ToString.agda

@@ -1,29 +0,0 @@
-module Luau.Type.ToString where
-
-open import FFI.Data.String using (String; _++_)
-open import Luau.Type using (Type; nil; _⇒_; never; unknown; number; boolean; string; _∪_; _∩_; normalizeOptional)
-
-{-# TERMINATING #-}
-typeToString : Type → String
-typeToStringᵁ : Type → String
-typeToStringᴵ : Type → String
-
-typeToString nil = "nil"
-typeToString (S ⇒ T) = "(" ++ (typeToString S) ++ ") -> " ++ (typeToString T)
-typeToString never = "never"
-typeToString unknown = "unknown"
-typeToString number = "number"
-typeToString boolean = "boolean"
-typeToString string = "string"
-typeToString (S ∪ T) with normalizeOptional(S ∪ T)
-typeToString (S ∪ T) | ((S′ ⇒ T′) ∪ nil) = "(" ++ typeToString (S′ ⇒ T′) ++ ")?"
-typeToString (S ∪ T) | (S′ ∪ nil) = typeToString S′ ++ "?"
-typeToString (S ∪ T) | (S′ ∪ T′) = "(" ++ typeToStringᵁ (S ∪ T) ++ ")"
-typeToString (S ∪ T) | T′ = typeToString T′
-typeToString (S ∩ T) = "(" ++ typeToStringᴵ (S ∩ T) ++ ")"
-
-typeToStringᵁ (S ∪ T) = (typeToStringᵁ S) ++ " | " ++ (typeToStringᵁ T)
-typeToStringᵁ T = typeToString T
-
-typeToStringᴵ (S ∩ T) = (typeToStringᴵ S) ++ " & " ++ (typeToStringᴵ T)
-typeToStringᴵ T = typeToString T

prototyping/Luau/TypeCheck.agda

@@ -1,160 +0,0 @@
-{-# OPTIONS --rewriting #-}
-
-module Luau.TypeCheck where
-
-open import Agda.Builtin.Equality using (_≡_)
-open import FFI.Data.Either using (Either; Left; Right)
-open import FFI.Data.Maybe using (Maybe; just)
-open import Luau.ResolveOverloads using (resolve)
-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.Heap using (Heap; Object; function_is_end) renaming (_[_] to _[_]ᴴ)
-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)
-open import Properties.DecSubtyping using (dec-subtyping)
-open import Properties.Product using (_×_; _,_)
-
-orUnknown : Maybe Type → Type
-orUnknown nothing = unknown
-orUnknown (just T) = T
-
-srcBinOp : BinaryOperator → Type
-srcBinOp + = number
-srcBinOp - = number
-srcBinOp * = number
-srcBinOp / = number
-srcBinOp < = number
-srcBinOp > = number
-srcBinOp == = unknown
-srcBinOp ~= = unknown
-srcBinOp <= = number
-srcBinOp >= = number
-srcBinOp ·· = string
-
-tgtBinOp : BinaryOperator → Type
-tgtBinOp + = number
-tgtBinOp - = number
-tgtBinOp * = number
-tgtBinOp / = number
-tgtBinOp < = boolean
-tgtBinOp > = boolean
-tgtBinOp == = boolean
-tgtBinOp ~= = boolean
-tgtBinOp <= = boolean
-tgtBinOp >= = boolean
-tgtBinOp ·· = string
-
-data _⊢ᴮ_∈_ : VarCtxt → Block yes → Type → Set
-data _⊢ᴱ_∈_ : VarCtxt → Expr yes → Type → Set
-
-data _⊢ᴮ_∈_ where
-
-  done : ∀ {Γ} →
-
-    ---------------
-    Γ ⊢ᴮ done ∈ nil
-
-  return : ∀ {M B T U Γ} →
-
-    Γ ⊢ᴱ M ∈ T →
-    Γ ⊢ᴮ B ∈ U →
-    ---------------------
-    Γ ⊢ᴮ return M ∙ B ∈ T
-
-  local : ∀ {x M B T U V Γ} →
-
-    Γ ⊢ᴱ M ∈ U →
-    (Γ ⊕ x ↦ T) ⊢ᴮ B ∈ V →
-    --------------------------------
-    Γ ⊢ᴮ local var x ∈ T ← M ∙ B ∈ V
-
-  function : ∀ {f x B C T U V W Γ} →
-
-    (Γ ⊕ x ↦ T) ⊢ᴮ C ∈ V →
-    (Γ ⊕ f ↦ (T ⇒ U)) ⊢ᴮ B ∈ W →
-    -------------------------------------------------
-    Γ ⊢ᴮ function f ⟨ var x ∈ T ⟩∈ U is C end ∙ B ∈ W
-
-data _⊢ᴱ_∈_ where
-
-  nil : ∀ {Γ} →
-
-    --------------------
-    Γ ⊢ᴱ (val nil) ∈ nil
-
-  var : ∀ {x T Γ} →
-
-    T ≡ orUnknown(Γ [ x ]ⱽ) →
-    ----------------
-    Γ ⊢ᴱ (var x) ∈ T
-
-  addr : ∀ {a Γ} T →
-
-    -----------------
-    Γ ⊢ᴱ val(addr a) ∈ T
-
-  number : ∀ {n Γ} →
-
-    ---------------------------
-    Γ ⊢ᴱ val(number n) ∈ number
-
-  bool : ∀ {b Γ} →
-
-    --------------------------
-    Γ ⊢ᴱ val(bool b) ∈ boolean
-  
-  string : ∀ {x Γ} →
-
-    ---------------------------
-    Γ ⊢ᴱ val(string x) ∈ string
-
-  app : ∀ {M N T U Γ} →
-
-    Γ ⊢ᴱ M ∈ T →
-    Γ ⊢ᴱ N ∈ U →
-    ----------------------------
-    Γ ⊢ᴱ (M $ N) ∈ (resolve T U)
-
-  function : ∀ {f x B T U V Γ} →
-
-    (Γ ⊕ x ↦ T) ⊢ᴮ B ∈ V →
-    -----------------------------------------------------
-    Γ ⊢ᴱ (function f ⟨ var x ∈ T ⟩∈ U is B end) ∈ (T ⇒ U)
-
-  block : ∀ {b B T U Γ} →
-
-    Γ ⊢ᴮ B ∈ U →
-    ------------------------------------
-    Γ ⊢ᴱ (block var b ∈ T is B end) ∈ T
-
-  binexp : ∀ {op Γ M N T U} →
-
-    Γ ⊢ᴱ M ∈ T →
-    Γ ⊢ᴱ N ∈ U →
-    ----------------------------------
-    Γ ⊢ᴱ (binexp M op N) ∈ tgtBinOp op
-
-data ⊢ᴼ_ : Maybe(Object yes) → Set where
-
-  nothing :
-
-    ---------
-    ⊢ᴼ nothing
-
-  function : ∀ {f x T U V B} →
-
-    (x ↦ T) ⊢ᴮ B ∈ V →
-    ----------------------------------------------
-    ⊢ᴼ (just function f ⟨ var x ∈ T ⟩∈ U is B end)
-
-⊢ᴴ_ : Heap yes → Set
-⊢ᴴ H = ∀ a {O} → (H [ a ]ᴴ ≡ O) → (⊢ᴼ O)
-
-_⊢ᴴᴱ_▷_∈_ : VarCtxt → Heap yes → Expr yes → Type → Set
-(Γ ⊢ᴴᴱ H ▷ M ∈ T) = (⊢ᴴ H) × (Γ ⊢ᴱ M ∈ T)
-
-_⊢ᴴᴮ_▷_∈_ : VarCtxt → Heap yes → Block yes → Type → Set
-(Γ ⊢ᴴᴮ H ▷ B ∈ T) = (⊢ᴴ H) × (Γ ⊢ᴮ B ∈ T)

prototyping/Luau/TypeNormalization.agda

@@ -1,65 +0,0 @@
-module Luau.TypeNormalization where
-
-open import Luau.Type using (Type; nil; number; string; boolean; never; unknown; _⇒_; _∪_; _∩_)
-
--- Operations on 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
-never ∪ⁿ T = T
-unknown ∪ⁿ T = unknown
-(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/Luau/TypeSaturation.agda

@@ -1,66 +0,0 @@
-module Luau.TypeSaturation where
-
-open import Luau.Type using (Type; _⇒_; _∩_; _∪_)
-open import Luau.TypeNormalization using (_∪ⁿ_; _∩ⁿ_)
-
--- So, there's a problem with overloaded functions
--- (of the form (S_1 ⇒ T_1) ∩⋯∩ (S_n ⇒ T_n))
--- which is that it's not good enough to compare them
--- for subtyping by comparing all of their overloads.
-
--- For example (nil → nil) is a subtype of (number? → number?) ∩ (string? → string?)
--- but not a subtype of any of its overloads.
-
--- To fix this, we adapt the semantic subtyping algorithm for
--- function types, given in
--- https://www.irif.fr/~gc/papers/covcon-again.pdf and
--- https://pnwamk.github.io/sst-tutorial/
-
--- A function type is *intersection-saturated* if for any overloads
--- (S₁ ⇒ T₁) and (S₂ ⇒ T₂), there exists an overload which is a subtype
--- of ((S₁ ∩ S₂) ⇒ (T₁ ∩ T₂)).
-
--- A function type is *union-saturated* if for any overloads
--- (S₁ ⇒ T₁) and (S₂ ⇒ T₂), there exists an overload which is a subtype
--- of ((S₁ ∪ S₂) ⇒ (T₁ ∪ T₂)).
-
--- A function type is *saturated* if it is both intersection- and
--- union-saturated.
-
--- For example (number? → number?) ∩ (string? → string?)
--- is not saturated, but (number? → number?) ∩ (string? → string?) ∩ (nil → nil) ∩ ((number ∪ string)? → (number ∪ string)?)
--- is.
-
--- Saturated function types have the nice property that they can ber
--- compared by just comparing their overloads: F <: G whenever for any
--- overload of G, there is an overload os F which is a subtype of it.
-
--- Forunately every function type can be saturated!
-_⋓_ : Type → Type → Type
-(S₁ ⇒ T₁) ⋓ (S₂ ⇒ T₂) = (S₁ ∪ⁿ S₂) ⇒ (T₁ ∪ⁿ T₂)
-(F₁ ∩ G₁) ⋓ F₂ = (F₁ ⋓ F₂) ∩ (G₁ ⋓ F₂)
-F₁ ⋓ (F₂ ∩ G₂) = (F₁ ⋓ F₂) ∩ (F₁ ⋓ G₂)
-F ⋓ G = F ∩ G
-
-_⋒_ : Type → Type → Type
-(S₁ ⇒ T₁) ⋒ (S₂ ⇒ T₂) = (S₁ ∩ⁿ S₂) ⇒ (T₁ ∩ⁿ T₂)
-(F₁ ∩ G₁) ⋒ F₂ = (F₁ ⋒ F₂) ∩ (G₁ ⋒ F₂)
-F₁ ⋒ (F₂ ∩ G₂) = (F₁ ⋒ F₂) ∩ (F₁ ⋒ G₂)
-F ⋒ G = F ∩ G
-
-_∩ᵘ_ : Type → Type → Type
-F ∩ᵘ G = (F ∩ G) ∩ (F ⋓ G)
-
-_∩ⁱ_ : Type → Type → Type
-F ∩ⁱ G = (F ∩ G) ∩ (F ⋒ G)
-
-∪-saturate : Type → Type
-∪-saturate (F ∩ G) = (∪-saturate F ∩ᵘ ∪-saturate G)
-∪-saturate F = F
-
-∩-saturate : Type → Type
-∩-saturate (F ∩ G) = (∩-saturate F ∩ⁱ ∩-saturate G)
-∩-saturate F = F
-
-saturate : Type → Type
-saturate F = ∪-saturate (∩-saturate F)

prototyping/Luau/Var.agda

@@ -1,16 +0,0 @@
-module Luau.Var where
-
-open import Agda.Builtin.Bool using (true; false)
-open import Agda.Builtin.Equality using (_≡_)
-open import Agda.Builtin.String using (String; primStringEquality)
-open import Agda.Builtin.TrustMe using (primTrustMe)
-open import Properties.Dec using (Dec; yes; no)
-open import Properties.Equality using (_≢_)
-
-Var : Set
-Var = String
-
-_≡ⱽ_ : (a b : Var) → Dec (a ≡ b)
-a ≡ⱽ b with primStringEquality a b
-a ≡ⱽ b | false = no p where postulate p : (a ≢ b)
-a ≡ⱽ b | true = yes primTrustMe

prototyping/Luau/Var/ToString.agda

@@ -1,8 +0,0 @@
-module Luau.Var.ToString where
-
-open import Agda.Builtin.String using (String)
-open import Luau.Var using (Var)
-
-varToString : Var → String
-varToString x = x
-

prototyping/Luau/VarCtxt.agda

@@ -1,43 +0,0 @@
-{-# OPTIONS --rewriting #-}
-
-module Luau.VarCtxt where
-
-open import Agda.Builtin.Equality using (_≡_)
-open import Luau.Type using (Type; _∪_; _∩_)
-open import Luau.Var using (Var)
-open import FFI.Data.Aeson using (KeyMap; Key; empty; unionWith; singleton; insert; delete; lookup; toString; fromString; lookup-insert; lookup-insert-not; lookup-empty; to-from; insert-swap; insert-over)
-open import FFI.Data.Maybe using (Maybe; just; nothing)
-open import Properties.Equality using (_≢_; cong; sym; trans)
-
-VarCtxt : Set
-VarCtxt = KeyMap Type
-
-∅ : VarCtxt
-∅ = empty
-
-_⋒_ : VarCtxt → VarCtxt → VarCtxt
-_⋒_ = unionWith _∩_
-
-_⋓_ : VarCtxt → VarCtxt → VarCtxt
-_⋓_ = unionWith _∪_
-
-_[_] : VarCtxt → Var → Maybe Type
-Γ [ x ] = lookup (fromString x) Γ
-
-_⊝_ : VarCtxt → Var → VarCtxt
-Γ ⊝ x = delete (fromString x) Γ
-
-_↦_ : Var → Type → VarCtxt
-x ↦ T = singleton (fromString x) T
-
-_⊕_↦_ : VarCtxt → Var → Type → VarCtxt
-Γ ⊕ x ↦ T = insert (fromString x) T Γ
-
-⊕-over : ∀ {Γ x y T U} → (x ≡ y) → ((Γ ⊕ x ↦ T) ⊕ y ↦ U) ≡ (Γ ⊕ y ↦ U)
-⊕-over p = insert-over _ _ _ _ _ (cong fromString (sym p))
-
-⊕-swap : ∀ {Γ x y T U} → (x ≢ y) → ((Γ ⊕ x ↦ T) ⊕ y ↦ U) ≡ ((Γ ⊕ y ↦ U) ⊕ x ↦ T)
-⊕-swap p = insert-swap _ _ _ _ _ (λ q → p (trans (sym (to-from _)) (trans (cong toString (sym q) ) (to-from _))) )
-
-⊕-lookup-miss : ∀ x y T Γ → (x ≢ y) → (Γ [ y ] ≡ (Γ ⊕ x ↦ T) [ y ])
-⊕-lookup-miss x y T Γ p = lookup-insert-not (fromString x) (fromString y) T Γ λ q → p (trans (sym (to-from x)) (trans (cong toString q) (to-from y)))

prototyping/PrettyPrinter.agda

@@ -1,34 +0,0 @@
-{-# OPTIONS --rewriting #-}
-
-module PrettyPrinter where
-
-open import Agda.Builtin.IO using (IO)
-open import Agda.Builtin.Int using (pos)
-open import Agda.Builtin.Unit using (⊤)
-
-open import FFI.IO using (getContents; putStrLn; _>>=_; _>>_)
-open import FFI.Data.Aeson using (Value; eitherDecode)
-open import FFI.Data.Either using (Left; Right)
-open import FFI.Data.String using (String; _++_)
-open import FFI.Data.Text.Encoding using (encodeUtf8)
-open import FFI.System.Exit using (exitWith; ExitFailure)
-
-open import Luau.Syntax using (Block)
-open import Luau.Syntax.FromJSON using (blockFromJSON)
-open import Luau.Syntax.ToString using (blockToString)
-
-runBlock : ∀ {a} → Block a → IO ⊤
-runBlock block = putStrLn (blockToString block)
-
-runJSON : Value → IO ⊤
-runJSON value with blockFromJSON(value)
-runJSON value | (Left err) = putStrLn ("Luau error: " ++ err) >> exitWith (ExitFailure (pos 1))
-runJSON value | (Right block) = runBlock block
-
-runString : String → IO ⊤
-runString txt with eitherDecode (encodeUtf8 txt)
-runString txt | (Left err) = putStrLn ("JSON error: " ++ err) >> exitWith (ExitFailure (pos 1))
-runString txt | (Right value) = runJSON value
-
-main : IO ⊤
-main = getContents >>= runString

prototyping/Properties.agda

@@ -1,15 +0,0 @@
-{-# OPTIONS --rewriting #-}
-
-module Properties where
-
-import Properties.Contradiction
-import Properties.Dec
-import Properties.DecSubtyping
-import Properties.Equality
-import Properties.Functions
-import Properties.Remember
-import Properties.Step
-import Properties.StrictMode
-import Properties.Subtyping
-import Properties.TypeCheck
-import Properties.TypeNormalization

prototyping/Properties/Contradiction.agda

@@ -1,9 +0,0 @@
-module Properties.Contradiction where
-
-data ⊥ : Set where
-
-¬ : Set → Set
-¬ A = A → ⊥
-
-CONTRADICTION : ∀ {A : Set} → ⊥ → A
-CONTRADICTION ()

prototyping/Properties/Dec.agda

@@ -1,7 +0,0 @@
-module Properties.Dec where
-
-open import Properties.Contradiction using (¬)
-
-data Dec(A : Set) : Set where
-  yes : A → Dec A
-  no : ¬ A → Dec A

prototyping/Properties/DecSubtyping.agda

@@ -1,174 +0,0 @@
-{-# 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.Subtyping using (_<:_; _≮:_; Tree; Language; ¬Language; witness; unknown; never; scalar; function; scalar-function; scalar-function-ok; scalar-function-err; scalar-function-tgt; scalar-scalar; function-scalar; function-ok; function-ok₁; function-ok₂; function-err; function-tgt; left; right; _,_)
-open import Luau.Type using (Type; Scalar; nil; number; string; boolean; never; unknown; _⇒_; _∪_; _∩_)
-open import Luau.TypeNormalization using (_∪ⁿ_; _∩ⁿ_)
-open import Luau.TypeSaturation using (saturate)
-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; <:-impl-¬≮:; <:-intersect; <:-function-∩-∪; <:-function-∩; <:-union; ≮:-left-∪; ≮:-right-∪; <:-∩-distr-∪; <:-impl-⊇; language-comp)
-open import Properties.TypeNormalization using (FunType; Normal; never; unknown; _∩_; _∪_; _⇒_; normal; <:-normalize; normalize-<:; normal-∩ⁿ; normal-∪ⁿ; ∪-<:-∪ⁿ; ∪ⁿ-<:-∪; ∩ⁿ-<:-∩; ∩-<:-∩ⁿ; normalᶠ; fun-top; fun-function; fun-¬scalar)
-open import Properties.TypeSaturation using (Overloads; Saturated; _⊆ᵒ_; _<:ᵒ_; defn; here; left; right; ov-language; ov-<:; saturated; normal-saturate; normal-overload-src; normal-overload-tgt; saturate-<:; <:-saturate; <:ᵒ-impl-<:; _>>=ˡ_; _>>=ʳ_)
-open import Properties.Equality using (_≢_)
-
--- Honest this terminates, since saturation maintains the depth of nested arrows
-{-# TERMINATING #-}
-dec-subtypingˢⁿ : ∀ {T U} → Scalar T → Normal U → Either (T ≮: U) (T <: U)
-dec-subtypingˢᶠ : ∀ {F G} → FunType F → Saturated F → FunType G → Either (F ≮: G) (F <:ᵒ G)
-dec-subtypingᶠ : ∀ {F G} → FunType F → FunType G → Either (F ≮: G) (F <: G)
-dec-subtypingᶠⁿ : ∀ {F U} → FunType F → Normal U → Either (F ≮: U) (F <: 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ˢᶠ {F} {S ⇒ T} Fᶠ (defn sat-∩ sat-∪) (Sⁿ ⇒ Tⁿ) = result (top Fᶠ (λ o → o)) where
-
-  data Top G : Set where
-
-    defn : ∀ Sᵗ Tᵗ →
-
-      Overloads F (Sᵗ ⇒ Tᵗ) →
-      (∀ {S′ T′} → Overloads G (S′ ⇒ T′) → (S′ <: Sᵗ)) →
-      -------------
-      Top G
-
-  top : ∀ {G} → (FunType G) → (G ⊆ᵒ F) → Top G
-  top {S′ ⇒ T′} _ G⊆F = defn S′ T′ (G⊆F here) (λ { here → <:-refl })
-  top (Gᶠ ∩ Hᶠ) G⊆F with top Gᶠ (G⊆F ∘ left) | top Hᶠ (G⊆F ∘ right)
-  top (Gᶠ ∩ Hᶠ) G⊆F | defn Rᵗ Sᵗ p p₁ | defn Tᵗ Uᵗ q q₁ with sat-∪ p q
-  top (Gᶠ ∩ Hᶠ) G⊆F | defn Rᵗ Sᵗ p p₁ | defn Tᵗ Uᵗ q q₁ | defn n r r₁ = defn _ _ n
-    (λ { (left o) → <:-trans (<:-trans (p₁ o) <:-∪-left) r ; (right o) → <:-trans (<:-trans (q₁ o) <:-∪-right) r })
-
-  result : Top F → Either (F ≮: (S ⇒ T)) (F <:ᵒ (S ⇒ T))
-  result (defn Sᵗ Tᵗ oᵗ srcᵗ) with dec-subtypingⁿ Sⁿ (normal-overload-src Fᶠ oᵗ)
-  result (defn Sᵗ Tᵗ oᵗ srcᵗ) | Left (witness s Ss ¬Sᵗs) = Left (witness (function-err s) (ov-language Fᶠ (λ o → function-err (<:-impl-⊇ (srcᵗ o) s ¬Sᵗs))) (function-err Ss))
-  result (defn Sᵗ Tᵗ oᵗ srcᵗ) | Right S<:Sᵗ = result₀ (largest Fᶠ (λ o → o)) where
-
-    data LargestSrc (G : Type) : Set where
-
-      yes : ∀ S₀ T₀ →
-
-        Overloads F (S₀ ⇒ T₀) →
-        T₀ <: T →
-        (∀ {S′ T′} → Overloads G (S′ ⇒ T′) → T′ <: T → (S′ <: S₀)) →
-        -----------------------
-        LargestSrc G
-
-      no : ∀ S₀ T₀ →
-
-        Overloads F (S₀ ⇒ T₀) →
-        T₀ ≮: T →  
-        (∀ {S′ T′} → Overloads G (S′ ⇒ T′) → T₀ <: T′) →
-        -----------------------
-        LargestSrc G
-
-    largest : ∀ {G} → (FunType G) → (G ⊆ᵒ F) → LargestSrc G
-    largest {S′ ⇒ T′} (S′ⁿ ⇒ T′ⁿ) G⊆F with dec-subtypingⁿ  T′ⁿ Tⁿ
-    largest {S′ ⇒ T′} (S′ⁿ ⇒ T′ⁿ) G⊆F | Left T′≮:T = no S′ T′ (G⊆F here) T′≮:T λ { here → <:-refl }
-    largest {S′ ⇒ T′} (S′ⁿ ⇒ T′ⁿ) G⊆F | Right T′<:T = yes S′ T′ (G⊆F here) T′<:T (λ { here _ → <:-refl })
-    largest (Gᶠ ∩ Hᶠ) GH⊆F with largest Gᶠ (GH⊆F ∘ left) | largest Hᶠ (GH⊆F ∘ right)
-    largest (Gᶠ ∩ Hᶠ) GH⊆F | no S₁ T₁ o₁ T₁≮:T tgt₁ | no S₂ T₂ o₂ T₂≮:T tgt₂ with sat-∩ o₁ o₂
-    largest (Gᶠ ∩ Hᶠ) GH⊆F | no S₁ T₁ o₁ T₁≮:T tgt₁ | no S₂ T₂ o₂ T₂≮:T tgt₂ | defn o src tgt with dec-subtypingⁿ (normal-overload-tgt Fᶠ o) Tⁿ
-    largest (Gᶠ ∩ Hᶠ) GH⊆F | no S₁ T₁ o₁ T₁≮:T tgt₁ | no S₂ T₂ o₂ T₂≮:T tgt₂ | defn o src tgt | Left T₀≮:T = no _ _ o T₀≮:T (λ { (left o) → <:-trans tgt (<:-trans <:-∩-left (tgt₁ o)) ; (right o) → <:-trans tgt (<:-trans <:-∩-right (tgt₂ o)) })
-    largest (Gᶠ ∩ Hᶠ) GH⊆F | no S₁ T₁ o₁ T₁≮:T tgt₁ | no S₂ T₂ o₂ T₂≮:T tgt₂ | defn o src tgt | Right T₀<:T = yes _ _ o T₀<:T (λ { (left o) p → CONTRADICTION (<:-impl-¬≮: p (<:-trans-≮: (tgt₁ o) T₁≮:T)) ; (right o) p → CONTRADICTION (<:-impl-¬≮: p (<:-trans-≮: (tgt₂ o) T₂≮:T)) })
-    largest (Gᶠ ∩ Hᶠ) GH⊆F | no S₁ T₁ o₁ T₁≮:T tgt₁ | yes S₂ T₂ o₂ T₂<:T src₂ = yes S₂ T₂ o₂ T₂<:T (λ { (left o) p → CONTRADICTION (<:-impl-¬≮: p (<:-trans-≮: (tgt₁ o) T₁≮:T)) ; (right o) p → src₂ o p })
-    largest (Gᶠ ∩ Hᶠ) GH⊆F | yes S₁ T₁ o₁ T₁<:T src₁ | no S₂ T₂ o₂ T₂≮:T tgt₂ = yes S₁ T₁ o₁ T₁<:T (λ { (left o) p → src₁ o p ; (right o) p → CONTRADICTION (<:-impl-¬≮: p (<:-trans-≮: (tgt₂ o) T₂≮:T)) })
-    largest (Gᶠ ∩ Hᶠ) GH⊆F | yes S₁ T₁ o₁ T₁<:T src₁ | yes S₂ T₂ o₂ T₂<:T src₂ with sat-∪ o₁ o₂
-    largest (Gᶠ ∩ Hᶠ) GH⊆F | yes S₁ T₁ o₁ T₁<:T src₁ | yes S₂ T₂ o₂ T₂<:T src₂ | defn o src tgt = yes _ _ o (<:-trans tgt (<:-∪-lub T₁<:T T₂<:T))
-      (λ { (left o) T′<:T → <:-trans (src₁ o T′<:T) (<:-trans <:-∪-left src)
-         ; (right o) T′<:T → <:-trans (src₂ o T′<:T) (<:-trans <:-∪-right src)
-         })
-
-    result₀ : LargestSrc F → Either (F ≮: (S ⇒ T)) (F <:ᵒ (S ⇒ T))
-    result₀ (no S₀ T₀ o₀ (witness t T₀t ¬Tt) tgt₀) = Left (witness (function-tgt t) (ov-language Fᶠ (λ o → function-tgt (tgt₀ o t T₀t))) (function-tgt ¬Tt))
-    result₀ (yes S₀ T₀ o₀ T₀<:T src₀) with dec-subtypingⁿ Sⁿ (normal-overload-src Fᶠ o₀)
-    result₀ (yes S₀ T₀ o₀ T₀<:T src₀) | Right S<:S₀ = Right λ { here → defn o₀ S<:S₀ T₀<:T }
-    result₀ (yes S₀ T₀ o₀ T₀<:T src₀) | Left (witness s Ss ¬S₀s) = Left (result₁ (smallest Fᶠ (λ o → o))) where
-
-      data SmallestTgt (G : Type) : Set where
-
-        defn : ∀ S₁ T₁ →
-
-          Overloads F (S₁ ⇒ T₁) →
-          Language S₁ s →
-          (∀ {S′ T′} → Overloads G (S′ ⇒ T′) → Language S′ s → (T₁ <: T′)) →
-          -----------------------
-          SmallestTgt G
-
-      smallest : ∀ {G} → (FunType G) → (G ⊆ᵒ F) → SmallestTgt G
-      smallest {S′ ⇒ T′} _ G⊆F with dec-language S′ s
-      smallest {S′ ⇒ T′} _ G⊆F | Left ¬S′s = defn Sᵗ Tᵗ oᵗ (S<:Sᵗ s Ss) λ { here S′s → CONTRADICTION (language-comp s ¬S′s S′s) }
-      smallest {S′ ⇒ T′} _ G⊆F | Right S′s = defn S′ T′ (G⊆F here) S′s (λ { here _ → <:-refl })
-      smallest (Gᶠ ∩ Hᶠ) GH⊆F with smallest Gᶠ (GH⊆F ∘ left) | smallest Hᶠ (GH⊆F ∘ right)
-      smallest (Gᶠ ∩ Hᶠ) GH⊆F | defn S₁ T₁ o₁ R₁s tgt₁ | defn S₂ T₂ o₂ R₂s tgt₂ with sat-∩ o₁ o₂
-      smallest (Gᶠ ∩ Hᶠ) GH⊆F | defn S₁ T₁ o₁ R₁s tgt₁ | defn S₂ T₂ o₂ R₂s tgt₂ | defn o src tgt = defn _ _ o (src s (R₁s , R₂s))
-        (λ { (left o) S′s → <:-trans (<:-trans tgt <:-∩-left) (tgt₁ o S′s)
-           ; (right o) S′s → <:-trans (<:-trans tgt <:-∩-right) (tgt₂ o S′s)
-           })
-
-      result₁ : SmallestTgt F → (F ≮: (S ⇒ T))
-      result₁ (defn S₁ T₁ o₁ S₁s tgt₁) with dec-subtypingⁿ (normal-overload-tgt Fᶠ o₁) Tⁿ
-      result₁ (defn S₁ T₁ o₁ S₁s tgt₁) | Right T₁<:T = CONTRADICTION (language-comp s ¬S₀s (src₀ o₁ T₁<:T s S₁s))
-      result₁ (defn S₁ T₁ o₁ S₁s tgt₁) | Left (witness t T₁t ¬Tt) = witness (function-ok s t) (ov-language Fᶠ lemma) (function-ok Ss ¬Tt) where
-
-        lemma : ∀ {S′ T′} → Overloads F (S′ ⇒ T′) → Language (S′ ⇒ T′) (function-ok s t)
-        lemma {S′} o with dec-language S′ s
-        lemma {S′} o | Left ¬S′s = function-ok₁ ¬S′s
-        lemma {S′} o | Right S′s = function-ok₂ (tgt₁ o S′s t T₁t)
-
-dec-subtypingˢᶠ F Fˢ (G ∩ H) with dec-subtypingˢᶠ F Fˢ G | dec-subtypingˢᶠ F Fˢ H
-dec-subtypingˢᶠ F Fˢ (G ∩ H) | Left F≮:G | _ = Left (≮:-∩-left F≮:G)
-dec-subtypingˢᶠ F Fˢ (G ∩ H) | _ | Left F≮:H = Left (≮:-∩-right F≮:H)
-dec-subtypingˢᶠ F Fˢ (G ∩ H) | Right F<:G | Right F<:H = Right (λ { (left o) → F<:G o ; (right o) → F<:H o })
-
-dec-subtypingᶠ F G with dec-subtypingˢᶠ (normal-saturate F) (saturated F) G
-dec-subtypingᶠ F G | Left H≮:G = Left (<:-trans-≮: (saturate-<: F) H≮:G)
-dec-subtypingᶠ F G | Right H<:G = Right (<:-trans (<:-saturate F) (<:ᵒ-impl-<: (normal-saturate F) G H<:G))
-
-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)))
-
--- As a corollary, for saturated functions
--- <:ᵒ coincides with <:, that is F is a subtype of (S ⇒ T) precisely
--- when one of its overloads is.
-
-<:-impl-<:ᵒ : ∀ {F G} → FunType F → Saturated F → FunType G → (F <: G) → (F <:ᵒ G)
-<:-impl-<:ᵒ {F} {G} Fᶠ Fˢ Gᶠ F<:G with dec-subtypingˢᶠ Fᶠ Fˢ Gᶠ
-<:-impl-<:ᵒ {F} {G} Fᶠ Fˢ Gᶠ F<:G | Left F≮:G = CONTRADICTION (<:-impl-¬≮: F<:G F≮:G)
-<:-impl-<:ᵒ {F} {G} Fᶠ Fˢ Gᶠ F<:G | Right F<:ᵒG = F<:ᵒG

prototyping/Properties/Equality.agda

@@ -1,23 +0,0 @@
-module Properties.Equality where
-
-open import Agda.Builtin.Equality using (_≡_; refl)
-open import Properties.Contradiction using (¬)
-
-sym : ∀ {A : Set} {a b : A} → (a ≡ b) → (b ≡ a)
-sym refl = refl
-
-trans : ∀ {A : Set} {a b c : A} → (a ≡ b) → (b ≡ c) → (a ≡ c)
-trans refl refl = refl
-
-cong : ∀ {A B : Set} {a b : A} (f : A → B) → (a ≡ b) → (f a ≡ f b)
-cong f refl = refl
-
-subst₁ : ∀ {A : Set} {a b : A} (F : A → Set) → (a ≡ b) → (F a) → (F b)
-subst₁ F refl x = x
-
-subst₂ : ∀ {A B : Set} {a b : A} {c d : B} (F : A → B → Set) → (a ≡ b) → (c ≡ d) → (F a c) → (F b d)
-subst₂ F refl refl x = x
-
-_≢_ : ∀ {A : Set} → A → A → Set
-(a ≢ b) = ¬(a ≡ b)
-

prototyping/Properties/Functions.agda

@@ -1,6 +0,0 @@
-module Properties.Functions where
-
-infixr 5 _∘_
-
-_∘_ : ∀ {A B C : Set} → (B → C) → (A → B) → (A → C)
-(f ∘ g) x = f (g x)

prototyping/Properties/Product.agda

@@ -1,14 +0,0 @@
-module Properties.Product where
-
-infixr 5 _×_ _,_
-
-record Σ {A : Set} (B : A → Set) : Set where
-
-  constructor _,_
-  field fst : A
-  field snd : B fst
-
-open Σ public
-
-_×_ : Set → Set → Set
-A × B = Σ (λ (a : A) → B)

prototyping/Properties/Remember.agda

@@ -1,9 +0,0 @@
-module Properties.Remember where
-
-open import Agda.Builtin.Equality using (_≡_; refl)
-
-data Remember {A : Set} (a : A) : Set where
-  _,_ : ∀ b → (a ≡ b) → Remember(a)
-  
-remember : ∀ {A} (a : A) → Remember(a)
-remember a = (a , refl)

prototyping/Properties/ResolveOverloads.agda

@@ -1,189 +0,0 @@
-{-# OPTIONS --rewriting #-}
-
-module Properties.ResolveOverloads where
-
-open import FFI.Data.Either using (Left; Right)
-open import Luau.ResolveOverloads using (Resolved; src; srcⁿ; resolve; resolveⁿ; resolveᶠ; resolveˢ; target; yes; no)
-open import Luau.Subtyping using (_<:_; _≮:_; Language; ¬Language; witness; scalar; unknown; never; function; function-ok; function-err; function-tgt; function-scalar; function-ok₁; function-ok₂; scalar-scalar; scalar-function; scalar-function-ok; scalar-function-err; scalar-function-tgt; _,_; left; right)
-open import Luau.Type using (Type ; Scalar; _⇒_; _∩_; _∪_; nil; boolean; number; string; unknown; never)
-open import Luau.TypeSaturation using (saturate)
-open import Luau.TypeNormalization using (normalize)
-open import Properties.Contradiction using (CONTRADICTION)
-open import Properties.DecSubtyping using (dec-subtyping; dec-subtypingⁿ; <:-impl-<:ᵒ)
-open import Properties.Functions using (_∘_)
-open import Properties.Subtyping using (<:-refl; <:-trans; <:-trans-≮:; ≮:-trans-<:; <:-∩-left; <:-∩-right; <:-∩-glb; <:-impl-¬≮:; <:-unknown; <:-function; function-≮:-never; <:-never; unknown-≮:-function; scalar-≮:-function; ≮:-∪-right; scalar-≮:-never; <:-∪-left; <:-∪-right; <:-impl-⊇; language-comp)
-open import Properties.TypeNormalization using (Normal; FunType; normal; _⇒_; _∩_; _∪_; never; unknown; <:-normalize; normalize-<:; fun-≮:-never; unknown-≮:-fun; scalar-≮:-fun)
-open import Properties.TypeSaturation using (Overloads; Saturated; _⊆ᵒ_; _<:ᵒ_; normal-saturate; saturated; <:-saturate; saturate-<:; defn; here; left; right)
-
--- 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-ok₂ p) = scalar-function-ok s
-¬fun-scalar s (S ⇒ T) (function-err p) = scalar-function-err s
-¬fun-scalar s (S ⇒ T) (function-tgt p) = scalar-function-tgt 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 s .(scalar s₁)) p (function-ok x (scalar-scalar s₁ () x₂)))
-unknown-src-≮: r (witness (function-ok s .function) p (function-ok x (scalar-function ())))
-unknown-src-≮: r (witness (function-ok s .(function-ok _ _)) p (function-ok x (scalar-function-ok ())))
-unknown-src-≮: r (witness (function-ok s .(function-err _)) p (function-ok x (scalar-function-err ())))
-unknown-src-≮: r (witness (function-err t) p (function-err q)) = witness t q (src-¬function-err p)
-unknown-src-≮: r (witness (function-tgt t) p (function-tgt (scalar-function-tgt ())))
-
--- Properties of resolve
-resolveˢ-<:-⇒ : ∀ {F V U} → (FunType F) → (Saturated F) → (FunType (V ⇒ U)) → (r : Resolved F V) → (F <: (V ⇒ U)) → (target r <: U)
-resolveˢ-<:-⇒ Fᶠ Fˢ V⇒Uᶠ r F<:V⇒U with <:-impl-<:ᵒ Fᶠ Fˢ V⇒Uᶠ F<:V⇒U here
-resolveˢ-<:-⇒ Fᶠ Fˢ V⇒Uᶠ (yes Sʳ Tʳ oʳ V<:Sʳ tgtʳ) F<:V⇒U | defn o o₁ o₂ = <:-trans (tgtʳ o o₁) o₂
-resolveˢ-<:-⇒ Fᶠ Fˢ V⇒Uᶠ (no tgtʳ) F<:V⇒U | defn o o₁ o₂ = CONTRADICTION (<:-impl-¬≮: o₁ (tgtʳ o))
-
-resolveⁿ-<:-⇒ : ∀ {F V U} → (Fⁿ : Normal F) → (Vⁿ : Normal V) → (Uⁿ : Normal U) → (F <: (V ⇒ U)) → (resolveⁿ Fⁿ Vⁿ <: U)
-resolveⁿ-<:-⇒ (Sⁿ ⇒ Tⁿ) Vⁿ Uⁿ F<:V⇒U = resolveˢ-<:-⇒ (normal-saturate (Sⁿ ⇒ Tⁿ)) (saturated (Sⁿ ⇒ Tⁿ)) (Vⁿ ⇒ Uⁿ) (resolveˢ (normal-saturate (Sⁿ ⇒ Tⁿ)) (saturated (Sⁿ ⇒ Tⁿ)) Vⁿ (λ o → o)) F<:V⇒U
-resolveⁿ-<:-⇒ (Fⁿ ∩ Gⁿ) Vⁿ Uⁿ F<:V⇒U = resolveˢ-<:-⇒ (normal-saturate (Fⁿ ∩ Gⁿ)) (saturated (Fⁿ ∩ Gⁿ)) (Vⁿ ⇒ Uⁿ) (resolveˢ (normal-saturate (Fⁿ ∩ Gⁿ)) (saturated (Fⁿ ∩ Gⁿ)) Vⁿ (λ o → o)) (<:-trans (saturate-<: (Fⁿ ∩ Gⁿ)) F<:V⇒U)
-resolveⁿ-<:-⇒ (Sⁿ ∪ Tˢ) Vⁿ Uⁿ F<:V⇒U = CONTRADICTION (<:-impl-¬≮: F<:V⇒U (<:-trans-≮: <:-∪-right (scalar-≮:-function Tˢ)))
-resolveⁿ-<:-⇒ never Vⁿ Uⁿ F<:V⇒U = <:-never
-resolveⁿ-<:-⇒ unknown Vⁿ Uⁿ F<:V⇒U = CONTRADICTION (<:-impl-¬≮: F<:V⇒U unknown-≮:-function)
-
-resolve-<:-⇒ : ∀ {F V U} → (F <: (V ⇒ U)) → (resolve F V <: U)
-resolve-<:-⇒ {F} {V} {U} F<:V⇒U = <:-trans (resolveⁿ-<:-⇒ (normal F) (normal V) (normal U) (<:-trans (normalize-<: F) (<:-trans F<:V⇒U (<:-normalize (V ⇒ U))))) (normalize-<: U)
-
-resolve-≮:-⇒ : ∀ {F V U} → (resolve F V ≮: U) → (F ≮: (V ⇒ U))
-resolve-≮:-⇒ {F} {V} {U} FV≮:U with dec-subtyping F (V ⇒ U)
-resolve-≮:-⇒ {F} {V} {U} FV≮:U | Left F≮:V⇒U = F≮:V⇒U
-resolve-≮:-⇒ {F} {V} {U} FV≮:U | Right F<:V⇒U = CONTRADICTION (<:-impl-¬≮: (resolve-<:-⇒ F<:V⇒U) FV≮:U)
-
-<:-resolveˢ-⇒ : ∀ {S T V} → (r : Resolved (S ⇒ T) V) → (V <: S) → T <: target r
-<:-resolveˢ-⇒ (yes S T here _ _) V<:S = <:-refl
-<:-resolveˢ-⇒ (no _) V<:S = <:-unknown
-
-<:-resolveⁿ-⇒ : ∀ {S T V} → (Sⁿ : Normal S) → (Tⁿ : Normal T) → (Vⁿ : Normal V) → (V <: S) → T <: resolveⁿ (Sⁿ ⇒ Tⁿ) Vⁿ
-<:-resolveⁿ-⇒ Sⁿ Tⁿ Vⁿ V<:S = <:-resolveˢ-⇒ (resolveˢ (Sⁿ ⇒ Tⁿ) (saturated (Sⁿ ⇒ Tⁿ)) Vⁿ (λ o → o)) V<:S 
-
-<:-resolve-⇒ : ∀ {S T V} → (V <: S) → T <: resolve (S ⇒ T) V
-<:-resolve-⇒ {S} {T} {V} V<:S = <:-trans (<:-normalize T) (<:-resolveⁿ-⇒ (normal S) (normal T) (normal V) (<:-trans (normalize-<: V) (<:-trans V<:S (<:-normalize S))))
-
-<:-resolveˢ : ∀ {F G V W} → (r : Resolved F V) → (s : Resolved G W) → (F <:ᵒ G) → (V <: W) → target r <: target s
-<:-resolveˢ (yes Sʳ Tʳ oʳ V<:Sʳ tgtʳ) (yes Sˢ Tˢ oˢ  W<:Sˢ tgtˢ) F<:G V<:W with F<:G oˢ
-<:-resolveˢ (yes Sʳ Tʳ oʳ V<:Sʳ tgtʳ) (yes Sˢ Tˢ oˢ W<:Sˢ tgtˢ) F<:G V<:W | defn o o₁ o₂ = <:-trans (tgtʳ o (<:-trans (<:-trans V<:W W<:Sˢ) o₁)) o₂
-<:-resolveˢ (no r) (yes Sˢ Tˢ oˢ  W<:Sˢ tgtˢ) F<:G V<:W with F<:G oˢ
-<:-resolveˢ (no r) (yes Sˢ Tˢ oˢ  W<:Sˢ tgtˢ) F<:G V<:W | defn o o₁ o₂ = CONTRADICTION (<:-impl-¬≮: (<:-trans V<:W (<:-trans W<:Sˢ o₁)) (r o))
-<:-resolveˢ r (no s) F<:G V<:W = <:-unknown
-
-<:-resolveᶠ : ∀ {F G V W} → (Fᶠ : FunType F) → (Gᶠ : FunType G) → (Vⁿ : Normal V) → (Wⁿ : Normal W) → (F <: G) → (V <: W) → resolveᶠ Fᶠ Vⁿ <: resolveᶠ Gᶠ Wⁿ
-<:-resolveᶠ Fᶠ Gᶠ Vⁿ Wⁿ F<:G V<:W = <:-resolveˢ
-  (resolveˢ (normal-saturate Fᶠ) (saturated Fᶠ) Vⁿ (λ o → o))
-  (resolveˢ (normal-saturate Gᶠ) (saturated Gᶠ) Wⁿ (λ o → o))
-  (<:-impl-<:ᵒ (normal-saturate Fᶠ) (saturated Fᶠ) (normal-saturate Gᶠ) (<:-trans (saturate-<: Fᶠ) (<:-trans F<:G (<:-saturate Gᶠ))))
-  V<:W
-
-<:-resolveⁿ : ∀ {F G V W} → (Fⁿ : Normal F) → (Gⁿ : Normal G) → (Vⁿ : Normal V) → (Wⁿ : Normal W) → (F <: G) → (V <: W) → resolveⁿ Fⁿ Vⁿ <: resolveⁿ Gⁿ Wⁿ
-<:-resolveⁿ (Rⁿ ⇒ Sⁿ) (Tⁿ ⇒ Uⁿ) Vⁿ Wⁿ F<:G V<:W = <:-resolveᶠ (Rⁿ ⇒ Sⁿ) (Tⁿ ⇒ Uⁿ) Vⁿ Wⁿ F<:G V<:W
-<:-resolveⁿ (Rⁿ ⇒ Sⁿ) (Gⁿ ∩ Hⁿ) Vⁿ Wⁿ F<:G V<:W = <:-resolveᶠ (Rⁿ ⇒ Sⁿ) (Gⁿ ∩ Hⁿ) Vⁿ Wⁿ F<:G V<:W
-<:-resolveⁿ (Eⁿ ∩ Fⁿ) (Tⁿ ⇒ Uⁿ) Vⁿ Wⁿ F<:G V<:W = <:-resolveᶠ (Eⁿ ∩ Fⁿ) (Tⁿ ⇒ Uⁿ) Vⁿ Wⁿ F<:G V<:W
-<:-resolveⁿ (Eⁿ ∩ Fⁿ) (Gⁿ ∩ Hⁿ) Vⁿ Wⁿ F<:G V<:W = <:-resolveᶠ (Eⁿ ∩ Fⁿ) (Gⁿ ∩ Hⁿ) Vⁿ Wⁿ F<:G V<:W
-<:-resolveⁿ (Fⁿ ∪ Sˢ) (Tⁿ ⇒ Uⁿ) Vⁿ Wⁿ F<:G V<:W = CONTRADICTION (<:-impl-¬≮: F<:G (≮:-∪-right (scalar-≮:-function Sˢ)))
-<:-resolveⁿ unknown (Tⁿ ⇒ Uⁿ) Vⁿ Wⁿ F<:G V<:W = CONTRADICTION (<:-impl-¬≮: F<:G unknown-≮:-function)
-<:-resolveⁿ (Fⁿ ∪ Sˢ) (Gⁿ ∩ Hⁿ) Vⁿ Wⁿ F<:G V<:W = CONTRADICTION (<:-impl-¬≮: F<:G (≮:-∪-right (scalar-≮:-fun (Gⁿ ∩ Hⁿ) Sˢ)))
-<:-resolveⁿ unknown (Gⁿ ∩ Hⁿ) Vⁿ Wⁿ F<:G V<:W = CONTRADICTION (<:-impl-¬≮: F<:G (unknown-≮:-fun (Gⁿ ∩ Hⁿ)))
-<:-resolveⁿ (Rⁿ ⇒ Sⁿ) never Vⁿ Wⁿ F<:G V<:W = CONTRADICTION (<:-impl-¬≮: F<:G (fun-≮:-never (Rⁿ ⇒ Sⁿ)))
-<:-resolveⁿ (Eⁿ ∩ Fⁿ) never Vⁿ Wⁿ F<:G V<:W = CONTRADICTION (<:-impl-¬≮: F<:G (fun-≮:-never (Eⁿ ∩ Fⁿ)))
-<:-resolveⁿ (Fⁿ ∪ Sˢ) never Vⁿ Wⁿ F<:G V<:W = CONTRADICTION (<:-impl-¬≮: F<:G (≮:-∪-right (scalar-≮:-never Sˢ)))
-<:-resolveⁿ unknown never Vⁿ Wⁿ F<:G V<:W = F<:G
-<:-resolveⁿ never Gⁿ Vⁿ Wⁿ F<:G V<:W = <:-never
-<:-resolveⁿ Fⁿ (Gⁿ ∪ Uˢ) Vⁿ Wⁿ F<:G V<:W = <:-unknown
-<:-resolveⁿ Fⁿ unknown Vⁿ Wⁿ F<:G V<:W = <:-unknown
-
-<:-resolve : ∀ {F G V W} → (F <: G) → (V <: W) → resolve F V <: resolve G W
-<:-resolve {F} {G} {V} {W} F<:G V<:W = <:-resolveⁿ (normal F) (normal G) (normal V) (normal W)
-  (<:-trans (normalize-<: F) (<:-trans F<:G (<:-normalize G)))
-  (<:-trans (normalize-<: V) (<:-trans V<:W (<:-normalize W)))

prototyping/Properties/Step.agda

@@ -1,172 +0,0 @@
-{-# OPTIONS --rewriting #-}
-
-module Properties.Step where
-
-open import Agda.Builtin.Equality using (_≡_; refl)
-open import Agda.Builtin.Float using (primFloatPlus; primFloatMinus; primFloatTimes; primFloatDiv; primFloatEquality; primFloatLess)
-open import Agda.Builtin.Bool using (true; false)
-open import Agda.Builtin.String using (primStringAppend)
-open import FFI.Data.Maybe using (just; nothing)
-open import Luau.Heap using (Heap; _[_]; alloc; ok; function_is_end)
-open import Luau.Syntax using (Block; Expr; nil; var; val; addr; bool; function_is_end; block_is_end; _$_; local_←_; return; done; _∙_; name; fun; arg; number; binexp; +; -; *; /; <; >; <=; >=; ==; ~=; ··; string)
-open import Luau.OpSem using (_⟦_⟧_⟶_; _⊢_⟶ᴱ_⊣_; _⊢_⟶ᴮ_⊣_; app₁ ; app₂ ; beta; function; block; return; done; local; subst; binOp₀; binOp₁; binOp₂; +; -; *; /; <; >; <=; >=; ==; ~=; ··; evalEqOp; evalNeqOp)
-open import Luau.RuntimeError using (BinOpError; RuntimeErrorᴱ; RuntimeErrorᴮ; FunctionMismatch; BinOpMismatch₁; BinOpMismatch₂; UnboundVariable; SEGV; app₁; app₂; block; local; return; bin₁; bin₂; +; -; *; /; <; >; <=; >=; ··)
-open import Luau.RuntimeType using (valueType; function; number)
-open import Luau.Substitution using (_[_/_]ᴮ)
-open import Properties.Remember using (remember; _,_)
-open import Utility.Bool using (not; _or_)
-
-data BinOpStepResult v op w : Set where
-  step : ∀ x → (v ⟦ op ⟧ w ⟶ x) → BinOpStepResult v op w
-  error₁ : BinOpError op (valueType(v)) → BinOpStepResult v op w
-  error₂ : BinOpError op (valueType(w)) → BinOpStepResult v op w
-
-binOpStep : ∀ v op w → BinOpStepResult v op w
-binOpStep nil + w = error₁ (+ (λ ()))
-binOpStep (addr a) + w = error₁ (+ (λ ()))
-binOpStep (number m) + nil = error₂ (+ (λ ()))
-binOpStep (number m) + (addr a) = error₂ (+ (λ ()))
-binOpStep (number m) + (number n) = step (number (primFloatPlus m n)) (+ m n)
-binOpStep (number m) + (bool b) = error₂ (+ (λ ()))
-binOpStep (number m) + (string x) = error₂ (+ (λ ()))
-binOpStep (number m) - (string x) = error₂ (- (λ ()))
-binOpStep (number m) * (string x) = error₂ (* (λ ()))
-binOpStep (number m) / (string x) = error₂ (/ (λ ()))
-binOpStep (number m) < (string x) = error₂ (< (λ ()))
-binOpStep (number m) > (string x) = error₂ (> (λ ()))
-binOpStep (number m) == (string x) = step (bool false) (== (number m) (string x))
-binOpStep (number m) ~= (string x) = step (bool true) (~= (number m) (string x))
-binOpStep (number m) <= (string x) = error₂ (<= (λ ()))
-binOpStep (number m) >= (string x) = error₂ (>= (λ ()))
-binOpStep (bool b) + w = error₁ (+ (λ ()))
-binOpStep nil - w = error₁ (- (λ ()))
-binOpStep (addr a) - w = error₁ (- (λ ()))
-binOpStep (number x) - nil = error₂ (- (λ ()))
-binOpStep (number x) - (addr a) = error₂ (- (λ ()))
-binOpStep (number x) - (number n) = step (number (primFloatMinus x n)) (- x n)
-binOpStep (number x) - (bool b) = error₂ (- (λ ()))
-binOpStep (bool b) - w = error₁ (- (λ ()))
-binOpStep nil * w = error₁ (* (λ ()))
-binOpStep (addr a) * w = error₁ (* (λ ()))
-binOpStep (number m) * nil = error₂ (* (λ ()))
-binOpStep (number m) * (addr a) = error₂ (* (λ ()))
-binOpStep (number m) * (number n) = step (number (primFloatDiv m n)) (* m n)
-binOpStep (number m) * (bool b) = error₂ (* (λ ()))
-binOpStep (bool b) * w = error₁ (* (λ ()))
-binOpStep nil / w = error₁ (/ (λ ()))
-binOpStep (addr a) / w = error₁ (/ (λ ()))
-binOpStep (number m) / nil = error₂ (/ (λ ()))
-binOpStep (number m) / (addr a) = error₂ (/ (λ ()))
-binOpStep (number m) / (number n) = step (number (primFloatTimes m n)) (/ m n)
-binOpStep (number m) / (bool b) = error₂ (/ (λ ()))
-binOpStep (bool b) / w = error₁ (/ (λ ()))
-binOpStep nil < w = error₁ (< (λ ()))
-binOpStep (addr a) < w = error₁ (< (λ ()))
-binOpStep (number m) < nil = error₂ (< (λ ()))
-binOpStep (number m) < (addr a) = error₂ (< (λ ()))
-binOpStep (number m) < (number n) = step (bool (primFloatLess m n)) (< m n)
-binOpStep (number m) < (bool b) = error₂ (< (λ ()))
-binOpStep (bool b) < w = error₁ (< (λ ()))
-binOpStep nil > w = error₁ (> (λ ()))
-binOpStep (addr a) > w = error₁ (> (λ ()))
-binOpStep (number m) > nil = error₂ (> (λ ()))
-binOpStep (number m) > (addr a) = error₂ (> (λ ()))
-binOpStep (number m) > (number n) = step (bool (primFloatLess n m)) (> m n)
-binOpStep (number m) > (bool b) = error₂ (> (λ ()))
-binOpStep (bool b) > w = error₁ (> (λ ()))
-binOpStep v == w = step (bool (evalEqOp v w)) (== v w)
-binOpStep v ~= w = step (bool (evalNeqOp v w)) (~= v w)
-binOpStep nil <= w = error₁ (<= (λ ()))
-binOpStep (addr a) <= w = error₁ (<= (λ ()))
-binOpStep (number m) <= nil = error₂ (<= (λ ()))
-binOpStep (number m) <= (addr a) = error₂ (<= (λ ()))
-binOpStep (number m) <= (number n) = step (bool (primFloatLess m n or primFloatEquality m n)) (<= m n)
-binOpStep (number m) <= (bool b) = error₂ (<= (λ ()))
-binOpStep (bool b) <= w = error₁ (<= (λ ()))
-binOpStep nil >= w = error₁ (>= (λ ()))
-binOpStep (addr a) >= w = error₁ (>= (λ ()))
-binOpStep (number m) >= nil = error₂ (>= (λ ()))
-binOpStep (number m) >= (addr a) = error₂ (>= (λ ()))
-binOpStep (number m) >= (number n) = step (bool (primFloatLess n m or primFloatEquality m n)) (>= m n)
-binOpStep (number m) >= (bool b) = error₂ (>= (λ ()))
-binOpStep (bool b) >= w = error₁ (>= (λ ()))
-binOpStep (string x) + w = error₁ (+ (λ ()))
-binOpStep (string x) - w = error₁ (- (λ ()))
-binOpStep (string x) * w = error₁ (* (λ ()))
-binOpStep (string x) / w = error₁ (/ (λ ()))
-binOpStep (string x) < w = error₁ (< (λ ()))
-binOpStep (string x) > w = error₁ (> (λ ()))
-binOpStep (string x) <= w = error₁ (<= (λ ()))
-binOpStep (string x) >= w = error₁ (>= (λ ()))
-binOpStep nil ·· y = error₁ (·· (λ ()))
-binOpStep (addr x) ·· y = error₁ (BinOpError.·· (λ ()))
-binOpStep (number x) ·· y = error₁ (BinOpError.·· (λ ()))
-binOpStep (bool x) ·· y = error₁ (BinOpError.·· (λ ()))
-binOpStep (string x) ·· nil = error₂ (·· (λ ()))
-binOpStep (string x) ·· (addr y) = error₂ (·· (λ ()))
-binOpStep (string x) ·· (number y) = error₂ (·· (λ ()))
-binOpStep (string x) ·· (bool y) = error₂ (·· (λ ()))
-binOpStep (string x) ·· (string y) = step (string (primStringAppend x y)) (·· x y)
-
-data StepResultᴮ {a} (H : Heap a) (B : Block a) : Set
-data StepResultᴱ {a} (H : Heap a) (M : Expr a) : Set
-
-data StepResultᴮ H B where
-  step : ∀ H′ B′ → (H ⊢ B ⟶ᴮ B′ ⊣ H′) → StepResultᴮ H B
-  return : ∀ v {B′} → (B ≡ (return (val v) ∙ B′)) → StepResultᴮ H B
-  done : (B ≡ done) → StepResultᴮ H B
-  error : (RuntimeErrorᴮ H B) → StepResultᴮ H B
-
-data StepResultᴱ H M where
-  step : ∀ H′ M′ → (H ⊢ M ⟶ᴱ M′ ⊣ H′) → StepResultᴱ H M
-  value : ∀ V → (M ≡ val V) → StepResultᴱ H M
-  error : (RuntimeErrorᴱ H M) → StepResultᴱ H M
-
-stepᴱ : ∀ {a} H M → StepResultᴱ {a} H M
-stepᴮ : ∀ {a} H B → StepResultᴮ {a} H B
-
-stepᴱ H (val v) = value v refl
-stepᴱ H (var x) = error UnboundVariable
-stepᴱ H (M $ N) with stepᴱ H M
-stepᴱ H (M $ N) | step H′ M′ D = step H′ (M′ $ N) (app₁ D)
-stepᴱ H (_ $ N) | value v refl with stepᴱ H N
-stepᴱ H (_ $ N) | value v refl | step H′ N′ s = step H′ (val v $ N′) (app₂ v s)
-stepᴱ H (_ $ _) | value (addr a) refl | value w refl with remember (H [ a ])
-stepᴱ H (_ $ _) | value (addr a) refl | value w refl  | (nothing , p) = error (app₁ (SEGV p))
-stepᴱ H (_ $ _) | value (addr a) refl | value w refl  | (just(function F is B end) , p) = step H (block (fun F) is B [ w / name (arg F) ]ᴮ end) (beta function F is B end w refl p)
-stepᴱ H (_ $ _) | value nil refl | value w refl = error (FunctionMismatch nil w (λ ()))
-stepᴱ H (_ $ _) | value (number m) refl | value w refl = error (FunctionMismatch (number m) w (λ ()))
-stepᴱ H (_ $ _) | value (bool b) refl | value w refl = error (FunctionMismatch (bool b) w (λ ()))
-stepᴱ H (_ $ _) | value (string x) refl | value w refl = error (FunctionMismatch (string x) w (λ ()))
-stepᴱ H (M $ N) | value V p | error E = error (app₂ E)
-stepᴱ H (M $ N) | error E = error (app₁ E)
-stepᴱ H (block b is B end) with stepᴮ H B
-stepᴱ H (block b is B end) | step H′ B′ D = step H′ (block b is B′ end) (block D)
-stepᴱ H (block b is (return _ ∙ B′) end) | return v refl = step H (val v) (return v)
-stepᴱ H (block b is done end) | done refl = step H (val nil) done
-stepᴱ H (block b is B end) | error E = error (block E)
-stepᴱ H (function F is C end) with alloc H (function F is C end)
-stepᴱ H function F is C end | ok a H′ p = step H′ (val (addr a)) (function a p)
-stepᴱ H (binexp M op N) with stepᴱ H M
-stepᴱ H (binexp M op N) | step H′ M′ s = step H′ (binexp M′ op N) (binOp₁ s)
-stepᴱ H (binexp M op N) | error E = error (bin₁ E)
-stepᴱ H (binexp M op N) | value v refl with stepᴱ H N
-stepᴱ H (binexp M op N) | value v refl | step H′ N′ s = step H′ (binexp (val v) op N′) (binOp₂ s)
-stepᴱ H (binexp M op N) | value v refl | error E = error (bin₂ E)
-stepᴱ H (binexp M op N) | value v refl | value w refl with binOpStep v op w
-stepᴱ H (binexp M op N) | value v refl | value w refl | step x p = step H (val x) (binOp₀ p)
-stepᴱ H (binexp M op N) | value v refl | value w refl | error₁ E = error (BinOpMismatch₁ v w E)
-stepᴱ H (binexp M op N) | value v refl | value w refl | error₂ E = error (BinOpMismatch₂ v w E)
-
-stepᴮ H (function F is C end ∙ B) with alloc H (function F is C end)
-stepᴮ H (function F is C end ∙ B) | ok a H′ p = step H′ (B [ addr a / name (fun F) ]ᴮ) (function a p)
-stepᴮ H (local x ← M ∙ B) with stepᴱ H M
-stepᴮ H (local x ← M ∙ B) | step H′ M′ D = step H′ (local x ← M′ ∙ B) (local D)
-stepᴮ H (local x ← _ ∙ B) | value v refl = step H (B [ v / name x ]ᴮ) (subst v)
-stepᴮ H (local x ← M ∙ B) | error E = error (local E)
-stepᴮ H (return M ∙ B) with stepᴱ H M
-stepᴮ H (return M ∙ B) | step H′ M′ D = step H′ (return M′ ∙ B) (return D)
-stepᴮ H (return _ ∙ B) | value V refl = return V refl
-stepᴮ H (return M ∙ B) | error E = error (return E)
-stepᴮ H done = done refl
- 

prototyping/Properties/StrictMode.agda

@@ -1,385 +0,0 @@
-{-# OPTIONS --rewriting #-}
-
-module Properties.StrictMode where
-
-import Agda.Builtin.Equality.Rewrite
-open import Agda.Builtin.Equality using (_≡_; refl)
-open import FFI.Data.Either using (Either; Left; Right; mapL; mapR; mapLR; swapLR; cond)
-open import FFI.Data.Maybe using (Maybe; just; nothing)
-open import Luau.Heap using (Heap; Object; function_is_end; defn; alloc; ok; next; lookup-not-allocated) renaming (_≡_⊕_↦_ to _≡ᴴ_⊕_↦_; _[_] to _[_]ᴴ; ∅ to ∅ᴴ)
-open import Luau.ResolveOverloads using (src; resolve)
-open import Luau.StrictMode using (Warningᴱ; Warningᴮ; Warningᴼ; Warningᴴ; UnallocatedAddress; UnboundVariable; FunctionCallMismatch; app₁; app₂; BinOpMismatch₁; BinOpMismatch₂; bin₁; bin₂; BlockMismatch; block₁; return; LocalVarMismatch; local₁; local₂; FunctionDefnMismatch; function₁; function₂; heap; expr; block; addr)
-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; _∩_; _∪_; _≡ᵀ_; _≡ᴹᵀ_)
-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 (_≡ᴬ_)
-open import Luau.VarCtxt using (VarCtxt; ∅; _⋒_; _↦_; _⊕_↦_; _⊝_; ⊕-lookup-miss; ⊕-swap; ⊕-over) renaming (_[_] to _[_]ⱽ)
-open import Luau.VarCtxt using (VarCtxt; ∅)
-open import Properties.Remember using (remember; _,_)
-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.DecSubtyping using (dec-subtyping)
-open import Properties.Subtyping using (unknown-≮:; ≡-trans-≮:; ≮:-trans-≡; ≮:-trans; ≮:-refl; scalar-≢-impl-≮:; function-≮:-scalar; scalar-≮:-function; function-≮:-never; unknown-≮:-scalar; scalar-≮:-never; unknown-≮:-never; <:-refl; <:-unknown; <:-impl-¬≮:)
-open import Properties.ResolveOverloads using (src-unknown-≮:; unknown-src-≮:; <:-resolve; resolve-<:-⇒; <:-resolve-⇒)
-open import Properties.Subtyping using (unknown-≮:; ≡-trans-≮:; ≮:-trans-≡; ≮:-trans; <:-trans-≮:; ≮:-refl; scalar-≢-impl-≮:; function-≮:-scalar; scalar-≮:-function; function-≮:-never; unknown-≮:-scalar; scalar-≮:-never; unknown-≮:-never; ≡-impl-<:; ≡-trans-<:; <:-trans-≡; ≮:-trans-<:; <:-trans)
-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; +; -; *; /; <; >; <=; >=; ··)
-open import Luau.RuntimeType using (RuntimeType; valueType; number; string; boolean; nil; function)
-
-data _⊑_ (H : Heap yes) : Heap yes → Set where
-  refl : (H ⊑ H)
-  snoc : ∀ {H′ a O} → (H′ ≡ᴴ H ⊕ a ↦ O) → (H ⊑ H′)
-
-rednᴱ⊑ : ∀ {H H′ M M′} → (H ⊢ M ⟶ᴱ M′ ⊣ H′) → (H ⊑ H′)
-rednᴮ⊑ : ∀ {H H′ B B′} → (H ⊢ B ⟶ᴮ B′ ⊣ H′) → (H ⊑ H′)
-
-rednᴱ⊑ (function a p) = snoc p
-rednᴱ⊑ (app₁ s) = rednᴱ⊑ s
-rednᴱ⊑ (app₂ p s) = rednᴱ⊑ s
-rednᴱ⊑ (beta O v p q) = refl
-rednᴱ⊑ (block s) = rednᴮ⊑ s
-rednᴱ⊑ (return v) = refl
-rednᴱ⊑ done = refl
-rednᴱ⊑ (binOp₀ p) = refl
-rednᴱ⊑ (binOp₁ s) = rednᴱ⊑ s
-rednᴱ⊑ (binOp₂ s) = rednᴱ⊑ s
-
-rednᴮ⊑ (local s) = rednᴱ⊑ s
-rednᴮ⊑ (subst v) = refl
-rednᴮ⊑ (function a p) = snoc p
-rednᴮ⊑ (return s) = rednᴱ⊑ s
-
-data LookupResult (H : Heap yes) a V : Set where
-  just : (H [ a ]ᴴ ≡ just V) → LookupResult H a V
-  nothing : (H [ a ]ᴴ ≡ nothing) → LookupResult H a V
-
-lookup-⊑-nothing : ∀ {H H′} a → (H ⊑ H′) → (H′ [ a ]ᴴ ≡ nothing) → (H [ a ]ᴴ ≡ nothing)
-lookup-⊑-nothing {H} a refl p = p
-lookup-⊑-nothing {H} a (snoc defn) p with a ≡ᴬ next H 
-lookup-⊑-nothing {H} a (snoc defn) p | yes refl = refl
-lookup-⊑-nothing {H} a (snoc o) p | no q = trans (lookup-not-allocated o q) p
-
-<:-heap-weakeningᴱ : ∀ Γ H M {H′} → (H ⊑ H′) → (typeOfᴱ H′ Γ M <: typeOfᴱ H Γ M)
-<:-heap-weakeningᴱ Γ H (var x) h = <:-refl
-<:-heap-weakeningᴱ Γ H (val nil) h = <:-refl
-<:-heap-weakeningᴱ Γ H (val (addr a)) refl = <:-refl
-<:-heap-weakeningᴱ Γ H (val (addr a)) (snoc {a = b} q) with a ≡ᴬ b
-<:-heap-weakeningᴱ Γ H (val (addr a)) (snoc {a = a} defn) | yes refl = <:-unknown
-<:-heap-weakeningᴱ Γ H (val (addr a)) (snoc {a = b} q) | no r = ≡-impl-<: (sym (cong orUnknown (cong typeOfᴹᴼ (lookup-not-allocated q r))))
-<:-heap-weakeningᴱ Γ H (val (number n)) h = <:-refl
-<:-heap-weakeningᴱ Γ H (val (bool b)) h = <:-refl
-<:-heap-weakeningᴱ Γ H (val (string s)) h = <:-refl
-<:-heap-weakeningᴱ Γ H (M $ N) h = <:-resolve (<:-heap-weakeningᴱ Γ H M h) (<:-heap-weakeningᴱ Γ H N h)
-<:-heap-weakeningᴱ Γ H (function f ⟨ var x ∈ S ⟩∈ T is B end) h = <:-refl
-<:-heap-weakeningᴱ Γ H (block var b ∈ T is N end) h = <:-refl
-<:-heap-weakeningᴱ Γ H (binexp M op N) h = <:-refl
-
-<:-heap-weakeningᴮ : ∀ Γ H B {H′} → (H ⊑ H′) → (typeOfᴮ H′ Γ B <: typeOfᴮ H Γ B)
-<:-heap-weakeningᴮ Γ H (function f ⟨ var x ∈ T ⟩∈ U is C end ∙ B) h = <:-heap-weakeningᴮ (Γ ⊕ f ↦ (T ⇒ U)) H B h
-<:-heap-weakeningᴮ Γ H (local var x ∈ T ← M ∙ B) h = <:-heap-weakeningᴮ (Γ ⊕ x ↦ T) H B h
-<:-heap-weakeningᴮ Γ H (return M ∙ B) h = <:-heap-weakeningᴱ Γ H M h
-<:-heap-weakeningᴮ Γ H done h = <:-refl
-
-≮:-heap-weakeningᴱ : ∀ Γ H M {H′ U} → (H ⊑ H′) → (typeOfᴱ H′ Γ M ≮: U) → (typeOfᴱ H Γ M ≮: U)
-≮:-heap-weakeningᴱ Γ H M h p = <:-trans-≮: (<:-heap-weakeningᴱ Γ H M h) p
-
-≮:-heap-weakeningᴮ : ∀ Γ H B {H′ U} → (H ⊑ H′) → (typeOfᴮ H′ Γ B ≮: U) → (typeOfᴮ H Γ B ≮: U)
-≮:-heap-weakeningᴮ Γ H B h p = <:-trans-≮: (<:-heap-weakeningᴮ Γ H B h) p
-
-binOpPreservation : ∀ H {op v w x} → (v ⟦ op ⟧ w ⟶ x) → (tgtBinOp op ≡ typeOfᴱ H ∅ (val x))
-binOpPreservation H (+ m n) = refl
-binOpPreservation H (- m n) = refl
-binOpPreservation H (/ m n) = refl
-binOpPreservation H (* m n) = refl
-binOpPreservation H (< m n) = refl
-binOpPreservation H (> m n) = refl
-binOpPreservation H (<= m n) = refl
-binOpPreservation H (>= m n) = refl
-binOpPreservation H (== v w) = refl
-binOpPreservation H (~= v w) = refl
-binOpPreservation H (·· v w) = refl
-
-<:-substitutivityᴱ : ∀ {Γ T} H M v x → (typeOfᴱ H ∅ (val v) <: T) → (typeOfᴱ H Γ (M [ v / x ]ᴱ) <: typeOfᴱ H (Γ ⊕ x ↦ T) M)
-<:-substitutivityᴱ-whenever : ∀ {Γ T} H v x y (r : Dec(x ≡ y)) → (typeOfᴱ H ∅ (val v) <: T) → (typeOfᴱ H Γ (var y [ v / x ]ᴱwhenever r) <: typeOfᴱ H (Γ ⊕ x ↦ T) (var y))
-<:-substitutivityᴮ : ∀ {Γ T} H B v x → (typeOfᴱ H ∅ (val v) <: T) → (typeOfᴮ H Γ (B [ v / x ]ᴮ) <: typeOfᴮ H (Γ ⊕ x ↦ T) B)
-<:-substitutivityᴮ-unless : ∀ {Γ T U} H B v x y (r : Dec(x ≡ y)) → (typeOfᴱ H ∅ (val v) <: T) → (typeOfᴮ H (Γ ⊕ y ↦ U) (B [ v / x ]ᴮunless r) <: typeOfᴮ H ((Γ ⊕ x ↦ T) ⊕ y ↦ U) B)
-<:-substitutivityᴮ-unless-yes : ∀ {Γ Γ′} H B v x y (r : x ≡ y) → (Γ′ ≡ Γ) → (typeOfᴮ H Γ (B [ v / x ]ᴮunless yes r) <: typeOfᴮ H Γ′ B)
-<:-substitutivityᴮ-unless-no : ∀ {Γ Γ′ T} H B v x y (r : x ≢ y) → (Γ′ ≡ Γ ⊕ x ↦ T) → (typeOfᴱ H ∅ (val v) <: T) → (typeOfᴮ H Γ (B [ v / x ]ᴮunless no r) <: typeOfᴮ H Γ′ B) 
-
-<:-substitutivityᴱ H (var y) v x p = <:-substitutivityᴱ-whenever H v x y (x ≡ⱽ y) p
-<:-substitutivityᴱ H (val w) v x p = <:-refl
-<:-substitutivityᴱ H (binexp M op N) v x p = <:-refl
-<:-substitutivityᴱ H (M $ N) v x p = <:-resolve (<:-substitutivityᴱ H M v x p) (<:-substitutivityᴱ H N v x p)
-<:-substitutivityᴱ H (function f ⟨ var y ∈ T ⟩∈ U is B end) v x p = <:-refl
-<:-substitutivityᴱ H (block var b ∈ T is B end) v x p = <:-refl
-<:-substitutivityᴱ-whenever H v x x (yes refl) p = p
-<:-substitutivityᴱ-whenever H v x y (no o) p = (≡-impl-<: (cong orUnknown (⊕-lookup-miss x y _ _ o)))
-
-<:-substitutivityᴮ H (function f ⟨ var y ∈ T ⟩∈ U is C end ∙ B) v x p = <:-substitutivityᴮ-unless H B v x f (x ≡ⱽ f) p
-<:-substitutivityᴮ H (local var y ∈ T ← M ∙ B) v x p = <:-substitutivityᴮ-unless H B v x y (x ≡ⱽ y) p
-<:-substitutivityᴮ H (return M ∙ B) v x p = <:-substitutivityᴱ H M v x p
-<:-substitutivityᴮ H done v x p = <:-refl
-<:-substitutivityᴮ-unless H B v x y (yes r) p = <:-substitutivityᴮ-unless-yes H B v x y r (⊕-over r)
-<:-substitutivityᴮ-unless H B v x y (no r) p = <:-substitutivityᴮ-unless-no H B v x y r (⊕-swap r) p
-<:-substitutivityᴮ-unless-yes H B v x y refl refl = <:-refl
-<:-substitutivityᴮ-unless-no H B v x y r refl p = <:-substitutivityᴮ H B v x p
-
-≮:-substitutivityᴱ : ∀ {Γ T U} H M v x → (typeOfᴱ H Γ (M [ v / x ]ᴱ) ≮: U) → Either (typeOfᴱ H (Γ ⊕ x ↦ T) M ≮: U) (typeOfᴱ H ∅ (val v) ≮: T)
-≮:-substitutivityᴱ {T = T} H M v x p with dec-subtyping (typeOfᴱ H ∅ (val v)) T
-≮:-substitutivityᴱ H M v x p | Left q = Right q
-≮:-substitutivityᴱ H M v x p | Right q = Left (<:-trans-≮: (<:-substitutivityᴱ H M v x q) p)
-
-≮:-substitutivityᴮ : ∀ {Γ T U} H B v x → (typeOfᴮ H Γ (B [ v / x ]ᴮ) ≮: U) → Either (typeOfᴮ H (Γ ⊕ x ↦ T) B ≮: U) (typeOfᴱ H ∅ (val v) ≮: T)
-≮:-substitutivityᴮ {T = T} H M v x p with dec-subtyping (typeOfᴱ H ∅ (val v)) T
-≮:-substitutivityᴮ H M v x p | Left q = Right q
-≮:-substitutivityᴮ H M v x p | Right q = Left (<:-trans-≮: (<:-substitutivityᴮ H M v x q) p)
-
-≮:-substitutivityᴮ-unless : ∀ {Γ T U V} H B v x y (r : Dec(x ≡ y)) → (typeOfᴮ H (Γ ⊕ y ↦ U) (B [ v / x ]ᴮunless r) ≮: V) → Either (typeOfᴮ H ((Γ ⊕ x ↦ T) ⊕ y ↦ U) B ≮: V) (typeOfᴱ H ∅ (val v) ≮: T)
-≮:-substitutivityᴮ-unless {T = T} H B v x y r p with dec-subtyping (typeOfᴱ H ∅ (val v)) T
-≮:-substitutivityᴮ-unless H B v x y r p | Left q = Right q
-≮:-substitutivityᴮ-unless H B v x y r p | Right q = Left (<:-trans-≮: (<:-substitutivityᴮ-unless H B v x y r q) p)
-
-<:-reductionᴱ : ∀ H M {H′ M′} → (H ⊢ M ⟶ᴱ M′ ⊣ H′) → Either (typeOfᴱ H′ ∅ M′ <: typeOfᴱ H ∅ M) (Warningᴱ H (typeCheckᴱ H ∅ M))
-<:-reductionᴮ : ∀ H B {H′ B′} → (H ⊢ B ⟶ᴮ B′ ⊣ H′) → Either (typeOfᴮ H′ ∅ B′ <: typeOfᴮ H ∅ B) (Warningᴮ H (typeCheckᴮ H ∅ B))
-
-<:-reductionᴱ H (M $ N) (app₁ s) = mapLR (λ p → <:-resolve p (<:-heap-weakeningᴱ ∅ H N (rednᴱ⊑ s))) app₁ (<:-reductionᴱ H M s)
-<:-reductionᴱ H (M $ N) (app₂ q s) = mapLR (λ p → <:-resolve (<:-heap-weakeningᴱ ∅ H M (rednᴱ⊑ s)) p) app₂ (<:-reductionᴱ H N s)
-<:-reductionᴱ H (M $ N) (beta (function f ⟨ var y ∈ S ⟩∈ U is B end) v refl q) with dec-subtyping (typeOfᴱ H ∅ (val v)) S
-<:-reductionᴱ H (M $ N) (beta (function f ⟨ var y ∈ S ⟩∈ U is B end) v refl q) | Left r = Right (FunctionCallMismatch (≮:-trans-≡ r (cong src (cong orUnknown (cong typeOfᴹᴼ (sym q))))))
-<:-reductionᴱ H (M $ N) (beta (function f ⟨ var y ∈ S ⟩∈ U is B end) v refl q) | Right r = Left (<:-trans-≡ (<:-resolve-⇒ r) (cong (λ F → resolve F (typeOfᴱ H ∅ N)) (cong orUnknown (cong typeOfᴹᴼ (sym q)))))
-<:-reductionᴱ H (function f ⟨ var x ∈ T ⟩∈ U is B end) (function a defn) = Left <:-refl
-<:-reductionᴱ H (block var b ∈ T is B end) (block s) = Left <:-refl
-<:-reductionᴱ H (block var b ∈ T is return (val v) ∙ B end) (return v) with dec-subtyping (typeOfᴱ H ∅ (val v)) T
-<:-reductionᴱ H (block var b ∈ T is return (val v) ∙ B end) (return v) | Left p = Right (BlockMismatch p)
-<:-reductionᴱ H (block var b ∈ T is return (val v) ∙ B end) (return v) | Right p = Left p
-<:-reductionᴱ H (block var b ∈ T is done end) done with dec-subtyping nil T
-<:-reductionᴱ H (block var b ∈ T is done end) done | Left p = Right (BlockMismatch p)
-<:-reductionᴱ H (block var b ∈ T is done end) done | Right p = Left p
-<:-reductionᴱ H (binexp M op N) (binOp₀ s) = Left (≡-impl-<: (sym (binOpPreservation H s)))
-<:-reductionᴱ H (binexp M op N) (binOp₁ s) = Left <:-refl
-<:-reductionᴱ H (binexp M op N) (binOp₂ s) = Left <:-refl
-
-<:-reductionᴮ H (function f ⟨ var x ∈ T ⟩∈ U is C end ∙ B) (function a defn) = Left (<:-trans (<:-substitutivityᴮ _ B (addr a) f <:-refl) (<:-heap-weakeningᴮ (f ↦ (T ⇒ U)) H B (snoc defn)))
-<:-reductionᴮ H (local var x ∈ T ← M ∙ B) (local s) = Left (<:-heap-weakeningᴮ (x ↦ T) H B (rednᴱ⊑ s))
-<:-reductionᴮ H (local var x ∈ T ← M ∙ B) (subst v) with dec-subtyping (typeOfᴱ H ∅ (val v)) T
-<:-reductionᴮ H (local var x ∈ T ← M ∙ B) (subst v) | Left p = Right (LocalVarMismatch p)
-<:-reductionᴮ H (local var x ∈ T ← M ∙ B) (subst v) | Right p = Left (<:-substitutivityᴮ H B v x p)
-<:-reductionᴮ H (return M ∙ B) (return s) = mapR return (<:-reductionᴱ H M s)
-
-≮:-reductionᴱ : ∀ H M {H′ M′ T} → (H ⊢ M ⟶ᴱ M′ ⊣ H′) → (typeOfᴱ H′ ∅ M′ ≮: T) → Either (typeOfᴱ H ∅ M ≮: T) (Warningᴱ H (typeCheckᴱ H ∅ M))
-≮:-reductionᴱ H M s p = mapL (λ q → <:-trans-≮: q p) (<:-reductionᴱ H M s)
-
-≮:-reductionᴮ : ∀ H B {H′ B′ T} → (H ⊢ B ⟶ᴮ B′ ⊣ H′) → (typeOfᴮ H′ ∅ B′ ≮: T) → Either (typeOfᴮ H ∅ B ≮: T) (Warningᴮ H (typeCheckᴮ H ∅ B))
-≮:-reductionᴮ H B s p = mapL (λ q → <:-trans-≮: q p) (<:-reductionᴮ H B s)
-
-reflect-substitutionᴱ : ∀ {Γ T} H M v x → Warningᴱ H (typeCheckᴱ H Γ (M [ v / x ]ᴱ)) → Either (Warningᴱ H (typeCheckᴱ H (Γ ⊕ x ↦ T) M)) (Either (Warningᴱ H (typeCheckᴱ H ∅ (val v))) (typeOfᴱ H ∅ (val v) ≮: T))
-reflect-substitutionᴱ-whenever : ∀ {Γ T} H v x y (p : Dec(x ≡ y)) → Warningᴱ H (typeCheckᴱ H Γ (var y [ v / x ]ᴱwhenever p)) → Either (Warningᴱ H (typeCheckᴱ H (Γ ⊕ x ↦ T) (var y))) (Either (Warningᴱ H (typeCheckᴱ H ∅ (val v))) (typeOfᴱ H ∅ (val v) ≮: T))
-reflect-substitutionᴮ : ∀ {Γ T} H B v x → Warningᴮ H (typeCheckᴮ H Γ (B [ v / x ]ᴮ)) → Either (Warningᴮ H (typeCheckᴮ H (Γ ⊕ x ↦ T) B)) (Either (Warningᴱ H (typeCheckᴱ H ∅ (val v))) (typeOfᴱ H ∅ (val v) ≮: T))
-reflect-substitutionᴮ-unless : ∀ {Γ T U} H B v x y (r : Dec(x ≡ y)) → Warningᴮ H (typeCheckᴮ H (Γ ⊕ y ↦ U) (B [ v / x ]ᴮunless r)) → Either (Warningᴮ H (typeCheckᴮ H ((Γ ⊕ x ↦ T) ⊕ y ↦ U) B)) (Either (Warningᴱ H (typeCheckᴱ H ∅ (val v))) (typeOfᴱ H ∅ (val v) ≮: T))
-reflect-substitutionᴮ-unless-yes : ∀ {Γ Γ′ T} H B v x y (r : x ≡ y) → (Γ′ ≡ Γ) → Warningᴮ H (typeCheckᴮ H Γ (B [ v / x ]ᴮunless yes r)) → Either (Warningᴮ H (typeCheckᴮ H Γ′ B)) (Either (Warningᴱ H (typeCheckᴱ H ∅ (val v))) (typeOfᴱ H ∅ (val v) ≮: T))
-reflect-substitutionᴮ-unless-no : ∀ {Γ Γ′ T} H B v x y (r : x ≢ y) → (Γ′ ≡ Γ ⊕ x ↦ T) → Warningᴮ H (typeCheckᴮ H Γ (B [ v / x ]ᴮunless no r)) → Either (Warningᴮ H (typeCheckᴮ H Γ′ B)) (Either (Warningᴱ H (typeCheckᴱ H ∅ (val v))) (typeOfᴱ H ∅ (val v) ≮: T))
-
-reflect-substitutionᴱ H (var y) v x W = reflect-substitutionᴱ-whenever H v x y (x ≡ⱽ y) W
-reflect-substitutionᴱ H (val (addr a)) v x (UnallocatedAddress r) = Left (UnallocatedAddress r)
-reflect-substitutionᴱ H (M $ N) v x (FunctionCallMismatch p) with ≮:-substitutivityᴱ H N v x p
-reflect-substitutionᴱ H (M $ N) v x (FunctionCallMismatch p) | Right W = Right (Right W)
-reflect-substitutionᴱ H (M $ N) v x (FunctionCallMismatch p) | Left q with ≮:-substitutivityᴱ H M v x (src-unknown-≮: q)
-reflect-substitutionᴱ H (M $ N) v x (FunctionCallMismatch p) | Left q | Left r = Left ((FunctionCallMismatch ∘ unknown-src-≮: q) r)
-reflect-substitutionᴱ H (M $ N) v x (FunctionCallMismatch p) | Left q | Right W = Right (Right W)
-reflect-substitutionᴱ H (M $ N) v x (app₁ W) = mapL app₁ (reflect-substitutionᴱ H M v x W)
-reflect-substitutionᴱ H (M $ N) v x (app₂ W) = mapL app₂ (reflect-substitutionᴱ H N v x W)
-reflect-substitutionᴱ H (function f ⟨ var y ∈ T ⟩∈ U is B end) v x (FunctionDefnMismatch q) = mapLR FunctionDefnMismatch Right (≮:-substitutivityᴮ-unless H B v x y (x ≡ⱽ y) q)
-reflect-substitutionᴱ H (function f ⟨ var y ∈ T ⟩∈ U is B end) v x (function₁ W) = mapL function₁ (reflect-substitutionᴮ-unless H B v x y (x ≡ⱽ y) W)
-reflect-substitutionᴱ H (block var b ∈ T is B end) v x (BlockMismatch q) =  mapLR BlockMismatch Right (≮:-substitutivityᴮ H B v x q)
-reflect-substitutionᴱ H (block var b ∈ T is B end) v x (block₁ W′) = mapL block₁ (reflect-substitutionᴮ H B v x W′)
-reflect-substitutionᴱ H (binexp M op N) v x (BinOpMismatch₁ q) = mapLR BinOpMismatch₁ Right (≮:-substitutivityᴱ H M v x q)
-reflect-substitutionᴱ H (binexp M op N) v x (BinOpMismatch₂ q) = mapLR BinOpMismatch₂ Right (≮:-substitutivityᴱ H N v x q)
-reflect-substitutionᴱ H (binexp M op N) v x (bin₁ W) = mapL bin₁ (reflect-substitutionᴱ H M v x W)
-reflect-substitutionᴱ H (binexp M op N) v x (bin₂ W) = mapL bin₂ (reflect-substitutionᴱ H N v x W)
-
-reflect-substitutionᴱ-whenever H a x x (yes refl) (UnallocatedAddress p) = Right (Left (UnallocatedAddress p))
-reflect-substitutionᴱ-whenever H v x y (no p) (UnboundVariable q) = Left (UnboundVariable (trans (sym (⊕-lookup-miss x y _ _ p)) q))
-
-reflect-substitutionᴮ H (function f ⟨ var y ∈ T ⟩∈ U is C end ∙ B) v x (FunctionDefnMismatch q) = mapLR FunctionDefnMismatch Right (≮:-substitutivityᴮ-unless H C v x y (x ≡ⱽ y) q)
-reflect-substitutionᴮ H (function f ⟨ var y ∈ T ⟩∈ U is C end ∙ B) v x (function₁ W) =  mapL function₁ (reflect-substitutionᴮ-unless H C v x y (x ≡ⱽ y) W)
-reflect-substitutionᴮ H (function f ⟨ var y ∈ T ⟩∈ U is C end ∙ B) v x (function₂ W) = mapL function₂ (reflect-substitutionᴮ-unless H B v x f (x ≡ⱽ f) W)
-reflect-substitutionᴮ H (local var y ∈ T ← M ∙ B) v x (LocalVarMismatch q) = mapLR LocalVarMismatch Right (≮:-substitutivityᴱ H M v x q)
-reflect-substitutionᴮ H (local var y ∈ T ← M ∙ B) v x (local₁ W) = mapL local₁ (reflect-substitutionᴱ H M v x W)
-reflect-substitutionᴮ H (local var y ∈ T ← M ∙ B) v x (local₂ W) = mapL local₂ (reflect-substitutionᴮ-unless H B v x y (x ≡ⱽ y) W)
-reflect-substitutionᴮ H (return M ∙ B) v x (return W) = mapL return (reflect-substitutionᴱ H M v x W)
-
-reflect-substitutionᴮ-unless H B v x y (yes p) W = reflect-substitutionᴮ-unless-yes H B v x y p (⊕-over p) W
-reflect-substitutionᴮ-unless H B v x y (no p) W = reflect-substitutionᴮ-unless-no H B v x y p (⊕-swap p) W
-reflect-substitutionᴮ-unless-yes H B v x x refl refl W = Left W
-reflect-substitutionᴮ-unless-no H B v x y p refl W = reflect-substitutionᴮ H B v x W
-
-reflect-weakeningᴱ : ∀ Γ H M {H′} → (H ⊑ H′) → Warningᴱ H′ (typeCheckᴱ H′ Γ M) → Warningᴱ H (typeCheckᴱ H Γ M)
-reflect-weakeningᴮ : ∀ Γ H B {H′} → (H ⊑ H′) → Warningᴮ H′ (typeCheckᴮ H′ Γ B) → Warningᴮ H (typeCheckᴮ H Γ B)
-
-reflect-weakeningᴱ Γ H (var x) h (UnboundVariable p) = (UnboundVariable p)
-reflect-weakeningᴱ Γ H (val (addr a)) h (UnallocatedAddress p) = UnallocatedAddress (lookup-⊑-nothing a h p)
-reflect-weakeningᴱ Γ H (M $ N) h (FunctionCallMismatch p) = FunctionCallMismatch (≮:-heap-weakeningᴱ Γ H N h (unknown-src-≮: p (≮:-heap-weakeningᴱ Γ H M h (src-unknown-≮: p))))
-reflect-weakeningᴱ Γ H (M $ N) h (app₁ W) = app₁ (reflect-weakeningᴱ Γ H M h W)
-reflect-weakeningᴱ Γ H (M $ N) h (app₂ W) = app₂ (reflect-weakeningᴱ Γ H N h W)
-reflect-weakeningᴱ Γ H (binexp M op N) h (BinOpMismatch₁ p) = BinOpMismatch₁ (≮:-heap-weakeningᴱ Γ H M h p)
-reflect-weakeningᴱ Γ H (binexp M op N) h (BinOpMismatch₂ p) = BinOpMismatch₂ (≮:-heap-weakeningᴱ Γ H N h p)
-reflect-weakeningᴱ Γ H (binexp M op N) h (bin₁ W′) = bin₁ (reflect-weakeningᴱ Γ H M h W′)
-reflect-weakeningᴱ Γ H (binexp M op N) h (bin₂ W′) = bin₂ (reflect-weakeningᴱ Γ H N h W′)
-reflect-weakeningᴱ Γ H (function f ⟨ var y ∈ T ⟩∈ U is B end) h (FunctionDefnMismatch p) = FunctionDefnMismatch (≮:-heap-weakeningᴮ (Γ ⊕ y ↦ T) H B h p)
-reflect-weakeningᴱ Γ H (function f ⟨ var y ∈ T ⟩∈ U is B end) h (function₁ W) = function₁ (reflect-weakeningᴮ (Γ ⊕ y ↦ T) H B h W)
-reflect-weakeningᴱ Γ H (block var b ∈ T is B end) h (BlockMismatch p) = BlockMismatch (≮:-heap-weakeningᴮ Γ H B h p)
-reflect-weakeningᴱ Γ H (block var b ∈ T is B end) h (block₁ W) = block₁ (reflect-weakeningᴮ Γ H B h W)
-
-reflect-weakeningᴮ Γ H (return M ∙ B) h (return W) = return (reflect-weakeningᴱ Γ H M h W)
-reflect-weakeningᴮ Γ H (local var y ∈ T ← M ∙ B) h (LocalVarMismatch p) = LocalVarMismatch (≮:-heap-weakeningᴱ Γ H M h p)
-reflect-weakeningᴮ Γ H (local var y ∈ T ← M ∙ B) h (local₁ W) = local₁ (reflect-weakeningᴱ Γ H M h W)
-reflect-weakeningᴮ Γ H (local var y ∈ T ← M ∙ B) h (local₂ W) = local₂ (reflect-weakeningᴮ (Γ ⊕ y ↦ T) H B h W)
-reflect-weakeningᴮ Γ H (function f ⟨ var x ∈ T ⟩∈ U is C end ∙ B) h (FunctionDefnMismatch p) = FunctionDefnMismatch (≮:-heap-weakeningᴮ (Γ ⊕ x ↦ T) H C h p)
-reflect-weakeningᴮ Γ H (function f ⟨ var x ∈ T ⟩∈ U is C end ∙ B) h (function₁ W) = function₁ (reflect-weakeningᴮ (Γ ⊕ x ↦ T) H C h W)
-reflect-weakeningᴮ Γ H (function f ⟨ var x ∈ T ⟩∈ U is C end ∙ B) h (function₂ W) = function₂ (reflect-weakeningᴮ (Γ ⊕ f ↦ (T ⇒ U)) H B h W)
-
-reflect-weakeningᴼ : ∀ H O {H′} → (H ⊑ H′) → Warningᴼ H′ (typeCheckᴼ H′ O) → Warningᴼ H (typeCheckᴼ H O)
-reflect-weakeningᴼ H (just function f ⟨ var x ∈ T ⟩∈ U is B end) h (FunctionDefnMismatch p) = FunctionDefnMismatch (≮:-heap-weakeningᴮ (x ↦ T) H B h p)
-reflect-weakeningᴼ H (just function f ⟨ var x ∈ T ⟩∈ U is B end) h (function₁ W) = function₁ (reflect-weakeningᴮ (x ↦ T) H B h W)
-
-reflectᴱ : ∀ H M {H′ M′} → (H ⊢ M ⟶ᴱ M′ ⊣ H′) → Warningᴱ H′ (typeCheckᴱ H′ ∅ M′) → Either (Warningᴱ H (typeCheckᴱ H ∅ M)) (Warningᴴ H (typeCheckᴴ H))
-reflectᴮ : ∀ H B {H′ B′} → (H ⊢ B ⟶ᴮ B′ ⊣ H′) → Warningᴮ H′ (typeCheckᴮ H′ ∅ B′) → Either (Warningᴮ H (typeCheckᴮ H ∅ B)) (Warningᴴ H (typeCheckᴴ H))
-
-reflectᴱ H (M $ N) (app₁ s) (FunctionCallMismatch p) = cond (Left ∘ FunctionCallMismatch ∘ ≮:-heap-weakeningᴱ ∅ H N (rednᴱ⊑ s) ∘ unknown-src-≮: p) (Left ∘ app₁) (≮:-reductionᴱ H M s (src-unknown-≮: p))
-reflectᴱ H (M $ N) (app₁ s) (app₁ W′) = mapL app₁ (reflectᴱ H M s W′)
-reflectᴱ H (M $ N) (app₁ s) (app₂ W′) = Left (app₂ (reflect-weakeningᴱ ∅ H N (rednᴱ⊑ s) W′))
-reflectᴱ H (M $ N) (app₂ p s) (FunctionCallMismatch q) = cond (λ r → Left (FunctionCallMismatch (unknown-src-≮: r (≮:-heap-weakeningᴱ ∅ H M (rednᴱ⊑ s) (src-unknown-≮: r))))) (Left ∘ app₂) (≮:-reductionᴱ H N s q)
-reflectᴱ H (M $ N) (app₂ p s) (app₁ W′) = Left (app₁ (reflect-weakeningᴱ ∅ H M (rednᴱ⊑ s) W′))
-reflectᴱ H (M $ N) (app₂ p s) (app₂ W′) = mapL app₂ (reflectᴱ H N s W′)
-reflectᴱ H (val (addr a) $ N) (beta (function f ⟨ var x ∈ T ⟩∈ U is B end) v refl p) (BlockMismatch q) with ≮:-substitutivityᴮ H B v x q 
-reflectᴱ H (val (addr a) $ N) (beta (function f ⟨ var x ∈ T ⟩∈ U is B end) v refl p) (BlockMismatch q) | Left r = Right (addr a p (FunctionDefnMismatch r))
-reflectᴱ H (val (addr a) $ N) (beta (function f ⟨ var x ∈ T ⟩∈ U is B end) v refl p) (BlockMismatch q) | Right r = Left (FunctionCallMismatch (≮:-trans-≡ r ((cong src (cong orUnknown (cong typeOfᴹᴼ (sym p)))))))
-reflectᴱ H (val (addr a) $ N) (beta (function f ⟨ var x ∈ T ⟩∈ U is B end) v refl p) (block₁ W′) with reflect-substitutionᴮ _ B v x W′
-reflectᴱ H (val (addr a) $ N) (beta (function f ⟨ var x ∈ T ⟩∈ U is B end) v refl p) (block₁ W′) | Left W = Right (addr a p (function₁ W))
-reflectᴱ H (val (addr a) $ N) (beta (function f ⟨ var x ∈ T ⟩∈ U is B end) v refl p) (block₁ W′) | Right (Left W) = Left (app₂ W)
-reflectᴱ H (val (addr a) $ N) (beta (function f ⟨ var x ∈ T ⟩∈ U is B end) v refl p) (block₁ W′) | Right (Right q) = Left (FunctionCallMismatch (≮:-trans-≡ q (cong src (cong orUnknown (cong typeOfᴹᴼ (sym p))))))
-reflectᴱ H (block var b ∈ T is B end) (block s) (BlockMismatch p) = Left (cond BlockMismatch block₁ (≮:-reductionᴮ H B s p))
-reflectᴱ H (block var b ∈ T is B end) (block s) (block₁ W′) = mapL block₁ (reflectᴮ H B s W′)
-reflectᴱ H (block var b ∈ T is B end) (return v) W′ = Left (block₁ (return W′))
-reflectᴱ H (function f ⟨ var x ∈ T ⟩∈ U is B end) (function a defn) (UnallocatedAddress ())
-reflectᴱ H (binexp M op N) (binOp₀ ()) (UnallocatedAddress p)
-reflectᴱ H (binexp M op N) (binOp₁ s) (BinOpMismatch₁ p) = Left (cond BinOpMismatch₁ bin₁ (≮:-reductionᴱ H M s p))
-reflectᴱ H (binexp M op N) (binOp₁ s) (BinOpMismatch₂ p) = Left (BinOpMismatch₂ (≮:-heap-weakeningᴱ ∅ H N (rednᴱ⊑ s) p))
-reflectᴱ H (binexp M op N) (binOp₁ s) (bin₁ W′) = mapL bin₁ (reflectᴱ H M s W′)
-reflectᴱ H (binexp M op N) (binOp₁ s) (bin₂ W′) = Left (bin₂ (reflect-weakeningᴱ ∅ H N (rednᴱ⊑ s) W′))
-reflectᴱ H (binexp M op N) (binOp₂ s) (BinOpMismatch₁ p) = Left (BinOpMismatch₁ (≮:-heap-weakeningᴱ ∅ H M (rednᴱ⊑ s) p))
-reflectᴱ H (binexp M op N) (binOp₂ s) (BinOpMismatch₂ p) = Left (cond BinOpMismatch₂ bin₂ (≮:-reductionᴱ H N s p))
-reflectᴱ H (binexp M op N) (binOp₂ s) (bin₁ W′) = Left (bin₁ (reflect-weakeningᴱ ∅ H M (rednᴱ⊑ s) W′))
-reflectᴱ H (binexp M op N) (binOp₂ s) (bin₂ W′) = mapL bin₂ (reflectᴱ H N s W′)
-
-reflectᴮ H (local var x ∈ T ← M ∙ B) (local s) (LocalVarMismatch p) = Left (cond LocalVarMismatch local₁ (≮:-reductionᴱ H M s p))
-reflectᴮ H (local var x ∈ T ← M ∙ B) (local s) (local₁ W′) = mapL local₁ (reflectᴱ H M s W′)
-reflectᴮ H (local var x ∈ T ← M ∙ B) (local s) (local₂ W′) = Left (local₂ (reflect-weakeningᴮ (x ↦ T) H B (rednᴱ⊑ s) W′))
-reflectᴮ H (local var x ∈ T ← M ∙ B) (subst v) W′ = Left (cond local₂ (cond local₁ LocalVarMismatch) (reflect-substitutionᴮ H B v x W′))
-reflectᴮ H (function f ⟨ var y ∈ T ⟩∈ U is C end ∙ B) (function a defn) W′ with reflect-substitutionᴮ _ B (addr a) f W′
-reflectᴮ H (function f ⟨ var y ∈ T ⟩∈ U is C end ∙ B) (function a defn) W′ | Left W = Left (function₂ (reflect-weakeningᴮ (f ↦ (T ⇒ U)) H B (snoc defn) W))
-reflectᴮ H (function f ⟨ var y ∈ T ⟩∈ U is C end ∙ B) (function a defn) W′ | Right (Left (UnallocatedAddress ()))
-reflectᴮ H (function f ⟨ var y ∈ T ⟩∈ U is C end ∙ B) (function a defn) W′ | Right (Right p) = CONTRADICTION (≮:-refl p)
-reflectᴮ H (return M ∙ B) (return s) (return W′) = mapL return (reflectᴱ H M s W′)
-
-reflectᴴᴱ : ∀ H M {H′ M′} → (H ⊢ M ⟶ᴱ M′ ⊣ H′) → Warningᴴ H′ (typeCheckᴴ H′) → Either (Warningᴱ H (typeCheckᴱ H ∅ M)) (Warningᴴ H (typeCheckᴴ H))
-reflectᴴᴮ : ∀ H B {H′ B′} → (H ⊢ B ⟶ᴮ B′ ⊣ H′) → Warningᴴ H′ (typeCheckᴴ H′) → Either (Warningᴮ H (typeCheckᴮ H ∅ B)) (Warningᴴ H (typeCheckᴴ H))
-
-reflectᴴᴱ H (M $ N) (app₁ s) W = mapL app₁ (reflectᴴᴱ H M s W)
-reflectᴴᴱ H (M $ N) (app₂ v s) W = mapL app₂ (reflectᴴᴱ H N s W)
-reflectᴴᴱ H (M $ N) (beta O v refl p) W = Right W
-reflectᴴᴱ H (function f ⟨ var x ∈ T ⟩∈ U is B end) (function a p) (addr b refl W) with b ≡ᴬ a
-reflectᴴᴱ H (function f ⟨ var x ∈ T ⟩∈ U is B end) (function a defn) (addr b refl (FunctionDefnMismatch p)) | yes refl = Left (FunctionDefnMismatch (≮:-heap-weakeningᴮ (x ↦ T) H B (snoc defn) p))
-reflectᴴᴱ H (function f ⟨ var x ∈ T ⟩∈ U is B end) (function a defn) (addr b refl (function₁ W)) | yes refl = Left (function₁ (reflect-weakeningᴮ (x ↦ T) H B (snoc defn) W))
-reflectᴴᴱ H (function f ⟨ var x ∈ T ⟩∈ U is B end) (function a p) (addr b refl W) | no q = Right (addr b (lookup-not-allocated p q) (reflect-weakeningᴼ H _ (snoc p) W))
-reflectᴴᴱ H (block var b ∈ T is B end) (block s) W = mapL block₁ (reflectᴴᴮ H B s W)
-reflectᴴᴱ H (block var b ∈ T is return (val v) ∙ B end) (return v) W = Right W
-reflectᴴᴱ H (block var b ∈ T is done end) done W = Right W
-reflectᴴᴱ H (binexp M op N) (binOp₀ s) W = Right W
-reflectᴴᴱ H (binexp M op N) (binOp₁ s) W = mapL bin₁ (reflectᴴᴱ H M s W)
-reflectᴴᴱ H (binexp M op N) (binOp₂ s) W = mapL bin₂ (reflectᴴᴱ H N s W)
-
-reflectᴴᴮ H (function f ⟨ var x ∈ T ⟩∈ U is C end ∙ B) (function a p) (addr b refl W) with b ≡ᴬ a
-reflectᴴᴮ H (function f ⟨ var x ∈ T ⟩∈ U is C end ∙ B) (function a defn) (addr b refl (FunctionDefnMismatch p)) | yes refl = Left (FunctionDefnMismatch (≮:-heap-weakeningᴮ (x ↦ T) H C (snoc defn) p))
-reflectᴴᴮ H (function f ⟨ var x ∈ T ⟩∈ U is C end ∙ B) (function a defn) (addr b refl (function₁ W)) | yes refl = Left (function₁ (reflect-weakeningᴮ (x ↦ T) H C (snoc defn) W))
-reflectᴴᴮ H (function f ⟨ var x ∈ T ⟩∈ U is C end ∙ B) (function a p) (addr b refl W) | no q = Right (addr b (lookup-not-allocated p q) (reflect-weakeningᴼ H _ (snoc p) W))
-reflectᴴᴮ H (local var x ∈ T ← M ∙ B) (local s) W = mapL local₁ (reflectᴴᴱ H M s W)
-reflectᴴᴮ H (local var x ∈ T ← M ∙ B) (subst v) W = Right W
-reflectᴴᴮ H (return M ∙ B) (return s) W = mapL return (reflectᴴᴱ H M s W)
-
-reflect* : ∀ H B {H′ B′} → (H ⊢ B ⟶* B′ ⊣ H′) → Either (Warningᴮ H′ (typeCheckᴮ H′ ∅ B′)) (Warningᴴ H′ (typeCheckᴴ H′)) → Either (Warningᴮ H (typeCheckᴮ H ∅ B)) (Warningᴴ H (typeCheckᴴ H))
-reflect* H B refl W = W
-reflect* H B (step s t) W = cond (reflectᴮ H B s) (reflectᴴᴮ H B s) (reflect* _ _ t W)
-
-isntNumber : ∀ H v → (valueType v ≢ number) → (typeOfᴱ H ∅ (val v) ≮: number)
-isntNumber H nil p = scalar-≢-impl-≮: nil number (λ ())
-isntNumber H (addr a) p with remember (H [ a ]ᴴ)
-isntNumber H (addr a) p | (just (function f ⟨ var x ∈ T ⟩∈ U is B end) , q) = ≡-trans-≮: (cong orUnknown (cong typeOfᴹᴼ q)) (function-≮:-scalar number)
-isntNumber H (addr a) p | (nothing , q) = ≡-trans-≮: (cong orUnknown (cong typeOfᴹᴼ q)) (unknown-≮:-scalar number)
-isntNumber H (number x) p = CONTRADICTION (p refl)
-isntNumber H (bool x) p = scalar-≢-impl-≮: boolean number (λ ())
-isntNumber H (string x) p = scalar-≢-impl-≮: string number (λ ())
-
-isntString : ∀ H v → (valueType v ≢ string) → (typeOfᴱ H ∅ (val v) ≮: string)
-isntString H nil p = scalar-≢-impl-≮: nil string (λ ())
-isntString H (addr a) p with remember (H [ a ]ᴴ)
-isntString H (addr a) p | (just (function f ⟨ var x ∈ T ⟩∈ U is B end) , q) = ≡-trans-≮: (cong orUnknown (cong typeOfᴹᴼ q)) (function-≮:-scalar string)
-isntString H (addr a) p | (nothing , q) = ≡-trans-≮: (cong orUnknown (cong typeOfᴹᴼ q)) (unknown-≮:-scalar string)
-isntString H (number x) p = scalar-≢-impl-≮: number string (λ ())
-isntString H (bool x) p = scalar-≢-impl-≮: boolean string (λ ())
-isntString H (string x) p = CONTRADICTION (p refl)
-
-isntFunction : ∀ H v {T U} → (valueType v ≢ function) → (typeOfᴱ H ∅ (val v) ≮: (T ⇒ U))
-isntFunction H nil p = scalar-≮:-function nil
-isntFunction H (addr a) p = CONTRADICTION (p refl)
-isntFunction H (number x) p = scalar-≮:-function number
-isntFunction H (bool x) p = scalar-≮:-function boolean
-isntFunction H (string x) p = scalar-≮:-function string
-
-isntEmpty : ∀ H v → (typeOfᴱ H ∅ (val v) ≮: never)
-isntEmpty H nil = scalar-≮:-never nil
-isntEmpty H (addr a) with remember (H [ a ]ᴴ)
-isntEmpty H (addr a) | (just (function f ⟨ var x ∈ T ⟩∈ U is B end) , p) = ≡-trans-≮: (cong orUnknown (cong typeOfᴹᴼ p)) function-≮:-never
-isntEmpty H (addr a) | (nothing , p) = ≡-trans-≮: (cong orUnknown (cong typeOfᴹᴼ p)) unknown-≮:-never
-isntEmpty H (number x) = scalar-≮:-never number
-isntEmpty H (bool x) = scalar-≮:-never boolean
-isntEmpty H (string x) = scalar-≮:-never string
-
-runtimeBinOpWarning : ∀ H {op} v → BinOpError op (valueType v) → (typeOfᴱ H ∅ (val v) ≮: srcBinOp op)
-runtimeBinOpWarning H v (+ p) = isntNumber H v p
-runtimeBinOpWarning H v (- p) = isntNumber H v p
-runtimeBinOpWarning H v (* p) = isntNumber H v p
-runtimeBinOpWarning H v (/ p) = isntNumber H v p
-runtimeBinOpWarning H v (< p) = isntNumber H v p
-runtimeBinOpWarning H v (> p) = isntNumber H v p
-runtimeBinOpWarning H v (<= p) = isntNumber H v p
-runtimeBinOpWarning H v (>= p) = isntNumber H v p
-runtimeBinOpWarning H v (·· p) = isntString H v p
-
-runtimeWarningᴱ : ∀ H M → RuntimeErrorᴱ H M → Warningᴱ H (typeCheckᴱ H ∅ M)
-runtimeWarningᴮ : ∀ H B → RuntimeErrorᴮ H B → Warningᴮ H (typeCheckᴮ H ∅ B)
-
-runtimeWarningᴱ H (var x) UnboundVariable = UnboundVariable refl
-runtimeWarningᴱ H (val (addr a)) (SEGV p) = UnallocatedAddress p
-runtimeWarningᴱ H (M $ N) (FunctionMismatch v w p) = FunctionCallMismatch (unknown-src-≮: (isntEmpty H w) (isntFunction H v p))
-runtimeWarningᴱ H (M $ N) (app₁ err) = app₁ (runtimeWarningᴱ H M err)
-runtimeWarningᴱ H (M $ N) (app₂ err) = app₂ (runtimeWarningᴱ H N err)
-runtimeWarningᴱ H (block var b ∈ T is B end) (block err) = block₁ (runtimeWarningᴮ H B err)
-runtimeWarningᴱ H (binexp M op N) (BinOpMismatch₁ v w p) = BinOpMismatch₁ (runtimeBinOpWarning H v p)
-runtimeWarningᴱ H (binexp M op N) (BinOpMismatch₂ v w p) = BinOpMismatch₂ (runtimeBinOpWarning H w p)
-runtimeWarningᴱ H (binexp M op N) (bin₁ err) = bin₁ (runtimeWarningᴱ H M err)
-runtimeWarningᴱ H (binexp M op N) (bin₂ err) = bin₂ (runtimeWarningᴱ H N err)
-
-runtimeWarningᴮ H (local var x ∈ T ← M ∙ B) (local err) = local₁ (runtimeWarningᴱ H M err)
-runtimeWarningᴮ H (return M ∙ B) (return err) = return (runtimeWarningᴱ H M err)
-
-wellTypedProgramsDontGoWrong : ∀ H′ B B′ → (∅ᴴ ⊢ B ⟶* B′ ⊣ H′) → (RuntimeErrorᴮ H′ B′) → Warningᴮ ∅ᴴ (typeCheckᴮ ∅ᴴ ∅ B)
-wellTypedProgramsDontGoWrong H′ B B′ t err with reflect* ∅ᴴ B t (Left (runtimeWarningᴮ H′ B′ err))
-wellTypedProgramsDontGoWrong H′ B B′ t err | Right (addr a refl ())
-wellTypedProgramsDontGoWrong H′ B B′ t err | Left W = W

prototyping/Properties/Subtyping.agda

@@ -1,481 +0,0 @@
-{-# OPTIONS --rewriting #-}
-
-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-function-tgt; scalar-scalar; function-scalar; function-ok; function-ok₁; function-ok₂; function-err; function-tgt; 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.Equality using (_≢_)
-open import Properties.Functions using (_∘_)
-open import Properties.Product using (_×_; _,_)
-
--- Language membership is decidable
-dec-language : ∀ T t → Either (¬Language T t) (Language T t)
-dec-language nil (scalar number) = Left (scalar-scalar number nil (λ ()))
-dec-language nil (scalar boolean) = Left (scalar-scalar boolean nil (λ ()))
-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 s t) = Left (scalar-function-ok 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 s t) = Left (scalar-function-ok 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 s t) = Left (scalar-function-ok 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 s t) = Left (scalar-function-ok 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 s t) = cond (Right ∘ function-ok₁) (λ p → mapLR (function-ok p) function-ok₂ (dec-language T₂ t)) (dec-language T₁ s)
-dec-language (T₁ ⇒ T₂) (function-err t) = mapLR function-err function-err (swapLR (dec-language T₁ t))
-dec-language never t = Left never
-dec-language unknown t = Right unknown
-dec-language (T₁ ∪ T₂) t = cond (λ p → cond (Left ∘ _,_ p) (Right ∘ right) (dec-language T₂ t)) (Right ∘ left) (dec-language T₁ t)
-dec-language (T₁ ∩ T₂) t = cond (Left ∘ left) (λ p → cond (Left ∘ right) (Right ∘ _,_ p) (dec-language T₂ t)) (dec-language T₁ t)
-dec-language nil (function-tgt t) = Left (scalar-function-tgt nil)
-dec-language (T₁ ⇒ T₂) (function-tgt t) = mapLR function-tgt function-tgt (dec-language T₂ t)
-dec-language boolean (function-tgt t) = Left (scalar-function-tgt boolean)
-dec-language number (function-tgt t) = Left (scalar-function-tgt number)
-dec-language string (function-tgt t) = Left (scalar-function-tgt string)
-
--- ¬Language T is the complement of Language T
-language-comp : ∀ {T} t → ¬Language T t → ¬(Language T t)
-language-comp t (p₁ , p₂) (left q) = language-comp t p₁ q
-language-comp t (p₁ , p₂) (right q) = language-comp t p₂ q
-language-comp t (left p) (q₁ , q₂) = language-comp t p q₁
-language-comp t (right p) (q₁ , q₂) = language-comp t p q₂
-language-comp (scalar s) (scalar-scalar s p₁ p₂) (scalar s) = p₂ refl
-language-comp (scalar s) (function-scalar s) (scalar s) = language-comp function (scalar-function s) function
-language-comp (scalar s) never (scalar ())
-language-comp function (scalar-function ()) function
-language-comp (function-ok s t) (scalar-function-ok ()) (function-ok₁ p)
-language-comp (function-ok s t) (function-ok p₁ p₂) (function-ok₁ q) = language-comp s q p₁
-language-comp (function-ok s t) (function-ok p₁ p₂) (function-ok₂ q) = language-comp t p₂ q
-language-comp (function-err t) (function-err p) (function-err q) = language-comp t q p 
-language-comp (function-tgt t) (scalar-function-tgt ()) (function-tgt q)
-language-comp (function-tgt t) (function-tgt p) (function-tgt q) = language-comp t p q
-
--- ≮: is the complement of <:
-¬≮:-impl-<: : ∀ {T U} → ¬(T ≮: U) → (T <: U)
-¬≮:-impl-<: {T} {U} p t q with dec-language U t
-¬≮:-impl-<: {T} {U} p t q | Left r = CONTRADICTION (p (witness t q r))
-¬≮:-impl-<: {T} {U} p t q | Right r = r
-
-<:-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
-
-<:-refl : ∀ {T} → (T <: T)
-<:-refl = ¬≮:-impl-<: ≮:-refl
-
--- transititivity
-≮:-trans-≡ : ∀ {S T U} → (S ≮: T) → (T ≡ U) → (S ≮: U)
-≮:-trans-≡ p refl = p
-
-<:-trans-≡ : ∀ {S T U} → (S <: T) → (T ≡ U) → (S <: U)
-<:-trans-≡ p refl = p
-
-≡-impl-<: : ∀ {T U} → (T ≡ U) → (T <: U)
-≡-impl-<: refl = <:-refl
-
-≡-trans-≮: : ∀ {S T U} → (S ≡ T) → (T ≮: U) → (S ≮: U)
-≡-trans-≮: refl p = p
-
-≡-trans-<: : ∀ {S T U} → (S ≡ T) → (T <: U) → (S <: U)
-≡-trans-<: refl p = p
-
-≮:-trans : ∀ {S T U} → (S ≮: U) → Either (S ≮: T) (T ≮: U)
-≮:-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 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
-
-≮:-left-∪ : ∀ {S T U} → (S ≮: (T ∪ U)) → (S ≮: T)
-≮:-left-∪ (witness t p (q₁ , q₂)) = witness t p q₁
-
-≮:-right-∪ : ∀ {S T U} → (S ≮: (T ∪ U)) → (S ≮: U)
-≮:-right-∪ (witness t p (q₁ , q₂)) = witness t 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₁)
-
-<:-∩-assocl : ∀ {S T U} → (S ∩ (T ∩ U)) <: ((S ∩ T) ∩ U)
-<:-∩-assocl t (p , (p₁ , p₂)) = (p , p₁) , p₂
-
-<:-∩-assocr : ∀ {S T U} → ((S ∩ T) ∩ U) <: (S ∩ (T ∩ U))
-<:-∩-assocr t ((p , p₁) , 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₁
-
-∩-<:-∪ : ∀ {S T} → (S ∩ T) <: (S ∪ T)
-∩-<:-∪ t (p , _) = left 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 s t) (function-ok₁ r) = function-ok₁ (<:-impl-⊇ p s r)
-<:-function p q (function-ok s 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 p q (function-tgt t) (function-tgt r) = function-tgt (q t r)
-
-<:-function-∩-∩ : ∀ {R S T U} → ((R ⇒ T) ∩ (S ⇒ U)) <: ((R ∩ S) ⇒ (T ∩ U))
-<:-function-∩-∩ function (function , function) = function
-<:-function-∩-∩ (function-ok s t) (function-ok₁ p , q) = function-ok₁ (left p)
-<:-function-∩-∩ (function-ok s t) (function-ok₂ p , function-ok₁ q) = function-ok₁ (right q)
-<:-function-∩-∩ (function-ok s t) (function-ok₂ p , function-ok₂ q) = function-ok₂ (p , q)
-<:-function-∩-∩ (function-err s) (function-err p , q) = function-err (left p)
-<:-function-∩-∩ (function-tgt s) (function-tgt p , function-tgt q) = function-tgt (p , q)
-
-<:-function-∩-∪ : ∀ {R S T U} → ((R ⇒ T) ∩ (S ⇒ U)) <: ((R ∪ S) ⇒ (T ∪ U))
-<:-function-∩-∪ function (function , function) = function
-<:-function-∩-∪ (function-ok s t) (function-ok₁ p₁ , function-ok₁ p₂) = function-ok₁ (p₁ , p₂)
-<:-function-∩-∪ (function-ok s t) (p₁ , function-ok₂ p₂) = function-ok₂ (right p₂)
-<:-function-∩-∪ (function-ok s t) (function-ok₂ p₁ , p₂) = function-ok₂ (left p₁)
-<:-function-∩-∪ (function-err s) (function-err p₁ , function-err q₂) = function-err (p₁ , q₂)
-<:-function-∩-∪ (function-tgt t) (function-tgt p , q) = function-tgt (left p)
-
-<:-function-∩ : ∀ {S T U} → ((S ⇒ T) ∩ (S ⇒ U)) <: (S ⇒ (T ∩ U))
-<:-function-∩ function (function , function) = function
-<:-function-∩ (function-ok s t) (p₁ , function-ok₁ p₂) = function-ok₁ p₂
-<:-function-∩ (function-ok s t) (function-ok₁ p₁ , p₂) = function-ok₁ p₁
-<:-function-∩ (function-ok s 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-∩ (function-tgt t) (function-tgt p₁ , function-tgt p₂) = function-tgt (p₁ , p₂)
-
-<:-function-∪ : ∀ {R S T U} → ((R ⇒ S) ∪ (T ⇒ U)) <: ((R ∩ T) ⇒ (S ∪ U))
-<:-function-∪ function (left function) = function
-<:-function-∪ (function-ok s t) (left (function-ok₁ p)) = function-ok₁ (left p)
-<:-function-∪ (function-ok s 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 s t) (right (function-ok₁ p)) = function-ok₁ (right p)
-<:-function-∪ (function-ok s 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-∪ (function-tgt t) (left (function-tgt p)) = function-tgt (left p)
-<:-function-∪ (function-tgt t) (right (function-tgt p)) = function-tgt (right p)
-
-<:-function-∪-∩ : ∀ {R S T U} → ((R ∩ S) ⇒ (T ∪ U)) <: ((R ⇒ T) ∪ (S ⇒ U))
-<:-function-∪-∩ function function = left function
-<:-function-∪-∩ (function-ok s t) (function-ok₁ (left p)) = left (function-ok₁ p)
-<:-function-∪-∩ (function-ok s t) (function-ok₂ (left p)) = left (function-ok₂ p)
-<:-function-∪-∩ (function-ok s t) (function-ok₁ (right p)) = right (function-ok₁ p)
-<:-function-∪-∩ (function-ok s 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-∪-∩ (function-tgt t) (function-tgt (left p)) = left (function-tgt p)
-<:-function-∪-∩ (function-tgt t) (function-tgt (right p)) = right (function-tgt p)
-
-<:-function-left : ∀ {R S T U} → (S ⇒ T) <: (R ⇒ U) → (R <: S)
-<:-function-left {R} {S} p s Rs with dec-language S s
-<:-function-left p s Rs | Right Ss = Ss
-<:-function-left p s Rs | Left ¬Ss with p (function-err s) (function-err ¬Ss)
-<:-function-left p s Rs | Left ¬Ss | function-err ¬Rs = CONTRADICTION (language-comp s ¬Rs Rs)
-
-<:-function-right : ∀ {R S T U} → (S ⇒ T) <: (R ⇒ U) → (T <: U)
-<:-function-right p t Tt with p (function-tgt t) (function-tgt Tt)
-<:-function-right p t Tt | function-tgt St = St
-
-≮:-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-tgt t) (function-tgt p) (function-tgt q)
-
--- Properties of scalars
-skalar-function-ok : ∀ {s t} → (¬Language skalar (function-ok s 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)
-
-scalar-≮:-function : ∀ {S T U} → (Scalar U) → (U ≮: (S ⇒ T))
-scalar-≮:-function s = witness (scalar s) (scalar s) (function-scalar s)
-
-unknown-≮:-scalar : ∀ {U} → (Scalar U) → (unknown ≮: U)
-unknown-≮:-scalar s = witness function unknown (scalar-function s)
-
-scalar-≮:-never : ∀ {U} → (Scalar U) → (U ≮: never)
-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)
-
-scalar-≢-∩-<:-never : ∀ {T U V} → (Scalar T) → (Scalar U) → (T ≢ U) → (T ∩ U) <: V
-scalar-≢-∩-<:-never s t p u (scalar s₁ , scalar s₂) = CONTRADICTION (p refl)
-
-skalar-scalar : ∀ {T} (s : Scalar T) → (Language skalar (scalar s))
-skalar-scalar number = left (scalar number)
-skalar-scalar boolean = right (right (right (scalar boolean)))
-skalar-scalar string = right (left (scalar string))
-skalar-scalar nil = right (right (left (scalar nil)))
-
--- Properties of unknown and never
-unknown-≮: : ∀ {T U} → (T ≮: U) → (unknown ≮: U)
-unknown-≮: (witness t p q) = witness t unknown q
-
-never-≮: : ∀ {T U} → (T ≮: U) → (T ≮: never)
-never-≮: (witness t p q) = witness t p never
-
-unknown-≮:-never : (unknown ≮: never)
-unknown-≮:-never = witness (scalar nil) unknown never
-
-unknown-≮:-function : ∀ {S T} → (unknown ≮: (S ⇒ T))
-unknown-≮:-function = witness (scalar nil) unknown (function-scalar nil)
-
-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 s t) p = left (function-ok₁ never)
-<:-everything (function-err s) p = left (function-err never)
-<:-everything (function-tgt t) p = left (function-tgt unknown)
-
--- 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,
--- for example (never -> T) is equivalent to (never -> U)
--- when types are interpreted as sets of syntactic values.
-
-_⊆_ : ∀ {A : Set} → (A → Set) → (A → Set) → Set
-(P ⊆ Q) = ∀ a → (P a) → (Q a)
-
-_⊗_ : ∀ {A B : Set} → (A → Set) → (B → Set) → ((A × B) → Set)
-(P ⊗ Q) (a , b) = (P a) × (Q b)
-
-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(Lift(Language T₁))) → Q ⊆ Comp((Language S₂) ⊗ Comp(Lift(Language T₂))))
-
-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
-  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
-
-  ¬T₁u : ¬(Language T₁ u)
-  ¬T₁u T₁u with p (function-ok t u) (function-ok₂ T₁u)
-  ¬T₁u T₁u | function-ok₁ ¬S₂t = language-comp t ¬S₂t S₂t
-  ¬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
-  -- it's only true when Language S₂ is inhabited
-  -- in particular it's not true when S₂ is never,
-  ∀ s₂ → Language S₂ s₂ →
-
-  -- This is the "only if" part of being a set-theoretic model
-  (∀ 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₂ S₂s₂ p = r where
-
-  Q : (Tree × Maybe Tree) → Set
-  Q (t , just u) = Either (¬Language S₁ t) (Language T₁ u)
-  Q (t , nothing) = ¬Language S₁ t
-  
-  q : Q ⊆ Comp(Language S₁ ⊗ Comp(Lift(Language T₁)))
-  q (t , just u) (Left ¬S₁t) (S₁t , ¬T₁u) = language-comp t ¬S₁t S₁t
-  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 s) (function-err ¬S₁s) with dec-language S₂ s
-  r (function-err s) (function-err ¬S₁s) | Left ¬S₂s = function-err ¬S₂s
-  r (function-err s) (function-err ¬S₁s) | Right S₂s = CONTRADICTION (p Q q (s , nothing) ¬S₁s (S₂s , λ ()))
-  r (function-ok s t) (function-ok₁ ¬S₁s) with dec-language S₂ s
-  r (function-ok s t) (function-ok₁ ¬S₁s) | Left ¬S₂s = function-ok₁ ¬S₂s
-  r (function-ok s t) (function-ok₁ ¬S₁s) | Right S₂s = CONTRADICTION (p Q q (s , nothing) ¬S₁s (S₂s , λ ()))
-  r (function-ok s t) (function-ok₂ T₁t) with dec-language T₂ t
-  r (function-ok s t) (function-ok₂ T₁t) | Left ¬T₂t with dec-language S₂ s
-  r (function-ok s t) (function-ok₂ T₁t) | Left ¬T₂t | Left ¬S₂s = function-ok₁ ¬S₂s
-  r (function-ok s t) (function-ok₂ T₁t) | Left ¬T₂t | Right S₂s = CONTRADICTION (p Q q (s , just t) (Right T₁t) (S₂s , language-comp t ¬T₂t))
-  r (function-ok s t) (function-ok₂ T₁t) | Right T₂t = function-ok₂ T₂t
-  r (function-tgt t) (function-tgt T₁t) with dec-language T₂ t
-  r (function-tgt t) (function-tgt T₁t) | Left ¬T₂t = CONTRADICTION (p Q q (s₂ , just t) (Right T₁t) (S₂s₂ , language-comp t ¬T₂t))
-  r (function-tgt t) (function-tgt T₁t) | Right T₂t = function-tgt T₂t
-
--- A counterexample when the argument type is empty.
-
-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-two : (never ⇒ number) ≮: (never ⇒ string)
-set-theoretic-counterexample-two = witness (function-tgt (scalar number)) (function-tgt (scalar number)) (function-tgt (scalar-scalar number string (λ ())))

prototyping/Properties/TypeCheck.agda

@@ -1,100 +0,0 @@
-{-# OPTIONS --rewriting #-}
-
-module Properties.TypeCheck where
-
-open import Agda.Builtin.Equality using (_≡_; refl)
-open import Agda.Builtin.Bool using (Bool; true; false)
-open import FFI.Data.Maybe using (Maybe; just; nothing)
-open import FFI.Data.Either using (Either)
-open import Luau.ResolveOverloads using (resolve)
-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; _⇒_)
-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)
-open import Luau.Var using (Var; _≡ⱽ_)
-open import Luau.Heap using (Heap; Object; function_is_end) renaming (_[_] to _[_]ᴴ)
-open import Properties.Contradiction using (CONTRADICTION)
-open import Properties.Dec using (yes; no)
-open import Properties.Equality using (_≢_; sym; trans; cong)
-open import Properties.Product using (_×_; _,_)
-open import Properties.Remember using (Remember; remember; _,_)
-
-typeOfᴼ : Object yes → Type
-typeOfᴼ (function f ⟨ var x ∈ S ⟩∈ T is B end) = (S ⇒ T)
-
-typeOfᴹᴼ : Maybe(Object yes) → Maybe Type
-typeOfᴹᴼ nothing = nothing
-typeOfᴹᴼ (just O) = just (typeOfᴼ O)
-
-typeOfⱽ : Heap yes → Value → Maybe Type
-typeOfⱽ H nil = just nil
-typeOfⱽ H (bool b) = just boolean
-typeOfⱽ H (addr a) = typeOfᴹᴼ (H [ a ]ᴴ)
-typeOfⱽ H (number n) = just number
-typeOfⱽ H (string x) = just string
-
-typeOfᴱ : Heap yes → VarCtxt → (Expr yes) → Type
-typeOfᴮ : Heap yes → VarCtxt → (Block yes) → Type
-
-typeOfᴱ H Γ (var x) = orUnknown(Γ [ x ]ⱽ)
-typeOfᴱ H Γ (val v) = orUnknown(typeOfⱽ H v)
-typeOfᴱ H Γ (M $ N) = resolve (typeOfᴱ H Γ M) (typeOfᴱ H Γ N)
-typeOfᴱ H Γ (function f ⟨ var x ∈ S ⟩∈ T is B end) = S ⇒ T
-typeOfᴱ H Γ (block var b ∈ T is B end) = T
-typeOfᴱ H Γ (binexp M op N) = tgtBinOp op
-
-typeOfᴮ H Γ (function f ⟨ var x ∈ S ⟩∈ T is C end ∙ B) = typeOfᴮ H (Γ ⊕ f ↦ (S ⇒ T)) B
-typeOfᴮ H Γ (local var x ∈ T ← M ∙ B) = typeOfᴮ H (Γ ⊕ x ↦ T) B
-typeOfᴮ H Γ (return M ∙ B) = typeOfᴱ H Γ M
-typeOfᴮ H Γ done = nil
-
-mustBeNumber : ∀ H Γ v → (typeOfᴱ H Γ (val v) ≡ number) → (valueType(v) ≡ number)
-mustBeNumber H Γ (addr a) p with remember (H [ a ]ᴴ)
-mustBeNumber H Γ (addr a) p | (just O , q) with trans (cong orUnknown (cong typeOfᴹᴼ (sym q))) p
-mustBeNumber H Γ (addr a) p | (just function f ⟨ var x ∈ T ⟩∈ U is B end , q) | ()
-mustBeNumber H Γ (addr a) p | (nothing , q) with trans (cong orUnknown (cong typeOfᴹᴼ (sym q))) p
-mustBeNumber H Γ (addr a) p | nothing , q | ()
-mustBeNumber H Γ (number n) p = refl
-
-mustBeString : ∀ H Γ v → (typeOfᴱ H Γ (val v) ≡ string) → (valueType(v) ≡ string)
-mustBeString H Γ (addr a) p with remember (H [ a ]ᴴ)
-mustBeString H Γ (addr a) p | (just O , q) with trans (cong orUnknown (cong typeOfᴹᴼ (sym q))) p
-mustBeString H Γ (addr a) p | (just function f ⟨ var x ∈ T ⟩∈ U is B end , q) | ()
-mustBeString H Γ (addr a) p | (nothing , q) with trans (cong orUnknown (cong typeOfᴹᴼ (sym q))) p
-mustBeString H Γ (addr a) p | (nothing , q) | ()
-mustBeString H Γ (string x) p = refl
-
-typeCheckᴱ : ∀ H Γ M → (Γ ⊢ᴱ M ∈ (typeOfᴱ H Γ M))
-typeCheckᴮ : ∀ H Γ B → (Γ ⊢ᴮ B ∈ (typeOfᴮ H Γ B))
-
-typeCheckᴱ H Γ (var x) = var refl
-typeCheckᴱ H Γ (val nil) = nil
-typeCheckᴱ H Γ (val (addr a)) = addr (orUnknown (typeOfᴹᴼ (H [ a ]ᴴ)))
-typeCheckᴱ H Γ (val (number n)) = number
-typeCheckᴱ H Γ (val (bool b)) = bool
-typeCheckᴱ H Γ (val (string x)) = string
-typeCheckᴱ H Γ (M $ N) = app (typeCheckᴱ H Γ M) (typeCheckᴱ H Γ N)
-typeCheckᴱ H Γ (function f ⟨ var x ∈ T ⟩∈ U is B end) = function (typeCheckᴮ H (Γ ⊕ x ↦ T) B)
-typeCheckᴱ H Γ (block var b ∈ T is B end) = block (typeCheckᴮ H Γ B)
-typeCheckᴱ H Γ (binexp M op N) = binexp (typeCheckᴱ H Γ M) (typeCheckᴱ H Γ N)
-
-typeCheckᴮ H Γ (function f ⟨ var x ∈ T ⟩∈ U is C end ∙ B) = function (typeCheckᴮ H (Γ ⊕ x ↦ T) C) (typeCheckᴮ H (Γ ⊕ f ↦ (T ⇒ U)) B)
-typeCheckᴮ H Γ (local var x ∈ T ← M ∙ B) = local (typeCheckᴱ H Γ M) (typeCheckᴮ H (Γ ⊕ x ↦ T) B)
-typeCheckᴮ H Γ (return M ∙ B) = return (typeCheckᴱ H Γ M) (typeCheckᴮ H Γ B)
-typeCheckᴮ H Γ done = done
-
-typeCheckᴼ : ∀ H O → (⊢ᴼ O)
-typeCheckᴼ H nothing = nothing
-typeCheckᴼ H (just function f ⟨ var x ∈ T ⟩∈ U is B end) = function (typeCheckᴮ H (x ↦ T) B)
-
-typeCheckᴴ : ∀ H → (⊢ᴴ H)
-typeCheckᴴ H a {O} p = typeCheckᴼ H (O)
-
-typeCheckᴴᴱ : ∀ H Γ M → (Γ ⊢ᴴᴱ H ▷ M ∈ typeOfᴱ H Γ M)
-typeCheckᴴᴱ H Γ M = (typeCheckᴴ H , typeCheckᴱ H Γ M)
-
-typeCheckᴴᴮ : ∀ H Γ M → (Γ ⊢ᴴᴮ H ▷ M ∈ typeOfᴮ H Γ M)
-typeCheckᴴᴮ H Γ M = (typeCheckᴴ H , typeCheckᴮ H Γ M)
- 

prototyping/Properties/TypeNormalization.agda

@@ -1,408 +0,0 @@
-{-# OPTIONS --rewriting #-}
-
-module Properties.TypeNormalization where
-
-open import Luau.Type using (Type; Scalar; nil; number; string; boolean; never; unknown; _⇒_; _∪_; _∩_)
-open import Luau.Subtyping using (Tree; Language; ¬Language; function; scalar; unknown; left; right; function-ok₁; function-ok₂; function-err; function-tgt; scalar-function; scalar-function-ok; scalar-function-err; scalar-function-tgt; function-scalar; _,_)
-open import Luau.TypeNormalization using (_∪ⁿ_; _∩ⁿ_; _∪ᶠ_; _∪ⁿˢ_; _∩ⁿˢ_; normalize)
-open import Luau.Subtyping using (_<:_; _≮:_; witness; never)
-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)
-
--- Normal 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
-  _⇒_ : ∀ {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)
-  never : Normal never
-  unknown : Normal unknown
-
-data OptScalar : Type → Set where
-  never : OptScalar never
-  number : OptScalar number
-  boolean : OptScalar boolean
-  string : OptScalar string
-  nil : OptScalar nil
-
--- Top function type
-fun-top : ∀ {F} → (FunType F) → (F <: (never ⇒ unknown))
-fun-top (S ⇒ T) = <:-function <:-never <:-unknown
-fun-top (F ∩ G) = <:-trans <:-∩-left (fun-top F)
-
--- function types are inhabited
-fun-function : ∀ {F} → FunType F → Language F function
-fun-function (S ⇒ T) = function
-fun-function (F ∩ G) = (fun-function F , fun-function G)
-
-fun-≮:-never : ∀ {F} → FunType F → (F ≮: never)
-fun-≮:-never F = witness function (fun-function F) never
-
--- function types aren't scalars
-fun-¬scalar : ∀ {F S t} → (s : Scalar S) → FunType F → Language F 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-ok₂ p) = scalar-function-ok s
-fun-¬scalar s (S ⇒ T) (function-err p) = scalar-function-err s
-fun-¬scalar s (S ⇒ T) (function-tgt p) = scalar-function-tgt s
-fun-¬scalar s (F ∩ G) (p₁ , p₂) = fun-¬scalar s G p₂
-
-¬scalar-fun : ∀ {F S} → FunType F → (s : Scalar S) → ¬Language F (scalar s)
-¬scalar-fun (S ⇒ T) s = function-scalar s
-¬scalar-fun (F ∩ G) s = left (¬scalar-fun F s)
-
-scalar-≮:-fun : ∀ {F S} → FunType F → Scalar S → S ≮: F
-scalar-≮:-fun F s = witness (scalar s) (scalar s) (¬scalar-fun F s)
-
-unknown-≮:-fun : ∀ {F} → FunType F → unknown ≮: F
-unknown-≮:-fun F = witness (scalar nil) unknown (¬scalar-fun F 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 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))
-
-

prototyping/Properties/TypeSaturation.agda

@@ -1,433 +0,0 @@
-{-# OPTIONS --rewriting #-}
-
-module Properties.TypeSaturation where
-
-open import Agda.Builtin.Equality using (_≡_; refl)
-open import FFI.Data.Either using (Either; Left; Right)
-open import Luau.Subtyping using (Tree; Language; ¬Language; _<:_; _≮:_; witness; scalar; function; function-err; function-ok; function-ok₁; function-ok₂; scalar-function; _,_; never)
-open import Luau.Type using (Type; _⇒_; _∩_; _∪_; never; unknown)
-open import Luau.TypeNormalization using (_∩ⁿ_; _∪ⁿ_)
-open import Luau.TypeSaturation using (_⋓_; _⋒_; _∩ᵘ_; _∩ⁱ_; ∪-saturate; ∩-saturate; saturate)
-open import Properties.Subtyping using (dec-language; language-comp; <:-impl-⊇; <:-refl; <:-trans; <:-trans-≮:; <:-impl-¬≮: ; <:-never; <:-unknown; <:-function; <:-union; <:-∪-symm; <:-∪-left; <:-∪-right; <:-∪-lub; <:-∪-assocl; <:-∪-assocr; <:-intersect; <:-∩-symm; <:-∩-left; <:-∩-right; <:-∩-glb; ≮:-function-left; ≮:-function-right; <:-function-∩-∪; <:-function-∩-∩; <:-∩-assocl; <:-∩-assocr; ∩-<:-∪; <:-∩-distl-∪; ∩-distl-∪-<:; <:-∩-distr-∪; ∩-distr-∪-<:)
-open import Properties.TypeNormalization using (Normal; FunType; _⇒_; _∩_; _∪_; never; unknown; normal-∪ⁿ; normal-∩ⁿ; ∪ⁿ-<:-∪; ∪-<:-∪ⁿ; ∩ⁿ-<:-∩; ∩-<:-∩ⁿ)
-open import Properties.Contradiction using (CONTRADICTION)
-open import Properties.Functions using (_∘_)
-
--- Saturation preserves normalization
-normal-⋒ : ∀ {F G} → FunType F → FunType G → FunType (F ⋒ G)
-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
-
-normal-⋓ : ∀ {F G} → FunType F → FunType G → FunType (F ⋓ G)
-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
-
-normal-∩-saturate : ∀ {F} → FunType F → FunType (∩-saturate F)
-normal-∩-saturate (S ⇒ T) = S ⇒ T
-normal-∩-saturate (F ∩ G) = (normal-∩-saturate F ∩ normal-∩-saturate G) ∩ normal-⋒ (normal-∩-saturate F) (normal-∩-saturate G)
-
-normal-∪-saturate : ∀ {F} → FunType F → FunType (∪-saturate F)
-normal-∪-saturate (S ⇒ T) = S ⇒ T
-normal-∪-saturate (F ∩ G) = (normal-∪-saturate F ∩ normal-∪-saturate G) ∩ normal-⋓ (normal-∪-saturate F) (normal-∪-saturate G)
-
-normal-saturate : ∀ {F} → FunType F → FunType (saturate F)
-normal-saturate F = normal-∪-saturate (normal-∩-saturate F)
-
--- Saturation resects subtyping
-∪-saturate-<: : ∀ {F} → FunType F → ∪-saturate F <: F
-∪-saturate-<: (S ⇒ T) = <:-refl
-∪-saturate-<: (F ∩ G) = <:-trans <:-∩-left (<:-intersect (∪-saturate-<: F) (∪-saturate-<: G))
-
-∩-saturate-<: : ∀ {F} → FunType F → ∩-saturate F <: F
-∩-saturate-<: (S ⇒ T) = <:-refl
-∩-saturate-<: (F ∩ G) = <:-trans <:-∩-left (<:-intersect (∩-saturate-<: F) (∩-saturate-<: G))
-
-saturate-<: : ∀ {F} → FunType F → saturate F <: F
-saturate-<: F = <:-trans (∪-saturate-<: (normal-∩-saturate F)) (∩-saturate-<: F)
-
-∩-<:-⋓ : ∀ {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 (<:-∩-glb (<:-intersect <:-refl <:-∩-left) (<:-intersect <:-refl <:-∩-right)) (<:-intersect (∩-<:-⋓ (R ⇒ S) G) (∩-<:-⋓ (R ⇒ S) H))
-∩-<:-⋓ (E ∩ F) G = <:-trans (<:-∩-glb (<:-intersect <:-∩-left <:-refl) (<:-intersect <:-∩-right <:-refl)) (<:-intersect (∩-<:-⋓ E G) (∩-<:-⋓ F G))
-
-∩-<:-⋒ : ∀ {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 (<:-∩-glb (<:-intersect <:-refl <:-∩-left) (<:-intersect <:-refl <:-∩-right)) (<:-intersect (∩-<:-⋒ (R ⇒ S) G) (∩-<:-⋒ (R ⇒ S) H))
-∩-<:-⋒ (E ∩ F) G = <:-trans (<:-∩-glb (<:-intersect <:-∩-left <:-refl) (<:-intersect <:-∩-right <:-refl)) (<:-intersect (∩-<:-⋒ E G) (∩-<:-⋒ F G))
-
-<:-∪-saturate : ∀ {F} → FunType F → F <: ∪-saturate F
-<:-∪-saturate (S ⇒ T) = <:-refl
-<:-∪-saturate (F ∩ G) = <:-∩-glb (<:-intersect (<:-∪-saturate F) (<:-∪-saturate G)) (<:-trans (<:-intersect (<:-∪-saturate F) (<:-∪-saturate G)) (∩-<:-⋓ (normal-∪-saturate F) (normal-∪-saturate G)))
-
-<:-∩-saturate : ∀ {F} → FunType F → F <: ∩-saturate F
-<:-∩-saturate (S ⇒ T) = <:-refl
-<:-∩-saturate (F ∩ G) = <:-∩-glb (<:-intersect (<:-∩-saturate F) (<:-∩-saturate G)) (<:-trans (<:-intersect (<:-∩-saturate F) (<:-∩-saturate G)) (∩-<:-⋒ (normal-∩-saturate F) (normal-∩-saturate G)))
-
-<:-saturate : ∀ {F} → FunType F → F <: saturate F
-<:-saturate F = <:-trans (<:-∩-saturate F) (<:-∪-saturate (normal-∩-saturate F))
-
--- Overloads F is the set of overloads of F
-data Overloads : Type → Type → Set where
-
-   here : ∀ {S T} → Overloads (S ⇒ T) (S ⇒ T)
-   left : ∀ {S T F G} → Overloads F (S ⇒ T) → Overloads (F ∩ G) (S ⇒ T)
-   right : ∀ {S T F G} → Overloads G (S ⇒ T) → Overloads (F ∩ G) (S ⇒ T)
-
-normal-overload-src : ∀ {F S T} → FunType F → Overloads F (S ⇒ T) → Normal S
-normal-overload-src (S ⇒ T) here = S
-normal-overload-src (F ∩ G) (left o) = normal-overload-src F o
-normal-overload-src (F ∩ G) (right o) = normal-overload-src G o
-
-normal-overload-tgt : ∀ {F S T} → FunType F → Overloads F (S ⇒ T) → Normal T
-normal-overload-tgt (S ⇒ T) here = T
-normal-overload-tgt (F ∩ G) (left o) = normal-overload-tgt F o
-normal-overload-tgt (F ∩ G) (right o) = normal-overload-tgt G o
-
--- An inductive presentation of the overloads of F ⋓ G
-data ∪-Lift (P Q : Type → Set) : Type → Set where
-
-  union : ∀ {R S T U} →
-
-    P (R ⇒ S) →
-    Q (T ⇒ U) →
-    --------------------
-    ∪-Lift P Q ((R ∪ T) ⇒ (S ∪ U))
-
--- An inductive presentation of the overloads of F ⋒ G
-data ∩-Lift (P Q : Type → Set) : Type → Set where
-
-  intersect : ∀ {R S T U} →
-
-    P (R ⇒ S) →
-    Q (T ⇒ U) →
-    --------------------
-    ∩-Lift P Q ((R ∩ T) ⇒ (S ∩ U))
-
--- An inductive presentation of the overloads of ∪-saturate F
-data ∪-Saturate (P : Type → Set) : Type → Set where
-
-  base : ∀ {S T} →
-
-    P (S ⇒ T) →
-    --------------------
-    ∪-Saturate P (S ⇒ T)
-
-  union : ∀ {R S T U} →
-
-    ∪-Saturate P (R ⇒ S) →
-    ∪-Saturate P (T ⇒ U) →
-    --------------------
-    ∪-Saturate P ((R ∪ T) ⇒ (S ∪ U))
-
--- An inductive presentation of the overloads of ∩-saturate F
-data ∩-Saturate (P : Type → Set) : Type → Set where
-
-  base : ∀ {S T} →
-
-    P (S ⇒ T) →
-    --------------------
-    ∩-Saturate P (S ⇒ T)
-
-  intersect : ∀ {R S T U} →
-
-    ∩-Saturate P (R ⇒ S) →
-    ∩-Saturate P (T ⇒ U) →
-    --------------------
-    ∩-Saturate P ((R ∩ T) ⇒ (S ∩ U))
-
--- The <:-up-closure of a set of function types
-data <:-Close (P : Type → Set) : Type → Set where
-
-  defn : ∀ {R S T U} →
-
-    P (S ⇒ T) →
-    R <: S →
-    T <: U →
-    ------------------
-    <:-Close P (R ⇒ U)
-
--- F ⊆ᵒ G whenever every overload of F is an overload of G
-_⊆ᵒ_ : Type → Type → Set
-F ⊆ᵒ G = ∀ {S T} → Overloads F (S ⇒ T) → Overloads G (S ⇒ T)
-
--- F <:ᵒ G when every overload of G is a supertype of an overload of F
-_<:ᵒ_ : Type → Type → Set
-_<:ᵒ_ F G = ∀ {S T} → Overloads G (S ⇒ T) → <:-Close (Overloads F) (S ⇒ T)
-
--- P ⊂: Q when any type in P is a subtype of some type in Q
-_⊂:_ : (Type → Set) → (Type → Set) → Set
-P ⊂: Q = ∀ {S T} → P (S ⇒ T) → <:-Close Q (S ⇒ T)
-
--- <:-Close is a monad
-just : ∀ {P S T} → P (S ⇒ T) → <:-Close P (S ⇒ T)
-just p = defn p <:-refl <:-refl
-
-infixl 5 _>>=_ _>>=ˡ_ _>>=ʳ_
-_>>=_ : ∀ {P Q S T} → <:-Close P (S ⇒ T) → (P ⊂: Q) → <:-Close Q (S ⇒ T)
-(defn p p₁ p₂) >>= P⊂Q with P⊂Q p
-(defn p p₁ p₂) >>= P⊂Q | defn q q₁ q₂ = defn q (<:-trans p₁ q₁) (<:-trans q₂ p₂)
-
-_>>=ˡ_ : ∀ {P R S T} → <:-Close P (S ⇒ T) → (R <: S) → <:-Close P (R ⇒ T)
-(defn p p₁ p₂) >>=ˡ q = defn p (<:-trans q p₁) p₂
-
-_>>=ʳ_ : ∀ {P S T U} → <:-Close P (S ⇒ T) → (T <: U) → <:-Close P (S ⇒ U)
-(defn p p₁ p₂) >>=ʳ q = defn p p₁ (<:-trans p₂ q)
-
--- Properties of ⊂:
-⊂:-refl : ∀ {P} → P ⊂: P
-⊂:-refl p = just p
-
-_[∪]_ : ∀ {P Q R S T U} → <:-Close P (R ⇒ S) → <:-Close Q (T ⇒ U) → <:-Close (∪-Lift P Q) ((R ∪ T) ⇒ (S ∪ U))
-(defn p p₁ p₂) [∪] (defn q q₁ q₂) = defn (union p q) (<:-union p₁ q₁) (<:-union p₂ q₂)
-
-_[∩]_ : ∀ {P Q R S T U} → <:-Close P (R ⇒ S) → <:-Close Q (T ⇒ U) → <:-Close (∩-Lift P Q) ((R ∩ T) ⇒ (S ∩ U))
-(defn p p₁ p₂) [∩] (defn q q₁ q₂) = defn (intersect p q) (<:-intersect p₁ q₁) (<:-intersect p₂ q₂)
-
-⊂:-∩-saturate-inj : ∀ {P} → P ⊂: ∩-Saturate P
-⊂:-∩-saturate-inj p = defn (base p) <:-refl <:-refl
-
-⊂:-∪-saturate-inj : ∀ {P} → P ⊂: ∪-Saturate P
-⊂:-∪-saturate-inj p = just (base p)
-
-⊂:-∩-lift-saturate : ∀ {P} → ∩-Lift (∩-Saturate P) (∩-Saturate P) ⊂: ∩-Saturate P
-⊂:-∩-lift-saturate (intersect p q) = just (intersect p q)
-
-⊂:-∪-lift-saturate : ∀ {P} → ∪-Lift (∪-Saturate P) (∪-Saturate P) ⊂: ∪-Saturate P
-⊂:-∪-lift-saturate (union p q) = just (union p q)
-
-⊂:-∩-lift : ∀ {P Q R S} → (P ⊂: Q) → (R ⊂: S) → (∩-Lift P R ⊂: ∩-Lift Q S)
-⊂:-∩-lift P⊂Q R⊂S (intersect n o) = P⊂Q n [∩] R⊂S o
-
-⊂:-∪-lift : ∀ {P Q R S} → (P ⊂: Q) → (R ⊂: S) → (∪-Lift P R ⊂: ∪-Lift Q S)
-⊂:-∪-lift P⊂Q R⊂S (union n o) = P⊂Q n [∪] R⊂S o
-
-⊂:-∩-saturate : ∀ {P Q} → (P ⊂: Q) → (∩-Saturate P ⊂: ∩-Saturate Q)
-⊂:-∩-saturate P⊂Q (base p) = P⊂Q p >>= ⊂:-∩-saturate-inj
-⊂:-∩-saturate P⊂Q (intersect p q) = (⊂:-∩-saturate P⊂Q p [∩] ⊂:-∩-saturate P⊂Q q) >>= ⊂:-∩-lift-saturate
-
-⊂:-∪-saturate : ∀ {P Q} → (P ⊂: Q) → (∪-Saturate P ⊂: ∪-Saturate Q)
-⊂:-∪-saturate P⊂Q (base p) = P⊂Q p >>= ⊂:-∪-saturate-inj
-⊂:-∪-saturate P⊂Q (union p q) = (⊂:-∪-saturate P⊂Q p [∪] ⊂:-∪-saturate P⊂Q q) >>= ⊂:-∪-lift-saturate
-
-⊂:-∩-saturate-indn : ∀ {P Q} → (P ⊂: Q) → (∩-Lift Q Q ⊂: Q) → (∩-Saturate P ⊂: Q)
-⊂:-∩-saturate-indn P⊂Q QQ⊂Q (base p) = P⊂Q p
-⊂:-∩-saturate-indn P⊂Q QQ⊂Q (intersect p q) = (⊂:-∩-saturate-indn P⊂Q QQ⊂Q p [∩] ⊂:-∩-saturate-indn P⊂Q QQ⊂Q q) >>= QQ⊂Q
-
-⊂:-∪-saturate-indn : ∀ {P Q} → (P ⊂: Q) → (∪-Lift Q Q ⊂: Q) → (∪-Saturate P ⊂: Q)
-⊂:-∪-saturate-indn P⊂Q QQ⊂Q (base p) = P⊂Q p
-⊂:-∪-saturate-indn P⊂Q QQ⊂Q (union p q) = (⊂:-∪-saturate-indn P⊂Q QQ⊂Q p [∪] ⊂:-∪-saturate-indn P⊂Q QQ⊂Q q) >>= QQ⊂Q
-
-∪-saturate-resp-∩-saturation : ∀ {P} → (∩-Lift P P ⊂: P) → (∩-Lift (∪-Saturate P) (∪-Saturate P) ⊂: ∪-Saturate P)
-∪-saturate-resp-∩-saturation ∩P⊂P (intersect (base p) (base q)) = ∩P⊂P (intersect p q) >>= ⊂:-∪-saturate-inj
-∪-saturate-resp-∩-saturation ∩P⊂P (intersect p (union q q₁)) = (∪-saturate-resp-∩-saturation ∩P⊂P (intersect p q) [∪] ∪-saturate-resp-∩-saturation ∩P⊂P (intersect p q₁)) >>= ⊂:-∪-lift-saturate >>=ˡ <:-∩-distl-∪ >>=ʳ ∩-distl-∪-<:
-∪-saturate-resp-∩-saturation ∩P⊂P (intersect (union p p₁) q) = (∪-saturate-resp-∩-saturation ∩P⊂P (intersect p q) [∪] ∪-saturate-resp-∩-saturation ∩P⊂P (intersect p₁ q)) >>= ⊂:-∪-lift-saturate >>=ˡ <:-∩-distr-∪ >>=ʳ ∩-distr-∪-<:
-
-ov-language : ∀ {F t} → FunType F → (∀ {S T} → Overloads F (S ⇒ T) → Language (S ⇒ T) t) → Language F t
-ov-language (S ⇒ T) p = p here
-ov-language (F ∩ G) p = (ov-language F (p ∘ left) , ov-language G (p ∘ right))
-
-ov-<: : ∀ {F R S T U} → FunType F → Overloads F (R ⇒ S) → ((R ⇒ S) <: (T ⇒ U)) → F <: (T ⇒ U)
-ov-<: F here p = p
-ov-<: (F ∩ G) (left o) p = <:-trans <:-∩-left (ov-<: F o p)
-ov-<: (F ∩ G) (right o) p = <:-trans <:-∩-right (ov-<: G o p)
-
-<:ᵒ-impl-<: : ∀ {F G} → FunType F → FunType G → (F <:ᵒ G) → (F <: G)
-<:ᵒ-impl-<: F (T ⇒ U) F<G with F<G here
-<:ᵒ-impl-<: F (T ⇒ U) F<G | defn o o₁ o₂ = ov-<: F o (<:-function o₁ o₂)
-<:ᵒ-impl-<: F (G ∩ H) F<G = <:-∩-glb (<:ᵒ-impl-<: F G (F<G ∘ left)) (<:ᵒ-impl-<: F H (F<G ∘ right))
-
-⊂:-overloads-left : ∀ {F G} → Overloads F ⊂: Overloads (F ∩ G)
-⊂:-overloads-left p = just (left p)
-
-⊂:-overloads-right : ∀ {F G} → Overloads G ⊂: Overloads (F ∩ G)
-⊂:-overloads-right p = just (right p)
-
-⊂:-overloads-⋒ : ∀ {F G} → FunType F → FunType G → ∩-Lift (Overloads F) (Overloads G) ⊂: Overloads (F ⋒ G)
-⊂:-overloads-⋒ (R ⇒ S) (T ⇒ U) (intersect here here) = defn here (∩-<:-∩ⁿ R T) (∩ⁿ-<:-∩ S U)
-⊂:-overloads-⋒ (R ⇒ S) (G ∩ H) (intersect here (left o)) = ⊂:-overloads-⋒ (R ⇒ S) G (intersect here o) >>= ⊂:-overloads-left
-⊂:-overloads-⋒ (R ⇒ S) (G ∩ H) (intersect here (right o)) = ⊂:-overloads-⋒ (R ⇒ S) H (intersect here o) >>= ⊂:-overloads-right
-⊂:-overloads-⋒ (E ∩ F) G (intersect (left n) o) = ⊂:-overloads-⋒ E G (intersect n o) >>= ⊂:-overloads-left
-⊂:-overloads-⋒ (E ∩ F) G (intersect (right n) o) = ⊂:-overloads-⋒ F G (intersect n o) >>= ⊂:-overloads-right
-
-⊂:-⋒-overloads : ∀ {F G} → FunType F → FunType G → Overloads (F ⋒ G) ⊂: ∩-Lift (Overloads F) (Overloads G)
-⊂:-⋒-overloads (R ⇒ S) (T ⇒ U) here = defn (intersect here here) (∩ⁿ-<:-∩ R T) (∩-<:-∩ⁿ S U)
-⊂:-⋒-overloads (R ⇒ S) (G ∩ H) (left o) = ⊂:-⋒-overloads (R ⇒ S) G o >>= ⊂:-∩-lift ⊂:-refl ⊂:-overloads-left 
-⊂:-⋒-overloads (R ⇒ S) (G ∩ H) (right o) = ⊂:-⋒-overloads (R ⇒ S) H o >>= ⊂:-∩-lift ⊂:-refl ⊂:-overloads-right
-⊂:-⋒-overloads (E ∩ F) G (left o) = ⊂:-⋒-overloads E G o >>= ⊂:-∩-lift ⊂:-overloads-left ⊂:-refl
-⊂:-⋒-overloads (E ∩ F) G (right o) = ⊂:-⋒-overloads F G o >>= ⊂:-∩-lift ⊂:-overloads-right ⊂:-refl
-
-⊂:-overloads-⋓ : ∀ {F G} → FunType F → FunType G → ∪-Lift (Overloads F) (Overloads G) ⊂: Overloads (F ⋓ G)
-⊂:-overloads-⋓ (R ⇒ S) (T ⇒ U) (union here here) = defn here (∪-<:-∪ⁿ R T) (∪ⁿ-<:-∪ S U)
-⊂:-overloads-⋓ (R ⇒ S) (G ∩ H) (union here (left o)) = ⊂:-overloads-⋓ (R ⇒ S) G (union here o) >>= ⊂:-overloads-left
-⊂:-overloads-⋓ (R ⇒ S) (G ∩ H) (union here (right o)) = ⊂:-overloads-⋓ (R ⇒ S) H (union here o) >>= ⊂:-overloads-right
-⊂:-overloads-⋓ (E ∩ F) G (union (left n) o) = ⊂:-overloads-⋓ E G (union n o) >>= ⊂:-overloads-left
-⊂:-overloads-⋓ (E ∩ F) G (union (right n) o) = ⊂:-overloads-⋓ F G (union n o) >>= ⊂:-overloads-right
-
-⊂:-⋓-overloads : ∀ {F G} → FunType F → FunType G → Overloads (F ⋓ G) ⊂: ∪-Lift (Overloads F) (Overloads G)
-⊂:-⋓-overloads (R ⇒ S) (T ⇒ U) here = defn (union here here) (∪ⁿ-<:-∪ R T) (∪-<:-∪ⁿ S U)
-⊂:-⋓-overloads (R ⇒ S) (G ∩ H) (left o) = ⊂:-⋓-overloads (R ⇒ S) G o >>= ⊂:-∪-lift ⊂:-refl ⊂:-overloads-left
-⊂:-⋓-overloads (R ⇒ S) (G ∩ H) (right o) = ⊂:-⋓-overloads (R ⇒ S) H o >>= ⊂:-∪-lift ⊂:-refl ⊂:-overloads-right
-⊂:-⋓-overloads (E ∩ F) G (left o) = ⊂:-⋓-overloads E G o >>= ⊂:-∪-lift ⊂:-overloads-left ⊂:-refl
-⊂:-⋓-overloads (E ∩ F) G (right o) = ⊂:-⋓-overloads F G o >>= ⊂:-∪-lift ⊂:-overloads-right ⊂:-refl
-
-∪-saturate-overloads : ∀ {F} → FunType F → Overloads (∪-saturate F) ⊂: ∪-Saturate (Overloads F)
-∪-saturate-overloads (S ⇒ T) here = just (base here)
-∪-saturate-overloads (F ∩ G) (left (left o)) = ∪-saturate-overloads F o >>= ⊂:-∪-saturate ⊂:-overloads-left
-∪-saturate-overloads (F ∩ G) (left (right o)) = ∪-saturate-overloads G o >>= ⊂:-∪-saturate ⊂:-overloads-right
-∪-saturate-overloads (F ∩ G) (right o) =
-  ⊂:-⋓-overloads (normal-∪-saturate F) (normal-∪-saturate G) o >>=
-  ⊂:-∪-lift (∪-saturate-overloads F) (∪-saturate-overloads G) >>=
-  ⊂:-∪-lift (⊂:-∪-saturate ⊂:-overloads-left) (⊂:-∪-saturate ⊂:-overloads-right) >>=
-  ⊂:-∪-lift-saturate
-
-overloads-∪-saturate : ∀ {F} → FunType F → ∪-Saturate (Overloads F) ⊂: Overloads (∪-saturate F)
-overloads-∪-saturate F = ⊂:-∪-saturate-indn (inj F) (step F) where
-
-  inj : ∀ {F} → FunType F → Overloads F ⊂: Overloads (∪-saturate F)
-  inj (S ⇒ T) here = just here
-  inj (F ∩ G) (left p) = inj F p >>= ⊂:-overloads-left >>= ⊂:-overloads-left
-  inj (F ∩ G) (right p) = inj G p >>= ⊂:-overloads-right >>= ⊂:-overloads-left
-
-  step : ∀ {F} → FunType F → ∪-Lift (Overloads (∪-saturate F)) (Overloads (∪-saturate F)) ⊂: Overloads (∪-saturate F)
-  step (S ⇒ T) (union here here) = defn here (<:-∪-lub <:-refl <:-refl) <:-∪-left
-  step (F ∩ G) (union (left (left p)) (left (left q))) = step F (union p q) >>= ⊂:-overloads-left >>= ⊂:-overloads-left
-  step (F ∩ G) (union (left (left p)) (left (right q))) = ⊂:-overloads-⋓ (normal-∪-saturate F) (normal-∪-saturate G) (union p q) >>= ⊂:-overloads-right
-  step (F ∩ G) (union (left (right p)) (left (left q))) = ⊂:-overloads-⋓ (normal-∪-saturate F) (normal-∪-saturate G) (union q p) >>= ⊂:-overloads-right >>=ˡ <:-∪-symm >>=ʳ <:-∪-symm
-  step (F ∩ G) (union (left (right p)) (left (right q))) = step G (union p q) >>= ⊂:-overloads-right >>= ⊂:-overloads-left
-  step (F ∩ G) (union p (right q)) with ⊂:-⋓-overloads (normal-∪-saturate F) (normal-∪-saturate G) q
-  step (F ∩ G) (union (left (left p)) (right q)) | defn (union q₁ q₂) q₃ q₄ =
-    (step F (union p q₁) [∪] just q₂) >>=
-    ⊂:-overloads-⋓ (normal-∪-saturate F) (normal-∪-saturate G) >>=
-    ⊂:-overloads-right >>=ˡ
-    <:-trans (<:-union <:-refl q₃) <:-∪-assocl >>=ʳ
-    <:-trans <:-∪-assocr (<:-union <:-refl q₄)
-  step (F ∩ G) (union (left (right p)) (right q)) | defn (union q₁ q₂) q₃ q₄ =
-    (just q₁ [∪] step G (union p q₂)) >>=
-    ⊂:-overloads-⋓ (normal-∪-saturate F) (normal-∪-saturate G) >>=
-    ⊂:-overloads-right >>=ˡ
-    <:-trans (<:-union <:-refl q₃) (<:-∪-lub (<:-trans <:-∪-left <:-∪-right) (<:-∪-lub <:-∪-left (<:-trans <:-∪-right <:-∪-right))) >>=ʳ
-    <:-trans (<:-∪-lub (<:-trans <:-∪-left <:-∪-right) (<:-∪-lub <:-∪-left (<:-trans <:-∪-right <:-∪-right))) (<:-union <:-refl q₄)
-  step (F ∩ G) (union (right p) (right q)) | defn (union q₁ q₂) q₃ q₄ with ⊂:-⋓-overloads (normal-∪-saturate F) (normal-∪-saturate G) p
-  step (F ∩ G) (union (right p) (right q)) | defn (union q₁ q₂) q₃ q₄ | defn (union p₁ p₂) p₃ p₄ =
-    (step F (union p₁ q₁) [∪] step G (union p₂ q₂)) >>=
-    ⊂:-overloads-⋓ (normal-∪-saturate F) (normal-∪-saturate G) >>=
-    ⊂:-overloads-right >>=ˡ
-    <:-trans (<:-union p₃ q₃) (<:-∪-lub (<:-union <:-∪-left <:-∪-left) (<:-union <:-∪-right <:-∪-right)) >>=ʳ
-    <:-trans (<:-∪-lub (<:-union <:-∪-left <:-∪-left) (<:-union <:-∪-right <:-∪-right)) (<:-union p₄ q₄)
-  step (F ∩ G) (union (right p) q) with ⊂:-⋓-overloads (normal-∪-saturate F) (normal-∪-saturate G) p
-  step (F ∩ G) (union (right p) (left (left q))) | defn (union p₁ p₂) p₃ p₄ =
-    (step F (union p₁ q) [∪] just p₂) >>=
-    ⊂:-overloads-⋓ (normal-∪-saturate F) (normal-∪-saturate G) >>=
-    ⊂:-overloads-right >>=ˡ
-    <:-trans (<:-union p₃ <:-refl) (<:-∪-lub (<:-union <:-∪-left <:-refl) (<:-trans <:-∪-right <:-∪-left)) >>=ʳ
-    <:-trans (<:-∪-lub (<:-union <:-∪-left <:-refl) (<:-trans <:-∪-right <:-∪-left)) (<:-union p₄ <:-refl)
-  step (F ∩ G) (union (right p) (left (right q))) | defn (union p₁ p₂) p₃ p₄ =
-    (just p₁ [∪] step G (union p₂ q)) >>=
-    ⊂:-overloads-⋓ (normal-∪-saturate F) (normal-∪-saturate G) >>=
-    ⊂:-overloads-right >>=ˡ
-    <:-trans (<:-union p₃ <:-refl) <:-∪-assocr >>=ʳ
-    <:-trans <:-∪-assocl (<:-union p₄ <:-refl)
-  step (F ∩ G) (union (right p) (right q)) | defn (union p₁ p₂) p₃ p₄ with ⊂:-⋓-overloads (normal-∪-saturate F) (normal-∪-saturate G) q
-  step (F ∩ G) (union (right p) (right q)) | defn (union p₁ p₂) p₃ p₄ | defn (union q₁ q₂) q₃ q₄ =
-    (step F (union p₁ q₁) [∪] step G (union p₂ q₂)) >>=
-    ⊂:-overloads-⋓ (normal-∪-saturate F) (normal-∪-saturate G) >>=
-    ⊂:-overloads-right >>=ˡ
-    <:-trans (<:-union p₃ q₃) (<:-∪-lub (<:-union <:-∪-left <:-∪-left) (<:-union <:-∪-right <:-∪-right)) >>=ʳ
-    <:-trans (<:-∪-lub (<:-union <:-∪-left <:-∪-left) (<:-union <:-∪-right <:-∪-right)) (<:-union p₄ q₄)
-
-∪-saturated : ∀ {F} → FunType F → ∪-Lift (Overloads (∪-saturate F)) (Overloads (∪-saturate F)) ⊂: Overloads (∪-saturate F)
-∪-saturated F o =
-  ⊂:-∪-lift (∪-saturate-overloads F) (∪-saturate-overloads F) o >>=
-  ⊂:-∪-lift-saturate >>=
-  overloads-∪-saturate F
-
-∩-saturate-overloads : ∀ {F} → FunType F → Overloads (∩-saturate F) ⊂: ∩-Saturate (Overloads F)
-∩-saturate-overloads (S ⇒ T) here = just (base here)
-∩-saturate-overloads (F ∩ G) (left (left o)) = ∩-saturate-overloads F o >>= ⊂:-∩-saturate ⊂:-overloads-left
-∩-saturate-overloads (F ∩ G) (left (right o)) = ∩-saturate-overloads G o >>= ⊂:-∩-saturate ⊂:-overloads-right
-∩-saturate-overloads (F ∩ G) (right o) =
-  ⊂:-⋒-overloads (normal-∩-saturate F) (normal-∩-saturate G) o >>=
-  ⊂:-∩-lift (∩-saturate-overloads F) (∩-saturate-overloads G) >>=
-  ⊂:-∩-lift (⊂:-∩-saturate ⊂:-overloads-left) (⊂:-∩-saturate ⊂:-overloads-right) >>=
-  ⊂:-∩-lift-saturate
-
-overloads-∩-saturate : ∀ {F} → FunType F → ∩-Saturate (Overloads F) ⊂: Overloads (∩-saturate F)
-overloads-∩-saturate F = ⊂:-∩-saturate-indn (inj F) (step F) where
-  
-  inj :  ∀ {F} → FunType F → Overloads F ⊂: Overloads (∩-saturate F)
-  inj (S ⇒ T) here = just here
-  inj (F ∩ G) (left p) = inj F p >>= ⊂:-overloads-left >>= ⊂:-overloads-left
-  inj (F ∩ G) (right p) = inj G p >>= ⊂:-overloads-right >>= ⊂:-overloads-left
-
-  step : ∀ {F} → FunType F → ∩-Lift (Overloads (∩-saturate F)) (Overloads (∩-saturate F)) ⊂: Overloads (∩-saturate F)
-  step (S ⇒ T) (intersect here here) = defn here <:-∩-left (<:-∩-glb <:-refl <:-refl) 
-  step (F ∩ G) (intersect (left (left p)) (left (left q))) = step F (intersect p q) >>= ⊂:-overloads-left >>= ⊂:-overloads-left
-  step (F ∩ G) (intersect (left (left p)) (left (right q))) = ⊂:-overloads-⋒ (normal-∩-saturate F) (normal-∩-saturate G) (intersect p q) >>= ⊂:-overloads-right
-  step (F ∩ G) (intersect (left (right p)) (left (left q))) = ⊂:-overloads-⋒ (normal-∩-saturate F) (normal-∩-saturate G) (intersect q p) >>= ⊂:-overloads-right >>=ˡ <:-∩-symm >>=ʳ <:-∩-symm
-  step (F ∩ G) (intersect (left (right p)) (left (right q))) = step G (intersect p q) >>= ⊂:-overloads-right >>= ⊂:-overloads-left
-  step (F ∩ G) (intersect (right p) q) with ⊂:-⋒-overloads (normal-∩-saturate F) (normal-∩-saturate G) p
-  step (F ∩ G) (intersect (right p) (left (left q))) | defn (intersect p₁ p₂) p₃ p₄ =
-    (step F (intersect p₁ q) [∩] just p₂) >>=
-    ⊂:-overloads-⋒ (normal-∩-saturate F) (normal-∩-saturate G) >>=
-    ⊂:-overloads-right >>=ˡ
-    <:-trans (<:-intersect p₃ <:-refl) (<:-∩-glb (<:-intersect <:-∩-left <:-refl) (<:-trans <:-∩-left <:-∩-right)) >>=ʳ
-    <:-trans (<:-∩-glb (<:-intersect <:-∩-left <:-refl) (<:-trans <:-∩-left <:-∩-right)) (<:-intersect p₄ <:-refl)
-  step (F ∩ G) (intersect (right p) (left (right q))) | defn (intersect p₁ p₂) p₃ p₄ =
-    (just p₁ [∩] step G (intersect p₂ q)) >>=
-    ⊂:-overloads-⋒ (normal-∩-saturate F) (normal-∩-saturate G) >>=
-    ⊂:-overloads-right >>=ˡ
-    <:-trans (<:-intersect p₃ <:-refl) <:-∩-assocr >>=ʳ
-    <:-trans <:-∩-assocl (<:-intersect p₄ <:-refl)
-  step (F ∩ G) (intersect (right p) (right q)) | defn (intersect p₁ p₂) p₃ p₄ with ⊂:-⋒-overloads (normal-∩-saturate F) (normal-∩-saturate G) q
-  step (F ∩ G) (intersect (right p) (right q)) | defn (intersect p₁ p₂) p₃ p₄ | defn (intersect q₁ q₂) q₃ q₄ =
-    (step F (intersect p₁ q₁) [∩] step G (intersect p₂ q₂)) >>=
-    ⊂:-overloads-⋒ (normal-∩-saturate F) (normal-∩-saturate G) >>=
-    ⊂:-overloads-right >>=ˡ
-    <:-trans (<:-intersect p₃ q₃) (<:-∩-glb (<:-intersect <:-∩-left <:-∩-left) (<:-intersect <:-∩-right <:-∩-right)) >>=ʳ
-    <:-trans (<:-∩-glb (<:-intersect <:-∩-left <:-∩-left) (<:-intersect <:-∩-right <:-∩-right)) (<:-intersect p₄ q₄)
-  step (F ∩ G) (intersect p (right q)) with ⊂:-⋒-overloads (normal-∩-saturate F) (normal-∩-saturate G) q
-  step (F ∩ G) (intersect (left (left p)) (right q)) | defn (intersect q₁ q₂) q₃ q₄ =
-    (step F (intersect p q₁) [∩] just q₂) >>=
-    ⊂:-overloads-⋒ (normal-∩-saturate F) (normal-∩-saturate G) >>=
-    ⊂:-overloads-right >>=ˡ
-    <:-trans (<:-intersect <:-refl q₃) <:-∩-assocl >>=ʳ
-    <:-trans <:-∩-assocr (<:-intersect <:-refl q₄)
-  step (F ∩ G) (intersect (left (right p)) (right q)) | defn (intersect q₁ q₂) q₃ q₄ =
-    (just q₁ [∩] step G (intersect p q₂) ) >>=
-    ⊂:-overloads-⋒ (normal-∩-saturate F) (normal-∩-saturate G) >>=
-    ⊂:-overloads-right >>=ˡ
-    <:-trans (<:-intersect <:-refl q₃) (<:-∩-glb (<:-trans <:-∩-right <:-∩-left) (<:-∩-glb <:-∩-left (<:-trans <:-∩-right <:-∩-right))) >>=ʳ
-    <:-∩-glb (<:-trans <:-∩-right <:-∩-left) (<:-trans (<:-∩-glb <:-∩-left (<:-trans <:-∩-right <:-∩-right)) q₄)
-  step (F ∩ G) (intersect (right p) (right q)) | defn (intersect q₁ q₂) q₃ q₄ with ⊂:-⋒-overloads (normal-∩-saturate F) (normal-∩-saturate G) p
-  step (F ∩ G) (intersect (right p) (right q)) | defn (intersect q₁ q₂) q₃ q₄ | defn (intersect p₁ p₂) p₃ p₄ =
-    (step F (intersect p₁ q₁) [∩] step G (intersect p₂ q₂)) >>=
-    ⊂:-overloads-⋒ (normal-∩-saturate F) (normal-∩-saturate G) >>=
-    ⊂:-overloads-right >>=ˡ
-    <:-trans (<:-intersect p₃ q₃) (<:-∩-glb (<:-intersect <:-∩-left <:-∩-left) (<:-intersect <:-∩-right <:-∩-right)) >>=ʳ
-    <:-trans (<:-∩-glb (<:-intersect <:-∩-left <:-∩-left) (<:-intersect <:-∩-right <:-∩-right)) (<:-intersect p₄ q₄)
-
-saturate-overloads : ∀ {F} → FunType F → Overloads (saturate F) ⊂: ∪-Saturate (∩-Saturate (Overloads F))
-saturate-overloads F o = ∪-saturate-overloads (normal-∩-saturate F) o >>= (⊂:-∪-saturate (∩-saturate-overloads F))
-
-overloads-saturate : ∀ {F} → FunType F → ∪-Saturate (∩-Saturate (Overloads F)) ⊂: Overloads (saturate F)
-overloads-saturate F o = ⊂:-∪-saturate (overloads-∩-saturate F) o >>= overloads-∪-saturate (normal-∩-saturate F)
-
--- Saturated F whenever
--- * if F has overloads (R ⇒ S) and (T ⇒ U) then F has an overload which is a subtype of ((R ∩ T) ⇒ (S ∩ U))
--- * ditto union
-data Saturated (F : Type) : Set where
-
-  defn : 
-
-    (∀ {R S T U} → Overloads F (R ⇒ S) → Overloads F (T ⇒ U) → <:-Close (Overloads F) ((R ∩ T) ⇒ (S ∩ U))) →
-    (∀ {R S T U} → Overloads F (R ⇒ S) → Overloads F (T ⇒ U) → <:-Close (Overloads F) ((R ∪ T) ⇒ (S ∪ U))) →
-    -----------
-    Saturated F
-
--- saturated F is saturated!
-saturated : ∀ {F} → FunType F → Saturated (saturate F)
-saturated F = defn
-  (λ n o → (saturate-overloads F n [∩] saturate-overloads F o) >>= ∪-saturate-resp-∩-saturation ⊂:-∩-lift-saturate >>= overloads-saturate F)
-  (λ n o → ∪-saturated (normal-∩-saturate F) (union n o))

prototyping/README.md

@@ -1,45 +0,0 @@
-# Prototyping Luau
-
-![prototyping workflow](https://github.com/Roblox/luau/actions/workflows/prototyping.yml/badge.svg)
-
-An experimental prototyping system for the Luau type system. This is
-intended to allow core language features to be tested quickly, without
-having to interact with all the features of production Lua.
-
-## Building
-
-First install Haskell and Agda.
-
-Install dependencies:
-```
-  cabal update
-  cabal install --lib aeson scientific vector
-```
-
-Then compile
-```
-  agda --compile PrettyPrinter.agda
-```
-
-and run!
-```
-  luau-ast Examples/SmokeTest.lua | ./PrettyPrinter
-```
-
-## Testing
-
-We have a series of snapshot tests in the `Tests/` directory. You interact with the tests using the `tests` Python script in the `prototyping` directory. To simply run the tests, run:
-
-```sh
-tests --luau-cli ../build/luau-ast --build
-```
-
-This will build the test targets and run them. Run `tests --help` for information about all the command-line options.
-
-### Adding a new test
-
-To add a new test, add it to `Tests/{SUITE_NAME}/{CASE_NAME}`. You'll need an `in.lua` file and an `out.txt` file. The `in.lua` file is the input Luau source code, while the `out.txt` file is the expected output after running `luau-ast in.lua | test_executable`.
-
-### Updating a test
-
-If you make a change to the prototype that results in an expected change in behavior, you might want to update the test cases automatically. To do this, run `tests` with the `--accept-new-output` (`-a` for short) flag. Rather than diffing the output, this will overwrite the `out.txt` files for each test case with the actual result. Commit the resulting changes with your PR.

prototyping/Tests/Interpreter/binary_equality_bools/in.lua

@@ -1 +0,0 @@
-return true == false

prototyping/Tests/Interpreter/binary_equality_bools/out.txt

@@ -1,4 +0,0 @@
-ANNOTATED PROGRAM:
-return true == false
-
-RAN WITH RESULT: false

prototyping/Tests/Interpreter/binary_equality_numbers/in.lua

@@ -1 +0,0 @@
-return 1 == 1

prototyping/Tests/Interpreter/binary_equality_numbers/out.txt

@@ -1,4 +0,0 @@
-ANNOTATED PROGRAM:
-return 1.0 == 1.0
-
-RAN WITH RESULT: true

prototyping/Tests/Interpreter/binary_exps/in.lua

@@ -1 +0,0 @@
-return 1 + 2 - 2 * 2 / 2

prototyping/Tests/Interpreter/binary_exps/out.txt

@@ -1,4 +0,0 @@
-ANNOTATED PROGRAM:
-return 1.0 + 2.0 - 2.0 * 2.0 / 2.0
-
-RAN WITH RESULT: 1.0

prototyping/Tests/Interpreter/concat_number_and_string/in.lua

@@ -1,3 +0,0 @@
-local x: string = "hello"
-local y: string = 37
-return x .. y

prototyping/Tests/Interpreter/concat_number_and_string/out.txt

@@ -1,12 +0,0 @@
-ANNOTATED PROGRAM:
-local x : string = "hello"
-local y : string = 37.0
-return x .. y
-
-RUNTIME ERROR:
-value 37.0 is not a string
-  in return statement
-
-TYPE ERROR:
-Local variable y has type string but expression has type number
-  because provided type contains v, where v is a number

prototyping/Tests/Interpreter/concat_two_strings/in.lua

@@ -1,3 +0,0 @@
-local x: string = "hello"
-local y: string = "world"
-return x .. y

prototyping/Tests/Interpreter/concat_two_strings/out.txt

@@ -1,6 +0,0 @@
-ANNOTATED PROGRAM:
-local x : string = "hello"
-local y : string = "world"
-return x .. y
-
-RAN WITH RESULT: "helloworld"

prototyping/Tests/Interpreter/return_nil/in.lua

@@ -1,5 +0,0 @@
-local function foo(x)
-	return nil
-end
-
-return foo(nil)

prototyping/Tests/Interpreter/return_nil/out.txt

@@ -1,7 +0,0 @@
-UNANNOTATED PROGRAM:
-local function foo(x)
-  return nil
-end
-return foo(nil)
-
-RAN WITH RESULT: nil

prototyping/Tests/Interpreter/return_string/in.lua

@@ -1 +0,0 @@
-return "foo bar"

prototyping/Tests/Interpreter/return_string/out.txt

@@ -1,4 +0,0 @@
-ANNOTATED PROGRAM:
-return "foo bar"
-
-RAN WITH RESULT: "foo bar"

prototyping/Tests/PrettyPrinter/smoke_test/in.lua

@@ -1,19 +0,0 @@
-local function id(x)
-	return x
-end
-local function comp(f)
-	return function(g)
-		return function(x)
-			return f(g(x))
-		end
-	end
-end
-local id2 = comp(id)(id)
-local nil2 = id2(nil)
-local a : any = nil
-local b : nil = nil
-local c : (nil) -> nil = nil
-local d : (any & nil) = nil
-local e : any? = nil
-local f : number = 123
-return id2(nil2)

prototyping/Tests/PrettyPrinter/smoke_test/out.txt

@@ -1,19 +0,0 @@
-local function id(x)
-  return x
-end
-local function comp(f)
-  return function(g)
-    return function(x)
-      return f(g(x))
-    end
-  end
-end
-local id2 = comp(id)(id)
-local nil2 = id2(nil)
-local a : unknown = nil
-local b : nil = nil
-local c : (nil) -> nil = nil
-local d : (unknown & nil) = nil
-local e : unknown? = nil
-local f : number = 123.0
-return id2(nil2)

prototyping/Utility/Bool.agda

@@ -1,16 +0,0 @@
-module Utility.Bool where
-
-open import Agda.Builtin.Bool using (Bool; true; false)
-
-not : Bool → Bool
-not false = true
-not true = false
-
-_or_ : Bool → Bool → Bool
-true or _ = true
-_ or true = true
-_ or _ = false
-
-_and_ : Bool → Bool → Bool
-true and true = true
-_ and _ = false

prototyping/tests.py

@@ -1,197 +0,0 @@
-#!/usr/bin/python
-
-import argparse
-import difflib
-import enum
-import os
-import os.path
-import subprocess
-import sys
-
-SUITES = ["interpreter", "prettyprinter"]
-IN_FILE_NAME = "in.lua"
-OUT_FILE_NAME = "out.txt"
-SUITE_EXE_NAMES = {
-    "interpreter": "Interpreter",
-    "prettyprinter": "PrettyPrinter",
-}
-
-SUITE_ENTRY_POINTS = {
-    "interpreter": "Interpreter.agda",
-    "prettyprinter": "PrettyPrinter.agda",
-}
-
-SUITE_ROOTS = {
-    "interpreter": "Tests/Interpreter",
-    "prettyprinter": "Tests/PrettyPrinter",
-}
-
-class TestResultStatus(enum.Enum):
-    CLI_ERROR = 0
-    EXE_ERROR = 1
-    DIFF_ERROR = 2
-    SUCCESS = 3
-    WROTE_NEW = 4
-
-class DiffFailure:
-    def __init__(self, expected, actual):
-        self.expected = expected
-        self.actual = actual
-    
-    def diff_text(self):
-        diff_generator = difflib.context_diff(self.expected.splitlines(), self.actual.splitlines(), fromfile="expected", tofile="actual", n=3)
-        return "".join(diff_generator)
-    
-    def diff_html(self):
-        differ = difflib.HtmlDiff(tabsize=4)
-        return differ.make_file(self.expected.splitlines(), self.actual.splitlines(), fromdesc="Expected", todesc="Actual", context=True, numlines=5)
-
-class TestCaseResult:
-    def __init__(self, suite, case, status, details):
-        self.suite = suite
-        self.case = case
-        self.status = status
-        self.details = details
-    
-    def did_pass(self):
-        return self.status == TestResultStatus.SUCCESS or self.status == TestResultStatus.WROTE_NEW
-    
-    def to_string(self):
-        prefix = f"[{self.suite}/{self.case}]: "
-        if self.status == TestResultStatus.CLI_ERROR:
-            return f"{prefix}CLI ERROR: {self.details}"
-        elif self.status == TestResultStatus.EXE_ERROR:
-            return f"{prefix}EXE ERROR: {self.details}"
-        elif self.status == TestResultStatus.DIFF_ERROR:
-            text_diff = self.details.diff_text()
-            return f"{prefix}FAILED:\n{text_diff}"
-        elif self.status == TestResultStatus.SUCCESS:
-            return f"{prefix}SUCCEEDED"
-        elif self.status == TestResultStatus.WROTE_NEW:
-            return f"{prefix}WROTE NEW RESULT"
-    
-    def write_artifact(self, artifact_root):
-        if self.status != TestResultStatus.DIFF_ERROR:
-            return
-
-        filename = f"{self.suite}-{self.case}.out.html"
-        path = os.path.join(artifact_root, filename)
-        html = self.details.diff_html()
-        with open(path, "w") as file:
-            file.write(html)
-
-parser = argparse.ArgumentParser(description="Runs prototype test cases")
-parser.add_argument("--luau-cli", "-l", dest="cli_location", required=True, help="The location of luau-cli")
-parser.add_argument("--root", "-r", dest="prototype_root", required=False, default=os.getcwd(), help="The root of the prototype")
-parser.add_argument("--build", "-b", dest="build", action="store_true", default=True, help="Whether to automatically build required test binaries")
-parser.add_argument("--suite", "-s", dest="suites", action="append", default=[], choices=SUITES, help="Which test suites to run")
-parser.add_argument("--case", "-c", dest="cases", action="append", default=[], help="Which test cases to run")
-parser.add_argument("--accept-new-output", "-a", dest="snapshot", action="store_true", default=False, help="Whether to write the new output to files, instead of diffing against it")
-parser.add_argument("--write-diff-failures", dest="write_diffs", action="store_true", default=False, help="Whether to write test failure diffs to files")
-parser.add_argument("--diff-failure-location", dest="diff_location", default=None, help="Where to write diff failure files to")
-
-def build_suite(root, suite):
-    entry_point = SUITE_ENTRY_POINTS.get(suite)
-    if entry_point is None:
-        return (False, "Invalid suite")
-    
-    result = subprocess.run(["~/.cabal/bin/agda", "--compile", entry_point], shell=True, cwd=root, stdout=subprocess.PIPE, stderr=subprocess.STDOUT)
-    if result.returncode == 0:
-        return (True, None)
-    else:
-        return (False, result.stdout)
-
-def run_test(in_path, out_path, cli_path, exe_path, snapshot):
-    cli_result = subprocess.run([cli_path, in_path], capture_output=True)
-    if cli_result.returncode != 0:
-        return (TestResultStatus.CLI_ERROR, f"CLI error: {cli_result.stderr}")
-    
-    exe_result = subprocess.run(exe_path, input=cli_result.stdout, capture_output=True)
-    if exe_result.returncode != 0:
-        return (TestResultStatus.EXE_ERROR, f"Executable error; stdout:{exe_result.stdout}\n\nstderr: {exe_result.stderr}")
-    actual_result = exe_result.stdout.decode("utf-8")
-
-    if snapshot:
-        with open(out_path, "w") as out_file:
-            out_file.write(actual_result)
-            return (TestResultStatus.WROTE_NEW, None)
-    else:
-        with open(out_path, "r") as out_file:
-            expected_result = out_file.read()
-
-            if expected_result != actual_result:
-                return (TestResultStatus.DIFF_ERROR, DiffFailure(expected_result, actual_result))
-    
-    return (TestResultStatus.SUCCESS, None)
-
-def should_run_case(case_name, filters):
-    if len(filters) == 0:
-        return True
-
-    return any([f in case_name for f in filters])
-
-def run_test_suite(args, suite, suite_root, suite_exe):
-    results = []
-
-    for entry in os.listdir(suite_root):
-        if not should_run_case(entry, args.cases):
-            continue
-
-        case_path = os.path.join(suite_root, entry)
-        if os.path.isdir(case_path):
-            in_path = os.path.join(case_path, IN_FILE_NAME)
-            out_path = os.path.join(case_path, OUT_FILE_NAME)
-
-            if not os.path.exists(in_path) or not os.path.exists(out_path):
-                continue
-            
-            status, details = run_test(in_path, out_path, args.cli_location, suite_exe, args.snapshot)
-            result = TestCaseResult(suite, entry, status, details)
-            results.append(result)
-
-    return results
-
-def main():
-    args = parser.parse_args()
-
-    suites = args.suites if len(args.suites) > 0 else SUITES
-    root = os.path.abspath(args.prototype_root)
-
-    if args.build:
-        for suite in suites:
-            success, reason = build_suite(root, suite)
-
-            if not success:
-                print(f"Error building executable for test suite {suite}:\n{reason}")
-                sys.exit(1)
-            else:
-                print(f"Built executable for test suite {suite} successfully.")
-    
-    failed = False
-    for suite in suites:
-        suite_root = os.path.join(root, SUITE_ROOTS.get(suite))
-        suite_exe = os.path.join(root, SUITE_EXE_NAMES.get(suite))
-        print(f"Running test suite {suite}...")
-        results = run_test_suite(args, suite, suite_root, suite_exe)
-
-        passed = 0
-        total = len(results)
-
-        for result in results:
-            if result.did_pass():
-                passed += 1
-            else:
-                failed = True
-
-        print(f"Suite {suite} [{passed} / {total} passed]:")
-        for result in results:
-            print(result.to_string())
-
-            if args.write_diffs:
-                result.write_artifact(args.diff_location)
-    
-    if failed:
-        sys.exit(1)
-
-if __name__ == "__main__":
-    main()