mostly parsing tweaks
This commit is contained in:
@@ -110,7 +110,7 @@ parameters (ctx: Context)
|
||||
(VMeta i sp, t' ) => solve l i sp t'
|
||||
(VU, VU) => pure ()
|
||||
-- REVIEW consider quoting back
|
||||
_ => error [DS "unify failed", DS (show t'), DS "=?=", DS (show u') ]
|
||||
_ => error [DS "unify failed \{show t'} =?= \{show u'} \n env is \{show ctx.env}" ]
|
||||
|
||||
insert : (ctx : Context) -> Tm -> Val -> M (Tm, Val)
|
||||
insert ctx tm ty = do
|
||||
@@ -192,11 +192,12 @@ infer ctx (RApp t u icit) = do
|
||||
else error [DS "IcitMismatch \{show icit} \{show icit'}"]
|
||||
|
||||
-- If it's not a VPi, try to unify it with a VPi
|
||||
-- TODO test case to cover this.
|
||||
tty => do
|
||||
putStrLn "unify PI for \{show tty}"
|
||||
a <- eval ctx.env CBN !(freshMeta ctx)
|
||||
b <- MkClosure ctx.env <$> freshMeta (extend ctx "x" ?hole)
|
||||
unify ctx 0 tty (VPi "x" icit a b)
|
||||
b <- MkClosure ctx.env <$> freshMeta (extend ctx ":ins" a)
|
||||
unify ctx 0 tty (VPi ":ins" icit a b)
|
||||
pure (a,b)
|
||||
|
||||
u <- check ctx u a
|
||||
|
||||
@@ -71,12 +71,8 @@ atom = withPos (RU <$ keyword "U"
|
||||
|
||||
-- Argument to a Spine
|
||||
pArg : Parser (Icit,Raw)
|
||||
pArg = (Explicit,) <$> atom <|> (Implicit,) <$> braces term
|
||||
pArg = (Explicit,) <$> atom <|> (Implicit,) <$> braces typeExpr
|
||||
|
||||
--
|
||||
-- atom is lit or ident
|
||||
|
||||
data Fixity = InfixL | InfixR | Infix
|
||||
|
||||
-- starter pack, but we'll move some to prelude
|
||||
operators : List (String, Int, Fixity)
|
||||
@@ -87,6 +83,7 @@ operators = [
|
||||
("*",5,InfixL),
|
||||
("/",5,InfixL)
|
||||
]
|
||||
|
||||
parseApp : Parser Raw
|
||||
parseApp = do
|
||||
hd <- atom
|
||||
@@ -195,11 +192,14 @@ ibind = do
|
||||
-- getPos is a hack here, I would like to position at the name...
|
||||
pure $ map (\name => (name, Implicit, fromMaybe (RSrcPos pos RImplicit) ty)) names
|
||||
|
||||
arrow : Parser Unit
|
||||
arrow = sym "->" <|> sym "→"
|
||||
|
||||
-- Collect a bunch of binders (A : U) {y : A} -> ...
|
||||
binders : Parser Raw
|
||||
binders = do
|
||||
binds <- many (ibind <|> ebind)
|
||||
sym "->"
|
||||
arrow
|
||||
commit
|
||||
scope <- typeExpr
|
||||
pure $ foldr mkBind scope (join binds)
|
||||
@@ -210,7 +210,7 @@ binders = do
|
||||
typeExpr = binders
|
||||
<|> do
|
||||
exp <- term
|
||||
scope <- optional (sym "->" *> mustWork typeExpr)
|
||||
scope <- optional (arrow *> mustWork typeExpr)
|
||||
case scope of
|
||||
Nothing => pure exp
|
||||
-- consider Maybe String to represent missing
|
||||
|
||||
@@ -1,5 +1,13 @@
|
||||
module Lib.Parser.Impl
|
||||
|
||||
-- For some reason I'm doing Idris' commit / mustWork dance here, even though it
|
||||
-- seems to be painful
|
||||
|
||||
-- Probably would like to do "did consume anything" on the input, but we might need
|
||||
-- something other than a token list
|
||||
|
||||
-- TODO see what Kovacs' flatparse does for error handling / <|>
|
||||
|
||||
import Lib.Token
|
||||
import Data.String
|
||||
import Data.Nat
|
||||
@@ -8,6 +16,9 @@ public export
|
||||
TokenList : Type
|
||||
TokenList = List BTok
|
||||
|
||||
public export
|
||||
data Fixity = InfixL | InfixR | Infix
|
||||
|
||||
-- I was going to use a record, but we're peeling this off of bounds at the moment.
|
||||
public export
|
||||
SourcePos : Type
|
||||
@@ -131,13 +142,9 @@ export
|
||||
commit : Parser ()
|
||||
commit = P $ \toks,com,col => OK () toks True
|
||||
|
||||
export
|
||||
defer : (() -> (Parser a)) -> Parser a
|
||||
defer f = P $ \toks,com,col => runP (f ()) toks com col
|
||||
|
||||
mutual
|
||||
export some : Parser a -> Parser (List a)
|
||||
some p = defer $ \_ => [| p :: many p|] --(::) <$> p <*> many p)
|
||||
some p = (::) <$> p <*> many p
|
||||
|
||||
export many : Parser a -> Parser (List a)
|
||||
many p = some p <|> pure []
|
||||
|
||||
@@ -5,7 +5,7 @@ import Text.Lexer.Tokenizer
|
||||
import Lib.Token
|
||||
|
||||
keywords : List String
|
||||
keywords = ["let", "in", "where", "case", "of", "data"]
|
||||
keywords = ["let", "in", "where", "case", "of", "data", "U"]
|
||||
|
||||
specialOps : List String
|
||||
specialOps = ["->", ":", "=>"]
|
||||
|
||||
@@ -156,6 +156,10 @@ Show Val where
|
||||
show (VPi str Explicit x y) = "(%pi (\{str} : \{show x}). \{show y})"
|
||||
show VU = "U"
|
||||
|
||||
|
||||
public export
|
||||
data Binder = Bind String BD Val
|
||||
|
||||
public export
|
||||
Env : Type
|
||||
Env = List Val
|
||||
@@ -250,6 +254,8 @@ record TopContext where
|
||||
metas : IORef MetaContext
|
||||
-- metas : TODO
|
||||
|
||||
|
||||
|
||||
-- we'll use this for typechecking, but need to keep a TopContext around too.
|
||||
public export
|
||||
record Context where
|
||||
|
||||
Reference in New Issue
Block a user