git.iko.soy/rowtype-yoga/purescript-native
on golang help sign in
Merge pull request #70 from Bogdanp/master

Add basic module imports (#66)

commit17496f98188b7cec1d11c6cf77f383fdfdb9494d authorPhil Freeman <paf31@cantab.net> dateSun 17 Nov 2013, 10:16 (13 years ago) parent74560583d932e1
10 files changed+94−18
compare with golang
unifiedsplit
README.md+12 examples/failing/Import.ps+1 examples/passing/Import.ps+12 src/Language/PureScript.hs+1−1 src/Language/PureScript/CodeGen/JS.hs+23−13 src/Language/PureScript/Declarations.hs+3−1 src/Language/PureScript/Names.hs+4−1 src/Language/PureScript/Parser/Declarations.hs+18−1 src/Language/PureScript/TypeChecker.hs+19 src/Language/PureScript/TypeChecker/Monad.hs+1−1
README.md+12
@@ -669,6 +669,18 @@ foo = A:foo
669669bar = A:B:bar
670670```
671671
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+
672684## Foreign Function Interface
673685
674686The `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)
3333compile decls = do
3434 bracketted <- rebracket decls
3535 (_, 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
3737 let exts = intercalate "\n" . mapMaybe (externToPs 0 global env) $ bracketted
3838 return (js, exts, env)
src/Language/PureScript/CodeGen/JS.hs+23−13
@@ -20,11 +20,13 @@ module Language.PureScript.CodeGen.JS (
2020import Data.Char
2121import Data.Maybe (fromMaybe, mapMaybe)
2222import Data.List (intercalate)
23+import qualified Data.Map as M
2324import qualified Control.Arrow as A
2425import Control.Arrow ((<+>), second)
2526import Control.Monad (forM)
2627import Control.Applicative
2728
29+import Language.PureScript.TypeChecker (Environment, names)
2830import Language.PureScript.Types
2931import Language.PureScript.Values
3032import Language.PureScript.Names
@@ -33,17 +35,17 @@ import Language.PureScript.Pretty.Common
3335import Language.PureScript.CodeGen.Monad
3436import Language.PureScript.CodeGen.JS.AST as AST
3537
36−declToJs :: Maybe Ident -> ModulePath -> Declaration -> Maybe [JS]
37−declToJs mod mp (ValueDeclaration ident (Abs args ret)) =
38+declToJs :: Maybe Ident -> ModulePath -> Declaration -> Environment -> Maybe [JS]
39+declToJs mod mp (ValueDeclaration ident (Abs args ret)) _ =
3840 Just $ JSFunction (Just ident) args (JSBlock [JSReturn (valueToJs mp ret)]) :
3941 maybe [] (return . setProperty (identToJs ident) (JSVar ident)) mod
40−declToJs mod mp (ValueDeclaration ident val) =
42+declToJs mod mp (ValueDeclaration ident val) _ =
4143 Just $ JSVariableIntroduction ident (Just (valueToJs mp val)) :
4244 maybe [] (return . setProperty (identToJs ident) (JSVar ident)) mod
43−declToJs mod _ (ExternMemberDeclaration member ident _) =
45+declToJs mod _ (ExternMemberDeclaration member ident _) _ =
4446 Just $ JSFunction (Just ident) [Ident "value"] (JSBlock [JSReturn (JSAccessor member (JSVar (Ident "value")))]) :
4547 maybe [] (return . setProperty (show ident) (JSVar ident)) mod
46−declToJs mod mp (DataDeclaration _ _ ctors) =
48+declToJs mod mp (DataDeclaration _ _ ctors) _ =
4749 Just $ flip concatMap ctors $ \(pn@(ProperName ctor), maybeTy) ->
4850 let
4951 ctorJs =
@@ -54,14 +56,22 @@ declToJs mod mp (DataDeclaration _ _ ctors) =
5456 (JSObjectLiteral [ ("ctor", JSStringLiteral (show (Qualified mp pn)))
5557 , ("value", JSVar (Ident "value")) ])])
5658 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 =
5860 Just $ [ JSVariableIntroduction (Ident name) Nothing
5961 , JSApp (JSFunction Nothing [Ident name]
60− (JSBlock (concat $ mapMaybe (declToJs (Just (Ident name)) (subModule mp pn)) decls)))
61− [JSAssignment (JSAssignVariable (Ident name) )
62+ (JSBlock (concat $ mapMaybe (\decl -> declToJs (Just (Ident name)) (subModule mp pn) decl env) decls)))
63+ [JSAssignment (JSAssignVariable (Ident name))
6264 (JSBinary Or (JSVar (Ident name)) (JSObjectLiteral []))]] ++
6365 maybe [] (return . setProperty name (JSVar (Ident name))) mod
64−declToJs _ _ _ = Nothing
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)))
74+declToJs _ _ _ _ = Nothing
6575
6676setProperty :: String -> JS -> Ident -> JS
6777setProperty prop val mod = JSAssignment (JSAssignProperty prop (JSAssignVariable mod)) val
@@ -87,10 +97,10 @@ valueToJs m (Var ident) = qualifiedToJS identToJs ident
8797valueToJs m (TypedValue val _) = valueToJs m val
8898
8999qualifiedToJS :: (a -> String) -> Qualified a -> JS
90−qualifiedToJS f (Qualified (ModulePath parts) a) = delimited (f a : reverse (map show parts))
91− where
92− delimited [part] = JSVar (Ident (part))
93− delimited (part:parts) = JSAccessor part (delimited parts)
100+qualifiedToJS f (Qualified (ModulePath parts) a) =
101+ delimited (f a : reverse (map show parts))
102+ where delimited [part] = JSVar (Ident (part))
103+ delimited (part:parts) = JSAccessor part (delimited parts)
94104
95105bindersToJs :: ModulePath -> [(Binder, Value)] -> JS -> Gen JS
96106bindersToJs m binders val = do
src/Language/PureScript/Declarations.hs+3−1
@@ -38,4 +38,6 @@ data Declaration
3838 | ExternMemberDeclaration String Ident PolyType
3939 | ExternDataDeclaration ProperName Kind
4040 | 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
3030instance Show ProperName where
3131 show = runProperName
3232
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
3437
3538subModule :: ModulePath -> ProperName -> ModulePath
3639subModule (ModulePath mp) name = ModulePath (mp ++ [name])
src/Language/PureScript/Parser/Declarations.hs+18−1
@@ -28,6 +28,7 @@ import qualified Data.Map as M
2828import qualified Text.Parsec as P
2929import qualified Text.Parsec.Pos as P
3030
31+import Language.PureScript.Names
3132import Language.PureScript.Values
3233import Language.PureScript.Types
3334import Language.PureScript.Parser.State
@@ -96,6 +97,21 @@ parseModuleDeclaration = do
9697 decls <- mark (P.many (same *> parseDeclaration))
9798 return $ ModuleDeclaration name decls
9899
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+
99115parseDeclaration :: P.Parsec String ParseState Declaration
100116parseDeclaration = P.choice
101117 [ parseDataDeclaration
@@ -104,7 +120,8 @@ parseDeclaration = P.choice
104120 , parseValueDeclaration
105121 , parseExternDeclaration
106122 , parseFixityDeclaration
107− , parseModuleDeclaration ] P.<?> "declaration"
123+ , parseModuleDeclaration
124+ , parseImportDeclaration ] P.<?> "declaration"
108125
109126parseDeclarations :: P.Parsec String ParseState [Declaration]
110127parseDeclarations = whiteSpace *> mark (P.many (same *> parseDeclaration)) <* P.eof
src/Language/PureScript/TypeChecker.hs+19
@@ -117,3 +117,22 @@ typeCheckAll (FixityDeclaration _ name : rest) = do
117117typeCheckAll (ModuleDeclaration name decls : rest) = do
118118 withModule name $ typeCheckAll decls
119119 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)
2828
2929import qualified Data.Map as M
3030
31−data NameKind = Value | Extern deriving Show
31+data NameKind = Value | Extern | Alias ModulePath Ident deriving Show
3232
3333data TypeDeclarationKind = Data | ExternData | TypeSynonym deriving Show
3434