initial commit

This commit is contained in:
Rachel Lambda Samuelsson 2022-04-23 15:18:06 +02:00
commit bdb30a2d62
10 changed files with 118 additions and 0 deletions

2
.gitignore vendored Normal file
View File

@ -0,0 +1,2 @@
build
src/build

3
makefile Normal file
View File

@ -0,0 +1,3 @@
.PHONY: all
all:
idris2 --build pi.ipkg

15
pi.ipkg Normal file
View File

@ -0,0 +1,15 @@
package pi
modules = Term
, Value
, Normalize
, Convert
, Check
, Misc
options = "-p contrib --warnpartial"
main = Main
sourcedir = "src"
executable = "addict"

0
src/Check.idr Normal file
View File

0
src/Convert.idr Normal file
View File

4
src/Main.idr Normal file
View File

@ -0,0 +1,4 @@
module Main
main : IO ()
main = pure ()

21
src/Misc.idr Normal file
View File

@ -0,0 +1,21 @@
module Misc
import Data.Nat
%default total
public export
Index : Type
Index = Nat
public export
Name : Type
Name = String
public export
PI : Type -> Type
PI = Maybe
public export
lteTransp : LTE a b -> a = c -> b = d -> LTE c d
lteTransp p Refl Refl = p

3
src/Normalize.idr Normal file
View File

@ -0,0 +1,3 @@
module Normalize
%default total

58
src/Term.idr Normal file
View File

@ -0,0 +1,58 @@
module Term
import Data.Nat
import Misc
%default total
{-
The type of terms is indexed by the size of the environment in which
they are valid, that is, it is impossible to construct an ill-scoped term.
-}
public export
data Term : (_ : Index) -> Type where
TType : Term n -- The type of types (type in type)
TDef : Name -> Term n -- Axiomised term
TLam : Term n -> Term (S n) -> Term n -- Lambda abstraction (λ Type -> Scope)
TPi : Term n -> Term (S n) -> Term n -- Pi type (∏ A -> B a )
TApp : Term n -> Term n -> Term n -- Appliction
TVar : (n : Nat) -> LT n m -> Term m -- Variable
public export
weaken : {p, q : _} -> LTE p q -> Term p -> Term q
weaken _ TType = TType
weaken _ (TDef n) = TDef n
weaken p (TLam ty sc) = TLam (weaken p ty) (weaken (LTESucc p) sc)
weaken p (TPi a bx) = TLam (weaken p a ) (weaken (LTESucc p) bx)
weaken p (TApp f x) = TApp (weaken p f) (weaken p x)
{-
Getting new index
=================
New index is
old + Δctx
in this case
r + (q - p)
which since p <= q is equivalent to
(r + q) - p
Proving validity of new index
=============================
r <= p => (+mono)
r + q <= p + q => (-mono)
(r + q) - p <= (p + q) - p => (lteTransp -+)
(r + q) - p <= q ∎
-}
weaken {p = S p} {q = S q} (LTESucc p1) (TVar r p2') =
case p2' of
LTESucc p2 => TVar (minus (r + q) p)
(LTESucc (lteTransp (minusLteMonotone (plusLteMonotoneRight q r p p2)) Refl (minusPlus p)))

12
src/Value.idr Normal file
View File

@ -0,0 +1,12 @@
module Value
import Term
import Misc
%default total
public export
data NF : Type where
NType : NF
NDef : Name -> NF
NLam : NF -> (Term 1 -> PI NF) -> NF