purescript 0.4.14 → 0.4.15

raw patch · 4 files changed

+58/−20 lines, 4 files

Files

• prelude/prelude.purs +19/−8
• psci/Main.hs +4/−3
• purescript.cabal +1/−1
• src/Language/PureScript/TypeChecker/Types.hs +34/−8

@@ -60,8 +60,8 @@     pure :: forall a. a -> f a     (<*>) :: forall a b. f (a -> b) -> f a -> f b -  instance functorFromApplicative :: (Applicative f) => Functor f where-    (<$>) f a = pure f <*> a+  liftA1 :: forall f a b. (Applicative f) => (a -> b) -> f a -> f b+  liftA1 f a = pure f <*> a    infixl 3 <|> @@ -75,13 +75,17 @@     return :: forall a. a -> m a     (>>=) :: forall a b. m a -> (a -> m b) -> m b -  instance applicativeFromMonad :: (Monad m) => Applicative m where-    pure = return-    (<*>) f a = do-      f' <- f-      a' <- a-      return (f' a')+  liftM1 :: forall m a b. (Monad m) => (a -> b) -> m a -> m b+  liftM1 f a = do+    a' <- a+    return (f a') +  ap :: forall m a b. (Monad m) => m (a -> b) -> m a -> m b+  ap f a = do+    f' <- f+    a' <- a+    return (f' a')+   infixl 7 *   infixl 7 /   infixl 7 %@@ -367,6 +371,13 @@   foreign import runPure "function runPure(f) {\                          \  return f();\                          \}" :: forall a. Pure a -> a++  instance functorEff :: Functor (Eff e) where+    (<$>) = liftA1++  instance applicativeEff :: Applicative (Eff e) where+    pure = return+    (<*>) = ap    instance monadEff :: Monad (Eff e) where     return = retEff

@@ -176,9 +176,10 @@   getDeclName Nothing (P.ValueDeclaration ident _ _ _ _) = Just ident   getDeclName (Just exts) (P.ValueDeclaration ident _ _ _ _) | isExported = Just ident     where-    isExported = flip any exts $ \e -> case e of-      P.ValueRef ident' -> ident == ident'-      _ -> False+    isExported = any exports exts+    exports (P.ValueRef ident') = ident == ident'+    exports (P.PositionedDeclarationRef _ r) = exports r+    exports _ = False   getDeclName exts (P.PositionedDeclaration _ d) = getDeclName exts d   getDeclName _ _ = Nothing   names :: [P.Module] -> [String]

@@ -1,5 +1,5 @@ name: purescript-version: 0.4.14+version: 0.4.15 cabal-version: >=1.8 build-type: Custom license: MIT

@@ -267,14 +267,34 @@   go other = return other  -- |+-- A simplified representation of expressions which are used to represent type+-- class dictionaries at runtime, which can be compared for equality+--+data DictionaryValue +  -- |+  -- A dictionary which is brought into scope by a local constraint+  --+  = LocalDictionaryValue (Qualified Ident)+  -- |+  -- A dictionary which is brought into scope by an instance declaration+  --+  | GlobalDictionaryValue (Qualified Ident)+  -- |+  -- A dictionary which depends on other dictionaries+  --+  | DependentDictionaryValue (Qualified Ident) [DictionaryValue]+  deriving (Show, Eq)++-- | -- Check that the current set of type class dictionaries entail the specified type class goal, and, if so, -- return a type class dictionary reference. -- entails :: Environment -> ModuleName -> [TypeClassDictionaryInScope] -> (Qualified ProperName, [Type]) -> Check Value entails env moduleName context goal@(className, tys) = do-  case go goal of-    [] -> throwError . strMsg $ "No " ++ show className ++ " instance found for " ++ intercalate ", " (map prettyPrintType tys)-    (dict : _) -> return dict+  case nub (go goal) of+    [] -> throwError . strMsg $ "No instance found for " ++ show className ++ " " ++  unwords (map prettyPrintTypeAtom tys)+    [dict] -> return (dictionaryValueToValue dict)+    _ -> throwError . strMsg $ "Overlapping instances found for " ++ show className ++ " " ++ unwords (map prettyPrintTypeAtom tys)   where   go (className', tys') =     [ mkDictionary (canonicalizeDictionary tcd) args@@ -290,16 +310,21 @@   -- Create dictionaries for subgoals which still need to be solved by calling go recursively   -- E.g. the goal (Show a, Show b) => Show (Either a b) can be satisfied if the current type   -- unifies with Either a b, and we can satisfy the subgoals Show a and Show b recursively.-  solveSubgoals :: [(String, Type)] -> Maybe [(Qualified ProperName, [Type])] -> [Maybe [Value]]+  solveSubgoals :: [(String, Type)] -> Maybe [(Qualified ProperName, [Type])] -> [Maybe [DictionaryValue]]   solveSubgoals _ Nothing = return Nothing   solveSubgoals subst (Just subgoals) = do     dict <- mapM (go . second (map (replaceAllTypeVars subst))) subgoals     return $ Just dict   -- Make a dictionary from subgoal dictionaries by applying the correct function-  mkDictionary :: Qualified Ident -> Maybe [Value] -> Value-  mkDictionary fnName Nothing = Var fnName-  mkDictionary fnName (Just []) = App (Var fnName) (ObjectLiteral [])-  mkDictionary fnName (Just dicts) = foldl App (Var fnName) dicts+  mkDictionary :: Qualified Ident -> Maybe [DictionaryValue] -> DictionaryValue+  mkDictionary fnName Nothing = LocalDictionaryValue fnName+  mkDictionary fnName (Just []) = GlobalDictionaryValue fnName+  mkDictionary fnName (Just dicts) = DependentDictionaryValue fnName dicts+  -- Turn a DictionaryValue into a Value+  dictionaryValueToValue :: DictionaryValue -> Value+  dictionaryValueToValue (LocalDictionaryValue fnName) = Var fnName+  dictionaryValueToValue (GlobalDictionaryValue fnName) = App (Var fnName) (ObjectLiteral [])+  dictionaryValueToValue (DependentDictionaryValue fnName dicts) = foldl App (Var fnName) (map dictionaryValueToValue dicts)   -- Filter out type dictionaries which are in scope in the current module   filterModule :: TypeClassDictionaryInScope -> Bool   filterModule (TypeClassDictionaryInScope { tcdName = Qualified (Just mn) _ }) | mn == moduleName = True@@ -983,5 +1008,6 @@ subsumes' val ty1 ty2 = do   ty1 =?= ty2   return val+