Skip to content

Omit the pointer tagging zero check for fields for values known to be strict

Consider the following module:

{-# language MagicHash #-}

{-# OPTIONS_GHC -O2 -fforce-recomp #-}

module Strict
  ( total
  ) where

import GHC.Exts

data Numbers = NumbersCons Int# !Numbers | NumbersNil

total :: Numbers -> Int#
total nums = case nums of
  NumbersNil -> 0#
  nums' -> totalInner 0# nums'

totalInner :: Int# -> Numbers -> Int#
totalInner acc (NumbersCons n ns) = totalInner (acc +# n) ns
totalInner acc NumbersNil = acc

The second argument to totalInner is always evaluated to WHNF before it is scrutinized by the function. However, GHC does not take advantage of this. In the generated cmm, we see (I've added extra comments for my own benefit):

 totalInner_rtW_entry() //  [R3, R2]
         { info_tbls: [(c1h6,
                        label: block_c1h6_info
                        rep: StackRep [True]
                        srt: Nothing),
                       (c1hd,
                        label: totalInner_rtW_info
                        rep: HeapRep static { Fun {arity: 2 fun_type: ArgSpec 13} }
                        srt: Nothing)]
           stack_info: arg_space: 8 updfr_space: Just 8
         }
     {offset
       c1hd: // global
           _s1gp::P64 = R3;
           _s1go::I64 = R2;
           if ((Sp + -16) >= SpLim) (likely: True) goto c1h3; else goto c1he;
       c1h3: // global
           I64[Sp - 16] = c1h6;
           R1 = _s1gp::P64;
           I64[Sp - 8] = _s1go::I64;
           Sp = Sp - 16;
           if (R1 & 7 != 0) goto c1h6; else goto c1h7;
       c1h7: // global
           // The Numbers value had not yet been evaluated. Evaluate it.
           // Note: this cannot ever actually happen.
           call (I64[R1])(R1) returns to c1h6, args: 8, res: 8, upd: 8;
       c1h6: // global
           _s1go::I64 = I64[Sp + 8];
           if (R1 & 7 != 1) goto c1hb; else goto c1ha;
       c1hb: // global
           // Argument was NumbersNil
           R1 = _s1go::I64;
           Sp = Sp + 16;
           call (P64[Sp])(R1) args: 8, res: 0, upd: 8;
       c1ha: // global
           // Argument was NumbersCons
           Sp = Sp + 16;
           _s1gp::P64 = P64[R1 + 7];
           _s1go::I64 = _s1go::I64 + I64[R1 + 15];
           goto c1h3;
       c1he: // global
           R3 = _s1gp::P64;
           R2 = _s1go::I64;
           R1 = totalInner_rtW_closure;
           call (stg_gc_fun)(R3, R2, R1) args: 8, res: 0, upd: 8;
     }
 },

The check for the pointer tagging bits being zero is not needed. I suspect that it might to hard to teach this to GHC, but it would be nice if it were able to figure this out.

To upload designs, you'll need to enable LFS and have an admin enable hashed storage. More information