git.iko.soy/elk
on master help sign in
cosmetic: modernize whitespace
98f4b61Evan Czaplicki
src/Canonicalize/Sort.hs+102−92
compare with master
unifiedsplit
@@ -14,8 +14,10 @@ import qualified AST.Variable as V
14import qualified Reporting.Annotation as A
14import qualified Reporting.Annotation as A
15
15
16
16
17+
17-- STARTING POINT
18-- STARTING POINT
18
19
20+
19definitions :: Canonical.Expr -> Canonical.Expr
21definitions :: Canonical.Expr -> Canonical.Expr
20definitions expression =
22definitions expression =
21 evalState (reorder expression) Set.empty
23 evalState (reorder expression) Set.empty
@@ -35,133 +37,137 @@ freeIfLocal (V.Canonical home name) =
35 V.Module _ -> return ()
37 V.Module _ -> return ()
36
38
37
39
40+
38-- REORDER EXPRESSIONS
41-- REORDER EXPRESSIONS
39
42
43+
40reorder :: Canonical.Expr -> State (Set.Set String) Canonical.Expr
44reorder :: Canonical.Expr -> State (Set.Set String) Canonical.Expr
41reorder (A.A ann expression) =
45reorder (A.A ann expression) =
42− A.A ann <$>
46+ A.A ann <$>
43− case expression of
47+ case expression of
44− -- Be careful adding and restricting freeVars
48+ -- Be careful adding and restricting freeVars
45− Var var ->
49+ Var var ->
46− do freeIfLocal var
50+ do freeIfLocal var
47− return expression
51+ return expression
48
52
49− Lambda pattern body ->
53+ Lambda pattern body ->
50− uncurry Lambda <$> bindingReorder (pattern,body)
54+ uncurry Lambda <$> bindingReorder (pattern,body)
51
55
52− Binop op leftExpr rightExpr ->
56+ Binop op leftExpr rightExpr ->
53− do freeIfLocal op
57+ do freeIfLocal op
54− Binop op <$> reorder leftExpr <*> reorder rightExpr
58+ Binop op <$> reorder leftExpr <*> reorder rightExpr
55
59
56− Case expr cases ->
60+ Case expr cases ->
57− Case <$> reorder expr <*> mapM bindingReorder cases
61+ Case <$> reorder expr <*> mapM bindingReorder cases
58
62
59− Data name exprs ->
63+ Data name exprs ->
60− do free name
64+ do free name
61− Data name <$> mapM reorder exprs
65+ Data name <$> mapM reorder exprs
62
66
63− -- Just pipe the reorder though
67+ -- Just pipe the reorder though
64− Literal _ ->
68+ Literal _ ->
65− return expression
69+ return expression
66
70
67− Range lowExpr highExpr ->
71+ Range lowExpr highExpr ->
68− Range <$> reorder lowExpr <*> reorder highExpr
72+ Range <$> reorder lowExpr <*> reorder highExpr
69
73
70− ExplicitList es ->
74+ ExplicitList es ->
71− ExplicitList <$> mapM reorder es
75+ ExplicitList <$> mapM reorder es
72
76
73− App func arg ->
77+ App func arg ->
74− App <$> reorder func <*> reorder arg
78+ App <$> reorder func <*> reorder arg
75
79
76− If branches finally ->
80+ If branches finally ->
77− If
81+ If
78− <$> mapM (\(cond,branch) -> (,) <$> reorder cond <*> reorder branch) branches
82+ <$> mapM (\(cond,branch) -> (,) <$> reorder cond <*> reorder branch) branches
79− <*> reorder finally
83+ <*> reorder finally
80
84
85+ Access record field ->
81− Access record field ->
86+ Access
82− Access
83− <$> reorder record
87+ <$> reorder record
84− <*> return field
88+ <*> return field
85
89
90+ Update record fields ->
86− Update record fields ->
91+ Update
87− Update
88− <$> reorder record
92+ <$> reorder record
89− <*> mapM (\(field,expr) -> (,) field <$> reorder expr) fields
93+ <*> mapM (\(field,expr) -> (,) field <$> reorder expr) fields
90
94
95+ Record fields ->
91− Record fields ->
96+ Record
92− Record
93− <$> mapM (\(field,expr) -> (,) field <$> reorder expr) fields
97+ <$> mapM (\(field,expr) -> (,) field <$> reorder expr) fields
94
98
95− GLShader _ _ _ ->
99+ GLShader _ _ _ ->
96− return expression
100+ return expression
97
101
102+ Port impl ->
98− Port impl ->
103+ Port <$>
99− Port <$>
100− case impl of
104+ case impl of
101− In _ _ ->
105+ In _ _ ->
102− return impl
106+ return impl
103
107
104− Out name expr tipe ->
108+ Out name expr tipe ->
105− (\e -> Out name e tipe) <$> reorder expr
109+ (\e -> Out name e tipe) <$> reorder expr
106
110
107− Task name expr tipe ->
111+ Task name expr tipe ->
108− (\e -> Task name e tipe) <$> reorder expr
112+ (\e -> Task name e tipe) <$> reorder expr
109
113
110− -- Actually do some reordering
114+ -- Actually do some reordering
111− Let defs body ->
115+ Let defs body ->
112− do body' <- reorder body
116+ do body' <- reorder body
113
117
114− -- Sort defs into strongly connected components.This
118+ -- Sort defs into strongly connected components.This
115− -- allows the programmer to write definitions in whatever
119+ -- allows the programmer to write definitions in whatever
116− -- order they please, we can still define things in order
120+ -- order they please, we can still define things in order
117− -- and generalize polymorphic functions when appropriate.
121+ -- and generalize polymorphic functions when appropriate.
118− sccs <- Graph.stronglyConnComp <$> buildDefGraph defs
122+ sccs <- Graph.stronglyConnComp <$> buildDefGraph defs
119− let defss = map Graph.flattenSCC sccs
123+ let defss = map Graph.flattenSCC sccs
120
124
121− -- remove let-bound variables from the context
125+ -- remove let-bound variables from the context
122− forM_ defs $ \(Canonical.Definition _ pattern _ _) -> do
126+ forM_ defs $ \(Canonical.Definition _ pattern _ _) -> do
123− bound pattern
127+ bound pattern
124− mapM free (ctors pattern)
128+ mapM free (ctors pattern)
125
129
126− let (A.A _ let') =
130+ let (A.A _ let') =
127− foldr (\ds bod -> A.A ann (Let ds bod)) body' defss
131+ foldr (\ds bod -> A.A ann (Let ds bod)) body' defss
128
132
129− return let'
133+ return let'
130
134
131
135
132ctors :: P.CanonicalPattern -> [String]
136ctors :: P.CanonicalPattern -> [String]
133ctors (A.A _ pattern) =
137ctors (A.A _ pattern) =
134− case pattern of
138+ case pattern of
135− P.Var _ ->
139+ P.Var _ ->
136− []
140+ []
137
141
138− P.Alias _ p ->
142+ P.Alias _ p ->
139− ctors p
143+ ctors p
140
144
141− P.Record _ ->
145+ P.Record _ ->
142− []
146+ []
143
147
144− P.Anything ->
148+ P.Anything ->
145− []
149+ []
146
150
147− P.Literal _ ->
151+ P.Literal _ ->
148− []
152+ []
149
153
150− P.Data (V.Canonical home name) ps ->
154+ P.Data (V.Canonical home name) ps ->
151− case home of
155+ case home of
152− V.Local -> name : rest
156+ V.Local -> name : rest
153− V.TopLevel _ -> name : rest
157+ V.TopLevel _ -> name : rest
154− V.BuiltIn -> rest
158+ V.BuiltIn -> rest
155− V.Module _ -> rest
159+ V.Module _ -> rest
156− where
160+ where
157− rest = concatMap ctors ps
161+ rest = concatMap ctors ps
158
162
159
163
160bound :: P.CanonicalPattern -> State (Set.Set String) ()
164bound :: P.CanonicalPattern -> State (Set.Set String) ()
161bound pattern =
165bound pattern =
166+ let
167+ boundVars =
162− let boundVars = P.boundVarSet pattern
168+ P.boundVarSet pattern
163 in
169 in
164− modify (\freeVars -> Set.difference freeVars boundVars)
170+ modify (\freeVars -> Set.difference freeVars boundVars)
165
171
166
172
167bindingReorder
173bindingReorder
@@ -174,8 +180,10 @@ bindingReorder (pattern, expr) =
174 return (pattern, expr')
180 return (pattern, expr')
175
181
176
182
183+
177-- BUILD DEPENDENCY GRAPH BETWEEN DEFINITIONS
184-- BUILD DEPENDENCY GRAPH BETWEEN DEFINITIONS
178
185
186+
179-- This also reorders the all of the sub-expressions in the Def list.
187-- This also reorders the all of the sub-expressions in the Def list.
180buildDefGraph
188buildDefGraph
181 :: [Canonical.Def]
189 :: [Canonical.Def]
@@ -186,21 +194,23 @@ buildDefGraph defs =
186 where
194 where
187 addKey :: [(Canonical.Def, [String])] -> [(Canonical.Def, Int, [String])]
195 addKey :: [(Canonical.Def, [String])] -> [(Canonical.Def, Int, [String])]
188 addKey =
196 addKey =
189− zipWith (\n (pdef,deps) -> (pdef,n,deps)) [0..]
197+ zipWith (\n (pdef,deps) -> (pdef,n,deps)) [0..]
190
198
191 variableToKey :: (Canonical.Def, Int, [String]) -> [(String, Int)]
199 variableToKey :: (Canonical.Def, Int, [String]) -> [(String, Int)]
192 variableToKey (Canonical.Definition _ pattern _ _, key, _) =
200 variableToKey (Canonical.Definition _ pattern _ _, key, _) =
193− [ (var, key) | var <- P.boundVarList pattern ]
201+ [ (var, key) | var <- P.boundVarList pattern ]
194
202
195 variableToKeyMap :: [(Canonical.Def, Int, [String])] -> Map.Map String Int
203 variableToKeyMap :: [(Canonical.Def, Int, [String])] -> Map.Map String Int
196 variableToKeyMap pdefsDeps =
204 variableToKeyMap pdefsDeps =
197− Map.fromList (concatMap variableToKey pdefsDeps)
205+ Map.fromList (concatMap variableToKey pdefsDeps)
198
206
199 realDeps :: [(Canonical.Def, Int, [String])] -> [(Canonical.Def, Int, [Int])]
207 realDeps :: [(Canonical.Def, Int, [String])] -> [(Canonical.Def, Int, [Int])]
200 realDeps pdefsDeps =
208 realDeps pdefsDeps =
201 map convert pdefsDeps
209 map convert pdefsDeps
202 where
210 where
211+ varDict =
203− varDict = variableToKeyMap pdefsDeps
212+ variableToKeyMap pdefsDeps
213+
204 convert (pdef, key, deps) =
214 convert (pdef, key, deps) =
205 (pdef, key, Maybe.mapMaybe (flip Map.lookup varDict) deps)
215 (pdef, key, Maybe.mapMaybe (flip Map.lookup varDict) deps)
206
216