git.iko.soy/elk
on master help sign in
Switch some AST modules from toString to toBuilder or toText
36d38dbEvan Czaplicki
src/AST/Expression/Canonical.hs+8−7
compare with master
unifiedsplit
@@ -11,8 +11,10 @@ module AST.Expression.Canonical
11 where
11 where
12
12
13
13
14−import qualified Data.Text as Text
14+import Data.Monoid ((<>))
15import Data.Text (Text)
15import Data.Text (Text)
16+import qualified Data.Text.Lazy as LText
17+import qualified Data.Text.Lazy.Builder as B
16
18
17import qualified AST.Effects as Effects
19import qualified AST.Effects as Effects
18import qualified AST.Literal as Literal
20import qualified AST.Literal as Literal
@@ -129,20 +131,19 @@ collectApps annExpr@(A.A _ expr) =
129 [annExpr]
131 [annExpr]
130
132
131
133
132−
133collectFields :: Expr -> Maybe Text
134collectFields :: Expr -> Maybe Text
134collectFields expr =
135collectFields expr =
135− collectFieldsHelp expr []
136+ fmap (LText.toStrict . B.toLazyText) (collectFieldsHelp expr mempty)
136
137
137
138
138−collectFieldsHelp :: Expr -> [Text] -> Maybe Text
139+collectFieldsHelp :: Expr -> B.Builder -> Maybe B.Builder
139−collectFieldsHelp (A.A _ expr) fields =
140+collectFieldsHelp (A.A _ expr) builder =
140 case expr of
141 case expr of
141 Var var ->
142 Var var ->
142− Just (Text.intercalate "." (Text.pack (Var.toString var) : fields))
143+ Just (B.fromText (Var.toText var) <> builder)
143
144
144 Access record field ->
145 Access record field ->
145− collectFieldsHelp record (field : fields)
146+ collectFieldsHelp record ("." <> B.fromText field <> builder)
146
147
147 _ ->
148 _ ->
148 Nothing
149 Nothing
src/AST/Literal.hs+19−16
@@ -4,6 +4,9 @@ module AST.Literal where
4
4
5import qualified Data.Map as Map
5import qualified Data.Map as Map
6import Data.Text (Text)
6import Data.Text (Text)
7+import Data.Text.Lazy.Builder (Builder, fromString)
8+import Data.Text.Lazy.Builder.Int (decimal)
9+import Data.Text.Lazy.Builder.RealFloat (realFloat)
7
10
8import qualified AST.Variable as Var
11import qualified AST.Variable as Var
9
12
@@ -13,22 +16,22 @@ import qualified AST.Variable as Var
13
16
14
17
15data Literal
18data Literal
19+ = Chr Char
20+ | Str Text
16− = IntNum Int
21+ | IntNum Int
17− | FloatNum Double
22+ | FloatNum Double
18− | Chr Char
19− | Str Text
20− | Boolean Bool
23+ | Boolean Bool
21− deriving (Eq, Ord)
24+ deriving (Eq, Ord)
22−
25+
23−
26+
24−toString :: Literal -> String
27+toBuilder :: Literal -> Builder
25−toString literal =
28+toBuilder literal =
26− case literal of
29+ case literal of
27− IntNum n -> show n
30+ Chr c -> fromString (show c)
28− FloatNum n -> show n
31+ Str s -> fromString (show s)
29− Chr c -> show c
32+ IntNum n -> decimal n
30− Str s -> show s
33+ FloatNum n -> realFloat n
31− Boolean bool -> show bool
34+ Boolean bool -> if bool then "True" else "False"
32
35
33
36
34
37
src/AST/Module/Name.hs+11−5
@@ -45,13 +45,19 @@ inLinearAlgebra raw =
45
45
46
46
47toString :: Raw -> String
47toString :: Raw -> String
48−toString name =
48+toString =
49− Text.unpack name
49+ Text.unpack
50
50
51
51
52−canonicalToString :: Canonical -> String
52+{-# INLINE toText #-}
53+toText :: Raw -> Text
54+toText name =
55+ name
56+
57+
58+canonicalToText :: Canonical -> Text
53−canonicalToString (Canonical _ name) =
59+canonicalToText (Canonical _ name) =
54− toString name
60+ toText name
55
61
56
62
57isNative :: Raw -> Bool
63isNative :: Raw -> Bool
src/AST/Pattern.hs+22−17
@@ -3,9 +3,12 @@
3module AST.Pattern where
3module AST.Pattern where
4
4
5import qualified Data.List as List
5import qualified Data.List as List
6+import Data.Monoid ((<>))
6import qualified Data.Set as Set
7import qualified Data.Set as Set
7−import qualified Data.Text as Text
8import Data.Text (Text)
8import Data.Text (Text)
9+import qualified Data.Text as Text
10+import qualified Data.Text.Lazy as LazyText
11+import Data.Text.Lazy.Builder (Builder, fromText, toLazyText)
9
12
10import qualified AST.Literal as L
13import qualified AST.Literal as L
11import qualified AST.Variable as Var
14import qualified AST.Variable as Var
@@ -109,42 +112,44 @@ boundVarList pattern =
109
112
110
113
111
114
112−-- TO STRING
115+-- TO BUILDER
116+
113
117
118+toString :: Canonical -> String
119+toString var =
120+ LazyText.unpack (toLazyText (toBuilder False var))
114
121
122+
115−toString :: Bool -> Canonical -> String
123+toBuilder :: Bool -> Canonical -> Builder
116−toString needsParens (A.A _ pattern) =
124+toBuilder needsParens (A.A _ pattern) =
117 case pattern of
125 case pattern of
118 Var name ->
126 Var name ->
119− Text.unpack name
127+ fromText name
120
128
121 Ctor name [] ->
129 Ctor name [] ->
122− if Var.isTuple name then
130+ if Var.isTuple name then "()" else fromText (Var.toText name)
123− "()"
124− else
125− Var.toString name
126
131
127 Ctor name args ->
132 Ctor name args ->
128 if Var.isTuple name then
133 if Var.isTuple name then
129− "( " ++ List.intercalate ", " (map (toString False) args) ++ " )"
134+ "( " <> mconcat (List.intersperse ", " (map (toBuilder False) args)) <> " )"
130 else
135 else
131 parensIf needsParens $
136 parensIf needsParens $
132− Var.toString name ++ concatMap ((" "++) . toString True) args
137+ fromText (Var.toText name) <> mconcat (map (\arg -> " " <> toBuilder True arg) args)
133
138
134 Record fields ->
139 Record fields ->
135− "{" ++ List.intercalate "," (map Text.unpack fields) ++ "}"
140+ "{" <> mconcat (List.intersperse "," (map fromText fields)) <> "}"
136
141
137 Alias alias subPattern ->
142 Alias alias subPattern ->
138 parensIf needsParens $
143 parensIf needsParens $
139− toString False subPattern ++ " as " ++ Text.unpack alias
144+ toBuilder False subPattern <> " as " <> fromText alias
140
145
141 Anything ->
146 Anything ->
142 "_"
147 "_"
143
148
144 Literal literal ->
149 Literal literal ->
145− L.toString literal
150+ L.toBuilder literal
146
151
147
152
148−parensIf :: Bool -> String -> String
153+parensIf :: Bool -> Builder -> Builder
149−parensIf needsParens str =
154+parensIf needsParens builder =
150− if needsParens then "(" ++ str ++ ")" else str
155+ if needsParens then "(" <> builder <> ")" else builder
src/AST/Variable.hs+33−21
@@ -4,6 +4,8 @@ module AST.Variable where
4
4
5import Data.Binary
5import Data.Binary
6import qualified Data.Maybe as Maybe
6import qualified Data.Maybe as Maybe
7+import Data.Monoid ((<>))
8+import qualified Data.Set as Set
7import qualified Data.Text as Text
9import qualified Data.Text as Text
8import Data.Text (Text)
10import Data.Text (Text)
9
11
@@ -169,12 +171,17 @@ isTuple v =
169
171
170isPrimitive :: Canonical -> Bool
172isPrimitive :: Canonical -> Bool
171isPrimitive v =
173isPrimitive v =
172− case v of
174+ case v of
173− Canonical BuiltIn name ->
175+ Canonical BuiltIn name ->
174− elem name ["Int","Float","String","Bool"]
176+ Set.member name primitiveSet
177+
178+ _ ->
179+ False
175
180
176− _ ->
181+
177− False
182+primitiveSet :: Set.Set Text
183+primitiveSet =
184+ Set.fromList ["Int","Float","String","Bool"]
178
185
179
186
180isPrim :: Text -> Canonical -> Bool
187isPrim :: Text -> Canonical -> Bool
@@ -201,29 +208,34 @@ isLocal check (Canonical home name) =
201-- VARIABLE TO STRING
208-- VARIABLE TO STRING
202
209
203
210
211+toString :: (ToText a) => a -> String
212+toString var =
213+ Text.unpack (toText var)
214+
215+
204−class ToString a where
216+class ToText a where
205− toString :: a -> String
217+ toText :: a -> Text
206
218
207
219
208−instance ToString Raw where
220+instance ToText Raw where
209− toString (Raw name) =
221+ toText (Raw name) =
210− Text.unpack name
222+ name
211
223
212
224
213−instance ToString Canonical where
225+instance ToText Canonical where
214− toString (Canonical home name) =
226+ toText (Canonical home name) =
215− case home of
227+ case home of
216− BuiltIn ->
228+ BuiltIn ->
217− Text.unpack name
229+ name
218
230
219− Module moduleName ->
231+ Module moduleName ->
220− ModuleName.canonicalToString moduleName ++ "." ++ Text.unpack name
232+ ModuleName.canonicalToText moduleName <> "." <> name
221
233
222− TopLevel _ ->
234+ TopLevel _ ->
223− Text.unpack name
235+ name
224
236
225− Local ->
237+ Local ->
226− Text.unpack name
238+ name
227
239
228
240
229
241
src/Elm/Package.hs+8−2
@@ -7,6 +7,7 @@ import Data.Binary
7import qualified Data.Char as Char
7import qualified Data.Char as Char
8import Data.Function (on)
8import Data.Function (on)
9import qualified Data.List as List
9import qualified Data.List as List
10+import Data.Monoid ((<>))
10import qualified Data.Text as Text
11import qualified Data.Text as Text
11import Data.Text (Text)
12import Data.Text (Text)
12import System.FilePath ((</>))
13import System.FilePath ((</>))
@@ -57,8 +58,13 @@ linearAlgebra =
57
58
58
59
59toString :: Name -> String
60toString :: Name -> String
61+toString name =
62+ Text.unpack (toText name)
63+
64+
65+toText :: Name -> Text
60−toString (Name user project) =
66+toText (Name user project) =
61− Text.unpack user ++ "/" ++ Text.unpack project
67+ user <> "/" <> project
62
68
63
69
64toUrl :: Name -> String
70toUrl :: Name -> String
src/Generate/JavaScript/Builder.hs+202−118
@@ -1,22 +1,155 @@
1{-# OPTIONS_GHC -Wall #-}
1{-# OPTIONS_GHC -Wall #-}
2{-# LANGUAGE OverloadedStrings #-}
2{-# LANGUAGE OverloadedStrings #-}
3−module Generate.JavaScript.Builder (stmtsToText) where
3+module Generate.JavaScript.Builder
4+ ( Expr(..), Id(..), Prop(..), LValue(..)
5+ , Stmt(..), Case(..), VarDecl(..)
6+ , InfixOp(..), AssignOp(..), PrefixOp(..)
7+ , stmtsToText
8+ )
9+ where
10+
11+-- Based on the language-ecmascript package.
12+-- https://hackage.haskell.org/package/language-ecmascript
13+-- They did the hard work of reading the spec to figure out
14+-- how all the types should fit together.
4
15
16+import Prelude hiding (lines)
5import qualified Data.List as List
17import qualified Data.List as List
6import Data.Monoid ((<>))
18import Data.Monoid ((<>))
7−import qualified Data.Text.Lazy as LazyText
19+import Data.Text (Text)
8import Data.Text.Lazy.Builder
20import Data.Text.Lazy.Builder
9import Data.Text.Lazy.Builder.Int (decimal)
21import Data.Text.Lazy.Builder.Int (decimal)
10import Data.Text.Lazy.Builder.RealFloat (realFloat)
22import Data.Text.Lazy.Builder.RealFloat (realFloat)
11−import Language.ECMAScript3.Syntax
23+import qualified Data.Text.Lazy as LazyText
12−import Prelude hiding (lines)
24+
25+
26+
27+-- EXPRESSIONS
28+
29+
30+data Expr
31+ = String Text
32+ | Float Double
33+ | Int Int
34+ | Bool Bool
35+ | Null
36+ | Array [Expr]
37+ | Object [(Prop, Expr)]
38+ | VarRef Id
39+ | DotRef Expr Id -- ^ @foo.bar@, spec 11.2.1
40+ | BracketRef Expr Expr -- ^ @foo[bar]@, spec 11.2.1
41+ | Prefix PrefixOp Expr
42+ | Infix InfixOp Expr Expr
43+ | If Expr Expr Expr
44+ | Assign AssignOp LValue Expr
45+ | Call Expr [Expr] -- ^ @f(x,y,z)@, spec 11.2.3
46+ | Function (Maybe Id) [Id] [Stmt]
47+
48+
49+newtype Id = Id Text
50+
51+
52+data Prop
53+ = StringProp Text
54+ | IntProp Int
55+ | IdProp Id
56+
57+
58+data LValue
59+ = LVar Text
60+ | LDot Expr Text
61+ | LBracket Expr Expr
62+
63+
64+
65+-- STATEMENTS
66+
67+
68+data Stmt
69+ = Block [Stmt] -- {stmts}
70+ | EmptyStmt -- ;
71+ | ExprStmt Expr -- expr;
72+ | IfStmt Expr Stmt Stmt -- if (e) stmt1 else stmt2
73+ | IfSingleStmt Expr Stmt -- if (e) stmt
74+ | Switch Expr [Case] -- switch (e) clauses
75+ | While Expr Stmt -- while (e) do stmt
76+ | DoWhile Stmt Expr -- do stmt while (e);
77+ | Break (Maybe Id) -- break lab;
78+ | Continue (Maybe Id) -- continue lab;
79+ | Labelled Id Stmt -- lab: stmt
80+ | Return (Maybe Expr) -- return expr;
81+ | VarDeclStmt [VarDecl] -- var x, y=42;
82+ | FunctionStmt Id [Id] [Stmt] -- function f(x, y, z) {...}
83+
84+
85+data Case
86+ = Case Expr [Stmt]
87+ | Default [Stmt]
88+
89+
90+data VarDecl = VarDecl Id (Maybe Expr)
91+
92+
93+
94+-- OPERATORS
95+
96+
97+data InfixOp
98+ = OpLT -- <
99+ | OpLEq -- <=
100+ | OpGT -- >
101+ | OpGEq -- >=
102+ | OpIn -- in
103+ | OpInstanceof -- instanceof
104+ | OpEq -- ==
105+ | OpNEq -- !=
106+ | OpStrictEq -- ===
107+ | OpStrictNEq -- !===
108+ | OpLAnd -- &&
109+ | OpLOr -- ||
110+ | OpMul -- *
111+ | OpDiv -- /
112+ | OpMod -- %
113+ | OpSub -- -
114+ | OpLShift -- <<
115+ | OpSpRShift -- >>
116+ | OpZfRShift -- >>>
117+ | OpBAnd -- &
118+ | OpBXor -- ^
119+ | OpBOr -- |
120+ | OpAdd -- +
121+
122+
123+data AssignOp
124+ = OpAssign -- =
125+ | OpAssignAdd -- +=
126+ | OpAssignSub -- -=
127+ | OpAssignMul -- *=
128+ | OpAssignDiv -- /=
129+ | OpAssignMod -- %=
130+ | OpAssignLShift -- <<=
131+ | OpAssignSpRShift -- >>=
132+ | OpAssignZfRShift -- >>>=
133+ | OpAssignBAnd -- &=
134+ | OpAssignBXor -- ^=
135+ | OpAssignBOr -- |=
136+
137+
138+data PrefixOp
139+ = PrefixLNot -- !
140+ | PrefixBNot -- ~
141+ | PrefixPlus -- +
142+ | PrefixMinus -- -
143+ | PrefixTypeof -- typeof
144+ | PrefixVoid -- void
145+ | PrefixDelete -- delete
13
146
14
147
15
148
16-- CONVERT TO LAZY TEXT
149-- CONVERT TO LAZY TEXT
17
150
18
151
19−stmtsToText :: [Statement a] -> LazyText.Text
152+stmtsToText :: [Stmt] -> LazyText.Text
20stmtsToText stmts =
153stmtsToText stmts =
21 toLazyText (fromStmtBlock "" stmts)
154 toLazyText (fromStmtBlock "" stmts)
22
155
@@ -44,24 +177,24 @@ commaNewlineSep indent builders =
44-- STATEMENTS
177-- STATEMENTS
45
178
46
179
47−fromStmtBlock :: Builder -> [Statement a] -> Builder
180+fromStmtBlock :: Builder -> [Stmt] -> Builder
48fromStmtBlock indent stmts =
181fromStmtBlock indent stmts =
49 mconcat (map (fromStmt indent) stmts)
182 mconcat (map (fromStmt indent) stmts)
50
183
51
184
52−fromStmt :: Builder -> Statement a -> Builder
185+fromStmt :: Builder -> Stmt -> Builder
53fromStmt indent statement =
186fromStmt indent statement =
54 case statement of
187 case statement of
55− BlockStmt _ stmts ->
188+ Block stmts ->
56 fromStmtBlock indent stmts
189 fromStmtBlock indent stmts
57
190
58− EmptyStmt _ ->
191+ EmptyStmt ->
59 mempty
192 mempty
60
193
61− ExprStmt _ expr ->
194+ ExprStmt expr ->
62 indent <> snd (fromExpr indent Whatever expr) <> ";\n"
195 indent <> snd (fromExpr indent Whatever expr) <> ";\n"
63
196
64− IfStmt _ condition thenStmt elseStmt ->
197+ IfStmt condition thenStmt elseStmt ->
65 mconcat
198 mconcat
66 [ indent, "if (", snd (fromExpr indent Whatever condition), ") {\n"
199 [ indent, "if (", snd (fromExpr indent Whatever condition), ") {\n"
67 , fromStmt (deeper indent) thenStmt
200 , fromStmt (deeper indent) thenStmt
@@ -70,80 +203,65 @@ fromStmt indent statement =
70 , indent, "}\n"
203 , indent, "}\n"
71 ]
204 ]
72
205
73− IfSingleStmt _ condition thenStmt ->
206+ IfSingleStmt condition thenStmt ->
74 mconcat
207 mconcat
75 [ indent, "if (", snd (fromExpr indent Whatever condition), ") {\n"
208 [ indent, "if (", snd (fromExpr indent Whatever condition), ") {\n"
76 , fromStmt (deeper indent) thenStmt
209 , fromStmt (deeper indent) thenStmt
77 , indent, "}\n"
210 , indent, "}\n"
78 ]
211 ]
79
212
80− SwitchStmt _ expr clauses ->
213+ Switch expr clauses ->
81 mconcat
214 mconcat
82 [ indent, "switch (", snd (fromExpr indent Whatever expr), ") {\n"
215 [ indent, "switch (", snd (fromExpr indent Whatever expr), ") {\n"
83 , mconcat (map (fromClause (deeper indent)) clauses)
216 , mconcat (map (fromClause (deeper indent)) clauses)
84 , indent, "}\n"
217 , indent, "}\n"
85 ]
218 ]
86
219
87− WhileStmt _ expr stmt ->
220+ While expr stmt ->
88 mconcat
221 mconcat
89 [ indent, "while (", snd (fromExpr indent Whatever expr), ") {\n"
222 [ indent, "while (", snd (fromExpr indent Whatever expr), ") {\n"
90 , fromStmt (deeper indent) stmt
223 , fromStmt (deeper indent) stmt
91 , indent, "}\n"
224 , indent, "}\n"
92 ]
225 ]
93
226
94− DoWhileStmt _ stmt expr ->
227+ DoWhile stmt expr ->
95 mconcat
228 mconcat
96 [ indent, "do {\n"
229 [ indent, "do {\n"
97 , fromStmt (deeper indent) stmt
230 , fromStmt (deeper indent) stmt
98 , indent, "} while(", snd (fromExpr indent Whatever expr), ");\n"
231 , indent, "} while(", snd (fromExpr indent Whatever expr), ");\n"
99 ]
232 ]
100
233
101− BreakStmt _ Nothing ->
234+ Break Nothing ->
102 indent <> "break;\n"
235 indent <> "break;\n"
103
236
104− BreakStmt _ (Just label) ->
237+ Break (Just label) ->
105 indent <> "break " <> fromId label <> ";\n"
238 indent <> "break " <> fromId label <> ";\n"
106
239
107− ContinueStmt _ Nothing ->
240+ Continue Nothing ->
108 indent <> "continue;\n"
241 indent <> "continue;\n"
109
242
110− ContinueStmt _ (Just label) ->
243+ Continue (Just label) ->
111 indent <> "continue " <> fromId label <> ";\n"
244 indent <> "continue " <> fromId label <> ";\n"
112
245
113− LabelledStmt _ label stmt ->
246+ Labelled label stmt ->
114 mconcat
247 mconcat
115 [ indent, fromId label, ":\n"
248 [ indent, fromId label, ":\n"
116 , fromStmt indent stmt
249 , fromStmt indent stmt
117 ]
250 ]
118
251
119− ForInStmt _ _ _ _ ->
120− error "TODO"
121−
122− ForStmt _ _ _ _ _ ->
123− error "TODO"
124−
125− TryStmt _ _ _ _ ->
126− error "TODO"
127−
128− ThrowStmt _ expr ->
129− indent <> "throw " <> snd (fromExpr indent Whatever expr) <> ";\n"
130−
131− ReturnStmt _ Nothing ->
252+ Return Nothing ->
132 indent <> "return;\n"
253 indent <> "return;\n"
133
254
134− ReturnStmt _ (Just expr) ->
255+ Return (Just expr) ->
135 indent <> "return " <> snd (fromExpr indent Whatever expr) <> ";\n"
256 indent <> "return " <> snd (fromExpr indent Whatever expr) <> ";\n"
136
257
137− WithStmt _ _ _ ->
138− error "TODO"
139−
140− VarDeclStmt _ [] ->
258+ VarDeclStmt [] ->
141 mempty
259 mempty
142
260
143− VarDeclStmt _ decls ->
261+ VarDeclStmt decls ->
144 indent <> "var " <> commaNewlineSep indent (map (fromVarDecl indent) decls) <> ";\n"
262 indent <> "var " <> commaNewlineSep indent (map (fromVarDecl indent) decls) <> ";\n"
145
263
146− FunctionStmt _ name args stmts ->
264+ FunctionStmt name args stmts ->
147 indent <> "function " <> fromId name <> "(" <> commaSep (map fromId args) <> ") {\n"
265 indent <> "function " <> fromId name <> "(" <> commaSep (map fromId args) <> ") {\n"
148 <>
266 <>
149 fromStmtBlock (deeper indent) stmts
267 fromStmtBlock (deeper indent) stmts
@@ -155,14 +273,14 @@ fromStmt indent statement =
155-- SWITCH CLAUSES
273-- SWITCH CLAUSES
156
274
157
275
158−fromClause :: Builder -> CaseClause a -> Builder
276+fromClause :: Builder -> Case -> Builder
159fromClause indent clause =
277fromClause indent clause =
160 case clause of
278 case clause of
161− CaseClause _ expr stmts ->
279+ Case expr stmts ->
162 indent <> "case " <> snd (fromExpr indent Whatever expr) <> ":\n"
280 indent <> "case " <> snd (fromExpr indent Whatever expr) <> ":\n"
163 <> fromStmtBlock (deeper indent) stmts
281 <> fromStmtBlock (deeper indent) stmts
164
282
165− CaseDefault _ stmts ->
283+ Default stmts ->
166 indent <> "default:\n"
284 indent <> "default:\n"
167 <> fromStmtBlock (deeper indent) stmts
285 <> fromStmtBlock (deeper indent) stmts
168
286
@@ -171,23 +289,23 @@ fromClause indent clause =
171-- ID
289-- ID
172
290
173
291
174−fromId :: Id a -> Builder
292+fromId :: Id -> Builder
175−fromId (Id _ name) =
293+fromId (Id name) =
176− fromString name
294+ fromText name
177
295
178
296
179
297
180-- VAR DECLS
298-- VAR DECLS
181
299
182
300
183−fromVarDecl :: Builder -> VarDecl a -> Builder
301+fromVarDecl :: Builder -> VarDecl -> Builder
184−fromVarDecl indent (VarDecl _ (Id _ name) maybeExpr) =
302+fromVarDecl indent (VarDecl (Id name) maybeExpr) =
185 case maybeExpr of
303 case maybeExpr of
186 Nothing ->
304 Nothing ->
187− fromString name
305+ fromText name
188
306
189 Just expr ->
307 Just expr ->
190− fromString name <> " = " <> snd (fromExpr indent Whatever expr)
308+ fromText name <> " = " <> snd (fromExpr indent Whatever expr)
191
309
192
310
193
311
@@ -226,31 +344,25 @@ parensFor grouping builder =
226 builder
344 builder
227
345
228
346
229−fromExpr :: Builder -> Grouping -> Expression a -> (Lines, Builder)
347+fromExpr :: Builder -> Grouping -> Expr -> (Lines, Builder)
230fromExpr indent grouping expression =
348fromExpr indent grouping expression =
231 case expression of
349 case expression of
232− StringLit _ string ->
350+ String string ->
233 (One, quoted string)
351 (One, quoted string)
234
352
235− RegexpLit _ _ _ _ ->
353+ Float n ->
236− error "TODO"
237−
238− NumLit _ n ->
239 (One, realFloat n)
354 (One, realFloat n)
240
355
241− IntLit _ n ->
356+ Int n ->
242 (One, decimal n)
357 (One, decimal n)
243
358
244− BoolLit _ True ->
359+ Bool bool ->
245− (One, "true")
360+ (One, if bool then "true" else "false")
246−
247− BoolLit _ False ->
248− (One, "false")
249
361
250− NullLit _ ->
362+ Null ->
251 (One, "null")
363 (One, "null")
252
364
253− ArrayLit _ exprs ->
365+ Array exprs ->
254 (,) Many $
366 (,) Many $
255 let
367 let
256 (anyMany, builders) =
368 (anyMany, builders) =
@@ -265,7 +377,7 @@ fromExpr indent grouping expression =
265 else
377 else
266 "[" <> commaSep builders <> "]"
378 "[" <> commaSep builders <> "]"
267
379
268− ObjectLit _ fields ->
380+ Object fields ->
269 (,) Many $
381 (,) Many $
270 let
382 let
271 deeperIndent =
383 deeperIndent =
@@ -283,22 +395,16 @@ fromExpr indent grouping expression =
283 else
395 else
284 "{" <> commaSep builders <> "}"
396 "{" <> commaSep builders <> "}"
285
397
286− ThisRef _ ->
287− (One, "this")
288−
289− VarRef _ name ->
398+ VarRef name ->
290 (One, fromId name)
399 (One, fromId name)
291
400
292− DotRef _ expr (Id _ name) ->
401+ DotRef expr (Id name) ->
293 makeDot indent expr name
402 makeDot indent expr name
294
403
295− BracketRef _ expr bracketedExpr ->
404+ BracketRef expr bracketedExpr ->
296 makeBracketed indent expr bracketedExpr
405 makeBracketed indent expr bracketedExpr
297
406
298− NewExpr _ _ _ ->
299− error "TODO"
300−
301− PrefixExpr _ op expr ->
407+ Prefix op expr ->
302 let
408 let
303 (lines, builder) =
409 (lines, builder) =
304 fromExpr indent Atomic expr
410 fromExpr indent Atomic expr
@@ -307,10 +413,7 @@ fromExpr indent grouping expression =
307 , parensFor grouping (fromPrefix op <> builder)
413 , parensFor grouping (fromPrefix op <> builder)
308 )
414 )
309
415
310− UnaryAssignExpr _ _ _ ->
311− error "TODO"
312−
313− InfixExpr _ op leftExpr rightExpr ->
416+ Infix op leftExpr rightExpr ->
314 let
417 let
315 (leftLines, left) =
418 (leftLines, left) =
316 fromExpr indent Atomic leftExpr
419 fromExpr indent Atomic leftExpr
@@ -322,7 +425,7 @@ fromExpr indent grouping expression =
322 , parensFor grouping (left <> fromInfix op <> right)
425 , parensFor grouping (left <> fromInfix op <> right)
323 )
426 )
324
427
325− CondExpr _ condExpr thenExpr elseExpr ->
428+ If condExpr thenExpr elseExpr ->
326 let
429 let
327 condB = snd (fromExpr indent Atomic condExpr)
430 condB = snd (fromExpr indent Atomic condExpr)
328 thenB = snd (fromExpr indent Atomic thenExpr)
431 thenB = snd (fromExpr indent Atomic thenExpr)
@@ -332,7 +435,7 @@ fromExpr indent grouping expression =
332 , parensFor grouping (condB <> " ? " <> thenB <> " : " <> elseB)
435 , parensFor grouping (condB <> " ? " <> thenB <> " : " <> elseB)
333 )
436 )
334
437
335− AssignExpr _ op lValue expr ->
438+ Assign op lValue expr ->
336 let
439 let
337 (leftLines, left) =
440 (leftLines, left) =
338 fromLValue indent lValue
441 fromLValue indent lValue
@@ -344,10 +447,7 @@ fromExpr indent grouping expression =
344 , parensFor grouping (left <> fromAssign op <> right)
447 , parensFor grouping (left <> fromAssign op <> right)
345 )
448 )
346
449
347− ListExpr _ _ ->
348− error "TODO"
349−
350− CallExpr _ function args ->
450+ Call function args ->
351 (,) Many $
451 (,) Many $
352 let
452 let
353 deeperIndent =
453 deeperIndent =
@@ -365,7 +465,7 @@ fromExpr indent grouping expression =
365 else
465 else
366 funcB <> "(" <> commaSep argsB <> ")"
466 funcB <> "(" <> commaSep argsB <> ")"
367
467
368− FuncExpr _ maybeName args stmts ->
468+ Function maybeName args stmts ->
369 (,) Many $
469 (,) Many $
370 "function " <> maybe mempty fromId maybeName <> "(" <> commaSep (map fromId args) <> ") {\n"
470 "function " <> maybe mempty fromId maybeName <> "(" <> commaSep (map fromId args) <> ") {\n"
371 <>
471 <>
@@ -378,7 +478,7 @@ fromExpr indent grouping expression =
378-- FIELDS
478-- FIELDS
379
479
380
480
381−fromField :: Builder -> (Prop a, Expression a) -> (Lines, Builder)
481+fromField :: Builder -> (Prop, Expr) -> (Lines, Builder)
382fromField indent (prop, expr) =
482fromField indent (prop, expr) =
383 let
483 let
384 (lines, builder) =
484 (lines, builder) =
@@ -389,16 +489,16 @@ fromField indent (prop, expr) =
389 )
489 )
390
490
391
491
392−fromProp :: Prop a -> Builder
492+fromProp :: Prop -> Builder
393fromProp prop =
493fromProp prop =
394 case prop of
494 case prop of
395− PropId _ name ->
495+ IdProp name ->
396 fromId name
496 fromId name
397
497
398− PropString _ string ->
498+ StringProp string ->
399 quoted string
499 quoted string
400
500
401− PropNum _ n ->
501+ IntProp n ->
402 decimal n
502 decimal n
403
503
404
504
@@ -406,54 +506,38 @@ fromProp prop =
406-- STRINGS
506-- STRINGS
407
507
408
508
409−quoted :: String -> Builder
509+quoted :: Text -> Builder
410−quoted string =
510+quoted str =
411− fromString ('\'' : foldr escapeCons "'" string)
511+ "'" <> fromText str <> "'"
412−
413−
414−-- https://developer.mozilla.org/en-US/docs/Web/JavaScript/Guide/Grammar_and_types#String_literals
415−escapeCons :: Char -> String -> String
416−escapeCons char rest =
417− case char of
418− '\b' -> '\\' : 'b' : rest
419− '\f' -> '\\' : 'f' : rest
420− '\n' -> '\\' : 'n' : rest
421− '\r' -> '\\' : 'r' : rest
422− '\t' -> '\\' : 't' : rest
423− '\v' -> '\\' : 'v' : rest
424− '\"' -> '\\' : '"' : rest
425− '\'' -> '\\' : '\'' : rest
426− '\\' -> '\\' : '\\' : rest
427− _ -> char : rest
428
512
429
513
430
514
431-- VALUES
515-- VALUES
432
516
433
517
434−fromLValue :: Builder -> LValue a -> (Lines, Builder)
518+fromLValue :: Builder -> LValue -> (Lines, Builder)
435fromLValue indent lValue =
519fromLValue indent lValue =
436 case lValue of
520 case lValue of
437− LVar _ name ->
521+ LVar name ->
438− (One, fromString name)
522+ (One, fromText name)
439
523
440− LDot _ expr field ->
524+ LDot expr field ->
441 makeDot indent expr field
525 makeDot indent expr field
442
526
443− LBracket _ expr bracketedExpr ->
527+ LBracket expr bracketedExpr ->
444 makeBracketed indent expr bracketedExpr
528 makeBracketed indent expr bracketedExpr
445
529
446
530
447−makeDot :: Builder -> Expression a -> String -> (Lines, Builder)
531+makeDot :: Builder -> Expr -> Text -> (Lines, Builder)
448makeDot indent expr field =
532makeDot indent expr field =
449 let
533 let
450 (lines, builder) =
534 (lines, builder) =
451 fromExpr indent Atomic expr
535 fromExpr indent Atomic expr
452 in
536 in
453− (lines, builder <> "." <> fromString field)
537+ (lines, builder <> "." <> fromText field)
454
538
455
539
456−makeBracketed :: Builder -> Expression a -> Expression a -> (Lines, Builder)
540+makeBracketed :: Builder -> Expr -> Expr -> (Lines, Builder)
457makeBracketed indent expr bracketedExpr =
541makeBracketed indent expr bracketedExpr =
458 let
542 let
459 (lines, builder) =
543 (lines, builder) =
src/Generate/JavaScript/Literal.hs+6−7
@@ -1,25 +1,24 @@
1module Generate.JavaScript.Literal (literal) where
1module Generate.JavaScript.Literal (literal) where
2
2
3−import qualified Language.ECMAScript3.Syntax as JS
4−
5import qualified AST.Literal as Lit
3import qualified AST.Literal as Lit
4+import qualified Generate.JavaScript.Builder as JS
6import qualified Generate.JavaScript.BuiltIn as BuiltIn
5import qualified Generate.JavaScript.BuiltIn as BuiltIn
7
6
8
7
9−literal :: Lit.Literal -> JS.Expression ()
8+literal :: Lit.Literal -> JS.Expr
10literal lit =
9literal lit =
11 case lit of
10 case lit of
12 Lit.Chr char ->
11 Lit.Chr char ->
13 BuiltIn.character char
12 BuiltIn.character char
14
13
15 Lit.Str string ->
14 Lit.Str string ->
16− BuiltIn.string string
15+ JS.String string
17
16
18 Lit.IntNum number ->
17 Lit.IntNum number ->
19− JS.IntLit () number
18+ JS.Int number
20
19
21 Lit.FloatNum number ->
20 Lit.FloatNum number ->
22− JS.NumLit () number
21+ JS.Float number
23
22
24 Lit.Boolean boolean ->
23 Lit.Boolean boolean ->
25− JS.BoolLit () boolean
24+ JS.Bool boolean
src/Reporting/Error/Pattern.hs+1−1
@@ -65,7 +65,7 @@ unhandledError unhandledPatterns relevantMessage =
65 splitAt 4 unhandledPatterns
65 splitAt 4 unhandledPatterns
66
66
67 patternList =
67 patternList =
68− map (Pattern.toString False) visiblePatterns
68+ map Pattern.toString visiblePatterns
69 ++ if null rest then [] else ["..."]
69 ++ if null rest then [] else ["..."]
70
70
71 noun =
71 noun =
src/Reporting/Warning.hs+2−1
@@ -4,6 +4,7 @@ module Reporting.Warning where
4
4
5import Data.Aeson ((.=))
5import Data.Aeson ((.=))
6import qualified Data.Aeson as Json
6import qualified Data.Aeson as Json
7+import qualified Data.Text as Text
7import Text.PrettyPrint.ANSI.Leijen (text)
8import Text.PrettyPrint.ANSI.Leijen (text)
8
9
9import qualified AST.Module.Name as ModuleName
10import qualified AST.Module.Name as ModuleName
@@ -34,7 +35,7 @@ toReport localizer warning =
34 Report.report
35 Report.report
35 "unused import"
36 "unused import"
36 Nothing
37 Nothing
37− ("Module `" ++ ModuleName.toString moduleName ++ "` is unused.")
38+ ("Module `" ++ Text.unpack (ModuleName.toText moduleName) ++ "` is unused.")
38 (text "Best to remove it. Don't save code quality for later!")
39 (text "Best to remove it. Don't save code quality for later!")
39
40
40 MissingTypeAnnotation name inferredType ->
41 MissingTypeAnnotation name inferredType ->