Skip to content

Commit

Permalink
Improve complexity of delete from O(N) to O(log(n))
Browse files Browse the repository at this point in the history 
Also make the C delete function mutable, so the optimiser can
omit the delete when the operations are linear.
  • Loading branch information
@HuwCampbell
HuwCampbell committed Jun 27, 2024
1 parent 8ecedf9 commit d4b992f
Show file tree
Hide file tree
Showing 3 changed files with 56 additions and 83 deletions.
20 changes: 6 additions & 14 deletions data/sea/30-array.h
View file
Original file line number Diff line number Diff line change
Expand Up @@ -247,7 +247,7 @@ static ARRAY_T(t) INLINE ARRAY_FUN(t,swap)


/*
Immutable Delete (arr, ix)
Mutable Delete (arr, ix)
*/

#define MK_ARRAY_DELETE(t) \
Expand All @@ -258,25 +258,17 @@ static ARRAY_T(t) INLINE ARRAY_FUN(t,delete)
VALID_ARRAY(x) \
VALID_INDEX(ix_delete, x) \
\
iint_t count = x->count; \
iint_t capacity = iarray_size(count - 1); \
size_t bytes = ARRAY_SIZE(t, capacity); \
iint_t count = x->count; \
\
ARRAY_T(t) arr = (ARRAY_T(t))anemone_mempool_alloc(pool, bytes); \
\
for (iint_t ix = 0; ix != ix_delete; ++ix) { \
t##_t val = ARRAY_PAYLOAD(t,x)[ix]; \
ARRAY_PAYLOAD(t,arr)[ix] = val; \
} \
for (iint_t ix = ix_delete + 1; ix != count; ++ix) { \
t##_t val = ARRAY_PAYLOAD(t,x)[ix]; \
ARRAY_PAYLOAD(t,arr)[ix - 1] = val; \
ARRAY_PAYLOAD(t,x)[ix - 1] = val; \
} \
\
arr->count = count - 1; \
x->count = count - 1; \
\
VALID_ARRAY(arr) \
return arr; \
VALID_ARRAY(x) \
return x; \
}


Expand Down
116 changes: 50 additions & 66 deletions icicle-compiler/src/Icicle/Avalanche/Statement/Flatten/Algorithms.hs
View file
Original file line number Diff line number Diff line change
Expand Up @@ -98,30 +98,6 @@ updateAcc a_fresh acc t x
= do n'x <- freshPrefix "update_acc"
return $ Read n'x acc t $ Write acc $ x $ XVar a_fresh n'x

pushArrayAcc :: (Hashable n, Monad m, IsString n)
=> a -> ValType -> Name n -> Flat.X a n
-> FreshT n m (Flat.S a n)
pushArrayAcc a_fresh t n'acc push
= do let t' = ArrayT t
sz arr = arrLen t arr
put arr i x = arrUpd t arr i x

updateAcc a_fresh n'acc t' (\arr -> put arr (sz arr) push)
where
Flat.FlatOps {..} = Flat.flatOps a_fresh

-- | Immutable put
putArrayAcc :: (Hashable n, Monad m, IsString n)
=> a -> ValType -> Name n -> Flat.X a n -> Flat.X a n
-> FreshT n m (Flat.S a n)
putArrayAcc a_fresh t n'acc idx push
= do let t' = ArrayT t
put arr i x = arrUpd t arr i x

updateAcc a_fresh n'acc t' (\arr -> put arr idx push)
where
Flat.FlatOps {..} = Flat.flatOps a_fresh

