git.iko.soy/elk
on master help sign in
Switch code-gen to no closures, only fully qualified names
c4522b0Evan Czaplicki
src/Generate/JavaScript.hs+6−144
compare with master
unifiedsplit
@@ -1,159 +1,21 @@
1module Generate.JavaScript (generate) where
1module Generate.JavaScript (generate) where
2
2
3import Control.Monad.State as State
3import Control.Monad.State as State
4−import qualified Data.List as List
5import Language.ECMAScript3.PrettyPrint as ES
4import Language.ECMAScript3.PrettyPrint as ES
6−import Language.ECMAScript3.Syntax
7import qualified Text.PrettyPrint.Leijen as PP
5import qualified Text.PrettyPrint.Leijen as PP
8
6
9−import qualified AST.Expression.Optimized as Optimized
10−import qualified AST.Helpers as Help
11import qualified AST.Module as Module
7import qualified AST.Module as Module
12−import qualified AST.Module.Name as ModuleName
13−import qualified AST.Variable as Variable
14import qualified Generate.JavaScript.Expression as JS
8import 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
17
9
18
10
19generate :: Module.Optimized -> String
11generate :: Module.Optimized -> String
20−generate (Module.Module (ModuleName.Canonical _ name) _ info) =
12+generate (Module.Module _ _ info) =
21 let
13 let
22− body =
14+ genBody =
23− concat
24− [ useStrict
25− , checkForCachedVersion name
26− , imports (Module.imports info)
27− , definitions (Module.program info)
15+ concat <$> mapM JS.generateDef (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−
94
16
95−imports :: [ModuleName.Raw] -> [Statement ()]
17+ body =
96−imports rawImports =
18+ State.evalState genBody 0
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 () [])
122 in
19 in
123− setup : State.evalState (mapM JS.generateDef defs) 0
20+ PP.displayS (PP.renderPretty 1 160 (ES.prettyPrint body)) ""
124
21
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 =
80-- DEFINITIONS
80-- DEFINITIONS
81
81
82
82
83−generateDef :: Opt.Def -> State Int (Statement ())
83+generateDef :: Opt.Def -> State Int [Statement ()]
84generateDef def =
84generateDef def =
85− do (_home, name, jsBody) <-
85+ do (home, name, jsBody) <-
86 case def of
86 case def of
87 Opt.TailDef (Opt.Facts home _) name argNames body ->
87 Opt.TailDef (Opt.Facts home _) name argNames body ->
88 (,,) home name <$> generateTailFunction name argNames body
88 (,,) home name <$> generateTailFunction name argNames body
@@ -90,7 +90,7 @@ generateDef def =
90 Opt.Def (Opt.Facts home _) name body ->
90 Opt.Def (Opt.Facts home _) name body ->
91 (,,) home name <$> generateJsExpr body
91 (,,) home name <$> generateJsExpr body
92
92
93− return (Var.define name jsBody)
93+ return (Var.define home name jsBody)
94
94
95
95
96
96
@@ -173,7 +173,7 @@ generateCode expr =
173 Let defs body ->
173 Let defs body ->
174 do stmts <- mapM generateDef defs
174 do stmts <- mapM generateDef defs
175 code <- generateCode body
175 code <- generateCode body
176− jsBlock (stmts ++ toStatementList code)
176+ jsBlock (concat stmts ++ toStatementList code)
177
177
178 If branches finally ->
178 If branches finally ->
179 generateIf branches finally
179 generateIf branches finally
src/Generate/JavaScript/Helpers.hs+9−7
@@ -3,6 +3,7 @@ module Generate.JavaScript.Helpers where
3import Language.ECMAScript3.Syntax
3import Language.ECMAScript3.Syntax
4
4
5
5
6+
6localRuntime :: String
7localRuntime :: String
7localRuntime =
8localRuntime =
8 "_elm"
9 "_elm"
@@ -13,18 +14,15 @@ varDecl x expr =
13 VarDecl () (var x) (Just expr)
14 VarDecl () (var x) (Just expr)
14
15
15
16
16−make :: [String] -> Expression ()
17+refOrObject :: String -> Expression ()
17−make moduleName =
18+refOrObject name =
18− obj (moduleName ++ ["make"]) <| ref localRuntime
19+ InfixExpr () OpLOr (ref name) (ObjectLit () [])
19−
20
20
21−useLazy :: [String] -> String -> Expression ()
22−useLazy moduleName functionName =
23− DotRef () (make moduleName) (var functionName)
24
21
25
22
26-- Creating Variables
23-- Creating Variables
27
24
25+
28var :: String -> Id ()
26var :: String -> Id ()
29var name =
27var name =
30 Id () name
28 Id () name
@@ -50,8 +48,10 @@ obj vars =
50 error "dotSep must be called on a non-empty list of variables"
48 error "dotSep must be called on a non-empty list of variables"
51
49
52
50
51+
53-- Function Calls
52-- Function Calls
54
53
54+
55(<|) :: Expression () -> Expression () -> Expression ()
55(<|) :: Expression () -> Expression () -> Expression ()
56(<|) f x =
56(<|) f x =
57 CallExpr () f [x]
57 CallExpr () f [x]
@@ -67,8 +67,10 @@ call =
67 CallExpr ()
67 CallExpr ()
68
68
69
69
70+
70-- Checks
71-- Checks
71
72
73+
72equal :: Expression () -> Expression () -> Expression ()
74equal :: Expression () -> Expression () -> Expression ()
73equal a b =
75equal a b =
74 InfixExpr () OpStrictEq a b
76 InfixExpr () OpStrictEq a b
src/Generate/JavaScript/Variable.hs+79−31
@@ -1,7 +1,6 @@
1module Generate.JavaScript.Variable
1module Generate.JavaScript.Variable
2 ( fresh
2 ( fresh
3 , canonical
3 , canonical
4− , modulePrefix
5 , define
4 , define
6 , safe
5 , safe
7 )
6 )
@@ -18,8 +17,10 @@ import qualified AST.Variable as Var
18import qualified Generate.JavaScript.Helpers as JS
17import qualified Generate.JavaScript.Helpers as JS
19
18
20
19
20+
21-- FRESH NAMES
21-- FRESH NAMES
22
22
23+
23fresh :: State.State Int String
24fresh :: State.State Int String
24fresh =
25fresh =
25 do n <- State.get
26 do n <- State.get
@@ -27,54 +28,96 @@ fresh =
27 return ("_v" ++ show n)
28 return ("_v" ++ show n)
28
29
29
30
31+
30-- DEF NAMES
32-- DEF NAMES
31
33
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")
38
34
39− lvalue =
35+define :: Maybe ModuleName.Canonical -> String -> JS.Expression () -> [JS.Statement ()]
40− JS.LBracket () root (JS.StringLit () name)
36+define maybeHome name body =
37+ if not (Help.isOp name) then
38+ let
39+ jsName =
40+ maybe unqualified qualified maybeHome name
41 in
41 in
42− JS.ExprStmt () (JS.AssignExpr () JS.OpAssign lvalue body)
42+ [ JS.VarDeclStmt () [ JS.varDecl jsName body ] ]
43
43
44 else
44 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+
46
61
47
62
48-- INSTANTIATE VARIABLES
63-- INSTANTIATE VARIABLES
49
64
65+
50canonical :: Var.Canonical -> JS.Expression ()
66canonical :: Var.Canonical -> JS.Expression ()
51canonical (Var.Canonical home name) =
67canonical (Var.Canonical home name) =
52 if Help.isOp name then
68 if Help.isOp name then
53− JS.BracketRef () (addRoot home "_op") (JS.StringLit () name)
69+ JS.BracketRef () (JS.ref (getOpsDictName home)) (JS.StringLit () name)
54
70
55 else
71 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)
57
78
79+ Var.Module moduleName@(ModuleName.Canonical _ rawName) ->
80+ if ModuleName.isNative rawName then
81+ native moduleName name
58
82
59−addRoot :: Var.Home -> String -> JS.Expression ()
83+ else
60−addRoot home name =
84+ JS.ref (qualified moduleName name)
61− case home of
62− Var.Local ->
63− JS.ref name
64
85
65− Var.TopLevel _moduleName ->
86+ Var.TopLevel moduleName ->
66− JS.ref name
87+ JS.ref (qualified moduleName name)
67
88
68− Var.BuiltIn ->
69− JS.ref name
70
89
71− Var.Module (ModuleName.Canonical _ moduleName) ->
90+unqualified :: String -> String
72− JS.DotRef () (JS.ref (modulePrefix moduleName)) (JS.Id () name)
91+unqualified =
92+ safe
73
93
74
94
75−modulePrefix :: ModuleName.Raw -> String
95+qualified :: ModuleName.Canonical -> String -> String
76−modulePrefix moduleName =
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) =
77− '$' : List.intercalate "$" moduleName
120+ '_' : List.intercalate "_" moduleName
78
121
79
122
80swap :: Char -> Char -> Char -> Char
123swap :: Char -> Char -> Char -> Char
@@ -82,14 +125,19 @@ swap from to c =
82 if c == from then to else c
125 if c == from then to else c
83
126
84
127
128+
85-- SAFE NAMES
129-- SAFE NAMES
86
130
131+
87safe :: String -> String
132safe :: String -> String
88safe name =
133safe name =
89− let saferName =
134+ removePrimes $
90− if Set.member name jsReserveds then '$' : name else name
135+ if Set.member name jsReserveds then '$' : name else name
91− in
136+
137+
138+removePrimes :: String -> String
139+removePrimes name =
92− map (swap '\'' '$') saferName
140+ map (swap '\'' '$') name
93
141
94
142
95jsReserveds :: Set.Set String
143jsReserveds :: Set.Set String