17496f9 · rowtype-yoga/purescript-native

README.md+12

compare with golang

unifiedsplit

@@ -669,6 +669,18 @@ foo = A:foo

669bar = A:B:bar

670```

671

672+All the names in a module can be aliased using the `import` declaration:

673+

674+```haskell

675+import A

676+```

677+

678+You can also limit which names are going to be aliased:

679+

680+```haskell

681+import A.B (bar)

682+```

683+

672## Foreign Function Interface

684## Foreign Function Interface

673

685

674The `foreign import` keyword declares a value which is defined in Javascript, and its type:

686The `foreign import` keyword declares a value which is defined in Javascript, and its type:

examples/failing/Import.psnew file+1

@@ -0,0 +1 @@

1+import UndefinedModule

examples/passing/Import.psnew file+12

@@ -0,0 +1,12 @@

1+module Hello where

2+ id :: forall a. a -> a

3+ id = \x -> x

4+

5+ module Nested where

6+ import Hello (id)

7+

8+ foo = id

9+

10+import Hello.Nested

11+

12+main = \() -> foo 42

src/Language/PureScript.hs+1−1

@@ -33,6 +33,6 @@ compile :: [Declaration] -> Either String (String, String, Environment)

33compile decls = do

34 bracketted <- rebracket decls

35 (_, env) <- check (typeCheckAll bracketted)

36− let js = prettyPrintJS . map optimize . concat . mapMaybe (declToJs Nothing global) $ bracketted

36+ let js = prettyPrintJS . map optimize . concat . mapMaybe (\decl -> declToJs Nothing global decl env) $ bracketted

37 let exts = intercalate "\n" . mapMaybe (externToPs 0 global env) $ bracketted

38 return (js, exts, env)

src/Language/PureScript/CodeGen/JS.hs+23−13

@@ -20,11 +20,13 @@ module Language.PureScript.CodeGen.JS (

20import Data.Char

21import Data.Maybe (fromMaybe, mapMaybe)

22import Data.List (intercalate)

23+import qualified Data.Map as M

23import qualified Control.Arrow as A

24import qualified Control.Arrow as A

24import Control.Arrow ((<+>), second)

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

25import Control.Monad (forM)

26import Control.Monad (forM)

26import Control.Applicative

27import Control.Applicative

27

28

29+import Language.PureScript.TypeChecker (Environment, names)

28import Language.PureScript.Types

30import Language.PureScript.Types

29import Language.PureScript.Values

31import Language.PureScript.Values

30import Language.PureScript.Names

32import Language.PureScript.Names

@@ -33,17 +35,17 @@ import Language.PureScript.Pretty.Common

33import Language.PureScript.CodeGen.Monad

35import Language.PureScript.CodeGen.Monad

34import Language.PureScript.CodeGen.JS.AST as AST

36import Language.PureScript.CodeGen.JS.AST as AST

35

37

36−declToJs :: Maybe Ident -> ModulePath -> Declaration -> Maybe [JS]

38+declToJs :: Maybe Ident -> ModulePath -> Declaration -> Environment -> Maybe [JS]

37−declToJs mod mp (ValueDeclaration ident (Abs args ret)) =

39+declToJs mod mp (ValueDeclaration ident (Abs args ret)) _ =

38 Just $ JSFunction (Just ident) args (JSBlock [JSReturn (valueToJs mp ret)]) :

40 Just $ JSFunction (Just ident) args (JSBlock [JSReturn (valueToJs mp ret)]) :

39 maybe [] (return . setProperty (identToJs ident) (JSVar ident)) mod

41 maybe [] (return . setProperty (identToJs ident) (JSVar ident)) mod

40−declToJs mod mp (ValueDeclaration ident val) =

42+declToJs mod mp (ValueDeclaration ident val) _ =

41 Just $ JSVariableIntroduction ident (Just (valueToJs mp val)) :

43 Just $ JSVariableIntroduction ident (Just (valueToJs mp val)) :

42 maybe [] (return . setProperty (identToJs ident) (JSVar ident)) mod

44 maybe [] (return . setProperty (identToJs ident) (JSVar ident)) mod

43−declToJs mod _ (ExternMemberDeclaration member ident _) =

45+declToJs mod _ (ExternMemberDeclaration member ident _) _ =

44 Just $ JSFunction (Just ident) [Ident "value"] (JSBlock [JSReturn (JSAccessor member (JSVar (Ident "value")))]) :

46 Just $ JSFunction (Just ident) [Ident "value"] (JSBlock [JSReturn (JSAccessor member (JSVar (Ident "value")))]) :

45 maybe [] (return . setProperty (show ident) (JSVar ident)) mod

47 maybe [] (return . setProperty (show ident) (JSVar ident)) mod

46−declToJs mod mp (DataDeclaration _ _ ctors) =

48+declToJs mod mp (DataDeclaration _ _ ctors) _ =

47 Just $ flip concatMap ctors $ \(pn@(ProperName ctor), maybeTy) ->

49 Just $ flip concatMap ctors $ \(pn@(ProperName ctor), maybeTy) ->

48 let

50 let

49 ctorJs =

51 ctorJs =

@@ -54,14 +56,22 @@ declToJs mod mp (DataDeclaration _ _ ctors) =

54 (JSObjectLiteral [ ("ctor", JSStringLiteral (show (Qualified mp pn)))

56 (JSObjectLiteral [ ("ctor", JSStringLiteral (show (Qualified mp pn)))

55 , ("value", JSVar (Ident "value")) ])])

57 , ("value", JSVar (Ident "value")) ])])

56 in ctorJs : maybe [] (return . setProperty ctor (JSVar (Ident ctor))) mod

58 in ctorJs : maybe [] (return . setProperty ctor (JSVar (Ident ctor))) mod

57−declToJs mod mp (ModuleDeclaration pn@(ProperName name) decls) =

59+declToJs mod mp (ModuleDeclaration pn@(ProperName name) decls) env =

58 Just $ [ JSVariableIntroduction (Ident name) Nothing

60 Just $ [ JSVariableIntroduction (Ident name) Nothing

59 , JSApp (JSFunction Nothing [Ident name]

61 , JSApp (JSFunction Nothing [Ident name]

60− (JSBlock (concat $ mapMaybe (declToJs (Just (Ident name)) (subModule mp pn)) decls)))

62+ (JSBlock (concat $ mapMaybe (\decl -> declToJs (Just (Ident name)) (subModule mp pn) decl env) decls)))

61− [JSAssignment (JSAssignVariable (Ident name) )

63+ [JSAssignment (JSAssignVariable (Ident name))

62 (JSBinary Or (JSVar (Ident name)) (JSObjectLiteral []))]] ++

64 (JSBinary Or (JSVar (Ident name)) (JSObjectLiteral []))]] ++

63 maybe [] (return . setProperty name (JSVar (Ident name))) mod

65 maybe [] (return . setProperty name (JSVar (Ident name))) mod

66+declToJs mod omp (ImportDeclaration mp idents) env =

67+ Just $ case idents of

68+ Nothing ->

69+ let identPairs = filter (\(m, _) -> m == mp) (M.keys (names env))

70+ idents = map snd identPairs

71+ in map mkLocal idents

72+ Just idents -> map mkLocal idents

73+ where mkLocal ident = JSVariableIntroduction ident (Just (qualifiedToJS identToJs (Qualified mp ident)))

64−declToJs _ _ _ = Nothing

74+declToJs _ _ _ _ = Nothing

65

75

66setProperty :: String -> JS -> Ident -> JS

76setProperty :: String -> JS -> Ident -> JS

67setProperty prop val mod = JSAssignment (JSAssignProperty prop (JSAssignVariable mod)) val

77setProperty prop val mod = JSAssignment (JSAssignProperty prop (JSAssignVariable mod)) val

@@ -87,10 +97,10 @@ valueToJs m (Var ident) = qualifiedToJS identToJs ident

87valueToJs m (TypedValue val _) = valueToJs m val

97valueToJs m (TypedValue val _) = valueToJs m val

88

98

89qualifiedToJS :: (a -> String) -> Qualified a -> JS

99qualifiedToJS :: (a -> String) -> Qualified a -> JS

90−qualifiedToJS f (Qualified (ModulePath parts) a) = delimited (f a : reverse (map show parts))

100+qualifiedToJS f (Qualified (ModulePath parts) a) =

91− where

101+ delimited (f a : reverse (map show parts))

92− delimited [part] = JSVar (Ident (part))

102+ where delimited [part] = JSVar (Ident (part))

93− delimited (part:parts) = JSAccessor part (delimited parts)

103+ delimited (part:parts) = JSAccessor part (delimited parts)

94

104

95bindersToJs :: ModulePath -> [(Binder, Value)] -> JS -> Gen JS

105bindersToJs :: ModulePath -> [(Binder, Value)] -> JS -> Gen JS

96bindersToJs m binders val = do

106bindersToJs m binders val = do

src/Language/PureScript/Declarations.hs+3−1

@@ -38,4 +38,6 @@ data Declaration

38 | ExternMemberDeclaration String Ident PolyType

39 | ExternDataDeclaration ProperName Kind

40 | FixityDeclaration Fixity String

41− | ModuleDeclaration ProperName [Declaration] deriving (Show, D.Data, D.Typeable)

41+ | ModuleDeclaration ProperName [Declaration]

42+ | ImportDeclaration ModulePath (Maybe [Ident])

43+ deriving (Show, D.Data, D.Typeable)

src/Language/PureScript/Names.hs+4−1

@@ -30,7 +30,10 @@ newtype ProperName = ProperName { runProperName :: String } deriving (Eq, Ord, D

30instance Show ProperName where

31 show = runProperName

32

33−data ModulePath = ModulePath [ProperName] deriving (Show, Eq, Ord, Data, Typeable)

33+data ModulePath = ModulePath [ProperName] deriving (Eq, Ord, Data, Typeable)

34+

35+instance Show ModulePath where

36+ show (ModulePath segments) = intercalate "." $ map show segments

34

37

35subModule :: ModulePath -> ProperName -> ModulePath

38subModule :: ModulePath -> ProperName -> ModulePath

36subModule (ModulePath mp) name = ModulePath (mp ++ [name])

39subModule (ModulePath mp) name = ModulePath (mp ++ [name])

src/Language/PureScript/Parser/Declarations.hs+18−1

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

28import qualified Text.Parsec as P

29import qualified Text.Parsec.Pos as P

30

31+import Language.PureScript.Names

31import Language.PureScript.Values

32import Language.PureScript.Values

32import Language.PureScript.Types

33import Language.PureScript.Types

33import Language.PureScript.Parser.State

34import Language.PureScript.Parser.State

@@ -96,6 +97,21 @@ parseModuleDeclaration = do

96 decls <- mark (P.many (same *> parseDeclaration))

97 decls <- mark (P.many (same *> parseDeclaration))

97 return $ ModuleDeclaration name decls

98 return $ ModuleDeclaration name decls

98

99

100+parseImportDeclaration :: P.Parsec String ParseState Declaration

101+parseImportDeclaration = do

102+ reserved "import"

103+ indented

104+ segments <- P.sepBy1 properName (lexeme $ P.char '.')

105+ idents <- P.optionMaybe $ do

106+ lexeme $ indented *> P.char '('

107+ idents <- P.sepBy1 parseIdent (lexeme $ indented *> P.char ',')

108+ lexeme $ indented *> P.char ')'

109+ return idents

110+ let modulePath = mkModulePath (ModulePath [head segments]) (tail segments)

111+ return $ ImportDeclaration modulePath idents

112+ where mkModulePath path (s:ss) = mkModulePath (subModule path s) ss

113+ mkModulePath path _ = path

114+

99parseDeclaration :: P.Parsec String ParseState Declaration

115parseDeclaration :: P.Parsec String ParseState Declaration

100parseDeclaration = P.choice

116parseDeclaration = P.choice

101 [ parseDataDeclaration

117 [ parseDataDeclaration

@@ -104,7 +120,8 @@ parseDeclaration = P.choice

104 , parseValueDeclaration

120 , parseValueDeclaration

105 , parseExternDeclaration

121 , parseExternDeclaration

106 , parseFixityDeclaration

122 , parseFixityDeclaration

107− , parseModuleDeclaration ] P.<?> "declaration"

123+ , parseModuleDeclaration

124+ , parseImportDeclaration ] P.<?> "declaration"

108

125

109parseDeclarations :: P.Parsec String ParseState [Declaration]

126parseDeclarations :: P.Parsec String ParseState [Declaration]

110parseDeclarations = whiteSpace *> mark (P.many (same *> parseDeclaration)) <* P.eof

127parseDeclarations = whiteSpace *> mark (P.many (same *> parseDeclaration)) <* P.eof

src/Language/PureScript/TypeChecker.hs+19

@@ -117,3 +117,22 @@ typeCheckAll (FixityDeclaration _ name : rest) = do

117typeCheckAll (ModuleDeclaration name decls : rest) = do

118 withModule name $ typeCheckAll decls

119 typeCheckAll rest

120+typeCheckAll (ImportDeclaration modulePath idents : rest) = do

121+ env <- getEnv

122+ omp <- checkModulePath `fmap` get

123+ rethrow errorMessage $ do

124+ guardWith "module does not exist" $ moduleExists env

125+ case idents of

126+ Nothing -> bindIdents (map snd $ filterModule env) omp env

127+ Just idents -> bindIdents idents omp env

128+ typeCheckAll rest

129+ where errorMessage = (("Error importing " ++ show modulePath ++ ": ") ++)

130+ filterModule env = filter (\(m, _) -> m == modulePath) (M.keys (names env))

131+ moduleExists env = not $ null $ filterModule env

132+ bindIdents idents omp env =

133+ forM_ idents $ \ident ->

134+ case M.lookup (modulePath, ident) (names env) of

135+ Nothing -> throwError $ show modulePath ++ "." ++ show ident ++ " is undefined"

136+ Just (pt, _) -> getEnv >>= \env' ->

137+ putEnv (env' { names = M.insert (omp, ident) (pt, Alias modulePath ident)

138+ (names env') })

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

@@ -28,7 +28,7 @@ import Control.Arrow ((***), first, second)

28

29import qualified Data.Map as M

30

31−data NameKind = Value | Extern deriving Show

31+data NameKind = Value | Extern | Alias ModulePath Ident deriving Show

32

33data TypeDeclarationKind = Data | ExternData | TypeSynonym deriving Show

34