git.iko.soy/rowtype-yoga/purescript-native
on golang help sign in
implement declToJs for ImportDeclarations

This changes `declToJs` so it takes an Environment parameter as well.

commitc50274633557879d0ee3647117727110f7f76f45 authorBogdan Popa <popa.bogdanp@gmail.com> dateSat 16 Nov 2013, 23:44 (13 years ago) parenta80fa9a
2 files changed+24−14
compare with golang
unifiedsplit
src/Language/PureScript.hs+1−1 src/Language/PureScript/CodeGen/JS.hs+23−13
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