770351a · rowtype-yoga/purescript-native

purescript.cabal+5−5

compare with golang

unifiedsplit

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

1name: purescript

2−version: 0.4.18

2+version: 0.4.18.1

3cabal-version: >=1.8

4build-type: Custom

5license: MIT

@@ -18,11 +18,11 @@ data-files: prelude/prelude.purs

18data-dir: ""

19

20library

21− build-depends: base >=4 && <5, cmdtheline -any, containers -any,

21+ build-depends: base >=4 && <5, cmdtheline -any, containers -any, unordered-containers -any,

22 directory >= 1.2, filepath -any, mtl -any, parsec -any, syb >= 0.4.1 && < 0.5,

23− transformers -any, utf8-string -any,

23+ transformers -any, utf8-string -any,

24− pattern-arrows >= 0.0.2 && < 0.1,

24+ pattern-arrows >= 0.0.2 && < 0.1,

25− monad-unify >= 0.2.1 && < 0.3,

25+ monad-unify >= 0.2.2 && < 0.3,

26 xdg-basedir -any, time -any

27 if (!os(windows))

28 build-depends: unix -any

src/Language/PureScript/Kinds.hs+14

@@ -44,3 +44,17 @@ data Kind

44 -- Function kinds

45 --

46 | FunKind Kind Kind deriving (Show, Eq, Data, Typeable)

47+

48+everywhereOnKinds :: (Kind -> Kind) -> Kind -> Kind

49+everywhereOnKinds f = go

50+ where

51+ go (Row k1) = f (Row (go k1))

52+ go (FunKind k1 k2) = f (FunKind (go k1) (go k2))

53+ go other = f other

54+

55+everythingOnKinds :: (r -> r -> r) -> (Kind -> r) -> Kind -> r

56+everythingOnKinds (<>) f = go

57+ where

58+ go k@(Row k1) = f k <> go k1

59+ go k@(FunKind k1 k2) = f k <> go k1 <> go k2

60+ go other = f other

src/Language/PureScript/Pretty/Kinds.hs+1−2

@@ -21,7 +21,6 @@ import Data.Maybe (fromMaybe)

21

22import Control.Arrow (ArrowPlus(..))

23import Control.PatternArrows

24−import Control.Monad.Unify

25

24

26import Language.PureScript.Kinds

25import Language.PureScript.Kinds

27import Language.PureScript.Pretty.Common

26import Language.PureScript.Pretty.Common

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

31 where

30 where

32 match Star = Just "*"

31 match Star = Just "*"

33 match Bang = Just "!"

32 match Bang = Just "!"

34− match (KUnknown (Unknown u)) = Just $ 'u' : show u

33+ match (KUnknown u) = Just $ 'u' : show u

35 match _ = Nothing

34 match _ = Nothing

36

35

37matchRow :: Pattern () Kind ((), Kind)

36matchRow :: Pattern () Kind ((), Kind)

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

@@ -24,7 +24,6 @@ import Data.List (intercalate)

24

25import Control.Arrow ((<+>))

26import Control.PatternArrows

27−import Control.Monad.Unify

28

27

29import Language.PureScript.Types

28import Language.PureScript.Types

30import Language.PureScript.Pretty.Common

29import Language.PureScript.Pretty.Common

@@ -37,7 +36,7 @@ typeLiterals = mkPattern match

37 match (PrettyPrintObject row) = Just $ "{ " ++ prettyPrintRow row ++ " }"

36 match (PrettyPrintObject row) = Just $ "{ " ++ prettyPrintRow row ++ " }"

38 match (PrettyPrintArray ty) = Just $ "[" ++ prettyPrintType ty ++ "]"

37 match (PrettyPrintArray ty) = Just $ "[" ++ prettyPrintType ty ++ "]"

39 match (TypeConstructor ctor) = Just $ show ctor

38 match (TypeConstructor ctor) = Just $ show ctor

40− match (TUnknown (Unknown u)) = Just $ 'u' : show u

39+ match (TUnknown u) = Just $ 'u' : show u

41 match (Skolem name s _) = Just $ name ++ show s

40 match (Skolem name s _) = Just $ name ++ show s

42 match (ConstrainedType deps ty) = Just $ "(" ++ intercalate ", " (map (\(pn, ty') -> show pn ++ " " ++ unwords (map prettyPrintTypeAtom ty')) deps) ++ ") => " ++ prettyPrintType ty

41 match (ConstrainedType deps ty) = Just $ "(" ++ intercalate ", " (map (\(pn, ty') -> show pn ++ " " ++ unwords (map prettyPrintTypeAtom ty')) deps) ++ ") => " ++ prettyPrintType ty

43 match (SaturatedTypeSynonym name args) = Just $ show name ++ "<" ++ intercalate "," (map prettyPrintTypeAtom args) ++ ">"

42 match (SaturatedTypeSynonym name args) = Just $ show name ++ "<" ++ intercalate "," (map prettyPrintTypeAtom args) ++ ">"

@@ -117,3 +116,4 @@ prettyPrintTypeAtom = fromMaybe (error "Incomplete pattern") . pattern matchType

