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 -> Creature ->
World -> World ->
World World
--foldCr xs cr w = foldr ($ cr) w xs foldCr xs cr w = foldl' f w xs
foldCr xs cr w = foldl' f w $ reverse xs
where where
f w' g = case w' ^? cWorld . creatures . ix (_crID cr) of f w' g = case w' ^? cWorld . creatures . ix (_crID cr) of
Just cr' -> g cr' w' 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 :: (Creature -> World -> World) -> Creature -> World -> World
stateUpdate f = stateUpdate f =
foldCr foldCr
[ equipmentEffects [ doDamage -- these three
, invSideEff
, upInv -- upInv must be called before invSideEff 22.05.23
, movementSideEff
, f
, internalUpdate
, clearDamage -- these three
, checkDeath -- must be in , 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 checkDeath :: Creature -> World -> World
@@ -245,7 +244,8 @@ itemUpdate cr i
| otherwise = baseupdate False | otherwise = baseupdate False
where where
baseupdate bool = baseupdate bool =
updateAutoRecharge . (itUse %~ useUpdate) updateAutoRecharge
. (itUse %~ useUpdate)
. (itLocation .~ InInv (_crID cr) i) . (itLocation .~ InInv (_crID cr) i)
. (itIsHeld .~ bool) . (itIsHeld .~ bool)
+3 -3
View File
@@ -1,6 +1,6 @@
{-# LANGUAGE DeriveGeneric #-} --{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DeriveAnyClass #-} --{-# LANGUAGE DeriveAnyClass #-}
--{-# LANGUAGE StrictData #-} {-# LANGUAGE StrictData #-}
{-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE TemplateHaskell #-}
module Dodge.Data.Item ( module Dodge.Data.Item (
+6 -2
View File
@@ -187,8 +187,12 @@ defaultImpulsive ::
Creature -> Creature ->
World -> World ->
World World
defaultImpulsive fs cr = updateRandGen -- . stateUpdate (const id) cr defaultImpulsive
--fmap (fmap updateRandGen) . stateUpdate . impulsiveAIBefore . chainCreatureUpdates --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 where
updateRandGen w = updateRandGen w =
let (_, g) = randomR (0, 1 :: Int) (_randGen w) let (_, g) = randomR (0, 1 :: Int) (_randGen w)