1c20cb3 · elk · git.iko.soy

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

compare with master

unifiedsplit

@@ -54,7 +54,7 @@ data Expr

54 | Record [(String, Expr)]

55 | Port (General.PortImpl Expr Type.Canonical)

56 | GLShader String String Literal.GLShaderTipe

57− | Crash ModuleName.Canonical R.Region (Maybe String)

57+ | Crash ModuleName.Canonical R.Region (Maybe Expr)

58

59

60data Decider a

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

@@ -72,7 +72,7 @@ cmp left right =

72-- CRASH

73

74

75−crash :: ModuleName.Canonical -> R.Region -> Maybe String -> JS.Expression ()

75+crash :: ModuleName.Canonical -> R.Region -> Maybe (JS.Expression ()) -> JS.Expression ()

76crash home region maybeCaseCrashValue =

77 let

78 homeString =

@@ -83,7 +83,7 @@ crash home region maybeCaseCrashValue =

83 utils "crash" [ homeString, regionToJs region ]

84

85 Just crashValue ->

86− utils "caseCrash" [ homeString, regionToJs region, ref crashValue ]

86+ utils "crashCase" [ homeString, regionToJs region, crashValue ]

87

88

89regionToJs :: R.Region -> JS.Expression ()

src/Generate/JavaScript/Expression.hs+3−2

@@ -209,8 +209,9 @@ generateCode expr =

209 do expr' <- generateJsExpr expr

