@@ -19,9 +19,52 @@ import Util.System
1919import Control.Arrow
2020import Data.Char
2121import Data.List
22+import qualified Data.Map as Map
2223import System.IO
2324
2425type 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 ++ ";"
2568
2669idrNamespace :: NamespaceName
2770idrNamespace = "__IDR__"
@@ -34,6 +77,7 @@ codegenJavaScript
3477codegenJavaScript definitions filename outputType =
3578 writeFile filename output
3679 where
80+ modules = foldl' insertDecl EmptyModule def
3781 def = map (first translateNamespace) definitions
3882
3983 mainLoop :: String
@@ -44,7 +88,7 @@ codegenJavaScript definitions filename outputType =
4488
4589 output :: String
4690 output = concat [ idrRuntime
47− , concatMap (translateModule Nothing) def
91+ , show modules
4892 , mainLoop
4993 ]
5094