parse.icl

   1 implementation module parse
   2
   3 import Control.Applicative
   4 import Control.Monad
   5 import Data.Either
   6 import Data.Functor
   7 import Data.Func
   8 import StdEnv
   9 import Text.Parsers.Simple.ParserCombinators => qualified parse
  10
  11 import ast
  12
  13 (<:>) infixl 0 :: a (m [a]) -> m [a] | Functor m
  14 (<:>) l r = (\xs->[l:xs]) <$> r
  15
  16 :: Token = TEq | TSemiColon | TLambda | TDot | TBrackOpen | TBrackClose | TBool Bool | TChar Char | TInt Int | TIdent [Char]
  17
  18 lex :: [Char] -> Either [String] [Token]
  19 lex [] = pure []
  20 lex ['=':ts] = TEq <:> lex ts
  21 lex [';':ts] = TSemiColon <:> lex ts
  22 lex ['\\':ts] = TLambda <:> lex ts
  23 lex ['.':ts] = TDot <:> lex ts
  24 lex [')':ts] = TBrackClose <:> lex ts
  25 lex ['(':ts] = TBrackOpen <:> lex ts
  26 lex ['True':ts] = TBool True <:> lex ts
  27 lex ['False':ts] = TBool False <:> lex ts
  28 lex ['\'',c,'\'':ts] = TChar c <:> lex ts
  29 lex ['-',t:ts]
  30         | isDigit t = lex [t:ts] >>= \v->case v of
  31                 [TInt i:rest] = Right [TInt (~i):rest]
  32                 x = pure x
  33 lex [t:ts]
  34         | isSpace t = lex ts
  35         | isDigit t
  36                 # (i, ts) = span isDigit [t:ts]
  37                 = TInt (toInt (toString i)) <:> lex ts
  38         | isAlpha t
  39                 # (i, ts) = span isAlpha [t:ts]
  40                 = TIdent i <:> lex ts
  41         = Left ["Unexpected: " +++ toString t +++ " ord: " +++ toString (toInt t)]
  42
  43 parse :: [Char] -> Either [String] AST
  44 parse t = lex t >>= 'Text.Parsers.Simple.ParserCombinators'.parse (AST <$> many pFunction)
  45 where
  46         pId = (\(TIdent i)->i) <$> pSatisfy (\t->t=:(TIdent _))
  47
  48         pFunction :: Parser Token Function
  49         pFunction
  50                 =   Function
  51                 <$> pId
  52                 <*> many pId
  53                 <*  pSatisfy (\t->t=:TEq)
  54                 <*> pExpression
  55                 <*  pSatisfy (\t->t=:TSemiColon)
  56
  57         pExpression :: Parser Token Expression
  58         pExpression = flip pChainl1 (pure App) $
  59                      (Lambda <$ pSatisfy (\t->t=:TLambda) <*> pId <* pSatisfy (\t->t=:TDot) <*> pExpression)
  60                 <<|> (pSatisfy (\t->t=:TBrackOpen) *> pExpression <* pSatisfy (\t->t=:TBrackClose))
  61                 <<|> ((\(TInt i)->Lit (Int i)) <$> pSatisfy (\t->t=:(TInt _)))
  62                 <<|> ((\(TChar i)->Lit (Char i)) <$> pSatisfy (\t->t=:(TChar _)))
  63                 <<|> ((\(TBool i)->Lit (Bool i)) <$> pSatisfy (\t->t=:(TBool _)))
  64                 <<|> (Var <$> pId)