e6ac3d3 · elk · git.iko.soy

git.iko.soy/elk

Update JS gen to use canonicals & be nicer/faster

commite6ac3d30a7b2cc8df516d0b1eed8088391c23a23 authorEvan Czaplicki <info@elm-lang.org> dateTue 3 Jun 2014, 05:55 (12 years ago) parent12a1752

6 files changed+188−133

compare with master

unifiedsplit

Elm.cabal+2 compiler/Generate/JavaScript.hs+82−81 compiler/Generate/JavaScript/Helpers.hs+41−20 compiler/Generate/JavaScript/Ports.hs+12−12 compiler/Generate/JavaScript/Variable.hs+49 compiler/Parse/Helpers.hs+2−20

Elm.cabal+2

@@ -53,6 +53,7 @@ Library

5353 Generate.JavaScript,

5454 Generate.JavaScript.Helpers,

5555 Generate.JavaScript.Ports,

56+ Generate.JavaScript.Variable,

5657 Generate.Markdown,

5758 Generate.Html,

5859 Generate.Cases,

@@ -144,6 +145,7 @@ Executable elm

144145 Generate.JavaScript,

145146 Generate.JavaScript.Helpers,

146147 Generate.JavaScript.Ports,

148+ Generate.JavaScript.Variable,

147149 Generate.Markdown,

148150 Generate.Html,

149151 Generate.Cases,

compiler/Generate/JavaScript.hs+82−81

@@ -10,9 +10,10 @@ import qualified Data.Set as Set

1010import Language.ECMAScript3.PrettyPrint

1111import Language.ECMAScript3.Syntax

1212

13−import Generate.JavaScript.Helpers

13+import Generate.JavaScript.Helpers as Help

1414import qualified Generate.Cases as Case

1515import qualified Generate.JavaScript.Ports as Port

16+import qualified Generate.JavaScript.Variable as Var

1617import qualified Generate.Markdown as MD

1718

1819import AST.Annotation

@@ -23,62 +24,52 @@ import qualified AST.Module as Module

2324import qualified AST.Helpers as Help

2425import AST.Literal

2526import qualified AST.Pattern as P

26−import AST.PrettyPrint (renderPretty)

2727import qualified AST.Variable as Var

2828

2929varDecl :: String -> Expression () -> VarDecl ()

3030varDecl x expr =

3131 VarDecl () (var x) (Just expr)

3232

33−include :: String -> String -> VarDecl ()

34−include alias moduleName =

35− varDecl alias (obj (moduleName ++ ".make") <| ref "_elm")

36−

37−internalImports :: String -> Statement ()

33+internalImports :: String -> [VarDecl ()]

3834internalImports name =

39− VarDeclStmt ()

