-pushAtom True{-tagged-} d p (AnnVar v)
- = case lookupBCEnv_maybe p v of
- Just offset -> (PUSH_L sz offset, sz)
- Nothing -> ASSERT(sz == 1) (PUSH_G nm, sz)
- where
- nm = getName v
- sz = taggedIdSizeW v
-
-pushAtom False{-not tagged-} d p (AnnVar v)
- = case lookupBCEnv_maybe p v of
- Just offset -> (PUSH_L sz (offset+1), sz-1)
- Nothing -> ASSERT(sz == 1) (PUSH_G nm, sz)
- where
- nm = getName v
- sz = untaggedIdSizeW v
+-- NB (further) that the env p must map each variable to the highest-
+-- numbered stack slot for it. For example, if the stack has depth 4
+-- and we tagged-ly push (v :: Int#) on it, the value will be in stack[4],
+-- the tag in stack[5], the stack will have depth 6, and p must map v to
+-- 5 and not to 4.
+
+pushAtom tagged d p (AnnVar v)
+ = let str = "\npushAtom " ++ showSDocDebug (ppr v) ++ ", depth = " ++ show d
+ ++ ", env =\n" ++
+ showSDocDebug (nest 4 (vcat (map ppr (fmToList p))))
+ ++ " -->\n" ++
+ showSDoc (nest 4 (vcat (map ppr (fromOL (fst result)))))
+ ++ "\nendPushAtom " ++ showSDocDebug (ppr v)
+ str' = if str == str then str else str
+
+ result
+ = case lookupBCEnv_maybe p v of
+ Just d_v -> (toOL (nOfThem nwords (PUSH_L (d-d_v+sz_t-2))), sz_t)
+ Nothing -> ASSERT(sz_t == 1) (unitOL (PUSH_G nm), sz_t)
+
+ nm = getName v
+ sz_t = taggedIdSizeW v
+ sz_u = untaggedIdSizeW v
+ nwords = if tagged then sz_t else sz_u
+ in
+ --trace str'
+ result