67edf7a · rowtype-yoga/purescript-native

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

[] can now be used in type class instances

commit67edf7a4b0d390fef28a4eeb2d7cb146bda88dba authorPhil Freeman <paf31@cantab.net> dateTue 21 Jan 2014, 18:51 (13 years ago) parentbbdc8d6

9 files changed+33−24

compare with golang

unifiedsplit

examples/passing/ArrayType.purs+13 purescript.cabal+1−1 src/Language/PureScript/CodeGen/JS.hs+1−1 src/Language/PureScript/Parser/Types.hs+5−1 src/Language/PureScript/Pretty/Types.hs+1−1 src/Language/PureScript/Sugar/TypeClasses.hs+1−1 src/Language/PureScript/TypeChecker/Kinds.hs+1−4 src/Language/PureScript/TypeChecker/Types.hs+9−13 src/Language/PureScript/Types.hs+1−2

examples/passing/ArrayType.pursnew file+13

@@ -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 @@

11name: purescript

2−version: 0.3.0

2+version: 0.3.1

33cabal-version: >=1.8

44build-type: Simple

55license: MIT

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

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

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

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

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

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

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

129129 argumentCheck val (Object row) =

130130 let

131131 (pairs, _) = rowToList row

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

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

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

3737

3838parseArray :: 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

4043

4144parseObject :: P.Parsec String ParseState Type

4245parseObject = braces $ Object <$> parseRow

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

6467 , parseString

6568 , parseBoolean

6669 , parseArray

70+ , parseArrayOf

6771 , parseObject

6872 , parseFunction

6973 , parseTypeVariable

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

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

3131 match Number = Just "Number"

3232 match String = Just "String"

3333 match Boolean = Just "Boolean"

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

34+ match Array = Just $ "[]"

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

3636 match (TypeVar var) = Just var

3737 match (TypeConstructor ctor) = Just $ show ctor

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

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

122122typeToString _ String = return "string"

123123typeToString _ Number = return "number"

124124typeToString _ Boolean = return "boolean"

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

125+typeToString _ Array = return "array"

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

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

128128typeToString _ _ = 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

9595infer Number = return Star

9696infer String = return Star

9797infer 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

10299infer (Object row) = do

103100 k <- infer row

104101 k ~~ Row Star

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

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

5353 apply s (TUnknown u) = runSubstitution s u

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

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

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

5756 apply s (Object r) = Object (apply s r)

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

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

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

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

6362 unknowns (SaturatedTypeSynonym _ tys) = concatMap unknowns tys

6463 unknowns (ForAll _ ty) = unknowns ty

65− unknowns (Array t) = unknowns t

6664 unknowns (Object r) = unknowns r

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

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

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

9189 unifyTypes' Number Number = return ()

9290 unifyTypes' String String = return ()

9391 unifyTypes' Boolean Boolean = return ()

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

92+ unifyTypes' Array Array = return ()

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

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

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

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

218216typeHeadsAreEqual _ _ Number Number = Just []

219217typeHeadsAreEqual _ _ Boolean Boolean = Just []

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

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

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

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

219+typeHeadsAreEqual _ _ Array Array = Just []

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

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

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

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

312308infer' (ArrayLiteral vals) = do

313309 ts <- mapM infer vals

314310 els <- fresh

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

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

316312 return $ TypedValue True (ArrayLiteral ts) els

317313infer' (Unary op val) = do

318314 v <- infer val

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

338334infer' (Indexer index val) = do

339335 el <- fresh

340336 index' <- check index Number

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

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

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

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

343339infer' (Accessor prop val) = do

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

345341 propTy <- inferProperty objTy prop

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

533529inferBinder val (ArrayBinder binders) = do

534530 el <- fresh

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

536− val ~~ Array el

532+ val ~~ TypeApp Array el

537533 return m1

538534inferBinder val (ConsBinder headBinder tailBinder) = do

539535 el <- fresh

540536 m1 <- inferBinder el headBinder

541537 m2 <- inferBinder val tailBinder

542− val ~~ Array el

538+ val ~~ TypeApp Array el

543539 return $ m1 `M.union` m2

544540inferBinder val (NamedBinder name binder) = do

545541 m <- inferBinder val binder

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

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

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

670666check' (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)

672668check' (Indexer index vals) ty = do

673669 index' <- check index Number

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

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

675671 return $ Indexer index' vals'

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

677673 moduleName <- substCurrentModule <$> ask

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

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

2727 | Number

2828 | String

2929 | Boolean

30− | Array Type

30+ | Array

3131 | Object Type

3232 | Function [Type] Type

3333 | TypeVar String

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

5454isMonoType ty = isPolyType ty

5555

5656isPolyType :: Type -> Bool

57−isPolyType (Array ty) = isMonoType ty

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

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

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