---------------------------------------------------------
-- |
-- Module:      Data.LazyArray.Lowlevel
-- Copyright:   (c) 2008, Milan Straka
-- License:     BSD 3 Clause
-- Maintainer:  fox@ucw.cz
-- Stability:   experimental
-- Portability: non-portable (uses Data.Array.IO)
--
-- This is an implementation of monolithic lazy array. If you want to know
-- what an monolithic lazy array is good for, you can read for example
-- the paper \"Efficient Graph Algorithms Using Lazy Monolithic Arrays\": 
-- <http://citeseer.ist.psu.edu/95126.html>.
--
-- This module implements lowlevel lazy array somewhat similar to 'Data.LazyArray.lArrayFirst',
-- so read its description first. This implementation
-- uses no temporary buffer (at least in optimised GHC build) and
-- for index i it returns not the first associated element, but
-- the first \'nonzero\' element (or \'zero\' if there are no elements).
-- Don't forget to import some kind of arrays when using this module.
--
-- Benchmark of various implementations of DFS can be found in the 
-- "Data.LazyArray" module.
---------------------------------------------------------

module Data.LazyArray.Lowlevel(
    -- * Lazy array methods
    -- | This specialised lazy array is not an 'Array' when being constructed,
    -- but can be converted to (using 'Data.Array.MArray.unsafeFreeze')
    -- when fully built. The usage of 'Data.Array.MArray.unsafeFreeze' is safe
    -- and when using optimised build, it is inplace and imposes no overhead.
    --
    -- The usage is very similar to "Data.LazyArray", which is demonstrated
    -- on the example from that module:
    --
    -- @dnum::Array Int [Int]->Int->Array Int Int
      --dnum g s = laFreeze marks where
    --   list = dfs' [s] 0
    --   marks = laCreate (-1) (bounds g) list
    --   dfs' []     _ = []
    --   dfs' (s:ss) n = (s,n) : if n == (marks \`laAt\` s) then dfs' ((g!s)++ss) (n+1) else dfs' ss n
    -- @
    LArray, laCreate, laAt, laFreeze,

    -- * Using 'Maybe' as the \'zero\' and \'nonzero\' element
    -- | 'Maybe' can be used to distinguish between \'zero\' and \'nonzero\' element.
    -- Convenience method for creating such an lazy array from associations 
    -- that of type (i, e) and not (i, 'Maybe' e) is provided.
    mlaCreate
  ) where
import Data.Array
import Data.Array.IO
import Data.IORef
import System.IO.Unsafe

-- | The lazyarray in construction is not classic 'Array', but has the same parameters.
data LArray i e = LArray !(IORef ([(i,e)],Int)) !(IOArray i e) !e

-- | Creates an lazy array, using first argument as \'zero\' element for this array.
-- The list of associations is left intact until needed by 'laAt' or 'laFreeze'.
laCreate::(Ix i)=>
          e           -- ^ \'zero\' element
        ->(i,i)       -- ^ bounds of the array
        ->[(i,e)]     -- ^ list of associations
        ->LArray i e  -- ^ resulting lazy array

laCreate zero bnds assoc = 
    LArray (unsafePerformIO$newIORef (assoc, rangeSize bnds)) (unsafePerformIO$newArray bnds zero) zero

-- | This method creates lazy array using 'Nothing' for \'zero\' element.
-- It is just a simple wrapper of 'laCreate':
--
-- @mlaCreate bnds assoc = laCreate Nothing bnds (map (\\(i,e)->(i,Just e)) assoc)@
mlaCreate::(Ix i)=>(i,i)->[(i,e)]->LArray i (Maybe e)
mlaCreate bnds assoc = laCreate Nothing bnds (map (\(i,e)->(i,Just e)) assoc)


-- | Returns an element on the i-th position of the lazy array. If it was already
-- found, just return it. If it was not found yet, consume the list of associations
-- until it is empty or the \'nonzero\' association for i is found.
-- If no \'nonzero\' association is found, returns \'zero'.
-- All visited elements from the association list are processed and not visited any more.
--
-- When not concerned about the laziness and time complexity,
--
-- @(laCreate zero bnds assoc) \`laAt\` i = zero \`fromMaybe\` (find (\\(i',e)->i'==i && e\/=zero) assoc)@
laAt::(Ix i,Eq e)=>LArray i e->i->e
(LArray ref elems zero) `laAt` i = case unsafePerformIO $ readArray elems i of
                                     x->if x/=zero then x else unsafePerformIO $ readIORef ref >>= uncurry more
 where
  more []        _    = writeIORef ref ([],0) >> return zero
  more ((j,e):t) left = if e==zero then more t left
                        else if j==i then writeArray elems i e >> writeIORef ref (t,left-1) >> return e
                             else do e'<-readArray elems j
                                     if e'==zero then writeArray elems j e >> more t (left-1) else more t left


-- | Convert lazy array to 'Array'. Because the result is not lazy,
-- this function /forces the evaluation of the whole association list/ before returning,
-- so it should be used when the lazy array is fully contructed (ie. the association
-- list is ended by []).
--
-- Once again - this function is really \"non-lazy\", as it traverses the whole associtation
-- list, no matter which elements from the resulting 'Array' will be needed. Even if
-- only 1-st element is needed and even if it could already be found, the whole rest
-- of the association list is processed. (Small heuristic is implemented - when all
-- members of resulting Array are \'nonzero\', the traversal of the association list is stopped.)
--
-- This function uses 'Data.Array.MArray.unsafeFreeze' to convert 'IOArray' to 'Array'.
-- It is used after the whole association list is processed, so it is safe, and
-- when using optimised GHC build, it imposes no time or space overhead.
laFreeze::(Ix i, Eq e)=>LArray i e->Array i e
laFreeze (LArray ref elems zero) = unsafePerformIO $ readIORef ref >>= uncurry finish
 where
  finish _          0    = writeIORef ref ([],0) >> unsafeFreeze elems
  finish []         _    = writeIORef ref ([],0) >> unsafeFreeze elems
  finish ((i,e):es) left = if e==zero then finish es left
                           else do e'<-readArray elems i
                                   if e'==zero then writeArray elems i e>>finish es (left-1)else finish es left