git.iko.soy/Idris-dev
on master help sign in
Add export functionality to Javascript backend
e861141Niklas Larsson
src/IRTS/CodegenJavaScript.hs+44−9
compare with master
unifiedsplit
@@ -17,6 +17,7 @@ import IRTS.JavaScript.AST
17import Idris.AbsSyntax hiding (TypeCase)
17import Idris.AbsSyntax hiding (TypeCase)
18import IRTS.Bytecode
18import IRTS.Bytecode
19import IRTS.Lang
19import IRTS.Lang
20+import IRTS.Exports
20import IRTS.Simplified
21import IRTS.Simplified
21import IRTS.Defunctionalise
22import IRTS.Defunctionalise
22import IRTS.CodegenCommon
23import IRTS.CodegenCommon
@@ -103,12 +104,12 @@ data JSTarget = Node | JavaScript deriving Eq
103codegenJavaScript :: CodeGenerator
104codegenJavaScript :: CodeGenerator
104codegenJavaScript ci =
105codegenJavaScript ci =
105 codegenJS_all JavaScript (simpleDecls ci)
106 codegenJS_all JavaScript (simpleDecls ci)
106− (includes ci) [] (outputFile ci) (outputType ci)
107+ (includes ci) [] (outputFile ci) (exportDecls ci) (outputType ci)
107
108
108codegenNode :: CodeGenerator
109codegenNode :: CodeGenerator
109codegenNode ci =
110codegenNode ci =
110 codegenJS_all Node (simpleDecls ci)
111 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)
112
113
113codegenJS_all
114codegenJS_all
114 :: JSTarget
115 :: JSTarget
@@ -116,14 +117,16 @@ codegenJS_all
116 -> [FilePath]
117 -> [FilePath]
117 -> [String]
118 -> [String]
118 -> FilePath
119 -> FilePath
120+ -> [ExportIFace]
119 -> OutputType
121 -> OutputType
120 -> IO ()
122 -> IO ()
121−codegenJS_all target definitions includes libs filename outputType = do
123+codegenJS_all target definitions includes libs filename exports outputType = do
122 let bytecode = map toBC definitions
124 let bytecode = map toBC definitions
123 let info = initCompileInfo bytecode
125 let info = initCompileInfo bytecode
124 let js = concatMap (translateDecl info) bytecode
126 let js = concatMap (translateDecl info) bytecode
125 let full = concatMap processFunction js
127 let full = concatMap processFunction js
128+ let exportedNames = map translateName ((getExpNames exports) ++ [sUN "call__IO"])
126− let code = deadCodeElim full
129+ let code = deadCodeElim exportedNames full
127 let ext = takeExtension filename
130 let ext = takeExtension filename
128 let isHtml = target == JavaScript && ext == ".html"
131 let isHtml = target == JavaScript && ext == ".html"
129 let htmlPrologue = T.pack "<!doctype html><html><head><script>\n"
132 let htmlPrologue = T.pack "<!doctype html><html><head><script>\n"
@@ -150,6 +153,7 @@ codegenJS_all target definitions includes libs filename outputType = do
150 let jsSource = T.pack runtime
153 let jsSource = T.pack runtime
151 `T.append` T.concat (map compileJS opt)
154 `T.append` T.concat (map compileJS opt)
152 `T.append` T.concat (map compileJS cons)
155 `T.append` T.concat (map compileJS cons)
156+ `T.append` T.concat (map compileJS (map genInterface (concatMap getExps exports)))
153 `T.append` main
157 `T.append` main
154 `T.append` invokeMain
158 `T.append` invokeMain
155 let source = if isHtml
159 let source = if isHtml
@@ -161,14 +165,17 @@ codegenJS_all target definitions includes libs filename outputType = do
161 , writable = True
165 , writable = True
162 })
166 })
163 where
167 where
164− deadCodeElim :: [JS] -> [JS]
168+ deadCodeElim :: [String] -> [JS] -> [JS]
165− deadCodeElim js = concatMap collectFunctions js
169+ deadCodeElim exports js = concatMap (collectFunctions exports) js
166 where
170 where
167− collectFunctions :: JS -> [JS]
171+ collectFunctions :: [String] -> JS -> [JS]
168− collectFunctions fun@(JSAlloc name _)
172+ collectFunctions _ fun@(JSAlloc name _)
169 | name == translateName (sMN 0 "runMain") = [fun]
173 | name == translateName (sMN 0 "runMain") = [fun]
170
174
175+ collectFunctions exports fun@(JSAlloc name _)
176+ | name `elem` exports = [fun]
177+
171− collectFunctions fun@(JSAlloc name (Just (JSFunction _ body))) =
178+ collectFunctions _ fun@(JSAlloc name (Just (JSFunction _ body))) =
172 let invokations = sum $ map (
179 let invokations = sum $ map (
173 \x -> execState (countInvokations name x) 0
180 \x -> execState (countInvokations name x) 0
174 ) js
181 ) js
@@ -273,6 +280,7 @@ codegenJS_all target definitions includes libs filename outputType = do
273
280
274 invokeMain :: T.Text
281 invokeMain :: T.Text
275 invokeMain = compileJS $ JSApp (JSIdent "main") []
282 invokeMain = compileJS $ JSApp (JSIdent "main") []
283+ getExps (Export _ _ exp) = exp
276
284
277optimizeConstructors :: [JS] -> ([JS], [JS])
285optimizeConstructors :: [JS] -> ([JS], [JS])
278optimizeConstructors js =
286optimizeConstructors js =
@@ -1237,6 +1245,33 @@ jsPUSH args = JSApp (JSProj jsCALLSTACK "push") args
1237jsPOP :: JS
1245jsPOP :: JS
1238jsPOP = JSApp (JSProj jsCALLSTACK "pop") []
1246jsPOP = JSApp (JSProj jsCALLSTACK "pop") []
1239
1247
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+
1240translateBC :: CompileInfo -> BC -> JS
1275translateBC :: CompileInfo -> BC -> JS
1241translateBC info bc
1276translateBC info bc
1242 | ASSIGN r1 r2 <- bc = jsASSIGN info r1 r2
1277 | ASSIGN r1 r2 <- bc = jsASSIGN info r1 r2