From: Matthijs Kooijman Date: Thu, 13 Aug 2009 14:24:44 +0000 (+0200) Subject: Make splitNormalized work for non-recursive lets. X-Git-Url: https://git.stderr.nl/gitweb?a=commitdiff_plain;h=3a2910eae9d5ae9846a7bd350b829e624717c4a3;p=matthijs%2Fmaster-project%2Fc%CE%BBash.git Make splitNormalized work for non-recursive lets. For now, normalized expressions can only contain a (single) recursive let, but this should become nested non-recursive lets only in the future. --- diff --git "a/c\316\273ash/CLasH/Normalize.hs" "b/c\316\273ash/CLasH/Normalize.hs" index 7fb0dc2..1d40f92 100644 --- "a/c\316\273ash/CLasH/Normalize.hs" +++ "b/c\316\273ash/CLasH/Normalize.hs" @@ -595,9 +595,25 @@ getBinding bndr = Utils.makeCached bndr tsBindings $ do splitNormalized :: CoreExpr -- ^ The normalized expression -> ([CoreBndr], [Binding], CoreBndr) -splitNormalized expr = - case letexpr of - (Let (Rec binds) (Var res)) -> (args, binds, res) - _ -> error $ "Normalize.splitNormalized: Not in normal form: " ++ pprString expr ++ "\n" +splitNormalized expr = (args, binds, res) where (args, letexpr) = CoreSyn.collectBinders expr + (binds, resexpr) = flattenLets letexpr + res = case resexpr of + (Var x) -> x + _ -> error $ "Normalize.splitNormalized: Not in normal form: " ++ pprString expr ++ "\n" + +-- | Flattens nested lets into a single list of bindings. The expression +-- passed does not have to be a let expression, if it isn't an empty list of +-- bindings is returned. +flattenLets :: + CoreExpr -- ^ The expression to flatten. + -> ([Binding], CoreExpr) -- ^ The bindings and resulting expression. +flattenLets (Let binds expr) = + (bindings ++ bindings', expr') + where + -- Recursively flatten the contained expression + (bindings', expr') =flattenLets expr + -- Flatten our own bindings to remove the Rec / NonRec constructors + bindings = CoreSyn.flattenBinds [binds] +flattenLets expr = ([], expr)