1c20cb3 · elk · git.iko.soy

git.iko.soy/elk

Properly display the "problematic value" for case-branches with crashes

commit1c20cb31226991251ac83ad278af3169c92bef02 authorEvan Czaplicki <info@elm-lang.org> dateFri 23 Oct 2015, 15:19 (11 years ago) parentc64aa8e

6 files changed+51−56

compare with master

unifiedsplit

src/AST/Expression/Optimized.hs+1−1 src/Generate/JavaScript/BuiltIn.hs+2−2 src/Generate/JavaScript/Expression.hs+3−2 src/Optimize.hs+29−8 src/Optimize/Case.hs+9−39 src/Optimize/Inline.hs+7−4

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

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

5454 | Record [(String, Expr)]

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

5656 | GLShader String String Literal.GLShaderTipe

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

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

5858

5959

6060data Decider a

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

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

7272-- CRASH

7373

7474

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

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

7676crash home region maybeCaseCrashValue =

7777 let

7878 homeString =

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

8383 utils "crash" [ homeString, regionToJs region ]

8484

8585 Just crashValue ->

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

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

8787

8888

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

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

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

209209 do expr' <- generateJsExpr expr

210210 jsExpr (Port.task name expr' portType)

211211

212− Crash home region maybeCaseCrashValue ->

213− jsExpr $ BuiltIn.crash home region maybeCaseCrashValue

212+ Crash home region maybeBranchProblem ->

213+ do maybeOptBranchProblem <- traverse generateJsExpr maybeBranchProblem

214+ jsExpr $ BuiltIn.crash home region maybeOptBranchProblem

214215

215216

216217-- FUNCTIONS

src/Optimize.hs+29−8

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

280280 variantDict <- Env.getVariantDict

281281

282282 name <- Env.freshName

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

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

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

284+ let optCase = Case.optimize variantDict name optBranches

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

286286

287287 Expr.Data name exprs ->

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

326326

327327optimizeBranch

328328 :: Context

329+ -> R.Region

329330 -> String

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

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

332−optimizeBranch context exprName (pattern, canonicalExpr) =

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

333334 let

334335 root =

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

336−

337− substitutions =

338− Map.fromList (patternToSubstitutions root pattern)

339337 in

340− do optExpr <- optimizeExpr context canonicalExpr

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

338+ do optBranch <- optimizeExpr context canBranch

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

340+

341+ let substitutions =

342+ Map.fromList (patternToSubstitutions root pattern)

343+

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)

342363

343364

344365-- DETECT TAIL CALL

src/Optimize/Case.hs+9−39

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

99import qualified AST.Expression.Optimized as Opt

1010import qualified AST.Pattern as P

1111import 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

1512

1613

1714

1815-- OPTIMIZE A CASE EXPRESSION

1916

2017

21−optimize

22− :: DT.VariantDict

23− -> R.Region

24− -> String

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

26− -> Env.Optimizer Opt.Expr

27−optimize variantDict region exprName optBranches =

28− do crashBranches <-

29− mapM (tagCrashBranches region) optBranches

30−

31− let (patterns, indexedBranches) =

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

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− )

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

19+optimize variantDict exprName optBranches =

20+ let

21+ (patterns, indexedBranches) =

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

5223

53− _ ->

54− return branch

24+ decisionTree =

25+ DT.compile variantDict patterns

26+ in

27+ treeToExpr exprName decisionTree indexedBranches

5528

5629

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

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

198171 Opt.FanOut path tests fallback ->

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

200173

201−

202−

203−

src/Optimize/Inline.hs+7−4

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

1313import qualified Optimize.Environment as Env

1414

1515

16+

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

1718inline rawSubs expression =

1819 let

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

178179 GLShader _ _ _ ->

179180 Map.empty

180181

181− Crash _ _ _ ->

182− Map.empty

182+ Crash _ _ maybeBranchProblem ->

183+ maybe Map.empty count maybeBranchProblem

184+

183185

184186

185187-- REPLACE

186188

189+

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

188191replace substitutions expression =

189192 let

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

287290 GLShader _ _ _ ->

288291 expression

289292

290− Crash _ _ _ ->

291− expression

293+ Crash home region maybeBranchProblem ->

294+ Crash home region (fmap go maybeBranchProblem)