git.iko.soy/Idris-dev
on master help sign in
javascript: fold modules
c7829ffraichoo
src/IRTS/CodegenJavaScript.hs+45−1
compare with master
unifiedsplit
@@ -19,9 +19,52 @@ import Util.System
19import Control.Arrow
19import Control.Arrow
20import Data.Char
20import Data.Char
21import Data.List
21import Data.List
22+import qualified Data.Map as Map
22import System.IO
23import System.IO
23
24
24type NamespaceName = String
25type NamespaceName = String
26+type Decl = ([String], SDecl)
27+
28+data ModuleTree = Module { moduleName :: String
29+ , functions :: [SDecl]
30+ , subModules :: Map.Map String ModuleTree
31+ }
32+ | EmptyModule
33+
34+insertDecl :: ModuleTree -> Decl -> ModuleTree
35+insertDecl EmptyModule ([modname], decl) =
36+ Module modname [decl] Map.empty
37+
38+insertDecl EmptyModule (m:s:ms, decl) =
39+ Module m [] (Map.singleton s (insertDecl EmptyModule (s:ms, decl)))
40+
41+insertDecl mod ([modname], decl)
42+ | moduleName mod == modname =
43+ mod { functions = decl : functions mod }
44+
45+insertDecl mod (_:m:ms, decl)
46+ | Nothing <- Map.lookup m (subModules mod) =
47+ mod {
48+ subModules =
49+ Map.insert m (insertDecl EmptyModule (m:ms, decl)) (subModules mod)
50+ }
51+ | Just s <- Map.lookup m (subModules mod) =
52+ mod {
53+ subModules =
54+ Map.insert m (insertDecl s (m:ms, decl)) (subModules mod)
55+ }
56+
57+instance Show ModuleTree where
58+ show EmptyModule = ""
59+ show (Module name fs subs) =
60+ createModule Nothing name body
61+ where
62+ functions = concatMap (translateDeclaration name) fs
63+ submodules = Map.foldWithKey (translateSubModule name) "" subs
64+ body = functions ++ submodules
65+
66+ translateSubModule toplevel name mod js =
67+ js ++ show mod ++ toplevel ++ "." ++ name ++ "=" ++ name ++ ";"
25
68
26idrNamespace :: NamespaceName
69idrNamespace :: NamespaceName
27idrNamespace = "__IDR__"
70idrNamespace = "__IDR__"
@@ -34,6 +77,7 @@ codegenJavaScript
34codegenJavaScript definitions filename outputType =
77codegenJavaScript definitions filename outputType =
35 writeFile filename output
78 writeFile filename output
36 where
79 where
80+ modules = foldl' insertDecl EmptyModule def
37 def = map (first translateNamespace) definitions
81 def = map (first translateNamespace) definitions
38
82
39 mainLoop :: String
83 mainLoop :: String
@@ -44,7 +88,7 @@ codegenJavaScript definitions filename outputType =
44
88
45 output :: String
89 output :: String
46 output = concat [ idrRuntime
90 output = concat [ idrRuntime
47− , concatMap (translateModule Nothing) def
91+ , show modules
48 , mainLoop
92 , mainLoop
49 ]
93 ]
50
94