summaryrefslogtreecommitdiff
path: root/src/Language/PureScript/AST/Traversals.hs
diff options
context:
space:
mode:
Diffstat (limited to 'src/Language/PureScript/AST/Traversals.hs')
-rw-r--r--src/Language/PureScript/AST/Traversals.hs11
1 files changed, 9 insertions, 2 deletions
diff --git a/src/Language/PureScript/AST/Traversals.hs b/src/Language/PureScript/AST/Traversals.hs
index 5367925..70543f8 100644
--- a/src/Language/PureScript/AST/Traversals.hs
+++ b/src/Language/PureScript/AST/Traversals.hs
@@ -72,6 +72,7 @@ everywhereOnValues f g h = (f', g', h')
g' (ObjectUpdateNested obj vs) = g (ObjectUpdateNested (g' obj) (fmap g' vs))
g' (Abs binder v) = g (Abs (h' binder) (g' v))
g' (App v1 v2) = g (App (g' v1) (g' v2))
+ g' (Unused v) = g (Unused (g' v))
g' (IfThenElse v1 v2 v3) = g (IfThenElse (g' v1) (g' v2) (g' v3))
g' (Case vs alts) = g (Case (fmap g' vs) (fmap handleCaseAlternative alts))
g' (TypedValue check v ty) = g (TypedValue check (g' v) ty)
@@ -146,6 +147,7 @@ everywhereOnValuesTopDownM f g h = (f' <=< f, g' <=< g, h' <=< h)
g' (ObjectUpdateNested obj vs) = ObjectUpdateNested <$> (g obj >>= g') <*> traverse (g' <=< g) vs
g' (Abs binder v) = Abs <$> (h binder >>= h') <*> (g v >>= g')
g' (App v1 v2) = App <$> (g v1 >>= g') <*> (g v2 >>= g')
+ g' (Unused v) = Unused <$> (g v >>= g')
g' (IfThenElse v1 v2 v3) = IfThenElse <$> (g v1 >>= g') <*> (g v2 >>= g') <*> (g v3 >>= g')
g' (Case vs alts) = Case <$> traverse (g' <=< g) vs <*> traverse handleCaseAlternative alts
g' (TypedValue check v ty) = TypedValue check <$> (g v >>= g') <*> pure ty
@@ -215,6 +217,7 @@ everywhereOnValuesM f g h = (f', g', h')
g' (ObjectUpdateNested obj vs) = (ObjectUpdateNested <$> g' obj <*> traverse g' vs) >>= g
g' (Abs binder v) = (Abs <$> h' binder <*> g' v) >>= g
g' (App v1 v2) = (App <$> g' v1 <*> g' v2) >>= g
+ g' (Unused v) = (Unused <$> g' v) >>= g
g' (IfThenElse v1 v2 v3) = (IfThenElse <$> g' v1 <*> g' v2 <*> g' v3) >>= g
g' (Case vs alts) = (Case <$> traverse g' vs <*> traverse handleCaseAlternative alts) >>= g
g' (TypedValue check v ty) = (TypedValue check <$> g' v <*> pure ty) >>= g
@@ -287,6 +290,7 @@ everythingOnValues (<>.) f g h i j = (f', g', h', i', j')
g' v@(ObjectUpdateNested obj vs) = foldl (<>.) (g v <>. g' obj) (fmap g' vs)
g' v@(Abs b v1) = g v <>. h' b <>. g' v1
g' v@(App v1 v2) = g v <>. g' v1 <>. g' v2
+ g' v@(Unused v1) = g v <>. g' v1
g' v@(IfThenElse v1 v2 v3) = g v <>. g' v1 <>. g' v2 <>. g' v3
g' v@(Case vs alts) = foldl (<>.) (foldl (<>.) (g v) (fmap g' vs)) (fmap i' alts)
g' v@(TypedValue _ v1 _) = g v <>. g' v1
@@ -368,6 +372,7 @@ everythingWithContextOnValues s0 r0 (<>.) f g h i j = (f'' s0, g'' s0, h'' s0, i
g' s (ObjectUpdateNested obj vs) = foldl (<>.) (g'' s obj) (fmap (g'' s) vs)
g' s (Abs binder v1) = h'' s binder <>. g'' s v1
g' s (App v1 v2) = g'' s v1 <>. g'' s v2
+ g' s (Unused v) = g'' s v
g' s (IfThenElse v1 v2 v3) = g'' s v1 <>. g'' s v2 <>. g'' s v3
g' s (Case vs alts) = foldl (<>.) (foldl (<>.) r0 (fmap (g'' s) vs)) (fmap (i'' s) alts)
g' s (TypedValue _ v1 _) = g'' s v1
@@ -453,6 +458,7 @@ everywhereWithContextOnValuesM s0 f g h i j = (f'' s0, g'' s0, h'' s0, i'' s0, j
g' s (ObjectUpdateNested obj vs) = ObjectUpdateNested <$> g'' s obj <*> traverse (g'' s) vs
g' s (Abs binder v) = Abs <$> h' s binder <*> g'' s v
g' s (App v1 v2) = App <$> g'' s v1 <*> g'' s v2
+ g' s (Unused v) = Unused <$> g'' s v
g' s (IfThenElse v1 v2 v3) = IfThenElse <$> g'' s v1 <*> g'' s v2 <*> g'' s v3
g' s (Case vs alts) = Case <$> traverse (g'' s) vs <*> traverse (i'' s) alts
g' s (TypedValue check v ty) = TypedValue check <$> g'' s v <*> pure ty
@@ -548,6 +554,7 @@ everythingWithScope f g h i j = (f'', g'', h'', i'', \s -> snd . j'' s)
let s' = S.union (S.fromList (localBinderNames b)) s
in h'' s b <> g'' s' v1
g' s (App v1 v2) = g'' s v1 <> g'' s v2
+ g' s (Unused v) = g'' s v
g' s (IfThenElse v1 v2 v3) = g'' s v1 <> g'' s v2 <> g'' s v3
g' s (Case vs alts) = foldMap (g'' s) vs <> foldMap (i'' s) alts
g' s (TypedValue _ v1 _) = g'' s v1
@@ -629,7 +636,7 @@ accumTypes
)
accumTypes f = everythingOnValues mappend forDecls forValues (const mempty) (const mempty) (const mempty)
where
- forDecls (DataDeclaration _ _ _ _ dctors) = mconcat (concatMap (fmap (f . snd) . snd) dctors)
+ forDecls (DataDeclaration _ _ _ _ dctors) = mconcat (concatMap (fmap (f . snd) . dataCtorFields) dctors)
forDecls (ExternDeclaration _ _ ty) = f ty
forDecls (TypeClassDeclaration _ _ _ implies _ _) = mconcat (concatMap (fmap f . constraintArgs) implies)
forDecls (TypeInstanceDeclaration _ _ _ _ cs _ tys _) = mconcat (concatMap (fmap f . constraintArgs) cs) <> mconcat (fmap f tys)
@@ -655,7 +662,7 @@ accumKinds f = everythingOnValues mappend forDecls forValues (const mempty) (con
where
forDecls (DataDeclaration _ _ _ args dctors) =
foldMap (foldMap f . snd) args <>
- foldMap (foldMap (forTypes . snd) . snd) dctors
+ foldMap (foldMap (forTypes . snd) . dataCtorFields) dctors
forDecls (TypeClassDeclaration _ _ args implies _ _) =
foldMap (foldMap f . snd) args <>
foldMap (foldMap forTypes . constraintArgs) implies