-- |
-- The core functional representation
--
module Language.PureScript.CoreFn.Expr where

import Prelude

import Control.Arrow ((***))

import Language.PureScript.AST.Literals (Literal)
import Language.PureScript.CoreFn.Binders (Binder)
import Language.PureScript.Names (Ident, ProperName, ProperNameType(..), Qualified)
import Language.PureScript.PSString (PSString)

-- |
-- Data type for expressions and terms
--
data Expr a
  -- |
  -- A literal value
  --
  = Literal a (Literal (Expr a))
  -- |
  -- A data constructor (type name, constructor name, field names)
  --
  | Constructor a (ProperName 'TypeName) (ProperName 'ConstructorName) [Ident]
  -- |
  -- A record property accessor
  --
  | Accessor a PSString (Expr a)
  -- |
  -- Partial record update
  --
  | ObjectUpdate a (Expr a) [(PSString, Expr a)]
  -- |
  -- Function introduction
  --
  | Abs a Ident (Expr a)
  -- |
  -- Function application
  --
  | App a (Expr a) (Expr a)
  -- |
  -- Variable
  --
  | Var a (Qualified Ident)
  -- |
  -- A case expression
  --
  | Case a [Expr a] [CaseAlternative a]
  -- |
  -- A let binding
  --
  | Let a [Bind a] (Expr a)
  deriving (Expr a -> Expr a -> Bool
forall a. Eq a => Expr a -> Expr a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Expr a -> Expr a -> Bool
$c/= :: forall a. Eq a => Expr a -> Expr a -> Bool
== :: Expr a -> Expr a -> Bool
$c== :: forall a. Eq a => Expr a -> Expr a -> Bool
Eq, Expr a -> Expr a -> Ordering
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall {a}. Ord a => Eq (Expr a)
forall a. Ord a => Expr a -> Expr a -> Bool
forall a. Ord a => Expr a -> Expr a -> Ordering
forall a. Ord a => Expr a -> Expr a -> Expr a
min :: Expr a -> Expr a -> Expr a
$cmin :: forall a. Ord a => Expr a -> Expr a -> Expr a
max :: Expr a -> Expr a -> Expr a
$cmax :: forall a. Ord a => Expr a -> Expr a -> Expr a
>= :: Expr a -> Expr a -> Bool
$c>= :: forall a. Ord a => Expr a -> Expr a -> Bool
> :: Expr a -> Expr a -> Bool
$c> :: forall a. Ord a => Expr a -> Expr a -> Bool
<= :: Expr a -> Expr a -> Bool
$c<= :: forall a. Ord a => Expr a -> Expr a -> Bool
< :: Expr a -> Expr a -> Bool
$c< :: forall a. Ord a => Expr a -> Expr a -> Bool
compare :: Expr a -> Expr a -> Ordering
$ccompare :: forall a. Ord a => Expr a -> Expr a -> Ordering
Ord, Int -> Expr a -> ShowS
forall a. Show a => Int -> Expr a -> ShowS
forall a. Show a => [Expr a] -> ShowS
forall a. Show a => Expr a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Expr a] -> ShowS
$cshowList :: forall a. Show a => [Expr a] -> ShowS
show :: Expr a -> String
$cshow :: forall a. Show a => Expr a -> String
showsPrec :: Int -> Expr a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> Expr a -> ShowS
Show, forall a b. a -> Expr b -> Expr a
forall a b. (a -> b) -> Expr a -> Expr b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: forall a b. a -> Expr b -> Expr a
$c<$ :: forall a b. a -> Expr b -> Expr a
fmap :: forall a b. (a -> b) -> Expr a -> Expr b
$cfmap :: forall a b. (a -> b) -> Expr a -> Expr b
Functor)

