12fbd47 · elk · git.iko.soy

git.iko.soy/elk

Use Var.Global in optimized AST

Need to allocate it a couple times otherwise.

commit12fbd47a913361822c80fea28d8ba4b6de41d80f authorEvan Czaplicki <evancz@users.noreply.github.com> dateThu 30 Mar 2017, 19:09 (10 years ago) parentfa7b51d

6 files changed+42−38

compare with master

unifiedsplit

src/AST/Expression/Optimized.hs+7−7 src/Generate/JavaScript/Expression.hs+12−12 src/Generate/JavaScript/Foreign.hs+2−2 src/Generate/JavaScript/Variable.hs+5−4 src/Optimize.hs+11−8 src/Optimize/Inline.hs+5−5

src/AST/Expression/Optimized.hs+7−7

@@ -8,7 +8,7 @@ module AST.Expression.Optimized

88 where

1010

11−import Control.Monad (liftM, liftM2, liftM3, liftM4)

11+import Control.Monad (liftM, liftM2, liftM3)

1212import Data.Binary

1313import qualified Data.Set as Set

1414import Data.Text (Text)

@@ -51,9 +51,9 @@ data Def

5151data Expr

5252 = Literal Literal.Literal

5353 | VarLocal Text

54− | VarGlobal ModuleName.Canonical Text

54+ | VarGlobal Var.Global

5555 | List [Expr]

56− | Binop ModuleName.Canonical Text Expr Expr

56+ | Binop Var.Global Expr Expr

5757 | Function [Text] Expr

5858 | Call Expr [Expr]

5959 | TailCall Text [Text] [Expr]

@@ -129,9 +129,9 @@ instance Binary Expr where

129129 case word of

130130 0 -> liftM Literal get

131131 1 -> liftM VarLocal get

132− 2 -> liftM2 VarGlobal get get

132+ 2 -> liftM VarGlobal get

133133 3 -> liftM List get

134− 4 -> liftM4 Binop get get get get

134+ 4 -> liftM3 Binop get get get

135135 5 -> liftM2 Function get get

136136 6 -> liftM2 Call get get

137137 7 -> liftM3 TailCall get get get

@@ -156,9 +156,9 @@ instance Binary Expr where

156156 case expr of

157157 Literal a -> putWord8 0 >> put a

158158 VarLocal a -> putWord8 1 >> put a

159− VarGlobal a b -> putWord8 2 >> put a >> put b

159+ VarGlobal a -> putWord8 2 >> put a

160160 List a -> putWord8 3 >> put a

161− Binop a b c d -> putWord8 4 >> put a >> put b >> put c >> put d

161+ Binop a b c -> putWord8 4 >> put a >> put b >> put c

162162 Function a b -> putWord8 5 >> put a >> put b

163163 Call a b -> putWord8 6 >> put a >> put b

164164 TailCall a b c -> putWord8 7 >> put a >> put b >> put c

src/Generate/JavaScript/Expression.hs+12−12

@@ -109,8 +109,8 @@ generateCode expr =

109109 VarLocal name ->

110110 jsExpr $ Var.local name

111111

112− VarGlobal home name ->

113− jsExpr $ Var.global home name

112+ VarGlobal name ->

113+ jsExpr $ Var.global name

114114

115115 Literal lit ->

116116 jsExpr (Literal.literal lit)

@@ -138,8 +138,8 @@ generateCode expr =

138138 do jsFields <- mapM toField fields

139139 jsExpr $ JS.Object jsFields

140140

141− Binop home op leftExpr rightExpr ->

142− generateBinop home op leftExpr rightExpr

141+ Binop op leftExpr rightExpr ->

142+ generateBinop op leftExpr rightExpr

143143

144144 Function args body ->

145145 generateFunction args body

@@ -300,13 +300,13 @@ generateFunctionWithArity rawArgs code =

300300generateCall :: Opt.Expr -> [Opt.Expr] -> State Int Code

301301generateCall func args =

302302 case (func, args) of

303− (Opt.VarGlobal home name, [arg]) ->

303+ (Opt.VarGlobal (V.Global home name), [arg]) ->

304304 case name of

305305 "complement" | home == bitwise -> genPrefix JS.PrefixBNot arg

306306 "not" | home == basics -> genPrefix JS.PrefixLNot arg

307307 _ -> generateCallHelp func args

308308

309− (Opt.VarGlobal home name, [ left, right ]) | home == bitwise ->

309+ (Opt.VarGlobal (V.Global home name), [ left, right ]) | home == bitwise ->

310310 case name of

311311 "and" -> genInfix JS.OpBAnd left right

312312 "or" -> genInfix JS.OpBOr left right

@@ -540,22 +540,22 @@ pathToExpr root fullPath =

540540-- BINARY OPERATORS

541541

542542

543−generateBinop :: ModuleName.Canonical -> Text -> Opt.Expr -> Opt.Expr -> State Int Code

544−generateBinop home op left right =

543+generateBinop :: V.Global -> Opt.Expr -> Opt.Expr -> State Int Code

544+generateBinop op left right =

545545 do jsLeft <- generateJsExpr left

546546 jsRight <- generateJsExpr right

547− jsExpr (generateBinopHelp home op jsLeft jsRight)

547+ jsExpr (generateBinopHelp op jsLeft jsRight)

548548

549549

550550

551551-- BINARY OPERATOR HELPERS

552552

553553

554−generateBinopHelp :: ModuleName.Canonical -> Text -> JS.Expr -> JS.Expr -> JS.Expr

555−generateBinopHelp home op leftExpr rightExpr =

554+generateBinopHelp :: V.Global -> JS.Expr -> JS.Expr -> JS.Expr

