ac43b4c · elk · git.iko.soy

git.iko.soy/elk

Do not bother tracking substitutions in decision tree

This is only really necessary if you have “shared” patterns like in OCaml

commitac43b4c5b841f2c3ed4f34545d28a57cacfb3d4d authorEvan Czaplicki <info@elm-lang.org> dateFri 9 Oct 2015, 00:54 (11 years ago) parent59087d9

4 files changed+57−113

compare with master

unifiedsplit

src/AST/Expression/Optimized.hs+4−11 src/Generate/JavaScript/Expression.hs+12−27 src/Optimize/Patterns.hs+34−40 src/Optimize/Patterns/DecisionTree.hs+7−35

src/AST/Expression/Optimized.hs+4−11

@@ -1,7 +1,7 @@

11{-# OPTIONS_GHC -Wall #-}

22module AST.Expression.Optimized

33 ( Def(..), Facts(..), dummyFacts

4− , Expr(..), Jump(..), Branch(..)

4+ , Expr(..), Decision(..)

55 ) where

77import qualified AST.Expression.General as General

@@ -47,7 +47,7 @@ data Expr

4747 | TailCall String [String] [Expr]

4848 | If [(Expr, Expr)] Expr

4949 | Let [Def] Expr

50− | Case String (DT.DecisionTree Jump) [(Int, Branch)]

50+ | Case String (DT.DecisionTree Decision) [(Int, Expr)]

5151 | Data String [Expr]

5252 | DataAccess Expr Int

5353 | Access Expr String

@@ -59,14 +59,7 @@ data Expr

5959 deriving (Eq)

6060

6161

62−data Jump

63− = Inline Branch

62+data Decision

63+ = Inline Expr

6464 | Jump Int

6565 deriving (Eq)

66−

67−

68−data Branch = Branch

69− { _substitutions :: [(String, DT.Path)]

70− , _branch :: Expr

71− }

72− deriving (Eq)

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

@@ -310,15 +310,15 @@ crushIfsHelp visitedBranches unvisitedBranches finally =

310310

311311generateCase

312312 :: String

313− -> DT.DecisionTree Opt.Jump

314− -> [(Int, Opt.Branch)]

313+ -> DT.DecisionTree Opt.Decision

314+ -> [(Int, Opt.Expr)]

315315 -> State Int [Statement ()]

316316generateCase root decisionTree jumpBranches =

317317 do decider <- generateDecisionTree root decisionTree

318318 foldM (goto root) decider jumpBranches

319319

320320

321−goto :: String -> [Statement ()] -> (Int, Opt.Branch) -> State Int [Statement ()]

321+goto :: String -> [Statement ()] -> (Int, Opt.Expr) -> State Int [Statement ()]

322322goto root decider (target, branch) =

323323 let

324324 deciderStmt =

@@ -326,8 +326,8 @@ goto root decider (target, branch) =

326326 (targetLabel root target)

327327 (DoWhileStmt () (BlockStmt () decider) (BoolLit () False))

328328 in

329− do stmts <- generateBranch root branch

330− return (deciderStmt : stmts)

329+ do code <- generateCode branch

330+ return (deciderStmt : toStatementList code)

331331

332332

333333targetLabel :: String -> Int -> Id ()

@@ -335,11 +335,11 @@ targetLabel root target =

335335 Id () (root ++ "_" ++ show target)

336336

337337

338−generateDecisionTree :: String -> DT.DecisionTree Opt.Jump -> State Int [Statement ()]

338+generateDecisionTree :: String -> DT.DecisionTree Opt.Decision -> State Int [Statement ()]

339339generateDecisionTree root decisionTree =

340340 case decisionTree of

341341 DT.Match (Opt.Inline branch) ->

342− generateBranch root branch

342+ toStatementList <$> generateCode branch

343343

344344 DT.Match (Opt.Jump target) ->

345345 return [ BreakStmt () (Just (targetLabel root target)) ]

@@ -368,9 +368,9 @@ generateDecisionTree root decisionTree =

368368

369369collapseTests

370370 :: [(DT.Path, DT.Test)]

371− -> DT.DecisionTree Opt.Jump

372− -> DT.DecisionTree Opt.Jump

373− -> ([(DT.Path, DT.Test)], DT.DecisionTree Opt.Jump)

371+ -> DT.DecisionTree Opt.Decision

372+ -> DT.DecisionTree Opt.Decision

373+ -> ([(DT.Path, DT.Test)], DT.DecisionTree Opt.Decision)

374374collapseTests tests outerFallback decisionTree =

375375 case decisionTree of

376376 DT.Decision testPath [(test, subTree)] (Just fallback)

@@ -381,7 +381,7 @@ collapseTests tests outerFallback decisionTree =

381381 (tests, decisionTree)

382382

383383

384−edgeToCaseClause :: String -> (DT.Test, DT.DecisionTree Opt.Jump) -> State Int (CaseClause ())

384+edgeToCaseClause :: String -> (DT.Test, DT.DecisionTree Opt.Decision) -> State Int (CaseClause ())

385385edgeToCaseClause root (test, subTree) =

386386 CaseClause () (testToExpr test) <$> generateDecisionTree root subTree

387387

@@ -410,7 +410,7 @@ testToExpr test =

410410 Literal.literal lit

411411

412412

413−fallbackToDefault :: String -> Maybe (DT.DecisionTree Opt.Jump) -> State Int [CaseClause ()]

413+fallbackToDefault :: String -> Maybe (DT.DecisionTree Opt.Decision) -> State Int [CaseClause ()]

414414fallbackToDefault root fallback =

415415 case fallback of

416416 Nothing ->

@@ -421,21 +421,6 @@ fallbackToDefault root fallback =

421421 return [ CaseDefault () stmts ]

422422

423423

424−generateBranch :: String -> Opt.Branch -> State Int [Statement ()]

425−generateBranch root (Opt.Branch substitutions expr) =

426− do substs <- mapM (loadPath root) substitutions

427− let substStmts =

428− if null substs then [] else [ VarDeclStmt () substs ]

429− code <- generateCode expr

430− return (substStmts ++ toStatementList code)

431−

432−

433−loadPath :: String -> (String, DT.Path) -> State Int (VarDecl ())

434−loadPath root (name, path) =

435− do jsAccessExpr <- generateJsExpr (pathToExpr root path)

436− return $ varDecl (Var.safe name) jsAccessExpr

437−

438−

439424pathToExpr :: String -> DT.Path -> Opt.Expr

440425pathToExpr root fullPath =

441426 go (Opt.Var (Var.local root)) fullPath

src/Optimize/Patterns.hs+34−40

@@ -55,70 +55,64 @@ optimize variantDict region optExpr optBranches =

5555

5656inlinedCase

5757 :: String

58− -> DT.DecisionTree DT.Jump

58+ -> DT.DecisionTree Int

5959 -> [(Int, Opt.Expr)]

6060 -> Opt.Expr

6161inlinedCase name decisionTree jumpTargets =

6262 let

63− substitutionDict =

64− gatherSubstitutions decisionTree

63+ targetCounts =

64+ countTargets decisionTree

6565

66− (jumps, sharedBranches) =

67− unzip (map (toJumps substitutionDict) jumpTargets)

66+ (decisions, sharedBranches) =

67+ unzip (map (toDecisions targetCounts) jumpTargets)

6868 in

6969 Opt.Case

7070 name

71− (inlineJumps (Map.fromList jumps) decisionTree)

71+ (inlineDecisions (Map.fromList decisions) decisionTree)

7272 (Maybe.catMaybes sharedBranches)

7373

7474

75−gatherSubstitutions

76− :: DT.DecisionTree DT.Jump

77− -> Map.Map Int [[(String, DT.Path)]]

78−gatherSubstitutions decisionTree =

75+countTargets :: DT.DecisionTree Int -> Map.Map Int Int

76+countTargets decisionTree =

7977 case decisionTree of

8078 DT.Decision _ edges fallback ->

8179 map snd edges

8280 |> maybe id (:) fallback

83− |> map gatherSubstitutions

84− |> Map.unionsWith (++)

81+ |> map countTargets

82+ |> Map.unionsWith (+)

8583

86− DT.Match (DT.Jump target substitutions) ->

87− Map.singleton target [substitutions]

84+ DT.Match target ->

85+ Map.singleton target 1

8886

8987

90−toJumps

91− :: Map.Map Int [[(String, DT.Path)]]

88+toDecisions

89+ :: Map.Map Int Int

9290 -> (Int, Opt.Expr)

93− -> ( (Int, Opt.Jump), Maybe (Int, Opt.Branch) )

94−toJumps substitutionDict (target, branch) =

95− case substitutionDict ! target of

96− [substitutions] ->

97− ( (target, Opt.Inline (Opt.Branch substitutions branch))

98− , Nothing

99− )

100−

101− substitutions : _ ->

102− ( (target, Opt.Jump target)

103− , Just (target, Opt.Branch substitutions branch)

104− )

105−

106− _ ->

107− error "it is not possible for there to be no substitutions"

108−

109−

110−inlineJumps

111− :: Map.Map Int Opt.Jump

112− -> DT.DecisionTree DT.Jump

113− -> DT.DecisionTree Opt.Jump

114−inlineJumps jumpDict decisionTree =

91+ -> ( (Int, Opt.Decision), Maybe (Int, Opt.Expr) )

92+toDecisions targetCounts (target, branch) =

93+ if targetCounts ! target == 1 then

94+ ( (target, Opt.Inline branch)

95+ , Nothing

96+ )

97+

98+ else

99+ ( (target, Opt.Jump target)

100+ , Just (target, branch)

101+ )

102+

103+

104+inlineDecisions

105+ :: Map.Map Int Opt.Decision

106+ -> DT.DecisionTree Int

107+ -> DT.DecisionTree Opt.Decision

108+inlineDecisions jumpDict decisionTree =

115109 let

116110 go =

117− inlineJumps jumpDict

111+ inlineDecisions jumpDict

118112 in

119113 case decisionTree of

120114 DT.Decision test edges fallback ->

121115 DT.Decision test (map (second go) edges) (fmap go fallback)

122116

123− DT.Match (DT.Jump target _) ->

117+ DT.Match target ->

124118 DT.Match (jumpDict ! target)

src/Optimize/Patterns/DecisionTree.hs+7−35

@@ -38,7 +38,7 @@ If 2 or more leaves point to the same label, we need to do some tricks in JS to

3838make that work nicely. When is JS getting goto?! ;) That is outside the scope

