67edf7a · rowtype-yoga/purescript-native

git.iko.soy/rowtype-yoga/purescript-native

on golang help sign in

[] can now be used in type class instances

67edf7aPhil Freeman13 years ago

examples/passing/ArrayType.pursnew file+13

compare with golang

unifiedsplit

@@ -0,0 +1,13 @@

1+module ArrayType where

3+test :: [] Number

4+test = [1, 2, 3]

6+class Functor f where

7+ fmap :: forall a b. (a -> b) -> f a -> f b

9+foreign import (:) :: forall a. a -> [a] -> [a]

10+

11+instance Functor [] where

12+ fmap _ [] = []

13+ fmap f (x:xs) = f x : fmap f xs

purescript.cabal+1−1

@@ -1,5 +1,5 @@

1name: purescript

2−version: 0.3.0

2+version: 0.3.1

3cabal-version: >=1.8

4build-type: Simple

5license: MIT

src/Language/PureScript/CodeGen/JS.hs+1−1

@@ -125,7 +125,7 @@ runtimeTypeChecks args ty =

125 argumentCheck val Number = [typeCheck val "number"]

126 argumentCheck val String = [typeCheck val "string"]

127 argumentCheck val Boolean = [typeCheck val "boolean"]

128− argumentCheck val (Array _) = [arrayCheck val]

128+ argumentCheck val (TypeApp Array _) = [arrayCheck val]

129 argumentCheck val (Object row) =

130 let

131 (pairs, _) = rowToList row

src/Language/PureScript/Parser/Types.hs+5−1

@@ -36,7 +36,10 @@ parseBoolean :: P.Parsec String ParseState Type

36parseBoolean = const Boolean <$> reserved "Boolean"

38parseArray :: P.Parsec String ParseState Type

39−parseArray = squares $ Array <$> parseType

39+parseArray = squares $ return Array

40+

41+parseArrayOf :: P.Parsec String ParseState Type

42+parseArrayOf = squares $ TypeApp Array <$> parseType

41parseObject :: P.Parsec String ParseState Type

44parseObject :: P.Parsec String ParseState Type

42parseObject = braces $ Object <$> parseRow

45parseObject = braces $ Object <$> parseRow

