Skip to content

Commit bb0099f

Browse files
committed
Fix fmap and bind for Array
`fmap` for `Array` got its indexing all wrong. Fix that. `>>=` for `Array` went into an infinite loop (haven't investigated why). Replace its implementation with the working `SmallArray` one. Fixes #92 and #95
1 parent a263cc2 commit bb0099f

File tree

1 file changed

+16
-13
lines changed

1 file changed

+16
-13
lines changed

Data/Primitive/Array.hs

Lines changed: 16 additions & 13 deletions
Original file line numberDiff line numberDiff line change
@@ -474,9 +474,9 @@ fromList l = fromListN (length l) l
474474
instance Functor Array where
475475
fmap f a =
476476
createArray (sizeofArray a) (die "fmap" "impossible") $ \mb ->
477-
let go i | i < sizeofArray a = return ()
478-
| otherwise = writeArray mb i (f $ indexArray a i)
479-
>> go (i+1)
477+
let go i | i == sizeofArray a = return ()
478+
| otherwise = writeArray mb i (f $ indexArray a i)
479+
>> go (i+1)
480480
in go 0
481481
#if MIN_VERSION_base(4,8,0)
482482
e <$ a = runST $ newArray (sizeofArray a) e >>= unsafeFreezeArray
@@ -521,17 +521,20 @@ instance Alternative Array where
521521
instance Monad Array where
522522
return = pure
523523
(>>) = (*>)
524-
a >>= f = push 0 [] (sizeofArray a - 1)
524+
525+
ary >>= f = collect 0 [] (la-1)
525526
where
526-
push !sz bs i
527-
| i < 0 = build sz bs
528-
| otherwise = let b = f $ indexArray a i
529-
in push (sz + sizeofArray b) (b:bs) (i+1)
530-
531-
build sz stk = createArray sz (die ">>=" "impossible") $ \mb ->
532-
let go off (b:bs) = copyArray mb off b 0 (sizeofArray b) >> go (off + sizeofArray b) bs
533-
go _ [ ] = return ()
534-
in go 0 stk
527+
la = sizeofArray ary
528+
collect sz stk i
529+
| i < 0 = createArray sz (die ">>=" "impossible") $ fill 0 stk
530+
| otherwise = let sb = f $ indexArray ary i in
531+
collect (sz + sizeofArray sb) (sb:stk) (i-1)
532+
533+
fill _ [ ] _ = return ()
534+
fill off (sb:sbs) smb =
535+
copyArray smb off sb 0 (sizeofArray sb)
536+
*> fill (off + sizeofArray sb) sbs smb
537+
535538
fail _ = empty
536539

537540
instance MonadPlus Array where

0 commit comments

Comments
 (0)