1 module Language.Core.CoreUtils where
3 import Language.Core.Core
4 import Language.Core.Utils
9 splitDataConApp_maybe :: Exp -> Maybe (Qual Dcon, [Ty], [Exp])
10 splitDataConApp_maybe (Dcon d) = Just (d, [], [])
11 splitDataConApp_maybe (Appt rator t) =
12 case splitDataConApp_maybe rator of
13 Just (r, ts, rs) -> Just (r, ts ++ [t], rs)
15 splitDataConApp_maybe (App rator rand) =
16 case splitDataConApp_maybe rator of
17 Just (r, ts, rs) -> Just (r, ts, rs++[rand])
19 splitDataConApp_maybe _ = Nothing
21 splitApp :: Exp -> (Exp, [Exp])
22 splitApp (Appt rator _) = splitApp rator
23 splitApp (App rator rand) =
24 case splitApp rator of
25 (r, rs) -> (r, rs++[rand])
28 splitAppIgnoreCasts :: Exp -> (Exp, [Exp])
29 splitAppIgnoreCasts (Appt rator _) = splitApp rator
30 splitAppIgnoreCasts (App (Cast rator _) rand) = splitApp (App rator rand)
31 splitAppIgnoreCasts (App rator rand) =
32 case splitApp rator of
33 (r, rs) -> (r, rs++[rand])
34 splitAppIgnoreCasts e = (e, [])
36 splitFunTy_maybe :: Ty -> Maybe ([Ty], Ty)
37 splitFunTy_maybe (Tforall _ t) = splitFunTy_maybe t
39 case splitFunTy2_maybe t of
40 Just (rator, rand) -> case splitFunTy_maybe rand of
41 Just (r,s) -> Just (rator:r, s)
42 Nothing -> Just ([rator], rand)
45 splitFunTy2_maybe :: Ty -> Maybe (Ty,Ty)
46 splitFunTy2_maybe (Tapp (Tapp (Tcon c) t) u) | c == tcArrow = Just (t, u)
47 splitFunTy2_maybe _ = Nothing
49 vdefNamesQ :: [Vdef] -> [Qual Var]
50 vdefNamesQ = map (\ (Vdef (v,_,_)) -> v)
52 vdefNames :: [Vdef] -> [Var]
53 vdefNames = snd . unzip . vdefNamesQ
55 vdefTys :: [Vdef] -> [Ty]
56 vdefTys = map (\ (Vdef (_,t,_)) -> t)
58 vdefgNames :: Vdefg -> [Var]
59 vdefgNames (Rec vds) = map (\ (Vdef ((_,v),_,_)) -> v) vds
60 vdefgNames (Nonrec (Vdef ((_,v),_,_))) = [v]
61 vdefgTys :: Vdefg -> [Ty]
62 vdefgTys (Rec vds) = map (\ (Vdef (_,t,_)) -> t) vds
63 vdefgTys (Nonrec (Vdef (_,t,_))) = [t]
65 vbNames :: [Vbind] -> [Var]
68 -- assumes v is not bound in e
69 substIn :: Data a => Var -> Var -> a -> a
70 substIn v newV = everywhereExcept (mkT frob)
71 where frob (Var (Nothing,v1)) | v == v1 = Var (Nothing,newV)
74 substVars :: Data a => [Var] -> [Var] -> a -> a
75 substVars oldVars newVars e = foldl' (\ e1 (old,new) -> substIn old new e1)
76 e (zip oldVars newVars)
79 tdefNames :: [Tdef] -> [Qual Var]
80 tdefNames = concatMap doOne
81 where doOne (Data qtc _ cds) = qtc:(concatMap doCdef cds)
82 doOne (Newtype qtc qtc1 _ _) = [qtc, qtc1]
83 doCdef (Constr qdc _ _) = [qdc]