From: Matthijs Kooijman <matthijs@stdin.nl>
Date: Wed, 16 Jun 2010 13:34:14 +0000 (+0200)
Subject: Store which binders become in scope in the CoreContext.
X-Git-Url: https://git.stderr.nl/gitweb?a=commitdiff_plain;h=db856c9442e721689a566c6f91e8763f075e7da5;p=matthijs%2Fmaster-project%2Fc%CE%BBash.git

Store which binders become in scope in the CoreContext.

This allows us to determine what variables are local in a more reliable
way and allows distinguishing arguments from other local variables.
---

diff --git a/clash/CLasH/Normalize/NormalizeTools.hs b/clash/CLasH/Normalize/NormalizeTools.hs
index eff8b67..3077956 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
@@ -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')
 
 
diff --git a/clash/CLasH/Normalize/NormalizeTypes.hs b/clash/CLasH/Normalize/NormalizeTypes.hs
index 07ccd97..506633d 100644
--- a/clash/CLasH/Normalize/NormalizeTypes.hs
+++ b/clash/CLasH/Normalize/NormalizeTypes.hs
@@ -21,12 +21,15 @@ data CoreContext = AppFirst        -- ^ The expression is the first
                  | AppSecond       -- ^ The expression is the second
                                    --   argument of an application
                                    --   (i.e., something is applied to it)
-                 | LetBinding      -- ^ The expression is bound in a
+                 | LetBinding [CoreSyn.CoreBndr]
+                                   -- ^ The expression is bound in a
                                    --   (recursive or non-recursive) let
                                    --   expression.
-                 | LetBody         -- ^ The expression is the body of a
+                 | LetBody [CoreSyn.CoreBndr]
+                                   -- ^ The expression is the body of a
                                    --   let expression
-                 | LambdaBody      -- ^ The expression is the body of a
+                 | LambdaBody CoreSyn.CoreBndr
+                                   -- ^ The expression is the body of a
                                    --   lambda abstraction
                  | Other           -- ^ Another context
   deriving (Eq, Show)
@@ -43,11 +46,11 @@ is_appfirst_ctx _ = False
 is_appsecond_ctx AppSecond = True
 is_appsecond_ctx _ = False
 
-is_letbinding_ctx LetBinding = True
+is_letbinding_ctx (LetBinding _) = True
 is_letbinding_ctx _ = False
 
-is_letbody_ctx LetBody = True
+is_letbody_ctx (LetBody _) = True
 is_letbody_ctx _ = False
 
-is_lambdabody_ctx LambdaBody = True
+is_lambdabody_ctx (LambdaBody _) = True
 is_lambdabody_ctx _ = False