@q
@program lib-numrng
1 99999 d
i
( lib-numrngs v1.0 Jessy @ FurryMUCK 3/00
This library provides functions that take a single string value
containing space- or comma- separated numbers or ranges of numbers,
and returns their values as a stack range.
An example: In most word processors, you can specify pages to print by
typing something like "1-4, 8, 12" or "1-4 8 12" to print pages 1, 2,
3, 4, 8, and 12. Lib-numrngs does something similar. If passed "1-4,
8, 12", it would put:
12 8 4 3 2 1 6
on the stack. That is, the numerical values indicated in the string,
followed by a range indicator of how many numbers are returned. Its
intended use is with mail and bulletin board programs and the like.
"mail #d 2-5" might delete messages 2, 3, 4, and 5.
Since the string passed to lib-numrngs will usually be generated by
user input, and since trapping bad input can be difficult in this
situation, I've put quite a bit of effort into making it robust.
The library can handle positive and negative numbers, in ascending or
descending order. Spaces, commas, " and ", or " & " may be used as
separators; dashes or " to " can be used to indicate ranges. Stack
height is checked as the arg string is parsed and expanded, to prevent
stack overflows from input like "1-100000". Input that would overflow
the stack returns 0, false, and no range values. Non-number input is
discarded. That is, if the input consists entirely of non-number input,
0 will be returned. If a single value or range contains a non-number
value, that portion of the range will be omitted; the rest will be
returned as normal. Wilful garbage input -- that is, crazy combinations
of numbers, non-number, commas, spaces, and dashes intended to confuse
the parser -- will either return false or accurate but useless data.
The basic lib-numrng function is ParseRange. This returns the numbers
indicated in the arg string, unsorted, as integers.
ParseRange :: Unsorted, Duplicates OK, Integers
"6-4, -1 to 1, 5" ParseRange -- 5, 1, 0, -1, 6, 5, 4, 7
~
Alternate forms may be used to specify how to handle sorting,
duplications, and data type:
ParseRange-SDI :: Sorted, Duplicates OK, Integers
"6-4, -1 to 1, 5" ParseRange-SDI -- 6, 5, 5, 4, 1, 0, -1, 7
ParseRange-SDS :: Sorted, Duplicates OK, Strings
"6-4, -1 to 1, 5" ParseRange-SDI -- "6", "5", "5", "4", "1", "0", "-1", 7
ParseRange-SNI :: Sorted, No Duplicates, Integers
"6-4, -1 to 1, 5" ParseRange-SNI -- 6, 5, 4, 1, 0, -1, 6
ParseRange-SNS :: Sorted, No Duplicates, Strings
"6-4, -1 to 1, 5" ParseRange-SNI :: "6", "5", "4", "1", "0", "-1", 6
ParseRange-UDI :: Unsorted, Duplicates OK, Integers
"6-4, -1 to 1, 5" ParseRange-UDI -- 5, 1, 0, -1, 6, 5, 4, 7
ParseRange-UDS :: Unsorted, Duplicates OK, Strings
"6-4, -1 to 1, 5" ParseRange-UDS -- "5", "1", "0", "-1", "6", "5", "4" 7
ParseRange-UNI :: Unsorted, No Duplicates, Integers
"6-4, -1 to 1, 5" ParseRange-UNI -- 5, 1, 0, -1, 6, 4, 6
ParseRange-UNS :: Unsorted, No Duplicates, Strings
"6-4, -1 to 1, 5" ParseRange-UNS -- "5", "1", "0", "-1", "6", "4" 6
Sorts are performed with a bubble sort. This is efficient for the small
ranges that users will be specifying in most situations. The bubble sort
is ineffecient and *slow* for large ranges. If large ranges -- more than
100 numbers, say -- are a realistic possibility for your program, con-
sider using the unsorted functions, either working with the data as is
or sorting it within your own program by some other method.
INSTALLATION:
Port lib-numrng and register it as lib/numrng. Set the program Link_OK.
Lib-numrng will function at Mucker Level 2, but may crash due to max
instruction count exceeded when working with large, sorted ranges.
It may be safely set M3 or Wizard.
Set the definition props as indicated below:
@set lib-numrng=_defs/ParseRange:"$lib/numrng" match "ParseRange" call
@set lib-numrng=_defs/ParseRange-SDI:"$lib/numrng" match "ParseRange-SDI" call
@set lib-numrng=_defs/ParseRange-SDS:"$lib/numrng" match "ParseRange-SDS" call
@set lib-numrng=_defs/ParseRange-SNI:"$lib/numrng" match "ParseRange-SNI" call
@set lib-numrng=_defs/ParseRange-SNS:"$lib/numrng" match "ParseRange-SNS" call
@set lib-numrng=_defs/ParseRange-UDI:"$lib/numrng" match "ParseRange-UDI" call
@set lib-numrng=_defs/ParseRange-UDS:"$lib/numrng" match "ParseRange-UDS" call
@set lib-numrng=_defs/ParseRange-UNI:"$lib/numrng" match "ParseRange-UNI" call
@set lib-numrng=_defs/ParseRange-UNS:"$lib/numrng" match "ParseRange-UNS" call
Lib-numrngs may be freely ported. Please comment any changes.
)
$define Tell me @ swap notify $enddef
lvar libRangeCounter
: SortInts ( {int-rng} i -- {int-rng}' i ) (* sort range of ints *)
dup
begin (* begin outer loop *)
dup while
over
begin (* begin inner loop: compare pairs *)
dup 1 > while (* pull two values from range *)
dup 3 + pick over 3 + pick
over over < if (* if 'first' value is greater, swap *)
swap
then
3 pick 3 + put (* put the pair back in sorted order *)
over 3 + put
1 -
repeat (* end inner loop *)
pop
1 -
repeat (* end outer loop *)
pop pop (* pop last value checked and empty counter *)
libRangeCounter @ (* put range length back on stack *)
;
: RemoveDups ( {int-rng} i -- {int-rng}' i ) (* remove dups in range *)
begin (* begin outer loop *)
dup while (* get a value to check for dups *)
dup 1 + pick over 1 -
begin (* begin inner loop *)
dup while
dup 3 + pick
3 pick = if (* compare value being checked to rest of range *)
dup 3 + rotate pop (* pop duplicates found *)
libRangeCounter @ 1 - libRangeCounter ! (* decr rng total *)
rot 1 - rot rot
then
1 -
repeat (* end inner loop *)
pop pop
1 -
repeat (* end outer loop *)
pop libRangeCounter @
;
: ConvertToStrings ( {int-rng} i -- {str-rng} i )
(* convert all values in range to strings *)
begin
dup while
dup 1 + pick
intostr over 1 + put
1 -
repeat
pop libRangeCounter @
;
: FindTokens ( s -- s' ) (* subst to make a parseable string *)
"" "^" subst
" to" "- to" subst
" to " " - " subst
"," " and " subst
"-" " to " subst
"--" "-- " subst
"," "&" subst (* & indicates a leading negative number *)
"," " " subst
"," ",," subst
"^^^-" "--" subst
"^^^-" "-,-" subst
"," ",," subst
"-" "-," subst
"-" "--" subst
"^^^" ",^^^" subst (* ^^^ indicates a range. replaces 'to' or - *)
"^^^" ",^^^" subst
"^^^" "&^^^" subst
dup "^^^" stringpfx if
begin
dup "^^^" stringpfx while
3 strcut swap pop
repeat
then
;
: CondenseMultiRange ( s -- s' ) (* get rid of linked ranges *)
(* "2-4-6" would become "2^^^6" *)
dup "-" instr 1 - strcut
dup "-" rinstr strcut
swap pop
"^^^" swap strcat strcat
"^^^" "^^^^^^" subst
;
: ParseRange ( s -- {str-rng} i ) (* parse s for numbers *)
(* bail out if nothing passed to us *)
dup not if pop 0 exit then
FindTokens (* put s in parseable form *)
dup "-" stringpfx if (* double check leading negative *)
1 strcut swap pop
"&" swap strcat
then
"," explode (* break into comma-separated chunks *)
dup if (* check stack height *)
dup 509 > if (* if dangerously high, bail out *)
begin
dup while
swap pop
repeat
exit
then
dup libRangeCounter ! (* otherwise, store current range size *)
else
exit (* exit if we didn't get anything from the explode *)
then
begin (* begin outer parsing loop *)
dup while
dup 1 + pick string? not if (* trap garbage *)
1 - continue
then
dup 1 + rotate (* pull one item *)
dup not if (* trap some more garbage *)
libRangeCounter @ 1 - libRangeCounter !
pop 1 - continue
then
strip
dup "-" smatch if
libRangeCounter @ 1 - libRangeCounter !
pop 1 - continue
then
dup number? if (* if a number, convert *)
atoi swap
else (* otherwise, parse as a range *)
dup "-" stringpfx if (* use & to indicate leading num is neg *)
1 strcut swap pop
"&" swap strcat
then
dup "-" instr if
dup "*-*-*" smatch if (* trap more garbage *)
CondenseMultiRange
then
dup "^^^" instr if (* if it's a range, get 1st & last *)
"^^^" explode pop
else
dup "-" instr if
"-" explode pop
then
then (* convert &x to -x, a number *)
"-" "&" subst swap "-" "&" subst swap
dup number? (* make sure both are numbers *)
3 pick number? and not if
pop pop
libRangeCounter @ 1 - libRangeCounter !
1 - continue
then
atoi swap atoi (* convert range bound strings to ints *)
"marker" rot rot (* insert a place marker below range ints *)
over over > if (* fill range with contiguous ints *)
begin
over over = not while
over 1 - swap
depth 509 > if (* keep an eye on stack height *)
begin (* clear and exit if too high *)
dup string? not while
pop
repeat
pop
libRangeCounter @ - 1
begin
dup while
swap pop
1 -
repeat
exit
then
repeat
pop
else
begin
over over = not while
over 1 + swap
depth 509 > if
begin
dup string? not while
pop
repeat
pop
libRangeCounter @ - 1
begin
dup while
swap pop
1 -
repeat
exit
then
repeat
pop
then
1 (* update libRangeCounter to new range size *)
begin
dup pick string? not while
1 +
repeat
1 +
begin (* put our way down to "marker", pop it *)
dup 1 > while
dup 4 > if
libRangeCounter @ 1 + libRangeCounter !
dup pick 1 + over put
then
swap over
-1 * rotate
1 -
repeat
pop swap pop
else (* do it this way if range evals to a single number *)
"-" "&" subst
dup number? if
atoi swap
else
pop 1 -
libRangeCounter @ 1 - libRangeCounter !
continue
then
then
then
repeat
(* we've decremented the range indicator to nothing; put it back *)
pop libRangeCounter @
;
public ParseRange
: ParseRange-SDI ( s -- {int-rng} i ) ( SORTED, DUPS OK, INTEGERS )
ParseRange
dup if SortInts then
;
public ParseRange-SDI
: ParseRange-SDS ( s -- {str-rng} i ) ( SORTED, DUPS OK, STRINGS )
ParseRange
dup if SortInts ConvertToStrings then
;
public ParseRange-SDS ( s -- {str-rng} i )
: ParseRange-SNI ( s -- {int-rng} i ) ( SORTED, NO DUPS, INTEGERS )
ParseRange
dup if SortInts RemoveDups then
;
public ParseRange-SNI
: ParseRange-SNS ( s -- {str-rng} i ) ( SORTED, NO DUPS, STRINGS )
ParseRange
dup if SortInts RemoveDups ConvertToStrings then
;
public ParseRange-SNS
: ParseRange-UDI ( s -- {int-rng} i ) ( UNSORTED, DUPS OK, INTEGERS )
ParseRange
;
public ParseRange-UDI
: ParseRange-UDS ( s -- {str-rng} i ) ( UNSORTED, DUPS OK, STRINGS )
ParseRange
dup if ConvertToStrings then
;
public ParseRange-UDS
: ParseRange-UNI ( s -- {int-rng} i ) ( UNSORTED, NO DUPS, INTEGERS )
ParseRange
dup if RemoveDups then
;
public ParseRange-UNI
: ParseRange-UNS ( s -- {str-rng} i ) ( UNSORTED, NO DUPS, STRINGS )
ParseRange
dup if RemoveDups ConvertToStrings then
;
public ParseRange-UNS
.
c
q
@set lib-numrng=L
@set lib-numrng=3
@reg lib-numrng=lib/numrng
@set lib-numrng=_defs/ParseRange:"$lib/numrng" match "ParseRange" call
@set lib-numrng=_defs/ParseRange-SDI:"$lib/numrng" match "ParseRange-SDI" call
@set lib-numrng=_defs/ParseRange-SDS:"$lib/numrng" match "ParseRange-SDS" call
@set lib-numrng=_defs/ParseRange-SNI:"$lib/numrng" match "ParseRange-SNI" call
@set lib-numrng=_defs/ParseRange-SNS:"$lib/numrng" match "ParseRange-SNS" call
@set lib-numrng=_defs/ParseRange-UDI:"$lib/numrng" match "ParseRange-UDI" call
@set lib-numrng=_defs/ParseRange-UDS:"$lib/numrng" match "ParseRange-UDS" call
@set lib-numrng=_defs/ParseRange-UNI:"$lib/numrng" match "ParseRange-UNI" call
@set lib-numrng=_defs/ParseRange-UNS:"$lib/numrng" match "ParseRange-UNS" call