An unrolled linked list

A sequence implemented as a linked list of arrays.

This data structure is similar to the List but it can benefit from better cache performance, lower data overhead for the nodes metadata and it spares the GC to allocate many small nodes.

Introduced properties

protected fun length=(length: Int)

more_collections :: UnrolledList :: length=

fun nodes_length: Int

more_collections :: UnrolledList :: nodes_length

Desired capacity for each nodes
fun nodes_length=(nodes_length: Int)

more_collections :: UnrolledList :: nodes_length=

Desired capacity for each nodes

Redefined properties

redef type SELF: UnrolledList[E]

more_collections $ UnrolledList :: SELF

Type of this instance, automatically specialized in every class
redef fun [](index: Int): E

more_collections $ UnrolledList :: []

Return the index-th element of the sequence.
redef fun []=(index: Int, value: E)

more_collections $ UnrolledList :: []=

Set the item at index.
redef fun clear

more_collections $ UnrolledList :: clear

Remove all items
redef fun core_serialize_to(v: Serializer)

more_collections $ UnrolledList :: core_serialize_to

Actual serialization of self to serializer
redef init from_deserializer(v: Deserializer)

more_collections $ UnrolledList :: from_deserializer

Create an instance of this class from the deserializer
redef fun insert(item: E, index: Int)

more_collections $ UnrolledList :: insert

Insert an element at a given position, following elements are shifted.
redef fun iterator: Iterator[E]

more_collections $ UnrolledList :: iterator

Get a new iterator on the collection.
redef fun length: Int

more_collections $ UnrolledList :: length

Number of items in the collection.
redef fun pop: E

more_collections $ UnrolledList :: pop

Remove the last item.
redef fun push(item: E)

more_collections $ UnrolledList :: push

Add an item after the last one.
redef fun remove_at(index: Int)

more_collections $ UnrolledList :: remove_at

Remove the item at index and shift all following elements
redef fun shift: E

more_collections $ UnrolledList :: shift

Remove the first item.
redef fun unshift(item: E)

more_collections $ UnrolledList :: unshift

Add an item before the first one.

All properties

fun !=(other: nullable Object): Bool

core :: Object :: !=

Have self and other different values?
fun ==(other: nullable Object): Bool

core :: Object :: ==

Have self and other the same value?
type CLASS: Class[SELF]

core :: Object :: CLASS

The type of the class of self.
type CONCURRENT: ConcurrentCollection[E]

core :: Collection :: CONCURRENT

Type of the concurrent variant of this collection
type SELF: Object

core :: Object :: SELF

Type of this instance, automatically specialized in every class
abstract fun [](index: Int): E

core :: SequenceRead :: []

Return the index-th element of the sequence.
abstract fun []=(index: Int, item: E)

core :: Sequence :: []=

Set the item at index.
protected fun accept_json_serializer(v: JsonSerializer)

serialization :: Serializable :: accept_json_serializer

Refinable service to customize the serialization of this class to JSON
protected fun accept_msgpack_attribute_counter(v: AttributeCounter)

serialization :: Serializable :: accept_msgpack_attribute_counter

Hook to customize the behavior of the AttributeCounter
protected fun accept_msgpack_serializer(v: MsgPackSerializer)

serialization :: Serializable :: accept_msgpack_serializer

Hook to customize the serialization of this class to MessagePack
abstract fun add(item: E)

core :: SimpleCollection :: add

Add item to this collection.
fun add_all(coll: Collection[E])

core :: SimpleCollection :: add_all

Add each item of coll.
protected fun add_to_bundle(bundle: NativeBundle, key: JavaString)

serialization :: Serializable :: add_to_bundle

Called by []= to dynamically choose the appropriate method according
fun append(coll: Collection[E])

core :: Sequence :: append

Add each item of coll after the last.
fun as_fifo: Queue[E]

core :: Sequence :: as_fifo

Return a FIFO proxy queue where result.take is shift.
fun as_lifo: Queue[E]

core :: Sequence :: as_lifo

Return a LIFO proxy queue (stack) where result.take is pop.
fun as_random: Queue[E]

