parser good enough to elab kovacs stuff

src/Lib/Parser.idr

@@ -1,5 +1,12 @@
 module Lib.Parser
 
+-- NEXT - need to sort out parsing implicits
+--
+-- app:   foo {a} a b 
+-- lam: λ {A} {b : A} (c : Blah) d e f. something
+-- pi: (A : Set) -> {b : A} -> (c : Foo b) -> c -> bar d
+
+
 
 import Lib.Token
 import Lib.Parser.Impl
@@ -27,33 +34,40 @@ parens pa = do
   sym ")"
   pure t
 
+braces : Parser a -> Parser a
+braces pa = do
+  sym "{"
+  t <- pa
+  sym "}"
+  pure t
+
+
+optional : Parser a -> Parser (Maybe a)
+optional pa = Just <$> pa <|> pure Nothing
+
 lit : Parser Raw
 lit = do
   t <- token Number
   pure $ RLit (LInt (cast t))
 
-export
-term : (Parser Raw)
+-- I can haz arrows
+export typeExpr : Parser Raw
+export term : (Parser Raw)
 
 withPos : Parser Raw -> Parser Raw
 withPos p = RSrcPos <$> getPos <*> p
 
--- ( t : ty ), (t , u) (t)
--- Or do we want (x : ty)  I think we may need to annotate any Raw
-parenThinger : Parser Raw
-parenThinger = do
-  keyword "("
-  t <- term
-  -- And now we want ) : or ,
-  -- we could do this with backtracing, but it'd kinda suck?
-  fail "todo"
-
 -- the inside of Raw
 atom : Parser Raw
-atom = lit
-    <|> withPos (RVar <$> ident)
+atom = withPos ( RVar <$> ident 
+              <|> lit
+              <|> RU <$ keyword "U"
+              <|> RHole <$ keyword "_")
     <|> parens term
-    -- <|> sym "(" *> Raw <* sym ")"
+
+-- Argument to a Spine
+pArg : Parser (Plicity,Raw)
+pArg = (Explicit,) <$> atom <|> (Implicit,) <$> braces term
 
 --
 -- atom is lit or ident
@@ -63,8 +77,7 @@ data Fixity = InfixL | InfixR | Infix
 -- starter pack, but we'll move some to prelude
 operators : List (String, Int, Fixity)
 operators = [
-  ("->", 1, InfixR),
-  ("=", 2, InfixL), -- REVIEW L R ?
+  ("=",2,Infix),
   ("+",4,InfixL),
   ("-",4,InfixL),
   ("*",5,InfixL),
@@ -73,8 +86,8 @@ operators = [
 parseApp : Parser Raw
 parseApp = do
   hd <- atom
-  rest <- many atom
-  pure $ foldl RApp hd rest
+  rest <- many pArg
+  pure $ foldl (\a, (c,b) => RApp a b c) hd rest
   
 parseOp : Lazy (Parser Raw)
 parseOp = parseApp >>= go 0
@@ -85,13 +98,10 @@ parseOp = parseApp >>= go 0
         op <- token Oper
         let Just (p,fix) = lookup op operators
          | Nothing => fail "expected operator"
-        -- if p >= prec then pure () else fail ""
-        guard $ p >= prec
-        -- commit
+        if p >= prec then pure () else fail ""
         let pr = case fix of InfixR => p; _ => p + 1
-        -- commit?
         right <- go pr !(parseApp)
-        go prec (RApp (RApp (RVar op) left) right)
+        go prec (RApp (RApp (RVar op) left Explicit) right Explicit)
       <|> pure left
 
 export
@@ -103,29 +113,37 @@ letExpr = do
   keyword' "in"
   scope <- term
   pure $ RLet alts scope
-  -- Let <$ keyword "let" <*> ident <* keyword "=" <*> Raw <* keyword "in" <*> Raw
   where
     letAssign : Parser (Name,Raw)
     letAssign = do
       name <- ident
+      -- TODO type assertion
       keyword "="
       t <- term
       pure (name,t)
 
-pPattern : Parser Pattern
-pPattern
-   = PatWild <$ keyword "_"
-  <|> PatVar <$> ident
+pLetArg : Parser (Plicity, String, Maybe Raw)
+pLetArg = (Implicit,,) <$> braces ident <*> optional (sym ":" >> typeExpr)
+       <|> (Explicit,,) <$> parens ident <*> optional (sym ":" >> typeExpr)
+       <|> (Explicit,,Nothing) <$> ident
+       <|> (Explicit,"_",Nothing) <$ keyword "_"
 
+-- lam: λ {A} {b : A} (c : Blah) d e f. something
 export
 lamExpr : Parser Raw
 lamExpr = do
   keyword "\\"
   commit
-  name <- pPattern
+  (icit, name, ty) <- pLetArg
   keyword "=>"
   scope <- term
-  pure $ RLam name scope
+  -- TODO optional type
+  pure $ RLam name icit scope
+
+pPattern : Parser Pattern
+pPattern
+   = PatWild <$ keyword "_"
+  <|> PatVar <$> ident
 
 
 caseAlt : Parser CaseAlt
@@ -146,29 +164,65 @@ caseExpr = do
   alts <- startBlock $ someSame $ caseAlt
   pure $ RCase sc alts
 
-term = defer $ \_ => 
-        caseExpr
+term =  caseExpr
     <|> letExpr
     <|> lamExpr
     <|> parseOp
 
+expBinder : Parser Raw
+expBinder = do
+  sym "("
+  name <- ident
+  sym ":"
+  ty <- typeExpr
+  sym ")"
+  sym "->"
+  scope <- typeExpr
+  pure $ RPi name Explicit ty scope
+
+impBinder : Parser Raw
+impBinder = do
+  sym "{"
+  name <- ident
+  sym ":"
+  ty <- typeExpr
+  sym "}"
+  sym "->"
+  scope <- typeExpr
+  pure $ RPi name Implicit ty scope
+
+-- something binder looking
+-- todo sepby space or whatever
+export
+binder : Parser Raw
+binder = expBinder <|> impBinder
+
+
+typeExpr = binder
+  <|> do
+        exp <- term
+        scope <- optional (sym "->" *> mustWork typeExpr)
+        case scope of
+          Nothing      => pure exp
+          -- consider Maybe String to represent missing
+          (Just scope) => pure $ RPi "_" Explicit exp scope
+
+
 -- And top level stuff
 
-optional : Parser a -> Parser (Maybe a)
-optional pa = Just <$> pa <|> pure Nothing
 
 export
 parseSig : Parser Decl
-parseSig = TypeSig <$> ident <* keyword ":" <*> term
+parseSig = TypeSig <$> ident <* keyword ":" <*> mustWork typeExpr
 
 parseImport : Parser Decl
-parseImport = DImport <$ keyword "import" <*> ident
+parseImport = DImport <$ keyword "import" <* commit <*> ident
 
 -- Do we do pattern stuff now? or just name = lambda?
 
 export
 parseDef : Parser Decl
-parseDef = Def <$> ident <* keyword "=" <*> term
+parseDef = Def <$> ident <* keyword "=" <*> mustWork typeExpr
 
 export
 parseData : Parser Decl
@@ -176,7 +230,7 @@ parseData = do
   keyword "data"
   name <- ident
   keyword ":"
-  ty <- term
+  ty <- typeExpr
   keyword "where"
   decls <- startBlock $ someSame $ parseSig
   -- TODO - turn decls into something more useful