sorry, i should clarify. i'm not using the little "f x" function
refered to in earlier mesgs.
i got this error mesg:
SignalArray.hs:78: Couldn't match the type `ST' against `ST'
Expected: `ST ta1tm [[ArrResp ta1m9 ta1ma]]'
Inferred: `ST ta1yp [[ArrResp ta1m9 ta1ma]]'
In the first argument of `runST', namely
`(do
arr - newSTArray bounds initVal
initArray arr
performRequests arr)'
In the second argument of `$', namely
`runST (do
arr - newSTArray bounds initVal
initArray arr
performRequests arr)'
In an equation for function `stateArray':
`stateArray ((bounds@(loBound, hiBound)), initWrites) (Sig reqss)
= Sig
$ (runST (do...
when compiling this rather long and ugly attached below.
however, lazyToStrictST, did the trick.
--
module SignalArray
(
stateArray
,updateArray
,ArrayDesc
,ArrReq(..)
,ArrResp(..)
) where
import Array
import Signal
import LazyST
import ST(runST)
import BasicTypes
-- Begin Signature
stateArray :: (Enum a, Ix a) = ArrayDesc a b - Signal [ArrReq a b] -
Signal [ArrResp a b]
updateArray :: Ix a =
Signal (Array a b) -
[(Signal Bool,(Signal a,Signal b))] -
Signal (Array a b)
-- End Signature
-- Updates an array Signal, given a static list of updaters. Each
-- updater consists of a Boolean enable signal, and a signal pair
-- of the update address and update value.
updateArray arr updaters
= foldr (\(updateEnable,updater) prevArray -
if' updateEnable
then' (lift2 (//) prevArray (singleton (bundle updater)))
else' prevArray)
arr
updaters
where singleton = lift1 $ \x - [x]
Array implemented with lazy state -
-- Info needed to initialize a stateful array.
-- the list of tuples denotes what the various array subranges
-- should be initialized to.
--type ArrayDesc index val = ((index,index),[(index,index,val)])
-- Array request
data ArrReq i a = ReadArr i |
WriteArr i i a |
WriteFn i (a - a) | -- modify contents at location i
FreezeArr
deriving Show
-- Array response
data ArrResp i a = ReadVal a |
Written |
WrittenFn a |
ArrayVal (Array i a)
deriving Show
{-
stateArray :: (Ix i, Enum i) =
ArrayDesc i a -- array initialization info
-
Signal [ArrReq i a] -- array requests to read
-- and write values from/to
-- the array.
-
Signal [ArrResp i a]-- array responses corresponding
-- to ReadArr and FreezeArr
-- requests.
-}
stateArray (bounds@(loBound,hiBound),initWrites) (Sig reqss)
= Sig $ runST (
do arr - newSTArray bounds initVal
initArray arr
performRequests arr)
where
-- Determine what the array should be initialized to; remove
-- some of the writes that would initialize the array to the
-- same value to speed up the initialization process.
contigWrites = contigWriteRanges
(loBound,hiBound,
error "uninitialized value read from stateArray")
initWrites
maxRange@(_,_,initVal) = maxWriteRange contigWrites
reducedInitWrites = removeWriteRange maxRange contigWrites
-- Initialize the array according to 'initWrites'
initArray arr
= strictSequence [ writeSTArray arr index val |
(lowIdx,hiIdx,val) - reducedInitWrites,
index - range (lowIdx,hiIdx) ]
--accumulate :: Monad m = [m a] - m [a]
accumulate [] = return []
accumulate (c:cs) = do x - c
xs - (accumulate cs)
return (x:xs)
-- Perform the requested writes, reads, and freezes for each clock cycle
performRequests arr
= accumulate $ map performReqs reqss
where
performReqs reqs
= mapM performReq reqs
performReq (ReadArr i)
= do val - readSTArray arr i
return (ReadVal val)
performReq (WriteArr loAddr hiAddr val)
= do sequence [ writeSTArray arr loc val |
