stdlib_bitsets Module

Implements zero based bitsets of size up to huge(0_int32). The current code uses 64 bit integers to store the bits and uses all 64 bits. The code assumes two's complement integers, and treats negative integers as having the sign bit set. (Specification)

Public procedures



Contents


Variables

TypeVisibilityAttributesNameInitial
integer, public, parameter:: alloc_fault =1

Error flag indicating a memory allocation failure

integer, public, parameter:: array_size_invalid_error =2

Error flag indicating an invalid bits value

integer, public, parameter:: char_string_invalid_error =3

Error flag indicating an invalid character string

integer, public, parameter:: char_string_too_large_error =4

Error flag indicating a too large character string

integer, public, parameter:: char_string_too_small_error =5

Error flag indicating a too small character string

integer, public, parameter:: eof_failure =6

Error flag indicating unexpected End-of-File on a READ

integer, public, parameter:: index_invalid_error =7

Error flag indicating an invalid index

integer, public, parameter:: integer_overflow_error =8

Error flag indicating integer overflow

integer, public, parameter:: max_digits =10
integer(kind=bits_kind), public, parameter:: overflow_bits =2_bits_kind**30/5
integer, public, parameter:: read_failure =9

Error flag indicating failure of a READ statement

integer, public, parameter:: success =0

Error flag indicating no errors

integer, public, parameter:: write_failure =10

Error flag indicating a failure on a WRITE statement


Interfaces

public interface and

Sets the bits in set1 to the bitwise and of the original bits in set1 and set2. The sets must have the same number of bits otherwise the result is undefined. (Specification)

Read more…
  • private elemental module subroutine and_64(set1, set2)

    Arguments

    TypeIntentOptionalAttributesName
    type(bitset_64), intent(inout) :: set1
    type(bitset_64), intent(in) :: set2
  • private elemental module subroutine and_large(set1, set2)

    Arguments

    TypeIntentOptionalAttributesName
    type(bitset_large), intent(inout) :: set1
    type(bitset_large), intent(in) :: set2

public interface and_not

Sets the bits in set1 to the bitwise and of the original bits in set1 with the bitwise negation of set2. The sets must have the same number of bits otherwise the result is undefined.

Read more…
  • private elemental module subroutine and_not_64(set1, set2)

    Arguments

    TypeIntentOptionalAttributesName
    type(bitset_64), intent(inout) :: set1
    type(bitset_64), intent(in) :: set2
  • private elemental module subroutine and_not_large(set1, set2)

    Arguments

    TypeIntentOptionalAttributesName
    type(bitset_large), intent(inout) :: set1
    type(bitset_large), intent(in) :: set2

public interface assignment(=)

Used to define assignment for bitset_large. (Specification)

Read more…
  • private pure module subroutine assign_logint16_large(self, logical_vector)

    Used to define assignment from an array of type logical(int16) to a bitset_large.

    Arguments

    TypeIntentOptionalAttributesName
    type(bitset_large), intent(out) :: self
    logical(kind=int16), intent(in) :: logical_vector(:)
  • private pure module subroutine assign_logint32_large(self, logical_vector)

    Used to define assignment from an array of type logical(int32) to a bitset_large.

    Arguments

    TypeIntentOptionalAttributesName
    type(bitset_large), intent(out) :: self
    logical(kind=int32), intent(in) :: logical_vector(:)
  • private pure module subroutine assign_logint64_large(self, logical_vector)

    Used to define assignment from an array of type logical(int64) to a bitset_large.

    Arguments

    TypeIntentOptionalAttributesName
    type(bitset_large), intent(out) :: self
    logical(kind=int64), intent(in) :: logical_vector(:)
  • private pure module subroutine assign_logint8_large(self, logical_vector)

    Used to define assignment from an array of type logical(int8) to a bitset_large.

    Arguments

    TypeIntentOptionalAttributesName
    type(bitset_large), intent(out) :: self
    logical(kind=int8), intent(in) :: logical_vector(:)
  • private pure module subroutine logint16_assign_large(logical_vector, set)

    Used to define assignment to an array of type logical(int16) from a bitset_large.

    Arguments

    TypeIntentOptionalAttributesName
    logical(kind=int16), intent(out), allocatable:: logical_vector(:)
    type(bitset_large), intent(in) :: set
  • private pure module subroutine logint32_assign_large(logical_vector, set)

    Used to define assignment to an array of type logical(int32) from a bitset_large.

    Arguments

    TypeIntentOptionalAttributesName
    logical(kind=int32), intent(out), allocatable:: logical_vector(:)
    type(bitset_large), intent(in) :: set
  • private pure module subroutine logint64_assign_large(logical_vector, set)

    Used to define assignment to an array of type logical(int64) from a bitset_large.

    Arguments

    TypeIntentOptionalAttributesName
    logical(kind=int64), intent(out), allocatable:: logical_vector(:)
    type(bitset_large), intent(in) :: set
  • private pure module subroutine logint8_assign_large(logical_vector, set)

    Used to define assignment to an array of type logical(int8) from a bitset_large.

    Arguments

    TypeIntentOptionalAttributesName
    logical(kind=int8), intent(out), allocatable:: logical_vector(:)
    type(bitset_large), intent(in) :: set