3939of this module though.

4040-}

41−compile :: VariantDict -> [(CPattern, Int)] -> DecisionTree Jump

41+compile :: VariantDict -> [(CPattern, Int)] -> DecisionTree Int

4242compile variantDict rawBranches =

4343 let

4444 format (pattern, index) =

@@ -76,12 +76,6 @@ data DecisionTree a

7676 deriving (Eq)

7777

7878

79−data Jump = Jump

80− { _result :: Int

81− , _substitutions :: [(String, Path)]

82− }

83−

84−

8579data Test

8680 = Constructor Var.Canonical

8781 | Literal L.Literal

@@ -131,15 +125,15 @@ data Branch =

131125 }

132126

133127

134−toDecisionTree :: VariantDict -> [Branch] -> DecisionTree Jump

128+toDecisionTree :: VariantDict -> [Branch] -> DecisionTree Int

135129toDecisionTree variantDict rawBranches =

136130 let

137131 branches =

138132 map (flattenPatterns variantDict) rawBranches

139133 in

140134 case checkForMatch branches of

141− Just (goal, substitutions) ->

142− Match (Jump goal substitutions)

135+ Just goal ->

136+ Match goal

143137

144138 Nothing ->

145139 let

@@ -240,38 +234,16 @@ path. If that is the case we give the resulting label and a mapping from free

