module DDC.Core.Exp.Generic.Compounds
( module DDC.Type.Compounds
, makeXAbs, takeXAbs
, makeXLAMs, takeXLAMs
, makeXLams, takeXLams
, makeXApps, takeXApps, splitXApps
, takeXConApps
, takeXPrimApps
, dcUnit
, takeNameOfDaCon
, takeTypeOfDaCon)
where
import DDC.Core.Exp.Generic.Exp
import DDC.Core.Exp.DaCon
import DDC.Type.Compounds
import Data.Maybe
makeXAbs :: [GAbs l] -> GExp l -> GExp l
makeXAbs as xx
= foldr XAbs xx as
takeXAbs :: GExp l -> Maybe ([GAbs l], GExp l)
takeXAbs xx
= let go as (XAbs a x) = go (a : as) x
go as x = (reverse as, x)
in case go [] xx of
([], _) -> Nothing
(as, body) -> Just (as, body)
makeXLAMs :: [GBind l] -> GExp l -> GExp l
makeXLAMs bs x
= foldr XLAM x bs
takeXLAMs :: GExp l -> Maybe ([GBind l], GExp l)
takeXLAMs xx
= let go bs (XLAM b x) = go (b : bs) x
go bs x = (reverse bs, x)
in case go [] xx of
([], _) -> Nothing
(bs, body) -> Just (bs, body)
makeXLams :: [GBind l] -> GExp l -> GExp l
makeXLams bs x
= foldr XLam x bs
takeXLams :: GExp l -> Maybe ([GBind l], GExp l)
takeXLams xx
= let go bs (XLam b x) = go (b : bs) x
go bs x = (reverse bs, x)
in case go [] xx of
([], _) -> Nothing
(bs, body) -> Just (bs, body)
makeXApps :: GExp l -> [GArg l] -> GExp l
makeXApps t1 ts
= foldl XApp t1 ts
takeXApps :: GExp l -> Maybe (GExp l, [GArg l])
takeXApps xx
= case xx of
XApp x1@XApp{} a2
-> case takeXApps x1 of
Just (f1, as1) -> Just (f1, as1 ++ [a2])
Nothing -> Nothing
XApp x1 a2
-> Just (x1, [a2])
_ -> Nothing
splitXApps :: GExp l -> (GExp l, [GArg l])
splitXApps xx
= fromMaybe (xx, []) $ takeXApps xx
takeXPrimApps :: GExp l -> Maybe (GPrim l, [GArg l])
takeXPrimApps xx
= case xx of
XApp (XPrim p) a2
-> Just (p, [a2])
XApp x1@XApp{} a2
-> case takeXPrimApps x1 of
Just (p, as1) -> Just (p, as1 ++ [a2])
_ -> Nothing
_ -> Nothing
takeXConApps :: GExp l -> Maybe (DaCon l, [GArg l])
takeXConApps xx
= case xx of
XApp (XCon c) a2
-> Just (c, [a2])
XApp x1@XApp{} a2
-> case takeXConApps x1 of
Just (c, as1) -> Just (c, as1 ++ [a2])
_ -> Nothing
_ -> Nothing