public interface extract

Creates a new bitset, new, from a range, start_pos to stop_pos, in bitset old. If start_pos is greater than stop_pos the new bitset is empty. If start_pos is less than zero or stop_pos is greater than bits(old)-1 then if status is present it has the value index_invalid_error and new is undefined, otherwise processing stops with an informative message. (Specification)

Read more…
  • private module subroutine extract_64(new, old, start_pos, stop_pos, status)

    Arguments

    TypeIntentOptionalAttributesName
    type(bitset_64), intent(out) :: new
    type(bitset_64), intent(in) :: old
    integer(kind=bits_kind), intent(in) :: start_pos
    integer(kind=bits_kind), intent(in) :: stop_pos
    integer, intent(out), optional :: status
  • private module subroutine extract_large(new, old, start_pos, stop_pos, status)

    Arguments

    TypeIntentOptionalAttributesName
    type(bitset_large), intent(out) :: new
    type(bitset_large), intent(in) :: old
    integer(kind=bits_kind), intent(in) :: start_pos
    integer(kind=bits_kind), intent(in) :: stop_pos
    integer, intent(out), optional :: status

public interface operator(/=)

Returns .true. if not all bits in set1 and set2 have the same value, .false. otherwise. The sets must have the same number of bits otherwise the result is undefined. (Specification)

Read more…
  • private elemental module function neqv_64(set1, set2) result(neqv)

    Arguments

    TypeIntentOptionalAttributesName
    type(bitset_64), intent(in) :: set1
    type(bitset_64), intent(in) :: set2

    Return Value logical

  • private elemental module function neqv_large(set1, set2) result(neqv)

    Arguments

    TypeIntentOptionalAttributesName
    type(bitset_large), intent(in) :: set1
    type(bitset_large), intent(in) :: set2

    Return Value logical

public interface operator(<)

Returns .true. if the bits in set1 and set2 differ and the highest order different bit is set to 0 in set1 and to 1 in set2, .false. otherwise. The sets must have the same number of bits otherwise the result is undefined. (Specification)

Read more…
  • private elemental module function lt_64(set1, set2) result(lt)

    Arguments

    TypeIntentOptionalAttributesName
    type(bitset_64), intent(in) :: set1
    type(bitset_64), intent(in) :: set2

    Return Value logical

  • private elemental module function lt_large(set1, set2) result(lt)

    Arguments

    TypeIntentOptionalAttributesName
    type(bitset_large), intent(in) :: set1
    type(bitset_large), intent(in) :: set2

    Return Value logical

public interface operator(<=)

Returns .true. if the bits in set1 and set2 are the same or the highest order different bit is set to 0 in set1 and to 1 in set2, .false. otherwise. The sets must have the same number of bits otherwise the result is undefined. (Specification)

Read more…
  • private elemental module function le_64(set1, set2) result(le)

    Arguments

    TypeIntentOptionalAttributesName
    type(bitset_64), intent(in) :: set1
    type(bitset_64), intent(in) :: set2

    Return Value logical

  • private elemental module function le_large(set1, set2) result(le)

    Arguments

    TypeIntentOptionalAttributesName
    type(bitset_large), intent(in) :: set1
    type(bitset_large), intent(in) :: set2

    Return Value logical

public interface operator(==)

Returns .true. if all bits in set1 and set2 have the same value, .false. otherwise. The sets must have the same number of bits otherwise the result is undefined. (Specification)

Read more…
  • private elemental module function eqv_64(set1, set2) result(eqv)

    Arguments

    TypeIntentOptionalAttributesName
    type(bitset_64), intent(in) :: set1
    type(bitset_64), intent(in) :: set2

    Return Value logical

  • private elemental module function eqv_large(set1, set2) result(eqv)

    Arguments

    TypeIntentOptionalAttributesName
    type(bitset_large), intent(in) :: set1
    type(bitset_large), intent(in) :: set2

    Return Value logical

