git.iko.soy/elk
on master help sign in
Better code gen for complex recursive values
e2a5157Evan Czaplicki
src/AST/Expression/Optimized.hs+6−5
compare with master
unifiedsplit
@@ -9,7 +9,7 @@ module AST.Expression.Optimized
9 where
9 where
10
10
11
11
12−import Control.Monad (liftM, liftM2, liftM3)
12+import Control.Monad (liftM, liftM2, liftM3, liftM4)
13import Data.Binary
13import Data.Binary
14import qualified Data.Set as Set
14import qualified Data.Set as Set
15import Data.Text (Text)
15import Data.Text (Text)
@@ -28,7 +28,8 @@ import qualified Reporting.Region as R
28
28
29data Decl =
29data Decl =
30 Decl
30 Decl
31+ { _direct :: Set.Set Var.Global
31− { _deps :: Set.Set Var.Global
32+ , _indirect :: Set.Set Var.Global
32 , _effects :: Maybe Effects.ManagerType
33 , _effects :: Maybe Effects.ManagerType
33 , _body :: !Def
34 , _body :: !Def
34 }
35 }
@@ -105,10 +106,10 @@ data Choice
105
106
106instance Binary Decl where
107instance Binary Decl where
107 get =
108 get =
108− liftM3 Decl get get get
109+ liftM4 Decl get get get get
109
110
110− put (Decl deps fx body) =
111+ put (Decl direct indirect fx body) =
111− put deps >> put fx >> put body
112+ put direct >> put indirect >> put fx >> put body
112
113
113
114
114instance Binary Def where
115instance 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 _)
88
88
89
89
90crawlDecl :: Graph -> Var.Global -> Opt.Decl -> State -> State
90crawlDecl :: 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 =
92 let
92 let
93− newState =
93+ state2 =
94− state { _seen = Set.insert var (_seen state) }
94+ state1 { _seen = Set.insert var (_seen state1) }
95
95
96 (State stmts seen kernels effects table) =
96 (State stmts seen kernels effects table) =
97− Set.foldl' (crawl graph) newState deps
97+ Set.foldl' (crawl graph) state2 direct
98
98
99 (stmt, newTable) =
99 (stmt, newTable) =
100 JS.run table (JS.generateDecl home name body)
100 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+ }
101 in
110 in
102− State
111+ Set.foldl' (crawl graph) state4 indirect
103− { _stmts = stmt : stmts
104− , _seen = seen
105− , _kernels = kernels
106− , _effects = maybe id (Map.insert home) fx effects
107− , _table = newTable
108− }
109
112
110
113
111crawlError :: Var.Global -> String
114crawlError :: Var.Global -> String
src/Optimize.hs+2−1
@@ -59,7 +59,7 @@ optimizeDecl variantDict home index (Can.Def _ pattern@(A.A _ ptrn) expression _
59 destructors =
59 destructors =
60 destruct (Opt.VarGlobal var) pattern
60 destruct (Opt.VarGlobal var) pattern
61 in
61 in
62− decl : map (second (Opt.Decl deps Nothing)) destructors
62+ decl : map (second (Opt.Decl deps Set.empty Nothing)) destructors
63
63
64 _ ->
64 _ ->
65 error "bug manifesting in Optimize.optimizeDecl, please report"
65 error "bug manifesting in Optimize.optimizeDecl, please report"
@@ -130,6 +130,7 @@ optimizeFunction
130 -> Can.Expr
130 -> Can.Expr
131 -> Env.Optimizer ([Text], Opt.Expr)
131 -> Env.Optimizer ([Text], Opt.Expr)
132optimizeFunction maybeName patterns givenBody =
132optimizeFunction maybeName patterns givenBody =
133+ Env.indirectly $
133 do (argNames, body) <- M.foldM depatternArgs ([], givenBody) (reverse patterns)
134 do (argNames, body) <- M.foldM depatternArgs ([], givenBody) (reverse patterns)
134 optBody <- optimizeExpr (makeContext argNames =<< maybeName) body
135 optBody <- optimizeExpr (makeContext argNames =<< maybeName) body
135 return (argNames, optBody)
136 return (argNames, optBody)
src/Optimize/Environment.hs+56−6
@@ -9,6 +9,7 @@ module Optimize.Environment
9 , freshName
9 , freshName
10 , register
10 , register
11 , registerEffects
11 , registerEffects
12+ , indirectly
12 )
13 )
13 where
14 where
14
15
@@ -34,13 +35,47 @@ data Env =
34 { _read_only_variants :: !DT.VariantDict
35 { _read_only_variants :: !DT.VariantDict
35 , _read_only_home :: !ModuleName.Canonical
36 , _read_only_home :: !ModuleName.Canonical
36 , _uid :: !Int
37 , _uid :: !Int
37− , _deps :: Set.Set Var.Global
38+ , _deps :: Deps
38 , _effects :: Maybe Effects.ManagerType
39 , _effects :: Maybe Effects.ManagerType
39 , _has_tail_call :: !Bool
40 , _has_tail_call :: !Bool
40 }
41 }
41
42
42
43
43
44
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+
44-- OPTIMIZER
79-- OPTIMIZER
45
80
46
81
@@ -55,11 +90,11 @@ run
55 -> (Text, Opt.Decl)
90 -> (Text, Opt.Decl)
56run variantDict home optimizer =
91run variantDict home optimizer =
57 let
92 let
58− ((name, def), Env _ _ _ deps fx _) =
93+ ((name, def), Env _ _ _ (Direct direct indirect) fx _) =
59 State.runState optimizer $
94 State.runState optimizer $
60− Env variantDict home 0 Set.empty Nothing False
95+ Env variantDict home 0 emptyDeps Nothing False
61 in
96 in
62− ( name, Opt.Decl deps fx def )
97+ ( name, Opt.Decl direct indirect fx def )
63
98
64
99
65
100
@@ -113,7 +148,22 @@ register global =
113
148
114registerHelp :: Var.Global -> Env -> Env
149registerHelp :: Var.Global -> Env -> Env
115registerHelp dep (Env vs home uid deps fx htc) =
150registerHelp 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
117
167
118
168
119
169
@@ -123,7 +173,7 @@ registerHelp dep (Env vs home uid deps fx htc) =
123registerEffects :: ModuleName.Canonical -> Effects.ManagerType -> Optimizer Effects.ManagerType
173registerEffects :: ModuleName.Canonical -> Effects.ManagerType -> Optimizer Effects.ManagerType
124registerEffects home manager =
174registerEffects home manager =
125 do (Env vs hm uid deps _ htc) <- State.get
175 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
127 State.put (Env vs hm uid newDeps (Just manager) htc)
177 State.put (Env vs hm uid newDeps (Just manager) htc)
128 return manager
178 return manager
129
179