-- |
-- A let or module binding.
--
data Bind a
  -- |
  -- Non-recursive binding for a single value
  --
  = NonRec a Ident (Expr a)
  -- |
  -- Mutually recursive binding group for several values
  --
  | Rec [((a, Ident), Expr a)] deriving (Bind a -> Bind a -> Bool
forall a. Eq a => Bind a -> Bind a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Bind a -> Bind a -> Bool
$c/= :: forall a. Eq a => Bind a -> Bind a -> Bool
== :: Bind a -> Bind a -> Bool
$c== :: forall a. Eq a => Bind a -> Bind a -> Bool
Eq, Bind a -> Bind a -> Bool
Bind a -> Bind a -> Ordering
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall {a}. Ord a => Eq (Bind a)
forall a. Ord a => Bind a -> Bind a -> Bool
forall a. Ord a => Bind a -> Bind a -> Ordering
forall a. Ord a => Bind a -> Bind a -> Bind a
min :: Bind a -> Bind a -> Bind a
$cmin :: forall a. Ord a => Bind a -> Bind a -> Bind a
max :: Bind a -> Bind a -> Bind a
$cmax :: forall a. Ord a => Bind a -> Bind a -> Bind a
>= :: Bind a -> Bind a -> Bool
$c>= :: forall a. Ord a => Bind a -> Bind a -> Bool
> :: Bind a -> Bind a -> Bool
$c> :: forall a. Ord a => Bind a -> Bind a -> Bool
<= :: Bind a -> Bind a -> Bool
$c<= :: forall a. Ord a => Bind a -> Bind a -> Bool
< :: Bind a -> Bind a -> Bool
$c< :: forall a. Ord a => Bind a -> Bind a -> Bool
compare :: Bind a -> Bind a -> Ordering
$ccompare :: forall a. Ord a => Bind a -> Bind a -> Ordering
Ord, Int -> Bind a -> ShowS
forall a. Show a => Int -> Bind a -> ShowS
forall a. Show a => [Bind a] -> ShowS
forall a. Show a => Bind a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Bind a] -> ShowS
$cshowList :: forall a. Show a => [Bind a] -> ShowS
show :: Bind a -> String
$cshow :: forall a. Show a => Bind a -> String
showsPrec :: Int -> Bind a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> Bind a -> ShowS
Show, forall a b. a -> Bind b -> Bind a
forall a b. (a -> b) -> Bind a -> Bind b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: forall a b. a -> Bind b -> Bind a
$c<$ :: forall a b. a -> Bind b -> Bind a
fmap :: forall a b. (a -> b) -> Bind a -> Bind b
$cfmap :: forall a b. (a -> b) -> Bind a -> Bind b
Functor)

-- |
-- A guard is just a boolean-valued expression that appears alongside a set of binders
--
type Guard a = Expr a

-- |
-- An alternative in a case statement
--
data CaseAlternative a = CaseAlternative
  { -- |
    -- A collection of binders with which to match the inputs
    --
    forall a. CaseAlternative a -> [Binder a]
caseAlternativeBinders :: [Binder a]
    -- |
    -- The result expression or a collect of guarded expressions
    --
  , forall a.
CaseAlternative a -> Either [(Guard a, Guard a)] (Guard a)
caseAlternativeResult :: Either [(Guard a, Expr a)] (Expr a)
  } deriving (CaseAlternative a -> CaseAlternative a -> Bool
forall a. Eq a => CaseAlternative a -> CaseAlternative a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CaseAlternative a -> CaseAlternative a -> Bool
$c/= :: forall a. Eq a => CaseAlternative a -> CaseAlternative a -> Bool
== :: CaseAlternative a -> CaseAlternative a -> Bool
$c== :: forall a. Eq a => CaseAlternative a -> CaseAlternative a -> Bool
Eq, CaseAlternative a -> CaseAlternative a -> Bool
CaseAlternative a -> CaseAlternative a -> Ordering
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall {a}. Ord a => Eq (CaseAlternative a)
forall a. Ord a => CaseAlternative a -> CaseAlternative a -> Bool
forall a.
Ord a =>
CaseAlternative a -> CaseAlternative a -> Ordering
forall a.
Ord a =>
CaseAlternative a -> CaseAlternative a -> CaseAlternative a
min :: CaseAlternative a -> CaseAlternative a -> CaseAlternative a
$cmin :: forall a.
Ord a =>
CaseAlternative a -> CaseAlternative a -> CaseAlternative a
max :: CaseAlternative a -> CaseAlternative a -> CaseAlternative a
$cmax :: forall a.
Ord a =>
CaseAlternative a -> CaseAlternative a -> CaseAlternative a
>= :: CaseAlternative a -> CaseAlternative a -> Bool
$c>= :: forall a. Ord a => CaseAlternative a -> CaseAlternative a -> Bool
> :: CaseAlternative a -> CaseAlternative a -> Bool
$c> :: forall a. Ord a => CaseAlternative a -> CaseAlternative a -> Bool
<= :: CaseAlternative a -> CaseAlternative a -> Bool
$c<= :: forall a. Ord a => CaseAlternative a -> CaseAlternative a -> Bool
< :: CaseAlternative a -> CaseAlternative a -> Bool
$c< :: forall a. Ord a => CaseAlternative a -> CaseAlternative a -> Bool
compare :: CaseAlternative a -> CaseAlternative a -> Ordering
$ccompare :: forall a.
Ord a =>
CaseAlternative a -> CaseAlternative a -> Ordering
Ord, Int -> CaseAlternative a -> ShowS
forall a. Show a => Int -> CaseAlternative a -> ShowS
forall a. Show a => [CaseAlternative a] -> ShowS
forall a. Show a => CaseAlternative a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CaseAlternative a] -> ShowS
$cshowList :: forall a. Show a => [CaseAlternative a] -> ShowS
show :: CaseAlternative a -> String
$cshow :: forall a. Show a => CaseAlternative a -> String
showsPrec :: Int -> CaseAlternative a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> CaseAlternative a -> ShowS
Show)

