ac43b4c · elk · git.iko.soy

git.iko.soy/elk

on master help sign in

Do not bother tracking substitutions in decision tree

ac43b4cEvan Czaplicki11 years ago

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

compare with master

unifiedsplit

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

1{-# OPTIONS_GHC -Wall #-}

2module AST.Expression.Optimized

3 ( Def(..), Facts(..), dummyFacts

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

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

5 ) where

7import qualified AST.Expression.General as General

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

47 | TailCall String [String] [Expr]

48 | If [(Expr, Expr)] Expr

49 | Let [Def] Expr

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

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

51 | Data String [Expr]

52 | DataAccess Expr Int

53 | Access Expr String

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

59 deriving (Eq)

62−data Jump

62+data Decision

63− = Inline Branch

63+ = Inline Expr

64 | Jump Int

65 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 =

310

311generateCase

312 :: String

313− -> DT.DecisionTree Opt.Jump

313+ -> DT.DecisionTree Opt.Decision

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

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

315 -> State Int [Statement ()]

316generateCase root decisionTree jumpBranches =

317 do decider <- generateDecisionTree root decisionTree

318 foldM (goto root) decider jumpBranches

319

320

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

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

322goto root decider (target, branch) =

323 let

324 deciderStmt =

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

326 (targetLabel root target)

327 (DoWhileStmt () (BlockStmt () decider) (BoolLit () False))

328 in

329− do stmts <- generateBranch root branch

329+ do code <- generateCode branch

330− return (deciderStmt : stmts)

330+ return (deciderStmt : toStatementList code)

331

332

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

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

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

336

337

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

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

339generateDecisionTree root decisionTree =

340 case decisionTree of

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

342− generateBranch root branch

342+ toStatementList <$> generateCode branch

343

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

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

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

368

369collapseTests

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

371− -> DT.DecisionTree Opt.Jump

371+ -> DT.DecisionTree Opt.Decision

372− -> DT.DecisionTree Opt.Jump

372+ -> DT.DecisionTree Opt.Decision

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

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

374collapseTests tests outerFallback decisionTree =

375 case decisionTree of

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

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

381 (tests, decisionTree)

382

383

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

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

385edgeToCaseClause root (test, subTree) =

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

387

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

410 Literal.literal lit

411

412

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

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

414fallbackToDefault root fallback =

415 case fallback of

416 Nothing ->

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

421 return [ CaseDefault () stmts ]

422

423

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−

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

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

440pathToExpr root fullPath =

425pathToExpr root fullPath =

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

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

src/Optimize/Patterns.hs+34−40

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

56inlinedCase

57 :: String

58− -> DT.DecisionTree DT.Jump

58+ -> DT.DecisionTree Int

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

60 -> Opt.Expr

61inlinedCase name decisionTree jumpTargets =

62 let

63− substitutionDict =

63+ targetCounts =

64− gatherSubstitutions decisionTree

64+ countTargets decisionTree

66− (jumps, sharedBranches) =

66+ (decisions, sharedBranches) =

67− unzip (map (toJumps substitutionDict) jumpTargets)

67+ unzip (map (toDecisions targetCounts) jumpTargets)

68 in

69 Opt.Case

70 name

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

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

72 (Maybe.catMaybes sharedBranches)

75−gatherSubstitutions

76− :: DT.DecisionTree DT.Jump

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

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

78−gatherSubstitutions decisionTree =

76+countTargets decisionTree =

79 case decisionTree of

77 case decisionTree of

80 DT.Decision _ edges fallback ->

78 DT.Decision _ edges fallback ->

81 map snd edges

79 map snd edges

82 |> maybe id (:) fallback

80 |> maybe id (:) fallback

83− |> map gatherSubstitutions

81+ |> map countTargets

84− |> Map.unionsWith (++)

82+ |> Map.unionsWith (+)

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

84+ DT.Match target ->

87− Map.singleton target [substitutions]

85+ Map.singleton target 1

90−toJumps

88+toDecisions

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

89+ :: Map.Map Int Int

92 -> (Int, Opt.Expr)

90 -> (Int, Opt.Expr)

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

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

94−toJumps substitutionDict (target, branch) =

92+toDecisions targetCounts (target, branch) =

95− case substitutionDict ! target of

93+ if targetCounts ! target == 1 then

96− [substitutions] ->

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

94+ ( (target, Opt.Inline branch)

98− , Nothing

95+ , Nothing

99− )

96+ )

100−

97+

101− substitutions : _ ->

98+ else

102− ( (target, Opt.Jump target)

99+ ( (target, Opt.Jump target)

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

100+ , Just (target, branch)

104− )

101+ )

105−

102+

106− _ ->

103+

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

104+inlineDecisions

108−

109−

110−inlineJumps

111− :: Map.Map Int Opt.Jump

105+ :: Map.Map Int Opt.Decision

112− -> DT.DecisionTree DT.Jump

106+ -> DT.DecisionTree Int

113− -> DT.DecisionTree Opt.Jump

107+ -> DT.DecisionTree Opt.Decision

114−inlineJumps jumpDict decisionTree =

108+inlineDecisions jumpDict decisionTree =

115 let

109 let

116 go =

110 go =

117− inlineJumps jumpDict

111+ inlineDecisions jumpDict

118 in

112 in

119 case decisionTree of

113 case decisionTree of

120 DT.Decision test edges fallback ->

114 DT.Decision test edges fallback ->

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

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

122

116

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

117+ DT.Match target ->

124 DT.Match (jumpDict ! target)

118 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

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

39of this module though.

40-}

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

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

42compile variantDict rawBranches =

43 let

44 format (pattern, index) =

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

76 deriving (Eq)

79−data Jump = Jump

80− { _result :: Int

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

82− }

83−

84−

85data Test

79data Test

86 = Constructor Var.Canonical

80 = Constructor Var.Canonical

87 | Literal L.Literal

81 | Literal L.Literal

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

131 }

125 }

132

126

133

127

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

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

135toDecisionTree variantDict rawBranches =

129toDecisionTree variantDict rawBranches =

136 let

130 let

137 branches =

131 branches =

138 map (flattenPatterns variantDict) rawBranches

132 map (flattenPatterns variantDict) rawBranches

139 in

133 in

140 case checkForMatch branches of

134 case checkForMatch branches of

141− Just (goal, substitutions) ->

135+ Just goal ->

142− Match (Jump goal substitutions)

136+ Match goal

143

137

144 Nothing ->

138 Nothing ->

145 let

139 let

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

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

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

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

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

242-}

236-}

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

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

244checkForMatch branches =

238checkForMatch branches =

245 case branches of

239 case branches of

246− Branch goal patterns : _ ->

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

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

241+ Just goal

248

242

249 _ ->

243 _ ->

250 Nothing

244 Nothing

251

245

252

246

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−

275-- GATHER OUTGOING EDGES

247-- GATHER OUTGOING EDGES

276

248

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

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