ArrayList lol

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
module Data.STArrayList where

import Control.Monad
import Data.STRef
import Data.Array.ST

data STArrayList s i e = STArrayList
	{ values_     :: STRef s (STArray s i e)
	, lowerBound_ :: STRef s i
	, upperBound_ :: STRef s i
	, size_       :: STRef s i
	}

newSTArrayList = newSTArrayListSize 10
newSTArrayListSize 0 = newSTArrayListSize 1
newSTArrayListSize n' = let n = abs n' in do
	vs <- newArray_ (-abs n,abs n)
	vr <- newSTRef vs
	lb <- newSTRef 1
	ub <- newSTRef 0
	s  <- newSTRef n
	return (STArrayList vr lb ub s)

lowerBound = readSTRef  . lowerBound_
upperBound = readSTRef  . upperBound_
size       = readSTRef  . size_
values     = readSTRef  . values_

readValue  al i   = values al >>= \vs -> readArray  vs i
writeValue al i e = values al >>= \vs -> writeArray vs i e

getBounds al = liftM2 (,) (lowerBound al) (upperBound al)

snoc al a = do
	ub <- upperBound al
	s  <- size al
	when (ub >= s) (doubleSize al)
	writeSTRef (upperBound_ al) (ub+1)
	writeValue al (ub+1) a
cons a al = do
	lb <- lowerBound al
	s  <- size al
	when (lb <= -s) (doubleSize al)
	writeSTRef (lowerBound_ al) (lb-1)
	writeValue al (lb-1) a

doubleSize al = do
	lb <- lowerBound al
	ub <- upperBound al
	s  <- size al
	v  <- newArray_ (-s*2,s*2)
	forM_ [lb..ub] $ \i -> readValue al i >>= writeArray v i
	writeSTRef (values_ al) v

readSTArrayList al i = do
	lb <- lowerBound al
	ub <- upperBound al
	if inRange (lb,ub) (lb+i) then readValue al (lb+i) else error "No fair, out of bounds array access!"

toList al = do
	lb <- lowerBound al
	ub <- upperBound al
	mapM (readValue al) [lb..ub]

uncons al = do
	lb <- lowerBound al
	ub <- upperBound al
	if lb > ub
		then return Nothing
		else do
			writeSTRef (lowerBound_ al) (lb+1)
			fmap Just (readValue al lb)

unsnoc al = do
	lb <- lowerBound al
	ub <- upperBound al
	if lb > ub
		then return Nothing
		else do
			writeSTRef (upperBound_ al) (ub-1)
			fmap Just (readValue al ub)

ArrayList lol (annotation)

1
2
3
4
5
6
7
8
doubleSize al = do
	lb <- lowerBound al
	ub <- upperBound al
	s  <- size al
	v  <- newArray_ (-s*2,s*2)
	forM_ [lb..ub] $ \i -> readValue al i >>= writeArray v i
	writeSTRef (values_ al) v
	writeSTRef (size_   al) (s*2) -- derp, can't forget this