git.iko.soy/rowtype-yoga/purescript-native
on golang help sign in
Include foreign JS in psc output
f56ed2bGary Burgess
psc/Main.hs+12−2
compare with golang
unifiedsplit
@@ -42,8 +42,10 @@ import qualified Data.Map as M
42import qualified Language.PureScript as P
42import qualified Language.PureScript as P
43import qualified Language.PureScript.CodeGen.JS as J
43import qualified Language.PureScript.CodeGen.JS as J
44import qualified Language.PureScript.Constants as C
44import qualified Language.PureScript.Constants as C
45+import qualified Language.PureScript.CoreFn as CF
45import qualified Paths_purescript as Paths
46import qualified Paths_purescript as Paths
46
47
48+
47import Foreign
49import Foreign
48
50
49data PSCOptions = PSCOptions
51data PSCOptions = PSCOptions
@@ -82,7 +84,7 @@ compile (PSCOptions input inputForeign opts stdin output externs usePrefix) = do
82 hPutStrLn stderr err
84 hPutStrLn stderr err
83 exitFailure
85 exitFailure
84 Right (ms, foreigns) ->
86 Right (ms, foreigns) ->
85− case runPSC opts (compileJS (map snd ms) M.empty prefix) of
87+ case runPSC opts (compileJS (map snd ms) foreigns prefix) of
86 Left errs -> do
88 Left errs -> do
87 hPutStrLn stderr (P.prettyPrintMultipleErrors (P.optionsVerboseErrors opts) errs)
89 hPutStrLn stderr (P.prettyPrintMultipleErrors (P.optionsVerboseErrors opts) errs)
88 exitFailure
90 exitFailure
@@ -106,13 +108,21 @@ compileJS :: forall m. (Functor m, Applicative m, MonadError P.MultipleErrors m,
106 => [P.Module] -> M.Map P.ModuleName String -> [String] -> m (String, String)
108 => [P.Module] -> M.Map P.ModuleName String -> [String] -> m (String, String)
107compileJS ms foreigns prefix = do
109compileJS ms foreigns prefix = do
108 (modulesToCodeGen, exts, env, nextVar) <- P.compile ms
110 (modulesToCodeGen, exts, env, nextVar) <- P.compile ms
109− js <- concat <$> evalSupplyT nextVar (traverse J.moduleToJs modulesToCodeGen)
111+ js <- concat <$> evalSupplyT nextVar (traverse codegenModule modulesToCodeGen)
110 js' <- generateMain env js
112 js' <- generateMain env js
111 let pjs = unlines $ map ("// " ++) prefix ++ [P.prettyPrintJS js']
113 let pjs = unlines $ map ("// " ++) prefix ++ [P.prettyPrintJS js']
112 return (pjs, exts)
114 return (pjs, exts)
113
115
114 where
116 where
115
117
118+ --codegenModule :: CF.Module CF.Ann -> m [J.JS]
119+ codegenModule m =
120+ J.moduleToJs m $ (\js -> J.JSApp (J.JSFunction Nothing [] (J.JSBlock
121+ [ J.JSVariableIntroduction "exports" (Just $ J.JSObjectLiteral [])
122+ , J.JSRaw js
123+ , J.JSReturn (J.JSVar "exports")
124+ ])) []) <$> CF.moduleName m `M.lookup` foreigns
125+
116 generateMain :: P.Environment -> [J.JS] -> m [J.JS]
126 generateMain :: P.Environment -> [J.JS] -> m [J.JS]
117 generateMain env js = do
127 generateMain env js = do
118 mainName <- asks P.optionsMain
128 mainName <- asks P.optionsMain
src/Language/PureScript.hs+1−1
@@ -210,7 +210,7 @@ make outputDir ms prefix = do
210 corefn = CoreFn.moduleToCoreFn env' mod'
210 corefn = CoreFn.moduleToCoreFn env' mod'
211 [renamed] = renameInModules [corefn]
211 [renamed] = renameInModules [corefn]
212
212
213− pjs <- prettyPrintJS <$> moduleToJs renamed
213+ pjs <- prettyPrintJS <$> moduleToJs renamed Nothing
214 let js = unlines $ map ("// " ++) prefix ++ [pjs]
214 let js = unlines $ map ("// " ++) prefix ++ [pjs]
215 let exts = unlines $ map ("-- " ++) prefix ++ [moduleToPs mod' env']
215 let exts = unlines $ map ("-- " ++) prefix ++ [moduleToPs mod' env']
216
216
src/Language/PureScript/CodeGen/JS.hs+4−3
@@ -49,8 +49,8 @@ import qualified Language.PureScript.Constants as C
49-- module.
49-- module.
50--
50--
51moduleToJs :: forall m mode. (Applicative m, Monad m, MonadReader (Options mode) m, MonadSupply m)
51moduleToJs :: forall m mode. (Applicative m, Monad m, MonadReader (Options mode) m, MonadSupply m)
52− => Module Ann -> m [JS]
52+ => Module Ann -> Maybe JS -> m [JS]
53−moduleToJs (Module coms mn imps exps foreigns decls) = do
53+moduleToJs (Module coms mn imps exps foreigns decls) foreign = do
54 additional <- asks optionsAdditional
54 additional <- asks optionsAdditional
55 jsImports <- T.traverse importToJs . delete (ModuleName [ProperName C.prim]) . (\\ [mn]) $ imps
55 jsImports <- T.traverse importToJs . delete (ModuleName [ProperName C.prim]) . (\\ [mn]) $ imps
56 jsDecls <- mapM bindToJs decls
56 jsDecls <- mapM bindToJs decls
@@ -59,7 +59,8 @@ moduleToJs (Module coms mn imps exps foreigns decls) = do
59 comments <- not <$> asks optionsNoComments
59 comments <- not <$> asks optionsNoComments
60 let strict = JSStringLiteral "use strict"
60 let strict = JSStringLiteral "use strict"
61 let header = if comments && not (null coms) then JSComment coms strict else strict
61 let header = if comments && not (null coms) then JSComment coms strict else strict
62+ let foreign' = [JSVariableIntroduction "$foreign" foreign | not $ null foreigns || foreign == Nothing]
62− let moduleBody = header : jsImports ++ concat optimized
63+ let moduleBody = header : foreign' ++ jsImports ++ concat optimized
63 let foreignExps = exps `intersect` (fst `map` foreigns)
64 let foreignExps = exps `intersect` (fst `map` foreigns)
64 let standardExps = exps \\ foreignExps
65 let standardExps = exps \\ foreignExps
65 let exps' = JSObjectLiteral $ map (runIdent &&& JSVar . identToJs) standardExps
66 let exps' = JSObjectLiteral $ map (runIdent &&& JSVar . identToJs) standardExps