summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorPhilFreeman <>2014-01-22 02:52:00 (GMT)
committerhdiff <hdiff@hdiff.luite.com>2014-01-22 02:52:00 (GMT)
commita86a55fd578bfc2046da533294d23be1973b5c23 (patch)
tree05b8dac1def9c9dff8cecdafbc7f331165a85344
parentae84a9b7fe354e04c5d3904d0b096959538f563f (diff)
version 0.3.10.3.1
-rw-r--r--libraries/prelude/prelude.purs4
-rw-r--r--purescript.cabal2
-rw-r--r--src/Language/PureScript/CodeGen/JS.hs2
-rw-r--r--src/Language/PureScript/Parser/Types.hs6
-rw-r--r--src/Language/PureScript/Pretty/Types.hs2
-rw-r--r--src/Language/PureScript/Sugar/TypeClasses.hs2
-rw-r--r--src/Language/PureScript/TypeChecker/Kinds.hs5
-rw-r--r--src/Language/PureScript/TypeChecker/Types.hs22
-rw-r--r--src/Language/PureScript/Types.hs3
9 files changed, 23 insertions, 25 deletions
diff --git a/libraries/prelude/prelude.purs b/libraries/prelude/prelude.purs
index 65c7bd6..44d2203 100644
--- a/libraries/prelude/prelude.purs
+++ b/libraries/prelude/prelude.purs
@@ -321,13 +321,15 @@ module IORef where
module Trace where
+ import Prelude
import Eff
foreign import data Trace :: !
foreign import trace "function trace(s) { return function() { console.log(s); return {}; }; }" :: forall r. String -> Eff (trace :: Trace | r) {}
- foreign import print "function print(dict) { return function (o) { return function() { console.log(Prelude.show(dict)(o)); return {}; }; }; }" :: forall a r. (Prelude.Show a) => a -> Eff (trace :: Trace | r) {}
+ print :: forall a r. (Prelude.Show a) => a -> Eff (trace :: Trace | r) {}
+ print o = trace (show o)
module ST where
diff --git a/purescript.cabal b/purescript.cabal
index fdc9f7d..8dd28d3 100644
--- a/purescript.cabal
+++ b/purescript.cabal
@@ -1,5 +1,5 @@
name: purescript
-version: 0.3.0
+version: 0.3.1
cabal-version: >=1.8
build-type: Simple
license: MIT
diff --git a/src/Language/PureScript/CodeGen/JS.hs b/src/Language/PureScript/CodeGen/JS.hs
index 484c360..7f5dc69 100644
--- a/src/Language/PureScript/CodeGen/JS.hs
+++ b/src/Language/PureScript/CodeGen/JS.hs
@@ -125,7 +125,7 @@ runtimeTypeChecks args ty =
argumentCheck val Number = [typeCheck val "number"]
argumentCheck val String = [typeCheck val "string"]
argumentCheck val Boolean = [typeCheck val "boolean"]
- argumentCheck val (Array _) = [arrayCheck val]
+ argumentCheck val (TypeApp Array _) = [arrayCheck val]
argumentCheck val (Object row) =
let
(pairs, _) = rowToList row
diff --git a/src/Language/PureScript/Parser/Types.hs b/src/Language/PureScript/Parser/Types.hs
index 2f3f153..e6b1984 100644
--- a/src/Language/PureScript/Parser/Types.hs
+++ b/src/Language/PureScript/Parser/Types.hs
@@ -36,7 +36,10 @@ parseBoolean :: P.Parsec String ParseState Type
parseBoolean = const Boolean <$> reserved "Boolean"
parseArray :: P.Parsec String ParseState Type
-parseArray = squares $ Array <$> parseType
+parseArray = squares $ return Array
+
+parseArrayOf :: P.Parsec String ParseState Type
+parseArrayOf = squares $ TypeApp Array <$> parseType
parseObject :: P.Parsec String ParseState Type
parseObject = braces $ Object <$> parseRow
@@ -64,6 +67,7 @@ parseTypeAtom = indented *> P.choice (map P.try
, parseString
, parseBoolean
, parseArray
+ , parseArrayOf
, parseObject
, parseFunction
, parseTypeVariable
diff --git a/src/Language/PureScript/Pretty/Types.hs b/src/Language/PureScript/Pretty/Types.hs
index d931ae6..c8fbfac 100644
--- a/src/Language/PureScript/Pretty/Types.hs
+++ b/src/Language/PureScript/Pretty/Types.hs
@@ -31,7 +31,7 @@ typeLiterals = mkPattern match
match Number = Just "Number"
match String = Just "String"
match Boolean = Just "Boolean"
- match (Array ty) = Just $ "[" ++ prettyPrintType ty ++ "]"
+ match Array = Just $ "[]"
match (Object row) = Just $ "{ " ++ prettyPrintType row ++ " }"
match (TypeVar var) = Just var
match (TypeConstructor ctor) = Just $ show ctor
diff --git a/src/Language/PureScript/Sugar/TypeClasses.hs b/src/Language/PureScript/Sugar/TypeClasses.hs
index 2d2d0e4..90ac4a8 100644
--- a/src/Language/PureScript/Sugar/TypeClasses.hs
+++ b/src/Language/PureScript/Sugar/TypeClasses.hs
@@ -122,7 +122,7 @@ typeToString :: ModuleName -> Type -> Either String String
typeToString _ String = return "string"
typeToString _ Number = return "number"
typeToString _ Boolean = return "boolean"
-typeToString _ (Array (TypeVar _)) = return "array"
+typeToString _ Array = return "array"
typeToString mn (TypeConstructor ty') = return $ qualifiedToString mn ty'
typeToString mn (TypeApp ty' (TypeVar _)) = typeToString mn ty'
typeToString _ _ = Left "Type class instance must be of the form T a1 ... an"
diff --git a/src/Language/PureScript/TypeChecker/Kinds.hs b/src/Language/PureScript/TypeChecker/Kinds.hs
index e52e1aa..5b492f7 100644
--- a/src/Language/PureScript/TypeChecker/Kinds.hs
+++ b/src/Language/PureScript/TypeChecker/Kinds.hs
@@ -95,10 +95,7 @@ infer :: Type -> Subst Kind
infer Number = return Star
infer String = return Star
infer Boolean = return Star
-infer (Array t) = do
- k <- infer t
- k ~~ Star
- return Star
+infer Array = return $ FunKind Star Star
infer (Object row) = do
k <- infer row
k ~~ Row Star
diff --git a/src/Language/PureScript/TypeChecker/Types.hs b/src/Language/PureScript/TypeChecker/Types.hs
index 15ae118..b334154 100644
--- a/src/Language/PureScript/TypeChecker/Types.hs
+++ b/src/Language/PureScript/TypeChecker/Types.hs
@@ -53,7 +53,6 @@ instance Unifiable Type where
apply s (TUnknown u) = runSubstitution s u
apply s (SaturatedTypeSynonym name tys) = SaturatedTypeSynonym name $ map (apply s) tys
apply s (ForAll idents ty) = ForAll idents $ apply s ty
- apply s (Array t) = Array (apply s t)
apply s (Object r) = Object (apply s r)
apply s (Function args ret) = Function (map (apply s) args) (apply s ret)
apply s (TypeApp t1 t2) = TypeApp (apply s t1) (apply s t2)
@@ -62,7 +61,6 @@ instance Unifiable Type where
unknowns (TUnknown (Unknown u)) = [u]
unknowns (SaturatedTypeSynonym _ tys) = concatMap unknowns tys
unknowns (ForAll _ ty) = unknowns ty
- unknowns (Array t) = unknowns t
unknowns (Object r) = unknowns r
unknowns (Function args ret) = concatMap unknowns args ++ unknowns ret
unknowns (TypeApp t1 t2) = unknowns t1 ++ unknowns t2
@@ -91,7 +89,7 @@ unifyTypes t1 t2 = rethrow (\e -> "Error unifying type " ++ prettyPrintType t1 +
unifyTypes' Number Number = return ()
unifyTypes' String String = return ()
unifyTypes' Boolean Boolean = return ()
- unifyTypes' (Array s) (Array t) = s `unifyTypes` t
+ unifyTypes' Array Array = return ()
unifyTypes' (Object row1) (Object row2) = row1 ~~ row2
unifyTypes' (Function args1 ret1) (Function args2 ret2) = do
guardWith "Function applied to incorrect number of args" $ length args1 == length args2
@@ -218,9 +216,7 @@ typeHeadsAreEqual _ _ String String = Just []
typeHeadsAreEqual _ _ Number Number = Just []
typeHeadsAreEqual _ _ Boolean Boolean = Just []
typeHeadsAreEqual _ _ (Skolem s1) (Skolem s2) | s1 == s2 = Just []
-typeHeadsAreEqual _ _ (Array (TypeVar v)) (Array ty) = Just [(v, ty)]
-typeHeadsAreEqual _ _ (Array ty) (Array (TypeVar v)) = Just [(v, ty)]
-typeHeadsAreEqual m e (Array ty1) (Array ty2) = typeHeadsAreEqual m e ty1 ty2
+typeHeadsAreEqual _ _ Array Array = Just []
typeHeadsAreEqual m e (TypeConstructor c1) (TypeConstructor c2) | typeConstructorsAreEqual e m c1 c2 = Just []
typeHeadsAreEqual m e (TypeApp h1 (TypeVar v)) (TypeApp h2 arg) = (:) (v, arg) <$> typeHeadsAreEqual m e h1 h2
typeHeadsAreEqual m e t1@(TypeApp _ _) t2@(TypeApp _ (TypeVar _)) = typeHeadsAreEqual m e t2 t1
@@ -312,7 +308,7 @@ infer' v@(BooleanLiteral _) = return $ TypedValue True v Boolean
infer' (ArrayLiteral vals) = do
ts <- mapM infer vals
els <- fresh
- forM_ ts $ \(TypedValue _ _ t) -> els ~~ Array t
+ forM_ ts $ \(TypedValue _ _ t) -> els ~~ TypeApp Array t
return $ TypedValue True (ArrayLiteral ts) els
infer' (Unary op val) = do
v <- infer val
@@ -338,8 +334,8 @@ infer' (ObjectUpdate o ps) = do
infer' (Indexer index val) = do
el <- fresh
index' <- check index Number
- val' <- check val (Array el)
- return $ TypedValue True (Indexer (TypedValue True index' Number) (TypedValue True val' (Array el))) el
+ val' <- check val (TypeApp Array el)
+ return $ TypedValue True (Indexer (TypedValue True index' Number) (TypedValue True val' (TypeApp Array el))) el
infer' (Accessor prop val) = do
typed@(TypedValue _ _ objTy) <- infer val
propTy <- inferProperty objTy prop
@@ -533,13 +529,13 @@ inferBinder val (ObjectBinder props) = do
inferBinder val (ArrayBinder binders) = do
el <- fresh
m1 <- M.unions <$> mapM (inferBinder el) binders
- val ~~ Array el
+ val ~~ TypeApp Array el
return m1
inferBinder val (ConsBinder headBinder tailBinder) = do
el <- fresh
m1 <- inferBinder el headBinder
m2 <- inferBinder val tailBinder
- val ~~ Array el
+ val ~~ TypeApp Array el
return $ m1 `M.union` m2
inferBinder val (NamedBinder name binder) = do
m <- inferBinder val binder
@@ -668,10 +664,10 @@ check' v@(StringLiteral _) String = return v
check' v@(BooleanLiteral _) Boolean = return v
check' (Unary op val) ty = checkUnary op val ty
check' (Binary op left right) ty = checkBinary op left right ty
-check' (ArrayLiteral vals) (Array ty) = ArrayLiteral <$> forM vals (\val -> check val ty)
+check' (ArrayLiteral vals) (TypeApp Array ty) = ArrayLiteral <$> forM vals (\val -> check val ty)
check' (Indexer index vals) ty = do
index' <- check index Number
- vals' <- check vals (Array ty)
+ vals' <- check vals (TypeApp Array ty)
return $ Indexer index' vals'
check' (Abs args ret) (Function argTys retTy) = do
moduleName <- substCurrentModule <$> ask
diff --git a/src/Language/PureScript/Types.hs b/src/Language/PureScript/Types.hs
index d800885..a7ad809 100644
--- a/src/Language/PureScript/Types.hs
+++ b/src/Language/PureScript/Types.hs
@@ -27,7 +27,7 @@ data Type
| Number
| String
| Boolean
- | Array Type
+ | Array
| Object Type
| Function [Type] Type
| TypeVar String
@@ -54,7 +54,6 @@ isMonoType (ForAll _ _) = False
isMonoType ty = isPolyType ty
isPolyType :: Type -> Bool
-isPolyType (Array ty) = isMonoType ty
isPolyType (Object ps) = all isPolyType (map snd . fst $ rowToList ps)
isPolyType (Function args ret) = all isPolyType args && isPolyType ret
isPolyType (TypeApp t1 t2) = isMonoType t1 && isMonoType t2