nat literals and comments in parser

This commit is contained in:
Rachel Lambda Samuelsson 2022-07-26 07:57:44 +02:00
parent 542f1cd685
commit 79ad67ffec
6 changed files with 61 additions and 16 deletions

View File

@ -131,7 +131,7 @@ mutual
infer trs tys (TTopInd c st) = do
guardS " C" =<< check trs tys (VClos trs (TPi TTop TType)) c
guardS "" =<< check trs tys (VApp (VClos trs c) VStar) st
guardS "" =<< check trs tys (VClos trs (TApp c TStar)) st
pure (VClos trs (TPi TTop (TApp (weakTr c) (TVar 0))))
infer trs tys (TBotInd c) = do

View File

@ -37,7 +37,7 @@ data PiTokenKind
| PTBot
| PTBotInd
| PTNat
| PTZero
| PTNum
| PTSuc
| PTNatInd
| PTSigInd
@ -67,7 +67,7 @@ Eq PiTokenKind where
(==) PTBot PTBot = True
(==) PTBotInd PTBotInd = True
(==) PTNat PTNat = True
(==) PTZero PTZero = True
(==) PTNum PTNum = True
(==) PTSuc PTSuc = True
(==) PTNatInd PTNatInd = True
(==) PTSigInd PTSigInd = True
@ -98,7 +98,7 @@ Show PiTokenKind where
show PTBot = "PTBot"
show PTBotInd = "PTBotInd"
show PTNat = "PTNat"
show PTZero = "PTZero"
show PTNum = "PTNum "
show PTSuc = "PTSuc"
show PTNatInd = "PTNatInd"
show PTSigInd = "PTSigInd"
@ -114,6 +114,7 @@ Show PiToken where
TokenKind PiTokenKind where
TokType PTIdentifier = String
TokType PTNum = Nat
TokType _ = ()
tokValue PTLambda _ = ()
@ -137,7 +138,7 @@ TokenKind PiTokenKind where
tokValue PTBot _ = ()
tokValue PTBotInd _ = ()
tokValue PTNat _ = ()
tokValue PTZero _ = ()
tokValue PTNum s = cast s
tokValue PTSuc _ = ()
tokValue PTNatInd _ = ()
tokValue PTSigInd _ = ()
@ -185,11 +186,14 @@ tokenmap = [
(is '', PTBot),
(is '', PTNat),
(is '', PTStar),
(is '0', PTZero)
(digits, PTNum)
]
piTokenMap : TokenMap PiToken
piTokenMap = (spaces, Tok PTIgnore) ::
piTokenMap =
(spaces, Tok PTIgnore) ::
(lineComment (exact "--"), Tok PTIgnore) ::
(blockComment (exact "{-") (exact "-}"), Tok PTIgnore) ::
toTokenMap tokenmap ++
[(identifier, \s =>
case lookup s keywords of
@ -211,7 +215,10 @@ mutual
expr n env = tpi n env
<|> tsigma n env
<|> tarr n env
<|> expr1 n env
<|> (do
e <- expr1 n env
tapp n env e <|> pure e)
expr1 : (n : Nat) -> Vect n String -> Grammar () PiToken True (Term n)
expr1 n env = ttopind n env
@ -232,7 +239,7 @@ mutual
<|> tstar
<|> tbot
<|> tnat
<|> tzero
<|> tnum
<|> tpair n env
<|> tlet n env
<|> tlam n env
@ -269,8 +276,14 @@ mutual
tnat : Grammar () PiToken True (Term n)
tnat = match PTNat >> pure TNat
tzero : Grammar () PiToken True (Term n)
tzero = match PTZero >> pure TZero
tnum : Grammar () PiToken True (Term n)
tnum = do
n <- match PTNum
pure (conv n)
where
conv : Nat -> Term n
conv 0 = TZero
conv (S n) = TSuc (conv n)
tsuc : (n : Nat) -> Vect n String -> Grammar () PiToken True (Term n)
tsuc n env = do
@ -400,6 +413,7 @@ mutual
tvar : (n : Nat) -> Vect n String -> Grammar () PiToken True (Term n)
tvar n env = do
str <- match PTIdentifier
commit
fromMaybe (fail ("'" ++ str ++ "' not in env")) (pure . TVar <$> findIndex (== str) env)
paren : (n : Nat) -> Vect n String -> Grammar () PiToken True (Term n)
@ -433,6 +447,7 @@ parsePi n env parseEntry toks =
Left e => (Left . show . map getErr) e
where
getErr : ParsingError tok -> String
getErr (Error "Unrecognised input" _) = ""
getErr (Error s _) = s

23
tests/fin.pi Normal file
View File

@ -0,0 +1,23 @@
let bottomat : → Type
-ind (λ_. → Type)
(λ_. ⊥)
(λn.λban. -ind (λ_. Type) (λm.λ_. ban m))
let fin : → Type
≔ λn. Σ (m : ) bottomat n m
let bool : Type
≔ fin 2
let false : bool
≔ (0, ★)
let true : bool
≔ (1, ★)
{-
let boolind : Π (C : bool → Type) C false → C true → Π (b : bool) C b
≔ λC.λCf.λCt. Σ-ind (bottomat 2) C (λn.λu. -ind (λm. Id m n → C (n, u))
(λp. ?)
(λn.λ_.λp. -ind (λm. Id m n → C (n, u)) (λp. ?) (λm.λ_.λp. ⊥-ind (λ_. C (n, u)) ?)))
-}

7
tests/id.pi Normal file
View File

@ -0,0 +1,7 @@
let transport : Π (A : Type) Π (f : A → Type) Π (x : A) Π (y : A)
Id A x y → f x → f y
≔ λA.λf.λx.λy. J A x y (λa.λb.λ_. f a → f b) (λa.a)
let ap : Π (A : Type) Π (B : Type) Π (f : A → B)
Π (x : A) Π (y : A) Id A x y → Id B (f x) (f y)
≔ λA.λB.λf.λx.λy. J A x y (λa.λb.λ_. Id B (f a) (f b)) (refl B (f x))

3
tests/makefile Normal file
View File

@ -0,0 +1,3 @@
phony: test
test:
@make -C .. test

View File

@ -1,6 +1,3 @@
let sucf :
≔ λn. suc n
let add :
-ind (λ_. ) (λn.n) (λn.λan.λm. suc (an m))
@ -14,10 +11,10 @@ let ap : Π (A : Type) Π (B : Type) Π (f : A → B)
let add_id_r : Π (n : ) Id n (add n 0)
-ind (λn. Id n (add n 0))
(refl 0)
(λn.λp. ap sucf n (add n 0) p)
(λn.λp. ap (λm. suc m) n (add n 0) p)
let add_assoc : Π (n : ) Π (m : ) Π (p : )
Id (add (add n m) p) (add n (add m p))
-ind (λn. Π (m : ) Π (p : ) Id (add (add n m) p) (add n (add m p)))
(λm.λp. refl (add m p))
(λn.λpn.λm.λp. ap sucf (add (add n m) p) (add n (add m p)) (pn m p))
(λn.λpn.λm.λp. ap (λm. suc m) (add (add n m) p) (add n (add m p)) (pn m p))