module Language.Lambda.Untyped.Expression
  ( LambdaExpr(..),
    lambda,
    prettyPrint
  ) where

import RIO
import Prettyprinter
import Prettyprinter.Render.Text (renderStrict)

data LambdaExpr name
  = Var name                                -- ^ Variables
  | App (LambdaExpr name) (LambdaExpr name) -- ^ Application
  | Abs name (LambdaExpr name)              -- ^ Abstractions
  | Let name (LambdaExpr name)              -- ^ Let bindings
  deriving (LambdaExpr name -> LambdaExpr name -> Bool
forall name. Eq name => LambdaExpr name -> LambdaExpr name -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: LambdaExpr name -> LambdaExpr name -> Bool
$c/= :: forall name. Eq name => LambdaExpr name -> LambdaExpr name -> Bool
== :: LambdaExpr name -> LambdaExpr name -> Bool
$c== :: forall name. Eq name => LambdaExpr name -> LambdaExpr name -> Bool
Eq, Int -> LambdaExpr name -> ShowS
forall name. Show name => Int -> LambdaExpr name -> ShowS
forall name. Show name => [LambdaExpr name] -> ShowS
forall name. Show name => LambdaExpr name -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [LambdaExpr name] -> ShowS
$cshowList :: forall name. Show name => [LambdaExpr name] -> ShowS
show :: LambdaExpr name -> String
$cshow :: forall name. Show name => LambdaExpr name -> String
showsPrec :: Int -> LambdaExpr name -> ShowS
$cshowsPrec :: forall name. Show name => Int -> LambdaExpr name -> ShowS
Show)

instance Pretty name => Pretty (LambdaExpr name) where
  pretty :: forall ann. LambdaExpr name -> Doc ann
pretty (Var name
name) = forall a ann. Pretty a => a -> Doc ann
pretty name
name
  pretty (Abs name
name LambdaExpr name
body) = forall name a. Pretty name => name -> LambdaExpr name -> Doc a
prettyAbs name
name LambdaExpr name
body
  pretty (App LambdaExpr name
e1 LambdaExpr name
e2) = forall name a.
Pretty name =>
LambdaExpr name -> LambdaExpr name -> Doc a
prettyApp LambdaExpr name
e1 LambdaExpr name
e2
  pretty (Let name
name LambdaExpr name
body) = forall name a. Pretty name => name -> LambdaExpr name -> Doc a
prettyLet name
name LambdaExpr name
body

prettyPrint :: Pretty name => LambdaExpr name -> Text
prettyPrint :: forall name. Pretty name => LambdaExpr name -> Text
prettyPrint LambdaExpr name
expr = forall ann. SimpleDocStream ann -> Text
renderStrict SimpleDocStream Any
docStream
  where docStream :: SimpleDocStream Any
docStream = forall ann. LayoutOptions -> Doc ann -> SimpleDocStream ann
layoutPretty LayoutOptions
defaultLayoutOptions (forall a ann. Pretty a => a -> Doc ann
pretty LambdaExpr name
expr)

lambda :: Char
lambda :: Char
lambda = Char
'λ'

prettyAbs :: Pretty name => name -> LambdaExpr name -> Doc a
prettyAbs :: forall name a. Pretty name => name -> LambdaExpr name -> Doc a
prettyAbs name
name LambdaExpr name
body
  = forall ann. Doc ann
lambda' forall a. Semigroup a => a -> a -> a
<> forall ann. [Doc ann] -> Doc ann
hsep (forall a b. (a -> b) -> [a] -> [b]
map forall a ann. Pretty a => a -> Doc ann
pretty [name]
names) forall a. Semigroup a => a -> a -> a
<> forall ann. Doc ann
dot
    forall ann. Doc ann -> Doc ann -> Doc ann
