1 {-# LANGUAGE PackageImports #-}
3 -- Functions to bring a Core expression in normal form. This module provides a
4 -- top level function "normalize", and defines the actual transformation passes that
7 module CLasH.Normalize (getNormalized, normalizeExpr, splitNormalized) where
11 import qualified Maybe
13 import qualified "transformers" Control.Monad.Trans as Trans
14 import qualified Control.Monad as Monad
15 import qualified Control.Monad.Trans.Writer as Writer
16 import qualified Data.Map as Map
17 import qualified Data.Monoid as Monoid
22 import qualified UniqSupply
23 import qualified CoreUtils
25 import qualified TcType
28 import qualified VarSet
29 import qualified NameSet
30 import qualified CoreFVs
31 import qualified CoreUtils
32 import qualified MkCore
33 import qualified HscTypes
34 import Outputable ( showSDoc, ppr, nest )
37 import CLasH.Normalize.NormalizeTypes
38 import CLasH.Translator.TranslatorTypes
39 import CLasH.Normalize.NormalizeTools
40 import CLasH.VHDL.VHDLTypes
41 import qualified CLasH.Utils as Utils
42 import CLasH.Utils.Core.CoreTools
43 import CLasH.Utils.Core.BinderTools
44 import CLasH.Utils.Pretty
46 --------------------------------
47 -- Start of transformations
48 --------------------------------
50 --------------------------------
52 --------------------------------
53 eta, etatop :: Transform
54 eta expr | is_fun expr && not (is_lam expr) = do
55 let arg_ty = (fst . Type.splitFunTy . CoreUtils.exprType) expr
56 id <- Trans.lift $ mkInternalVar "param" arg_ty
57 change (Lam id (App expr (Var id)))
58 -- Leave all other expressions unchanged
60 etatop = notappargs ("eta", eta)
62 --------------------------------
64 --------------------------------
65 beta, betatop :: Transform
66 -- Substitute arg for x in expr
67 beta (App (Lam x expr) arg) = change $ substitute [(x, arg)] expr
68 -- Propagate the application into the let
69 beta (App (Let binds expr) arg) = change $ Let binds (App expr arg)
70 -- Propagate the application into each of the alternatives
71 beta (App (Case scrut b ty alts) arg) = change $ Case scrut b ty' alts'
73 alts' = map (\(con, bndrs, expr) -> (con, bndrs, (App expr arg))) alts
74 ty' = CoreUtils.applyTypeToArg ty arg
75 -- Leave all other expressions unchanged
76 beta expr = return expr
77 -- Perform this transform everywhere
78 betatop = everywhere ("beta", beta)
80 --------------------------------
82 --------------------------------
83 -- Try to move casts as much downward as possible.
84 castprop, castproptop :: Transform
85 castprop (Cast (Let binds expr) ty) = change $ Let binds (Cast expr ty)
86 castprop expr@(Cast (Case scrut b _ alts) ty) = change (Case scrut b ty alts')
88 alts' = map (\(con, bndrs, expr) -> (con, bndrs, (Cast expr ty))) alts
89 -- Leave all other expressions unchanged
90 castprop expr = return expr
91 -- Perform this transform everywhere
92 castproptop = everywhere ("castprop", castprop)
94 --------------------------------
95 -- Cast simplification. Mostly useful for state packing and unpacking, but
96 -- perhaps for others as well.
97 --------------------------------
98 castsimpl, castsimpltop :: Transform
99 castsimpl expr@(Cast val ty) = do
100 -- Don't extract values that are already simpl
101 local_var <- Trans.lift $ is_local_var val
102 -- Don't extract values that are not representable, to prevent loops with
105 if (not local_var) && repr
107 -- Generate a binder for the expression
108 id <- Trans.lift $ mkBinderFor val "castval"
109 -- Extract the expression
110 change $ Let (NonRec id val) (Cast (Var id) ty)
113 -- Leave all other expressions unchanged
114 castsimpl expr = return expr
115 -- Perform this transform everywhere
116 castsimpltop = everywhere ("castsimpl", castsimpl)
118 --------------------------------
119 -- let derecursification
120 --------------------------------
121 letderec, letderectop :: Transform
122 letderec expr@(Let (Rec binds) res) = case liftable of
123 -- Nothing is liftable, just return
125 -- Something can be lifted, generate a new let expression
126 _ -> change $ MkCore.mkCoreLets newbinds res
128 -- Make a list of all the binders bound in this recursive let
129 bndrs = map fst binds
130 -- See which bindings are liftable
131 (liftable, nonliftable) = List.partition canlift binds
132 -- Create nonrec bindings for each liftable binding and a single recursive
133 -- binding for all others
134 newbinds = (map (uncurry NonRec) liftable) ++ [Rec nonliftable]
135 -- Any expression that does not use any of the binders in this recursive let
136 -- can be lifted into a nonrec let. It can't use its own binder either,
137 -- since that would mean the binding is self-recursive and should be in a
138 -- single bind recursive let.
139 canlift (bndr, e) = not $ expr_uses_binders bndrs e
140 -- Leave all other expressions unchanged
141 letderec expr = return expr
142 -- Perform this transform everywhere
143 letderectop = everywhere ("letderec", letderec)
145 --------------------------------
146 -- let simplification
147 --------------------------------
148 letsimpl, letsimpltop :: Transform
149 -- Put the "in ..." value of a let in its own binding, but not when the
150 -- expression is already a local variable, or not representable (to prevent loops with inlinenonrep).
151 letsimpl expr@(Let binds res) = do
153 local_var <- Trans.lift $ is_local_var res
154 if not local_var && repr
156 -- If the result is not a local var already (to prevent loops with
157 -- ourselves), extract it.
158 id <- Trans.lift $ mkBinderFor res "foo"
159 change $ Let binds (Let (NonRec id res) (Var id))
161 -- If the result is already a local var, don't extract it.
164 -- Leave all other expressions unchanged
165 letsimpl expr = return expr
166 -- Perform this transform everywhere
167 letsimpltop = everywhere ("letsimpl", letsimpl)
169 --------------------------------
171 --------------------------------
172 letflat, letflattop :: Transform
173 letflat (Let (Rec binds) expr) = do
174 -- Turn each binding into a list of bindings (possibly containing just one
175 -- element, of course)
176 bindss <- Monad.mapM flatbind binds
177 -- Concat all the bindings
178 let binds' = concat bindss
179 -- Return the new let. We don't use change here, since possibly nothing has
180 -- changed. If anything has changed, flatbind has already flagged that
182 return $ Let (Rec binds') expr
184 -- Turns a binding of a let into a multiple bindings, or any other binding
185 -- into a list with just that binding
186 flatbind :: (CoreBndr, CoreExpr) -> TransformMonad [(CoreBndr, CoreExpr)]
187 flatbind (b, Let (Rec binds) expr) = change ((b, expr):binds)
188 flatbind (b, expr) = return [(b, expr)]
189 -- Leave all other expressions unchanged
190 letflat expr = return expr
191 -- Perform this transform everywhere
192 letflattop = everywhere ("letflat", letflat)
194 --------------------------------
195 -- Simple let binding removal
196 --------------------------------
197 -- Remove a = b bindings from let expressions everywhere
198 letremovetop :: Transform
199 letremovetop = everywhere ("letremove", inlinebind (\(b, e) -> Trans.lift $ is_local_var e))
201 --------------------------------
202 -- Unused let binding removal
203 --------------------------------
204 letremoveunused, letremoveunusedtop :: Transform
205 letremoveunused expr@(Let (Rec binds) res) = do
206 -- Filter out all unused binds.
207 let binds' = filter dobind binds
208 -- Only set the changed flag if binds got removed
209 changeif (length binds' /= length binds) (Let (Rec binds') res)
211 bound_exprs = map snd binds
212 -- For each bind check if the bind is used by res or any of the bound
214 dobind (bndr, _) = any (expr_uses_binders [bndr]) (res:bound_exprs)
215 -- Leave all other expressions unchanged
216 letremoveunused expr = return expr
217 letremoveunusedtop = everywhere ("letremoveunused", letremoveunused)
219 --------------------------------
220 -- Identical let binding merging
221 --------------------------------
222 -- Merge two bindings in a let if they are identical
223 -- TODO: We would very much like to use GHC's CSE module for this, but that
224 -- doesn't track if something changed or not, so we can't use it properly.
225 letmerge, letmergetop :: Transform
226 letmerge expr@(Let (Rec binds) res) = do
227 binds' <- domerge binds
228 return (Let (Rec binds') res)
230 domerge :: [(CoreBndr, CoreExpr)] -> TransformMonad [(CoreBndr, CoreExpr)]
231 domerge [] = return []
233 es' <- mapM (mergebinds e) es
237 -- Uses the second bind to simplify the second bind, if applicable.
238 mergebinds :: (CoreBndr, CoreExpr) -> (CoreBndr, CoreExpr) -> TransformMonad (CoreBndr, CoreExpr)
239 mergebinds (b1, e1) (b2, e2)
240 -- Identical expressions? Replace the second binding with a reference to
242 | CoreUtils.cheapEqExpr e1 e2 = change $ (b2, Var b1)
243 -- Different expressions? Don't change
244 | otherwise = return (b2, e2)
245 -- Leave all other expressions unchanged
246 letmerge expr = return expr
247 letmergetop = everywhere ("letmerge", letmerge)
249 --------------------------------
251 --------------------------------
252 -- Remove a = B bindings, with B :: a -> b, or B :: forall x . T, from let
253 -- expressions everywhere. This means that any value that still needs to be
254 -- applied to something else (polymorphic values need to be applied to a
255 -- Type) will be inlined, and will eventually be applied to all their
258 -- This is a tricky function, which is prone to create loops in the
259 -- transformations. To fix this, we make sure that no transformation will
260 -- create a new let binding with a function type. These other transformations
261 -- will just not work on those function-typed values at first, but the other
262 -- transformations (in particular β-reduction) should make sure that the type
263 -- of those values eventually becomes primitive.
264 inlinenonreptop :: Transform
265 inlinenonreptop = everywhere ("inlinenonrep", inlinebind ((Monad.liftM not) . isRepr . snd))
267 --------------------------------
268 -- Scrutinee simplification
269 --------------------------------
270 scrutsimpl,scrutsimpltop :: Transform
271 -- Don't touch scrutinees that are already simple
272 scrutsimpl expr@(Case (Var _) _ _ _) = return expr
273 -- Replace all other cases with a let that binds the scrutinee and a new
274 -- simple scrutinee, but only when the scrutinee is representable (to prevent
275 -- loops with inlinenonrep, though I don't think a non-representable scrutinee
276 -- will be supported anyway...)
277 scrutsimpl expr@(Case scrut b ty alts) = do
281 id <- Trans.lift $ mkBinderFor scrut "scrut"
282 change $ Let (NonRec id scrut) (Case (Var id) b ty alts)
285 -- Leave all other expressions unchanged
286 scrutsimpl expr = return expr
287 -- Perform this transform everywhere
288 scrutsimpltop = everywhere ("scrutsimpl", scrutsimpl)
290 --------------------------------
291 -- Case binder wildening
292 --------------------------------
293 casesimpl, casesimpltop :: Transform
294 -- This is already a selector case (or, if x does not appear in bndrs, a very
295 -- simple case statement that will be removed by caseremove below). Just leave
297 casesimpl expr@(Case scrut b ty [(con, bndrs, Var x)]) = return expr
298 -- Make sure that all case alternatives have only wild binders and simple
300 -- This is done by creating a new let binding for each non-wild binder, which
301 -- is bound to a new simple selector case statement and for each complex
302 -- expression. We do this only for representable types, to prevent loops with
304 casesimpl expr@(Case scrut b ty alts) = do
305 (bindingss, alts') <- (Monad.liftM unzip) $ mapM doalt alts
306 let bindings = concat bindingss
307 -- Replace the case with a let with bindings and a case
308 let newlet = (Let (Rec bindings) (Case scrut b ty alts'))
309 -- If there are no non-wild binders, or this case is already a simple
310 -- selector (i.e., a single alt with exactly one binding), already a simple
311 -- selector altan no bindings (i.e., no wild binders in the original case),
312 -- don't change anything, otherwise, replace the case.
313 if null bindings then return expr else change newlet
315 -- Generate a single wild binder, since they are all the same
316 wild = MkCore.mkWildBinder
317 -- Wilden the binders of one alt, producing a list of bindings as a
319 doalt :: CoreAlt -> TransformMonad ([(CoreBndr, CoreExpr)], CoreAlt)
320 doalt (con, bndrs, expr) = do
321 -- Make each binder wild, if possible
322 bndrs_res <- Monad.zipWithM dobndr bndrs [0..]
323 let (newbndrs, bindings_maybe) = unzip bndrs_res
324 -- Extract a complex expression, if possible. For this we check if any of
325 -- the new list of bndrs are used by expr. We can't use free_vars here,
326 -- since that looks at the old bndrs.
327 let uses_bndrs = not $ VarSet.isEmptyVarSet $ CoreFVs.exprSomeFreeVars (`elem` newbndrs) $ expr
328 (exprbinding_maybe, expr') <- doexpr expr uses_bndrs
329 -- Create a new alternative
330 let newalt = (con, newbndrs, expr')
331 let bindings = Maybe.catMaybes (exprbinding_maybe : bindings_maybe)
332 return (bindings, newalt)
334 -- Make wild alternatives for each binder
335 wildbndrs = map (\bndr -> MkCore.mkWildBinder (Id.idType bndr)) bndrs
336 -- A set of all the binders that are used by the expression
337 free_vars = CoreFVs.exprSomeFreeVars (`elem` bndrs) expr
338 -- Look at the ith binder in the case alternative. Return a new binder
339 -- for it (either the same one, or a wild one) and optionally a let
340 -- binding containing a case expression.
341 dobndr :: CoreBndr -> Int -> TransformMonad (CoreBndr, Maybe (CoreBndr, CoreExpr))
343 repr <- isRepr (Var b)
344 -- Is b wild (e.g., not a free var of expr. Since b is only in scope
345 -- in expr, this means that b is unused if expr does not use it.)
346 let wild = not (VarSet.elemVarSet b free_vars)
347 -- Create a new binding for any representable binder that is not
348 -- already wild and is representable (to prevent loops with
350 if (not wild) && repr
352 -- Create on new binder that will actually capture a value in this
353 -- case statement, and return it.
354 let bty = (Id.idType b)
355 id <- Trans.lift $ mkInternalVar "sel" bty
356 let binders = take i wildbndrs ++ [id] ++ drop (i+1) wildbndrs
357 let caseexpr = Case scrut b bty [(con, binders, Var id)]
358 return (wildbndrs!!i, Just (b, caseexpr))
360 -- Just leave the original binder in place, and don't generate an
361 -- extra selector case.
363 -- Process the expression of a case alternative. Accepts an expression
364 -- and whether this expression uses any of the binders in the
365 -- alternative. Returns an optional new binding and a new expression.
366 doexpr :: CoreExpr -> Bool -> TransformMonad (Maybe (CoreBndr, CoreExpr), CoreExpr)
367 doexpr expr uses_bndrs = do
368 local_var <- Trans.lift $ is_local_var expr
370 -- Extract any expressions that do not use any binders from this
371 -- alternative, is not a local var already and is representable (to
372 -- prevent loops with inlinenonrep).
373 if (not uses_bndrs) && (not local_var) && repr
375 id <- Trans.lift $ mkBinderFor expr "caseval"
376 -- We don't flag a change here, since casevalsimpl will do that above
377 -- based on Just we return here.
378 return $ (Just (id, expr), Var id)
380 -- Don't simplify anything else
381 return (Nothing, expr)
382 -- Leave all other expressions unchanged
383 casesimpl expr = return expr
384 -- Perform this transform everywhere
385 casesimpltop = everywhere ("casesimpl", casesimpl)
387 --------------------------------
389 --------------------------------
390 -- Remove case statements that have only a single alternative and only wild
392 caseremove, caseremovetop :: Transform
393 -- Replace a useless case by the value of its single alternative
394 caseremove (Case scrut b ty [(con, bndrs, expr)]) | not usesvars = change expr
395 -- Find if any of the binders are used by expr
396 where usesvars = (not . VarSet.isEmptyVarSet . (CoreFVs.exprSomeFreeVars (`elem` bndrs))) expr
397 -- Leave all other expressions unchanged
398 caseremove expr = return expr
399 -- Perform this transform everywhere
400 caseremovetop = everywhere ("caseremove", caseremove)
402 --------------------------------
403 -- Argument extraction
404 --------------------------------
405 -- Make sure that all arguments of a representable type are simple variables.
406 appsimpl, appsimpltop :: Transform
407 -- Simplify all representable arguments. Do this by introducing a new Let
408 -- that binds the argument and passing the new binder in the application.
409 appsimpl expr@(App f arg) = do
410 -- Check runtime representability
412 local_var <- Trans.lift $ is_local_var arg
413 if repr && not local_var
414 then do -- Extract representable arguments
415 id <- Trans.lift $ mkBinderFor arg "arg"
416 change $ Let (NonRec id arg) (App f (Var id))
417 else -- Leave non-representable arguments unchanged
419 -- Leave all other expressions unchanged
420 appsimpl expr = return expr
421 -- Perform this transform everywhere
422 appsimpltop = everywhere ("appsimpl", appsimpl)
424 --------------------------------
425 -- Function-typed argument propagation
426 --------------------------------
427 -- Remove all applications to function-typed arguments, by duplication the
428 -- function called with the function-typed parameter replaced by the free
429 -- variables of the argument passed in.
430 argprop, argproptop :: Transform
431 -- Transform any application of a named function (i.e., skip applications of
432 -- lambda's). Also skip applications that have arguments with free type
433 -- variables, since we can't inline those.
434 argprop expr@(App _ _) | is_var fexpr = do
435 -- Find the body of the function called
436 body_maybe <- Trans.lift $ getGlobalBind f
439 -- Process each of the arguments in turn
440 (args', changed) <- Writer.listen $ mapM doarg args
441 -- See if any of the arguments changed
442 case Monoid.getAny changed of
444 let (newargs', newparams', oldargs) = unzip3 args'
445 let newargs = concat newargs'
446 let newparams = concat newparams'
447 -- Create a new body that consists of a lambda for all new arguments and
448 -- the old body applied to some arguments.
449 let newbody = MkCore.mkCoreLams newparams (MkCore.mkCoreApps body oldargs)
450 -- Create a new function with the same name but a new body
451 newf <- Trans.lift $ mkFunction f newbody
452 -- Replace the original application with one of the new function to the
454 change $ MkCore.mkCoreApps (Var newf) newargs
456 -- Don't change the expression if none of the arguments changed
459 -- If we don't have a body for the function called, leave it unchanged (it
460 -- should be a primitive function then).
461 Nothing -> return expr
463 -- Find the function called and the arguments
464 (fexpr, args) = collectArgs expr
467 -- Process a single argument and return (args, bndrs, arg), where args are
468 -- the arguments to replace the given argument in the original
469 -- application, bndrs are the binders to include in the top-level lambda
470 -- in the new function body, and arg is the argument to apply to the old
472 doarg :: CoreExpr -> TransformMonad ([CoreExpr], [CoreBndr], CoreExpr)
475 bndrs <- Trans.lift getGlobalBinders
476 let interesting var = Var.isLocalVar var && (not $ var `elem` bndrs)
477 if not repr && not (is_var arg && interesting (exprToVar arg)) && not (has_free_tyvars arg)
479 -- Propagate all complex arguments that are not representable, but not
480 -- arguments with free type variables (since those would require types
481 -- not known yet, which will always be known eventually).
482 -- Find interesting free variables, each of which should be passed to
483 -- the new function instead of the original function argument.
485 -- Interesting vars are those that are local, but not available from the
486 -- top level scope (functions from this module are defined as local, but
487 -- they're not local to this function, so we can freely move references
488 -- to them into another function).
489 let free_vars = VarSet.varSetElems $ CoreFVs.exprSomeFreeVars interesting arg
490 -- Mark the current expression as changed
492 return (map Var free_vars, free_vars, arg)
494 -- Representable types will not be propagated, and arguments with free
495 -- type variables will be propagated later.
496 -- TODO: preserve original naming?
497 id <- Trans.lift $ mkBinderFor arg "param"
498 -- Just pass the original argument to the new function, which binds it
499 -- to a new id and just pass that new id to the old function body.
500 return ([arg], [id], mkReferenceTo id)
501 -- Leave all other expressions unchanged
502 argprop expr = return expr
503 -- Perform this transform everywhere
504 argproptop = everywhere ("argprop", argprop)
506 --------------------------------
507 -- Function-typed argument extraction
508 --------------------------------
509 -- This transform takes any function-typed argument that cannot be propagated
510 -- (because the function that is applied to it is a builtin function), and
511 -- puts it in a brand new top level binder. This allows us to for example
512 -- apply map to a lambda expression This will not conflict with inlinenonrep,
513 -- since that only inlines local let bindings, not top level bindings.
514 funextract, funextracttop :: Transform
515 funextract expr@(App _ _) | is_var fexpr = do
516 body_maybe <- Trans.lift $ getGlobalBind f
518 -- We don't have a function body for f, so we can perform this transform.
520 -- Find the new arguments
521 args' <- mapM doarg args
522 -- And update the arguments. We use return instead of changed, so the
523 -- changed flag doesn't get set if none of the args got changed.
524 return $ MkCore.mkCoreApps fexpr args'
525 -- We have a function body for f, leave this application to funprop
526 Just _ -> return expr
528 -- Find the function called and the arguments
529 (fexpr, args) = collectArgs expr
531 -- Change any arguments that have a function type, but are not simple yet
532 -- (ie, a variable or application). This means to create a new function
533 -- for map (\f -> ...) b, but not for map (foo a) b.
535 -- We could use is_applicable here instead of is_fun, but I think
536 -- arguments to functions could only have forall typing when existential
537 -- typing is enabled. Not sure, though.
538 doarg arg | not (is_simple arg) && is_fun arg = do
539 -- Create a new top level binding that binds the argument. Its body will
540 -- be extended with lambda expressions, to take any free variables used
541 -- by the argument expression.
542 let free_vars = VarSet.varSetElems $ CoreFVs.exprFreeVars arg
543 let body = MkCore.mkCoreLams free_vars arg
544 id <- Trans.lift $ mkBinderFor body "fun"
545 Trans.lift $ addGlobalBind id body
546 -- Replace the argument with a reference to the new function, applied to
548 change $ MkCore.mkCoreApps (Var id) (map Var free_vars)
549 -- Leave all other arguments untouched
550 doarg arg = return arg
552 -- Leave all other expressions unchanged
553 funextract expr = return expr
554 -- Perform this transform everywhere
555 funextracttop = everywhere ("funextract", funextract)
557 --------------------------------
558 -- End of transformations
559 --------------------------------
564 -- What transforms to run?
565 transforms = [argproptop, funextracttop, etatop, betatop, castproptop, letremovetop, letderectop, letsimpltop, letflattop, scrutsimpltop, casesimpltop, caseremovetop, inlinenonreptop, appsimpltop, letmergetop, letremoveunusedtop, castsimpltop]
567 -- | Returns the normalized version of the given function.
569 CoreBndr -- ^ The function to get
570 -> TranslatorSession CoreExpr -- The normalized function body
572 getNormalized bndr = Utils.makeCached bndr tsNormalized $ do
573 if is_poly (Var bndr)
575 -- This should really only happen at the top level... TODO: Give
576 -- a different error if this happens down in the recursion.
577 error $ "\nNormalize.normalizeBind: Function " ++ show bndr ++ " is polymorphic, can't normalize"
579 expr <- getBinding bndr
580 normalizeExpr (show bndr) expr
582 -- | Normalize an expression
584 String -- ^ What are we normalizing? For debug output only.
585 -> CoreSyn.CoreExpr -- ^ The expression to normalize
586 -> TranslatorSession CoreSyn.CoreExpr -- ^ The normalized expression
588 normalizeExpr what expr = do
589 -- Normalize this expression
590 trace (what ++ " before normalization:\n\n" ++ showSDoc ( ppr expr ) ++ "\n") $ return ()
591 expr' <- dotransforms transforms expr
592 trace ("\n" ++ what ++ " after normalization:\n\n" ++ showSDoc ( ppr expr')) $ return ()
595 -- | Get the value that is bound to the given binder at top level. Fails when
596 -- there is no such binding.
598 CoreBndr -- ^ The binder to get the expression for
599 -> TranslatorSession CoreExpr -- ^ The value bound to the binder
601 getBinding bndr = Utils.makeCached bndr tsBindings $ do
602 -- If the binding isn't in the "cache" (bindings map), then we can't create
603 -- it out of thin air, so return an error.
604 error $ "Normalize.getBinding: Unknown function requested: " ++ show bndr
606 -- | Split a normalized expression into the argument binders, top level
607 -- bindings and the result binder.
609 CoreExpr -- ^ The normalized expression
610 -> ([CoreBndr], [Binding], CoreBndr)
611 splitNormalized expr = (args, binds, res)
613 (args, letexpr) = CoreSyn.collectBinders expr
614 (binds, resexpr) = flattenLets letexpr
615 res = case resexpr of
617 _ -> error $ "Normalize.splitNormalized: Not in normal form: " ++ pprString expr ++ "\n"
619 -- | Flattens nested lets into a single list of bindings. The expression
620 -- passed does not have to be a let expression, if it isn't an empty list of
621 -- bindings is returned.
623 CoreExpr -- ^ The expression to flatten.
624 -> ([Binding], CoreExpr) -- ^ The bindings and resulting expression.
625 flattenLets (Let binds expr) =
626 (bindings ++ bindings', expr')
628 -- Recursively flatten the contained expression
629 (bindings', expr') =flattenLets expr
630 -- Flatten our own bindings to remove the Rec / NonRec constructors
631 bindings = CoreSyn.flattenBinds [binds]
632 flattenLets expr = ([], expr)