module DDC.Core.Compounds
(
bindsOfLets
, specBindsOfLets
, valwitBindsOfLets
, bindsOfPat
, makeXLAMs, takeXLAMs
, makeXLams, takeXLams
, takeXLamFlags
, makeXLamFlags
, makeXApps
, takeXApps
, takeXConApps
, takeXPrimApps
, takeCtorNameOfAlt)
where
import DDC.Type.Compounds
import DDC.Core.Exp
bindsOfLets :: Lets a n -> [Bind n]
bindsOfLets ll
= case ll of
LLet _ b _ -> [b]
LRec bxs -> map fst bxs
LLetRegion b bs -> b : bs
LWithRegion{} -> []
specBindsOfLets :: Lets a n -> [Bind n]
specBindsOfLets ll
= case ll of
LLet _ _ _ -> []
LRec _ -> []
LLetRegion b _ -> [b]
LWithRegion{} -> []
valwitBindsOfLets :: Lets a n -> [Bind n]
valwitBindsOfLets ll
= case ll of
LLet _ b _ -> [b]
LRec bxs -> map fst bxs
LLetRegion _ bs -> bs
LWithRegion{} -> []
bindsOfPat :: Pat n -> [Bind n]
bindsOfPat pp
= case pp of
PDefault -> []
PData _ bs -> bs
makeXLAMs :: a -> [Bind n] -> Exp a n -> Exp a n
makeXLAMs a bs x
= foldr (XLAM a) x (reverse bs)
takeXLAMs :: Exp a n -> Maybe ([Bind n], Exp a n)
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 :: a -> [Bind n] -> Exp a n -> Exp a n
makeXLams a bs x
= foldr (XLam a) x (reverse bs)
takeXLams :: Exp a n -> Maybe ([Bind n], Exp a n)
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)
takeXLamFlags :: Exp a n -> Maybe ([(Bool, Bind n)], Exp a n)
takeXLamFlags xx
= let go bs (XLAM _ b x) = go ((True, b):bs) x
go bs (XLam _ b x) = go ((False, b):bs) x
go bs x = (reverse bs, x)
in case go [] xx of
([], _) -> Nothing
(bs, body) -> Just (bs, body)
makeXLamFlags :: a -> [(Bool, Bind n)] -> Exp a n -> Exp a n
makeXLamFlags a fbs x
= foldr (\(f, b) x'
-> if f then XLAM a b x'
else XLam a b x')
x fbs
makeXApps :: a -> Exp a n -> [Exp a n] -> Exp a n
makeXApps a t1 ts = foldl (XApp a) t1 ts
takeXApps :: Exp a n -> [Exp a n]
takeXApps xx
= case xx of
XApp _ x1 x2 -> takeXApps x1 ++ [x2]
_ -> [xx]
takeXPrimApps :: Exp a n -> Maybe (n, [Exp a n])
takeXPrimApps xx
= case takeXApps xx of
XVar _ (UPrim p _) : xs -> Just (p, xs)
_ -> Nothing
takeXConApps :: Exp a n -> Maybe (Bound n, [Exp a n])
takeXConApps xx
= case takeXApps xx of
XCon _ u : xs -> Just (u, xs)
_ -> Nothing
takeCtorNameOfAlt :: Alt a n -> Maybe n
takeCtorNameOfAlt aa
= case aa of
AAlt (PData u _) _ -> takeNameOfBound u
_ -> Nothing