git.iko.soy/rowtype-yoga/purescript-native
on golang help sign in
Allow overlapping instances from module imports, fix tests
571af15Phil Freeman
examples/passing/Do.purs+9
compare with golang
unifiedsplit
@@ -4,6 +4,15 @@ import Prelude
4
4
5data Maybe a = Nothing | Just a
5data Maybe a = Nothing | Just a
6
6
7+instance functorMaybe :: Functor Maybe where
8+ (<$>) f Nothing = Nothing
9+ (<$>) f (Just x) = Just (f x)
10+
11+instance applicativeMaybe :: Applicative Maybe where
12+ pure = Just
13+ (<*>) (Just f) (Just x) = Just (f x)
14+ (<*>) _ _ = Nothing
15+
7instance monadMaybe :: Prelude.Monad Maybe where
16instance monadMaybe :: Prelude.Monad Maybe where
8 return = Just
17 return = Just
9 (>>=) Nothing _ = Nothing
18 (>>=) Nothing _ = Nothing
examples/passing/Operators.purs−1
@@ -1,6 +1,5 @@
1module Main where
1module Main where
2
2
3− import Prelude
4 import Control.Monad.Eff
3 import Control.Monad.Eff
5 import Debug.Trace
4 import Debug.Trace
6
5
src/Language/PureScript/TypeChecker/Types.hs+31−7
@@ -266,15 +266,34 @@ replaceTypeClassDictionaries mn = everywhereM' (mkM go)
266 entails env mn dicts constraint
266 entails env mn dicts constraint
267 go other = return other
267 go other = return other
268
268
269+-- |
270+-- A simplified representation of expressions which are used to represent type
271+-- class dictionaries at runtime, which can be compared for equality
272+--
273+data DictionaryValue
274+ -- |
275+ -- A dictionary which is brought into scope by a local constraint
276+ --
277+ = LocalDictionaryValue (Qualified Ident)
278+ -- |
279+ -- A dictionary which is brought into scope by an instance declaration
280+ --
281+ | GlobalDictionaryValue (Qualified Ident)
282+ -- |
283+ -- A dictionary which depends on other dictionaries
284+ --
285+ | DependentDictionaryValue (Qualified Ident) [DictionaryValue]
286+ deriving (Show, Eq)
287+
269-- |
288-- |
270-- Check that the current set of type class dictionaries entail the specified type class goal, and, if so,
289-- Check that the current set of type class dictionaries entail the specified type class goal, and, if so,
271-- return a type class dictionary reference.
290-- return a type class dictionary reference.
272--
291--
273entails :: Environment -> ModuleName -> [TypeClassDictionaryInScope] -> (Qualified ProperName, [Type]) -> Check Value
292entails :: Environment -> ModuleName -> [TypeClassDictionaryInScope] -> (Qualified ProperName, [Type]) -> Check Value
274entails env moduleName context goal@(className, tys) = do
293entails env moduleName context goal@(className, tys) = do
275− case go goal of
294+ case nub (go goal) of
276 [] -> throwError . strMsg $ "No instance found for " ++ show className ++ " " ++ unwords (map prettyPrintTypeAtom tys)
295 [] -> throwError . strMsg $ "No instance found for " ++ show className ++ " " ++ unwords (map prettyPrintTypeAtom tys)
277− [dict] -> return dict
296+ [dict] -> return (dictionaryValueToValue dict)
278 _ -> throwError . strMsg $ "Overlapping instances found for " ++ show className ++ " " ++ unwords (map prettyPrintTypeAtom tys)
297 _ -> throwError . strMsg $ "Overlapping instances found for " ++ show className ++ " " ++ unwords (map prettyPrintTypeAtom tys)
279 where
298 where
280 go (className', tys') =
299 go (className', tys') =
@@ -291,16 +310,21 @@ entails env moduleName context goal@(className, tys) = do
291 -- Create dictionaries for subgoals which still need to be solved by calling go recursively
310 -- Create dictionaries for subgoals which still need to be solved by calling go recursively
292 -- E.g. the goal (Show a, Show b) => Show (Either a b) can be satisfied if the current type
311 -- E.g. the goal (Show a, Show b) => Show (Either a b) can be satisfied if the current type
293 -- unifies with Either a b, and we can satisfy the subgoals Show a and Show b recursively.
312 -- unifies with Either a b, and we can satisfy the subgoals Show a and Show b recursively.
294− solveSubgoals :: [(String, Type)] -> Maybe [(Qualified ProperName, [Type])] -> [Maybe [Value]]
313+ solveSubgoals :: [(String, Type)] -> Maybe [(Qualified ProperName, [Type])] -> [Maybe [DictionaryValue]]
295 solveSubgoals _ Nothing = return Nothing
314 solveSubgoals _ Nothing = return Nothing
296 solveSubgoals subst (Just subgoals) = do
315 solveSubgoals subst (Just subgoals) = do
297 dict <- mapM (go . second (map (replaceAllTypeVars subst))) subgoals
316 dict <- mapM (go . second (map (replaceAllTypeVars subst))) subgoals
298 return $ Just dict
317 return $ Just dict
299 -- Make a dictionary from subgoal dictionaries by applying the correct function
318 -- Make a dictionary from subgoal dictionaries by applying the correct function
300− mkDictionary :: Qualified Ident -> Maybe [Value] -> Value
319+ mkDictionary :: Qualified Ident -> Maybe [DictionaryValue] -> DictionaryValue
301− mkDictionary fnName Nothing = Var fnName
320+ mkDictionary fnName Nothing = LocalDictionaryValue fnName
302− mkDictionary fnName (Just []) = App (Var fnName) (ObjectLiteral [])
321+ mkDictionary fnName (Just []) = GlobalDictionaryValue fnName
322+ mkDictionary fnName (Just dicts) = DependentDictionaryValue fnName dicts
323+ -- Turn a DictionaryValue into a Value
324+ dictionaryValueToValue :: DictionaryValue -> Value
325+ dictionaryValueToValue (LocalDictionaryValue fnName) = Var fnName
326+ dictionaryValueToValue (GlobalDictionaryValue fnName) = App (Var fnName) (ObjectLiteral [])
303− mkDictionary fnName (Just dicts) = foldl App (Var fnName) dicts
327+ dictionaryValueToValue (DependentDictionaryValue fnName dicts) = foldl App (Var fnName) (map dictionaryValueToValue dicts)
304 -- Filter out type dictionaries which are in scope in the current module
328 -- Filter out type dictionaries which are in scope in the current module
305 filterModule :: TypeClassDictionaryInScope -> Bool
329 filterModule :: TypeClassDictionaryInScope -> Bool
306 filterModule (TypeClassDictionaryInScope { tcdName = Qualified (Just mn) _ }) | mn == moduleName = True
330 filterModule (TypeClassDictionaryInScope { tcdName = Qualified (Just mn) _ }) | mn == moduleName = True