@@ -54,7 +54,7 @@ bits. The other constants that are error codes are summarized below:
5454| ` char_string_too_large_error ` | Character string was too large to be encoded in the bitset|
5555| ` char_string_too_small_error ` | Character string was too small to hold the expected number of bits|
5656| ` index_invalid_error ` | Index to a bitstring was less than zero or greater than the number of bits|
57- | ` integer_overflow_error ` | Attempt to define an integer value bigger than ` huge(0_bits_kind ` ) |
57+ | ` integer_overflow_error ` | Attempt to define an integer value bigger than ` huge(0_bits_kind) ` |
5858| ` read_failure ` | Failure on a ` read ` statement|
5959| ` eof_failure ` | An unexpected "End-of-File" on a ` read ` statement|
6060| ` write_failure ` | Failure on a ` write ` statement|
@@ -78,13 +78,13 @@ position, that, in turn, is indexed from 0 to `bits-1`. `bitset_type` is
7878used only as a ` class ` to define entities that can be either a ` bitset_64 ` or
7979a ` bitset_large ` . The syntax for using the types are:
8080
81- ` class([[stdlib_bitset (module):bitset_type(class )]]) :: variable `
81+ ` class([[stdlib_bitsets (module):bitset_type(type )]]) :: variable `
8282
83- ` type([[stdlib_bitset (module):bitset_64(type)]]) :: variable `
83+ ` type([[stdlib_bitsets (module):bitset_64(type)]]) :: variable `
8484
8585and
8686
87- ` type([[stdlib_bitset (module):bitset_large(type)]]) :: variable `
87+ ` type([[stdlib_bitsets (module):bitset_large(type)]]) :: variable `
8888
8989## The * bitset-literal*
9090
@@ -136,6 +136,7 @@ and all characters in the string must be either "0" or "1".
136136## Summary of the module's operations
137137
138138The ` stdlib_bitsets ` module defines a number of operations:
139+
139140* "unary" methods of class ` bitset_type ` ,
140141* "binary" procedure overloads of type ` bitset_64 ` or ` bitset_large ` ,
141142* assignments, and
@@ -249,7 +250,7 @@ are summarized in the following table:
249250
250251## Specification of the ` stdlib_bitsets ` methods and procedures
251252
252- ### ` all ` - determine whether all bits are set in ` self ` .
253+ ### ` all ` - determine whether all bits are set in ` self `
253254
254255#### Status
255256
@@ -261,7 +262,7 @@ Determines whether all bits are set to 1 in `self`.
261262
262263#### Syntax
263264
264- ` result = self % [[bitset_type(class ):all(bound)]]() `
265+ ` result = self % [[bitset_type(type ):all(bound)]]() `
265266
266267#### Class
267268
@@ -297,7 +298,7 @@ otherwise it is `.false.`.
297298 end program demo_all
298299```
299300
300- #### ` and ` - bitwise ` and ` of the bits of two bitsets.
301+ ### ` and ` - bitwise ` and ` of the bits of two bitsets
301302
302303#### Status
303304
@@ -311,7 +312,7 @@ number of bits, otherwise the result is undefined.
311312
312313#### Syntax
313314
314- ` call [[stdlib_bitsets(module):and(interface]] (set1, set2) `
315+ ` call [[stdlib_bitsets(module):and(interface)]] (set1, set2) `
315316
316317#### Class
317318
@@ -417,7 +418,7 @@ Determines whether any bits are set in `self`.
417418
418419#### Syntax
419420
420- ` result = self % [[bitset_type(class ):any(bound)]]() `
421+ ` result = self % [[bitset_type(type ):any(bound)]]() `
421422
422423#### Class
423424
@@ -465,7 +466,7 @@ Returns the number of bits that are set to one in `self`.
465466
466467#### Syntax
467468
468- ` result = self % [[bitset_type(class ):bit_count(bound)]] () `
469+ ` result = self % [[bitset_type(type ):bit_count(bound)]] () `
469470
470471#### Class
471472
@@ -513,7 +514,7 @@ Reports the number of bits in `self`.
513514
514515#### Syntax
515516
516- ` result = self % [[bitset_type(class ):bits(bound)]] () `
517+ ` result = self % [[bitset_type(type ):bits(bound)]] () `
517518
518519#### Class
519520
@@ -545,7 +546,7 @@ the number of defined bits in `self`.
545546 end program demo_bits
546547```
547548
548- ### ` clear ` - clears a sequence of one or more bits.
549+ ### ` clear ` - clears a sequence of one or more bits
549550
550551#### Status
551552
@@ -566,11 +567,11 @@ Note: Positions outside the range 0 to `bits(set) -1` are ignored.
566567
567568#### Syntax
568569
569- `call self % [[ bitset_type(class ): clear (bound)]] ( pos ) '
570+ ` call self % [[bitset_type(type ):clear(bound)]](pos) `
570571
571572or
572573
573- ` call self % [[bitset_type(class ):clear(bound)]](start_pos, end_pos) `
574+ ` call self % [[bitset_type(type ):clear(bound)]](start_pos, end_pos) `
574575
575576#### Class
576577
@@ -675,21 +676,24 @@ Experimental
675676#### Description
676677
677678Flip the values of a sequence of one or more bits.
679+
678680* If only ` pos ` is present flip the bit value with position ` pos ` in
681+
679682 ` self ` .
680683* If ` start_pos ` and ` end_pos ` are present with ` end_pos >= start_pos `
681684flip the bit values with positions from ` start_pos ` to ` end_pos ` in
682685` self ` .
686+
683687* If ` end_pos < start_pos ` then ` self ` is unmodified.
684688
685689
686690#### Syntax
687691
688- ` call self % [[bitset_type(class ):flip(bound)]] (pos) `
692+ ` call self % [[bitset_type(type ):flip(bound)]] (pos) `
689693
690694or
691695
692- ` call self % [[bitset_type(class ):flip(bound)]] (start_pos, end_pos) `
696+ ` call self % [[bitset_type(type ):flip(bound)]] (start_pos, end_pos) `
693697
694698#### Class
695699
@@ -737,7 +741,7 @@ binary literal.
737741
738742#### Syntax
739743
740- ` call self % [[bitset_type(class ):from_string(bound)]](string[, status]) `
744+ ` call self % [[bitset_type(type ):from_string(bound)]](string[, status]) `
741745
742746#### Class
743747
@@ -790,7 +794,7 @@ codes:
790794 end program demo_from_string
791795```
792796
793- ### ` init ` - ` bitset_type ` initialization routines.
797+ ### ` init ` - ` bitset_type ` initialization routines
794798
795799#### Status
796800
@@ -802,7 +806,7 @@ Experimental
802806
803807#### Syntax
804808
805- ` call [[stdlib_bitsets(module ):init(interface )]] (self, bits [, status]) `
809+ ` call self % [[bitset_type(type ):init(bound )]] (bits [, status]) `
806810
807811#### Class
808812
@@ -813,7 +817,7 @@ Subroutine.
813817` self ` : shall be a scalar ` bitset_64 ` or ` bitset_large ` variable. It
814818is an ` intent(out) ` argument.
815819
816- ` bits ` (optional) : shall be a scalar integer expression of kind
820+ ` bits ` : shall be a scalar integer expression of kind
817821` bits_kind ` . It is an ` intent(in) ` argument that if present
818822specifies the number of bits in ` set ` . A negative value, or a value
819823greater than 64 if ` self ` is of type ` bitset_64 ` , is an error.
@@ -841,7 +845,7 @@ stop code. It can have any of the following error codes:
841845 type(bitset_large) :: set0
842846 call set0 % init(166)
843847 if ( set0 % bits() == 166 ) &
844- write(*,*) ` SET0 has the proper size.'
848+ write(*,*) ' SET0 has the proper size.'
845849 if ( set0 % none() ) write(*,*) 'SET0 is properly initialized.'
846850 end program demo_init
847851```
@@ -859,7 +863,7 @@ file.
859863
860864#### Syntax
861865
862- ` call self % [[bitset_type(class ):input(bound)]] (unit [, status]) `
866+ ` call self % [[bitset_type(type ):input(bound)]] (unit [, status]) `
863867
864868#### Class
865869
@@ -940,7 +944,7 @@ Determines whether no bits are set in `self`.
940944
941945#### Syntax
942946
943- ` result = self % [[bitset_type(class ):none(bound)]] () `
947+ ` result = self % [[bitset_type(type ):none(bound)]] () `
944948
945949#### Class
946950
@@ -989,7 +993,7 @@ Performs the logical complement on the bits of `self`.
989993
990994#### Syntax
991995
992- ` call self % [[bitset_type(class ):not(bound)]] () `
996+ ` call self % [[bitset_type(type ):not(bound)]] () `
993997
994998#### Class
995999
@@ -1019,7 +1023,7 @@ complement of their values on input.
10191023 end program demo_not
10201024```
10211025
1022- ### ` or ` - Bitwise OR of the bits of two bitsets.
1026+ ### ` or ` - Bitwise OR of the bits of two bitsets
10231027
10241028#### Status
10251029
@@ -1085,7 +1089,7 @@ Writes a binary representation of a bitset to an unformatted file.
10851089
10861090#### Syntax
10871091
1088- ` call self % [[bitset_type(class ):output(bound)]] (unit[, status]) `
1092+ ` call self % [[bitset_type(type ):output(bound)]] (unit[, status]) `
10891093
10901094#### Class
10911095
@@ -1159,11 +1163,11 @@ value.
11591163
11601164#### Syntax
11611165
1162- ` call self % [[bitset_type(class ):read_bitset(bound)]](string[, status]) `
1166+ ` call self % [[bitset_type(type ):read_bitset(bound)]](string[, status]) `
11631167
11641168or
11651169
1166- ` call self % [[bitset_type(class ):read_bitset(bound)]](unit[, advance, status]) `
1170+ ` call self % [[bitset_type(type ):read_bitset(bound)]](unit[, advance, status]) `
11671171
11681172
11691173#### Class
@@ -1258,7 +1262,7 @@ as its error code. The possible error codes are:
12581262 end program demo_read_bitset
12591263```
12601264
1261- ### ` set ` - sets a sequence of one or more bits to 1.
1265+ ### ` set ` - sets a sequence of one or more bits to 1
12621266
12631267#### Status
12641268
@@ -1282,11 +1286,11 @@ set the bits at positions from `start_pos` to `end_pos` in `self` to 1.
12821286
12831287#### Syntax
12841288
1285- ` call self % [[bitset_type(class ):set(bound)]] (POS) `
1289+ ` call self % [[bitset_type(type ):set(bound)]] (POS) `
12861290
12871291or
12881292
1289- ` call self % [[bitset_type(class ):set(bound)]] (START_POS, END_POS) `
1293+ ` call self % [[bitset_type(type ):set(bound)]] (START_POS, END_POS) `
12901294
12911295#### Class
12921296
@@ -1334,7 +1338,7 @@ Determine whether the bit at position `pos` is set to 1 in `self`.
13341338
13351339#### Syntax
13361340
1337- ` result = self % [[bitset_type(class ):test(bound)]](pos) `
1341+ ` result = self % [[bitset_type(type ):test(bound)]](pos) `
13381342
13391343#### Class
13401344
@@ -1383,7 +1387,7 @@ Represents the value of `self` as a binary literal in `string`.
13831387
13841388#### Syntax
13851389
1386- ` call self % [[bitset_type(class ):to_string(bound)]](string[, status]) `
1390+ ` call self % [[bitset_type(type ):to_string(bound)]](string[, status]) `
13871391
13881392#### Class
13891393
@@ -1440,7 +1444,7 @@ Determines the value of the bit at position, `pos`, in `self`.
14401444
14411445#### Syntax
14421446
1443- ` result = self % [[bitset_type(class ):value(bound)]](pos) `
1447+ ` result = self % [[bitset_type(type ):value(bound)]](pos) `
14441448
14451449#### Class
14461450
@@ -1491,11 +1495,11 @@ character string or formatted file.
14911495
14921496#### Syntax
14931497
1494- ` call self % [[bitset_type(class ):write_bitset(bound)]](string[, status]) `
1498+ ` call self % [[bitset_type(type ):write_bitset(bound)]](string[, status]) `
14951499
14961500or
14971501
1498- ` call self % [[bitset_type(class ):write_bitset(bound)]] (unit[, advance, status]) `
1502+ ` call self % [[bitset_type(type ):write_bitset(bound)]] (unit[, advance, status]) `
14991503
15001504#### Class
15011505
@@ -1649,7 +1653,7 @@ Returns `.true.` if all bits in `set1` and `set2` have the same value,
16491653
16501654or
16511655
1652- ` result = set1 [[stdlib_bitsets(module): .EQ.(interface)]] set2 `
1656+ ` result = set1 .EQ. set2 `
16531657
16541658#### Class
16551659
@@ -1708,7 +1712,7 @@ Returns `.true.` if any bits in `self` and `set2` differ in value,
17081712
17091713or
17101714
1711- ` result = set1 [[stdlib_bitsets(module): .NE.(interface)]] set2 `
1715+ ` result = set1 .NE. set2 `
17121716
17131717#### Class
17141718
@@ -1769,7 +1773,7 @@ results are undefined.
17691773
17701774or
17711775
1772- ` result = set1 [[stdlib_bitsets(module): .GE.(interface)]] set2 `
1776+ ` result = set1 .GE. set2 `
17731777
17741778#### Class
17751779
@@ -1832,7 +1836,7 @@ results are undefined.
18321836
18331837or
18341838
1835- ` result = set1 [[stdlib_bitsets(module): .GT.(interface)]] set2 `
1839+ ` result = set1 .GT. set2 `
18361840
18371841#### Class
18381842
@@ -1894,7 +1898,7 @@ results are undefined.
18941898
18951899or
18961900
1897- ` result = set1 [[stdlib_bitsets(module): .LE.(interface)]] set2 `
1901+ ` result = set1 .LE. set2 `
18981902
18991903#### Class
19001904
@@ -1957,7 +1961,7 @@ results are undefined.
19571961
19581962or
19591963
1960- `result = set1 [[ stdlib_bitsets(module): .LT.(interface) ]] set2
1964+ `result = set1 .LT. set2
19611965
19621966#### Class
19631967
0 commit comments