30261e2 · elk · git.iko.soy

git.iko.soy/elk

Distinguish between local and global variables in optimized AST

commit30261e2ac6085180054104a57c6c5fb711dfa8d4 authorEvan Czaplicki <evancz@users.noreply.github.com> dateTue 28 Mar 2017, 13:25 (10 years ago) parent28a5e11

8 files changed+238−273

compare with master

unifiedsplit

src/AST/Expression/Optimized.hs+3−2 src/Generate/JavaScript.hs+1−1 src/Generate/JavaScript/Expression.hs+107−127 src/Generate/JavaScript/Foreign.hs+10−9 src/Generate/JavaScript/Variable.hs+47−72 src/Optimize.hs+57−29 src/Optimize/Environment.hs+3−14 src/Optimize/Inline.hs+10−19

src/AST/Expression/Optimized.hs+3−2

@@ -48,9 +48,10 @@ data Def

4848

4949data Expr

5050 = Literal Literal.Literal

51− | Var Var.Canonical

51+ | VarLocal Text

52+ | VarGlobal ModuleName.Canonical Text

5253 | List [Expr]

53− | Binop Var.Canonical Expr Expr

54+ | Binop ModuleName.Canonical Text Expr Expr

5455 | Function [Text] Expr

5556 | Call Expr [Expr]

5657 | TailCall Text [Text] [Expr]

src/Generate/JavaScript.hs+1−1

@@ -109,7 +109,7 @@ generateDecl :: Var.Global -> Opt.Def -> BS.Builder

109109generateDecl (Var.Global home name) def =

110110 let

111111 genBody =

112− JS.generateDef (Just home) name def

112+ JS.generateDecl home name def

113113 in

114114 JS.encodeUtf8 (State.evalState genBody 0)

115115

src/Generate/JavaScript/Expression.hs+107−127

@@ -1,5 +1,8 @@

