@@ -12,7 +12,7 @@
1212--
1313-----------------------------------------------------------------------------
1414
15−{-# LANGUAGE DeriveDataTypeable #-}
15+{-# LANGUAGE DeriveDataTypeable, ScopedTypeVariables #-}
1616
1717module Language.PureScript.Declarations where
1818
@@ -668,6 +668,74 @@ everythingOnValues (<>) f g h i j = (f', g', h', i', j')
668668 j' e@(DoNotationLet ds) = foldl (<>) (j e) (map f' ds)
669669 j' e@(PositionedDoNotationElement _ e1) = j e <> j' e1
670670
671+everythingWithContextOnValues ::
672+ s ->
673+ r ->
674+ (r -> r -> r) ->
675+ (s -> Declaration -> (s, r)) ->
676+ (s -> Value -> (s, r)) ->
677+ (s -> Binder -> (s, r)) ->
678+ (s -> CaseAlternative -> (s, r)) ->
679+ (s -> DoNotationElement -> (s, r)) ->
680+ ( Declaration -> r
681+ , Value -> r
682+ , Binder -> r
683+ , CaseAlternative -> r
684+ , DoNotationElement -> r)
685+everythingWithContextOnValues s0 r0 (<>) f g h i j = (f'' s0, g'' s0, h'' s0, i'' s0, j'' s0)
686+ where
687+ f'' s d = let (s', r) = f s d in r <> f' s' d
688+
689+ f' s (DataBindingGroupDeclaration ds) = foldl (<>) r0 (map (f'' s) ds)
690+ f' s (ValueDeclaration _ _ bs Nothing val) = foldl (<>) r0 (map (h'' s) bs) <> (g'' s) val
691+ f' s (ValueDeclaration _ _ bs (Just grd) val) = foldl (<>) r0 (map (h'' s) bs) <> (g'' s) grd <> (g'' s) val
692+ f' s (BindingGroupDeclaration ds) = foldl (<>) r0 (map (\(_, _, val) -> (g'' s) val) ds)
693+ f' s (TypeClassDeclaration _ _ _ ds) = foldl (<>) r0 (map (f'' s) ds)
694+ f' s (TypeInstanceDeclaration _ _ _ _ ds) = foldl (<>) r0 (map (f'' s) ds)
695+ f' s (PositionedDeclaration _ d1) = (f'' s) d1
696+ f' _ _ = r0
697+
698+ g'' s v = let (s', r) = g s v in r <> g' s' v
699+
700+ g' s (UnaryMinus v1) = (g'' s) v1
701+ g' s (BinaryNoParens _ v1 v2) = (g'' s) v1 <> (g'' s) v2
702+ g' s (Parens v1) = (g'' s) v1
703+ g' s (ArrayLiteral vs) = foldl (<>) r0 (map (g'' s) vs)
704+ g' s (ObjectLiteral vs) = foldl (<>) r0 (map (g'' s . snd) vs)
705+ g' s (Accessor _ v1) = (g'' s) v1
706+ g' s (ObjectUpdate obj vs) = foldl (<>) ((g'' s) obj) (map (g'' s . snd) vs)
707+ g' s (Abs _ v1) = (g'' s) v1
708+ g' s (App v1 v2) = (g'' s) v1 <> (g'' s) v2
709+ g' s (IfThenElse v1 v2 v3) = (g'' s) v1 <> (g'' s) v2 <> (g'' s) v3
710+ g' s (Case vs alts) = foldl (<>) (foldl (<>) r0 (map (g'' s) vs)) (map (i'' s) alts)
711+ g' s (TypedValue _ v1 _) = (g'' s) v1
712+ g' s (Let ds v1) = (foldl (<>) r0 (map (f'' s) ds)) <> (g'' s) v1
713+ g' s (Do es) = foldl (<>) r0 (map (j'' s) es)
714+ g' s (PositionedValue _ v1) = (g'' s) v1
715+ g' _ _ = r0
716+
717+ h'' s b = let (s', r) = h s b in r <> h' s' b
718+
719+ h' s (ConstructorBinder _ bs) = foldl (<>) r0 (map (h'' s) bs)
720+ h' s (ObjectBinder bs) = foldl (<>) r0 (map (h'' s . snd) bs)
721+ h' s (ArrayBinder bs) = foldl (<>) r0 (map (h'' s) bs)
722+ h' s (ConsBinder b1 b2) = (h'' s) b1 <> (h'' s) b2
723+ h' s (NamedBinder _ b1) = (h'' s) b1
724+ h' s (PositionedBinder _ b1) = (h'' s) b1
725+ h' _ _ = r0
726+
727+ i'' s ca = let (s', r) = i s ca in r <> i' s' ca
728+
729+ i' s (CaseAlternative bs Nothing val) = foldl (<>) r0 (map (h'' s) bs) <> (g'' s) val
730+ i' s (CaseAlternative bs (Just grd) val) = foldl (<>) r0 (map (h'' s) bs) <> (g'' s) grd <> (g'' s) val
731+
732+ j'' s e = let (s', r) = j s e in r <> j' s' e
733+
734+ j' s (DoNotationValue v) = (g'' s) v
735+ j' s (DoNotationBind b v) = (h'' s) b <> (g'' s) v
736+ j' s (DoNotationLet ds) = foldl (<>) r0 (map (f'' s) ds)
737+ j' s (PositionedDoNotationElement _ e1) = (j'' s) e1
738+
671739accumTypes :: (Monoid r) => (Type -> r) -> (Declaration -> r, Value -> r, Binder -> r, CaseAlternative -> r, DoNotationElement -> r)
672740accumTypes f = everythingOnValues mappend forDecls forValues (const mempty) (const mempty) (const mempty)
673741 where
@@ -686,4 +754,3 @@ accumTypes f = everythingOnValues mappend forDecls forValues (const mempty) (con
686754 forValues _ = mempty
687755
688756
689−