public interface operator(>)

Returns .true. if the bits in set1 and set2 differ and the highest order different bit is set to 1 in set1 and to 0 in set2, .false. otherwise. The sets must have the same number of bits otherwise the result is undefined. (Specification)

Read more…
  • private elemental module function gt_64(set1, set2) result(gt)

    Arguments

    TypeIntentOptionalAttributesName
    type(bitset_64), intent(in) :: set1
    type(bitset_64), intent(in) :: set2

    Return Value logical

  • private elemental module function gt_large(set1, set2) result(gt)

    Arguments

    TypeIntentOptionalAttributesName
    type(bitset_large), intent(in) :: set1
    type(bitset_large), intent(in) :: set2

    Return Value logical

public interface operator(>=)

Returns .true. if the bits in set1 and set2 are the same or the highest order different bit is set to 1 in set1 and to 0 in set2, .false. otherwise. The sets must have the same number of bits otherwise the result is undefined. (Specification)

Read more…
  • private elemental module function ge_64(set1, set2) result(ge)

    Arguments

    TypeIntentOptionalAttributesName
    type(bitset_64), intent(in) :: set1
    type(bitset_64), intent(in) :: set2

    Return Value logical

  • private elemental module function ge_large(set1, set2) result(ge)

    Arguments

    TypeIntentOptionalAttributesName
    type(bitset_large), intent(in) :: set1
    type(bitset_large), intent(in) :: set2

    Return Value logical

public interface or

Sets the bits in set1 to the bitwise or of the original bits in set1 and set2. The sets must have the same number of bits otherwise the result is undefined. (Specification)

Read more…
  • private elemental module subroutine or_64(set1, set2)

    Arguments

    TypeIntentOptionalAttributesName
    type(bitset_64), intent(inout) :: set1
    type(bitset_64), intent(in) :: set2
  • private elemental module subroutine or_large(set1, set2)

    Arguments

    TypeIntentOptionalAttributesName
    type(bitset_large), intent(inout) :: set1
    type(bitset_large), intent(in) :: set2

public interface xor

Sets the bits in set1 to the bitwise xor of the original bits in set1 and set2. The sets must have the same number of bits otherwise the result is undefined. (Specification)

Read more…
  • private elemental module subroutine xor_64(set1, set2)

    Arguments

    TypeIntentOptionalAttributesName
    type(bitset_64), intent(inout) :: set1
    type(bitset_64), intent(in) :: set2
  • private elemental module subroutine xor_large(set1, set2)

    Arguments

    TypeIntentOptionalAttributesName
    type(bitset_large), intent(inout) :: set1
    type(bitset_large), intent(in) :: set2

Derived Types

type, public, extends(bitset_type) :: bitset_64

Type for bitsets with no more than 64 bits (Specification)

Type-Bound Procedures

procedure, public, pass(self) :: all => all_64
procedure, public, pass(self) :: any => any_64
procedure, public, pass(self) :: bit_count => bit_count_64
procedure, public, pass(self) :: bits
generic, public :: clear => clear_bit, clear_range
procedure, public, pass(self) :: clear_bit => clear_bit_64
procedure, public, pass(self) :: clear_range => clear_range_64
generic, public :: flip => flip_bit, flip_range
procedure, public, pass(self) :: flip_bit => flip_bit_64
procedure, public, pass(self) :: flip_range => flip_range_64
procedure, public, pass(self) :: from_string => from_string_64
generic, public :: init => init_zero
procedure, public, pass(self) :: init_zero => init_zero_64
procedure, public, pass(self) :: input => input_64
procedure, public, pass(self) :: none => none_64
procedure, public, pass(self) :: not => not_64
procedure, public, pass(self) :: output => output_64
generic, public :: read_bitset => read_bitset_string, read_bitset_unit
procedure, public, pass(self) :: read_bitset_string => read_bitset_string_64
procedure, public, pass(self) :: read_bitset_unit => read_bitset_unit_64
generic, public :: set => set_bit, set_range
procedure, public, pass(self) :: set_bit => set_bit_64
procedure, public, pass(self) :: set_range => set_range_64
procedure, public, pass(self) :: test => test_64
procedure, public, pass(self) :: to_string => to_string_64
procedure, public, pass(self) :: value => value_64
generic, public :: write_bitset => write_bitset_string, write_bitset_unit
procedure, public, pass(self) :: write_bitset_string => write_bitset_string_64
procedure, public, pass(self) :: write_bitset_unit => write_bitset_unit_64

