git.iko.soy/rowtype-yoga/purescript-native
on golang help sign in
Merge pull request #1934 from purescript/202
8847b66Phil Freeman
examples/failing/ConstraintInference.pursnew file+10
compare with golang
unifiedsplit
@@ -0,0 +1,10 @@
1+-- @shouldFailWith NoInstanceFound
2+
3+module Main where
4+
5+import Prelude
6+
7+spin :: forall a b. a -> b
8+spin x = spin x
9+
10+test = show <<< spin
examples/passing/ConstraintInference.pursnew file+7
@@ -0,0 +1,7 @@
1+module Main where
2+
3+import Prelude
4+
5+shout = Control.Monad.Eff.Console.log <<< (<> "!") <<< show
6+
7+main = shout "Done"
examples/passing/ContextSimplification.pursnew file+13
@@ -0,0 +1,13 @@
1+module Main where
2+
3+import Prelude
4+import Control.Monad.Eff.Console
5+
6+shout = log <<< (<> "!") <<< show
7+
8+-- Here, we should simplify the context so that only one Show
9+-- constraint is added.
10+usesShowTwice true = shout
11+usesShowTwice false = print
12+
13+main = usesShowTwice true "Done"
examples/passing/MonadState.purs+32−19
@@ -1,12 +1,16 @@
1module Main where
1module Main where
2
2
3import Prelude
3import Prelude
4+import Control.Monad.Eff.Console
4
5
5data Tuple a b = Tuple a b
6data Tuple a b = Tuple a b
6
7
8+instance showTuple :: (Show a, Show b) => Show (Tuple a b) where
9+ show (Tuple a b) = "(" <> show a <> ", " <> show b <> ")"
10+
7−class MonadState s m where
11+class Monad m <= MonadState s m where
8 get :: m s
12 get :: m s
9− put :: s -> m {}
13+ put :: s -> m Unit
10
14
11data State s a = State (s -> Tuple s a)
15data State s a = State (s -> Tuple s a)
12
16
@@ -29,20 +33,29 @@ instance monadState :: Monad (State s)
29
33
30instance monadStateState :: MonadState s (State s) where
34instance monadStateState :: MonadState s (State s) where
31 get = State (\s -> Tuple s s)
35 get = State (\s -> Tuple s s)
32− put s = State (\_ -> Tuple s {})
36+ put s = State (\_ -> Tuple s unit)
33−
37+
38+-- Without the call to same, the following strange (but correct, in the absence of
39+-- functional dependencies) type:
40+--
41+-- forall m t1 t2.
42+-- ( Bind m
43+-- , MonadState t1 m
44+-- , MonadState t2 m
45+-- ) => (t1 -> t2) -> m Unit
46+--
47+-- With the type hint, the inferred type is more sensible:
48+--
49+-- forall m t.
50+-- ( Bind m
34−modify :: forall m s. (Prelude.Monad m, MonadState s m) => (s -> s) -> m {}
51+-- , MonadState t m
52+-- ) => (t -> t) -> m Unit
35−modify f = do
53+modify f =
54+ do
36− s <- get
55+ s <- get
37− put (f s)
56+ put (same f s)
38−
57+ where
39−test :: Tuple String String
58+ same :: forall a. (a -> a) -> (a -> a)
40−test = runState "" $ do
59+ same = id
41− modify $ (++) "World!"
60+
42− modify $ (++) "Hello, "
61+main = print $ runState 0 (modify (+ 1))
43− get
44−
45−main = do
46− let t1 = test
47− Control.Monad.Eff.Console.log "Done"
48−
src/Language/PureScript/TypeChecker/Entailment.hs+81−32
@@ -4,7 +4,7 @@
4-- |
4-- |
5-- Type class entailment
5-- Type class entailment
6--
6--
7−module Language.PureScript.TypeChecker.Entailment (entails) where
7+module Language.PureScript.TypeChecker.Entailment (Context, replaceTypeClassDictionaries) where
8
8
9import Prelude ()
9import Prelude ()
10import Prelude.Compat
10import Prelude.Compat
@@ -16,8 +16,9 @@ import qualified Data.Map as M
16
16
17import Control.Arrow (Arrow(..))
17import Control.Arrow (Arrow(..))
18import Control.Monad.State
18import Control.Monad.State
19+import Control.Monad.Writer
19import Control.Monad.Error.Class (MonadError(..))
20import Control.Monad.Error.Class (MonadError(..))
20−import Control.Monad.Writer.Class (MonadWriter(..))
21+import Control.Monad.Supply.Class (MonadSupply(..))
21
22
22import Language.PureScript.Crash
23import Language.PureScript.Crash
23import Language.PureScript.AST
24import Language.PureScript.AST
@@ -28,22 +29,47 @@ import Language.PureScript.TypeClassDictionaries
28import Language.PureScript.Types
29import Language.PureScript.Types
29import qualified Language.PureScript.Constants as C
30import qualified Language.PureScript.Constants as C
30
31
32+-- | The 'Context' tracks those constraints which can be satisfied.
33+type Context = M.Map (Maybe ModuleName)
34+ (M.Map (Qualified (ProperName 'ClassName))
35+ (M.Map (Qualified Ident)
36+ TypeClassDictionaryInScope))
37+
38+-- | Merge two type class contexts
39+combineContexts :: Context -> Context -> Context
40+combineContexts = M.unionWith (M.unionWith M.union)
41+
42+-- | Replace type class dictionary placeholders with inferred type class dictionaries
43+replaceTypeClassDictionaries
44+ :: (MonadError MultipleErrors m, MonadWriter MultipleErrors m, MonadSupply m)
45+ => Bool
46+ -> ModuleName
47+ -> Expr
48+ -> m (Expr, [(Ident, Constraint)])
49+replaceTypeClassDictionaries shouldGeneralize mn =
50+ let (_, f, _) = everywhereOnValuesTopDownM return (WriterT . go) return
51+ in flip evalStateT M.empty . runWriterT . f
52+ where
53+ go (TypeClassDictionary constraint dicts) = entails shouldGeneralize mn dicts constraint
54+ go other = return (other, [])
55+
31-- |
56-- |
32-- Check that the current set of type class dictionaries entail the specified type class goal, and, if so,
57-- Check that the current set of type class dictionaries entail the specified type class goal, and, if so,
33-- return a type class dictionary reference.
58-- return a type class dictionary reference.
34--
59--
35entails
60entails
36 :: forall m
61 :: forall m
37− . (MonadError MultipleErrors m, MonadWriter MultipleErrors m)
62+ . (MonadError MultipleErrors m, MonadWriter MultipleErrors m, MonadSupply m)
38− => ModuleName
63+ => Bool
39− -> M.Map (Maybe ModuleName) (M.Map (Qualified (ProperName 'ClassName)) (M.Map (Qualified Ident) TypeClassDictionaryInScope))
64+ -> ModuleName
65+ -> Context
40 -> Constraint
66 -> Constraint
41− -> m Expr
67+ -> StateT Context m (Expr, [(Ident, Constraint)])
42−entails moduleName context = solve
68+entails shouldGeneralize moduleName context = solve
43 where
69 where
44− forClassName :: Qualified (ProperName 'ClassName) -> [Type] -> [TypeClassDictionaryInScope]
70+ forClassName :: Context -> Qualified (ProperName 'ClassName) -> [Type] -> [TypeClassDictionaryInScope]
45− forClassName cn@(Qualified (Just mn) _) tys = concatMap (findDicts cn) (Nothing : Just mn : map Just (mapMaybe ctorModules tys))
71+ forClassName ctx cn@(Qualified (Just mn) _) tys = concatMap (findDicts ctx cn) (Nothing : Just mn : map Just (mapMaybe ctorModules tys))
46− forClassName _ _ = internalError "forClassName: expected qualified class name"
72+ forClassName _ _ _ = internalError "forClassName: expected qualified class name"
47
73
48 ctorModules :: Type -> Maybe ModuleName
74 ctorModules :: Type -> Maybe ModuleName
49 ctorModules (TypeConstructor (Qualified (Just mn) _)) = Just mn
75 ctorModules (TypeConstructor (Qualified (Just mn) _)) = Just mn
@@ -51,37 +77,58 @@ entails moduleName context = solve
51 ctorModules (TypeApp ty _) = ctorModules ty
77 ctorModules (TypeApp ty _) = ctorModules ty
52 ctorModules _ = Nothing
78 ctorModules _ = Nothing
53
79
54− findDicts :: Qualified (ProperName 'ClassName) -> Maybe ModuleName -> [TypeClassDictionaryInScope]
80+ findDicts :: Context -> Qualified (ProperName 'ClassName) -> Maybe ModuleName -> [TypeClassDictionaryInScope]
55− findDicts cn = maybe [] M.elems . (>>= M.lookup cn) . flip M.lookup context
81+ findDicts ctx cn = maybe [] M.elems . (>>= M.lookup cn) . flip M.lookup ctx
56
82
57− solve :: Constraint -> m Expr
83+ solve :: Constraint -> StateT Context m (Expr, [(Ident, Constraint)])
58 solve (className, tys) = do
84 solve (className, tys) = do
59− dict <- go 0 className tys
85+ (dict, unsolved) <- go 0 className tys
60− return $ dictionaryValueToValue dict
86+ return (dictionaryValueToValue dict, unsolved)
61 where
87 where
62− go :: Int -> Qualified (ProperName 'ClassName) -> [Type] -> m DictionaryValue
88+ go :: Int -> Qualified (ProperName 'ClassName) -> [Type] -> StateT Context m (DictionaryValue, [(Ident, Constraint)])
63 go work className' tys' | work > 1000 = throwError . errorMessage $ PossiblyInfiniteInstance className' tys'
89 go work className' tys' | work > 1000 = throwError . errorMessage $ PossiblyInfiniteInstance className' tys'
64 go work className' tys' = do
90 go work className' tys' = do
91+ -- Get the inferred constraint context so far, and merge it with the global context
92+ inferred <- get
65 let instances = do
93 let instances = do
66− tcd <- forClassName className' tys'
94+ tcd <- forClassName (combineContexts context inferred) className' tys'
67 -- Make sure the type unifies with the type in the type instance definition
95 -- Make sure the type unifies with the type in the type instance definition
68 subst <- maybeToList . (>>= verifySubstitution) . fmap concat $ zipWithM (typeHeadsAreEqual moduleName) tys' (tcdInstanceTypes tcd)
96 subst <- maybeToList . (>>= verifySubstitution) . fmap concat $ zipWithM (typeHeadsAreEqual moduleName) tys' (tcdInstanceTypes tcd)
69 return (subst, tcd)
97 return (subst, tcd)
70− (subst, tcd) <- unique instances
98+ solution <- lift $ unique instances
99+ case solution of
100+ Left (subst, tcd) -> do
71− -- Solve any necessary subgoals
101+ -- Solve any necessary subgoals
72− args <- solveSubgoals subst (tcdDependencies tcd)
102+ (args, unsolved) <- solveSubgoals subst (tcdDependencies tcd)
73− return $ foldr (\(superclassName, index) dict -> SubclassDictionaryValue dict superclassName index)
103+ let match = foldr (\(superclassName, index) dict -> SubclassDictionaryValue dict superclassName index)
74− (mkDictionary (tcdName tcd) args)
104+ (mkDictionary (tcdName tcd) args)
75− (tcdPath tcd)
105+ (tcdPath tcd)
106+ return (match, unsolved)
107+ Right unsolved@(unsolvedClassName@(Qualified _ pn), unsolvedTys) -> do
108+ -- Generate a fresh name for the unsolved constraint's new dictionary
109+ ident <- freshIdent ("dict" ++ runProperName pn)
110+ let qident = Qualified Nothing ident
111+ -- Store the new dictionary in the Context so that we can solve this goal in
112+ -- future.
113+ let newDict = TypeClassDictionaryInScope qident [] unsolvedClassName unsolvedTys Nothing
114+ newContext = M.singleton Nothing (M.singleton unsolvedClassName (M.singleton qident newDict))
115+ modify (combineContexts newContext)
116+ return (LocalDictionaryValue qident, [(ident, unsolved)])
76 where
117 where
77
118
78− unique :: [(a, TypeClassDictionaryInScope)] -> m (a, TypeClassDictionaryInScope)
119+ unique :: [(a, TypeClassDictionaryInScope)] -> m (Either (a, TypeClassDictionaryInScope) Constraint)
120+ unique [] | shouldGeneralize && all canBeGeneralized tys' = return $ Right (className, tys)
79− unique [] = throwError . errorMessage $ NoInstanceFound className' tys'
121+ | otherwise = throwError . errorMessage $ NoInstanceFound className' tys'
80− unique [a] = return a
122+ unique [a] = return $ Left a
81 unique tcds | pairwise overlapping (map snd tcds) = do
123 unique tcds | pairwise overlapping (map snd tcds) = do
82 tell . errorMessage $ OverlappingInstances className' tys' (map (tcdName . snd) tcds)
124 tell . errorMessage $ OverlappingInstances className' tys' (map (tcdName . snd) tcds)
83− return (head tcds)
125+ return $ Left (head tcds)
84− | otherwise = return (minimumBy (compare `on` length . tcdPath . snd) tcds)
126+ | otherwise = return $ Left (minimumBy (compare `on` length . tcdPath . snd) tcds)
127+
128+ canBeGeneralized :: Type -> Bool
129+ canBeGeneralized TUnknown{} = True
130+ canBeGeneralized Skolem{} = True
131+ canBeGeneralized _ = False
85
132
86 -- |
133 -- |
87 -- Check if two dictionaries are overlapping
134 -- Check if two dictionaries are overlapping
@@ -98,11 +145,12 @@ entails moduleName context = solve
98 -- Create dictionaries for subgoals which still need to be solved by calling go recursively
145 -- Create dictionaries for subgoals which still need to be solved by calling go recursively
99 -- E.g. the goal (Show a, Show b) => Show (Either a b) can be satisfied if the current type
146 -- E.g. the goal (Show a, Show b) => Show (Either a b) can be satisfied if the current type
100 -- unifies with Either a b, and we can satisfy the subgoals Show a and Show b recursively.
147 -- unifies with Either a b, and we can satisfy the subgoals Show a and Show b recursively.
101− solveSubgoals :: [(String, Type)] -> Maybe [Constraint] -> m (Maybe [DictionaryValue])
148+ solveSubgoals :: [(String, Type)] -> Maybe [Constraint] -> StateT Context m (Maybe [DictionaryValue], [(Ident, Constraint)])
102− solveSubgoals _ Nothing = return Nothing
149+ solveSubgoals _ Nothing = return (Nothing, [])
103 solveSubgoals subst (Just subgoals) = do
150 solveSubgoals subst (Just subgoals) = do
104− dict <- traverse (uncurry (go (work + 1)) . second (map (replaceAllTypeVars subst))) subgoals
151+ zipped <- traverse (uncurry (go (work + 1)) . second (map (replaceAllTypeVars subst))) subgoals
152+ let (dicts, unsolved) = unzip zipped
105− return $ Just dict
153+ return (Just dicts, concat unsolved)
106
154
107 -- Make a dictionary from subgoal dictionaries by applying the correct function
155 -- Make a dictionary from subgoal dictionaries by applying the correct function
108 mkDictionary :: Qualified Ident -> Maybe [DictionaryValue] -> DictionaryValue
156 mkDictionary :: Qualified Ident -> Maybe [DictionaryValue] -> DictionaryValue
@@ -134,6 +182,7 @@ entails moduleName context = solve
134-- and return a substitution from type variables to types which makes the type heads unify.
182-- and return a substitution from type variables to types which makes the type heads unify.
135--
183--
136typeHeadsAreEqual :: ModuleName -> Type -> Type -> Maybe [(String, Type)]
184typeHeadsAreEqual :: ModuleName -> Type -> Type -> Maybe [(String, Type)]
185+typeHeadsAreEqual _ (TUnknown u1) (TUnknown u2) | u1 == u2 = Just []
137typeHeadsAreEqual _ (Skolem _ s1 _ _) (Skolem _ s2 _ _) | s1 == s2 = Just []
186typeHeadsAreEqual _ (Skolem _ s1 _ _) (Skolem _ s2 _ _) | s1 == s2 = Just []
138typeHeadsAreEqual _ t (TypeVar v) = Just [(v, t)]
187typeHeadsAreEqual _ t (TypeVar v) = Just [(v, t)]
139typeHeadsAreEqual _ (TypeConstructor c1) (TypeConstructor c2) | c1 == c2 = Just []
188typeHeadsAreEqual _ (TypeConstructor c1) (TypeConstructor c2) | c1 == c2 = Just []
src/Language/PureScript/TypeChecker/Types.hs+26−25
@@ -2,6 +2,7 @@
2{-# LANGUAGE ScopedTypeVariables #-}
2{-# LANGUAGE ScopedTypeVariables #-}
3{-# LANGUAGE MultiParamTypeClasses #-}
3{-# LANGUAGE MultiParamTypeClasses #-}
4{-# LANGUAGE OverloadedStrings #-}
4{-# LANGUAGE OverloadedStrings #-}
5+{-# LANGUAGE TupleSections #-}
5
6
6-- |
7-- |
7-- This module implements the type checker
8-- This module implements the type checker
@@ -69,23 +70,38 @@ typesOf moduleName vals = do
69 tys <- fmap tidyUp . liftUnifyWarnings replace $ do
70 tys <- fmap tidyUp . liftUnifyWarnings replace $ do
70 (untyped, typed, dict, untypedDict) <- typeDictionaryForBindingGroup moduleName vals
71 (untyped, typed, dict, untypedDict) <- typeDictionaryForBindingGroup moduleName vals
71 ds1 <- parU typed $ \e -> checkTypedBindingGroupElement moduleName e dict
72 ds1 <- parU typed $ \e -> checkTypedBindingGroupElement moduleName e dict
72− ds2 <- forM untyped $ \e -> typeForBindingGroupElement True e dict untypedDict
73+ ds2 <- forM untyped $ \e -> typeForBindingGroupElement e dict untypedDict
73− return $ ds1 ++ ds2
74+ return (map (\x -> (False, x)) ds1 ++ map (\x -> (True, x)) ds2)
74
75
75− forM tys $ \(ident, (val, ty)) -> do
76+ forM tys $ \(shouldGeneralize, (ident, (val, ty))) -> do
76 -- Replace type class dictionary placeholders with actual dictionaries
77 -- Replace type class dictionary placeholders with actual dictionaries
77− val' <- replaceTypeClassDictionaries moduleName val
78+ (val', unsolved) <- replaceTypeClassDictionaries shouldGeneralize moduleName val
79+ let unsolvedTypeVars = nub $ unknownsInType ty
80+ -- Generalize and constrain the type
81+ let generalized = generalize unsolved ty
82+ -- Make sure any unsolved type constraints only use type variables which appear
83+ -- unknown in the inferred type.
84+ when shouldGeneralize $ do
85+ tell . errorMessage $ MissingTypeDeclaration ident generalized
86+ forM_ unsolved $ \(_, (className, classTys)) -> do
87+ let constraintTypeVars = nub $ foldMap unknownsInType classTys
88+ when (any (`notElem` unsolvedTypeVars) constraintTypeVars) $
89+ throwError . errorMessage $ NoInstanceFound className classTys
78 -- Check skolem variables did not escape their scope
90 -- Check skolem variables did not escape their scope
79 skolemEscapeCheck val'
91 skolemEscapeCheck val'
80 -- Check rows do not contain duplicate labels
92 -- Check rows do not contain duplicate labels
81 checkDuplicateLabels val'
93 checkDuplicateLabels val'
82− return (ident, (val', varIfUnknown ty))
94+ return (ident, (foldr (Abs . Left . fst) val' unsolved, generalized))
83 where
95 where
96+ -- | Generalize type vars using forall and add inferred constraints
97+ generalize unsolved = varIfUnknown . constrain unsolved
98+ -- | Add any unsolved constraints
99+ constrain [] = id
100+ constrain cs = ConstrainedType (map snd cs)
84 -- Apply the substitution that was returned from runUnify to both types and (type-annotated) values
101 -- Apply the substitution that was returned from runUnify to both types and (type-annotated) values
85− tidyUp (ts, sub) = map (\(i, (val, ty)) -> (i, (overTypes (substituteType sub) val, substituteType sub ty))) ts
102+ tidyUp (ts, sub) = map (\(b, (i, (val, ty))) -> (b, (i, (overTypes (substituteType sub) val, substituteType sub ty)))) ts
86 -- Replace all the wildcards types with their inferred types
103 -- Replace all the wildcards types with their inferred types
87 replace sub (ErrorMessage hints (WildcardInferredType ty)) = ErrorMessage hints . WildcardInferredType $ substituteType sub ty
104 replace sub (ErrorMessage hints (WildcardInferredType ty)) = ErrorMessage hints . WildcardInferredType $ substituteType sub ty
88− replace sub (ErrorMessage hints (MissingTypeDeclaration name ty)) = ErrorMessage hints $ MissingTypeDeclaration name (varIfUnknown (substituteType sub ty))
89 replace _ em = em
105 replace _ em = em
90
106
91type TypeData = M.Map (ModuleName, Ident) (Type, NameKind, NameVisibility)
107type TypeData = M.Map (ModuleName, Ident) (Type, NameKind, NameVisibility)
@@ -138,16 +154,14 @@ checkTypedBindingGroupElement mn (ident, (val', ty, checkType)) dict = do
138
154
139typeForBindingGroupElement ::
155typeForBindingGroupElement ::
140 (MonadSupply m, MonadState CheckState m, MonadError MultipleErrors m, MonadWriter MultipleErrors m) =>
156 (MonadSupply m, MonadState CheckState m, MonadError MultipleErrors m, MonadWriter MultipleErrors m) =>
141− Bool ->
142 (Ident, Expr) ->
157 (Ident, Expr) ->
143 TypeData ->
158 TypeData ->
144 UntypedData ->
159 UntypedData ->
145 m (Ident, (Expr, Type))
160 m (Ident, (Expr, Type))
146−typeForBindingGroupElement warn (ident, val) dict untypedDict = do
161+typeForBindingGroupElement (ident, val) dict untypedDict = do
147 -- Infer the type with the new names in scope
162 -- Infer the type with the new names in scope
148 TypedValue _ val' ty <- bindNames dict $ infer val
163 TypedValue _ val' ty <- bindNames dict $ infer val
149 unifyTypes ty $ fromMaybe (internalError "name not found in dictionary") (lookup ident untypedDict)
164 unifyTypes ty $ fromMaybe (internalError "name not found in dictionary") (lookup ident untypedDict)
150− when warn . tell . errorMessage $ MissingTypeDeclaration ident ty
151 return (ident, (TypedValue True val' ty, ty))
165 return (ident, (TypedValue True val' ty, ty))
152
166
153-- | Check if a value contains a type annotation
167-- | Check if a value contains a type annotation
@@ -165,20 +179,7 @@ overTypes f = let (_, f', _) = everywhereOnValues id g id in f'
165 g (TypedValue checkTy val t) = TypedValue checkTy val (f t)
179 g (TypedValue checkTy val t) = TypedValue checkTy val (f t)
166 g (TypeClassDictionary (nm, tys) sco) = TypeClassDictionary (nm, map f tys) sco
180 g (TypeClassDictionary (nm, tys) sco) = TypeClassDictionary (nm, map f tys) sco
167 g other = other
181 g other = other
168−
182+
169−-- | Replace type class dictionary placeholders with inferred type class dictionaries
170−replaceTypeClassDictionaries ::
171− (MonadError MultipleErrors m, MonadWriter MultipleErrors m) =>
172− ModuleName ->
173− Expr ->
174− m Expr
175−replaceTypeClassDictionaries mn =
176− let (_, f, _) = everywhereOnValuesTopDownM return go return
177− in f
178− where
179− go (TypeClassDictionary constraint dicts) = entails mn dicts constraint
180− go other = return other
181−
182-- | Check the kind of a type, failing if it is not of kind *.
183-- | Check the kind of a type, failing if it is not of kind *.
183checkTypeKind ::
184checkTypeKind ::
184 (MonadState CheckState m, MonadError MultipleErrors m) =>
185 (MonadState CheckState m, MonadError MultipleErrors m) =>
@@ -329,7 +330,7 @@ inferLetBinding seen (BindingGroupDeclaration ds : rest) ret j = do
329 Just moduleName <- checkCurrentModule <$> get
330 Just moduleName <- checkCurrentModule <$> get
330 (untyped, typed, dict, untypedDict) <- typeDictionaryForBindingGroup moduleName (map (\(i, _, v) -> (i, v)) ds)
331 (untyped, typed, dict, untypedDict) <- typeDictionaryForBindingGroup moduleName (map (\(i, _, v) -> (i, v)) ds)
331 ds1' <- parU typed $ \e -> checkTypedBindingGroupElement moduleName e dict
332 ds1' <- parU typed $ \e -> checkTypedBindingGroupElement moduleName e dict
332− ds2' <- forM untyped $ \e -> typeForBindingGroupElement False e dict untypedDict
333+ ds2' <- forM untyped $ \e -> typeForBindingGroupElement e dict untypedDict
333 let ds' = [(ident, Private, val') | (ident, (val', _)) <- ds1' ++ ds2']
334 let ds' = [(ident, Private, val') | (ident, (val', _)) <- ds1' ++ ds2']
334 bindNames dict $ do
335 bindNames dict $ do
335 makeBindingGroupVisible
336 makeBindingGroupVisible
src/Language/PureScript/TypeChecker/Unify.hs+1
@@ -23,6 +23,7 @@ module Language.PureScript.TypeChecker.Unify (
23 freshType,
23 freshType,
24 solveType,
24 solveType,
25 substituteType,
25 substituteType,
26+ unknownsInType,
26 unifyTypes,
27 unifyTypes,
27 unifyRows,
28 unifyRows,
28 unifiesWith,
29 unifiesWith,