@@ -64,6 +67,7 @@ parseTypeAtom = indented *> P.choice (map P.try

64 , parseString

67 , parseString

65 , parseBoolean

68 , parseBoolean

66 , parseArray

69 , parseArray

70+ , parseArrayOf

67 , parseObject

71 , parseObject

68 , parseFunction

72 , parseFunction

69 , parseTypeVariable

73 , parseTypeVariable

src/Language/PureScript/Pretty/Types.hs+1−1

@@ -31,7 +31,7 @@ typeLiterals = mkPattern match

31 match Number = Just "Number"

32 match String = Just "String"

33 match Boolean = Just "Boolean"

34− match (Array ty) = Just $ "[" ++ prettyPrintType ty ++ "]"

34+ match Array = Just $ "[]"

35 match (Object row) = Just $ "{ " ++ prettyPrintType row ++ " }"

36 match (TypeVar var) = Just var

37 match (TypeConstructor ctor) = Just $ show ctor

src/Language/PureScript/Sugar/TypeClasses.hs+1−1

@@ -122,7 +122,7 @@ typeToString :: ModuleName -> Type -> Either String String

122typeToString _ String = return "string"

123typeToString _ Number = return "number"

124typeToString _ Boolean = return "boolean"

125−typeToString _ (Array (TypeVar _)) = return "array"

125+typeToString _ Array = return "array"

126typeToString mn (TypeConstructor ty') = return $ qualifiedToString mn ty'

127typeToString mn (TypeApp ty' (TypeVar _)) = typeToString mn ty'

128typeToString _ _ = Left "Type class instance must be of the form T a1 ... an"

src/Language/PureScript/TypeChecker/Kinds.hs+1−4

@@ -95,10 +95,7 @@ infer :: Type -> Subst Kind

95infer Number = return Star

96infer String = return Star

97infer Boolean = return Star

98−infer (Array t) = do

99− k <- infer t

100− k ~~ Star

101− return Star

98+infer Array = return $ FunKind Star Star

102infer (Object row) = do

99infer (Object row) = do

103 k <- infer row

100 k <- infer row

104 k ~~ Row Star

101 k ~~ Row Star

src/Language/PureScript/TypeChecker/Types.hs+9−13

@@ -53,7 +53,6 @@ instance Unifiable Type where

53 apply s (TUnknown u) = runSubstitution s u

54 apply s (SaturatedTypeSynonym name tys) = SaturatedTypeSynonym name $ map (apply s) tys

55 apply s (ForAll idents ty) = ForAll idents $ apply s ty

56− apply s (Array t) = Array (apply s t)

57 apply s (Object r) = Object (apply s r)

56 apply s (Object r) = Object (apply s r)

58 apply s (Function args ret) = Function (map (apply s) args) (apply s ret)

57 apply s (Function args ret) = Function (map (apply s) args) (apply s ret)

59 apply s (TypeApp t1 t2) = TypeApp (apply s t1) (apply s t2)

58 apply s (TypeApp t1 t2) = TypeApp (apply s t1) (apply s t2)

@@ -62,7 +61,6 @@ instance Unifiable Type where

62 unknowns (TUnknown (Unknown u)) = [u]

61 unknowns (TUnknown (Unknown u)) = [u]

63 unknowns (SaturatedTypeSynonym _ tys) = concatMap unknowns tys

62 unknowns (SaturatedTypeSynonym _ tys) = concatMap unknowns tys

64 unknowns (ForAll _ ty) = unknowns ty

63 unknowns (ForAll _ ty) = unknowns ty

65− unknowns (Array t) = unknowns t

66 unknowns (Object r) = unknowns r

64 unknowns (Object r) = unknowns r

67 unknowns (Function args ret) = concatMap unknowns args ++ unknowns ret

65 unknowns (Function args ret) = concatMap unknowns args ++ unknowns ret

68 unknowns (TypeApp t1 t2) = unknowns t1 ++ unknowns t2

66 unknowns (TypeApp t1 t2) = unknowns t1 ++ unknowns t2

@@ -91,7 +89,7 @@ unifyTypes t1 t2 = rethrow (\e -> "Error unifying type " ++ prettyPrintType t1 +

91 unifyTypes' Number Number = return ()

89 unifyTypes' Number Number = return ()

92 unifyTypes' String String = return ()

90 unifyTypes' String String = return ()

93 unifyTypes' Boolean Boolean = return ()

91 unifyTypes' Boolean Boolean = return ()

94− unifyTypes' (Array s) (Array t) = s `unifyTypes` t

92+ unifyTypes' Array Array = return ()

95 unifyTypes' (Object row1) (Object row2) = row1 ~~ row2

93 unifyTypes' (Object row1) (Object row2) = row1 ~~ row2

96 unifyTypes' (Function args1 ret1) (Function args2 ret2) = do

94 unifyTypes' (Function args1 ret1) (Function args2 ret2) = do

97 guardWith "Function applied to incorrect number of args" $ length args1 == length args2

95 guardWith "Function applied to incorrect number of args" $ length args1 == length args2

@@ -218,9 +216,7 @@ typeHeadsAreEqual _ _ String String = Just []

218typeHeadsAreEqual _ _ Number Number = Just []

216typeHeadsAreEqual _ _ Number Number = Just []

219typeHeadsAreEqual _ _ Boolean Boolean = Just []

217typeHeadsAreEqual _ _ Boolean Boolean = Just []

220typeHeadsAreEqual _ _ (Skolem s1) (Skolem s2) | s1 == s2 = Just []

218typeHeadsAreEqual _ _ (Skolem s1) (Skolem s2) | s1 == s2 = Just []

221−typeHeadsAreEqual _ _ (Array (TypeVar v)) (Array ty) = Just [(v, ty)]

219+typeHeadsAreEqual _ _ Array Array = Just []

222−typeHeadsAreEqual _ _ (Array ty) (Array (TypeVar v)) = Just [(v, ty)]

223−typeHeadsAreEqual m e (Array ty1) (Array ty2) = typeHeadsAreEqual m e ty1 ty2

224typeHeadsAreEqual m e (TypeConstructor c1) (TypeConstructor c2) | typeConstructorsAreEqual e m c1 c2 = Just []

220typeHeadsAreEqual m e (TypeConstructor c1) (TypeConstructor c2) | typeConstructorsAreEqual e m c1 c2 = Just []

225typeHeadsAreEqual m e (TypeApp h1 (TypeVar v)) (TypeApp h2 arg) = (:) (v, arg) <$> typeHeadsAreEqual m e h1 h2

221typeHeadsAreEqual m e (TypeApp h1 (TypeVar v)) (TypeApp h2 arg) = (:) (v, arg) <$> typeHeadsAreEqual m e h1 h2

226typeHeadsAreEqual m e t1@(TypeApp _ _) t2@(TypeApp _ (TypeVar _)) = typeHeadsAreEqual m e t2 t1

222typeHeadsAreEqual m e t1@(TypeApp _ _) t2@(TypeApp _ (TypeVar _)) = typeHeadsAreEqual m e t2 t1

@@ -312,7 +308,7 @@ infer' v@(BooleanLiteral _) = return $ TypedValue True v Boolean

312infer' (ArrayLiteral vals) = do

308infer' (ArrayLiteral vals) = do

313 ts <- mapM infer vals

309 ts <- mapM infer vals

314 els <- fresh

310 els <- fresh

315− forM_ ts $ \(TypedValue _ _ t) -> els ~~ Array t

311+ forM_ ts $ \(TypedValue _ _ t) -> els ~~ TypeApp Array t

316 return $ TypedValue True (ArrayLiteral ts) els

312 return $ TypedValue True (ArrayLiteral ts) els

317infer' (Unary op val) = do

313infer' (Unary op val) = do

318 v <- infer val

314 v <- infer val

@@ -338,8 +334,8 @@ infer' (ObjectUpdate o ps) = do

338infer' (Indexer index val) = do

334infer' (Indexer index val) = do

339 el <- fresh

335 el <- fresh

340 index' <- check index Number

336 index' <- check index Number

341− val' <- check val (Array el)

337+ val' <- check val (TypeApp Array el)

342− return $ TypedValue True (Indexer (TypedValue True index' Number) (TypedValue True val' (Array el))) el

338+ return $ TypedValue True (Indexer (TypedValue True index' Number) (TypedValue True val' (TypeApp Array el))) el

343infer' (Accessor prop val) = do

339infer' (Accessor prop val) = do

344 typed@(TypedValue _ _ objTy) <- infer val

340 typed@(TypedValue _ _ objTy) <- infer val

345 propTy <- inferProperty objTy prop

341 propTy <- inferProperty objTy prop

@@ -533,13 +529,13 @@ inferBinder val (ObjectBinder props) = do

533inferBinder val (ArrayBinder binders) = do

529inferBinder val (ArrayBinder binders) = do

534 el <- fresh

530 el <- fresh

535 m1 <- M.unions <$> mapM (inferBinder el) binders

531 m1 <- M.unions <$> mapM (inferBinder el) binders

536− val ~~ Array el

532+ val ~~ TypeApp Array el

537 return m1

533 return m1

538inferBinder val (ConsBinder headBinder tailBinder) = do

534inferBinder val (ConsBinder headBinder tailBinder) = do

539 el <- fresh

535 el <- fresh

540 m1 <- inferBinder el headBinder

536 m1 <- inferBinder el headBinder

541 m2 <- inferBinder val tailBinder

537 m2 <- inferBinder val tailBinder

542− val ~~ Array el

538+ val ~~ TypeApp Array el

543 return $ m1 `M.union` m2

539 return $ m1 `M.union` m2

544inferBinder val (NamedBinder name binder) = do

540inferBinder val (NamedBinder name binder) = do

545 m <- inferBinder val binder

541 m <- inferBinder val binder

@@ -668,10 +664,10 @@ check' v@(StringLiteral _) String = return v

668check' v@(BooleanLiteral _) Boolean = return v

664check' v@(BooleanLiteral _) Boolean = return v

669check' (Unary op val) ty = checkUnary op val ty

665check' (Unary op val) ty = checkUnary op val ty

670check' (Binary op left right) ty = checkBinary op left right ty

666check' (Binary op left right) ty = checkBinary op left right ty

671−check' (ArrayLiteral vals) (Array ty) = ArrayLiteral <$> forM vals (\val -> check val ty)

667+check' (ArrayLiteral vals) (TypeApp Array ty) = ArrayLiteral <$> forM vals (\val -> check val ty)

672check' (Indexer index vals) ty = do

668check' (Indexer index vals) ty = do

673 index' <- check index Number

669 index' <- check index Number

674− vals' <- check vals (Array ty)

670+ vals' <- check vals (TypeApp Array ty)

675 return $ Indexer index' vals'

671 return $ Indexer index' vals'

676check' (Abs args ret) (Function argTys retTy) = do

672check' (Abs args ret) (Function argTys retTy) = do

677 moduleName <- substCurrentModule <$> ask

673 moduleName <- substCurrentModule <$> ask

src/Language/PureScript/Types.hs+1−2

@@ -27,7 +27,7 @@ data Type

27 | Number

28 | String

29 | Boolean

30− | Array Type

30+ | Array

31 | Object Type

32 | Function [Type] Type

33 | TypeVar String

@@ -54,7 +54,6 @@ isMonoType (ForAll _ _) = False

54isMonoType ty = isPolyType ty

56isPolyType :: Type -> Bool

57−isPolyType (Array ty) = isMonoType ty

58isPolyType (Object ps) = all isPolyType (map snd . fst $ rowToList ps)

57isPolyType (Object ps) = all isPolyType (map snd . fst $ rowToList ps)

59isPolyType (Function args ret) = all isPolyType args && isPolyType ret

58isPolyType (Function args ret) = all isPolyType args && isPolyType ret

60isPolyType (TypeApp t1 t2) = isMonoType t1 && isMonoType t2

59isPolyType (TypeApp t1 t2) = isMonoType t1 && isMonoType t2