core :: SimpleCollection :: as_random

Return a random proxy queue where result.take is random.
protected fun class_factory(name: String): CLASS

core :: Object :: class_factory

Implementation used by get_class to create the specific class.
fun class_name: String

core :: Object :: class_name

The class name of the object.
abstract fun clear

core :: RemovableCollection :: clear

Remove all items
fun combinations(r: Int): Collection[SequenceRead[E]]

core :: Collection :: combinations

All r-length combinations on self (in same order) without repeated elements.
fun combinations_with_replacement(r: Int): Collection[SequenceRead[E]]

core :: Collection :: combinations_with_replacement

All r-length combination on self (in same order) with repeated elements.
fun core_serialize_to(serializer: Serializer)

serialization :: Serializable :: core_serialize_to

Actual serialization of self to serializer
fun count(item: nullable Object): Int

core :: Collection :: count

How many occurrences of item are in the collection?
fun first: E

core :: Collection :: first

Return the first item of the collection
fun first=(item: E)

core :: Sequence :: first=

Set the first item.
init from_deserializer(deserializer: Deserializer)

serialization :: Serializable :: from_deserializer

Create an instance of this class from the deserializer
fun get_class: CLASS

core :: Object :: get_class

The meta-object representing the dynamic type of self.
fun get_or_default(index: Int, default: E): E

core :: SequenceRead :: get_or_default

Try to get an element, return default if the index is invalid.
fun get_or_null(index: Int): nullable E

core :: SequenceRead :: get_or_null

Try to get an element, return null if the index is invalid.
fun has(item: nullable Object): Bool

core :: Collection :: has

Is item in the collection ?
fun has_all(other: Collection[nullable Object]): Bool

core :: Collection :: has_all

Does the collection contain at least each element of other?
fun has_any(other: Collection[nullable Object]): Bool

core :: Collection :: has_any

Does the collection contain at least one element of other?
fun has_exactly(other: Collection[nullable Object]): Bool

core :: Collection :: has_exactly

Does the collection contain exactly all the elements of other?
fun has_only(item: nullable Object): Bool

core :: Collection :: has_only

Is the collection contain only item?
fun hash: Int

core :: Object :: hash

The hash code of the object.
fun index_of(item: nullable Object): Int

core :: SequenceRead :: index_of

The index of the first occurrence of item.
fun index_of_from(item: nullable Object, pos: Int): Int

core :: SequenceRead :: index_of_from

The index of the first occurrence of item, starting from pos.
init init

core :: Object :: init

abstract fun insert(item: E, index: Int)

core :: Sequence :: insert

Insert an element at a given position, following elements are shifted.
fun insert_all(coll: Collection[E], index: Int)

core :: Sequence :: insert_all

Insert all elements at a given position, following elements are shifted.
fun inspect: String

core :: Object :: inspect

Developer readable representation of self.
protected fun inspect_head: String

core :: Object :: inspect_head

Return "CLASSNAME:#OBJECTID".
fun is_empty: Bool

core :: Collection :: is_empty

Is there no item in the collection?
intern fun is_same_instance(other: nullable Object): Bool

core :: Object :: is_same_instance

Return true if self and other are the same instance (i.e. same identity).
fun is_same_serialized(other: nullable Object): Bool

core :: Object :: is_same_serialized

Is self the same as other in a serialization context?
intern fun is_same_type(other: Object): Bool

core :: Object :: is_same_type

Return true if self and other have the same dynamic type.
abstract fun iterator: Iterator[E]

core :: Collection :: iterator

Get a new iterator on the collection.
fun iterator_from(pos: Int): IndexedIterator[E]

core :: SequenceRead :: iterator_from

Gets a new Iterator starting at position pos
fun join(separator: nullable Text, last_separator: nullable Text): String

core :: Collection :: join

Concatenate and separate each elements with separator.
fun last: E

core :: SequenceRead :: last

Get the last item.
fun last=(item: E)

core :: Sequence :: last=

Set the last item.
fun last_index_of(item: nullable Object): Int

