git.iko.soy/elk
on 7b60982 help sign in
elk/compiler/src/Generate/JavaScript/Builder.hs
540 lines 12 kB history raw
1{-# OPTIONS_GHC -Wall #-}
2{-# LANGUAGE OverloadedStrings #-}
3module Generate.JavaScript.Builder
4 ( stmtToBuilder
5 , exprToBuilder
6 , Expr(..), LValue(..)
7 , Stmt(..), Case(..)
8 , InfixOp(..), PrefixOp(..)
9 )
10 where
12-- Based on the language-ecmascript package.
13-- https://hackage.haskell.org/package/language-ecmascript
14-- They did the hard work of reading the spec to figure out
15-- how all the types should fit together.
17import Prelude hiding (lines)
18import qualified Data.List as List
19import Data.ByteString.Builder as B
20import Data.Monoid ((<>))
21import qualified Generate.JavaScript.Name as Name
22import Generate.JavaScript.Name (Name)
23import qualified Json.Encode as Json
27-- EXPRESSIONS
30data Expr
31 = String Builder
32 | Float Builder
33 | Int Int
34 | Bool Bool
35 | Null
36 | Json Json.Value
37 | Array [Expr]
38 | Object [(Name, Expr)]
39 | Ref Name
40 | Access Expr Name -- ^ @foo.bar@, spec 11.2.1
41 | Index Expr Expr -- ^ @foo[bar]@, spec 11.2.1
42 | Prefix PrefixOp Expr
43 | Infix InfixOp Expr Expr
44 | If Expr Expr Expr
45 | Assign LValue Expr
46 | Call Expr [Expr] -- ^ @f(x,y,z)@, spec 11.2.3
47 | Function (Maybe Name) [Name] [Stmt]
50data LValue
51 = LRef Name
52 | LDot Expr Name
53 | LBracket Expr Expr
57-- STATEMENTS
60data Stmt
61 = Block [Stmt] -- {stmts}
62 | EmptyStmt -- ;
63 | ExprStmt Expr -- expr;
64 | IfStmt Expr Stmt Stmt -- if (e) stmt1 else stmt2
65 | Switch Expr [Case] -- switch (e) clauses
66 | While Expr Stmt -- while (e) do stmt
67 | Break (Maybe Name) -- break lab;
68 | Continue (Maybe Name) -- continue lab;
69 | Labelled Name Stmt -- lab: stmt
70 | Try Stmt Name Stmt -- try stmt catch (x) stmt
71 | Throw Expr -- throw expr;
72 | Return (Maybe Expr) -- return expr;
73 | Var [(Name, Maybe Expr)] -- var x, y=42;
74 | FunctionStmt Name [Name] [Stmt] -- function f(x, y, z) {...}
77data Case
78 = Case Expr [Stmt]
79 | Default [Stmt]
83-- OPERATORS
86data InfixOp
87 = OpLT -- <
88 | OpLEq -- <=
89 | OpGT -- >
90 | OpGEq -- >=
91 | OpIn -- in
92 | OpInstanceof -- instanceof
93 | OpEq -- ==
94 | OpNEq -- !=
95 | OpStrictEq -- ===
96 | OpStrictNEq -- !==
97 | OpLAnd -- &&
98 | OpLOr -- ||
99 | OpMul -- *
100 | OpDiv -- /
101 | OpMod -- %
102 | OpSub -- -
103 | OpLShift -- <<
104 | OpSpRShift -- >>
105 | OpZfRShift -- >>>
106 | OpBAnd -- &
107 | OpBXor -- ^
108 | OpBOr -- |
109 | OpAdd -- +
112data PrefixOp
113 = PrefixLNot -- !
114 | PrefixBNot -- ~
115 | PrefixPlus -- +
116 | PrefixMinus -- -
117 | PrefixTypeof -- typeof
121-- ENCODE
124stmtToBuilder :: Stmt -> Builder
125stmtToBuilder stmts =
126 fromStmt "" stmts
129exprToBuilder :: Expr -> Builder
130exprToBuilder expr =
131 snd $ fromExpr "" Whatever expr
135-- HELPERS
138deeper :: Builder -> Builder
139deeper indent =
140 "\t" <> indent
143commaSep :: [Builder] -> Builder
144commaSep builders =
145 mconcat (List.intersperse ", " builders)
148commaNewlineSep :: Builder -> [Builder] -> Builder
149commaNewlineSep indent builders =
150 mconcat (List.intersperse (",\n" <> deeper indent) builders)
154-- STATEMENTS
157fromStmtBlock :: Builder -> [Stmt] -> Builder
158fromStmtBlock indent stmts =
159 mconcat (map (fromStmt indent) stmts)
162fromStmt :: Builder -> Stmt -> Builder
163fromStmt indent statement =
164 case statement of
165 Block stmts ->
166 fromStmtBlock indent stmts
168 EmptyStmt ->
169 mempty
171 ExprStmt expr ->
172 indent <> snd (fromExpr indent Whatever expr) <> ";\n"
174 IfStmt condition thenStmt elseStmt ->
175 mconcat
176 [ indent, "if (", snd (fromExpr indent Whatever condition), ") {\n"
177 , fromStmt (deeper indent) thenStmt
178 , indent, "} else {\n"
179 , fromStmt (deeper indent) elseStmt
180 , indent, "}\n"
181 ]
183 Switch expr clauses ->
184 mconcat
185 [ indent, "switch (", snd (fromExpr indent Whatever expr), ") {\n"
186 , mconcat (map (fromClause (deeper indent)) clauses)
187 , indent, "}\n"
188 ]
190 While expr stmt ->
191 mconcat
192 [ indent, "while (", snd (fromExpr indent Whatever expr), ") {\n"
193 , fromStmt (deeper indent) stmt
194 , indent, "}\n"
195 ]
197 Break Nothing ->
198 indent <> "break;\n"
200 Break (Just label) ->
201 indent <> "break " <> Name.toBuilder label <> ";\n"
203 Continue Nothing ->
204 indent <> "continue;\n"
206 Continue (Just label) ->
207 indent <> "continue " <> Name.toBuilder label <> ";\n"
209 Labelled label stmt ->
210 mconcat
211 [ indent, Name.toBuilder label, ":\n"
212 , fromStmt indent stmt
213 ]
215 Try tryStmt errorName catchStmt ->
216 mconcat
217 [ indent, "try {\n"
218 , fromStmt (deeper indent) tryStmt
219 , indent, "} catch (", Name.toBuilder errorName, ") {\n"
220 , fromStmt (deeper indent) catchStmt
221 , indent, "}\n"
222 ]
224 Throw expr ->
225 "throw " <> snd (fromExpr indent Whatever expr) <> ";"
227 Return Nothing ->
228 indent <> "return;\n"
230 Return (Just expr) ->
231 indent <> "return " <> snd (fromExpr indent Whatever expr) <> ";\n"
233 Var [] ->
234 mempty
236 Var vars ->
237 indent <> "var " <> commaNewlineSep indent (map (varToBuilder indent) vars) <> ";\n"
239 FunctionStmt name args stmts ->
240 indent <> "function " <> Name.toBuilder name <> "(" <> commaSep (map Name.toBuilder args) <> ") {\n"
241 <>
242 fromStmtBlock (deeper indent) stmts
243 <>
244 indent <> "}\n"
248-- SWITCH CLAUSES
251fromClause :: Builder -> Case -> Builder
252fromClause indent clause =
253 case clause of
254 Case expr stmts ->
255 indent <> "case " <> snd (fromExpr indent Whatever expr) <> ":\n"
256 <> fromStmtBlock (deeper indent) stmts
258 Default stmts ->
259 indent <> "default:\n"
260 <> fromStmtBlock (deeper indent) stmts
264-- VAR DECLS
267varToBuilder :: Builder -> (Name, Maybe Expr) -> Builder
268varToBuilder indent (name, maybeExpr) =
269 case maybeExpr of
270 Nothing ->
271 Name.toBuilder name
273 Just expr ->
274 Name.toBuilder name <> " = " <> snd (fromExpr indent Whatever expr)
278-- EXPRESSIONS
281data Lines = One | Many deriving (Eq)
284merge :: Lines -> Lines -> Lines
285merge a b =
286 if a == Many || b == Many then Many else One
289linesMap :: (a -> (Lines, b)) -> [a] -> (Bool, [b])
290linesMap func xs =
291 let
292 pairs =
293 map func xs
294 in
295 ( any ((==) Many . fst) pairs
296 , map snd pairs
297 )
300data Grouping = Atomic | Whatever
303parensFor :: Grouping -> Builder -> Builder
304parensFor grouping builder =
305 case grouping of
306 Atomic ->
307 "(" <> builder <> ")"
309 Whatever ->
310 builder
313fromExpr :: Builder -> Grouping -> Expr -> (Lines, Builder)
314fromExpr indent grouping expression =
315 case expression of
316 String string ->
317 (One, "'" <> string <> "'")
319 Float float ->
320 (One, float)
322 Int n ->
323 (One, B.intDec n)
325 Bool bool ->
326 (One, if bool then "true" else "false")
328 Null ->
329 (One, "null")
331 Json json ->
332 ( One, Json.encodeUgly json )
334 Array exprs ->
335 (,) Many $
336 let
337 (anyMany, builders) =
338 linesMap (fromExpr indent Whatever) exprs
339 in
340 if anyMany then
341 "[\n"
342 <> deeper indent
343 <> commaNewlineSep indent builders
344 <> "\n" <> indent <> "]"
346 else
347 "[" <> commaSep builders <> "]"
349 Object fields ->
350 (,) Many $
351 let
352 deeperIndent =
353 deeper indent
355 (anyMany, builders) =
356 linesMap (fromField deeperIndent) fields
357 in
358 if anyMany then
359 "{\n"
360 <> deeperIndent
361 <> commaNewlineSep indent builders
362 <> "\n" <> indent <> "}"
364 else
365 "{" <> commaSep builders <> "}"
367 Ref name ->
368 (One, Name.toBuilder name)
370 Access expr field ->
371 makeDot indent expr field
373 Index expr bracketedExpr ->
374 makeBracketed indent expr bracketedExpr
376 Prefix op expr ->
377 let
378 (lines, builder) =
379 fromExpr indent Atomic expr
380 in
381 ( lines
382 , parensFor grouping (fromPrefix op <> builder)
383 )
385 Infix op leftExpr rightExpr ->
386 let
387 (leftLines, left) =
388 fromExpr indent Atomic leftExpr
390 (rightLines, right) =
391 fromExpr indent Atomic rightExpr
392 in
393 ( merge leftLines rightLines
394 , parensFor grouping (left <> fromInfix op <> right)
395 )
397 If condExpr thenExpr elseExpr ->
398 let
399 condB = snd (fromExpr indent Atomic condExpr)
400 thenB = snd (fromExpr indent Atomic thenExpr)
401 elseB = snd (fromExpr indent Atomic elseExpr)
402 in
403 ( Many
404 , parensFor grouping (condB <> " ? " <> thenB <> " : " <> elseB)
405 )
407 Assign lValue expr ->
408 let
409 (leftLines, left) =
410 fromLValue indent lValue
412 (rightLines, right) =
413 fromExpr indent Whatever expr
414 in
415 ( merge leftLines rightLines
416 , parensFor grouping (left <> " = " <> right)
417 )
419 Call function args ->
420 (,) Many $
421 let
422 deeperIndent =
423 deeper indent
425 funcB =
426 snd (fromExpr indent Atomic function)
428 (anyMany, argsB) =
429 linesMap (fromExpr deeperIndent Whatever) args
430 in
431 if anyMany then
432 funcB <> "(\n" <> deeperIndent <> commaNewlineSep indent argsB <> ")"
434 else
435 funcB <> "(" <> commaSep argsB <> ")"
437 Function maybeName args stmts ->
438 (,) Many $
439 "function " <> maybe mempty Name.toBuilder maybeName <> "(" <> commaSep (map Name.toBuilder args) <> ") {\n"
440 <>
441 fromStmtBlock (deeper indent) stmts
442 <>
443 indent <> "}"
447-- FIELDS
450fromField :: Builder -> (Name, Expr) -> (Lines, Builder)
451fromField indent (field, expr) =
452 let
453 (lines, builder) =
454 fromExpr indent Whatever expr
455 in
456 ( lines
457 , Name.toBuilder field <> ": " <> builder
458 )
462-- VALUES
465fromLValue :: Builder -> LValue -> (Lines, Builder)
466fromLValue indent lValue =
467 case lValue of
468 LRef name ->
469 (One, Name.toBuilder name)
471 LDot expr field ->
472 makeDot indent expr field
474 LBracket expr bracketedExpr ->
475 makeBracketed indent expr bracketedExpr
478makeDot :: Builder -> Expr -> Name -> (Lines, Builder)
479makeDot indent expr field =
480 let
481 (lines, builder) =
482 fromExpr indent Atomic expr
483 in
484 (lines, builder <> "." <> Name.toBuilder field)
487makeBracketed :: Builder -> Expr -> Expr -> (Lines, Builder)
488makeBracketed indent expr bracketedExpr =
489 let
490 (lines, builder) =
491 fromExpr indent Atomic expr
493 (bracketedLines, bracketedBuilder) =
494 fromExpr indent Whatever bracketedExpr
495 in
496 ( merge lines bracketedLines
497 , builder <> "[" <> bracketedBuilder <> "]"
498 )
502-- OPERATORS
505fromPrefix :: PrefixOp -> Builder
506fromPrefix op =
507 case op of
508 PrefixLNot -> "!"
509 PrefixBNot -> "~"
510 PrefixPlus -> "+"
511 PrefixMinus -> "-"
512 PrefixTypeof -> "typeof "
515fromInfix :: InfixOp -> Builder
516fromInfix op =
517 case op of
518 OpLT -> " < "
519 OpLEq -> " <= "
520 OpGT -> " > "
521 OpGEq -> " >= "
522 OpIn -> " in "
523 OpInstanceof -> " instanceof "
524 OpEq -> " == "
525 OpNEq -> " != "
526 OpStrictEq -> " === "
527 OpStrictNEq -> " !== "
528 OpLAnd -> " && "
529 OpLOr -> " || "
530 OpMul -> " * "
531 OpDiv -> " / "
532 OpMod -> " % "
533 OpSub -> " - "
534 OpLShift -> " << "
535 OpSpRShift -> " >> "
536 OpZfRShift -> " >>> "
537 OpBAnd -> " & "
538 OpBXor -> " ^ "
539 OpBOr -> " | "
540 OpAdd -> " + "