555+generateBinopHelp var@(V.Global home op) leftExpr rightExpr =

556556 let

557557 simpleMake left right =

558− JS.Call (ref "A2") [ Var.global home op, left, right ]

558+ JS.Call (ref "A2") [ Var.global var, left, right ]

559559 in

560560 if home == basics then

561561 (Map.findWithDefault simpleMake op basicOps) leftExpr rightExpr

src/Generate/JavaScript/Foreign.hs+2−2

@@ -155,7 +155,7 @@ decode tipe =

155155

156156to :: Text -> Opt.Expr

157157to name =

158− Opt.VarGlobal jsonDecode name

158+ Opt.VarGlobal (Var.Global jsonDecode name)

159159

160160

161161jsonDecode :: ModuleName.Canonical

@@ -186,7 +186,7 @@ toMaybe :: T.Canonical -> Opt.Expr

186186toMaybe tipe =

187187 let

188188 maybe tag =

189− Opt.VarGlobal (ModuleName.inCore "Maybe") tag

189+ Opt.VarGlobal (Var.Global (ModuleName.inCore "Maybe") tag)

190190 in

191191 to "oneOf" <==

192192 [ Opt.List

src/Generate/JavaScript/Variable.hs+5−4

@@ -20,6 +20,7 @@ import Data.Text (Text)

2020

2121import qualified AST.Helpers as Help

2222import qualified AST.Module.Name as ModuleName

23+import qualified AST.Variable as Var

2324import qualified Elm.Package as Pkg

2425import qualified Generate.JavaScript.Builder as JS

2526import qualified Generate.JavaScript.Helpers as JS

@@ -45,8 +46,8 @@ local name =

4546 JS.ref (safe name)

4647

4748

48−global :: ModuleName.Canonical -> Text -> JS.Expr

49−global home name =

49+global :: Var.Global -> JS.Expr

50+global (Var.Global home name) =

5051 if Help.isOp name then

5152 JS.BracketRef (JS.ref (opsDict home)) (JS.String name)

5253 else

@@ -59,12 +60,12 @@ global home name =

5960

6061coreNative :: Text -> Text -> JS.Expr

6162coreNative moduleName name =

62− global (ModuleName.inCore ("Native." <> moduleName)) name

63+ global (Var.Global (ModuleName.inCore ("Native." <> moduleName)) name)

6364

6465

6566staticProgram :: JS.Expr

6667staticProgram =

67− global (ModuleName.inVirtualDom "Native.VirtualDom") "staticProgram"

68+ global (Var.Global (ModuleName.inVirtualDom "Native.VirtualDom") "staticProgram")

6869

6970

7071

src/Optimize.hs+11−8

@@ -50,12 +50,13 @@ optimizeDecl variantDict home index (Can.Def _ pattern@(A.A _ ptrn) expression _

5050 (_, []) ->

5151 let

5252 name = "_" <> Text.pack (show index)

53− deps = Set.singleton (Var.Global home name)

53+ var = Var.Global home name

54+ deps = Set.singleton var

5455 decl =

5556 Env.run variantDict home $

5657 ((,) name . Opt.Def) <$> optimizeExpr Nothing rawBody

5758 destructors =

58− destruct (Opt.VarGlobal home name) pattern

59+ destruct (Opt.VarGlobal var) pattern

5960 in

6061 decl : map (second (Opt.Decl deps Nothing)) destructors

6162

@@ -309,17 +310,19 @@ optimizeVariable region (Var.Canonical home name) =

309310 pure (Opt.VarLocal name)

310311

311312 Var.TopLevel modul ->

312− do Env.register (Var.Global modul name)

313− pure (Opt.VarGlobal modul name)

313+ do let var = Var.Global modul name

314+ Env.register var

315+ pure (Opt.VarGlobal var)

314316

315317 Var.Module modul ->

316− do Env.register (Var.Global modul name)

318+ do let var = Var.Global modul name

319+ Env.register var

317320 if name == "crash" && modul == ModuleName.inCore "Debug"

318321 then

319322 do here <- Env.getHome

320323 pure (Opt.Crash here region Nothing)

321324 else

322− pure (Opt.VarGlobal modul name)

325+ pure (Opt.VarGlobal var)

323326

324327

325328

@@ -541,7 +544,7 @@ makeOptBinop (Var.Canonical home op) leftExpr rightExpr =

541544 error "bug manifesting in Optimize.makeOptBinop"

542545

543546 Var.Module name ->

544− Opt.Binop name op leftExpr rightExpr

547+ Opt.Binop (Var.Global name op) leftExpr rightExpr

545548

546549 Var.TopLevel name ->

547− Opt.Binop name op leftExpr rightExpr

550+ Opt.Binop (Var.Global name op) leftExpr rightExpr

src/Optimize/Inline.hs+5−5

@@ -81,13 +81,13 @@ count expression =

8181 VarLocal name ->

8282 Map.singleton name 1

8383

84− VarGlobal _ _ ->

84+ VarGlobal _ ->

8585 Map.empty

8686

8787 List exprs ->

8888 countMany exprs

8989

90− Binop _ _ left right ->

90+ Binop _ left right ->

9191 count2 left right

9292

9393 Function args body ->

@@ -188,14 +188,14 @@ replace substitutions expression =

188188 VarLocal name ->

189189 maybe expression id (Map.lookup name substitutions)

190190

191− VarGlobal _ _ ->

191+ VarGlobal _ ->

192192 expression

193193

194194 List exprs ->

195195 List (map go exprs)

196196

197− Binop home op left right ->

198− Binop home op (go left) (go right)

197+ Binop op left right ->

198+ Binop op (go left) (go right)

199199

200200 Function args body ->

201201 Function args (replace (deleteBatch args substitutions) body)