e2a5157 · elk · git.iko.soy

git.iko.soy/elk

Better code gen for complex recursive values

Probable fix for https://github.com/elm-lang/elm-compiler/issues/1591 The dependency graph for code generation now distinguishes between direct and indirect dependencies. - Direct dependencies are values that must exist to instantiate the current value. They must appear BEFORE the value. - Indirect dependencies are values hidden behind a lambda. Except in crazy code, they will not be needed for instantiation. They must appear AFTER the value. This distinction already exists in the canonicalization phase. At that point, we give you errors if you have a cycle of values without a lambda. So at that phase checked it was *possible* to generate good code, but did not actually generate according to those rules until this commit.

commite2a51574d3c4f1142139611cb359d0e68bb9541a authorEvan Czaplicki <evancz@users.noreply.github.com> dateMon 15 May 2017, 19:13 (9 years ago) parentf5bf4ad

4 files changed+78−23

compare with master

unifiedsplit

src/AST/Expression/Optimized.hs+6−5 src/Generate/JavaScript.hs+14−11 src/Optimize.hs+2−1 src/Optimize/Environment.hs+56−6

src/AST/Expression/Optimized.hs+6−5

@@ -9,7 +9,7 @@ module AST.Expression.Optimized

99 where

1010

1111

12−import Control.Monad (liftM, liftM2, liftM3)

12+import Control.Monad (liftM, liftM2, liftM3, liftM4)

1313import Data.Binary

1414import qualified Data.Set as Set

1515import Data.Text (Text)

@@ -28,7 +28,8 @@ import qualified Reporting.Region as R

2828

2929data Decl =

3030 Decl

31− { _deps :: Set.Set Var.Global

31+ { _direct :: Set.Set Var.Global

32+ , _indirect :: Set.Set Var.Global

3233 , _effects :: Maybe Effects.ManagerType

3334 , _body :: !Def

3435 }

@@ -105,10 +106,10 @@ data Choice

105106

106107instance Binary Decl where

107108 get =

108− liftM3 Decl get get get

109+ liftM4 Decl get get get get

109110

110− put (Decl deps fx body) =

111− put deps >> put fx >> put body

111+ put (Decl direct indirect fx body) =

112+ put direct >> put indirect >> put fx >> put body

112113

113114

114115instance Binary Def where

src/Generate/JavaScript.hs+14−11

@@ -88,24 +88,27 @@ crawl graph state@(State js seen kernels effects table) name@(Var.Global home _)

8888

8989

9090crawlDecl :: Graph -> Var.Global -> Opt.Decl -> State -> State

91−crawlDecl graph var@(Var.Global home name) (Opt.Decl deps fx body) state =

91+crawlDecl graph var@(Var.Global home name) (Opt.Decl direct indirect fx body) state1 =

9292 let

93− newState =

94− state { _seen = Set.insert var (_seen state) }

93+ state2 =

94+ state1 { _seen = Set.insert var (_seen state1) }

9595

9696 (State stmts seen kernels effects table) =

97− Set.foldl' (crawl graph) newState deps

97+ Set.foldl' (crawl graph) state2 direct

9898

9999 (stmt, newTable) =

100100 JS.run table (JS.generateDecl home name body)

101+

102+ state4 =

103+ State

104+ { _stmts = stmt : stmts

105+ , _seen = seen

106+ , _kernels = kernels

107+ , _effects = maybe id (Map.insert home) fx effects

108+ , _table = newTable

109+ }

101110 in

102− State

103− { _stmts = stmt : stmts

104− , _seen = seen

105− , _kernels = kernels

106− , _effects = maybe id (Map.insert home) fx effects

107− , _table = newTable

108− }

111+ Set.foldl' (crawl graph) state4 indirect

109112

110113

111114crawlError :: Var.Global -> String

src/Optimize.hs+2−1

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

5959 destructors =

6060 destruct (Opt.VarGlobal var) pattern

6161 in

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

62+ decl : map (second (Opt.Decl deps Set.empty Nothing)) destructors

6363

6464 _ ->

6565 error "bug manifesting in Optimize.optimizeDecl, please report"

@@ -130,6 +130,7 @@ optimizeFunction

130130 -> Can.Expr

131131 -> Env.Optimizer ([Text], Opt.Expr)

132132optimizeFunction maybeName patterns givenBody =

133+ Env.indirectly $

133134 do (argNames, body) <- M.foldM depatternArgs ([], givenBody) (reverse patterns)

134135 optBody <- optimizeExpr (makeContext argNames =<< maybeName) body

135136 return (argNames, optBody)

src/Optimize/Environment.hs+56−6

@@ -9,6 +9,7 @@ module Optimize.Environment

99 , freshName

1010 , register

1111 , registerEffects

12+ , indirectly

1213 )