11{-# LANGUAGE OverloadedStrings #-}

2−module Generate.JavaScript.Expression (generateDef) where

2+module Generate.JavaScript.Expression

3+ ( generateDecl

4+ )

5+ where

47import Control.Arrow (second)

58import Control.Monad.State (State, foldM)

@@ -13,7 +16,7 @@ import qualified AST.Expression.Canonical as Can

1316import AST.Expression.Optimized as Opt

1417import qualified AST.Literal as L

1518import qualified AST.Module.Name as ModuleName

16−import qualified AST.Variable as Var

19+import qualified AST.Variable as V

1720import Generate.JavaScript.Helpers as Help

1821import qualified Generate.JavaScript.Builder as JS

1922import qualified Generate.JavaScript.BuiltIn as BuiltIn

@@ -24,6 +27,15 @@ import qualified Optimize.DecisionTree as DT

2427

2528

2629

30+-- GENERATE DECLARATION

31+

32+

33+generateDecl :: ModuleName.Canonical -> Text -> Opt.Def -> State Int [JS.Stmt]

34+generateDecl home name def =

35+ Var.defineGlobal home name <$> generateDef name def

36+

37+

38+

2739-- CODE CHUNKS

2840

2941

@@ -83,23 +95,6 @@ toExpr code =

8395

8496

8597

86−-- DEFINITIONS

87−

88−

89−generateDef :: Maybe ModuleName.Canonical -> Text -> Opt.Def -> State Int [JS.Stmt]

90−generateDef home name def =

91− do jsBody <-

92− case def of

93− Opt.TailDef argNames body ->

94− generateTailFunction name argNames body

95−

96− Opt.Def body ->

97− generateJsExpr body

98−

99− return (Var.define home name jsBody)

100−

101−

102−

10398-- EXPRESSIONS

10499

105100

@@ -111,8 +106,11 @@ generateJsExpr optExpr =

111106generateCode :: Opt.Expr -> State Int Code

112107generateCode expr =

113108 case expr of

114− Var var ->

115− jsExpr $ Var.canonical var

109+ VarLocal name ->

110+ jsExpr $ Var.local name

111+

112+ VarGlobal home name ->

113+ jsExpr $ Var.global home name

116114

117115 Literal lit ->

118116 jsExpr (Literal.literal lit)

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

140138 do jsFields <- mapM toField fields

141139 jsExpr $ JS.Object jsFields

142140

143− Binop op leftExpr rightExpr ->

144− binop op leftExpr rightExpr

141+ Binop home op leftExpr rightExpr ->

142+ generateBinop home op leftExpr rightExpr

145143

146144 Function args body ->

147145 generateFunction args body

@@ -163,10 +161,9 @@ generateCode expr =

163161 ++ [JS.Continue (Just (JS.Id (Var.safe name)))]

164162

165163 Let defs body ->

166− do let genDef (name, def) = generateDef Nothing name def

167− stmts <- mapM genDef defs

164+ do stmts <- mapM generateLetDef defs

168165 code <- generateCode body

169− jsBlock (concat stmts ++ toStatementList code)

166+ jsBlock (stmts ++ toStatementList code)

170167

171168 If branches finally ->

172169 generateIf branches finally

@@ -239,13 +236,23 @@ generateProgram kind body =

239236

240237

241238

242−-- FUNCTIONS

239+-- DEFINITIONS

243240

244241

245−generateFunction :: [Text] -> Opt.Expr -> State Int Code

246−generateFunction args body =

247− do code <- generateCode body

248− jsExpr (generateFunctionWithArity args code)

242+generateLetDef :: (Text, Opt.Def) -> State Int JS.Stmt

243+generateLetDef (name, def) =

244+ do jsBody <- generateDef name def

245+ return $ JS.VarDeclStmt [ Help.varDecl name jsBody ]

246+

247+

248+generateDef :: Text -> Opt.Def -> State Int JS.Expr

249+generateDef name def =

250+ case def of

251+ Opt.TailDef argNames body ->

252+ generateTailFunction name argNames body

253+

254+ Opt.Def body ->

255+ generateJsExpr body

249256

250257

251258generateTailFunction :: Text -> [Text] -> Opt.Expr -> State Int JS.Expr

@@ -257,6 +264,16 @@ generateTailFunction name args body =

257264 (JS.While (JS.Bool True) (toStatement code))

258265

259266

267+

268+-- FUNCTIONS

269+

270+

271+generateFunction :: [Text] -> Opt.Expr -> State Int Code

272+generateFunction args body =

273+ do code <- generateCode body

274+ jsExpr (generateFunctionWithArity args code)

275+

276+

260277generateFunctionWithArity :: [Text] -> Code -> JS.Expr

261278generateFunctionWithArity rawArgs code =

262279 let

@@ -283,27 +300,47 @@ generateFunctionWithArity rawArgs code =

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

284301generateCall func args =

285302 case (func, args) of

286− (Opt.Var var, [arg]) ->

287− case getUnaryOp var of

288− Just op ->

289− do jsArg <- generateJsExpr arg

290− jsExpr $ JS.Prefix op jsArg

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

304+ case name of

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

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

307+ _ -> generateCallHelp func args

308+

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

310+ case name of

311+ "and" -> genInfix JS.OpBAnd left right

312+ "or" -> genInfix JS.OpBOr left right

313+ "xor" -> genInfix JS.OpBXor left right

314+ "shiftLeftBy" -> genInfix JS.OpLShift right left

315+ "shiftRightBy" -> genInfix JS.OpSpRShift right left

316+ "shiftRightZfBy" -> genInfix JS.OpZfRShift right left

317+ _ -> generateCallHelp func args

291318

292− Nothing ->

293− generateCallHelp func args

319+ _ ->

320+ generateCallHelp func args

294321

295− (Opt.Var var, [ arg1, arg2 ]) ->

296− case getBinaryOp var arg1 arg2 of

297− Just (op, left, right) ->

298− do jsLeft <- generateJsExpr left

299− jsRight <- generateJsExpr right

300− jsExpr $ JS.Infix op jsLeft jsRight

301322

302− Nothing ->

303− generateCallHelp func args

323+genPrefix :: JS.PrefixOp -> Opt.Expr -> State Int Code

324+genPrefix op arg =

325+ do jsArg <- generateJsExpr arg

326+ jsExpr (JS.Prefix op jsArg)

304327

305− _ ->

306− generateCallHelp func args

328+

329+genInfix :: JS.InfixOp -> Opt.Expr -> Opt.Expr -> State Int Code

330+genInfix op left right =

331+ do jsLeft <- generateJsExpr left

332+ jsRight <- generateJsExpr right

333+ jsExpr $ JS.Infix op jsLeft jsRight

334+

335+

336+basics :: ModuleName.Canonical

337+basics =

338+ ModuleName.inCore "Basics"

339+

340+

341+bitwise :: ModuleName.Canonical

342+bitwise =

343+ ModuleName.inCore "Bitwise"

307344

308345

309346generateCallHelp :: Opt.Expr -> [Opt.Expr] -> State Int Code

@@ -321,49 +358,6 @@ generateCallHelp func args =

321358 foldl1 (<|) (jsFunc:jsArgs)

322359

323360

324−getUnaryOp :: Var.Canonical -> Maybe JS.PrefixOp

325−getUnaryOp var =

326− if var == bitwiseComplement then

327− Just JS.PrefixBNot

328−

329− else if var == basicsNot then

330− Just JS.PrefixLNot

331−

332− else

333− Nothing

334−

335−

336−getBinaryOp :: Var.Canonical -> Opt.Expr -> Opt.Expr -> Maybe (JS.InfixOp, Opt.Expr, Opt.Expr)

337−getBinaryOp (Var.Canonical home name) left right =

338− if home /= bitwise then

339− Nothing

340−

341− else

342− case name of

343− "and" -> Just ( JS.OpBAnd, left, right )

344− "or" -> Just ( JS.OpBOr, left, right )

345− "xor" -> Just ( JS.OpBXor, left, right )

346− "shiftLeftBy" -> Just ( JS.OpLShift, right, left )

347− "shiftRightBy" -> Just ( JS.OpSpRShift, right, left )

348− "shiftRightZfBy" -> Just ( JS.OpZfRShift, right, left )

349− _ -> Nothing

350−

351−

352−bitwiseComplement :: Var.Canonical

353−bitwiseComplement =

354− Var.inCore "Bitwise" "complement"

355−

356−

357−basicsNot :: Var.Canonical

358−basicsNot =

359− Var.inCore "Basics" "not"

360−

361−

362−bitwise :: Var.Home

363−bitwise =

364− Var.Module (ModuleName.inCore "Bitwise")

365−

366−

367361

368362-- GENERATE IFS

369363

@@ -495,7 +489,7 @@ edgeToCase exprName labelRoot (test, subTree) =

495489testToExpr :: DT.Test -> JS.Expr

496490testToExpr test =

497491 case test of

498− DT.Constructor (Var.Canonical _ tag) ->

492+ DT.Constructor (V.Canonical _ tag) ->

499493 JS.String tag

500494

501495 DT.Literal (L.Chr char) ->

@@ -525,7 +519,7 @@ pathToTestableExpr root path exampleTest =

525519

526520pathToExpr :: Text -> DT.Path -> Opt.Expr

527521pathToExpr root fullPath =

528− go (Opt.Var (Var.local root)) fullPath

522+ go (Opt.VarLocal root) fullPath

529523 where

530524 go expr path =

531525 case path of

@@ -546,50 +540,36 @@ pathToExpr root fullPath =

546540-- BINARY OPERATORS

547541

548542

549−binop

550− :: Var.Canonical

551− -> Opt.Expr

552− -> Opt.Expr

553− -> State Int Code

554−binop func left right =

555− do jsLeft <- generateJsExpr left

556− jsRight <- generateJsExpr right

557− jsExpr (binopHelp func jsLeft jsRight)

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

544+generateBinop home op left right =

545+ do jsLeft <- generateJsExpr left

546+ jsRight <- generateJsExpr right

547+ jsExpr (generateBinopHelp home op jsLeft jsRight)

558548

559549

560550

561551-- BINARY OPERATOR HELPERS

562552

563553

564−binopHelp :: Var.Canonical -> JS.Expr -> JS.Expr -> JS.Expr

565−binopHelp qualifiedOp@(Var.Canonical home op) leftExpr rightExpr =

566− let

567− simpleMake left right =

568− JS.Call (ref "A2") [ Var.canonical qualifiedOp, left, right ]

569− in

570− if home == basicsModule then

571− (Map.findWithDefault simpleMake op basicOps) leftExpr rightExpr

572−

573− else if op == "::" && (home == listModule || home == listModuleInternals) then

574− BuiltIn.cons leftExpr rightExpr

575−

576− else

577− simpleMake leftExpr rightExpr

578−

579−

580−listModule :: Var.Home

581−listModule =

582− Var.Module (ModuleName.inCore "List")

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

555+generateBinopHelp home op leftExpr rightExpr =

556+ let

557+ simpleMake left right =

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

559+ in

560+ if home == basics then

561+ (Map.findWithDefault simpleMake op basicOps) leftExpr rightExpr

583562

563+ else if op == "::" && home == list then

564+ BuiltIn.cons leftExpr rightExpr

584565

585−listModuleInternals :: Var.Home

586−listModuleInternals =

587− Var.TopLevel (ModuleName.inCore "List")

566+ else

567+ simpleMake leftExpr rightExpr

588568

589569

590−basicsModule :: Var.Home

591−basicsModule =

592− Var.Module (ModuleName.inCore "Basics")

570+list :: ModuleName.Canonical

571+list =

572+ ModuleName.inCore "List"

593573

594574

595575basicOps :: Map.Map Text (JS.Expr -> JS.Expr -> JS.Expr)

src/Generate/JavaScript/Foreign.hs+10−9

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

1010import qualified AST.Expression.Optimized as Opt

1111import qualified AST.Literal as Literal

12+import qualified AST.Module.Name as ModuleName

1213import qualified AST.Type as T

1314import qualified AST.Variable as Var

1415import qualified Generate.JavaScript.Builder as JS

@@ -152,14 +153,14 @@ decode tipe =

152153-- DECODE HELPERS

153154

154155

155−inJsonDecode :: Text -> Var.Canonical

156−inJsonDecode name =

157− Var.inCore "Json.Decode" name

158−

159−

160156to :: Text -> Opt.Expr

161157to name =

162− Opt.Var (inJsonDecode name)

158+ Opt.VarGlobal jsonDecode name

159+

160+

161+jsonDecode :: ModuleName.Canonical

162+jsonDecode =

163+ ModuleName.inCore "Json.Decode"

163164

164165

165166field :: Text -> Opt.Expr -> Opt.Expr

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

185186toMaybe tipe =

186187 let

187188 maybe tag =

188− Opt.Var (Var.inCore "Maybe" tag)

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

189190 in

190191 to "oneOf" <==

191192 [ Opt.List

@@ -216,7 +217,7 @@ toTuple types =

216217 to "succeed" <==

217218 [ Opt.Ctor

218219 (Text.pack ("_Tuple" ++ show size))

219− (map (Opt.Var . Var.local . toVar . fst) pairs)

220+ (map (Opt.VarLocal . toVar . fst) pairs)

220221 ]

221222

222223 andThen (i, tipe) decoder =

@@ -229,7 +230,7 @@ toRecord :: [(Text, T.Canonical)] -> Opt.Expr

229230toRecord fields =

230231 let

231232 toFieldExpr (key, _) =

232− (key, Opt.Var (Var.local key))

233+ (key, Opt.VarLocal key)

233234

234235 finalDecoder =

235236 to "succeed" <== [ Opt.Record (map toFieldExpr fields) ]

src/Generate/JavaScript/Variable.hs+47−72

@@ -2,12 +2,13 @@

22{-# LANGUAGE OverloadedStrings #-}

33module Generate.JavaScript.Variable

44 ( fresh

5− , canonical

5+ , local

6+ , global

67 , qualified

78 , native

89 , coreNative

910 , staticProgram

10− , define

11+ , defineGlobal

1112 , safe

1213 )

1314 where

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

2021

2122import qualified AST.Helpers as Help

2223import qualified AST.Module.Name as ModuleName

23−import qualified AST.Variable as Var

2424import qualified Elm.Package as Pkg

2525import qualified Generate.JavaScript.Builder as JS

2626import qualified Generate.JavaScript.Helpers as JS

@@ -38,72 +38,24 @@ fresh =

3838

3939

4040

41−-- DEF NAMES

41+-- VARIABLES

4242

4343

44−define :: Maybe ModuleName.Canonical -> Text -> JS.Expr -> [JS.Stmt]

45−define maybeHome name body =

46− if not (Help.isOp name) then

47− let

48− jsName =

49− maybe unqualified qualified maybeHome name

50− in

51− [ JS.VarDeclStmt [ JS.varDecl jsName body ] ]

52−

53− else

54− case maybeHome of

55− Nothing ->

56− error "can only define infix operators at the top level"

57−

58− Just home ->

59− let

60− opsDictName =

61− getOpsDictName (Var.TopLevel home)

62−

63− lvalue =

64− JS.LBracket (JS.ref opsDictName) (JS.String name)

65− in

66− [ JS.VarDeclStmt [ JS.varDecl opsDictName (JS.refOrObject opsDictName) ]

67− , JS.ExprStmt (JS.Assign lvalue body)

68− ]

69−

70−

71−

72−-- INSTANTIATE VARIABLES

44+local :: Text -> JS.Expr

45+local name =

46+ JS.ref (safe name)

7347

7448

75−canonical :: Var.Canonical -> JS.Expr

76−canonical (Var.Canonical home name) =

49+global :: ModuleName.Canonical -> Text -> JS.Expr

50+global home name =

7751 if Help.isOp name then

78− JS.BracketRef (JS.ref (getOpsDictName home)) (JS.String name)

79−

52+ JS.BracketRef (JS.ref (opsDict home)) (JS.String name)

8053 else

81− case home of

82− Var.Local ->

83− JS.ref (unqualified name)

84−

85− Var.BuiltIn ->

86− JS.ref (unqualified name)

87−

88− Var.Module moduleName@(ModuleName.Canonical _ rawName) ->

89− if ModuleName.isNative rawName then

90− native moduleName name

91−

92− else

93− JS.ref (qualified moduleName name)

54+ JS.ref (qualified home name)

9455

95− Var.TopLevel moduleName ->

96− JS.ref (qualified moduleName name)

9756

9857

99−unqualified :: Text -> Text

100−unqualified =

101− safe

102−

103−

104−qualified :: ModuleName.Canonical -> Text -> Text

105−qualified moduleName name =

106− moduleToText moduleName <> "$" <> name

58+-- MISC

10759

10860

10961native :: ModuleName.Canonical -> Text -> JS.Expr

@@ -121,17 +73,39 @@ staticProgram =

12173 native (ModuleName.inVirtualDom "Native.VirtualDom") "staticProgram"

12274

12375

124−getOpsDictName :: Var.Home -> Text

125−getOpsDictName home =

126− let

127− moduleName =

128− case home of

129− Var.Local -> error "infix operators should only be defined in top-level declarations"

130− Var.BuiltIn -> error "there should be no built-in infix operators"

131− Var.Module name -> name

132− Var.TopLevel name -> name

133− in

134− moduleToText moduleName <> "_ops"

76+

77+-- DEFINE GLOBALS

78+

79+

80+defineGlobal :: ModuleName.Canonical -> Text -> JS.Expr -> [JS.Stmt]

81+defineGlobal home name body =

82+ case Help.isOp name of

83+ False ->

84+ [ JS.VarDeclStmt [ JS.varDecl (qualified home name) body ]

85+ ]

86+

87+ True ->

88+ let

89+ dict = opsDict home

90+ lvalue = JS.LBracket (JS.ref dict) (JS.String name)

91+ in

92+ [ JS.VarDeclStmt [ JS.varDecl dict (JS.refOrObject dict) ]

93+ , JS.ExprStmt (JS.Assign lvalue body)

94+ ]

95+

96+

97+

98+-- GLOBAL NAMES

99+

100+

101+qualified :: ModuleName.Canonical -> Text -> Text

102+qualified home name =

103+ moduleToText home <> "$" <> name

104+

105+

106+opsDict :: ModuleName.Canonical -> Text

107+opsDict home =

108+ moduleToText home <> "_ops"

135109

136110

137111moduleToText :: ModuleName.Canonical -> Text

@@ -155,7 +129,7 @@ moduleToText (ModuleName.Canonical (Pkg.Name user project) moduleName) =

155129

156130safe :: Text -> Text

157131safe name =

158− if Set.member name jsReserveds then "$" <> name else name

132+ if Set.member name jsReserveds then "_" <> name else name

159133

160134

161135jsReserveds :: Set.Set Text

@@ -175,4 +149,5 @@ jsReserveds =

175149 -- reserved by the Elm runtime system

176150 , "F2", "F3", "F4", "F5", "F6", "F7", "F8", "F9"

177151 , "A2", "A3", "A4", "A5", "A6", "A7", "A8", "A9"

152+ , "ctor"

178153 ]

src/Optimize.hs+57−29

@@ -55,7 +55,7 @@ optimizeDecl variantDict home index (Can.Def _ pattern@(A.A _ ptrn) expression _

5555 Env.run variantDict home $

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

5757 destructors =

58− destruct (Var.topLevel home name) pattern

58+ destruct (Opt.VarGlobal home name) pattern

5959 in

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

6161

@@ -81,7 +81,7 @@ optimizeLetDef (Can.Def _ pattern@(A.A _ ptrn) expression _) =

8181 (_, []) ->

8282 do name <- Env.freshName

8383 body <- optimizeExpr Nothing rawBody

84− return $ (name, Opt.Def body) : destruct (Var.local name) pattern

84+ return $ (name, Opt.Def body) : destruct (Opt.VarLocal name) pattern

8585

8686 _ ->

8787 error "bug manifesting in Optimize.optimizeLetDef, please report"

@@ -112,10 +112,10 @@ optimizeNamedDef name rawArgs rawBody =

112112 Opt.Def (Opt.Function args body)

113113

114114

115−destruct :: Var.Canonical -> P.Canonical -> [(Text, Opt.Def)]

116−destruct var pattern =

115+destruct :: Opt.Expr -> P.Canonical -> [(Text, Opt.Def)]

116+destruct root pattern =

117117 map (second Opt.Def) $

118− patternToSubstitutions (Opt.Var var) pattern

118+ patternToSubstitutions root pattern

119119

120120

121121

@@ -199,14 +199,8 @@ optimizeExpr context annExpr@(A.A region expression) =

199199 Can.Literal lit ->

200200 pure (Opt.Literal lit)

201201

202− Can.Var name ->

203− do Env.register name

204− if name == debugCrash

205− then

206− do home <- Env.getHome

207− pure (Opt.Crash home region Nothing)

208− else

209− pure (Opt.Var name)

202+ Can.Var var ->

203+ optimizeVariable region var

210204

211205 Can.List elements ->

212206 Opt.List

@@ -302,6 +296,33 @@ optimizeExpr context annExpr@(A.A region expression) =

302296

303297

304298

299+-- OPTIMIZE VARIABLE

300+

301+

302+optimizeVariable :: R.Region -> Var.Canonical -> Env.Optimizer Opt.Expr

303+optimizeVariable region (Var.Canonical home name) =

304+ case home of

305+ Var.BuiltIn ->

306+ pure (Opt.VarLocal name)

307+

308+ Var.Local ->

309+ pure (Opt.VarLocal name)

310+

311+ Var.TopLevel modul ->

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

313+ pure (Opt.VarGlobal modul name)

314+

315+ Var.Module modul ->

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

317+ if name == "crash" && modul == ModuleName.inCore "Debug"

318+ then

319+ do here <- Env.getHome

320+ pure (Opt.Crash here region Nothing)

321+ else

322+ pure (Opt.VarGlobal modul name)

323+

324+

325+

305326-- OPTIMIZE CASE BRANCHES

306327

307328

@@ -312,17 +333,13 @@ optimizeBranch

312333 -> (P.Canonical, Can.Expr)

313334 -> Env.Optimizer (P.Canonical, Opt.Expr)

314335optimizeBranch context region exprName (rawPattern, canBranch) =

315− let

316− root =

317− Opt.Var (Var.Canonical Var.Local exprName)

318− in

319− do optBranch <- optimizeExpr context canBranch

320− (pattern, branch) <- tagCrashBranch region rawPattern optBranch

336+ do optBranch <- optimizeExpr context canBranch

337+ (pattern, branch) <- tagCrashBranch region rawPattern optBranch

321338

322− let substitutions =

323− Map.fromList (patternToSubstitutions root pattern)

339+ let substitutions = Map.fromList $

340+ patternToSubstitutions (Opt.VarLocal exprName) pattern

324341

325− (,) pattern <$> Inline.inline substitutions branch

342+ (,) pattern <$> Inline.inline substitutions branch

326343

327344

328345tagCrashBranch

@@ -336,7 +353,7 @@ tagCrashBranch region pattern@(A.A pr _) expr =

336353 do name <- Env.freshName

337354 return

338355 ( A.A pr (P.Alias name pattern)

339− , Opt.Call (Opt.Crash home region (Just (Opt.Var (Var.local name)))) [arg]

356+ , Opt.Call (Opt.Crash home region (Just (Opt.VarLocal name))) [arg]

340357 )

341358

342359 _ ->

@@ -453,7 +470,7 @@ optimizeBinop context region op leftExpr rightExpr =

453470

454471 else

455472

456− Opt.Binop op

473+ makeOptBinop op

457474 <$> optimizeExpr Nothing leftExpr

458475 <*> optimizeExpr Nothing rightExpr

459476

@@ -487,11 +504,6 @@ cons =

487504 Var.Canonical Var.BuiltIn "::"

488505

489506

490−debugCrash :: Var.Canonical

491−debugCrash =

492− Var.inCore "Debug" "crash"

493−

494−

495507type Assoc =

496508 Can.Expr -> Can.Expr -> (Can.Expr, Can.Expr)

497509

@@ -517,3 +529,19 @@ collect makeRoot assoc desiredOp annExpr@(A.A ann expr) =

517529

518530 _ ->

519531 makeRoot annExpr

532+

533+

534+makeOptBinop :: Var.Canonical -> Opt.Expr -> Opt.Expr -> Opt.Expr

535+makeOptBinop (Var.Canonical home op) leftExpr rightExpr =

536+ case home of

537+ Var.Local ->

538+ error "bug manifesting in Optimize.makeOptBinop"

539+

540+ Var.BuiltIn ->

541+ error "bug manifesting in Optimize.makeOptBinop"

542+

543+ Var.Module name ->

544+ Opt.Binop name op leftExpr rightExpr

545+

546+ Var.TopLevel name ->

547+ Opt.Binop name op leftExpr rightExpr

src/Optimize/Environment.hs+3−14

@@ -106,20 +106,9 @@ freshName =

106106-- REGISTER DEPENDENCIES

107107

108108

109−register :: Var.Canonical -> Optimizer ()

110−register (Var.Canonical home name) =

111− case home of

112− Var.BuiltIn ->

113− return ()

114−

115− Var.Module realHome ->

116− State.modify (registerHelp (Var.Global realHome name))

117−

118− Var.TopLevel realHome ->

119− State.modify (registerHelp (Var.Global realHome name))

120−

121− Var.Local ->

122− return ()

109+register :: Var.Global -> Optimizer ()

110+register global =

111+ State.modify (registerHelp global)

123112

124113

125114registerHelp :: Var.Global -> Env -> Env

src/Optimize/Inline.hs+10−19

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

1010

1111import AST.Expression.Optimized (Expr(..), Decider(..), Choice(..))

1212import qualified AST.Expression.Optimized as Opt

13−import qualified AST.Variable as Var

1413import qualified Optimize.Environment as Env

1514

1615

@@ -49,7 +48,7 @@ processSubs (Subs subs defs) (name, (n, expr)) =

4948 else

5049 do uniqueName <- Env.freshName

5150 return $ Subs

52− (Map.insert name (Opt.Var (Var.local uniqueName)) subs)

51+ (Map.insert name (Opt.VarLocal uniqueName) subs)

5352 ((uniqueName, expr) : defs)

5453

5554

@@ -79,24 +78,16 @@ count expression =

7978 Literal _ ->

8079 Map.empty

8180

82− Var (Var.Canonical home name) ->

83− case home of

84− Var.Local ->

85− Map.singleton name 1

81+ VarLocal name ->

82+ Map.singleton name 1

8683

87− Var.BuiltIn ->

88− Map.empty

89−

90− Var.Module _ ->

91− Map.empty

92−

93− Var.TopLevel _ ->

94− Map.empty

84+ VarGlobal _ _ ->

85+ Map.empty

9586

9687 List exprs ->

9788 countMany exprs

9889

99− Binop _op left right ->

90+ Binop _ _ left right ->

10091 count2 left right

10192

10293 Function args body ->

@@ -194,17 +185,17 @@ replace substitutions expression =

194185 Literal _ ->

195186 expression

196187

197− Var (Var.Canonical Var.Local name) ->

188+ VarLocal name ->

198189 maybe expression id (Map.lookup name substitutions)

199190

200− Var _ ->

191+ VarGlobal _ _ ->

201192 expression

202193

203194 List exprs ->

204195 List (map go exprs)

205196

206− Binop op left right ->

207− Binop op (go left) (go right)

197+ Binop home op left right ->

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

208199

209200 Function args body ->

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