rachel/pi
1
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

parser is now useable for tests n stuff

Browse Source
This commit is contained in:
Rachel Lambda Samuelsson 2022-07-26 01:11:44 +02:00
parent fa384e2e26
commit 8e85d97b7f
4 changed files with 84 additions and 49 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

6
makefile
View File

@ -1,3 +1,7 @@
.PHONY: all .PHONY: all run
all: all:
idris2 --build pi.ipkg idris2 --build pi.ipkg
run:
./build/exec/pi
test:
for file in ./tests/*; do ./build/exec/pi $$file; done

42
src/Main.idr
View File

@ -4,24 +4,42 @@ import Core.Check
import Core.Term import Core.Term
import Parser.Parse import Parser.Parse
import Data.Vect
import Data.String
import System import System
import System.File import System.File
ioStr : IO String unwrap : {a : Type} -> Show a => Either a b -> IO b
ioStr = getArgs >>= \case unwrap {a = a} = \case
[] => getLine
(x :: _) => do
r <- readFile x
case r of
Left e => do Left e => do
print e case a of
String => putStrLn e
_ => printLn e
exitFailure exitFailure
Right s => pure s Right s => pure s
replRead : IO String
replRead = do
line <- getLine
if null (trim line)
then replRead
else case line of
":exit" => exitSuccess
_ => pure line
repl : (n : Nat) -> Vect n String -> IO ()
repl n env = do
line <- replRead
printLn =<< unwrap (parseEnv n env line)
repl n env
main : IO () main : IO ()
main = do main = getArgs >>= \case
str <- ioStr (_ :: x :: _) => do
case parse0 str of res <- readFile x >>= unwrap >>= unwrap . parsetoplevel
Left e => putStrLn e >>= unwrap . (`typecheck` TTop)
Right t => print t putStr (x ++ ": ")
if fst res
then putStrLn ("Success !")
else unwrap (Left res)
_ => repl 0 []

74
src/Parser/Parse.idr
View File

@ -192,13 +192,13 @@ lexPi str =
{- Basic idea, parsing has a list of the identifiers to convert to -} {- Basic idea, parsing has a list of the identifiers to convert to -}
{- de bruijn indecies, and a Nat to keep track of context size -} {- de bruijn indecies, and a Nat to keep track of context size -}
mutual mutual
expr : (n : Nat) -> Vect n String -> Grammar state PiToken True (Term n) expr : (n : Nat) -> Vect n String -> Grammar () PiToken True (Term n)
expr n env = tpi n env expr n env = tpi n env
<|> tsigma n env <|> tsigma n env
<|> tarr n env <|> tarr n env
<|> expr1 n env <|> expr1 n env
expr1 : (n : Nat) -> Vect n String -> Grammar state PiToken True (Term n) expr1 : (n : Nat) -> Vect n String -> Grammar () PiToken True (Term n)
expr1 n env = ttopind n env expr1 n env = ttopind n env
<|> tbotind n env <|> tbotind n env
<|> tsuc n env <|> tsuc n env
@ -208,7 +208,7 @@ mutual
t <- term n env t <- term n env
tapp n env t <|> pure t) tapp n env t <|> pure t)
term : (n : Nat) -> Vect n String -> Grammar state PiToken True (Term n) term : (n : Nat) -> Vect n String -> Grammar () PiToken True (Term n)
term n env = ttype term n env = ttype
<|> ttop <|> ttop
<|> tstar <|> tstar
@ -221,16 +221,16 @@ mutual
<|> tvar n env <|> tvar n env
<|> paren n env <|> paren n env
ttype : Grammar state PiToken True (Term n) ttype : Grammar () PiToken True (Term n)
ttype = match PTType >> pure TType ttype = match PTType >> pure TType
ttop : Grammar state PiToken True (Term n) ttop : Grammar () PiToken True (Term n)
ttop = match PTTop >> pure TTop ttop = match PTTop >> pure TTop
tstar : Grammar state PiToken True (Term n) tstar : Grammar () PiToken True (Term n)
tstar = match PTStar >> pure TStar tstar = match PTStar >> pure TStar
ttopind : (n : Nat) -> Vect n String -> Grammar state PiToken True (Term n) ttopind : (n : Nat) -> Vect n String -> Grammar () PiToken True (Term n)
ttopind n env = do ttopind n env = do
match PTTopInd match PTTopInd
commit commit
@ -238,30 +238,30 @@ mutual
st <- term n env st <- term n env
pure (TTopInd c st) pure (TTopInd c st)
tbot : Grammar state PiToken True (Term n) tbot : Grammar () PiToken True (Term n)
tbot = match PTBot >> pure TBot tbot = match PTBot >> pure TBot
tbotind : (n : Nat) -> Vect n String -> Grammar state PiToken True (Term n) tbotind : (n : Nat) -> Vect n String -> Grammar () PiToken True (Term n)
tbotind n env = do tbotind n env = do
match PTBotInd match PTBotInd
commit commit
c <- term n env c <- term n env
pure (TBotInd c) pure (TBotInd c)
tnat : Grammar state PiToken True (Term n) tnat : Grammar () PiToken True (Term n)
tnat = match PTNat >> pure TNat tnat = match PTNat >> pure TNat
tzero : Grammar state PiToken True (Term n) tzero : Grammar () PiToken True (Term n)
tzero = match PTZero >> pure TZero tzero = match PTZero >> pure TZero
tsuc : (n : Nat) -> Vect n String -> Grammar state PiToken True (Term n) tsuc : (n : Nat) -> Vect n String -> Grammar () PiToken True (Term n)
tsuc n env = do tsuc n env = do
match PTSuc match PTSuc
commit commit
m <- term n env m <- term n env
pure (TSuc m) pure (TSuc m)
tnatind : (n : Nat) -> Vect n String -> Grammar state PiToken True (Term n) tnatind : (n : Nat) -> Vect n String -> Grammar () PiToken True (Term n)
tnatind n env = do tnatind n env = do
match PTNatInd match PTNatInd
commit commit
@ -270,7 +270,7 @@ mutual
s <- term n env s <- term n env
pure (TNatInd c z s) pure (TNatInd c z s)
tsigma : (n : Nat) -> Vect n String -> Grammar state PiToken True (Term n) tsigma : (n : Nat) -> Vect n String -> Grammar () PiToken True (Term n)
tsigma n env = do tsigma n env = do
match PTSigma match PTSigma
commit commit
@ -282,7 +282,7 @@ mutual
b <- expr (S n) (arg :: env) b <- expr (S n) (arg :: env)
pure (TSigma a (TLam b)) pure (TSigma a (TLam b))
tpair : (n : Nat) -> Vect n String -> Grammar state PiToken True (Term n) tpair : (n : Nat) -> Vect n String -> Grammar () PiToken True (Term n)
tpair n env = do tpair n env = do
match PTLParen match PTLParen
x <- expr n env x <- expr n env
@ -292,7 +292,7 @@ mutual
match PTRParen match PTRParen
pure (TPair x y) pure (TPair x y)
tsigind : (n : Nat) -> Vect n String -> Grammar state PiToken True (Term n) tsigind : (n : Nat) -> Vect n String -> Grammar () PiToken True (Term n)
tsigind n env = do tsigind n env = do
match PTSigInd match PTSigInd
commit commit
@ -302,7 +302,7 @@ mutual
f <- term n env f <- term n env
pure (TSigInd a b c f) pure (TSigInd a b c f)
tlet : (n : Nat) -> Vect n String -> Grammar state PiToken True (Term n) tlet : (n : Nat) -> Vect n String -> Grammar () PiToken True (Term n)
tlet n env = do tlet n env = do
match PTLet match PTLet
commit commit
@ -315,7 +315,7 @@ mutual
tri <- expr (S n) (arg :: env) tri <- expr (S n) (arg :: env)
pure (TLet ty tr tri) pure (TLet ty tr tri)
tlam : (n : Nat) -> Vect n String -> Grammar state PiToken True (Term n) tlam : (n : Nat) -> Vect n String -> Grammar () PiToken True (Term n)
tlam n env = do tlam n env = do
match PTLambda match PTLambda
commit commit
@ -324,7 +324,7 @@ mutual
e <- expr (S n) (arg :: env) e <- expr (S n) (arg :: env)
pure (TLam e) pure (TLam e)
tpi : (n : Nat) -> Vect n String -> Grammar state PiToken True (Term n) tpi : (n : Nat) -> Vect n String -> Grammar () PiToken True (Term n)
tpi n env = do tpi n env = do
match PTPi match PTPi
commit commit
@ -336,7 +336,7 @@ mutual
b <- expr (S n) (arg :: env) b <- expr (S n) (arg :: env)
pure (TPi a b) pure (TPi a b)
tarr : (n : Nat) -> Vect n String -> Grammar state PiToken True (Term n) tarr : (n : Nat) -> Vect n String -> Grammar () PiToken True (Term n)
tarr n env = do tarr n env = do
l <- expr1 n env l <- expr1 n env
match PTArrow match PTArrow
@ -344,20 +344,20 @@ mutual
r <- expr (S n) ("" :: env) r <- expr (S n) ("" :: env)
pure (TPi l r) pure (TPi l r)
tapp : (n : Nat) -> Vect n String -> Term n -> Grammar state PiToken True (Term n) tapp : (n : Nat) -> Vect n String -> Term n -> Grammar () PiToken True (Term n)
tapp n env e1 = do tapp n env e1 = do
e2 <- term n env e2 <- term n env
tapp1 n env (TApp e1 e2) tapp1 n env (TApp e1 e2)
tapp1 : (n : Nat) -> Vect n String -> Term n -> Grammar state PiToken False (Term n) tapp1 : (n : Nat) -> Vect n String -> Term n -> Grammar () PiToken False (Term n)
tapp1 n env e = tapp n env e <|> pure e tapp1 n env e = tapp n env e <|> pure e
tvar : (n : Nat) -> Vect n String -> Grammar state PiToken True (Term n) tvar : (n : Nat) -> Vect n String -> Grammar () PiToken True (Term n)
tvar n env = do tvar n env = do
str <- match PTIdentifier str <- match PTIdentifier
fromMaybe (fail ("'" ++ str ++ "' not in env")) (pure . TVar <$> findIndex (== str) env) fromMaybe (fail ("'" ++ str ++ "' not in env")) (pure . TVar <$> findIndex (== str) env)
paren : (n : Nat) -> Vect n String -> Grammar state PiToken True (Term n) paren : (n : Nat) -> Vect n String -> Grammar () PiToken True (Term n)
paren n env = do paren n env = do
match PTLParen match PTLParen
commit commit
@ -365,7 +365,7 @@ mutual
match PTRParen match PTRParen
pure e pure e
definitions : (n : Nat) -> Vect n String -> Grammar state PiToken True (Term n) definitions : (n : Nat) -> Vect n String -> Grammar () PiToken True (Term n)
definitions n env = do definitions n env = do
match PTLet match PTLet
commit commit
@ -377,12 +377,12 @@ definitions n env = do
next <- definitions (S n) (arg :: env) <|> pure TStar next <- definitions (S n) (arg :: env) <|> pure TStar
pure (TLet ty tr next) pure (TLet ty tr next)
toplevel : Grammar state PiToken True (Term 0) toplevel : Grammar () PiToken True (Term 0)
toplevel = definitions 0 [] toplevel = definitions 0 []
parsePi : (n : Nat) -> Vect n String -> List (WithBounds PiToken) -> Either String (Term n) parsePi : (n : Nat) -> Vect n String -> Grammar () PiToken True (Term n) -> List (WithBounds PiToken) -> Either String (Term n)
parsePi n env toks = parsePi n env parseEntry toks =
case parse (expr n env) $ filter (not . ignored) toks of case parse parseEntry $ filter (not . ignored) toks of
Right (l, []) => Right l Right (l, []) => Right l
Right e => Left "contains tokens that were not consumed" Right e => Left "contains tokens that were not consumed"
Left e => (Left . show . map getErr) e Left e => (Left . show . map getErr) e
@ -392,12 +392,20 @@ parsePi n env toks =
public export public export
parse : (n : Nat) -> Vect n String -> String -> Either String (Term n) parse : (n : Nat) -> Vect n String -> Grammar () PiToken True (Term n) -> String -> Either String (Term n)
parse n env x = parse n env parseEntry x =
case lexPi x of case lexPi x of
Just toks => parsePi n env toks Just toks => parsePi n env parseEntry toks
Nothing => Left "Failed to lex." Nothing => Left "Failed to lex."
public export public export
parse0 : String -> Either String (Term 0) parse0 : String -> Either String (Term 0)
parse0 = parse 0 [] parse0 = parse 0 [] (expr 0 [])
public export
parseEnv : (n : Nat) -> Vect n String -> String -> Either String (Term n)
parseEnv n env = parse n env (expr n env)
public export
parsetoplevel : String -> Either String (Term 0)
parsetoplevel = parse 0 [] (toplevel)

5
tests/projections.pi Normal file
View File

@ -0,0 +1,5 @@
let pr1 : Π (A : Type) Π (B : A → Type) (Σ (a : A) B a) → A
≔ λA.λB. Σ-ind A B (λ_. A) (λa.λBa. a)
let pr2 : Π (A : Type) Π (B : A → Type) Π (s : Σ (a : A) B a) B (pr1 A B s)
≔ λA.λB. Σ-ind A B (λs. B (pr1 A B s)) (λa.λBa. Ba)