1314 where

1415

@@ -34,13 +35,47 @@ data Env =

3435 { _read_only_variants :: !DT.VariantDict

3536 , _read_only_home :: !ModuleName.Canonical

3637 , _uid :: !Int

37− , _deps :: Set.Set Var.Global

38+ , _deps :: Deps

3839 , _effects :: Maybe Effects.ManagerType

3940 , _has_tail_call :: !Bool

4041 }

4142

4243

4344

45+-- DEPS

46+

47+

48+data Deps

49+ = Direct { _direct :: Set.Set Var.Global, _indirect :: Set.Set Var.Global }

50+ | Indirect (Set.Set Var.Global)

51+

52+

53+emptyDeps :: Deps

54+emptyDeps =

55+ Direct Set.empty Set.empty

56+

57+

58+insertDep :: Var.Global -> Deps -> Deps

59+insertDep var deps =

60+ case deps of

61+ Direct direct indirect ->

62+ Direct (Set.insert var direct) indirect

63+

64+ Indirect indirect ->

65+ Indirect (Set.insert var indirect)

66+

67+

68+unionDeps :: Set.Set Var.Global -> Deps -> Deps

69+unionDeps vars deps =

70+ case deps of

71+ Direct direct indirect ->

72+ Direct (Set.union vars direct) indirect

73+

74+ Indirect indirect ->

75+ Indirect (Set.union vars indirect)

76+

77+

78+

4479-- OPTIMIZER

4580

4681

@@ -55,11 +90,11 @@ run

5590 -> (Text, Opt.Decl)

5691run variantDict home optimizer =

5792 let

58− ((name, def), Env _ _ _ deps fx _) =

93+ ((name, def), Env _ _ _ (Direct direct indirect) fx _) =

5994 State.runState optimizer $

60− Env variantDict home 0 Set.empty Nothing False

95+ Env variantDict home 0 emptyDeps Nothing False

6196 in

62− ( name, Opt.Decl deps fx def )

97+ ( name, Opt.Decl direct indirect fx def )

6398

6499

65100

@@ -113,7 +148,22 @@ register global =

113148

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

115150registerHelp dep (Env vs home uid deps fx htc) =

116− Env vs home uid (Set.insert dep deps) fx htc

151+ Env vs home uid (insertDep dep deps) fx htc

152+

153+

154+indirectly :: Optimizer a -> Optimizer a

155+indirectly optimizer =

156+ do (Env vs home uid deps fx htc) <- State.get

157+ case deps of

158+ Indirect _ ->

159+ optimizer

160+

161+ Direct direct indirect ->

162+ do State.put (Env vs home uid (Indirect indirect) fx htc)

163+ result <- optimizer

164+ (Env vs_ home_ uid_ (Indirect indirect_) fx_ htc_) <- State.get

165+ State.put (Env vs_ home_ uid_ (Direct direct indirect_) fx_ htc_)

166+ return result

117167

118168

119169

@@ -123,7 +173,7 @@ registerHelp dep (Env vs home uid deps fx htc) =

123173registerEffects :: ModuleName.Canonical -> Effects.ManagerType -> Optimizer Effects.ManagerType

124174registerEffects home manager =

125175 do (Env vs hm uid deps _ htc) <- State.get

126− let newDeps = Set.union deps (getEffectDeps home manager)

176+ let newDeps = unionDeps (getEffectDeps home manager) deps

127177 State.put (Env vs hm uid newDeps (Just manager) htc)

128178 return manager

129179