@@ -43,8 +43,11 @@ module Language.PureScript.TypeChecker.Types (
44import Data.List
44import Data.List
45import Data.Maybe (maybeToList, isNothing, isJust, fromMaybe)
45import Data.Maybe (maybeToList, isNothing, isJust, fromMaybe)
46+import Data.Function (on)
47+import Data.Ord (comparing)
46import Data.Generics
49import Data.Generics
47− (everythingWithContext, mkM, something, mkQ)
50+ (everythingWithContext, mkM, mkQ)
48import Data.Generics.Extras
51import Data.Generics.Extras
50import Language.PureScript.Declarations
53import Language.PureScript.Declarations
@@ -69,9 +72,6 @@ import Control.Arrow (Arrow(..))
70import qualified Data.Map as M
73import qualified Data.Map as M
71import qualified Data.HashMap.Strict as H
74import qualified Data.HashMap.Strict as H
72−import Data.Function (on)
73−import Data.Ord (comparing)
74−import Data.Monoid ((<>))
76instance Partial Type where
76instance Partial Type where
77 unknown = TUnknown
77 unknown = TUnknown
@@ -478,10 +478,12 @@ skolemEscapeCheck root@TypedValue{} =
478 collect _ = []
478 collect _ = []
479 go _ scos = ([], scos)
479 go _ scos = ([], scos)
480 findBindingScope :: SkolemScope -> Maybe Value
480 findBindingScope :: SkolemScope -> Maybe Value
481− findBindingScope sco = something (mkQ Nothing go') root
481+ findBindingScope sco =
482+ let (_, f, _, _, _) = everythingOnValues mappend (const mempty) go' (const mempty) (const mempty) (const mempty)
483+ in getFirst $ f root
483− go' val@(TypedValue _ _ (ForAll _ _ (Just sco'))) | sco == sco' = Just val
485+ go' val@(TypedValue _ _ (ForAll _ _ (Just sco'))) | sco == sco' = First (Just val)
484− go' _ = Nothing
486+ go' _ = mempty
485skolemEscapeCheck val = throwError $ mkErrorStack "Untyped value passed to skolemEscapeCheck" (Just (ValueError val))
487skolemEscapeCheck val = throwError $ mkErrorStack "Untyped value passed to skolemEscapeCheck" (Just (ValueError val))