instance Functor CaseAlternative where

  fmap :: forall a b. (a -> b) -> CaseAlternative a -> CaseAlternative b
fmap a -> b
f (CaseAlternative [Binder a]
cabs Either [(Guard a, Guard a)] (Guard a)
car) = forall a.
[Binder a]
-> Either [(Guard a, Guard a)] (Guard a) -> CaseAlternative a
CaseAlternative
    (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f) [Binder a]
cabs)
    (forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (forall a b. a -> Either a b
Left forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f forall (a :: * -> * -> *) b c b' c'.
Arrow a =>
a b c -> a b' c' -> a (b, b') (c, c')
*** forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f)) (forall a b. b -> Either a b
Right forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f) Either [(Guard a, Guard a)] (Guard a)
car)

-- |
-- Extract the annotation from a term
--
extractAnn :: Expr a -> a
extractAnn :: forall a. Expr a -> a
extractAnn (Literal a
a Literal (Expr a)
_) = a
a
extractAnn (Constructor a
a ProperName 'TypeName
_ ProperName 'ConstructorName
_ [Ident]
_) = a
a
extractAnn (Accessor a
a PSString
_ Expr a
_) = a
a
extractAnn (ObjectUpdate a
a Expr a
_ [(PSString, Expr a)]
_) = a
a
extractAnn (Abs a
a Ident
_ Expr a
_) = a
a
extractAnn (App a
a Expr a
_ Expr a
_) = a
a
extractAnn (Var a
a Qualified Ident
_) = a
a
extractAnn (Case a
a [Expr a]
_ [CaseAlternative a]
_) = a
a
extractAnn (Let a
a [Bind a]
_ Expr a
_) = a
a


-- |
-- Modify the annotation on a term
--
modifyAnn :: (a -> a) -> Expr a -> Expr a
modifyAnn :: forall a. (a -> a) -> Expr a -> Expr a
modifyAnn a -> a
f (Literal a
a Literal (Expr a)
b)         = forall a. a -> Literal (Expr a) -> Expr a
Literal (a -> a
f a
a) Literal (Expr a)
b
modifyAnn a -> a
f (Constructor a
a ProperName 'TypeName
b ProperName 'ConstructorName
c [Ident]
d) = forall a.
a
-> ProperName 'TypeName
-> ProperName 'ConstructorName
-> [Ident]
-> Expr a
Constructor (a -> a
f a
a) ProperName 'TypeName
b ProperName 'ConstructorName
c [Ident]
d
modifyAnn a -> a
f (Accessor a
a PSString
b Expr a
c)      = forall a. a -> PSString -> Expr a -> Expr a
Accessor (a -> a
f a
a) PSString
b Expr a
c
modifyAnn a -> a
f (ObjectUpdate a
a Expr a
b [(PSString, Expr a)]
c)  = forall a. a -> Expr a -> [(PSString, Expr a)] -> Expr a
ObjectUpdate (a -> a
f a
a) Expr a
b [(PSString, Expr a)]
c
modifyAnn a -> a
f (Abs a
a Ident
b Expr a
c)           = forall a. a -> Ident -> Expr a -> Expr a
Abs (a -> a
f a
a) Ident
b Expr a
c
modifyAnn a -> a
f (App a
a Expr a
b Expr a
c)           = forall a. a -> Expr a -> Expr a -> Expr a
App (a -> a
f a
a) Expr a
b Expr a
c
modifyAnn a -> a
f (Var a
a Qualified Ident
b)             = forall a. a -> Qualified Ident -> Expr a
Var (a -> a
f a
a) Qualified Ident
b
modifyAnn a -> a
f (Case a
a [Expr a]
b [CaseAlternative a]
c)          = forall a. a -> [Expr a] -> [CaseAlternative a] -> Expr a
Case (a -> a
f a
a) [Expr a]
b [CaseAlternative a]
c
modifyAnn a -> a
f (Let a
a [Bind a]
b Expr a
c)           = forall a. a -> [Bind a] -> Expr a -> Expr a
Let (a -> a
f a
a) [Bind a]
b Expr a
c