git.iko.soy/elk
on master help sign in
Switch some AST modules from toString to toBuilder or toText
commit36d38db6c2614761c4eeb208be46c464583e14f8 authorEvan Czaplicki <evancz@users.noreply.github.com> dateMon 5 Dec 2016, 19:07 (10 years ago) parent09a60c7
10 files changed+312−195
compare with master
unifiedsplit
src/AST/Expression/Canonical.hs+8−7 src/AST/Literal.hs+19−16 src/AST/Module/Name.hs+11−5 src/AST/Pattern.hs+22−17 src/AST/Variable.hs+33−21 src/Elm/Package.hs+8−2 src/Generate/JavaScript/Builder.hs+202−118 src/Generate/JavaScript/Literal.hs+6−7 src/Reporting/Error/Pattern.hs+1−1 src/Reporting/Warning.hs+2−1
src/AST/Expression/Canonical.hs+8−7
@@ -11,8 +11,10 @@ module AST.Expression.Canonical
1111 where
1212
1313
14−import qualified Data.Text as Text
14+import Data.Monoid ((<>))
1515import Data.Text (Text)
16+import qualified Data.Text.Lazy as LText
17+import qualified Data.Text.Lazy.Builder as B
1618
1719import qualified AST.Effects as Effects
1820import qualified AST.Literal as Literal
@@ -129,20 +131,19 @@ collectApps annExpr@(A.A _ expr) =
129131 [annExpr]
130132
131133
132−
133134collectFields :: Expr -> Maybe Text
134135collectFields expr =
135− collectFieldsHelp expr []
136+ fmap (LText.toStrict . B.toLazyText) (collectFieldsHelp expr mempty)
136137
137138
138−collectFieldsHelp :: Expr -> [Text] -> Maybe Text
139−collectFieldsHelp (A.A _ expr) fields =
139+collectFieldsHelp :: Expr -> B.Builder -> Maybe B.Builder
140+collectFieldsHelp (A.A _ expr) builder =
140141 case expr of
141142 Var var ->
142− Just (Text.intercalate "." (Text.pack (Var.toString var) : fields))
143+ Just (B.fromText (Var.toText var) <> builder)
143144
144145 Access record field ->
145− collectFieldsHelp record (field : fields)
146+ collectFieldsHelp record ("." <> B.fromText field <> builder)
146147
147148 _ ->
148149 Nothing
src/AST/Literal.hs+19−16
@@ -4,6 +4,9 @@ module AST.Literal where
44
55import qualified Data.Map as Map
66import 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)
710
811import qualified AST.Variable as Var
912
@@ -13,22 +16,22 @@ import qualified AST.Variable as Var
1316
1417
1518data Literal
16− = IntNum Int
17− | FloatNum Double
18− | Chr Char
19− | Str Text
20− | Boolean Bool
21− deriving (Eq, Ord)
22−
23−
24−toString :: Literal -> String
25−toString literal =
26− case literal of
27− IntNum n -> show n
28− FloatNum n -> show n
29− Chr c -> show c
30− Str s -> show s
31− Boolean bool -> show bool
19+ = Chr Char
20+ | Str Text
21+ | IntNum Int
22+ | FloatNum Double
23+ | Boolean Bool
24+ deriving (Eq, Ord)
25+
26+
27+toBuilder :: Literal -> Builder
28+toBuilder literal =
29+ case literal of
30+ Chr c -> fromString (show c)
31+ Str s -> fromString (show s)
32+ IntNum n -> decimal n
33+ FloatNum n -> realFloat n
34+ Boolean bool -> if bool then "True" else "False"
3235
3336
3437
src/AST/Module/Name.hs+11−5
@@ -45,13 +45,19 @@ inLinearAlgebra raw =
4545
4646
4747toString :: Raw -> String
48−toString name =
49− Text.unpack name
48+toString =
49+ Text.unpack
5050
5151
52−canonicalToString :: Canonical -> String
53−canonicalToString (Canonical _ name) =
54− toString name
52+{-# INLINE toText #-}
53+toText :: Raw -> Text
54+toText name =
55+ name
56+
57+
58+canonicalToText :: Canonical -> Text
59+canonicalToText (Canonical _ name) =
60+ toText name
5561
5662
5763isNative :: Raw -> Bool
src/AST/Pattern.hs+22−17
@@ -3,9 +3,12 @@
33module AST.Pattern where
44
55import qualified Data.List as List
6+import Data.Monoid ((<>))
67import qualified Data.Set as Set
7−import qualified Data.Text as Text
88import 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)
912
1013import qualified AST.Literal as L
1114import qualified AST.Variable as Var
@@ -109,42 +112,44 @@ boundVarList pattern =
109112
110113
111114
112−-- TO STRING
115+-- TO BUILDER
116+
113117
118+toString :: Canonical -> String
119+toString var =
120+ LazyText.unpack (toLazyText (toBuilder False var))
114121
115−toString :: Bool -> Canonical -> String
116−toString needsParens (A.A _ pattern) =
122+
123+toBuilder :: Bool -> Canonical -> Builder
124+toBuilder needsParens (A.A _ pattern) =
117125 case pattern of
118126 Var name ->
119− Text.unpack name
127+ fromText name
120128
121129 Ctor name [] ->
122− if Var.isTuple name then
123− "()"
124− else
125− Var.toString name
130+ if Var.isTuple name then "()" else fromText (Var.toText name)
126131
127132 Ctor name args ->
128133 if Var.isTuple name then
129− "( " ++ List.intercalate ", " (map (toString False) args) ++ " )"
134+ "( " <> mconcat (List.intersperse ", " (map (toBuilder False) args)) <> " )"
130135 else
131136 parensIf needsParens $
132− Var.toString name ++ concatMap ((" "++) . toString True) args
137+ fromText (Var.toText name) <> mconcat (map (\arg -> " " <> toBuilder True arg) args)
133138
134139 Record fields ->
135− "{" ++ List.intercalate "," (map Text.unpack fields) ++ "}"
140+ "{" <> mconcat (List.intersperse "," (map fromText fields)) <> "}"
136141
137142 Alias alias subPattern ->
138143 parensIf needsParens $
139− toString False subPattern ++ " as " ++ Text.unpack alias
144+ toBuilder False subPattern <> " as " <> fromText alias
140145
141146 Anything ->
142147 "_"
143148
144149 Literal literal ->
145− L.toString literal
150+ L.toBuilder literal
146151
147152
148−parensIf :: Bool -> String -> String
149−parensIf needsParens str =
150− if needsParens then "(" ++ str ++ ")" else str
153+parensIf :: Bool -> Builder -> Builder
154+parensIf needsParens builder =
155+ if needsParens then "(" <> builder <> ")" else builder
src/AST/Variable.hs+33−21
@@ -4,6 +4,8 @@ module AST.Variable where
44
55import Data.Binary
66import qualified Data.Maybe as Maybe
7+import Data.Monoid ((<>))
8+import qualified Data.Set as Set
79import qualified Data.Text as Text
810import Data.Text (Text)
911
@@ -169,12 +171,17 @@ isTuple v =
169171
170172isPrimitive :: Canonical -> Bool
171173isPrimitive v =
172− case v of
173− Canonical BuiltIn name ->
174− elem name ["Int","Float","String","Bool"]
174+ case v of
175+ Canonical BuiltIn name ->
176+ Set.member name primitiveSet
177+
178+ _ ->
179+ False
175180
176− _ ->
177− False
181+
182+primitiveSet :: Set.Set Text
183+primitiveSet =
184+ Set.fromList ["Int","Float","String","Bool"]
178185
179186
180187isPrim :: Text -> Canonical -> Bool
@@ -201,29 +208,34 @@ isLocal check (Canonical home name) =
201208-- VARIABLE TO STRING
202209
203210
204−class ToString a where
205− toString :: a -> String
211+toString :: (ToText a) => a -> String
212+toString var =
213+ Text.unpack (toText var)
214+
215+
216+class ToText a where
217+ toText :: a -> Text
206218
207219
208−instance ToString Raw where
209− toString (Raw name) =
210− Text.unpack name
220+instance ToText Raw where
221+ toText (Raw name) =
222+ name
211223
212224
213−instance ToString Canonical where
214− toString (Canonical home name) =
215− case home of
216− BuiltIn ->
217− Text.unpack name
225+instance ToText Canonical where
226+ toText (Canonical home name) =
227+ case home of
228+ BuiltIn ->
229+ name
218230
219− Module moduleName ->
220− ModuleName.canonicalToString moduleName ++ "." ++ Text.unpack name
231+ Module moduleName ->
232+ ModuleName.canonicalToText moduleName <> "." <> name
221233
222− TopLevel _ ->
223− Text.unpack name
234+ TopLevel _ ->
235+ name
224236
225− Local ->
226− Text.unpack name
237+ Local ->
238+ name
227239
228240
229241
src/Elm/Package.hs+8−2
@@ -7,6 +7,7 @@ import Data.Binary
77import qualified Data.Char as Char
88import Data.Function (on)
99import qualified Data.List as List
10+import Data.Monoid ((<>))
1011import qualified Data.Text as Text
1112import Data.Text (Text)
1213import System.FilePath ((</>))
@@ -57,8 +58,13 @@ linearAlgebra =
5758
5859
5960toString :: Name -> String
60−toString (Name user project) =
61− Text.unpack user ++ "/" ++ Text.unpack project
61+toString name =
62+ Text.unpack (toText name)
63+
64+
65+toText :: Name -> Text
66+toText (Name user project) =
67+ user <> "/" <> project
6268
6369
6470toUrl :: Name -> String
src/Generate/JavaScript/Builder.hs+202−118
@@ -1,22 +1,155 @@
11{-# OPTIONS_GHC -Wall #-}
22{-# 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.
415
16+import Prelude hiding (lines)
517import qualified Data.List as List
618import Data.Monoid ((<>))
7−import qualified Data.Text.Lazy as LazyText
19+import Data.Text (Text)
820import Data.Text.Lazy.Builder
921import Data.Text.Lazy.Builder.Int (decimal)
1022import Data.Text.Lazy.Builder.RealFloat (realFloat)
11−import Language.ECMAScript3.Syntax
12−import Prelude hiding (lines)
23+import qualified Data.Text.Lazy as LazyText
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
13146
14147
15148
16149-- CONVERT TO LAZY TEXT
17150
18151
19−stmtsToText :: [Statement a] -> LazyText.Text
152+stmtsToText :: [Stmt] -> LazyText.Text
20153stmtsToText stmts =
21154 toLazyText (fromStmtBlock "" stmts)
22155
@@ -44,24 +177,24 @@ commaNewlineSep indent builders =
44177-- STATEMENTS
45178
46179
47−fromStmtBlock :: Builder -> [Statement a] -> Builder
180+fromStmtBlock :: Builder -> [Stmt] -> Builder
48181fromStmtBlock indent stmts =
49182 mconcat (map (fromStmt indent) stmts)
50183
51184
52−fromStmt :: Builder -> Statement a -> Builder
185+fromStmt :: Builder -> Stmt -> Builder
53186fromStmt indent statement =
54187 case statement of
55− BlockStmt _ stmts ->
188+ Block stmts ->
56189 fromStmtBlock indent stmts
57190
58− EmptyStmt _ ->
191+ EmptyStmt ->
59192 mempty
60193
61− ExprStmt _ expr ->
194+ ExprStmt expr ->
62195 indent <> snd (fromExpr indent Whatever expr) <> ";\n"
63196
64− IfStmt _ condition thenStmt elseStmt ->
197+ IfStmt condition thenStmt elseStmt ->
65198 mconcat
66199 [ indent, "if (", snd (fromExpr indent Whatever condition), ") {\n"
67200 , fromStmt (deeper indent) thenStmt
@@ -70,80 +203,65 @@ fromStmt indent statement =
70203 , indent, "}\n"
71204 ]
72205
73− IfSingleStmt _ condition thenStmt ->
206+ IfSingleStmt condition thenStmt ->
74207 mconcat
75208 [ indent, "if (", snd (fromExpr indent Whatever condition), ") {\n"
76209 , fromStmt (deeper indent) thenStmt
77210 , indent, "}\n"
78211 ]
79212
80− SwitchStmt _ expr clauses ->
213+ Switch expr clauses ->
81214 mconcat
82215 [ indent, "switch (", snd (fromExpr indent Whatever expr), ") {\n"
83216 , mconcat (map (fromClause (deeper indent)) clauses)
84217 , indent, "}\n"
85218 ]
86219
87− WhileStmt _ expr stmt ->
220+ While expr stmt ->
88221 mconcat
89222 [ indent, "while (", snd (fromExpr indent Whatever expr), ") {\n"
90223 , fromStmt (deeper indent) stmt
91224 , indent, "}\n"
92225 ]
93226
94− DoWhileStmt _ stmt expr ->
227+ DoWhile stmt expr ->
95228 mconcat
96229 [ indent, "do {\n"
97230 , fromStmt (deeper indent) stmt
98231 , indent, "} while(", snd (fromExpr indent Whatever expr), ");\n"
99232 ]
100233
101− BreakStmt _ Nothing ->
234+ Break Nothing ->
102235 indent <> "break;\n"
103236
104− BreakStmt _ (Just label) ->
237+ Break (Just label) ->
105238 indent <> "break " <> fromId label <> ";\n"
106239
107− ContinueStmt _ Nothing ->
240+ Continue Nothing ->
108241 indent <> "continue;\n"
109242
110− ContinueStmt _ (Just label) ->
243+ Continue (Just label) ->
111244 indent <> "continue " <> fromId label <> ";\n"
112245
113− LabelledStmt _ label stmt ->
246+ Labelled label stmt ->
114247 mconcat
115248 [ indent, fromId label, ":\n"
116249 , fromStmt indent stmt
117250 ]
118251
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 ->
132253 indent <> "return;\n"
133254
134− ReturnStmt _ (Just expr) ->
255+ Return (Just expr) ->
135256 indent <> "return " <> snd (fromExpr indent Whatever expr) <> ";\n"
136257
137− WithStmt _ _ _ ->
138− error "TODO"
139−
140− VarDeclStmt _ [] ->
258+ VarDeclStmt [] ->
141259 mempty
142260
143− VarDeclStmt _ decls ->
261+ VarDeclStmt decls ->
144262 indent <> "var " <> commaNewlineSep indent (map (fromVarDecl indent) decls) <> ";\n"
145263
146− FunctionStmt _ name args stmts ->
264+ FunctionStmt name args stmts ->
147265 indent <> "function " <> fromId name <> "(" <> commaSep (map fromId args) <> ") {\n"
148266 <>
149267 fromStmtBlock (deeper indent) stmts
@@ -155,14 +273,14 @@ fromStmt indent statement =
155273-- SWITCH CLAUSES
156274
157275
158−fromClause :: Builder -> CaseClause a -> Builder
276+fromClause :: Builder -> Case -> Builder
159277fromClause indent clause =
160278 case clause of
161− CaseClause _ expr stmts ->
279+ Case expr stmts ->
162280 indent <> "case " <> snd (fromExpr indent Whatever expr) <> ":\n"
163281 <> fromStmtBlock (deeper indent) stmts
164282
165− CaseDefault _ stmts ->
283+ Default stmts ->
166284 indent <> "default:\n"
167285 <> fromStmtBlock (deeper indent) stmts
168286
@@ -171,23 +289,23 @@ fromClause indent clause =
171289-- ID
172290
173291
174−fromId :: Id a -> Builder
175−fromId (Id _ name) =
176− fromString name
292+fromId :: Id -> Builder
293+fromId (Id name) =
294+ fromText name
177295
178296
179297
180298-- VAR DECLS
181299
182300
183−fromVarDecl :: Builder -> VarDecl a -> Builder
184−fromVarDecl indent (VarDecl _ (Id _ name) maybeExpr) =
301+fromVarDecl :: Builder -> VarDecl -> Builder
302+fromVarDecl indent (VarDecl (Id name) maybeExpr) =
185303 case maybeExpr of
186304 Nothing ->
187− fromString name
305+ fromText name
188306
189307 Just expr ->
190− fromString name <> " = " <> snd (fromExpr indent Whatever expr)
308+ fromText name <> " = " <> snd (fromExpr indent Whatever expr)
191309
192310
193311
@@ -226,31 +344,25 @@ parensFor grouping builder =
226344 builder
227345
228346
229−fromExpr :: Builder -> Grouping -> Expression a -> (Lines, Builder)
347+fromExpr :: Builder -> Grouping -> Expr -> (Lines, Builder)
230348fromExpr indent grouping expression =
231349 case expression of
232− StringLit _ string ->
350+ String string ->
233351 (One, quoted string)
234352
235− RegexpLit _ _ _ _ ->
236− error "TODO"
237−
238− NumLit _ n ->
353+ Float n ->
239354 (One, realFloat n)
240355
241− IntLit _ n ->
356+ Int n ->
242357 (One, decimal n)
243358
244− BoolLit _ True ->
245− (One, "true")
246−
247− BoolLit _ False ->
248− (One, "false")
359+ Bool bool ->
360+ (One, if bool then "true" else "false")
249361
250− NullLit _ ->
362+ Null ->
251363 (One, "null")
252364
253− ArrayLit _ exprs ->
365+ Array exprs ->
254366 (,) Many $
255367 let
256368 (anyMany, builders) =
@@ -265,7 +377,7 @@ fromExpr indent grouping expression =
265377 else
266378 "[" <> commaSep builders <> "]"
267379
268− ObjectLit _ fields ->
380+ Object fields ->
269381 (,) Many $
270382 let
271383 deeperIndent =
@@ -283,22 +395,16 @@ fromExpr indent grouping expression =
283395 else
284396 "{" <> commaSep builders <> "}"
285397
286− ThisRef _ ->
287− (One, "this")
288−
289− VarRef _ name ->
398+ VarRef name ->
290399 (One, fromId name)
291400
292− DotRef _ expr (Id _ name) ->
401+ DotRef expr (Id name) ->
293402 makeDot indent expr name
294403
295− BracketRef _ expr bracketedExpr ->
404+ BracketRef expr bracketedExpr ->
296405 makeBracketed indent expr bracketedExpr
297406
298− NewExpr _ _ _ ->
299− error "TODO"
300−
301− PrefixExpr _ op expr ->
407+ Prefix op expr ->
302408 let
303409 (lines, builder) =
304410 fromExpr indent Atomic expr
@@ -307,10 +413,7 @@ fromExpr indent grouping expression =
307413 , parensFor grouping (fromPrefix op <> builder)
308414 )
309415
310− UnaryAssignExpr _ _ _ ->
311− error "TODO"
312−
313− InfixExpr _ op leftExpr rightExpr ->
416+ Infix op leftExpr rightExpr ->
314417 let
315418 (leftLines, left) =
316419 fromExpr indent Atomic leftExpr
@@ -322,7 +425,7 @@ fromExpr indent grouping expression =
322425 , parensFor grouping (left <> fromInfix op <> right)
323426 )
324427
325− CondExpr _ condExpr thenExpr elseExpr ->
428+ If condExpr thenExpr elseExpr ->
326429 let
327430 condB = snd (fromExpr indent Atomic condExpr)
328431 thenB = snd (fromExpr indent Atomic thenExpr)
@@ -332,7 +435,7 @@ fromExpr indent grouping expression =
332435 , parensFor grouping (condB <> " ? " <> thenB <> " : " <> elseB)
333436 )
334437
335− AssignExpr _ op lValue expr ->
438+ Assign op lValue expr ->
336439 let
337440 (leftLines, left) =
338441 fromLValue indent lValue
@@ -344,10 +447,7 @@ fromExpr indent grouping expression =
344447 , parensFor grouping (left <> fromAssign op <> right)
345448 )
346449
347− ListExpr _ _ ->
348− error "TODO"
349−
350− CallExpr _ function args ->
450+ Call function args ->
351451 (,) Many $
352452 let
353453 deeperIndent =
@@ -365,7 +465,7 @@ fromExpr indent grouping expression =
365465 else
366466 funcB <> "(" <> commaSep argsB <> ")"
367467
368− FuncExpr _ maybeName args stmts ->
468+ Function maybeName args stmts ->
369469 (,) Many $
370470 "function " <> maybe mempty fromId maybeName <> "(" <> commaSep (map fromId args) <> ") {\n"
371471 <>
@@ -378,7 +478,7 @@ fromExpr indent grouping expression =
378478-- FIELDS
379479
380480
381−fromField :: Builder -> (Prop a, Expression a) -> (Lines, Builder)
481+fromField :: Builder -> (Prop, Expr) -> (Lines, Builder)
382482fromField indent (prop, expr) =
383483 let
384484 (lines, builder) =
@@ -389,16 +489,16 @@ fromField indent (prop, expr) =
389489 )
390490
391491
392−fromProp :: Prop a -> Builder
492+fromProp :: Prop -> Builder
393493fromProp prop =
394494 case prop of
395− PropId _ name ->
495+ IdProp name ->
396496 fromId name
397497
398− PropString _ string ->
498+ StringProp string ->
399499 quoted string
400500
401− PropNum _ n ->
501+ IntProp n ->
402502 decimal n
403503
404504
@@ -406,54 +506,38 @@ fromProp prop =
406506-- STRINGS
407507
408508
409−quoted :: String -> Builder
410−quoted string =
411− fromString ('\'' : foldr escapeCons "'" string)
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
509+quoted :: Text -> Builder
510+quoted str =
511+ "'" <> fromText str <> "'"
428512
429513
430514
431515-- VALUES
432516
433517
434−fromLValue :: Builder -> LValue a -> (Lines, Builder)
518+fromLValue :: Builder -> LValue -> (Lines, Builder)
435519fromLValue indent lValue =
436520 case lValue of
437− LVar _ name ->
438− (One, fromString name)
521+ LVar name ->
522+ (One, fromText name)
439523
440− LDot _ expr field ->
524+ LDot expr field ->
441525 makeDot indent expr field
442526
443− LBracket _ expr bracketedExpr ->
527+ LBracket expr bracketedExpr ->
444528 makeBracketed indent expr bracketedExpr
445529
446530
447−makeDot :: Builder -> Expression a -> String -> (Lines, Builder)
531+makeDot :: Builder -> Expr -> Text -> (Lines, Builder)
448532makeDot indent expr field =
449533 let
450534 (lines, builder) =
451535 fromExpr indent Atomic expr
452536 in
453− (lines, builder <> "." <> fromString field)
537+ (lines, builder <> "." <> fromText field)
454538
455539
456−makeBracketed :: Builder -> Expression a -> Expression a -> (Lines, Builder)
540+makeBracketed :: Builder -> Expr -> Expr -> (Lines, Builder)
457541makeBracketed indent expr bracketedExpr =
458542 let
459543 (lines, builder) =
src/Generate/JavaScript/Literal.hs+6−7
@@ -1,25 +1,24 @@
11module Generate.JavaScript.Literal (literal) where
22
3−import qualified Language.ECMAScript3.Syntax as JS
4−
53import qualified AST.Literal as Lit
4+import qualified Generate.JavaScript.Builder as JS
65import qualified Generate.JavaScript.BuiltIn as BuiltIn
76
87
9−literal :: Lit.Literal -> JS.Expression ()
8+literal :: Lit.Literal -> JS.Expr
109literal lit =
1110 case lit of
1211 Lit.Chr char ->
1312 BuiltIn.character char
1413
1514 Lit.Str string ->
16− BuiltIn.string string
15+ JS.String string
1716
1817 Lit.IntNum number ->
19− JS.IntLit () number
18+ JS.Int number
2019
2120 Lit.FloatNum number ->
22− JS.NumLit () number
21+ JS.Float number
2322
2423 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 =
6565 splitAt 4 unhandledPatterns
6666
6767 patternList =
68− map (Pattern.toString False) visiblePatterns
68+ map Pattern.toString visiblePatterns
6969 ++ if null rest then [] else ["..."]
7070
7171 noun =
src/Reporting/Warning.hs+2−1
@@ -4,6 +4,7 @@ module Reporting.Warning where
44
55import Data.Aeson ((.=))
66import qualified Data.Aeson as Json
7+import qualified Data.Text as Text
78import Text.PrettyPrint.ANSI.Leijen (text)
89
910import qualified AST.Module.Name as ModuleName
@@ -34,7 +35,7 @@ toReport localizer warning =
3435 Report.report
3536 "unused import"
3637 Nothing
37− ("Module `" ++ ModuleName.toString moduleName ++ "` is unused.")
38+ ("Module `" ++ Text.unpack (ModuleName.toText moduleName) ++ "` is unused.")
3839 (text "Best to remove it. Don't save code quality for later!")
3940
4041 MissingTypeAnnotation name inferredType ->