purescript 0.5.0 → 0.5.1

raw patch · 10 files changed

+96/−30 lines, 10 filesPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

API changes (from Hackage documentation)

Files

• prelude/prelude.purs +64/−5
• purescript.cabal +1/−1
• src/Language/PureScript/Environment.hs +5/−5
• src/Language/PureScript/Parser/Common.hs +8/−2
• src/Language/PureScript/Parser/Declarations.hs +2/−2
• src/Language/PureScript/Pretty/Common.hs +9/−0
• src/Language/PureScript/Pretty/Types.hs +1/−1
• src/Language/PureScript/Pretty/Values.hs +2/−2
• src/Language/PureScript/Sugar/TypeClasses.hs +3/−5
• src/Language/PureScript/TypeChecker/Types.hs +1/−7

@@ -1,4 +1,28 @@-module Prelude where+module Prelude+  ( flip+  , const+  , asTypeOf+  , Semigroupoid, (<<<), (>>>)+  , Category, id+  , ($), (#)+  , (:), cons+  , Show, show+  , Functor, (<$>)+  , Apply, (<*>)+  , Applicative, pure, liftA1+  , Alternative, empty, (<|>)+  , Bind, (>>=)+  , Monad, return, liftM1, ap+  , Num, (+), (-), (*), (/), (%)+  , negate+  , Eq, (==), (/=), refEq, refIneq+  , Ord, Ordering(..), compare, (<), (>), (<=), (>=)+  , Bits, (&), (|), (^), shl, shr, zshr, complement+  , BoolLike, (&&), (||)+  , not+  , Semigroup, (<>), (++)+  , Unit(..), unit+  ) where    flip :: forall a b c. (a -> b -> c) -> b -> a -> c   flip f b a = f a b@@ -56,6 +80,9 @@     \  return JSON.stringify(s);\     \}" :: String -> String +  instance showUnit :: Show Unit where+    show (Unit {}) = "Unit {}"+   instance showString :: Show String where     show = showStringImpl @@ -184,6 +211,11 @@     (%) = numMod     negate = numNegate +  data Unit = Unit {}++  unit :: Unit+  unit = Unit {}+   infix 4 ==   infix 4 /= @@ -205,6 +237,10 @@     \  };\     \}" :: forall a. a -> a -> Boolean +  instance eqUnit :: Eq Unit where+    (==) (Unit {}) (Unit {}) = true+    (/=) (Unit {}) (Unit {}) = false+   instance eqString :: Eq String where     (==) = refEq     (/=) = refIneq@@ -268,15 +304,35 @@     LT -> false     _ -> true -  foreign import numCompare-    "function numCompare(n1) {\+  foreign import unsafeCompare+    "function unsafeCompare(n1) {\     \  return function(n2) {\     \    return n1 < n2 ? LT : n1 > n2 ? GT : EQ;\     \  };\-    \}" :: Number -> Number -> Ordering+    \}" :: forall a. a -> a -> Ordering +  instance ordUnit :: Ord Unit where+    compare (Unit {}) (Unit {}) = EQ+    +  instance ordBoolean :: Ord Boolean where+    compare false false = EQ+    compare false true  = LT+    compare true  true  = EQ+    compare true  false = GT+       instance ordNumber :: Ord Number where-    compare = numCompare+    compare = unsafeCompare+    +  instance ordString :: Ord String where+    compare = unsafeCompare+    +  instance ordArray :: (Ord a) => Ord [a] where+    compare [] [] = EQ+    compare [] _ = LT+    compare _ [] = GT+    compare (x:xs) (y:ys) = case compare x y of+      EQ -> compare xs ys+      other -> other    infixl 10 &   infixl 10 |@@ -380,6 +436,9 @@     \    return s1 + s2;\     \  };\     \}" :: String -> String -> String++  instance semigroupUnit :: Semigroup Unit where+    (<>) (Unit {}) (Unit {}) = Unit {}    instance semigroupString :: Semigroup String where     (<>) = concatString

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

@@ -73,11 +73,7 @@   -- |   -- A foreign import which contains inline Javascript as a string literal   ---  | InlineJavascript-  -- |-  -- A type class dictionary member accessor import, generated during desugaring of type class declarations-  ---  | TypeClassAccessorImport deriving (Show, Eq, Data, Typeable)+  | InlineJavascript deriving (Show, Eq, Data, Typeable)  -- | -- The kind of a name@@ -87,6 +83,10 @@   -- A value introduced as a binding in a module   --   = Value+  -- |+  -- A type class dictionary member accessor import, generated during desugaring of type class declarations+  --+  | TypeClassAccessorImport   -- |   -- A foreign import   --

@@ -54,6 +54,12 @@                   ]  -- |+-- The characters allowed for use in operators+--+opChars :: [Char]+opChars = ":!#$%&*+./<=>?@\\^|-~"++-- | -- A list of reserved identifiers for types -- reservedTypeNames :: [String]@@ -82,13 +88,13 @@ -- Valid first characters for an operator -- opStart :: P.Parsec String u Char-opStart = P.oneOf ":!#$%&*+./<=>?@\\^|-~"+opStart = P.oneOf opChars  -- | -- Valid operators characters -- opLetter :: P.Parsec String u Char-opLetter = P.oneOf ":!#$%&*+./<=>?@\\^|-~"+opLetter = P.oneOf opChars  -- | -- The PureScript language definition

@@ -123,13 +123,13 @@   where   stdImport = do     moduleName' <- moduleName-    idents <- P.optionMaybe $ parens $ commaSep parseDeclarationRef+    idents <- P.optionMaybe $ indented *> (parens $ commaSep parseDeclarationRef)     return $ ImportDeclaration moduleName' idents Nothing   qualImport = do     reserved "qualified"     indented     moduleName' <- moduleName-    idents <- P.optionMaybe $ parens $ commaSep parseDeclarationRef+    idents <- P.optionMaybe $ indented *> (parens $ commaSep parseDeclarationRef)     reserved "as"     asQ <- moduleName     return $ ImportDeclaration moduleName' idents (Just asQ)

@@ -17,6 +17,7 @@  import Control.Monad.State import Data.List (intercalate)+import Language.PureScript.Parser.Common (reservedPsNames, opChars)  -- | -- Wrap a string in parentheses@@ -58,3 +59,11 @@   ss <- mapM f xs   indentString <- currentIndent   return $ intercalate "\n" $ map (indentString ++) ss++-- |+-- Prints an object key, escaping reserved names.+--+prettyPrintObjectKey :: String -> String+prettyPrintObjectKey s | s `elem` reservedPsNames = show s+                       | head s `elem` opChars = show s+                       | otherwise = s

@@ -51,7 +51,7 @@ prettyPrintRow = (\(tys, rest) -> intercalate ", " (map (uncurry nameAndTypeToPs) tys) ++ tailToPs rest) . toList []   where   nameAndTypeToPs :: String -> Type -> String-  nameAndTypeToPs name ty = name ++ " :: " ++ prettyPrintType ty+  nameAndTypeToPs name ty = prettyPrintObjectKey name ++ " :: " ++ prettyPrintType ty   tailToPs :: Type -> String   tailToPs REmpty = ""   tailToPs other = " | " ++ prettyPrintType other

@@ -215,12 +215,12 @@  prettyPrintObjectPropertyBinder :: (String, Binder) -> StateT PrinterState Maybe String prettyPrintObjectPropertyBinder (key, binder) = fmap concat $ sequence-    [ return $ key ++ ": "+    [ return $ prettyPrintObjectKey key ++ ": "     , prettyPrintBinder' binder     ]  prettyPrintObjectProperty :: (String, Value) -> StateT PrinterState Maybe String prettyPrintObjectProperty (key, value) = fmap concat $ sequence-    [ return $ key ++ ": "+    [ return $ prettyPrintObjectKey key ++ ": "     , prettyPrintValue' value     ]

@@ -21,12 +21,10 @@ import Language.PureScript.Declarations import Language.PureScript.Names import Language.PureScript.Types-import Language.PureScript.CodeGen.JS.AST import Language.PureScript.Sugar.CaseDeclarations import Language.PureScript.Environment import Language.PureScript.Errors import Language.PureScript.Pretty.Types (prettyPrintTypeAtom)-import Language.PureScript.CodeGen.Common (identToJs)  import qualified Language.PureScript.Constants as C @@ -143,9 +141,9 @@  typeClassMemberToDictionaryAccessor :: ModuleName -> ProperName -> [String] -> Declaration -> Declaration typeClassMemberToDictionaryAccessor mn name args (TypeDeclaration ident ty) =-  ExternDeclaration TypeClassAccessorImport ident-    (Just (JSFunction (Just $ identToJs ident) ["dict"] (JSBlock [JSReturn (JSIndexer (JSStringLiteral (identToProperty ident)) (JSVar "dict"))])))-    (moveQuantifiersToFront (quantify (ConstrainedType [(Qualified (Just mn) name, map TypeVar args)] ty)))+  ValueDeclaration ident TypeClassAccessorImport [] Nothing $+    TypedValue False (Abs (Left $ Ident "dict") (Accessor (runIdent ident) (Var $ Qualified Nothing (Ident "dict")))) $+    moveQuantifiersToFront (quantify (ConstrainedType [(Qualified (Just mn) name, map TypeVar args)] ty)) typeClassMemberToDictionaryAccessor mn name args (PositionedDeclaration pos d) =   PositionedDeclaration pos $ typeClassMemberToDictionaryAccessor mn name args d typeClassMemberToDictionaryAccessor _ _ _ _ = error "Invalid declaration in type class definition"

@@ -348,7 +348,7 @@ 	    -- Make sure the types unify with the types in the superclass implication 	    , subst <- maybeToList . (>>= verifySubstitution) . fmap concat $ zipWithM (typeHeadsAreEqual moduleName env) tys' suTyArgs 	    -- Finally, satisfy the subclass constraint-	    , args' <- maybeToList $ mapM (applySubst subst . TypeVar) args+	    , args' <- maybeToList $ mapM (flip lookup subst) args 	    , suDict <- go True subclassName args' ] 	 	  -- Create dictionaries for subgoals which still need to be solved by calling go recursively@@ -379,12 +379,6 @@ 	    let grps = groupBy ((==) `on` fst) subst 	    guard (all (pairwise (unifiesWith env) . map snd) grps) 	    return $ map head grps-	  -- Apply a substitution to a type-	  applySubst :: [(String, Type)] -> Type -> Maybe Type-	  applySubst subst = everywhereOnTypesM replace-	    where-	    replace (TypeVar v) = lookup v subst-	    replace other = Just other 	  -- Choose the simplest DictionaryValues from a list of candidates 	  -- The reason for this function is as follows: 	  -- When considering overlapping instances, we don't want to consider the same dictionary