Fix space leak (non-strict data fields)

This commit is contained in:
2022-08-24 10:08:55 +01:00
parent e7e20277e4
commit 13b07b53ce
3 changed files with 20 additions and 16 deletions
+11 -11
View File
@@ -34,8 +34,7 @@ foldCr ::
Creature ->
World ->
World
--foldCr xs cr w = foldr ($ cr) w xs
foldCr xs cr w = foldl' f w $ reverse xs
foldCr xs cr w = foldl' f w xs
where
f w' g = case w' ^? cWorld . creatures . ix (_crID cr) of
Just cr' -> g cr' w'
@@ -51,15 +50,15 @@ foldCr xs cr w = foldl' f w $ reverse xs
stateUpdate :: (Creature -> World -> World) -> Creature -> World -> World
stateUpdate f =
foldCr
[ equipmentEffects
, invSideEff
, upInv -- upInv must be called before invSideEff 22.05.23
, movementSideEff
, f
, internalUpdate
, clearDamage -- these three
[ doDamage -- these three
, checkDeath -- must be in
, doDamage -- this order 22/06/05
, clearDamage -- this order 24/7/22
, internalUpdate
, f
, movementSideEff
, upInv -- upInv must be called before invSideEff 22.05.23
, invSideEff
, equipmentEffects
]
checkDeath :: Creature -> World -> World
@@ -245,7 +244,8 @@ itemUpdate cr i
| otherwise = baseupdate False
where
baseupdate bool =
updateAutoRecharge . (itUse %~ useUpdate)
updateAutoRecharge
. (itUse %~ useUpdate)
. (itLocation .~ InInv (_crID cr) i)
. (itIsHeld .~ bool)
+3 -3
View File
@@ -1,6 +1,6 @@
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DeriveAnyClass #-}
--{-# LANGUAGE StrictData #-}
--{-# LANGUAGE DeriveGeneric #-}
--{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE StrictData #-}
{-# LANGUAGE TemplateHaskell #-}
module Dodge.Data.Item (
+6 -2
View File
@@ -187,8 +187,12 @@ defaultImpulsive ::
Creature ->
World ->
World
defaultImpulsive fs cr = updateRandGen -- . stateUpdate (const id) cr
--fmap (fmap updateRandGen) . stateUpdate . impulsiveAIBefore . chainCreatureUpdates
defaultImpulsive
--xs cr = id
-- updateRandGen -- . stateUpdate (const id) cr
= fmap (fmap updateRandGen) . stateUpdate . impulsiveAIBefore . chainCreatureUpdates
--xs cr = updateRandGen . stateUpdate (const id) cr
--xs cr = stateUpdate (const id) cr
where
updateRandGen w =
let (_, g) = randomR (0, 1 :: Int) (_randGen w)