content: {-|
  This module contains a simple lambda calculus parser. This parser is not optimized for maximum
  performance; instead it's written in a style which emulates the look and feel of conventional
  monadic parsers. An optimized implementation would use low-level `switch` expressions more often.
  -}
  
  {-# language StrictData #-}
  
  module FlatParse.Examples.BasicLambda.Parser where
  
  import Data.Char (ord)
  import qualified Data.ByteString as B
  
  import FlatParse.Basic hiding (Parser, runParser, string, char, cut)
  import FlatParse.Examples.BasicLambda.Lexer
  
  --------------------------------------------------------------------------------
  
  type Name = B.ByteString
  
  {-|
  A term in the language. The precedences of different constructs are the following, in decreasing
  order of strength:
  
  * Identifiers, literals and parenthesized expressions
  * Function application (left assoc)
  * Multiplication (left assoc)
  * Addition (left assoc)
  * Equality, less-than (non-assoc)
  * @lam@, @let@, @if@ (right assoc)
  
  -}
  data Tm
    = Var Name        -- ^ @x@
    | App Tm Tm       -- ^ @t u@
    | Lam Name Tm     -- ^ @lam x. t@
    | Let Name Tm Tm  -- ^ @let x = t in u@
    | BoolLit Bool    -- ^ @true@ or @false@.
    | IntLit Int      -- ^ A positive `Int` literal.
    | If Tm Tm Tm     -- ^ @if t then u else v@
    | Add Tm Tm       -- ^ @t + u@
    | Mul Tm Tm       -- ^ @t * u@
    | Eq Tm Tm        -- ^ @t == u@
    | Lt Tm Tm        -- ^ @t < u@
    deriving Show
  
  
  -- | Parse an identifier. This parser uses `isKeyword` to check that an identifier is not a
  --   keyword.
  ident :: Parser Name
  ident = token $ byteStringOf $
    withSpan (identStartChar *> skipMany identChar) (\_ span -> fails (isKeyword span))
  
  -- | Parse an identifier, throw a precise error on failure.
  ident' :: Parser Name
  ident' = ident `cut'` (Msg "identifier")
  
  digit :: Parser Int
  digit = (\c -> ord c - ord '0') <$> satisfyAscii isDigit
  
  int :: Parser Int
  int = token do
    (place, n) <- chainr (\n (!place, !acc) -> (place*10,acc+place*n)) digit (pure (1, 0))
    case place of
      1 -> empty
      _ -> pure n
  
  -- | Parse a literal, identifier or parenthesized expression.
  atom :: Parser Tm
  atom =
         (Var           <$> ident)
     <|> (BoolLit True  <$  $(keyword "true"))
     <|> (BoolLit False <$  $(keyword "false"))
     <|> (IntLit        <$> int)
     <|> ($(symbol "(") *> tm' <* $(symbol' ")"))
  
  atom' :: Parser Tm
  atom' = atom
    `cut` [Msg "identifier", "true", "false", Msg "parenthesized expression", Msg "integer literal"]
  
  -- | Parse an `App`-level expression.
  app' :: Parser Tm
  app' = chainl App atom' atom
  
  -- | Parse a `Mul`-level expression.
  mul' :: Parser Tm
  mul' = chainl Mul app' ($(symbol "*") *> app')
  
  -- | Parse an `Add`-level expression.
  add' :: Parser Tm
  add' = chainl Add mul' ($(symbol "+") *> mul')
  
  -- | Parse an `FlatParse.Examples.BasicLambda.Parser.Eq` or `Lt`-level expression.
  eqLt' :: Parser Tm
  eqLt' =
    add' >>= \e1 ->
    branch $(symbol "==") (Eq e1 <$> add') $
    branch $(symbol "<")  (Lt e1 <$> add') $
    pure e1
  
  -- | Parse a `Let`.
  pLet :: Parser Tm
  pLet = do
    $(keyword "let")
    x <- ident'
    $(symbol' "=")
    t <- tm'
    $(keyword' "in")
    u <- tm'
    pure $ Let x t u
  
  -- | Parse a `Lam`.
  lam :: Parser Tm
  lam = do
    $(keyword "lam")
    x <- ident'
    $(symbol' ".")
    t <- tm'
    pure $ Lam x t
  
  -- | Parse an `If`.
  pIf :: Parser Tm
  pIf = do
    $(keyword "if")
    t <- tm'
    $(keyword' "then")
    u <- tm'
    $(keyword' "else")
    v <- tm'
    pure $ If t u v
  
  -- | Parse any `Tm`.
  tm' :: Parser Tm
  tm' = (pLet <|> lam <|> pIf <|> eqLt') `cut` ["let", "lam", "if"]
  
  -- | Parse a complete source file.
  src' :: Parser Tm
  src' = ws *> tm' <* eof `cut` [Msg "end of input (lexical error)"]
  
  
  -- Examples
  --------------------------------------------------------------------------------
  
  -- testParser src' p1
  p1 = unlines [
    "let f = lam x. lam y. x (x (x y)) in",
    "let g = if f true then false else true in",
    "let h = f x y + 200 in",
    "f g g h"
    ]
  