/* -*- REXX -*- */ /* @@PLEAC@@_NAME */ /* @@SKIP@@ REXX @@SKIP@@ */ /* @@PLEAC@@_WEB */ /* @@SKIP@@ http://www.rexxla.org/ @@SKIP@@ */ /* @@PLEAC@@_INTRO */ /* @@SKIP@@ REXX is an interpreted, general purpose programming language that @@SKIP@@ */ /* @@SKIP@@ is used for both system and applications programming, as well as @@SKIP@@ */ /* @@SKIP@@ scripting tasks on a number of platforms ranging from mainframes @@SKIP@@ */ /* @@SKIP@@ to hand-held devices. @@SKIP@@ */ /* @@SKIP@@ @@SKIP@@ */ /* @@SKIP@@ ANSI Standard of the REXX language released in 1996. The language has @@SKIP@@ */ /* @@SKIP@@ undergone extensive development over time, and is now available in @@SKIP@@ */ /* @@SKIP@@ two flavours: @@SKIP@@ */ /* @@SKIP@@ @@SKIP@@ */ /* @@SKIP@@ * REXX or 'classic' REXX @@SKIP@@ */ /* @@SKIP@@ * Object Oriented REXX or ooREXX @@SKIP@@ */ /* @@SKIP@@ @@SKIP@@ */ /* @@SKIP@@ The difference between these two flavours can be likened to that @@SKIP@@ */ /* @@SKIP@@ between the C, and C++ languages: syntactically similar, but the @@SKIP@@ */ /* @@SKIP@@ latter extended to support object oriented programming. @@SKIP@@ */ /* @@SKIP@@ @@SKIP@@ */ /* @@SKIP@@ More information is available at: http://en.wikipedia.org/wiki/REXX @@SKIP@@ */ /* @@SKIP@@ @@SKIP@@ */ /* @@SKIP@@ Comments about the examples: @@SKIP@@ */ /* @@SKIP@@ @@SKIP@@ */ /* @@SKIP@@ * Incomplete examples are marked with the relevant PLEAC tags @@SKIP@@ */ /* @@SKIP@@ * Complete, but untranslateable, examples are so-marked @@SKIP@@ */ /* @@SKIP@@ * Extensive use of third-party libraries made [see Appendix] @@SKIP@@ */ /* @@SKIP@@ * Regina 3.3 interpreter used for testing [*NIX and Win32] @@SKIP@@ */ /* @@PLEAC@@_APPENDIX */ /* Some of the libraries used: * http://home.interlog.com/~ptjm/software.html REXXUtil General Purpose Utilities - System Information - Basic Console Control - File / Directory Manipulation REXXMath Common Mathematical Functions RxHash Associative Array Support REXXRe Regular Expressions * http://rxsock.sourceforge.net/index.html RxSock TCP/IP Sockets * http://rexxsql.sourceforge.net/index.html REXX/SQL SQL Library * http://rexxtk.sourceforge.net/index.html REXX/Tk TK Toolkit * http://rexxcurses.sourceforge.net/index.html REXX/Curses Curses Toolkit /* ----------------------------- */ A REXX script is assumed to commence with the following lines: options 'STRICT_ANSI' ; trace 'OFF' ; signal on NOVALUE FALSE = 0 ; TRUE = 1 ; NULL = "" ; SPACE = ' ' ; NEWLINE = "0A"X NaN = "NaN" globals = "sys. env. args. $. FALSE TRUE NULL NEWLINE SPACE NaN" /* ----------------------------- */ REXXToolkit routines [when documented] will appear here /* ----------------------------- */ */ /* @@PLEAC@@_1.0 */ string = '\n' /* two characters, \ and an n, though not a newline */ string = "\n" /* two characters, \ and an n, though not a newline */ string = "0A"X /* newline character code [hex] */ string = "1010"B /* newline character code [binary] */ string = "Newline" "0A"X "here" /* embedded newline in string */ string = 'Jon ''Maddog'' Orwant' /* literal single quotes */ string = "Jon ""Maddog"" Orwant" /* literal double quotes */ string = "Jon 'Maddog' Orwant" /* embedded literal single quotes */ string = 'Jon "Maddog" Orwant' /* embedded literal double quotes */ /* ----------------------------- */ /* HERE documents not supported, but multi-line string allowed */ a = "This is a multiline string that is not a HERE document" , "but consists of a series of concatenated strings" , "each on its own line courtesy of the 'comma' which, when" , "it appears as the last, space-separated character on a" , "line, acts as a line continuation character" /* ----------------------------- */ /* Pseudo implementation of a HERE document */ signal HEREDOC /* Line 1 ... Line 2 ... Line 3 */ HEREDOC: a = NULL do i = SIGL + 1 line = SOURCELINE(i) if line = "*/" then leave a = a||NEWLINE||line end /* @@PLEAC@@_1.1 */ /* ------------------------------------------------------------------ */ /* * REXX offers string manipulation built-in functions [BIF's] many */ /* being equivalent to Perl offerings. However, all REXX BIF's */ /* return copies of the transformed string; original is unaltered. */ /* Therefore this type of usage is illegal: */ /* */ /* SUBSTR(string, offset, count) = newstring */ /* */ /* Instead, variable storing original must be reassigned with the */ /* altered copy */ /* */ /* * REXX implements PARSE instruction which provides a faster means */ /* of: */ /* - tokenising strings [from several sources: string, file, stack] */ /* - assigning tokens to variables */ /* - initialisng and swapping variables, multi-line assignments */ /* */ /* Examples of both approaches shown wherever applicable */ /* ------------------------------------------------------------------ */ string = "a value" /* ----------------------------- */ offset = 3 ; count = 9 ; padchar = 'X' parse var string =(offset) v v = SUBSTR(string, offset) /* "value " */ parse var string =(offset) v +(count) v = SUBSTR(string, offset, count) /* "value " */ v = SUBSTR(string, offset, count, padchar) /* "valueXXXX" */ /* ----------------------------- */ offset = 2 ; count = 2 ; padchar = '*' ; newstr = "Z" v = INSERT(newstr, string, offset, count, padchar) /* "a Z*value" */ v = OVERLAY(newstr, string, offset, count, padchar) /* "aZ*alue" */ /* ----------------------------- */ /* *** Unfinished *** - UNPACK */ /* ----------------------------- */ /* PARSE VAR instruction equivalent, but more efficient, than SUBSTR */ string = "This is what you have" slen = LENGTH(string) parse var string =1 first +1 first = SUBSTR(string, 1, 1) /* "T" */ parse var string =6 start +2 start = SUBSTR(string, 6, 2) /* "is" */ parse var string =14 rest rest = SUBSTR(string, 14) /* "you have" */ parse var string =(slen) last +1 last = SUBSTR(string, slen, 1) /* "e" */ parse var string =(slen) -3 end end = SUBSTR(string, slen - 3) /* "have" */ parse var string =(slen) -7 piece +3 piece = SUBSTR(string, slen - 7, 3) /* "you" */ /* Display contents of string */ say string /* Change "is" to "wasn't" : This wasn't what you have */ string = CHANGEWORD("is", string, "wasn't") /* Replace last 12 characters : This wasn't wondrous */ newstr = "ondrous" ; slen = LENGTH(string) ; nlen = LENGTH(newstr) /* 1 - slow */ string = OVERLAY(newstr, string, slen - 11) string = DELSTR(string, LASTPOS(newstr, string) + nlen) /* 2 - faster */ string = LEFT(string, slen - 12) || newstr /* 3 - fastest */ sparse = slen - 12 parse var string string +(sparse) string = string || newstr /* delete first character : his wasn't wondrous */ parse var string =2 string string = DELSTR(string, 1, 1) string = RIGHT(string, slen - 1) /* Return last 15 characters : wasn't wondrous */ slen = LENGTH(string) parse var string =(slen) -14 string +15 string = SUBSTR(string, slen - 14, 15) string = RIGHT(string, 15) /* Delete last 10 characters : wasn' */ slen = LENGTH(string) ; sparse = slen - 10 parse var string string +(sparse) string = DELSTR(string, slen - 9, 10) string = LEFT(string, slen - 10) /* *** Unfinished *** */ /* @@PLEAC@@_1.2 */ /* ------------------------------------------------------------------ */ /* REXX Boolean values are strictly: */ /* */ /* 1 - TRUE */ /* 0 - FALSE */ /* */ /* All other values force an syntax error if used in a Boolean */ /* context; Boolean expression can be forced via a comparision */ /* operation [see example below] */ /* */ /* REXX does not support conditional structures other than the 'IF' */ /* and 'SELECT' instructions; there is no ternary operator, nor a */ /* conditional assignment expression. This can, however, be mimiced */ /* via function; examples below use an 'iif' function implementation */ /* that, rather crudely, supports this type of operation */ /* */ /* iif(CONDITION, TRUE_VALUE, FALSE_VALUE) */ /* */ /* It is also worth mentioning that the WORD BIF can also be used for */ /* performing conditional assignment. It can be used where alternate */ /* values can be placed in the same string, and relies on: */ /* */ /* * The fact that in REXX all data are strings */ /* * The values of FALSE and TRUE being exactly 0, and 1, respectively*/ /* */ /* See example at end of this section */ /* ------------------------------------------------------------------ */ condition = TRUE ; b = 'B' ; c = 'C' ; x = TRUE ; y = 'Y' /* Use 'b' if 'condition' is TRUE, else return 'c' */ a = iif(condition, b, c) /* Use 'b' if 'b' is TRUE, else 'c' */ a = iif(, b, c) /* Set 'x' to 'y' unless 'x' is already TRUE */ x = iif(, \x, y) /* As above; Boolean expression forced in case 'x' non-Boolean */ x = iif(, \(x == TRUE), y) /* ----------- */ /* Use 'b' if 'b' is defined, else 'c' */ a = iif(SYMBOL('b') == "VAR", b, c) bar = "ANOTHER VALUE" foo = iif(SYMBOL('bar') \= "VAR", bar, "DEFAULT VALUE") exit 0 /* ----------- */ iif : procedure expose (globals) if ARG(1, 'E') then cond = ARG(1) ; else cond = ARG(2) if cond == TRUE then return ARG(2) ; else return ARG(3) /* ----------------------------- */ condition = TRUE ; alternatives = "B C" /* condition: FALSE -> 'B' returned condition: TRUE -> 'C' returned */ WORD(alternatives, condition + 1) /* @@PLEAC@@_1.3 */ /* ------------------------------------------------------------------ */ /* No multiple-assignment support, but PARSE VALUE instruction may be */ /* used to perform: */ /* */ /* * Multiple variable initialisation */ /* * Multiple variable assignment [even swap values without temps] */ /* ------------------------------------------------------------------ */ parse value 1 2 with VAR1 VAR2 parse value VAR1 VAR2 with VAR2 VAR1 /* ----------------------------- */ a = 1 ; b = 2 temp = a ; a = b ; b = temp /* ----------------------------- */ parse value 57 72 103 with alpha beta production parse value beta production alpha with alpha beta production /* @@PLEAC@@_1.4 */ /* ------------------------------------------------------------------ */ /* REXX is a typeless language: all data are strings. This means: */ /* */ /* * REXX has no notion of objects, or aggregate types like arrays */ /* * It does not support 'primitive' types, those usually mapped to */ /* hardware registers */ /* */ /* In order to support mathematical operations, however, strings in */ /* Base 10 format [containing 0-9, leading + or -, a decimal point, */ /* exponent indicator 'E' and exponent] are recognised as 'numeric' */ /* strings in such contexts [whilst hex and binary strings are not]. */ /* */ /* The benefit of this approach: */ /* */ /* * Simplifies interpreter implementation on new platforms */ /* * Implicit support for arbitrary precision arithmetic */ /* * Language kept simple - no declarations, casting or conversions */ /* */ /* A set of conversion BIF's is supplied to facilitate the conversion */ /* of strings to / from various numeric representations, though it is */ /* understood that this is not a type conversion, but a 'form' */ /* conversion, one that may facilitate data printing or storage: */ /* */ /* * C2D / D2C [Character to Decimal / vice versa] */ /* * C2X / X2C [Character to Hex / vice versa] */ /* * X2B / B2X [Hex to Binary / vice versa] */ /* ------------------------------------------------------------------ */ char = 'A' /* or: char = '41'X [ASCII] */ num = C2D(char) char = D2C(num) /* ----------------------------- */ char = 'e' say "Number" C2D(char) "is" char /* Number 101 is e */ /* ----------------------------- */ string = "ABCDE" ascii = C2X(string) /* ascii [hex]: 4142434445 */ string = X2C(ascii) /* string: ABCDE */ /* ----------------------------- */ /* Contents: 73616D706C65 */ ascii_character_numbers = C2X("sample") /* Output will now be: 73 61 6D 70 6C 65 */ out = "" ; acn = ascii_character_numbers do while acn <> NULL parse var acn token +2 acn out = out token end say STRIP(out) /* Output will now be: sample */ out = X2C(ascii_character_numbers) say out /* ----------------------------- */ hal = "HAL" ; ibm = "" do while hal <> NULL parse var hal token +1 hal ibm = ibm||D2C(C2D(token) + 1) end /* Output will now be: IBM */ say ibm /* @@PLEAC@@_1.6 */ /* ------------------------------------------------------------------ */ /* The task of reversing strings is easily and efficiently performed */ /* via the REVERSE BIF. Implementation of a palindome-checking routine*/ /* is probably best accomplished via its use since it involves a */ /* single function call, thus incurs minimal calling overhead. Since */ /* REXX is typically used as an interpreted language, it often becomes*/ /* a significant issue. Performance comparision of the following two */ /* 'isPalindrome' functions should clearly reveal it's impact. */ /* */ /* isPalindrome : procedure */ /* i = 1 ; j = LENGTH(ARG(1)) */ /* do until i >= j */ /* if SUBSTR(ARG(1),i,1) \= SUBSTR(ARG(1),j,1) ; then return FALSE*/ /* i = i + 1 ; j = j - 1 */ /* end */ /* return TRUE */ /* */ /* isPalindrome : procedure */ /* return REVERSE(ARG(1)) == ARG(1) */ /* */ /* The task of reversing words within a string can quite easily be */ /* accomplished in several ways: */ /* */ /* * PARSE instruction together with the stack operations PUSH and */ /* PARSE PULL [stack and queue structures are native to REXX, and */ /* are used for many diverse tasks including interprocess comms] */ /* */ /* * Word-oriented BIF's ['reverseWords' is a recursive function that */ /* uses two of these: DELWORD and WORD. Anyone familiar with LISP or*/ /* Scheme will note how they are being used like 'car' and cdr'] */ /* */ /* reverseWords : procedure */ /* if ARG(1) == "" then ; return "" */ /* return STRIP(reverseWords(DELWORD(ARG(1), 1, 1)) WORD(ARG(1), 1))*/ /* ------------------------------------------------------------------ */ string = "A horse is a horse, of course, of course !" /* Reverse string using REXX BIF */ revbytes = REVERSE(string) /* ----------------------------- */ /* Tokenise 'string', and place each token on stack */ do while string <> NULL parse var string token string push token end /* Build 'revwords' by extracting tokens from stack */ revwords = "" do while QUEUED() > 0 parse pull token revwords = revwords token end /* ----------------------------- */ string = 'Yoda said, "can you see this?"' /* Reverse the word order in a string [custom function - see header] */ revwords = reverseWords(string) say revwords /* ----------------------------- */ word = "reviver" /* Check whether string is palindrome [custom function - see header] */ is_palindrome = isPalindrome(word) /* @@PLEAC@@_2.0 */ /* ------------------------------------------------------------------ */ /* REXX uses floating point-based, arbitrary precision arithmetic */ /* which, unlike most computer languages, operates not on hardware- */ /* mapped bit collections, but on strings which represent numbers. */ /* */ /* The immediately-obvious disadvantage of this approach is slower, */ /* less memory-efficient number crunching capabilities when compared */ /* to scripting languages like Perl or Python. On the other hand, this*/ /* design approach simplifies REXX interpreter implementation across */ /* platforms, as well as eliminating most of the loss-of-precision and*/ /* related problems so often encountered when 'number crunching'. So, */ /* from an end-user perspective, arithmetic operations should nearly */ /* always generate 'unsurprising' results, and not cause the naive or */ /* unwary user any confusion. */ /* ------------------------------------------------------------------ */ /* @@PLEAC@@_2.1 */ /* ------------------------------------------------------------------ */ /* The REXX-idiomatic numeric validation approach is to use the */ /* 'DATATYPE' BIF. For more complex validation needs the 'VERIFY' BIF */ /* may also be used but since it only checks for the presence or the */ /* absence of characters it needs to be augmented with other checks. */ /* */ /* Regex-based validation [once implemented] requires the least work. */ /* The examples make use of a REXXToolkit routine, 'match', which */ /* uses the 'RxRe' external library. See Appendix for details. */ /* ------------------------------------------------------------------ */ /* REXX BIF-based Validation */ /* Accepts: +9 -9 9.0 9.0e+2 9.0E-3 */ if \DATATYPE(string, 'N') then ; say "not a decimal number" /* Accepts: +9 -9 Rejects: 9.0 9.0e+2 9.0E-3 */ if \(DATATYPE(string, 'W') & POS(".", string) == 0) then say "not an integer" /* ----------- */ /* Checks for presence / absence of characters, but does not check position of characters, or presence of patterns. Useful for quick, but not thorough, validation */ if VERIFY(string, "0123456789") \= 0 then ; say "has nondigits" if VERIFY(string, "+-.Ee0123456789") \= 0 then ; say "not a decimal" /* ----------- */ /* Custom function, 'isDecimal', which uses a combination of the PARSE instruction, and DATATYPE BIF to thoroughly validate a decimal value */ tbl = "+934.521e-2 -934.521 934 ", "+934.521e-a +934.521f-2 +934.!e-2 ", "e934.521e-2" entries = WORDS(tbl) do i = 1 for entries entry = WORD(tbl, i) if isDecimal(entry) then ; say entry "is decimal" else ; say entry "is NOT decimal" end exit 0 /* ----------- */ isDecimal : procedure expose (globals) parse upper value ARG(1) with whole "." frac "E" exp if exp \= NULL then ; if \DATATYPE(exp, 'W') then ; return FALSE if frac \= NULL then ; if \DATATYPE(frac, 'W') then ; return FALSE if whole \= NULL then ; if \DATATYPE(whole, 'W') then ; return FALSE return TRUE /* ----------------------------- */ /* Regex-based Validation */ if match(string, "PATTERN") then /* Is a number */ else /* Is not */ /* ----------- */ /* Also rejects: +9 -9 9.0 */ if match(string, "[^[:digit:]]") then ; say "has nondigits" /* Also rejects: +9 -9 9.0 */ if \match(string, "^[[:digit:]]+$") then ; say "not a natural number" /* Rejects: +9 9.0 Accepts: -9 */ if \match(string, "^-?[[:digit:]]+$") then ; say "not an integer" /* Rejects: 9.0 Accepts: +9 -9 */ if \match(string, "^[+-]?[[:digit:]]+$") then ; say "not an integer" /* Accepts: +9 -9 9.0 9.0e+2 9.0E-3 */ decimalRE = "^[+-]?[[:digit:]]+\.?[[:digit:]]+[e|E][+-]?[[:digit:]]+$" if \match(string, decimalRE) then say "not a decimal number" /* @@PLEAC@@_2.2 */ /* ------------------------------------------------------------------ */ /* The NUMERIC instruction allows adjustment of: */ /* */ /* * Significant digits used in arithmetic operations [DIGITS] */ /* * Digits to be ignored during arithmetic comparisons [FUZZ] */ /* */ /* Default values are usually adequate. Increasing DIGITS increases */ /* precision, but slows down arithmetic operations. FUZZ is by default*/ /* 0, so all digits are significant in comparison operations. */ /* */ /* The FORMAT BIF may be used like the C-derived, 'sprintf', function */ /* to compare floating point values as strings. */ /* ------------------------------------------------------------------ */ numeric digits 11 a = 1234567.8234 ; b = 1234567.8237 /* Compare 'DIGITS - FUZZ' [11] number of digits */ numeric fuzz 0 if a = b then ; say "a = b" /* FALSE */ /* Compare 'DIGITS - FUZZ' [10] number of digits */ numeric fuzz 1 if a = b then ; say "a = b" /* FALSE */ /* Compare 'DIGITS - FUZZ' [9] number of digits */ numeric fuzz 2 if a = b then ; say "a = b" /* TRUE */ /* ----------------------------- */ /* Returns TRUE if 'num1' and 'num2' are equal to 'accuracy' number of decimal places */ isEqual(num1, num2, accuracy) /* ----------------------------- */ a = 1234567.8234 ; b = 1234567.8237 /* isEqual(a, b, 1) ==> TRUE isEqual(a, b, 2) ==> TRUE isEqual(a, b, 3) ==> TRUE isEqual(a, b, 4) ==> FALSE */ exit 0 /* ----------- */ isEqual : procedure expose (globals) places = ARG(3) ; numeric fuzz 0 return FORMAT(ARG(1),, places) == FORMAT(ARG(2),, places) /* ----------------------------- */ wage = 536 /* $ 5.36 / hr */ week = 40 * wage /* $ 214.40 */ say "One week's wage is: $" FORMAT(week / 100,, 2) /* @@PLEAC@@_2.3 */ /* ------------------------------------------------------------------ */ /* The 'FORMAT' BIF is REXX's equivalent to the much-used, C-derived */ /* 'sprintf' function. */ /* ------------------------------------------------------------------ */ /* Truncate to integer value */ truncated = TRUNC(value, length) /* Round value [and possibly justify] */ rounded = FORMAT(value, n_before_decimal, n_after_decimal) /* ----------------------------- */ a = 0.255 ; b = FORMAT(a, 1, 2) say "Unrounded:" a "Rounded:" b say "Unrounded:" a "Rounded:" FORMAT(a, 1, 2) /* Unrounded: 0.255 Rounded: 0.26 Unrounded: 0.255 Rounded: 0.26 */ /* ----------------------------- */ /* Example illustrating external library routine use. Not, however, that the FORMAT BIF can be used to perform the same tasks as 'NInt', 'Floor' and 'Ceil', making library routine use unnecessary */ /* Load [rexxMath] math functions from external library */ call rxFuncAdd 'mathLoadFuncs', 'rexxMath', 'mathLoadFuncs' call mathLoadFuncs tbl = "3.3 3.5 3.7 -3.3" say cstr2rxstr("number\tint\tfloor\tceil") do while tbl <> NULL parse var tbl n tbl line = FORMAT(n, 2, 1) || "\t" ||, FORMAT(NInt(n), 2, 1) || "\t" ||, FORMAT(Floor(n), 2, 1) || "\t" ||, FORMAT(Ceil(n), 2, 1) say cstr2rxstr(line) end /* number int floor ceil 3.3 3.0 3.0 4.0 3.5 4.0 3.0 4.0 3.7 4.0 3.0 4.0 -3.3 -3.0 -4.0 -3.0 */ /* Unload math functions */ call mathDropFuncs exit 0 /* ----------- */ cstr2rxstr : procedure expose (globals) s = ARG(1) ; tbl = "\n 0A \r 0D \t 09" do while tbl \= NULL parse var tbl esc replc tbl s = CHANGESTR(esc, s, X2C(replc)) end return s /* @@PLEAC@@_2.4 */ /* ------------------------------------------------------------------ */ /* Binary, hexadecimal, decimal interconversion is well-supported via */ /* the following BIF's: */ /* */ /* * X2D, D2X [hex->dec, dec->hex, respectively] */ /* * X2B, B2X [hex->bin, bin->hex, respectively] */ /* */ /* Easily combined to create functions that interconvert binary and */ /* decimal. */ /* ------------------------------------------------------------------ */ /* Convert binary string to decimal */ decimal = B2D('0110110') /* Convert decimal value to binary string */ binary = D2B(54) exit 0 /* ----------- */ B2D : procedure expose (globals) return X2D(B2X(ARG(1))) D2B : procedure expose (globals) return X2B(D2X(ARG(1))) /* @@PLEAC@@_2.5 */ /* ------------------------------------------------------------------ */ /* The 'do' loop is the REXX-idiomatic control structure for */ /* repetitive tasks such as list traversal. Recursive solutions are */ /* possible but less efficient due to argument passing overhead, and */ /* lack of tail-call optimisation. */ /* ------------------------------------------------------------------ */ x = 1 ; y = 5 ; step = 1 /* Number sequence is traversed using 'do' loop */ /* 'i' set from value of 1 through to 5 in 'step' increments */ do i = x to y by step /* do something with 'i' */ end /* ----------- */ /* 'i' set from value of 1 through to 5; default increment of 1 */ do i = x to y /* do something with 'i' */ end /* ----------------------------- */ call CHAROUT , "Infancy is: " do i = 0 to 2 ; call CHAROUT , i || SPACE ; end say NULL call CHAROUT , "Toddling is: " do i = 3 to 4 ; call CHAROUT , i || SPACE ; end say NULL call CHAROUT , "Childhood is: " do i = 5 to 12 ; call CHAROUT , i || SPACE ; end say NULL /* ----------------------------- */ /* REXX does not sport a native 'foreach' control structure, but it is possible to implement similar behaviour provided certain conventions are followed such as generating lists of SPACE or COMMA-separated sequences */ /* ----------------------------- */ sequence = makeIntegerSequence(1, 5, 1) do while sequence <> NULL parse var sequence value sequence call CHAROUT , value || SPACE end /* ----------- */ /* Partial reimplementation of earlier example */ infancy = makeIntegerSequence(0, 2, 1) call CHAROUT , "Infancy is: " do while infancy <> NULL parse var infancy value infancy call CHAROUT , value || SPACE end /* ... */ exit 0 /* ----------- */ /* Iterative ['do' loop-based] */ makeIntegerSequence : procedure expose (globals) x = ARG(1) ; y = ARG(2) ; step = ARG(3) seq = x ; x = x + 1 ; do i = x to y by step ; seq = seq i ; end return seq /* Recursive */ makeIntegerSequenceR : procedure expose (globals) x = ARG(1) ; y = ARG(2) ; step = ARG(3) if x > y then ; return NULL return x makeIntegerSequenceR(x + step, y, step) /* Iterative [Tail Recursive] */ makeIntegerSequenceI : procedure expose (globals) x = ARG(1) ; y = ARG(2) ; step = ARG(3) ; seq = ARG(4) if x > y then ; return STRIP(seq) return makeIntegerSequenceI(x + step, y, step, (seq x)) /* @@PLEAC@@_2.6 */ /* ------------------------------------------------------------------ */ /* REXX sports no inbuilt Roman numeral-handling routines. A custom */ /* implementation appears below. */ /* ------------------------------------------------------------------ */ roman = arabic2roman(arabic) arabic = roman2arabic(roaman) /* ----------------------------- */ roman_fifteen = arabic2roman(15) say "Roman for fifteen is" roman_fifteen arabic_fifteen = roman2arabic(roman_fifteen) say "Converted back" roman_fifteen "is" arabic_fifteen exit 0 /* ----------- */ roman2arabic : procedure tbl.I = 1 ; tbl.V = 5 ; tbl.X = 10 ; tbl.L = 50 tbl.C = 100 ; tbl.D = 500 ; tbl.M = 1000 tbl.IV = 4 ; tbl.IX = 9 ; tbl.XL = 40 ; tbl.XC = 90 tbl.CD = 400 ; tbl.CM = 900 roman = " " || TRANSLATE(STRIP(ARG(1))) ; arabic = 0 do i = LENGTH(roman) - 1 to 1 by -1 r = SUBSTR(roman, i, 2) if SYMBOL('tbl.r') == 'VAR' then ; i = i - 1 else ; r = RIGHT(r, 1) arabic = arabic + tbl.r end return arabic /* ----------- */ arabic2roman : procedure arabic = REVERSE(ARG(1)) ; len = LENGTH(arabic) ; roman = "" tbl.1 = "I II III IV V VI VII VIII IX" tbl.2 = "X XX XXX XL L LX LXX LXXX XC" tbl.3 = "C CC CCC CD D DC DCC DCCC CM" if len < 4 then do i = 1 to len j = SUBSTR(arabic, i, 1) ; if j == 0 then ; iterate roman = WORD(tbl.i, j) || roman end else ; do do i = 1 to 3 j = SUBSTR(arabic, i, 1) ; if j == 0 then ; iterate roman = WORD(tbl.i, j) || roman end roman = COPIES("M", REVERSE(SUBSTR(arabic, 4))) || roman end return roman /* @@PLEAC@@_2.7 */ /* ------------------------------------------------------------------ */ /* Random number [well, pseudo-random :)] generation is typically */ /* performed using the 'RANDOM' BIF. */ /* ------------------------------------------------------------------ */ random = RANDOM(maxval) /* 0 - maxval [maxval <= 100000] */ random = RANDOM(minval, maxval) /* minval - maxval [as above] */ /* ----------------------------- */ tbl = "abcdefghijklmnop" elt = randomChoice(tbl) /* One of 'a', 'b', ... */ tbl = "12 67 asde cvs +++ &fgt klmnop" elt = randomChoice(tbl) /* One of 12, 67, ... */ /* ----------------------------- */ /* Generate 8 character-length password with randomly chosen chars */ chars = XRANGE("A", "Z") || XRANGE("a", "z") ||, XRANGE("0", "9") || "!$%#@*&" password = NULL do 8 password = password || randomChoice(chars) end exit 0 /* ----------- */ randomChoice : procedure expose (globals) tbl = ARG(1) ; items = WORDS(tbl) if items == 1 then do items = LENGTH(tbl) ; item = SUBSTR(tbl, RANDOM(1, items), 1) end ; else do item = WORD(tbl, RANDOM(1, items)) end return item /* @@PLEAC@@_2.8 */ /* ------------------------------------------------------------------ */ /* See comments in previous section */ /* ------------------------------------------------------------------ */ random = RANDOM(,, seed) /* Each such call reseeds the RNG */ /* @@PLEAC@@_2.9 */ /* ------------------------------------------------------------------ */ /* Custom functions for this type of task are easily written in REXX. */ /* Examples include: */ /* */ /* * 'lcg', simple linear-congruential RNG */ /* * 'randomSlice' - see example below */ /* ------------------------------------------------------------------ */ random = 47523 ; reps = 10 do reps random = lcg(random) /* do something with 'random' ... */ end /* ----------------------------- */ reps = 10 do reps /* Random length digit sequence; sliced from random position of a default-length 'RANDU'-generated digit sequence */ random = randomSlice() /* 3 digit sequence; as previous */ random = randomSlice(3) /* 4 digit sequence; sliced from random position of a 13 digit length 'RANDU'-generated digit sequence */ random = randomSlice(4, 13) end /* ----------- */ lgc : procedure expose (globals) numeric digits 17 return 16807 * ARG(1) // 2147483647 randomSlice : procedure expose (globals) sizeSlice = ARG(1) ; sizePool = ARG(2) if sizePool == NULL | sizePool > 17 then ; sizePool = 17 if sizeSlice == NULL then ; sizeSlice = RANDOM(1, sizePool - 1) if sizeSlice >= sizePool then ; sizeSlice = sizePool - 1; posSlice = RANDOM(1, sizePool - sizeSlice) numeric digits sizePool parse value RANDU() with "." frac return SUBSTR(frac, posSlice, sizeSlice) /* @@PLEAC@@_2.10 */ /* ------------------------------------------------------------------ */ /* Gaussian RNG */ /* ------------------------------------------------------------------ */ /* Need this for access to non-standard, 'RANDU', function */ options 'AREXX_BIFS' /* Using 'rexxMath' Library Routines */ /* Load [rexxMath] math functions from external library */ call rxFuncAdd 'mathLoadFuncs', 'rexxMath', 'mathLoadFuncs' call mathLoadFuncs /* ----------- */ mean = 25.0 ; sdev = 2.0 ; salary = gaussian_rand() * mean + sdev say "You have been hired at:" FORMAT(salary,, 2) /* ----------- */ /* Unload math functions */ call mathDropFuncs exit 0 /* ----------- */ gaussian_rand : procedure w = 2.0 do while w > 1.0 u1 = 2.0 * RANDU() - 1.0 ; u2 = 2.0 * RANDU() - 1.0 w = u1 * u1 + u2 * u2 end w = Sqrt((-2.0 * Log10(w)) / w) ; g2 = u1 * w ; g1 = u2 * w return g1 /* @@PLEAC@@_2.11 */ /* ------------------------------------------------------------------ */ /* Aside from supporting the usual arithmetic operations, including */ /* exponentiation [via the '**' operator], and a few BIF's including */ /* 'MIN', 'MAX', 'SIGN' and 'ABS', REXX offers no built-in support for*/ /* mathematical operations. Instead the programmer can implement the */ /* required functionality themselves, or make use of external library */ /* routines. */ /* */ /* REXX-native mathematical functions are easily implementable, but */ /* the string-expressable, arbitrary precision arithmetic model used */ /* ensures they will not be as 'high performance' as hardware-based */ /* implementations, precluding their use for 'serious' number crunch- */ /* ing. On the other hand, external library routines are [like the one*/ /* illustrated here] to be hardware-based, hence offer performance */ /* comparable to that of other languages after both function call and */ /* data conversion overhead is taken into account. */ /* ------------------------------------------------------------------ */ /* Using 'rxMath' Library Routines */ /* Load [rxMath] math functions from external library */ call rxFuncAdd 'mathLoadFuncs', 'rxMath', 'mathLoadFuncs' call mathLoadFuncs /* Accepts argumets in either degree, radian, or gradian form */ say rxCalcSin(30, 'D') say FORMAT(rxCalcSin(60, 'D'),,3) /* Unload math functions */ call mathDropFuncs exit 0 /* ----------- */ /* Using native REXX Routines [need 'Sin' from external library] */ radians = DEG2RAD(degrees) degrees = RAD2DEG(radians) /* ----------------------------- */ /* Load [rexxMath] math functions from external library */ call rxFuncAdd 'mathLoadFuncs', 'rexxMath', 'mathLoadFuncs' call mathLoadFuncs say degree_sin(30) say FORMAT(degree_sin(60),,3) /* Unload math functions */ call mathDropFuncs exit 0 /* ----------- */ degree_sin : procedure expose (globals) /* ARG(1) - Degrees --- 'Sin' [a 'rexxMath' library routine] expects its argument in radians so 'DEG2RAD' used to perform the conversion */ return Sin(DEG2RAD(ARG(1))) DEG2RAD : procedure expose (globals) return ARG(1) / 180 * PI() RAD2DEG : procedure expose (globals) return ARG(1) / PI() * 180 PI : procedure expose (globals) return 3.14159265358979323846264338327 /* @@PLEAC@@_2.12 */ /* ------------------------------------------------------------------ */ /* See comments in previous section header */ /* ------------------------------------------------------------------ */ /* Using 'rxMath' Library Routines */ /* Load [rxMath] math functions from external library */ call rxFuncAdd 'mathLoadFuncs', 'rxMath', 'mathLoadFuncs' call mathLoadFuncs /* Accepts argumets in either degree, radian, or gradian form */ theta = 1.7 ; tan = rxCalcSin(theta, 'R') / rxCalcCos(theta, 'R') say "tan of theta" theta "[radians]:" tan say "tan of theta" FORMAT(theta,, 3) "[radians]:" FORMAT(tan,, 3) /* ----------- */ say "tan of theta" theta "[radians]:" rxCalcTan(theta, 'R') say "tan of theta" FORMAT(theta,, 3) "[radians]:", /* ----------- */ theta = 0.37 ; say "acos of" theta "[radians]:" rxCalcArcCos(theta, 'R') /* ----------- */ /* Unload math functions */ call mathDropFuncs exit 0 /* ----------------------------- */ /* Using 'rexxMath' Library Routines */ /* Load [rexxMath] math functions from external library */ call rxFuncAdd 'mathLoadFuncs', 'rexxMath', 'mathLoadFuncs' call mathLoadFuncs theta = 1.7 ; tan = Sin(theta) / Cos(theta) say "tan of theta" theta "[radians]:" tan say "tan of theta" FORMAT(theta,, 3) "[radians]:" FORMAT(tan,, 3) /* ----------- */ say "tan of theta" theta "[radians]:" Tan(theta) say "tan of theta" FORMAT(theta,, 3) "[radians]:" FORMAT(Tan(theta),, 3) /* ----------- */ theta = 0.37 ; say "acos of" theta "[radians]:" ACos(theta) /* ----------- */ /* Unload math functions */ call mathDropFuncs exit 0 /* @@PLEAC@@_2.13 */ /* ------------------------------------------------------------------ */ /* See comments in previous section header */ /* ------------------------------------------------------------------ */ /* Using 'rxMath' Library Routines */ /* Load [rxMath] math functions from external library */ call rxFuncAdd 'mathLoadFuncs', 'rxMath', 'mathLoadFuncs' call mathLoadFuncs log_e = rxCalcLog(value) /* ----------- */ log_10 = rxCalcLog10(value) /* ----------- */ answer = rxlog_base(10, 10000) say "log_base(10, 10000) ==>" FORMAT(answer,, 2) say "log10(10000) ==>" FORMAT(rxCalcLog10(10000),, 2) /* ----------- */ /* Unload math functions */ call mathDropFuncs exit 0 /* ----------- */ rxlog_base : procedure expose (globals) base = ARG(1) ; value = ARG(2) return rxCalcLog(value) / rxCalcLog(base) /* ----------------------------- */ /* Using 'rexxMath' Library Routines */ /* Load [rexxMath] math functions from external library */ call rxFuncAdd 'mathLoadFuncs', 'rexxMath', 'mathLoadFuncs' call mathLoadFuncs log_e = Log(value) /* ----------- */ log_10 = Log10(value) /* ----------- */ answer = log_base(10, 10000) say "log_base(10, 10000) ==>" FORMAT(answer,, 2) say "log10(10000) ==>" FORMAT(Log10(10000),, 2) /* ----------- */ /* Unload math functions */ call mathDropFuncs exit 0 /* ----------- */ log_base : procedure expose (globals) base = ARG(1) ; value = ARG(2) return Log(value) / Log(base) /* @@PLEAC@@_2.14 */ /* ------------------------------------------------------------------ */ /* REXX offers no matrix-handling BIF's. Below can be found a custom */ /* implementation that, perhaps unusually, represents matrices as str-*/ /* ings. Notes: */ /* */ /* * Since strings are immutable, matrix manipulations result in new */ /* strings being created; high performance, therefore, should not be*/ /* expected */ /* */ /* * Only a smattering of operations are offered, and some of them use*/ /* rather naive algorithms [e.g. multiplication - Winograd's algori-*/ /* thm could instead be used] */ /* */ /* * There is much code redundancy [e.g. 'madd' and 'msub' are identi-*/ /* save for the arithmetic operation performed]. This could have be-*/ /* en avoided via use of both the VALUE BIF and INTERPRET instructi-*/ /* on [an approach much used in Chapter 4], but it was felt that co-*/ /* de would be more readable, and perhaps more easily adapted if ke-*/ /* pt simple, despite the repetition. */ /* */ /* * Decision to model matrices as strings was based on two factors: */ /* */ /* - Avoiding global array use */ /* - Illustrate how ADT's may be modelled using strings, and showca-*/ /* se the REXX PARSE instruction and string manipulation BIF's */ /* */ /* Performance can be significantly improved without resorting to the */ /* use of global arrays by using an external library like T. J. McPhe-*/ /* e's, 'rxHash', that implements arrays as special strings that may */ /* be freely passed around. Chapter 4 makes extensive use of this very*/ /* versatile library. I hope to provide an expanded version of the */ /* present library using this technique as part of the REXXToolkit [to*/ /* be found in the Appendix] sometime in 2007. */ /* ------------------------------------------------------------------ */ /* Global Constants */ FALSE = 0 ; TRUE = 1 ; NULL = "" ; NEWLINE = "0A"X ; SPACE = ' ' NaN = "NaN" /* Matrix-specific global constants */ MTAG = "<M>" ; MHSEP = "|" ; MRAWSEP = "; " ; MRSEP = ";" MTYPE_REGULAR = "R" ; MTYPE_SINGULAR = "S" ; MTYPE_ZERO = "Z" MTYPE_IDENTITY = "I" ; MTYPE_VECTOR = "V" /* -- */ /* Global Roots and 'expose' list */ globals = "sys. env. args. $. FALSE TRUE NULL NEWLINE SPACE NaN" /* Matrix-specific 'expose' list */ matdefs = "MTAG MHSEP MTYPE_REGULAR MTYPE_SINGULAR" , "MTYPE_ZERO MTYPE_IDENTITY MTYPE_VECTOR" , "MRSEP" , "MRAWSEP" /* ----------------------------- */ x = makeMatrix("3 2 3;5 9 8;") ; y = makeMatrix("4 7;9 3;8 1;") z = mmul(x, y) say "z =" ; call mdump z /* ----------------------------- */ say "z determinant:" mdet(z) say "z inverse =" ; call mdump minverse(z), 8 say "trace: " mtrace(z) say "z transpose =" ; call mdump mtranspose(z) exit 0 /* ----------------------------- */ /* * *** IMPORTANT *** Matrix rows and columns numbered from 1, and *not* 0 like so many zero-index-based languages * Variable size, delimited strings represent the matrix type. Each such string has a header section followed by a data section; typically, the string is split, metadata extracted from the header, and the data section returned for subsequent processing * Easy to view matrix contents: just SAY the string. The 'mdump' routine is available for pretty printing * Simple error-handling approach used: a value of, 'NaN', is returned where any error is detected [applies only to routines that do error checking - 'stupid' usage merely sees the script crash] * Matrix Format [EBNF]: <matrix> ::= <header> <data> <header> ::= <type-tag> <rows> <columns> <matrix-type> <EOH> <data> ::= <row>+ <type-tag> ::= '<M>' <rows> ::= <integer> <colums> ::= <integer> <matrix-type> ::= 'S' | 'R' | 'V' | 'Z' | 'I' <EOH> ::= '|' <row> ::= <decimal>+ <EOR> <EOR> ::= ';' <integer> ::= digit+ <decimal> ::= <integer> | digit+ '.' digit+ <digit> ::= '0' | '1' | '2' | '3' | '4' | '5' | '6' | '7' | '8' | '9' * Matrix Format Examples: - 1-row matrices considered vectors 1x1 -> "<M>1 1 V|7;" 1x3 -> "<M>1 3 V|7 8 9;" - Square Matrices; regular, zero, or identity 2x2 Regular -> "<M>2 2 R|1 2;4 5;" 3x3 Regular -> "<M>3 3 R|1 2 3;4 5 6;7 8 9;" 3x3 Zero -> "<M>3 3 Z|0 0 0;0 0 0;0 0 0;" 3x3 Identity -> "<M>3 3 I|1 0 0;0 1 0;0 0 1;" - Singular Matrices 2x3 -> "<M>2 3 S|1 2 3;4 5 6;" 3x2 -> "<M>3 2 S|1 2;3 4;5 6;" * Matrix string contains both metadata and uses a delimiter to mark out rows. Using only one of these items would have allowed determination of the other [i.e. compute metadata by counting delimiters, or tokenise into rows using metadata], but using both allowed for easy type-checking and simplified tokenisation via the PARSE instruction * Routines classed as follows: - Constructors [makeVector, makeMatrix, makeDiagonal] - Type Checkers [isVector, isMatrix, is1x1, is2x2] - Metadata [mrows, mcols] - Comparators [meql] - Selectors [extractMatrix, mrow, mcol, msubset, mminor] - Matrix Arithmetic [madd, msub, mmul, mdiv] - Matrix OPerations [mtranspose, mcofactor, mdet1x1, mdet2x2, mdet, minv1x1, minverse, mtrace] - Elementary Row / Column Operations [mswapc, mswapr, maddc, maddr, mmulc, mmulr]. These are needed for solving linear equations via Echelon method - Pretty Print [mdump] * Routine documentation has the following structure: Parameter List --- Description --- Routine Example(s) Parameter list conventions include: - x | y | z -> One of x or y or z - [optional arguments ...] - Types: + s, s1, s2 -> string(s) + n, n1, n2 -> numeric + v, v1, v2 -> vector(s) + m, m1, m2 -> matrices */ /* ----------- */ makeVector : procedure expose (globals) (matdefs) /* s | n1 [, n2, ...] --- Returns a vector created by parsing, 's', or assembling, 'n1', 'n2' ... --- v = makeVector("1 2 3;") v = makeVector(1, 2, 3) */ argc = ARG() ; if argc == 0 then ; return NaN if argc == 1 then do v = ARG(1) ; argc = WORDS(v) end ; else do v = NULL ; do i = 1 for argc ; v = v ARG(i) ; end ; v = STRIP(v) end return MTAG || 1 argc MTYPE_VECTOR || MHSEP || v || MRSEP makeMatrix : procedure expose (globals) (matdefs) /* s | v1 [, v2, ...] --- Returns a matrix created by parsing, 's', or assembling, 'v1', 'v2' ... --- m = makeMatrix("1 2 3;4 5 6;7 8 9;") m = makeMatrix(makeVector(1, 2, 3)) m = makeMatrix(makeVector(1, 2, 3), makeVector(4, 5, 6),, makeVector(7, 8, 9)) */ argc = ARG() ; if argc == 0 then ; return NaN if argc == 1 then do m = ARG(1) ; if isVector(m) then ; return m rows = COUNTSTR(MRSEP, m) cols = WORDS(SUBSTR(m, 1, POS(MRSEP, m) - 1)) rv = NULL ; do i = 1 for rows parse var m row (MRSEP) m ; rv = rv || row || MRSEP end end ; else do rows = argc ; rv = NULL ; do i = 1 for rows parse value ARG(i) with (MTAG) . cols . (MHSEP) data rv = rv || data end end select when cols == rows then ; type = MTYPE_REGULAR otherwise ; type = MTYPE_SINGULAR end return MTAG || rows cols type || MHSEP || STRIP(rv) makeDiagonal : procedure expose (globals) (matdefs) /* s | v | n1 [, n2, ...] --- Returns a square matrix with a leading diagonal having the values obtained by parsing, 's', assembling, 'v1', 'v2', or from, 'v' --- m = makeDiagonal("1 2 3;") m = makeDiagonal(1, 2, 3) m = makeDiagonal(makeVector(1, 2, 3)) */ argc = ARG() ; if argc == 0 then ; return NaN ONE_ONLY = TRUE ; chksum = 0 if argc == 1 then do v = ARG(1) ; if isVector(v) then do parse var v (MTAG) . cols . (MHSEP) data end ; else do cols = WORDS(SUBSTR(v, 1, POS(MRSEP, v) - 1)) ; data = v end parse var data row (MRSEP) . rows = cols ; rv = NULL ; do i = 1 for rows do j = 1 for cols if i == j then do parse var row item row chksum = chksum + item ; rv = rv item if item > 1 then ; ONE_ONLY = FALSE end ; else ; rv = rv 0 end rv = rv || MRSEP end end ; else do cols = argc ; rows = cols ; rv = NULL do i = 1 for rows do j = 1 for cols if i == j then do value = ARG(i) ; chksum = chksum + value ; rv = rv value if value > 1 then ; ONE_ONLY = FALSE end ; else ; rv = rv 0 end rv = rv || MRSEP end end select when chksum == 0 then ; type = MTYPE_ZERO when chksum == rows & ONE_ONLY then ; type = MTYPE_IDENTITY otherwise ; type = MTYPE_REGULAR end return MTAG || rows cols type || MHSEP ||, STRIP(CHANGESTR(MRAWSEP, rv, MRSEP)) /* -- */ isMatrix : procedure expose (globals) (matdefs) /*