@@ -14,8 +14,10 @@ import qualified AST.Variable as V
1414import qualified Reporting.Annotation as A
1515
1616
17+
1718-- STARTING POINT
1819
20+
1921definitions :: Canonical.Expr -> Canonical.Expr
2022definitions expression =
2123 evalState (reorder expression) Set.empty
@@ -35,133 +37,137 @@ freeIfLocal (V.Canonical home name) =
3537 V.Module _ -> return ()
3638
3739
40+
3841-- REORDER EXPRESSIONS
3942
43+
4044reorder :: Canonical.Expr -> State (Set.Set String) Canonical.Expr
4145reorder (A.A ann expression) =
42− A.A ann <$>
43− case expression of
44− -- Be careful adding and restricting freeVars
45− Var var ->
46− do freeIfLocal var
47− return expression
46+ A.A ann <$>
47+ case expression of
48+ -- Be careful adding and restricting freeVars
49+ Var var ->
50+ do freeIfLocal var
51+ return expression
4852
49− Lambda pattern body ->
50− uncurry Lambda <$> bindingReorder (pattern,body)
53+ Lambda pattern body ->
54+ uncurry Lambda <$> bindingReorder (pattern,body)
5155
52− Binop op leftExpr rightExpr ->
53− do freeIfLocal op
54− Binop op <$> reorder leftExpr <*> reorder rightExpr
56+ Binop op leftExpr rightExpr ->
57+ do freeIfLocal op
58+ Binop op <$> reorder leftExpr <*> reorder rightExpr
5559
56− Case expr cases ->
57− Case <$> reorder expr <*> mapM bindingReorder cases
60+ Case expr cases ->
61+ Case <$> reorder expr <*> mapM bindingReorder cases
5862
59− Data name exprs ->
60− do free name
61− Data name <$> mapM reorder exprs
63+ Data name exprs ->
64+ do free name
65+ Data name <$> mapM reorder exprs
6266
63− -- Just pipe the reorder though
64− Literal _ ->
65− return expression
67+ -- Just pipe the reorder though
68+ Literal _ ->
69+ return expression
6670
67− Range lowExpr highExpr ->
68− Range <$> reorder lowExpr <*> reorder highExpr
71+ Range lowExpr highExpr ->
72+ Range <$> reorder lowExpr <*> reorder highExpr
6973
70− ExplicitList es ->
71− ExplicitList <$> mapM reorder es
74+ ExplicitList es ->
75+ ExplicitList <$> mapM reorder es
7276
73− App func arg ->
74− App <$> reorder func <*> reorder arg
77+ App func arg ->
78+ App <$> reorder func <*> reorder arg
7579
76− If branches finally ->
77− If
78− <$> mapM (\(cond,branch) -> (,) <$> reorder cond <*> reorder branch) branches
79− <*> reorder finally
80+ If branches finally ->
81+ If
82+ <$> mapM (\(cond,branch) -> (,) <$> reorder cond <*> reorder branch) branches
83+ <*> reorder finally
8084
81− Access record field ->
82− Access
83− <$> reorder record
84− <*> return field
85+ Access record field ->
86+ Access
87+ <$> reorder record
88+ <*> return field
8589
86− Update record fields ->
87− Update
88− <$> reorder record
89− <*> mapM (\(field,expr) -> (,) field <$> reorder expr) fields
90+ Update record fields ->
91+ Update
92+ <$> reorder record
93+ <*> mapM (\(field,expr) -> (,) field <$> reorder expr) fields
9094
91− Record fields ->
92− Record
93− <$> mapM (\(field,expr) -> (,) field <$> reorder expr) fields
95+ Record fields ->
96+ Record
97+ <$> mapM (\(field,expr) -> (,) field <$> reorder expr) fields
9498
95− GLShader _ _ _ ->
96− return expression
99+ GLShader _ _ _ ->
100+ return expression
97101
98− Port impl ->
99− Port <$>
100− case impl of
101− In _ _ ->
102− return impl
102+ Port impl ->
103+ Port <$>
104+ case impl of
105+ In _ _ ->
106+ return impl
103107
104− Out name expr tipe ->
105− (\e -> Out name e tipe) <$> reorder expr
108+ Out name expr tipe ->
109+ (\e -> Out name e tipe) <$> reorder expr
106110
107− Task name expr tipe ->
108− (\e -> Task name e tipe) <$> reorder expr
111+ Task name expr tipe ->
112+ (\e -> Task name e tipe) <$> reorder expr
109113
110− -- Actually do some reordering
111− Let defs body ->
112− do body' <- reorder body
114+ -- Actually do some reordering
115+ Let defs body ->
116+ do body' <- reorder body
113117
114− -- Sort defs into strongly connected components.This
115− -- allows the programmer to write definitions in whatever
116− -- order they please, we can still define things in order
117− -- and generalize polymorphic functions when appropriate.
118− sccs <- Graph.stronglyConnComp <$> buildDefGraph defs
119− let defss = map Graph.flattenSCC sccs
118+ -- Sort defs into strongly connected components.This
119+ -- allows the programmer to write definitions in whatever
120+ -- order they please, we can still define things in order
121+ -- and generalize polymorphic functions when appropriate.
122+ sccs <- Graph.stronglyConnComp <$> buildDefGraph defs
123+ let defss = map Graph.flattenSCC sccs
120124
121− -- remove let-bound variables from the context
122− forM_ defs $ \(Canonical.Definition _ pattern _ _) -> do
123− bound pattern
124− mapM free (ctors pattern)
125+ -- remove let-bound variables from the context
126+ forM_ defs $ \(Canonical.Definition _ pattern _ _) -> do
127+ bound pattern
128+ mapM free (ctors pattern)
125129
126− let (A.A _ let') =
127− foldr (\ds bod -> A.A ann (Let ds bod)) body' defss
130+ let (A.A _ let') =
131+ foldr (\ds bod -> A.A ann (Let ds bod)) body' defss
128132
129− return let'
133+ return let'
130134
131135
132136ctors :: P.CanonicalPattern -> [String]
133137ctors (A.A _ pattern) =
134− case pattern of
135− P.Var _ ->
136− []
138+ case pattern of
139+ P.Var _ ->
140+ []
137141
138− P.Alias _ p ->
139− ctors p
142+ P.Alias _ p ->
143+ ctors p
140144
141− P.Record _ ->
142− []
145+ P.Record _ ->
146+ []
143147
144− P.Anything ->
145− []
148+ P.Anything ->
149+ []
146150
147− P.Literal _ ->
148− []
151+ P.Literal _ ->
152+ []
149153
150− P.Data (V.Canonical home name) ps ->
151− case home of
152− V.Local -> name : rest
153− V.TopLevel _ -> name : rest
154− V.BuiltIn -> rest
155− V.Module _ -> rest
156− where
157− rest = concatMap ctors ps
154+ P.Data (V.Canonical home name) ps ->
155+ case home of
156+ V.Local -> name : rest
157+ V.TopLevel _ -> name : rest
158+ V.BuiltIn -> rest
159+ V.Module _ -> rest
160+ where
161+ rest = concatMap ctors ps
158162
159163
160164bound :: P.CanonicalPattern -> State (Set.Set String) ()
161165bound pattern =
162− let boundVars = P.boundVarSet pattern
166+ let
167+ boundVars =
168+ P.boundVarSet pattern
163169 in
164− modify (\freeVars -> Set.difference freeVars boundVars)
170+ modify (\freeVars -> Set.difference freeVars boundVars)
165171
166172
167173bindingReorder
@@ -174,8 +180,10 @@ bindingReorder (pattern, expr) =
174180 return (pattern, expr')
175181
176182
183+
177184-- BUILD DEPENDENCY GRAPH BETWEEN DEFINITIONS
178185
186+
179187-- This also reorders the all of the sub-expressions in the Def list.
180188buildDefGraph
181189 :: [Canonical.Def]
@@ -186,21 +194,23 @@ buildDefGraph defs =
186194 where
187195 addKey :: [(Canonical.Def, [String])] -> [(Canonical.Def, Int, [String])]
188196 addKey =
189− zipWith (\n (pdef,deps) -> (pdef,n,deps)) [0..]
197+ zipWith (\n (pdef,deps) -> (pdef,n,deps)) [0..]
190198
191199 variableToKey :: (Canonical.Def, Int, [String]) -> [(String, Int)]
192200 variableToKey (Canonical.Definition _ pattern _ _, key, _) =
193− [ (var, key) | var <- P.boundVarList pattern ]
201+ [ (var, key) | var <- P.boundVarList pattern ]
194202
195203 variableToKeyMap :: [(Canonical.Def, Int, [String])] -> Map.Map String Int
196204 variableToKeyMap pdefsDeps =
197− Map.fromList (concatMap variableToKey pdefsDeps)
205+ Map.fromList (concatMap variableToKey pdefsDeps)
198206
199207 realDeps :: [(Canonical.Def, Int, [String])] -> [(Canonical.Def, Int, [Int])]
200208 realDeps pdefsDeps =
201209 map convert pdefsDeps
202210 where
203− varDict = variableToKeyMap pdefsDeps
211+ varDict =
212+ variableToKeyMap pdefsDeps
213+
204214 convert (pdef, key, deps) =
205215 (pdef, key, Maybe.mapMaybe (flip Map.lookup varDict) deps)
206216