Improve debug output timing.

[matthijs/master-project/cλash.git] / Normalize.hs

diff --git a/Normalize.hs b/Normalize.hs
index d06670cfbb363b244460c0497a3f3de12ba60234..647168b4587df5f782fca4aef6e8ce998fcae508 100644 (file)
--- a/Normalize.hs
+++ b/Normalize.hs
@@ -294,8 +294,10 @@ appsimpltop = everywhere ("appsimpl", appsimpl)
 typeprop, typeproptop :: Transform
 -- Transform any function that is applied to a type argument. Since type
 -- arguments are always the first ones to apply and we'll remove all type
--- arguments, we can simply do them one by one.
-typeprop expr@(App (Var f) (Type ty)) = do
+-- arguments, we can simply do them one by one. We only propagate type
+-- arguments without any free tyvars, since tyvars those wouldn't be in scope
+-- in the new function.
+typeprop expr@(App (Var f) arg@(Type ty)) | not $ has_free_tyvars arg = do
   id <- cloneVar f
   let newty = Type.applyTy (Id.idType f) ty
   let newf = Var.setVarType id newty
@@ -360,14 +362,15 @@ normalizeBind bndr = do
       case expr_maybe of 
         Just expr -> do
           -- Normalize this expression
+          trace ("Transforming " ++ (show bndr) ++ "\nBefore:\n\n" ++ showSDoc ( ppr expr ) ++ "\n") $ return ()
           expr' <- dotransforms transforms expr
-          let expr'' = trace ("Before:\n\n" ++ showSDoc ( ppr expr ) ++ "\n\nAfter:\n\n" ++ showSDoc ( ppr expr')) expr'
+          trace ("\nAfter:\n\n" ++ showSDoc ( ppr expr')) $ return ()
           -- And store the normalized version in the session
-          modA tsBindings (Map.insert bndr expr'')
+          modA tsBindings (Map.insert bndr expr')
           -- Find all vars used with a function type. All of these should be global
           -- binders (i.e., functions used), since any local binders with a function
           -- type should have been inlined already.
-          let used_funcs_set = CoreFVs.exprSomeFreeVars (\v -> (Type.isFunTy . snd . Type.splitForAllTys . Id.idType) v) expr''
+          let used_funcs_set = CoreFVs.exprSomeFreeVars (\v -> (Type.isFunTy . snd . Type.splitForAllTys . Id.idType) v) expr'
           let used_funcs = VarSet.varSetElems used_funcs_set
           -- Process each of the used functions recursively
           mapM normalizeBind used_funcs