type, public, extends(bitset_type) :: bitset_large

Type for bitsets with more than 64 bits (Specification)

Type-Bound Procedures

procedure, public, pass(self) :: all => all_large
procedure, public, pass(self) :: any => any_large
procedure, public, pass(self) :: bit_count => bit_count_large
procedure, public, pass(self) :: bits
generic, public :: clear => clear_bit, clear_range
procedure, public, pass(self) :: clear_bit => clear_bit_large
procedure, public, pass(self) :: clear_range => clear_range_large
generic, public :: flip => flip_bit, flip_range
procedure, public, pass(self) :: flip_bit => flip_bit_large
procedure, public, pass(self) :: flip_range => flip_range_large
procedure, public, pass(self) :: from_string => from_string_large
generic, public :: init => init_zero
procedure, public, pass(self) :: init_zero => init_zero_large
procedure, public, pass(self) :: input => input_large
procedure, public, pass(self) :: none => none_large
procedure, public, pass(self) :: not => not_large
procedure, public, pass(self) :: output => output_large
generic, public :: read_bitset => read_bitset_string, read_bitset_unit
procedure, public, pass(self) :: read_bitset_string => read_bitset_string_large
procedure, public, pass(self) :: read_bitset_unit => read_bitset_unit_large
generic, public :: set => set_bit, set_range
procedure, public, pass(self) :: set_bit => set_bit_large
procedure, public, pass(self) :: set_range => set_range_large
procedure, public, pass(self) :: test => test_large
procedure, public, pass(self) :: to_string => to_string_large
procedure, public, pass(self) :: value => value_large
generic, public :: write_bitset => write_bitset_string, write_bitset_unit
procedure, public, pass(self) :: write_bitset_string => write_bitset_string_large
procedure, public, pass(self) :: write_bitset_unit => write_bitset_unit_large

type, public, abstract :: bitset_type

Parent type for bitset_64 and bitset_large (Specification)

Type-Bound Procedures

procedure(all_abstract), public, pass(self) :: all
procedure(any_abstract), public, pass(self) :: any
procedure(bit_count_abstract), public, pass(self) :: bit_count
procedure, public, pass(self) :: bits
generic, public :: clear => clear_bit, clear_range
procedure(clear_bit_abstract), public, pass(self) :: clear_bit
procedure(clear_range_abstract), public, pass(self) :: clear_range
generic, public :: flip => flip_bit, flip_range
procedure(flip_bit_abstract), public, pass(self) :: flip_bit
procedure(flip_range_abstract), public, pass(self) :: flip_range
procedure(from_string_abstract), public, pass(self) :: from_string
generic, public :: init => init_zero
procedure(init_zero_abstract), public, pass(self) :: init_zero
procedure(input_abstract), public, pass(self) :: input
procedure(none_abstract), public, pass(self) :: none
procedure(not_abstract), public, pass(self) :: not
procedure(output_abstract), public, pass(self) :: output
generic, public :: read_bitset => read_bitset_string, read_bitset_unit
procedure(read_bitset_string_abstract), public, pass(self) :: read_bitset_string
procedure(read_bitset_unit_abstract), public, pass(self) :: read_bitset_unit
generic, public :: set => set_bit, set_range
procedure(set_bit_abstract), public, pass(self) :: set_bit
procedure(set_range_abstract), public, pass(self) :: set_range
procedure(test_abstract), public, pass(self) :: test
procedure(to_string_abstract), public, pass(self) :: to_string
procedure(value_abstract), public, pass(self) :: value
generic, public :: write_bitset => write_bitset_string, write_bitset_unit
procedure(write_bitset_string_abstract), public, pass(self) :: write_bitset_string
procedure(write_bitset_unit_abstract), public, pass(self) :: write_bitset_unit

Functions

public elemental function bits(self)

License
Creative Commons License
Version
experimental

Returns the number of bit positions in self.

Arguments

TypeIntentOptionalAttributesName
class(bitset_type), intent(in) :: self

Return Value integer(kind=bits_kind)


Subroutines

public module subroutine error_handler(message, error, status, module, procedure)

Arguments

TypeIntentOptionalAttributesName
character, intent(in) :: message
integer, intent(in) :: error
integer, intent(out), optional :: status
character, intent(in), optional :: module
character, intent(in), optional :: procedure