This commit is contained in:
crumbtoo
2024-01-10 15:11:26 -07:00
parent 8ad967fac0
commit cb9ec43c14
2 changed files with 25 additions and 21 deletions

View File

@@ -83,7 +83,7 @@ layout item = scn *> (explicit <|> implicit) where
let indentGuard = L.indentGuard scn EQ i let indentGuard = L.indentGuard scn EQ i
-- override foldGuard in order with new indentation -- override foldGuard in order with new indentation
let ?foldGuard = void $ L.indentGuard scn GT i let ?foldGuard = void $ L.indentGuard scn GT i
fix \ds -> (:) <$> (indentGuard *> item) fix \ds -> (:) <$> (indentGuard *> item <* scn)
<*> (ds <|> pure []) <*> (ds <|> pure [])
t :: (?foldGuard :: Parser ()) => Parser [Text] t :: (?foldGuard :: Parser ()) => Parser [Text]
@@ -95,7 +95,7 @@ decl = choice
-- arbitrary name -- arbitrary name
[ infixD [ infixD
, dataD , dataD
, funD , try funD
, tySigD , tySigD
] ]
@@ -182,17 +182,11 @@ varid = NameVar <$> try (lexeme namevar)
<|> SymVar <$> lexeme (char '(' *> symvar <* char ')') <|> SymVar <$> lexeme (char '(' *> symvar <* char ')')
<?> "variable identifier" <?> "variable identifier"
decls :: Parser [PartialDecl'] program :: Parser [Decl' RlpExpr]
decls = layout decl <* eof program = do
ds <- layout decl <* eof
-- decls :: Parser [PartialDecl'] pt <- use psOpTable
-- decls = do pure $ complete pt <$> ds
-- space
-- i <- L.indentLevel
-- let indentGuard = L.indentGuard scn EQ i
-- let ?foldGuard = void $ L.indentGuard scn GT i
-- fix \ds -> (:) <$> (indentGuard *> decl)
-- <*> (try ds <|> eof *> pure [])
namevar :: Parser Name namevar :: Parser Name
namevar = word namevar = word
@@ -255,10 +249,10 @@ infixD = do
f (Just x) = registerCustomFailure RlpParErrDuplicateInfixD f (Just x) = registerCustomFailure RlpParErrDuplicateInfixD
$> Just x $> Just x
tySigD :: Parser (Decl' e) tySigD :: (OnFold) => Parser (Decl' e)
tySigD = undefined -- TySigD <$> (flexeme) tySigD = TySigD <$> (pure <$> varid) <*> (flexeme "::" *> flexeme type_)
dataD :: Parser (Decl' e) dataD :: (OnFold) => Parser (Decl' e)
dataD = DataD <$> (lexeme "data" *> conid) <*> many typaram dataD = DataD <$> (lexeme "data" *> conid) <*> many typaram
<*> optionalList (symbol "=" *> conalts) <*> optionalList (symbol "=" *> conalts)
where where
@@ -271,16 +265,16 @@ dataD = DataD <$> (lexeme "data" *> conid) <*> many typaram
conalt :: Parser ConAlt conalt :: Parser ConAlt
conalt = ConAlt <$> conid <*> many type1 conalt = ConAlt <$> conid <*> many type1
type1 :: Parser Type type1 :: (OnFold) => Parser Type
type1 = choice type1 = choice
[ lexeme "(" *> type_ <* lexeme ")" [ lexeme "(" *> type_ <* lexeme ")"
, TyVar <$> namevar , TyVar <$> namevar
, TyCon <$> namecon , TyCon <$> namecon
] ]
type_ :: Parser Type type_ :: (OnFold) => Parser Type
type_ = choice type_ = choice
[ try $ (:->) <$> type1 <*> (lexeme "->" *> type_) [ try $ (:->) <$> type1 <*> (flexeme "->" *> type_)
, type1 , type1
] ]
@@ -293,8 +287,15 @@ lit = int
-------------------------------------------------------------------------------- --------------------------------------------------------------------------------
-- completing partial expressions -- completing partial expressions
complete :: (?pt :: OpTable) => PartialExpr' -> RlpExpr' complete :: OpTable -> PartialDecl' -> Decl' RlpExpr
complete = cata completePartial complete pt (FunD n as b w) = FunD n as b' w
where b' = let ?pt = pt in completeExpr (getConst b)
complete pt (TySigD ns t) = TySigD ns t
complete pt (DataD n as cs) = DataD n as cs
complete pt (InfixD a p n) = InfixD a p n
completeExpr :: (?pt :: OpTable) => PartialExpr' -> RlpExpr'
completeExpr = cata completePartial
completePartial :: (?pt :: OpTable) => PartialE -> RlpExpr' completePartial :: (?pt :: OpTable) => PartialE -> RlpExpr'
completePartial (E e) = completeRlpExpr e completePartial (E e) = completeRlpExpr e

View File

@@ -42,6 +42,9 @@ import Rlp.Syntax
-- parser types -- parser types
-- TODO: the State is only used for building an operator table from infix[lr]
-- declarations. we should switch to a normal Parsec monad in the future
type Parser = ParsecT RlpParseError Text (State ParserState) type Parser = ParsecT RlpParseError Text (State ParserState)
data ParserState = ParserState data ParserState = ParserState