pCoreExpr :: Parser CoreExpr
pCoreExpr = choice [pLet, pCase, pLam, expr1] where
  expr1 = P.buildExpressionParser table term
  table = [ map binary ["*", "/"]
          , map binary ["+", "-"]
          , map binary relOps
          , [ binary "&" ]
          , [ binary "|" ]
          ]

  -- App or single Aexpr
  term = foldl1 EAp <$> many1 pAexpr

  pLam = do
    reservedOp "\\"
    params <- many1 identifier
    reservedOp "."
    expr <- pCoreExpr
    return (ELam params expr)

  pCase = do
    reserved "case"
    e <- pCoreExpr
    reserved "of"
    alts <- sequence1 pAlt1
    return (ECase e alts)
    where
      pAlt1 = do
        i <- reservedOp "<" *> int <* reservedOp ">"
        vars <- many identifier
        reservedOp "->"
        expr <- pCoreExpr
        return (i, vars, expr)

  pLet  = do
    isrec <- try (reserved "let" $> False) <|> (reserved "letrec" $> True)
    binds <- sequence1 (try bind1)
    reserved "in"
    expr <- pCoreExpr
    return (ELet isrec binds expr)
    where
      bind1 = do
        name <- identifier
        reservedOp "="
        expr <- pCoreExpr
        return (name, expr)

  pCtor = do
    reserved "Pack"
    braces $ EConstr <$> int <* reservedOp "," <*> int

  pAexpr = spaces *> choice [pVar, pNum, pCtor, parens pCoreExpr] <* spaces

  pNum  = ENum  <$> int
  pVar  = EVar  <$> identifier
pCoreExpr :: Parser CoreExpr
pCoreExpr = choice [pLet, pCase, pLam, expr1] where
  expr1 = P.buildExpressionParser table term
  table = [ map binary ["*", "/"]
          , map binary ["+", "-"]
          , map binary relOps
          , [ binary "&" ]
          , [ binary "|" ]
          ]

  -- App or single Aexpr
  term = foldl1 EAp <$> many1 pAexpr

  pLam = do
    reservedOp "\\"
    params <- many1 identifier
    reservedOp "."
    expr <- pCoreExpr
    return (ELam params expr)

  pCase = do
    reserved "case"
    e <- pCoreExpr
    reserved "of"
    alts <- sequence1 pAlt1
    return (ECase e alts)
    where
      pAlt1 = do
        i <- reservedOp "<" *> int <* reservedOp ">"
        vars <- many identifier
        reservedOp "->"
        expr <- pCoreExpr
        return (i, vars, expr)

  pLet  = do
    isrec <- try (reserved "let" $> False) <|> (reserved "letrec" $> True)
    binds <- sequence1 (try bind1)
    reserved "in"
    expr <- pCoreExpr
    return (ELet isrec binds expr)
    where
      bind1 = do
        name <- identifier
        reservedOp "="
        expr <- pCoreExpr
        return (name, expr)

  pCtor = do
    reserved "Pack"
    braces $ EConstr <$> int <* reservedOp "," <*> int

  pAexpr = spaces *> choice [pVar, pNum, pCtor, parens pCoreExpr] <* spaces

  pNum  = ENum  <$> int
  pVar  = EVar  <$> identifier
pCoreExpr = choice [pLet, pCase, pLam, expr1] where
  expr1 = P.buildExpressionParser table term
  table = [ map binary ["*", "/"]
          , map binary ["+", "-"]
          , map binary relOps
          , [ binary "&" ]
          , [ binary "|" ]
          ]

  -- App or single Aexpr
  term = foldl1 EAp <$> many1 pAexpr

  pLam = do
    reservedOp "\\"
    params <- many1 identifier
    reservedOp "."
    expr <- pCoreExpr
    return (ELam params expr)

  pCase = do
    reserved "case"
    e <- pCoreExpr
    reserved "of"
    alts <- sequence1 pAlt1
    return (ECase e alts)
    where
      pAlt1 = do
        i <- reservedOp "<" *> int <* reservedOp ">"
        vars <- many identifier
        reservedOp "->"
        expr <- pCoreExpr
        return (i, vars, expr)

  pLet  = do
    isrec <- try (reserved "let" $> False) <|> (reserved "letrec" $> True)
    binds <- sequence1 (try bind1)
    reserved "in"
    expr <- pCoreExpr
    return (ELet isrec binds expr)
    where
      bind1 = do
        name <- identifier
        reservedOp "="
        expr <- pCoreExpr
        return (name, expr)

  pCtor = do
    reserved "Pack"
    braces $ EConstr <$> int <* reservedOp "," <*> int

  pAexpr = spaces *> choice [pVar, pNum, pCtor, parens pCoreExpr] <* spaces

  pNum  = ENum  <$> int
  pVar  = EVar  <$> identifier