module DDC.Source.Tetra.Exp.Generic
(
HasAnonBind (..)
, GName
, GAnnot
, GBind
, GBound
, GPrim
, GExp (..)
, GLets (..)
, GAlt (..)
, GPat (..)
, GClause (..)
, GGuardedExp (..)
, GGuard (..)
, GCast (..)
, DaCon (..)
, GWitness (..)
, GWiCon (..)
, ShowLanguage
, NFDataLanguage)
where
import DDC.Type.Exp
import qualified DDC.Type.Exp as T
import DDC.Type.Sum ()
import Control.DeepSeq
import DDC.Core.Exp
( DaCon (..))
type family GName l
type family GAnnot l
type family GBind l
type family GBound l
type family GPrim l
class HasAnonBind l where
isAnon :: l -> GBind l -> Bool
data GExp l
= XVar !(GAnnot l) !(GBound l)
| XPrim !(GAnnot l) !(GPrim l)
| XCon !(GAnnot l) !(DaCon (GName l))
| XLAM !(GAnnot l) !(GBind l) !(GExp l)
| XLam !(GAnnot l) !(GBind l) !(GExp l)
| XApp !(GAnnot l) !(GExp l) !(GExp l)
| XLet !(GAnnot l) !(GLets l) !(GExp l)
| XCase !(GAnnot l) !(GExp l) ![GAlt l]
| XCast !(GAnnot l) !(GCast l) !(GExp l)
| XType !(GAnnot l) !(Type (GName l))
| XWitness !(GAnnot l) !(GWitness l)
| XDefix !(GAnnot l) [GExp l]
| XInfixOp !(GAnnot l) String
| XInfixVar !(GAnnot l) String
data GLets l
= LLet !(GBind l) !(GExp l)
| LRec ![(GBind l, GExp l)]
| LPrivate ![GBind l] !(Maybe (Type (GName l))) ![GBind l]
| LGroup ![GClause l]
data GClause l
= SSig !(GAnnot l) !(GBind l) !(Type (GName l))
| SLet !(GAnnot l) !(GBind l) ![GPat l] ![GGuardedExp l]
data GAlt l
= AAlt !(GPat l) ![GGuardedExp l]
data GPat l
= PDefault
| PData !(DaCon (GName l)) ![GBind l]
data GGuardedExp l
= GGuard !(GGuard l) !(GGuardedExp l)
| GExp !(GExp l)
data GGuard l
= GPat !(GPat l) !(GExp l)
| GPred !(GExp l)
| GDefault
data GCast l
= CastWeakenEffect !(Effect (GName l))
| CastPurify !(GWitness l)
| CastBox
| CastRun
data GWitness l
= WVar !(GAnnot l) !(GBound l)
| WCon !(GAnnot l) !(GWiCon l)
| WApp !(GAnnot l) !(GWitness l) !(GWitness l)
| WType !(GAnnot l) !(T.Type (GName l))
data GWiCon l
= WiConBound !(GBound l) !(T.Type (GName l))
type ShowLanguage l
= ( Show l
, Show (GName l), Show (GAnnot l)
, Show (GBind l), Show (GBound l), Show (GPrim l))
deriving instance ShowLanguage l => Show (GExp l)
deriving instance ShowLanguage l => Show (GLets l)
deriving instance ShowLanguage l => Show (GClause l)
deriving instance ShowLanguage l => Show (GAlt l)
deriving instance ShowLanguage l => Show (GGuardedExp l)
deriving instance ShowLanguage l => Show (GGuard l)
deriving instance ShowLanguage l => Show (GPat l)
deriving instance ShowLanguage l => Show (GCast l)
deriving instance ShowLanguage l => Show (GWitness l)
deriving instance ShowLanguage l => Show (GWiCon l)
type NFDataLanguage l
= ( NFData l
, NFData (GAnnot l), NFData (GName l)
, NFData (GBind l), NFData (GBound l), NFData (GPrim l))
instance NFDataLanguage l => NFData (GExp l) where
rnf xx
= case xx of
XVar a u -> rnf a `seq` rnf u
XPrim a p -> rnf a `seq` rnf p
XCon a dc -> rnf a `seq` rnf dc
XLAM a b x -> rnf a `seq` rnf b `seq` rnf x
XLam a b x -> rnf a `seq` rnf b `seq` rnf x
XApp a x1 x2 -> rnf a `seq` rnf x1 `seq` rnf x2
XLet a lts x -> rnf a `seq` rnf lts `seq` rnf x
XCase a x alts -> rnf a `seq` rnf x `seq` rnf alts
XCast a c x -> rnf a `seq` rnf c `seq` rnf x
XType a t -> rnf a `seq` rnf t
XWitness a w -> rnf a `seq` rnf w
XDefix a xs -> rnf a `seq` rnf xs
XInfixOp a s -> rnf a `seq` rnf s
XInfixVar a s -> rnf a `seq` rnf s
instance NFDataLanguage l => NFData (GClause l) where
rnf cc
= case cc of
SSig a b t -> rnf a `seq` rnf b `seq` rnf t
SLet a b ps gxs -> rnf a `seq` rnf b `seq` rnf ps `seq` rnf gxs
instance NFDataLanguage l => NFData (GLets l) where
rnf lts
= case lts of
LLet b x -> rnf b `seq` rnf x
LRec bxs -> rnf bxs
LPrivate bs1 mR bs2 -> rnf bs1 `seq` rnf mR `seq` rnf bs2
LGroup cs -> rnf cs
instance NFDataLanguage l => NFData (GAlt l) where
rnf aa
= case aa of
AAlt w gxs -> rnf w `seq` rnf gxs
instance NFDataLanguage l => NFData (GPat l) where
rnf pp
= case pp of
PDefault -> ()
PData dc bs -> rnf dc `seq` rnf bs
instance NFDataLanguage l => NFData (GGuardedExp l) where
rnf gx
= case gx of
GGuard g gx' -> rnf g `seq` rnf gx'
GExp x -> rnf x
instance NFDataLanguage l => NFData (GGuard l) where
rnf gg
= case gg of
GPred x -> rnf x
GPat p x -> rnf p `seq` rnf x
GDefault -> ()
instance NFDataLanguage l => NFData (GCast l) where
rnf cc
= case cc of
CastWeakenEffect e -> rnf e
CastPurify w -> rnf w
CastBox -> ()
CastRun -> ()
instance NFDataLanguage l => NFData (GWitness l) where
rnf ww
= case ww of
WVar a u -> rnf a `seq` rnf u
WCon a c -> rnf a `seq` rnf c
WApp a w1 w2 -> rnf a `seq` rnf w1 `seq` rnf w2
WType a t -> rnf a `seq` rnf t
instance NFDataLanguage l => NFData (GWiCon l) where
rnf wc
= case wc of
WiConBound u t -> rnf u `seq` rnf t