git.iko.soy/elk
on 7a8b568 help sign in
elk/src/Generate/JavaScript.hs
122 lines 3.3 kB history raw
1{-# OPTIONS_GHC -Wall #-}
2{-# LANGUAGE OverloadedStrings #-}
3module Generate.JavaScript (generate) where
5import Prelude hiding (init)
6import Data.Monoid ((<>))
7import qualified Data.List as List
8import qualified Data.Map as Map
9import qualified Data.Set as Set
10import qualified Data.Text as Text
11import qualified Data.ByteString.Builder as BS
13import qualified AST.Effects as Effects
14import qualified AST.Expression.Optimized as Opt
15import qualified AST.Module.Name as ModuleName
16import qualified AST.Variable as Var
17import qualified Elm.Package as Pkg
18import qualified Elm.Compiler.Objects.Internal as Obj
19import qualified Generate.JavaScript.Builder as JS
20import qualified Generate.JavaScript.Effects as Effects
21import qualified Generate.JavaScript.Expression as JS
22import qualified Generate.JavaScript.Variable as JS
26-- GENERATE JAVASCRIPT
29generate :: Obj.SymbolTable -> Obj.Graph -> Obj.Roots -> (Set.Set ModuleName.Canonical, BS.Builder)
30generate symbols (Obj.Graph graph) roots =
31 let
32 (State builders _ kernels effects table) =
33 List.foldl' (crawl graph) (init symbols) (Obj.toGlobals roots)
35 managers =
36 fst $ JS.run table (Effects.generate effects)
38 javascript =
39 List.foldl' (\rest stmt -> JS.encodeUtf8 stmt <> rest) managers builders
40 in
41 (kernels, javascript)
45-- DCE STATE
48data State =
49 State
50 { _stmts :: [JS.Stmt]
51 , _seen :: Set.Set Var.Global
52 , _kernels :: Set.Set ModuleName.Canonical
53 , _effects :: Map.Map ModuleName.Canonical Effects.ManagerType
54 , _table :: JS.Table
55 }
58init :: Obj.SymbolTable -> State
59init symbols =
60 State [] Set.empty Set.empty Map.empty (JS.init symbols)
64-- DEAD CODE ELIMINATION
67type Graph = Map.Map Var.Global Opt.Decl
70crawl :: Graph -> State -> Var.Global -> State
71crawl graph state@(State js seen kernels effects table) name@(Var.Global home _) =
72 if Set.member name seen then
73 state
75 else if home == virtualDomDebug then
76 state
78 else
79 case Map.lookup name graph of
80 Just decl ->
81 crawlDecl graph name decl state
83 Nothing ->
84 if ModuleName.canonicalIsKernel home then
85 State js seen (Set.insert home kernels) effects table
86 else
87 error (crawlError name)
90crawlDecl :: Graph -> Var.Global -> Opt.Decl -> State -> State
91crawlDecl graph var@(Var.Global home name) (Opt.Decl deps fx body) state =
92 let
93 newState =
94 state { _seen = Set.insert var (_seen state) }
96 (State stmts seen kernels effects table) =
97 Set.foldl' (crawl graph) newState deps
99 (stmt, newTable) =
100 JS.run table (JS.generateDecl home name body)
101 in
102 State
103 { _stmts = stmt : stmts
104 , _seen = seen
105 , _kernels = kernels
106 , _effects = maybe id (Map.insert home) fx effects
107 , _table = newTable
108 }
111crawlError :: Var.Global -> String
112crawlError (Var.Global (ModuleName.Canonical pkg home) name) =
113 Text.unpack $
114 "compiler bug manifesting in Generate.JavaScript\n"
115 <> "could not find " <> Pkg.toText pkg <> " " <> ModuleName.toText home <> "." <> name <> "\n"
116 <> "please report at <https://github.com/elm-lang/elm-compiler/issues>\n"
117 <> "try to make an <http://sscce.org/> that demonstrates the issue!"
120virtualDomDebug :: ModuleName.Canonical
121virtualDomDebug =
122 ModuleName.inVirtualDom "VirtualDom.Debug"