240234variables to "how to get their value". So a pattern like (Just (x,_)) will give

241235us something like ("x" => value.0.0)

242236-}

243−checkForMatch :: [Branch] -> Maybe (Int, [(String, Path)])

237+checkForMatch :: [Branch] -> Maybe Int

244238checkForMatch branches =

245239 case branches of

246− Branch goal patterns : _ ->

247− (,) goal `fmap` concat `fmap` mapM getSubstitution patterns

240+ Branch goal patterns : _ | all (not . needsTests . snd) patterns ->

241+ Just goal

248242

249243 _ ->

250244 Nothing

251245

252246

253−getSubstitution :: (Path, CPattern) -> Maybe [(String, Path)]

254−getSubstitution (path, A.A _ pattern) =

255− case pattern of

256− P.Var x ->

257− Just [(x, path)]

258−

259− P.Anything ->

260− Just []

261−

262− P.Alias _ _ ->

263− error "aliases should never reach 'getSubstitution' function"

264−

265− P.Record fields ->

266− Just (map (\name -> (name, add path (Field name Empty))) fields)

267−

268− P.Data _ _ ->

269− Nothing

270−

271− P.Literal _ ->

272− Nothing

273−

274−

275247-- GATHER OUTGOING EDGES

276248

277249gatherEdges :: VariantDict -> [Branch] -> Path -> ([(Test, [Branch])], [Branch])