git.iko.soy/elk
on 1433e40 help sign in
elk/src/Generate/JavaScript/BuiltIn.hs
142 lines 2.7 kB history raw
1{-# OPTIONS_GHC -Wall #-}
2{-# LANGUAGE OverloadedStrings #-}
3module Generate.JavaScript.BuiltIn
4 ( character
5 , list, cons
6 , recordUpdate
7 , eq, cmp
8 , effect, outgoingPort, incomingPort
9 , crash
10 )
11 where
13import qualified Data.Text as Text
14import Data.Text (Text)
16import qualified AST.Module.Name as ModuleName
17import qualified Generate.JavaScript.Builder as JS
18import Generate.JavaScript.Helpers ((<|), (==>))
19import qualified Generate.JavaScript.Variable as Var
20import qualified Reporting.Region as R
24utils :: Text -> [JS.Expr] -> JS.Expr
25utils func args =
26 JS.Call (Var.coreNative "Utils" func) args
30-- LITERALS
33character :: Char -> JS.Expr
34character char =
35 utils "chr" [ JS.String (Text.singleton char) ]
39-- LISTS
42list :: [JS.Expr] -> JS.Expr
43list elements =
44 case elements of
45 [] ->
46 JS.Object [ "ctor" ==> JS.String "[]" ]
48 front : back ->
49 cons front (list back)
52cons :: JS.Expr -> JS.Expr -> JS.Expr
53cons front back =
54 JS.Object
55 [ "ctor" ==> JS.String "::"
56 , "_0" ==> front
57 , "_1" ==> back
58 ]
62-- RECORDS
65recordUpdate :: JS.Expr -> [(Text, JS.Expr)] -> JS.Expr
66recordUpdate record fields =
67 utils "update"
68 [ record
69 , JS.Object (map (uncurry (==>)) fields)
70 ]
74-- COMPARISIONS
77eq :: JS.Expr -> JS.Expr -> JS.Expr
78eq left right =
79 utils "eq" [ left, right ]
82cmp :: JS.Expr -> JS.Expr -> JS.Expr
83cmp left right =
84 utils "cmp" [ left, right ]
88-- EFFECTS
91effect :: ModuleName.Canonical -> JS.Expr
92effect effectName =
93 Var.coreNative "Platform" "leaf" <|
94 JS.String (ModuleName.canonicalToText effectName)
97outgoingPort :: Text -> JS.Expr -> JS.Expr
98outgoingPort name converter =
99 JS.Call
100 (Var.coreNative "Platform" "outgoingPort")
101 [ JS.String name, converter ]
104incomingPort :: Text -> JS.Expr -> JS.Expr
105incomingPort name converter =
106 JS.Call
107 (Var.coreNative "Platform" "incomingPort")
108 [ JS.String name, converter ]
112-- CRASH
115crash :: ModuleName.Canonical -> R.Region -> Maybe (JS.Expr) -> JS.Expr
116crash home region maybeCaseCrashValue =
117 let
118 homeString =
119 JS.String (ModuleName.canonicalToText home)
120 in
121 case maybeCaseCrashValue of
122 Nothing ->
123 utils "crash" [ homeString, regionToJs region ]
125 Just crashValue ->
126 utils "crashCase" [ homeString, regionToJs region, crashValue ]
129regionToJs :: R.Region -> JS.Expr
130regionToJs (R.Region start end) =
131 JS.Object
132 [ "start" ==> positionToJs start
133 , "end" ==> positionToJs end
134 ]
137positionToJs :: R.Position -> JS.Expr
138positionToJs (R.Position line column) =
139 JS.Object
140 [ "line" ==> JS.Int line
141 , "column" ==> JS.Int column
142 ]