Add a CaseAlt constructor to CoreContext.
[matthijs/master-project/cλash.git] / clash / CLasH / Normalize / NormalizeTools.hs
index cdb7ee01352a85fca6cf080de9019259c359d632..0652081760d8f646a19823343a95e84c10bf665e 100644 (file)
@@ -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?