├── .gitignore ├── src ├── linear.agda-lib └── linear │ ├── Relation │ ├── Nullary.agda │ └── Functional.agda │ ├── Utils.agda │ ├── Typing │ ├── Examples.agda │ ├── Consumption.agda │ ├── Extensional.agda │ ├── Mix.agda │ ├── Inversion.agda │ ├── Functional.agda │ ├── Substitution.agda │ └── Thinning.agda │ ├── Data │ └── ByteString.agda │ ├── RawIso.agda │ ├── Examples.agda │ ├── Language │ ├── Examples.agda │ └── SmartConstructors.agda │ ├── Typecheck │ ├── Examples.agda │ └── Problem.agda │ ├── Context │ ├── Mix.agda │ └── Pointwise.agda │ ├── Usage │ ├── Equality.agda │ ├── Mix.agda │ ├── Erasure.agda │ ├── Functional.agda │ ├── Pointwise.agda │ └── Consumption.agda │ ├── input.lin │ ├── README.agda │ ├── Main.agda │ ├── Context.agda │ ├── Scope.agda │ ├── ILL.agda │ ├── Soundness.agda │ ├── Type │ └── Parser.hs │ ├── Language.agda │ ├── Surface │ ├── Parser.hs │ └── Surface.agda │ ├── Mix.agda │ ├── Type.agda │ ├── Typing.agda │ ├── Model.agda │ ├── Usage.agda │ ├── Completeness.agda │ └── Typecheck.agda ├── travis ├── libraries-2.5.3 └── install_agda.sh ├── doc ├── cc-by.pdf ├── lipics-logo-bw.pdf ├── Makefile ├── types17-abstract │ ├── Makefile │ ├── subst.sed │ ├── main.bib │ └── types17.tex ├── types17-slides │ ├── Makefile │ ├── subst.sed │ └── types17.tex ├── typing-identity.tex ├── typing-rules-pattern.tex ├── typing-rules-var.tex ├── typing-rules.tex ├── typing-rules-infer.tex ├── typing-rules-check.tex ├── ill.tex ├── main.tex ├── commands.tex ├── typing-swap.tex └── main.bib ├── TODO ├── README.md └── .travis.yml /.gitignore: -------------------------------------------------------------------------------- 1 | *.agdai 2 | *.o 3 | *.hi 4 | *~ 5 | -------------------------------------------------------------------------------- /src/linear.agda-lib: -------------------------------------------------------------------------------- 1 | name: linear 2 | depend: standard-library 3 | include: . 4 | -------------------------------------------------------------------------------- /travis/libraries-2.5.3: -------------------------------------------------------------------------------- 1 | $HOME/.agda/agda-stdlib-0.15/standard-library.agda-lib 2 | -------------------------------------------------------------------------------- /doc/cc-by.pdf: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/gallais/typing-with-leftovers/HEAD/doc/cc-by.pdf -------------------------------------------------------------------------------- /doc/lipics-logo-bw.pdf: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/gallais/typing-with-leftovers/HEAD/doc/lipics-logo-bw.pdf -------------------------------------------------------------------------------- /TODO: -------------------------------------------------------------------------------- 1 | * study properties of `(1 + 1) (neg involutive, etc.) 2 | * add support for a v b when a <= neg b (cf. effect algebra) 3 | * managing resources during proof search references 4 | * pretty print of derivations 5 | -------------------------------------------------------------------------------- /doc/Makefile: -------------------------------------------------------------------------------- 1 | all: 2 | mkdir -p __build/ 3 | rm -f main.pdf 4 | cp *.tex *.sty *.pdf *.bib *.cls __build/ 5 | cd __build && latexmk -bibtex -pdf main.tex 6 | ln -sf __build/main.pdf 7 | 8 | clean: 9 | rm -rf __build/ main.pdf 10 | -------------------------------------------------------------------------------- /doc/types17-abstract/Makefile: -------------------------------------------------------------------------------- 1 | paper: 2 | mkdir -p __build/ 3 | cp *.tex *.bib *.cls *.sed __build/ 4 | cd __build/ && sed -i -f subst.sed types17.tex && latexmk -bibtex -pdf types17.tex 5 | ln -sf __build/types17.pdf 6 | xdotool search --class mupdf key --window %@ r > /dev/null 2>&1 7 | 8 | clean: 9 | rm -rf __build/ 10 | -------------------------------------------------------------------------------- /src/linear/Relation/Nullary.agda: -------------------------------------------------------------------------------- 1 | module linear.Relation.Nullary where 2 | 3 | open import Data.Bool 4 | open import Relation.Nullary 5 | 6 | isYes : ∀ {ℓ} {P : Set ℓ} → Dec P → Bool 7 | isYes (yes _) = true 8 | isYes (no _) = false 9 | 10 | fromYes : ∀ {ℓ} {P : Set ℓ} (d : Dec P) {_ : T (isYes d)} → P 11 | fromYes (yes p) = p 12 | fromYes (no ¬p) {()} 13 | -------------------------------------------------------------------------------- /src/linear/Utils.agda: -------------------------------------------------------------------------------- 1 | module linear.Utils where 2 | 3 | open import Level 4 | open import Data.List 5 | open import Data.Vec 6 | open import Relation.Binary.PropositionalEquality 7 | 8 | toList∘fromList : {ℓ : Level} {A : Set ℓ} (xs : List A) → toList (fromList xs) ≡ xs 9 | toList∘fromList [] = refl 10 | toList∘fromList (x ∷ xs) = cong (x ∷_) (toList∘fromList xs) 11 | 12 | -------------------------------------------------------------------------------- /doc/types17-slides/Makefile: -------------------------------------------------------------------------------- 1 | SLIDES=types17 2 | 3 | all: 4 | mkdir -p __build 5 | cp *.tex *.sed __build/ 6 | cd __build/ \ 7 | && sed -f subst.sed -i ${SLIDES}.tex \ 8 | && latexmk -shell-escape -pdf -e '$$pdflatex=q/xelatex %O %S/' ${SLIDES}.tex 9 | ln -sf __build/${SLIDES}.pdf 10 | xdotool search --class mupdf key --window %@ r > /dev/null 2>&1 11 | 12 | clean: 13 | rm -rf __build/ ${SLIDES}.pdf 14 | -------------------------------------------------------------------------------- /travis/install_agda.sh: -------------------------------------------------------------------------------- 1 | #!/bin/sh 2 | if ! type "agda" > /dev/null || [ ! `agda -V | sed "s/[^2]*//"` = "2.5.3" ]; then 3 | cabal update 4 | cabal install alex happy cpphs 5 | cabal install Agda-2.5.3 6 | mkdir -p $HOME/.agda 7 | cp libraries-2.5.3 $HOME/.agda/ 8 | cd $HOME/.agda/ 9 | wget https://github.com/agda/agda-stdlib/archive/v0.15.tar.gz 10 | tar -xvzf v0.15.tar.gz 11 | cd - 12 | fi 13 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | Typing with Leftovers - A Mechanization of Intuitionistic Linear Logic 2 | ======== 3 | 4 | ![build status](https://travis-ci.org/gallais/typing-with-leftovers.svg) 5 | 6 | ## Compilation 7 | 8 | The development has been typechecked with: 9 | 10 | * [Agda version 2.5.3](http://hackage.haskell.org/package/Agda-2.5.1) 11 | * The [Standard Library version 0.15](https://github.com/agda/agda-stdlib/archive/v0.12.tar.gz) 12 | -------------------------------------------------------------------------------- /doc/types17-abstract/subst.sed: -------------------------------------------------------------------------------- 1 | s/Γ/\\Gamma{}/g 2 | s/Δ/\\Delta{}/g 3 | s/Θ/\\Theta{}/g 4 | s/α/\\alpha{}/g 5 | s/γ/\\gamma{}/g 6 | s/σ/\\sigma{}/g 7 | s/τ/\\tau{}/g 8 | s/λ/\\lambda{}/g 9 | 10 | s/⊢/\\vdash{}/g 11 | s/∋/\\ni{}/g 12 | s/∈/\\in{}/g 13 | s/⊠/\\boxtimes{}/g 14 | s/⊗/\\otimes{}/g 15 | s/⊕/\\oplus{}/g 16 | s/⊸/\\multimap{}/g 17 | s/≈/\\approx{}/g 18 | s/∙/\\cdot{}/g 19 | 20 | s/ℕ/\\mathbb{N}/g 21 | s/𝟘/\\mathbb{0}/g 22 | s/𝟙/\\mathbb{1}/g 23 | -------------------------------------------------------------------------------- /doc/types17-slides/subst.sed: -------------------------------------------------------------------------------- 1 | s/Γ/\\Gamma{}/g 2 | s/Δ/\\Delta{}/g 3 | s/Θ/\\Theta{}/g 4 | s/α/\\alpha{}/g 5 | s/γ/\\gamma{}/g 6 | s/σ/\\sigma{}/g 7 | s/τ/\\tau{}/g 8 | s/ν/\\nu{}/g 9 | s/λ/\\lambda{}/g 10 | 11 | s/⊢/\\vdash{}/g 12 | s/∋/\\ni{}/g 13 | s/∈/\\in{}/g 14 | s/⊠/\\boxtimes{}/g 15 | s/⊗/\\otimes{}/g 16 | s/⊕/\\oplus{}/g 17 | s/⊸/\\multimap{}/g 18 | s/≈/\\approx{}/g 19 | s/∙/\\cdot{}/g 20 | 21 | s/ℕ/\\mathbb{N}/g 22 | s/𝟘/\\mathbb{0}/g 23 | s/𝟙/\\mathbb{1}/g 24 | -------------------------------------------------------------------------------- /src/linear/Typing/Examples.agda: -------------------------------------------------------------------------------- 1 | module linear.Typing.Examples where 2 | 3 | open import linear.Type 4 | open import linear.Usage 5 | open import linear.Language.Examples 6 | open import linear.Typing 7 | 8 | identityTyped : {σ : Type} → [] ⊢ σ ─o σ ∋ identity ⊠ [] 9 | identityTyped = `lam (`neu `var z) 10 | 11 | swapTyped : {σ τ : Type} → [] ⊢ (σ ⊗ τ) ─o (τ ⊗ σ) ∋ swap ⊠ [] 12 | swapTyped = `lam (`let (`v ,, `v) ∷= `var z 13 | `in `prd⊗ (`neu `var (s z)) (`neu `var z)) 14 | -------------------------------------------------------------------------------- /doc/typing-identity.tex: -------------------------------------------------------------------------------- 1 | \begin{mathpar} 2 | \inferrule{\inferrule{\inferrule{\inferrule{ }{[] \ensuremath{\cdot} \fresh{α} ⊢ 0 \ensuremath{\in} \fresh{α} \andalso{} [] \ensuremath{\cdot} \stale{α}}}{[] \ensuremath{\cdot} \fresh{α} ⊢ \var{0} \ensuremath{\in} α \andalso{} [] \ensuremath{\cdot} \stale{α}}}{[] \ensuremath{\cdot} \fresh{α} ⊢ α \ensuremath{\ni} \neu{\var{0}} \andalso{} [] \ensuremath{\cdot} \stale{α}}}{[] ⊢ α \ensuremath{\multimap} α \ensuremath{\ni} \lam{\neu{\var{0}}} \andalso{} []} 3 | \end{mathpar} 4 | -------------------------------------------------------------------------------- /doc/typing-rules-pattern.tex: -------------------------------------------------------------------------------- 1 | \begin{figure}[H] 2 | \begin{mathpar} 3 | \inferrule{ }{\ensuremath{\sigma \ni \varpattern{} \leadsto{} [] \cdot \sigma}} 4 | \and \inferrule{ }{\Unit{} \ensuremath{\ni} \unitpattern{} \leadsto{} []} 5 | \and \inferrule{\ensuremath{\sigma \ni p \leadsto{} \gamma} \and \ensuremath{\tau \ni q \leadsto{} \delta} 6 | }{\ensuremath{\sigma \otimes \tau \ni \prdpattern{p}{q} \leadsto{} \append{\delta}{\gamma}} 7 | } 8 | \end{mathpar} 9 | \caption{Typing rules for \Pattern{}\label{figure:pattern}} 10 | \end{figure} 11 | -------------------------------------------------------------------------------- /src/linear/Data/ByteString.agda: -------------------------------------------------------------------------------- 1 | module linear.Data.ByteString where 2 | 3 | open import Data.String.Base 4 | open import IO.Primitive 5 | 6 | {-# FOREIGN GHC import qualified Data.ByteString #-} 7 | {-# FOREIGN GHC import qualified Data.Text #-} 8 | 9 | postulate 10 | RByteString : Set 11 | RreadFileBS : String → IO RByteString 12 | 13 | {-# COMPILE GHC RByteString = type Data.ByteString.ByteString #-} 14 | {-# COMPILE GHC RreadFileBS = Data.ByteString.readFile . Data.Text.unpack #-} 15 | 16 | ByteString = RByteString 17 | 18 | readFileBS : String → IO ByteString 19 | readFileBS = RreadFileBS 20 | -------------------------------------------------------------------------------- /src/linear/RawIso.agda: -------------------------------------------------------------------------------- 1 | module linear.RawIso where 2 | 3 | open import Function 4 | open import Data.Product 5 | open import Relation.Nullary 6 | 7 | record RawIso (A B : Set) : Set where 8 | constructor mkRawIso 9 | field 10 | push : A → B 11 | pull : B → A 12 | open RawIso public 13 | 14 | infixl 2 _<$>_ 15 | _<$>_ : {A B : Set} (f : RawIso A B) → Dec A → Dec B 16 | f <$> yes p = yes (push f p) 17 | f <$> no ¬p = no (¬p ∘ pull f) 18 | 19 | infixr 3 _<*>_ 20 | _<*>_ : {A B : Set} → Dec A → Dec B → Dec (A × B) 21 | yes a <*> yes b = yes (a , b) 22 | no ¬a <*> b = no (¬a ∘ proj₁) 23 | a <*> no ¬b = no (¬b ∘ proj₂) 24 | -------------------------------------------------------------------------------- /src/linear/Relation/Functional.agda: -------------------------------------------------------------------------------- 1 | module linear.Relation.Functional where 2 | 3 | open import Data.Unit 4 | open import Function 5 | open import Relation.Binary.PropositionalEquality 6 | 7 | Functional : 8 | {RI : Set} -- Relevant Input 9 | {II : RI → Set} -- Irelevant Input 10 | {O : RI → Set} -- Output 11 | (R : (ri : RI) → II ri → O ri → Set) → Set 12 | Functional {RI} {II} {O} R = 13 | (ri : RI) {ii₁ ii₂ : II ri} {o₁ o₂ : O ri} → 14 | R ri ii₁ o₁ → R ri ii₂ o₂ → o₁ ≡ o₂ 15 | 16 | Functional′ : {I : Set} {O : I → Set} (R : (i : I) → O i → Set) → Set 17 | Functional′ R = Functional {II = const ⊤} (λ ri _ o → R ri o) 18 | -------------------------------------------------------------------------------- /doc/typing-rules-var.tex: -------------------------------------------------------------------------------- 1 | \begin{figure}[H] 2 | \begin{mathpar} 3 | \inferrule 4 | { 5 | }{\ensuremath{\Gamma} \ensuremath{\cdot} \fresh{\ensuremath{\sigma}} \ensuremath{\vdash}_v \varzero \ensuremath{\in} \ensuremath{\sigma} \andalso{} \ensuremath{\Gamma} \ensuremath{\cdot} \stale{\ensuremath{\sigma}} 6 | } 7 | \and \inferrule 8 | {\ensuremath{\Gamma} \ensuremath{\vdash}_v k \ensuremath{\in} \ensuremath{\sigma} \andalso{} \ensuremath{\Delta} 9 | }{\ensuremath{\Gamma} \ensuremath{\cdot} A \ensuremath{\vdash}_v \varsucc{k} \ensuremath{\in} \ensuremath{\sigma} \andalso{} \ensuremath{\Delta} \ensuremath{\cdot} A 10 | } 11 | \end{mathpar} 12 | \caption{Typing rules for \Var{}\label{figure:deBruijn}} 13 | \end{figure} 14 | -------------------------------------------------------------------------------- /src/linear/Examples.agda: -------------------------------------------------------------------------------- 1 | module linear.Examples where 2 | 3 | open import Data.Nat 4 | open import Data.Fin 5 | 6 | open import linear.Type 7 | open import linear.Context 8 | open import linear.Usage hiding ([_]) 9 | open import linear.Language 10 | open import linear.Typing 11 | open import linear.Language.SmartConstructors 12 | 13 | ⊢swap⊗ : {σ τ : Type} → [] ⊢ (σ ⊗ τ) ─o (τ ⊗ σ) ∋ _ ⊠ [] 14 | ⊢swap⊗ = 15 | `lam `let (`v ,, `v) ∷= [ 0 ] `in 16 | `prd⊗ (`neu [ 1 ]) (`neu [ 0 ]) 17 | 18 | ⊗⊕-distr : (σ τ ν : Type) → [] ⊢ (σ ⊗ (τ ⊕ ν)) ─o (σ ⊗ τ) ⊕ (σ ⊗ ν) ∋ _ ⊠ [] 19 | ⊗⊕-distr σ τ ν = 20 | `lam `let (`v ,, `v) ∷= [ 0 ] `in 21 | `neu `case `var (s z) return (σ ⊗ τ) ⊕ (σ ⊗ ν) 22 | of `inl (`prd⊗ [ 1 ] [ 0 ]) 23 | %% `inr (`prd⊗ [ 1 ] [ 0 ]) 24 | -------------------------------------------------------------------------------- /src/linear/Language/Examples.agda: -------------------------------------------------------------------------------- 1 | module linear.Language.Examples where 2 | 3 | open import Data.Fin 4 | open import linear.Type 5 | open import linear.Language 6 | 7 | identity : Check 0 8 | identity = `lam (`neu (`var zero)) 9 | 10 | swap : Check 0 11 | swap = `lam `let (`v ,, `v) ∷= `var zero 12 | `in `prd (`neu `var (suc zero)) (`neu `var zero) 13 | 14 | illTyped : Check 0 15 | illTyped = `let (`v ,, `v) ∷= `cut (`inl (`lam (`neu (`var zero)))) ((κ 0 ─o κ 0) ⊕ κ 1) 16 | `in `prd (`neu (`var zero)) (`neu (`var (suc zero))) 17 | 18 | diag : Check 0 19 | diag = `lam (`prd (`neu (`var zero)) (`neu (`var zero))) 20 | 21 | omega : Infer 0 22 | omega = let delta = `lam (`neu (`app (`var zero) (`neu (`var zero)))) 23 | in `app (`cut delta (κ 0)) delta 24 | -------------------------------------------------------------------------------- /src/linear/Typecheck/Examples.agda: -------------------------------------------------------------------------------- 1 | module linear.Typecheck.Examples where 2 | 3 | open import linear.Type 4 | open import linear.Language 5 | open import linear.Language.Examples 6 | open import linear.Usage 7 | open import linear.Typing 8 | open import linear.Typing.Examples 9 | open import linear.Typecheck 10 | open import linear.Typecheck.Problem 11 | 12 | open import Relation.Nullary 13 | open import Relation.Binary.PropositionalEquality 14 | 15 | swapChecked : {σ τ : Type} → check [] ((σ ⊗ τ) ─o (τ ⊗ σ)) swap ≡ yes ([] , swapTyped) 16 | swapChecked {σ} {τ} rewrite eq-diag τ | eq-diag σ = refl 17 | 18 | 19 | identityInfer : {σ : Type} → --let σ = κ 0 ⊗ κ 1 in 20 | infer [] (`cut identity (σ ─o σ)) ≡ yes (σ ─o σ , [] , `cut identityTyped) 21 | identityInfer {σ} rewrite eq-diag σ = refl 22 | -------------------------------------------------------------------------------- /src/linear/Context/Mix.agda: -------------------------------------------------------------------------------- 1 | module linear.Context.Mix where 2 | 3 | open import Data.Vec as V hiding (_∷ʳ_ ; fromList) 4 | open import linear.Context 5 | import linear.Usage.Erasure as UE 6 | 7 | data _++_≅_ : ∀ {m n p} → Context m → Context n → Context p → Set where 8 | [] : [] ++ [] ≅ [] 9 | _∷ˡ_ : ∀ {m n p} {γ : Context m} {δ : Context n} {θ : Context p} 10 | σ → γ ++ δ ≅ θ → (σ ∷ γ) ++ δ ≅ (σ ∷ θ) 11 | _∷ʳ_ : ∀ {m n p} {γ : Context m} {δ : Context n} {θ : Context p} 12 | σ → γ ++ δ ≅ θ → γ ++ (σ ∷ δ) ≅ (σ ∷ θ) 13 | 14 | infix 2 _++_≅_ 15 | _++ˡ_ : ∀ {m n p} {γ : Context m} {δ : Context n} {θ : Context p} 16 | {o} (φ : Context o) → γ ++ δ ≅ θ → φ V.++ γ ++ δ ≅ φ V.++ θ 17 | [] ++ˡ p = p 18 | (σ ∷ φ) ++ˡ p = σ ∷ˡ (φ ++ˡ p) 19 | 20 | fromList : ∀ {γ δ θ} → γ UE.++ δ ≅ θ → V.fromList γ ++ V.fromList δ ≅ V.fromList θ 21 | fromList UE.[] = [] 22 | fromList (σ UE.∷ˡ p) = σ ∷ˡ fromList p 23 | fromList (σ UE.∷ʳ p) = σ ∷ʳ fromList p 24 | -------------------------------------------------------------------------------- /src/linear/Usage/Equality.agda: -------------------------------------------------------------------------------- 1 | module linear.Usage.Equality where 2 | 3 | open import Data.Nat 4 | open import Data.Vec 5 | open import Data.Product 6 | open import Function 7 | open import Relation.Nullary 8 | open import Relation.Binary.PropositionalEquality 9 | 10 | open import linear.Type hiding (eq) 11 | open import linear.Context 12 | open import linear.Usage 13 | open import linear.RawIso 14 | 15 | eq : {a : Type} (A B : Usage a) → Dec (A ≡ B) 16 | eq [ a ] [ .a ] = yes refl 17 | eq ] a [ ] .a [ = yes refl 18 | eq [ a ] ] .a [ = no (λ ()) 19 | eq ] a [ [ .a ] = no (λ ()) 20 | 21 | RawIso-∷ : {n : ℕ} {γ : Context n} {Γ Δ : Usages γ} {a : Type} {A B : Usage a} → 22 | RawIso (A ≡ B × Γ ≡ Δ) ((Usages (a ∷ γ) ∋ A ∷ Γ) ≡ B ∷ Δ) 23 | push RawIso-∷ (refl , refl) = refl 24 | pull RawIso-∷ refl = refl , refl 25 | 26 | eqs : {n : ℕ} {γ : Context n} (Γ Δ : Usages γ) → Dec (Γ ≡ Δ) 27 | eqs [] [] = yes refl 28 | eqs (A ∷ Γ) (B ∷ Δ) = RawIso-∷ <$> eq A B <*> eqs Γ Δ 29 | -------------------------------------------------------------------------------- /src/linear/input.lin: -------------------------------------------------------------------------------- 1 | ('a * 'b) -o ('b * 'a) : \ pair. let (left , right) = pair 2 | in (right , left) 3 | 4 | ('a + 'b) -o ('b + 'a) : \ sum. case sum return 'b + 'a 5 | of left -> inr left 6 | | right -> inl right 7 | 8 | ('a -o 'b) -o 'a -o 'b : \ fun. \ arg. fun arg 9 | 10 | ('a + 'a) -o 'a : \ sum. case sum return 'a 11 | of left -> (\ x. x : 'a -o 'a) left 12 | | right -> right 13 | 14 | ('a & 'b) -o ('b & 'a) : \ pair. (snd pair, fst pair) 15 | 16 | 0 -o 'b : \x. exfalso 'b x 17 | 18 | (0 * 'a) -o 0 : \ pair. let (left, right) = pair 19 | in exfalso ('a -o 0) left right 20 | 21 | (0 + 'a) -o 'a : \ sum. case sum return 'a 22 | of left -> exfalso 'a left 23 | | right -> right 24 | 25 | (('b -o 'c) -o ('a -o 'b) -o ('a -o 'c)) : \ g. \ f. \ x. g (f x) 26 | 27 | ('a -o 'b -o 'c) -o ('b -o 'a -o 'c) : \ f. \ b. \ a. f a b 28 | -------------------------------------------------------------------------------- /.travis.yml: -------------------------------------------------------------------------------- 1 | language: C 2 | sudo: false 3 | 4 | branches: 5 | only: 6 | - master 7 | 8 | addons: 9 | apt: 10 | packages: 11 | - cabal-install-2.0 12 | - ghc-8.2.2 13 | sources: 14 | - hvr-ghc 15 | 16 | cache: 17 | directories: 18 | - $HOME/.cabal/ 19 | - $HOME/.ghc/ 20 | - $HOME/.agda/ 21 | 22 | install: 23 | - export PATH=$HOME/.cabal/bin:/opt/ghc/8.2.2/bin:/opt/cabal/2.0/bin:$PATH 24 | - cd travis/ 25 | - travis_wait 50 ./install_agda.sh 26 | 27 | script: 28 | - cd ../src/ 29 | - agda --html linear/README.agda 30 | - cd ../ 31 | - mv src/html/* . 32 | 33 | after_success: 34 | # uploading to gh-pages 35 | - git init 36 | - git config --global user.name "Travis CI bot" 37 | - git config --global user.email "travis-ci-bot@travis.fake" 38 | - git remote add upstream https://$GH_TOKEN@github.com/gallais/typing-with-leftovers.git &>/dev/null 39 | - git fetch upstream && git reset upstream/gh-pages 40 | - git add -f \*.html \*.css 41 | - git commit -m "Automatic HTML update via Travis" 42 | - git push -q upstream HEAD:gh-pages &>/dev/null; 43 | -------------------------------------------------------------------------------- /src/linear/Language/SmartConstructors.agda: -------------------------------------------------------------------------------- 1 | module linear.Language.SmartConstructors where 2 | 3 | open import Data.Bool 4 | open import Data.Nat as ℕ 5 | open import Data.Fin 6 | open import Data.Vec hiding ([_]) 7 | open import linear.Type 8 | open import linear.Context 9 | open import linear.Usage as U hiding ([_]) 10 | open import linear.Language as L 11 | open import linear.Typing as T 12 | open import linear.Typecheck 13 | open import linear.Typecheck.Problem 14 | open import Relation.Nullary 15 | open import linear.Relation.Nullary 16 | open import Function 17 | 18 | record VAR (T : ℕ → Set) (𝓣 : Typing T) : Set where 19 | field 20 | mkVarT : ∀ {n} → Fin n → T n 21 | mkVar𝓣 : ∀ {n γ} {Γ : Usages γ} {σ} {k : Fin n} {Δ} → 22 | Γ ⊢ k ∈[ σ ]⊠ Δ → 𝓣 Γ (mkVarT k) σ Δ 23 | open VAR {{...}} public 24 | 25 | [_] : ∀ {n} k {pr : T (isYes (suc k ℕ.≤? n))} {γ : Context n} {Γ : Usages γ} → 26 | let k′ = fromℕ≤ (fromYes _ {pr}) in 27 | {pr′ : T (isYes (consume Γ k′))} → 28 | let (σ , Δ , _) = fromYes _ {pr′} 29 | in ∀ {T} {𝓣 : Typing T} {{V : VAR T 𝓣}} → 𝓣 Γ (mkVarT {{V}} k′) σ Δ 30 | [ k ] {pr′ = pr′} {{V}} = mkVar𝓣 {{V}} $ CONSUME.proof $ fromYes _ {pr′} 31 | 32 | 33 | instance 34 | 35 | VARFin : VAR Fin TFin 36 | VAR.mkVarT VARFin = id 37 | VAR.mkVar𝓣 VARFin = id 38 | 39 | VARInfer : VAR Infer TInfer 40 | VAR.mkVarT VARInfer = `var_ 41 | VAR.mkVar𝓣 VARInfer = `var_ 42 | 43 | VARCheck : VAR Check TCheck 44 | VAR.mkVarT VARCheck k = `neu `var k 45 | VAR.mkVar𝓣 VARCheck K = `neu `var K 46 | -------------------------------------------------------------------------------- /src/linear/README.agda: -------------------------------------------------------------------------------- 1 | module linear.README where 2 | 3 | -- Raw terms 4 | open import linear.Scope 5 | open import linear.Language 6 | 7 | -- Types, typing Contexts and Usage annotations 8 | open import linear.Type 9 | open import linear.Context 10 | open import linear.Usage 11 | 12 | -- Typing relation and basic properties 13 | open import linear.Typing 14 | open import linear.Typing.Inversion 15 | open import linear.Typing.Functional 16 | 17 | -- Frame rule and stability of Typing under Weakening and Substitution 18 | open import linear.Typing.Consumption 19 | open import linear.Typing.Substitution 20 | 21 | -- Decidability of Typing inference / checking 22 | open import linear.Typecheck.Problem 23 | open import linear.Typecheck 24 | 25 | -- Thinning 26 | open import linear.Usage.Erasure 27 | open import linear.Typing.Thinning 28 | 29 | -- More traditional presentation and Model 30 | open import linear.ILL 31 | open import linear.Model 32 | 33 | -- Mix aka context permutations (needed for completeness) 34 | open import linear.Mix 35 | open import linear.Context.Mix 36 | open import linear.Usage.Mix 37 | open import linear.Typing.Mix 38 | 39 | -- Soundness and Completeness 40 | open import linear.Soundness 41 | open import linear.Completeness 42 | 43 | -- Examples 44 | open import linear.Language.Examples 45 | open import linear.Typing.Examples 46 | open import linear.Typecheck.Examples 47 | 48 | -- A surface language with named variables (using String) 49 | open import linear.Surface.Surface 50 | 51 | -- An executable combining our scope and type checkers with a 52 | -- parser written in Haskell 53 | -- (cf. linear/Type/Parser.hs and linear/Surface/Parser.hs) 54 | open import linear.Main 55 | -------------------------------------------------------------------------------- /src/linear/Main.agda: -------------------------------------------------------------------------------- 1 | module linear.Main where 2 | 3 | open import Level 4 | open import linear.Surface.Surface 5 | open import linear.Data.ByteString 6 | open import Data.String 7 | open import Data.List as List hiding (_++_) 8 | open import Function 9 | open import Coinduction 10 | open import IO 11 | 12 | open import Data.Maybe as Maybe 13 | open import linear.Type 14 | 15 | data Pair {ℓ₁ ℓ₂} (A : Set ℓ₁) (B : Set ℓ₂) : Set (ℓ₁ ⊔ ℓ₂) where 16 | _,_ : A → B → Pair A B 17 | {-# FOREIGN GHC type AgdaPair l1 l2 a b = (a,b) #-} 18 | {-# COMPILE GHC Pair = data MAlonzo.Code.Qlinear.Main.AgdaPair ((,)) #-} 19 | 20 | Pairmap : ∀ {a b c d} {A : Set a} {B : Set b} {C : Set c} {D : Set d} → 21 | (A → C) → (B → D) → Pair A B → Pair C D 22 | Pairmap f g (a , b) = f a , g b 23 | 24 | uncurry : ∀ {ℓ₁ ℓ₂ ℓ₃} {A : Set ℓ₁} {B : Set ℓ₂} {C : Set ℓ₃} → 25 | (A → B → C) → (Pair A B → C) 26 | uncurry f (a , b) = f a b 27 | 28 | postulate 29 | RparseProblems : RByteString → Maybe (List (Pair RType RCheck)) 30 | 31 | {-# FOREIGN GHC import qualified Data.ByteString #-} 32 | {-# FOREIGN GHC import qualified Type.Parser #-} 33 | {-# FOREIGN GHC import qualified Surface.Parser #-} 34 | {-# COMPILE GHC RparseProblems = Surface.Parser.parseProblems #-} 35 | 36 | parseProblems : ByteString → Maybe (List (Pair Type Check)) 37 | parseProblems bs = Maybe.map (List.map (Pairmap embed^RType embed^RCheck)) $ RparseProblems bs 38 | 39 | infixr 5 _¡[_]_ 40 | _¡[_]_ : ∀ {ℓ} {A : Set ℓ} → Maybe A → String → (A → _) → _ 41 | ma ¡[ str ] f = maybe f (♯ putStrLn ("Fail: " ++ str)) ma 42 | 43 | main = 44 | run $ ♯ lift (readFileBS "input.lin") >>= λ bs → 45 | parseProblems bs ¡[ "parse" ] foldr (uncurry λ σ c io → 46 | ♯ ((linear σ c ¡[ "check" ] λ _ → ♯ putStrLn "Success") >> io)) (♯ return _) 47 | -------------------------------------------------------------------------------- /doc/typing-rules.tex: -------------------------------------------------------------------------------- 1 | \begin{figure}[H] 2 | \begin{mathpar} 3 | \type[\Var{}] 4 | {{\begin{array}{l} 5 | \ensuremath{\gamma} : \Context{n} \\ 6 | \ensuremath{\Gamma} : \Usages{\ensuremath{\gamma}} \\ \\ 7 | \end{array}} 8 | \and k : \Var{n} 9 | \and {\begin{array}{l} 10 | \ensuremath{\sigma} : \Type{} \\ 11 | \ensuremath{\Delta} : \Usages{\ensuremath{\gamma}} \\ \\ 12 | \end{array}} 13 | }{\ensuremath{\Gamma} \ensuremath{\vdash}_v k \ensuremath{\in} \ensuremath{\sigma} \andalso{} \ensuremath{\Delta} : \Set{} 14 | } 15 | \and \type[\Inferable{}] 16 | {{\begin{array}{l} 17 | \ensuremath{\gamma} : \Context{n} \\ 18 | \ensuremath{\Gamma} : \Usages{\ensuremath{\gamma}} \\ \\ 19 | \end{array}} 20 | \and t : \Inferable{n} 21 | \and {\begin{array}{l} 22 | \ensuremath{\sigma} : \Type{} \\ 23 | \ensuremath{\Delta} : \Usages{\ensuremath{\gamma}} \\ \\ 24 | \end{array}} 25 | }{\ensuremath{\Gamma} \ensuremath{\vdash} t \ensuremath{\in} \ensuremath{\sigma} \andalso{} \ensuremath{\Delta} : \Set{} 26 | } 27 | \and \type[\Checkable{}] 28 | {{\begin{array}{l} 29 | \ensuremath{\gamma} : \Context{n} \\ 30 | \ensuremath{\Gamma} : \Usages{\ensuremath{\gamma}} \\ 31 | \ensuremath{\sigma} : \Type{} \\ \\ 32 | \end{array}} 33 | \and t : \Checkable{n} 34 | \and \ensuremath{\Delta} : \Usages{\ensuremath{\gamma}} 35 | }{\ensuremath{\Gamma} \ensuremath{\vdash} \ensuremath{\sigma} \ensuremath{\ni} t \andalso{} \ensuremath{\Delta} : \Set{} 36 | } 37 | \and \type[\Pattern{}] 38 | { \ensuremath{\sigma} : \Type{} 39 | \and p : \Pattern{n} 40 | \and \ensuremath{\gamma} : \Context{n} 41 | }{\ensuremath{\sigma} \ensuremath{\ni} p \leadsto{} \ensuremath{\gamma} : \Set{} 42 | } 43 | \end{mathpar} 44 | \caption{Typing relations for \Var{}, \Inferable{}, \Checkable{} and \Pattern{}} 45 | \end{figure} 46 | -------------------------------------------------------------------------------- /src/linear/Context.agda: -------------------------------------------------------------------------------- 1 | module linear.Context where 2 | 3 | open import Function 4 | open import Data.Nat as ℕ 5 | open import Data.Fin 6 | open import Data.Vec as V hiding (_++_) 7 | 8 | open import linear.Type 9 | open import linear.Scope as Sc hiding (Mergey ; copys ; inserts) 10 | open import Relation.Binary.PropositionalEquality 11 | 12 | Context : ℕ → Set 13 | Context = Vec Type 14 | 15 | _++_ = V._++_ 16 | 17 | -- Induction principle 18 | induction : 19 | (P : {n : ℕ} → Context n → Set) 20 | (pε : P []) 21 | (p∷ : {n : ℕ} (a : Type) (Γ : Context n) → P Γ → P (a ∷ Γ)) → 22 | {n : ℕ} (Γ : Context n) → P Γ 23 | induction P pε p∷ [] = pε 24 | induction P pε p∷ (a ∷ Γ) = p∷ a Γ (induction P pε p∷ Γ) 25 | 26 | data Mergey : {k l : ℕ} (m : Sc.Mergey k l) → Set where 27 | finish : {k : ℕ} → Mergey (finish {k}) 28 | copy : {k l : ℕ} {m : Sc.Mergey k l} → Mergey m → Mergey (copy m) 29 | insert : {k l : ℕ} {m : Sc.Mergey k l} → Type → Mergey m → Mergey (insert m) 30 | 31 | copys : (o : ℕ) {k l : ℕ} {m : Sc.Mergey k l} (M : Mergey m) → Mergey (Sc.copys o m) 32 | copys zero M = M 33 | copys (suc o) M = copy (copys o M) 34 | 35 | inserts : {o k l : ℕ} (O : Context o) {m : Sc.Mergey k l} → 36 | Mergey m → Mergey (Sc.inserts o m) 37 | inserts [] M = M 38 | inserts (σ ∷ O) M = insert σ (inserts O M) 39 | 40 | infixl 4 _⋈_ 41 | _⋈_ : {k l : ℕ} (Γ : Context k) {m : Sc.Mergey k l} (M : Mergey m) → Context l 42 | Γ ⋈ finish = Γ 43 | a ∷ Γ ⋈ copy M = a ∷ (Γ ⋈ M) 44 | Γ ⋈ insert a M = a ∷ (Γ ⋈ M) 45 | 46 | ++copys-elim : {k l o : ℕ} {m : Sc.Mergey k l} (P : Context (o ℕ.+ l) → Set) 47 | (δ : Context o) (γ : Context k) (M : Mergey m) → 48 | P ((δ ++ γ) ⋈ copys o M) → P (δ ++ (γ ⋈ M)) 49 | ++copys-elim P [] γ M p = p 50 | ++copys-elim P (a ∷ δ) γ M p = ++copys-elim (P ∘ (a ∷_)) δ γ M p 51 | -------------------------------------------------------------------------------- /src/linear/Scope.agda: -------------------------------------------------------------------------------- 1 | module linear.Scope where 2 | 3 | open import Data.Nat 4 | open import Data.Fin hiding (_+_) 5 | open import Function 6 | 7 | data Mergey : (k l : ℕ) → Set where 8 | finish : {k : ℕ} → Mergey k k 9 | copy : {k l : ℕ} → Mergey k l → Mergey (suc k) (suc l) 10 | insert : {k l : ℕ} → Mergey k l → Mergey k (suc l) 11 | 12 | Weakening : (T : ℕ → Set) → Set 13 | Weakening T = {k l : ℕ} (m : Mergey k l) → T k → T l 14 | 15 | Extending : (T : ℕ → ℕ → Set) → Set 16 | Extending T = {k l : ℕ} (o : ℕ) → T k l → T (o + k) (o + l) 17 | 18 | copys : Extending Mergey 19 | copys zero m = m 20 | copys (suc o) m = copy (copys o m) 21 | 22 | inserts : {k l : ℕ} (o : ℕ) → Mergey k l → Mergey k (o + l) 23 | inserts zero m = m 24 | inserts (suc o) m = insert (inserts o m) 25 | 26 | weakFin : Weakening Fin 27 | weakFin finish k = k 28 | weakFin (copy m) zero = zero 29 | weakFin (copy m) (suc k) = suc (weakFin m k) 30 | weakFin (insert m) k = suc (weakFin m k) 31 | 32 | data Env (T : ℕ → Set) : (k l : ℕ) → Set where 33 | [] : {l : ℕ} → Env T 0 l 34 | v∷_ : {k l : ℕ} → Env T k l → Env T (suc k) (suc l) 35 | _∷_ : {k l : ℕ} (t : T l) (ρ : Env T k l) → Env T (suc k) l 36 | 37 | Substituting : (E T : ℕ → Set) → Set 38 | Substituting E T = {k l : ℕ} (ρ : Env E k l) → T k → T l 39 | 40 | record Freshey (T : ℕ → Set) : Set where 41 | field 42 | fresh : {k : ℕ} → T (suc k) 43 | weak : Weakening T 44 | 45 | substFin : {k l : ℕ} {T : ℕ → Set} (F : Freshey T) (ρ : Env T k l) → Fin k → T l 46 | substFin F (v∷ ρ) zero = Freshey.fresh F 47 | substFin F (t ∷ ρ) zero = t 48 | substFin F (v∷ ρ) (suc v) = Freshey.weak F (insert finish) $ substFin F ρ v 49 | substFin F (t ∷ ρ) (suc v) = substFin F ρ v 50 | 51 | withFreshVars : {T : ℕ → Set} → Extending (Env T) 52 | withFreshVars zero ρ = ρ 53 | withFreshVars (suc o) ρ = v∷ withFreshVars o ρ 54 | -------------------------------------------------------------------------------- /src/linear/ILL.agda: -------------------------------------------------------------------------------- 1 | module linear.ILL where 2 | 3 | open import Data.List hiding (_∷ʳ_) 4 | open import Data.List.Properties 5 | open import linear.Type 6 | open import linear.Usage.Erasure 7 | open import Function 8 | open import Algebra 9 | import Relation.Binary.PropositionalEquality as PEq 10 | 11 | -- This presentation of ILL is taken from: 12 | -- http://llwiki.ens-lyon.fr/mediawiki/index.php/Intuitionistic_linear_logic 13 | -- except for the `mix` constructor allowing the user to reorganise the 14 | -- context (on the llwiki, the context is a multiset). 15 | 16 | infix 1 _⊢_ 17 | data _⊢_ : List Type → Type → Set where 18 | ax : {σ : Type} → (σ ∷ []) ⊢ σ 19 | cut : {γ δ : List Type} {σ τ : Type} → γ ⊢ σ → σ ∷ δ ⊢ τ → γ ++ δ ⊢ τ 20 | ⊗R : {γ δ : List Type} {σ τ : Type} → γ ⊢ σ → δ ⊢ τ → γ ++ δ ⊢ σ ⊗ τ 21 | ⊗L : {γ : List Type} {σ τ ν : Type} → τ ∷ σ ∷ γ ⊢ ν → σ ⊗ τ ∷ γ ⊢ ν 22 | 1R : [] ⊢ 𝟙 23 | 1L : {γ : List Type} {σ : Type} → γ ⊢ σ → 𝟙 ∷ γ ⊢ σ 24 | 0L : {γ : List Type} {σ : Type} → 𝟘 ∷ γ ⊢ σ 25 | ─oR : {γ : List Type} {σ τ : Type} → σ ∷ γ ⊢ τ → γ ⊢ σ ─o τ 26 | ─oL : {γ δ : List Type} {σ τ ν : Type} → γ ⊢ σ → τ ∷ δ ⊢ ν → (σ ─o τ) ∷ γ ++ δ ⊢ ν 27 | &R : {γ : List Type} {σ τ : Type} → γ ⊢ σ → γ ⊢ τ → γ ⊢ σ & τ 28 | &₁L : {γ : List Type} {σ τ ν : Type} → σ ∷ γ ⊢ ν → σ & τ ∷ γ ⊢ ν 29 | &₂L : {γ : List Type} {σ τ ν : Type} → τ ∷ γ ⊢ ν → σ & τ ∷ γ ⊢ ν 30 | ⊕₁R : {γ : List Type} {σ τ : Type} → γ ⊢ σ → γ ⊢ σ ⊕ τ 31 | ⊕₂R : {γ : List Type} {σ τ : Type} → γ ⊢ τ → γ ⊢ σ ⊕ τ 32 | ⊕L : {γ : List Type} {σ τ ν : Type} → σ ∷ γ ⊢ ν → τ ∷ γ ⊢ ν → σ ⊕ τ ∷ γ ⊢ ν 33 | mix : {γ δ θ : List Type} {σ : Type} → γ ++ δ ⊢ σ → γ ++ δ ≅ θ → θ ⊢ σ 34 | 35 | -- We can derive the more traditional `swap` structural rule 36 | -- from the `mix` constructor provided here. 37 | swap : ∀ {γ δ σ τ ν} → γ ++ σ ∷ τ ∷ δ ⊢ ν → γ ++ τ ∷ σ ∷ δ ⊢ ν 38 | swap {γ} {δ} {σ} {τ} p 39 | rewrite PEq.sym (++-assoc γ [ σ ] (τ ∷ δ)) 40 | = mix p $ γ ++ˡ τ ∷ʳ trivial 41 | -------------------------------------------------------------------------------- /src/linear/Context/Pointwise.agda: -------------------------------------------------------------------------------- 1 | module linear.Context.Pointwise where 2 | 3 | open import Data.Nat 4 | open import Data.Vec using ([] ; _∷_) 5 | open import Function 6 | open import Relation.Binary.PropositionalEquality as PEq using (_≡_ ; cong₂ ; subst) 7 | 8 | open import linear.Scope as Sc hiding (copys) 9 | open import linear.Type 10 | open import linear.Context as C hiding (_++_ ; copys ; _⋈_) 11 | open import linear.Usage hiding (_++_ ; copys ; _⋈_) 12 | 13 | data Context[_] (R : (σ τ : Type) → Set) : {k : ℕ} (γ δ : Context k) → Set where 14 | [] : Context[ R ] [] [] 15 | _∷_ : {σ τ : Type} {k : ℕ} {γ δ : Context k} → 16 | R σ τ → Context[ R ] γ δ → Context[ R ] (σ ∷ γ) (τ ∷ δ) 17 | 18 | _++_ : {R : (σ τ : Type) → Set} {k l : ℕ} {γ γ′ : Context k} {δ δ′ : Context l} → 19 | Context[ R ] γ γ′ → Context[ R ] δ δ′ → Context[ R ] (γ C.++ δ) (γ′ C.++ δ′) 20 | [] ++ ss = ss 21 | (r ∷ rs) ++ ss = r ∷ (rs ++ ss) 22 | 23 | refl : {k : ℕ} {γ : Context k} → Context[ _≡_ ] γ γ 24 | refl {γ = []} = [] 25 | refl {γ = σ ∷ γ} = PEq.refl ∷ refl 26 | 27 | sym : {k : ℕ} {γ δ : Context k} → Context[ _≡_ ] γ δ → Context[ _≡_ ] δ γ 28 | sym [] = [] 29 | sym (eq ∷ eqs) = PEq.sym eq ∷ sym eqs 30 | 31 | trans : {k : ℕ} {γ δ θ : Context k} → Context[ _≡_ ] γ δ → Context[ _≡_ ] δ θ → 32 | Context[ _≡_ ] γ θ 33 | trans [] [] = [] 34 | trans (eq₁ ∷ eqs₁) (eq₂ ∷ eqs₂) = PEq.trans eq₁ eq₂ ∷ trans eqs₁ eqs₂ 35 | 36 | copys : {k l o : ℕ} {m : Sc.Mergey k l} {M : C.Mergey m} {γ : Context k} (δ : Context o) → 37 | Context[ _≡_ ] (δ C.++ γ C.⋈ C.copys o M) (δ C.++ (γ C.⋈ M)) 38 | copys [] = refl 39 | copys (σ ∷ δ) = PEq.refl ∷ copys δ 40 | 41 | pointwiseEq : {k : ℕ} {γ δ : Context k} → Context[ _≡_ ] γ δ → γ ≡ δ 42 | pointwiseEq [] = PEq.refl 43 | pointwiseEq (eq ∷ eqs) = cong₂ (_∷_) eq $ pointwiseEq eqs 44 | 45 | _⋈_ : {k l : ℕ} {γ δ : Context k} {m : Sc.Mergey k l} 46 | (eq : Context[ _≡_ ] γ δ) (M : C.Mergey m) → Context[ _≡_ ] (γ C.⋈ M) (δ C.⋈ M) 47 | eq ⋈ finish = eq 48 | (eq ∷ eqs) ⋈ copy M = eq ∷ (eqs ⋈ M) 49 | eq ⋈ insert σ M = PEq.refl ∷ (eq ⋈ M) 50 | -------------------------------------------------------------------------------- /doc/types17-abstract/main.bib: -------------------------------------------------------------------------------- 1 | @Inbook{Danielsson2012, 2 | author="Danielsson, Nils Anders", 3 | editor="Beringer, Lennart 4 | and Felty, Amy", 5 | title="Bag Equivalence via a Proof-Relevant Membership Relation", 6 | bookTitle="Interactive Theorem Proving: Third International Conference, ITP 2012, Princeton, NJ, USA, August 13-15, 2012. Proceedings", 7 | year="2012", 8 | publisher="Springer Berlin Heidelberg", 9 | address="Berlin, Heidelberg", 10 | pages="149--165", 11 | isbn="978-3-642-32347-8", 12 | doi="10.1007/978-3-642-32347-8_11", 13 | url="http://dx.doi.org/10.1007/978-3-642-32347-8_11" 14 | } 15 | @Inbook{McBride2016, 16 | author="McBride, Conor", 17 | editor="Lindley, Sam 18 | and McBride, Conor 19 | and Trinder, Phil 20 | and Sannella, Don", 21 | title="I Got Plenty o' Nuttin'", 22 | bookTitle="A List of Successes That Can Change the World: Essays Dedicated to Philip Wadler on the Occasion of His 60th Birthday", 23 | year="2016", 24 | publisher="Springer International Publishing", 25 | pages="207--233", 26 | isbn="978-3-319-30936-1", 27 | doi="10.1007/978-3-319-30936-1_12", 28 | url="http://dx.doi.org/10.1007/978-3-319-30936-1_12" 29 | } 30 | @Inbook{Altenkirch1999, 31 | author="Altenkirch, Thorsten 32 | and Reus, Bernhard", 33 | editor="Flum, J{\"o}rg 34 | and Rodriguez-Artalejo, Mario", 35 | title="Monadic Presentations of Lambda Terms Using Generalized Inductive Types", 36 | bookTitle="Computer Science Logic: 13th International Workshop, CSL'99 8th Annual Conference of the EACSL Madrid, Spain, September 20--25, 1999 Proceedings", 37 | year="1999", 38 | publisher="Springer Berlin Heidelberg", 39 | address="Berlin, Heidelberg", 40 | pages="453--468", 41 | isbn="978-3-540-48168-3", 42 | doi="10.1007/3-540-48168-0_32", 43 | url="http://dx.doi.org/10.1007/3-540-48168-0_32" 44 | } 45 | @article{Pierce:2000:LTI:345099.345100, 46 | author = {Pierce, Benjamin C. and Turner, David N.}, 47 | title = {Local Type Inference}, 48 | journal = {ACM Trans. Program. Lang. Syst.}, 49 | issue_date = {Jan. 2000}, 50 | volume = {22}, 51 | number = {1}, 52 | month = jan, 53 | year = {2000}, 54 | issn = {0164-0925}, 55 | pages = {1--44}, 56 | numpages = {44}, 57 | url = {http://doi.acm.org/10.1145/345099.345100}, 58 | doi = {10.1145/345099.345100}, 59 | acmid = {345100}, 60 | publisher = {ACM}, 61 | address = {New York, NY, USA}, 62 | keywords = {polymorphism, subtyping, type inference}, 63 | } 64 | -------------------------------------------------------------------------------- /src/linear/Soundness.agda: -------------------------------------------------------------------------------- 1 | module linear.Soundness where 2 | 3 | open import Data.Nat 4 | open import Data.Product 5 | open import Data.List 6 | open import Data.List.Properties 7 | open import Data.Vec 8 | open import Function 9 | open import Algebra 10 | open import Relation.Binary.PropositionalEquality as PEq 11 | open ≡-Reasoning 12 | 13 | open import linear.Type 14 | open import linear.Context 15 | open import linear.Usage 16 | open import linear.Language 17 | open import linear.Typing 18 | open import linear.Typing.Consumption 19 | open import linear.ILL 20 | open import linear.Model 21 | open import linear.Usage.Erasure as UE 22 | open import linear.Utils 23 | 24 | ILL : Linear _⊢_ _⊢_ 25 | ILL = let open Monoid (++-monoid Type) in record 26 | { var = ax 27 | ; app = λ f t inc → 28 | let F = cut f (─oL t ax) 29 | in mix F (subst (_ ++_≅ _) (PEq.sym $ proj₂ identity _) inc) 30 | ; skip = λ u t → mix (cut u (1L t)) 31 | ; fst = λ t → subst (_⊢ _) (proj₂ identity _) (cut t (&₁L ax)) 32 | ; snd = λ t → subst (_⊢ _) (proj₂ identity _) (cut t (&₂L ax)) 33 | ; case = λ t l r → mix (cut t (⊕L l r)) 34 | ; exfalso = λ v → mix (cut v 0L) (UE.sym (trivial {xs = []})) 35 | ; cut = id 36 | ; lam = ─oR 37 | ; let' = λ t u → mix (cut t (⊗L u)) 38 | ; unit = 1R 39 | ; prd⊗ = λ a b → mix (⊗R a b) 40 | ; prd& = &R 41 | ; inl = ⊕₁R 42 | ; inr = ⊕₂R 43 | ; neu = id 44 | ; mix^I = mix 45 | ; mix^C = mix 46 | } 47 | 48 | -- Immediate consequence: every derivation in our extension 49 | -- gives rise to a derivation in ILL 50 | 51 | illCheck : ∀ {γ σ t} → [[ fromList γ ]] ⊢ σ ∋ t ⊠ ]] fromList γ [[ → γ ⊢ σ 52 | illCheck {γ} {σ} T = subst (_⊢ σ) eqγ proof where 53 | 54 | proof = LINEAR.linearCheck ILL T (consumptionCheck T) 55 | eqγ = begin 56 | used (consumptionCheck T) ≡⟨ used-all (consumptionCheck T) ⟩ 57 | toList (fromList γ) ≡⟨ toList∘fromList γ ⟩ 58 | γ 59 | ∎ 60 | 61 | illInfer : ∀ {γ σ t} → [[ fromList γ ]] ⊢ t ∈ σ ⊠ ]] fromList γ [[ → γ ⊢ σ 62 | illInfer {γ} {σ} T = subst (_⊢ σ) eqγ proof where 63 | 64 | proof = LINEAR.linearInfer ILL T (consumptionInfer T) 65 | eqγ = begin 66 | used (consumptionInfer T) ≡⟨ used-all (consumptionInfer T) ⟩ 67 | toList (fromList γ) ≡⟨ toList∘fromList γ ⟩ 68 | γ 69 | ∎ 70 | -------------------------------------------------------------------------------- /src/linear/Type/Parser.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE OverloadedStrings #-} 2 | {-# LANGUAGE DeriveFunctor #-} 3 | {-# LANGUAGE DeriveFoldable #-} 4 | {-# LANGUAGE DeriveTraversable #-} 5 | 6 | module Type.Parser where 7 | 8 | import Control.Applicative 9 | import Control.Monad 10 | import Control.Monad.State 11 | import Data.List (elemIndex) 12 | import Data.Attoparsec.ByteString 13 | import Data.Attoparsec.Combinator 14 | import Data.Attoparsec.ByteString.Char8 as AC (char, satisfy, skipSpace) 15 | 16 | data TypeF b = 17 | Base b 18 | | Unit 19 | | Zero 20 | | Tensor (TypeF b) (TypeF b) 21 | | Plus (TypeF b) (TypeF b) 22 | | With (TypeF b) (TypeF b) 23 | | Lolli (TypeF b) (TypeF b) 24 | deriving (Show, Functor, Foldable, Traversable) 25 | 26 | type RType = TypeF String 27 | type Type = TypeF Integer 28 | 29 | two :: TypeF b 30 | two = Plus Unit Unit 31 | 32 | pBase :: Parser String 33 | pBase = string "'" *> many1 (AC.satisfy (`elem` ['a'..'z'])) 34 | 35 | -- Because the grammar is left-recursive, we need to break it 36 | -- in various fixity-based tiers to avoid infinite loops 37 | 38 | betweenSpace :: Parser a -> Parser a 39 | betweenSpace p = skipSpace *> p <* skipSpace 40 | 41 | pRType5 :: Parser RType 42 | pRType5 = Lolli <$> pRType6 43 | <*> (betweenSpace (string "-o") *> pRType5) 44 | <|> pRType6 45 | 46 | pRType6 :: Parser RType 47 | pRType6 = Tensor <$> pRType7 48 | <*> (betweenSpace (string "*") *> pRType6) 49 | <|> pRType7 50 | 51 | pRType7 :: Parser RType 52 | pRType7 = Plus <$> pRType8 53 | <*> (betweenSpace (string "+") *> pRType7) 54 | <|> pRType8 55 | 56 | pRType8 :: Parser RType 57 | pRType8 = With <$> pRType9 58 | <*> (betweenSpace (string "&") *> pRType8) 59 | <|> pRType9 60 | 61 | pRType9 :: Parser RType 62 | pRType9 = Base <$> pBase 63 | <|> Zero <$ string "0" 64 | <|> Unit <$ string "1" 65 | <|> two <$ string "2" 66 | <|> string "(" *> pRType <* string ")" 67 | 68 | pRType :: Parser RType 69 | pRType = pRType5 70 | 71 | reifyNames :: (Traversable f, Eq a) => Parser (f a) -> Parser (f Integer) 72 | reifyNames = fmap $ (`evalState` (0, [])) . traverse reifyName where 73 | 74 | reifyName :: Eq a => a -> State (Int, [a]) Integer 75 | reifyName x = fromIntegral <$> do 76 | (n, xs) <- get 77 | case elemIndex x xs of 78 | Just k -> return (n - 1 - k) 79 | Nothing -> put (n+1, x:xs) >> return n 80 | -------------------------------------------------------------------------------- /doc/typing-rules-infer.tex: -------------------------------------------------------------------------------- 1 | \begin{figure}[H] 2 | \begin{mathpar} 3 | \inferrule 4 | {\ensuremath{\Gamma} \ensuremath{\vdash}_v k \ensuremath{\in} \ensuremath{\sigma} \andalso{} \ensuremath{\Delta} 5 | }{\ensuremath{\Gamma} \ensuremath{\vdash} \var{k} \ensuremath{\in} \ensuremath{\sigma} \andalso{} \ensuremath{\Delta} 6 | } 7 | \and \inferrule 8 | {\ensuremath{\Gamma} \ensuremath{\vdash} t \ensuremath{\in} \ensuremath{\sigma} \ensuremath{\multimap} \ensuremath{\tau} \andalso{} \ensuremath{\Delta} \and \ensuremath{\Delta} \ensuremath{\vdash} \ensuremath{\sigma} \ensuremath{\ni} u \andalso{} \ensuremath{\Theta} 9 | }{\ensuremath{\Gamma} \ensuremath{\vdash} \app{t}{u} \ensuremath{\in} \ensuremath{\tau} \andalso{} \ensuremath{\Theta} 10 | } 11 | \and \inferrule 12 | {\ensuremath{\Gamma} \ensuremath{\vdash} t \ensuremath{\in} \ensuremath{\sigma} \ensuremath{\oplus} \ensuremath{\tau} \andalso{} \ensuremath{\Delta} \and 13 | {\begin{array}{l} 14 | \ensuremath{\Delta} \ensuremath{\cdot} \fresh{\ensuremath{\sigma}} \ensuremath{\vdash} \ensuremath{\nu} \ensuremath{\ni} l \andalso{} \ensuremath{\Theta} \ensuremath{\cdot} \stale{\ensuremath{\sigma}} \\ 15 | \ensuremath{\Delta} \ensuremath{\cdot} \fresh{\ensuremath{\tau}} \ensuremath{\vdash} \ensuremath{\nu} \ensuremath{\ni} r \andalso{} \ensuremath{\Theta} \ensuremath{\cdot} \stale{\ensuremath{\tau}} 16 | \end{array}} 17 | }{\ensuremath{\Gamma} \ensuremath{\vdash} \cas{t}{\ensuremath{\nu}}{l}{r} \ensuremath{\in} \ensuremath{\nu} \andalso{} \ensuremath{\Theta} 18 | } 19 | \and \inferrule 20 | {\ensuremath{\Gamma} \ensuremath{\vdash} t \ensuremath{\in} \ensuremath{\sigma} \& \ensuremath{\tau} \andalso{} \ensuremath{\Delta} 21 | }{\ensuremath{\Gamma} \ensuremath{\vdash} \prl{t} \ensuremath{\in} \ensuremath{\sigma} \andalso{} \ensuremath{\Delta} 22 | } 23 | \and \inferrule 24 | {\ensuremath{\Gamma} \ensuremath{\vdash} t \ensuremath{\in} \ensuremath{\sigma} \& \ensuremath{\tau} \andalso{} \ensuremath{\Delta} 25 | }{\ensuremath{\Gamma} \ensuremath{\vdash} \prr{t} \ensuremath{\in} \ensuremath{\tau} \andalso{} \ensuremath{\Delta} 26 | } 27 | \and \inferrule 28 | {\ensuremath{\Gamma} \ensuremath{\vdash} t \ensuremath{\in} \Zero \andalso{} \ensuremath{\Delta} 29 | }{\ensuremath{\Gamma} \ensuremath{\vdash} \exf{\ensuremath{\sigma}}{t} \ensuremath{\in} \ensuremath{\sigma} \andalso{} \ensuremath{\Delta} 30 | } 31 | \and \inferrule 32 | {\ensuremath{\Gamma} \ensuremath{\vdash} \ensuremath{\sigma} \ensuremath{\ni} t \andalso{} \ensuremath{\Delta} 33 | }{\ensuremath{\Gamma} \ensuremath{\vdash} \cut{t}{\ensuremath{\sigma}} \ensuremath{\in} \ensuremath{\sigma} \andalso{} \ensuremath{\Delta} 34 | } 35 | \end{mathpar} 36 | \caption{Typing rules for \Inferable{}\label{figure:infer}} 37 | \end{figure} 38 | -------------------------------------------------------------------------------- /doc/typing-rules-check.tex: -------------------------------------------------------------------------------- 1 | \begin{figure}[H] 2 | \begin{mathpar} 3 | \inferrule 4 | {\ensuremath{\Gamma} \ensuremath{\cdot} \fresh{\ensuremath{\sigma}} \ensuremath{\vdash} \ensuremath{\tau} \ensuremath{\ni} b \andalso{} \ensuremath{\Delta} \ensuremath{\cdot} \stale{\ensuremath{\sigma}} 5 | }{\ensuremath{\Gamma} \ensuremath{\vdash} \ensuremath{\sigma} \ensuremath{\multimap} \ensuremath{\tau} \ensuremath{\ni} \lam{b} \andalso{} \ensuremath{\Delta} 6 | } 7 | \and \inferrule 8 | {\ensuremath{\Gamma} \ensuremath{\vdash} \ensuremath{\sigma} \ensuremath{\ni} a \andalso{} \ensuremath{\Delta} \and \ensuremath{\Delta} \ensuremath{\vdash} \ensuremath{\tau} \ensuremath{\ni} b \andalso{} \ensuremath{\Theta} 9 | }{\ensuremath{\Gamma} \ensuremath{\vdash} \ensuremath{\sigma} \ensuremath{\otimes} \ensuremath{\tau} \ensuremath{\ni} \prd{a}{b} \andalso{} \ensuremath{\Theta} 10 | } 11 | \\ 12 | \and \inferrule 13 | {\ensuremath{\Gamma} \ensuremath{\vdash} \ensuremath{\sigma} \ensuremath{\ni} t \andalso{} \ensuremath{\Delta} 14 | }{\ensuremath{\Gamma} \ensuremath{\vdash} \ensuremath{\sigma} \ensuremath{\oplus} \ensuremath{\tau} \ensuremath{\ni} \inl{t} \andalso{} \ensuremath{\Delta} 15 | } 16 | \and \inferrule 17 | {\ensuremath{\Gamma} \ensuremath{\vdash} \ensuremath{\tau} \ensuremath{\ni} t \andalso{} \ensuremath{\Delta} 18 | }{\ensuremath{\Gamma} \ensuremath{\vdash} \ensuremath{\sigma} \ensuremath{\oplus} \ensuremath{\tau} \ensuremath{\ni} \inr{t} \andalso{} \ensuremath{\Delta} 19 | } 20 | \and \inferrule 21 | {\ensuremath{\Gamma} \ensuremath{\vdash} \ensuremath{\sigma} \ensuremath{\ni} a \andalso{} \ensuremath{\Delta} \and \ensuremath{\Gamma} \ensuremath{\vdash} \ensuremath{\tau} \ensuremath{\ni} b \andalso{} \ensuremath{\Delta} 22 | }{\ensuremath{\Gamma} \ensuremath{\vdash} \ensuremath{\sigma} \& \ensuremath{\tau} \ensuremath{\ni} \prd{a}{b} \andalso{} \ensuremath{\Delta} 23 | } 24 | \\ 25 | \and \inferrule 26 | { 27 | }{\ensuremath{\Gamma} \ensuremath{\vdash} \Unit \ensuremath{\ni} \uni \andalso{} \ensuremath{\Gamma} 28 | } \and \inferrule 29 | {\ensuremath{\Gamma} \ensuremath{\vdash} t \ensuremath{\in} \ensuremath{\sigma} \andalso{} \ensuremath{\Delta} \and \ensuremath{\sigma} \ensuremath{\ni} p \leadsto{} \ensuremath{\delta} 30 | \\\\ \append{\Delta}{\fresh{\delta}} 31 | \ensuremath{\vdash} \ensuremath{\tau} \ensuremath{\ni} u \andalso{} 32 | \append{\Theta}{\stale{\delta}} 33 | }{\ensuremath{\Gamma} \ensuremath{\vdash} \ensuremath{\tau} \ensuremath{\ni} \letin{p}{t}{u} \andalso{} \ensuremath{\Theta} 34 | } 35 | \and \inferrule 36 | {\ensuremath{\Gamma} \ensuremath{\vdash} t \ensuremath{\in} \ensuremath{\sigma} \andalso{} \ensuremath{\Delta} 37 | }{\ensuremath{\Gamma} \ensuremath{\vdash} \ensuremath{\sigma} \ensuremath{\ni} \neu{t} \andalso{} \ensuremath{\Delta} 38 | } 39 | \end{mathpar} 40 | \caption{Typing rules for \Checkable{}\label{figure:check}} 41 | \end{figure} 42 | -------------------------------------------------------------------------------- /src/linear/Usage/Mix.agda: -------------------------------------------------------------------------------- 1 | module linear.Usage.Mix where 2 | 3 | open import Data.Product as Prod 4 | open import Data.Vec as V hiding ([_] ; _∷ʳ_ ; fromList) 5 | open import Function 6 | open import Relation.Binary.PropositionalEquality hiding ([_]) 7 | 8 | open import linear.Context 9 | open import linear.Context.Mix as CM hiding (_++ˡ_) 10 | open import linear.Usage as U hiding ([_]) 11 | import linear.Usage.Erasure as UE 12 | open import linear.Relation.Functional 13 | 14 | infix 2 [_]_++_≅_ 15 | infixr 4 _∷ˡ_ _∷ʳ_ 16 | data [_]_++_≅_ : ∀ {m n p} {γ : Context m} {δ : Context n} {θ : Context p} → 17 | γ ++ δ ≅ θ → Usages γ → Usages δ → Usages θ → Set where 18 | [] : [ [] ] [] ++ [] ≅ [] 19 | _∷ˡ_ : ∀ {m n p σ} {γ : Context m} {δ : Context n} {θ : Context p} 20 | {p : γ ++ δ ≅ θ} {Γ Δ Θ} (S : Usage σ) → 21 | [ p ] Γ ++ Δ ≅ Θ → [ σ ∷ˡ p ] S ∷ Γ ++ Δ ≅ S ∷ Θ 22 | _∷ʳ_ : ∀ {m n p σ} {γ : Context m} {δ : Context n} {θ : Context p} 23 | {p : γ ++ δ ≅ θ} {Γ Δ Θ} (S : Usage σ) → 24 | [ p ] Γ ++ Δ ≅ Θ → [ σ ∷ʳ p ] Γ ++ S ∷ Δ ≅ S ∷ Θ 25 | 26 | ≅-inj : ∀ {m n p} {γ : Context m} {δ : Context n} {θ : Context p} 27 | {Γ₁ Γ₂ Δ₁ Δ₂ Θ} (p : γ ++ δ ≅ θ) → 28 | [ p ] Γ₁ ++ Δ₁ ≅ Θ → [ p ] Γ₂ ++ Δ₂ ≅ Θ → 29 | Γ₁ ≡ Γ₂ × Δ₁ ≡ Δ₂ 30 | ≅-inj [] [] [] = refl , refl 31 | ≅-inj (a ∷ˡ p) (S ∷ˡ eq₁) (.S ∷ˡ eq₂) = Prod.map (cong (S ∷_)) id $ ≅-inj p eq₁ eq₂ 32 | ≅-inj (σ ∷ʳ p) (S ∷ʳ eq₁) (.S ∷ʳ eq₂) = Prod.map id (cong (S ∷_)) $ ≅-inj p eq₁ eq₂ 33 | 34 | _++ˡ_ : ∀ {m n p} {γ : Context m} {δ : Context n} {θ : Context p} 35 | {p : γ ++ δ ≅ θ} {Γ Δ Θ} {o} {φ : Context o} (Φ : Usages φ) → 36 | [ p ] Γ ++ Δ ≅ Θ → [ φ CM.++ˡ p ] Φ U.++ Γ ++ Δ ≅ Φ U.++ Θ 37 | [] ++ˡ eq = eq 38 | (S ∷ Φ) ++ˡ eq = S ∷ˡ (Φ ++ˡ eq) 39 | 40 | [[fromList]] : ∀ {γ δ θ} (p : γ UE.++ δ ≅ θ) → 41 | [ CM.fromList p ] [[ _ ]] ++ [[ _ ]] ≅ [[ V.fromList θ ]] 42 | [[fromList]] UE.[] = [] 43 | [[fromList]] (a UE.∷ˡ p) = U.[ a ] ∷ˡ [[fromList]] p 44 | [[fromList]] (a UE.∷ʳ p) = U.[ a ] ∷ʳ [[fromList]] p 45 | 46 | 47 | ]]fromList[[ : ∀ {γ δ θ} (p : γ UE.++ δ ≅ θ) → 48 | [ CM.fromList p ] ]] _ [[ ++ ]] _ [[ ≅ ]] V.fromList θ [[ 49 | ]]fromList[[ UE.[] = [] 50 | ]]fromList[[ (a UE.∷ˡ p) = ] a [ ∷ˡ ]]fromList[[ p 51 | ]]fromList[[ (a UE.∷ʳ p) = ] a [ ∷ʳ ]]fromList[[ p 52 | 53 | open import Data.Nat 54 | open import Data.Unit 55 | 56 | MixSplit : 57 | (ri : Σ[ γδθ ∈ ∃ Context × ∃ Context × ∃ Context ] 58 | let ((_ , γ) , (_ , δ) , (_ , θ)) = γδθ in 59 | (γ ++ δ ≅ θ) × Usages γ × Usages δ) → 60 | let ((_ , _ , (_ , θ)) , eq , Γ , Δ) = ri in Usages θ → Set 61 | MixSplit (_ , eq , Γ , Δ) Θ = [ eq ] Γ ++ Δ ≅ Θ 62 | 63 | functionalMix : Functional′ MixSplit 64 | functionalMix (_ , [] , _) [] [] = refl 65 | functionalMix (_ , (σ ∷ˡ eq) , _) (_ ∷ˡ o₁) (_ ∷ˡ o₂) = 66 | cong _ (functionalMix (_ , eq , _) o₁ o₂) 67 | functionalMix (_ , (σ ∷ʳ eq) , _) (_ ∷ʳ o₁) (_ ∷ʳ o₂) = 68 | cong _ (functionalMix (_ , eq , _) o₁ o₂) 69 | -------------------------------------------------------------------------------- /src/linear/Typecheck/Problem.agda: -------------------------------------------------------------------------------- 1 | module linear.Typecheck.Problem where 2 | 3 | open import Data.Nat 4 | open import Data.Fin 5 | open import Data.Vec hiding (_++_ ; tail) 6 | open import Data.Product 7 | open import Relation.Binary.PropositionalEquality 8 | 9 | open import linear.Type 10 | open import linear.Context as C hiding (_++_) 11 | open import linear.Usage 12 | open import linear.Language 13 | open import linear.Typing 14 | open import linear.RawIso 15 | 16 | -- The Typechecking problems we are going to prove are decidable 17 | record CONSUME {n : ℕ} {γ : Context n} (Γ : Usages γ) (k : Fin n) : Set where 18 | constructor _,_,_ 19 | field 20 | type : Type 21 | usages : Usages γ 22 | proof : Γ ⊢ k ∈[ type ]⊠ usages 23 | 24 | infix 4 _,_,_ 25 | record INFER {n : ℕ} {γ : Context n} (Γ : Usages γ) (t : Infer n) : Set where 26 | constructor _,_,_ 27 | field 28 | type : Type 29 | usages : Usages γ 30 | proof : Γ ⊢ t ∈ type ⊠ usages 31 | 32 | infix 4 _,_ 33 | record CHECK {n : ℕ} {γ : Context n} (Γ : Usages γ) (σ : Type) (t : Check n) : Set where 34 | constructor _,_ 35 | field 36 | usages : Usages γ 37 | proof : Γ ⊢ σ ∋ t ⊠ usages 38 | 39 | record PATTERN {n : ℕ} (σ : Type) (p : Pattern n) : Set where 40 | constructor _,_ 41 | field 42 | context : Context n 43 | proof : σ ∋ p ↝ context 44 | 45 | record TRUNCATE {n o : ℕ} {γ : Context n} (δ : Context o) (Γ : Usages (δ C.++ γ)) : Set where 46 | constructor _,_ 47 | field 48 | usages : Usages γ 49 | proof : Γ ≡ (]] δ [[ ++ usages) 50 | 51 | 52 | -- some related RawIsos 53 | consumeSuc : {n : ℕ} {γ : Context n} (Γ : Usages γ) {σ : Type} (a : Usage σ) (k : Fin n) → 54 | RawIso (CONSUME Γ k) (CONSUME (a ∷ Γ) (suc k)) 55 | push (consumeSuc Γ a k) (σ , Δ , v) = σ , (a ∷ Δ) , s v 56 | pull (consumeSuc Γ a k) (σ , (.a ∷ Δ) , (s v)) = σ , Δ , v 57 | 58 | truncateUsed : {n o : ℕ} {γ : Context n} {a : Type} (δ : Context o) (ΔΓ : Usages (δ C.++ γ)) → 59 | RawIso (TRUNCATE δ ΔΓ) (TRUNCATE (a ∷ δ) (] a [ ∷ ΔΓ)) 60 | push (truncateUsed δ ΔΓ) (Γ , prf) = _ , cong (_ ∷_) prf 61 | pull (truncateUsed δ ΔΓ) (Γ , prf) = _ , cong tail prf 62 | 63 | inferVar : {n : ℕ} {γ : Context n} (Γ : Usages γ) (k : Fin n) → RawIso (CONSUME Γ k) (INFER Γ (`var k)) 64 | push (inferVar Γ k) (σ , Δ , v) = σ , Δ , `var v 65 | pull (inferVar Γ k) (σ , Δ , `var v) = σ , Δ , v 66 | 67 | inferCut : {n : ℕ} {γ : Context n} (Γ : Usages γ) (t : Check n) (σ : Type) → 68 | RawIso (CHECK Γ σ t) (INFER Γ (`cut t σ)) 69 | push (inferCut Γ t σ) (Δ , p) = σ , Δ , `cut p 70 | pull (inferCut Γ t σ) (.σ , Δ , `cut p) = Δ , p 71 | 72 | checkInl : {n : ℕ} {γ : Context n} (Γ : Usages γ) (t : Check n) (σ τ : Type) → 73 | RawIso (CHECK Γ σ t) (CHECK Γ (σ ⊕ τ) (`inl t)) 74 | push (checkInl Γ t σ τ) (Δ , p) = _ , `inl p 75 | pull (checkInl Γ t σ τ) (Δ , `inl p) = _ , p 76 | 77 | checkInr : {n : ℕ} {γ : Context n} (Γ : Usages γ) (t : Check n) (σ τ : Type) → 78 | RawIso (CHECK Γ τ t) (CHECK Γ (σ ⊕ τ) (`inr t)) 79 | push (checkInr Γ t σ τ) (Δ , p) = _ , `inr p 80 | pull (checkInr Γ t σ τ) (Δ , `inr p) = _ , p 81 | 82 | patternTensor : {m n : ℕ} {p : Pattern m} {q : Pattern n} {σ τ : Type} → 83 | RawIso (PATTERN σ p × PATTERN τ q) (PATTERN (σ ⊗ τ) (p ,, q)) 84 | push patternTensor ((_ , p) , (_ , q)) = _ , p ,, q 85 | pull patternTensor (_ , p ,, q) = (_ , p) , (_ , q) 86 | -------------------------------------------------------------------------------- /src/linear/Typing/Consumption.agda: -------------------------------------------------------------------------------- 1 | module linear.Typing.Consumption where 2 | 3 | open import Data.Nat 4 | open import Data.Vec hiding (_++_) 5 | open import Data.Product 6 | open import Function 7 | 8 | open import linear.Type 9 | open import linear.Context hiding (_++_) 10 | open import linear.Typing 11 | open import linear.Usage hiding ([_] ; _++_) 12 | open import linear.Usage.Consumption 13 | import Relation.Binary.PropositionalEquality as PEq 14 | 15 | mutual 16 | 17 | consumptionInfer : Consumption TInfer 18 | consumptionInfer (`var k) = consumptionFin k 19 | consumptionInfer (`app t u) = trans (consumptionInfer t) (consumptionCheck u) 20 | consumptionInfer (`fst t) = consumptionInfer t 21 | consumptionInfer (`snd t) = consumptionInfer t 22 | consumptionInfer (`case t return σ of l %% r) = 23 | trans (consumptionInfer t) $ truncate [ _ ] $ consumptionCheck l 24 | consumptionInfer (`exfalso σ t) = consumptionInfer t 25 | consumptionInfer (`cut t) = consumptionCheck t 26 | 27 | consumptionCheck : Consumption TCheck 28 | consumptionCheck (`lam t) = truncate [ _ ] $ consumptionCheck t 29 | consumptionCheck (`let p ∷= t `in u) = 30 | trans (consumptionInfer t) $ truncate (patternContext p) $ consumptionCheck u 31 | consumptionCheck `unit = refl _ 32 | consumptionCheck (`prd⊗ a b) = trans (consumptionCheck a) (consumptionCheck b) 33 | consumptionCheck (`prd& a b) = consumptionCheck a 34 | consumptionCheck (`inl t) = consumptionCheck t 35 | consumptionCheck (`inr t) = consumptionCheck t 36 | consumptionCheck (`neu t) = consumptionInfer t 37 | 38 | mutual 39 | 40 | framingInfer : Framing TInfer 41 | framingInfer c (`var k) = `var (framingFin c k) 42 | framingInfer c (`app t u) = 43 | let (_ , c₁ , c₂) = divide c (consumptionInfer t) (consumptionCheck u) 44 | in `app (framingInfer c₁ t) (framingCheck c₂ u) 45 | framingInfer c (`fst t) = `fst framingInfer c t 46 | framingInfer c (`snd t) = `snd framingInfer c t 47 | framingInfer c (`case t return σ of l %% r) = 48 | let (_ , c₁ , c₂) = divide c (consumptionInfer t) (truncate [ _ ] (consumptionCheck l)) 49 | in `case framingInfer c₁ t return σ of framingCheck (_ ∷ c₂) l %% framingCheck (_ ∷ c₂) r 50 | framingInfer c (`exfalso σ t) = `exfalso σ (framingInfer c t) 51 | framingInfer c (`cut t) = `cut (framingCheck c t) 52 | 53 | framingCheck : Framing TCheck 54 | framingCheck c (`lam t) = `lam framingCheck (_ ∷ c) t 55 | framingCheck c (`let p ∷= t `in u) = 56 | let (_ , c₁ , c₂) = divide c (consumptionInfer t) (truncate (patternContext p) (consumptionCheck u)) 57 | in `let p ∷= framingInfer c₁ t `in framingCheck (pure (patternContext p) ++ c₂) u 58 | framingCheck c `unit = PEq.subst (TCheck _ _ _) (equality c) `unit 59 | framingCheck c (`prd⊗ a b) = 60 | let (_ , c₁ , c₂) = divide c (consumptionCheck a) (consumptionCheck b) 61 | in `prd⊗ (framingCheck c₁ a) (framingCheck c₂ b) 62 | framingCheck c (`prd& a b) = `prd& (framingCheck c a) (framingCheck c b) 63 | framingCheck c (`inl t) = `inl framingCheck c t 64 | framingCheck c (`inr t) = `inr framingCheck c t 65 | framingCheck c (`neu t) = `neu framingInfer c t 66 | -------------------------------------------------------------------------------- /doc/ill.tex: -------------------------------------------------------------------------------- 1 | \begin{figure}[H] 2 | \begin{mathpar} 3 | \inferrule{ }{\ensuremath{\sigma} \ensuremath{\vdash} \ensuremath{\sigma}}{ax} 4 | \and \inferrule{\ensuremath{\gamma} \ensuremath{\vdash} \ensuremath{\sigma} \and \ensuremath{\sigma} , \ensuremath{\delta} \ensuremath{\vdash} \ensuremath{\tau}}{\ensuremath{\gamma} , \ensuremath{\delta} \ensuremath{\vdash} \ensuremath{\tau}}{cut} 5 | \and \inferrule{\ensuremath{\gamma} \ensuremath{\vdash} \ensuremath{\sigma} \and \ensuremath{\delta} \ensuremath{\vdash} \ensuremath{\tau}}{\ensuremath{\gamma} , \ensuremath{\delta} \ensuremath{\vdash} \ensuremath{\sigma} \ensuremath{\otimes} \ensuremath{\tau}}{\ensuremath{\otimes}^R} 6 | \and \inferrule{\ensuremath{\tau} , \ensuremath{\sigma} , \ensuremath{\gamma} \ensuremath{\vdash} \ensuremath{\nu}} {\ensuremath{\sigma} \ensuremath{\otimes} \ensuremath{\tau} , \ensuremath{\gamma} \ensuremath{\vdash}}{\ensuremath{\otimes}^L} 7 | \and \inferrule{ }{\ensuremath{\vdash} \ensuremath{\mathbb{1}}}{1^R} 8 | \and \inferrule{\ensuremath{\gamma} \ensuremath{\vdash} \ensuremath{\sigma}}{\ensuremath{\mathbb{1}} , \ensuremath{\gamma} \ensuremath{\vdash} \ensuremath{\sigma}}{1^L} 9 | \and \inferrule{ }{\ensuremath{\mathbb{0}} , \ensuremath{\gamma} \ensuremath{\vdash} \ensuremath{\sigma}}{0^L} 10 | \and \inferrule{\ensuremath{\sigma} , \ensuremath{\gamma} \ensuremath{\vdash} \ensuremath{\tau}}{\ensuremath{\gamma} \ensuremath{\vdash} \ensuremath{\sigma} \ensuremath{\multimap} \ensuremath{\tau}}{\ensuremath{\multimap}^R} 11 | \and \inferrule{\ensuremath{\gamma} \ensuremath{\vdash} \ensuremath{\sigma} \and \ensuremath{\tau} , \ensuremath{\delta} \ensuremath{\vdash} \ensuremath{\nu}}{(\ensuremath{\sigma} \ensuremath{\multimap} \ensuremath{\tau}) , \ensuremath{\gamma} , \ensuremath{\delta} \ensuremath{\vdash} \ensuremath{\nu}}{\ensuremath{\multimap}^L} 12 | \and \inferrule{\ensuremath{\gamma} \ensuremath{\vdash} \ensuremath{\sigma} \and \ensuremath{\gamma} \ensuremath{\vdash} \ensuremath{\tau}}{\ensuremath{\gamma} \ensuremath{\vdash} \ensuremath{\sigma} \& \ensuremath{\tau}}{\&^R} 13 | \and \inferrule{\ensuremath{\sigma} , \ensuremath{\gamma} \ensuremath{\vdash} \ensuremath{\nu}}{\ensuremath{\sigma} \& \ensuremath{\tau} , \ensuremath{\gamma} \ensuremath{\vdash} \ensuremath{\nu}}{\&_1^L} 14 | \and \inferrule{\ensuremath{\tau} , \ensuremath{\gamma} \ensuremath{\vdash} \ensuremath{\nu}}{\ensuremath{\sigma} \& \ensuremath{\tau} , \ensuremath{\gamma} \ensuremath{\vdash} \ensuremath{\nu}}{\&_2^L} 15 | \and \inferrule{\ensuremath{\gamma} \ensuremath{\vdash} \ensuremath{\sigma}}{\ensuremath{\gamma} \ensuremath{\vdash} \ensuremath{\sigma} \ensuremath{\oplus} \ensuremath{\tau}}{\ensuremath{\oplus}_1^R} 16 | \and \inferrule{\ensuremath{\gamma} \ensuremath{\vdash} \ensuremath{\tau}}{\ensuremath{\gamma} \ensuremath{\vdash} \ensuremath{\sigma} \ensuremath{\oplus} \ensuremath{\tau}}{\ensuremath{\oplus}_2^R} 17 | \and \inferrule{\ensuremath{\sigma} , \ensuremath{\gamma} \ensuremath{\vdash} \ensuremath{\nu} \and \ensuremath{\tau} , \ensuremath{\gamma} \ensuremath{\vdash} \ensuremath{\nu}}{\ensuremath{\sigma} \ensuremath{\oplus} \ensuremath{\tau} , \ensuremath{\gamma} \ensuremath{\vdash} \ensuremath{\nu}}{\ensuremath{\oplus}^L} 18 | \and \inferrule{\ensuremath{\gamma} , \ensuremath{\delta} \ensuremath{\vdash} \ensuremath{\sigma} \and \ensuremath{\gamma} , \ensuremath{\delta} \ensuremath{\cong} \ensuremath{\theta}}{\ensuremath{\theta} \ensuremath{\vdash} \ensuremath{\sigma}}{mix} 19 | \end{mathpar} 20 | \caption{Sequent Calculus for Intuitionistic Linear Logic}\label{sequent:ill} 21 | \end{figure} 22 | -------------------------------------------------------------------------------- /doc/main.tex: -------------------------------------------------------------------------------- 1 | \documentclass[a4paper,UKenglish]{lipics-v2018} 2 | %This is a template for producing LIPIcs articles. 3 | %See lipics-manual.pdf for further information. 4 | %for A4 paper format use option "a4paper", for US-letter use option "letterpaper" 5 | %for british hyphenation rules use option "UKenglish", for american hyphenation rules use option "USenglish" 6 | % for section-numbered lemmas etc., use "numberwithinsect" 7 | 8 | \nolinenumbers 9 | \usepackage{float} 10 | %\usepackage{agda} 11 | \usepackage{mathpartir} 12 | \usepackage{microtype}%if unwanted, comment out or use option "draft" 13 | \lstset{ 14 | escapeinside='', 15 | extendedchars=true, 16 | inputencoding=utf8, 17 | } 18 | 19 | %\graphicspath{{./graphics/}}%helpful if your graphic files are in another directory 20 | 21 | \input{commands} 22 | 23 | \bibliographystyle{plainurl}% the recommnded bibstyle 24 | 25 | \title{Typing with Leftovers \protect\\ 26 | {\Large A mechanization of Intuitionistic Multiplicative-Additive Linear Logic}} 27 | 28 | \titlerunning{Typing with Leftovers}%optional, please use if title is longer than one line 29 | 30 | \author{Guillaume Allais}{iCIS, Radboud University Nijmegen, The Netherlands}{gallais@cs.ru.nl}{}{}%mandatory, please use full name; only 1 author per \author macro; first two parameters are mandatory, other parameters can be empty. 31 | 32 | \authorrunning{G. Allais}%mandatory. First: Use abbreviated first/middle names. Second (only in severe cases): Use first author plus 'et al.' 33 | 34 | \Copyright{Guillaume Allais}%mandatory, please use full first names. LIPIcs license is "CC-BY"; http://creativecommons.org/licenses/by/3.0/ 35 | 36 | 37 | \subjclass{\ccsdesc[500]{Theory of computation~Type theory},\ccsdesc[100]{Theory of computation~Linear logic}} 38 | % mandatory: Please choose ACM 2012 classifications from https://www.acm.org/publications/class-2012 or https://dl.acm.org/ccs/ccs_flat.cfm . E.g., cite as "General and reference $\rightarrow$ General literature" or \ccsdesc[100]{General and reference~General literature}. 39 | 40 | \keywords{Type System, Bidirectional, Linear Logic, Agda}%mandatory 41 | 42 | \category{}%optional, e.g. invited paper 43 | 44 | \relatedversion{}%optional, e.g. full version hosted on arXiv, HAL, or other respository/website 45 | 46 | \supplement{https://github.com/gallais/typing-with-leftovers}%optional, e.g. related research data, source code, ... hosted on a repository like zenodo, figshare, GitHub, ... 47 | 48 | \funding{The research leading to these results has received funding from the European Research Council under the 49 | European Union’s Seventh Framework Programme (FP7/2007-2013) / ERC grant agreement nr. 320571}%optional, to capture a funding statement, which applies to all authors. Please enter author specific funding statements as fifth argument of the \author macro. 50 | 51 | \acknowledgements{}%optional 52 | 53 | %Editor-only macros:: begin (do not touch as author)%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 54 | \EventEditors{Andreas Abel, Fredrik Nordvall Forsberg, and Ambrus Kaposi} 55 | \EventNoEds{3} 56 | \EventLongTitle{23rd International Conference on Types for Proofs and 57 | Programs (TYPES 2017)} 58 | \EventShortTitle{TYPES 2017} 59 | \EventAcronym{TYPES} 60 | \EventYear{2017} 61 | \EventDate{May 29--June 1, 2017} 62 | \EventLocation{Budapest, Hungary} 63 | \EventLogo{} 64 | \SeriesVolume{104} 65 | \ArticleNo{1} % This is specific to your paper! 66 | %\nolinenumbers %uncomment to disable line numbering 67 | %\hideLIPIcs %uncomment to remove references to LIPIcs series (logo, DOI, ...), e.g. when preparing a pre-final version to be uploaded to arXiv or another public repository 68 | %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 69 | 70 | 71 | \input{leftovers} 72 | -------------------------------------------------------------------------------- /src/linear/Usage/Erasure.agda: -------------------------------------------------------------------------------- 1 | module linear.Usage.Erasure where 2 | 3 | open import Level 4 | open import Data.Nat hiding (_⊔_) 5 | open import Data.Vec as Vec hiding (_∷ʳ_) 6 | open import Data.List as List hiding (_∷ʳ_) 7 | open import Data.Product 8 | open import Function 9 | open import Relation.Binary.PropositionalEquality as PEq using (_≡_) 10 | 11 | open import linear.Type 12 | open import linear.Scope as Sc 13 | open import linear.Context as C 14 | open import linear.Context.Pointwise hiding (sym) 15 | open import linear.Usage as U 16 | open import linear.Usage.Consumption as UC hiding (divide) 17 | open import linear.Usage.Pointwise as UP hiding (sym) 18 | 19 | ⌊_⌋ : {n : ℕ} {γ : Context n} {Γ Δ : Usages γ} → Γ ⊆ Δ → 20 | Σ[ k ∈ ℕ ] Σ[ m ∈ Sc.Mergey k n ] 21 | Σ[ δ ∈ Context k ] Σ[ M ∈ C.Mergey m ] 22 | Σ[ 𝓜 ∈ U.Mergey M ] Σ[ eq ∈ Context[ _≡_ ] γ (δ C.⋈ M) ] 23 | coerce eq Γ ─ coerce eq Δ ≡ [[ δ ]] U.⋈ 𝓜 ─ ]] δ [[ U.⋈ 𝓜 24 | ⌊ [] ⌋ = , , , , finish , [] , [] 25 | ⌊ ─∷ inc ⌋ = 26 | let (k , m , δ , M , 𝓜 , eq , usg) = ⌊ inc ⌋ 27 | in k , insert m , δ , insert _ M , insert (U.[ _ ]) 𝓜 , PEq.refl ∷ eq , (─∷ usg) 28 | ⌊ σ ∷ inc ⌋ = 29 | let (k , m , δ , M , 𝓜 , eq , usg) = ⌊ inc ⌋ 30 | in , , _ ∷ _ , , copy 𝓜 , PEq.refl ∷ eq , σ ∷ usg 31 | 32 | used : {n : ℕ} {γ : Context n} {Γ Δ : Usages γ} → Γ ⊆ Δ → List Type 33 | used [] = [] 34 | used (─∷ γ) = used γ 35 | used (σ ∷ γ) = σ ∷ used γ 36 | 37 | used-refl : {n : ℕ} {γ : Context n} {Γ : Usages γ} (inc : Γ ⊆ Γ) → used inc ≡ [] 38 | used-refl [] = PEq.refl 39 | used-refl (─∷ inc) = used-refl inc 40 | 41 | used-all : {n : ℕ} {γ : Context n} (pr : [[ γ ]] ⊆ ]] γ [[) → used pr ≡ toList γ 42 | used-all [] = PEq.refl 43 | used-all (σ ∷ γ) = PEq.cong (σ ∷_) (used-all γ) 44 | 45 | used-++ : {k l : ℕ} {γ : Context k} {δ : Context l} {Γ Γ′ : Usages γ} {Δ Δ′ : Usages δ} 46 | (incΓ : Γ ⊆ Γ′) (incΔ : Δ ⊆ Δ′) → 47 | used (incΓ UC.++ incΔ) ≡ used incΓ List.++ used incΔ 48 | used-++ [] incΔ = PEq.refl 49 | used-++ (─∷ incΓ) incΔ = used-++ incΓ incΔ 50 | used-++ (a ∷ incΓ) incΔ = PEq.cong (a ∷_) (used-++ incΓ incΔ) 51 | 52 | 53 | toList-++ : {k l : ℕ} (xs : Context k) (ys : Context l) → 54 | toList (xs Vec.++ ys) ≡ toList xs List.++ toList ys 55 | toList-++ [] ys = PEq.refl 56 | toList-++ (x ∷ xs) ys = PEq.cong (x ∷_) (toList-++ xs ys) 57 | 58 | infix 1 _++_≅_ 59 | infixr 20 _∷ˡ_ _∷ʳ_ 60 | data _++_≅_ {A : Set} : (xs ys zs : List A) → Set where 61 | [] : [] ++ [] ≅ [] 62 | _∷ˡ_ : (a : A) {xs ys zs : List A} (as : xs ++ ys ≅ zs) → a ∷ xs ++ ys ≅ a ∷ zs 63 | _∷ʳ_ : (a : A) {xs ys zs : List A} (as : xs ++ ys ≅ zs) → xs ++ a ∷ ys ≅ a ∷ zs 64 | 65 | sym : {A : Set} {xs ys zs : List A} → xs ++ ys ≅ zs → ys ++ xs ≅ zs 66 | sym [] = [] 67 | sym (x ∷ˡ xs) = x ∷ʳ sym xs 68 | sym (x ∷ʳ xs) = x ∷ˡ sym xs 69 | 70 | 71 | divide : {n : ℕ} {γ : Context n} {Γ Δ θ : Usages γ} (p : Γ ⊆ Δ) (q : Δ ⊆ θ) (pq : Γ ⊆ θ) → 72 | used p ++ used q ≅ used pq 73 | divide [] [] [] = [] 74 | divide (─∷ p) (─∷ q) (─∷ pq) = divide p q pq 75 | divide (─∷ p) (a ∷ q) (.a ∷ pq) = a ∷ʳ divide p q pq 76 | divide (a ∷ p) (─∷ q) (.a ∷ pq) = a ∷ˡ divide p q pq 77 | 78 | infixr 10 _++ʳ_ _++ˡ_ 79 | 80 | _++ʳ_ : {A : Set} {xs ys zs : List A} (ts : List A) (eq : xs ++ ys ≅ zs) → 81 | xs ++ ts List.++ ys ≅ ts List.++ zs 82 | [] ++ʳ eq = eq 83 | (t ∷ ts) ++ʳ eq = t ∷ʳ (ts ++ʳ eq) 84 | 85 | _++ˡ_ : {A : Set} {xs ys zs : List A} (ts : List A) (eq : xs ++ ys ≅ zs) → 86 | ts List.++ xs ++ ys ≅ ts List.++ zs 87 | [] ++ˡ eq = eq 88 | (t ∷ ts) ++ˡ eq = t ∷ˡ (ts ++ˡ eq) 89 | 90 | trivial : {A : Set} {xs ys : List A} → xs ++ ys ≅ xs List.++ ys 91 | trivial {xs = []} {[]} = [] 92 | trivial {xs = []} {y ∷ ys} = y ∷ʳ trivial 93 | trivial {xs = x ∷ xs} = x ∷ˡ trivial 94 | -------------------------------------------------------------------------------- /doc/commands.tex: -------------------------------------------------------------------------------- 1 | \usepackage[bb=boondox]{mathalfa} 2 | \renewcommand{\textsc}[1]{{\footnotesize \uppercase{#1}}} 3 | \newcommand{\DefinedType}[1]{\text{\textsc{#1}}} 4 | \newcommand{\Zeta}{Z} 5 | \newcommand{\TR}[1]{\ensuremath{\mathcal{T}_{#1}}} 6 | 7 | \newcommand{\append}[2]{(#1\,+\!\!\!+\,#2)} 8 | \newcommand{\listcons}{:\!\!\!:} 9 | 10 | \newcommand{\andalso}{\,\ensuremath{{\scriptstyle \boxtimes{}}}\,} 11 | 12 | \newcommand{\fresh}[1]{\ensuremath{\texttt{f}_{#1}}} 13 | \newcommand{\stale}[1]{\ensuremath{\texttt{s}_{#1}}} 14 | 15 | \newcommand{\List}[1]{\ensuremath{\DefinedType{List}\,#1}} 16 | \newcommand{\Usage}[1]{\ensuremath{\DefinedType{Usage}_{#1}}} 17 | \newcommand{\Usages}[1]{\ensuremath{\DefinedType{Usage}_{#1}}} 18 | 19 | \newcommand{\Type}{\DefinedType{Type}} 20 | \newcommand{\Nat}{\DefinedType{Nat}} 21 | \newcommand{\Var}[1]{\ensuremath{\DefinedType{Var}_{#1}}} 22 | \newcommand{\Inferable}[1]{\ensuremath{\DefinedType{Infer}_{#1}}} 23 | \newcommand{\Checkable}[1]{\ensuremath{\DefinedType{Check}_{#1}}} 24 | \newcommand{\Pattern}[1]{\ensuremath{\DefinedType{Pattern}_{#1}}} 25 | \newcommand{\Context}[1]{\ensuremath{\DefinedType{Context}_{#1}}} 26 | \newcommand{\OPE}{\DefinedType{OPE}} 27 | \newcommand{\Env}{\ensuremath{\DefinedType{Env}}} 28 | 29 | \newcommand{\TEnv}[4]{\ensuremath{#1 \ensuremath{\vdash}_e #2 \ensuremath{\ni} #3 \andalso{} #4}} 30 | 31 | \newcommand{\Set}{\mathcal{\textit{Set}}} 32 | 33 | \newcommand{\natzero}{\ensuremath{\texttt{0}}} 34 | \newcommand{\natsucc}[1]{\ensuremath{\texttt{1\!+} #1}} 35 | 36 | \newcommand{\used}[1]{\ensuremath{\text{used}(#1)}} 37 | \newcommand{\ope}[1]{\ensuremath{\text{ope}(#1)}} 38 | 39 | \newcommand{\opeinsert}[1]{\ensuremath{\texttt{insert}_{#1}}} 40 | \newcommand{\opecopy}{\ensuremath{\texttt{copy}}} 41 | \newcommand{\opedone}{\ensuremath{\texttt{done}}} 42 | 43 | \newcommand{\envextend}{\ensuremath{\mathbin{\vcenter{\hbox{\scalebox{.6}{$\bullet$}}}}}\!\texttt{v}} 44 | 45 | %% LANGUAGE 46 | \newcommand{\varzero}{\texttt{z}} 47 | \newcommand{\varsucc}[1]{\ensuremath{\texttt{s}\, #1}} 48 | 49 | \newcommand{\var}[1]{\ensuremath{\texttt{var}~#1}} 50 | \newcommand{\app}[2]{\ensuremath{\texttt{app}~#1~#2}} 51 | \newcommand{\exf}[2]{\ensuremath{\texttt{exfalso}~#1~#2}} 52 | \newcommand{\cas}[4]{\ensuremath{\texttt{case}~#1~\texttt{return}~#2~\texttt{of}~#3~\texttt{\%\!\!\%}~#4}} 53 | \newcommand{\cut}[2]{\ensuremath{\texttt{cut}~#1~#2}} 54 | \newcommand{\lam}[1]{\ensuremath{\texttt{lam}~#1}} 55 | \newcommand{\letin}[3]{\ensuremath{\texttt{let}~#1 \texttt{:=}\, #2 \texttt{in}\, #3}} 56 | \newcommand{\letinsplit}[3]{\ensuremath{\texttt{let}~#1 ~\texttt{:=}~ #2 ~\texttt{in}\\#3}} 57 | \newcommand{\uni}{\texttt{unit}} 58 | \newcommand{\inl}[1]{\ensuremath{\texttt{inl}~#1}} 59 | \newcommand{\inr}[1]{\ensuremath{\texttt{inr}~#1}} 60 | \newcommand{\prd}[2]{\ensuremath{\texttt{prd}~#1~#2}} 61 | \newcommand{\prdsplit}[2]{\texttt{prd}&\ensuremath{#1}\\&\ensuremath{#2}} 62 | \newcommand{\neu}[1]{\ensuremath{\texttt{neu}~#1}} 63 | \newcommand{\prl}[1]{\ensuremath{\texttt{prj$_1$}~#1}} 64 | \newcommand{\prr}[1]{\ensuremath{\texttt{prj$_2$}~#1}} 65 | 66 | \newcommand{\varpattern}{\texttt{v}} 67 | \newcommand{\unitpattern}{\texttt{\ensuremath{\langle\rangle}}} 68 | \newcommand{\prdpattern}[2]{\ensuremath{(#1~\texttt{,}~#2)}} 69 | 70 | \newcommand{\weaken}[2]{\ensuremath{\texttt{weak}~#2~#1}} 71 | \newcommand{\subst}[2]{\ensuremath{#1~[\,#2\,]}} 72 | 73 | %% TYPES 74 | \newcommand{\Base}[1]{\ensuremath{\kappa}\, #1} 75 | \newcommand{\Lolli}[2]{#1 \,\ensuremath{\multimap}\, #2} 76 | \newcommand{\Tensor}[2]{#1 \,\ensuremath{\otimes}\, #2} 77 | \newcommand{\Unit}{\ensuremath{\mathbb{1}}} 78 | \newcommand{\Sum}[2]{#1 \,\ensuremath{\oplus}\, #2} 79 | \newcommand{\With}[2]{#1 \,\&\, #2} 80 | \newcommand{\Zero}{\ensuremath{\mathbb{0}}} 81 | 82 | \newcommand{\type}[3][]{\mprset{fraction={===}}\inferrule{#2}{#3}{#1}} 83 | \newcommand{\constructor}[2]{\mprset{fraction={---}}\inferrule{#1}{#2}{}} 84 | -------------------------------------------------------------------------------- /src/linear/Typing/Extensional.agda: -------------------------------------------------------------------------------- 1 | module linear.Typing.Extensional where 2 | 3 | open import Data.Nat 4 | open import Function 5 | open import Relation.Binary.PropositionalEquality as PEq 6 | 7 | open import linear.Type 8 | open import linear.Context 9 | open import linear.Context.Pointwise as CP 10 | open import linear.Usage 11 | open import linear.Usage.Pointwise as UP 12 | open import linear.Typing 13 | 14 | Extensional : {T : ℕ → Set} (𝓣 : Typing T) → Set 15 | Extensional {T} 𝓣 = 16 | {k : ℕ} {γ δ : Context k} (eqs₁ : Context[ _≡_ ] δ γ) (eqs₂ : Context[ _≡_ ] γ δ) 17 | {Γ Δ : Usages γ} {Γ′ Δ′ : Usages δ} 18 | (EQs₁ : Usages[ _≡_ , UsageEq ] eqs₁ Γ′ Γ) (EQs₂ : Usages[ _≡_ , UsageEq ] eqs₂ Δ Δ′) 19 | {rt : T k} {σ : Type} (t : 𝓣 Γ rt σ Δ) → 𝓣 Γ′ rt σ Δ′ 20 | 21 | extensionalFin : Extensional TFin 22 | extensionalFin 23 | (PEq.refl ∷ eqs₁) (PEq.refl ∷ eqs₂) 24 | (PEq.refl ∷ EQs₁) (PEq.refl ∷ EQs₂) z 25 | with CP.pointwiseEq (CP.trans eqs₁ eqs₂) 26 | | UP.pointwiseEq (UP.trans EQs₁ EQs₂) 27 | ... | PEq.refl | PEq.refl = z 28 | extensionalFin 29 | (PEq.refl ∷ eqs₁) (PEq.refl ∷ eqs₂) 30 | (PEq.refl ∷ EQs₁) (PEq.refl ∷ EQs₂) (s k) = 31 | s extensionalFin eqs₁ eqs₂ EQs₁ EQs₂ k 32 | 33 | 34 | mutual 35 | 36 | extensionalInfer : Extensional TInfer 37 | extensionalInfer eqs₁ eqs₂ EQs₁ EQs₂ (`var k) = 38 | `var extensionalFin eqs₁ eqs₂ EQs₁ EQs₂ k 39 | extensionalInfer eqs₁ eqs₂ EQs₁ EQs₂ (`app f t) = 40 | let f′ = extensionalInfer eqs₁ eqs₂ EQs₁ (coerceʳ eqs₂) f 41 | t′ = extensionalCheck (CP.sym eqs₂) eqs₂ (coerceˡ eqs₂) EQs₂ t 42 | in `app f′ t′ 43 | extensionalInfer eqs₁ eqs₂ EQs₁ EQs₂ (`fst t) = 44 | `fst (extensionalInfer eqs₁ eqs₂ EQs₁ EQs₂ t) 45 | extensionalInfer eqs₁ eqs₂ EQs₁ EQs₂ (`snd t) = 46 | `snd (extensionalInfer eqs₁ eqs₂ EQs₁ EQs₂ t) 47 | extensionalInfer eqs₁ eqs₂ EQs₁ EQs₂ (`case t return σ of l %% r) = 48 | let t′ = extensionalInfer eqs₁ eqs₂ EQs₁ (coerceʳ eqs₂) t 49 | l′ = extensionalCheck (PEq.refl ∷ CP.sym eqs₂) (PEq.refl ∷ eqs₂) 50 | (PEq.refl ∷ coerceˡ eqs₂) (PEq.refl ∷ EQs₂) l 51 | r′ = extensionalCheck (PEq.refl ∷ CP.sym eqs₂) (PEq.refl ∷ eqs₂) 52 | (PEq.refl ∷ coerceˡ eqs₂) (PEq.refl ∷ EQs₂) r 53 | in `case t′ return σ of l′ %% r′ 54 | extensionalInfer eqs₁ eqs₂ EQs₁ EQs₂ (`exfalso σ t) = 55 | `exfalso σ (extensionalInfer eqs₁ eqs₂ EQs₁ EQs₂ t) 56 | extensionalInfer eqs₁ eqs₂ EQs₁ EQs₂ (`cut t) = 57 | `cut $ extensionalCheck eqs₁ eqs₂ EQs₁ EQs₂ t 58 | 59 | extensionalCheck : Extensional TCheck 60 | extensionalCheck eqs₁ eqs₂ EQs₁ EQs₂ (`lam t) = 61 | `lam extensionalCheck (PEq.refl ∷ eqs₁) (PEq.refl ∷ eqs₂) 62 | (PEq.refl ∷ EQs₁ ) (PEq.refl ∷ EQs₂) t 63 | extensionalCheck eqs₁ eqs₂ EQs₁ EQs₂ (`let p ∷= t `in u) = 64 | let t′ = extensionalInfer eqs₁ eqs₂ EQs₁ (coerceʳ eqs₂) t 65 | δ = patternContext p 66 | u′ = extensionalCheck 67 | (CP.refl {γ = δ} CP.++ CP.sym eqs₂) (CP.refl {γ = δ} CP.++ eqs₂) 68 | (UP.refl {Γ = [[ δ ]]} UP.++ coerceˡ eqs₂) (UP.refl {Γ = ]] δ [[} UP.++ EQs₂) 69 | u 70 | in `let p ∷= t′ `in u′ 71 | extensionalCheck eqs₁ eqs₂ EQs₁ EQs₂ `unit = 72 | subst (TCheck _ _ _) (pointwiseEq′ (UP.trans EQs₁ EQs₂)) `unit 73 | extensionalCheck eqs₁ eqs₂ EQs₁ EQs₂ (`prd⊗ a b) = 74 | let a′ = extensionalCheck eqs₁ eqs₂ EQs₁ (coerceʳ eqs₂) a 75 | b′ = extensionalCheck (CP.sym eqs₂) eqs₂ (coerceˡ eqs₂) EQs₂ b 76 | in `prd⊗ a′ b′ 77 | extensionalCheck eqs₁ eqs₂ EQs₁ EQs₂ (`prd& a b) = 78 | `prd& (extensionalCheck eqs₁ eqs₂ EQs₁ EQs₂ a) (extensionalCheck eqs₁ eqs₂ EQs₁ EQs₂ b) 79 | extensionalCheck eqs₁ eqs₂ EQs₁ EQs₂ (`inl t) = 80 | `inl extensionalCheck eqs₁ eqs₂ EQs₁ EQs₂ t 81 | extensionalCheck eqs₁ eqs₂ EQs₁ EQs₂ (`inr t) = 82 | `inr extensionalCheck eqs₁ eqs₂ EQs₁ EQs₂ t 83 | extensionalCheck eqs₁ eqs₂ EQs₁ EQs₂ (`neu t) = 84 | `neu extensionalInfer eqs₁ eqs₂ EQs₁ EQs₂ t 85 | -------------------------------------------------------------------------------- /src/linear/Language.agda: -------------------------------------------------------------------------------- 1 | module linear.Language where 2 | 3 | open import Data.Nat as ℕ 4 | open import Data.Fin 5 | open import Data.Vec hiding ([_]) 6 | 7 | open import linear.Type 8 | open import linear.Scope as Sc hiding (Env) 9 | open import linear.Context hiding (Mergey ; copys) 10 | 11 | mutual 12 | 13 | data Check (n : ℕ) : Set where 14 | `lam_ : (b : Check (suc n)) → Check n 15 | `let_∷=_`in_ : {o : ℕ} (p : Pattern o) (t : Infer n) (u : Check (o ℕ.+ n)) → Check n 16 | `unit : Check n 17 | `prd : (a b : Check n) → Check n 18 | `inl_ : (t : Check n) → Check n 19 | `inr_ : (t : Check n) → Check n 20 | `neu_ : (t : Infer n) → Check n 21 | 22 | data Infer (n : ℕ) : Set where 23 | `var_ : (k : Fin n) → Infer n 24 | `app : (t : Infer n) (u : Check n) → Infer n 25 | `fst_ : (t : Infer n) → Infer n 26 | `snd_ : (t : Infer n) → Infer n 27 | `case_return_of_%%_ : (i : Infer n) (σ : Type) (l r : Check (suc n)) → Infer n 28 | `exfalso : (σ : Type) (i : Infer n) → Infer n 29 | `cut : (t : Check n) (σ : Type) → Infer n 30 | 31 | data Pattern : (m : ℕ) → Set where 32 | `v : Pattern 1 33 | `⟨⟩ : Pattern 0 34 | _,,_ : {m n : ℕ} (p : Pattern m) (q : Pattern n) → Pattern (m ℕ.+ n) 35 | 36 | -- hack 37 | patternSize : {m : ℕ} → Pattern m → ℕ 38 | patternSize {m} _ = m 39 | 40 | mutual 41 | 42 | weakCheck : Weakening Check 43 | weakCheck inc (`lam b) = `lam weakCheck (copy inc) b 44 | weakCheck inc (`let p ∷= t `in u) = `let p ∷= weakInfer inc t `in weakCheck (copys (patternSize p) inc) u 45 | weakCheck inc `unit = `unit 46 | weakCheck inc (`prd a b) = `prd (weakCheck inc a) (weakCheck inc b) 47 | weakCheck inc (`inl t) = `inl weakCheck inc t 48 | weakCheck inc (`inr t) = `inr weakCheck inc t 49 | weakCheck inc (`neu t) = `neu weakInfer inc t 50 | 51 | weakInfer : Weakening Infer 52 | weakInfer inc (`var k) = `var (weakFin inc k) 53 | weakInfer inc (`app i u) = `app (weakInfer inc i) (weakCheck inc u) 54 | weakInfer inc (`fst t) = `fst (weakInfer inc t) 55 | weakInfer inc (`snd t) = `snd (weakInfer inc t) 56 | weakInfer inc (`case i return σ of l %% r) = 57 | `case weakInfer inc i return σ 58 | of weakCheck (copy inc) l 59 | %% weakCheck (copy inc) r 60 | weakInfer inc (`exfalso σ t) = `exfalso σ (weakInfer inc t) 61 | weakInfer inc (`cut t σ) = `cut (weakCheck inc t) σ 62 | 63 | 64 | Env = Sc.Env Infer 65 | 66 | fresheyInfer : Freshey Infer 67 | fresheyInfer = record { fresh = `var zero ; weak = weakInfer } 68 | 69 | mutual 70 | 71 | substCheck : Substituting Infer Check 72 | substCheck ρ (`lam b) = `lam substCheck (v∷ ρ) b 73 | substCheck ρ (`let p ∷= t `in u) = `let p ∷= substInfer ρ t 74 | `in substCheck (withFreshVars (patternSize p) ρ) u 75 | substCheck ρ `unit = `unit 76 | substCheck ρ (`prd a b) = `prd (substCheck ρ a) (substCheck ρ b) 77 | substCheck ρ (`inl t) = `inl substCheck ρ t 78 | substCheck ρ (`inr t) = `inr substCheck ρ t 79 | substCheck ρ (`neu t) = `neu substInfer ρ t 80 | 81 | substInfer : Substituting Infer Infer 82 | substInfer ρ (`var k) = substFin fresheyInfer ρ k 83 | substInfer ρ (`app i u) = `app (substInfer ρ i) (substCheck ρ u) 84 | substInfer ρ (`fst t) = `fst (substInfer ρ t) 85 | substInfer ρ (`snd t) = `snd (substInfer ρ t) 86 | substInfer ρ (`case i return σ of l %% r) = 87 | `case substInfer ρ i return σ 88 | of substCheck (v∷ ρ) l 89 | %% substCheck (v∷ ρ) r 90 | substInfer ρ (`exfalso σ t) = `exfalso σ (substInfer ρ t) 91 | substInfer ρ (`cut t σ) = `cut (substCheck ρ t) σ 92 | -------------------------------------------------------------------------------- /src/linear/Typing/Mix.agda: -------------------------------------------------------------------------------- 1 | module linear.Typing.Mix where 2 | 3 | open import Data.Fin as F 4 | open import Data.Sum as Sum 5 | open import Data.Product as Prod 6 | open import Function 7 | open import Relation.Binary.PropositionalEquality as Eq hiding ([_]) 8 | 9 | open import linear.Context as C 10 | open import linear.Context.Pointwise as CP 11 | open import linear.Usage as U hiding ([_]) 12 | open import linear.Usage.Pointwise as UP 13 | open import linear.Usage.Mix 14 | open import linear.Language 15 | open import linear.Typing 16 | open import linear.Typing.Extensional 17 | 18 | open import linear.Mix 19 | open import linear.Context.Mix hiding (_++ˡ_) 20 | open import linear.Usage.Mix 21 | 22 | splitUsages : 23 | ∀ {m n p} {γ : Context m} {δ : Context n} {θ : Context p} 24 | (p : γ ++ δ ≅ θ) (Γ : Usages θ) → 25 | ∃ λ Γ₁ → ∃ λ Γ₂ → [ p ] Γ₁ ++ Γ₂ ≅ Γ 26 | splitUsages [] [] = [] , [] , [] 27 | splitUsages (a ∷ˡ p) (A ∷ Γ) = 28 | let (Γ₁ , Γ₂ , eq) = splitUsages p Γ 29 | in A ∷ Γ₁ , Γ₂ , A ∷ˡ eq 30 | splitUsages (a ∷ʳ p) (A ∷ Γ) = 31 | let (Γ₁ , Γ₂ , eq) = splitUsages p Γ 32 | in Γ₁ , A ∷ Γ₂ , A ∷ʳ eq 33 | 34 | unsplitUsages : ∀ {m n p} {γ : Context m} {δ : Context n} {θ : Context p} (p : γ ++ δ ≅ θ) 35 | (Γ : Usages γ) (Δ : Usages δ) → 36 | ∃ λ Θ → [ p ] Γ ++ Δ ≅ Θ 37 | unsplitUsages [] [] [] = , [] 38 | unsplitUsages (a ∷ˡ p) (A ∷ Γ) Δ = Prod.map (A ∷_) (A ∷ˡ_) $ unsplitUsages p Γ Δ 39 | unsplitUsages (a ∷ʳ p) Γ (A ∷ Δ) = Prod.map (A ∷_) (A ∷ʳ_) $ unsplitUsages p Γ Δ 40 | 41 | mutual 42 | 43 | mixCheck : Mix TCheck 44 | mixCheck eqΓ eqΔ eqΓ′ eqΔ′ (`lam b) = 45 | Prod.map `lam_ `lam_ $ mixCheck (_ ∷ˡ eqΓ) (_ ∷ˡ eqΔ) (_ ∷ˡ eqΓ′) (_ ∷ˡ eqΔ′) b 46 | mixCheck {p = p} {q} eqΓ eqΔ eqΓ′ eqΔ′ (`let pat ∷= t `in u) = 47 | let (Δ₁ , Δ₂ , eqΔ₁₂) = splitUsages p _ 48 | (Δ′₁₂ , eqΔ′₁₂) = unsplitUsages q Δ₁ Δ₂ 49 | (t , T) = mixInfer eqΓ eqΔ₁₂ eqΓ′ eqΔ′₁₂ t 50 | φ = patternContext pat 51 | (u , U) = mixCheck ([[ φ ]] ++ˡ eqΔ₁₂) (]] φ [[ ++ˡ eqΔ) 52 | ([[ φ ]] ++ˡ eqΔ′₁₂) (]] φ [[ ++ˡ eqΔ′) u 53 | in , `let pat ∷= T `in U 54 | mixCheck eqΓ eqΔ eqΓ′ eqΔ′ `unit = 55 | let (eqΓΔ₁ , eqΓΔ₂) = ≅-inj _ eqΓ eqΔ 56 | eqΔ′′ = subst₂ ([ _ ]_++_≅ _) (Eq.sym eqΓΔ₁) (Eq.sym eqΓΔ₂) eqΔ′ 57 | eq = functionalMix _ eqΓ′ eqΔ′′ 58 | in , subst (TCheck _ _ _) eq `unit 59 | mixCheck {p = p} {q} eqΓ eqΔ eqΓ′ eqΔ′ (`prd⊗ t u) = 60 | let (Δ₁ , Δ₂ , eqΔ₁₂) = splitUsages p _ 61 | (Δ′₁₂ , eqΔ′₁₂) = unsplitUsages q Δ₁ Δ₂ 62 | (t , T) = mixCheck eqΓ eqΔ₁₂ eqΓ′ eqΔ′₁₂ t 63 | (u , U) = mixCheck eqΔ₁₂ eqΔ eqΔ′₁₂ eqΔ′ u 64 | in , `prd⊗ T U 65 | mixCheck eqΓ eqΔ eqΓ′ eqΔ′ (`prd& t u) = 66 | let (t , T) = mixCheck eqΓ eqΔ eqΓ′ eqΔ′ t 67 | (u , U) = mixCheck eqΓ eqΔ eqΓ′ eqΔ′ u 68 | in , `prd& T U 69 | mixCheck eqΓ eqΔ eqΓ′ eqΔ′ (`inl t) = Prod.map `inl_ `inl_ $ mixCheck eqΓ eqΔ eqΓ′ eqΔ′ t 70 | mixCheck eqΓ eqΔ eqΓ′ eqΔ′ (`inr t) = Prod.map `inr_ `inr_ $ mixCheck eqΓ eqΔ eqΓ′ eqΔ′ t 71 | mixCheck eqΓ eqΔ eqΓ′ eqΔ′ (`neu t) = Prod.map `neu_ `neu_ $ mixInfer eqΓ eqΔ eqΓ′ eqΔ′ t 72 | 73 | mixInfer : Mix TInfer 74 | mixInfer eqΓ eqΔ eqΓ′ eqΔ′ (`var k) = Prod.map `var_ `var_ $ mixFin eqΓ eqΔ eqΓ′ eqΔ′ k 75 | mixInfer {p = p} {q} eqΓ eqΔ eqΓ′ eqΔ′ (`app f t) = 76 | let (Δ₁ , Δ₂ , eqΔ₁₂) = splitUsages p _ 77 | (Δ′₁₂ , eqΔ′₁₂) = unsplitUsages q Δ₁ Δ₂ 78 | (f , F) = mixInfer eqΓ eqΔ₁₂ eqΓ′ eqΔ′₁₂ f 79 | (t , T) = mixCheck eqΔ₁₂ eqΔ eqΔ′₁₂ eqΔ′ t 80 | in , `app F T 81 | mixInfer eqΓ eqΔ eqΓ′ eqΔ′ (`fst p) = Prod.map `fst_ `fst_ $ mixInfer eqΓ eqΔ eqΓ′ eqΔ′ p 82 | mixInfer eqΓ eqΔ eqΓ′ eqΔ′ (`snd p) = Prod.map `snd_ `snd_ $ mixInfer eqΓ eqΔ eqΓ′ eqΔ′ p 83 | mixInfer {p = p} {q} eqΓ eqΔ eqΓ′ eqΔ′ (`case t return σ of l %% r) = 84 | let (Δ₁ , Δ₂ , eqΔ₁₂) = splitUsages p _ 85 | (Δ′₁₂ , eqΔ′₁₂) = unsplitUsages q Δ₁ Δ₂ 86 | (t , T) = mixInfer eqΓ eqΔ₁₂ eqΓ′ eqΔ′₁₂ t 87 | (l , L) = mixCheck (_ ∷ˡ eqΔ₁₂) (_ ∷ˡ eqΔ) (_ ∷ˡ eqΔ′₁₂) (_ ∷ˡ eqΔ′) l 88 | (r , R) = mixCheck (_ ∷ˡ eqΔ₁₂) (_ ∷ˡ eqΔ) (_ ∷ˡ eqΔ′₁₂) (_ ∷ˡ eqΔ′) r 89 | in , `case T return σ of L %% R 90 | mixInfer eqΓ eqΔ eqΓ′ eqΔ′ (`exfalso σ t) = 91 | Prod.map (`exfalso σ) (`exfalso σ) $ mixInfer eqΓ eqΔ eqΓ′ eqΔ′ t 92 | mixInfer eqΓ eqΔ eqΓ′ eqΔ′ (`cut t) = Prod.map _ `cut $ mixCheck eqΓ eqΔ eqΓ′ eqΔ′ t 93 | -------------------------------------------------------------------------------- /src/linear/Usage/Functional.agda: -------------------------------------------------------------------------------- 1 | module linear.Usage.Functional where 2 | 3 | open import Data.Nat 4 | open import Data.Fin 5 | open import Data.Vec hiding (_++_ ; tail ; map) 6 | open import Data.Product 7 | open import Function 8 | open import Relation.Binary.PropositionalEquality 9 | 10 | open import linear.Scope as Sc hiding (Env) 11 | open import linear.Type 12 | open import linear.Context as C hiding (_++_) 13 | open import linear.Usage 14 | open import linear.Relation.Functional 15 | 16 | R++ : {o k : ℕ} (δ : Context o) (γ : Context k) (ΔΓ : Usages (δ C.++ γ)) → (i : Usages δ) (o : Usages γ) → Set 17 | R++ δ γ ΔΓ Δ Γ = ΔΓ ≡ (Δ ++ Γ) 18 | 19 | functional++ : {o k : ℕ} {δ : Context o} {γ : Context k} {ΔΓ : Usages (δ C.++ γ)} → Functional′ (R++ δ γ ΔΓ) 20 | functional++ [] refl refl = refl 21 | functional++ (A ∷ Δ) eq₁ eq₂ = functional++ Δ (cong tail eq₁) (cong tail eq₂) 22 | 23 | RFin : (k : Σ[ n ∈ ℕ ] Context n × Fin n) → (let (_ , γ , _) = k in Usages γ × Usages γ) → Type → Set 24 | RFin (_ , _ , k) (Γ , Δ) σ = Γ ⊢ k ∈[ σ ]⊠ Δ 25 | 26 | functionalFin : Functional RFin 27 | functionalFin _ z z = refl 28 | functionalFin _ (s k₁) (s k₂) = cong _ $ functionalFin _ k₁ k₂ 29 | 30 | RFinPost : (k : Σ[ n ∈ ℕ ] Σ[ γ ∈ Context n ] Usages γ × Fin n) → 31 | (let (_ , γ , _) = k in Type × Usages γ) → Set 32 | RFinPost (_ , _ , Γ , k) (A , Δ) = Γ ⊢ k ∈[ A ]⊠ Δ 33 | 34 | RFinPre : (k : Σ[ n ∈ ℕ ] Σ[ γ ∈ Context n ] Usages γ × Fin n) → 35 | (let (_ , γ , _) = k in Type × Usages γ) → Set 36 | RFinPre (_ , _ , Δ , k) (A , Γ) = Γ ⊢ k ∈[ A ]⊠ Δ 37 | 38 | functionalFinPost : Functional′ RFinPost 39 | functionalFinPost _ z z = refl 40 | functionalFinPost _ (s k₁) (s k₂) = cong (map id _) $ functionalFinPost _ k₁ k₂ 41 | 42 | functionalFinPre : Functional′ RFinPre 43 | functionalFinPre _ z z = refl 44 | functionalFinPre _ (s k₁) (s k₂) = cong _ $ functionalFinPre _ k₁ k₂ 45 | 46 | InferTypingPost : 47 | {T : ℕ → Set} (𝓣 : Typing T) (i : Σ[ n ∈ ℕ ] Σ[ γ ∈ Context n ] Usages γ × T n) → 48 | (let (_ , γ , _) = i in Type × Usages γ) → Set 49 | InferTypingPost 𝓣 (_ , _ , Γ , t) (A , Δ) = 𝓣 Γ t A Δ 50 | 51 | CheckTypingPost : 52 | {T : ℕ → Set} (𝓣 : Typing T) (i : Σ[ n ∈ ℕ ] Σ[ γ ∈ Context n ] Usages γ × Type × T n) → 53 | (let (_ , γ , _) = i in Usages γ) → Set 54 | CheckTypingPost 𝓣 (_ , _ , Γ , A , t) Δ = 𝓣 Γ t A Δ 55 | 56 | REnvPost : 57 | {E : ℕ → Set} (𝓔 : Typing E) 58 | (i : Σ[ k ∈ ℕ ] Σ[ l ∈ ℕ ] Σ[ θ ∈ Context l ] Usages θ × Sc.Env E k l × Σ[ γ ∈ Context k ] Usages γ) → 59 | (let (_ , l , θ , _) = i in Usages θ) → Set 60 | REnvPost 𝓔 (_ , _ , _ , Τ₁ , ρ , _ , Γ) Τ₂ = Env 𝓔 Τ₁ ρ Τ₂ Γ 61 | 62 | functionalEnvPost : 63 | {E : ℕ → Set} {𝓔 : Typing E} → Functional′ (InferTypingPost 𝓔) → Functional′ (REnvPost 𝓔) 64 | functionalEnvPost det𝓔 _ [] [] = refl 65 | functionalEnvPost det𝓔 _ (T₁ ∷ ρ₁) (T₂ ∷ ρ₂) rewrite cong proj₂ (det𝓔 _ T₁ T₂) = functionalEnvPost det𝓔 _ ρ₁ ρ₂ 66 | functionalEnvPost det𝓔 _ (─∷ ρ₁) (─∷ ρ₂) = functionalEnvPost det𝓔 _ ρ₁ ρ₂ 67 | functionalEnvPost det𝓔 _ ([v]∷ ρ₁) ([v]∷ ρ₂) = cong _ $ functionalEnvPost det𝓔 _ ρ₁ ρ₂ 68 | functionalEnvPost det𝓔 _ (]v[∷ ρ₁) (]v[∷ ρ₂) = cong _ $ functionalEnvPost det𝓔 _ ρ₁ ρ₂ 69 | 70 | InferTypingPre : 71 | {T : ℕ → Set} (𝓣 : Typing T) (i : Σ[ n ∈ ℕ ] Σ[ γ ∈ Context n ] Usages γ × T n) → 72 | (let (_ , γ , _) = i in Type × Usages γ) → Set 73 | InferTypingPre 𝓣 (_ , _ , Δ , t) (A , Γ) = 𝓣 Γ t A Δ 74 | 75 | CheckTypingPre : 76 | {T : ℕ → Set} (𝓣 : Typing T) (i : Σ[ n ∈ ℕ ] Σ[ γ ∈ Context n ] Usages γ × Type × T n) → 77 | (let (_ , γ , _) = i in Usages γ) → Set 78 | CheckTypingPre 𝓣 (_ , _ , Δ , A , t) Γ = 𝓣 Γ t A Δ 79 | 80 | REnvPre : 81 | {E : ℕ → Set} (𝓔 : Typing E) 82 | (i : Σ[ k ∈ ℕ ] Σ[ l ∈ ℕ ] Σ[ θ ∈ Context l ] Usages θ × Sc.Env E k l × Σ[ γ ∈ Context k ] Usages γ) → 83 | (let (_ , l , θ , _) = i in Usages θ) → Set 84 | REnvPre 𝓔 (_ , _ , _ , Τ₂ , ρ , _ , Γ) Τ₁ = Env 𝓔 Τ₁ ρ Τ₂ Γ 85 | 86 | functionalEnvPre : 87 | {E : ℕ → Set} {𝓔 : Typing E} → Functional′ (InferTypingPre 𝓔) → Functional′ (REnvPre 𝓔) 88 | functionalEnvPre det𝓔 _ [] [] = refl 89 | functionalEnvPre det𝓔 _ (T₁ ∷ ρ₁) (T₂ ∷ ρ₂) rewrite functionalEnvPre det𝓔 _ ρ₁ ρ₂ = cong proj₂ (det𝓔 _ T₁ T₂) 90 | functionalEnvPre det𝓔 _ (─∷ ρ₁) (─∷ ρ₂) = functionalEnvPre det𝓔 _ ρ₁ ρ₂ 91 | functionalEnvPre det𝓔 _ ([v]∷ ρ₁) ([v]∷ ρ₂) = cong _ $ functionalEnvPre det𝓔 _ ρ₁ ρ₂ 92 | functionalEnvPre det𝓔 _ (]v[∷ ρ₁) (]v[∷ ρ₂) = cong _ $ functionalEnvPre det𝓔 _ ρ₁ ρ₂ 93 | 94 | InferTyping : 95 | {T : ℕ → Set} (𝓣 : Typing T) (ri : Σ[ n ∈ ℕ ] Σ[ γ ∈ Context n ] T n) 96 | (ii : let (_ , γ , _) = ri in Usages γ × Usages γ) (o : Type) → Set 97 | InferTyping 𝓣 (_ , _ , t) (Γ , Δ) A = 𝓣 Γ t A Δ 98 | -------------------------------------------------------------------------------- /src/linear/Usage/Pointwise.agda: -------------------------------------------------------------------------------- 1 | module linear.Usage.Pointwise where 2 | 3 | open import Data.Nat 4 | open import Function 5 | open import Relation.Binary.PropositionalEquality as PEq using (_≡_ ; cong ; subst) 6 | 7 | open import linear.Type 8 | open import linear.Scope as Sc hiding (copys) 9 | open import linear.Context as C hiding (_++_ ; copys) 10 | open import linear.Context.Pointwise as CP using (Context[_] ; [] ; _∷_) 11 | open import linear.Usage as U hiding (_++_ ; copys) 12 | 13 | data Usages[_,_] 14 | (R : (σ τ : Type) → Set) 15 | (𝓡 : {σ τ : Type} → R σ τ → (S : Usage σ) (T : Usage τ) → Set) : 16 | {k : ℕ} {γ δ : Context k} (rs : Context[ R ] γ δ) → 17 | (Γ : Usages γ) (Δ : Usages δ) → Set where 18 | 19 | [] : Usages[ R , 𝓡 ] [] [] [] 20 | 21 | _∷_ : {σ τ : Type} {r : R σ τ} {S : Usage σ} {T : Usage τ} 22 | {k : ℕ} {γ δ : Context k} {rs : Context[ R ] γ δ} {Γ : Usages γ} {Δ : Usages δ} → 23 | 𝓡 r S T → Usages[ R , 𝓡 ] rs Γ Δ → 24 | Usages[ R , 𝓡 ] (r ∷ rs) (S ∷ Γ) (T ∷ Δ) 25 | 26 | _++_ : {R : (σ τ : Type) → Set} {𝓡 : {σ τ : Type} → R σ τ → Usage σ → Usage τ → Set} 27 | {k l : ℕ} {γ γ′ : Context k} {δ δ′ : Context l} → 28 | {rs : Context[ R ] γ γ′} {ss : Context[ R ] δ δ′} → 29 | {Γ : Usages γ} {Γ′ : Usages γ′} {Δ : Usages δ} {Δ′ : Usages δ′} → 30 | Usages[ R , 𝓡 ] rs Γ Γ′ → Usages[ R , 𝓡 ] ss Δ Δ′ → 31 | Usages[ R , 𝓡 ] (rs CP.++ ss) (Γ U.++ Δ) (Γ′ U.++ Δ′) 32 | [] ++ SS = SS 33 | (R ∷ RS) ++ SS = R ∷ (RS ++ SS) 34 | 35 | 36 | UsageEq : {σ τ : Type} → σ ≡ τ → Usage σ → Usage τ → Set 37 | UsageEq eq rewrite eq = _≡_ 38 | 39 | refl : {k : ℕ} {γ : Context k} {Γ : Usages γ} → Usages[ _≡_ , UsageEq ] CP.refl Γ Γ 40 | refl {Γ = []} = [] 41 | refl {Γ = S ∷ Γ} = PEq.refl ∷ refl 42 | 43 | fromEq : {k : ℕ} {γ : Context k} {Γ Δ : Usages γ} (pr : Γ ≡ Δ) → 44 | Usages[ _≡_ , UsageEq ] CP.refl Γ Δ 45 | fromEq PEq.refl = refl 46 | 47 | sym : {k : ℕ} {γ δ : Context k} {eq : Context[ _≡_ ] γ δ} {Γ : Usages γ} {Δ : Usages δ} → 48 | Usages[ _≡_ , UsageEq ] eq Γ Δ → Usages[ _≡_ , UsageEq ] (CP.sym eq) Δ Γ 49 | sym [] = [] 50 | sym {eq = PEq.refl ∷ _} (EQ ∷ EQs) = PEq.sym EQ ∷ sym EQs 51 | 52 | trans : 53 | {k : ℕ} {γ δ θ : Context k} {eq₁ : Context[ _≡_ ] γ δ} {eq₂ : Context[ _≡_ ] δ θ} → 54 | {Γ : Usages γ} {Δ : Usages δ} {Θ : Usages θ} → 55 | Usages[ _≡_ , UsageEq ] eq₁ Γ Δ → Usages[ _≡_ , UsageEq ] eq₂ Δ Θ → 56 | Usages[ _≡_ , UsageEq ] (CP.trans eq₁ eq₂) Γ Θ 57 | trans [] [] = [] 58 | trans {eq₁ = PEq.refl ∷ _} {eq₂ = PEq.refl ∷ _} 59 | (EQ₁ ∷ EQs₁) (EQ₂ ∷ EQs₂) = PEq.trans EQ₁ EQ₂ ∷ trans EQs₁ EQs₂ 60 | 61 | irrelevance : 62 | {k : ℕ} {γ δ : Context k} {eq₁ : Context[ _≡_ ] γ δ} (eq₂ : Context[ _≡_ ] γ δ) 63 | {Γ : Usages γ} {Δ : Usages δ} → 64 | Usages[ _≡_ , UsageEq ] eq₁ Γ Δ → Usages[ _≡_ , UsageEq ] eq₂ Γ Δ 65 | irrelevance [] [] = [] 66 | irrelevance {eq₁ = PEq.refl ∷ _} (PEq.refl ∷ eqs) (EQ ∷ EQs) = EQ ∷ irrelevance eqs EQs 67 | 68 | 69 | -- coercion 70 | coerce : {k : ℕ} {γ δ : Context k} → Context[ _≡_ ] γ δ → Usages γ → Usages δ 71 | coerce [] [] = [] 72 | coerce (eq ∷ eqs) (S ∷ Γ) = subst Usage eq S ∷ coerce eqs Γ 73 | 74 | coerceʳ : {k : ℕ} {γ δ : Context k} {Γ : Usages γ} (eq : Context[ _≡_ ] γ δ) → 75 | Usages[ _≡_ , UsageEq ] eq Γ (coerce eq Γ) 76 | coerceʳ {Γ = []} [] = [] 77 | coerceʳ {Γ = S ∷ Γ} (PEq.refl ∷ eq) = PEq.refl ∷ coerceʳ eq 78 | 79 | coerceˡ : {k : ℕ} {γ δ : Context k} {Γ : Usages γ} (eq : Context[ _≡_ ] γ δ) → 80 | Usages[ _≡_ , UsageEq ] (CP.sym eq) (coerce eq Γ) Γ 81 | coerceˡ {Γ = []} [] = [] 82 | coerceˡ {Γ = S ∷ Γ} (PEq.refl ∷ eq) = PEq.refl ∷ coerceˡ eq 83 | 84 | -- copys 85 | copys : 86 | {k l o : ℕ} {m : Sc.Mergey k l} {M : C.Mergey m} {𝓜 : U.Mergey M} 87 | {γ : Context k} {Γ : Usages γ} {δ : Context o} (Δ : Usages δ) → 88 | Usages[ _≡_ , UsageEq ] (CP.copys δ) ((Δ U.++ Γ) U.⋈ U.copys o 𝓜) (Δ U.++ (Γ U.⋈ 𝓜)) 89 | copys [] = refl 90 | copys (T ∷ Δ) = PEq.refl ∷ (copys Δ) 91 | 92 | pointwiseEq′ : {k : ℕ} {γ : Context k} {eq : Context[ _≡_ ] γ γ} {Γ Δ : Usages γ} → 93 | Usages[ _≡_ , UsageEq ] eq Γ Δ → Γ ≡ Δ 94 | pointwiseEq′ [] = PEq.refl 95 | pointwiseEq′ {eq = PEq.refl ∷ eqs} (PEq.refl ∷ EQs) = cong (_ ∷_) $ pointwiseEq′ EQs 96 | 97 | pointwiseEq : 98 | {k : ℕ} {γ δ : Context k} {eq : Context[ _≡_ ] γ δ} 99 | {Γ : Usages γ} {Δ : Usages δ} → Usages[ _≡_ , UsageEq ] eq Γ Δ → 100 | subst Usages (CP.pointwiseEq eq) Γ ≡ Δ 101 | pointwiseEq {eq = eq} EQ with CP.pointwiseEq eq 102 | pointwiseEq EQ | PEq.refl = pointwiseEq′ EQ 103 | -------------------------------------------------------------------------------- /doc/types17-slides/types17.tex: -------------------------------------------------------------------------------- 1 | \documentclass{beamer} 2 | \usetheme{ru} 3 | \usepackage{xcolor} 4 | \usepackage{amssymb} 5 | \usepackage{mathpartir} 6 | 7 | \newcommand{\inval}[1]{\colorbox{blue!40}{$#1$}} 8 | \newcommand{\outval}[1]{\colorbox{orange!50}{$#1$}} 9 | \newcommand{\fresh}[1]{f_{#1}} 10 | \newcommand{\stale}[1]{s_{#1}} 11 | 12 | \title{Typing with Leftovers} 13 | \subtitle{A Mechanisation of Intuitionistic Linear Logic} 14 | \author{Guillaume Allais} 15 | \date{May 29th, 2017} 16 | \institute[TYPES'17]{ 17 | TYPES 2017 \\ 18 | Budapest, Hungary} 19 | 20 | \begin{document} 21 | 22 | \maketitle 23 | 24 | \begin{frame}{Introduction rule for tensor: Contexts as Multisets} 25 | 26 | \begin{mathpar} 27 | \inferrule 28 | {Γ ⊢ σ \and Δ ⊢ τ 29 | }{Γ, Δ ⊢ σ ⊗ τ 30 | }{⊗_i} 31 | \end{mathpar} 32 | 33 | \begin{itemize} 34 | \item<2-> Multisets are an extensional notion 35 | \item<3-> Going bottom-up (typechecking), one needs to guess a split 36 | \end{itemize} 37 | \end{frame} 38 | 39 | \begin{frame}{Introduction rule for tensor: Contexts as Lists} 40 | \begin{itemize} 41 | \item Either explicit commutation rules 42 | \begin{mathpar} 43 | \inferrule 44 | {Γ, σ, τ, Δ ⊢ ν 45 | }{Γ, τ, σ, Δ ⊢ ν 46 | }{swap} 47 | \end{mathpar} 48 | 49 | \item Or introduction rules with reordering ``on the fly'': 50 | \begin{mathpar} 51 | \inferrule 52 | {Γ ⊢ σ \and Δ ⊢ τ \and Γ, Δ ≈ Θ 53 | }{Θ ⊢ σ ⊗ τ 54 | }{⊗_i} 55 | \end{mathpar} 56 | \end{itemize} 57 | 58 | \begin{itemize} 59 | \item<2-> Non structural 60 | \item<2-> The user has to provide the split / permutation by hand 61 | \end{itemize} 62 | \end{frame} 63 | 64 | \begin{frame}{Introduction rule for tensor: Contexts as Available Resources} 65 | \begin{mathpar} 66 | \inferrule 67 | {\inval{Γ} ⊢ \inval{σ} ⊠ \outval{Δ} \and \inval{Δ} ⊢ \inval{τ} ⊠ \outval{Θ} 68 | }{\inval{Γ} ⊢ \inval{σ ⊗ τ} ⊠ \outval{Θ} 69 | }{⊗_i} 70 | \end{mathpar} 71 | 72 | \begin{itemize} 73 | \item \inval{Inputs} vs. \outval{Outputs} 74 | \item<2-> Nothing to guess: syntax directed 75 | \item<3-> However the scope keeps changing! 76 | \end{itemize} 77 | \end{frame} 78 | 79 | \begin{frame}{Variant: Contexts as Resource Annotations} 80 | \begin{mathpar} 81 | \inferrule 82 | {n : ℕ \and 83 | γ : Context_n \and 84 | Γ, Δ : Usage_γ \and 85 | σ : Type 86 | }{ 87 | \inval{Γ} ⊢ \inval{σ} ⊠ \outval{Δ} : Set 88 | } 89 | \end{mathpar} 90 | 91 | \begin{columns} 92 | \begin{column}{0.5\textwidth} 93 | \begin{mathpar} 94 | \inferrule 95 | { 96 | }{ 97 | \inval{Γ, \fresh{σ}} ⊢ \inval{σ} ⊠ \outval{Γ, \stale{σ}} 98 | }{ax} 99 | \end{mathpar} 100 | \end{column} 101 | \begin{column}{0.5\textwidth} 102 | \begin{mathpar} 103 | \inferrule 104 | {\inval{Γ} ⊢ \inval{σ} ⊠ \outval{Δ} 105 | }{ 106 | \inval{Γ, s} ⊢ \inval{σ} ⊠ \outval{Δ, s} 107 | }{wk} 108 | \end{mathpar} 109 | \end{column} 110 | \end{columns} 111 | 112 | \begin{itemize} 113 | \item<2-> Context shared across the whole derivation 114 | \item<3-> The Axiom rule corresponds to consumption 115 | \item<4-> A notion of weakening: some resources don't matter (yet) 116 | \end{itemize} 117 | \end{frame} 118 | 119 | \begin{frame}{With Well Scoped Terms, Bidirectionally} 120 | \begin{columns} 121 | \begin{column}{0.5\textwidth} 122 | \begin{mathpar} 123 | \inferrule 124 | {n : ℕ \and 125 | γ : Context_n \\ 126 | t : Check_n \\ 127 | Γ, Δ : Usage_γ \\ 128 | σ : Type 129 | }{ 130 | \inval{Γ} ⊢ \inval{σ} ∋ \inval{t} ⊠ \outval{Δ} : Set 131 | } 132 | \end{mathpar} 133 | \end{column} 134 | \begin{column}{0.5\textwidth} 135 | \begin{mathpar} 136 | \inferrule 137 | {n : ℕ \and 138 | γ : Context_n \\ 139 | t : Infer_n \\ 140 | Γ, Δ : Usage_γ \\ 141 | σ : Type 142 | }{ 143 | \inval{Γ} ⊢ \inval{t} ∈ \outval{σ} ⊠ \outval{Δ} : Set 144 | } 145 | \end{mathpar} 146 | \end{column} 147 | \end{columns} 148 | 149 | \begin{itemize} 150 | \item<2-> Fully syntax-directed (same constructors for $λ$C \& TwL) 151 | \item<3-> Fully compatible with operations on $λ$C 152 | \end{itemize} 153 | \end{frame} 154 | 155 | \begin{frame}{Theorems} 156 | \begin{tabular}{ll} 157 | Framing & Unused resources can be in any state \\ 158 | Weakening & One can add resources, they will be ignored \\ 159 | Substitution & Parallel linear substitutions yield valid terms \\ 160 | Functionality & The relation is deterministic (backward \& forward) \\ 161 | Typechecking & Type checking / inference is decidable \\ 162 | Soudness & Derivations in TwL give rise to sequents in ILL \\ 163 | Completeness & Sequents in ILL give rise to derivations in TwL \\ 164 | \end{tabular} 165 | \end{frame} 166 | 167 | \begin{frame}[fragile]{Thanks for Your Attention} 168 | All of this work has been formalised in Agda. 169 | It is available at: 170 | 171 | \url{https://github.com/gallais/typing-with-leftovers} 172 | \end{frame} 173 | 174 | \end{document} 175 | -------------------------------------------------------------------------------- /src/linear/Surface/Parser.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE OverloadedStrings #-} 2 | {-# LANGUAGE DeriveFunctor #-} 3 | {-# LANGUAGE DeriveFoldable #-} 4 | {-# LANGUAGE DeriveTraversable #-} 5 | 6 | module Surface.Parser where 7 | 8 | import Type.Parser 9 | import Data.Text 10 | 11 | import Control.Applicative 12 | import Control.Monad 13 | import Data.ByteString (ByteString) 14 | import Data.Attoparsec.ByteString 15 | import Data.Attoparsec.Combinator 16 | import Data.Attoparsec.ByteString.Char8 17 | 18 | type Identifier = Text 19 | 20 | reservedKeywords :: [String] 21 | reservedKeywords = 22 | [ "let", "in", "case", "return", "of", "inl", "inr" , "fst" , "snd" , "exfalso" ] 23 | 24 | pIdentifier :: Parser Identifier 25 | pIdentifier = do 26 | id <- many1' letter_ascii 27 | guard (id `notElem` reservedKeywords) 28 | return $ Data.Text.pack id 29 | 30 | data CheckF b = 31 | Lam Identifier (CheckF b) 32 | | Let Pattern (InferF b) (CheckF b) 33 | | One 34 | | Prd (CheckF b) (CheckF b) 35 | | Inl (CheckF b) 36 | | Inr (CheckF b) 37 | | Neu (InferF b) 38 | deriving (Show, Functor, Foldable, Traversable) 39 | 40 | type RCheck = CheckF String 41 | type Check = CheckF Integer 42 | 43 | pRCheck :: Parser RCheck 44 | pRCheck = Lam <$> (string "\\" *> skipSpace 45 | *> pIdentifier <* betweenSpace (string ".")) 46 | <*> pRCheck 47 | <|> Let <$> (string "let" *> betweenSpace pPattern) 48 | <*> (string "=" *> betweenSpace pRInfer) 49 | <*> (string "in" *> skipSpace *> pRCheck) 50 | <|> One <$ string "()" 51 | <|> Prd <$> (string "(" *> betweenSpace pRCheck) 52 | <*> (string "," *> betweenSpace pRCheck <* string ")") 53 | <|> Inl <$> (string "inl" *> skipSpace *> pRCheck) 54 | <|> Inr <$> (string "inr" *> skipSpace *> pRCheck) 55 | <|> Neu <$> pRInfer 56 | 57 | data InferF b = 58 | Var Identifier 59 | | App (InferF b) (CheckF b) 60 | | Fst (InferF b) 61 | | Snd (InferF b) 62 | | Cas (InferF b) (TypeF b) Identifier (CheckF b) Identifier (CheckF b) 63 | | ExF (TypeF b) (InferF b) 64 | | Cut (CheckF b) (TypeF b) 65 | deriving (Show, Functor, Foldable, Traversable) 66 | 67 | type RInfer = InferF String 68 | type Infer = InferF Integer 69 | 70 | pRVar :: Parser RInfer 71 | pRVar = Var <$> pIdentifier 72 | 73 | pRCut :: Parser RInfer 74 | pRCut = Cut <$> (string "(" *> betweenSpace pRCheck) 75 | <*> (string ":" *> betweenSpace pRType <* string ")") 76 | 77 | pRNut :: Parser RInfer 78 | pRNut = pRVar <|> pRCut 79 | 80 | pRArg :: Parser RCheck 81 | pRArg = Neu <$> pRVar 82 | <|> string "(" *> betweenSpace pRCheck <* string ")" 83 | 84 | chainl1 :: Parser a -> Parser b -> Parser (a -> b -> a) -> Parser a 85 | chainl1 p q op = p >>= rest 86 | where rest x = (op <*> return x <*> q >>= rest) <|> return x 87 | 88 | pRInfer :: Parser RInfer 89 | pRInfer = (chainl1 pRInfer2 pRArg $ App <$ string " " <* skipSpace) 90 | <|> pRInfer2 91 | 92 | pRInfer2 :: Parser RInfer 93 | pRInfer2 = Fst <$> (string "fst" *> skipSpace *> pRInfer2) 94 | <|> Snd <$> (string "snd" *> skipSpace *> pRInfer2) 95 | <|> Cas <$> (string "case" *> betweenSpace pRInfer) 96 | <*> (string "return" *> betweenSpace pRType) 97 | <*> (string "of" *> betweenSpace pIdentifier) 98 | <*> (string "->" *> betweenSpace pRCheck) 99 | <*> (string "|" *> betweenSpace pIdentifier) 100 | <*> (string "->" *> skipSpace *> pRCheck) 101 | <|> ExF <$> (string "exfalso" *> skipSpace *> pRType) 102 | <*> (skipSpace *> pRInfer2) 103 | <|> pRNut 104 | <|> string "(" *> skipSpace *> pRInfer <* skipSpace <* string ")" 105 | 106 | data Pattern = 107 | All Identifier 108 | | Uni 109 | | And Pattern Pattern 110 | deriving Show 111 | 112 | pPattern2 :: Parser Pattern 113 | pPattern2 = And <$> pPattern <* skipSpace 114 | <* string "," <* skipSpace 115 | <*> pPattern2 116 | <|> Uni <$ string "()" 117 | <|> pPattern 118 | 119 | pPattern :: Parser Pattern 120 | pPattern = All <$> pIdentifier 121 | <|> string "(" *> pPattern2 <* string ")" 122 | 123 | pRProblem :: Parser (RType, RCheck) 124 | pRProblem = (,) <$> (pRType <* betweenSpace (string ":")) 125 | <*> pRCheck 126 | 127 | newtype IPair f g a = IPair { runIPair :: (f a, g a) } 128 | deriving (Functor, Foldable, Traversable) 129 | 130 | pProblem :: Parser (Type , Check) 131 | pProblem = fmap runIPair $ reifyNames $ fmap IPair pRProblem 132 | 133 | fromRight :: Either a b -> Maybe b 134 | fromRight = either (const Nothing) Just 135 | 136 | parseProblem :: ByteString -> Maybe (Type , Check) 137 | parseProblem = fromRight . parseOnly (pProblem <* skipSpace <* endOfInput) 138 | 139 | parseProblems :: ByteString -> Maybe [(Type, Check)] 140 | parseProblems = fromRight . parseOnly (many (pProblem <* skipSpace) <* endOfInput) 141 | -------------------------------------------------------------------------------- /src/linear/Mix.agda: -------------------------------------------------------------------------------- 1 | module linear.Mix where 2 | 3 | open import Data.Fin as F 4 | open import Data.Sum as Sum 5 | open import Data.Product as Prod 6 | open import Function 7 | open import Relation.Binary.PropositionalEquality as Eq hiding ([_]) 8 | 9 | open import linear.Context as C 10 | open import linear.Context.Pointwise as CP 11 | open import linear.Context.Mix 12 | open import linear.Usage as U hiding ([_]) 13 | open import linear.Usage.Pointwise as UP 14 | open import linear.Usage.Mix 15 | open import linear.Typing.Extensional 16 | 17 | Mix : ∀ {T} → Typing T → Set 18 | Mix {T} 𝓣 = 19 | ∀ {l m n o} {γ : Context l} {δ : Context m} {θ : Context n} {ξ : Context o} 20 | {Γ₁ Γ₂ Δ₁ Δ₂ Γ Γ′ Δ Δ′ t σ} {p : γ ++ δ ≅ θ} {q : γ ++ δ ≅ ξ} → 21 | [ p ] Γ₁ ++ Γ₂ ≅ Γ → [ p ] Δ₁ ++ Δ₂ ≅ Δ → 22 | [ q ] Γ₁ ++ Γ₂ ≅ Γ′ → [ q ] Δ₁ ++ Δ₂ ≅ Δ′ → 23 | 𝓣 Γ t σ Δ → ∃ λ t → 𝓣 Γ′ t σ Δ′ 24 | 25 | splitFin : 26 | ∀ {m n p} {γ : Context m} {δ : Context n} {θ : Context p} 27 | {Γ₁ Γ₂ Δ₁ Δ₂ Γ Δ k σ} (p : γ ++ δ ≅ θ) → 28 | [ p ] Γ₁ ++ Γ₂ ≅ Γ → [ p ] Δ₁ ++ Δ₂ ≅ Δ → 29 | Γ ⊢ k ∈[ σ ]⊠ Δ → (∃ λ k → Γ₁ ⊢ k ∈[ σ ]⊠ Δ₁ × Γ₂ ≡ Δ₂) 30 | ⊎ (∃ λ k → Γ₂ ⊢ k ∈[ σ ]⊠ Δ₂ × Γ₁ ≡ Δ₁) 31 | splitFin [] [] [] () 32 | splitFin (σ ∷ˡ p) (_ ∷ˡ eq₁) (_ ∷ˡ eq₂) z 33 | rewrite proj₁ (≅-inj p eq₁ eq₂) = inj₁ (, z , proj₂ (≅-inj p eq₁ eq₂)) 34 | splitFin (σ ∷ʳ p) (_ ∷ʳ eq₁) (_ ∷ʳ eq₂) z 35 | rewrite proj₂ (≅-inj p eq₁ eq₂) = inj₂ (, z , proj₁ (≅-inj p eq₁ eq₂)) 36 | splitFin (σ ∷ˡ p) (u ∷ˡ eq₁) (.u ∷ˡ eq₂) (s K) = 37 | Sum.map 38 | (Prod.map F.suc (Prod.map s_ id)) 39 | (Prod.map id (Prod.map id (cong (u ∷_)))) 40 | $ splitFin p eq₁ eq₂ K 41 | splitFin (σ ∷ʳ p) (u ∷ʳ eq₁) (.u ∷ʳ eq₂) (s K) = 42 | Sum.map 43 | (Prod.map id (Prod.map id (cong (u ∷_)))) 44 | (Prod.map F.suc (Prod.map s_ id)) 45 | $ splitFin p eq₁ eq₂ K 46 | 47 | unsplitContext : ∀ {m n p} {γ : Context m} {δ : Context n} {θ : Context p} (p : γ ++ δ ≅ θ) → 48 | ∃ λ (mM₁ : ∃ C.Mergey) → 49 | ∃ λ (mM₂ : ∃ C.Mergey) → 50 | Context[ _≡_ ] θ (γ C.⋈ proj₂ mM₁) 51 | × Context[ _≡_ ] θ (δ C.⋈ proj₂ mM₂) 52 | unsplitContext [] = (, finish) , (, finish) , ([] , []) 53 | unsplitContext (σ ∷ˡ p) = 54 | let ((_ , M₁) , (_ , M₂) , eq₁ , eq₂) = unsplitContext p 55 | in (, copy M₁) , (, insert σ M₂) , Eq.refl ∷ eq₁ , Eq.refl ∷ eq₂ 56 | unsplitContext (σ ∷ʳ p) = 57 | let ((m₁ , M₁) , (m₂ , M₂) , eq₁ , eq₂) = unsplitContext p 58 | in (, insert σ M₁) , (, copy M₂) , Eq.refl ∷ eq₁ , Eq.refl ∷ eq₂ 59 | 60 | 61 | unsplitUsages₁ : 62 | ∀ {m n p} {γ : Context m} {δ : Context n} {θ : Context p} 63 | (p : γ ++ δ ≅ θ) (Δ : Usages δ) → 64 | let ((_ , M₁) , _) = unsplitContext p 65 | in U.Mergey M₁ 66 | unsplitUsages₁ [] Δ = finish 67 | unsplitUsages₁ (a ∷ˡ p) Δ = copy (unsplitUsages₁ p Δ) 68 | unsplitUsages₁ (a ∷ʳ p) (A ∷ Δ) = insert A (unsplitUsages₁ p Δ) 69 | 70 | unsplitUsages₁-eq : 71 | ∀ {m n p} {γ : Context m} {δ : Context n} {θ : Context p} {p : γ ++ δ ≅ θ} {Δ : Usages δ} → 72 | let ((_ , M₁) , _ , eq₁ , _) = unsplitContext p in 73 | ∀ {Γ Θ} → [ p ] Γ ++ Δ ≅ Θ → Usages[ _≡_ , UsageEq ] eq₁ Θ (Γ U.⋈ unsplitUsages₁ p Δ) 74 | unsplitUsages₁-eq [] = [] 75 | unsplitUsages₁-eq (S ∷ˡ eq) = Eq.refl ∷ (unsplitUsages₁-eq eq) 76 | unsplitUsages₁-eq (S ∷ʳ eq) = Eq.refl ∷ (unsplitUsages₁-eq eq) 77 | 78 | unsplitUsages₂ : 79 | ∀ {m n p} {γ : Context m} {δ : Context n} {θ : Context p} (p : γ ++ δ ≅ θ) (Γ : Usages γ) → 80 | let (_ , (_ , M₂) , _) = unsplitContext p 81 | in U.Mergey M₂ 82 | unsplitUsages₂ [] Γ = finish 83 | unsplitUsages₂ (a ∷ˡ p) (A ∷ Γ) = insert A (unsplitUsages₂ p Γ) 84 | unsplitUsages₂ (a ∷ʳ p) Γ = copy (unsplitUsages₂ p Γ) 85 | 86 | unsplitUsages₂-eq : 87 | ∀ {m n p} {γ : Context m} {δ : Context n} {θ : Context p} {p : γ ++ δ ≅ θ} {Γ : Usages γ} → 88 | let (_ , (_ , M₂) , _ , eq₂) = unsplitContext p in 89 | ∀ {Δ Θ} → [ p ] Γ ++ Δ ≅ Θ → Usages[ _≡_ , UsageEq ] eq₂ Θ (Δ U.⋈ unsplitUsages₂ p Γ) 90 | unsplitUsages₂-eq [] = [] 91 | unsplitUsages₂-eq (S ∷ˡ eq) = Eq.refl ∷ (unsplitUsages₂-eq eq) 92 | unsplitUsages₂-eq (S ∷ʳ eq) = Eq.refl ∷ (unsplitUsages₂-eq eq) 93 | 94 | mixFin : Mix TFin 95 | mixFin {Γ₁ = Γ₁} {Γ₂} {p = p} {q} eqΓ eqΔ eqΓ′ eqΔ′ K = 96 | case splitFin p eqΓ eqΔ K of λ 97 | { (inj₁ (k , K , Γ₂≡Δ₂)) → 98 | let (_ , _ , eq₁ , _) = unsplitContext q 99 | inc = unsplitUsages₁ q Γ₂ 100 | EQΓ′ = unsplitUsages₁-eq eqΓ′ 101 | EQΔ′ = unsplitUsages₁-eq eqΔ′ 102 | K′ = U.weakFin inc K 103 | EQΔ′ = UP.irrelevance _ (subst _ (Eq.sym Γ₂≡Δ₂) (UP.sym EQΔ′)) 104 | in , extensionalFin eq₁ (CP.sym eq₁) EQΓ′ EQΔ′ K′ 105 | ; (inj₂ (k , K , Γ₁≡Δ₁)) → 106 | let (_ , _ , _ , eq₂) = unsplitContext q 107 | inc = unsplitUsages₂ q Γ₁ 108 | EQΓ′ = unsplitUsages₂-eq eqΓ′ 109 | EQΔ′ = unsplitUsages₂-eq eqΔ′ 110 | K′ = U.weakFin inc K 111 | EQΔ′ = UP.irrelevance _ (subst _ (Eq.sym Γ₁≡Δ₁) (UP.sym EQΔ′)) 112 | in , extensionalFin eq₂ (CP.sym eq₂) EQΓ′ EQΔ′ K′ 113 | } 114 | 115 | -------------------------------------------------------------------------------- /src/linear/Type.agda: -------------------------------------------------------------------------------- 1 | module linear.Type where 2 | 3 | open import Function 4 | open import Data.Nat 5 | open import Data.Product 6 | open import Relation.Nullary 7 | open import Relation.Binary.PropositionalEquality 8 | 9 | open import linear.RawIso 10 | 11 | infixr 8 _&_ 12 | infixr 7 _⊕_ 13 | infixr 6 _⊗_ 14 | infixr 5 _─o_ 15 | data Type : Set where 16 | κ : ℕ → Type 17 | 𝟘 𝟙 : Type 18 | _⊗_ : (σ τ : Type) → Type 19 | _─o_ : (σ τ : Type) → Type 20 | _&_ : (σ τ : Type) → Type 21 | _⊕_ : (σ τ : Type) → Type 22 | 23 | data RType : Set where 24 | Base : ℕ → RType 25 | Unit Zero : RType 26 | Tensor Lolli With Plus : (σ τ : RType) → RType 27 | 28 | {-# FOREIGN GHC import Type.Parser #-} 29 | {-# COMPILE GHC RType 30 | = data Type.Parser.Type 31 | (Type.Parser.Base 32 | | Type.Parser.Unit 33 | | Type.Parser.Zero 34 | | Type.Parser.Tensor 35 | | Type.Parser.Lolli 36 | | Type.Parser.With 37 | | Type.Parser.Plus) 38 | #-} 39 | 40 | embed^RType : RType → Type 41 | embed^RType (Base x) = κ x 42 | embed^RType Unit = 𝟙 43 | embed^RType Zero = 𝟘 44 | embed^RType (Tensor x x₁) = embed^RType x ⊗ embed^RType x₁ 45 | embed^RType (Lolli x x₁) = embed^RType x ─o embed^RType x₁ 46 | embed^RType (With x x₁) = embed^RType x & embed^RType x₁ 47 | embed^RType (Plus x x₁) = embed^RType x ⊕ embed^RType x₁ 48 | 49 | -- Equality of types is decidable 50 | κ-inj : {x y : ℕ} → κ x ≡ κ y → x ≡ y 51 | κ-inj refl = refl 52 | 53 | eqκ : {x y : ℕ} → RawIso (x ≡ y) (κ x ≡ κ y) 54 | eqκ = mkRawIso (cong κ) κ-inj 55 | 56 | ⊗-inj : {σ₁ τ₁ σ₂ τ₂ : Type} → σ₁ ⊗ τ₁ ≡ σ₂ ⊗ τ₂ → σ₁ ≡ σ₂ × τ₁ ≡ τ₂ 57 | ⊗-inj refl = refl , refl 58 | 59 | eq⊗ : {σ₁ τ₁ σ₂ τ₂ : Type} → RawIso (σ₁ ≡ σ₂ × τ₁ ≡ τ₂) (σ₁ ⊗ τ₁ ≡ σ₂ ⊗ τ₂) 60 | eq⊗ = mkRawIso (uncurry (cong₂ _⊗_)) ⊗-inj 61 | 62 | ⊕-inj : {σ₁ τ₁ σ₂ τ₂ : Type} → σ₁ ⊕ τ₁ ≡ σ₂ ⊕ τ₂ → σ₁ ≡ σ₂ × τ₁ ≡ τ₂ 63 | ⊕-inj refl = refl , refl 64 | 65 | eq⊕ : {σ₁ τ₁ σ₂ τ₂ : Type} → RawIso (σ₁ ≡ σ₂ × τ₁ ≡ τ₂) (σ₁ ⊕ τ₁ ≡ σ₂ ⊕ τ₂) 66 | eq⊕ = mkRawIso (uncurry (cong₂ _⊕_)) ⊕-inj 67 | 68 | ─o-inj : {σ₁ τ₁ σ₂ τ₂ : Type} → σ₁ ─o τ₁ ≡ σ₂ ─o τ₂ → σ₁ ≡ σ₂ × τ₁ ≡ τ₂ 69 | ─o-inj refl = refl , refl 70 | 71 | &-inj : {σ₁ τ₁ σ₂ τ₂ : Type} → σ₁ & τ₁ ≡ σ₂ & τ₂ → σ₁ ≡ σ₂ × τ₁ ≡ τ₂ 72 | &-inj refl = refl , refl 73 | 74 | eq& : {σ₁ τ₁ σ₂ τ₂ : Type} → RawIso (σ₁ ≡ σ₂ × τ₁ ≡ τ₂) (σ₁ & τ₁ ≡ σ₂ & τ₂) 75 | eq& = mkRawIso (uncurry (cong₂ _&_)) &-inj 76 | 77 | eq─o : {σ₁ τ₁ σ₂ τ₂ : Type} → RawIso (σ₁ ≡ σ₂ × τ₁ ≡ τ₂) (σ₁ ─o τ₁ ≡ σ₂ ─o τ₂) 78 | eq─o = mkRawIso (uncurry (cong₂ _─o_)) ─o-inj 79 | 80 | eq : (σ τ : Type) → Dec (σ ≡ τ) 81 | eq (κ x) (κ y) = eqκ <$> x ≟ y 82 | eq 𝟙 𝟙 = yes refl 83 | eq 𝟘 𝟘 = yes refl 84 | eq (σ₁ ⊗ τ₁) (σ₂ ⊗ τ₂) = eq⊗ <$> eq σ₁ σ₂ <*> eq τ₁ τ₂ 85 | eq (σ₁ ─o τ₁) (σ₂ ─o τ₂) = eq─o <$> eq σ₁ σ₂ <*> eq τ₁ τ₂ 86 | eq (σ₁ & τ₁) (σ₂ & τ₂) = eq& <$> eq σ₁ σ₂ <*> eq τ₁ τ₂ 87 | eq (σ₁ ⊕ τ₁) (σ₂ ⊕ τ₂) = eq⊕ <$> eq σ₁ σ₂ <*> eq τ₁ τ₂ 88 | eq (κ _) 𝟙 = no (λ ()) 89 | eq (κ _) 𝟘 = no (λ ()) 90 | eq (κ _) (_ ⊗ _) = no (λ ()) 91 | eq (κ _) (_ ─o _) = no (λ ()) 92 | eq (κ _) (_ & _) = no (λ ()) 93 | eq (κ _) (_ ⊕ _) = no (λ ()) 94 | eq (_ ⊗ _) (κ _) = no (λ ()) 95 | eq (_ ⊗ _) 𝟙 = no (λ ()) 96 | eq (_ ⊗ _) 𝟘 = no (λ ()) 97 | eq (_ ⊗ _) (_ ─o _) = no (λ ()) 98 | eq (_ ⊗ _) (_ & _) = no (λ ()) 99 | eq (_ ⊗ _) (_ ⊕ _) = no (λ ()) 100 | eq (_ ─o _) (κ _) = no (λ ()) 101 | eq (_ ─o _) 𝟙 = no (λ ()) 102 | eq (_ ─o _) 𝟘 = no (λ ()) 103 | eq (_ ─o _) (_ ⊗ _) = no (λ ()) 104 | eq (_ ─o _) (_ & _) = no (λ ()) 105 | eq (_ ─o _) (_ ⊕ _) = no (λ ()) 106 | eq (_ ⊕ _) (κ _) = no (λ ()) 107 | eq (_ ⊕ _) 𝟙 = no (λ ()) 108 | eq (_ ⊕ _) 𝟘 = no (λ ()) 109 | eq (_ ⊕ _) (_ ─o _) = no (λ ()) 110 | eq (_ ⊕ _) (_ & _) = no (λ ()) 111 | eq (_ ⊕ _) (_ ⊗ _) = no (λ ()) 112 | eq (_ & _) (κ _) = no (λ ()) 113 | eq (_ & _) 𝟙 = no (λ ()) 114 | eq (_ & _) 𝟘 = no (λ ()) 115 | eq (_ & _) (_ ⊗ _) = no (λ ()) 116 | eq (_ & _) (_ ─o _) = no (λ ()) 117 | eq (_ & _) (_ ⊕ _) = no (λ ()) 118 | eq 𝟙 (κ _) = no (λ ()) 119 | eq 𝟙 𝟘 = no (λ ()) 120 | eq 𝟙 (_ ⊗ _) = no (λ ()) 121 | eq 𝟙 (_ ─o _) = no (λ ()) 122 | eq 𝟙 (_ & _) = no (λ ()) 123 | eq 𝟙 (_ ⊕ _) = no (λ ()) 124 | eq 𝟘 (κ _) = no (λ ()) 125 | eq 𝟘 𝟙 = no (λ ()) 126 | eq 𝟘 (_ ⊗ _) = no (λ ()) 127 | eq 𝟘 (_ ─o _) = no (λ ()) 128 | eq 𝟘 (_ & _) = no (λ ()) 129 | eq 𝟘 (_ ⊕ _) = no (λ ()) 130 | 131 | ≟-diag : (n : ℕ) → (n ≟ n) ≡ yes refl 132 | ≟-diag zero = refl 133 | ≟-diag (suc n) rewrite ≟-diag n = refl 134 | 135 | eq-diag : (σ : Type) → eq σ σ ≡ yes refl 136 | eq-diag (κ n) rewrite ≟-diag n = refl 137 | eq-diag 𝟙 = refl 138 | eq-diag 𝟘 = refl 139 | eq-diag (σ ⊗ τ) rewrite eq-diag σ | eq-diag τ = refl 140 | eq-diag (σ ─o τ) rewrite eq-diag σ | eq-diag τ = refl 141 | eq-diag (σ & τ) rewrite eq-diag σ | eq-diag τ = refl 142 | eq-diag (σ ⊕ τ) rewrite eq-diag σ | eq-diag τ = refl 143 | -------------------------------------------------------------------------------- /doc/typing-swap.tex: -------------------------------------------------------------------------------- 1 | \begin{figure}[H] 2 | \begin{mathpar} 3 | \inferrule 4 | { % premise 1 5 | \inferrule 6 | { % premise 2 7 | \ensuremath{\mathcal{E}} % expression 8 | \and \ensuremath{\mathcal{P}} % pattern 9 | \and \inferrule 10 | { % premise 3 11 | \ensuremath{\mathcal{L} \and \mathcal{R}} 12 | }{ % conclusion 1 13 | \ensuremath{[] \cdot \stale{\sigma \otimes \tau} \cdot \fresh{\tau} \cdot \fresh{\sigma} 14 | \vdash \tau \otimes \sigma \ni \prd{(\neu{(\var{(\varsucc{\varzero})})})}{(\neu{(\var{\varzero})})} 15 | \andalso{} [] \cdot \stale{\sigma \otimes \tau} \cdot \stale{\tau} \cdot \stale{\sigma}} 16 | } 17 | }{ % conslusion 2 18 | \ensuremath{[] \cdot \fresh{\sigma \otimes \tau} 19 | \vdash \tau \otimes \sigma \ni 20 | {\begin{array}{l} 21 | \letinsplit{\prdpattern{\varpattern{}}{\varpattern{}}}{\var{\varzero}}{\prd{(\neu{(\var{(\varsucc{\varzero})})})}{(\neu{(\var{\varzero})}})} 22 | \end{array}} 23 | \andalso{} [] \cdot \stale{\sigma \otimes \tau}} 24 | } 25 | }{ % conclusion 1 26 | [] \ensuremath{\vdash} (\ensuremath{\sigma} \ensuremath{\otimes} \ensuremath{\tau}) \ensuremath{\multimap} (\ensuremath{\tau} \ensuremath{\otimes} \ensuremath{\sigma}) \ensuremath{\ni} \texttt{swap} \andalso{} [] 27 | } 28 | 29 | \and \ensuremath{\mathcal{E}} = \inferrule 30 | { % premise 3 31 | \inferrule 32 | { % premise 4 33 | }{ % conclusion 4 34 | \ensuremath{[] \cdot \fresh{\sigma \otimes \tau} 35 | \vdash_v \varzero \in \sigma \otimes \tau 36 | \andalso{} [] \cdot \stale{\sigma \otimes \tau}} 37 | } 38 | }{ % conclusion 3 39 | \ensuremath{[] \cdot \fresh{\sigma \otimes \tau} 40 | \vdash \var{\varzero} \in \sigma \otimes \tau 41 | \andalso{} [] \cdot \stale{\sigma \otimes\tau}} 42 | } 43 | 44 | \and 45 | 46 | \ensuremath{\mathcal{P}} = % premise 2 47 | \inferrule 48 | { % premise 3 49 | \inferrule 50 | { % premise 4 51 | }{ % conclusion 4 52 | \ensuremath{\sigma \ni \varpattern{} \leadsto{} [] \cdot \sigma} 53 | } 54 | \and % premise 3 55 | \inferrule 56 | { % premise 4 57 | }{ % conclusion 4 58 | \ensuremath{\tau \ni \varpattern{} \leadsto{} [] \cdot \tau} 59 | } 60 | }{ % conclusion 3 61 | \ensuremath{\sigma \otimes \tau \ni \prdpattern{\varpattern{}}{\varpattern{}} \leadsto{} [] \cdot \tau \cdot \sigma} 62 | } 63 | 64 | \and 65 | 66 | \ensuremath{\mathcal{L}} = \inferrule 67 | { % premise 2 68 | \inferrule 69 | { % premise 3 70 | \inferrule 71 | { % premise 4 72 | \inferrule 73 | { % premise 5 74 | }{ % conclusion 5 75 | \ensuremath{[] \cdot \stale{\sigma \otimes \tau} \cdot \fresh{\tau} 76 | \vdash_v \varzero \in \tau 77 | \andalso{} [] \cdot \stale{\sigma \otimes \tau} \cdot \stale{\tau}} 78 | } 79 | }{ % conclusion 4 80 | \ensuremath{[] \cdot \stale{\sigma \otimes \tau} \cdot \fresh{\tau} \cdot \fresh{\sigma} 81 | \vdash_v \varsucc{\varzero} \in \tau 82 | \andalso{} [] \cdot \stale{\sigma \otimes \tau} \cdot \stale{\tau} \cdot \fresh{\sigma}} 83 | } 84 | }{ % conclusion 3 85 | \ensuremath{[] \cdot \stale{\sigma \otimes \tau} \cdot \fresh{\tau} \cdot \fresh{\sigma} 86 | \vdash \var{(\varsucc{\varzero})} \in \tau 87 | \andalso{} [] \cdot \stale{\sigma \otimes \tau} \cdot \stale{\tau} \cdot \fresh{\sigma}} 88 | } 89 | }{ % conclusion 2 90 | \ensuremath{[] \cdot \stale{\sigma \otimes \tau} \cdot \fresh{\tau} \cdot \fresh{\sigma} 91 | \vdash \tau \ni \neu{(\var{(\varsucc{\varzero})})} 92 | \andalso{} [] \cdot \stale{\sigma \otimes \tau} \cdot \stale{\tau} \cdot \fresh{\sigma}} 93 | } 94 | 95 | \and 96 | 97 | 98 | 99 | \and 100 | 101 | \ensuremath{\mathcal{R}} = \inferrule 102 | { % premise 1 103 | \inferrule 104 | { % premise 2 105 | \inferrule 106 | { % premise 3 107 | }{ % conclusion 3 108 | \ensuremath{[] \cdot \stale{\sigma \otimes \tau} \cdot \stale{\tau} \cdot \fresh{\sigma} 109 | \vdash_v \varzero \in \sigma 110 | \andalso{} [] \cdot \stale{\sigma \otimes \tau} \cdot \stale{\tau} \cdot \stale{\sigma}} 111 | } 112 | }{ % conclusion 2 113 | \ensuremath{[] \cdot \stale{\sigma \otimes \tau} \cdot \stale{\tau} \cdot \fresh{\sigma} 114 | \vdash \var{\varzero} \in \sigma 115 | \andalso{} [] \cdot \stale{\sigma \otimes \tau} \cdot \stale{\tau} \cdot \stale{\sigma}} 116 | } 117 | }{ % conclusion 1 118 | \ensuremath{[] \cdot \stale{\sigma \otimes \tau} \cdot \stale{\tau} \cdot \fresh{\sigma} 119 | \vdash \sigma \ni \neu{(\var{\varzero})} 120 | \andalso{} [] \cdot \stale{\sigma \otimes \tau} \cdot \stale{\tau} \cdot \stale{\sigma}} 121 | } 122 | 123 | \end{mathpar} 124 | \label{typing:swap} 125 | \end{figure} 126 | -------------------------------------------------------------------------------- /src/linear/Usage/Consumption.agda: -------------------------------------------------------------------------------- 1 | module linear.Usage.Consumption where 2 | 3 | open import Data.Nat 4 | open import Data.Vec hiding (map ; [_] ; split ; _++_ ; tail) 5 | open import Data.Product hiding (swap) 6 | open import Function 7 | 8 | open import linear.Type 9 | open import linear.Scope as Sc 10 | open import linear.Context as C hiding (_++_) 11 | open import linear.Usage as U hiding (_++_ ; tail) 12 | import Relation.Binary.PropositionalEquality as PEq 13 | 14 | infix 3 _─_≡_─_ 15 | data _─_≡_─_ : {n : ℕ} {γ : Context n} (Γ Δ θ ξ : Usages γ) → Set where 16 | [] : [] ─ [] ≡ [] ─ [] 17 | ─∷_ : {n : ℕ} {γ : Context n} {Γ Δ θ ξ : Usages γ} {a : Type} {A B : Usage a} → 18 | Γ ─ Δ ≡ θ ─ ξ → A ∷ Γ ─ A ∷ Δ ≡ B ∷ θ ─ B ∷ ξ 19 | _∷_ : {n : ℕ} {γ : Context n} {Γ Δ θ ξ : Usages γ} (a : Type) → 20 | Γ ─ Δ ≡ θ ─ ξ → [ a ] ∷ Γ ─ ] a [ ∷ Δ ≡ [ a ] ∷ θ ─ ] a [ ∷ ξ 21 | 22 | tail : {n : ℕ} {γ : Context n} {Γ Δ θ ξ : Usages γ} {a : Type} {S T U V : Usage a} → 23 | S ∷ Γ ─ T ∷ Δ ≡ U ∷ θ ─ V ∷ ξ → Γ ─ Δ ≡ θ ─ ξ 24 | tail (─∷ p) = p 25 | tail (a ∷ p) = p 26 | 27 | infix 3 _⊆_ 28 | _⊆_ : {n : ℕ} {γ : Context n} (Γ Δ : Usages γ) → Set 29 | Γ ⊆ Δ = Γ ─ Δ ≡ Γ ─ Δ 30 | 31 | pure : {n : ℕ} (γ : Context n) → [[ γ ]] ⊆ ]] γ [[ 32 | pure [] = [] 33 | pure (a ∷ γ) = a ∷ pure γ 34 | 35 | refl : {n : ℕ} {γ : Context n} (Γ : Usages γ) → Γ ⊆ Γ 36 | refl [] = [] 37 | refl (_ ∷ Γ) = ─∷ refl Γ 38 | 39 | trans : {n : ℕ} {γ : Context n} {Γ Δ θ : Usages γ} → Γ ⊆ Δ → Δ ⊆ θ → Γ ⊆ θ 40 | trans [] [] = [] 41 | trans (─∷ p) (─∷ q) = ─∷ trans p q 42 | trans (a ∷ p) (─∷ q) = a ∷ trans p q 43 | trans (─∷ p) (a ∷ q) = a ∷ trans p q 44 | 45 | antisym : {n : ℕ} {γ : Context n} {Γ Δ : Usages γ} → Γ ⊆ Δ → Δ ⊆ Γ → Γ PEq.≡ Δ 46 | antisym [] [] = PEq.refl 47 | antisym (─∷ p) (─∷ q) = PEq.cong _ $ antisym p q 48 | antisym (a ∷ p) () 49 | 50 | irrelevance : {n : ℕ} {γ : Context n} {Γ Δ : Usages γ} (p q : Γ ⊆ Δ) → p PEq.≡ q 51 | irrelevance [] [] = PEq.refl 52 | irrelevance (─∷ p) (─∷ q) = PEq.cong ─∷_ $ irrelevance p q 53 | irrelevance (a ∷ p) (.a ∷ q) = PEq.cong (a ∷_) $ irrelevance p q 54 | 55 | infixr 3 _++_ 56 | _++_ : {m n : ℕ} {γ : Context m} {δ : Context n} {Γ Δ θ ξ : Usages γ} {χ Φ : Usages δ} → 57 | χ ⊆ Φ → Γ ─ Δ ≡ θ ─ ξ → χ U.++ Γ ─ Φ U.++ Δ ≡ χ U.++ θ ─ Φ U.++ ξ 58 | [] ++ q = q 59 | ─∷ p ++ q = ─∷ (p ++ q) 60 | a ∷ p ++ q = a ∷ (p ++ q) 61 | 62 | swap : {n : ℕ} {γ : Context n} {Γ Δ θ : Usages γ} → Γ ⊆ Δ → Δ ⊆ θ → 63 | ∃ λ Δ′ → Γ ─ Δ ≡ Δ′ ─ θ × Δ ─ θ ≡ Γ ─ Δ′ 64 | swap [] [] = [] , [] , [] 65 | swap (─∷ p) (─∷ q) = map _ (map ─∷_ ─∷_) $ swap p q 66 | swap (─∷ p) (a ∷ q) = map _ (map ─∷_ (a ∷_)) $ swap p q 67 | swap (a ∷ p) (─∷ q) = map _ (map (a ∷_) ─∷_) $ swap p q 68 | 69 | split : {m n : ℕ} {γ : Context m} {δ : Context n} (Γ₁ Γ₂ : Usages γ) {Δ₁ Δ₂ : Usages δ} → 70 | Γ₁ U.++ Δ₁ ⊆ Γ₂ U.++ Δ₂ → Γ₁ ⊆ Γ₂ × Δ₁ ⊆ Δ₂ 71 | split [] [] p = [] , p 72 | split (_ ∷ _) (_ ∷ _) (─∷ p) = map ─∷_ id $ split _ _ p 73 | split (_ ∷ _) (_ ∷ _) (a ∷ p) = map (a ∷_) id $ split _ _ p 74 | 75 | truncate : {m n : ℕ} (γ : Context m) {δ : Context n} {Δ₁ Δ₂ : Usages δ} → 76 | [[ γ ]] U.++ Δ₁ ⊆ ]] γ [[ U.++ Δ₂ → Δ₁ ⊆ Δ₂ 77 | truncate γ = proj₂ ∘ split [[ γ ]] ]] γ [[ 78 | 79 | divide : {n : ℕ} {γ : Context n} {Γ Δ θ ξ χ : Usages γ} → Γ ─ Δ ≡ θ ─ ξ → Γ ⊆ χ → χ ⊆ Δ → 80 | ∃ λ Φ → Γ ─ χ ≡ θ ─ Φ × χ ─ Δ ≡ Φ ─ ξ 81 | divide [] [] [] = [] , [] , [] 82 | divide (a ∷ eq) (─∷ p) (.a ∷ q) = map _ (map ─∷_ (a ∷_)) $ divide eq p q 83 | divide (a ∷ eq) (.a ∷ p) (─∷ q) = map _ (map (a ∷_) ─∷_) $ divide eq p q 84 | divide (─∷ eq) (─∷ p) (─∷ q) = map _ (map ─∷_ ─∷_) $ divide eq p q 85 | divide (─∷ eq) (a ∷ p) () 86 | 87 | weaken⁻¹ : {k l : ℕ} {γ : Context k} {m : Sc.Mergey k l} {M : C.Mergey m} (𝓜 : U.Mergey M) 88 | {Γ Δ : Usages γ} {χ : Usages (γ C.⋈ M)} → Γ U.⋈ 𝓜 ⊆ χ → χ ⊆ Δ U.⋈ 𝓜 → 89 | ∃ λ χ′ → χ PEq.≡ (χ′ U.⋈ 𝓜) 90 | weaken⁻¹ finish p q = , PEq.refl 91 | weaken⁻¹ (copy 𝓜) {T ∷ Γ} {.T ∷ Δ} (─∷ p) (─∷ q) = map (_ ∷_) (PEq.cong (_ ∷_)) $ weaken⁻¹ 𝓜 p q 92 | weaken⁻¹ (copy 𝓜) {.([ a ]) ∷ Γ} {.(] a [) ∷ Δ} (─∷ p) (a ∷ q) = map (_ ∷_) (PEq.cong (_ ∷_)) $ weaken⁻¹ 𝓜 p q 93 | weaken⁻¹ (copy 𝓜) {.([ a ]) ∷ Γ} {.(] a [) ∷ Δ} (a ∷ p) (─∷ q) = map (_ ∷_) (PEq.cong (_ ∷_)) $ weaken⁻¹ 𝓜 p q 94 | weaken⁻¹ (insert A 𝓜) (─∷ p) (─∷ q) = map id (PEq.cong (_ ∷_)) $ weaken⁻¹ 𝓜 p q 95 | weaken⁻¹ (insert .([ a ]) 𝓜) (a ∷ p) () 96 | 97 | equality : {n : ℕ} {γ : Context n} {Γ θ ξ : Usages γ} → Γ ─ Γ ≡ θ ─ ξ → θ PEq.≡ ξ 98 | equality [] = PEq.refl 99 | equality (─∷ p) = PEq.cong _ $ equality p 100 | 101 | Consumption : {T : ℕ → Set} (𝓣 : Typing T) → Set 102 | Consumption {T} 𝓣 = {n : ℕ} {γ : Context n} {t : T n} {A : Type} {Γ Δ : Usages γ} → 𝓣 Γ t A Δ → Γ ⊆ Δ 103 | 104 | Framing : {T : ℕ → Set} (𝓣 : Typing T) → Set 105 | Framing {T} 𝓣 = 106 | {n : ℕ} {γ : Context n} {Γ Δ θ ξ : Usages γ} {t : T n} {A : Type} → 107 | Γ ─ Δ ≡ θ ─ ξ → 𝓣 Γ t A Δ → 𝓣 θ t A ξ 108 | 109 | consumptionFin : Consumption TFin 110 | consumptionFin z = _ ∷ refl _ 111 | consumptionFin (s k) = ─∷ consumptionFin k 112 | 113 | framingFin : Framing TFin 114 | framingFin (A ∷ p) z rewrite equality p = z 115 | framingFin (─∷ p) (s k) = s framingFin p k 116 | -------------------------------------------------------------------------------- /src/linear/Typing.agda: -------------------------------------------------------------------------------- 1 | module linear.Typing where 2 | 3 | open import Data.Nat as ℕ 4 | open import Data.Fin 5 | open import Data.Product 6 | open import Data.Vec hiding ([_] ; _++_ ; map) 7 | open import Function 8 | open import Relation.Binary.PropositionalEquality hiding ([_]) 9 | 10 | open import linear.Type 11 | open import linear.Scope as Sc 12 | hiding (Mergey ; copys ; Weakening ; weakFin ; Substituting ; substFin ; Env ; Freshey ; withFreshVars) 13 | open import linear.Context as C hiding (Mergey ; _⋈_ ; copys ; _++_ ; ++copys-elim) 14 | open import linear.Language as L 15 | hiding (patternSize ; weakInfer ; weakCheck ; substInfer ; substCheck ; Env 16 | ; fresheyInfer) 17 | open import linear.Usage 18 | 19 | infix 3 _⊢_∋_⊠_ _⊢_∈_⊠_ _∋_↝_ 20 | mutual 21 | 22 | data _⊢_∋_⊠_ {n : ℕ} {γ : Context n} (Γ : Usages γ) : (A : Type) (t : Check n) (Δ : Usages γ) → Set where 23 | 24 | `lam_ : {σ τ : Type} {b : Check (suc n)} {Δ : Usages γ} → 25 | 26 | [ σ ] ∷ Γ ⊢ τ ∋ b ⊠ ] σ [ ∷ Δ → 27 | ------------------------- 28 | Γ ⊢ σ ─o τ ∋ `lam b ⊠ Δ 29 | 30 | `let_∷=_`in_ : {σ τ : Type} {o : ℕ} {p : Pattern o} {δ : Context o} {t : Infer n} 31 | {Δ θ : Usages γ} {u : Check (o ℕ.+ n)} → 32 | 33 | σ ∋ p ↝ δ → Γ ⊢ t ∈ σ ⊠ Δ → [[ δ ]] ++ Δ ⊢ τ ∋ u ⊠ ]] δ [[ ++ θ → 34 | ----------------------------------------------------------------- 35 | Γ ⊢ τ ∋ `let p ∷= t `in u ⊠ θ 36 | 37 | `unit : -------------------- 38 | Γ ⊢ 𝟙 ∋ `unit ⊠ Γ 39 | 40 | `prd⊗ : {σ τ : Type} {a b : Check n} {Δ θ : Usages γ} → 41 | 42 | Γ ⊢ σ ∋ a ⊠ Δ → Δ ⊢ τ ∋ b ⊠ θ → 43 | --------------------------------- 44 | Γ ⊢ σ ⊗ τ ∋ `prd a b ⊠ θ 45 | 46 | 47 | `prd& : {σ τ : Type} {a b : Check n} {Δ : Usages γ} → 48 | 49 | Γ ⊢ σ ∋ a ⊠ Δ → Γ ⊢ τ ∋ b ⊠ Δ → 50 | --------------------------------- 51 | Γ ⊢ σ & τ ∋ `prd a b ⊠ Δ 52 | 53 | 54 | `inl_ : {σ τ : Type} {t : Check n} {Δ : Usages γ} → 55 | 56 | Γ ⊢ σ ∋ t ⊠ Δ → 57 | --------------------------------- 58 | Γ ⊢ σ ⊕ τ ∋ `inl t ⊠ Δ 59 | 60 | `inr_ : {σ τ : Type} {t : Check n} {Δ : Usages γ} → 61 | 62 | Γ ⊢ τ ∋ t ⊠ Δ → 63 | --------------------------------- 64 | Γ ⊢ σ ⊕ τ ∋ `inr t ⊠ Δ 65 | 66 | `neu_ : {σ : Type} {t : Infer n} {Δ : Usages γ} → 67 | 68 | Γ ⊢ t ∈ σ ⊠ Δ → 69 | --------------------- 70 | Γ ⊢ σ ∋ `neu t ⊠ Δ 71 | 72 | data _⊢_∈_⊠_ {n : ℕ} {γ : Context n} (Γ : Usages γ) : (t : Infer n) (A : Type) (Δ : Usages γ) → Set where 73 | 74 | `var_ : {σ : Type} {Δ : Usages γ} {k : Fin n} → 75 | 76 | Γ ⊢ k ∈[ σ ]⊠ Δ → 77 | ---------------------- 78 | Γ ⊢ `var k ∈ σ ⊠ Δ 79 | 80 | `app : {σ τ : Type} {Δ θ : Usages γ} {t : Infer n} {u : Check n} → 81 | 82 | Γ ⊢ t ∈ σ ─o τ ⊠ Δ → Δ ⊢ σ ∋ u ⊠ θ → 83 | --------------------------------------- 84 | Γ ⊢ `app t u ∈ τ ⊠ θ 85 | 86 | `fst_ : {σ τ : Type} {Δ : Usages γ} {t : Infer n} → 87 | 88 | Γ ⊢ t ∈ σ & τ ⊠ Δ → 89 | ----------------------- 90 | Γ ⊢ `fst t ∈ σ ⊠ Δ 91 | 92 | `snd_ : {σ τ : Type} {Δ : Usages γ} {t : Infer n} → 93 | 94 | Γ ⊢ t ∈ σ & τ ⊠ Δ → 95 | ----------------------- 96 | Γ ⊢ `snd t ∈ τ ⊠ Δ 97 | 98 | `case_return_of_%%_ : {σ τ : Type} {Δ θ : Usages γ} {t : Infer n} {l r : Check (suc n)} → 99 | 100 | Γ ⊢ t ∈ σ ⊕ τ ⊠ Δ → 101 | (ν : Type) → 102 | [ σ ] ∷ Δ ⊢ ν ∋ l ⊠ ] σ [ ∷ θ → 103 | [ τ ] ∷ Δ ⊢ ν ∋ r ⊠ ] τ [ ∷ θ → 104 | --------------------------------------------- 105 | Γ ⊢ `case t return ν of l %% r ∈ ν ⊠ θ 106 | 107 | `exfalso : {Δ : Usages γ} {t : Infer n} → 108 | 109 | (σ : Type) → 110 | Γ ⊢ t ∈ 𝟘 ⊠ Δ → 111 | ---------------------------- 112 | Γ ⊢ `exfalso σ t ∈ σ ⊠ Δ 113 | 114 | `cut : {σ : Type} {Δ : Usages γ} {t : Check n} → 115 | 116 | Γ ⊢ σ ∋ t ⊠ Δ → 117 | ----------------------- 118 | Γ ⊢ `cut t σ ∈ σ ⊠ Δ 119 | 120 | data _∋_↝_ : (A : Type) {m : ℕ} (p : Pattern m) (Δ : Context m) → Set where 121 | `v : {σ : Type} → σ ∋ `v ↝ σ ∷ [] 122 | `⟨⟩ : 𝟙 ∋ `⟨⟩ ↝ [] 123 | _,,_ : {σ τ : Type} {m n : ℕ} {p : Pattern m} {q : Pattern n} {Δ₁ : Context m} {Δ₂ : Context n} → 124 | σ ∋ p ↝ Δ₁ → τ ∋ q ↝ Δ₂ → σ ⊗ τ ∋ p ,, q ↝ Δ₁ C.++ Δ₂ 125 | 126 | 127 | 128 | -- dirty hack 129 | patternSize : {o : ℕ} {p : Pattern o} {σ : Type} {γ : Context o} (p : σ ∋ p ↝ γ) → ℕ 130 | patternSize {o} _ = o 131 | 132 | patternContext : {o : ℕ} {p : Pattern o} {σ : Type} {γ : Context o} 133 | (p : σ ∋ p ↝ γ) → Context o 134 | patternContext {γ = γ} _ = γ 135 | 136 | checkOutput : {n : ℕ} {γ : Context n} {Γ Δ : Usages γ} {σ : Type} {t : Check n} → 137 | Γ ⊢ σ ∋ t ⊠ Δ → Usages γ 138 | checkOutput {Δ = Δ} _ = Δ 139 | 140 | inferOutput : {n : ℕ} {γ : Context n} {Γ Δ : Usages γ} {σ : Type} {t : Infer n} → 141 | Γ ⊢ t ∈ σ ⊠ Δ → Usages γ 142 | inferOutput {Δ = Δ} _ = Δ 143 | 144 | TCheck : Typing Check 145 | TCheck = λ Γ t A Δ → Γ ⊢ A ∋ t ⊠ Δ 146 | 147 | TInfer : Typing Infer 148 | TInfer = _⊢_∈_⊠_ 149 | -------------------------------------------------------------------------------- /src/linear/Typing/Inversion.agda: -------------------------------------------------------------------------------- 1 | module linear.Typing.Inversion where 2 | 3 | open import Data.Nat 4 | open import Data.Vec hiding (map ; [_] ; _++_) 5 | open import Data.Product 6 | 7 | open import linear.Type 8 | open import linear.Context hiding (_++_) 9 | open import linear.Language 10 | open import linear.Usage 11 | open import linear.Typing 12 | 13 | -- inversion lemmas 14 | app-inv : 15 | {n : ℕ} {γ : Context n} {t : Infer n} {u : Check n} {Γ Δ : Usages γ} {τ : Type} → 16 | Γ ⊢ `app t u ∈ τ ⊠ Δ → Σ[ θ ∈ Usages γ ] Σ[ σ ∈ Type ] Γ ⊢ t ∈ σ ─o τ ⊠ θ × θ ⊢ σ ∋ u ⊠ Δ 17 | app-inv (`app t u) = , , t , u 18 | 19 | fst-inv : 20 | {n : ℕ} {γ : Context n} {t : Infer n} {Γ Δ : Usages γ} {σ : Type} → 21 | Γ ⊢ `fst t ∈ σ ⊠ Δ → Σ[ τ ∈ Type ] Γ ⊢ t ∈ σ & τ ⊠ Δ 22 | fst-inv (`fst t) = , t 23 | 24 | snd-inv : 25 | {n : ℕ} {γ : Context n} {t : Infer n} {Γ Δ : Usages γ} {τ : Type} → 26 | Γ ⊢ `snd t ∈ τ ⊠ Δ → Σ[ σ ∈ Type ] Γ ⊢ t ∈ σ & τ ⊠ Δ 27 | snd-inv (`snd t) = , t 28 | 29 | exfalso-inv : 30 | {n : ℕ} {γ : Context n} {t : Infer n} {Γ Δ : Usages γ} {σ τ : Type} → 31 | Γ ⊢ `exfalso σ t ∈ τ ⊠ Δ → Γ ⊢ t ∈ 𝟘 ⊠ Δ 32 | exfalso-inv (`exfalso σ t) = t 33 | 34 | case-inv : 35 | {n : ℕ} {γ : Context n} {t : Infer n} {l r : Check (suc n)} {Γ Δ : Usages γ} {ν₁ ν₂ : Type} → 36 | Γ ⊢ `case t return ν₁ of l %% r ∈ ν₂ ⊠ Δ → 37 | Σ[ θ ∈ Usages γ ] Σ[ σ ∈ Type ] Σ[ τ ∈ Type ] 38 | Γ ⊢ t ∈ σ ⊕ τ ⊠ θ × [ σ ] ∷ θ ⊢ ν₁ ∋ l ⊠ ] σ [ ∷ Δ × [ τ ] ∷ θ ⊢ ν₁ ∋ r ⊠ ] τ [ ∷ Δ 39 | case-inv (`case t return ν of l %% r) = , , , t , l , r 40 | 41 | neu-inv : 42 | {n : ℕ} {γ : Context n} {t : Infer n} {Γ Δ : Usages γ} {σ : Type} → 43 | Γ ⊢ σ ∋ `neu t ⊠ Δ → Γ ⊢ t ∈ σ ⊠ Δ 44 | neu-inv (`neu t) = t 45 | 46 | lam-inv : 47 | {n : ℕ} {γ : Context n} {t : Check (suc n)} {Γ Δ : Usages γ} {σ τ : Type} → 48 | Γ ⊢ σ ─o τ ∋ `lam t ⊠ Δ → [ σ ] ∷ Γ ⊢ τ ∋ t ⊠ ] σ [ ∷ Δ 49 | lam-inv (`lam t) = t 50 | 51 | let-inv : 52 | {n o : ℕ} {γ : Context n} {p : Pattern o} {t : Infer n} {u : Check (o + n)} 53 | {Γ Δ : Usages γ} {τ : Type} → Γ ⊢ τ ∋ `let p ∷= t `in u ⊠ Δ → 54 | Σ[ θ ∈ Usages γ ] Σ[ σ ∈ Type ] Σ[ δ ∈ Context o ] 55 | Γ ⊢ t ∈ σ ⊠ θ × σ ∋ p ↝ δ × [[ δ ]] ++ θ ⊢ τ ∋ u ⊠ ]] δ [[ ++ Δ 56 | let-inv (`let p ∷= t `in u) = , , , t , p , u 57 | 58 | prd⊗-inv : 59 | {n : ℕ} {γ : Context n} {t u : Check n} {Γ Δ : Usages γ} {σ τ : Type} → 60 | Γ ⊢ σ ⊗ τ ∋ `prd t u ⊠ Δ → Σ[ θ ∈ Usages γ ] Γ ⊢ σ ∋ t ⊠ θ × θ ⊢ τ ∋ u ⊠ Δ 61 | prd⊗-inv (`prd⊗ t u) = , t , u 62 | 63 | prd&-inv : 64 | {n : ℕ} {γ : Context n} {t u : Check n} {Γ Δ : Usages γ} {σ τ : Type} → 65 | Γ ⊢ σ & τ ∋ `prd t u ⊠ Δ → Γ ⊢ σ ∋ t ⊠ Δ × Γ ⊢ τ ∋ u ⊠ Δ 66 | prd&-inv (`prd& t u) = t , u 67 | 68 | -- useful corrolaries 69 | app-inv-function : 70 | {n : ℕ} {γ : Context n} {t : Infer n} {u : Check n} {Γ Δ : Usages γ} {τ : Type} → 71 | (p : Γ ⊢ `app t u ∈ τ ⊠ Δ) → let (θ , σ , _) = app-inv p in Γ ⊢ t ∈ σ ─o τ ⊠ θ 72 | app-inv-function p = let (_ , _ , T , _) = app-inv p in T 73 | 74 | app-inv-argument : 75 | {n : ℕ} {γ : Context n} {t : Infer n} {u : Check n} {Γ Δ : Usages γ} {τ : Type} → 76 | (p : Γ ⊢ `app t u ∈ τ ⊠ Δ) → let (θ , σ , _) = app-inv p in θ ⊢ σ ∋ u ⊠ Δ 77 | app-inv-argument p = let (_ , _ , _ , U) = app-inv p in U 78 | 79 | case-inv-scrutinee : 80 | {n : ℕ} {γ : Context n} {t : Infer n} {l r : Check (suc n)} {Γ Δ : Usages γ} {ν₁ ν₂ : Type} → 81 | (p : Γ ⊢ `case t return ν₁ of l %% r ∈ ν₂ ⊠ Δ) → 82 | let (θ , σ , τ , _) = case-inv p in Γ ⊢ t ∈ σ ⊕ τ ⊠ θ 83 | case-inv-scrutinee p = let (_ , _ , _ , T , _) = case-inv p in T 84 | 85 | case-inv-left : 86 | {n : ℕ} {γ : Context n} {t : Infer n} {l r : Check (suc n)} {Γ Δ : Usages γ} {ν₁ ν₂ : Type} → 87 | (p : Γ ⊢ `case t return ν₁ of l %% r ∈ ν₂ ⊠ Δ) → 88 | let (θ , σ , τ , _) = case-inv p in [ σ ] ∷ θ ⊢ ν₁ ∋ l ⊠ ] σ [ ∷ Δ 89 | case-inv-left p = let (_ , _ , _ , _ , L , _) = case-inv p in L 90 | 91 | case-inv-right : 92 | {n : ℕ} {γ : Context n} {t : Infer n} {l r : Check (suc n)} {Γ Δ : Usages γ} {ν₁ ν₂ : Type} → 93 | (p : Γ ⊢ `case t return ν₁ of l %% r ∈ ν₂ ⊠ Δ) → 94 | let (θ , σ , τ , _) = case-inv p in [ τ ] ∷ θ ⊢ ν₁ ∋ r ⊠ ] τ [ ∷ Δ 95 | case-inv-right p = let (_ , _ , _ , _ , _ , R) = case-inv p in R 96 | 97 | let-inv-bound : 98 | {n o : ℕ} {γ : Context n} {p : Pattern o} {t : Infer n} {u : Check (o + n)} 99 | {Γ Δ : Usages γ} {τ : Type} (p : Γ ⊢ τ ∋ `let p ∷= t `in u ⊠ Δ) → 100 | let (θ , σ , _) = let-inv p in Γ ⊢ t ∈ σ ⊠ θ 101 | let-inv-bound p = let (_ , _ , _ , T , _) = let-inv p in T 102 | 103 | let-inv-pattern : 104 | {n o : ℕ} {γ : Context n} {p : Pattern o} {t : Infer n} {u : Check (o + n)} 105 | {Γ Δ : Usages γ} {τ : Type} (d : Γ ⊢ τ ∋ `let p ∷= t `in u ⊠ Δ) → 106 | let (_ , σ , δ , _) = let-inv d in σ ∋ p ↝ δ 107 | let-inv-pattern p = let (_ , _ , _ , _ , P , _) = let-inv p in P 108 | 109 | let-inv-body : 110 | {n o : ℕ} {γ : Context n} {p : Pattern o} {t : Infer n} {u : Check (o + n)} 111 | {Γ Δ : Usages γ} {τ : Type} (p : Γ ⊢ τ ∋ `let p ∷= t `in u ⊠ Δ) → 112 | let (θ , σ , δ , _) = let-inv p in [[ δ ]] ++ θ ⊢ τ ∋ u ⊠ ]] δ [[ ++ Δ 113 | let-inv-body p = let (_ , _ , _ , _ , _ , U) = let-inv p in U 114 | 115 | prd-inv-fst : 116 | {n : ℕ} {γ : Context n} {t u : Check n} {Γ Δ : Usages γ} {σ τ : Type} → 117 | (p : Γ ⊢ σ ⊗ τ ∋ `prd t u ⊠ Δ) → let (θ , _) = prd⊗-inv p in Γ ⊢ σ ∋ t ⊠ θ 118 | prd-inv-fst p = let (_ , T , _) = prd⊗-inv p in T 119 | 120 | prd-inv-snd : 121 | {n : ℕ} {γ : Context n} {t u : Check n} {Γ Δ : Usages γ} {σ τ : Type} → 122 | (p : Γ ⊢ σ ⊗ τ ∋ `prd t u ⊠ Δ) → let (θ , _) = prd⊗-inv p in θ ⊢ τ ∋ u ⊠ Δ 123 | prd-inv-snd p = let (_ , _ , U) = prd⊗-inv p in U 124 | -------------------------------------------------------------------------------- /src/linear/Typing/Functional.agda: -------------------------------------------------------------------------------- 1 | module linear.Typing.Functional where 2 | 3 | open import Data.Nat 4 | open import Data.Product 5 | open import Function 6 | open import Relation.Binary.PropositionalEquality 7 | 8 | open import linear.Type 9 | open import linear.Context 10 | open import linear.Language 11 | open import linear.Usage 12 | open import linear.Usage.Functional 13 | open import linear.Typing 14 | open import linear.Relation.Functional 15 | 16 | RPattern : (i : Type × Σ[ m ∈ ℕ ] Pattern m) (o : let (_ , m , _) = i in Context m) → Set 17 | RPattern (A , _ , p) δ = A ∋ p ↝ δ 18 | 19 | functionalPattern : Functional′ RPattern 20 | functionalPattern _ `v `v = refl 21 | functionalPattern _ `⟨⟩ `⟨⟩ = refl 22 | functionalPattern _ (p₁ ,, q₁) (p₂ ,, q₂) = cong₂ _ (functionalPattern _ p₁ p₂) (functionalPattern _ q₁ q₂) 23 | 24 | functionalInfer : Functional (InferTyping TInfer) 25 | functionalInfer _ (`var k₁) (`var k₂) = functionalFin _ k₁ k₂ 26 | functionalInfer _ (`app t₁ u₁) (`app t₂ u₂) = cong (λ { (_ ─o τ) → τ; σ → σ }) 27 | $ functionalInfer _ t₁ t₂ 28 | functionalInfer _ (`fst t₁) (`fst t₂) = cong (λ { (σ & _) → σ; σ → σ}) 29 | $ functionalInfer _ t₁ t₂ 30 | functionalInfer _ (`snd t₁) (`snd t₂) = cong (λ { (_ & τ) → τ; σ → σ}) 31 | $ functionalInfer _ t₁ t₂ 32 | functionalInfer _ (`case t₁ return σ₁ of l₁ %% r₁) (`case t₂ return .σ₁ of l₂ %% r₂) = refl 33 | functionalInfer _ (`exfalso σ₁ t₁) (`exfalso σ₂ t₂) = refl 34 | functionalInfer _ (`cut t₁) (`cut t₂) = refl 35 | 36 | 37 | mutual 38 | 39 | functionalInferPost : Functional′ (InferTypingPost TInfer) 40 | functionalInferPost _ (`var x₁) (`var x₂) = functionalFinPost _ x₁ x₂ 41 | functionalInferPost _ (`app t₁ u₁) (`app t₂ u₂) 42 | with functionalInferPost _ t₁ t₂ 43 | ... | refl = cong _ $ functionalCheckPost _ u₁ u₂ 44 | functionalInferPost _ (`fst t₁) (`fst t₂) 45 | with functionalInferPost _ t₁ t₂ 46 | ... | refl = refl 47 | functionalInferPost _ (`snd t₁) (`snd t₂) 48 | with functionalInferPost _ t₁ t₂ 49 | ... | refl = refl 50 | functionalInferPost _ (`case t₁ return σ₁ of l₁ %% r₁) (`case t₂ return .σ₁ of l₂ %% r₂) 51 | with functionalInferPost _ t₁ t₂ 52 | ... | refl with functionalCheckPost _ l₁ l₂ 53 | ... | refl = refl 54 | functionalInferPost _ (`exfalso σ₁ t₁) (`exfalso σ₂ t₂) 55 | with functionalInferPost _ t₁ t₂ 56 | ... | refl = refl 57 | functionalInferPost _ (`cut t₁) (`cut t₂) = cong _ $ functionalCheckPost _ t₁ t₂ 58 | 59 | functionalCheckPost : Functional′ (CheckTypingPost TCheck) 60 | functionalCheckPost _ (`lam t₁) (`lam t₂) 61 | with functionalCheckPost _ t₁ t₂ 62 | ... | refl = refl 63 | functionalCheckPost (n , γ , Γ , σ , `let p ∷= t `in u) 64 | (`let_∷=_`in_ {δ = δ} p₁ t₁ u₁) (`let p₂ ∷= t₂ `in u₂) 65 | with functionalInferPost _ t₁ t₂ 66 | ... | refl with functionalPattern _ p₁ p₂ 67 | ... | refl = functional++ ]] δ [[ refl (functionalCheckPost _ u₁ u₂) 68 | functionalCheckPost _ `unit `unit = refl 69 | functionalCheckPost _ (`prd⊗ a₁ b₁) (`prd⊗ a₂ b₂) 70 | with functionalCheckPost _ a₁ a₂ 71 | ... | refl = functionalCheckPost _ b₁ b₂ 72 | functionalCheckPost _ (`prd& a₁ b₁) (`prd& a₂ b₂) = functionalCheckPost _ a₁ a₂ 73 | functionalCheckPost _ (`inl t₁) (`inl t₂) = functionalCheckPost _ t₁ t₂ 74 | functionalCheckPost _ (`inr t₁) (`inr t₂) = functionalCheckPost _ t₁ t₂ 75 | functionalCheckPost _ (`neu t₁) (`neu t₂) = cong proj₂ $ functionalInferPost _ t₁ t₂ 76 | 77 | mutual 78 | 79 | functionalInferPre : Functional′ (InferTypingPre TInfer) 80 | functionalInferPre _ (`var k₁) (`var k₂) = functionalFinPre _ k₁ k₂ 81 | functionalInferPre _ (`app t₁ u₁) (`app t₂ u₂) 82 | with functionalInfer _ t₁ t₂ 83 | ... | refl with functionalCheckPre _ u₁ u₂ 84 | ... | refl with functionalInferPre _ t₁ t₂ 85 | ... | refl = refl 86 | functionalInferPre _ (`fst t₁) (`fst t₂) 87 | with functionalInfer _ t₁ t₂ 88 | ... | refl with functionalInferPre _ t₁ t₂ 89 | ... | refl = refl 90 | functionalInferPre _ (`snd t₁) (`snd t₂) 91 | with functionalInfer _ t₁ t₂ 92 | ... | refl with functionalInferPre _ t₁ t₂ 93 | ... | refl = refl 94 | functionalInferPre _ (`case t₁ return σ of l₁ %% r₁) (`case t₂ return .σ of l₂ %% r₂) 95 | with functionalInfer _ t₁ t₂ 96 | ... | refl with functionalCheckPre _ r₁ r₂ 97 | ... | refl with functionalInferPre _ t₁ t₂ 98 | ... | refl = refl 99 | functionalInferPre _ (`exfalso σ₁ t₁) (`exfalso σ₂ t₂) 100 | with functionalInferPre _ t₁ t₂ 101 | ... | refl = refl 102 | functionalInferPre _ (`cut t₁) (`cut t₂) = cong _ $ functionalCheckPre _ t₁ t₂ 103 | 104 | functionalCheckPre : Functional′ (CheckTypingPre TCheck) 105 | functionalCheckPre _ (`lam t₁) (`lam t₂) with functionalCheckPre _ t₁ t₂ 106 | ... | refl = refl 107 | functionalCheckPre _ (`let p₁ ∷= t₁ `in u₁) (`let p₂ ∷= t₂ `in u₂) 108 | with functionalInfer _ t₁ t₂ 109 | ... | refl with functionalPattern _ p₁ p₂ 110 | ... | refl with functional++ [[ patternContext p₁ ]] refl (functionalCheckPre _ u₁ u₂) 111 | ... | refl = cong proj₂ $ functionalInferPre _ t₁ t₂ 112 | functionalCheckPre _ `unit `unit = refl 113 | functionalCheckPre _ (`prd⊗ a₁ b₁) (`prd⊗ a₂ b₂) 114 | rewrite functionalCheckPre _ b₁ b₂ = functionalCheckPre _ a₁ a₂ 115 | functionalCheckPre _ (`prd& a₁ b₁) (`prd& a₂ b₂) = functionalCheckPre _ a₁ a₂ 116 | functionalCheckPre _ (`inl t₁) (`inl t₂) = functionalCheckPre _ t₁ t₂ 117 | functionalCheckPre _ (`inr t₁) (`inr t₂) = functionalCheckPre _ t₁ t₂ 118 | functionalCheckPre _ (`neu t₁) (`neu t₂) = cong proj₂ $ functionalInferPre _ t₁ t₂ 119 | -------------------------------------------------------------------------------- /src/linear/Model.agda: -------------------------------------------------------------------------------- 1 | module linear.Model where 2 | 3 | open import Data.Nat 4 | open import Data.Fin 5 | open import Data.Product 6 | open import Data.Vec as V using ([] ; _∷_ ; toList) 7 | open import Data.List as L using (List ; [] ; _∷_) 8 | open import Data.List.Properties using (++-monoid) 9 | open import Function 10 | open import Algebra 11 | open import Algebra.Structures 12 | open import Relation.Binary.PropositionalEquality as PEq 13 | 14 | open import linear.Scope 15 | open import linear.Type 16 | open import linear.Context 17 | open import linear.Language 18 | open import linear.Usage 19 | open import linear.Usage.Consumption as UC 20 | open import linear.Usage.Erasure as UE 21 | open import linear.Typing 22 | open import linear.Typing.Consumption 23 | 24 | Model : Set₁ 25 | Model = List Type → Type → Set 26 | 27 | coerce : {n : ℕ} {γ : Context n} {Γ Δ : Usages γ} (𝓜 : Model) (p q : Γ ⊆ Δ) {σ : Type} → 28 | 𝓜 (used p) σ → 𝓜 (used q) σ 29 | coerce 𝓜 p q {σ} = subst (flip 𝓜 σ ∘′ used) (irrelevance p q) 30 | 31 | open Monoid (++-monoid Type) 32 | 33 | record Linear (𝓜^C 𝓜^I : Model) 34 | : Set where 35 | field 36 | -- Infer 37 | var : {σ : Type} → 𝓜^I (σ ∷ []) σ 38 | app : {γ δ θ : List Type} {σ τ : Type} → 39 | 𝓜^I γ (σ ─o τ) → 𝓜^C δ σ → γ ++ δ ≅ θ → 𝓜^I θ τ 40 | skip : {γ δ θ : List Type} {σ : Type} → 𝓜^C γ 𝟙 → 𝓜^I δ σ → γ ++ δ ≅ θ → 𝓜^I θ σ 41 | fst : {γ : List Type} {σ τ : Type} → 𝓜^I γ (σ & τ) → 𝓜^I γ σ 42 | snd : {γ : List Type} {σ τ : Type} → 𝓜^I γ (σ & τ) → 𝓜^I γ τ 43 | case : {γ δ θ : List Type} {σ τ ν : Type} → 44 | 𝓜^I γ (σ ⊕ τ) → 𝓜^C (σ ∷ δ) ν → 𝓜^C (τ ∷ δ) ν → γ ++ δ ≅ θ → 𝓜^I θ ν 45 | exfalso : {γ : List Type} {σ : Type} → 𝓜^I γ 𝟘 → 𝓜^I γ σ 46 | cut : {γ : List Type} {σ : Type} → 𝓜^C γ σ → 𝓜^I γ σ 47 | -- Check 48 | lam : {γ : List Type} {σ τ : Type} → 𝓜^C (σ ∷ γ) τ → 𝓜^C γ (σ ─o τ) 49 | let' : {γ δ θ : List Type} {σ τ ν : Type} → 50 | 𝓜^I γ (σ ⊗ τ) → 𝓜^C (τ ∷ σ ∷ δ) ν → γ ++ δ ≅ θ → 𝓜^C θ ν 51 | unit : 𝓜^C [] 𝟙 52 | prd⊗ : {γ δ θ : List Type} {σ τ : Type} → 53 | 𝓜^C γ σ → 𝓜^C δ τ → γ ++ δ ≅ θ → 𝓜^C θ (σ ⊗ τ) 54 | prd& : {γ : List Type} {σ τ : Type} → 𝓜^C γ σ → 𝓜^C γ τ → 𝓜^C γ (σ & τ) 55 | inl : {γ : List Type} {σ τ : Type} → 𝓜^C γ σ → 𝓜^C γ (σ ⊕ τ) 56 | inr : {γ : List Type} {σ τ : Type} → 𝓜^C γ τ → 𝓜^C γ (σ ⊕ τ) 57 | neu : {γ : List Type} {σ : Type} → 𝓜^I γ σ → 𝓜^C γ σ 58 | -- Structural 59 | mix^I : {γ δ θ : List Type} {σ : Type} → 𝓜^I (γ L.++ δ) σ → γ ++ δ ≅ θ → 𝓜^I θ σ 60 | mix^C : {γ δ θ : List Type} {σ : Type} → 𝓜^C (γ L.++ δ) σ → γ ++ δ ≅ θ → 𝓜^C θ σ 61 | 62 | module LINEAR {𝓜^C 𝓜^I : Model} (𝓜 : Linear 𝓜^C 𝓜^I) where 63 | 64 | open Linear 𝓜 65 | 66 | linearPattern : 67 | {γ δ θ : List Type} {σ ν : Type} {k : ℕ} {σp : Context k} {p : Pattern k} → 68 | σ ∋ p ↝ σp → 𝓜^I γ σ → 𝓜^C (toList σp L.++ δ) ν → γ ++ δ ≅ θ → 𝓜^C θ ν 69 | linearPattern `v t u inc = neu (app (cut (lam u)) (neu t) (UE.sym inc)) 70 | linearPattern `⟨⟩ t u inc = neu (skip (neu t) (cut u) inc) 71 | linearPattern {δ = δ} {ν = ν} (p₁ ,, p₂) t u inc = 72 | let δ₁ = patternContext p₁ 73 | δ₂ = patternContext p₂ 74 | eq : toList (δ₁ V.++ δ₂) L.++ δ ≡ toList δ₁ L.++ toList δ₂ L.++ δ 75 | eq = let open ≡-Reasoning in 76 | begin 77 | toList (δ₁ V.++ δ₂) L.++ δ ≡⟨ cong (L._++ δ) (toList-++ δ₁ δ₂) ⟩ 78 | (toList δ₁ L.++ toList δ₂) L.++ δ ≡⟨ assoc (toList δ₁) (toList δ₂) δ ⟩ 79 | toList δ₁ L.++ toList δ₂ L.++ δ 80 | ∎ 81 | u' : 𝓜^C (toList δ₁ L.++ toList δ₂ L.++ δ) ν 82 | u' = subst (λ γ → 𝓜^C γ ν) eq u 83 | ih₁ = linearPattern p₁ var 84 | ih₂ = linearPattern p₂ var 85 | T = app (cut (lam 86 | (let' var (ih₂ (ih₁ u' (toList δ₂ ++ʳ trivial)) 87 | (_ ∷ˡ trivial)) trivial))) 88 | (neu t) trivial 89 | in mix^C (neu T) (UE.sym inc) 90 | 91 | LINEAR : {T : ℕ → Set} (𝓣 : Typing T) (𝓜^T : Model) → Set 92 | LINEAR {T} 𝓣 𝓜^T = 93 | {n : ℕ} {γ : Context n} {Γ Δ : Usages γ} {t : T n} {σ : Type} → 94 | (T : 𝓣 Γ t σ Δ) (inc : Γ ⊆ Δ) → 𝓜^T (used inc) σ 95 | 96 | linearFin : LINEAR TFin 𝓜^I 97 | linearFin z (σ ∷ inc) rewrite used-refl inc = var 98 | linearFin (s k) (─∷ inc) = linearFin k inc 99 | 100 | linearInfer : LINEAR TInfer 𝓜^I 101 | linearCheck : LINEAR TCheck 𝓜^C 102 | 103 | linearInfer (`var k) inc = linearFin k inc 104 | linearInfer (`app f t) inc = 105 | let F = linearInfer f (consumptionInfer f) 106 | T = linearCheck t (consumptionCheck t) 107 | INC = UE.divide (consumptionInfer f) (consumptionCheck t) inc 108 | in app F T INC 109 | linearInfer (`fst t) inc = fst (linearInfer t inc) 110 | linearInfer (`snd t) inc = snd (linearInfer t inc) 111 | linearInfer (`case t return ν of l %% r) inc = 112 | let γ = consumptionInfer t ; T = linearInfer t γ 113 | δl = consumptionCheck l ; L = linearCheck l δl 114 | δr = consumptionCheck r ; R = linearCheck r δr 115 | δ = UC.tail δl 116 | INC = UE.divide γ δ inc 117 | in case T (coerce 𝓜^C δl (_ ∷ δ) L) (coerce 𝓜^C δr (_ ∷ δ) R) INC 118 | linearInfer (`exfalso σ t) inc = exfalso (linearInfer t inc) 119 | linearInfer (`cut t) inc = cut (linearCheck t inc) 120 | 121 | 122 | linearCheck (`lam t) inc = lam (linearCheck t (_ ∷ inc)) 123 | linearCheck (`let p ∷= t `in u) inc = 124 | let γ = consumptionInfer t ; T = linearInfer t γ 125 | δ = consumptionCheck u ; U = linearCheck u δ 126 | θ = patternContext p 127 | δ′ = truncate θ δ 128 | INC = UE.divide γ δ′ inc 129 | eq : used (pure θ UC.++ δ′) ≡ toList θ L.++ used δ′ 130 | eq = let open ≡-Reasoning in 131 | begin 132 | used (pure θ UC.++ δ′) ≡⟨ used-++ (pure θ) _ ⟩ 133 | used (pure θ) L.++ used δ′ ≡⟨ cong (L._++ used δ′) (used-all (pure θ)) ⟩ 134 | toList θ L.++ used δ′ 135 | ∎ 136 | U′ : 𝓜^C (toList θ L.++ used δ′) _ 137 | U′ = subst (λ γ → 𝓜^C γ _) eq (coerce 𝓜^C δ (pure θ UC.++ δ′) U) 138 | in linearPattern p T U′ INC 139 | linearCheck `unit inc = subst (λ γ → 𝓜^C γ 𝟙) (PEq.sym (used-refl inc)) unit 140 | linearCheck (`prd⊗ a b) inc = 141 | let γ = consumptionCheck a ; A = linearCheck a γ 142 | δ = consumptionCheck b ; B = linearCheck b δ 143 | INC = UE.divide γ δ inc 144 | in prd⊗ A B INC 145 | linearCheck (`prd& a b) inc = prd& (linearCheck a inc) (linearCheck b inc) 146 | linearCheck (`inl t) inc = inl (linearCheck t inc) 147 | linearCheck (`inr t) inc = inr (linearCheck t inc) 148 | linearCheck (`neu t) inc = neu (linearInfer t inc) 149 | 150 | -------------------------------------------------------------------------------- /src/linear/Typing/Substitution.agda: -------------------------------------------------------------------------------- 1 | module linear.Typing.Substitution where 2 | 3 | open import Data.Nat 4 | open import Data.Fin 5 | open import Data.Vec hiding (map ; [_] ; _++_) 6 | open import Data.Product hiding (swap) 7 | open import Function 8 | open import Relation.Binary.PropositionalEquality hiding ([_]) 9 | 10 | open import linear.Scope as Sc hiding (Weakening ; weakFin ; Substituting ; substFin ; copys ; Env ; withFreshVars) 11 | open import linear.Type 12 | open import linear.Context as C hiding (copys ; _++_) 13 | open import linear.Language as L hiding (weakInfer ; weakCheck ; Env ; substInfer ; substCheck) 14 | open import linear.Usage 15 | open import linear.Usage.Functional 16 | open import linear.Usage.Consumption hiding (_++_) 17 | open import linear.Typing 18 | open import linear.Typing.Functional 19 | open import linear.Typing.Consumption 20 | 21 | mutual 22 | 23 | weakInfer : Weakening Infer L.weakInfer TInfer 24 | weakInfer 𝓜 (`var k) = `var (weakFin 𝓜 k) 25 | weakInfer 𝓜 (`app t u) = `app (weakInfer 𝓜 t) (weakCheck 𝓜 u) 26 | weakInfer 𝓜 (`fst t) = `fst (weakInfer 𝓜 t) 27 | weakInfer 𝓜 (`snd t) = `snd (weakInfer 𝓜 t) 28 | weakInfer 𝓜 (`case t return σ of l %% r) = `case weakInfer 𝓜 t return σ 29 | of weakCheck (copy 𝓜) l 30 | %% weakCheck (copy 𝓜) r 31 | weakInfer 𝓜 (`exfalso σ t) = `exfalso σ (weakInfer 𝓜 t) 32 | weakInfer 𝓜 (`cut t) = `cut (weakCheck 𝓜 t) 33 | 34 | weakCheck : Weakening Check L.weakCheck TCheck 35 | weakCheck 𝓜 (`lam t) = `lam weakCheck (copy 𝓜) t 36 | weakCheck {m = m} 𝓜 (`let_∷=_`in_ {σ} {τ} {o} {rp} {δ} {rt} {Δ} {θ} {ru} p t u) = 37 | let P = λ {γ} (Γ Γ′ : Usages γ) → Γ ⊢ τ ∋ L.weakCheck (Sc.copys o m) ru ⊠ Γ′ 38 | ih = weakCheck (copys o 𝓜) u 39 | cast = ++copys-elim₂ P [[ δ ]] ]] δ [[ Δ θ 𝓜 40 | in `let p ∷= weakInfer 𝓜 t `in cast ih 41 | weakCheck 𝓜 `unit = `unit 42 | weakCheck 𝓜 (`prd⊗ t u) = `prd⊗ (weakCheck 𝓜 t) (weakCheck 𝓜 u) 43 | weakCheck 𝓜 (`prd& t u) = `prd& (weakCheck 𝓜 t) (weakCheck 𝓜 u) 44 | weakCheck 𝓜 (`inl t) = `inl weakCheck 𝓜 t 45 | weakCheck 𝓜 (`inr t) = `inr weakCheck 𝓜 t 46 | weakCheck 𝓜 (`neu t) = `neu weakInfer 𝓜 t 47 | 48 | substFin : 49 | {k l : ℕ} {γ : Context k} {Γ Δ : Usages γ} {σ : Type} {v : Fin k} {ρ : Sc.Env Infer k l} 50 | {θ : Context l} {Τ₁ Τ₂ : Usages θ} → 51 | Env TInfer Τ₁ ρ Τ₂ Γ → Γ ⊢ v ∈[ σ ]⊠ Δ → 52 | ∃ λ Τ₃ → Τ₁ ⊢ Sc.substFin L.fresheyInfer ρ v ∈ σ ⊠ Τ₃ × Env TInfer Τ₃ ρ Τ₂ Δ 53 | substFin (t ∷ ρ) z = , t , ─∷ ρ 54 | substFin ([v]∷ ρ) z = , `var z , ]v[∷ ρ 55 | substFin (T ∷ ρ) (s v) = 56 | let (θ , val , ρ′) = substFin ρ v 57 | (_ , c₁ , c₂) = swap (consumptionInfer T) (consumptionInfer val) 58 | in , framingInfer c₂ val , framingInfer c₁ T ∷ ρ′ 59 | substFin ([v]∷ ρ) (s v) = map ([ _ ] ∷_) (map (weakInfer (insert _ finish)) [v]∷_) $ substFin ρ v 60 | substFin (]v[∷ ρ) (s v) = map (] _ [ ∷_) (map (weakInfer (insert _ finish)) ]v[∷_) $ substFin ρ v 61 | substFin (─∷ ρ) (s v) = map id (map id ─∷_) $ substFin ρ v 62 | 63 | substLam : 64 | {k l : ℕ} {γ : Context k} {Δ : Usages γ} {ρ : Sc.Env Infer k l} 65 | {θ : Context l} {Τ₁ Τ₂ : Usages θ} {σ τ : Type} {b : Check (suc k)} → 66 | Σ[ T₃ ∈ Usages (σ ∷ θ) ] [ σ ] ∷ Τ₁ ⊢ τ ∋ L.substCheck (v∷ ρ) b ⊠ T₃ 67 | × Env TInfer T₃ (v∷ ρ) (] σ [ ∷ Τ₂) (] σ [ ∷ Δ) → 68 | Σ[ Τ₃ ∈ Usages θ ] Τ₁ ⊢ σ ─o τ ∋ L.substCheck ρ (`lam b) ⊠ Τ₃ 69 | × Env TInfer Τ₃ ρ Τ₂ Δ 70 | substLam (._ , bρ , ]v[∷ ρ′) = , `lam bρ , ρ′ 71 | 72 | substCase : 73 | {k l : ℕ} {γ : Context k} {Δ : Usages γ} {ρ : Sc.Env Infer k l} 74 | {θ : Context l} {Τ₁ Τ₂ Τ₄ : Usages θ} {σ₁ σ₂ τ : Type} (t : Infer k) {l r : Check (suc k)} → 75 | Τ₁ ⊢ L.substInfer ρ t ∈ σ₁ ⊕ σ₂ ⊠ Τ₂ → 76 | Σ[ T₃ ∈ Usages (σ₁ ∷ θ) ] [ σ₁ ] ∷ Τ₂ ⊢ τ ∋ L.substCheck (v∷ ρ) l ⊠ T₃ 77 | × Env TInfer T₃ (v∷ ρ) (] σ₁ [ ∷ Τ₄) (] σ₁ [ ∷ Δ) → 78 | Σ[ T₃ ∈ Usages (σ₂ ∷ θ) ] [ σ₂ ] ∷ Τ₂ ⊢ τ ∋ L.substCheck (v∷ ρ) r ⊠ T₃ 79 | × Env TInfer T₃ (v∷ ρ) (] σ₂ [ ∷ Τ₄) (] σ₂ [ ∷ Δ) → 80 | Σ[ Τ₃ ∈ Usages θ ] Τ₁ ⊢ L.substInfer ρ (`case t return τ of l %% r) ∈ τ ⊠ Τ₃ 81 | × Env TInfer Τ₃ ρ Τ₄ Δ 82 | substCase t tρ (._ , lρ , (]v[∷ ρ₁′)) (._ , rρ , (]v[∷ ρ₂′)) 83 | rewrite sym (functionalEnvPre functionalInferPre _ ρ₁′ ρ₂′) = 84 | , `case tρ return _ of lρ %% rρ , ρ₁′ 85 | 86 | -- idea: generalise with a function f applied to each side! 87 | substLet : 88 | {k l o : ℕ} {γ : Context k} {Δ : Usages γ} {ρ : Sc.Env Infer k l} (δ : Context o) 89 | {θ : Context l} {Τ₃ : Usages θ} → 90 | Σ[ T₂ ∈ Usages (δ C.++ θ) ] Env TInfer T₂ (Sc.withFreshVars o ρ) (]] δ [[ ++ Τ₃) (]] δ [[ ++ Δ) → 91 | Σ[ Τ₂ ∈ Usages θ ] Env TInfer Τ₂ ρ Τ₃ Δ 92 | substLet [] (Τ₂ , ρ′) = , ρ′ 93 | substLet (a ∷ δ) (._ , (]v[∷ ρ′)) = substLet δ (, ρ′) 94 | 95 | 96 | mutual 97 | 98 | substInfer : Substituting Infer Infer L.substInfer TInfer TInfer 99 | substInfer ρ (`var x) = substFin ρ x 100 | substInfer ρ (`app t u) = 101 | let (θ₁ , tρ , ρ₁) = substInfer ρ t 102 | (θ₂ , uρ , ρ₂) = substCheck ρ₁ u 103 | in θ₂ , `app tρ uρ , ρ₂ 104 | substInfer ρ (`fst t) = 105 | let (θ₁ , tρ , ρ₁) = substInfer ρ t 106 | in θ₁ , `fst tρ , ρ₁ 107 | substInfer ρ (`snd t) = 108 | let (θ₁ , tρ , ρ₁) = substInfer ρ t 109 | in θ₁ , `snd tρ , ρ₁ 110 | substInfer {t = `case rt return .σ of rl %% rr} ρ (`case t return σ of l %% r) = 111 | let (θ₁ , tρ , ρ₁) = substInfer ρ t 112 | in substCase rt tρ (substCheck ([v]∷ ρ₁) l) (substCheck ([v]∷ ρ₁) r) 113 | substInfer ρ (`exfalso σ t) = 114 | let (Θ₁ , tρ , ρ₁) = substInfer ρ t 115 | in Θ₁ , `exfalso σ tρ , ρ₁ 116 | substInfer ρ (`cut t) = 117 | let (θ₁ , tρ , ρ₁) = substCheck ρ t 118 | in θ₁ , `cut tρ , ρ₁ 119 | 120 | substCheck : Substituting Infer Check L.substCheck TInfer TCheck 121 | substCheck ρ (`lam t) = substLam (substCheck ([v]∷ ρ) t) 122 | substCheck {t = `let _ ∷= rt `in ru} ρ (`let p ∷= t `in u) = 123 | let δ = patternContext p 124 | (θ₁ , tρ , ρ₁) = substInfer ρ t 125 | (θ₂ , uρ , ρ₂) = substCheck (withFreshVars δ ρ₁) u 126 | (θ₃ , ρ) = substLet δ (θ₂ , ρ₂) 127 | eq = functionalEnvPre functionalInferPre _ ρ₂ (withStaleVars (patternContext p) ρ) 128 | in , `let p ∷= tρ `in subst (TCheck _ _ _) eq uρ , ρ 129 | substCheck ρ `unit = , `unit , ρ 130 | substCheck ρ (`prd⊗ a b) = 131 | let (θ₁ , aρ , ρ₁) = substCheck ρ a 132 | (θ₂ , bρ , ρ₂) = substCheck ρ₁ b 133 | in θ₂ , `prd⊗ aρ bρ , ρ₂ 134 | substCheck ρ (`prd& a b) = 135 | let (θ₁ , aρ , ρ₁) = substCheck ρ a 136 | (θ₂ , bρ , ρ₂) = substCheck ρ b 137 | eq = functionalEnvPre functionalInferPre _ ρ₂ ρ₁ 138 | in , `prd& aρ (subst (TCheck _ _ _) eq bρ) , ρ₁ 139 | substCheck ρ (`inl t) = 140 | let (θ₁ , tρ , ρ₁) = substCheck ρ t 141 | in θ₁ , `inl tρ , ρ₁ 142 | substCheck ρ (`inr t) = 143 | let (θ₁ , tρ , ρ₁) = substCheck ρ t 144 | in θ₁ , `inr tρ , ρ₁ 145 | substCheck ρ (`neu t) = 146 | let (θ₁ , tρ , ρ₁) = substInfer ρ t 147 | in θ₁ , `neu tρ , ρ₁ 148 | -------------------------------------------------------------------------------- /doc/types17-abstract/types17.tex: -------------------------------------------------------------------------------- 1 | \documentclass[a4paper]{easychair} 2 | 3 | \usepackage{bbold} 4 | \usepackage{amssymb} 5 | \usepackage{mathpartir} 6 | 7 | \newtheorem{lemma}{Lemma} 8 | 9 | \title{Typing with Leftovers: a Mechanisation of ILL} 10 | \titlerunning{Typing with Leftovers} 11 | 12 | \author{Guillaume Allais \inst{1}} 13 | \institute{ 14 | Radboud University 15 | Nijmegen, The Netherlands 16 | \email{gallais@cs.ru.nl}} 17 | \authorrunning{Allais G.} 18 | 19 | \begin{document} 20 | \maketitle 21 | 22 | In a linear type system, all the resources available in the context 23 | have to be used exactly once by the term being checked. In traditional 24 | presentations of intuitionistic linear logic this is achieved by 25 | representing the context as a multiset which, in each rule, gets cut 26 | up and distributed among the premises. This is epitomised 27 | by the right rule for tensor (cf. Figure~\ref{rule:tensor}). 28 | 29 | However, multisets are an intrinsically extensional notion and 30 | therefore quite arduous to work with in an intensional type 31 | theory. Various strategies can be applied to tackle this issue; 32 | most of them rely on using linked lists to represent contexts 33 | together with either extra inference rules to reorganise the 34 | context or a side condition to rules splitting the context so 35 | that it may be re-arranged on the fly. In the following example, 36 | $≈$ stands for ``bag-equivalence'' of lists. 37 | 38 | \begin{figure}[ht] 39 | \begin{mathpar} 40 | \inferrule 41 | {Γ ⊢ σ \and Δ ⊢ τ 42 | }{Γ, Δ ⊢ σ ⊗ τ 43 | }{⊗_i} 44 | 45 | \and \inferrule 46 | {Γ ⊢ σ \and Δ ⊢ τ \and Γ, Δ ≈ Θ 47 | }{Θ ⊢ σ ⊗ τ 48 | }{⊗_i} 49 | \end{mathpar} 50 | \caption{Introduction rules for $⊗$. 51 | Left: usual presentation; 52 | Right: with reordering on the fly\label{rule:tensor}} 53 | \end{figure} 54 | 55 | All of these strategies are artefacts of the unfortunate mismatch 56 | between the ideal mathematical objects one wishes to model and 57 | their internal representation in the proof assistant. Short of 58 | having proper quotient types, this will continue to be an issue 59 | when dealing with multisets. The solution we offer tries not to 60 | replicate a set-theoretic approach in intuitionistic type theory 61 | but rather strives to find the type theoretical structures which 62 | can make the problem more tractable. Given the right abstractions, 63 | the proofs follow directly by structural induction. 64 | 65 | McBride's recent work~\cite{McBride2016} on combining linear and 66 | dependent types highlights the distinction one can make between 67 | referring to a resource and actually consuming it. In the same spirit, 68 | rather than dispatching the available resources in the appropriate 69 | sub-derivations, we consider that a term is checked in a \emph{given} 70 | context (typically named $γ$) on top of which usage annotations 71 | (typically named $Γ$, $Δ$, etc.) for each of its variables are 72 | super-imposed. 73 | 74 | A derivation $Γ ⊢ σ ⊠ Δ$ corresponds to a proof of $σ$ in the underlying 75 | context $γ$ with input (resp. output) usage annotations $Γ$ (resp. $Δ$). 76 | Informally, the resources used to prove $σ$ correspond to a subset of 77 | $γ$: they are precisely the ones which used to be marked \emph{free} 78 | in the input usage annotation and come out marked \emph{stale} in the 79 | \emph{leftovers} $Δ$. 80 | 81 | Wherever we used to split the context between sub-derivations, we now 82 | thread the leftovers from one to the next. Writing $f_{σ}$ for a 83 | \emph{fresh} resource of type $σ$ and $s_{σ}$ for a \emph{stale} one, 84 | we can give new introduction rules for the variable with de Bruijn 85 | index zero, tensor and the linear implication, three examples of the 86 | treatment of context annotation, splitting and extension: 87 | 88 | \begin{figure}[ht] 89 | \begin{mathpar} 90 | \inferrule 91 | { 92 | }{Γ ∙ f_{σ} ⊢ σ ⊠ Γ ∙ s_{σ} 93 | }{var_0} 94 | 95 | \and \inferrule 96 | {Γ ⊢ σ ⊠ Δ \and Δ ⊢ τ ⊠ Θ 97 | }{Γ ⊢ σ ⊗ τ ⊠ Θ 98 | }{⊗_i} 99 | 100 | \and \inferrule 101 | {Γ ∙ f_{σ} ⊢ τ ⊠ Δ ∙ s_{σ} 102 | }{Γ ⊢ σ ⊸ τ ⊠ Δ 103 | }{⊸_i} 104 | \end{mathpar} 105 | \caption{Introduction rules for $var_0$ $⊗$ and $⊸$ with leftovers\label{rules:leftovers}} 106 | \end{figure} 107 | 108 | This approach is particularly well-suited to use intuitionistic linear 109 | logic as a type system for an untyped $λ$-calculus where well-scopedness 110 | is statically enforced: in the untyped calculus, it \emph{is} the case 111 | that both branches of a pair live in the same scope. In our development, 112 | we use an inductive family in the style of Altenkirch and Reus~\cite{Altenkirch1999} 113 | and opt for a bidirectional presentation~\cite{Pierce:2000:LTI:345099.345100} 114 | to minimise the amount of redundant information that needs to be stored. 115 | 116 | Type Inference (resp. Type Checking) is then inferring (resp. checking) 117 | a term's type but \emph{also} annotating the resources it consumed and 118 | returning the \emph{leftovers}. These typing relations can be described 119 | by two mutual definitions; e.g. the definitions in Figure~\ref{rules:leftovers} 120 | would become: 121 | 122 | \begin{figure}[ht] 123 | \begin{mathpar} 124 | \inferrule 125 | { 126 | }{Γ ∙ f_{σ} ⊢ v_0 ∈ σ ⊠ Γ ∙ s_{σ} 127 | } 128 | 129 | \and \inferrule 130 | {Γ ⊢ σ ∋ a ⊠ Δ \and Δ ⊢ τ ∋ b ⊠ Θ 131 | }{Γ ⊢ σ ⊗ τ ∋ (a, b) ⊠ Θ 132 | } 133 | 134 | \and \inferrule 135 | {Γ ∙ f_{σ} ⊢ τ ∋ b ⊠ Δ ∙ s_{σ} 136 | }{Γ ⊢ σ ⊸ τ ∋ λb ⊠ Δ 137 | } 138 | \end{mathpar} 139 | \caption{Type \emph{Inference} rule for $var_0$ and Type \emph{Checking} rules for pairs and lambdas\label{rules:checking}} 140 | \end{figure} 141 | 142 | For this mechanisation to be usable, it needs to be well-behaved with 143 | respect to the natural operations on the underlying calculus (renaming 144 | and substitution) but also encompass all of ILL. Our Agda formalisation 145 | (available at \url{https://github.com/gallais/typing-with-leftovers}) 146 | states and proves the following results for a system handling types of 147 | the shape: 148 | \[σ, τ, ... ::= α \,|\, 𝟘 \,|\, 𝟙 \,|\, σ \,⊸\, τ \,|\, σ \,⊕\, τ \,|\, σ \,⊗\, τ \,|\, σ \,\&\, τ\] 149 | 150 | \begin{lemma}[Framing] The usage annotation of resources left untouched 151 | by a typing derivation can be altered freely. The change is unnoticeable 152 | from the underlying $λ$-term's point of view. 153 | \end{lemma} 154 | 155 | \begin{lemma}[Weakening] The input and output contexts of a typing 156 | derivation can be expanded with arbitrarily many new resources. This 157 | corresponds to a weakening on the underlying $λ$-term. 158 | \end{lemma} 159 | 160 | \begin{lemma}[Parallel Substitution] Given a term and a typing derivation 161 | corresponding to each one of the fresh resources in its typing derivation's 162 | context, one can build a new typing derivation and a leftover environment. 163 | The corresponding action on the underlying $λ$-term is parallel substitution. 164 | \end{lemma} 165 | 166 | \begin{lemma}[Functional Relation] The typing relation is functional: for 167 | given ``inputs'', the outputs are uniquely determined. It is also the case 168 | that the input context is uniquely determined by the output one, the term 169 | and the type. 170 | \end{lemma} 171 | 172 | \begin{lemma}[Typechecking] Type checking (resp. Type inference) is decidable. 173 | \end{lemma} 174 | 175 | \begin{lemma}[Soundness] Typing derivations give rise to sequent proofs 176 | in ILL. 177 | \end{lemma} 178 | 179 | \begin{lemma}[Completeness] From a sequent proofs in ILL, one can build a 180 | pair of an untyped term together with the appropriate typing derivation. 181 | \end{lemma} 182 | 183 | \bibliographystyle{plain} 184 | \bibliography{main} 185 | 186 | \end{document} 187 | -------------------------------------------------------------------------------- /src/linear/Usage.agda: -------------------------------------------------------------------------------- 1 | module linear.Usage where 2 | 3 | open import Data.Unit 4 | open import Data.Nat as ℕ 5 | open import Data.Fin 6 | open import Data.Product 7 | open import Data.Vec hiding ([_] ; _++_ ; map ; head ; tail) 8 | open import Function 9 | open import linear.Relation.Functional 10 | 11 | open import linear.Type 12 | open import linear.Scope as Sc 13 | hiding (Mergey ; copys ; inserts 14 | ; Extending 15 | ; Weakening ; weakFin 16 | ; Env ; Substituting 17 | ; Freshey ; withFreshVars) 18 | open import linear.Context as C 19 | hiding (Mergey ; _⋈_ ; copys ; inserts 20 | ; _++_ ; ++copys-elim) 21 | open import Relation.Binary.PropositionalEquality 22 | 23 | data Usage : (a : Type) → Set where 24 | [_] : (a : Type) → Usage a 25 | ]_[ : (a : Type) → Usage a 26 | 27 | infixr 5 _∷_ -- _∙_ 28 | data Usages : {n : ℕ} (γ : Context n) → Set where 29 | [] : Usages [] 30 | _∷_ : {n : ℕ} {γ : Context n} {a : Type} → Usage a → Usages γ → Usages (a ∷ γ) 31 | 32 | head : {n : ℕ} {γ : Context n} {a : Type} → Usages (a ∷ γ) → Usage a 33 | head (S ∷ _) = S 34 | 35 | tail : {n : ℕ} {γ : Context n} {a : Type} → Usages (a ∷ γ) → Usages γ 36 | tail (_ ∷ Γ) = Γ 37 | 38 | infixr 4 _++_ 39 | _++_ : {m n : ℕ} {γ : Context m} {δ : Context n} 40 | (Γ : Usages γ) (Δ : Usages δ) → Usages (γ C.++ δ) 41 | [] ++ Δ = Δ 42 | x ∷ Γ ++ Δ = x ∷ (Γ ++ Δ) 43 | 44 | infix 3 _⊢_∈[_]⊠_ 45 | data _⊢_∈[_]⊠_ : {n : ℕ} {γ : Context n} (Γ : Usages γ) (k : Fin n) (a : Type) (Δ : Usages γ) → Set where 46 | z : {n : ℕ} {γ : Context n} {Γ : Usages γ} {a : Type} → [ a ] ∷ Γ ⊢ zero ∈[ a ]⊠ ] a [ ∷ Γ 47 | s_ : {n : ℕ} {γ : Context n} {k : Fin n} {Γ Δ : Usages γ} {a b : Type} {u : Usage b} → 48 | Γ ⊢ k ∈[ a ]⊠ Δ → u ∷ Γ ⊢ suc k ∈[ a ]⊠ u ∷ Δ 49 | 50 | [[_]] : {m : ℕ} (δ : Context m) → Usages δ 51 | [[ δ ]] = induction Usages [] (λ a _ → [ a ] ∷_) δ 52 | 53 | ]]_[[ : {m : ℕ} (δ : Context m) → Usages δ 54 | ]] δ [[ = induction Usages [] (λ a _ → ] a [ ∷_) δ 55 | 56 | data Mergey : {k l : ℕ} {m : Sc.Mergey k l} (M : C.Mergey m) → Set where 57 | finish : {k : ℕ} → Mergey (finish {k}) 58 | copy : {k l : ℕ} {m : Sc.Mergey k l} {M : C.Mergey m} (𝓜 : Mergey M) → Mergey (copy M) 59 | insert : {k l : ℕ} {m : Sc.Mergey k l} {M : C.Mergey m} {a : Type} 60 | (A : Usage a) (𝓜 : Mergey M) → Mergey (insert a M) 61 | 62 | copys : (o : ℕ) {k l : ℕ} {m : Sc.Mergey k l} {M : C.Mergey m} → 63 | Mergey M → Mergey (C.copys o M) 64 | copys zero M = M 65 | copys (suc o) M = copy (copys o M) 66 | 67 | inserts : {o k l : ℕ} {O : Context o} (𝓞 : Usages O) {m : Sc.Mergey k l} {M : C.Mergey m} → 68 | Mergey M → Mergey (C.inserts O M) 69 | inserts [] 𝓜 = 𝓜 70 | inserts (S ∷ 𝓞) 𝓜 = insert S (inserts 𝓞 𝓜) 71 | 72 | infixl 4 _⋈_ 73 | _⋈_ : {k l : ℕ} {γ : Context k} {m : Sc.Mergey k l} {M : C.Mergey m} 74 | (Γ : Usages γ) (𝓜 : Mergey M) → Usages (γ C.⋈ M) 75 | Γ ⋈ finish = Γ 76 | A ∷ Γ ⋈ copy M = A ∷ (Γ ⋈ M) 77 | Γ ⋈ insert A M = A ∷ (Γ ⋈ M) 78 | 79 | ⋈ˡ : (ri : Σ[ k ∈ ℕ ] Σ[ l ∈ ℕ ] Σ[ γ ∈ Context k ] Σ[ m ∈ Sc.Mergey k l ] 80 | Σ[ M ∈ C.Mergey m ] Mergey M × Usages (γ C.⋈ M)) 81 | (ii : ⊤) (o : let (_ , _ , γ , _) = ri in Usages γ) → Set 82 | ⋈ˡ (_ , _ , _ , _ , _ , 𝓜 , Γ) ii Γ′ = Γ ≡ (Γ′ ⋈ 𝓜) 83 | 84 | ⋈ˡ-injective : Functional ⋈ˡ 85 | ⋈ˡ-injective (l , .l , γ , .finish , .finish , finish , Γ) eq₁ eq₂ = trans (sym eq₁) eq₂ 86 | ⋈ˡ-injective (_ , _ , _ ∷ γ , _ , _ , copy 𝓜 , S ∷ Γ) {_} {_} {σ ∷ o₁} {τ ∷ o₂} eq₁ eq₂ = 87 | cong₂ _∷_ (cong head $ trans (sym eq₁) eq₂) 88 | (⋈ˡ-injective (_ , _ , _ , _ , _ , 𝓜 , Γ) (cong tail eq₁) (cong tail eq₂)) 89 | ⋈ˡ-injective (k , _ , γ , _ , _ , insert A 𝓜 , S ∷ Γ) eq₁ eq₂ = 90 | ⋈ˡ-injective (_ , _ , _ , _ , _ , 𝓜 , Γ) (cong tail eq₁) (cong tail eq₂) 91 | 92 | 93 | ++copys-elim₂ : 94 | {k l o : ℕ} {m : Sc.Mergey k l} {M : C.Mergey m} {δ : Context o} {γ : Context k} 95 | (P : {γ : Context (o ℕ.+ l)} → Usages γ → Usages γ → Set) 96 | (Δ Δ′ : Usages δ) (Γ Γ′ : Usages γ) (𝓜 : Mergey M) → 97 | P ((Δ ++ Γ) ⋈ copys o 𝓜) ((Δ′ ++ Γ′) ⋈ copys o 𝓜) → P (Δ ++ (Γ ⋈ 𝓜)) (Δ′ ++ (Γ′ ⋈ 𝓜)) 98 | ++copys-elim₂ P [] [] Γ Γ′ 𝓜 p = p 99 | ++copys-elim₂ P (A ∷ Δ) (A′ ∷ Δ′) Γ Γ′ 𝓜 p = ++copys-elim₂ (λ θ θ′ → P (A ∷ θ) (A′ ∷ θ′)) Δ Δ′ Γ Γ′ 𝓜 p 100 | 101 | -- We can give an abstract interface to describe these relations 102 | -- by introducing the notion of `Typing`. It exists for `Fin`, 103 | -- `Check` and `Infer`: 104 | Typing : (T : ℕ → Set) → Set₁ 105 | Typing T = {n : ℕ} {γ : Context n} (Γ : Usages γ) (t : T n) (σ : Type) (Δ : Usages γ) → Set 106 | 107 | -- The notion of 'Usage Weakening' can be expressed for a `Typing` 108 | -- of `T` if it enjoys `Scope Weakening` 109 | Weakening : (T : ℕ → Set) (Wk : Sc.Weakening T) (𝓣 : Typing T) → Set 110 | Weakening T Wk 𝓣 = 111 | {k l : ℕ} {γ : Context k} {Γ Δ : Usages γ} {m : Sc.Mergey k l} {M : C.Mergey m} {σ : Type} 112 | {t : T k} (𝓜 : Mergey M) → 𝓣 Γ t σ Δ → 𝓣 (Γ ⋈ 𝓜) (Wk m t) σ (Δ ⋈ 𝓜) 113 | 114 | -- A first example of a Typing enjoying Usage Weakening: Fin. 115 | TFin : Typing Fin 116 | TFin = _⊢_∈[_]⊠_ 117 | 118 | weakFin : Weakening Fin Sc.weakFin TFin 119 | weakFin finish k = k 120 | weakFin (insert A 𝓜) k = s (weakFin 𝓜 k) 121 | weakFin (copy 𝓜) z = z 122 | weakFin (copy 𝓜) (s k) = s (weakFin 𝓜 k) 123 | 124 | -- Similarly to 'Usage Weakening', the notion of 'Usage Substituting' 125 | -- can be expressed for a `Typing` of `T` if it enjoys `Scope Substituting` 126 | 127 | data Env {E : ℕ → Set} (𝓔 : Typing E) : {k l : ℕ} {θ : Context l} (T₁ : Usages θ) 128 | (ρ : Sc.Env E k l) (Τ₂ : Usages θ) {γ : Context k} (Γ : Usages γ) → Set where 129 | [] : {l : ℕ} {θ : Context l} {Τ₁ : Usages θ} → Env 𝓔 Τ₁ [] Τ₁ [] 130 | _∷_ : {a : Type} {k l : ℕ} {θ : Context l} {ρ : Sc.Env E k l} {t : E l} {Τ₁ Τ₂ Τ₃ : Usages θ} 131 | {γ : Context k} {Γ : Usages γ} (T : 𝓔 Τ₁ t a Τ₂) (R : Env 𝓔 Τ₂ ρ Τ₃ Γ) → Env 𝓔 Τ₁ (t ∷ ρ) Τ₃ ([ a ] ∷ Γ) 132 | ─∷_ : {a : Type} {k l : ℕ} {ρ : Sc.Env E k l} {t : E l} {θ : Context l} {Τ₁ Τ₂ : Usages θ} {γ : Context k} 133 | {Γ : Usages γ} → Env 𝓔 Τ₁ ρ Τ₂ Γ → Env 𝓔 Τ₁ (t ∷ ρ) Τ₂ (] a [ ∷ Γ) 134 | [v]∷_ : {a : Type} {k l : ℕ} {ρ : Sc.Env E k l} {θ : Context l} {Τ₁ Τ₂ : Usages θ} {γ : Context k} 135 | {Γ : Usages γ} → Env 𝓔 Τ₁ ρ Τ₂ Γ → Env 𝓔 ([ a ] ∷ Τ₁) (v∷ ρ) (] a [ ∷ Τ₂) ([ a ] ∷ Γ) 136 | ]v[∷_ : {a : Type} {k l : ℕ} {ρ : Sc.Env E k l} {θ : Context l} {Τ₁ Τ₂ : Usages θ} {γ : Context k} 137 | {Γ : Usages γ} → Env 𝓔 Τ₁ ρ Τ₂ Γ → Env 𝓔 (] a [ ∷ Τ₁) (v∷ ρ) (] a [ ∷ Τ₂) (] a [ ∷ Γ) 138 | 139 | 140 | Substituting : (E T : ℕ → Set) ([_]_ : Sc.Substituting E T) (𝓔 : Typing E) (𝓣 : Typing T) → Set 141 | Substituting E T subst 𝓔 𝓣 = 142 | {k l : ℕ} {γ : Context k} {Γ Δ : Usages γ} {σ : Type} {t : T k} {ρ : Sc.Env E k l} 143 | {θ : Context l} {Τ₁ Τ₂ : Usages θ} → 144 | Env 𝓔 Τ₁ ρ Τ₂ Γ → 𝓣 Γ t σ Δ → ∃ λ Τ₃ → 𝓣 Τ₁ (subst ρ t) σ Τ₃ × Env 𝓔 Τ₃ ρ Τ₂ Δ 145 | 146 | [Extending] : (E : ℕ → ℕ → Set) (Ext : Sc.Extending E) 147 | (𝓔 : {k l : ℕ} {θ : Context l} (T₁ : Usages θ) (ρ : E k l) (Τ₂ : Usages θ) {γ : Context k} (Γ : Usages γ) → Set) 148 | → Set 149 | [Extending] E Ext 𝓔 = 150 | {k l o : ℕ} {θ : Context l} {Τ₁ Τ₂ : Usages θ} (δ : Context o) {e : E k l} {γ : Context k} {Γ : Usages γ} → 151 | 𝓔 Τ₁ e Τ₂ Γ → 𝓔 ([[ δ ]] ++ Τ₁) (Ext o e) (]] δ [[ ++ Τ₂) ([[ δ ]] ++ Γ) 152 | 153 | ]Extending[ : (E : ℕ → ℕ → Set) (Ext : Sc.Extending E) 154 | (𝓔 : {k l : ℕ} {θ : Context l} (T₁ : Usages θ) (ρ : E k l) (Τ₂ : Usages θ) {γ : Context k} (Γ : Usages γ) → Set) 155 | → Set 156 | ]Extending[ E Ext 𝓔 = 157 | {k l o : ℕ} {θ : Context l} {Τ₁ Τ₂ : Usages θ} (δ : Context o) {e : E k l} {γ : Context k} {Γ : Usages γ} → 158 | 𝓔 Τ₁ e Τ₂ Γ → 𝓔 (]] δ [[ ++ Τ₁) (Ext o e) (]] δ [[ ++ Τ₂) (]] δ [[ ++ Γ) 159 | 160 | record Freshey (E : ℕ → Set) (F : Sc.Freshey E) (𝓔 : Typing E) : Set where 161 | field 162 | fresh : {k : ℕ} {γ : Context k} {Γ : Usages γ} (σ : Type) → 163 | 𝓔 ([ σ ] ∷ Γ) (Sc.Freshey.fresh F {k}) σ (] σ [ ∷ Γ) 164 | weak : Weakening E (Sc.Freshey.weak F) 𝓔 165 | 166 | withFreshVars : {E : ℕ → Set} {𝓔 : Typing E} → [Extending] (Sc.Env E) Sc.withFreshVars (Env 𝓔) 167 | withFreshVars [] ρ = ρ 168 | withFreshVars (a ∷ δ) ρ = [v]∷ withFreshVars δ ρ 169 | 170 | withStaleVars : {E : ℕ → Set} {𝓔 : Typing E} → ]Extending[ (Sc.Env E) Sc.withFreshVars (Env 𝓔) 171 | withStaleVars [] ρ = ρ 172 | withStaleVars (a ∷ δ) ρ = ]v[∷ withStaleVars δ ρ 173 | -------------------------------------------------------------------------------- /src/linear/Surface/Surface.agda: -------------------------------------------------------------------------------- 1 | module linear.Surface.Surface where 2 | 3 | open import Data.Maybe 4 | open import Data.String using (String) 5 | open import Data.Product 6 | open import Data.Sum 7 | open import Data.Nat 8 | open import Data.Fin 9 | open import Data.Vec hiding ([_] ; _⊛_ ; _>>=_) 10 | open import Data.Empty 11 | open import Function 12 | open import Relation.Nullary 13 | open import Relation.Binary.PropositionalEquality hiding ([_]) 14 | 15 | open import linear.Type 16 | 17 | {-# FOREIGN GHC import qualified Type.Parser #-} 18 | {-# FOREIGN GHC import qualified Surface.Parser #-} 19 | 20 | data Pattern : Set where 21 | `v : String → Pattern 22 | `⟨⟩ : Pattern 23 | _,,_ : (p q : Pattern) → Pattern 24 | 25 | data RPattern : Set where 26 | RAll : String → RPattern 27 | RUni : RPattern 28 | RAnd : RPattern → RPattern → RPattern 29 | 30 | {-# COMPILE GHC RPattern 31 | = data Surface.Parser.Pattern 32 | (Surface.Parser.All 33 | | Surface.Parser.Uni 34 | | Surface.Parser.And) 35 | #-} 36 | 37 | embed^RPattern : RPattern → Pattern 38 | embed^RPattern (RAll x) = `v x 39 | embed^RPattern RUni = `⟨⟩ 40 | embed^RPattern (RAnd x x₁) = embed^RPattern x ,, embed^RPattern x₁ 41 | 42 | mutual 43 | 44 | data Check : Set where 45 | `lam_↦_ : String → Check → Check 46 | `let_∷=_`in_ : Pattern → Infer → Check → Check 47 | `unit : Check 48 | `prd : Check → Check → Check 49 | `inl_ : Check → Check 50 | `inr_ : Check → Check 51 | `neu_ : Infer → Check 52 | 53 | data Infer : Set where 54 | `var : String → Infer 55 | `app : Infer → Check → Infer 56 | `fst `snd : Infer → Infer 57 | `case_return_of_↦_%%_↦_ : Infer → Type → String → Check → String → Check → Infer 58 | `exfalso : Type → Infer → Infer 59 | `cut : Check → Type → Infer 60 | 61 | data RCheck : Set 62 | data RInfer : Set 63 | 64 | data RCheck where 65 | Lam : String → RCheck → RCheck 66 | Let : RPattern → RInfer → RCheck → RCheck 67 | One : RCheck 68 | Prd : RCheck → RCheck → RCheck 69 | Inl Inr : RCheck → RCheck 70 | Neu : RInfer → RCheck 71 | 72 | {-# COMPILE GHC RCheck 73 | = data Surface.Parser.Check 74 | (Surface.Parser.Lam 75 | | Surface.Parser.Let 76 | | Surface.Parser.One 77 | | Surface.Parser.Prd 78 | | Surface.Parser.Inl 79 | | Surface.Parser.Inr 80 | | Surface.Parser.Neu) 81 | #-} 82 | 83 | data RInfer where 84 | Var : String → RInfer 85 | App : RInfer → RCheck → RInfer 86 | Fst Snd : RInfer → RInfer 87 | Cas : RInfer → RType → String → RCheck → String → RCheck → RInfer 88 | ExF : RType → RInfer → RInfer 89 | Cut : RCheck → RType → RInfer 90 | 91 | {-# COMPILE GHC RInfer 92 | = data Surface.Parser.Infer 93 | (Surface.Parser.Var 94 | | Surface.Parser.App 95 | | Surface.Parser.Fst 96 | | Surface.Parser.Snd 97 | | Surface.Parser.Cas 98 | | Surface.Parser.ExF 99 | | Surface.Parser.Cut) 100 | #-} 101 | 102 | embed^RCheck : RCheck → Check 103 | embed^RInfer : RInfer → Infer 104 | 105 | 106 | embed^RCheck (Lam x x₁) = `lam x ↦ embed^RCheck x₁ 107 | embed^RCheck (Let x x₁ x₂) = `let embed^RPattern x ∷= embed^RInfer x₁ `in embed^RCheck x₂ 108 | embed^RCheck One = `unit 109 | embed^RCheck (Prd x x₁) = `prd (embed^RCheck x) (embed^RCheck x₁) 110 | embed^RCheck (Inl x) = `inl (embed^RCheck x) 111 | embed^RCheck (Inr x) = `inr (embed^RCheck x) 112 | embed^RCheck (Neu x) = `neu (embed^RInfer x) 113 | 114 | embed^RInfer (Var x) = `var x 115 | embed^RInfer (App x x₁) = `app (embed^RInfer x) (embed^RCheck x₁) 116 | embed^RInfer (Fst x) = `fst (embed^RInfer x) 117 | embed^RInfer (Snd x) = `snd (embed^RInfer x) 118 | embed^RInfer (Cas x x₁ x₂ x₃ x₄ x₅) = `case embed^RInfer x return embed^RType x₁ of x₂ ↦ embed^RCheck x₃ %% x₄ ↦ embed^RCheck x₅ 119 | embed^RInfer (ExF x x₁) = `exfalso (embed^RType x) (embed^RInfer x₁) 120 | embed^RInfer (Cut x x₁) = `cut (embed^RCheck x) (embed^RType x₁) 121 | 122 | -- example: 123 | 124 | `swap⊗ : Check 125 | `swap⊗ = `lam "pair" ↦ 126 | `let `v "left" ,, `v "right" ∷= `var "pair" 127 | `in `prd (`neu `var "right") (`neu `var "left") 128 | 129 | `swap⊕ : (σ τ : Type) → Check 130 | `swap⊕ σ τ = `lam "sum" ↦ `neu 131 | `case (`var "sum") return τ ⊕ σ 132 | of "left" ↦ `inr (`neu `var "left") 133 | %% "right" ↦ `inl (`neu `var "right") 134 | 135 | 136 | `swap& : Check 137 | `swap& = `lam "pair" ↦ 138 | `prd (`neu (`snd (`var "pair"))) (`neu (`fst (`var "pair"))) 139 | 140 | 141 | 142 | ----------------------------------------------- 143 | -- Scope Checking 144 | ----------------------------------------------- 145 | 146 | infix 1 _⁇_↝_ 147 | data _⁇_↝_ {A : Set} : ∀ {n} → Vec A n → A → Fin n → Set where 148 | ze : ∀ {n} {xs : Vec A n} {x : A} → x ∷ xs ⁇ x ↝ zero 149 | su : ∀ {n} {xs : Vec A n} {x y : A} {k : Fin n} → 150 | x ≢ y → xs ⁇ x ↝ k → y ∷ xs ⁇ x ↝ suc k 151 | 152 | ⁇↝-invert : ∀ {A} {n} {xs : Vec A n} {x y} {k} → y ∷ xs ⁇ x ↝ k → 153 | x ≡ y ⊎ ∃ λ k → xs ⁇ x ↝ k 154 | ⁇↝-invert ze = inj₁ refl 155 | ⁇↝-invert (su ¬eq pr) = inj₂ (, pr) 156 | 157 | module withEqDec {A : Set} (eq? : (x y : A) → Dec (x ≡ y)) where 158 | 159 | resolve : ∀ {n} (x : A) (xs : Vec A n) → Dec (∃ λ k → xs ⁇ x ↝ k) 160 | resolve x [] = no (λ { (() , ()) }) 161 | resolve x (y ∷ xs) with eq? x y | resolve x xs 162 | resolve x (.x ∷ xs) | yes refl | _ = yes (, ze) 163 | ... | no ¬eq | yes (k , pr) = yes (, su ¬eq pr) 164 | ... | no ¬eq | no ¬pr = no ([ ¬eq , ¬pr ] ∘ ⁇↝-invert ∘ proj₂) 165 | 166 | open withEqDec Data.String._≟_ 167 | import linear.Language as L 168 | open import Category.Monad 169 | import Level 170 | open RawMonad (monad {Level.zero}) hiding (_⊗_) 171 | 172 | scopePattern : Pattern → ∃ λ n → Vec String n × L.Pattern n 173 | scopePattern (`v nm) = , nm ∷ [] , L.`v 174 | scopePattern `⟨⟩ = zero , [] , L.`⟨⟩ 175 | scopePattern (p ,, q) = 176 | let (m , xs , p′) = scopePattern p 177 | (n , ys , q′) = scopePattern q 178 | in , xs ++ ys , p′ L.,, q′ 179 | 180 | mutual 181 | 182 | scopeCheck : ∀ {n} → Vec String n → Check → Maybe (L.Check n) 183 | scopeCheck nms (`lam nm ↦ b) = L.`lam_ <$> scopeCheck (nm ∷ nms) b 184 | scopeCheck nms (`let p ∷= t `in u) = 185 | let (m , nms′ , p′) = scopePattern p 186 | in L.`let p′ ∷=_`in_ <$> scopeInfer nms t ⊛ scopeCheck (nms′ ++ nms) u 187 | scopeCheck nms `unit = return L.`unit 188 | scopeCheck nms (`prd a b) = L.`prd <$> scopeCheck nms a ⊛ scopeCheck nms b 189 | scopeCheck nms (`inl t) = L.`inl_ <$> scopeCheck nms t 190 | scopeCheck nms (`inr t) = L.`inr_ <$> scopeCheck nms t 191 | scopeCheck nms (`neu i) = L.`neu_ <$> scopeInfer nms i 192 | 193 | scopeInfer : ∀ {n} → Vec String n → Infer → Maybe (L.Infer n) 194 | scopeInfer nms (`var nm) with resolve nm nms 195 | ... | yes (k , _) = just (L.`var k) 196 | ... | no ¬p = nothing 197 | scopeInfer nms (`app f t) = L.`app <$> scopeInfer nms f ⊛ scopeCheck nms t 198 | scopeInfer nms (`fst t) = L.`fst_ <$> scopeInfer nms t 199 | scopeInfer nms (`snd t) = L.`snd_ <$> scopeInfer nms t 200 | scopeInfer nms (`case i return σ of nml ↦ l %% nmr ↦ r) = 201 | L.`case_return σ of_%%_ <$> scopeInfer nms i ⊛ scopeCheck (nml ∷ nms) l ⊛ scopeCheck (nmr ∷ nms) r 202 | scopeInfer nms (`exfalso σ t) = L.`exfalso σ <$> scopeInfer nms t 203 | scopeInfer nms (`cut t σ) = (λ t → L.`cut t σ) <$> scopeCheck nms t 204 | 205 | 206 | 207 | ----------------------------------------------- 208 | -- Scope and Type Checking 209 | ----------------------------------------------- 210 | 211 | import linear.Usage as U 212 | import linear.Typing as T 213 | import linear.Typecheck as TC 214 | import linear.Typecheck.Problem as TCP 215 | 216 | linear : (σ : Type) (t : Check) → Maybe (∃ λ c → just c ≡ scopeCheck [] t 217 | × U.[] T.⊢ σ ∋ c ⊠ U.[]) 218 | linear σ c with scopeCheck [] c 219 | ... | nothing = nothing 220 | ... | just t = case TC.check U.[] σ t of λ 221 | { (yes (U.[] TCP., pr)) → just (t , refl , pr) 222 | ; (no ¬C) → nothing 223 | } 224 | 225 | -- example: 226 | `swap⊗-ok : ∀ σ τ → Is-just (linear ((σ ⊗ τ) ─o (τ ⊗ σ)) `swap⊗) 227 | `swap⊗-ok σ τ rewrite eq-diag τ | eq-diag σ = just _ 228 | 229 | -- example: 230 | `swap⊕-ok : ∀ σ τ → Is-just (linear ((σ ⊕ τ) ─o (τ ⊕ σ)) (`swap⊕ σ τ)) 231 | `swap⊕-ok σ τ rewrite eq-diag τ | eq-diag σ | eq-diag (τ ⊕ σ) = just _ 232 | 233 | -- example: 234 | `swap&-ok : ∀ σ τ → Is-just (linear ((σ & τ) ─o (τ & σ)) `swap&) 235 | `swap&-ok σ τ rewrite eq-diag τ | eq-diag σ = just _ 236 | -------------------------------------------------------------------------------- /src/linear/Typing/Thinning.agda: -------------------------------------------------------------------------------- 1 | module linear.Typing.Thinning where 2 | 3 | open import Level 4 | open import Data.Nat 5 | open import Data.Fin 6 | open import Data.Product as P 7 | open import Data.Vec hiding (map ; tail) 8 | open import Function 9 | open import Relation.Binary.PropositionalEquality as PEq 10 | 11 | open import linear.Type 12 | open import linear.Scope as Sc 13 | open import linear.Context as C 14 | open import linear.Language 15 | import linear.Context.Pointwise as CP 16 | open import linear.Usage as U hiding (tail) 17 | open import linear.Usage.Consumption hiding (refl ; trans) 18 | import linear.Usage.Pointwise as UP 19 | open import linear.Usage.Erasure 20 | open import linear.Language 21 | open import linear.Typing as T 22 | open import linear.Typing.Consumption 23 | open import linear.Typing.Extensional 24 | 25 | Thinning : {T : ℕ → Set} (Wk : Sc.Weakening T) (𝓣 : Typing T) → Set 26 | Thinning {T} Wk 𝓣 = 27 | {k l : ℕ} {m : Sc.Mergey k l} {M : C.Mergey m} (𝓜 : U.Mergey M) → 28 | {γ : Context k} (Γ Δ : Usages γ) {t : T l} {σ : Type} → 29 | 𝓣 (Γ U.⋈ 𝓜) t σ (Δ U.⋈ 𝓜) → Σ[ t′ ∈ T k ] t ≡ Wk m t′ × 𝓣 Γ t′ σ Δ 30 | 31 | data Usages[_] 32 | {ℓ^R : Level} (R : {σ : Type} (S T : Usage σ) → Set ℓ^R) : 33 | {k : ℕ} {γ : Context k} → Usages γ → Usages γ → Set ℓ^R where 34 | [] : Usages[ R ] [] [] 35 | _∷_ : {k : ℕ} {γ : Context k} {Γ Δ : Usages γ} {σ : Type} {S T : Usage σ} → 36 | R S T → Usages[ R ] Γ Δ → Usages[ R ] (S ∷ Γ) (T ∷ Δ) 37 | 38 | reflUsages : {k : ℕ} {γ : Context k} (Γ : Usages γ) → Usages[ _≡_ ] Γ Γ 39 | reflUsages [] = [] 40 | reflUsages (x ∷ Γ) = refl ∷ reflUsages Γ 41 | 42 | equalUsages : {k : ℕ} {γ : Context k} {Γ Δ : Usages γ} → Usages[ _≡_ ] Γ Δ → Γ ≡ Δ 43 | equalUsages [] = refl 44 | equalUsages (refl ∷ eqs) = cong (_∷_ _) (equalUsages eqs) 45 | 46 | Thinning′ : {T : ℕ → Set} (Wk : Sc.Weakening T) (𝓣 : Typing T) → Set 47 | Thinning′ {T} Wk 𝓣 = 48 | {k l : ℕ} {m : Sc.Mergey k l} {M : C.Mergey m} (𝓜 : U.Mergey M) → 49 | {γ : Context k} {Γ Δ : Usages γ} {ξ ζ : Usages (γ C.⋈ M)} {t : T l} {σ : Type} → 50 | Usages[ _≡_ ] ξ (Γ U.⋈ 𝓜) → Usages[ _≡_ ] ζ (Δ U.⋈ 𝓜) → 51 | 𝓣 ξ t σ ζ → Σ[ t′ ∈ T k ] t ≡ Wk m t′ × 𝓣 Γ t′ σ Δ 52 | 53 | thinning : {T : ℕ → Set} {Wk : Sc.Weakening T} {𝓣 : Typing T} → 54 | Thinning′ Wk 𝓣 → Thinning Wk 𝓣 55 | thinning th 𝓜 Γ Δ t = th 𝓜 (reflUsages _) (reflUsages _) t 56 | 57 | thinning′Fin : Thinning′ Sc.weakFin TFin 58 | thinning′Fin finish Γ Δ k rewrite equalUsages Γ | equalUsages Δ = , refl , k 59 | thinning′Fin (copy 𝓜) {γ = σ ∷ γ} {Γ = _ ∷ Γ} {Δ = _ ∷ Δ} (refl ∷ eqΓ) (refl ∷ eqΔ) z 60 | rewrite ⋈ˡ-injective (_ , _ , _ , _ , _ , 𝓜 , _) (equalUsages eqΓ) (equalUsages eqΔ) = 61 | Fin.zero , refl , z 62 | thinning′Fin (copy 𝓜) {γ = σ ∷ γ} {S ∷ Γ} {T ∷ Δ} (eqS ∷ eqΓ) (eqT ∷ eqΔ) (s k) 63 | rewrite trans (PEq.sym eqS) eqT = 64 | let (k′ , eq , K) = thinning′Fin 𝓜 eqΓ eqΔ k 65 | in Fin.suc k′ , cong Fin.suc eq , s K 66 | thinning′Fin (insert A 𝓜) (S ∷ Γ) (T ∷ Δ) (s k) = 67 | let (k′ , eq , K) = thinning′Fin 𝓜 Γ Δ k 68 | in k′ , cong Fin.suc eq , K 69 | thinning′Fin (insert A 𝓜) (S ∷ Γ) (T ∷ Δ) z = case trans S (PEq.sym T) of λ () 70 | 71 | thinningFin : Thinning Sc.weakFin TFin 72 | thinningFin = thinning thinning′Fin 73 | 74 | split-⋈ : 75 | {k l : ℕ} {m : Sc.Mergey k l} {M : C.Mergey m} (𝓜 : U.Mergey M) → 76 | {γ : Context k} {Γ Δ : Usages γ} {ξ Φ ζ : Usages (γ C.⋈ M)} → 77 | Usages[ _≡_ ] ξ (Γ U.⋈ 𝓜) → Usages[ _≡_ ] ζ (Δ U.⋈ 𝓜) → 78 | ξ ⊆ Φ → Φ ⊆ ζ → ∃ λ φ → Usages[ _≡_ ] Φ (φ U.⋈ 𝓜) 79 | split-⋈ finish eq₁ eq₂ le₁ le₂ = , reflUsages _ 80 | split-⋈ (copy 𝓜) {σ ∷ γ} {S ∷ Γ} {T ∷ Δ} (eqS ∷ eq₁) (eqT ∷ eq₂) (─∷ le₁) (─∷ le₂) = 81 | let (φ , eq) = split-⋈ 𝓜 eq₁ eq₂ le₁ le₂ 82 | in T ∷ φ , eqT ∷ eq 83 | split-⋈ (copy 𝓜) {.σ ∷ γ} {S ∷ Γ} {T ∷ Δ} (eqS ∷ eq₁) (eqT ∷ eq₂) (─∷ le₁) (σ ∷ le₂) = 84 | let (φ , eq) = split-⋈ 𝓜 eq₁ eq₂ le₁ le₂ 85 | in Usage.[ σ ] ∷ φ , refl ∷ eq 86 | split-⋈ (copy 𝓜) {.σ ∷ γ} {S ∷ Γ} {T ∷ Δ} (eqS ∷ eq₁) (eqT ∷ eq₂) (σ ∷ le₁) (─∷ le₂) = 87 | let (φ , eq) = split-⋈ 𝓜 eq₁ eq₂ le₁ le₂ 88 | in ] σ [ ∷ φ , refl ∷ eq 89 | split-⋈ (insert A 𝓜) (eqA ∷ eq₁) (_ ∷ eq₂) (─∷ le₁) (─∷ le₂) = 90 | let (φ , eq) = split-⋈ 𝓜 eq₁ eq₂ le₁ le₂ 91 | in , eqA ∷ eq 92 | split-⋈ (insert A 𝓜) (eqA ∷ eq₁) (_ ∷ eq₂) (─∷ le₁) (a ∷ le₂) = 93 | let (φ , eq) = split-⋈ 𝓜 eq₁ eq₂ le₁ le₂ 94 | in , eqA ∷ eq 95 | split-⋈ (insert A 𝓜) (_ ∷ eq₁) (eqA ∷ eq₂) (a ∷ le₁) (─∷ le₂) = 96 | let (φ , eq) = split-⋈ 𝓜 eq₁ eq₂ le₁ le₂ 97 | in , eqA ∷ eq 98 | 99 | thinning′Infer : Thinning′ weakInfer TInfer 100 | thinning′Check : Thinning′ weakCheck TCheck 101 | 102 | thinning′Infer 𝓜 eq₁ eq₂ (`var k) = 103 | let (k′ , eq , K) = thinning′Fin 𝓜 eq₁ eq₂ k 104 | in `var k′ , cong `var_ eq , `var K 105 | thinning′Infer 𝓜 eq₁ eq₂ (`app f t) = 106 | let (φ , eq) = split-⋈ 𝓜 eq₁ eq₂ (consumptionInfer f) (consumptionCheck t) 107 | (f′ , eqf , F) = thinning′Infer 𝓜 eq₁ eq f 108 | (t′ , eqt , T) = thinning′Check 𝓜 eq eq₂ t 109 | in , cong₂ `app eqf eqt , `app F T 110 | thinning′Infer 𝓜 eq₁ eq₂ (`fst t) = 111 | let (t′ , eqt , T) = thinning′Infer 𝓜 eq₁ eq₂ t 112 | in , cong `fst_ eqt , `fst T 113 | thinning′Infer 𝓜 eq₁ eq₂ (`snd t) = 114 | let (t′ , eqt , T) = thinning′Infer 𝓜 eq₁ eq₂ t 115 | in , cong `snd_ eqt , `snd T 116 | thinning′Infer 𝓜 eq₁ eq₂ (`case t return σ of l %% r) = 117 | let (φ , eq) = split-⋈ 𝓜 eq₁ eq₂ (consumptionInfer t) (tail (consumptionCheck l)) 118 | (t′ , eqt , T) = thinning′Infer 𝓜 eq₁ eq t 119 | (l′ , eql , L) = thinning′Check (copy 𝓜) (refl ∷ eq) (refl ∷ eq₂) l 120 | (r′ , eqr , R) = thinning′Check (copy 𝓜) (refl ∷ eq) (refl ∷ eq₂) r 121 | in , cong₂ (λ t → uncurry (`case t return σ of_%%_)) eqt (cong₂ _,_ eql eqr) 122 | , `case T return σ of L %% R 123 | thinning′Infer 𝓜 eq₁ eq₂ (`exfalso σ t) = 124 | let (t′ , eqt , T) = thinning′Infer 𝓜 eq₁ eq₂ t 125 | in , cong (`exfalso σ) eqt , `exfalso σ T 126 | thinning′Infer 𝓜 eq₁ eq₂ (`cut t) = 127 | let (t′ , eqt , T) = thinning′Check 𝓜 eq₁ eq₂ t 128 | in , cong (λ t → `cut t _) eqt , `cut T 129 | 130 | thinning′Check 𝓜 eq₁ eq₂ (`lam t) = 131 | let (t′ , eqt , T) = thinning′Check (copy 𝓜) (refl ∷ eq₁) (refl ∷ eq₂) t 132 | in , cong `lam_ eqt , `lam T 133 | thinning′Check 𝓜 eq₁ eq₂ (`let p ∷= t `in u) = 134 | let o = T.patternSize p 135 | δ = patternContext p 136 | Φ = inferOutput t 137 | (φ , eq) = split-⋈ 𝓜 eq₁ eq₂ (consumptionInfer t) 138 | $ truncate δ (consumptionCheck u) 139 | (t′ , eqt , T) = thinning′Infer 𝓜 eq₁ eq t 140 | v : ([[ δ ]] U.++ φ) U.⋈ U.copys o 𝓜 141 | ⊢ _ ∋ _ 142 | ⊠ (]] δ [[ U.++ _) U.⋈ U.copys o 𝓜 143 | v = extensionalCheck (CP.copys δ) (CP.sym $ CP.copys δ) 144 | (UP.irrelevance _ $ UP.trans (UP.copys [[ δ ]]) 145 | (UP.refl {Γ = [[ δ ]]} UP.++ UP.fromEq (PEq.sym $ equalUsages eq))) 146 | (UP.irrelevance _ $ UP.trans 147 | (UP.refl {Γ = ]] δ [[} UP.++ UP.fromEq (equalUsages eq₂)) 148 | (UP.sym (UP.copys ]] δ [[))) 149 | u 150 | (u′ , equ , U) = thinning′Check (U.copys o 𝓜) (reflUsages _) (reflUsages _) v 151 | in , cong₂ (`let _ ∷=_`in_) eqt equ , `let p ∷= T `in U 152 | thinning′Check 𝓜 eq₁ eq₂ `unit = 153 | let eq = ⋈ˡ-injective (_ , _ , _ , _ , _ , 𝓜 , _) (equalUsages eq₁) (equalUsages eq₂) 154 | in , refl , subst (TCheck _ _ _) eq `unit 155 | thinning′Check 𝓜 eq₁ eq₂ (`prd⊗ a b) = 156 | let (φ , eq) = split-⋈ 𝓜 eq₁ eq₂ (consumptionCheck a) (consumptionCheck b) 157 | (a′ , eqa , A) = thinning′Check 𝓜 eq₁ eq a 158 | (b′ , eqb , B) = thinning′Check 𝓜 eq eq₂ b 159 | in , cong₂ `prd eqa eqb , `prd⊗ A B 160 | thinning′Check 𝓜 eq₁ eq₂ (`prd& a b) = 161 | let (a′ , eqa , A) = thinning′Check 𝓜 eq₁ eq₂ a 162 | (b′ , eqb , B) = thinning′Check 𝓜 eq₁ eq₂ b 163 | in , cong₂ `prd eqa eqb , `prd& A B 164 | thinning′Check 𝓜 eq₁ eq₂ (`inl t) = 165 | let (t′ , eqt , T) = thinning′Check 𝓜 eq₁ eq₂ t 166 | in , cong `inl_ eqt , `inl T 167 | thinning′Check 𝓜 eq₁ eq₂ (`inr t) = 168 | let (t′ , eqt , T) = thinning′Check 𝓜 eq₁ eq₂ t 169 | in , cong `inr_ eqt , `inr T 170 | thinning′Check 𝓜 eq₁ eq₂ (`neu t) = 171 | let (t′ , eqt , T) = thinning′Infer 𝓜 eq₁ eq₂ t 172 | in , cong `neu_ eqt , `neu T 173 | 174 | thinningInfer : Thinning weakInfer TInfer 175 | thinningInfer = thinning thinning′Infer 176 | 177 | thinningCheck : Thinning weakCheck TCheck 178 | thinningCheck = thinning thinning′Check 179 | 180 | -- A more conventional formulation of Thinning for Check and Infer 181 | -- can be derived as simple corrolaries of previous results: 182 | 183 | thinCheck : 184 | {n : ℕ} {γ : Context n} {Γ Δ : Usages γ} {t : Check n} {σ : Type} → Γ ⊢ σ ∋ t ⊠ Δ → 185 | Σ[ k ∈ ℕ ] Σ[ δ ∈ Context k ] Σ[ t′ ∈ Check k ] Σ[ m ∈ Sc.Mergey k n ] 186 | t ≡ weakCheck m t′ × [[ δ ]] ⊢ σ ∋ t′ ⊠ ]] δ [[ 187 | thinCheck T = 188 | let (k , m , δ , M , 𝓜 , eqs , eq) = ⌊ consumptionCheck T ⌋ 189 | EQs = (UP.irrelevance _ (UP.coerceˡ eqs)) 190 | T₁ = extensionalCheck (CP.sym eqs) eqs EQs (UP.coerceʳ eqs) T 191 | T₂ = framingCheck eq T₁ 192 | (t′ , eq , T₃) = thinningCheck 𝓜 _ _ T₂ 193 | in k , δ , t′ , m , eq , T₃ 194 | 195 | thinInfer : 196 | {n : ℕ} {γ : Context n} {Γ Δ : Usages γ} {t : Infer n} {σ : Type} → Γ ⊢ t ∈ σ ⊠ Δ → 197 | Σ[ k ∈ ℕ ] Σ[ δ ∈ Context k ] Σ[ t′ ∈ Infer k ] Σ[ m ∈ Sc.Mergey k n ] 198 | t ≡ weakInfer m t′ × [[ δ ]] ⊢ t′ ∈ σ ⊠ ]] δ [[ 199 | thinInfer T = 200 | let (k , m , δ , M , 𝓜 , eqs , eq) = ⌊ consumptionInfer T ⌋ 201 | EQs = (UP.irrelevance _ (UP.coerceˡ eqs)) 202 | T₁ = extensionalInfer (CP.sym eqs) eqs EQs (UP.coerceʳ eqs) T 203 | T₂ = framingInfer eq T₁ 204 | (t′ , eq , T₃) = thinningInfer 𝓜 _ _ T₂ 205 | in k , δ , t′ , m , eq , T₃ 206 | -------------------------------------------------------------------------------- /doc/main.bib: -------------------------------------------------------------------------------- 1 | @incollection{kiselyov2012typed, 2 | title={Typed tagless final interpreters}, 3 | author={Kiselyov, Oleg}, 4 | booktitle={Generic and Indexed Programming}, 5 | pages={130--174}, 6 | year={2012}, 7 | publisher={Springer} 8 | } 9 | @techreport{winiko1994deterministic, 10 | title={Deterministic resource management for the linear logic programming language Lygon}, 11 | author={Winiko, Michael and Harland, James}, 12 | year={1994}, 13 | institution={Technical Report 94/23, Melbourne University} 14 | } 15 | @inproceedings{cervesato1996efficient, 16 | title={Efficient resource management for linear logic proof search}, 17 | author={Cervesato, Iliano and Hodas, Joshua S and Pfenning, Frank}, 18 | booktitle={International Workshop on Extensions of Logic Programming}, 19 | pages={67--81}, 20 | year={1996}, 21 | organization={Springer} 22 | } 23 | @article{polakow2016embedding, 24 | title={Embedding a full linear lambda calculus in Haskell}, 25 | author={Polakow, Jeff}, 26 | journal={ACM SIGPLAN Notices}, 27 | volume={50}, 28 | number={12}, 29 | pages={177--188}, 30 | year={2016}, 31 | publisher={ACM} 32 | } 33 | @inproceedings{rand17qwire, 34 | title={{QWIRE} Practice: Formal Verification of Quantum Circuits in {C}oq}, 35 | booktitle={Quantum Physics and Logic}, 36 | year={2017}, 37 | author={Rand, Robert and Paykin, Jennifer and Zdancewic, Steve} 38 | } 39 | @book{mitchell1996foundations, 40 | title={Foundations for programming languages}, 41 | author={Mitchell, John C}, 42 | volume={1}, 43 | year={1996}, 44 | publisher={MIT press} 45 | } 46 | @inproceedings{boutin1997using, 47 | title={Using reflection to build efficient and certified decision procedures}, 48 | author={Boutin, Samuel}, 49 | booktitle={Theoretical Aspects of Computer Software}, 50 | pages={515--529}, 51 | year={1997}, 52 | organization={Springer} 53 | } 54 | @article{danielsson2012bag, 55 | title={Bag Equivalence via a Proof-Relevant Membership Relation}, 56 | author={Danielsson, Nils}, 57 | journal={Interactive Theorem Proving}, 58 | pages={149--165}, 59 | year={2012}, 60 | publisher={Springer} 61 | } 62 | @incollection{altenkirch1999monadic, 63 | title={Monadic presentations of lambda terms using generalized inductive types}, 64 | author={Altenkirch, Thorsten and Reus, Bernhard}, 65 | booktitle={Computer Science Logic}, 66 | pages={453--468}, 67 | year={1999}, 68 | publisher={Springer} 69 | } 70 | @incollection{mcbride2016got, 71 | title={I Got Plenty o’Nuttin’}, 72 | author={McBride, Conor}, 73 | booktitle={A List of Successes That Can Change the World}, 74 | pages={207--233}, 75 | year={2016}, 76 | publisher={Springer} 77 | } 78 | @PHDTHESIS{krebbers2015thesis, 79 | title={The C standard formalized in Coq}, 80 | author={Krebbers, Robbert}, 81 | school={Radboud University Nijmegen}, 82 | year={2015} 83 | } 84 | @article{dybjer1994inductive, 85 | title={Inductive families}, 86 | author={Dybjer, Peter}, 87 | journal={Formal aspects of computing}, 88 | volume={6}, 89 | number={4}, 90 | pages={440--465}, 91 | year={1994}, 92 | publisher={Springer} 93 | } 94 | @article{bird_paterson_1999, 95 | title={de {B}ruijn notation as a nested datatype}, 96 | volume={9}, 97 | number={1}, 98 | journal={Journal of Functional Programming}, 99 | publisher={Cambridge University Press}, 100 | author={Bird, Richard S. and Paterson, Ross}, 101 | year={1999}, 102 | pages={77–91} 103 | } 104 | @inproceedings{debruijn1972lambda, 105 | title={Lambda Calculus Notation with Nameless Dummies}, 106 | author={De Bruijn, Nicolaas Govert}, 107 | booktitle={Indagationes Mathematicae (Proceedings)}, 108 | volume={75}, 109 | number={5}, 110 | pages={381--392}, 111 | year={1972}, 112 | publisher={Elsevier} 113 | } 114 | @phdthesis{chapman2009thesis, 115 | title={Type checking and normalisation}, 116 | author={Chapman, James Maitland}, 117 | year={2009}, 118 | school={University of Nottingham} 119 | } 120 | @inproceedings{altenkirch1995categorical, 121 | title={Categorical reconstruction of a reduction free normalization proof}, 122 | author={Altenkirch, Thorsten and Hofmann, Martin and Streicher, Thomas}, 123 | booktitle={Category Theory and Computer Science}, 124 | pages={182--199}, 125 | year={1995}, 126 | publisher={Springer} 127 | } 128 | @unpublished{Adams2015Type, 129 | author = {Adams, Robin and Jacobs, Bart}, 130 | day = {30}, 131 | month = nov, 132 | title = {A Type Theory for Probabilistic and {B}ayesian Reasoning}, 133 | url = {http://arxiv.org/abs/1511.09230}, 134 | year = {2015} 135 | } 136 | @unpublished{Allais2015Proof, 137 | author = {Allais, Guillaume and McBride, Conor}, 138 | title = {Certified Proof Search for Intuitionistic Linear Logic}, 139 | url = {http://gallais.github.io/proof-search-ILLWiL/}, 140 | year = {2015} 141 | } 142 | @article{pierce2000local, 143 | title={Local type inference}, 144 | author={Pierce, Benjamin C and Turner, David N}, 145 | journal={ACM Transactions on Programming Languages and Systems (TOPLAS)}, 146 | volume={22}, 147 | number={1}, 148 | pages={1--44}, 149 | year={2000}, 150 | publisher={ACM} 151 | } 152 | @article{brady2013idris, 153 | title={Idris, a general-purpose dependently typed programming language: Design and implementation}, 154 | author={Brady, Edwin}, 155 | journal={Journal of Functional Programming}, 156 | volume={23}, 157 | number={05}, 158 | pages={552--593}, 159 | year={2013}, 160 | publisher={Cambridge Univ Press} 161 | } 162 | @Inbook{Danvy1999Type, 163 | author="Danvy, Olivier", 164 | title="Type-Directed Partial Evaluation", 165 | year="1999", 166 | publisher="Springer", 167 | } 168 | @incollection{letouzey2002new, 169 | title={A new extraction for {C}oq}, 170 | author={Letouzey, Pierre}, 171 | booktitle={Types for proofs and programs}, 172 | pages={200--219}, 173 | year={2002}, 174 | publisher={Springer} 175 | } 176 | @inproceedings{launchbury1994lazy, 177 | title={Lazy functional state threads}, 178 | author={Launchbury, John and Peyton Jones, Simon L}, 179 | booktitle={ACM SIGPLAN Notices}, 180 | volume={29}, 181 | number={6}, 182 | pages={24--35}, 183 | year={1994}, 184 | organization={ACM} 185 | } 186 | @incollection{norell2009dependently, 187 | title={Dependently typed programming in {A}gda}, 188 | author={Norell, Ulf}, 189 | booktitle={Advanced Functional Programming}, 190 | pages={230--266}, 191 | year={2009}, 192 | publisher={Springer} 193 | } 194 | @inproceedings{weirich2013towards, 195 | title={Towards dependently typed {H}askell: {S}ystem {FC} with kind equality}, 196 | author={Weirich, Stephanie and Hsu, Justin and Eisenberg, Richard A}, 197 | booktitle={Proceedings of the 18th ACM SIGPLAN International Conference on Functional Programming, ICFP}, 198 | volume={13}, 199 | year={2013} 200 | } 201 | @incollection{achten1993high, 202 | title={High level specification of {I}/{O} in functional languages}, 203 | author={Achten, Peter and Van Groningen, John and Plasmeijer, Rinus}, 204 | booktitle={Functional Programming, Glasgow 1992}, 205 | pages={1--17}, 206 | year={1993}, 207 | publisher={Springer} 208 | } 209 | @misc{manual:rust, 210 | title={The {R}ust {P}rogramming {L}anguage -- {O}wnership}, 211 | author={The Rust Project Developers}, 212 | howpublished={\url{https://doc.rust-lang.org/book/first-edition/ownership.html}}, 213 | year={2017}, 214 | note={Retrieved on 2017-11-06} 215 | } 216 | @misc{wiki:linearlogic, 217 | title={{L}inear {L}ogic {W}iki -- {I}ntuitionistic {L}inear {L}ogic}, 218 | author={Laurent, Olivier and Regnier, Laurent}, 219 | howpublished={\url{http://llwiki.ens-lyon.fr/mediawiki/index.php/Intuitionistic_linear_logic}}, 220 | year={2009}, 221 | note={Retrieved on 2017-11-06} 222 | } 223 | @misc{bob:sortingtypes, 224 | title={Sorting Types -- Permutation via Linearity}, 225 | author={Atkey, Robert and Wood, James}, 226 | howpublished={\url{https://github.com/bobatkey/sorting-types}}, 227 | year={2013}, 228 | note={Retrieved on 2017-11-06} 229 | } 230 | @article{girard1987linear, 231 | title={Linear logic}, 232 | author={Girard, Jean-Yves}, 233 | journal={Theoretical computer science}, 234 | volume={50}, 235 | number={1}, 236 | pages={1--101}, 237 | year={1987}, 238 | publisher={Elsevier} 239 | } 240 | @incollection{brady2003inductive, 241 | title={Inductive families need not store their indices}, 242 | author={Brady, Edwin and McBride, Conor and McKinna, James}, 243 | booktitle={Types for proofs and programs}, 244 | pages={115--129}, 245 | year={2003}, 246 | publisher={Springer} 247 | } 248 | @article{bradypractical, 249 | title={Practical Erasure in Dependently Typed Languages}, 250 | author={Brady, Edwin and Teji{\v{s}}c{\'a}k, Mat{\'u}{\v{s}}} 251 | } 252 | @article{benton1993term, 253 | title={A term calculus for intuitionistic linear logic}, 254 | author={Benton, Nick and Bierman, Gavin and De Paiva, Valeria and Hyland, Martin}, 255 | journal={Typed Lambda Calculi and Applications}, 256 | pages={75--90}, 257 | year={1993}, 258 | publisher={Springer} 259 | } 260 | @book{troelstra1991lectures, 261 | title={Lectures on linear logic}, 262 | author={Troelstra, Anne Sjerp}, 263 | year={1991} 264 | } 265 | @book{barber1996dual, 266 | title={Dual intuitionistic linear logic}, 267 | author={Barber, Andrew and Plotkin, Gordon}, 268 | year={1996}, 269 | publisher={University of Edinburgh, Department of Computer Science, Laboratory for Foundations of Computer Science} 270 | } 271 | @article{dagand2014transporting, 272 | title={Transporting functions across ornaments}, 273 | author={Dagand, Pierre-Evariste and McBride, Conor}, 274 | journal={Journal of Functional Programming}, 275 | volume={24}, 276 | number={2-3}, 277 | pages={316--383}, 278 | year={2014}, 279 | publisher={Cambridge University Press} 280 | } 281 | @article{mcbride2010ornamental, 282 | title={Ornamental algebras, algebraic ornaments}, 283 | author={McBride, Conor}, 284 | journal={Journal of functional programming}, 285 | year={2010} 286 | } -------------------------------------------------------------------------------- /src/linear/Completeness.agda: -------------------------------------------------------------------------------- 1 | module linear.Completeness where 2 | 3 | open import Data.Nat 4 | import Data.Fin as F 5 | open import Data.Nat.Properties.Simple 6 | open import Data.List as List hiding ([_] ; _∷ʳ_) 7 | open import Data.List.Properties 8 | open import Data.Vec as V hiding ([_] ; _∷ʳ_ ; fromList) 9 | open import Data.Product as Prod 10 | open import Data.Sum as Sum 11 | open import Function 12 | open import Relation.Binary.PropositionalEquality as Eq hiding ([_]) 13 | 14 | open import linear.ILL 15 | open import linear.Type 16 | open import linear.Context as C 17 | open import linear.Scope as S 18 | open import linear.Usage as U hiding ([_]) 19 | open import linear.Usage.Erasure 20 | open import linear.Context.Pointwise as CP 21 | open import linear.Usage.Pointwise as UP 22 | open import linear.Language as L 23 | open import linear.Typing 24 | open import linear.Typing.Extensional 25 | open import linear.Typing.Substitution as T 26 | open import linear.Usage.Mix 27 | open import linear.Typing.Mix 28 | 29 | lemma₁ : ∀ (γ : List Type) δ → S.Mergey (length γ) (length (δ List.++ γ)) 30 | lemma₁ γ [] = finish 31 | lemma₁ γ (σ ∷ δ) = insert (lemma₁ γ δ) 32 | 33 | Lemma₁ : ∀ γ δ → C.Mergey (lemma₁ γ δ) 34 | Lemma₁ γ [] = finish 35 | Lemma₁ γ (σ ∷ δ) = insert σ (Lemma₁ γ δ) 36 | 37 | Lemma₁-eq : ∀ γ δ → Context[ _≡_ ] (V.fromList (δ List.++ γ)) (V.fromList γ C.⋈ Lemma₁ γ δ) 38 | Lemma₁-eq γ [] = CP.refl 39 | Lemma₁-eq γ (σ ∷ δ) = Eq.refl ∷ Lemma₁-eq γ δ 40 | 41 | 𝓛emma₁ : ∀ γ δ (Δ : Usages (V.fromList δ)) → U.Mergey (Lemma₁ γ δ) 42 | 𝓛emma₁ γ [] [] = finish 43 | 𝓛emma₁ γ (σ ∷ δ) (S ∷ Δ) = insert S (𝓛emma₁ γ δ Δ) 44 | 45 | 𝓛emma₁-[[eq]] : ∀ γ δ → Usages[ _≡_ , UsageEq ] (Lemma₁-eq γ δ) 46 | [[ V.fromList (δ List.++ γ) ]] 47 | ([[ V.fromList γ ]] U.⋈ 𝓛emma₁ γ δ [[ V.fromList δ ]]) 48 | 𝓛emma₁-[[eq]] γ [] = UP.refl 49 | 𝓛emma₁-[[eq]] γ (σ ∷ δ) = Eq.refl ∷ 𝓛emma₁-[[eq]] γ δ 50 | 51 | 𝓛emma₁-]]eq[[ : ∀ γ δ → Usages[ _≡_ , UsageEq ] (Lemma₁-eq γ δ) 52 | ]] V.fromList (δ List.++ γ) [[ 53 | (]] V.fromList γ [[ U.⋈ 𝓛emma₁ γ δ ]] V.fromList δ [[) 54 | 𝓛emma₁-]]eq[[ γ [] = UP.refl 55 | 𝓛emma₁-]]eq[[ γ (σ ∷ δ) = Eq.refl ∷ 𝓛emma₁-]]eq[[ γ δ 56 | 57 | lemma₂ : ∀ (γ : List Type) δ → S.Mergey (length γ) (length (γ List.++ δ)) 58 | lemma₂ [] [] = finish 59 | lemma₂ [] (σ ∷ δ) = insert (lemma₂ [] δ) 60 | lemma₂ (σ ∷ γ) δ = copy (lemma₂ γ δ) 61 | 62 | Lemma₂ : ∀ γ δ → C.Mergey (lemma₂ γ δ) 63 | Lemma₂ [] [] = finish 64 | Lemma₂ [] (σ ∷ δ) = insert σ (Lemma₂ [] δ) 65 | Lemma₂ (σ ∷ γ) δ = copy (Lemma₂ γ δ) 66 | 67 | Lemma₂-eq : ∀ γ δ → Context[ _≡_ ] (V.fromList (γ List.++ δ)) (V.fromList γ C.⋈ Lemma₂ γ δ) 68 | Lemma₂-eq [] [] = [] 69 | Lemma₂-eq [] (σ ∷ δ) = Eq.refl ∷ Lemma₂-eq [] δ 70 | Lemma₂-eq (σ ∷ γ) δ = Eq.refl ∷ Lemma₂-eq γ δ 71 | 72 | Lemma₁₂-eq : ∀ γ δ → Context[ _≡_ ] (V.fromList δ C.⋈ Lemma₁ δ γ) 73 | (V.fromList γ C.⋈ Lemma₂ γ δ) 74 | Lemma₁₂-eq γ δ = CP.trans (CP.sym (Lemma₁-eq δ γ)) (Lemma₂-eq γ δ) 75 | 76 | Lemma₂₁-eq : ∀ γ δ → Context[ _≡_ ] (V.fromList γ C.⋈ Lemma₂ γ δ) 77 | (V.fromList δ C.⋈ Lemma₁ δ γ) 78 | Lemma₂₁-eq γ δ = CP.trans (CP.sym (Lemma₂-eq γ δ)) (Lemma₁-eq δ γ) 79 | 80 | 𝓛emma₂ : ∀ γ δ (Δ : Usages (V.fromList δ)) → U.Mergey (Lemma₂ γ δ) 81 | 𝓛emma₂ [] [] Δ = finish 82 | 𝓛emma₂ [] (σ ∷ δ) (S ∷ Δ) = insert S (𝓛emma₂ [] δ Δ) 83 | 𝓛emma₂ (σ ∷ γ) δ Δ = copy (𝓛emma₂ γ δ Δ) 84 | 85 | 𝓛emma₂-[[eq]] : ∀ γ δ → Usages[ _≡_ , UsageEq ] (Lemma₂-eq γ δ) 86 | [[ V.fromList (γ List.++ δ) ]] 87 | ([[ V.fromList γ ]] U.⋈ 𝓛emma₂ γ δ [[ V.fromList δ ]]) 88 | 𝓛emma₂-[[eq]] [] [] = [] 89 | 𝓛emma₂-[[eq]] [] (σ ∷ δ) = Eq.refl ∷ 𝓛emma₂-[[eq]] [] δ 90 | 𝓛emma₂-[[eq]] (x ∷ γ) δ = Eq.refl ∷ 𝓛emma₂-[[eq]] γ δ 91 | 92 | 𝓛emma₂-]]eq[[ : ∀ γ δ → Usages[ _≡_ , UsageEq ] (Lemma₂-eq γ δ) 93 | ]] V.fromList (γ List.++ δ) [[ 94 | (]] V.fromList γ [[ U.⋈ 𝓛emma₂ γ δ ]] V.fromList δ [[) 95 | 𝓛emma₂-]]eq[[ [] [] = [] 96 | 𝓛emma₂-]]eq[[ [] (σ ∷ δ) = Eq.refl ∷ 𝓛emma₂-]]eq[[ [] δ 97 | 𝓛emma₂-]]eq[[ (σ ∷ γ) δ = Eq.refl ∷ 𝓛emma₂-]]eq[[ γ δ 98 | 99 | 𝓛emma₁₂-]]eq[[ : ∀ γ δ → Usages[ _≡_ , UsageEq ] (Lemma₁₂-eq γ δ) 100 | (]] V.fromList δ [[ U.⋈ 𝓛emma₁ δ γ [[ V.fromList γ ]]) 101 | ([[ V.fromList γ ]] U.⋈ 𝓛emma₂ γ δ ]] V.fromList δ [[) 102 | 𝓛emma₁₂-]]eq[[ (σ ∷ γ) δ = Eq.refl ∷ 𝓛emma₁₂-]]eq[[ γ δ 103 | 𝓛emma₁₂-]]eq[[ [] [] = UP.refl 104 | 𝓛emma₁₂-]]eq[[ [] (σ ∷ δ) = Eq.refl ∷ 𝓛emma₁₂-]]eq[[ [] δ 105 | 106 | 𝓛emma₁₂-[[eq]] : ∀ γ δ → Usages[ _≡_ , UsageEq ] (Lemma₁₂-eq γ δ) 107 | ([[ V.fromList δ ]] U.⋈ 𝓛emma₁ δ γ ]] V.fromList γ [[) 108 | (]] V.fromList γ [[ U.⋈ 𝓛emma₂ γ δ [[ V.fromList δ ]]) 109 | 𝓛emma₁₂-[[eq]] (σ ∷ γ) δ = Eq.refl ∷ 𝓛emma₁₂-[[eq]] γ δ 110 | 𝓛emma₁₂-[[eq]] [] [] = UP.refl 111 | 𝓛emma₁₂-[[eq]] [] (σ ∷ δ) = Eq.refl ∷ 𝓛emma₁₂-[[eq]] [] δ 112 | 113 | 𝓛emma₂₁-[[eq]] : ∀ γ δ → Usages[ _≡_ , UsageEq ] (Lemma₂₁-eq γ δ) 114 | ([[ V.fromList γ ]] U.⋈ 𝓛emma₂ γ δ [[ V.fromList δ ]]) 115 | ([[ V.fromList δ ]] U.⋈ 𝓛emma₁ δ γ [[ V.fromList γ ]]) 116 | 𝓛emma₂₁-[[eq]] (σ ∷ γ) δ = Eq.refl ∷ 𝓛emma₂₁-[[eq]] γ δ 117 | 𝓛emma₂₁-[[eq]] [] [] = [] 118 | 𝓛emma₂₁-[[eq]] [] (σ ∷ δ) = Eq.refl ∷ 𝓛emma₂₁-[[eq]] [] δ 119 | 120 | 𝓛emma₂₁-]]eq[[ : ∀ γ δ → Usages[ _≡_ , UsageEq ] (Lemma₂₁-eq γ δ) 121 | (]] V.fromList γ [[ U.⋈ 𝓛emma₂ γ δ [[ V.fromList δ ]]) 122 | ([[ V.fromList δ ]] U.⋈ 𝓛emma₁ δ γ ]] V.fromList γ [[) 123 | 𝓛emma₂₁-]]eq[[ (σ ∷ γ) δ = Eq.refl ∷ 𝓛emma₂₁-]]eq[[ γ δ 124 | 𝓛emma₂₁-]]eq[[ [] [] = [] 125 | 𝓛emma₂₁-]]eq[[ [] (σ ∷ δ) = Eq.refl ∷ 𝓛emma₂₁-]]eq[[ [] δ 126 | 127 | 128 | `0L : (γ : List Type) (σ : Type) → ∃ λ t → U.[ 𝟘 ] ∷ [[ V.fromList γ ]] ⊢ t ∈ σ ⊠ ] 𝟘 [ ∷ ]] V.fromList γ [[ 129 | `0L [] τ = , `exfalso τ (`var z) 130 | `0L (σ ∷ γ) τ = 131 | let (t , T) = `0L γ (σ ─o τ) 132 | in , `app (T.weakInfer (copy (insert U.[ σ ] finish)) T) (`neu (`var (s z))) 133 | 134 | complete : {γ : List Type} {σ : Type} → γ ⊢ σ → 135 | ∃ λ t → [[ V.fromList γ ]] ⊢ σ ∋ t ⊠ ]] V.fromList γ [[ 136 | complete ax = , `neu (`var z) 137 | complete (cut {γ} {δ} {σ} {τ} t u) = 138 | let (rT , T) = complete t 139 | (rU , U) = complete u 140 | 141 | U′ : [[ V.fromList (σ ∷ δ) ]] U.⋈ copy (𝓛emma₁ δ γ [[ V.fromList γ ]]) 142 | ⊢ τ ∋ _ ⊠ 143 | ]] V.fromList (σ ∷ δ) [[ U.⋈ copy (𝓛emma₁ δ γ [[ V.fromList γ ]]) 144 | U′ = T.weakCheck (copy (𝓛emma₁ δ γ [[ V.fromList γ ]])) U 145 | 146 | T′ : [[ V.fromList γ ]] U.⋈ 𝓛emma₂ γ δ ]] V.fromList δ [[ 147 | ⊢ σ ∋ _ ⊠ 148 | ]] V.fromList γ [[ U.⋈ 𝓛emma₂ γ δ ]] V.fromList δ [[ 149 | T′ = T.weakCheck (𝓛emma₂ γ δ ]] V.fromList δ [[) T 150 | 151 | F : [[ V.fromList γ ]] U.⋈ 𝓛emma₂ γ δ [[ V.fromList δ ]] 152 | ⊢ _ ∈ σ ─o τ ⊠ 153 | [[ V.fromList γ ]] U.⋈ 𝓛emma₂ γ δ ]] V.fromList δ [[ 154 | F = extensionalInfer (Lemma₂₁-eq γ δ) (Lemma₁₂-eq γ δ) 155 | (𝓛emma₂₁-[[eq]] γ δ) (𝓛emma₁₂-]]eq[[ γ δ) 156 | $ `cut (`lam U′) 157 | 158 | FT : [[ V.fromList (γ List.++ δ) ]] 159 | ⊢ _ ∈ τ ⊠ 160 | ]] V.fromList (γ List.++ δ) [[ 161 | FT = extensionalInfer (Lemma₂-eq γ δ) (CP.sym (Lemma₂-eq γ δ)) 162 | (𝓛emma₂-[[eq]] γ δ) (UP.sym (𝓛emma₂-]]eq[[ γ δ)) 163 | $ `app F T′ 164 | 165 | in , `neu FT 166 | complete (⊗R {γ} {δ} {σ} {τ} t u) = 167 | let (rT , T) = complete t 168 | (rU , U) = complete u 169 | 170 | T′ : [[ V.fromList δ ]] U.⋈ 𝓛emma₁ δ γ [[ V.fromList γ ]] 171 | ⊢ σ ∋ _ ⊠ 172 | [[ V.fromList δ ]] U.⋈ 𝓛emma₁ δ γ ]] V.fromList γ [[ 173 | T′ = extensionalCheck (Lemma₁₂-eq γ δ) (Lemma₂₁-eq γ δ) 174 | (UP.irrelevance _ (UP.sym (𝓛emma₂₁-[[eq]] γ δ))) 175 | (𝓛emma₂₁-]]eq[[ γ δ) 176 | $ T.weakCheck (𝓛emma₂ γ δ [[ V.fromList δ ]]) T 177 | 178 | U′ : [[ V.fromList δ ]] U.⋈ 𝓛emma₁ δ γ ]] V.fromList γ [[ 179 | ⊢ τ ∋ _ ⊠ 180 | ]] V.fromList δ [[ U.⋈ 𝓛emma₁ δ γ ]] V.fromList γ [[ 181 | U′ = T.weakCheck (𝓛emma₁ δ γ ]] V.fromList γ [[) U 182 | 183 | TU : [[ V.fromList (γ List.++ δ) ]] 184 | ⊢ σ ⊗ τ ∋ _ ⊠ 185 | ]] V.fromList (γ List.++ δ) [[ 186 | TU = extensionalCheck (Lemma₁-eq δ γ) (CP.sym (Lemma₁-eq δ γ)) 187 | (𝓛emma₁-[[eq]] δ γ) (UP.sym (𝓛emma₁-]]eq[[ δ γ)) 188 | $ `prd⊗ T′ U′ 189 | 190 | in , TU 191 | complete (⊗L t) = 192 | let (rT , T) = complete t 193 | T′ = T.weakCheck (copy (copy (U.inserts (_ ∷ _ ∷ _ ∷ []) finish))) T 194 | in , `let `v ,, `v ∷= `var z 195 | `in `neu `app (`app (`cut (`lam (`lam T′))) (`neu `var z)) (`neu (`var (s z))) 196 | complete 1R = , `unit 197 | complete (1L t) = 198 | let (rt , T) = complete t 199 | in , `let `⟨⟩ ∷= `var z `in T.weakCheck (insert _ finish) T 200 | complete 0L = , `neu (`exfalso _ (proj₂ (`0L _ _))) 201 | complete (─oR t) = , `lam (proj₂ $ complete t) 202 | complete (─oL {γ} {δ} {σ} {τ} {ν} t u) = 203 | let (rT , T) = complete t 204 | (rU , U) = complete u 205 | 206 | U′ : [[ V.fromList ((σ ─o τ) ∷ γ) ]] U.⋈ 𝓛emma₂ ((σ ─o τ) ∷ γ) δ [[ V.fromList δ ]] 207 | ⊢ τ ─o ν ∋ _ ⊠ 208 | [[ V.fromList ((σ ─o τ) ∷ γ) ]] U.⋈ 𝓛emma₂ ((σ ─o τ) ∷ γ) δ ]] V.fromList δ [[ 209 | U′ = extensionalCheck (Lemma₂₁-eq ((σ ─o τ) ∷ γ) δ) (Lemma₁₂-eq ((σ ─o τ) ∷ γ) δ) 210 | (𝓛emma₂₁-[[eq]] ((σ ─o τ) ∷ γ) δ) (𝓛emma₁₂-]]eq[[ ((σ ─o τ) ∷ γ) δ) 211 | $ T.weakCheck (𝓛emma₁ δ ((σ ─o τ) ∷ γ) [[ V.fromList ((σ ─o τ) ∷ γ) ]]) (`lam U) 212 | 213 | T′ : ] σ ─o τ [ ∷ ([[ V.fromList γ ]] U.⋈ 𝓛emma₂ γ δ ]] V.fromList δ [[) 214 | ⊢ σ ∋ _ ⊠ 215 | ] σ ─o τ [ ∷ (]] V.fromList γ [[ U.⋈ 𝓛emma₂ γ δ ]] V.fromList δ [[) 216 | T′ = T.weakCheck (insert _ (𝓛emma₂ γ δ ]] V.fromList δ [[)) T 217 | 218 | UT : [[ V.fromList ((σ ─o τ) ∷ γ List.++ δ) ]] 219 | ⊢ _ ∈ ν ⊠ 220 | ]] V.fromList ((σ ─o τ) ∷ γ List.++ δ) [[ 221 | UT = extensionalInfer (Eq.refl ∷ Lemma₂-eq γ δ) (Eq.refl ∷ CP.sym (Lemma₂-eq γ δ)) 222 | (Eq.refl ∷ 𝓛emma₂-[[eq]] γ δ) 223 | (Eq.refl ∷ UP.sym (𝓛emma₂-]]eq[[ γ δ)) 224 | $ `app (`cut U′) (`neu (`app (`var z) T′)) 225 | 226 | in , `neu UT 227 | complete (&R t u) = , `prd& (proj₂ $ complete t) (proj₂ $ complete u) 228 | complete (&₁L t) = 229 | let (rT , T) = complete t 230 | T′ = T.weakCheck (copy (insert _ finish)) T 231 | in , `neu `app (`cut (`lam T′)) (`neu (`fst (`var z))) 232 | complete (&₂L t) = 233 | let (rT , T) = complete t 234 | T′ = T.weakCheck (copy (insert _ finish)) T 235 | in , `neu `app (`cut (`lam T′)) (`neu (`snd (`var z))) 236 | complete (⊕₁R t) = , `inl (proj₂ $ complete t) 237 | complete (⊕₂R t) = , `inr (proj₂ $ complete t) 238 | complete (⊕L t u) = 239 | let (rT , T) = complete t 240 | (rU , U) = complete u 241 | T′ = T.weakCheck (copy (insert _ finish)) T 242 | U′ = T.weakCheck (copy (insert _ finish)) U 243 | in , `neu (`case `var z return _ of T′ %% U′) 244 | complete (mix t inc) = 245 | let (rT , T) = complete t 246 | T′ = mixCheck ([[fromList]] trivial) (]]fromList[[ trivial) 247 | ([[fromList]] inc) (]]fromList[[ inc) T 248 | in T′ 249 | 250 | 251 | 252 | -------------------------------------------------------------------------------- /src/linear/Typecheck.agda: -------------------------------------------------------------------------------- 1 | module linear.Typecheck where 2 | 3 | open import Function 4 | open import Data.Nat 5 | open import Data.Fin 6 | open import Data.Vec hiding ([_] ; _++_ ; tail) 7 | open import Data.Product as P using (proj₁ ; proj₂) 8 | open import Relation.Nullary 9 | open import Relation.Binary.PropositionalEquality 10 | 11 | open import linear.Type as Type 12 | open import linear.Context as C hiding (_++_) 13 | open import linear.Usage 14 | open import linear.Usage.Equality as UsageEq 15 | open import linear.Language 16 | open import linear.Typing 17 | open import linear.Typing.Inversion 18 | open import linear.Typing.Functional 19 | open import linear.RawIso 20 | open import linear.Typecheck.Problem 21 | 22 | -- Decidability of Type-checking 23 | 24 | consume : {n : ℕ} {γ : Context n} (Γ : Usages γ) (k : Fin n) → Dec $ CONSUME Γ k 25 | consume ([ σ ] ∷ Γ) zero = yes (σ , ] σ [ ∷ Γ , z) 26 | consume (] σ [ ∷ Γ) zero = no (λ { (_ , _ , ()) }) 27 | consume (σ ∷ Γ) (suc k) = consumeSuc Γ σ k <$> consume Γ k 28 | 29 | checkPattern : {n : ℕ} (σ : Type) (p : Pattern n) → Dec $ PATTERN σ p 30 | checkPattern σ `v = yes (σ ∷ [] , `v) 31 | checkPattern 𝟙 `⟨⟩ = yes ([] , `⟨⟩) 32 | checkPattern (σ ⊗ τ) (p ,, q) = patternTensor <$> checkPattern σ p <*> checkPattern τ q 33 | checkPattern (κ x) `⟨⟩ = no (λ { (_ , ()) }) 34 | checkPattern 𝟘 `⟨⟩ = no (λ { (_ , ()) }) 35 | checkPattern (σ ⊗ τ) `⟨⟩ = no (λ { (_ , ()) }) 36 | checkPattern (σ ─o τ) `⟨⟩ = no (λ { (_ , ()) }) 37 | checkPattern (σ & τ) `⟨⟩ = no (λ { (_ , ()) }) 38 | checkPattern (σ ⊕ τ) `⟨⟩ = no (λ { (_ , ()) }) 39 | checkPattern 𝟙 (p ,, q) = no (λ { (_ , ()) }) 40 | checkPattern 𝟘 (p ,, q) = no (λ { (_ , ()) }) 41 | checkPattern (σ ─o τ) (p ,, q) = no (λ { (_ , ()) }) 42 | checkPattern (σ & τ) (p ,, q) = no (λ { (_ , ()) }) 43 | checkPattern (κ x) (p ,, q) = no (λ { (_ , ()) }) 44 | checkPattern (σ ⊕ τ) (p ,, q) = no (λ { (_ , ()) }) 45 | 46 | 47 | truncate : {n o : ℕ} {γ : Context n} (δ : Context o) (Γ : Usages (δ C.++ γ)) → Dec $ TRUNCATE δ Γ 48 | truncate [] Γ = yes (Γ , refl) 49 | truncate (a ∷ δ) ([ .a ] ∷ Γ) = no (λ { (_ , ()) }) 50 | truncate (a ∷ δ) (] .a [ ∷ Γ) = truncateUsed δ Γ <$> truncate δ Γ 51 | 52 | mutual 53 | 54 | infer : {n : ℕ} {γ : Context n} (Γ : Usages γ) (t : Infer n) → Dec $ INFER Γ t 55 | 56 | -- VAR 57 | infer Γ (`var k) = inferVar Γ k <$> consume Γ k 58 | 59 | -- APP 60 | infer Γ (`app t u) 61 | with infer Γ t 62 | ... | no ¬p = no $ λ p → ¬p (_ , _ , app-inv-function (INFER.proof p)) 63 | ... | yes (𝟙 , _ , T) = no $ λ p → case functionalInfer _ T (app-inv-function $ INFER.proof p) of λ () 64 | ... | yes (𝟘 , _ , T) = no $ λ p → case functionalInfer _ T (app-inv-function $ INFER.proof p) of λ () 65 | ... | yes (σ ⊗ τ , _ , T) = no $ λ p → case functionalInfer _ T (app-inv-function $ INFER.proof p) of λ () 66 | ... | yes (σ ⊕ τ , _ , T) = no $ λ p → case functionalInfer _ T (app-inv-function $ INFER.proof p) of λ () 67 | ... | yes (σ & τ , _ , T) = no $ λ p → case functionalInfer _ T (app-inv-function $ INFER.proof p) of λ () 68 | ... | yes (κ n , _ , T) = no $ λ p → case functionalInfer _ T (app-inv-function $ INFER.proof p) of λ () 69 | ... | yes (σ ─o τ , Δ , T) 70 | with check Δ σ u 71 | ... | no ¬p = no $ λ p → let eq = functionalInferPost _ (app-inv-function (INFER.proof p)) T 72 | coerce = subst₂ (_⊢_∋ _ ⊠ _) (cong proj₂ eq) (proj₁ $ ─o-inj $ cong proj₁ eq) 73 | in ¬p (_ , coerce (app-inv-argument (INFER.proof p))) 74 | ... | yes (θ , U) = yes (τ , θ , `app T U) 75 | 76 | 77 | -- FST 78 | infer Γ (`fst t) 79 | with infer Γ t 80 | ... | no ¬p = no $ λ p → ¬p (_ , _ , proj₂ (fst-inv (INFER.proof p))) 81 | ... | yes (𝟙 , _ , T) = no $ λ p → case functionalInfer _ T (proj₂ $ fst-inv $ INFER.proof p) of λ () 82 | ... | yes (𝟘 , _ , T) = no $ λ p → case functionalInfer _ T (proj₂ $ fst-inv $ INFER.proof p) of λ () 83 | ... | yes (σ ⊗ τ , _ , T) = no $ λ p → case functionalInfer _ T (proj₂ $ fst-inv $ INFER.proof p) of λ () 84 | ... | yes (σ ⊕ τ , _ , T) = no $ λ p → case functionalInfer _ T (proj₂ $ fst-inv $ INFER.proof p) of λ () 85 | ... | yes (σ ─o τ , _ , T) = no $ λ p → case functionalInfer _ T (proj₂ $ fst-inv $ INFER.proof p) of λ () 86 | ... | yes (κ n , _ , T) = no $ λ p → case functionalInfer _ T (proj₂ $ fst-inv $ INFER.proof p) of λ () 87 | ... | yes (σ & τ , Δ , T) = yes (σ , Δ , `fst T) 88 | 89 | -- SND 90 | infer Γ (`snd t) 91 | with infer Γ t 92 | ... | no ¬p = no $ λ p → ¬p (_ , _ , proj₂ (snd-inv (INFER.proof p))) 93 | ... | yes (𝟙 , _ , T) = no $ λ p → case functionalInfer _ T (proj₂ $ snd-inv $ INFER.proof p) of λ () 94 | ... | yes (𝟘 , _ , T) = no $ λ p → case functionalInfer _ T (proj₂ $ snd-inv $ INFER.proof p) of λ () 95 | ... | yes (σ ⊗ τ , _ , T) = no $ λ p → case functionalInfer _ T (proj₂ $ snd-inv $ INFER.proof p) of λ () 96 | ... | yes (σ ⊕ τ , _ , T) = no $ λ p → case functionalInfer _ T (proj₂ $ snd-inv $ INFER.proof p) of λ () 97 | ... | yes (σ ─o τ , _ , T) = no $ λ p → case functionalInfer _ T (proj₂ $ snd-inv $ INFER.proof p) of λ () 98 | ... | yes (κ n , _ , T) = no $ λ p → case functionalInfer _ T (proj₂ $ snd-inv $ INFER.proof p) of λ () 99 | ... | yes (σ & τ , Δ , T) = yes (τ , Δ , `snd T) 100 | 101 | 102 | -- CASE 103 | infer Γ (`case t return ν of l %% r) 104 | with infer Γ t 105 | ... | no ¬p = no $ λ p → ¬p (_ , _ , case-inv-scrutinee (INFER.proof p)) 106 | ... | yes (𝟙 , _ , T) = no $ λ p → case functionalInfer _ T (case-inv-scrutinee $ INFER.proof p) of λ () 107 | ... | yes (𝟘 , _ , T) = no $ λ p → case functionalInfer _ T (case-inv-scrutinee $ INFER.proof p) of λ () 108 | ... | yes (σ ⊗ τ , _ , T) = no $ λ p → case functionalInfer _ T (case-inv-scrutinee $ INFER.proof p) of λ () 109 | ... | yes (σ & τ , _ , T) = no $ λ p → case functionalInfer _ T (case-inv-scrutinee $ INFER.proof p) of λ () 110 | ... | yes (σ ─o τ , _ , T) = no $ λ p → case functionalInfer _ T (case-inv-scrutinee $ INFER.proof p) of λ () 111 | ... | yes (κ n , _ , T) = no $ λ p → case functionalInfer _ T (case-inv-scrutinee $ INFER.proof p) of λ () 112 | ... | yes (σ ⊕ τ , Δ , T) 113 | with check ([ σ ] ∷ Δ) ν l | check ([ τ ] ∷ Δ) ν r 114 | ... | no ¬l | _ = no $ λ p → 115 | let eq = functionalInferPost _ (case-inv-scrutinee $ INFER.proof p) T 116 | coerce = subst₂ (λ Δ σ → [ σ ] ∷ Δ ⊢ ν ∋ l ⊠ ] σ [ ∷ _) (cong proj₂ eq) (proj₁ $ ⊕-inj $ cong proj₁ eq) 117 | in ¬l (_ , coerce (case-inv-left (INFER.proof p))) 118 | ... | _ | no ¬r = no $ λ p → 119 | let eq = functionalInferPost _ (case-inv-scrutinee $ INFER.proof p) T 120 | coerce = subst₂ (λ Δ τ → [ τ ] ∷ Δ ⊢ ν ∋ r ⊠ ] τ [ ∷ _) (cong proj₂ eq) (proj₂ $ ⊕-inj $ cong proj₁ eq) 121 | in ¬r (_ , coerce (case-inv-right (INFER.proof p))) 122 | ... | yes ([ .σ ] ∷ θ₁ , L) | _ = no $ λ p → 123 | let eq = functionalInferPost _ (case-inv-scrutinee (INFER.proof p)) T 124 | coerce = subst₂ (λ σ θ → [ σ ] ∷ θ ⊢ ν ∋ l ⊠ ] σ [ ∷ _) (proj₁ $ ⊕-inj $ cong proj₁ eq) (cong proj₂ eq) 125 | in case functionalCheckPost _ (coerce (case-inv-left (INFER.proof p))) L of λ () 126 | ... | _ | yes ([ .τ ] ∷ θ₂ , R) = no $ λ p → 127 | let eq = functionalInferPost _ (case-inv-scrutinee (INFER.proof p)) T 128 | coerce = subst₂ (λ σ θ → [ σ ] ∷ θ ⊢ ν ∋ r ⊠ ] σ [ ∷ _) (proj₂ $ ⊕-inj $ cong proj₁ eq) (cong proj₂ eq) 129 | in case functionalCheckPost _ (coerce (case-inv-right (INFER.proof p))) R of λ () 130 | ... | yes (] .σ [ ∷ θ₁ , L) | yes (] .τ [ ∷ θ₂ , R) 131 | with eqs θ₁ θ₂ 132 | ... | no ¬eq = no $ λ p → 133 | let eq = functionalInferPost _ (case-inv-scrutinee (INFER.proof p)) T 134 | coerceˡ = subst₂ (λ σ θ → [ σ ] ∷ θ ⊢ ν ∋ l ⊠ ] σ [ ∷ _) (proj₁ $ ⊕-inj $ cong proj₁ eq) (cong proj₂ eq) 135 | coerceʳ = subst₂ (λ σ θ → [ σ ] ∷ θ ⊢ ν ∋ r ⊠ ] σ [ ∷ _) (proj₂ $ ⊕-inj $ cong proj₁ eq) (cong proj₂ eq) 136 | eq₁ = functionalCheckPost _ (coerceˡ (case-inv-left (INFER.proof p))) L 137 | eq₂ = functionalCheckPost _ (coerceʳ (case-inv-right (INFER.proof p))) R 138 | in ¬eq $ trans (sym $ cong tail eq₁) (cong tail eq₂) 139 | ... | yes eq rewrite eq = yes (ν , _ , `case T return ν of L %% R) 140 | 141 | -- EX FALSO 142 | infer Γ (`exfalso σ t) with infer Γ t 143 | ... | no ¬p = no $ λ p → case ¬p (_ , _ , exfalso-inv (INFER.proof p)) of λ () 144 | ... | yes (𝟘 , Δ , p) = yes (σ , Δ , `exfalso σ p) 145 | 146 | ... | yes (κ _ , Δ , p) = no $ λ q → case functionalInferPost _ (exfalso-inv $ INFER.proof q) p of λ () 147 | ... | yes (𝟙 , Δ , p) = no $ λ q → case functionalInferPost _ (exfalso-inv $ INFER.proof q) p of λ () 148 | ... | yes (_ ⊗ _ , Δ , p) = no $ λ q → case functionalInferPost _ (exfalso-inv $ INFER.proof q) p of λ () 149 | ... | yes (_ ─o _ , Δ , p) = no $ λ q → case functionalInferPost _ (exfalso-inv $ INFER.proof q) p of λ () 150 | ... | yes (_ & _ , Δ , p) = no $ λ q → case functionalInferPost _ (exfalso-inv $ INFER.proof q) p of λ () 151 | ... | yes (_ ⊕ _ , Δ , p) = no $ λ q → case functionalInferPost _ (exfalso-inv $ INFER.proof q) p of λ () 152 | 153 | -- CUT 154 | infer Γ (`cut t σ) = inferCut Γ t σ <$> check Γ σ t 155 | 156 | check : {n : ℕ} {γ : Context n} (Γ : Usages γ) (σ : Type) (t : Check n) → Dec $ CHECK Γ σ t 157 | 158 | -- NEU 159 | check Γ σ (`neu t) 160 | with infer Γ t 161 | ... | no ¬p = no $ λ p → case ¬p (_ , _ , (neu-inv $ CHECK.proof p)) of λ () 162 | ... | yes (τ , Δ , p) 163 | with Type.eq σ τ 164 | ... | no ¬σ≡τ = no $ λ q → ¬σ≡τ $ functionalInfer _ (neu-inv $ CHECK.proof q) p 165 | check Γ σ (`neu t) | yes (.σ , Δ , p) | yes refl = yes (Δ , `neu p) 166 | 167 | check Γ σ (`let p ∷= t `in u) 168 | with infer Γ t 169 | ... | no ¬p = no $ λ p → ¬p (_ , _ , let-inv-bound (CHECK.proof p)) 170 | ... | yes (τ , Δ , T) 171 | with checkPattern τ p 172 | ... | no ¬p = no $ λ p → let eq = functionalInfer _ (let-inv-bound (CHECK.proof p)) T 173 | coerce = subst (_∋ _ ↝ (patternContext (let-inv-pattern (CHECK.proof p)))) eq 174 | in ¬p (_ , (coerce (let-inv-pattern (CHECK.proof p)))) 175 | ... | yes (δ , P) 176 | with check ([[ δ ]] ++ Δ) σ u 177 | ... | no ¬q = no $ λ q → 178 | let eq₁ = functionalInferPost _ (let-inv-bound (CHECK.proof q)) T 179 | coerce₁ = subst (_∋ p ↝ patternContext (let-inv-pattern (CHECK.proof q))) (cong proj₁ eq₁) 180 | eq₂ = functionalPattern _ (coerce₁ (let-inv-pattern (CHECK.proof q))) P 181 | coerce₂ = subst₂ (λ δ Δ → [[ δ ]] ++ Δ ⊢ σ ∋ u ⊠ ]] δ [[ ++ _) eq₂ (cong proj₂ eq₁) 182 | in ¬q (_ , coerce₂ (let-inv-body (CHECK.proof q))) 183 | ... | yes (θ , U) 184 | with truncate δ θ 185 | ... | no ¬q = no $ λ q → 186 | let eq₁ = functionalInferPost _ (let-inv-bound (CHECK.proof q)) T 187 | coerce₁ = subst (_∋ p ↝ patternContext (let-inv-pattern (CHECK.proof q))) (cong proj₁ eq₁) 188 | eq₂ = functionalPattern _ (coerce₁ (let-inv-pattern (CHECK.proof q))) P 189 | coerce₂ = subst₂ (λ δ Δ → [[ δ ]] ++ Δ ⊢ σ ∋ u ⊠ ]] δ [[ ++ _) eq₂ (cong proj₂ eq₁) 190 | eq₃ = functionalCheckPost _ (coerce₂ (let-inv-body (CHECK.proof q))) U 191 | in ¬q (_ , sym eq₃) 192 | ... | yes (ξ , eq) rewrite eq = yes (_ , `let P ∷= T `in U) 193 | 194 | -- UNIT 195 | check Γ 𝟙 `unit = yes (Γ , `unit) 196 | check Γ (κ k) `unit = no (λ { (_ , ()) }) 197 | check Γ 𝟘 `unit = no (λ { (_ , ()) }) 198 | check Γ (σ ⊗ τ) `unit = no (λ { (_ , ()) }) 199 | check Γ (σ ─o τ) `unit = no (λ { (_ , ()) }) 200 | check Γ (σ & τ) `unit = no (λ { (_ , ()) }) 201 | check Γ (σ ⊕ τ) `unit = no (λ { (_ , ()) }) 202 | 203 | -- LAM 204 | check Γ (σ ─o τ) (`lam b) 205 | with check ([ σ ] ∷ Γ) τ b 206 | ... | no ¬p = no $ λ p → ¬p (_ , lam-inv (CHECK.proof p)) 207 | ... | yes ([ .σ ] ∷ Δ , p) = no λ q → case functionalCheckPost _ p (lam-inv $ CHECK.proof q) of λ () 208 | ... | yes (] .σ [ ∷ Δ , p) = yes (Δ , `lam p) 209 | check Γ 𝟙 (`lam b) = no $ λ p → case CHECK.proof p of λ () 210 | check Γ 𝟘 (`lam b) = no $ λ p → case CHECK.proof p of λ () 211 | check Γ (σ & τ) (`lam b) = no $ λ p → case CHECK.proof p of λ () 212 | check Γ (σ ⊕ τ) (`lam b) = no $ λ p → case CHECK.proof p of λ () 213 | check Γ (σ ⊗ τ) (`lam b) = no $ λ p → case CHECK.proof p of λ () 214 | check Γ (κ n) (`lam b) = no $ λ p → case CHECK.proof p of λ () 215 | 216 | -- PRD 217 | check Γ (σ ⊗ τ) (`prd t u) 218 | with check Γ σ t 219 | ... | no ¬p = no $ λ p → ¬p (_ , prd-inv-fst (CHECK.proof p)) 220 | ... | yes (θ , T) 221 | with check θ τ u 222 | ... | no ¬p = no $ λ p → let eq = functionalCheckPost _ (prd-inv-fst (CHECK.proof p)) T 223 | coerce = subst (_⊢ τ ∋ u ⊠ _) eq 224 | in ¬p (_ , coerce (prd-inv-snd (CHECK.proof p))) 225 | ... | yes (Δ , U) = yes (Δ , `prd⊗ T U) 226 | check Γ (σ & τ) (`prd t u) 227 | with check Γ σ t | check Γ τ u 228 | ... | no ¬p | _ = no $ λ p → ¬p (_ , proj₁ (prd&-inv (CHECK.proof p))) 229 | ... | _ | no ¬q = no $ λ p → ¬q (_ , proj₂ (prd&-inv (CHECK.proof p))) 230 | ... | yes (Θ₁ , p) | yes (Θ₂ , q) 231 | with eqs Θ₁ Θ₂ 232 | ... | no ¬eq = no $ λ pq → 233 | let (p′ P., q′) = prd&-inv (CHECK.proof pq) 234 | eqp = functionalCheckPost _ p p′ 235 | eqq = functionalCheckPost _ q q′ 236 | in ¬eq (trans eqp (sym eqq)) 237 | ... | yes eq rewrite eq = yes (Θ₂ , `prd& p q) 238 | 239 | check Γ 𝟙 (`prd t u) = no $ λ p → case CHECK.proof p of λ () 240 | check Γ 𝟘 (`prd t u) = no $ λ p → case CHECK.proof p of λ () 241 | check Γ (σ ⊕ τ) (`prd t u) = no $ λ p → case CHECK.proof p of λ () 242 | check Γ (σ ─o τ) (`prd t u) = no $ λ p → case CHECK.proof p of λ () 243 | check Γ (κ n) (`prd t u) = no $ λ p → case CHECK.proof p of λ () 244 | 245 | -- INL 246 | check Γ (σ ⊕ τ) (`inl t) = checkInl Γ t σ τ <$> check Γ σ t 247 | check Γ 𝟙 (`inl t) = no $ λ p → case CHECK.proof p of λ () 248 | check Γ 𝟘 (`inl t) = no $ λ p → case CHECK.proof p of λ () 249 | check Γ (σ ⊗ τ) (`inl t) = no $ λ p → case CHECK.proof p of λ () 250 | check Γ (σ ─o τ) (`inl t) = no $ λ p → case CHECK.proof p of λ () 251 | check Γ (σ & τ) (`inl t) = no $ λ p → case CHECK.proof p of λ () 252 | check Γ (κ n) (`inl t) = no $ λ p → case CHECK.proof p of λ () 253 | 254 | -- INR 255 | check Γ (σ ⊕ τ) (`inr t) = checkInr Γ t σ τ <$> check Γ τ t 256 | check Γ 𝟙 (`inr t) = no $ λ p → case CHECK.proof p of λ () 257 | check Γ 𝟘 (`inr t) = no $ λ p → case CHECK.proof p of λ () 258 | check Γ (σ ⊗ τ) (`inr t) = no $ λ p → case CHECK.proof p of λ () 259 | check Γ (σ ─o τ) (`inr t) = no $ λ p → case CHECK.proof p of λ () 260 | check Γ (σ & τ) (`inr t) = no $ λ p → case CHECK.proof p of λ () 261 | check Γ (κ n) (`inr t) = no $ λ p → case CHECK.proof p of λ () 262 | 263 | --------------------------------------------------------------------------------