dunham/newt
1
0
Fork 0
Code Issues Pull Requests Actions 1 Packages Projects Releases Wiki Activity

drop commit/mustWork for parsec approach. allow mixfix constructors

Browse Source
This commit is contained in:
Steve Dunham
2024-09-14 14:46:04 -07:00
parent 647d8d8728
commit 331d966ef3
5 changed files with 49 additions and 62 deletions
Download Patch File Download Diff File Expand all files Collapse all files

3
TODO.md
View File

@@ -3,7 +3,8 @@
I may be done with `U` - I keep typing `Type`.
- [ ] type constructors are no longer generated? And seem to have 0 arity.
- [x] switch from commit/mustWork to checking progress
- [x] type constructors are no longer generated? And seem to have 0 arity.
- [ ] raw let is not yet implemented (although define used by case tree building)
- [x] there is some zero argument application in generated code
- [x] get equality.newt to work

4
newt/oper.newt
View File

@@ -39,3 +39,7 @@ data Pair : U -> U -> U where
blah : Int -> Int -> Int -> Pair Int (Pair Int Int)
blah x y z = (x, y, z)
curryPlus : Pair Int Int -> Int
curryPlus (_,_ a b) = a + b
-- curryPlus (a , b) = a + b

40
src/Lib/Parser.idr
View File

