src/parse.icl

   1 implementation module parse
   2
   3 import StdString
   4 import StdTuple
   5 import StdList
   6 from StdFunc import const
   7 import Data.Either
   8 import Control.Monad
   9 import Control.Applicative
  10 import Data.Func
  11
  12 import yard
  13 import lex
  14
  15 parse :: LexerOutput -> ParserOutput
  16 parse (Left e) = Left $ toString $ LexError e
  17 parse (Right r) = case runParser parseProgram r of
  18         (Right p, _) = Right p
  19         (Left e, _) = Left $ toString e
  20
  21 parseProgram :: Parser Token AST
  22 parseProgram = parseVar >>= \t.pure $ AST [t] []
  23
  24 parseVar :: Parser Token VarDecl
  25 parseVar = parseType
  26         >>= \t->parseIdent <* satTok AssignmentToken
  27         >>= \i->parseExpr <* satTok SColonToken
  28         >>= \e->pure $ VarDecl i t e
  29
  30 parseType :: Parser Token Type
  31 parseType =
  32         trans1 IntTypeToken IntType <|>
  33         trans1 VarToken VarType <|>
  34         trans1 CharTypeToken CharType <|>
  35         trans1 BoolTypeToken BoolType <|>
  36         (satTok SquareOpenToken *> parseType <* satTok SquareCloseToken
  37                 >>= \t.pure $ ListType t) <|>
  38         (satTok BraceOpenToken *> parseType <* satTok CommaToken
  39                 >>= \t1->parseType <* satTok BraceCloseToken
  40                 >>= \t2->pure $ TupleType t1 t2) <|>
  41         (parseIdent >>= \e.pure $ IdType e) <|>
  42         empty
  43
  44 parseExpr :: Parser Token Expr
  45 parseExpr =
  46         (satTok BraceOpenToken *> parseExpr <* satTok BraceCloseToken) <|>
  47         (satTok BraceOpenToken *> parseExpr <* satTok CommaToken
  48                 >>= \e1->parseExpr <* satTok BraceCloseToken
  49                 >>= \e2->pure $ TupleExpr e1 e2) <|>
  50         trans1 EmptyListToken EmptyListExpr <|>
  51         trans2 TrueToken (const $ BoolExpr True) <|>
  52         trans2 FalseToken (const $ BoolExpr True) <|>
  53         trans2 (NumberToken zero) (\(NumberToken i)->IntExpr i) <|>
  54         trans2 (CharToken zero) (\(CharToken c)->CharExpr c) <|>
  55         (parseOp1 >>= \o->parseExpr >>= \e.pure $ Op1Expr o e) <|>
  56         (parseIdent >>= \i. parseFieldSelector >>= \f.pure $ VarExpr i f)
  57
  58 parseOp1 :: Parser Token Op1
  59 parseOp1 = trans1 DashToken UnMinus <|>
  60         trans1 ExclamationToken UnNegation
  61
  62 parseOp2 :: Parser Token Op2
  63 parseOp2 = trans1 StarToken BiTimes <|> trans1 SlashToken BiDivide <|>
  64         trans1 PercentToken BiMod <|> trans1 EqualsToken BiEquals <|>
  65         trans1 LesserToken BiLesser <|> trans1 BiggerToken BiGreater <|>
  66         trans1 LesserEqToken BiLesserEq <|> trans1 PlusToken BiPlus <|>
  67         trans1 GreaterEqToken BiGreaterEq <|> trans1 DashToken BiMinus <|>
  68         trans1 NotEqualToken BiUnEqual <|> trans1 AmpersandsToken BiAnd <|>
  69         trans1 PipesToken BiOr <|> trans1 ColonToken BiCons
  70
  71 parseFieldSelector :: Parser Token (Maybe FieldSelector)
  72 parseFieldSelector = optional (satTok DotToken *> (
  73         (parseIdent >>= (\i.if (i == "hd") (pure FieldHd) empty)) <|>
  74         (parseIdent >>= \i.if (i == "tl") (pure FieldTl) empty) <|>
  75         (parseIdent >>= \i.if (i == "fst") (pure FieldFst) empty) <|>
  76         (parseIdent >>= \i.if (i == "snd") (pure FieldSnd) empty)))
  77
  78 trans2 :: TokenValue (TokenValue -> a) -> Parser Token a
  79 trans2 t f = satTok t >>= \(_, r).pure (f r)
  80
  81 trans1 :: TokenValue a -> Parser Token a
  82 trans1 t r = trans2 t $ const r
  83
  84 satTok :: TokenValue -> Parser Token Token
  85 satTok t = satisfy ((===) t)
  86
  87 parseIdent :: Parser Token String
  88 parseIdent = trans2 (IdentToken []) (\(IdentToken e).toString e)