40− [ varDecl "_N" (obj "Elm.Native")

41− , include "_U" "_N.Utils"

42− , include "_L" "_N.List"

43− , include "_A" "_N.Array"

44− , include "_E" "_N.Error"

45− , varDecl "$moduleName" (string name)

35+ [ varDecl "_N" (obj ["Elm","Native"])

36+ , include "_U" "Utils"

37+ , include "_L" "List"

38+ , include "_A" "Array"

39+ , include "_E" "Error"

40+ , varDecl Help.localModuleName (string name)

4641 ]

42+ where

43+ include :: String -> String -> VarDecl ()

44+ include alias modul =

45+ varDecl alias (obj ["_N", modul, "make"] <| ref "_elm")

46+

47+_Utils :: String -> Expression ()

48+_Utils x = obj ["_U", x]

49+

50+_List :: String -> Expression ()

51+_List x = obj ["_L", x]

4752

4853literal :: Literal -> Expression ()

4954literal lit =

5055 case lit of

51− Chr c -> obj "_U.chr" <| string [c]

56+ Chr c -> _Utils "chr" <| string [c]

5257 Str s -> string s

5358 IntNum n -> IntLit () n

5459 FloatNum n -> NumLit () n

5560 Boolean b -> BoolLit () b

5661

57−canonical :: Var.Canonical -> Expression ()

58−canonical (Var.Canonical home name) =

59− case Help.isOp name of

60− True -> BracketRef () (dotSep (home' ++ ["_op"])) (string name)

61− False -> dotSep (home' ++ [map (swap '\'' '$') name])

62− where

63− swap from to c = if c == from then to else c

64−

65− home' =

66− case home of

67− Var.Local -> []

68− Var.BuiltIn -> []

69− Var.Module path -> [ map (swap '.' '$') path ]

70−

7162expression :: Canonical.Expr -> State Int (Expression ())

7263expression (A region expr) =

7364 case expr of

74− Var var -> return $ canonical var

65+ Var var -> return $ Var.canonical var

7566

7667 Literal lit -> return $ literal lit

7768

7869 Range lo hi ->

7970 do lo' <- expression lo

8071 hi' <- expression hi

81− return $ obj "_L.range" `call` [lo',hi']

72+ return $ _List "range" `call` [lo',hi']

8273

8374 Access e x ->

8475 do e' <- expression e

@@ -86,19 +77,19 @@ expression (A region expr) =

8677

8778 Remove e x ->

8879 do e' <- expression e

89− return $ obj "_U.remove" `call` [string x, e']

80+ return $ _Utils "remove" `call` [string x, e']

9081

9182 Insert e x v ->

9283 do v' <- expression v

9384 e' <- expression e

94− return $ obj "_U.insert" `call` [string x, v', e']

85+ return $ _Utils "insert" `call` [string x, v', e']

9586

9687 Modify e fs ->

9788 do e' <- expression e

9889 fs' <- forM fs $ \(f,v) -> do

9990 v' <- expression v

10091 return $ ArrayLit () [string f, v']

101− return $ obj "_U.replace" `call` [ArrayLit () fs', e']

92+ return $ _Utils "replace" `call` [ArrayLit () fs', e']

10293

10394 Record fields ->

10495 do fields' <- forM fields $ \(f,e) -> do

@@ -122,7 +113,7 @@ expression (A region expr) =

122113 where

123114 depattern (args, body) pattern =

124115 case pattern of

125− P.Var x -> return (args ++ [x], body)

116+ P.Var x -> return (args ++ [ Var.varName x ], body)

126117 _ -> do arg <- Case.newVar

127118 return ( args ++ [arg]

128119 , A ann (Case (A ann (localVar arg)) [(pattern, body)]))

@@ -161,7 +152,7 @@ expression (A region expr) =

161152 (A _ (Var (Var.Canonical (Var.Module "Basics") "otherwise")), _) ->

162153 safeIfs branches'

163154 (A _ (Literal (Boolean True)), _) -> safeIfs branches'

164− _ -> ifs branches' (obj "_E.If" `call` [ ref "$moduleName", string (renderPretty region) ])

155+ _ -> ifs branches' (throw "If" region)

165156 where

166157 safeIfs branches = ifs (init branches) (snd (last branches))

167158 ifs branches finally = foldr iff finally branches

@@ -181,7 +172,7 @@ expression (A region expr) =

181172

182173 ExplicitList es ->

183174 do es' <- mapM expression es

184− return $ obj "_L.fromArray" <| ArrayLit () es'

175+ return $ _List "fromArray" <| ArrayLit () es'

185176

186177 Data name es ->

187178 do es' <- mapM expression es

@@ -192,7 +183,7 @@ expression (A region expr) =

192183

193184 Markdown uid doc es ->

194185 do es' <- mapM expression es

195− return $ obj "Text.markdown" `call` (string md : string uid : es')

186+ return $ obj ["Text","markdown"] `call` (string md : string uid : es')

196187 where

197188 pad = "<div style=\"height:0;width:0;\"> </div>"

198189 md = pad ++ MD.toHtml doc ++ pad

@@ -201,11 +192,11 @@ expression (A region expr) =

201192 return $ ObjectLit () [(PropString () "src", literal (Str src))]

202193

203194 PortIn name tipe ->

204− return $ obj "Native.Ports.portIn" `call` [ string name, Port.incoming tipe ]

195+ return $ obj ["Native","Ports","portIn"] `call` [ string name, Port.incoming tipe ]

205196

206197 PortOut name tipe value ->

207198 do value' <- expression value

208− return $ obj "Native.Ports.portOut" `call`

199+ return $ obj ["Native","Ports","portOut"] `call`

209200 [ string name, Port.outgoing tipe, value' ]

210201

211202definition :: Canonical.Def -> State Int [Statement ()]

@@ -218,10 +209,10 @@ definition (Canonical.Definition pattern expr@(A region _) _) = do

218209 let op = LBracket () (ref "_op") (string x) in

219210 return [ ExprStmt () $ AssignExpr () OpAssign op expr' ]

220211 | otherwise ->

221− return [ VarDeclStmt () [ assign x ] ]

212+ return [ VarDeclStmt () [ assign (Var.varName x) ] ]

222213

223214 P.Record fields ->

224− let setField f = varDecl f (dotSep ["$",f]) in

215+ let setField f = varDecl f (obj ["$",f]) in

225216 return [ VarDeclStmt () (assign "$" : map setField fields) ]

226217

227218 P.Data (Var.Canonical _ name) patterns | vars /= Nothing ->

@@ -230,18 +221,18 @@ definition (Canonical.Definition pattern expr@(A region _) _) = do

230221 vars = getVars patterns

231222 getVars patterns =

232223 case patterns of

233− P.Var x : rest -> (x:) `fmap` getVars rest

224+ P.Var x : rest -> (Var.varName x :) `fmap` getVars rest

234225 [] -> Just []

235226 _ -> Nothing

236227

237− decl x n = varDecl x (dotSep ["$","_" ++ show n])

228+ decl x n = varDecl x (obj ["$","_" ++ show n])

238229 setup vars

239230 | Help.isTuple name = assign "$" : vars

240231 | otherwise = assign "_raw" : safeAssign : vars

241232

242− safeAssign = varDecl "$" (CondExpr () if' (obj "_raw") exception)

243− if' = InfixExpr () OpStrictEq (obj "_raw.ctor") (string name)

244− exception = obj "_E.Case" `call` [ref "$moduleName", string (renderPretty region)]

233+ safeAssign = varDecl "$" (CondExpr () if' (ref "_raw") exception)

234+ if' = InfixExpr () OpStrictEq (obj ["_raw","ctor"]) (string name)

235+ exception = Help.throw "Case" region

245236

246237 _ ->

247238 do defs' <- concat <$> mapM toDef vars

@@ -265,15 +256,15 @@ match region mtch =

265256 _ -> False

266257

267258 access name

268− | any isLiteral clauses = obj name

269− | otherwise = dotSep (split name ++ ["ctor"])

259+ | any isLiteral clauses = obj [name]

260+ | otherwise = obj (Help.splitDots name ++ ["ctor"])

270261

271262 format isChars e

272263 | or isChars = InfixExpr () OpAdd e (string "")

273264 | otherwise = e

274265

275266 Case.Fail ->

276− return [ ExprStmt () (obj "_E.Case" `call` [ref "$moduleName", string (renderPretty region)]) ]

267+ return [ ExprStmt () (Help.throw "Case" region) ]

277268

278269 Case.Break -> return [BreakStmt () Nothing]

279270

@@ -314,22 +305,48 @@ generate modul =

314305 show . prettyPrint $ setup "Elm" (names ++ ["make"]) ++

315306 [ assign ("Elm" : names ++ ["make"]) (function ["_elm"] programStmts) ]

316307 where

308+ names :: [String]

317309 names = Module.names modul

318310

319− thisModule = dotSep ("_elm" : names ++ ["values"])

311+ thisModule :: Expression ()

312+ thisModule = obj ("_elm" : names ++ ["values"])

313+

314+ programStmts :: [Statement ()]

320315 programStmts =

321316 concat

322− [ [ ExprStmt () $ string "use strict" ]

317+ [ [ ExprStmt () (string "use strict") ]

323318 , setup "_elm" (names ++ ["values"])

324319 , [ IfSingleStmt () thisModule (ret thisModule) ]

325− , [ internalImports (List.intercalate "." names) ]

326− , map jsImport . Set.toList . Set.fromList . map fst $ Module.imports modul

327− , [ assign ["_op"] (ObjectLit () []) ]

328− , concat $ evalState (mapM definition . fst . flattenLets [] $ Module.program (Module.body modul)) 0

320+ , [ VarDeclStmt () localVars ]

321+ , body

329322 , [ jsExports ]

330323 , [ ret thisModule ]

331324 ]

332325

326+ localVars :: [VarDecl ()]

327+ localVars = varDecl "_op" (ObjectLit () []) :

328+ internalImports (Module.getName modul) ++

329+ explicitImports

330+ where

331+ explicitImports :: [VarDecl ()]

332+ explicitImports =

333+ map jsImport . Set.toList . Set.fromList . map fst $ Module.imports modul

334+

335+ jsImport :: String -> VarDecl ()

336+ jsImport name =

337+ varDecl (Var.moduleName name) $

338+ obj ("Elm" : Help.splitDots name ++ ["make"]) <| ref "_elm"

339+

340+ body :: [Statement ()]

341+ body = concat $ evalState defs 0

342+ where

343+ defs = mapM definition . fst . flattenLets [] $ Module.program (Module.body modul)

344+

345+ setup namespace path = map create paths

346+ where

347+ create name = assign name (InfixExpr () OpLOr (obj name) (ObjectLit () []))

348+ paths = drop 2 . init . List.inits $ namespace : path

349+

333350 jsExports = assign ("_elm" : names ++ ["values"]) (ObjectLit () exs)

334351 where

335352 exs = map entry $ "_op" : concatMap extract (exports modul)

@@ -345,19 +362,11 @@ generate modul =

345362 case path of

346363 [x] -> VarDeclStmt () [ varDecl x expr ]

347364 _ -> ExprStmt () $

348− AssignExpr () OpAssign (LDot () (dotSep (init path)) (last path)) expr

349−

350− jsImport name =

351− assign [dolarize name] $ dotSep ("Elm" : Help.splitDots name ++ ["make"]) <| ref "_elm"

352−

353− setup namespace path = map create paths

354− where

355− create name = assign name (InfixExpr () OpLOr (dotSep name) (ObjectLit () []))

356− paths = drop 2 . init . List.inits $ namespace : path

365+ AssignExpr () OpAssign (LDot () (obj (init path)) (last path)) expr

357366

358367binop :: Region -> Var.Canonical -> Canonical.Expr -> Canonical.Expr

359368 -> State Int (Expression ())

360−binop region (Var.Canonical home op) e1 e2 =

369+binop region func@(Var.Canonical home op) e1 e2 =

361370 case (home, op) of

362371 (Var.Module "Basics", ".") ->

363372 do es <- mapM expression (e1 : collect [] e2)

@@ -371,7 +380,7 @@ binop region (Var.Canonical home op) e1 e2 =

371380 (Var.Module "List", "++") ->

372381 do e1' <- expression e1

373382 e2' <- expression e2

374− return $ obj "_L.append" `call` [e1', e2']

383+ return $ _List "append" `call` [e1', e2']

375384

376385 (Var.BuiltIn, "::") ->

377386 expression (A region (Data "::" [e1,e2]))

@@ -381,12 +390,12 @@ binop region (Var.Canonical home op) e1 e2 =

381390 e2' <- expression e2

382391 return $ case Map.lookup op basicOps of

383392 Just f -> f e1' e2'

384− Nothing -> ref "A2" `call` [ func, e1', e2' ]

393+ Nothing -> ref "A2" `call` [ Var.canonical func, e1', e2' ]

385394

386395 _ ->

387396 do e1' <- expression e1

388397 e2' <- expression e2

389− return (ref "A2" `call` [ func, e1', e2' ])

398+ return (ref "A2" `call` [ Var.canonical func, e1', e2' ])

390399

391400 where

392401 collect es e =

@@ -395,14 +404,6 @@ binop region (Var.Canonical home op) e1 e2 =

395404 collect (es ++ [e1]) e2

396405 _ -> es ++ [e]

397406

398− func | Help.isOp op = BracketRef () (dotSep (path ++ ["_op"])) (string op)

399− | otherwise = dotSep (path ++ [op])

400− where

401− path = case home of

402− Var.Local -> []

403− Var.BuiltIn -> []

404− Var.Module m -> [dolarize m]

405−

406407 basicOps = Map.fromList (infixOps ++ specialOps)

407408

408409 infixOps =

@@ -416,10 +417,10 @@ binop region (Var.Canonical home op) e1 e2 =

416417 ]

417418

418419 specialOps =

419− [ (,) "^" $ \a b -> obj "Math.pow" `call` [a,b]

420+ [ (,) "^" $ \a b -> obj ["Math","pow"] `call` [a,b]

420421 , (,) "|>" $ flip (<|)

421− , (,) "==" $ \a b -> obj "_U.eq" `call` [a,b]

422− , (,) "/=" $ \a b -> PrefixExpr () PrefixLNot (obj "_U.eq" `call` [a,b])

422+ , (,) "==" $ \a b -> _Utils "eq" `call` [a,b]

423+ , (,) "/=" $ \a b -> PrefixExpr () PrefixLNot (_Utils "eq" `call` [a,b])

423424 , (,) "<" $ cmp OpLT 0

424425 , (,) ">" $ cmp OpGT 0

425426 , (,) "<=" $ cmp OpLT 1

@@ -427,4 +428,4 @@ binop region (Var.Canonical home op) e1 e2 =

427428 , (,) "div" $ \a b -> InfixExpr () OpBOr (InfixExpr () OpDiv a b) (IntLit () 0)

428429 ]

429430

430− cmp op n a b = InfixExpr () op (obj "_U.cmp" `call` [a,b]) (IntLit () n)

431+ cmp op n a b = InfixExpr () op (_Utils "cmp" `call` [a,b]) (IntLit () n)

compiler/Generate/JavaScript/Helpers.hs+41−20

@@ -1,20 +1,11 @@

11{-# OPTIONS_GHC -W #-}

22module Generate.JavaScript.Helpers where

4−import qualified AST.Helpers as Help

4+import AST.Annotation (Region)

5+import qualified AST.PrettyPrint as PP

56import Language.ECMAScript3.Syntax

7−dolarize :: String -> String

8−dolarize x = map (\c -> if c == '.' then '$' else c) x

9−

10−split :: String -> [String]

11−split = go []

12− where

13− go vars str =

14− case break (=='.') str of

15− (x,_:rest) | Help.isOp x -> vars ++ [x ++ '.' : rest]

16− | otherwise -> go (vars ++ [x]) rest

17− (x,[]) -> vars ++ [x]

8+-- Creating Variables

189

1910var :: String -> Id ()

2011var name = Id () name

@@ -22,24 +13,54 @@ var name = Id () name

2213ref :: String -> Expression ()

2314ref name = VarRef () (var name)

2415

16+prop :: String -> Prop ()

2517prop name = PropId () (var name)

26−f <| x = CallExpr () f [x]

27−ret e = ReturnStmt () (Just e)

28−args ==> e = FuncExpr () Nothing (map var args) [ ret e ]

29−function args stmts = FuncExpr () Nothing (map var args) stmts

30−call = CallExpr ()

18+

3119string = StringLit ()

3220

33−dotSep :: [String] -> Expression ()

34−dotSep vars =

21+obj :: [String] -> Expression ()

22+obj vars =

3523 case vars of

3624 x:xs -> foldl (DotRef ()) (ref x) (map var xs)

3725 [] -> error "dotSep must be called on a non-empty list of variables"

3826

39−obj = dotSep . split

27+-- Specific Utilities

28+

29+localModuleName :: String

30+localModuleName = "$moduleName"

31+

32+throw :: String -> Region -> Expression ()

33+throw kind region =

34+ obj ["_E",kind] `call` [ ref localModuleName, string (PP.renderPretty region) ]

35+

36+-- Function Calls

37+

38+(<|) :: Expression () -> Expression () -> Expression ()

39+(<|) f x = CallExpr () f [x]

40+

41+ret :: Expression () -> Statement ()

42+ret e = ReturnStmt () (Just e)

43+

44+(==>) :: [String] -> Expression () -> Expression ()

45+(==>) args e = FuncExpr () Nothing (map var args) [ ret e ]

46+

47+function :: [String] -> [Statement ()] -> Expression ()

48+function args stmts = FuncExpr () Nothing (map var args) stmts

49+

50+call :: Expression () -> [Expression ()] -> Expression ()

51+call = CallExpr ()

52+

53+-- Checks

4054

55+equal :: Expression () -> Expression () -> Expression ()

4156equal a b = InfixExpr () OpStrictEq a b

57+

58+instanceof :: String -> Expression () -> Expression ()

4259instanceof tipe x =

4360 InfixExpr () OpLAnd (typeof "object" x) (InfixExpr () OpInstanceof x (ref tipe))

61+

62+typeof :: String -> Expression () -> Expression ()

4463typeof tipe x = equal (PrefixExpr () PrefixTypeof x) (string tipe)

64+

65+member :: String -> Expression () -> Expression ()

4566member field x = InfixExpr () OpIn (string field) x

compiler/Generate/JavaScript/Ports.hs+12−12

@@ -14,13 +14,13 @@ check x jsType continue =

1414 CondExpr () (jsFold OpLOr checks x) continue throw

1515 where

1616 jsFold op checks value = foldl1 (InfixExpr () op) (map ($value) checks)

17− throw = obj "_E.raise" <| InfixExpr () OpAdd msg x

17+ throw = obj ["_E","raise"] <| InfixExpr () OpAdd msg x

1818 msg = string ("invalid input, expecting " ++ show jsType ++ " but got ")

1919 checks = case jsType of

2020 JSNumber -> [typeof "number"]

2121 JSBoolean -> [typeof "boolean"]

2222 JSString -> [typeof "string", instanceof "String"]

23− JSArray -> [(obj "_U.isJSArray" <|)]

23+ JSArray -> [(obj ["_U","isJSArray"] <|)]

2424 JSObject fields -> [jsFold OpLAnd (typeof "object" : map member fields)]

2525

2626incoming :: CanonicalType -> Expression ()

@@ -29,7 +29,7 @@ incoming tipe =

2929 Aliased _ t -> incoming t

3030

3131 App (Type v) [t]

32− | Var.isSignal v -> obj "Native.Ports.incomingSignal" <| incoming t

32+ | Var.isSignal v -> obj ["Native","Ports","incomingSignal"] <| incoming t

3333

3434 _ -> ["v"] ==> inc tipe (ref "v")

3535

@@ -50,19 +50,19 @@ inc tipe x =

5050 from checks = check x checks x

5151

5252 Type name

53− | Var.isJson name -> obj "Native.Json.fromJS" <| x

53+ | Var.isJson name -> obj ["Native","Json","fromJS"] <| x

5454 | otherwise -> error "bad type got to incoming port generation code"

5555

5656 App f args ->

5757 case f : args of

5858 Type name : [t]

5959 | Var.isMaybe name -> CondExpr () (equal x (NullLit ()))

60− (obj "Maybe.Nothing")

61− (obj "Maybe.Just" <| inc t x)

60+ (obj ["Maybe","Nothing"])

61+ (obj ["Maybe","Just"] <| inc t x)

6262

63− | Var.isList name -> check x JSArray (obj "_L.fromArray" <| array)

63+ | Var.isList name -> check x JSArray (obj ["_L","fromArray"] <| array)

6464

65− | Var.isArray name -> check x JSArray (obj "_A.fromJSArray" <| array)

65+ | Var.isArray name -> check x JSArray (obj ["_A","fromJSArray"] <| array)

6666 where

6767 array = DotRef () x (var "map") <| incoming t

6868

@@ -96,7 +96,7 @@ outgoing tipe =

9696 Aliased _ t -> outgoing t

9797

9898 App (Type v) [t]

99− | Var.isSignal v -> obj "Native.Ports.outgoingSignal" <| outgoing t

99+ | Var.isSignal v -> obj ["Native","Ports","outgoingSignal"] <| outgoing t

100100

101101 _ -> ["v"] ==> out tipe (ref "v")

102102

@@ -125,7 +125,7 @@ out tipe x =

125125 | name `elem` ["Int","Float","Bool","String"] -> x

126126

127127 Type name

128− | Var.isJson name -> obj "Native.Json.toJS" <| x

128+ | Var.isJson name -> obj ["Native","Json","toJS"] <| x

129129 | otherwise -> error "bad type got to outgoing port generation code"

130130

131131 App f args ->

@@ -137,10 +137,10 @@ out tipe x =

137137 (out t (DotRef () x (var "_0")))

138138

139139 | Var.isArray name ->

140− DotRef () (obj "_A.toJSArray" <| x) (var "map") <| outgoing t

140+ DotRef () (obj ["_A","toJSArray"] <| x) (var "map") <| outgoing t

141141

142142 | Var.isList name ->

143− DotRef () (obj "_L.toArray" <| x) (var "map") <| outgoing t

143+ DotRef () (obj ["_L","toArray"] <| x) (var "map") <| outgoing t

144144

145145 Type name : ts

146146 | Var.isTuple name ->

compiler/Generate/JavaScript/Variable.hsnew file+49

@@ -0,0 +1,49 @@

1+{-# OPTIONS_GHC -W #-}

2+module Generate.JavaScript.Variable where

4+import qualified AST.Helpers as Help

5+import qualified AST.Variable as Var

6+import qualified Data.Set as Set

7+import qualified Generate.JavaScript.Helpers as JS

8+import qualified Language.ECMAScript3.Syntax as JS

10+swap :: Char -> Char -> Char -> Char

11+swap from to c = if c == from then to else c

12+

13+canonical :: Var.Canonical -> JS.Expression ()

14+canonical (Var.Canonical home name) =

15+ case Help.isOp name of

16+ True -> JS.BracketRef () (JS.obj (home' ++ ["_op"])) (JS.string name)

17+ False -> JS.obj (home' ++ [ varName name ])

18+ where

19+ home' =

20+ case home of

21+ Var.Local -> []

22+ Var.BuiltIn -> []

23+ Var.Module path -> [ moduleName path ]

24+

25+moduleName :: String -> String

26+moduleName x = '$' : map (swap '.' '$') x

27+

28+varName :: String -> String

29+varName x = map (swap '\'' '$') x'

30+ where

31+ x' = if Set.member x jsReserveds then '$' : x else x

32+

33+jsReserveds :: Set.Set String

34+jsReserveds = Set.fromList

35+ [ "null", "undefined", "Nan", "Infinity", "true", "false", "eval"

36+ , "arguments", "int", "byte", "char", "goto", "long", "final", "float"

37+ , "short", "double", "native", "throws", "boolean", "abstract", "volatile"

38+ , "transient", "synchronized", "function", "break", "case", "catch"

39+ , "continue", "debugger", "default", "delete", "do", "else", "finally"

40+ , "for", "function", "if", "in", "instanceof", "new", "return", "switch"

41+ , "this", "throw", "try", "typeof", "var", "void", "while", "with", "class"

42+ , "const", "enum", "export", "extends", "import", "super", "implements"

43+ , "interface", "let", "package", "private", "protected", "public"

44+ , "static", "yield"

45+ -- reserved by the Elm runtime system

46+ , "Elm", "ElmRuntime"

47+ , "F2", "F3", "F4", "F5", "F6", "F7", "F8", "F9"

48+ , "A2", "A3", "A4", "A5", "A6", "A7", "A8", "A9"

49+ ]

compiler/Parse/Helpers.hs+2−20

@@ -6,7 +6,6 @@ import Control.Applicative ((<$>),(<*>))

66import Control.Monad

77import Control.Monad.State

88import Data.Char (isUpper)

9−import qualified Data.Set as Set

109import qualified Data.Map as Map

1110import qualified Language.GLSL.Parser as GLP

1211import Language.GLSL.Syntax as GLS

@@ -30,25 +29,8 @@ reserveds = [ "if", "then", "else"

3029 , "module", "where"

3130 , "import", "as", "hiding", "open"

3231 , "export", "foreign"

33− , "deriving", "port" ]

34−

35−jsReserveds :: Set.Set String

36−jsReserveds = Set.fromList

37− [ "null", "undefined", "Nan", "Infinity", "true", "false", "eval"

38− , "arguments", "int", "byte", "char", "goto", "long", "final", "float"

39− , "short", "double", "native", "throws", "boolean", "abstract", "volatile"

40− , "transient", "synchronized", "function", "break", "case", "catch"

41− , "continue", "debugger", "default", "delete", "do", "else", "finally"

42− , "for", "function", "if", "in", "instanceof", "new", "return", "switch"

43− , "this", "throw", "try", "typeof", "var", "void", "while", "with", "class"

44− , "const", "enum", "export", "extends", "import", "super", "implements"

45− , "interface", "let", "package", "private", "protected", "public"

46− , "static", "yield"

47− -- reserved by the Elm runtime system

48− , "Elm", "ElmRuntime"

49− , "F2", "F3", "F4", "F5", "F6", "F7", "F8", "F9"

50− , "A2", "A3", "A4", "A5", "A6", "A7", "A8", "A9"

51− ]

32+ , "deriving", "port"

33+ ]

5234

5335expecting = flip (<?>)

5436