@@ -94,9 +94,9 @@ parseOp = parseApp >>= go 0
where
go : Int -> Raw -> Parser Raw
go prec left =
do
fc <- getPos
try (do
op <- token Oper
fc <- getPos
ops <- getOps
let op' = "_" ++ op ++ "_"
let Just (p,fix) = lookup op' ops
@@ -108,14 +108,13 @@ parseOp = parseApp >>= go 0
if p >= prec then pure () else fail ""
let pr = case fix of InfixR => p; _ => p + 1
right <- go pr !(parseApp)
go prec (RApp fc (RApp fc (RVar fc op') left Explicit) right Explicit)
go prec (RApp fc (RApp fc (RVar fc op') left Explicit) right Explicit))
<|> pure left
export
letExpr : Parser Raw
letExpr = do
keyword "let"
commit
alts <- startBlock $ someSame $ letAssign
keyword' "in"
scope <- typeExpr
@@ -142,7 +141,6 @@ export
lamExpr : Parser Raw
lamExpr = do
keyword "\\" <|> keyword "λ"
commit
args <- some pLetArg
keyword "=>"
scope <- typeExpr
@@ -163,19 +161,18 @@ patAtom = do
fc <- getPos
PatWild fc Explicit <$ keyword "_"
<|> PatVar fc Explicit <$> ident
<|> PatCon fc Explicit <$> uident <*> pure []
<|> PatCon fc Explicit <$> (uident <|> token MixFix) <*> pure []
<|> braces (PatVar fc Implicit <$> ident)
<|> braces (PatWild fc Implicit <$ keyword "_")
<|> braces (PatCon fc Implicit <$> uident <*> many patAtom)
<|> braces (PatCon fc Implicit <$> (uident <|> token MixFix) <*> many patAtom)
<|> parens pPattern
pPattern = PatCon (!getPos) Explicit <$> uident <*> many patAtom <|> patAtom
pPattern = PatCon (!getPos) Explicit <$> (uident <|> token MixFix) <*> many patAtom <|> patAtom
caseAlt : Parser RCaseAlt
caseAlt = do
pat <- pPattern
keyword "=>"
commit
t <- term
pure $ MkAlt pat t
@@ -183,7 +180,6 @@ export
caseExpr : Parser Raw
caseExpr = do
keyword "case"
commit
sc <- term
keyword "of"
alts <- startBlock $ someSame $ caseAlt
@@ -208,12 +204,10 @@ ebind = do
ibind : Parser (List (String, Icit, Raw))
ibind = do
sym "{"
mustWork $ do
names <- some (ident <|> uident)
ty <- optional (sym ":" >> typeExpr)
pos <- getPos
sym "}"
-- getPos is a hack here, I would like to position at the name...
pure $ map (\name => (name, Implicit, fromMaybe (RImplicit pos) ty)) names
arrow : Parser Unit
@@ -222,9 +216,8 @@ arrow = sym "->" <|> sym "→"
-- Collect a bunch of binders (A : U) {y : A} -> ...
binders : Parser Raw
binders = do
binds <- many (ibind <|> ebind)
binds <- many (ibind <|> try ebind)
arrow
commit
scope <- typeExpr
fc <- getPos
pure $ foldr (mkBind fc) scope (join binds)
@@ -235,7 +228,7 @@ binders = do
typeExpr = binders
<|> do
exp <- term
scope <- optional (arrow *> mustWork typeExpr)
scope <- optional (arrow *> typeExpr)
case scope of
Nothing => pure exp
-- consider Maybe String to represent missing
@@ -247,10 +240,10 @@ typeExpr = binders
export
parseSig : Parser Decl
parseSig = TypeSig <$> getPos <*> (ident <|> uident) <* keyword ":" <*> mustWork typeExpr
parseSig = TypeSig <$> getPos <*> (ident <|> uident) <* keyword ":" <*> typeExpr
parseImport : Parser Decl
parseImport = DImport <$> getPos <* keyword "import" <* commit <*> uident
parseImport = DImport <$> getPos <* keyword "import" <*> uident
-- Do we do pattern stuff now? or just name = lambda?
@@ -260,7 +253,6 @@ parseMixfix = do
fix <- InfixL <$ keyword "infixl"
<|> InfixR <$ keyword "infixr"
<|> Infix <$ keyword "infix"
mustWork $ do
prec <- token Number
op <- token MixFix
addOp op (cast prec) fix
@@ -273,7 +265,7 @@ parseDef = do
nm <- ident <|> uident
pats <- many patAtom
keyword "="
body <- mustWork typeExpr
body <- typeExpr
-- these get collected later
pure $ Def fc nm [MkClause fc [] pats body]
@@ -285,7 +277,7 @@ parsePType = do
id <- uident
ty <- optional $ do
keyword ":"
mustWork typeExpr
typeExpr
pure $ PType fc id ty
parsePFunc : Parser Decl
@@ -296,7 +288,7 @@ parsePFunc = do
keyword ":"
ty <- typeExpr
keyword ":="
src <- mustWork (cast <$> token StringKind)
src <- cast <$> token StringKind
pure $ PFunc fc nm ty src
export
@@ -304,15 +296,11 @@ parseData : Parser Decl
parseData = do
fc <- getPos
keyword "data"
-- FIXME - switch from mustWork / commit to checking if we've consumed tokens
mustWork $ do
name <- uident
keyword ":"
ty <- typeExpr
keyword "where"
commit
decls <- startBlock $ manySame $ parseSig
-- TODO - turn decls into something more useful
pure $ Data fc name ty decls
-- Not sure what I want here.
@@ -322,7 +310,7 @@ parseNorm = DCheck <$> getPos <* keyword "#check" <*> typeExpr <* keyword ":" <*
export
parseDecl : Parser Decl
parseDecl = parseMixfix <|> parsePType <|> parsePFunc <|> parseImport <|> parseNorm <|> parseData <|> parseSig <|> parseDef
parseDecl = parseMixfix <|> parsePType <|> parsePFunc <|> parseImport <|> parseNorm <|> parseData <|> (try $ parseSig) <|> parseDef
export
parseMod : Parser Module

25
src/Lib/Parser/Impl.idr
View File

@@ -1,13 +1,5 @@
module Lib.Parser.Impl
-- This follows Idris, not sure why I did that because commit / mustWork is messy
-- and painful to work with. I _think_ a commit on consumption of anything, like parsec
-- would work better.
-- Perhaps we can set the commit flag on consumption and get that with minor changes.
-- TODO see what Kovacs' flatparse does for error handling / <|>
import Lib.Token
import Data.String
import Data.Nat
@@ -101,6 +93,12 @@ parse pa toks = case runP pa toks False [] (-1,-1) of
-- I think I want to drop the typeclasses for v1
export
try : Parser a -> Parser a
try (P pa) = P $ \toks,com,ops,col => case pa toks com ops col of
(Fail x err toks com ops) => Fail x err toks False ops
res => res
export
fail : String -> Parser a
fail msg = P $ \toks,com,ops,col => Fail False (error toks msg) toks com ops
@@ -109,13 +107,6 @@ export
fatal : String -> Parser a
fatal msg = P $ \toks,com,ops,col => Fail True (error toks msg) toks com ops
-- mustWork / commit copied from Idris, but I may switch to the parsec consumption thing.
export
mustWork : Parser a -> Parser a
mustWork (P pa) = P $ \ toks, com, ops, col => case (pa toks com ops col) of
Fail x err xs y ops => Fail True err xs y ops
res => res
export
getOps : Parser (List (String, Int, Fixity))
getOps = P $ \ toks, com, ops, col => OK ops toks com ops
@@ -147,7 +138,7 @@ export
case pa toks False ops col of
OK a toks' _ ops => OK a toks' com ops
Fail True err toks' com ops => Fail True err toks' com ops
Fail fatal err toks' True ops => Fail fatal err toks' com ops
Fail fatal err toks' True ops => Fail fatal err toks' True ops
Fail fatal err toks' False ops => pb toks com ops col
export
@@ -161,7 +152,7 @@ Monad Parser where
pred : (BTok -> Bool) -> String -> Parser String
pred f msg = P $ \toks,com,ops,col =>
case toks of
(t :: ts) => if f t then OK (value t) ts com ops else Fail False (error toks "\{msg} at \{show $ kind t}:\{value t}") toks com ops
(t :: ts) => if f t then OK (value t) ts True ops else Fail False (error toks "\{msg} at \{show $ kind t}:\{value t}") toks com ops
[] => Fail False (error toks "\{msg} at EOF") toks com ops
export

7
src/Lib/Tokenizer.idr
View File

@@ -17,6 +17,9 @@ checkKW s = if elem s keywords then Tok Keyword s else Tok Ident s
checkUKW : String -> Token Kind
checkUKW s = if elem s keywords then Tok Keyword s else Tok UIdent s
checkOp : String -> Token Kind
checkOp s = if elem s specialOps then Tok Keyword s else Tok Oper s
isOpChar : Char -> Bool
isOpChar c = c `elem` (unpack ":!#$%&*+./<=>?@\\^|-~")
@@ -54,8 +57,8 @@ rawTokens
<|> match (quo <+> manyUntil quo ((esc any <+> any) <|> any) <+> opt quo) (Tok StringKind . unquote)
<|> match (lineComment (exact "--")) (Tok Space)
<|> match (blockComment (exact "/-") (exact "-/")) (Tok Space)
<|> match (exact ",") (\s => Tok Oper s)
<|> match (some opChar) (\s => Tok Oper s)
<|> match (exact ",") (Tok Oper)
<|> match (some opChar) checkOp
<|> match symbol (Tok Symbol)
<|> match spaces (Tok Space)