+
+Stix optimisation passes may wish to find out how many times a
+given temporary appears in a tree, so as to be able to decide
+whether or not to inline the assignment's RHS at usage site(s).
+
+\begin{code}
+stixCountTempUses :: Unique -> StixTree -> Int
+stixCountTempUses u t
+ = let qq = stixCountTempUses u
+ in
+ case t of
+ StReg reg
+ -> case reg of
+ StixTemp uu pr -> if u == uu then 1 else 0
+ StixMagicId mid -> 0
+
+ StIndex pk t1 t2 -> qq t1 + qq t2
+ StInd pk t1 -> qq t1
+ StAssign pk t1 t2 -> qq t1 + qq t2
+ StJump t1 -> qq t1
+ StCondJump lbl t1 -> qq t1
+ StData pk ts -> sum (map qq ts)
+ StPrim op ts -> sum (map qq ts)
+ StCall nm cconv pk ts -> sum (map qq ts)
+
+ StSegment _ -> 0
+ StInt _ -> 0
+ StDouble _ -> 0
+ StString _ -> 0
+ StLitLbl _ -> 0
+ StCLbl _ -> 0
+ StLabel _ -> 0
+ StFunBegin _ -> 0
+ StFunEnd _ -> 0
+ StFallThrough _ -> 0
+ StScratchWord _ -> 0
+ StComment _ -> 0
+
+
+stixSubst :: Unique -> StixTree -> StixTree -> StixTree
+stixSubst u new_u in_this_tree
+ = stixMapUniques f in_this_tree
+ where
+ f :: Unique -> Maybe StixTree
+ f uu = if uu == u then Just new_u else Nothing
+
+
+stixMapUniques :: (Unique -> Maybe StixTree) -> StixTree -> StixTree
+stixMapUniques f t
+ = let qq = stixMapUniques f
+ in
+ case t of
+ StReg reg
+ -> case reg of
+ StixMagicId mid -> t
+ StixTemp uu pr
+ -> case f uu of
+ Just xx -> xx
+ Nothing -> t
+
+ StIndex pk t1 t2 -> StIndex pk (qq t1) (qq t2)
+ StInd pk t1 -> StInd pk (qq t1)
+ StAssign pk t1 t2 -> StAssign pk (qq t1) (qq t2)
+ StJump t1 -> StJump (qq t1)
+ StCondJump lbl t1 -> StCondJump lbl (qq t1)
+ StData pk ts -> StData pk (map qq ts)
+ StPrim op ts -> StPrim op (map qq ts)
+ StCall nm cconv pk ts -> StCall nm cconv pk (map qq ts)
+
+ StSegment _ -> t
+ StInt _ -> t
+ StDouble _ -> t
+ StString _ -> t
+ StLitLbl _ -> t
+ StCLbl _ -> t
+ StLabel _ -> t
+ StFunBegin _ -> t
+ StFunEnd _ -> t
+ StFallThrough _ -> t
+ StScratchWord _ -> t
+ StComment _ -> t
+\end{code}
+
+\begin{code}
+data NatM_State = NatM_State UniqSupply Int
+type NatM result = NatM_State -> (result, NatM_State)
+
+mkNatM_State :: UniqSupply -> Int -> NatM_State
+mkNatM_State = NatM_State
+
+uniqOfNatM_State (NatM_State us delta) = us
+deltaOfNatM_State (NatM_State us delta) = delta
+
+
+initNat :: NatM_State -> NatM a -> (a, NatM_State)
+initNat init_st m = case m init_st of { (r,st) -> (r,st) }
+
+thenNat :: NatM a -> (a -> NatM b) -> NatM b
+thenNat expr cont st
+ = case expr st of { (result, st') -> cont result st' }
+
+returnNat :: a -> NatM a
+returnNat result st = (result, st)
+
+mapNat :: (a -> NatM b) -> [a] -> NatM [b]
+mapNat f [] = returnNat []
+mapNat f (x:xs)
+ = f x `thenNat` \ r ->
+ mapNat f xs `thenNat` \ rs ->
+ returnNat (r:rs)
+
+mapAndUnzipNat :: (a -> NatM (b,c)) -> [a] -> NatM ([b],[c])
+mapAndUnzipNat f [] = returnNat ([],[])
+mapAndUnzipNat f (x:xs)
+ = f x `thenNat` \ (r1, r2) ->
+ mapAndUnzipNat f xs `thenNat` \ (rs1, rs2) ->
+ returnNat (r1:rs1, r2:rs2)
+
+
+getUniqueNat :: NatM Unique
+getUniqueNat (NatM_State us delta)
+ = case splitUniqSupply us of
+ (us1,us2) -> (uniqFromSupply us1, (NatM_State us2 delta))
+
+getDeltaNat :: NatM Int
+getDeltaNat st@(NatM_State us delta)
+ = (delta, st)
+
+setDeltaNat :: Int -> NatM ()
+setDeltaNat delta (NatM_State us _)
+ = ((), NatM_State us delta)
+\end{code}