core :: SequenceRead :: last_index_of

The index of the last occurrence of item.
fun last_index_of_from(item: nullable Object, pos: Int): Int

core :: SequenceRead :: last_index_of_from

The index of the last occurrence of item starting from pos and decrementing.
fun length: Int

core :: Collection :: length

Number of items in the collection.
protected fun length=(length: Int)

more_collections :: UnrolledList :: length=

fun modulo(index: Int): E

core :: SequenceRead :: modulo

Return the index-th element but wrap
fun modulo=(index: Int, value: E)

core :: Sequence :: modulo=

Set the index-th element but wrap
fun modulo_index(index: Int): Int

core :: SequenceRead :: modulo_index

Returns the real index for a modulo index.
protected fun msgpack_extra_array_items: Int

serialization :: Serializable :: msgpack_extra_array_items

Hook to request a larger than usual metadata array
fun nodes_length: Int

more_collections :: UnrolledList :: nodes_length

Desired capacity for each nodes
fun nodes_length=(nodes_length: Int)

more_collections :: UnrolledList :: nodes_length=

Desired capacity for each nodes
fun not_empty: Bool

core :: Collection :: not_empty

Alias for not is_empty.
intern fun object_id: Int

core :: Object :: object_id

An internal hash code for the object based on its identity.
fun output

core :: Object :: output

Display self on stdout (debug only).
intern fun output_class_name

core :: Object :: output_class_name

Display class name on stdout (debug only).
fun permutations(r: Int): Collection[SequenceRead[E]]

core :: Collection :: permutations

All r-length permutations on self (all possible ordering) without repeated elements.
fun plain_to_s: String

core :: Collection :: plain_to_s

Concatenate elements without separators
abstract fun pop: E

core :: Sequence :: pop

Remove the last item.
fun prepend(coll: Collection[E])

core :: Sequence :: prepend

Add all items of coll before the first one.
fun product(r: Int): Collection[SequenceRead[E]]

core :: Collection :: product

Cartesian product, over r times self.
abstract fun push(e: E)

core :: Sequence :: push

Add an item after the last one.
fun rand: E

core :: Collection :: rand

Return a random element form the collection
abstract fun remove(item: nullable Object)

core :: RemovableCollection :: remove

Remove an occurrence of item
fun remove_all(item: nullable Object)

core :: RemovableCollection :: remove_all

Remove all occurrences of item
abstract fun remove_at(index: Int)

core :: Sequence :: remove_at

Remove the item at index and shift all following elements
abstract fun reverse_iterator: IndexedIterator[E]

core :: SequenceRead :: reverse_iterator

Gets an iterator starting at the end and going backwards
fun reverse_iterator_from(pos: Int): IndexedIterator[E]

core :: SequenceRead :: reverse_iterator_from

Gets an iterator on the chars of self starting from pos
fun rotate_left

core :: Sequence :: rotate_left

Rotates the elements of self once to the left
fun rotate_right

core :: Sequence :: rotate_right

Rotates the elements of self once to the right
fun sample(length: Int): Array[E]

core :: Collection :: sample

Return a new array made of (at most) length elements randomly chosen.
fun serialization_hash: Int

core :: Object :: serialization_hash

Hash value use for serialization
fun serialize_msgpack(plain: nullable Bool): Bytes

serialization :: Serializable :: serialize_msgpack

Serialize self to MessagePack bytes
fun serialize_to(serializer: Serializer)

serialization :: Serializable :: serialize_to

Serialize self to serializer
fun serialize_to_json(plain: nullable Bool, pretty: nullable Bool): String

serialization :: Serializable :: serialize_to_json

Serialize self to JSON
abstract fun shift: E

core :: Sequence :: shift

Remove the first item.
fun subarray(start: Int, len: Int): Array[E]

core :: Sequence :: subarray

Copy the content of self between start and len to a new Array.
intern fun sys: Sys

core :: Object :: sys

Return the global sys object, the only instance of the Sys class.
fun to_a: Array[E]

core :: Collection :: to_a

