[commit: ghc] wip/kavon-nosplit-llvm: Some debug output while working on return types. (c9700eb)

git at git.haskell.org git at git.haskell.org
Wed Aug 23 23:00:54 UTC 2017


Repository : ssh://git@git.haskell.org/ghc

On branch  : wip/kavon-nosplit-llvm
Link       : http://ghc.haskell.org/trac/ghc/changeset/c9700ebf8f4d5a4afd82eec961c0ad7a0a73cb4b/ghc

>---------------------------------------------------------------

commit c9700ebf8f4d5a4afd82eec961c0ad7a0a73cb4b
Author: Kavon Farvardin <kavon at farvard.in>
Date:   Tue Aug 8 18:59:13 2017 -0500

    Some debug output while working on return types.


>---------------------------------------------------------------

c9700ebf8f4d5a4afd82eec961c0ad7a0a73cb4b
 compiler/codeGen/StgCmmBind.hs | 14 ++++++++++++--
 1 file changed, 12 insertions(+), 2 deletions(-)

diff --git a/compiler/codeGen/StgCmmBind.hs b/compiler/codeGen/StgCmmBind.hs
index 31775d6..3d88200 100644
--- a/compiler/codeGen/StgCmmBind.hs
+++ b/compiler/codeGen/StgCmmBind.hs
@@ -1,4 +1,5 @@
 {-# LANGUAGE CPP #-}
+{-# LANGUAGE BangPatterns #-}
 
 -----------------------------------------------------------------------------
 --
@@ -506,11 +507,17 @@ closureCodeBody top_lvl bndr cl_info cc args arity body fv_details
                 -- Load free vars out of closure *after*
                 -- heap check, to reduce live vars over check
                 ; when node_points $ load_fvs node lf_info fv_bindings
-                ; void $ cgExpr body
+                ; retKind <- cgExpr body
+                ; let !x = trace (retK2s retKind) ()
+                ; return ()
                 }}}
 
   }
 
+retK2s :: ReturnKind -> String  
+retK2s AssignedDirectly = "AssignedDirectly"
+retK2s (ReturnedTo _ _ _) = "ReturnedTo"
+
 -- Note [NodeReg clobbered with loopification]
 -- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
 --
@@ -590,7 +597,10 @@ thunkCode cl_info fv_details _cc node arity body
                ; let lf_info = closureLFInfo cl_info
                ; fv_bindings <- mapM bind_fv fv_details
                ; load_fvs node lf_info fv_bindings
-               ; void $ cgExpr body }}}
+               ; retKind <- cgExpr body
+               ; let !x = trace (retK2s retKind) ()
+               ; return ()
+               }}}
 
 
 ------------------------------------------------------------------------



More information about the ghc-commits mailing list