git.iko.soy/elk
on master help sign in
Switch code-gen to no closures, only fully qualified names
commitc4522b0dd4bd96756bb87afa0058760eb31b9a88 authorEvan Czaplicki <info@elm-lang.org> dateWed 17 Feb 2016, 16:34 (11 years ago) parent599c7a3
4 files changed+98−186
compare with master
unifiedsplit
src/Generate/JavaScript.hs+6−144 src/Generate/JavaScript/Expression.hs+4−4 src/Generate/JavaScript/Helpers.hs+9−7 src/Generate/JavaScript/Variable.hs+79−31
src/Generate/JavaScript.hs+6−144
@@ -1,159 +1,21 @@
11module Generate.JavaScript (generate) where
22
33import Control.Monad.State as State
4−import qualified Data.List as List
54import Language.ECMAScript3.PrettyPrint as ES
6−import Language.ECMAScript3.Syntax
75import qualified Text.PrettyPrint.Leijen as PP
86
9−import qualified AST.Expression.Optimized as Optimized
10−import qualified AST.Helpers as Help
117import qualified AST.Module as Module
12−import qualified AST.Module.Name as ModuleName
13−import qualified AST.Variable as Variable
148import qualified Generate.JavaScript.Expression as JS
15−import Generate.JavaScript.Helpers (call, function, localRuntime, obj, prop, ref, varDecl)
16−import qualified Generate.JavaScript.Variable as Var
179
1810
1911generate :: Module.Optimized -> String
20−generate (Module.Module (ModuleName.Canonical _ name) _ info) =
12+generate (Module.Module _ _ info) =
2113 let
22− body =
23− concat
24− [ useStrict
25− , checkForCachedVersion name
26− , imports (Module.imports info)
27− , definitions (Module.program info)
28− , exports name (Module.exports info)
29− ]
30−
31− make =
32− "Elm" : name ++ ["make"]
33−
34− javascript =
35− buildIntermediateObjects make
36− ++
37− [ assign make (function [localRuntime] body)
38− ]
39− in
40− PP.displayS (PP.renderPretty 1 160 (ES.prettyPrint javascript)) ""
41−
42−
43−
44−-- INTRO
45−
46−
47−useStrict :: [Statement ()]
48−useStrict =
49− [ ExprStmt () (StringLit () "use strict")
50− ]
51−
52−
53−checkForCachedVersion :: ModuleName.Raw -> [Statement ()]
54−checkForCachedVersion name =
55− let
56− values =
57− localRuntime : name ++ ["values"]
58−
59− valuesObject =
60− obj values
61− in
62− buildIntermediateObjects values
63− ++
64− [ IfSingleStmt () valuesObject (ReturnStmt () (Just valuesObject))
65− ]
66−
67−
68−buildIntermediateObjects :: [String] -> [Statement ()]
69−buildIntermediateObjects path =
70− let
71− create name =
72− assign name (InfixExpr () OpLOr (obj name) (ObjectLit () []))
73−
74− paths =
75− drop 2 (init (List.inits path))
76− in
77− map create paths
78−
79−
80−assign :: [String] -> Expression () -> Statement ()
81−assign path expr =
82− case path of
83− [x] ->
84− VarDeclStmt () [ varDecl x expr ]
85−
86− _ ->
87− ExprStmt () $
88− AssignExpr () OpAssign (LDot () (obj (init path)) (last path)) expr
89−
90−
91−
92−-- IMPORTS
93−
14+ genBody =
15+ concat <$> mapM JS.generateDef (Module.program info)
9416
95−imports :: [ModuleName.Raw] -> [Statement ()]
96−imports rawImports =
97− let
98− utils =
99− varDecl "_U" (call (obj ["Elm", "Native", "Utils", "make"]) [ref localRuntime])
100− in
101− [ VarDeclStmt () (utils : map jsImport rawImports) ]
102−
103−
104−jsImport :: ModuleName.Raw -> VarDecl ()
105−jsImport name =
106− let
107− make =
108− obj ("Elm" : name ++ ["make"])
109− in
110− varDecl (Var.modulePrefix name) (call make [ref localRuntime])
111−
112−
113−
114−-- DEFINITIONS
115−
116−
117−definitions :: [Optimized.Def] -> [Statement ()]
118−definitions defs =
119− let
120− setup =
121− Var.define "_op" (ObjectLit () [])
17+ body =
18+ State.evalState genBody 0
12219 in
123− setup : State.evalState (mapM JS.generateDef defs) 0
20+ PP.displayS (PP.renderPretty 1 160 (ES.prettyPrint body)) ""
12421
125−
126−
127−-- EXPORTS
128−
129−
130−exports :: ModuleName.Raw -> [Variable.Value] -> [Statement ()]
131−exports name exportedValues =
132− let
133− exportedFields =
134− map toField ("_op" : concatMap extract exportedValues)
135−
136− toField x =
137− (prop x, ref x)
138−
139− extract value =
140− case value of
141− Variable.Alias _ ->
142− []
143−
144− Variable.Value x ->
145− if Help.isOp x then
146− []
147−
148− else
149− [Var.safe x]
150−
151− Variable.Union _ (Variable.Listing ctors _) ->
152− map Var.safe ctors
153−
154− values =
155− LDot () (obj (localRuntime : name)) "values"
156− in
157− [ ReturnStmt () $ Just $
158− AssignExpr () OpAssign values (ObjectLit () exportedFields)
159− ]
src/Generate/JavaScript/Expression.hs+4−4
@@ -80,9 +80,9 @@ toExpr code =
8080-- DEFINITIONS
8181
8282
83−generateDef :: Opt.Def -> State Int (Statement ())
83+generateDef :: Opt.Def -> State Int [Statement ()]
8484generateDef def =
85− do (_home, name, jsBody) <-
85+ do (home, name, jsBody) <-
8686 case def of
8787 Opt.TailDef (Opt.Facts home _) name argNames body ->
8888 (,,) home name <$> generateTailFunction name argNames body
@@ -90,7 +90,7 @@ generateDef def =
9090 Opt.Def (Opt.Facts home _) name body ->
9191 (,,) home name <$> generateJsExpr body
9292
93− return (Var.define name jsBody)
93+ return (Var.define home name jsBody)
9494
9595
9696
@@ -173,7 +173,7 @@ generateCode expr =
173173 Let defs body ->
174174 do stmts <- mapM generateDef defs
175175 code <- generateCode body
176− jsBlock (stmts ++ toStatementList code)
176+ jsBlock (concat stmts ++ toStatementList code)
177177
178178 If branches finally ->
179179 generateIf branches finally
src/Generate/JavaScript/Helpers.hs+9−7
@@ -3,6 +3,7 @@ module Generate.JavaScript.Helpers where
33import Language.ECMAScript3.Syntax
44
55
6+
67localRuntime :: String
78localRuntime =
89 "_elm"
@@ -13,18 +14,15 @@ varDecl x expr =
1314 VarDecl () (var x) (Just expr)
1415
1516
16−make :: [String] -> Expression ()
17−make moduleName =
18− obj (moduleName ++ ["make"]) <| ref localRuntime
19−
17+refOrObject :: String -> Expression ()
18+refOrObject name =
19+ InfixExpr () OpLOr (ref name) (ObjectLit () [])
2020
21−useLazy :: [String] -> String -> Expression ()
22−useLazy moduleName functionName =
23− DotRef () (make moduleName) (var functionName)
2421
2522
2623-- Creating Variables
2724
25+
2826var :: String -> Id ()
2927var name =
3028 Id () name
@@ -50,8 +48,10 @@ obj vars =
5048 error "dotSep must be called on a non-empty list of variables"
5149
5250
51+
5352-- Function Calls
5453
54+
5555(<|) :: Expression () -> Expression () -> Expression ()
5656(<|) f x =
5757 CallExpr () f [x]
@@ -67,8 +67,10 @@ call =
6767 CallExpr ()
6868
6969
70+
7071-- Checks
7172
73+
7274equal :: Expression () -> Expression () -> Expression ()
7375equal a b =
7476 InfixExpr () OpStrictEq a b
src/Generate/JavaScript/Variable.hs+79−31
@@ -1,7 +1,6 @@
11module Generate.JavaScript.Variable
22 ( fresh
33 , canonical
4− , modulePrefix
54 , define
65 , safe
76 )
@@ -18,8 +17,10 @@ import qualified AST.Variable as Var
1817import qualified Generate.JavaScript.Helpers as JS
1918
2019
20+
2121-- FRESH NAMES
2222
23+
2324fresh :: State.State Int String
2425fresh =
2526 do n <- State.get
@@ -27,54 +28,96 @@ fresh =
2728 return ("_v" ++ show n)
2829
2930
31+
3032-- DEF NAMES
3133
32−define :: String -> JS.Expression () -> JS.Statement ()
33−define name body =
34− if Help.isOp name then
35− let
36− root =
37− JS.VarRef () (JS.Id () "_op")
3834
39− lvalue =
40− JS.LBracket () root (JS.StringLit () name)
35+define :: Maybe ModuleName.Canonical -> String -> JS.Expression () -> [JS.Statement ()]
36+define maybeHome name body =
37+ if not (Help.isOp name) then
38+ let
39+ jsName =
40+ maybe unqualified qualified maybeHome name
4141 in
42− JS.ExprStmt () (JS.AssignExpr () JS.OpAssign lvalue body)
42+ [ JS.VarDeclStmt () [ JS.varDecl jsName body ] ]
4343
4444 else
45− JS.VarDeclStmt () [ JS.VarDecl () (JS.Id () (safe name)) (Just body) ]
45+ case maybeHome of
46+ Nothing ->
47+ error "can only define infix operators at the top level"
48+
49+ Just home ->
50+ let
51+ opsDictName =
52+ getOpsDictName (Var.TopLevel home)
53+
54+ lvalue =
55+ JS.LBracket () (JS.ref opsDictName) (JS.StringLit () name)
56+ in
57+ [ JS.VarDeclStmt () [ JS.varDecl opsDictName (JS.refOrObject opsDictName) ]
58+ , JS.ExprStmt () (JS.AssignExpr () JS.OpAssign lvalue body)
59+ ]
60+
4661
4762
4863-- INSTANTIATE VARIABLES
4964
65+
5066canonical :: Var.Canonical -> JS.Expression ()
5167canonical (Var.Canonical home name) =
5268 if Help.isOp name then
53− JS.BracketRef () (addRoot home "_op") (JS.StringLit () name)
69+ JS.BracketRef () (JS.ref (getOpsDictName home)) (JS.StringLit () name)
5470
5571 else
56− addRoot home (safe name)
72+ case home of
73+ Var.Local ->
74+ JS.ref (unqualified name)
75+
76+ Var.BuiltIn ->
77+ JS.ref (unqualified name)
5778
79+ Var.Module moduleName@(ModuleName.Canonical _ rawName) ->
80+ if ModuleName.isNative rawName then
81+ native moduleName name
5882
59−addRoot :: Var.Home -> String -> JS.Expression ()
60−addRoot home name =
61− case home of
62− Var.Local ->
63− JS.ref name
83+ else
84+ JS.ref (qualified moduleName name)
6485
65− Var.TopLevel _moduleName ->
66− JS.ref name
86+ Var.TopLevel moduleName ->
87+ JS.ref (qualified moduleName name)
6788
68− Var.BuiltIn ->
69− JS.ref name
7089
71− Var.Module (ModuleName.Canonical _ moduleName) ->
72− JS.DotRef () (JS.ref (modulePrefix moduleName)) (JS.Id () name)
90+unqualified :: String -> String
91+unqualified =
92+ safe
7393
7494
75−modulePrefix :: ModuleName.Raw -> String
76−modulePrefix moduleName =
77− '$' : List.intercalate "$" moduleName
95+qualified :: ModuleName.Canonical -> String -> String
96+qualified moduleName name =
97+ moduleToString moduleName ++ "$" ++ removePrimes name
98+
99+
100+native :: ModuleName.Canonical -> String -> JS.Expression ()
101+native moduleName name =
102+ JS.obj [ moduleToString moduleName, name ]
103+
104+
105+getOpsDictName :: Var.Home -> String
106+getOpsDictName home =
107+ let
108+ moduleName =
109+ case home of
110+ Var.Local -> error "infix operators should only be defined in top-level declarations"
111+ Var.BuiltIn -> error "there should be no built-in infix operators"
112+ Var.Module name -> name
113+ Var.TopLevel name -> name
114+ in
115+ moduleToString moduleName ++ "_ops"
116+
117+
118+moduleToString :: ModuleName.Canonical -> String
119+moduleToString (ModuleName.Canonical _ moduleName) =
120+ '_' : List.intercalate "_" moduleName
78121
79122
80123swap :: Char -> Char -> Char -> Char
@@ -82,14 +125,19 @@ swap from to c =
82125 if c == from then to else c
83126
84127
128+
85129-- SAFE NAMES
86130
131+
87132safe :: String -> String
88133safe name =
89− let saferName =
90− if Set.member name jsReserveds then '$' : name else name
91− in
92− map (swap '\'' '$') saferName
134+ removePrimes $
135+ if Set.member name jsReserveds then '$' : name else name
136+
137+
138+removePrimes :: String -> String
139+removePrimes name =
140+ map (swap '\'' '$') name
93141
94142
95143jsReserveds :: Set.Set String