git.iko.soy/elk
on 755239c help sign in
elk/src/Generate/JavaScript/Expression.hs
825 lines 21 kB history raw
1{-# LANGUAGE OverloadedStrings #-}
2module Generate.JavaScript.Expression
3 ( generateJsExpr
4 )
5 where
8import qualified Data.IntMap as IntMap
9import qualified Data.List as List
10import qualified Data.Map as Map
11import qualified Data.Text.Encoding as Text
13import qualified AST.Optimized as Opt
14import qualified AST.Module.Name as ModuleName
15import qualified Data.Index as Index
16import qualified Elm.Name as N
17import qualified Elm.Package as Pkg
18import qualified Generate.JavaScript.Builder as JS
19import qualified Generate.JavaScript.Name as Name
20import qualified Optimize.DecisionTree as DT
21import qualified Reporting.Region as R
25-- ENVIRONMENT
28type Mode = Name.Mode
32-- EXPRESSIONS
35generateJsExpr :: Mode -> Opt.Expr -> JS.Expr
36generateJsExpr mode expression =
37 codeToJsExpr (generateCode mode expression)
40generateCode :: Mode -> Opt.Expr -> Code
41generateCode mode expression =
42 case expression of
43 Opt.Chr char ->
44 JsExpr $
45 case mode of
46 Name.Debug ->
47 JS.Call toChar [ JS.String (Text.encodeUtf8Builder char) ]
49 Name.Prod _ ->
50 JS.String (Text.encodeUtf8Builder char)
52 Opt.Str string ->
53 JsExpr $ JS.String (Text.encodeUtf8Builder string)
55 Opt.Int int ->
56 JsExpr $ JS.Int int
58 Opt.Float float ->
59 JsExpr $ JS.Float float
61 Opt.VarLocal name ->
62 JsExpr $ JS.Ref (Name.fromLocal name)
64 Opt.VarGlobal (Opt.Global home name) ->
65 JsExpr $ JS.Ref (Name.fromGlobal home name)
67 Opt.VarCycle home name ->
68 JsExpr $ JS.Ref (Name.fromCycle home name)
70 Opt.VarDebug name home region unhandledValueName ->
71 JsExpr $ generateDebug name home region unhandledValueName
73 Opt.VarKernel home name ->
74 JsExpr $ JS.Ref (Name.fromKernel home name)
76 Opt.List entries ->
77 JsExpr $
78 JS.Call
79 (JS.Ref (Name.fromKernel N.list "fromArray"))
80 [ JS.Array $ map (generateJsExpr mode) entries
81 ]
83 Opt.Function args body ->
84 generateFunction args (generateCode mode body)
86 Opt.Call func args ->
87 JsExpr $ generateCall mode func args
89 Opt.TailCall name args ->
90 JsBlock $ generateTailCall mode name args
92 Opt.If branches final ->
93 generateIf mode branches final
95 Opt.Let def body ->
96 JsBlock $
97 generateDef mode def : codeToStatementList (generateCode mode body)
99 Opt.Case label root decider jumps ->
100 JsBlock $ generateCase mode label root decider jumps
102 Opt.Index expr index ->
103 JsExpr $ JS.Access (generateJsExpr mode expr) (Name.fromInt index)
105 Opt.Accessor field ->
106 JsExpr $ JS.Function Nothing [Name.dollar]
107 [ JS.Return $ Just $
108 JS.Access (JS.Ref Name.dollar) (Name.fromField mode field)
109 ]
111 Opt.Access record field ->
112 JsExpr $ JS.Access (generateJsExpr mode record) (Name.fromField mode field)
114 Opt.Update record fields ->
115 JsExpr $
116 JS.Call (JS.Ref (Name.fromKernel N.utils "update"))
117 [ generateJsExpr mode record
118 , generateRecord mode fields
119 ]
121 Opt.Record fields ->
122 JsExpr $ generateRecord mode fields
124 Opt.Unit ->
125 JsExpr $ JS.Ref (Name.fromKernel N.utils "Tuple0")
127 Opt.Tuple a b maybeC ->
128 JsExpr $
129 case maybeC of
130 Nothing ->
131 JS.Call (JS.Ref (Name.fromKernel N.utils "Tuple2"))
132 [ generateJsExpr mode a
133 , generateJsExpr mode b
134 ]
136 Just c ->
137 JS.Call (JS.Ref (Name.fromKernel N.utils "Tuple3"))
138 [ generateJsExpr mode a
139 , generateJsExpr mode b
140 , generateJsExpr mode c
141 ]
143 Opt.Shader src ->
144 let string = JS.String (Text.encodeUtf8Builder src) in
145 JsExpr $ JS.Object [ ( Name.fromLocal "src", string ) ]
149-- CODE CHUNKS
152data Code
153 = JsExpr JS.Expr
154 | JsBlock [JS.Stmt]
157codeToJsExpr :: Code -> JS.Expr
158codeToJsExpr code =
159 case code of
160 JsExpr expr ->
161 expr
163 JsBlock stmts ->
164 JS.Call (JS.Function Nothing [] stmts) []
167codeToStatementList :: Code -> [JS.Stmt]
168codeToStatementList code =
169 case code of
170 JsExpr expr ->
171 [ JS.Return (Just expr) ]
173 JsBlock stmts ->
174 stmts
177codeToStatement :: Code -> JS.Stmt
178codeToStatement code =
179 case code of
180 JsExpr expr ->
181 JS.Return (Just expr)
183 JsBlock [stmt] ->
184 stmt
186 JsBlock stmts ->
187 JS.Block stmts
191-- CHARS
194{-# NOINLINE toChar #-}
195toChar :: JS.Expr
196toChar =
197 JS.Ref (Name.fromKernel N.utils "chr")
201-- RECORDS
204generateRecord :: Mode -> Map.Map N.Name Opt.Expr -> JS.Expr
205generateRecord mode fields =
206 let
207 toPair (field, value) =
208 (Name.fromField mode field, generateJsExpr mode value)
209 in
210 JS.Object (map toPair (Map.toList fields))
214-- DEBUG
217generateDebug :: N.Name -> ModuleName.Canonical -> R.Region -> Maybe N.Name -> JS.Expr
218generateDebug name (ModuleName.Canonical _ home) region unhandledValueName =
219 if name /= "crash" then
220 JS.Ref (Name.fromGlobal ModuleName.debug name)
221 else
222 case unhandledValueName of
223 Nothing ->
224 JS.Call (JS.Ref (Name.fromKernel N.utils "crash")) $
225 [ JS.String (N.toBuilder home)
226 , regionToJsExpr region
227 ]
229 Just valueName ->
230 JS.Call (JS.Ref (Name.fromKernel N.utils "crashCase")) $
231 [ JS.String (N.toBuilder home)
232 , regionToJsExpr region
233 , JS.Ref (Name.fromLocal valueName)
234 ]
237regionToJsExpr :: R.Region -> JS.Expr
238regionToJsExpr (R.Region start end) =
239 JS.Object
240 [ ( Name.fromLocal "start", positionToJsExpr start )
241 , ( Name.fromLocal "end", positionToJsExpr end )
242 ]
245positionToJsExpr :: R.Position -> JS.Expr
246positionToJsExpr (R.Position line column) =
247 JS.Object
248 [ ( Name.fromLocal "line", JS.Int line )
249 , ( Name.fromLocal "column", JS.Int column )
250 ]
254-- FUNCTION
257generateFunction :: [N.Name] -> Code -> Code
258generateFunction args body =
259 case IntMap.lookup (length args) funcHelpers of
260 Just helper ->
261 JsExpr $
262 JS.Call helper
263 [ JS.Function Nothing (map Name.fromLocal args) $
264 codeToStatementList body
265 ]
267 Nothing ->
268 let
269 addArg arg code =
270 JsExpr $ JS.Function Nothing [Name.fromLocal arg] $
271 codeToStatementList code
272 in
273 foldr addArg body args
276{-# NOINLINE funcHelpers #-}
277funcHelpers :: IntMap.IntMap JS.Expr
278funcHelpers =
279 IntMap.fromList
280 [ (2, JS.Ref (Name.fromLocal "F2"))
281 , (3, JS.Ref (Name.fromLocal "F3"))
282 , (4, JS.Ref (Name.fromLocal "F4"))
283 , (5, JS.Ref (Name.fromLocal "F5"))
284 , (6, JS.Ref (Name.fromLocal "F6"))
285 , (7, JS.Ref (Name.fromLocal "F7"))
286 , (8, JS.Ref (Name.fromLocal "F8"))
287 , (9, JS.Ref (Name.fromLocal "F9"))
288 ]
292-- CALLS
295generateCall :: Mode -> Opt.Expr -> [Opt.Expr] -> JS.Expr
296generateCall mode func args =
297 case func of
298 Opt.VarGlobal global@(Opt.Global (ModuleName.Canonical pkg _) _) | pkg == Pkg.core ->
299 generateCoreCall mode global args
301 _ ->
302 generateNormalCall
303 (generateJsExpr mode func)
304 (map (generateJsExpr mode) args)
307generateNormalCall' :: ModuleName.Canonical -> N.Name -> [JS.Expr] -> JS.Expr
308generateNormalCall' home name args =
309 generateNormalCall (JS.Ref (Name.fromGlobal home name)) args
312generateNormalCall :: JS.Expr -> [JS.Expr] -> JS.Expr
313generateNormalCall func args =
314 case IntMap.lookup (length args) callHelpers of
315 Just helper ->
316 JS.Call helper (func:args)
318 Nothing ->
319 List.foldl' (\f a -> JS.Call f [a]) func args
322{-# NOINLINE callHelpers #-}
323callHelpers :: IntMap.IntMap JS.Expr
324callHelpers =
325 IntMap.fromList
326 [ (2, JS.Ref (Name.fromLocal "A2"))
327 , (3, JS.Ref (Name.fromLocal "A3"))
328 , (4, JS.Ref (Name.fromLocal "A4"))
329 , (5, JS.Ref (Name.fromLocal "A5"))
330 , (6, JS.Ref (Name.fromLocal "A6"))
331 , (7, JS.Ref (Name.fromLocal "A7"))
332 , (8, JS.Ref (Name.fromLocal "A8"))
333 , (9, JS.Ref (Name.fromLocal "A9"))
334 ]
338-- CORE CALLS
341generateCoreCall :: Mode -> Opt.Global -> [Opt.Expr] -> JS.Expr
342generateCoreCall mode (Opt.Global home@(ModuleName.Canonical _ moduleName) name) args =
343 if moduleName == N.basics then
344 generateBasicsCall mode home name args
346 else if moduleName == N.bitwise then
347 generateBitwiseCall home name (map (generateJsExpr mode) args)
349 else if moduleName == N.tuple then
350 generateTupleCall home name (map (generateJsExpr mode) args)
352 else
353 generateNormalCall' home name (map (generateJsExpr mode) args)
356generateTupleCall :: ModuleName.Canonical -> N.Name -> [JS.Expr] -> JS.Expr
357generateTupleCall home name args =
358 case args of
359 [value] ->
360 case name of
361 "first" -> JS.Access value (Name.fromLocal "a")
362 "second" -> JS.Access value (Name.fromLocal "b")
363 _ -> generateNormalCall' home name args
365 _ ->
366 generateNormalCall' home name args
369generateBitwiseCall :: ModuleName.Canonical -> N.Name -> [JS.Expr] -> JS.Expr
370generateBitwiseCall home name args =
371 case args of
372 [arg] ->
373 case name of
374 "complement" -> JS.Prefix JS.PrefixBNot arg
375 _ -> generateNormalCall' home name args
377 [left,right] ->
378 case name of
379 "and" -> JS.Infix JS.OpBAnd left right
380 "or" -> JS.Infix JS.OpBOr left right
381 "xor" -> JS.Infix JS.OpBXor left right
382 "shiftLeftBy" -> JS.Infix JS.OpLShift right left
383 "shiftRightBy" -> JS.Infix JS.OpSpRShift right left
384 "shiftRightZfBy" -> JS.Infix JS.OpZfRShift right left
385 _ -> generateNormalCall' home name args
387 _ ->
388 generateNormalCall' home name args
391generateBasicsCall :: Mode -> ModuleName.Canonical -> N.Name -> [Opt.Expr] -> JS.Expr
392generateBasicsCall mode home name args =
393 case args of
394 [elmArg] ->
395 let arg = generateJsExpr mode elmArg in
396 case name of
397 "not" -> JS.Prefix JS.PrefixLNot arg
398 "toFloat" -> arg
399 "truncate" -> JS.Infix JS.OpBOr arg (JS.Int 0)
400 _ -> generateNormalCall' home name [arg]
402 [elmLeft, elmRight] ->
403 case name of
404 "composeL" -> decomposeL mode elmLeft [elmRight]
405 "composeR" -> decomposeR mode [elmLeft] elmRight
406 "append" -> append mode elmLeft elmRight
407 "apL" -> generateJsExpr mode $ apply elmLeft elmRight
408 "apR" -> generateJsExpr mode $ apply elmRight elmLeft
409 _ ->
410 let
411 left = generateJsExpr mode elmLeft
412 right = generateJsExpr mode elmRight
413 in
414 case name of
415 "add" -> JS.Infix JS.OpAdd left right
416 "sub" -> JS.Infix JS.OpSub left right
417 "mul" -> JS.Infix JS.OpMul left right
418 "fdiv" -> JS.Infix JS.OpDiv left right
419 "idiv" -> JS.Infix JS.OpBOr (JS.Infix JS.OpDiv left right) (JS.Int 0)
420 "eq" -> equal left right
421 "neq" -> notEqual left right
422 "lt" -> cmp JS.OpLT JS.OpLT 0 left right
423 "gt" -> cmp JS.OpGT JS.OpGT 0 left right
424 "le" -> cmp JS.OpLEq JS.OpLT 1 left right
425 "ge" -> cmp JS.OpGEq JS.OpGT (-1) left right
426 "or" -> JS.Infix JS.OpLOr left right
427 "and" -> JS.Infix JS.OpLAnd left right
428 "xor" -> JS.Infix JS.OpStrictNEq left right
429 _ -> generateNormalCall' home name [left, right]
431 _ ->
432 generateNormalCall' home name (map (generateJsExpr mode) args)
435equal :: JS.Expr -> JS.Expr -> JS.Expr
436equal left right =
437 if isLiteral left || isLiteral right then
438 strictEq left right
439 else
440 JS.Call (JS.Ref (Name.fromKernel N.utils "eq")) [left, right]
443notEqual :: JS.Expr -> JS.Expr -> JS.Expr
444notEqual left right =
445 if isLiteral left || isLiteral right then
446 strictNEq left right
447 else
448 JS.Prefix JS.PrefixLNot $
449 JS.Call (JS.Ref (Name.fromKernel N.utils "eq")) [left, right]
452cmp :: JS.InfixOp -> JS.InfixOp -> Int -> JS.Expr -> JS.Expr -> JS.Expr
453cmp idealOp backupOp backupInt left right =
454 if isLiteral left || isLiteral right then
455 JS.Infix idealOp left right
456 else
457 JS.Infix backupOp
458 (JS.Call (JS.Ref (Name.fromKernel N.utils "cmp")) [left, right])
459 (JS.Int backupInt)
462isLiteral :: JS.Expr -> Bool
463isLiteral expr =
464 case expr of
465 JS.String _ ->
466 True
468 JS.Float _ ->
469 True
471 JS.Int _ ->
472 True
474 JS.Bool _ ->
475 True
477 _ ->
478 False
481decomposeL :: Mode -> Opt.Expr -> [Opt.Expr] -> JS.Expr
482decomposeL mode expr funcs =
483 case expr of
484 Opt.Call (Opt.VarGlobal (Opt.Global home "composeL")) [left, func]
485 | home == ModuleName.basics ->
486 decomposeL mode left (func:funcs)
488 _ ->
489 generateJsExpr mode $
490 Opt.Function [N.dollar] (foldr apply (Opt.VarLocal N.dollar) (expr:funcs))
493decomposeR :: Mode -> [Opt.Expr] -> Opt.Expr -> JS.Expr
494decomposeR mode funcs expr =
495 case expr of
496 Opt.Call (Opt.VarGlobal (Opt.Global home "composeR")) [func, right]
497 | home == ModuleName.basics ->
498 decomposeR mode (func:funcs) right
500 _ ->
501 generateJsExpr mode $
502 Opt.Function [N.dollar] (foldr apply (Opt.VarLocal N.dollar) (expr:funcs))
505apply :: Opt.Expr -> Opt.Expr -> Opt.Expr
506apply func value =
507 case func of
508 Opt.Accessor field ->
509 Opt.Access value field
511 Opt.Call f args ->
512 Opt.Call f (args ++ [value])
514 _ ->
515 Opt.Call func [value]
518append :: Mode -> Opt.Expr -> Opt.Expr -> JS.Expr
519append mode left right =
520 let seqs = generateJsExpr mode left : toSeqs mode right in
521 if any isStringLiteral seqs then
522 foldr1 (JS.Infix JS.OpAdd) seqs
523 else
524 foldr1 jsAppend seqs
527jsAppend :: JS.Expr -> JS.Expr -> JS.Expr
528jsAppend a b =
529 JS.Call (JS.Ref (Name.fromKernel N.utils "ap")) [a, b]
532toSeqs :: Mode -> Opt.Expr -> [JS.Expr]
533toSeqs mode expr =
534 case expr of
535 Opt.Call (Opt.VarGlobal (Opt.Global home "append")) [left, right]
536 | home == ModuleName.basics ->
537 generateJsExpr mode left : toSeqs mode right
539 _ ->
540 [generateJsExpr mode expr]
543isStringLiteral :: JS.Expr -> Bool
544isStringLiteral expr =
545 case expr of
546 JS.String _ ->
547 True
549 _ ->
550 False
554-- SIMPLIFY INFIX OPERATORS
557strictEq :: JS.Expr -> JS.Expr -> JS.Expr
558strictEq left right =
559 case left of
560 JS.Int 0 ->
561 JS.Prefix JS.PrefixLNot right
563 JS.Bool bool ->
564 if bool then right else JS.Prefix JS.PrefixLNot right
566 _ ->
567 case right of
568 JS.Int 0 ->
569 JS.Prefix JS.PrefixLNot left
571 JS.Bool bool ->
572 if bool then left else JS.Prefix JS.PrefixLNot left
574 _ ->
575 JS.Infix JS.OpStrictEq left right
578strictNEq :: JS.Expr -> JS.Expr -> JS.Expr
579strictNEq left right =
580 case left of
581 JS.Int 0 ->
582 right
584 JS.Bool bool ->
585 if bool then JS.Prefix JS.PrefixLNot right else right
587 _ ->
588 case right of
589 JS.Int 0 ->
590 left
592 JS.Bool bool ->
593 if bool then JS.Prefix JS.PrefixLNot left else left
595 _ ->
596 JS.Infix JS.OpStrictNEq left right
600-- TAIL CALL
603-- TODO check if JS minifiers collapse unnecessary temporary variables
604--
605generateTailCall :: Mode -> N.Name -> [(N.Name, Opt.Expr)] -> [JS.Stmt]
606generateTailCall mode name args =
607 let
608 toTempVars (argName, arg) =
609 ( Name.makeTemp argName, Just (generateJsExpr mode arg) )
611 toRealVars (argName, _) =
612 JS.ExprStmt $
613 JS.Assign (JS.LVar (Name.fromLocal argName)) (JS.Ref (Name.makeTemp argName))
614 in
615 JS.Var (map toTempVars args)
616 : map toRealVars args
617 ++ [ JS.Continue (Just (Name.fromLocal name)) ]
621-- DEFINITIONS
624generateDef :: Mode -> Opt.Def -> JS.Stmt
625generateDef mode def =
626 case def of
627 Opt.Def name body ->
628 JS.Var [ (Name.fromLocal name, Just (generateJsExpr mode body)) ]
630 Opt.TailDef name argNames body ->
631 let
632 function =
633 JS.Function Nothing (map Name.fromLocal argNames)
634 [ JS.Labelled (Name.fromLocal name) $
635 JS.While (JS.Bool True) $
636 codeToStatement $ generateCode mode body
637 ]
638 in
639 JS.Var [ (Name.fromLocal name, Just function) ]
643-- GENERATE IFS
646generateIf :: Mode -> [(Opt.Expr, Opt.Expr)] -> Opt.Expr -> Code
647generateIf mode givenBranches givenFinal =
648 let
649 (branches, final) =
650 crushIfs givenBranches givenFinal
652 convertBranch (condition, expr) =
653 ( generateJsExpr mode condition
654 , generateCode mode expr
655 )
657 branchExprs = map convertBranch branches
658 finalCode = generateCode mode final
659 in
660 if isBlock finalCode || any (isBlock . snd) branchExprs then
661 JsBlock [ foldr addStmtIf (codeToStatement finalCode) branchExprs ]
662 else
663 JsExpr $ foldr addExprIf (codeToJsExpr finalCode) branchExprs
666addExprIf :: (JS.Expr, Code) -> JS.Expr -> JS.Expr
667addExprIf (condition, branch) final =
668 JS.If condition (codeToJsExpr branch) final
671addStmtIf :: (JS.Expr, Code) -> JS.Stmt -> JS.Stmt
672addStmtIf (condition, branch) final =
673 JS.IfStmt condition (codeToStatement branch) final
676isBlock :: Code -> Bool
677isBlock code =
678 case code of
679 JsBlock _ -> True
680 JsExpr _ -> False
683crushIfs :: [(Opt.Expr, Opt.Expr)] -> Opt.Expr -> ([(Opt.Expr, Opt.Expr)], Opt.Expr)
684crushIfs branches final =
685 crushIfsHelp [] branches final
688crushIfsHelp
689 :: [(Opt.Expr, Opt.Expr)]
690 -> [(Opt.Expr, Opt.Expr)]
691 -> Opt.Expr
692 -> ([(Opt.Expr, Opt.Expr)], Opt.Expr)
693crushIfsHelp visitedBranches unvisitedBranches final =
694 case unvisitedBranches of
695 [] ->
696 case final of
697 Opt.If subBranches subFinal ->
698 crushIfsHelp visitedBranches subBranches subFinal
700 _ ->
701 (reverse visitedBranches, final)
703 visiting : unvisited ->
704 crushIfsHelp (visiting : visitedBranches) unvisited final
708-- CASE EXPRESSIONS
711generateCase :: Mode -> N.Name -> N.Name -> Opt.Decider Opt.Choice -> [(Int, Opt.Expr)] -> [JS.Stmt]
712generateCase mode label root decider jumps =
713 foldr (goto mode label) (generateDecider mode label root decider) jumps
716goto :: Mode -> N.Name -> (Int, Opt.Expr) -> [JS.Stmt] -> [JS.Stmt]
717goto mode label (index, branch) stmts =
718 let
719 labeledDeciderStmt =
720 JS.Labelled
721 (Name.makeLabel label index)
722 (JS.While (JS.Bool True) (JS.Block stmts))
723 in
724 labeledDeciderStmt : codeToStatementList (generateCode mode branch)
727generateDecider :: Mode -> N.Name -> N.Name -> Opt.Decider Opt.Choice -> [JS.Stmt]
728generateDecider mode label root decisionTree =
729 case decisionTree of
730 Opt.Leaf (Opt.Inline branch) ->
731 codeToStatementList (generateCode mode branch)
733 Opt.Leaf (Opt.Jump index) ->
734 [ JS.Break (Just (Name.makeLabel label index)) ]
736 Opt.Chain testChain success failure ->
737 let
738 makeTest (path, test) =
739 strictEq
740 (pathToTestableExpr mode root path test)
741 (testToExpr mode test)
742 in
743 [ JS.IfStmt
744 (List.foldl1' (JS.Infix JS.OpLAnd) (map makeTest testChain))
745 (JS.Block $ generateDecider mode label root success)
746 (JS.Block $ generateDecider mode label root failure)
747 ]
749 Opt.FanOut path edges fallback ->
750 [ JS.Switch
751 (pathToTestableExpr mode root path (fst (head edges)))
752 ( foldr
753 (addCase mode label root)
754 [ JS.Default (generateDecider mode label root fallback) ]
755 edges
756 )
757 ]
760addCase :: Mode -> N.Name -> N.Name -> (DT.Test, Opt.Decider Opt.Choice) -> [JS.Case] -> [JS.Case]
761addCase mode label root (test, subTree) cases =
762 let stmts = generateDecider mode label root subTree in
763 JS.Case (testToExpr mode test) stmts : cases
766testToExpr :: Mode -> DT.Test -> JS.Expr
767testToExpr mode test =
768 case test of
769 DT.IsCtor _ tag index ->
770 case mode of
771 Name.Debug ->
772 JS.String (N.toBuilder tag)
774 Name.Prod _ ->
775 JS.Int (Index.toZeroBased index)
777 DT.IsInt int ->
778 JS.Int int
780 DT.IsChr char ->
781 JS.String (Text.encodeUtf8Builder char)
783 DT.IsStr string ->
784 JS.String (Text.encodeUtf8Builder string)
787pathToTestableExpr :: Mode -> N.Name -> DT.Path -> DT.Test -> JS.Expr
788pathToTestableExpr mode root path exampleTest =
789 let
790 expr =
791 pathToJsExpr mode (JS.Ref (Name.fromLocal root)) path
792 in
793 case exampleTest of
794 DT.IsCtor _ _ _ ->
795 JS.Access expr Name.dollar
797 DT.IsInt _ ->
798 expr
800 DT.IsStr _ ->
801 expr
803 DT.IsChr _ ->
804 case mode of
805 Name.Debug ->
806 JS.Call (JS.Access expr (Name.fromLocal "valueOf")) []
808 Name.Prod _ ->
809 expr
812pathToJsExpr :: Mode -> JS.Expr -> DT.Path -> JS.Expr
813pathToJsExpr mode expr path =
814 case path of
815 DT.Index index subpath ->
816 pathToJsExpr mode (JS.Access expr (Name.fromInt index)) subpath
818 DT.Field field subpath ->
819 pathToJsExpr mode (JS.Access expr (Name.fromField mode field)) subpath
821 DT.Empty ->
822 expr
824 DT.Alias ->
825 expr