117--

116--

118prettyPrintType :: Type -> String

117prettyPrintType :: Type -> String

119prettyPrintType = fromMaybe (error "Incomplete pattern") . pattern matchType () . insertPlaceholders

118prettyPrintType = fromMaybe (error "Incomplete pattern") . pattern matchType () . insertPlaceholders

119+

src/Language/PureScript/TypeChecker/Kinds.hs+12

@@ -37,12 +37,23 @@ import Control.Monad.Unify

37import Control.Applicative

38

39import qualified Data.Map as M

40+import qualified Data.HashMap.Strict as H

40import Data.Monoid ((<>))

41import Data.Monoid ((<>))

41

42

42instance Partial Kind where

43instance Partial Kind where

43 unknown = KUnknown

44 unknown = KUnknown

44 isUnknown (KUnknown u) = Just u

45 isUnknown (KUnknown u) = Just u

45 isUnknown _ = Nothing

46 isUnknown _ = Nothing

47+ unknowns = everythingOnKinds (++) go

48+ where

49+ go (KUnknown u) = [u]

50+ go _ = []

51+ ($?) sub = everywhereOnKinds go

52+ where

53+ go t@(KUnknown u) = case H.lookup u (runSubstitution sub) of

54+ Nothing -> t

55+ Just t' -> t'

56+ go other = other

46

57

47instance Unifiable Check Kind where

58instance Unifiable Check Kind where

48 KUnknown u1 =?= KUnknown u2 | u1 == u2 = return ()

59 KUnknown u1 =?= KUnknown u2 | u1 == u2 = return ()

@@ -171,3 +182,4 @@ infer' (ConstrainedType deps ty) = do

171infer' _ = error "Invalid argument to infer"

182infer' _ = error "Invalid argument to infer"

172

183

173

184

185+

src/Language/PureScript/TypeChecker/Types.hs+16−4

@@ -68,6 +68,7 @@ import Control.Applicative

68import Control.Arrow (Arrow(..))

69

70import qualified Data.Map as M

71+import qualified Data.HashMap.Strict as H

71import Data.Function (on)

72import Data.Function (on)

72import Data.Ord (comparing)

73import Data.Ord (comparing)

73import Data.Monoid ((<>))

74import Data.Monoid ((<>))

@@ -76,6 +77,16 @@ instance Partial Type where

76 unknown = TUnknown

77 unknown = TUnknown

77 isUnknown (TUnknown u) = Just u

78 isUnknown (TUnknown u) = Just u

78 isUnknown _ = Nothing

79 isUnknown _ = Nothing

80+ unknowns = everythingOnTypes (++) go

81+ where

82+ go (TUnknown u) = [u]

83+ go _ = []

84+ ($?) sub = everywhereOnTypes go

85+ where

86+ go t@(TUnknown u) = case H.lookup u (runSubstitution sub) of

87+ Nothing -> t

88+ Just t' -> t'

89+ go other = other

79

90

80instance Unifiable Check Type where

91instance Unifiable Check Type where

81 (=?=) = unifyTypes

92 (=?=) = unifyTypes

@@ -494,9 +505,9 @@ varIfUnknown ty =

494 toName = (:) 't' . show

505 toName = (:) 't' . show

495 ty' = everywhereOnTypes typeToVar ty

506 ty' = everywhereOnTypes typeToVar ty

496 typeToVar :: Type -> Type

507 typeToVar :: Type -> Type

497− typeToVar (TUnknown (Unknown u)) = TypeVar (toName u)

508+ typeToVar (TUnknown u) = TypeVar (toName u)

498 typeToVar t = t

509 typeToVar t = t

499− in mkForAll (sort . map (toName . runUnknown) $ unks) ty'

510+ in mkForAll (sort . map toName $ unks) ty'

500

511

501-- |

512-- |

502-- Remove any ForAlls and ConstrainedType constructors in a type by introducing new unknowns

513-- Remove any ForAlls and ConstrainedType constructors in a type by introducing new unknowns

@@ -791,13 +802,13 @@ checkBinders nvals ret (CaseAlternative binders grd val : bs) = do

791-- Generate a new skolem constant

802-- Generate a new skolem constant

792--

803--

793newSkolemConstant :: UnifyT Type Check Int

804newSkolemConstant :: UnifyT Type Check Int

794−newSkolemConstant = runUnknown <$> fresh'

805+newSkolemConstant = fresh'

795

806

796-- |

807-- |

797-- Generate a new skolem scope

808-- Generate a new skolem scope

798--

809--

799newSkolemScope :: UnifyT Type Check SkolemScope

810newSkolemScope :: UnifyT Type Check SkolemScope

800−newSkolemScope = SkolemScope . runUnknown <$> fresh'

811+newSkolemScope = SkolemScope <$> fresh'

801

812

802-- |

813-- |

803-- Skolemize a type variable by replacing its instances with fresh skolem constants

814-- Skolemize a type variable by replacing its instances with fresh skolem constants

@@ -1109,3 +1120,4 @@ subsumes' val ty1 ty2 = do

1109

1120

1110

1121

1111

1122

1123+