module Language.PureScript.CoreFn.Expr where
import Prelude.Compat
import Control.Arrow ((***))
import Language.PureScript.AST.Literals
import Language.PureScript.CoreFn.Binders
import Language.PureScript.Names
import Language.PureScript.PSString (PSString)
data Expr a
= Literal a (Literal (Expr a))
| Constructor a (ProperName 'TypeName) (ProperName 'ConstructorName) [Ident]
| Accessor a PSString (Expr a)
| ObjectUpdate a (Expr a) [(PSString, Expr a)]
| Abs a Ident (Expr a)
| App a (Expr a) (Expr a)
| Var a (Qualified Ident)
| Case a [Expr a] [CaseAlternative a]
| Let a [Bind a] (Expr a)
deriving (Show, Functor)
data Bind a
= NonRec a Ident (Expr a)
| Rec [((a, Ident), Expr a)] deriving (Show, Functor)
type Guard a = Expr a
data CaseAlternative a = CaseAlternative
{
caseAlternativeBinders :: [Binder a]
, caseAlternativeResult :: Either [(Guard a, Expr a)] (Expr a)
} deriving (Show)
instance Functor CaseAlternative where
fmap f (CaseAlternative cabs car) = CaseAlternative
(fmap (fmap f) cabs)
(either (Left . fmap (fmap f *** fmap f)) (Right . fmap f) car)
extractAnn :: Expr a -> a
extractAnn (Literal a _) = a
extractAnn (Constructor a _ _ _) = a
extractAnn (Accessor a _ _) = a
extractAnn (ObjectUpdate a _ _) = a
extractAnn (Abs a _ _) = a
extractAnn (App a _ _) = a
extractAnn (Var a _) = a
extractAnn (Case a _ _) = a
extractAnn (Let a _ _) = a
modifyAnn :: (a -> a) -> Expr a -> Expr a
modifyAnn f (Literal a b) = Literal (f a) b
modifyAnn f (Constructor a b c d) = Constructor (f a) b c d
modifyAnn f (Accessor a b c) = Accessor (f a) b c
modifyAnn f (ObjectUpdate a b c) = ObjectUpdate (f a) b c
modifyAnn f (Abs a b c) = Abs (f a) b c
modifyAnn f (App a b c) = App (f a) b c
modifyAnn f (Var a b) = Var (f a) b
modifyAnn f (Case a b c) = Case (f a) b c
modifyAnn f (Let a b c) = Let (f a) b c