git.iko.soy/elk
on master help sign in
Code gen can customize how variables are generated

For example: - Infix operators are now _ops24 instead of _ops[‘>>’] - Variables in bundles can refer to _a[‘b2’] instead of _a[‘_elm_lang$core$Maybe$Just’] The overall changes should make bundling possible, and make the resulting code easier for minifiers to deal with.

commitceb91752930c970026fdead582bd5979114790f7 authorEvan Czaplicki <evancz@users.noreply.github.com> dateFri 31 Mar 2017, 13:07 (10 years ago) parent12fbd47
13 files changed+472−326
compare with master
unifiedsplit
elm-compiler.cabal+1 src/Elm/Compiler.hs+10−10 src/Elm/Compiler/Module.hs+1−11 src/Elm/Compiler/Objects.hs+2−1 src/Elm/Compiler/Objects/Internal.hs+36−3 src/Generate/JavaScript.hs+27−86 src/Generate/JavaScript/Builder.hs+2−2 src/Generate/JavaScript/BuiltIn.hs+70−42 src/Generate/JavaScript/Effects.hs+82 src/Generate/JavaScript/Expression.hs+89−77 src/Generate/JavaScript/Foreign.hs+2−3 src/Generate/JavaScript/Literal.hs+7−6 src/Generate/JavaScript/Variable.hs+143−85
elm-compiler.cabal+1
@@ -90,6 +90,7 @@ Library
9090 Generate.JavaScript,
9191 Generate.JavaScript.Builder,
9292 Generate.JavaScript.BuiltIn,
93+ Generate.JavaScript.Effects,
9394 Generate.JavaScript.Expression,
9495 Generate.JavaScript.Foreign,
9596 Generate.JavaScript.Helpers,
src/Elm/Compiler.hs+10−10
@@ -1,14 +1,14 @@
11{-# OPTIONS_GHC -Wall #-}
22module Elm.Compiler
3− ( version
4− , parseDependencies, Tag(..)
5− , compile, Context(..), Result(..)
6− , generate
7− , Localizer, dummyLocalizer
8− , Error, errorToDoc, errorToJson
9− , Warning, warningToDoc, warningToJson
10− )
11− where
3+ ( version
4+ , parseDependencies, Tag(..)
5+ , compile, Context(..), Result(..)
6+ , generate
7+ , Localizer, dummyLocalizer
8+ , Error, errorToDoc, errorToJson
9+ , Warning, warningToDoc, warningToJson
10+ )
11+ where
1212
1313import qualified Data.Aeson as Json
1414import qualified Data.Map as Map
@@ -152,7 +152,7 @@ docsGen isExposed (Module.Module name info) =
152152-- CODE GENERATION
153153
154154
155−generate :: Obj.Graph -> Obj.Roots -> (Set.Set M.Canonical, BS.Builder)
155+generate :: Obj.SymbolTable -> Obj.Graph -> Obj.Roots -> (Set.Set M.Canonical, BS.Builder)
156156generate =
157157 JS.generate
158158
src/Elm/Compiler/Module.hs+1−11
@@ -20,7 +20,6 @@ module Elm.Compiler.Module
2020
2121 -- canonical names
2222 , ModuleName.Canonical(..)
23− , qualifiedVar
2423 )
2524 where
2625
@@ -36,7 +35,6 @@ import qualified AST.Module as Module
3635import qualified AST.Module.Name as ModuleName
3736import qualified Elm.Compiler.Type as PublicType
3837import qualified Elm.Compiler.Type.Extract as Extract
39−import qualified Generate.JavaScript.Variable as Gen
4038
4139
4240
@@ -45,7 +43,7 @@ import qualified Generate.JavaScript.Variable as Gen
4543
4644interfaceAliasedTypes :: Module.Interface -> Map.Map Text PublicType.Type
4745interfaceAliasedTypes interface =
48− Map.map Extract.extract (Module.iTypes interface)
46+ Map.map Extract.extract (Module.iTypes interface)
4947
5048
5149programTypes :: Module.Interfaces -> ModuleName.Canonical -> Maybe PublicType.Program
@@ -136,11 +134,3 @@ instance Json.FromJSON RawForJson where
136134 parseJSON _ =
137135 fail "expecting the module name to be a string"
138136
139−
140−
141−-- CANONICAL NAMES
142−
143−
144−qualifiedVar :: ModuleName.Canonical -> Text -> Text
145−qualifiedVar =
146− Gen.qualified
src/Elm/Compiler/Objects.hs+2−1
@@ -1,6 +1,7 @@
11{-# OPTIONS_GHC -Wall #-}
22module Elm.Compiler.Objects
3− ( Graph
3+ ( Symbol(..)
4+ , Graph
45 , union
56 , unions
67 , Roots
src/Elm/Compiler/Objects/Internal.hs+36−3
@@ -5,6 +5,9 @@ module Elm.Compiler.Objects.Internal
55 , fromModule
66 , union
77 , unions
8+ , SymbolTable
9+ , Symbol(..)
10+ , lookup
811 , Roots
912 , root
1013 , toGlobals
@@ -12,7 +15,9 @@ module Elm.Compiler.Objects.Internal
1215 where
1316
1417
18+import Prelude hiding (lookup)
1519import Control.Arrow (first)
20+import Control.Monad (liftM, liftM2)
1621import Data.Binary
1722import qualified Data.Map as Map
1823
@@ -24,7 +29,7 @@ import qualified Elm.Package as Pkg
2429
2530
2631
27−-- OBJECTS
32+-- OBJECT GRAPH
2833
2934
3035newtype Graph =
@@ -32,7 +37,7 @@ newtype Graph =
3237
3338
3439
35−-- HELPERS
40+-- OBJECT GRAPH HELPERS
3641
3742
3843fromModule :: Module.Optimized -> Graph
@@ -57,6 +62,26 @@ destruct (Graph graph) =
5762
5863
5964
65+-- SYMBOLS
66+
67+
68+data Symbol =
69+ Symbol
70+ { _home :: !Word16
71+ , _name :: !Word32
72+ }
73+
74+
75+newtype SymbolTable =
76+ SymbolTable (Map.Map Var.Global Symbol)
77+
78+
79+lookup :: Var.Global -> SymbolTable -> Maybe Symbol
80+lookup var (SymbolTable symbols) =
81+ Map.lookup var symbols
82+
83+
84+
6085-- ROOTS
6186
6287
@@ -85,4 +110,12 @@ instance Binary Graph where
85110 put dict
86111
87112 get =
88− Graph <$> get
113+ liftM Graph get
114+
115+
116+instance Binary Symbol where
117+ put (Symbol home name) =
118+ put home >> put name
119+
120+ get =
121+ liftM2 Symbol get get
src/Generate/JavaScript.hs+27−86
@@ -2,13 +2,12 @@
22{-# LANGUAGE OverloadedStrings #-}
33module Generate.JavaScript (generate) where
44
5−import qualified Control.Monad.State as State
5+import Prelude hiding (init)
66import Data.Monoid ((<>))
77import qualified Data.List as List
88import qualified Data.Map as Map
99import qualified Data.Set as Set
1010import qualified Data.Text as Text
11−import Data.Text (Text)
1211import qualified Data.ByteString.Builder as BS
1312
1413import qualified AST.Effects as Effects
@@ -18,8 +17,8 @@ import qualified AST.Variable as Var
1817import qualified Elm.Package as Pkg
1918import qualified Elm.Compiler.Objects.Internal as Obj
2019import qualified Generate.JavaScript.Builder as JS
20+import qualified Generate.JavaScript.Effects as Effects
2121import qualified Generate.JavaScript.Expression as JS
22−import qualified Generate.JavaScript.Helpers as JS
2322import qualified Generate.JavaScript.Variable as JS
2423
2524
@@ -27,37 +26,38 @@ import qualified Generate.JavaScript.Variable as JS
2726-- GENERATE JAVASCRIPT
2827
2928
30−generate :: Obj.Graph -> Obj.Roots -> (Set.Set ModuleName.Canonical, BS.Builder)
31−generate (Obj.Graph graph) roots =
29+generate :: Obj.SymbolTable -> Obj.Graph -> Obj.Roots -> (Set.Set ModuleName.Canonical, BS.Builder)
30+generate symbols (Obj.Graph graph) roots =
3231 let
33− (State builders _ natives effects) =
34− List.foldl' (crawl graph) empty (Obj.toGlobals roots)
32+ (State builders _ natives effects table) =
33+ List.foldl' (crawl graph) (init symbols) (Obj.toGlobals roots)
3534
3635 managers =
37− Map.foldrWithKey addManager "" effects
36+ fst $ JS.run table (Effects.generate effects)
3837
3938 javascript =
40− List.foldl' (\rest js -> js <> rest) managers builders
39+ List.foldl' (\rest stmt -> JS.encodeUtf8 stmt <> rest) managers builders
4140 in
4241 (natives, javascript)
4342
4443
4544
46−-- DEAD CODE ELIMINATION
45+-- DCE STATE
4746
4847
4948data State =
5049 State
51− { _js :: [BS.Builder]
50+ { _stmts :: [JS.Stmt]
5251 , _seen :: Set.Set Var.Global
5352 , _natives :: Set.Set ModuleName.Canonical
5453 , _effects :: Map.Map ModuleName.Canonical Effects.ManagerType
54+ , _table :: JS.Table
5555 }
5656
5757
58−empty :: State
59−empty =
60− State [] Set.empty Set.empty Map.empty
58+init :: Obj.SymbolTable -> State
59+init symbols =
60+ State [] Set.empty Set.empty Map.empty (JS.init symbols)
6161
6262
6363
@@ -68,7 +68,7 @@ type Graph = Map.Map Var.Global Opt.Decl
6868
6969
7070crawl :: Graph -> State -> Var.Global -> State
71−crawl graph state@(State js seen natives effects) name@(Var.Global home _) =
71+crawl graph state@(State js seen natives effects table) name@(Var.Global home _) =
7272 if Set.member name seen then
7373 state
7474
@@ -82,35 +82,29 @@ crawl graph state@(State js seen natives effects) name@(Var.Global home _) =
8282
8383 Nothing ->
8484 if ModuleName.canonicalIsNative home then
85− State js seen (Set.insert home natives) effects
85+ State js seen (Set.insert home natives) effects table
8686 else
8787 error (crawlError name)
8888
8989
90−virtualDomDebug :: ModuleName.Canonical
91−virtualDomDebug =
92− ModuleName.inVirtualDom "VirtualDom.Debug"
93−
94−
9590crawlDecl :: Graph -> Var.Global -> Opt.Decl -> State -> State
96−crawlDecl graph name@(Var.Global home _) (Opt.Decl deps mfx body) state =
91+crawlDecl graph var@(Var.Global home name) (Opt.Decl deps fx body) state =
9792 let
9893 newState =
99− state { _seen = Set.insert name (_seen state) }
94+ state { _seen = Set.insert var (_seen state) }
10095
101− (State js seen natives effects) =
96+ (State stmts seen natives effects table) =
10297 Set.foldl' (crawl graph) newState deps
10398
104− newEffects =
105− case mfx of
106− Nothing -> effects
107− Just fx -> Map.insert home fx effects
99+ (stmt, newTable) =
100+ JS.run table (JS.generateDecl home name body)
108101 in
109102 State
110− { _js = generateDecl name body : js
103+ { _stmts = stmt : stmts
111104 , _seen = seen
112105 , _natives = natives
113− , _effects = newEffects
106+ , _effects = maybe id (Map.insert home) fx effects
107+ , _table = newTable
114108 }
115109
116110
@@ -123,59 +117,6 @@ crawlError (Var.Global (ModuleName.Canonical pkg home) name) =
123117 <> "try to make an <http://sscce.org/> that demonstrates the issue!"
124118
125119
126−generateDecl :: Var.Global -> Opt.Def -> BS.Builder
127−generateDecl (Var.Global home name) def =
128− let
129− genBody =
130− JS.generateDecl home name def
131− in
132− JS.encodeUtf8 (State.evalState genBody 0)
133−
134−
135−
136−-- ADD EFFECT MANAGER
137−
138−
139−addManager :: ModuleName.Canonical -> Effects.ManagerType -> BS.Builder -> BS.Builder
140−addManager name manager builder =
141− JS.encodeUtf8 [genManager name manager] <> builder
142−
143−
144−genManager :: ModuleName.Canonical -> Effects.ManagerType -> JS.Stmt
145−genManager moduleName@(ModuleName.Canonical pkg _) manager =
146− let
147− managers =
148− JS.coreNative "Platform" "effectManagers"
149−
150− managerName =
151− JS.String (ModuleName.canonicalToText moduleName)
152−
153− entry name =
154− ( JS.IdProp (JS.Id name)
155− , JS.ref (JS.qualified moduleName name)
156− )
157−
158− managerEntries =
159− [ "pkg" ==> Pkg.toText pkg
160− , entry "init"
161− , entry "onEffects"
162− , entry "onSelfMsg"
163− ]
164−
165− otherEntries =
166− case manager of
167− Effects.Cmds -> [ "tag" ==> "cmd", entry "cmdMap" ]
168− Effects.Subs -> [ "tag" ==> "sub", entry "subMap" ]
169− Effects.Both -> [ "tag" ==> "fx", entry "cmdMap", entry "subMap" ]
170− in
171− JS.ExprStmt $
172− JS.Assign
173− (JS.LBracket managers managerName)
174− (JS.Object (managerEntries ++ otherEntries))
175−
176−
177−(==>) :: Text -> Text -> ( JS.Prop, JS.Expr )
178−(==>) key value =
179− ( JS.IdProp (JS.Id key)
180− , JS.String value
181− )
120+virtualDomDebug :: ModuleName.Canonical
121+virtualDomDebug =
122+ ModuleName.inVirtualDom "VirtualDom.Debug"
src/Generate/JavaScript/Builder.hs+2−2
@@ -130,9 +130,9 @@ data PrefixOp
130130-- ENCODE
131131
132132
133−encodeUtf8 :: [Stmt] -> Builder
133+encodeUtf8 :: Stmt -> Builder
134134encodeUtf8 stmts =
135− fromStmtBlock "" stmts
135+ fromStmt "" stmts
136136
137137
138138
src/Generate/JavaScript/BuiltIn.hs+70−42
@@ -1,58 +1,74 @@
11{-# OPTIONS_GHC -Wall #-}
22{-# LANGUAGE OverloadedStrings #-}
33module Generate.JavaScript.BuiltIn
4− ( character
5− , list, cons
4+ ( char
5+ , list
6+ , cons
67 , recordUpdate
7− , eq, cmp
8− , effect, outgoingPort, incomingPort
8+ , eq
9+ , cmp
10+ , effectManagers
11+ , effect
12+ , outgoingPort
13+ , incomingPort
14+ , staticProgram
915 , crash
1016 )
1117 where
1218
19+
1320import Data.Text (Text)
1421
1522import qualified AST.Module.Name as ModuleName
23+import qualified AST.Variable as Var
1624import qualified Generate.JavaScript.Builder as JS
1725import Generate.JavaScript.Helpers ((<|), (==>))
1826import qualified Generate.JavaScript.Variable as Var
27+import Generate.JavaScript.Variable (Generator)
1928import qualified Reporting.Region as R
2029
2130
2231
23−utils :: Text -> [JS.Expr] -> JS.Expr
24−utils func args =
25− JS.Call (Var.coreNative "Utils" func) args
32+-- LITERALS
33+
2634
35+char :: Text -> Generator JS.Expr
36+char c =
37+ utils "chr" [ JS.String c ]
2738
2839
29−-- LITERALS
40+utils :: Text -> [JS.Expr] -> Generator JS.Expr
41+utils name args =
42+ do func <- core "Native.Utils" name
43+ return $ JS.Call func args
3044
3145
32−character :: Text -> JS.Expr
33−character char =
34− utils "chr" [ JS.String char ]
46+core :: ModuleName.Raw -> Text -> Generator JS.Expr
47+core home name =
48+ Var.global (Var.Global (ModuleName.inCore home) name)
3549
3650
3751
3852-- LISTS
3953
4054
41−list :: [JS.Expr] -> JS.Expr
55+list :: [JS.Expr] -> Generator JS.Expr
4256list elements =
43− Var.coreNative "List" "fromArray" <| JS.Array elements
57+ do fromArray <- core "Native.List" "fromArray"
58+ return $ fromArray <| JS.Array elements
4459
4560
46−cons :: JS.Expr -> JS.Expr -> JS.Expr
47−cons front back =
48− JS.Call (Var.coreNative "List" "Cons") [front, back]
61+cons :: JS.Expr -> JS.Expr -> Generator JS.Expr
62+cons first rest =
63+ do func <- core "Native.List" "Cons"
64+ return $ JS.Call func [first, rest]
4965
5066
5167
5268-- RECORDS
5369
5470
55−recordUpdate :: JS.Expr -> [(Text, JS.Expr)] -> JS.Expr
71+recordUpdate :: JS.Expr -> [(Text, JS.Expr)] -> Generator JS.Expr
5672recordUpdate record fields =
5773 utils "update"
5874 [ record
@@ -64,12 +80,12 @@ recordUpdate record fields =
6480-- COMPARISIONS
6581
6682
67−eq :: JS.Expr -> JS.Expr -> JS.Expr
83+eq :: JS.Expr -> JS.Expr -> Generator JS.Expr
6884eq left right =
6985 utils "eq" [ left, right ]
7086
7187
72−cmp :: JS.Expr -> JS.Expr -> JS.Expr
88+cmp :: JS.Expr -> JS.Expr -> Generator JS.Expr
7389cmp left right =
7490 utils "cmp" [ left, right ]
7591
@@ -78,55 +94,67 @@ cmp left right =
7894-- EFFECTS
7995
8096
81−effect :: ModuleName.Canonical -> JS.Expr
97+effectManagers :: Generator JS.Expr
98+effectManagers =
99+ core "Native.Platform" "effectManagers"
100+
101+
102+effect :: ModuleName.Canonical -> Generator JS.Expr
82103effect effectName =
83− Var.coreNative "Platform" "leaf" <|
84− JS.String (ModuleName.canonicalToText effectName)
104+ do leaf <- core "Native.Platform" "leaf"
105+ return $ leaf <| JS.String (ModuleName.canonicalToText effectName)
85106
86107
87−outgoingPort :: Text -> JS.Expr -> JS.Expr
108+outgoingPort :: Text -> JS.Expr -> Generator JS.Expr
88109outgoingPort name converter =
89− JS.Call
90− (Var.coreNative "Platform" "outgoingPort")
91− [ JS.String name, converter ]
110+ do outPort <- core "Native.Platform" "outgoingPort"
111+ return $ JS.Call outPort [ JS.String name, converter ]
92112
93113
94−incomingPort :: Text -> JS.Expr -> JS.Expr
114+incomingPort :: Text -> JS.Expr -> Generator JS.Expr
95115incomingPort name converter =
96− JS.Call
97− (Var.coreNative "Platform" "incomingPort")
98− [ JS.String name, converter ]
116+ do inPort <- core "Native.Platform" "incomingPort"
117+ return $ JS.Call inPort [ JS.String name, converter ]
118+
119+
120+
121+-- VIRTUAL DOM
122+
123+
124+staticProgram :: Generator JS.Expr
125+staticProgram =
126+ Var.global (Var.Global (ModuleName.inVirtualDom "Native.VirtualDom") "staticProgram")
99127
100128
101129
102130-- CRASH
103131
104132
105−crash :: ModuleName.Canonical -> R.Region -> Maybe (JS.Expr) -> JS.Expr
133+crash :: ModuleName.Canonical -> R.Region -> Maybe (JS.Expr) -> Generator JS.Expr
106134crash home region maybeCaseCrashValue =
107135 let
108136 homeString =
109137 JS.String (ModuleName.canonicalToText home)
110138 in
111− case maybeCaseCrashValue of
112− Nothing ->
139+ case maybeCaseCrashValue of
140+ Nothing ->
113141 utils "crash" [ homeString, regionToJs region ]
114142
115− Just crashValue ->
143+ Just crashValue ->
116144 utils "crashCase" [ homeString, regionToJs region, crashValue ]
117145
118146
119147regionToJs :: R.Region -> JS.Expr
120148regionToJs (R.Region start end) =
121− JS.Object
122− [ "start" ==> positionToJs start
123− , "end" ==> positionToJs end
124− ]
149+ JS.Object
150+ [ "start" ==> positionToJs start
151+ , "end" ==> positionToJs end
152+ ]
125153
126154
127155positionToJs :: R.Position -> JS.Expr
128156positionToJs (R.Position line column) =
129− JS.Object
130− [ "line" ==> JS.Int line
131− , "column" ==> JS.Int column
132− ]
157+ JS.Object
158+ [ "line" ==> JS.Int line
159+ , "column" ==> JS.Int column
160+ ]
src/Generate/JavaScript/Effects.hsnew file+82
@@ -0,0 +1,82 @@
1+{-# OPTIONS_GHC -Wall #-}
2+{-# LANGUAGE OverloadedStrings #-}
3+module Generate.JavaScript.Effects
4+ ( generate
5+ )
6+ where
7+
8+
9+import qualified Data.ByteString.Builder as BS
10+import qualified Data.Map as Map
11+import Data.Monoid ((<>))
12+import Data.Text (Text)
13+
14+import qualified AST.Effects as Effects
15+import qualified AST.Module.Name as ModuleName
16+import qualified AST.Variable as Var
17+import qualified Elm.Package as Pkg
18+import qualified Generate.JavaScript.Builder as JS
19+import qualified Generate.JavaScript.BuiltIn as BuiltIn
20+import qualified Generate.JavaScript.Variable as Var
21+
22+
23+
24+-- GENERATE
25+
26+
27+generate :: Map.Map ModuleName.Canonical Effects.ManagerType -> Var.Generator BS.Builder
28+generate managers =
29+ let
30+ add home mngr makeBuilder =
31+ do builder <- makeBuilder
32+ stmt <- generateManager home mngr
33+ return (JS.encodeUtf8 stmt <> builder)
34+ in
35+ Map.foldrWithKey' add (return "") managers
36+
37+
38+generateManager :: ModuleName.Canonical -> Effects.ManagerType -> Var.Generator JS.Stmt
39+generateManager home manager =
40+ do managers <- BuiltIn.effectManagers
41+ let managerName = JS.String (ModuleName.canonicalToText home)
42+ let lValue = JS.LBracket managers managerName
43+ entries <- generateEntries home manager
44+ return $ JS.ExprStmt (JS.Assign lValue entries)
45+
46+
47+generateEntries :: ModuleName.Canonical -> Effects.ManagerType -> Var.Generator JS.Expr
48+generateEntries home@(ModuleName.Canonical pkg _) manager =
49+ let
50+ entry name =
51+ do let key = JS.IdProp (JS.Id name)
52+ value <- Var.global (Var.Global home name)
53+ return ( key, value )
54+ in
55+ fmap JS.Object $ sequence $
56+ [ "pkg" ==> Pkg.toText pkg
57+ , entry "init"
58+ , entry "onEffects"
59+ , entry "onSelfMsg"
60+ ]
61+ ++
62+ case manager of
63+ Effects.Cmds ->
64+ [ "tag" ==> "cmd"
65+ , entry "cmdMap"
66+ ]
67+
68+ Effects.Subs ->
69+ [ "tag" ==> "sub"
70+ , entry "subMap"
71+ ]
72+
73+ Effects.Both ->
74+ [ "tag" ==> "fx"
75+ , entry "cmdMap"
76+ , entry "subMap"
77+ ]
78+
79+
80+(==>) :: Text -> Text -> Var.Generator ( JS.Prop, JS.Expr )
81+(==>) key value =
82+ return ( JS.IdProp (JS.Id key), JS.String value )
src/Generate/JavaScript/Expression.hs+89−77
@@ -5,7 +5,7 @@ module Generate.JavaScript.Expression
55 where
66
77import Control.Arrow (second)
8−import Control.Monad.State (State, foldM)
8+import Control.Monad (foldM)
99import qualified Data.List as List
1010import qualified Data.Map as Map
1111import Data.Monoid ((<>))
@@ -23,6 +23,7 @@ import qualified Generate.JavaScript.BuiltIn as BuiltIn
2323import qualified Generate.JavaScript.Foreign as Foreign
2424import qualified Generate.JavaScript.Literal as Literal
2525import qualified Generate.JavaScript.Variable as Var
26+import Generate.JavaScript.Variable (Generator)
2627import qualified Optimize.DecisionTree as DT
2728
2829
@@ -30,9 +31,11 @@ import qualified Optimize.DecisionTree as DT
3031-- GENERATE DECLARATION
3132
3233
33−generateDecl :: ModuleName.Canonical -> Text -> Opt.Def -> State Int [JS.Stmt]
34+generateDecl :: ModuleName.Canonical -> Text -> Opt.Def -> Generator JS.Stmt
3435generateDecl home name def =
35− Var.defineGlobal home name <$> generateDef name def
36+ do jsName <- Var.getGlobalName (V.Global home name)
37+ jsBody <- generateDef name def
38+ return $ JS.VarDeclStmt [ Help.varDecl jsName jsBody ]
3639
3740
3841
@@ -44,12 +47,12 @@ data Code
4447 | JsBlock [JS.Stmt]
4548
4649
47−jsExpr :: JS.Expr -> State Int Code
50+jsExpr :: JS.Expr -> Generator Code
4851jsExpr exp =
4952 return (JsExpr exp)
5053
5154
52−jsBlock :: [JS.Stmt] -> State Int Code
55+jsBlock :: [JS.Stmt] -> Generator Code
5356jsBlock exp =
5457 return (JsBlock exp)
5558
@@ -98,22 +101,22 @@ toExpr code =
98101-- EXPRESSIONS
99102
100103
101−generateJsExpr :: Opt.Expr -> State Int JS.Expr
104+generateJsExpr :: Opt.Expr -> Generator JS.Expr
102105generateJsExpr optExpr =
103106 toExpr <$> generateCode optExpr
104107
105108
106−generateCode :: Opt.Expr -> State Int Code
109+generateCode :: Opt.Expr -> Generator Code
107110generateCode expr =
108111 case expr of
109112 VarLocal name ->
110113 jsExpr $ Var.local name
111114
112115 VarGlobal name ->
113− jsExpr $ Var.global name
116+ JsExpr <$> Var.global name
114117
115118 Literal lit ->
116− jsExpr (Literal.literal lit)
119+ JsExpr <$> Literal.literal lit
117120
118121 Access record field ->
119122 do jsRecord <- generateJsExpr record
@@ -127,7 +130,7 @@ generateCode expr =
127130 in
128131 do jsRecord <- generateJsExpr record
129132 jsFields <- mapM fieldToJs fields
130− jsExpr $ BuiltIn.recordUpdate jsRecord jsFields
133+ JsExpr <$> BuiltIn.recordUpdate jsRecord jsFields
131134
132135 Record fields ->
133136 let
@@ -173,7 +176,7 @@ generateCode expr =
173176
174177 List elements ->
175178 do jsElements <- mapM generateJsExpr elements
176− jsExpr $ BuiltIn.list jsElements
179+ JsExpr <$> BuiltIn.list jsElements
177180
178181 Ctor tag members ->
179182 let
@@ -191,39 +194,41 @@ generateCode expr =
191194 jsExpr $ JS.DotRef jsDataExpr (JS.Id ("_" <> Text.pack (show index)))
192195
193196 Cmd moduleName _ ->
194− jsExpr $ BuiltIn.effect moduleName
197+ JsExpr <$> BuiltIn.effect moduleName
195198
196199 Sub moduleName _ ->
197− jsExpr $ BuiltIn.effect moduleName
200+ JsExpr <$> BuiltIn.effect moduleName
198201
199202 OutgoingPort name tipe ->
200− jsExpr $ BuiltIn.outgoingPort name (Foreign.encode tipe)
203+ JsExpr <$> BuiltIn.outgoingPort name (Foreign.encode tipe)
201204
202205 IncomingPort name tipe ->
203206 do jsDecoder <- generateJsExpr (Foreign.decode tipe)
204− jsExpr $ BuiltIn.incomingPort name jsDecoder
207+ JsExpr <$> BuiltIn.incomingPort name jsDecoder
205208
206209 Program kind body ->
207210 generateProgram kind body
208211
209212 GLShader src ->
210− jsExpr $ JS.Object [(JS.StringProp "src", Literal.literal (L.Str src))]
213+ do string <- Literal.literal (L.Str src)
214+ jsExpr $ JS.Object [(JS.StringProp "src", string)]
211215
212216 Crash home region maybeBranchProblem ->
213217 do maybeOptBranchProblem <- traverse generateJsExpr maybeBranchProblem
214− jsExpr $ BuiltIn.crash home region maybeOptBranchProblem
218+ JsExpr <$> BuiltIn.crash home region maybeOptBranchProblem
215219
216220
217221
218222-- PROGRAMS
219223
220224
221−generateProgram :: Can.Main -> Opt.Expr -> State Int Code
225+generateProgram :: Can.Main -> Opt.Expr -> Generator Code
222226generateProgram kind body =
223227 case kind of
224228 Can.VDom ->
225229 do html <- generateJsExpr body
226− jsExpr (Var.staticProgram <| html)
230+ func <- BuiltIn.staticProgram
231+ jsExpr (func <| html)
227232
228233 Can.NoFlags ->
229234 do almostProgram <- generateJsExpr body
@@ -239,13 +244,13 @@ generateProgram kind body =
239244-- DEFINITIONS
240245
241246
242−generateLetDef :: (Text, Opt.Def) -> State Int JS.Stmt
247+generateLetDef :: (Text, Opt.Def) -> Generator JS.Stmt
243248generateLetDef (name, def) =
244249 do jsBody <- generateDef name def
245250 return $ JS.VarDeclStmt [ Help.varDecl name jsBody ]
246251
247252
248−generateDef :: Text -> Opt.Def -> State Int JS.Expr
253+generateDef :: Text -> Opt.Def -> Generator JS.Expr
249254generateDef name def =
250255 case def of
251256 Opt.TailDef argNames body ->
@@ -255,7 +260,7 @@ generateDef name def =
255260 generateJsExpr body
256261
257262
258−generateTailFunction :: Text -> [Text] -> Opt.Expr -> State Int JS.Expr
263+generateTailFunction :: Text -> [Text] -> Opt.Expr -> Generator JS.Expr
259264generateTailFunction name args body =
260265 do code <- generateCode body
261266 return $ generateFunctionWithArity args $ JsBlock $ (:[]) $
@@ -268,7 +273,7 @@ generateTailFunction name args body =
268273-- FUNCTIONS
269274
270275
271−generateFunction :: [Text] -> Opt.Expr -> State Int Code
276+generateFunction :: [Text] -> Opt.Expr -> Generator Code
272277generateFunction args body =
273278 do code <- generateCode body
274279 jsExpr (generateFunctionWithArity args code)
@@ -297,7 +302,7 @@ generateFunctionWithArity rawArgs code =
297302-- GENERATE CALL
298303
299304
300−generateCall :: Opt.Expr -> [Opt.Expr] -> State Int Code
305+generateCall :: Opt.Expr -> [Opt.Expr] -> Generator Code
301306generateCall func args =
302307 case (func, args) of
303308 (Opt.VarGlobal (V.Global home name), [arg]) ->
@@ -320,13 +325,13 @@ generateCall func args =
320325 generateCallHelp func args
321326
322327
323−genPrefix :: JS.PrefixOp -> Opt.Expr -> State Int Code
328+genPrefix :: JS.PrefixOp -> Opt.Expr -> Generator Code
324329genPrefix op arg =
325330 do jsArg <- generateJsExpr arg
326331 jsExpr (JS.Prefix op jsArg)
327332
328333
329−genInfix :: JS.InfixOp -> Opt.Expr -> Opt.Expr -> State Int Code
334+genInfix :: JS.InfixOp -> Opt.Expr -> Opt.Expr -> Generator Code
330335genInfix op left right =
331336 do jsLeft <- generateJsExpr left
332337 jsRight <- generateJsExpr right
@@ -343,7 +348,7 @@ bitwise =
343348 ModuleName.inCore "Bitwise"
344349
345350
346−generateCallHelp :: Opt.Expr -> [Opt.Expr] -> State Int Code
351+generateCallHelp :: Opt.Expr -> [Opt.Expr] -> Generator Code
347352generateCallHelp func args =
348353 let
349354 arity = length args
@@ -362,7 +367,7 @@ generateCallHelp func args =
362367-- GENERATE IFS
363368
364369
365−generateIf :: [(Opt.Expr, Opt.Expr)] -> Opt.Expr -> State Int Code
370+generateIf :: [(Opt.Expr, Opt.Expr)] -> Opt.Expr -> Generator Code
366371generateIf givenBranches givenFinally =
367372 let
368373 (branches, finally) =
@@ -421,7 +426,7 @@ crushIfsHelp visitedBranches unvisitedBranches finally =
421426-- CASE EXPRESSIONS
422427
423428
424−generateCase :: Text -> Opt.Decider Opt.Choice -> [(Int, Opt.Expr)] -> State Int [JS.Stmt]
429+generateCase :: Text -> Opt.Decider Opt.Choice -> [(Int, Opt.Expr)] -> Generator [JS.Stmt]
425430generateCase exprName decider jumps =
426431 do labelRoot <- Var.fresh
427432 decider <- generateDecider exprName labelRoot decider
@@ -432,7 +437,7 @@ generateCase exprName decider jumps =
432437-- handle any jumps
433438
434439
435−goto :: Text -> [JS.Stmt] -> (Int, Opt.Expr) -> State Int [JS.Stmt]
440+goto :: Text -> [JS.Stmt] -> (Int, Opt.Expr) -> Generator [JS.Stmt]
436441goto labelRoot deciderStmts (target, branch) =
437442 let
438443 labeledDeciderStmt =
@@ -453,7 +458,7 @@ toLabel root target =
453458-- turn deciders into ifs and switches
454459
455460
456−generateDecider :: Text -> Text -> Opt.Decider Opt.Choice -> State Int [JS.Stmt]
461+generateDecider :: Text -> Text -> Opt.Decider Opt.Choice -> Generator [JS.Stmt]
457462generateDecider exprName labelRoot decisionTree =
458463 case decisionTree of
459464 Opt.Leaf (Opt.Inline branch) ->
@@ -466,7 +471,7 @@ generateDecider exprName labelRoot decisionTree =
466471 let
467472 makeTest (path, test) =
468473 do testExpr <- pathToTestableExpr exprName path test
469− return (JS.Infix JS.OpStrictEq testExpr (testToExpr test))
474+ JS.Infix JS.OpStrictEq testExpr <$> testToExpr test
470475 in
471476 do testExprs <- mapM makeTest testChain
472477 let cond = List.foldl1' (JS.Infix JS.OpLAnd) testExprs
@@ -481,29 +486,31 @@ generateDecider exprName labelRoot decisionTree =
481486 return [ JS.Switch testExpr (caseClauses ++ [caseDefault]) ]
482487
483488
484−edgeToCase :: Text -> Text -> (DT.Test, Opt.Decider Opt.Choice) -> State Int JS.Case
489+edgeToCase :: Text -> Text -> (DT.Test, Opt.Decider Opt.Choice) -> Generator JS.Case
485490edgeToCase exprName labelRoot (test, subTree) =
486− JS.Case (testToExpr test) <$> generateDecider exprName labelRoot subTree
491+ JS.Case
492+ <$> testToExpr test
493+ <*> generateDecider exprName labelRoot subTree
487494
488495
489−testToExpr :: DT.Test -> JS.Expr
496+testToExpr :: DT.Test -> Generator JS.Expr
490497testToExpr test =
491498 case test of
492499 DT.Constructor (V.Canonical _ tag) ->
493− JS.String tag
500+ return $ JS.String tag
494501
495502 DT.Literal (L.Chr char) ->
496− JS.String char
503+ return $ JS.String char
497504
498505 DT.Literal lit ->
499− Literal.literal lit
506+ Literal.literal lit
500507
501508
502509
503510-- work with paths
504511
505512
506−pathToTestableExpr :: Text -> DT.Path -> DT.Test -> State Int JS.Expr
513+pathToTestableExpr :: Text -> DT.Path -> DT.Test -> Generator JS.Expr
507514pathToTestableExpr root path exampleTest =
508515 do accessExpr <- generateJsExpr (pathToExpr root path)
509516 case exampleTest of
@@ -540,31 +547,32 @@ pathToExpr root fullPath =
540547-- BINARY OPERATORS
541548
542549
543−generateBinop :: V.Global -> Opt.Expr -> Opt.Expr -> State Int Code
550+generateBinop :: V.Global -> Opt.Expr -> Opt.Expr -> Generator Code
544551generateBinop op left right =
545552 do jsLeft <- generateJsExpr left
546553 jsRight <- generateJsExpr right
547− jsExpr (generateBinopHelp op jsLeft jsRight)
554+ JsExpr <$> generateBinopHelp op jsLeft jsRight
548555
549556
550557
551558-- BINARY OPERATOR HELPERS
552559
553560
554−generateBinopHelp :: V.Global -> JS.Expr -> JS.Expr -> JS.Expr
555−generateBinopHelp var@(V.Global home op) leftExpr rightExpr =
561+generateBinopHelp :: V.Global -> JS.Expr -> JS.Expr -> Generator JS.Expr
562+generateBinopHelp var@(V.Global home op) jsLeft jsRight =
556563 let
557564 simpleMake left right =
558− JS.Call (ref "A2") [ Var.global var, left, right ]
565+ do func <- Var.global var
566+ return $ JS.Call (ref "A2") [ func, left, right ]
559567 in
560568 if home == basics then
561− (Map.findWithDefault simpleMake op basicOps) leftExpr rightExpr
569+ (Map.findWithDefault simpleMake op basicsOps) jsLeft jsRight
562570
563571 else if op == "::" && home == list then
564− BuiltIn.cons leftExpr rightExpr
572+ BuiltIn.cons jsLeft jsRight
565573
566574 else
567− simpleMake leftExpr rightExpr
575+ simpleMake jsLeft jsRight
568576
569577
570578list :: ModuleName.Canonical
@@ -572,39 +580,43 @@ list =
572580 ModuleName.inCore "List"
573581
574582
575−basicOps :: Map.Map Text (JS.Expr -> JS.Expr -> JS.Expr)
576−basicOps =
577− Map.fromList (infixOps ++ specialOps)
583+basicsOps :: Map.Map Text (JS.Expr -> JS.Expr -> Generator JS.Expr)
584+basicsOps =
585+ Map.fromList (basicsOpsNormal ++ basicsOpsSpecial)
578586
579587
580−infixOps :: [(Text, JS.Expr -> JS.Expr -> JS.Expr)]
581−infixOps =
582− let
583− infixOp str op =
584− (str, JS.Infix op)
585− in
586− [ infixOp "+" JS.OpAdd
587− , infixOp "-" JS.OpSub
588− , infixOp "*" JS.OpMul
589− , infixOp "/" JS.OpDiv
590− , infixOp "&&" JS.OpLAnd
591− , infixOp "||" JS.OpLOr
592− ]
593−
594−
595−specialOps :: [(Text, JS.Expr -> JS.Expr -> JS.Expr)]
596−specialOps =
597− [ (,) "^" $ \a b -> JS.Call (obj ["Math","pow"]) [a,b]
598− , (,) "==" $ \a b -> BuiltIn.eq a b
599− , (,) "/=" $ \a b -> JS.Prefix JS.PrefixLNot (BuiltIn.eq a b)
600− , (,) "<" $ cmp JS.OpLT 0
601− , (,) ">" $ cmp JS.OpGT 0
602− , (,) "<=" $ cmp JS.OpLT 1
603− , (,) ">=" $ cmp JS.OpGT (-1)
604− , (,) "//" $ \a b -> JS.Infix JS.OpBOr (JS.Infix JS.OpDiv a b) (JS.Int 0)
588+basicsOpsNormal :: [(Text, JS.Expr -> JS.Expr -> Generator JS.Expr)]
589+basicsOpsNormal =
590+ let
591+ (=*>) str op =
592+ ( str, \left right -> return (JS.Infix op left right) )
593+ in
594+ [ "+" =*> JS.OpAdd
595+ , "-" =*> JS.OpSub
596+ , "*" =*> JS.OpMul
597+ , "/" =*> JS.OpDiv
598+ , "&&" =*> JS.OpLAnd
599+ , "||" =*> JS.OpLOr
600+ ]
601+
602+
603+basicsOpsSpecial :: [(Text, JS.Expr -> JS.Expr -> Generator JS.Expr)]
604+basicsOpsSpecial =
605+ let
606+ (=*>) = (,)
607+ in
608+ [ "^" =*> \a b -> return $ JS.Call (obj ["Math","pow"]) [a,b]
609+ , "==" =*> BuiltIn.eq
610+ , "/=" =*> \a b -> JS.Prefix JS.PrefixLNot <$> BuiltIn.eq a b
611+ , "<" =*> cmp JS.OpLT 0
612+ , ">" =*> cmp JS.OpGT 0
613+ , "<=" =*> cmp JS.OpLT 1
614+ , ">=" =*> cmp JS.OpGT (-1)
615+ , "//" =*> \a b -> return $ JS.Infix JS.OpBOr (JS.Infix JS.OpDiv a b) (JS.Int 0)
605616 ]
606617
607618
608−cmp :: JS.InfixOp -> Int -> JS.Expr -> JS.Expr -> JS.Expr
619+cmp :: JS.InfixOp -> Int -> JS.Expr -> JS.Expr -> Generator JS.Expr
609620cmp op n a b =
610− JS.Infix op (BuiltIn.cmp a b) (JS.Int n)
621+ do ordering <- BuiltIn.cmp a b
622+ return $ JS.Infix op ordering (JS.Int n)
src/Generate/JavaScript/Foreign.hs+2−3
@@ -14,7 +14,6 @@ import qualified AST.Type as T
1414import qualified AST.Variable as Var
1515import qualified Generate.JavaScript.Builder as JS
1616import qualified Generate.JavaScript.Helpers as JS (function, ref)
17−import qualified Generate.JavaScript.Variable as Var
1817import Generate.JavaScript.Helpers ((<|), (==>))
1918
2019
@@ -83,7 +82,7 @@ fromList :: T.Canonical -> JS.Expr -> JS.Expr
8382fromList tipe expr =
8483 let
8584 array =
86− Var.coreNative "List" "toArray" <| expr
85+ error "TODO port fromList" expr -- Var.coreNative "List" "toArray" <| expr
8786 in
8887 JS.DotRef array (JS.Id "map") <| encode tipe
8988
@@ -92,7 +91,7 @@ fromArray :: T.Canonical -> JS.Expr -> JS.Expr
9291fromArray tipe expr =
9392 let
9493 array =
95− Var.coreNative "Array" "toJSArray" <| expr
94+ error "TODO port fromArray" expr -- Var.coreNative "Array" "toJSArray" <| expr
9695 in
9796 JS.DotRef array (JS.Id "map") <| encode tipe
9897
src/Generate/JavaScript/Literal.hs+7−6
@@ -3,22 +3,23 @@ module Generate.JavaScript.Literal (literal) where
33import qualified AST.Literal as Lit
44import qualified Generate.JavaScript.Builder as JS
55import qualified Generate.JavaScript.BuiltIn as BuiltIn
6+import Generate.JavaScript.Variable (Generator)
67
78
8−literal :: Lit.Literal -> JS.Expr
9+literal :: Lit.Literal -> Generator JS.Expr
910literal lit =
1011 case lit of
1112 Lit.Chr char ->
12− BuiltIn.character char
13+ BuiltIn.char char
1314
1415 Lit.Str string ->
15− JS.String string
16+ return $ JS.String string
1617
1718 Lit.IntNum number ->
18− JS.Int number
19+ return $ JS.Int number
1920
2021 Lit.FloatNum number ->
21− JS.Float number
22+ return $ JS.Float number
2223
2324 Lit.Boolean boolean ->
24− JS.Bool boolean
25+ return $ JS.Bool boolean
src/Generate/JavaScript/Variable.hs+143−85
@@ -1,44 +1,80 @@
11{-# OPTIONS_GHC -Wall #-}
22{-# LANGUAGE OverloadedStrings #-}
33module Generate.JavaScript.Variable
4− ( fresh
5− , local
6− , global
7− , qualified
8− , coreNative
9− , staticProgram
10− , defineGlobal
11− , safe
12− )
13− where
14−
4+ ( Generator
5+ , run
6+ , Table
7+ , init
8+ , fresh
9+ , local
10+ , safe
11+ , global
12+ , getGlobalName
13+ )
14+ where
15+
16+
17+import Prelude hiding (init)
1518import qualified Control.Monad.State as State
16−import Data.Monoid
19+import qualified Data.Char as Char
20+import Data.Monoid ((<>))
21+import qualified Data.Map as Map
1722import qualified Data.Set as Set
1823import qualified Data.Text as Text
1924import Data.Text (Text)
25+import Data.Word (Word16, Word32)
2026
2127import qualified AST.Helpers as Help
2228import qualified AST.Module.Name as ModuleName
2329import qualified AST.Variable as Var
2430import qualified Elm.Package as Pkg
31+import qualified Elm.Compiler.Objects.Internal as Obj
2532import qualified Generate.JavaScript.Builder as JS
2633import qualified Generate.JavaScript.Helpers as JS
2734
2835
2936
37+-- GENERATOR
38+
39+
40+type Generator = State.State Table
41+
42+
43+run :: Table -> Generator a -> ( a, Table )
44+run table generator =
45+ State.runState generator table
46+
47+
48+
49+-- STATE
50+
51+
52+data Table =
53+ Table
54+ { _uid :: !Int
55+ , _names :: Map.Map Var.Global Text
56+ , _symbols :: Obj.SymbolTable
57+ }
58+
59+
60+init :: Obj.SymbolTable -> Table
61+init symbols =
62+ Table 0 Map.empty symbols
63+
64+
65+
3066-- FRESH NAMES
3167
3268
33−fresh :: State.State Int Text
69+fresh :: Generator Text
3470fresh =
35− do n <- State.get
36− State.modify (+1)
37− return (Text.pack ("_v" ++ show n))
71+ do (Table uid names symbols) <- State.get
72+ State.put (Table (uid + 1) names symbols)
73+ return (Text.pack ("_v" ++ show uid))
3874
3975
4076
41−-- VARIABLES
77+-- LOCAL NAMES
4278
4379
4480local :: Text -> JS.Expr
@@ -46,103 +82,125 @@ local name =
4682 JS.ref (safe name)
4783
4884
49−global :: Var.Global -> JS.Expr
50−global (Var.Global home name) =
51− if Help.isOp name then
52− JS.BracketRef (JS.ref (opsDict home)) (JS.String name)
85+safe :: Text -> Text
86+safe name =
87+ if Set.member name reservedWords then
88+ "_" <> name
5389 else
54− JS.ref (qualified home name)
90+ name
5591
5692
93+reservedWords :: Set.Set Text
94+reservedWords =
95+ Set.fromList
96+ -- reserved by JavaScript
97+ [ "null", "undefined", "Nan", "Infinity", "true", "false", "eval"
98+ , "arguments", "int", "byte", "char", "goto", "long", "final", "float"
99+ , "short", "double", "native", "throws", "boolean", "abstract", "volatile"
100+ , "transient", "synchronized", "function", "break", "case", "catch"
101+ , "continue", "debugger", "default", "delete", "do", "else", "finally"
102+ , "for", "function", "if", "in", "instanceof", "new", "return", "switch"
103+ , "this", "throw", "try", "typeof", "var", "void", "while", "with", "class"
104+ , "const", "enum", "export", "extends", "import", "super", "implements"
105+ , "interface", "let", "package", "private", "protected", "public"
106+ , "static", "yield"
107+ -- reserved by Elm
108+ , "F2", "F3", "F4", "F5", "F6", "F7", "F8", "F9"
109+ , "A2", "A3", "A4", "A5", "A6", "A7", "A8", "A9"
110+ , "ctor"
111+ ]
57112
58−-- MISC
59113
60114
61−coreNative :: Text -> Text -> JS.Expr
62−coreNative moduleName name =
63− global (Var.Global (ModuleName.inCore ("Native." <> moduleName)) name)
115+-- GLOBAL NAMES
64116
65117
66−staticProgram :: JS.Expr
67−staticProgram =
68− global (Var.Global (ModuleName.inVirtualDom "Native.VirtualDom") "staticProgram")
118+global :: Var.Global -> Generator JS.Expr
119+global var =
120+ do table@(Table _ _ symbols) <- State.get
121+ case Obj.lookup var symbols of
122+ Nothing ->
123+ JS.ref <$> getGlobalNameHelp var table
69124
125+ Just (Obj.Symbol symHome symName) ->
126+ return $
127+ JS.DotRef
128+ (JS.ref (symbolHomeToText symHome))
129+ (JS.Id (symbolNameToText symName))
70130
71131
72−-- DEFINE GLOBALS
132+getGlobalName :: Var.Global -> Generator Text
133+getGlobalName var =
134+ do table <- State.get
135+ getGlobalNameHelp var table
73136
74137
75−defineGlobal :: ModuleName.Canonical -> Text -> JS.Expr -> [JS.Stmt]
76−defineGlobal home name body =
77− case Help.isOp name of
78− False ->
79− [ JS.VarDeclStmt [ JS.varDecl (qualified home name) body ]
80− ]
138+getGlobalNameHelp :: Var.Global -> Table -> Generator Text
139+getGlobalNameHelp var@(Var.Global home name) (Table uid names symbols) =
140+ case Map.lookup var names of
141+ Just jsName ->
142+ return jsName
81143
82− True ->
83− let
84− dict = opsDict home
85− lvalue = JS.LBracket (JS.ref dict) (JS.String name)
86− in
87− [ JS.VarDeclStmt [ JS.varDecl dict (JS.refOrObject dict) ]
88− , JS.ExprStmt (JS.Assign lvalue body)
89− ]
144+ Nothing ->
145+ case Help.isOp name of
146+ False ->
147+ do let jsName = globalToName home name
148+ State.put (Table uid (Map.insert var jsName names) symbols)
149+ return jsName
90150
151+ True ->
152+ do let jsName = globalToName home ("_op" <> Text.pack (show uid))
153+ State.put (Table (uid + 1) (Map.insert var jsName names) symbols)
154+ return jsName
91155
92156
93−-- GLOBAL NAMES
157+globalToName :: ModuleName.Canonical -> Text -> Text
158+globalToName (ModuleName.Canonical (Pkg.Name user project) moduleName) name =
159+ Text.replace "-" "_" user
160+ <> "$" <> Text.replace "-" "_" project
161+ <> "$" <> Text.replace "." "_" moduleName
162+ <> "$" <> name
94163
95164
96−qualified :: ModuleName.Canonical -> Text -> Text
97−qualified home name =
98− moduleToText home <> "$" <> name
99165
166+-- SYMBOLS
100167
101−opsDict :: ModuleName.Canonical -> Text
102−opsDict home =
103− moduleToText home <> "_ops"
104168
169+symbolHomeToText :: Word16 -> Text
170+symbolHomeToText word =
171+ Text.pack ('$' : show word)
105172
106−moduleToText :: ModuleName.Canonical -> Text
107−moduleToText (ModuleName.Canonical (Pkg.Name user project) moduleName) =
108− let
109− safeUser =
110− Text.replace "-" "_" user
111173
112− safeProject =
113− Text.replace "-" "_" project
174+symbolNameToText :: Word32 -> Text
175+symbolNameToText word =
176+ Text.pack (makeName word "")
114177
115− safeModuleName =
116− Text.replace "." "_" moduleName
117− in
118− "_" <> safeUser <> "$" <> safeProject <> "$" <> safeModuleName
119178
179+makeName :: Word32 -> String -> String
180+makeName word str =
181+ if word < 26 then
182+ makeChar 97 word : str
120183
184+ else if word < 52 then
185+ makeChar 65 (word - 26) : str
121186
122−-- SAFE NAMES
187+ else
188+ let
189+ (next, leftover) =
190+ quotRem word 52
191+ in
192+ makeName next (makeInnerChar leftover : str)
123193
124194
125−safe :: Text -> Text
126−safe name =
127− if Set.member name jsReserveds then "_" <> name else name
195+makeInnerChar :: Word32 -> Char
196+makeInnerChar word =
197+ if word < 26 then
198+ makeChar 97 word
199+ else
200+ makeChar 65 (word - 26)
128201
129202
130−jsReserveds :: Set.Set Text
131−jsReserveds =
132− Set.fromList
133− -- JS reserved words
134− [ "null", "undefined", "Nan", "Infinity", "true", "false", "eval"
135− , "arguments", "int", "byte", "char", "goto", "long", "final", "float"
136− , "short", "double", "native", "throws", "boolean", "abstract", "volatile"
137− , "transient", "synchronized", "function", "break", "case", "catch"
138− , "continue", "debugger", "default", "delete", "do", "else", "finally"
139− , "for", "function", "if", "in", "instanceof", "new", "return", "switch"
140− , "this", "throw", "try", "typeof", "var", "void", "while", "with", "class"
141− , "const", "enum", "export", "extends", "import", "super", "implements"
142− , "interface", "let", "package", "private", "protected", "public"
143− , "static", "yield"
144− -- reserved by the Elm runtime system
145− , "F2", "F3", "F4", "F5", "F6", "F7", "F8", "F9"
146− , "A2", "A3", "A4", "A5", "A6", "A7", "A8", "A9"
147− , "ctor"
148− ]
203+{-# INLINE makeChar #-}
204+makeChar :: Word32 -> Word32 -> Char
205+makeChar root offset =
206+ Char.chr (fromIntegral (root + offset))