210 jsExpr (Port.task name expr' portType)

211

212− Crash home region maybeCaseCrashValue ->

212+ Crash home region maybeBranchProblem ->

213+ do maybeOptBranchProblem <- traverse generateJsExpr maybeBranchProblem

213− jsExpr $ BuiltIn.crash home region maybeCaseCrashValue

214+ jsExpr $ BuiltIn.crash home region maybeOptBranchProblem

214

215

216

216-- FUNCTIONS

217-- FUNCTIONS

src/Optimize.hs+29−8

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

280 variantDict <- Env.getVariantDict

281

282 name <- Env.freshName

283− optBranches <- T.traverse (optimizeBranch context name) branches

283+ optBranches <- T.traverse (optimizeBranch context region name) branches

284− optCase <- Case.optimize variantDict region name optBranches

284+ let optCase = Case.optimize variantDict name optBranches

285 return $ Opt.Let [ Opt.Def Opt.dummyFacts name optExpr ] optCase

286

287 Expr.Data name exprs ->

@@ -326,19 +326,40 @@ mapSnd func (x, a) =

326

327optimizeBranch

328 :: Context

329+ -> R.Region

329 -> String

330 -> String

330 -> (P.CanonicalPattern, Can.Expr)

331 -> (P.CanonicalPattern, Can.Expr)

331 -> Env.Optimizer (P.CanonicalPattern, Opt.Expr)

332 -> Env.Optimizer (P.CanonicalPattern, Opt.Expr)

332−optimizeBranch context exprName (pattern, canonicalExpr) =

333+optimizeBranch context region exprName (rawPattern, canBranch) =

333 let

334 let

334 root =

335 root =

335 Opt.Var (Var.Canonical Var.Local exprName)

336 Opt.Var (Var.Canonical Var.Local exprName)

336−

337− substitutions =

338− Map.fromList (patternToSubstitutions root pattern)

339 in

337 in

340− do optExpr <- optimizeExpr context canonicalExpr

338+ do optBranch <- optimizeExpr context canBranch

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

340+

341+ let substitutions =

342+ Map.fromList (patternToSubstitutions root pattern)

343+

341− (,) pattern <$> Inline.inline substitutions optExpr

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

345+

346+

347+tagCrashBranch

348+ :: R.Region

349+ -> P.CanonicalPattern

350+ -> Opt.Expr

351+ -> Env.Optimizer (P.CanonicalPattern, Opt.Expr)

352+tagCrashBranch region pattern@(A.A pr _) expr =

353+ case expr of

354+ Opt.Call (Opt.Crash home _ _) [arg] ->

355+ do name <- Env.freshName

356+ return

357+ ( A.A pr (P.Alias name pattern)

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

359+ )

360+

361+ _ ->

362+ return (pattern, expr)

342

363

343

364

344-- DETECT TAIL CALL

365-- DETECT TAIL CALL

src/Optimize/Case.hs+9−39

@@ -9,49 +9,22 @@ import qualified Data.Maybe as Maybe

9import qualified AST.Expression.Optimized as Opt

10import qualified AST.Pattern as P

11import qualified Optimize.DecisionTree as DT

12−import qualified Optimize.Environment as Env

13−import qualified Reporting.Annotation as A

14−import qualified Reporting.Region as R

15

12

16

13

17

14

18-- OPTIMIZE A CASE EXPRESSION

15-- OPTIMIZE A CASE EXPRESSION

19

16

20

17

21−optimize

22− :: DT.VariantDict

23− -> R.Region

24− -> String

25− -> [(P.CanonicalPattern, Opt.Expr)]

18+optimize :: DT.VariantDict -> String -> [(P.CanonicalPattern, Opt.Expr)] -> Opt.Expr

26− -> Env.Optimizer Opt.Expr

27−optimize variantDict region exprName optBranches =

19+optimize variantDict exprName optBranches =

28− do crashBranches <-

20+ let

29− mapM (tagCrashBranches region) optBranches

30−

31− let (patterns, indexedBranches) =

21+ (patterns, indexedBranches) =

32− unzip (zipWith indexify [0..] crashBranches)

22+ unzip (zipWith indexify [0..] optBranches)

33−

34− let decisionTree =

35− DT.compile variantDict patterns

36−

37− return (treeToExpr exprName decisionTree indexedBranches)

38−

39−

40−tagCrashBranches

41− :: R.Region

42− -> (P.CanonicalPattern, Opt.Expr)

43− -> Env.Optimizer (P.CanonicalPattern, Opt.Expr)

44−tagCrashBranches region branch@(pattern@(A.A pr _), expr) =

45− case expr of

46− Opt.Call (Opt.Crash home _ _) [arg] ->

47− do name <- Env.freshName

48− return

49− ( A.A pr (P.Alias name pattern)

50− , Opt.Call (Opt.Crash home region (Just name)) [arg]

51− )

52

23

53− _ ->

24+ decisionTree =

54− return branch

25+ DT.compile variantDict patterns

26+ in

27+ treeToExpr exprName decisionTree indexedBranches

55

28

56

29

57indexify :: Int -> (a,b) -> ((a,Int), (Int,b))

30indexify :: Int -> (a,b) -> ((a,Int), (Int,b))

@@ -198,6 +171,3 @@ insertChoices choiceDict decider =

198 Opt.FanOut path tests fallback ->

171 Opt.FanOut path tests fallback ->

199 Opt.FanOut path (map (second go) tests) (go fallback)

172 Opt.FanOut path (map (second go) tests) (go fallback)

200

173

201−

202−

203−

src/Optimize/Inline.hs+7−4

@@ -13,6 +13,7 @@ import qualified AST.Variable as Var

13import qualified Optimize.Environment as Env

14

15

16+

16inline :: Map.Map String Opt.Expr -> Opt.Expr -> Env.Optimizer Opt.Expr

17inline :: Map.Map String Opt.Expr -> Opt.Expr -> Env.Optimizer Opt.Expr

17inline rawSubs expression =

18inline rawSubs expression =

18 let

19 let

@@ -178,12 +179,14 @@ count expression =

178 GLShader _ _ _ ->

179 GLShader _ _ _ ->

179 Map.empty

180 Map.empty

180

181

181− Crash _ _ _ ->

182+ Crash _ _ maybeBranchProblem ->

182− Map.empty

183+ maybe Map.empty count maybeBranchProblem

184+

183

185

184

186

185-- REPLACE

187-- REPLACE

186

188

189+

187replace :: Map.Map String Opt.Expr -> Opt.Expr -> Opt.Expr

190replace :: Map.Map String Opt.Expr -> Opt.Expr -> Opt.Expr

188replace substitutions expression =

191replace substitutions expression =

189 let

192 let

@@ -287,5 +290,5 @@ replace substitutions expression =

287 GLShader _ _ _ ->

290 GLShader _ _ _ ->

288 expression

291 expression

289

292

290− Crash _ _ _ ->

293+ Crash home region maybeBranchProblem ->

291− expression

294+ Crash home region (fmap go maybeBranchProblem)