<+> forall a ann. Pretty a => a -> Doc ann
pretty LambdaExpr name
body'
  where ([name]
names, LambdaExpr name
body') = forall n. n -> LambdaExpr n -> ([n], LambdaExpr n)
uncurryAbs name
name LambdaExpr name
body

prettyApp :: Pretty name => LambdaExpr name -> LambdaExpr name -> Doc a
prettyApp :: forall name a.
Pretty name =>
LambdaExpr name -> LambdaExpr name -> Doc a
prettyApp e1 :: LambdaExpr name
e1@(Abs name
_ LambdaExpr name
_) e2 :: LambdaExpr name
e2@(Abs name
_ LambdaExpr name
_) = forall ann. Doc ann -> Doc ann
parens (forall a ann. Pretty a => a -> Doc ann
pretty LambdaExpr name
e1) forall ann. Doc ann -> Doc ann -> Doc ann
<+> forall ann. Doc ann -> Doc ann
parens (forall a ann. Pretty a => a -> Doc ann
pretty LambdaExpr name
e2)
prettyApp e1 :: LambdaExpr name
e1@(Abs name
_ LambdaExpr name
_) LambdaExpr name
e2 = forall ann. Doc ann -> Doc ann
parens (forall a ann. Pretty a => a -> Doc ann
pretty LambdaExpr name
e1) forall ann. Doc ann -> Doc ann -> Doc ann
<+> forall a ann. Pretty a => a -> Doc ann
pretty LambdaExpr name
e2
prettyApp LambdaExpr name
e1 e2 :: LambdaExpr name
e2@(Abs name
_ LambdaExpr name
_) = forall a ann. Pretty a => a -> Doc ann
pretty LambdaExpr name
e1 forall ann. Doc ann -> Doc ann -> Doc ann
<+> forall ann. Doc ann -> Doc ann
parens (forall a ann. Pretty a => a -> Doc ann
pretty LambdaExpr name
e2)
prettyApp LambdaExpr name
e1 e2 :: LambdaExpr name
e2@(App LambdaExpr name
_ LambdaExpr name
_) = forall a ann. Pretty a => a -> Doc ann
pretty LambdaExpr name
e1 forall ann. Doc ann -> Doc ann -> Doc ann
<+> forall ann. Doc ann -> Doc ann
parens (forall a ann. Pretty a => a -> Doc ann
pretty LambdaExpr name
e2)
prettyApp LambdaExpr name
e1 LambdaExpr name
e2 = forall a ann. Pretty a => a -> Doc ann
pretty LambdaExpr name
e1 forall ann. Doc ann -> Doc ann -> Doc ann
<+> forall a ann. Pretty a => a -> Doc ann
pretty LambdaExpr name
e2

prettyLet :: Pretty name => name -> LambdaExpr name -> Doc a
prettyLet :: forall name a. Pretty name => name -> LambdaExpr name -> Doc a
prettyLet name
name LambdaExpr name
body
  = forall a ann. Pretty a => a -> Doc ann
pretty (Text
"let"::Text)
    forall ann. Doc ann -> Doc ann -> Doc ann
<+> forall a ann. Pretty a => a -> Doc ann
pretty name
name
    forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc a
"="
    forall ann. Doc ann -> Doc ann -> Doc ann
<+> forall a ann. Pretty a => a -> Doc ann
pretty LambdaExpr name
body

lambda' :: Doc ann
lambda' :: forall ann. Doc ann
lambda' = forall a ann. Pretty a => a -> Doc ann
pretty Char
lambda

uncurryAbs :: n -> LambdaExpr n -> ([n], LambdaExpr n)
uncurryAbs :: forall n. n -> LambdaExpr n -> ([n], LambdaExpr n)
uncurryAbs n
n = forall {a}. [a] -> LambdaExpr a -> ([a], LambdaExpr a)
uncurry' [n
n]
  where uncurry' :: [a] -> LambdaExpr a -> ([a], LambdaExpr a)
uncurry' [a]
ns (Abs a
n' LambdaExpr a
body') = [a] -> LambdaExpr a -> ([a], LambdaExpr a)
uncurry' (a
n'forall a. a -> [a] -> [a]
:[a]
ns) LambdaExpr a
body'
        uncurry' [a]
ns LambdaExpr a
body'          = (forall a. [a] -> [a]
reverse [a]
ns, LambdaExpr a
body')