Build a new array from a collection
abstract fun to_concurrent: CONCURRENT

core :: Collection :: to_concurrent

Wraps self in a thread-safe collection
fun to_counter: Counter[E]

core :: Collection :: to_counter

Create and fill up a counter with the elements of `self.
fun to_curlslist: CURLSList

core :: Collection :: to_curlslist

Convert Collection[String] to CURLSList
fun to_json: String

serialization :: Serializable :: to_json

Serialize self to plain JSON
abstract fun to_jvalue(env: JniEnv): JValue

core :: Object :: to_jvalue

fun to_pretty_json: String

serialization :: Serializable :: to_pretty_json

Serialize self to plain pretty JSON
fun to_s: String

core :: Object :: to_s

User readable representation of self.
fun to_shuffle: Array[E]

core :: Collection :: to_shuffle

Return a new array made of elements in a random order.
abstract fun unshift(e: E)

core :: Sequence :: unshift

Add an item before the first one.
package_diagram more_collections::UnrolledList UnrolledList core::Sequence Sequence more_collections::UnrolledList->core::Sequence core::SequenceRead SequenceRead core::Sequence->core::SequenceRead core::SimpleCollection SimpleCollection core::Sequence->core::SimpleCollection ...core::SequenceRead ... ...core::SequenceRead->core::SequenceRead ...core::SimpleCollection ... ...core::SimpleCollection->core::SimpleCollection

Ancestors

interface Collection[E: nullable Object]

core :: Collection

The root of the collection hierarchy.
interface Object

core :: Object

The root of the class hierarchy.
interface RemovableCollection[E: nullable Object]

core :: RemovableCollection

Items can be removed from this collection
interface SequenceRead[E: nullable Object]

core :: SequenceRead

Sequences are indexed collections.
interface Serializable

serialization :: Serializable

Instances of this class can be passed to Serializer::serialize
interface SimpleCollection[E: nullable Object]

core :: SimpleCollection

Items can be added to these collections.

Parents

interface Sequence[E: nullable Object]

core :: Sequence

Sequence are indexed collection.

Class definitions

more_collections $ UnrolledList
# An unrolled linked list
#
# A sequence implemented as a linked list of arrays.
#
# This data structure is similar to the `List` but it can benefit from
# better cache performance, lower data overhead for the nodes metadata and
# it spares the GC to allocate many small nodes.
class UnrolledList[E]
	super Sequence[E]

	# Desired capacity for each nodes
	#
	# By default at `32`, it can be increased for very large lists.
	#
	# It can be modified anytime, but newly created nodes may still be assigned
	# the same capacity of old nodes when created by `insert`.
	var nodes_length = 32 is writable

	private var head_node: UnrolledNode[E] = new UnrolledNode[E](nodes_length)

	private var tail_node: UnrolledNode[E] = head_node

	redef var length = 0

	redef fun clear
	do
		head_node = new UnrolledNode[E](nodes_length)
		tail_node = head_node
		length = 0
	end

	# Out parameter of `node_at`
	private var index_within_node = 0

	private fun node_at(index: Int): UnrolledNode[E]
	do
		assert index >= 0 and index < length

		var node = head_node
		while index >= node.length do
			index -= node.length
			node = node.next.as(not null)
		end

		index_within_node = index
		return node
	end

	private fun insert_node(node: UnrolledNode[E], prev, next: nullable UnrolledNode[E])
	do
		if prev != null then
			prev.next = node
		else head_node = node

		if next != null then
			next.prev = node
		else tail_node = node

		node.next = next
		node.prev = prev
	end

	redef fun [](index)
	do
		var node = node_at(index)
		index = index_within_node + node.head_index
		return node.items[index]
	end

	redef fun []=(index, value)
	do
		var node = node_at(index)
		index = index_within_node + node.head_index
		node.items[index] = value
	end

	redef fun push(item)
	do
		var node = tail_node
		if not node.full then
			if node.tail_index < node.capacity then
				# There's room at the tail
				node.tail_index += 1
			else
				# Move everything over by `d`
				assert node.head_index > 0
				var d = node.head_index / 2 + 1
				node.move_head(node.length, d)
				for i in d.times do node.items[node.tail_index - i] = null
				node.head_index -= d
				node.tail_index += -d+1
			end
			node.items[node.tail_index-1] = item
		else
			# New node!
			node = new UnrolledNode[E](nodes_length)
			insert_node(node, tail_node, null)
			node.tail_index = 1
			node.items[0] = item
		end
		length += 1
	end

	redef fun unshift(item)
	do
		var node = head_node
		if not node.full then
			if node.head_index > 0 then
				# There's room at the head
				node.head_index -= 1
			else
				# Move everything over by `d`
				assert node.tail_index < node.capacity
				var d = (node.capacity-node.tail_index) / 2 + 1
				node.move_tail(0, d)
				for i in d.times do node.items[node.head_index+i] = null
				node.head_index += d-1
				node.tail_index += d
			end
			node.items[node.head_index] = item
		else
			# New node!
			node = new UnrolledNode[E](nodes_length)
			insert_node(node, null, head_node)
			node.head_index = node.capacity-1
			node.tail_index = node.capacity
			node.items[node.capacity-1] = item
		end
		length += 1
	end

	redef fun pop
	do
		assert not_empty

		var node = tail_node
		while node.length == 0 do
			# Delete empty node
			var nullable_node = node.prev
			assert is_not_empty: nullable_node != null
			node = nullable_node
			node.next = null
			self.tail_node = node
		end

		var item = node.items[node.tail_index-1]
		node.tail_index -= 1
		length -= 1
		return item
	end

	redef fun shift
	do
		assert not_empty

		var node = head_node
		while node.length == 0 do
			# Delete empty node
			var nullable_node = node.next
			assert is_not_empty: nullable_node != null
			node = nullable_node
			node.prev = null
			self.head_node = node
		end

		var item = node.items[node.head_index]
		node.head_index += 1
		length -= 1
		return item
	end

	redef fun insert(item, index)
	do
		if index == length then
			push item
			return
		end

		var node = node_at(index)
		index = index_within_node
		if node.full then
			# Move half to a new node
			var new_node = new UnrolledNode[E](nodes_length.max(node.capacity))

			# Plug in the new node
			var next_node = node.next
			insert_node(new_node, node, next_node)

			# Move items at and after `index` to the new node
			var to_displace = node.length-index
			var offset = (new_node.capacity-to_displace)/2
			for i in [0..to_displace[ do
				new_node.items[offset+i] = node.items[index+i]
				node.items[index+i] = null
			end
			new_node.head_index = offset
			new_node.tail_index = offset + to_displace
			node.tail_index -= to_displace

			# Store `item`
			if index > node.capacity / 2 then
				new_node.items[offset-1] = item
				new_node.head_index -= 1
			else
				node.items[node.head_index+index] = item
				node.tail_index += 1
			end
		else
			if node.tail_index < node.capacity then
				# Move items towards the tail
				node.move_tail(index, 1)
				node.tail_index += 1
				node.items[node.head_index + index] = item
			else
				# Move items towards the head
				node.move_head(index, 1)
				node.items[node.head_index + index-1] = item
				node.head_index -= 1
			end
		end
		length += 1
	end

	redef fun remove_at(index)
	do
		var node = node_at(index)
		index = index_within_node + node.head_index

		# Shift left all the elements after `index`
		for i in [index+1 .. node.tail_index[ do
			node.items[i-1] = node.items[i]
		end
		node.tail_index -= 1
		node.items[node.tail_index] = null

		length -= 1

		var next_node = node.next
		var prev_node = node.prev
		if node.is_empty and (next_node != null or prev_node != null) then
			# Empty and non-head or tail node, delete
			if next_node != null then
				next_node.prev = node.prev
			else tail_node = prev_node.as(not null)

			if prev_node != null then
				prev_node.next = node.next
			else head_node = next_node.as(not null)
		end
	end

	redef fun iterator do return new UnrolledIterator[E](self)
end
lib/more_collections/more_collections.nit:351,1--603,3