summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorPhilFreeman <>2014-02-17 04:20:00 (GMT)
committerhdiff <hdiff@hdiff.luite.com>2014-02-17 04:20:00 (GMT)
commit2403a4abf8d4388fe87ec237a41a25ac7c2ee486 (patch)
tree693853dcce6c1eb63793bc57c344e4d1f7c3dcd4
parent2d2180046aae6303965fd8be7349b428539caf5e (diff)
version 0.4.10.4.1
-rw-r--r--prelude/prelude.purs30
-rw-r--r--purescript.cabal2
-rw-r--r--src/Language/PureScript/Pretty/Types.hs6
-rw-r--r--src/Language/PureScript/TypeChecker/Types.hs24
4 files changed, 42 insertions, 20 deletions
diff --git a/prelude/prelude.purs b/prelude/prelude.purs
index cbf0b0f..cba4d1b 100644
--- a/prelude/prelude.purs
+++ b/prelude/prelude.purs
@@ -54,11 +54,11 @@ module Prelude where
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 @@ module Prelude where
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 @@ module Monoid where
instance Monoid String where
mempty = ""
(<>) = (++)
-
+
instance Monoid [a] where
mempty = []
(<>) = Arrays.concat
@@ -440,11 +440,11 @@ module Maybe where
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 @@ module Maybe where
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 @@ module Either where
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 @@ module Either where
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 @@ module Arrays where
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 @@ module Math where
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
diff --git a/purescript.cabal b/purescript.cabal
index 6142c1c..875acd6 100644
--- a/purescript.cabal
+++ b/purescript.cabal
@@ -1,5 +1,5 @@
name: purescript
-version: 0.4.0
+version: 0.4.1
cabal-version: >=1.8
build-type: Simple
license: MIT
diff --git a/src/Language/PureScript/Pretty/Types.hs b/src/Language/PureScript/Pretty/Types.hs
index 3407b09..2c9621e 100644
--- a/src/Language/PureScript/Pretty/Types.hs
+++ b/src/Language/PureScript/Pretty/Types.hs
@@ -32,7 +32,7 @@ import Language.PureScript.Pretty.Common
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 @@ typeLiterals = mkPattern match
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
-- |
diff --git a/src/Language/PureScript/TypeChecker/Types.hs b/src/Language/PureScript/TypeChecker/Types.hs
index d020ebe..3e9166d 100644
--- a/src/Language/PureScript/TypeChecker/Types.hs
+++ b/src/Language/PureScript/TypeChecker/Types.hs
@@ -68,6 +68,7 @@ import Control.Arrow (Arrow(..))
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 r1 r2 =
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 @@ subsumes' (Just val) (ConstrainedType constraints ty1) ty2 = do
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