From: Matthijs Kooijman Date: Wed, 19 Aug 2009 14:45:54 +0000 (+0200) Subject: Rewrite substitute to clone the substitution range. X-Git-Url: https://git.stderr.nl/gitweb?a=commitdiff_plain;h=5eb86d4e07de5c2a31e0862314d100f72bfaa46e;p=matthijs%2Fmaster-project%2Fc%CE%BBash.git Rewrite substitute to clone the substitution range. This makes substitute no longer use CoreSubst for id substitutions, just for type substitutions (which we don't have to clone before replacing them). By cloning the substitution range before every substitution, we keep the binders in it globally unique. --- diff --git "a/c\316\273ash/CLasH/Normalize.hs" "b/c\316\273ash/CLasH/Normalize.hs" index 1f0509d..4ef112b 100644 --- "a/c\316\273ash/CLasH/Normalize.hs" +++ "b/c\316\273ash/CLasH/Normalize.hs" @@ -65,7 +65,7 @@ etatop = notappargs ("eta", eta) -------------------------------- beta, betatop :: Transform -- Substitute arg for x in expr -beta (App (Lam x expr) arg) = change $ substitute [(x, arg)] expr +beta (App (Lam x expr) arg) = setChanged >> substitute x arg expr -- Propagate the application into the let beta (App (Let binds expr) arg) = change $ Let binds (App expr arg) -- Propagate the application into each of the alternatives diff --git "a/c\316\273ash/CLasH/Normalize/NormalizeTools.hs" "b/c\316\273ash/CLasH/Normalize/NormalizeTools.hs" index dd62a34..e32bd34 100644 --- "a/c\316\273ash/CLasH/Normalize/NormalizeTools.hs" +++ "b/c\316\273ash/CLasH/Normalize/NormalizeTools.hs" @@ -138,7 +138,7 @@ inlinebind condition expr@(Let (NonRec bndr expr') res) = do if applies then -- Substitute the binding in res and return that - change $ substitute [(bndr, expr')] res + setChanged >> substitute bndr expr' res else -- Don't change this let return expr @@ -162,24 +162,28 @@ changeif :: Bool -> a -> TransformMonad a changeif True val = change val changeif False val = return val --- Replace each of the binders given with the coresponding expressions in the --- given expression. -substitute :: [(CoreBndr, CoreExpr)] -> CoreExpr -> CoreExpr -substitute [] expr = expr --- Apply one substitution on the expression, but also on any remaining --- substitutions. This seems to be the only way to handle substitutions like --- [(b, c), (a, b)]. This means we reuse a substitution, which is not allowed --- according to CoreSubst documentation (but it doesn't seem to be a problem). --- TODO: Find out how this works, exactly. -substitute ((b, e):subss) expr = substitute subss' expr' - where - -- Create the Subst - subs = (CoreSubst.extendSubst CoreSubst.emptySubst b e) - -- Apply this substitution to the main expression - expr' = CoreSubst.substExpr subs expr - -- Apply this substitution on all the expressions in the remaining - -- substitutions - subss' = map (Arrow.second (CoreSubst.substExpr subs)) subss +-- Creates a transformation that substitutes the given binder with the given +-- expression (This can be a type variable, replace by a Type expression). All +-- value binders in the expression are cloned before the replacement, to +-- guarantee uniqueness. +substitute :: CoreBndr -> CoreExpr -> Transform +-- Use CoreSubst to subst a type var in a type +substitute find (Type repl_ty) (Type ty) = do + let subst = CoreSubst.extendTvSubst CoreSubst.emptySubst find repl_ty + let ty' = CoreSubst.substTy subst ty + return (Type ty') +-- Use CoreSubst to subst a type var in the type annotation of a case +substitute find repl@(Type repl_ty) (Case scrut bndr ty alts) = do + let subst = CoreSubst.extendTvSubst CoreSubst.emptySubst find repl_ty + let ty' = CoreSubst.substTy subst ty + -- And continue with substituting on all subexpressions of the case + subeverywhere (substitute find repl) (Case scrut bndr ty' alts) +-- If we see the var to find, replace it by a uniqued version of repl +substitute find repl (Var var) | find == var = do + setChanged >> (Trans.lift $ CoreTools.genUniques repl) + +-- For all other expressions, just look in subexpressions +substitute find repl expr = subeverywhere (substitute find repl) expr -- Is the given expression representable at runtime, based on the type? isRepr :: (CoreTools.TypedThing t) => t -> TransformMonad Bool