on master help sign in
Add export functionality to Javascript backend
commite861141c5e0304b07b198c10f444c7ef231a53b2 authorNiklas Larsson <niklas@mm.st> dateSun 3 Jul 2016, 00:47 (10 years ago) parent8885f72
1 file changed+44−9
src/IRTS/CodegenJavaScript.hs+44−9
src/IRTS/CodegenJavaScript.hs+44−9
@@ -17,6 +17,7 @@ import IRTS.JavaScript.AST
1717import Idris.AbsSyntax hiding (TypeCase)
1818import IRTS.Bytecode
1919import IRTS.Lang
20+import IRTS.Exports
2021import IRTS.Simplified
2122import IRTS.Defunctionalise
2223import IRTS.CodegenCommon
@@ -103,12 +104,12 @@ data JSTarget = Node | JavaScript deriving Eq
103104codegenJavaScript :: CodeGenerator
104105codegenJavaScript ci =
105106 codegenJS_all JavaScript (simpleDecls ci)
106− (includes ci) [] (outputFile ci) (outputType ci)
107+ (includes ci) [] (outputFile ci) (exportDecls ci) (outputType ci)
107108
108109codegenNode :: CodeGenerator
109110codegenNode ci =
110111 codegenJS_all Node (simpleDecls ci)
111− (includes ci) (compileLibs ci) (outputFile ci) (outputType ci)
112+ (includes ci) (compileLibs ci) (outputFile ci) (exportDecls ci) (outputType ci)
112113
113114codegenJS_all
114115 :: JSTarget
@@ -116,14 +117,16 @@ codegenJS_all
116117 -> [FilePath]
117118 -> [String]
118119 -> FilePath
120+ -> [ExportIFace]
119121 -> OutputType
120122 -> IO ()
121−codegenJS_all target definitions includes libs filename outputType = do
123+codegenJS_all target definitions includes libs filename exports outputType = do
122124 let bytecode = map toBC definitions
123125 let info = initCompileInfo bytecode
124126 let js = concatMap (translateDecl info) bytecode
125127 let full = concatMap processFunction js
126− let code = deadCodeElim full
128+ let exportedNames = map translateName ((getExpNames exports) ++ [sUN "call__IO"])
129+ let code = deadCodeElim exportedNames full
127130 let ext = takeExtension filename
128131 let isHtml = target == JavaScript && ext == ".html"
129132 let htmlPrologue = T.pack "<!doctype html><html><head><script>\n"
@@ -150,6 +153,7 @@ codegenJS_all target definitions includes libs filename outputType = do
150153 let jsSource = T.pack runtime
151154 `T.append` T.concat (map compileJS opt)
152155 `T.append` T.concat (map compileJS cons)
156+ `T.append` T.concat (map compileJS (map genInterface (concatMap getExps exports)))
153157 `T.append` main
154158 `T.append` invokeMain
155159 let source = if isHtml
@@ -161,14 +165,17 @@ codegenJS_all target definitions includes libs filename outputType = do
161165 , writable = True
162166 })
163167 where
164− deadCodeElim :: [JS] -> [JS]
165− deadCodeElim js = concatMap collectFunctions js
168+ deadCodeElim :: [String] -> [JS] -> [JS]
169+ deadCodeElim exports js = concatMap (collectFunctions exports) js
166170 where
167− collectFunctions :: JS -> [JS]
168− collectFunctions fun@(JSAlloc name _)
171+ collectFunctions :: [String] -> JS -> [JS]
172+ collectFunctions _ fun@(JSAlloc name _)
169173 | name == translateName (sMN 0 "runMain") = [fun]
170174
171− collectFunctions fun@(JSAlloc name (Just (JSFunction _ body))) =
175+ collectFunctions exports fun@(JSAlloc name _)
176+ | name `elem` exports = [fun]
177+
178+ collectFunctions _ fun@(JSAlloc name (Just (JSFunction _ body))) =
172179 let invokations = sum $ map (
173180 \x -> execState (countInvokations name x) 0
174181 ) js
@@ -273,6 +280,7 @@ codegenJS_all target definitions includes libs filename outputType = do
273280
274281 invokeMain :: T.Text
275282 invokeMain = compileJS $ JSApp (JSIdent "main") []
283+ getExps (Export _ _ exp) = exp
276284
277285optimizeConstructors :: [JS] -> ([JS], [JS])
278286optimizeConstructors js =
@@ -1237,6 +1245,33 @@ jsPUSH args = JSApp (JSProj jsCALLSTACK "push") args
12371245jsPOP :: JS
12381246jsPOP = JSApp (JSProj jsCALLSTACK "pop") []
12391247
1248+genInterface :: Export -> JS
1249+genInterface (ExportData name) = JSNoop
1250+genInterface (ExportFun name (FStr jsName) ret args) = JSAlloc jsName
1251+ (Just (JSFunction [] (JSSeq $
1252+ jsFUNPRELUDE ++
1253+ pushArgs nargs ++
1254+ [jsSTOREOLD d,
1255+ jsBASETOP d 0,
1256+ jsADDTOP d nargs,
1257+ jsCALL d name] ++
1258+ retval ret)))
1259+ where
1260+ nargs = length args
1261+ d = CompileInfo [] [] False
1262+ pushArg n = JSAssign (jsTOP n) (JSIndex (JSIdent "arguments") (JSNum (JSInt n)))
1263+ pushArgs 0 = []
1264+ pushArgs n = (pushArg (n-1)):pushArgs (n-1)
1265+ retval (FIO t) = [JSApp (JSIdent "i$RUN") [],
1266+ JSAssign (jsTOP 0) JSNull,
1267+ JSAssign (jsTOP 1) JSNull,
1268+ JSAssign (jsTOP 2) (translateReg RVal),
1269+ jsSTOREOLD d,
1270+ jsBASETOP d 0,
1271+ jsADDTOP d 3,
1272+ jsCALL d (sUN "call__IO")] ++ retval t
1273+ retval t = [JSApp (JSIdent "i$RUN") [], JSReturn (translateReg RVal)]
1274+
12401275translateBC :: CompileInfo -> BC -> JS
12411276translateBC info bc
12421277 | ASSIGN r1 r2 <- bc = jsASSIGN info r1 r2