X-Git-Url: https://git.stderr.nl/gitweb?a=blobdiff_plain;f=clash%2FCLasH%2FNormalize%2FNormalizeTools.hs;h=0652081760d8f646a19823343a95e84c10bf665e;hb=bebe01ce76e62bea88aba87d5cceecfab7a0c6c4;hp=cdb7ee01352a85fca6cf080de9019259c359d632;hpb=04f836932ad17dd557af0ba388a12d2b74c1e7d7;p=matthijs%2Fmaster-project%2Fc%CE%BBash.git diff --git a/clash/CLasH/Normalize/NormalizeTools.hs b/clash/CLasH/Normalize/NormalizeTools.hs index cdb7ee0..0652081 100644 --- a/clash/CLasH/Normalize/NormalizeTools.hs +++ b/clash/CLasH/Normalize/NormalizeTools.hs @@ -80,22 +80,30 @@ subeverywhere trans c (App a b) = do return $ App a' b' subeverywhere trans c (Let (NonRec b bexpr) expr) = do - bexpr' <- trans (LetBinding:c) bexpr - expr' <- trans (LetBody:c) expr + -- In the binding of a non-recursive let binding, no extra binders are + -- in scope. + bexpr' <- trans (LetBinding []:c) bexpr + -- In the body of a non-recursive let binding, the bound binder is in + -- scope. + expr' <- trans ((LetBody [b]):c) expr return $ Let (NonRec b bexpr') expr' subeverywhere trans c (Let (Rec binds) expr) = do - expr' <- trans (LetBody:c) expr + -- In the body of a recursive let, all binders are in scope + expr' <- trans ((LetBody bndrs):c) expr binds' <- mapM transbind binds return $ Let (Rec binds') expr' where + bndrs = map fst binds transbind :: (CoreBndr, CoreExpr) -> TransformMonad (CoreBndr, CoreExpr) transbind (b, e) = do - e' <- trans (LetBinding:c) e + -- In the bindings of a recursive let, all binders are in scope + e' <- trans ((LetBinding bndrs):c) e return (b, e') subeverywhere trans c (Lam x expr) = do - expr' <- trans (LambdaBody:c) expr + -- In the body of a lambda, the bound binder is in scope. + expr' <- trans ((LambdaBody x):c) expr return $ Lam x expr' subeverywhere trans c (Case scrut b t alts) = do @@ -105,7 +113,7 @@ subeverywhere trans c (Case scrut b t alts) = do where transalt :: CoreAlt -> TransformMonad CoreAlt transalt (con, binders, expr) = do - expr' <- trans (Other:c) expr + expr' <- trans ((CaseAlt b):c) expr return (con, binders, expr') subeverywhere trans c (Var x) = return $ Var x @@ -154,12 +162,15 @@ inlinebind condition context expr@(Let (Rec binds) res) = do reps' <- mapM (subs_bind bndr val) reps -- And then perform the remaining substitutions do_substitute reps' expr' + + -- All binders bound in the transformed recursive let + bndrs = map fst binds -- Replace the given binder with the given expression in the -- expression oft the given let binding subs_bind :: CoreBndr -> CoreExpr -> (CoreBndr, CoreExpr) -> TransformMonad (CoreBndr, CoreExpr) subs_bind bndr expr (b, v) = do - v' <- substitute_clone bndr expr (LetBinding:context) v + v' <- substitute_clone bndr expr ((LetBinding bndrs):context) v return (b, v') @@ -216,7 +227,10 @@ isRepr' tything = case CoreTools.getType tything of is_local_var :: CoreSyn.CoreExpr -> TranslatorSession Bool is_local_var (CoreSyn.Var v) = do bndrs <- getGlobalBinders - return $ v `notElem` bndrs + -- A datacon id is not a global binder, but not a local variable + -- either. + let is_dc = Id.isDataConWorkId v + return $ not is_dc && v `notElem` bndrs is_local_var _ = return False -- Is the given binder defined by the user?