c584c40 · rowtype-yoga/purescript-native

PureScript.cabal+4−3

compare with golang

unifiedsplit

@@ -30,7 +30,8 @@ library

30 exposed: True

31 buildable: True

32 hs-source-dirs: src

33− other-modules: PureScript.CodeGen.Pretty.Kinds

33+ other-modules: PureScript.Parser.Kinds

34+ PureScript.CodeGen.Pretty.Kinds

34

35

35executable psc

36executable psc

36 build-depends: base -any, cmdtheline -any, containers -any,

37 build-depends: base -any, cmdtheline -any, containers -any,

@@ -38,6 +39,6 @@ executable psc

38 main-is: Main.hs

39 main-is: Main.hs

39 buildable: True

40 buildable: True

40 hs-source-dirs: src

41 hs-source-dirs: src

41− other-modules: PureScript.CodeGen.Pretty.Kinds

42+ other-modules: PureScript.Parser.Kinds

42− PureScript.CodeGen.Pretty.Types

43+ PureScript.CodeGen.Pretty.Kinds PureScript.CodeGen.Pretty.Types

43

44

examples/ExternData.psnew file+13

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

1+extern data IO :: * -> *

2+

3+extern fmap :: forall a b. IO a -> (a -> b) -> IO b

4+

5+extern ret :: forall a. a -> IO a

6+

7+extern bind :: forall a b. IO a -> (a -> IO b) -> IO b

8+

9+extern showMessage :: String -> IO { }

10+

11+extern prompt :: IO String

12+

13+main = prompt `bind` \s -> showMessage s

src/PureScript/Declarations.hs+2

@@ -19,6 +19,7 @@ module PureScript.Declarations where

19import PureScript.Values

20import PureScript.Types

21import PureScript.Names

22+import PureScript.Kinds

22

23

23import qualified Data.Data as D

24import qualified Data.Data as D

24

25

@@ -34,4 +35,5 @@ data Declaration

34 | TypeDeclaration Ident PolyType

35 | TypeDeclaration Ident PolyType

35 | ValueDeclaration Ident Value

36 | ValueDeclaration Ident Value

36 | ExternDeclaration Ident PolyType

37 | ExternDeclaration Ident PolyType

38+ | ExternDataDeclaration String Kind

37 | FixityDeclaration Fixity String deriving (Show, D.Data, D.Typeable)

39 | FixityDeclaration Fixity String deriving (Show, D.Data, D.Typeable)

src/PureScript/Parser/Declarations.hs+6−3

@@ -35,6 +35,7 @@ import PureScript.Parser.Common

35import PureScript.Declarations

36import PureScript.Parser.Values

37import PureScript.Parser.Types

38+import PureScript.Parser.Kinds

38

39

39parseDataDeclaration :: P.Parsec String ParseState Declaration

40parseDataDeclaration :: P.Parsec String ParseState Declaration

40parseDataDeclaration = do

41parseDataDeclaration = do

@@ -62,9 +63,11 @@ parseValueDeclaration =

62 <*> (lexeme (indented *> P.char '=') *> parseValue)

63 <*> (lexeme (indented *> P.char '=') *> parseValue)

63

64

64parseExternDeclaration :: P.Parsec String ParseState Declaration

65parseExternDeclaration :: P.Parsec String ParseState Declaration

65−parseExternDeclaration =

66+parseExternDeclaration = reserved "extern" *> indented *>

67+ (ExternDataDeclaration <$> (reserved "data" *> indented *> properName)

68+ <*> (lexeme (indented *> P.string "::") *> parseKind)

66− ExternDeclaration <$> (reserved "extern" *> indented *> parseIdent)

69+ <|> ExternDeclaration <$> parseIdent

67− <*> (lexeme (indented *> P.string "::") *> parsePolyType)

70+ <*> (lexeme (indented *> P.string "::") *> parsePolyType))

68

71

69parseAssociativity :: P.Parsec String ParseState Associativity

72parseAssociativity :: P.Parsec String ParseState Associativity

70parseAssociativity =

73parseAssociativity =

src/PureScript/Parser/Kinds.hsnew file+41

@@ -0,0 +1,41 @@

1+-----------------------------------------------------------------------------

2+--

3+-- Module : PureScript.Parser.Kinds

4+-- Copyright : (c) Phil Freeman 2013

5+-- License : MIT

6+--

7+-- Maintainer : Phil Freeman <paf31@cantab.net>

8+-- Stability : experimental

9+-- Portability :

10+--

11+-- |

12+--

13+-----------------------------------------------------------------------------

14+

15+module PureScript.Parser.Kinds (

16+ parseKind

17+) where

18+

19+import PureScript.Kinds

20+import PureScript.Parser.State

21+import PureScript.Parser.Common

22+import Control.Applicative

23+import qualified Text.Parsec as P

24+import qualified Text.Parsec.Expr as P

25+

26+parseStar :: P.Parsec String ParseState Kind

27+parseStar = const Star <$> lexeme (P.char '*')

28+

29+parseRow :: P.Parsec String ParseState Kind

30+parseRow = const Row <$> lexeme (P.char 'ρ')

31+

32+parseTypeAtom :: P.Parsec String ParseState Kind

33+parseTypeAtom = indented *> P.choice (map P.try

34+ [ parseStar

35+ , parseRow

36+ , parens parseKind ])

37+

38+parseKind :: P.Parsec String ParseState Kind

39+parseKind = P.buildExpressionParser operators $ parseTypeAtom

40+ where

41+ operators = [ [ P.Infix (lexeme (P.try (P.string "->")) >> return FunKind) P.AssocRight ] ]

src/PureScript/TypeChecker.hs+5

@@ -79,6 +79,11 @@ typeCheckAll (ValueDeclaration name val : rest) = do

79 ty <- typeOf name val

80 putEnv (env { names = M.insert name (ty, Value) (names env) })

81 typeCheckAll rest

82+typeCheckAll (ExternDataDeclaration name kind : rest) = do

83+ env <- getEnv

84+ guardWith (name ++ " is already defined") $ not $ M.member name (types env)

85+ putEnv $ env { types = M.insert name (kind, TypeSynonym) (types env) }

86+ typeCheckAll rest

82typeCheckAll (ExternDeclaration name ty : rest) = do

87typeCheckAll (ExternDeclaration name ty : rest) = do

83 rethrow (("Error in extern declaration " ++ show name ++ ": ") ++) $ do

88 rethrow (("Error in extern declaration " ++ show name ++ ": ") ++) $ do

84 env <- getEnv

89 env <- getEnv

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

@@ -89,7 +89,7 @@ kindConstraints m (Function args ret) = do

89 me <- fresh

90 (cs, ns, m') <- kindConstraintsAll m args

91 (cs', retN, m'') <- kindConstraints m' ret

92− return ((KindConstraint retN Star) : (KindConstraint me Star) : (map (flip KindConstraint Star) ns) ++ cs, me, m'')

92+ return ((KindConstraint retN Star) : (KindConstraint me Star) : (map (flip KindConstraint Star) ns) ++ cs ++ cs', me, m'')

93kindConstraints m (TypeVar v) = do

94 case M.lookup v m of

95 Just u -> return ([], u, m)

src/PureScript/TypeChecker/Monad.hs+1−1

@@ -30,7 +30,7 @@ import qualified Data.Map as M

30

31data NameKind = Value | Extern deriving Show

32

33−data TypeDeclarationKind = Data | TypeSynonym deriving Show

33+data TypeDeclarationKind = Data | ExternData | TypeSynonym deriving Show

34

35data Environment = Environment

36 { names :: M.Map Ident (PolyType, NameKind)