git.iko.soy/elk
on master help sign in
start breaking JS gen into smaller modules and clean up code
6ccaf92Evan Czaplicki
elm-compiler.cabal+2
compare with master
unifiedsplit
@@ -77,8 +77,10 @@ Library
77 Elm.Compiler.Type.Extract,
77 Elm.Compiler.Type.Extract,
78 Elm.Compiler.Version,
78 Elm.Compiler.Version,
79 Generate.JavaScript,
79 Generate.JavaScript,
80+ Generate.JavaScript.BuiltIn,
80 Generate.JavaScript.Crash,
81 Generate.JavaScript.Crash,
81 Generate.JavaScript.Helpers,
82 Generate.JavaScript.Helpers,
83+ Generate.JavaScript.Literal,
82 Generate.JavaScript.Port,
84 Generate.JavaScript.Port,
83 Generate.JavaScript.Variable,
85 Generate.JavaScript.Variable,
84 Nitpick.Pattern,
86 Nitpick.Pattern,
src/Generate/JavaScript.hs+25−44
@@ -17,7 +17,9 @@ import qualified AST.Module.Name as ModuleName
17import qualified AST.Pattern as P
17import qualified AST.Pattern as P
18import qualified AST.Variable as Var
18import qualified AST.Variable as Var
19import Generate.JavaScript.Helpers as Help
19import Generate.JavaScript.Helpers as Help
20+import qualified Generate.JavaScript.BuiltIn as BuiltIn
20import qualified Generate.JavaScript.Crash as Crash
21import qualified Generate.JavaScript.Crash as Crash
22+import qualified Generate.JavaScript.Literal as Literal
21import qualified Generate.JavaScript.Port as Port
23import qualified Generate.JavaScript.Port as Port
22import qualified Generate.JavaScript.Variable as Var
24import qualified Generate.JavaScript.Variable as Var
23import qualified Optimize.Cases as Case
25import qualified Optimize.Cases as Case
@@ -30,28 +32,6 @@ generate modul =
30 error "TODO" modul exprToCode
32 error "TODO" modul exprToCode
31
33
32
34
33−-- HELPERS
34−
35−_Utils :: String -> Expression ()
36−_Utils x =
37− obj ["_U", x]
38−
39−
40−_List :: String -> Expression ()
41−_List x =
42− obj ["_L", x]
43−
44−
45−literal :: Literal -> Expression ()
46−literal lit =
47− case lit of
48− Chr c -> _Utils "chr" <| string [c]
49− Str s -> string s
50− IntNum n -> IntLit () n
51− FloatNum n -> NumLit () n
52− Boolean b -> BoolLit () b
53−
54−
55-- CODE CHUNKS
35-- CODE CHUNKS
56
36
57data Code
37data Code
@@ -139,30 +119,31 @@ exprToCode tcc annotatedExpr@(A.A _ expr) =
139 jsExpr $ Var.canonical var
119 jsExpr $ Var.canonical var
140
120
141 Literal lit ->
121 Literal lit ->
142− jsExpr $ literal lit
122+ jsExpr (Literal.literal lit)
143
123
144 Range lo hi ->
124 Range lo hi ->
145 do lo' <- toJsExpr lo
125 do lo' <- toJsExpr lo
146 hi' <- toJsExpr hi
126 hi' <- toJsExpr hi
147− jsExpr $ _List "range" `call` [lo',hi']
127+ jsExpr $ BuiltIn.range lo' hi'
148
128
149 Access record field ->
129 Access record field ->
150 do record' <- toJsExpr record
130 do record' <- toJsExpr record
151− jsExpr $ DotRef () record' (var (Var.varName field))
131+ jsExpr $ DotRef () record' (var (Var.safe field))
152
132
153 Update record fields ->
133 Update record fields ->
154− do record' <- toJsExpr record
134+ let
155− fields' <-
135+ fieldToJs (field, value) =
156− forM fields $ \(field, value) ->
136+ do jsValue <- toJsExpr value
157− do value' <- toJsExpr value
158− return $ ArrayLit () [ string (Var.varName field), value' ]
137+ return (Var.safe field, jsValue)
159−
138+ in
160− jsExpr $ _Utils "replace" `call` [ArrayLit () fields', record']
139+ do jsRecord <- toJsExpr record
140+ jsFields <- mapM fieldToJs fields
141+ jsExpr $ BuiltIn.recordUpdate jsRecord jsFields
161
142
162 Record fields ->
143 Record fields ->
163 do fields' <-
144 do fields' <-
164 forM fields $ \(field, e) ->
145 forM fields $ \(field, e) ->
165− (,) (Var.varName field) <$> toJsExpr e
146+ (,) (Var.safe field) <$> toJsExpr e
166
147
167 let fieldMap =
148 let fieldMap =
168 List.foldl' combine Map.empty fields'
149 List.foldl' combine Map.empty fields'
@@ -199,7 +180,7 @@ exprToCode tcc annotatedExpr@(A.A _ expr) =
199
180
200 ExplicitList elements ->
181 ExplicitList elements ->
201 do jsElements <- mapM toJsExpr elements
182 do jsElements <- mapM toJsExpr elements
202− jsExpr $ _List "fromArray" <| ArrayLit () jsElements
183+ jsExpr $ BuiltIn.list jsElements
203
184
204 Data tag members ->
185 Data tag members ->
205 do jsMembers <- mapM toJsExpr members
186 do jsMembers <- mapM toJsExpr members
@@ -210,7 +191,7 @@ exprToCode tcc annotatedExpr@(A.A _ expr) =
210 zipWith (\n e -> (prop ("_" ++ show n), e)) [ 0 :: Int .. ]
191 zipWith (\n e -> (prop ("_" ++ show n), e)) [ 0 :: Int .. ]
211
192
212 GLShader _uid src _tipe ->
193 GLShader _uid src _tipe ->
213− jsExpr $ ObjectLit () [(PropString () "src", literal (Str src))]
194+ jsExpr $ ObjectLit () [(PropString () "src", Literal.literal (Str src))]
214
195
215 Port impl ->
196 Port impl ->
216 case impl of
197 case impl of
@@ -276,7 +257,7 @@ destructPattern :: P.Optimized -> State Int (String, Maybe Opt.Def)
276destructPattern pattern@(A.A ann pat) =
257destructPattern pattern@(A.A ann pat) =
277 case pat of
258 case pat of
278 P.Var x ->
259 P.Var x ->
279− return (Var.varName x, Nothing)
260+ return (Var.safe x, Nothing)
280
261
281 _ ->
262 _ ->
282 do arg <- Case.newVar
263 do arg <- Case.newVar
@@ -444,7 +425,7 @@ defToStatementsHelp facts annPattern@(A.A _ pattern) jsExpr =
444 in
425 in
445 return [ ExprStmt () $ AssignExpr () OpAssign op jsExpr ]
426 return [ ExprStmt () $ AssignExpr () OpAssign op jsExpr ]
446 else
427 else
447− return [ VarDeclStmt () [ define (Var.varName x) ] ]
428+ return [ VarDeclStmt () [ define (Var.safe x) ] ]
448
429
449 P.Record fields ->
430 P.Record fields ->
450 let
431 let
@@ -460,7 +441,7 @@ defToStatementsHelp facts annPattern@(A.A _ pattern) jsExpr =
460 getVars patterns =
441 getVars patterns =
461 case patterns of
442 case patterns of
462 A.A _ (P.Var x) : rest ->
443 A.A _ (P.Var x) : rest ->
463− (Var.varName x :) `fmap` getVars rest
444+ (Var.safe x :) `fmap` getVars rest
464 [] ->
445 [] ->
465 Just []
446 Just []
466 _ ->
447 _ ->
@@ -498,9 +479,9 @@ generateCase tcc expr branches =
498 (revisedMatch, stmt) <-
479 (revisedMatch, stmt) <-
499 case expr of
480 case expr of
500 A.A _ (Var (Var.Canonical Var.Local x)) ->
481 A.A _ (Var (Var.Canonical Var.Local x)) ->
501− return (Case.matchSubst [(tempVar, Var.varName x)] initialMatch, [])
482+ return (Case.matchSubst [(tempVar, Var.safe x)] initialMatch, [])
502 A.A _ (Var (Var.Canonical (Var.TopLevel _) x)) ->
483 A.A _ (Var (Var.Canonical (Var.TopLevel _) x)) ->
503− return (Case.matchSubst [(tempVar, Var.varName x)] initialMatch, [])
484+ return (Case.matchSubst [(tempVar, Var.safe x)] initialMatch, [])
504 _ ->
485 _ ->
505 do expr' <- toJsExpr expr
486 do expr' <- toJsExpr expr
506 return (initialMatch, [VarDeclStmt () [varDecl tempVar expr']])
487 return (initialMatch, [VarDeclStmt () [varDecl tempVar expr']])
@@ -571,7 +552,7 @@ clause tcc variable (Case.Clause value vars mtch) =
571 (,) False $
552 (,) False $
572 case value of
553 case value of
573 Right (Boolean b) -> BoolLit () b
554 Right (Boolean b) -> BoolLit () b
574− Right lit -> literal lit
555+ Right lit -> Literal.literal lit
575 Left (Var.Canonical _ name) ->
556 Left (Var.Canonical _ name) ->
576 string name
557 string name
577
558
@@ -694,8 +675,8 @@ specialOps :: [(String, Expression () -> Expression () -> Expression ())]
694specialOps =
675specialOps =
695 [ (,) "^" $ \a b -> obj ["Math","pow"] `call` [a,b]
676 [ (,) "^" $ \a b -> obj ["Math","pow"] `call` [a,b]
696 , (,) "|>" $ flip (<|)
677 , (,) "|>" $ flip (<|)
697− , (,) "==" $ \a b -> _Utils "eq" `call` [a,b]
678+ , (,) "==" $ \a b -> BuiltIn.eq a b
698− , (,) "/=" $ \a b -> PrefixExpr () PrefixLNot (_Utils "eq" `call` [a,b])
679+ , (,) "/=" $ \a b -> PrefixExpr () PrefixLNot (BuiltIn.eq a b)
699 , (,) "<" $ cmp OpLT 0
680 , (,) "<" $ cmp OpLT 0
700 , (,) ">" $ cmp OpGT 0
681 , (,) ">" $ cmp OpGT 0
701 , (,) "<=" $ cmp OpLT 1
682 , (,) "<=" $ cmp OpLT 1
@@ -706,7 +687,7 @@ specialOps =
706
687
707cmp :: InfixOp -> Int -> Expression () -> Expression () -> Expression ()
688cmp :: InfixOp -> Int -> Expression () -> Expression () -> Expression ()
708cmp op n a b =
689cmp op n a b =
709− InfixExpr () op (_Utils "cmp" `call` [a,b]) (IntLit () n)
690+ InfixExpr () op (BuiltIn.compare a b) (IntLit () n)
710
691
711
692
712-- BINARY OPERATOR COLLECTORS
693-- BINARY OPERATOR COLLECTORS
src/Generate/JavaScript/BuiltIn.hsnew file+46
@@ -0,0 +1,46 @@
1+module Generate.JavaScript.BuiltIn where
2+
3+import qualified Language.ECMAScript3.Syntax as JS
4+
5+
6+-- LITERALS
7+
8+character :: Char -> JS.Expression ()
9+character char =
10+ error "TODO - utils.chr" JS.StringLit () [char]
11+
12+
13+string :: String -> JS.Expression ()
14+string str =
15+ JS.StringLit () str
16+
17+
18+-- LISTS
19+
20+list :: [JS.Expression ()] -> JS.Expression ()
21+list elements =
22+ error "TODO - utils.list" (JS.ArrayLit () elements)
23+
24+
25+range :: JS.Expression () -> JS.Expression () -> JS.Expression ()
26+range low high =
27+ error "TODO - utils.range" low high
28+
29+
30+-- RECORDS
31+
32+recordUpdate :: JS.Expression () -> [(String, JS.Expression ())] -> JS.Expression ()
33+recordUpdate record fields =
34+ error "TODO - utils.update" record fields
35+
36+
37+-- COMPARISIONS
38+
39+eq :: JS.Expression () -> JS.Expression () -> JS.Expression ()
40+eq left right =
41+ error "TODO - utils.eq" left right
42+
43+
44+compare :: JS.Expression () -> JS.Expression () -> JS.Expression ()
45+compare left right =
46+ error "TODO - utils.compare" left right
src/Generate/JavaScript/Literal.hsnew file+25
@@ -0,0 +1,25 @@
1+module Generate.JavaScript.Literal (literal) where
2+
3+import qualified Language.ECMAScript3.Syntax as JS
4+
5+import qualified AST.Literal as Lit
6+import qualified Generate.JavaScript.BuiltIn as BuiltIn
7+
8+
9+literal :: Lit.Literal -> JS.Expression ()
10+literal lit =
11+ case lit of
12+ Lit.Chr char ->
13+ BuiltIn.character char
14+
15+ Lit.Str string ->
16+ BuiltIn.string string
17+
18+ Lit.IntNum number ->
19+ JS.IntLit () number
20+
21+ Lit.FloatNum number ->
22+ JS.NumLit () number
23+
24+ Lit.Boolean boolean ->
25+ JS.BoolLit () boolean
src/Generate/JavaScript/Variable.hs+14−15
@@ -1,4 +1,4 @@
1−module Generate.JavaScript.Variable where
1+module Generate.JavaScript.Variable (canonical, safe) where
2
2
3import qualified Data.List as List
3import qualified Data.List as List
4import qualified Data.Set as Set
4import qualified Data.Set as Set
@@ -11,10 +11,7 @@ import qualified Elm.Package as Pkg
11import qualified Generate.JavaScript.Helpers as JS
11import qualified Generate.JavaScript.Helpers as JS
12
12
13
13
14−swap :: Char -> Char -> Char -> Char
14+-- INSTANTIATE VARIABLES
15−swap from to c =
16− if c == from then to else c
17−
18
15
19canonical :: Var.Canonical -> JS.Expression ()
16canonical :: Var.Canonical -> JS.Expression ()
20canonical (Var.Canonical home name) =
17canonical (Var.Canonical home name) =
@@ -22,7 +19,7 @@ canonical (Var.Canonical home name) =
22 JS.BracketRef () (JS.ref (addRoot home "_op")) (JS.string name)
19 JS.BracketRef () (JS.ref (addRoot home "_op")) (JS.string name)
23
20
24 else
21 else
25− JS.ref (addRoot home (varName name))
22+ JS.ref (addRoot home (safe name))
26
23
27
24
28addRoot :: Var.Home -> String -> String
25addRoot :: Var.Home -> String -> String
@@ -49,22 +46,25 @@ canonicalName (ModuleName.Canonical (Pkg.Name user project) moduleName) name =
49 ++ '$' : name
46 ++ '$' : name
50
47
51
48
49+swap :: Char -> Char -> Char -> Char
50+swap from to c =
51+ if c == from then to else c
52+
53+
54+-- SAFE NAMES
52
55
53−varName :: String -> String
56+safe :: String -> String
54−varName name =
57+safe name =
55 let saferName =
58 let saferName =
56 if Set.member name jsReserveds then '$' : name else name
59 if Set.member name jsReserveds then '$' : name else name
57 in
60 in
58 map (swap '\'' '$') saferName
61 map (swap '\'' '$') saferName
59
62
60
63
61−--value :: Module.Name -> String -> JS.Expression ()
62−--value home name =
63−-- canonical (Var.Canonical (Var.Module home) name)
64−
65−
66jsReserveds :: Set.Set String
64jsReserveds :: Set.Set String
67−jsReserveds = Set.fromList
65+jsReserveds =
66+ Set.fromList
67+ -- JS reserved words
68 [ "null", "undefined", "Nan", "Infinity", "true", "false", "eval"
68 [ "null", "undefined", "Nan", "Infinity", "true", "false", "eval"
69 , "arguments", "int", "byte", "char", "goto", "long", "final", "float"
69 , "arguments", "int", "byte", "char", "goto", "long", "final", "float"
70 , "short", "double", "native", "throws", "boolean", "abstract", "volatile"
70 , "short", "double", "native", "throws", "boolean", "abstract", "volatile"
@@ -76,7 +76,6 @@ jsReserveds = Set.fromList
76 , "interface", "let", "package", "private", "protected", "public"
76 , "interface", "let", "package", "private", "protected", "public"
77 , "static", "yield"
77 , "static", "yield"
78 -- reserved by the Elm runtime system
78 -- reserved by the Elm runtime system
79− , "Elm"
80 , "F2", "F3", "F4", "F5", "F6", "F7", "F8", "F9"
79 , "F2", "F3", "F4", "F5", "F6", "F7", "F8", "F9"
81 , "A2", "A3", "A4", "A5", "A6", "A7", "A8", "A9"
80 , "A2", "A3", "A4", "A5", "A6", "A7", "A8", "A9"
82 ]
81 ]