purescript 0.4.0 → 0.4.1
raw patch · 4 files changed
+42/−20 lines, 4 files
Files
- prelude/prelude.purs +15/−15
- purescript.cabal +1/−1
- src/Language/PureScript/Pretty/Types.hs +3/−3
- src/Language/PureScript/TypeChecker/Types.hs +23/−1
prelude/prelude.purs view
@@ -54,11 +54,11 @@ instance Read Boolean where read "true" = true read _ = false- + foreign import readNumber "function readNumber(n) {\- \ return parseInt(n, 10);\+ \ return parseFloat(n);\ \}" :: String -> Number- + instance Read Number where read = readNumber @@ -164,13 +164,13 @@ foreign import refEq "function refEq(r1) {\ \ return function(r2) {\- \ return r1.value === r2.value;\+ \ return r1.values[0] === r2.values[0];\ \ };\ \}" :: forall a. Ref a -> Ref a -> Boolean foreign import refIneq "function refIneq(r1) {\ \ return function(r2) {\- \ return r1.value !== r2.value;\+ \ return r1.values[0] !== r2.values[0];\ \ };\ \}" :: forall a. Ref a -> Ref a -> Boolean @@ -369,7 +369,7 @@ instance Monoid String where mempty = "" (<>) = (++)- + instance Monoid [a] where mempty = [] (<>) = Arrays.concat@@ -440,11 +440,11 @@ fromMaybe :: forall a. a -> Maybe a -> a fromMaybe a = maybe a (Prelude.id :: forall a. a -> a)- + instance Prelude.Monad Maybe where return = Just (>>=) m f = maybe Nothing f m- + instance Prelude.Applicative Maybe where pure = Just (<*>) (Just fn) x = fn <$> x@@ -453,7 +453,7 @@ instance Prelude.Functor Maybe where (<$>) fn (Just x) = Just (fn x) (<$>) _ _ = Nothing- + instance (Show a) => Prelude.Show (Maybe a) where show (Just x) = "Just " ++ (show x) show Nothing = "Nothing"@@ -467,11 +467,11 @@ either :: forall a b c. (a -> c) -> (b -> c) -> Either a b -> c either f _ (Left a) = f a either _ g (Right b) = g b- + instance Prelude.Monad (Either e) where return = Right (>>=) = either (\e _ -> Left e) (\a f -> f a)- + instance Prelude.Applicative (Either e) where pure = Right (<*>) (Left e) _ = Left e@@ -480,7 +480,7 @@ instance Prelude.Functor (Either a) where (<$>) _ (Left x) = Left x (<$>) f (Right y) = Right (f y)- + instance (Show a, Show b) => Prelude.Show (Either a b) where show (Left x) = "Left " ++ (show x) show (Right y) = "Right " ++ (show y)@@ -637,10 +637,10 @@ instance (Prelude.Show a) => Prelude.Show [a] where show [] = "[]" show (x:xs) = show x ++ " : " ++ show xs- + instance Prelude.Functor [] where (<$>) = map- + instance Prelude.Monad [] where return = singleton (>>=) = concatMap@@ -898,7 +898,7 @@ foreign import tan "function tan(n){\ \ return Math.tan(n);\ \}" :: Number -> Number- + foreign import e "var e = Math.E;" :: Number foreign import ln2 "var ln2 = Math.LN2;" :: Number foreign import ln10 "var ln10 = Math.LN10;" :: Number
purescript.cabal view
@@ -1,5 +1,5 @@ name: purescript-version: 0.4.0+version: 0.4.1 cabal-version: >=1.8 build-type: Simple license: MIT
src/Language/PureScript/Pretty/Types.hs view
@@ -32,7 +32,7 @@ typeLiterals :: Pattern () Type String typeLiterals = mkPattern match where- match (Object row) = Just $ "{ " ++ prettyPrintType row ++ " }"+ match (Object row) = Just $ "{ " ++ prettyPrintRow row ++ " }" match (TypeVar var) = Just var match (PrettyPrintArray ty) = Just $ "[" ++ prettyPrintType ty ++ "]" match ty@(TypeConstructor ctor) = Just $ show ctor@@ -41,8 +41,8 @@ match (ConstrainedType deps ty) = Just $ "(" ++ intercalate "," (map (\(pn, ty') -> show pn ++ " (" ++ prettyPrintType ty' ++ ")") deps) ++ ") => " ++ prettyPrintType ty match (SaturatedTypeSynonym name args) = Just $ show name ++ "<" ++ intercalate "," (map prettyPrintType args) ++ ">" match (ForAll ident ty _) = Just $ "forall " ++ ident ++ ". " ++ prettyPrintType ty- match REmpty = Just $ prettyPrintRow REmpty- match row@(RCons _ _ _) = Just $ prettyPrintRow row+ match REmpty = Just "()"+ match row@(RCons _ _ _) = Just $ '(' : prettyPrintRow row ++ ")" match _ = Nothing -- |
src/Language/PureScript/TypeChecker/Types.hs view
@@ -68,6 +68,7 @@ import qualified Data.Map as M import Data.Function (on)+import Data.Ord (comparing) instance Partial Type where unknown = TUnknown@@ -152,7 +153,7 @@ unifyRows' [] REmpty [] REmpty = return () unifyRows' [] (TypeVar v1) [] (TypeVar v2) | v1 == v2 = return () unifyRows' [] (Skolem s1 _) [] (Skolem s2 _) | s1 == s2 = return ()- unifyRows' sd3 r3 sd4 r4 = throwError $ "Cannot unify " ++ prettyPrintRow (rowFromList (sd3, r3)) ++ " with " ++ prettyPrintRow (rowFromList (sd4, r4)) ++ "."+ unifyRows' sd3 r3 sd4 r4 = throwError $ "Cannot unify (" ++ prettyPrintRow (rowFromList (sd3, r3)) ++ ") with (" ++ prettyPrintRow (rowFromList (sd4, r4)) ++ ")." -- | -- Ensure type constructors are equal after canonicalization@@ -1012,6 +1013,27 @@ Just moduleName <- checkCurrentModule <$> get _ <- subsumes' Nothing ty1 ty2 return . Just $ foldl App val (map (flip TypeClassDictionary dicts) (qualifyAllUnqualifiedNames moduleName env constraints))+subsumes' val (Object r1) (Object r2) = do+ let+ (ts1, r1') = rowToList r1+ (ts2, r2') = rowToList r2+ ts1' = sortBy (comparing fst) ts1+ ts2' = sortBy (comparing fst) ts2+ go ts1' ts2' r1' r2'+ return val+ where+ go [] ts2 r1 r2 = r1 =?= rowFromList (ts2, r2)+ go ts1 [] r1 r2 = r2 =?= rowFromList (ts1, r1)+ go ((p1, ty1) : ts1) ((p2, ty2) : ts2) r1 r2+ | p1 == p2 = do subsumes Nothing ty1 ty2+ go ts1 ts2 r1 r2+ | p1 < p2 = do rest <- fresh+ r2 =?= RCons p1 ty1 rest+ go ts1 ((p2, ty2) : ts2) r1 rest+ | p1 > p2 = do rest <- fresh+ r1 =?= RCons p2 ty2 rest+ go ((p1, ty1) : ts1) ts2 rest r2+subsumes' val ty1 ty2@(Object _) = subsumes val ty2 ty1 subsumes' val ty1 ty2 = do ty1 =?= ty2 return val