-- | Mutable put
putArrayAcc' :: (Hashable n, Monad m, IsString n)
=> a -> ValType -> Name n -> Flat.X a n -> Flat.X a n
Expand Down Expand Up @@ -686,63 +662,71 @@ avalancheMapDelete
-> FlatM a n
avalancheMapDelete a_fresh stm flatX tk tv key map
= flatX' key $ \key' -> flatX' map $ \map' -> do
n'map'k <- fresh
n'map'v <- fresh
n'map'sz <- fresh
let acc'map'k= Accumulator n'map'k (ArrayT tk) (mapKeys tk tv map')
acc'map'v= Accumulator n'map'v (ArrayT tv) (mapVals tk tv map')
n_acc_keys <- freshPrefix "map_insert_acc_keys"
n_acc_vals <- freshPrefix "map_insert_acc_vals"
n_acc_idx <- freshPrefix "map_insert_acc_bs_index"
n_acc_found <- freshPrefix "map_insert_acc_bs_found"
n_loc_keys <- freshPrefix "map_insert_loc_keys"
n_loc_vals <- freshPrefix "map_insert_loc_vals"
n_cpy_keys <- freshPrefix "map_insert_cpy_keys"
n_cpy_vals <- freshPrefix "map_insert_cpy_vals"
n_loc_idx <- freshPrefix "map_insert_loc_bs_index"
n_loc_found <- freshPrefix "map_insert_loc_bs_found"
n_res <- freshPrefix "map_insert_result"

x'map'k = xVar n'map'k
x'map'v = xVar n'map'v
let v_keys = xVar n_loc_keys
v_vals = xVar n_loc_vals
v_idx = xVar n_loc_idx
v_found = xVar n_loc_found
v_res = xVar n_res

read'k = Read n'map'k n'map'k (ArrayT tk)
read'v = Read n'map'v n'map'v (ArrayT tv)
let acc_idx = Accumulator n_acc_idx IntT $ xValue IntT (VInt (-1))
acc_found = Accumulator n_acc_found BoolT $ xFalse
acc_keys = Accumulator n_acc_keys (ArrayT tk) $ mapKeys tk tv map'
acc_vals = Accumulator n_acc_vals (ArrayT tv) $ mapVals tk tv map'

sz = xVar n'map'sz
get'k i = arrIx tk x'map'k i
let readk = readArr tk n_loc_keys n_acc_keys
readv = readArr tv n_loc_vals n_acc_vals
readk' = readArr tk n_cpy_keys n_acc_keys
readv' = readArr tv n_cpy_vals n_acc_vals
readix = readBool n_loc_found n_acc_found
. readInt n_loc_idx n_acc_idx

del'k i = arrDel tk x'map'k i
del'v i = arrDel tv x'map'v i
-- Look up the key.
sLookup <- avalancheBinarySearch a_fresh tk key' v_keys n_acc_found n_acc_idx

del' i = Block
[ Write n'map'k (del'k i)
, Write n'map'v (del'v i)
]
-- If it's found, we'll need a copy.
copyk <- copyArrayAcc a_fresh tk n_acc_keys
copyv <- copyArrayAcc a_fresh tv n_acc_vals

loop1 <- forReverse sz
$ \i
-> (read'k
<$> (read'v
<$> pure (If (relEq tk (get'k i) key') (del' i) mempty)))
-- Perform the delete (this will also update the count)
let del = Write n_acc_keys (arrDel tk (xVar n_cpy_keys) v_idx)
<> Write n_acc_vals (arrDel tv (xVar n_cpy_vals) v_idx)

n'map' <- fresh
stm' <- stm $ xVar n'map'
let sDel = copyk <> copyv <> readk' (readv' del)

let stm'' = read'k
$ read'v
$ Let n'map' (mapPack tk tv x'map'k x'map'v)
$ stm'
let keyInMap = relEq BoolT v_found xTrue
let sInsertOrUpdate = If keyInMap sDel mempty

ss = InitAccumulator acc'map'k
$ InitAccumulator acc'map'v
$ read'k
$ Let n'map'sz (arrLen tk x'map'k)
( loop1 <> stm'' )
stm' <- stm v_res
let res = Let n_res (mapPack tk tv v_keys v_vals) stm'
ss = InitAccumulator acc_keys
$ InitAccumulator acc_vals
$ InitAccumulator acc_found
$ InitAccumulator acc_idx
$ readk . readv . readix
$ sLookup <> (readix (sInsertOrUpdate <> readk (readv res)))

return ss

where
flatX'
= flatX a_fresh

forReverse len
= forI_ a_fresh ForeachStepDown (xMinusOne len) (XValue a_fresh IntT (VInt (-1)))

xMinusOne m
= xArith Min.PrimArithMinus `xApp` m `xApp` xValue IntT (VInt 1)
xTrue = xValue BoolT (VBool True)
xFalse = xValue BoolT (VBool False)

Flat.FlatCons {..} = Flat.flatCons a_fresh
flatX' = flatX a_fresh
Flat.FlatOps {..} = Flat.flatOps a_fresh
Flat.FlatCons {..} = Flat.flatCons a_fresh


--------------------------------------------------------------------------------

Expand Down
3 changes: 0 additions & 3 deletions icicle-compiler/src/Icicle/Avalanche/Statement/Simp/Linear.hs
View file
Original file line number Diff line number Diff line change
Expand Up @@ -191,9 +191,6 @@ linearise =
_ | Just (Flat.PrimUnsafe (Flat.PrimUnsafeArrayIndex _), [g,_]) <- takePrimApps x ->
arrayReference g

_ | Just (Flat.PrimBuf (Flat.PrimBufRead {}), [g]) <- takePrimApps x ->
arrayReference g

_ ->
Nothing

Expand Down

0 comments on commit d4b992f

Please sign in to comment.