diff options
Diffstat (limited to 'test/scanners/scheme')
| -rw-r--r-- | test/scanners/scheme/pleac.expected.raydebug | 5141 | ||||
| -rw-r--r-- | test/scanners/scheme/pleac.in.scm | 5141 | ||||
| -rw-r--r-- | test/scanners/scheme/strange.expected.raydebug | 38 | ||||
| -rw-r--r-- | test/scanners/scheme/strange.in.scm | 38 | ||||
| -rw-r--r-- | test/scanners/scheme/suite.rb | 2 |
5 files changed, 0 insertions, 10360 deletions
diff --git a/test/scanners/scheme/pleac.expected.raydebug b/test/scanners/scheme/pleac.expected.raydebug deleted file mode 100644 index 223b65c..0000000 --- a/test/scanners/scheme/pleac.expected.raydebug +++ /dev/null @@ -1,5141 +0,0 @@ -comment(;;; -*- scheme -*-) - -comment(;;; @@PLEAC@@_NAME) -comment(;;; @@SKIP@@ Guile 1.8) - -comment(;;; @@PLEAC@@_WEB) -comment(;;; @@SKIP@@ http://www.gnu.org/software/guile/) - -comment(;;; @@PLEAC@@_INTRO) -comment(;;; @@SKIP@@ Sections 1 - 3, and 7 - 9, largely completed using Guile 1.5; subsequent additions use Guile 1.8.) - -comment(;;; @@PLEAC@@_APPENDIX) -comment(;;; @@SKIP@@ General-purpose, custom functions that might be used in several sections, appear here ) - -comment(;; Helper which aims to reduce code clutter by:) -comment(;; * Replacing the oft-used, '(display item\) (newline\)' combination) -comment(;; * Avoiding overuse of '(string-append\)' for simple output tasks) -operator(()reserved(define) operator(()ident(print) ident(item) operator(.) ident(rest)operator(\)) - operator(()reserved(let) operator(()operator(()ident(all-item) operator(()reserved(cons) ident(item) ident(rest)operator(\))operator(\))operator(\)) - operator(()ident(for-each) - operator(()reserved(lambda) operator(()ident(item)operator(\)) operator(()ident(display) ident(item)operator(\)) operator(()ident(display) string<delimiter(")content( )delimiter(")>operator(\))operator(\)) - ident(all-item)operator(\))operator(\)) - operator(()ident(newline)operator(\))operator(\)) - -comment(;; ------------) - -comment(;; Slightly modified version of '(qx\)' from Chapter 4) -operator(()ident(use-modules) operator(()ident(ice-9) ident(popen)operator(\)) operator(()ident(srfi) ident(srfi-1)operator(\)) operator(()ident(srfi) ident(srfi-13)operator(\))operator(\)) - -operator(()reserved(define) operator(()ident(drain-output) ident(port)operator(\)) - operator(()reserved(let) ident(loop) operator(()operator(()ident(chars) operator(')operator(()operator(\))operator(\)) - operator(()ident(next) operator(()ident(read-char) ident(port)operator(\))operator(\))operator(\)) - operator(()reserved(if) operator(()ident(eof-object?) ident(next)operator(\)) - comment(; Modified to not return last 'line' with newline) - operator(()ident(list->string) operator(()ident(reverse!) operator(()ident(cdr) ident(chars)operator(\))operator(\))operator(\)) - operator(()ident(loop) operator(()reserved(cons) ident(next) ident(chars)operator(\)) - operator(()ident(read-char) ident(port)operator(\))operator(\))operator(\))operator(\))operator(\)) - -operator(()reserved(define) operator(()ident(qx) ident(pipeline)operator(\)) - operator(()reserved(let*) operator(()operator(()ident(pipe) operator(()ident(open-input-pipe) ident(pipeline)operator(\))operator(\)) - operator(()ident(output) operator(()ident(drain-output) ident(pipe)operator(\))operator(\))operator(\)) - operator(()ident(close-pipe) ident(pipe)operator(\)) - ident(output)operator(\))operator(\)) - -comment(;; ------------) - -comment(;; @@PLEAC@@_1.0) -operator(()reserved(define) ident(string) string<delimiter(")content(\\\\)content(n)delimiter(")>operator(\)) comment(; two characters, \\ and an n) -operator(()reserved(define) ident(string) string<delimiter(")content(\\n)delimiter(")>operator(\)) comment(; a "newline" character) -operator(()reserved(define) ident(string) string<delimiter(")content(Jon )content(\\")content(Maddog)content(\\")content( Orwant)delimiter(")>operator(\)) comment(; literal double quotes) -operator(()reserved(define) ident(string) string<delimiter(")content(Jon 'Maddog' Orwant)delimiter(")>operator(\)) comment(; literal single quotes) - -operator(()reserved(define) ident(a) string<delimiter(")content(This is a multiline here document -terminated by a closing double quote)delimiter(")>operator(\)) - -comment(;; @@PLEAC@@_1.1) -comment(;; Use substring) - -operator(()ident(substring) ident(str) ident(start) ident(end)operator(\)) -operator(()ident(substring) ident(str) ident(start)operator(\)) - -comment(;; You can fill portions of a string with another string) - -operator(()ident(substring-move-right!) ident(str) ident(start) ident(end) ident(newstring) ident(newstart)operator(\)) -operator(()ident(substring-move-left!) ident(str) ident(start) ident(end) ident(newstring) ident(newstart)operator(\)) - -comment(;; Guile has a separate character type, and you can treat strings as a) -comment(;; character array.) - -operator(()ident(string-ref) ident(str) ident(pos)operator(\)) -operator(()ident(string-set!) ident(str) ident(pos) ident(char)operator(\)) -operator(()ident(string-fill!) ident(str) ident(char)operator(\)) -operator(()ident(substring-fill!) ident(str) ident(start) ident(end) ident(char)operator(\)) - -operator(()reserved(define) ident(s) string<delimiter(")content(This is what you have)delimiter(")>operator(\)) -operator(()reserved(define) ident(first) operator(()ident(substring) ident(s) integer(0) integer(1)operator(\))operator(\)) comment(; "T") -operator(()reserved(define) ident(start) operator(()ident(substring) ident(s) integer(5) integer(7)operator(\))operator(\)) comment(; "is") -operator(()reserved(define) ident(rest) operator(()ident(substring) ident(s) integer(13)operator(\))operator(\)) comment(; "you have") -operator(()reserved(define) ident(last) operator(()ident(substring) ident(s) operator(()integer(1)ident(-) operator(()ident(string-length) ident(s)operator(\))operator(\))operator(\))operator(\)) comment(; "e") -operator(()reserved(define) ident(end) operator(()ident(substring) ident(s) operator(()ident(-) operator(()ident(string-length) ident(s)operator(\)) integer(4)operator(\))operator(\))operator(\)) comment(; "have") -operator(()reserved(define) ident(piece) operator(()reserved(let) operator(()operator(()ident(len) operator(()ident(string-length) ident(s)operator(\))operator(\))operator(\)) - operator(()ident(substring) ident(s) operator(()ident(-) ident(len) integer(8)operator(\)) operator(()ident(-) ident(len) integer(5)operator(\))operator(\))operator(\))operator(\)) comment(; "you") - - -comment(;;; Or use the string library SRFI-13) -operator(()ident(use-modules) operator(()ident(srfi) ident(srfi-13)operator(\))operator(\)) - -operator(()reserved(define) ident(s) string<delimiter(")content(This is what you have)delimiter(")>operator(\)) -operator(()reserved(define) ident(first) operator(()ident(string-take) ident(s) integer(1)operator(\))operator(\)) comment(; "T") -operator(()reserved(define) ident(start) operator(()ident(xsubstring) ident(s) integer(5) integer(7)operator(\))operator(\)) comment(; "is") -operator(()reserved(define) ident(rest) operator(()ident(xsubstring) ident(s) integer(13) ident(-)integer(1)operator(\))operator(\)) comment(; "you have") -operator(()reserved(define) ident(last) operator(()ident(string-take-right) ident(s) integer(1)operator(\))operator(\)) comment(; "e") -operator(()reserved(define) ident(end) operator(()ident(string-take-right) ident(s) integer(4)operator(\))operator(\)) comment(; "have") -operator(()reserved(define) ident(piece) operator(()ident(xsubstring) ident(s) ident(-)integer(8) ident(-)integer(5)operator(\))operator(\)) comment(; "you") - -comment(;; Mutation of different sized strings is not allowed. You have to) -comment(;; use set! to change the variable.) - -operator(()reserved(set!) ident(s) operator(()ident(string-replace) ident(s) string<delimiter(")content(wasn't)delimiter(")> integer(5) integer(7)operator(\))operator(\)) -comment(;; This wasn't what you have) -operator(()reserved(set!) ident(s) operator(()ident(string-replace) ident(s) string<delimiter(")content(ondrous)delimiter(")> integer(13) integer(25)operator(\))operator(\)) -comment(;; This wasn't wondrous) -operator(()reserved(set!) ident(s) operator(()ident(string-take-right) ident(s) operator(()integer(1)ident(-) operator(()ident(string-length) ident(s)operator(\))operator(\))operator(\))operator(\)) -comment(;; his wasn't wondrous) -operator(()reserved(set!) ident(s) operator(()ident(string-take) ident(s) integer(9)operator(\))operator(\)) - -comment(;; @@PLEAC@@_1.2) -operator(()reserved(define) ident(a) operator(()reserved(or) ident(b) ident(c)operator(\))operator(\)) -operator(()reserved(define) ident(a) operator(()reserved(if) operator(()ident(defined?) ident(b)operator(\)) ident(b) ident(c)operator(\))operator(\)) -operator(()reserved(define) ident(a) operator(()reserved(or) operator(()reserved(and) operator(()ident(defined?) ident(b)operator(\)) ident(b)operator(\)) ident(c)operator(\))operator(\)) - -comment(;; @@PLEAC@@_1.3) -comment(;; This doesn't really make sense in Scheme... temporary variables are) -comment(;; a natural construct and cheap. If you want to swap variables in a) -comment(;; block without introducing any new variable names, you can use let:) - -operator(()reserved(let) operator(()operator(()ident(a) ident(b)operator(\)) operator(()ident(b) ident(a)operator(\))operator(\)) - comment(;; ...) - operator(\)) - -operator(()reserved(let) operator(()operator(()ident(alpha) ident(beta)operator(\)) operator(()ident(beta) ident(production)operator(\)) operator(()ident(production) ident(alpha)operator(\))operator(\)) - comment(;; ...) - operator(\)) - -comment(;; @@PLEAC@@_1.4) -operator(()reserved(define) ident(num) operator(()ident(char->integer) ident(char)operator(\))operator(\)) -operator(()reserved(define) ident(char) operator(()ident(integer->char) ident(num)operator(\))operator(\)) - -operator(()ident(use-modules) operator(()ident(srfi) ident(srfi-13)operator(\))operator(\)) -operator(()reserved(let) operator(()operator(()ident(str) string<delimiter(")content(sample)delimiter(")>operator(\))operator(\)) - operator(()ident(display) operator(()ident(string-join) - operator(()ident(map) ident(number->string) - operator(()ident(map) ident(char->integer) operator(()ident(string->list) ident(str)operator(\))operator(\))operator(\)) string<delimiter(")content( )delimiter(")>operator(\))operator(\)) - operator(()ident(newline)operator(\))operator(\)) - -operator(()reserved(let) operator(()operator(()ident(lst) operator(')operator(()integer(115) integer(97) integer(109) integer(112) integer(108) integer(101)operator(\))operator(\))operator(\)) - operator(()ident(display) operator(()ident(list->string) operator(()ident(map) ident(integer->char) ident(lst)operator(\))operator(\))operator(\)) - operator(()ident(newline)operator(\))operator(\)) - -operator(()reserved(letrec) operator(()operator(()ident(next) operator(()reserved(lambda) operator(()ident(c)operator(\)) operator(()ident(integer->char) operator(()integer(1)ident(+) operator(()ident(char->integer) ident(c)operator(\))operator(\))operator(\))operator(\))operator(\))operator(\)) - operator(()reserved(let*) operator(()operator(()ident(hal) string<delimiter(")content(HAL)delimiter(")>operator(\)) - operator(()ident(ibm) operator(()ident(list->string) operator(()ident(map) ident(next) operator(()ident(string->list) ident(hal)operator(\))operator(\))operator(\))operator(\))operator(\)) - operator(()ident(display) ident(ibm)operator(\)) - operator(()ident(newline)operator(\))operator(\))operator(\)) - -comment(;; @@PLEAC@@_1.5) -comment(;; Convert the string to a list of characters) -operator(()ident(map) ident(proc) - operator(()ident(string->list) ident(str)operator(\))operator(\)) - -operator(()ident(use-modules) operator(()ident(srfi) ident(srfi-1)operator(\))operator(\)) -operator(()ident(format) pre_constant(#t) string<delimiter(")content(unique chars are: ~A)content(\\n)delimiter(")> - operator(()ident(apply) ident(string) operator(()ident(sort) operator(()ident(delete-duplicates) - operator(()ident(string->list) string<delimiter(")content(an apple a day)delimiter(")>operator(\))operator(\)) ident(char<?)operator(\))operator(\))operator(\)) - -operator(()reserved(let*) operator(()operator(()ident(str) string<delimiter(")content(an apple a day)delimiter(")>operator(\)) - operator(()ident(sum) operator(()ident(apply) ident(+) operator(()ident(map) ident(char->integer) operator(()ident(string->list) ident(str)operator(\))operator(\))operator(\))operator(\))operator(\)) - operator(()ident(format) pre_constant(#t) string<delimiter(")content(sum is ~A)content(\\n)delimiter(")> ident(sum)operator(\))operator(\)) - -comment(;;; or use string-fold/string-map/string-for-each from SRFI-13) -operator(()ident(use-modules) operator(()ident(srfi) ident(srfi-13)operator(\))operator(\)) - -operator(()reserved(let*) operator(()operator(()ident(str) string<delimiter(")content(an apple a day)delimiter(")>operator(\)) - operator(()ident(sum) operator(()ident(string-fold) operator(()reserved(lambda) operator(()ident(c) ident(acc)operator(\)) operator(()ident(+) ident(acc) operator(()ident(char->integer) ident(c)operator(\))operator(\))operator(\)) - integer(0) ident(str)operator(\))operator(\))operator(\)) - operator(()ident(format) pre_constant(#t) string<delimiter(")content(sum is ~A)content(\\n)delimiter(")> ident(sum)operator(\))operator(\)) - -error(#)ident(!/usr/local/bin/guile) ident(-)ident(s) -ident(!)error(#) -comment(;; sum - compute 16-bit checksum of all input files) -operator(()ident(use-modules) operator(()ident(srfi) ident(srfi-13)operator(\))operator(\)) -operator(()reserved(define) operator(()ident(checksum) ident(p)operator(\)) - operator(()reserved(let) ident(loop) operator(()operator(()ident(line) operator(()ident(read-line) ident(p) operator(')ident(concat)operator(\))operator(\)) operator(()ident(sum) integer(0)operator(\))operator(\)) - operator(()reserved(if) operator(()ident(eof-object?) ident(line)operator(\)) - operator(()ident(format) pre_constant(#t) string<delimiter(")content(~A ~A)content(\\n)delimiter(")> ident(sum) operator(()ident(port-filename) ident(p)operator(\))operator(\)) - operator(()reserved(let) operator(()operator(()ident(line-sum) operator(()ident(string-fold) operator(()reserved(lambda) operator(()ident(c) ident(acc)operator(\)) - operator(()ident(+) ident(acc) operator(()ident(char->integer) ident(c)operator(\))operator(\))operator(\)) - integer(0) ident(line)operator(\))operator(\))operator(\)) - operator(()ident(loop) operator(()ident(read-line) ident(p) operator(')ident(concat)operator(\)) operator(()ident(modulo) operator(()ident(+) ident(sum) ident(line-sum)operator(\)) - operator(()integer(1)ident(-) operator(()ident(expt) integer(2) integer(16)operator(\))operator(\))operator(\))operator(\))operator(\))operator(\))operator(\))operator(\)) -operator(()reserved(let) operator(()operator(()ident(args) operator(()ident(cdr) operator(()ident(command-line)operator(\))operator(\))operator(\))operator(\)) - operator(()reserved(if) operator(()ident(null?) ident(args)operator(\)) - operator(()ident(checksum) operator(()ident(current-input-port)operator(\))operator(\)) - operator(()ident(for-each) operator(()reserved(lambda) operator(()ident(f)operator(\)) operator(()ident(call-with-input-file) ident(f) ident(checksum)operator(\))operator(\)) ident(args)operator(\))operator(\))operator(\)) - -error(#)ident(!/usr/local/bin/guile) ident(-)ident(s) -ident(!)error(#) -comment(;; slowcat - emulate a s l o w line printer) -operator(()ident(use-modules) operator(()ident(ice-9) ident(regex)operator(\)) operator(()ident(srfi) ident(srfi-2)operator(\)) operator(()ident(srfi) ident(srfi-13)operator(\))operator(\)) -operator(()reserved(define) ident(args) operator(()ident(cdr) operator(()ident(command-line)operator(\))operator(\))operator(\)) -operator(()reserved(define) reserved(delay) integer(1)operator(\)) -operator(()ident(and-let*) operator(()operator(()ident(p) operator(()ident(pair?) ident(args)operator(\))operator(\)) - operator(()ident(m) operator(()ident(string-match) string<delimiter(")content(^-([0-9]+\)$)delimiter(")> operator(()ident(car) ident(args)operator(\))operator(\))operator(\))operator(\)) - operator(()reserved(set!) reserved(delay) operator(()ident(string->number) operator(()ident(match:substring) ident(m) integer(1)operator(\))operator(\))operator(\)) - operator(()reserved(set!) ident(args) operator(()ident(cdr) ident(args)operator(\))operator(\))operator(\)) -operator(()reserved(define) operator(()ident(slowcat) ident(p)operator(\)) - operator(()reserved(let) ident(loop) operator(()operator(()ident(line) operator(()ident(read-line) ident(p) operator(')ident(concat)operator(\))operator(\))operator(\)) - operator(()reserved(cond) operator(()operator(()ident(not) operator(()ident(eof-object?) ident(line)operator(\))operator(\)) - operator(()ident(string-for-each) - operator(()reserved(lambda) operator(()ident(c)operator(\)) operator(()ident(display) ident(c)operator(\)) operator(()ident(usleep) operator(()ident(*) integer(5) reserved(delay)operator(\))operator(\))operator(\)) ident(line)operator(\)) - operator(()ident(loop) operator(()ident(read-line) ident(p) operator(')ident(concat)operator(\))operator(\))operator(\))operator(\))operator(\))operator(\)) -operator(()reserved(if) operator(()ident(null?) ident(args)operator(\)) - operator(()ident(slowcat) operator(()ident(current-input-port)operator(\))operator(\)) - operator(()ident(for-each) operator(()reserved(lambda) operator(()ident(f)operator(\)) operator(()ident(call-with-input-file) ident(f) ident(slowcat)operator(\))operator(\)) ident(args)operator(\))operator(\)) - -comment(;; @@PLEAC@@_1.6) -operator(()reserved(define) ident(revbytes) operator(()ident(list->string) operator(()ident(reverse) operator(()ident(string->list) ident(str)operator(\))operator(\))operator(\))operator(\)) - -comment(;;; Or from SRFI-13) -operator(()ident(use-modules) operator(()ident(srfi) ident(srfi-13)operator(\))operator(\)) -operator(()reserved(define) ident(revbytes) operator(()ident(string-reverse) ident(str)operator(\))operator(\)) -operator(()ident(string-reverse!) ident(str)operator(\)) comment(; modifies in place) - -operator(()reserved(define) ident(revwords) operator(()ident(string-join) operator(()ident(reverse) operator(()ident(string-tokenize) ident(str)operator(\))operator(\)) string<delimiter(")content( )delimiter(")>operator(\))operator(\)) - -operator(()ident(with-input-from-file) string<delimiter(")content(/usr/share/dict/words)delimiter(")> - operator(()reserved(lambda) operator(()operator(\)) - operator(()reserved(do) operator(()operator(()ident(word) operator(()ident(read-line)operator(\)) operator(()ident(read-line)operator(\))operator(\))operator(\)) - operator(()operator(()ident(eof-object?) ident(word)operator(\))operator(\)) - operator(()reserved(if) operator(()reserved(and) operator(()ident(>) operator(()ident(string-length) ident(word)operator(\)) integer(5)operator(\)) - operator(()ident(string=?) ident(word) operator(()ident(string-reverse) ident(word)operator(\))operator(\))operator(\)) - operator(()ident(write-line) ident(word)operator(\))operator(\))operator(\))operator(\))operator(\)) - -comment(;; A little too verbose on the command line) -comment(;; guile --use-srfi=13 -c '(with-input-from-file "/usr/share/dict/words" (lambda (\) (do ((word (read-line\) (read-line\)\)\) ((eof-object? word\)\) (if (and (> (string-length word\) 5\) (string=? word (string-reverse word\)\)\) (write-line word\)\)\)\)\)') - -comment(;; @@PLEAC@@_1.7) -comment(;; Use regexp-substitute/global) -operator(()ident(regexp-substitute/global) - pre_constant(#f) string<delimiter(")content(([^)content(\\t)content(]*\)()content(\\t)content(+\))delimiter(")> ident(str) - operator(()reserved(lambda) operator(()ident(m)operator(\)) - operator(()reserved(let*) operator(()operator(()ident(pre-string) operator(()ident(match:substring) ident(m) integer(1)operator(\))operator(\)) - operator(()ident(pre-len) operator(()ident(string-length) ident(pre-string)operator(\))operator(\)) - operator(()ident(match-len) operator(()ident(-) operator(()ident(match:end) ident(m) integer(2)operator(\)) operator(()ident(match:start) ident(m) integer(2)operator(\))operator(\))operator(\))operator(\)) - operator(()ident(string-append) - ident(pre-string) - operator(()ident(make-string) - operator(()ident(-) operator(()ident(*) ident(match-len) integer(8)operator(\)) - operator(()ident(modulo) ident(pre-len) integer(8)operator(\))operator(\)) - char(#\\space)operator(\))operator(\))operator(\))operator(\)) - operator(')ident(post)operator(\)) - -comment(;; @@PLEAC@@_1.8) -comment(;; just interpolate $abc in strings:) -operator(()reserved(define) operator(()ident(varsubst) ident(str)operator(\)) - operator(()ident(regexp-substitute/global) pre_constant(#f) string<delimiter(")content(\\\\)content($()content(\\\\)content(w+\))delimiter(")> ident(str) - operator(')ident(pre) operator(()reserved(lambda) operator(()ident(m)operator(\)) operator(()ident(eval) operator(()ident(string->symbol) operator(()ident(match:substring) ident(m) integer(1)operator(\))operator(\)) - operator(()ident(current-module)operator(\))operator(\))operator(\)) - operator(')ident(post)operator(\))operator(\)) - -comment(;; interpolate $abc with error messages:) -operator(()reserved(define) operator(()ident(safe-varsubst) ident(str)operator(\)) - operator(()ident(regexp-substitute/global) pre_constant(#f) string<delimiter(")content(\\\\)content($()content(\\\\)content(w+\))delimiter(")> ident(str) - operator(')ident(pre) operator(()reserved(lambda) operator(()ident(m)operator(\)) - operator(()ident(catch) pre_constant(#t) - operator(()reserved(lambda) operator(()operator(\)) operator(()ident(eval) operator(()ident(string->symbol) operator(()ident(match:substring) ident(m) integer(1)operator(\))operator(\)) - operator(()ident(current-module)operator(\))operator(\))operator(\)) - operator(()reserved(lambda) ident(args) - operator(()ident(format) pre_constant(#f) string<delimiter(")content([NO VARIABLE: ~A])delimiter(")> operator(()ident(match:substring) ident(m) integer(1)operator(\))operator(\))operator(\))operator(\))operator(\)) - operator(')ident(post)operator(\))operator(\)) - -comment(;; interpolate ${(any (scheme expression\)\)} in strings:) -operator(()reserved(define) operator(()ident(interpolate) ident(str)operator(\)) - operator(()ident(regexp-substitute/global) pre_constant(#f) string<delimiter(")content(\\\\)content(${([^{}]+\)})delimiter(")> ident(str) - operator(')ident(pre) operator(()reserved(lambda) operator(()ident(m)operator(\)) operator(()ident(eval-string) operator(()ident(match:substring) ident(m) integer(1)operator(\))operator(\))operator(\)) operator(')ident(post)operator(\))operator(\)) - -comment(;; @@PLEAC@@_1.9) -operator(()ident(use-modules) operator(()ident(srfi) ident(srfi-13)operator(\))operator(\)) - -operator(()ident(string-upcase) string<delimiter(")content(bo beep)delimiter(")>operator(\)) comment(; BO PEEP) -operator(()ident(string-downcase) string<delimiter(")content(JOHN)delimiter(")>operator(\)) comment(; john) -operator(()ident(string-titlecase) string<delimiter(")content(bo)delimiter(")>operator(\)) comment(; Bo) -operator(()ident(string-titlecase) string<delimiter(")content(JOHN)delimiter(")>operator(\)) comment(; John) - -operator(()ident(string-titlecase) string<delimiter(")content(thIS is a loNG liNE)delimiter(")>operator(\)) comment(; This Is A Long Line) - -error(#)ident(!/usr/local/bin/guile) ident(-)ident(s) -ident(!)error(#) -comment(;; randcap: filter to randomly capitalize 20% of the time) -operator(()ident(use-modules) operator(()ident(srfi) ident(srfi-13)operator(\))operator(\)) -operator(()ident(seed->random-state) operator(()ident(current-time)operator(\))operator(\)) -operator(()reserved(define) operator(()ident(randcap) ident(p)operator(\)) - operator(()reserved(let) ident(loop) operator(()operator(()ident(line) operator(()ident(read-line) ident(p) operator(')ident(concat)operator(\))operator(\))operator(\)) - operator(()reserved(cond) operator(()operator(()ident(not) operator(()ident(eof-object?) ident(line)operator(\))operator(\)) - operator(()ident(display) operator(()ident(string-map) operator(()reserved(lambda) operator(()ident(c)operator(\)) - operator(()reserved(if) operator(()ident(=) operator(()ident(random) integer(5)operator(\)) integer(0)operator(\)) - operator(()ident(char-upcase) ident(c)operator(\)) - operator(()ident(char-downcase) ident(c)operator(\))operator(\))operator(\)) - ident(line)operator(\))operator(\)) - operator(()ident(loop) operator(()ident(read-line) ident(p) operator(')ident(concat)operator(\))operator(\))operator(\))operator(\))operator(\))operator(\)) -operator(()reserved(let) operator(()operator(()ident(args) operator(()ident(cdr) operator(()ident(command-line)operator(\))operator(\))operator(\))operator(\)) - operator(()reserved(if) operator(()ident(null?) ident(args)operator(\)) - operator(()ident(randcap) operator(()ident(current-input-port)operator(\))operator(\)) - operator(()ident(for-each) operator(()reserved(lambda) operator(()ident(f)operator(\)) operator(()ident(call-with-input-file) ident(f) ident(randcap)operator(\))operator(\)) ident(args)operator(\))operator(\))operator(\)) - -comment(;; @@PLEAC@@_1.10) -comment(;; You can do this with format. Lisp/Scheme format is a little) -comment(;; different from what you may be used to with C/Perl style printf) -comment(;; (actually far more powerful\) , but if you keep in mind that we use) -comment(;; ~ instead of %, and , instead of . for the prefix characters, you) -comment(;; won't have trouble getting used to Guile's format.) - -operator(()ident(format) pre_constant(#f) string<delimiter(")content(I have ~A guanacos.)delimiter(")> ident(n)operator(\)) - -comment(;; @@PLEAC@@_1.11) -operator(()reserved(define) ident(var) string<delimiter(")content( - your text - goes here)delimiter(")>operator(\)) - -operator(()ident(use-modules) operator(()ident(ice-9) ident(regexp)operator(\))operator(\)) -operator(()reserved(set!) ident(var) operator(()ident(regexp-substitute/global) pre_constant(#f) string<delimiter(")content(\\n)content( +)delimiter(")> ident(var) operator(')ident(pre) string<delimiter(")content(\\n)delimiter(")> operator(')ident(post)operator(\))operator(\)) - -operator(()ident(use-modules) operator(()ident(srfi) ident(srfi-13)operator(\))operator(\)) -operator(()reserved(set!) ident(var) operator(()ident(string-join) operator(()ident(map) ident(string-trim) operator(()ident(string-tokenize) ident(var) char(#\\newline)operator(\))operator(\)) string<delimiter(")content(\\n)delimiter(")>operator(\))operator(\)) - -operator(()ident(use-modules) operator(()ident(ice-9) ident(regexp)operator(\)) operator(()ident(srfi) ident(srfi-13)operator(\)) operator(()ident(srfi) ident(srfi-14)operator(\))operator(\)) -operator(()reserved(define) operator(()ident(dequote) ident(str)operator(\)) - operator(()reserved(let*) operator(()operator(()ident(str) operator(()reserved(if) operator(()ident(char=?) operator(()ident(string-ref) ident(str) integer(0)operator(\)) char(#\\newline)operator(\)) - operator(()ident(substring) ident(str) integer(1)operator(\)) ident(str)operator(\))operator(\)) - operator(()ident(lines) operator(()ident(string-tokenize) ident(str) char(#\\newline)operator(\))operator(\)) - operator(()ident(rx) operator(()reserved(let) ident(loop) operator(()operator(()ident(leader) operator(()ident(car) ident(lines)operator(\))operator(\)) operator(()ident(lst) operator(()ident(cdr) ident(lines)operator(\))operator(\))operator(\)) - operator(()reserved(cond) operator(()operator(()ident(string=) ident(leader) string<delimiter(")delimiter(")>operator(\)) - operator(()reserved(let) operator(()operator(()ident(pos) operator(()reserved(or) operator(()ident(string-skip) operator(()ident(car) ident(lines)operator(\)) - ident(char-set:whitespace)operator(\)) integer(0)operator(\))operator(\))operator(\)) - operator(()ident(make-regexp) operator(()ident(format) pre_constant(#f) string<delimiter(")content(^[ )content(\\\\)content(t]{1,~A})delimiter(")> ident(pos)operator(\)) - ident(regexp/newline)operator(\))operator(\))operator(\)) - operator(()operator(()ident(null?) ident(lst)operator(\)) - operator(()ident(make-regexp) operator(()ident(string-append) string<delimiter(")content(^[ )content(\\\\)content(t]*)delimiter(")> - operator(()ident(regexp-quote) ident(leader)operator(\))operator(\)) - ident(regexp/newline)operator(\))operator(\)) - operator(()ident(else) - operator(()reserved(let) operator(()operator(()ident(pos) operator(()reserved(or) operator(()ident(string-prefix-length) ident(leader) operator(()ident(car) ident(lst)operator(\))operator(\)) integer(0)operator(\))operator(\))operator(\)) - operator(()ident(loop) operator(()ident(substring) ident(leader) integer(0) ident(pos)operator(\)) operator(()ident(cdr) ident(lst)operator(\))operator(\))operator(\))operator(\))operator(\))operator(\))operator(\))operator(\)) - operator(()ident(regexp-substitute/global) pre_constant(#f) ident(rx) ident(str) operator(')ident(pre) operator(')ident(post)operator(\))operator(\))operator(\)) - -comment(;; @@PLEAC@@_1.12) -operator(()ident(use-modules) operator(()ident(srfi) ident(srfi-13)operator(\))operator(\)) - -operator(()reserved(define) ident(text) string<delimiter(")content(Folding and splicing is the work of an editor, -not a mere collection of silicon -and -mobile electrons!)delimiter(")>operator(\)) - -operator(()reserved(define) operator(()ident(wrap) ident(str) ident(max-col)operator(\)) - operator(()reserved(let*) operator(()operator(()ident(words) operator(()ident(string-tokenize) ident(str)operator(\))operator(\)) - operator(()ident(all) operator(')operator(()operator(\))operator(\)) - operator(()ident(first) operator(()ident(car) ident(words)operator(\))operator(\)) - operator(()ident(col) operator(()ident(string-length) ident(first)operator(\))operator(\)) - operator(()ident(line) operator(()ident(list) ident(first)operator(\))operator(\))operator(\)) - operator(()ident(for-each) - operator(()reserved(lambda) operator(()ident(x)operator(\)) - operator(()reserved(let*) operator(()operator(()ident(len) operator(()ident(string-length) ident(x)operator(\))operator(\)) - operator(()ident(new-col) operator(()ident(+) ident(col) ident(len) integer(1)operator(\))operator(\))operator(\)) - operator(()reserved(cond) operator(()operator(()ident(>) ident(new-col) ident(max-col)operator(\)) - operator(()reserved(set!) ident(all) operator(()reserved(cons) operator(()ident(string-join) operator(()ident(reverse!) ident(line)operator(\)) string<delimiter(")content( )delimiter(")>operator(\)) ident(all)operator(\))operator(\)) - operator(()reserved(set!) ident(line) operator(()ident(list) ident(x)operator(\))operator(\)) - operator(()reserved(set!) ident(col) ident(len)operator(\))operator(\)) - operator(()ident(else) - operator(()reserved(set!) ident(line) operator(()reserved(cons) ident(x) ident(line)operator(\))operator(\)) - operator(()reserved(set!) ident(col) ident(new-col)operator(\))operator(\))operator(\))operator(\))operator(\)) - operator(()ident(cdr) ident(words)operator(\))operator(\)) - operator(()reserved(set!) ident(all) operator(()reserved(cons) operator(()ident(string-join) operator(()ident(reverse!) ident(line)operator(\)) string<delimiter(")content( )delimiter(")>operator(\)) ident(all)operator(\))operator(\)) - operator(()ident(string-join) operator(()ident(reverse!) ident(all)operator(\)) string<delimiter(")content(\\n)delimiter(")>operator(\))operator(\))operator(\)) - -operator(()ident(display) operator(()ident(wrap) ident(text) integer(20)operator(\))operator(\)) - -comment(;; @@PLEAC@@_1.13) -operator(()reserved(define) ident(str) string<delimiter(")content(Mom said, )content(\\")content(Don't do that.)content(\\")delimiter(")>operator(\)) -operator(()reserved(set!) ident(str) operator(()ident(regexp-substitute/global) pre_constant(#f) string<delimiter(")content([')content(\\")content(])delimiter(")> ident(str) operator(')ident(pre) string<delimiter(")content(\\\\)delimiter(")> - ident(match:substring) operator(')ident(post)operator(\))operator(\)) -operator(()reserved(set!) ident(str) operator(()ident(regexp-substitute/global) pre_constant(#f) string<delimiter(")content([^A-Z])delimiter(")> ident(str) operator(')ident(pre) string<delimiter(")content(\\\\)delimiter(")> - ident(match:substring) operator(')ident(post)operator(\))operator(\)) -operator(()reserved(set!) ident(str) operator(()ident(string-append) string<delimiter(")content(this )delimiter(")> operator(()ident(regexp-substitute/global) - pre_constant(#f) string<delimiter(")content(\\W)delimiter(")> string<delimiter(")content(is a test!)delimiter(")> operator(')ident(pre) string<delimiter(")content(\\\\)delimiter(")> - ident(match:substring) operator(')ident(post)operator(\))operator(\))operator(\)) - -comment(;; @@PLEAC@@_1.14) -operator(()ident(use-modules) operator(()ident(srfi) ident(srfi-13)operator(\))operator(\)) - -operator(()reserved(define) ident(str) string<delimiter(")content( space )delimiter(")>operator(\)) -operator(()ident(string-trim) ident(str)operator(\)) comment(; "space ") -operator(()ident(string-trim-right) ident(str)operator(\)) comment(; " space") -operator(()ident(string-trim-both) ident(str)operator(\)) comment(; "space") - -comment(;; @@PLEAC@@_1.15) -operator(()ident(use-modules) operator(()ident(srfi) ident(srfi-2)operator(\)) operator(()ident(srfi) ident(srfi-13)operator(\)) operator(()ident(ice-9) ident(format)operator(\))operator(\)) - -operator(()reserved(define) ident(parse-csv) - operator(()reserved(let*) operator(()operator(()ident(csv-match) operator(()ident(string-join) operator(')operator(()string<delimiter(")content(\\")content(([^)content(\\")content(\\\\)content(\\\\)content(]*()content(\\\\)content(\\\\)content(.[^)content(\\")content(\\\\)content(\\\\)content(]*\)*\))content(\\")content(,?)delimiter(")> - string<delimiter(")content(([^,]+\),?)delimiter(")> - string<delimiter(")content(,)delimiter(")>operator(\)) - string<delimiter(")content(|)delimiter(")>operator(\))operator(\)) - operator(()ident(csv-rx) operator(()ident(make-regexp) ident(csv-match)operator(\))operator(\))operator(\)) - operator(()reserved(lambda) operator(()ident(text)operator(\)) - operator(()reserved(let) operator(()operator(()ident(start) integer(0)operator(\)) - operator(()ident(result) operator(')operator(()operator(\))operator(\))operator(\)) - operator(()reserved(let) ident(loop) operator(()operator(()ident(start) integer(0)operator(\))operator(\)) - operator(()ident(and-let*) operator(()operator(()ident(m) operator(()ident(regexp-exec) ident(csv-rx) ident(text) ident(start)operator(\))operator(\))operator(\)) - operator(()reserved(set!) ident(result) operator(()reserved(cons) operator(()reserved(or) operator(()ident(match:substring) ident(m) integer(1)operator(\)) - operator(()ident(match:substring) ident(m) integer(3)operator(\))operator(\)) - ident(result)operator(\))operator(\)) - operator(()ident(loop) operator(()ident(match:end) ident(m)operator(\))operator(\))operator(\))operator(\)) - operator(()ident(reverse) ident(result)operator(\))operator(\))operator(\))operator(\))operator(\)) - -operator(()reserved(define) ident(line) string<delimiter(")content(XYZZY,)content(\\")content(\\")content(,)content(\\")content(O'Reilly, Inc)content(\\")content(,)content(\\")content(Wall, Larry)content(\\")content(,)content(\\")content(a )content(\\\\)content(\\")content(glug)content(\\\\)content(\\")content( bit,)content(\\")content(,5,)content(\\")content(Error, Core Dumped)content(\\")delimiter(")>operator(\)) - -operator(()reserved(do) operator(()operator(()ident(i) integer(0) operator(()integer(1)ident(+) ident(i)operator(\))operator(\)) - operator(()ident(fields) operator(()ident(parse-csv) ident(line)operator(\)) operator(()ident(cdr) ident(fields)operator(\))operator(\))operator(\)) - operator(()operator(()ident(null?) ident(fields)operator(\))operator(\)) - operator(()ident(format) pre_constant(#t) string<delimiter(")content(~D : ~A)content(\\n)delimiter(")> ident(i) operator(()ident(car) ident(fields)operator(\))operator(\))operator(\)) - -comment(;; @@PLEAC@@_1.16) -operator(()ident(use-modules) operator(()ident(srfi) ident(srfi-13)operator(\)) operator(()ident(srfi) ident(srfi-14)operator(\))operator(\)) - -comment(;; Knuth's soundex algorithm from The Art of Computer Programming, Vol 3) -operator(()reserved(define) ident(soundex) - operator(()reserved(letrec) operator(()operator(()ident(chars) string<delimiter(")content(AEIOUYBFPVCGJKQSXZDTLMNR)delimiter(")>operator(\)) - operator(()ident(nums) string<delimiter(")content(000000111122222222334556)delimiter(")>operator(\)) - operator(()ident(skipchars) operator(()ident(string->char-set) string<delimiter(")content(HW)delimiter(")>operator(\))operator(\)) - operator(()ident(trans) operator(()reserved(lambda) operator(()ident(c)operator(\)) - operator(()reserved(let) operator(()operator(()ident(i) operator(()ident(string-index) ident(chars) ident(c)operator(\))operator(\))operator(\)) - operator(()reserved(if) ident(i) operator(()ident(string-ref) ident(nums) ident(i)operator(\)) ident(c)operator(\))operator(\))operator(\))operator(\))operator(\)) - operator(()reserved(lambda) operator(()ident(str)operator(\)) - operator(()reserved(let*) operator(()operator(()ident(ustr) operator(()ident(string-upcase) ident(str)operator(\))operator(\)) - operator(()ident(f) operator(()ident(string-ref) ident(ustr) integer(0)operator(\))operator(\)) - operator(()ident(skip) operator(()ident(trans) ident(f)operator(\))operator(\))operator(\)) - operator(()reserved(let*) operator(()operator(()ident(mstr) operator(()ident(string-map) ident(trans) operator(()ident(string-delete) ident(ustr) ident(skipchars) integer(1)operator(\))operator(\))operator(\)) - operator(()ident(dstr) operator(()ident(string-map) operator(()reserved(lambda) operator(()ident(c)operator(\)) - operator(()reserved(cond) operator(()operator(()ident(eq?) ident(c) ident(skip)operator(\)) char(#\\0)operator(\)) - operator(()ident(else) operator(()reserved(set!) ident(skip) ident(c)operator(\)) ident(c)operator(\))operator(\))operator(\)) - ident(mstr)operator(\))operator(\)) - operator(()ident(zstr) operator(()ident(string-delete) ident(dstr) char(#\\0)operator(\))operator(\))operator(\)) - operator(()ident(substring) operator(()ident(string-append) operator(()ident(make-string) integer(1) ident(f)operator(\)) ident(zstr) string<delimiter(")content(000)delimiter(")>operator(\)) integer(0) integer(4)operator(\))operator(\))operator(\))operator(\))operator(\))operator(\)) - -operator(()ident(soundex) string<delimiter(")content(Knuth)delimiter(")>operator(\)) comment(; K530) -operator(()ident(soundex) string<delimiter(")content(Kant)delimiter(")>operator(\)) comment(; K530) -operator(()ident(soundex) string<delimiter(")content(Lloyd)delimiter(")>operator(\)) comment(; L300) -operator(()ident(soundex) string<delimiter(")content(Ladd)delimiter(")>operator(\)) comment(; L300) - -comment(;; @@PLEAC@@_1.17) -error(#)ident(!/usr/local/bin/guile) ident(-)ident(s) -ident(!)error(#) - -operator(()ident(use-modules) operator(()ident(srfi) ident(srfi-13)operator(\)) - operator(()ident(srfi) ident(srfi-14)operator(\)) - operator(()ident(ice-9) ident(rw)operator(\)) - operator(()ident(ice-9) ident(regex)operator(\))operator(\)) - -operator(()reserved(define) ident(data) string<delimiter(")content(analysed => analyzed -built-in => builtin -chastized => chastised -commandline => command-line -de-allocate => deallocate -dropin => drop-in -hardcode => hard-code -meta-data => metadata -multicharacter => multi-character -multiway => multi-way -non-empty => nonempty -non-profit => nonprofit -non-trappable => nontrappable -pre-define => predefine -preextend => pre-extend -re-compiling => recompiling -reenter => re-enter -turnkey => turn-key)delimiter(")>operator(\)) - -operator(()reserved(define) ident(input) operator(()reserved(if) operator(()ident(null?) operator(()ident(cdr) operator(()ident(command-line)operator(\))operator(\))operator(\)) - operator(()ident(current-input-port)operator(\)) - operator(()ident(open-input-file) operator(()ident(cadr) operator(()ident(command-line)operator(\))operator(\))operator(\))operator(\))operator(\)) - -operator(()reserved(let*) operator(()operator(()ident(newline-char-set) operator(()ident(string->char-set) string<delimiter(")content(\\n)delimiter(")>operator(\))operator(\)) - operator(()ident(assoc-char-set) operator(()ident(string->char-set) string<delimiter(")content( =>)delimiter(")>operator(\))operator(\)) - operator(()ident(dict) operator(()ident(map) - operator(()reserved(lambda) operator(()ident(line)operator(\)) - operator(()ident(string-tokenize) ident(line) ident(assoc-char-set)operator(\))operator(\)) - operator(()ident(string-tokenize) ident(data) ident(newline-char-set)operator(\))operator(\))operator(\)) - operator(()ident(dict-match) operator(()ident(string-join) operator(()ident(map) ident(car) ident(dict)operator(\)) string<delimiter(")content(|)delimiter(")>operator(\))operator(\))operator(\)) - operator(()reserved(let) ident(loop) operator(()operator(()ident(line) operator(()ident(read-line) ident(input)operator(\))operator(\))operator(\)) - operator(()reserved(cond) operator(()operator(()ident(not) operator(()ident(eof-object?) ident(line)operator(\))operator(\)) - operator(()ident(regexp-substitute/global) - operator(()ident(current-output-port)operator(\)) ident(dict-match) ident(line) - operator(')ident(pre) - operator(()reserved(lambda) operator(()ident(x)operator(\)) - operator(()ident(cadr) operator(()ident(assoc) operator(()ident(match:substring) ident(x) integer(0)operator(\)) ident(dict)operator(\))operator(\))operator(\)) - operator(')ident(post)operator(\)) - operator(()ident(loop) operator(()ident(read-line) ident(input) operator(')ident(concat)operator(\))operator(\))operator(\))operator(\))operator(\))operator(\)) - -operator(()ident(close-port) ident(input)operator(\)) - -comment(;; @@PLEAC@@_2.1) -comment(;; Strings and numbers are separate data types in Scheme, so this) -comment(;; isn't as important as it is in Perl. More often you would use the) -comment(;; type predicates, string? and number?.) - -operator(()reserved(if) operator(()ident(string-match) string<delimiter(")content([^)content(\\\\)content(d])delimiter(")> ident(str)operator(\)) operator(()ident(display) string<delimiter(")content(has nondigits)delimiter(")>operator(\))operator(\)) -operator(()reserved(or) operator(()ident(string-match) string<delimiter(")content(^)content(\\\\)content(d+$)delimiter(")> ident(str)operator(\)) operator(()ident(display) string<delimiter(")content(not a natural number)delimiter(")>operator(\))operator(\)) -operator(()reserved(or) operator(()ident(string-match) string<delimiter(")content(^-?)content(\\\\)content(d+$)delimiter(")> ident(str)operator(\)) operator(()ident(display) string<delimiter(")content(not an integer)delimiter(")>operator(\))operator(\)) -operator(()reserved(or) operator(()ident(string-match) string<delimiter(")content(^[)content(\\\\)content(-+]?)content(\\\\)content(d+$)delimiter(")> ident(str)operator(\)) operator(()ident(display) string<delimiter(")content(not an integer)delimiter(")>operator(\))operator(\)) -operator(()reserved(or) operator(()ident(string-match) string<delimiter(")content(^-?)content(\\\\)content(d+)content(\\.)content(?)content(\\d)content(*$)delimiter(")> ident(str)operator(\)) operator(()ident(display) string<delimiter(")content(not a decimal number)delimiter(")>operator(\))operator(\)) -operator(()reserved(or) operator(()ident(string-match) string<delimiter(")content(^-?()content(\\d)content(+()content(\\.)content(\\d)content(*\)?|)content(\\.)content(\\d)content(+\)$)delimiter(")> ident(str)operator(\)) - operator(()ident(display) string<delimiter(")content(not a decimal number)delimiter(")>operator(\))operator(\)) -operator(()reserved(or) operator(()ident(string-match) string<delimiter(")content(^([+-]?\)()content(\\d)content(|)content(\\.)content(\\d)content(\))content(\\d)content(*()content(\\.)content(\\d)content(*\)?([Ee]([+-]?)content(\\d)content(+\)\)?$)delimiter(")> ident(str)operator(\)) - operator(()ident(display) string<delimiter(")content(not a C float)delimiter(")>operator(\))operator(\)) - -operator(()reserved(define) ident(num1) operator(()ident(string->number) ident(str)operator(\))operator(\)) - -operator(()reserved(define) ident(num2) operator(()ident(read)operator(\))operator(\)) - -comment(;; @@PLEAC@@_2.2) -comment(;; (approx-equal? num1 num2 accuracy\) : returns #t if num1 and num2 are) -comment(;; equal to accuracy number of decimal places) -operator(()reserved(define) operator(()ident(approx-equal?) ident(num1) ident(num2) ident(accuracy)operator(\)) - operator(()ident(<) operator(()ident(abs) operator(()ident(-) ident(num1) ident(num2)operator(\))operator(\)) operator(()ident(expt) integer(10.0) operator(()ident(-) ident(accuracy)operator(\))operator(\))operator(\))operator(\)) - -operator(()reserved(define) ident(wage) integer(536)operator(\)) comment(;; $5.36/hour) -operator(()reserved(define) ident(week) operator(()ident(*) integer(40) ident(wage)operator(\))operator(\)) comment(;; $214.40) -operator(()ident(format) pre_constant(#t) string<delimiter(")content(One week's wage is: $~$)content(\\n)delimiter(")> operator(()ident(/) ident(week) integer(100.0)operator(\))operator(\)) - -comment(;; @@PLEAC@@_2.3) -operator(()ident(round) ident(num)operator(\)) comment(;; rounds to inexact whole number) -operator(()ident(inexact->exact) ident(num)operator(\)) comment(;; rounds to exact integer) - -comment(;; You can also use format to convert numbers to more precisely) -comment(;; formatted strings. Note Guile has a builtin format which is a more) -comment(;; limited version of that found in the (ice-9 format\) module, to save) -comment(;; load time. Basically, if you are doing anything you couldn't do) -comment(;; with a series of (display\), (write\) and (newline\), then you'll need) -comment(;; to use the module.) -operator(()ident(use-modules) operator(()ident(ice-9) ident(format)operator(\))operator(\)) - -operator(()reserved(define) ident(a) integer(0.255)operator(\)) -operator(()reserved(define) ident(b) operator(()ident(/) operator(()ident(round) operator(()ident(*) integer(100.0) ident(a)operator(\))operator(\)) integer(100.0)operator(\))operator(\)) -operator(()ident(format) pre_constant(#t) string<delimiter(")content(Unrounded: ~F)content(\\n)content(Rounded: ~F)content(\\n)delimiter(")> ident(a) ident(b)operator(\)) -operator(()ident(format) pre_constant(#t) string<delimiter(")content(Unrounded: ~F)content(\\n)content(Rounded: ~,2F)content(\\n)delimiter(")> ident(a) ident(a)operator(\)) - -operator(()reserved(define) ident(a) operator(')operator(()integer(3.3) integer(3.5) integer(3.7) ident(-)integer(3.3)operator(\))operator(\)) -operator(()ident(display) string<delimiter(")content(number)content(\\t)content(int)content(\\t)content(floor)content(\\t)content(ceil)content(\\n)delimiter(")>operator(\)) -operator(()ident(for-each) - operator(()reserved(lambda) operator(()ident(n)operator(\)) - operator(()ident(format) pre_constant(#t) string<delimiter(")content(~,1F)content(\\t)content(~,1F)content(\\t)content(~,1F)content(\\t)content(~,1F)content(\\n)delimiter(")> - ident(n) operator(()ident(round) ident(n)operator(\)) operator(()ident(floor) ident(n)operator(\)) operator(()ident(ceiling) ident(n)operator(\))operator(\))operator(\)) - ident(a)operator(\)) - -comment(;; @@PLEAC@@_2.4) -comment(;; numbers are radix independent internally, so you usually only) -comment(;; convert on output, however to convert strings:) -operator(()reserved(define) operator(()ident(dec->bin) ident(num)operator(\)) - operator(()ident(number->string) operator(()ident(string->number) ident(num) integer(10)operator(\)) integer(2)operator(\))operator(\)) - -operator(()reserved(define) operator(()ident(bin->dec) ident(num)operator(\)) - operator(()ident(number->string) operator(()ident(string->number) ident(num) integer(2)operator(\)) integer(10)operator(\))operator(\)) - -operator(()reserved(define) ident(num) operator(()ident(bin->dec) string<delimiter(")content(0110110)delimiter(")>operator(\))operator(\)) comment(; 54) -operator(()reserved(define) ident(binstr) operator(()ident(dec->bin) string<delimiter(")content(54)delimiter(")>operator(\))operator(\)) comment(; 110110) - -comment(;; @@PLEAC@@_2.5) -comment(;; do is the most general loop iterator) -operator(()reserved(do) operator(()operator(()ident(i) ident(x) operator(()integer(1)ident(+) ident(i)operator(\))operator(\))operator(\)) comment(; var init-value step-value) - operator(()operator(()ident(>) ident(i) ident(y)operator(\))operator(\)) comment(; end when true) - comment(;; i is set to every integer from x to y, inclusive) - comment(;; ...) - operator(\)) - -comment(;; Guile also offers a while loop) -operator(()reserved(let) operator(()operator(()ident(i) ident(x)operator(\))operator(\)) - operator(()ident(while) operator(()ident(<=) ident(i) ident(y)operator(\)) - comment(;; i is set to every integer from x to y, inclusive) - comment(; ...) - operator(()reserved(set!) ident(i) operator(()integer(1)ident(+) ident(i)operator(\))operator(\))operator(\))operator(\)) - -comment(;; named let is another common loop) -operator(()reserved(let) ident(loop) operator(()operator(()ident(i) ident(x)operator(\))operator(\)) - operator(()reserved(cond) operator(()operator(()ident(<=) ident(i) ident(y)operator(\)) - comment(;; i is set to every integer from x to y, step-size 7) - comment(;; ...) - operator(()ident(loop) operator(()ident(+) ident(i) integer(7)operator(\))operator(\))operator(\))operator(\))operator(\)) comment(; tail-recursive call) - -operator(()ident(display) string<delimiter(")content(Infancy is: )delimiter(")>operator(\)) -operator(()reserved(do) operator(()operator(()ident(i) integer(0) operator(()integer(1)ident(+) ident(i)operator(\))operator(\))operator(\)) - operator(()operator(()ident(>) ident(i) integer(2)operator(\))operator(\)) - operator(()ident(format) pre_constant(#t) string<delimiter(")content(~A )delimiter(")> ident(i)operator(\))operator(\)) -operator(()ident(newline)operator(\)) - -operator(()ident(display) string<delimiter(")content(Toddling is: )delimiter(")>operator(\)) -operator(()reserved(let) operator(()operator(()ident(i) integer(3)operator(\))operator(\)) - operator(()ident(while) operator(()ident(<=) ident(i) integer(4)operator(\)) - operator(()ident(format) pre_constant(#t) string<delimiter(")content(~A )delimiter(")> ident(i)operator(\)) - operator(()reserved(set!) ident(i) operator(()integer(1)ident(+) ident(i)operator(\))operator(\))operator(\))operator(\)) -operator(()ident(newline)operator(\)) - -operator(()ident(display) string<delimiter(")content(Childhood is: )delimiter(")>operator(\)) -operator(()reserved(let) ident(loop) operator(()operator(()ident(i) integer(5)operator(\))operator(\)) - operator(()reserved(cond) operator(()operator(()ident(<=) ident(i) integer(12)operator(\)) - operator(()ident(format) pre_constant(#t) string<delimiter(")content(~A )delimiter(")> ident(i)operator(\)) - operator(()ident(loop) operator(()integer(1)ident(+) ident(i)operator(\))operator(\))operator(\))operator(\))operator(\)) -operator(()ident(newline)operator(\)) - -comment(;; @@PLEAC@@_2.6) -comment(;; format can output roman numerals - use ~:@R) - -operator(()ident(use-modules) operator(()ident(ice-9) ident(format)operator(\))operator(\)) - -operator(()ident(format) pre_constant(#t) string<delimiter(")content(Roman for ~R is ~:@R)content(\\n)delimiter(")> integer(15) integer(15)operator(\)) - -comment(;; @@PLEAC@@_2.7) -operator(()ident(random) integer(5)operator(\)) comment(; an integer from 0 to 4) -operator(()ident(random) integer(5.0)operator(\)) comment(; an inexact real in the range [0,5\)) - -comment(;; char sets from SRFI-14 and string-unfold from SRFI-13 make a quick) -comment(;; way to generate passwords) - -operator(()ident(use-modules) operator(()ident(srfi) ident(srfi-13)operator(\)) operator(()ident(srfi) ident(srfi-14)operator(\))operator(\)) - -operator(()reserved(define) ident(chars) operator(()ident(char-set->string) ident(char-set:graphic)operator(\))operator(\)) -operator(()reserved(define) ident(size) operator(()ident(char-set-size) ident(char-set:graphic)operator(\))operator(\)) -operator(()reserved(define) ident(password) - operator(()ident(string-unfold) operator(()reserved(lambda) operator(()ident(x)operator(\)) operator(()ident(=) ident(x) integer(8)operator(\))operator(\)) - operator(()reserved(lambda) operator(()ident(x)operator(\)) operator(()ident(string-ref) ident(chars) operator(()ident(random) ident(size)operator(\))operator(\))operator(\)) - integer(1)ident(+) integer(0)operator(\))operator(\)) - -comment(;; @@PLEAC@@_2.8) -comment(;; if you're working with random numbers you'll probably want to set) -comment(;; the random seed) - -operator(()ident(seed->random-state) operator(()ident(current-time)operator(\))operator(\)) - -comment(;; you can also save random states and pass them to any of the above) -comment(;; random functions) - -operator(()reserved(define) ident(state) operator(()ident(copy-random-state)operator(\))operator(\)) -operator(()ident(random:uniform)operator(\)) -comment(;; 0.939377327721761) -operator(()ident(random:uniform) ident(state)operator(\)) -comment(;; 0.939377327721761) - -comment(;; @@PLEAC@@_2.9) -comment(;; @@INCOMPLETE@@) -comment(;; very inefficient) -operator(()ident(use-modules) operator(()ident(ice-9) ident(rw)operator(\))operator(\)) -operator(()reserved(define) ident(make-true-random) - operator(()reserved(letrec) operator(()operator(()ident(bufsize) integer(8)operator(\)) - operator(()ident(accum) operator(()reserved(lambda) operator(()ident(c) ident(acc)operator(\)) operator(()ident(+) operator(()ident(*) integer(256) ident(acc)operator(\)) - operator(()ident(char->integer) ident(c)operator(\))operator(\))operator(\))operator(\)) - operator(()ident(getbuf) operator(()reserved(lambda) operator(()operator(\)) - operator(()ident(call-with-input-file) string<delimiter(")content(/dev/urandom)delimiter(")> - operator(()reserved(lambda) operator(()ident(p)operator(\)) - operator(()reserved(let) operator(()operator(()ident(buf) operator(()ident(make-string) ident(bufsize)operator(\))operator(\))operator(\)) - operator(()ident(read-string!/partial) ident(buf) ident(p)operator(\)) - ident(buf)operator(\))operator(\))operator(\))operator(\))operator(\))operator(\)) - operator(()reserved(lambda) operator(()ident(rand-proc)operator(\)) - operator(()reserved(lambda) ident(args) - operator(()reserved(let) operator(()operator(()ident(state) operator(()ident(seed->random-state) operator(()ident(string-fold) ident(accum) integer(0) operator(()ident(getbuf)operator(\))operator(\))operator(\))operator(\))operator(\)) - operator(()ident(apply) ident(rand-proc) operator(()ident(append) ident(args) operator(()ident(list) ident(state)operator(\))operator(\))operator(\))operator(\))operator(\))operator(\))operator(\))operator(\)) - -operator(()reserved(define) ident(urandom) operator(()ident(make-true-random) ident(random)operator(\))operator(\)) -operator(()reserved(define) ident(urandom:exp) operator(()ident(make-true-random) ident(random:exp)operator(\))operator(\)) -operator(()reserved(define) ident(urandom:normal) operator(()ident(make-true-random) ident(random:normal)operator(\))operator(\)) -operator(()reserved(define) ident(urandom:uniform) operator(()ident(make-true-random) ident(random:uniform)operator(\))operator(\)) - -comment(;; @@PLEAC@@_2.10) -comment(;; Guile offers a number of random distributions) - -operator(()ident(random:exp)operator(\)) comment(; an inexact real in an exponential dist with mean 1) -operator(()ident(random:normal)operator(\)) comment(; an inexact real in a standard normal distribution) -operator(()ident(random:uniform)operator(\)) comment(; a uniformly distributed inexact real in [0,1\)) - -comment(;; There are also functions to fill vectors with random distributions) - -comment(;; Fills vector v with inexact real random numbers the sum of whose) -comment(;; squares is equal to 1.0.) -operator(()ident(random:hollow-sphere!) ident(v)operator(\)) - -comment(;; Fills vector v with inexact real random numbers that are) -comment(;; independent and standard normally distributed (i.e., with mean 0) -comment(;; and variance 1\).) -operator(()ident(random:normal-vector!) ident(v)operator(\)) - -comment(;; Fills vector v with inexact real random numbers the sum of whose) -comment(;; squares is less than 1.0.) -operator(()ident(random:solid-sphere!) ident(v)operator(\)) - -comment(;; @@PLEAC@@_2.11) -comment(;; Guile's trigonometric functions use radians.) - -operator(()reserved(define) ident(pi) integer(3.14159265358979)operator(\)) - -operator(()reserved(define) operator(()ident(degrees->radians) ident(deg)operator(\)) - operator(()ident(*) ident(pi) operator(()ident(/) ident(deg) integer(180.0)operator(\))operator(\))operator(\)) - -operator(()reserved(define) operator(()ident(radians->degrees) ident(rad)operator(\)) - operator(()ident(*) integer(180.0) operator(()ident(/) ident(rad) ident(pi)operator(\))operator(\))operator(\)) - -operator(()reserved(define) operator(()ident(degree-sine) ident(deg)operator(\)) - operator(()ident(sin) operator(()ident(degrees->radians) ident(deg)operator(\))operator(\))operator(\)) - -comment(;; @@PLEAC@@_2.12) - -comment(;; Guile provides the following standard trigonometric functions (and) -comment(;; their hyperbolic equivalents\), defined for all real and complex) -comment(;; numbers:) - -operator(()ident(sin) ident(z)operator(\)) -operator(()ident(cos) ident(z)operator(\)) -operator(()ident(tan) ident(z)operator(\)) -operator(()ident(asin) ident(z)operator(\)) -operator(()ident(acos) ident(z)operator(\)) -operator(()ident(atan) ident(z)operator(\)) - -operator(()ident(acos) integer(3.7)operator(\)) comment(; 0.0+1.9826969446812i) - -comment(;; @@PLEAC@@_2.13) -comment(;; Guile provides log in base e and 10 natively, defined for any real) -comment(;; or complex numbers:) - -operator(()ident(log) ident(z)operator(\)) comment(; natural logarithm) -operator(()ident(log10) ident(z)operator(\)) comment(; base-10 logarithm) - -comment(;; For other bases, divide by the log of the base:) - -operator(()reserved(define) operator(()ident(log-base) ident(n) ident(z)operator(\)) - operator(()ident(/) operator(()ident(log) ident(z)operator(\)) operator(()ident(log) ident(n)operator(\))operator(\))operator(\)) - -comment(;; To avoid re-computing (log n\) for a base you want to use) -comment(;; frequently, you can create a custom log function:) - -operator(()reserved(define) operator(()ident(make-log-base) ident(n)operator(\)) - operator(()reserved(let) operator(()operator(()ident(divisor) operator(()ident(log) ident(n)operator(\))operator(\))operator(\)) - operator(()reserved(lambda) operator(()ident(z)operator(\)) operator(()ident(/) operator(()ident(log) ident(z)operator(\)) ident(divisor)operator(\))operator(\))operator(\))operator(\)) - -operator(()reserved(define) ident(log2) operator(()ident(make-log-base) integer(2)operator(\))operator(\)) - -operator(()ident(log2) integer(1024)operator(\)) - -comment(;; @@PLEAC@@_2.14) -comment(;; In addition to simple vectors, Guile has builtin support for) -comment(;; uniform arrays of an arbitrary dimension.) - -comment(;; a rows x cols integer matrix) -operator(()reserved(define) ident(a) operator(()ident(make-array) integer(0) ident(rows) ident(cols)operator(\))operator(\)) -operator(()ident(array-set!) ident(a) integer(3) ident(row) ident(col)operator(\)) -operator(()ident(array-ref) ident(a) ident(row) ident(col)operator(\)) - -comment(;; a 3D matrix of reals) -operator(()reserved(define) ident(b) operator(()ident(make-array) integer(0.0) ident(x) ident(y) ident(z)operator(\))operator(\)) - -comment(;; a literal boolean truth table for logical and) -operator(')error(#)integer(2)operator(()operator(()pre_constant(#f) pre_constant(#f)operator(\)) operator(()pre_constant(#f) pre_constant(#t)operator(\))operator(\)) - -comment(;; simple matrix multiplication) - -operator(()reserved(define) operator(()ident(matrix-mult) ident(m1) ident(m2)operator(\)) - operator(()reserved(let*) operator(()operator(()ident(d1) operator(()ident(array-dimensions) ident(m1)operator(\))operator(\)) - operator(()ident(d2) operator(()ident(array-dimensions) ident(m2)operator(\))operator(\)) - operator(()ident(m1rows) operator(()ident(car) ident(d1)operator(\))operator(\)) - operator(()ident(m1cols) operator(()ident(cadr) ident(d1)operator(\))operator(\)) - operator(()ident(m2rows) operator(()ident(car) ident(d2)operator(\))operator(\)) - operator(()ident(m2cols) operator(()ident(cadr) ident(d2)operator(\))operator(\))operator(\)) - operator(()reserved(if) operator(()ident(not) operator(()ident(=) ident(m1cols) ident(m2rows)operator(\))operator(\)) - operator(()ident(error) operator(')ident(index-error) string<delimiter(")content(matrices don't match)delimiter(")>operator(\))operator(\)) - operator(()reserved(let) operator(()operator(()ident(result) operator(()ident(make-array) integer(0) ident(m1rows) ident(m2cols)operator(\))operator(\))operator(\)) - operator(()reserved(do) operator(()operator(()ident(i) integer(0) operator(()integer(1)ident(+) ident(i)operator(\))operator(\))operator(\)) - operator(()operator(()ident(=) ident(i) ident(m1rows)operator(\))operator(\)) - operator(()reserved(do) operator(()operator(()ident(j) integer(0) operator(()integer(1)ident(+) ident(j)operator(\))operator(\))operator(\)) - operator(()operator(()ident(=) ident(j) ident(m2cols)operator(\))operator(\)) - operator(()reserved(do) operator(()operator(()ident(k) integer(0) operator(()integer(1)ident(+) ident(k)operator(\))operator(\))operator(\)) - operator(()operator(()ident(=) ident(k) ident(m1cols)operator(\))operator(\)) - operator(()ident(array-set!) ident(result) operator(()ident(+) operator(()ident(array-ref) ident(result) ident(i) ident(j)operator(\)) - operator(()ident(*) operator(()ident(array-ref) ident(m1) ident(i) ident(k)operator(\)) - operator(()ident(array-ref) ident(m2) ident(k) ident(j)operator(\))operator(\))operator(\)) - ident(i) ident(j)operator(\))operator(\))operator(\))operator(\)) - ident(result)operator(\))operator(\))operator(\)) - -operator(()ident(matrix-mult) operator(')error(#)integer(2)operator(()operator(()integer(3) integer(2) integer(3)operator(\)) operator(()integer(5) integer(9) integer(8)operator(\))operator(\)) operator(')error(#)integer(2)operator(()operator(()integer(4) integer(7)operator(\)) operator(()integer(9) integer(3)operator(\)) operator(()integer(8) integer(1)operator(\))operator(\))operator(\)) - -comment(;; @@PLEAC@@_2.15) -comment(;; Guile has builtin support for complex numbers:) - -operator(()reserved(define) ident(i) integer(0+1i)operator(\)) comment(; 0.0+1.0i) -operator(()reserved(define) ident(i) operator(()ident(sqrt) ident(-)integer(1)operator(\))operator(\)) comment(; 0.0+1.0i) - -operator(()ident(complex?) ident(i)operator(\)) comment(; #t) -operator(()ident(real-part) ident(i)operator(\)) comment(; 0.0) -operator(()ident(imag-part) ident(i)operator(\)) comment(; 1.0) - -operator(()ident(*) integer(3+5i) integer(2-2i)operator(\)) comment(; 16+4i) -operator(()ident(sqrt) integer(3+4i)operator(\)) comment(; 2+i) - -comment(;; Classic identity: -e^(pi*i\) => 1) -operator(()ident(inexact->exact) operator(()ident(real-part) operator(()ident(-) operator(()ident(exp) operator(()ident(*) ident(pi) integer(0+1i)operator(\))operator(\))operator(\))operator(\))operator(\)) comment(; 1) - -comment(;; @@PLEAC@@_2.16) -comment(;; You can type in literal numbers in alternate radixes:) - -integer(#b01101101) comment(; 109 in binary) -integer(#o155) comment(; 109 in octal) -integer(#d109) comment(; 109 in decimal) -integer(#x6d) comment(; 109 in hexadecimal) - -comment(;; number->string and string->number also take an optional radix:) - -operator(()reserved(define) ident(number) operator(()ident(string->number) ident(hexadecimal) integer(16)operator(\))operator(\)) -operator(()reserved(define) ident(number) operator(()ident(string->number) ident(octal) integer(8)operator(\))operator(\)) - -comment(;; format will also output in different radixes:) - -operator(()ident(format) pre_constant(#t) string<delimiter(")content(~B ~O ~D ~X)content(\\n)delimiter(")> ident(num) ident(num) ident(num) ident(num)operator(\)) - -comment(;; converting Unix file permissions read from stdin:) - -operator(()reserved(let) ident(loop) operator(()operator(()ident(perm) operator(()ident(read-line)operator(\))operator(\))operator(\)) - operator(()reserved(cond) operator(()operator(()ident(not) operator(()ident(eof-object?) ident(perm)operator(\))operator(\)) - operator(()ident(format) pre_constant(#t) string<delimiter(")content(The decimal value is ~D)content(\\n)delimiter(")> operator(()ident(string->number) ident(perm) integer(8)operator(\))operator(\)) - operator(()ident(loop) operator(()ident(read-line)operator(\))operator(\))operator(\))operator(\))operator(\)) - -comment(;; @@PLEAC@@_2.17) -comment(;; once again, format is our friend :\)) -operator(()ident(use-modules) operator(()ident(ice-9) ident(format)operator(\))operator(\)) - -comment(;; the : prefix to the D directive causes commas to be output every) -comment(;; three digits.) -operator(()ident(format) pre_constant(#t) string<delimiter(")content(~:D)content(\\n)delimiter(")> operator(()ident(random) integer(10000000000000000)operator(\))operator(\)) -comment(; => 2,301,267,079,619,540) - -comment(;; the third prefix arg to the D directive is the separator character) -comment(;; to use instead of a comma, useful for European style numbers:) -operator(()ident(format) pre_constant(#t) string<delimiter(")content(~,,'.:D)content(\\n)delimiter(")> operator(()ident(random) integer(10000000000000000)operator(\))operator(\)) -comment(; => 6.486.470.447.356.534) - -comment(;; the F directive, however, does not support grouping by commas. to) -comment(;; achieve this, we can format the integer and fractional parts) -comment(;; separately:) -operator(()reserved(define) operator(()ident(commify) ident(num)operator(\)) - operator(()reserved(let) operator(()operator(()ident(int) operator(()ident(inexact->exact) operator(()ident(truncate) ident(num)operator(\))operator(\))operator(\))operator(\)) - operator(()reserved(if) operator(()ident(=) ident(num) ident(int)operator(\)) - operator(()ident(format) pre_constant(#f) string<delimiter(")content(~:D)delimiter(")> ident(int)operator(\)) - operator(()ident(string-append) operator(()ident(format) pre_constant(#f) string<delimiter(")content(~:D)delimiter(")> ident(int)operator(\)) - operator(()reserved(let) operator(()operator(()ident(str) operator(()ident(format) pre_constant(#f) string<delimiter(")content(~F)delimiter(")> ident(num)operator(\))operator(\))operator(\)) - operator(()ident(substring) ident(str) operator(()reserved(or) operator(()ident(string-index) ident(str) char(#\\.)operator(\)) - operator(()ident(string-length) ident(str)operator(\))operator(\))operator(\))operator(\))operator(\))operator(\))operator(\))operator(\)) - -comment(;; @@PLEAC@@_2.18) -comment(;; format can handle simple 's' plurals with ~p, and 'y/ies' plurals) -comment(;; with the @ prefix:) - -operator(()ident(format) pre_constant(#t) string<delimiter(")content(It took ~D hour~P)content(\\n)delimiter(")> ident(hours) ident(hours)operator(\)) - -operator(()ident(format) pre_constant(#t) string<delimiter(")content(It took ~D centur~@P)content(\\n)delimiter(")> ident(centuries) ident(centuries)operator(\)) - -operator(()reserved(define) ident(noun-plural) - operator(()reserved(let*) operator(()operator(()ident(suffixes) operator(')operator(()operator(()string<delimiter(")content(ss)delimiter(")> operator(.) string<delimiter(")content(sses)delimiter(")>operator(\)) - operator(()string<delimiter(")content(ph)delimiter(")> operator(.) string<delimiter(")content(phes)delimiter(")>operator(\)) - operator(()string<delimiter(")content(sh)delimiter(")> operator(.) string<delimiter(")content(shes)delimiter(")>operator(\)) - operator(()string<delimiter(")content(ch)delimiter(")> operator(.) string<delimiter(")content(ches)delimiter(")>operator(\)) - operator(()string<delimiter(")content(z)delimiter(")> operator(.) string<delimiter(")content(zes)delimiter(")>operator(\)) - operator(()string<delimiter(")content(ff)delimiter(")> operator(.) string<delimiter(")content(ffs)delimiter(")>operator(\)) - operator(()string<delimiter(")content(f)delimiter(")> operator(.) string<delimiter(")content(ves)delimiter(")>operator(\)) - operator(()string<delimiter(")content(ey)delimiter(")> operator(.) string<delimiter(")content(eys)delimiter(")>operator(\)) - operator(()string<delimiter(")content(y)delimiter(")> operator(.) string<delimiter(")content(ies)delimiter(")>operator(\)) - operator(()string<delimiter(")content(ix)delimiter(")> operator(.) string<delimiter(")content(ices)delimiter(")>operator(\)) - operator(()string<delimiter(")content(s)delimiter(")> operator(.) string<delimiter(")content(ses)delimiter(")>operator(\)) - operator(()string<delimiter(")content(x)delimiter(")> operator(.) string<delimiter(")content(xes)delimiter(")>operator(\)) - operator(()string<delimiter(")content(ius)delimiter(")> operator(.) string<delimiter(")content(ii)delimiter(")>operator(\))operator(\))operator(\)) - operator(()ident(suffix-match) - operator(()ident(string-append) string<delimiter(")content(()delimiter(")> operator(()ident(string-join) operator(()ident(map) ident(car) ident(suffixes)operator(\)) string<delimiter(")content(|)delimiter(")>operator(\)) string<delimiter(")content(\)$)delimiter(")>operator(\))operator(\)) - operator(()ident(suffix-rx) operator(()ident(make-regexp) ident(suffix-match)operator(\))operator(\))operator(\)) - operator(()reserved(lambda) operator(()ident(noun)operator(\)) - operator(()reserved(let) operator(()operator(()ident(m) operator(()ident(regexp-exec) ident(suffix-rx) ident(noun)operator(\))operator(\))operator(\)) - operator(()reserved(if) ident(m) - operator(()ident(string-append) operator(()ident(regexp-substitute) pre_constant(#f) ident(m) operator(')ident(pre)operator(\)) - operator(()ident(cdr) operator(()ident(assoc) operator(()ident(match:substring) ident(m)operator(\)) ident(suffixes)operator(\))operator(\))operator(\)) - operator(()ident(string-append) ident(noun) string<delimiter(")content(s)delimiter(")>operator(\))operator(\))operator(\))operator(\))operator(\))operator(\)) - -comment(;; @@PLEAC@@_2.19) -error(#)ident(!/usr/local/bin/guile) ident(-)ident(s) -ident(!)error(#) - -comment(;; very naive factoring algorithm) -operator(()reserved(define) operator(()ident(factor) ident(n)operator(\)) - operator(()reserved(let) operator(()operator(()ident(factors) operator(')operator(()operator(\))operator(\)) - operator(()ident(limit) operator(()ident(inexact->exact) operator(()ident(round) operator(()ident(sqrt) ident(n)operator(\))operator(\))operator(\))operator(\)) - operator(()ident(twos) integer(0)operator(\))operator(\)) - comment(;; factor out 2's) - operator(()ident(while) operator(()ident(even?) ident(n)operator(\)) - operator(()reserved(set!) ident(n) operator(()ident(ash) ident(n) ident(-)integer(1)operator(\))operator(\)) - operator(()reserved(set!) ident(twos) operator(()integer(1)ident(+) ident(twos)operator(\))operator(\))operator(\)) - operator(()reserved(if) operator(()ident(>) ident(twos) integer(0)operator(\)) operator(()reserved(set!) ident(factors) operator(()ident(list) operator(()reserved(cons) integer(2) ident(twos)operator(\))operator(\))operator(\))operator(\)) - comment(;; factor out odd primes) - operator(()reserved(let) ident(loop) operator(()operator(()ident(i) integer(3)operator(\))operator(\)) - operator(()reserved(let) operator(()operator(()ident(r) operator(()ident(remainder) ident(n) ident(i)operator(\))operator(\))operator(\)) - operator(()reserved(cond) operator(()operator(()ident(=) ident(r) integer(0)operator(\)) - operator(()reserved(set!) ident(n) operator(()ident(quotient) ident(n) ident(i)operator(\))operator(\)) - operator(()reserved(let*) operator(()operator(()ident(old-val) operator(()ident(assv) ident(i) ident(factors)operator(\))operator(\)) - operator(()ident(new-val) operator(()reserved(if) ident(old-val) operator(()integer(1)ident(+) operator(()ident(cdr) ident(old-val)operator(\))operator(\)) integer(1)operator(\))operator(\))operator(\)) - operator(()reserved(set!) ident(factors) operator(()ident(assv-set!) ident(factors) ident(i) ident(new-val)operator(\))operator(\))operator(\)) - operator(()ident(loop) ident(i)operator(\))operator(\)) - operator(()operator(()ident(<) ident(i) ident(limit)operator(\)) - operator(()ident(loop) operator(()ident(+) integer(2) ident(i)operator(\))operator(\))operator(\))operator(\))operator(\))operator(\)) - comment(;; remainder) - operator(()reserved(if) operator(()ident(>) ident(n) integer(1)operator(\)) operator(()reserved(set!) ident(factors) operator(()reserved(cons) operator(()reserved(cons) ident(n) integer(1)operator(\)) ident(factors)operator(\))operator(\))operator(\)) - operator(()ident(reverse!) ident(factors)operator(\))operator(\))operator(\)) - -comment(;; pretty print a term of a factor) -operator(()reserved(define) operator(()ident(pp-term) ident(pair)operator(\)) - operator(()reserved(if) operator(()ident(=) operator(()ident(cdr) ident(pair)operator(\)) integer(1)operator(\)) - operator(()ident(number->string) operator(()ident(car) ident(pair)operator(\))operator(\)) - operator(()ident(format) pre_constant(#f) string<delimiter(")content(~A^~A)delimiter(")> operator(()ident(car) ident(pair)operator(\)) operator(()ident(cdr) ident(pair)operator(\))operator(\))operator(\))operator(\)) - -comment(;; factor each number given on the command line) -operator(()ident(for-each) - operator(()reserved(lambda) operator(()ident(n)operator(\)) - operator(()reserved(let) operator(()operator(()ident(factors) operator(()ident(factor) ident(n)operator(\))operator(\))operator(\)) - operator(()ident(format) pre_constant(#t) string<delimiter(")content(~A = ~A)delimiter(")> ident(n) operator(()ident(pp-term) operator(()ident(car) ident(factors)operator(\))operator(\))operator(\)) - operator(()ident(for-each) - operator(()reserved(lambda) operator(()ident(x)operator(\)) operator(()ident(format) pre_constant(#t) string<delimiter(")content( * ~A)delimiter(")> operator(()ident(pp-term) ident(x)operator(\))operator(\))operator(\)) - operator(()ident(cdr) ident(factors)operator(\))operator(\)) - operator(()ident(newline)operator(\))operator(\))operator(\)) - operator(()ident(map) ident(string->number) operator(()ident(cdr) operator(()ident(command-line)operator(\))operator(\))operator(\))operator(\)) - -comment(;; @@PLEAC@@_3.0) -comment(;; Use the builtin POSIX time functions) - -comment(;; get the current time) -operator(()ident(current-time)operator(\)) comment(; number of seconds since the epoch) -operator(()ident(gettimeofday)operator(\)) comment(; pair of seconds and microseconds since the epoch) - -comment(;; create a time object from an integer (e.g. returned by current-time\)) -operator(()ident(localtime) ident(time)operator(\)) comment(; in localtime) -operator(()ident(gmtime) ident(time)operator(\)) comment(; in UTC) - -comment(;; get/set broken down components of a time object) - -operator(()ident(tm:sec) ident(time)operator(\)) operator(()ident(set-tm:sec) ident(time) ident(secs)operator(\)) comment(; seconds (0-59\)) -operator(()ident(tm:min) ident(time)operator(\)) operator(()ident(set-tm:min) ident(time) ident(mins)operator(\)) comment(; minutes (0-59\)) -operator(()ident(tm:hour) ident(time)operator(\)) operator(()ident(set-tm:hour) ident(time) ident(hours)operator(\)) comment(; hours (0-23\)) -operator(()ident(tm:mday) ident(time)operator(\)) operator(()ident(set-tm:mday) ident(time) ident(mday)operator(\)) comment(; day of the month (1-31\)) -operator(()ident(tm:mon) ident(time)operator(\)) operator(()ident(set-tm:mon) ident(time) ident(month)operator(\)) comment(; month (0-11\)) -operator(()ident(tm:year) ident(time)operator(\)) operator(()ident(set-tm:year) ident(time) ident(year)operator(\)) comment(; year minus 1900 (70-\)) -operator(()ident(tm:wday) ident(time)operator(\)) operator(()ident(set-tm:wday) ident(time) ident(wday)operator(\)) comment(; day of the week (0-6\)) - comment(; where Sunday is 0) -operator(()ident(tm:yday) ident(time)operator(\)) operator(()ident(set-tm:yday) ident(time) ident(yday)operator(\)) comment(; day of year (0-365\)) -operator(()ident(tm:isdst) ident(time)operator(\)) operator(()ident(set-tm:isdst) ident(time) ident(isdst)operator(\)) comment(; daylight saving indicator) - comment(; 0 for "no", > 0 for "yes",) - comment(; < 0 for "unknown") -operator(()ident(tm:gmtoff) ident(time)operator(\)) operator(()ident(set-tm:gmtoff) ident(time) ident(off)operator(\)) comment(; time zone offset in seconds) - comment(; west of UTC (-46800 to 43200\)) -operator(()ident(tm:zone) ident(time)operator(\)) operator(()ident(set-tm:zone) ident(time) ident(zone)operator(\)) comment(; Time zone label (a string\),) - comment(; not necessarily unique.) - -operator(()ident(format) pre_constant(#t) string<delimiter(")content(Today is day ~A of the current year.)content(\\n)delimiter(")> - operator(()ident(tm:yday) operator(()ident(localtime) operator(()ident(current-time)operator(\))operator(\))operator(\))operator(\)) - -comment(;; Or use SRFI-19 - Time and Date Procedures) -operator(()ident(use-modules) operator(()ident(srfi) ident(srfi-19)operator(\))operator(\)) - -operator(()reserved(define) ident(now) operator(()ident(current-date)operator(\))operator(\)) comment(; immutable once created) - -operator(()ident(date-nanosecond) ident(now)operator(\)) comment(; 0-9,999,999) -operator(()ident(date-second) ident(now)operator(\)) comment(; 0-60 (60 represents a leap second\)) -operator(()ident(date-minute) ident(now)operator(\)) comment(; 0-59) -operator(()ident(date-hour) ident(now)operator(\)) comment(; 0-23) -operator(()ident(date-day) ident(now)operator(\)) comment(; 0-31) -operator(()ident(date-month) ident(now)operator(\)) comment(; 1-12) -operator(()ident(date-year) ident(now)operator(\)) comment(; integer representing the year) -operator(()ident(date-year-day) ident(now)operator(\)) comment(; day of year (Jan 1 is 1, etc.\)) -operator(()ident(date-week-day) ident(now)operator(\)) comment(; day of week (Sunday is 0, etc.\)) -operator(()ident(date-week-number) ident(now) ident(start)operator(\)) comment(; week of year, ignoring a first partial week) - comment(; start is the first day of week as above) -operator(()ident(date-zone-offset) ident(now)operator(\)) comment(; integer number of seconds east of GMT) - -operator(()ident(format) pre_constant(#t) string<delimiter(")content(Today is day ~A of the current year.)content(\\n)delimiter(")> - operator(()ident(date-year-day) operator(()ident(current-date)operator(\))operator(\))operator(\)) - -comment(;; @@PLEAC@@_3.1) -comment(;; using format and POSIX time components) -operator(()ident(use-modules) operator(()ident(ice-9) ident(format)operator(\))operator(\)) -operator(()reserved(let) operator(()operator(()ident(now) operator(()ident(localtime) operator(()ident(current-time)operator(\))operator(\))operator(\))operator(\)) - operator(()ident(format) pre_constant(#t) string<delimiter(")content(The current date is ~4'0D ~2'0D ~2'0D)content(\\n)delimiter(")> - operator(()ident(+) integer(1900) operator(()ident(tm:year) ident(now)operator(\))operator(\)) operator(()ident(tm:mon) ident(now)operator(\)) operator(()ident(tm:mday) ident(now)operator(\))operator(\))operator(\)) - -comment(;; using format and SRFI-19 time components) -operator(()ident(use-modules) operator(()ident(srfi) ident(srfi-19)operator(\)) operator(()ident(ice-9) ident(format)operator(\))operator(\)) -operator(()reserved(let) operator(()operator(()ident(now) operator(()ident(current-date)operator(\))operator(\))operator(\)) - operator(()ident(format) pre_constant(#t) string<delimiter(")content(The current date is ~4'0d-~2'0D-~2'0D)content(\\n)delimiter(")> - operator(()ident(date-year) ident(now)operator(\)) operator(()ident(date-month) ident(now)operator(\)) operator(()ident(date-day) ident(now)operator(\))operator(\))operator(\)) - -comment(;; using POSIX strftime with a libc time format string) -operator(()ident(display) operator(()ident(strftime) string<delimiter(")content(%Y-%m-%d)content(\\n)delimiter(")> operator(()ident(localtime) operator(()ident(current-time)operator(\))operator(\))operator(\))operator(\)) - -comment(;; @@PLEAC@@_3.2) -comment(;; set the individual components of a time struct and use mktime) -operator(()reserved(define) ident(time) operator(()ident(localtime) operator(()ident(current-time)operator(\))operator(\))operator(\)) -operator(()ident(set-tm:mday) ident(time) ident(mday)operator(\)) -operator(()ident(set-tm:mon) ident(time) ident(mon)operator(\)) -operator(()ident(set-tm:year) ident(time) ident(year)operator(\)) -operator(()ident(car) operator(()ident(mktime) ident(time)operator(\))operator(\)) comment(; mktime returns a (epoch-seconds . time\) pair) - -comment(;; or use SRFI-19's make-date and date->time-monotonic) -operator(()ident(use-modules) operator(()ident(srfi) ident(srfi-19)operator(\))operator(\)) -operator(()ident(date->time-monotonic) - operator(()ident(make-date) ident(nanosecond) ident(second) ident(minute) ident(hour) ident(day) ident(month) ident(year) ident(zone-offset)operator(\))operator(\)) - -comment(;; @@PLEAC@@_3.3) -comment(;; use localtime or gmtime with the accessors mentioned in the) -comment(;; introduction to this chapter) -operator(()reserved(let) operator(()operator(()ident(time) operator(()ident(localtime) ident(seconds)operator(\))operator(\))operator(\)) comment(; or gmtime) - operator(()ident(format) pre_constant(#t) string<delimiter(")content(Dateline: ~2'0d:~2'0d:~2'0d-~4'0d/~2'0d/~2'0d)content(\\n)delimiter(")> - operator(()ident(tm:hour) ident(time)operator(\)) operator(()ident(tm:min) ident(time)operator(\)) operator(()ident(tm:sec) ident(time)operator(\)) - operator(()ident(+) integer(1900) operator(()ident(tm:year) ident(time)operator(\))operator(\)) operator(()integer(1)ident(+) operator(()ident(tm:mon) ident(time)operator(\))operator(\)) operator(()ident(tm:mday) ident(time)operator(\))operator(\))operator(\)) - -comment(;; or use SRFI-19) -operator(()ident(use-modules) operator(()ident(srfi) ident(srfi-19)operator(\))operator(\)) -operator(()reserved(let*) operator(()operator(()ident(time) operator(()ident(make-time) ident(time-monotonic) ident(nanosecond) ident(second)operator(\))operator(\))operator(\)) - operator(()ident(display) operator(()ident(date->string) operator(()ident(time-monotonic->date) ident(time)operator(\)) string<delimiter(")content(~T-~1)content(\\n)delimiter(")>operator(\))operator(\))operator(\)) - -comment(;; @@PLEAC@@_3.4) -comment(;; just add or subtract epoch seconds) -operator(()reserved(define) ident(when) operator(()ident(+) ident(now) ident(difference)operator(\))operator(\)) -operator(()reserved(define) ident(then) operator(()ident(-) ident(now) ident(difference)operator(\))operator(\)) - -comment(;; if you have DMYHMS values, you can convert them to times or add) -comment(;; them as seconds:) -operator(()reserved(define) ident(birthtime) integer(96176750)operator(\)) -operator(()reserved(define) ident(interval) operator(()ident(+) integer(5) comment(; 5 seconds) - operator(()ident(*) integer(17) integer(60)operator(\)) comment(; 17 minutes) - operator(()ident(*) integer(2) integer(60) integer(60)operator(\)) comment(; 2 hours) - operator(()ident(*) integer(55) integer(60) integer(60) integer(24)operator(\))operator(\))operator(\)) comment(; and 55 days) -operator(()reserved(define) ident(then) operator(()ident(+) ident(birthtime) ident(interval)operator(\))operator(\)) -operator(()ident(format) pre_constant(#t) string<delimiter(")content(Then is ~A)content(\\n)delimiter(")> operator(()ident(strftime) string<delimiter(")content(%a %b %d %T %Y)delimiter(")> operator(()ident(localtime) ident(then)operator(\))operator(\))operator(\)) - -comment(;; @@PLEAC@@_3.5) -comment(;; subtract the epoch seconds:) -operator(()reserved(define) ident(bree) integer(361535725)operator(\)) -operator(()reserved(define) ident(nat) integer(96201950)operator(\)) -operator(()reserved(define) ident(difference) operator(()ident(-) ident(bree) ident(nat)operator(\))operator(\)) -operator(()ident(format) pre_constant(#t) string<delimiter(")content(There were ~A seconds between Nat and Bree)content(\\n)delimiter(")> ident(difference)operator(\)) - -comment(;; or use SRFI-19's time arithmetic procedures:) -operator(()ident(use-modules) operator(()ident(srfi) ident(srfi-19)operator(\))operator(\)) -operator(()reserved(define) ident(time1) operator(()ident(make-time) ident(time-monotonic) ident(nano1) ident(sec1)operator(\))operator(\)) -operator(()reserved(define) ident(time2) operator(()ident(make-time) ident(time-monotonic) ident(nano2) ident(sec2)operator(\))operator(\)) -operator(()reserved(define) ident(duration) operator(()ident(time-difference) ident(time1) ident(time2)operator(\))operator(\)) -operator(()ident(time=?) operator(()ident(subtract-duration) ident(time1) ident(duration)operator(\)) ident(time2)operator(\)) comment(; #t) -operator(()ident(time=?) operator(()ident(add-duration) ident(time2) ident(duration)operator(\)) ident(time1)operator(\)) comment(; #t) - -comment(;; @@PLEAC@@_3.6) -comment(;; convert to a SRFI-19 date and use the accessors) -operator(()ident(use-modules) operator(()ident(srfi) ident(srfi-19)operator(\))operator(\)) -operator(()ident(date-day) ident(date)operator(\)) -operator(()ident(date-year-day) ident(date)operator(\)) -operator(()ident(date-week-day) ident(date)operator(\)) -operator(()ident(date-week-number) ident(date) ident(start-day-of-week)operator(\)) - -comment(;; @@PLEAC@@_3.7) -comment(;; use the strptime function:) -operator(()reserved(define) ident(time-pair) operator(()ident(strptime) string<delimiter(")content(%Y-%m-%d)delimiter(")> string<delimiter(")content(1998-06-03)delimiter(")>operator(\))operator(\)) -operator(()ident(format) pre_constant(#t) string<delimiter(")content(Time is ~A)content(\\n)content(.)delimiter(")> operator(()ident(strftime) string<delimiter(")content(%b %d, %Y)delimiter(")> operator(()ident(car) ident(time-pair)operator(\))operator(\))operator(\)) - -comment(;; or use SRFI-19's string->date:) -operator(()ident(use-modules) operator(()ident(srfi) ident(srfi-19)operator(\))operator(\)) -operator(()reserved(define) ident(date) operator(()ident(string->date) string<delimiter(")content(1998-06-03)delimiter(")> string<delimiter(")content(~Y-~m-~d)delimiter(")>operator(\))operator(\)) -operator(()ident(format) pre_constant(#t) string<delimiter(")content(Time is ~A.)content(\\n)delimiter(")> operator(()ident(date->string) ident(date)operator(\))operator(\)) - -comment(;; @@PLEAC@@_3.8) -comment(;; use the already seen strftime:) -operator(()ident(format) pre_constant(#t) string<delimiter(")content(strftime gives: ~A)content(\\n)delimiter(")> - operator(()ident(strftime) string<delimiter(")content(%A %D)delimiter(")> operator(()ident(localtime) operator(()ident(current-time)operator(\))operator(\))operator(\))operator(\)) - -comment(;; or SRFI-19's date->string:) -operator(()ident(use-modules) operator(()ident(srfi) ident(srfi-19)operator(\))operator(\)) -operator(()ident(format) pre_constant(#t) string<delimiter(")content(default date->string gives: ~A)content(\\n)delimiter(")> operator(()ident(date->string) operator(()ident(current-date)operator(\))operator(\))operator(\)) -operator(()ident(format) pre_constant(#t) string<delimiter(")content(date->string gives: ~A)content(\\n)delimiter(")> - operator(()ident(date->string) operator(()ident(current-date)operator(\)) string<delimiter(")content(~a ~b ~e ~H:~M:~S ~z ~Y)delimiter(")>operator(\))operator(\)) - -comment(;; @@PLEAC@@_3.9) -comment(;; gettimeofday will return seconds and microseconds:) -operator(()reserved(define) ident(t0) operator(()ident(gettimeofday)operator(\))operator(\)) -comment(;; do your work here) -operator(()reserved(define) ident(t1) operator(()ident(gettimeofday)operator(\))operator(\)) -operator(()ident(format) pre_constant(#t) string<delimiter(")content(You took ~A seconds and ~A microseconds)content(\\n)delimiter(")> - operator(()ident(-) operator(()ident(car) ident(t1)operator(\)) operator(()ident(car) ident(t0)operator(\))operator(\)) operator(()ident(-) operator(()ident(cdr) ident(t1)operator(\)) operator(()ident(cdr) ident(t0)operator(\))operator(\))operator(\)) - -comment(;; you can also get more detailed info about the real and processor) -comment(;; times:) -operator(()reserved(define) ident(runtime) operator(()ident(times)operator(\))operator(\)) -operator(()ident(tms:clock) ident(runtime)operator(\)) comment(; the current real time) -operator(()ident(tms:utime) ident(runtime)operator(\)) comment(; the CPU time units used by the calling process) -operator(()ident(tms:stime) ident(runtime)operator(\)) comment(; the CPU time units used by the system on behalf) - comment(; of the calling process.) -operator(()ident(tms:cutime) ident(runtime)operator(\)) comment(; the CPU time units used by terminated child) - comment(; processes of the calling process, whose status) - comment(; has been collected (e.g., using `waitpid'\).) -operator(()ident(tms:cstime) ident(runtime)operator(\)) comment(; the CPU times units used by the system on) - comment(; behalf of terminated child processes) - -comment(;; you can also use the time module to time execution:) -operator(()ident(use-modules) operator(()ident(ice-9) ident(time)operator(\))operator(\)) -operator(()ident(time) operator(()ident(sleep) integer(3)operator(\))operator(\)) -comment(;; clock utime stime cutime cstime gctime) -comment(;; 3.01 0.00 0.00 0.00 0.00 0.00) -comment(;; 0) - -comment(;; @@PLEAC@@_3.10) -operator(()ident(sleep) ident(i)operator(\)) comment(; sleep for i seconds) -operator(()ident(usleep) ident(i)operator(\)) comment(; sleep for i microseconds (not available on all platforms\)) - -comment(;; @@PLEAC@@_4.0) -operator(()reserved(define) ident(nested) operator(')operator(()string<delimiter(")content(this)delimiter(")> string<delimiter(")content(that)delimiter(")> string<delimiter(")content(the)delimiter(")> string<delimiter(")content(other)delimiter(")>operator(\))operator(\)) -operator(()reserved(define) ident(nested) operator(')operator(()string<delimiter(")content(this)delimiter(")> string<delimiter(")content(that)delimiter(")> operator(()string<delimiter(")content(the)delimiter(")> string<delimiter(")content(other)delimiter(")>operator(\))operator(\))operator(\)) -operator(()reserved(define) ident(tune) operator(')operator(()string<delimiter(")content(The)delimiter(")> string<delimiter(")content(Star-Spangled)delimiter(")> string<delimiter(")content(Banner)delimiter(")>operator(\))operator(\)) - -comment(;; @@PLEAC@@_4.1) -operator(()reserved(define) ident(a) operator(')operator(()string<delimiter(")content(quick)delimiter(")> string<delimiter(")content(brown)delimiter(")> string<delimiter(")content(fox)delimiter(")>operator(\))operator(\)) -operator(()reserved(define) ident(a) operator(')operator(()string<delimiter(")content(Why)delimiter(")> string<delimiter(")content(are)delimiter(")> string<delimiter(")content(you)delimiter(")> string<delimiter(")content(teasing)delimiter(")> string<delimiter(")content(me?)delimiter(")>operator(\))operator(\)) - -operator(()ident(use-modules) operator(()ident(srfi) ident(srfi-13)operator(\))operator(\)) -operator(()reserved(define) ident(lines) - operator(()ident(map) ident(string-trim) - operator(()ident(string-tokenize) string<delimiter(")content(\\)content( - The boy stood on the burning deck, - It was as hot as glass.)delimiter(")> - char(#\\newline)operator(\))operator(\))operator(\)) - -operator(()reserved(define) ident(bigarray) - operator(()ident(with-input-from-file) string<delimiter(")content(mydatafile)delimiter(")> - operator(()reserved(lambda) operator(()operator(\)) - operator(()reserved(let) ident(loop) operator(()operator(()ident(lines) operator(')operator(()operator(\))operator(\)) - operator(()ident(next-line) operator(()ident(read-line)operator(\))operator(\))operator(\)) - operator(()reserved(if) operator(()ident(eof-object?) ident(next-line)operator(\)) - operator(()ident(reverse) ident(lines)operator(\)) - operator(()ident(loop) operator(()reserved(cons) ident(next-line) ident(lines)operator(\)) - operator(()ident(read-line)operator(\))operator(\))operator(\))operator(\))operator(\))operator(\))operator(\)) - -operator(()reserved(define) ident(banner) string<delimiter(")content(The Mines of Moria)delimiter(")>operator(\)) - -operator(()reserved(define) ident(name) string<delimiter(")content(Gandalf)delimiter(")>operator(\)) -operator(()reserved(define) ident(banner) - operator(()ident(string-append) string<delimiter(")content(Speak, )delimiter(")> ident(name) string<delimiter(")content(, and enter!)delimiter(")>operator(\))operator(\)) -operator(()reserved(define) ident(banner) - operator(()ident(format) pre_constant(#f) string<delimiter(")content(Speak, ~A, and welcome!)delimiter(")> ident(name)operator(\))operator(\)) - -comment(;; Advanced shell-like function is provided by guile-scsh, the Guile) -comment(;; port of SCSH, the Scheme shell. Here we roll our own using the) -comment(;; pipe primitives that come with core Guile.) -operator(()ident(use-modules) operator(()ident(ice-9) ident(popen)operator(\))operator(\)) - -operator(()reserved(define) operator(()ident(drain-output) ident(port)operator(\)) - operator(()reserved(let) ident(loop) operator(()operator(()ident(chars) operator(')operator(()operator(\))operator(\)) - operator(()ident(next) operator(()ident(read-char) ident(port)operator(\))operator(\))operator(\)) - operator(()reserved(if) operator(()ident(eof-object?) ident(next)operator(\)) - operator(()ident(list->string) operator(()ident(reverse!) ident(chars)operator(\))operator(\)) - operator(()ident(loop) operator(()reserved(cons) ident(next) ident(chars)operator(\)) - operator(()ident(read-char) ident(port)operator(\))operator(\))operator(\))operator(\))operator(\)) - -operator(()reserved(define) operator(()ident(qx) ident(pipeline)operator(\)) - operator(()reserved(let*) operator(()operator(()ident(pipe) operator(()ident(open-input-pipe) ident(pipeline)operator(\))operator(\)) - operator(()ident(output) operator(()ident(drain-output) ident(pipe)operator(\))operator(\))operator(\)) - operator(()ident(close-pipe) ident(pipe)operator(\)) - ident(output)operator(\))operator(\)) - -operator(()reserved(define) ident(his-host) string<delimiter(")content(www.perl.com)delimiter(")>operator(\)) -operator(()reserved(define) ident(host-info) operator(()ident(qx) operator(()ident(format) pre_constant(#f) string<delimiter(")content(nslookup ~A)delimiter(")> ident(his-host)operator(\))operator(\))operator(\)) - -operator(()reserved(define) ident(perl-info) operator(()ident(qx) operator(()ident(format) pre_constant(#f) string<delimiter(")content(ps ~A)delimiter(")> operator(()ident(getpid)operator(\))operator(\))operator(\))operator(\)) -operator(()reserved(define) ident(shell-info) operator(()ident(qx) string<delimiter(")content(ps $$)delimiter(")>operator(\))operator(\)) - -operator(()reserved(define) ident(banner) operator(')operator(()string<delimiter(")content(Costs)delimiter(")> string<delimiter(")content(only)delimiter(")> string<delimiter(")content($4.95)delimiter(")>operator(\))operator(\)) -operator(()reserved(define) ident(brax) operator(()ident(map) ident(string) operator(()ident(string->list) string<delimiter(")content((\)<>{}[])delimiter(")>operator(\))operator(\))operator(\)) -operator(()reserved(define) ident(rings) operator(()ident(string-tokenize) string<delimiter(")content(Nenya Narya Vilya)delimiter(")>operator(\))operator(\)) -operator(()reserved(define) ident(tags) operator(()ident(string-tokenize) string<delimiter(")content(LI TABLE TR TD A IMG H1 P)delimiter(")>operator(\))operator(\)) -operator(()reserved(define) ident(sample) - operator(()ident(string-tokenize) string<delimiter(")content(The vertical bar (|\) looks and behaves like a pipe.)delimiter(")>operator(\))operator(\)) -operator(()reserved(define) ident(ships) operator(')operator(()string<delimiter(")content(Niña)delimiter(")> string<delimiter(")content(Pinta)delimiter(")> string<delimiter(")content(Santa MarÃa)delimiter(")>operator(\))operator(\)) - -comment(;; @@PLEAC@@_4.2) -operator(()reserved(define) ident(array) operator(')operator(()string<delimiter(")content(red)delimiter(")> string<delimiter(")content(yellow)delimiter(")> string<delimiter(")content(green)delimiter(")>operator(\))operator(\)) - -operator(()reserved(begin) - operator(()ident(display) string<delimiter(")content(I have )delimiter(")>operator(\)) - operator(()ident(for-each) ident(display) ident(array)operator(\)) - operator(()ident(display) string<delimiter(")content( marbles.)content(\\n)delimiter(")>operator(\))operator(\)) -comment(;; I have redyellowgreen marbles.) - -operator(()reserved(begin) - operator(()ident(display) string<delimiter(")content(I have )delimiter(")>operator(\)) - operator(()ident(for-each) operator(()reserved(lambda) operator(()ident(colour)operator(\)) - operator(()ident(display) ident(colour)operator(\)) - operator(()ident(display) string<delimiter(")content( )delimiter(")>operator(\))operator(\)) - ident(array)operator(\)) - operator(()ident(display) string<delimiter(")content(marbles.)content(\\n)delimiter(")>operator(\))operator(\)) -comment(;; I have red yellow green marbles.) - -comment(;; commify - insertion of commas into list output) -operator(()reserved(define) operator(()ident(commify) ident(strings)operator(\)) - operator(()reserved(let) operator(()operator(()ident(len) operator(()ident(length) ident(strings)operator(\))operator(\))operator(\)) - operator(()reserved(case) ident(len) - operator(()operator(()integer(0)operator(\)) string<delimiter(")delimiter(")>operator(\)) - operator(()operator(()integer(1)operator(\)) operator(()ident(car) ident(strings)operator(\))operator(\)) - operator(()operator(()integer(2)operator(\)) operator(()ident(string-append) operator(()ident(car) ident(strings)operator(\)) string<delimiter(")content( and )delimiter(")> operator(()ident(cadr) ident(strings)operator(\))operator(\))operator(\)) - operator(()operator(()integer(3)operator(\)) operator(()ident(string-append) operator(()ident(car) ident(strings)operator(\)) string<delimiter(")content(, )delimiter(")> - operator(()ident(cadr) ident(strings)operator(\)) string<delimiter(")content(, and )delimiter(")> - operator(()ident(caddr) ident(strings)operator(\))operator(\))operator(\)) - operator(()ident(else) - operator(()ident(string-append) operator(()ident(car) ident(strings)operator(\)) string<delimiter(")content(, )delimiter(")> - operator(()ident(commify) operator(()ident(cdr) ident(strings)operator(\))operator(\))operator(\))operator(\))operator(\))operator(\))operator(\)) - -operator(()reserved(define) ident(lists) operator(')operator(()operator(()string<delimiter(")content(just one thing)delimiter(")>operator(\)) - operator(()string<delimiter(")content(Mutt)delimiter(")> string<delimiter(")content(Jeff)delimiter(")>operator(\)) - operator(()string<delimiter(")content(Peter)delimiter(")> string<delimiter(")content(Paul)delimiter(")> string<delimiter(")content(Mary)delimiter(")>operator(\)) - operator(()string<delimiter(")content(To our parents)delimiter(")> string<delimiter(")content(Mother Theresa)delimiter(")> string<delimiter(")content(God)delimiter(")>operator(\)) - operator(()string<delimiter(")content(pastrami)delimiter(")> string<delimiter(")content(ham and cheese)delimiter(")> string<delimiter(")content(peanut butter and jelly)delimiter(")> string<delimiter(")content(tuna)delimiter(")>operator(\)) - operator(()string<delimiter(")content(recycle tired, old phrases)delimiter(")> string<delimiter(")content(ponder big, happy thoughts)delimiter(")>operator(\)) - operator(()string<delimiter(")content(recycle tired, old phrases)delimiter(")> - string<delimiter(")content(ponder big, happy thoughts)delimiter(")> - string<delimiter(")content(sleep and dream peacefully)delimiter(")>operator(\))operator(\))operator(\)) - -operator(()ident(for-each) operator(()reserved(lambda) operator(()ident(list)operator(\)) - operator(()ident(display) string<delimiter(")content(The list is: )delimiter(")>operator(\)) - operator(()ident(display) operator(()ident(commify) ident(list)operator(\))operator(\)) - operator(()ident(display) string<delimiter(")content(.)content(\\n)delimiter(")>operator(\))operator(\)) - ident(lists)operator(\)) - -comment(;; The list is: just one thing.) -comment(;; The list is: Mutt and Jeff.) -comment(;; The list is: Peter, Paul, and Mary.) -comment(;; The list is: To our parents, Mother Theresa, and God.) -comment(;; The list is: pastrami, ham and cheese, peanut butter and jelly, and tuna.) -comment(;; The list is: recycle tired, old phrases and ponder big, happy thoughts.) -comment(;; The list is: recycle tired, old phrases, ponder big, happy thoughts, and sleep and dream peacefully.) - -comment(;; @@PLEAC@@_4.3) -comment(;;-----------------------------) - -comment(;; Scheme does not normally grow and shrink arrays in the way that) -comment(;; Perl can. The more usual operations are adding and removing from) -comment(;; the head of a list using the `cons' and `cdr' procedures.) -comment(;; However ...) -operator(()reserved(define) operator(()ident(grow/shrink) ident(list) ident(new-size)operator(\)) - operator(()reserved(let) operator(()operator(()ident(size) operator(()ident(length) ident(list)operator(\))operator(\))operator(\)) - operator(()reserved(cond) operator(()operator(()ident(<) ident(size) ident(new-size)operator(\)) - operator(()ident(grow/shrink) operator(()reserved(cons) string<delimiter(")delimiter(")> ident(list)operator(\)) ident(new-size)operator(\))operator(\)) - operator(()operator(()ident(>) ident(size) ident(new-size)operator(\)) - operator(()ident(grow/shrink) operator(()ident(cdr) ident(list)operator(\)) ident(new-size)operator(\))operator(\)) - operator(()ident(else) ident(list)operator(\))operator(\))operator(\))operator(\)) - -operator(()reserved(define) operator(()ident(element) ident(list) ident(i)operator(\)) - operator(()ident(list-ref) ident(list) operator(()ident(-) operator(()ident(length) ident(list)operator(\)) ident(i) integer(1)operator(\))operator(\))operator(\)) - -operator(()reserved(define) operator(()ident(set-element) ident(list) ident(i) ident(value)operator(\)) - operator(()reserved(if) operator(()ident(>=) ident(i) operator(()ident(length) ident(list)operator(\))operator(\)) - operator(()reserved(set!) ident(list) operator(()ident(grow/shrink) ident(list) operator(()ident(-) ident(i) integer(1)operator(\))operator(\))operator(\))operator(\)) - operator(()ident(set-car!) operator(()ident(list-cdr-ref) ident(list) operator(()ident(-) operator(()ident(length) ident(list)operator(\)) ident(i) integer(1)operator(\))operator(\))operator(\)) - ident(list)operator(\)) - -operator(()reserved(define) operator(()ident(what-about) ident(list)operator(\)) - operator(()reserved(let) operator(()operator(()ident(len) operator(()ident(length) ident(list)operator(\))operator(\))operator(\)) - operator(()ident(format) pre_constant(#t) string<delimiter(")content(The array now has ~A elements.)content(\\n)delimiter(")> ident(len)operator(\)) - operator(()ident(format) pre_constant(#t) string<delimiter(")content(The index of the last element is ~A.)content(\\n)delimiter(")> operator(()ident(-) ident(len) integer(1)operator(\))operator(\)) - operator(()ident(format) pre_constant(#t) string<delimiter(")content(Element #3 is `~A'.)content(\\n)delimiter(")> operator(()reserved(if) operator(()ident(>) ident(len) integer(3)operator(\)) - operator(()ident(element) ident(list) integer(3)operator(\)) - string<delimiter(")delimiter(")>operator(\))operator(\))operator(\))operator(\)) - -comment(;; In the emulation of Perl arrays implemented here, the elements are) -comment(;; in reverse order when compared to normal Scheme lists.) -operator(()reserved(define) ident(people) operator(()ident(reverse) operator(')operator(()string<delimiter(")content(Crosby)delimiter(")> string<delimiter(")content(Stills)delimiter(")> string<delimiter(")content(Nash)delimiter(")> string<delimiter(")content(Young)delimiter(")>operator(\))operator(\))operator(\)) -operator(()ident(what-about) ident(people)operator(\)) -comment(;;-----------------------------) -comment(;; The array now has 4 elements.) -comment(;; The index of the last element is 3.) -comment(;; Element #3 is `Young'.) -comment(;;-----------------------------) -operator(()reserved(set!) ident(people) operator(()ident(grow/shrink) ident(people) integer(3)operator(\))operator(\)) -operator(()ident(what-about) ident(people)operator(\)) -comment(;;-----------------------------) -comment(;; The array now has 3 elements.) -comment(;; The index of the last element is 2.) -comment(;; Element #3 is `'.) -comment(;;-----------------------------) -operator(()reserved(set!) ident(people) operator(()ident(grow/shrink) ident(people) integer(10001)operator(\))operator(\)) -operator(()ident(what-about) ident(people)operator(\)) -comment(;;-----------------------------) -comment(;; The array now has 10001 elements.) -comment(;; The index of the last element is 10000.) -comment(;; Element #3 is `'.) -comment(;;-----------------------------) - -comment(;; @@PLEAC@@_4.4) -comment(; Using a 'list' i.e. chain of pairs) -operator(()reserved(define) ident(*mylist*) operator(')operator(()integer(1) integer(2) integer(3)operator(\))operator(\)) - -comment(; Apply procedure to each member of 'mylist') -operator(()ident(for-each) - operator(()reserved(lambda) operator(()ident(item)operator(\)) operator(()ident(print) ident(item)operator(\))operator(\)) - ident(*mylist*)operator(\)) - -comment(;; ------------) - -comment(; Using a 'vector' i.e. one-dimensional array) -operator(()reserved(define) ident(*bad-users*) operator(')operator(#()string<delimiter(")content(lou)delimiter(")> string<delimiter(")content(mo)delimiter(")> string<delimiter(")content(sterling)delimiter(")> string<delimiter(")content(john)delimiter(")>operator(\))operator(\)) - -operator(()reserved(define) operator(()ident(complain) ident(user)operator(\)) - operator(()ident(print) string<delimiter(")content(You're a *bad user*,)delimiter(")> ident(user)operator(\))operator(\)) - -operator(()ident(array-for-each) - operator(()reserved(lambda) operator(()ident(user)operator(\)) operator(()ident(complain) ident(user)operator(\))operator(\)) - ident(*bad-users*)operator(\)) - -comment(;; ------------) - -comment(; Could probably get away with sorting a list of strings ...) -operator(()reserved(define) ident(*sorted-environ*) - operator(()ident(sort) operator(()ident(environ)operator(\)) ident(string<?)operator(\))operator(\)) - -operator(()ident(for-each) - operator(()reserved(lambda) operator(()ident(var)operator(\)) operator(()ident(display) ident(var)operator(\)) operator(()ident(newline)operator(\))operator(\)) - ident(*sorted-environ*)operator(\)) - -comment(;; ----) - -comment(; ... but the intent here is to sort a hash table, so we'll use) -comment(; an 'assoc', Scheme's native dictionary type, which is really) -comment(; nothing more than a list of conses / dotted pairs [hash tables) -comment(; will be used in later examples]) -operator(()reserved(define) operator(()ident(cons->env-string) ident(a)operator(\)) - operator(()ident(string-append) operator(()ident(car) ident(a)operator(\)) string<delimiter(")content(=)delimiter(")> operator(()ident(cdr) ident(a)operator(\))operator(\))operator(\)) - -operator(()reserved(define) operator(()ident(env-string->cons) ident(s)operator(\)) - operator(()reserved(let) operator(()operator(()ident(key-value) operator(()ident(string-split) ident(s) char(#\\=)operator(\))operator(\))operator(\)) - operator(()reserved(cons) operator(()ident(car) ident(key-value)operator(\)) operator(()ident(cadr) ident(key-value)operator(\))operator(\))operator(\))operator(\)) - -operator(()reserved(define) ident(*sorted-environ-assoc*) - operator(()ident(sort) - operator(()ident(map) - operator(()reserved(lambda) operator(()ident(var)operator(\)) operator(()ident(env-string->cons) ident(var)operator(\))operator(\)) - operator(()ident(environ)operator(\))operator(\)) - operator(()reserved(lambda) operator(()ident(left) ident(right)operator(\)) operator(()ident(string<?) operator(()ident(car) ident(left)operator(\)) operator(()ident(car) ident(right)operator(\))operator(\))operator(\)) operator(\))operator(\)) - -operator(()ident(for-each) - operator(()reserved(lambda) operator(()ident(var)operator(\)) - operator(()ident(print) operator(()ident(car) ident(var)operator(\)) string<delimiter(")content(=)delimiter(")> operator(()ident(cdr) ident(var)operator(\))operator(\))operator(\)) - ident(*sorted-environ-assoc*)operator(\)) - -comment(;; ----------------------------) - -operator(()reserved(define) ident(*MAX-QUOTA*) integer(100)operator(\)) - -operator(()reserved(define) operator(()ident(get-all-users)operator(\)) ident(...)operator(\)) -operator(()reserved(define) operator(()ident(get-usage) ident(user)operator(\)) ident(...)operator(\)) -operator(()reserved(define) operator(()ident(complain) ident(user)operator(\)) ident(...)operator(\)) - -operator(()ident(for-each) - operator(()reserved(lambda) operator(()ident(user)operator(\)) - operator(()reserved(let) operator(()operator(()ident(disk-usage) operator(()ident(get-usage) ident(user)operator(\))operator(\))operator(\)) - operator(()reserved(if) operator(()ident(>) ident(disk-usage) ident(*MAX-QUOTA*)operator(\)) - operator(()ident(complain) ident(user)operator(\))operator(\))operator(\))operator(\)) - operator(()ident(get-all-users)operator(\))operator(\)) - -comment(;; ----------------------------) - -operator(()ident(for-each) - operator(()reserved(lambda) operator(()ident(user)operator(\)) operator(()reserved(if) operator(()ident(string=?) ident(user) string<delimiter(")content(tchrist)delimiter(")>operator(\)) operator(()ident(print) ident(user)operator(\))operator(\))operator(\)) - operator(()ident(string-split) operator(()ident(qx) string<delimiter(")content(who|cut -d' ' -f1|uniq)delimiter(")>operator(\)) char(#\\newline)operator(\))operator(\)) - -comment(;; ----------------------------) - -operator(()ident(use-modules) operator(()ident(srfi) ident(srfi-13)operator(\)) operator(()ident(srfi) ident(srfi-14)operator(\))operator(\)) - -operator(()reserved(do) operator(()operator(()ident(line) operator(()ident(read-line)operator(\)) operator(()ident(read-line)operator(\))operator(\))operator(\)) - operator(()operator(()ident(eof-object?) ident(line)operator(\))operator(\)) - operator(()ident(for-each) - operator(()reserved(lambda) operator(()ident(word)operator(\)) operator(()ident(print) operator(()ident(string-reverse) ident(word)operator(\))operator(\))operator(\)) - operator(()ident(string-tokenize) ident(line) ident(char-set:graphic)operator(\))operator(\))operator(\)) - -comment(;; ----------------------------) - -comment(; Updates vector in-place [accepts variable number of vectors]) -comment(; See also the library function, 'array-map-in-order!' and its) -comment(; brethren) -operator(()reserved(define) operator(()ident(vector-map-in-order!) ident(proc) ident(vec) operator(.) ident(rest)operator(\)) - operator(()reserved(let) operator(()operator(()ident(all-vec) operator(()reserved(cons) ident(vec) ident(rest)operator(\))operator(\))operator(\)) - operator(()ident(for-each) - operator(()reserved(lambda) operator(()ident(vec)operator(\)) - operator(()reserved(let) operator(()operator(()ident(end) operator(()ident(vector-length) ident(vec)operator(\))operator(\))operator(\)) - operator(()reserved(let) ident(loop) operator(()operator(()ident(idx) integer(0)operator(\))operator(\)) - operator(()reserved(cond) - operator(()operator(()ident(=) ident(idx) ident(end)operator(\)) operator(')operator(()operator(\))operator(\)) - operator(()ident(else) - operator(()ident(vector-set!) ident(vec) ident(idx) operator(()ident(apply) ident(proc) operator(()ident(list) operator(()ident(vector-ref) ident(vec) ident(idx)operator(\))operator(\))operator(\))operator(\)) - operator(()ident(loop) operator(()ident(+) ident(idx) integer(1)operator(\))operator(\))operator(\))operator(\)) operator(\))operator(\))operator(\)) - ident(all-vec)operator(\))operator(\))operator(\)) - -comment(;; ----) - -comment(; A non-mutating version - illustration only, as library routines) -comment(; [SRFI-43 and built-ins] should be preferred) -operator(()reserved(define) operator(()ident(vector-map-in-order) ident(proc) ident(vec) operator(.) ident(rest)operator(\)) - operator(()reserved(let*) operator(()operator(()ident(all-vec) operator(()reserved(cons) ident(vec) ident(rest)operator(\))operator(\)) - operator(()ident(new-vec-len) operator(()ident(reduce) ident(+) integer(0) operator(()ident(map) ident(vector-length) ident(all-vec)operator(\))operator(\))operator(\)) - operator(()ident(new-vec) operator(()ident(make-vector) ident(new-vec-len)operator(\))operator(\)) - operator(()ident(new-vec-idx) integer(0)operator(\))operator(\)) - operator(()reserved(let) ident(loop) operator(()operator(()ident(all-vec) ident(all-vec)operator(\))operator(\)) - operator(()reserved(cond) - operator(()operator(()ident(=) ident(new-vec-idx) ident(new-vec-len)operator(\)) ident(new-vec)operator(\)) - operator(()ident(else) - operator(()ident(array-for-each) - operator(()reserved(lambda) operator(()ident(element)operator(\)) - operator(()ident(vector-set!) ident(new-vec) ident(new-vec-idx) operator(()ident(apply) ident(proc) operator(()ident(list) ident(element)operator(\))operator(\))operator(\)) - operator(()reserved(set!) ident(new-vec-idx) operator(()ident(+) ident(new-vec-idx) integer(1)operator(\))operator(\))operator(\)) - operator(()ident(car) ident(all-vec)operator(\))operator(\)) - operator(()ident(loop) operator(()ident(cdr) ident(all-vec)operator(\))operator(\)) operator(\))operator(\))operator(\)) operator(\))operator(\)) - -comment(;; ------------) - -operator(()reserved(define) ident(*array*) operator(')operator(#()integer(1) integer(2) integer(3)operator(\))operator(\)) - -operator(()ident(array-for-each) - operator(()reserved(lambda) operator(()ident(item)operator(\)) - operator(()ident(print) string<delimiter(")content(i =)delimiter(")> ident(item)operator(\))operator(\)) - ident(*array*)operator(\)) - -comment(;; ------------) - -operator(()reserved(define) ident(*array*) operator(')operator(#()integer(1) integer(2) integer(3)operator(\))operator(\)) - -operator(()ident(array-for-each) - operator(()reserved(lambda) operator(()ident(item)operator(\)) - operator(()ident(print) string<delimiter(")content(i =)delimiter(")> ident(item)operator(\))operator(\)) - ident(*array*)operator(\)) - -comment(; Since a 'vector' is mutable, in-place updates allowed) -operator(()ident(vector-map-in-order!) - operator(()reserved(lambda) operator(()ident(item)operator(\)) operator(()ident(-) ident(item) integer(1)operator(\))operator(\)) - ident(*array*)operator(\)) - -operator(()ident(print) ident(*array*)operator(\)) - -comment(;; ------------) - -operator(()reserved(define) ident(*a*) operator(')operator(#()integer(0.5) integer(3)operator(\))operator(\)) -operator(()reserved(define) ident(*b*) operator(')operator(#()integer(0) integer(1)operator(\))operator(\)) - -operator(()ident(vector-map-in-order!) - operator(()reserved(lambda) operator(()ident(item)operator(\)) operator(()ident(*) ident(item) integer(7)operator(\))operator(\)) - ident(*a*) ident(*b*)operator(\)) - -operator(()ident(print) ident(*a*) ident(*b*)operator(\)) - -comment(;; ----------------------------) - -comment(; Using 'for-each' to iterate over several container items is a) -comment(; simple matter of passing a list of those items e.g. a list of) -comment(; strings, or of arrays etc.) -comment(;) -comment(; However, complications arise when:) -comment(; * Heterogenous list of items e.g. list contains all of arrays,) -comment(; hashes, strings, etc. Necesitates different handling based on type) -comment(; * Item needs updating. It is not possible to alter the item reference) -comment(; and updating an item's internals is only possible if the relevant) -comment(; mutating procedures are implemented e.g. specified string characters) -comment(; may be altered in-place, but character deletion requires a new be) -comment(; created [i.e. altering the item reference], so is not possible) - -operator(()reserved(define) ident(*scalar*) string<delimiter(")content(123 )delimiter(")>operator(\)) -operator(()reserved(define) ident(*array*) operator(')operator(#()string<delimiter(")content( 123 )delimiter(")> string<delimiter(")content(456 )delimiter(")>operator(\))operator(\)) -operator(()reserved(define) ident(*hash*) operator(()ident(list) operator(()reserved(cons) string<delimiter(")content(key1)delimiter(")> string<delimiter(")content(123 )delimiter(")>operator(\)) operator(()reserved(cons) string<delimiter(")content(key2)delimiter(")> string<delimiter(")content( 456)delimiter(")>operator(\))operator(\))operator(\)) - -comment(; Illustrates iteration / handling of heterogenous types) -operator(()ident(for-each) - operator(()reserved(lambda) operator(()ident(item)operator(\)) - operator(()reserved(cond) - operator(()operator(()ident(string?) ident(item)operator(\)) operator(()ident(do-stuff-with-string) ident(item)operator(\))operator(\)) - operator(()operator(()ident(vector?) ident(item)operator(\)) operator(()ident(do-stuff-with-vector) ident(item)operator(\))operator(\)) - operator(()operator(()ident(pair?) ident(item)operator(\)) operator(()ident(do-stuff-with-hash) ident(item)operator(\))operator(\)) - operator(()ident(else) operator(()ident(print) string<delimiter(")content(unknown type)delimiter(")>operator(\))operator(\))operator(\))operator(\)) - operator(()ident(list) ident(*scalar*) ident(*array*) ident(*hash*)operator(\))operator(\)) - -comment(; So, for item-replacement-based updating you need to use explicit) -comment(; iteration e.g. 'do' loop, or recursion [as is done in the code for) -comment(; 'vector-map-in-order!'] - examples in next section. Or, you could) -comment(; create a new 'for-each' type control structure using Scheme's) -comment(; macro facility [example not shown]) - -comment(;; @@PLEAC@@_4.5) -operator(()reserved(define) ident(*array*) operator(')operator(#()integer(1) integer(2) integer(3)operator(\))operator(\)) - -comment(;; ----) - -comment(; Whilst a 'vector' is mutable, 'array-for-each' passes only a copy) -comment(; of each cell, thus there is no way to perform updates) -operator(()ident(array-for-each) - operator(()reserved(lambda) operator(()ident(item)operator(\)) - ident(...) reserved(do) ident(some) ident(non-array-mutating) ident(task) ident(with) operator(')ident(item)operator(')ident(...)operator(\)) - ident(*array*)operator(\)) - -comment(;; ------------) - -comment(; For mutating operations, use one of the mutating 'array-map-...' routines) -comment(; or the custom, 'vector-map-in-order!') -operator(()ident(vector-map-in-order!) - operator(()reserved(lambda) operator(()ident(item)operator(\)) - ident(...) reserved(do) ident(some) ident(array-mutating) ident(task) ident(with) operator(')ident(item)operator(')ident(...)operator(\)) - ident(*array*)operator(\)) - -comment(;; ------------) - -comment(; Alternatively, use 'do' to iterate over the array and directly update ) -operator(()reserved(let) operator(()operator(()ident(vector-length) operator(()ident(vector-length) ident(*array*)operator(\))operator(\))operator(\)) - operator(()reserved(do) operator(()operator(()ident(i) integer(0) operator(()ident(+) ident(i) integer(1)operator(\))operator(\))operator(\)) - operator(()operator(()ident(=) ident(i) ident(vector-length)operator(\))operator(\)) - ident(...) reserved(do) ident(some) ident(array-mutating) ident(task) ident(with) ident(current) ident(array) ident(element) ident(...)operator(\))operator(\)) - -comment(;; ------------) - -comment(; Alternatively, use a 'named let' to iterate over array and directly update ) -operator(()reserved(let) operator(()operator(()ident(vector-length) operator(()ident(vector-length) ident(*array*)operator(\))operator(\))operator(\)) - operator(()reserved(let) ident(loop) operator(()operator(()ident(i) integer(0)operator(\))operator(\)) - operator(()reserved(cond) - operator(()operator(()ident(=) ident(i) ident(vector-length)operator(\)) operator(')operator(()operator(\))operator(\)) - operator(()ident(else) - ident(...) reserved(do) ident(some) ident(array-mutating) ident(task) ident(with) ident(current) ident(array) ident(element) ident(...) - operator(()ident(loop) operator(()ident(+) ident(i) integer(1)operator(\))operator(\))operator(\))operator(\)) operator(\))operator(\)) - -comment(;; ----------------------------) - -operator(()reserved(define) ident(*fruits*) operator(')operator(#()string<delimiter(")content(Apple)delimiter(")> string<delimiter(")content(Blackberry)delimiter(")>operator(\))operator(\)) - -comment(;; ------------) - -operator(()ident(array-for-each) - operator(()reserved(lambda) operator(()ident(fruit)operator(\)) - operator(()ident(print) ident(fruit) string<delimiter(")content(tastes good in a pie.)delimiter(")>operator(\))operator(\)) - ident(*fruits*)operator(\)) - -comment(;; ------------) - -operator(()reserved(let) operator(()operator(()ident(vector-length) operator(()ident(vector-length) ident(*fruits*)operator(\))operator(\))operator(\)) - operator(()reserved(do) operator(()operator(()ident(i) integer(0) operator(()ident(+) ident(i) integer(1)operator(\))operator(\))operator(\)) - operator(()operator(()ident(=) ident(i) ident(vector-length)operator(\))operator(\)) - operator(()ident(print) operator(()ident(vector-ref) ident(*fruits*) ident(i)operator(\)) string<delimiter(")content(tastes good in a pie.)delimiter(")>operator(\)) operator(\))operator(\)) - -comment(;; ----------------------------) - -operator(()reserved(define) ident(*rogue-cats*) operator(')operator(()string<delimiter(")content(Blacky)delimiter(")> string<delimiter(")content(Ginger)delimiter(")> string<delimiter(")content(Puss)delimiter(")>operator(\))operator(\)) - -operator(()reserved(define) ident(*name-list*) operator(()ident(acons) operator(')ident(felines) ident(*rogue-cats*) operator(')operator(()operator(\))operator(\))operator(\)) - -comment(;; ------------) - -operator(()ident(for-each) - operator(()reserved(lambda) operator(()ident(cat)operator(\)) - operator(()ident(print) ident(cat) string<delimiter(")content(purrs hypnotically..)delimiter(")>operator(\))operator(\)) - operator(()ident(cdr) operator(()ident(assoc) operator(')ident(felines) ident(*name-list*)operator(\))operator(\))operator(\)) - -comment(;; ------------) - -operator(()reserved(let) ident(loop) operator(()operator(()ident(felines) operator(()ident(cdr) operator(()ident(assoc) operator(')ident(felines) ident(*name-list*)operator(\))operator(\))operator(\))operator(\)) - operator(()reserved(cond) - operator(()operator(()ident(null?) ident(felines)operator(\)) operator(')operator(()operator(\))operator(\)) - operator(()ident(else) - operator(()ident(print) operator(()ident(car) ident(felines)operator(\)) string<delimiter(")content(purrs hypnotically..)delimiter(")>operator(\)) - operator(()ident(loop) operator(()ident(cdr) ident(felines)operator(\))operator(\))operator(\))operator(\))operator(\)) - -comment(;; @@PLEAC@@_4.6) -operator(()ident(use-modules) operator(()ident(srfi) ident(srfi-1)operator(\))operator(\)) - -comment(; Simplest [read: least code] means of removing duplicates is to use ) -comment(; SRFI-1's 'delete-duplicates' routine) - -operator(()reserved(define) ident(*non-uniq-num-list*) operator(')operator(()integer(1) integer(2) integer(3) integer(1) integer(2) integer(3)operator(\))operator(\)) -operator(()reserved(define) ident(*uniq*) operator(()ident(delete-duplicates) ident(*my-non-uniq-num-list*)operator(\)) - -comment(;; ------------) - -operator(()ident(use-modules) operator(()ident(srfi) ident(srfi-1)operator(\))operator(\)) - -comment(; Another simple alternative is to use SRFI-1's 'lset-union' routine. In) -comment(; general, the 'lset-...' routines:) -comment(; - convenient, but not fast; probably best avoided for 'large' sets) -comment(; - operate on standard lists, so simple matter of type-converting arrays and such) -comment(; - care needs to be taken in choosing the needed equality function) - -operator(()reserved(define) ident(*non-uniq-string-list*) operator(')operator(()string<delimiter(")content(abc)delimiter(")> string<delimiter(")content(def)delimiter(")> string<delimiter(")content(ghi)delimiter(")> string<delimiter(")content(abc)delimiter(")> string<delimiter(")content(def)delimiter(")> string<delimiter(")content(ghi)delimiter(")>operator(\))operator(\)) -operator(()reserved(define) ident(*uniq*) operator(()ident(lset-union) ident(string=?) ident(*non-uniq-string-list*) ident(*non-uniq-string-list*)operator(\))operator(\)) - -comment(;; ----) - -operator(()reserved(define) ident(*non-uniq-sym-list*) operator(')operator(()operator(')ident(a) operator(')ident(b) operator(')ident(c) operator(')ident(a) operator(')ident(b) operator(')ident(c)operator(\))operator(\)) -operator(()reserved(define) ident(*uniq*) operator(()ident(lset-union) ident(equal?) ident(*my-non-uniq-sym-list*) ident(*my-non-uniq-sym-list*)operator(\))operator(\)) - -comment(;; ----) - -operator(()reserved(define) ident(*non-uniq-num-list*) operator(')operator(()integer(1) integer(2) integer(3) integer(1) integer(2) integer(3)operator(\))operator(\)) -operator(()reserved(define) ident(*uniq*) operator(()ident(lset-union) ident(=) ident(*my-non-uniq-num-list*) ident(*my-non-uniq-num-list*)operator(\))operator(\)) - -comment(;; ----------------------------) - -comment(;; Perl Cookbook-based examples - illustrative only, *not* recommended approaches) - -operator(()ident(use-modules) operator(()ident(srfi) ident(srfi-1)operator(\))operator(\)) - -operator(()reserved(define) ident(*list*) operator(')operator(()integer(1) integer(2) integer(3) integer(1) integer(2) integer(7) integer(8) integer(1) integer(8) integer(2) integer(1) integer(3)operator(\))operator(\)) -operator(()reserved(define) ident(*seen*) operator(')operator(()operator(\))operator(\)) - -comment(; Use hash to filter out unique items) -operator(()ident(for-each) - operator(()reserved(lambda) operator(()ident(item)operator(\)) - operator(()reserved(if) operator(()ident(not) operator(()ident(assoc-ref) ident(*seen*) ident(item)operator(\))operator(\)) - operator(()reserved(set!) ident(*seen*) operator(()ident(assoc-set!) ident(*seen*) ident(item) pre_constant(#t)operator(\))operator(\))operator(\))operator(\)) - ident(*list*)operator(\)) - -comment(; Generate list of unique items) -operator(()reserved(define) ident(*uniq*) - operator(()ident(fold-right) - operator(()reserved(lambda) operator(()ident(pair) ident(accum)operator(\)) operator(()reserved(cons) operator(()ident(car) ident(pair)operator(\)) ident(accum)operator(\))operator(\)) - operator(')operator(()operator(\)) - ident(*seen*)operator(\))operator(\)) - -comment(;; ------------) - -operator(()reserved(define) ident(*list*) operator(')operator(()integer(1) integer(2) integer(3) integer(1) integer(2) integer(7) integer(8) integer(1) integer(8) integer(2) integer(1) integer(3)operator(\))operator(\)) -operator(()reserved(define) ident(*seen*) operator(')operator(()operator(\))operator(\)) - -comment(; Build list of unique items by checking set membership) -operator(()ident(for-each) - operator(()reserved(lambda) operator(()ident(item)operator(\)) - operator(()reserved(if) operator(()ident(not) operator(()ident(member) ident(item) ident(*seen*)operator(\))operator(\)) - operator(()reserved(set!) ident(*seen*) operator(()reserved(cons) ident(item) ident(*seen*)operator(\))operator(\))operator(\))operator(\)) - ident(*list*)operator(\)) - -comment(;; ------------) - -operator(()reserved(define) ident(*users*) - operator(()ident(sort) - operator(()ident(string-split) operator(()ident(qx) string<delimiter(")content(who|cut -d' ' -f1)delimiter(")>operator(\)) char(#\\newline)operator(\)) - ident(string<?)operator(\))operator(\)) - -operator(()reserved(define) ident(*seen*) operator(')operator(()operator(\))operator(\)) - -comment(; Build list of unique users by checking set membership) -operator(()ident(for-each) - operator(()reserved(lambda) operator(()ident(user)operator(\)) - operator(()reserved(if) operator(()ident(not) operator(()ident(member) ident(user) ident(*seen*)operator(\))operator(\)) - operator(()reserved(set!) ident(*seen*) operator(()reserved(cons) ident(item) ident(*seen*)operator(\))operator(\))operator(\))operator(\)) - ident(*list*)operator(\)) - -comment(;; @@PLEAC@@_4.7) -comment(; All problems in this section involve, at core, set difference) -comment(; operations. Thus, the most compact and straightforward approach is) -comment(; to utilise SRFI-1's 'lset-difference' routine) - -operator(()ident(use-modules) operator(()ident(srfi) ident(srfi-1)operator(\))operator(\)) - -operator(()reserved(define) ident(*a*) operator(')operator(()integer(1) integer(3) integer(5) integer(6) integer(7) integer(8)operator(\))operator(\)) -operator(()reserved(define) ident(*b*) operator(')operator(()integer(2) integer(3) integer(5) integer(7) integer(9)operator(\))operator(\)) - -comment(; *difference* contains elements in *a* but not in *b*: 1 6 8) -operator(()reserved(define) ident(*difference*) operator(()ident(lset-difference) ident(=) ident(*a*) ident(*b*)operator(\))operator(\)) - -comment(; *difference* contains elements in *b* but not in *a*: 2 9) -operator(()reserved(set!) ident(*difference*) operator(()ident(lset-difference) ident(=) ident(*b*) ident(*a*)operator(\))operator(\)) - -comment(;; ----------------------------) - -comment(;; Perl Cookbook-based example - illustrative only, *not* recommended approaches) - -operator(()ident(use-modules) operator(()ident(srfi) ident(srfi-1)operator(\))operator(\)) - -operator(()reserved(define) ident(*a*) operator(')operator(()integer(1) integer(3) integer(5) integer(6) integer(7) integer(8)operator(\))operator(\)) -operator(()reserved(define) ident(*b*) operator(')operator(()integer(2) integer(3) integer(5) integer(7) integer(9)operator(\))operator(\)) - -operator(()reserved(define) ident(*a-only*) operator(')operator(()operator(\))operator(\)) - -comment(; Build list of items in *a* but not in *b*) -operator(()ident(for-each) - operator(()reserved(lambda) operator(()ident(item)operator(\)) - operator(()reserved(if) operator(()ident(not) operator(()ident(member) ident(item) ident(*b*)operator(\))operator(\)) - operator(()reserved(set!) ident(*a-only*) operator(()reserved(cons) ident(item) ident(*a-only*)operator(\))operator(\))operator(\))operator(\)) - ident(*a*)operator(\)) - -comment(;; @@PLEAC@@_4.8) -comment(; The SRFI-1 'lset-xxx' routines are appropriate here) - -operator(()ident(use-modules) operator(()ident(srfi) ident(srfi-1)operator(\))operator(\)) - -operator(()reserved(define) ident(*a*) operator(')operator(()integer(1) integer(3) integer(5) integer(6) integer(7) integer(8)operator(\))operator(\)) -operator(()reserved(define) ident(*b*) operator(')operator(()integer(2) integer(3) integer(5) integer(7) integer(9)operator(\))operator(\)) - -comment(; Combined elements of *a* and *b* sans duplicates: 1 2 3 5 6 7 8 9) -operator(()reserved(define) ident(*union*) operator(()ident(lset-union) ident(=) ident(*a*) ident(*b*)operator(\))operator(\)) - -comment(; Elements common to both *a* and *b*: 3 5 7) -operator(()reserved(define) ident(*intersection*) operator(()ident(lset-intersection) ident(=) ident(*a*) ident(*b*)operator(\))operator(\)) - -comment(; Elements in *a* but not in *b*: 1 6 8) -operator(()reserved(define) ident(*difference*) operator(()ident(lset-difference) ident(=) ident(*a*) ident(*b*)operator(\))operator(\)) - -comment(;; ----------------------------) - -comment(;; Perl Cookbook-based example - illustrative only, *not* recommended approaches) - -operator(()ident(use-modules) operator(()ident(srfi) ident(srfi-1)operator(\))operator(\)) - -operator(()reserved(define) ident(*a*) operator(')operator(()integer(1) integer(3) integer(5) integer(6) integer(7) integer(8)operator(\))operator(\)) -operator(()reserved(define) ident(*b*) operator(')operator(()integer(2) integer(3) integer(5) integer(7) integer(9)operator(\))operator(\)) - -operator(()reserved(define) ident(*union*) operator(')operator(()operator(\))operator(\)) -operator(()reserved(define) ident(*isect*) operator(')operator(()operator(\))operator(\)) -operator(()reserved(define) ident(*diff*) operator(')operator(()operator(\))operator(\)) - -comment(;; ------------) - -comment(; Union and intersection) -operator(()ident(for-each) - operator(()reserved(lambda) operator(()ident(item)operator(\)) operator(()reserved(set!) ident(*union*) operator(()ident(assoc-set!) ident(*union*) ident(item) pre_constant(#t)operator(\))operator(\))operator(\)) - ident(*a*)operator(\)) - -operator(()ident(for-each) - operator(()reserved(lambda) operator(()ident(item)operator(\)) - operator(()reserved(if) operator(()ident(assoc-ref) ident(*union*) ident(item)operator(\)) - operator(()reserved(set!) ident(*isect*) operator(()ident(assoc-set!) ident(*isect*) ident(item) pre_constant(#t)operator(\))operator(\))operator(\)) - operator(()reserved(set!) ident(*union*) operator(()ident(assoc-set!) ident(*union*) ident(item) pre_constant(#t)operator(\))operator(\))operator(\)) - ident(*b*)operator(\)) - -comment(; Difference *a* and *b*) -operator(()ident(for-each) - operator(()reserved(lambda) operator(()ident(item)operator(\)) - operator(()reserved(if) operator(()ident(not) operator(()ident(assoc-ref) ident(*isect*) ident(item)operator(\))operator(\)) - operator(()reserved(set!) ident(*diff*) operator(()ident(assoc-set!) ident(*diff*) ident(item) pre_constant(#t)operator(\))operator(\))operator(\))operator(\)) - ident(*a*)operator(\)) - -operator(()reserved(set!) ident(*union*) - operator(()ident(fold) - operator(()reserved(lambda) operator(()ident(pair) ident(accum)operator(\)) operator(()reserved(cons) operator(()ident(car) ident(pair)operator(\)) ident(accum)operator(\))operator(\)) - operator(')operator(()operator(\)) - ident(*union*)operator(\))operator(\)) - -operator(()reserved(set!) ident(*isect*) - operator(()ident(fold) - operator(()reserved(lambda) operator(()ident(pair) ident(accum)operator(\)) operator(()reserved(cons) operator(()ident(car) ident(pair)operator(\)) ident(accum)operator(\))operator(\)) - operator(')operator(()operator(\)) - ident(*isect*)operator(\))operator(\)) - -operator(()reserved(set!) ident(*diff*) - operator(()ident(fold) - operator(()reserved(lambda) operator(()ident(pair) ident(accum)operator(\)) operator(()reserved(cons) operator(()ident(car) ident(pair)operator(\)) ident(accum)operator(\))operator(\)) - operator(')operator(()operator(\)) - ident(*diff*)operator(\))operator(\)) - -operator(()ident(print) string<delimiter(")content(Union count: )delimiter(")> operator(()ident(length) ident(*union*)operator(\))operator(\)) -operator(()ident(print) string<delimiter(")content(Intersection count:)delimiter(")> operator(()ident(length) ident(*isect*)operator(\))operator(\)) -operator(()ident(print) string<delimiter(")content(Difference count: )delimiter(")> operator(()ident(length) ident(*diff*)operator(\))operator(\)) - -comment(;; @@PLEAC@@_4.9) -comment(; Arrays, specifically vectors in the current context, are fixed-size) -comment(; entities; joining several such together requires copying of their) -comment(; contents into a new, appropriately-sized, array. This task may be) -comment(; performed:) - -comment(; * Directly: loop through existing arrays copying elements into a) -comment(; newly-created array) - -operator(()reserved(define) operator(()ident(vector-join) ident(vec) operator(.) ident(rest)operator(\)) - operator(()reserved(let*) operator(()operator(()ident(all-vec) operator(()reserved(cons) ident(vec) ident(rest)operator(\))operator(\)) - operator(()ident(new-vec-len) operator(()ident(reduce) ident(+) integer(0) operator(()ident(map) ident(vector-length) ident(all-vec)operator(\))operator(\))operator(\)) - operator(()ident(new-vec) operator(()ident(make-vector) ident(new-vec-len)operator(\))operator(\)) - operator(()ident(new-vec-idx) integer(0)operator(\))operator(\)) - operator(()reserved(let) ident(loop) operator(()operator(()ident(all-vec) ident(all-vec)operator(\))operator(\)) - operator(()reserved(cond) - operator(()operator(()ident(=) ident(new-vec-idx) ident(new-vec-len)operator(\)) ident(new-vec)operator(\)) - operator(()ident(else) - operator(()ident(array-for-each) - operator(()reserved(lambda) operator(()ident(element)operator(\)) - operator(()ident(vector-set!) ident(new-vec) ident(new-vec-idx) ident(element)operator(\)) - operator(()reserved(set!) ident(new-vec-idx) operator(()ident(+) ident(new-vec-idx) integer(1)operator(\))operator(\))operator(\)) - operator(()ident(car) ident(all-vec)operator(\))operator(\)) - operator(()ident(loop) operator(()ident(cdr) ident(all-vec)operator(\))operator(\)) operator(\))operator(\))operator(\)) operator(\))operator(\)) - -comment(;; ----) - -operator(()reserved(define) ident(*array1*) operator(')operator(#()integer(1) integer(2) integer(3)operator(\))operator(\)) -operator(()reserved(define) ident(*array2*) operator(')operator(#()integer(4) integer(5) integer(6)operator(\))operator(\)) - -operator(()reserved(define) ident(*newarray*) - operator(()ident(vector-join) ident(*array1*) ident(*array2*)operator(\))operator(\)) - -comment(;; ----------------------------) - -comment(; * Indirectly; convert arrays to lists, append the lists, convert) -comment(; resulting list back into an array) - -operator(()reserved(define) ident(*array1*) operator(')operator(#()integer(1) integer(2) integer(3)operator(\))operator(\)) -operator(()reserved(define) ident(*array2*) operator(')operator(#()integer(4) integer(5) integer(6)operator(\))operator(\)) - -operator(()reserved(define) ident(*newarray*) - operator(()ident(list->vector) operator(()ident(append) operator(()ident(vector->list) ident(*array1*)operator(\)) operator(()ident(vector->list) ident(*array2*)operator(\))operator(\)) operator(\))operator(\)) - -comment(; Of course if random access is not required, it is probably best to simply) -comment(; use lists since a wealth of list manipulation routines are available) - -comment(;; ----------------------------) - -comment(; While Perl offers an all-purpose 'splice' routine, a cleaner approach is) -comment(; to separate out such functionality; here three routines are implemented) -comment(; together offering an equivalent to 'splice'. The routines are:) -comment(; * vector-replace! [use with 'vector-copy' to avoid changing original]) -comment(; e.g. (vector-replace! vec ...\)) -comment(; (set! new-vec (vector-replace! (vector-copy vec\) ...\)\)) -comment(; * vector-delete) -comment(; * vector-insert) - -operator(()reserved(define) operator(()ident(vector-replace!) ident(vec) ident(pos) ident(item) operator(.) ident(rest)operator(\)) - operator(()reserved(let*) operator(()operator(()ident(all-items) operator(()reserved(cons) ident(item) ident(rest)operator(\))operator(\)) - operator(()ident(pos) operator(()reserved(if) operator(()ident(<) ident(pos) integer(0)operator(\)) operator(()ident(+) operator(()ident(vector-length) ident(vec)operator(\)) ident(pos)operator(\)) ident(pos)operator(\))operator(\)) - operator(()ident(in-bounds) - operator(()ident(not) operator(()ident(>) operator(()ident(+) ident(pos) operator(()ident(length) ident(all-items)operator(\))operator(\)) operator(()ident(vector-length) ident(vec)operator(\))operator(\))operator(\))operator(\))operator(\)) - operator(()reserved(if) ident(in-bounds) - operator(()reserved(let) ident(loop) operator(()operator(()ident(i) ident(pos)operator(\)) operator(()ident(all-items) ident(all-items)operator(\))operator(\)) - operator(()reserved(cond) - operator(()operator(()ident(null?) ident(all-items)operator(\)) ident(vec)operator(\)) - operator(()ident(else) - operator(()ident(vector-set!) ident(vec) ident(i) operator(()ident(car) ident(all-items)operator(\))operator(\)) - operator(()ident(loop) operator(()ident(+) ident(i) integer(1)operator(\)) operator(()ident(cdr) ident(all-items)operator(\))operator(\))operator(\)) operator(\))operator(\)) - comment(;else) - ident(vec)operator(\))operator(\))operator(\)) - -operator(()reserved(define) operator(()ident(vector-delete) ident(vec) ident(pos) ident(len)operator(\)) - operator(()reserved(let*) operator(()operator(()ident(new-vec-len) operator(()ident(-) operator(()ident(vector-length) ident(vec)operator(\)) ident(len)operator(\))operator(\)) - operator(()ident(new-vec) pre_constant(#f)operator(\)) - operator(()ident(pos) operator(()reserved(if) operator(()ident(<) ident(pos) integer(0)operator(\)) operator(()ident(+) operator(()ident(vector-length) ident(vec)operator(\)) ident(pos)operator(\)) ident(pos)operator(\))operator(\))operator(\)) - operator(()reserved(cond) - operator(()operator(()ident(<) ident(new-vec-len) integer(0)operator(\)) ident(vec)operator(\)) - operator(()ident(else) - operator(()reserved(set!) ident(new-vec) operator(()ident(make-vector) ident(new-vec-len)operator(\))operator(\)) - operator(()reserved(let) ident(loop) operator(()operator(()ident(vec-idx) integer(0)operator(\)) operator(()ident(new-vec-idx) integer(0)operator(\))operator(\)) - operator(()reserved(cond) - operator(()operator(()ident(=) ident(new-vec-idx) ident(new-vec-len)operator(\)) ident(new-vec)operator(\)) - operator(()ident(else) - operator(()reserved(if) operator(()ident(=) ident(vec-idx) ident(pos)operator(\)) operator(()reserved(set!) ident(vec-idx) operator(()ident(+) ident(vec-idx) ident(len)operator(\))operator(\))operator(\)) - operator(()ident(vector-set!) ident(new-vec) ident(new-vec-idx) operator(()ident(vector-ref) ident(vec) ident(vec-idx)operator(\))operator(\)) - operator(()ident(loop) operator(()ident(+) ident(vec-idx) integer(1)operator(\)) operator(()ident(+) ident(new-vec-idx) integer(1)operator(\))operator(\)) operator(\))operator(\))operator(\)) operator(\))operator(\)) operator(\))operator(\)) - -comment(; This routine would probably benefit from having 'cmd' implemented as a keyword) -comment(; argument. However, 'cmd' implemented as a positional to keep example simple) -operator(()reserved(define) operator(()ident(vector-insert) ident(vec) ident(pos) ident(cmd) ident(item) operator(.) ident(rest)operator(\)) - operator(()reserved(let*) operator(()operator(()ident(all-item-vec) operator(()ident(list->array) integer(1) operator(()reserved(cons) ident(item) ident(rest)operator(\))operator(\))operator(\)) - operator(()ident(all-item-vec-len) operator(()ident(vector-length) ident(all-item-vec)operator(\))operator(\)) - operator(()ident(vec-len) operator(()ident(vector-length) ident(vec)operator(\))operator(\)) - operator(()ident(new-vec) operator(()ident(make-vector) operator(()ident(+) ident(vec-len) ident(all-item-vec-len)operator(\))operator(\))operator(\)) - operator(()ident(pos) operator(()reserved(if) operator(()ident(<) ident(pos) integer(0)operator(\)) operator(()ident(+) operator(()ident(vector-length) ident(vec)operator(\)) ident(pos)operator(\)) ident(pos)operator(\))operator(\))operator(\)) - operator(()reserved(if) operator(()ident(eq?) ident(cmd) operator(')ident(after)operator(\)) operator(()reserved(set!) ident(pos) operator(()ident(+) ident(pos) integer(1)operator(\))operator(\))operator(\)) - operator(()ident(vector-move-left!) ident(vec) integer(0) ident(pos) ident(new-vec) integer(0)operator(\)) - operator(()ident(vector-move-left!) ident(all-item-vec) integer(0) ident(all-item-vec-len) ident(new-vec) ident(pos)operator(\)) - operator(()ident(vector-move-left!) ident(vec) ident(pos) ident(vec-len) ident(new-vec) operator(()ident(+) ident(pos) ident(all-item-vec-len)operator(\))operator(\)) - ident(new-vec)operator(\))operator(\)) - -comment(;; ----) - -operator(()reserved(define) ident(*members*) operator(')operator(#()string<delimiter(")content(Time)delimiter(")> string<delimiter(")content(Flies)delimiter(")>operator(\))operator(\)) -operator(()reserved(define) ident(*initiates*) operator(')operator(#()string<delimiter(")content(An)delimiter(")> string<delimiter(")content(Arrow)delimiter(")>operator(\))operator(\)) - -operator(()reserved(set!) ident(*members*) operator(()ident(vector-join) ident(*members*) ident(*initiates*)operator(\))operator(\)) - -comment(;; ------------) - -operator(()reserved(set!) ident(*members*) operator(()ident(vector-insert) ident(*members*) integer(1) operator(')ident(after) string<delimiter(")content(Like)delimiter(")> ident(*initiates*)operator(\))operator(\)) -operator(()ident(print) ident(*members*)operator(\)) - -operator(()reserved(set!) ident(*members*) operator(()ident(vector-replace) ident(*members*) integer(0) string<delimiter(")content(Fruit)delimiter(")>operator(\))operator(\)) -operator(()reserved(set!) ident(*members*) operator(()ident(vector-replace) ident(*members*) ident(-)integer(2) string<delimiter(")content(A)delimiter(")> string<delimiter(")content(Banana)delimiter(")>operator(\))operator(\)) -operator(()ident(print) ident(*members*)operator(\)) - -comment(; was: '#("Time" "Flies" "An" "Arrow"\)) -comment(; now: '#("Fruit" "Flies" "Like" "A" "Banana"\)) - -comment(;; @@PLEAC@@_4.10) -comment(; As for appending arrays, there is the choice of iterating through) -comment(; the array:) -operator(()reserved(define) operator(()ident(vector-reverse!) ident(vec)operator(\)) - operator(()reserved(let) ident(loop) operator(()operator(()ident(i) integer(0)operator(\)) operator(()ident(j) operator(()ident(-) operator(()ident(vector-length) ident(vec)operator(\)) integer(1)operator(\))operator(\))operator(\)) - operator(()reserved(cond) - operator(()operator(()ident(>=) ident(i) ident(j)operator(\)) ident(vec)operator(\)) - operator(()ident(else) - operator(()ident(vector-ref-swap!) ident(vec) ident(i) ident(j)operator(\)) - operator(()ident(loop) operator(()ident(+) ident(i) integer(1)operator(\)) operator(()ident(-) ident(j) integer(1)operator(\))operator(\))operator(\))operator(\)) operator(\))operator(\)) - -comment(;; ------------) - -operator(()reserved(define) ident(*array*) operator(')operator(#()integer(1) integer(2) integer(3)operator(\))operator(\)) - -operator(()ident(vector-reverse!) ident(*array*)operator(\)) - -comment(;; ------------) - -operator(()reserved(define) ident(*array*) operator(')operator(#()integer(1) integer(2) integer(3)operator(\))operator(\)) - -operator(()reserved(do) operator(()operator(()ident(i) operator(()ident(-) operator(()ident(vector-length) ident(*array*)operator(\)) integer(1)operator(\)) operator(()ident(-) ident(i) integer(1)operator(\))operator(\))operator(\)) - operator(()operator(()ident(<) ident(i) integer(0)operator(\))operator(\)) - ident(...) reserved(do) ident(something) ident(with) ident(*array*) ident(...)operator(\)) - -comment(;; ----------------------------) - -comment(; or of converting to / from a list, performing any manipulation using) -comment(; the list routines) - -operator(()reserved(define) ident(*array*) operator(')operator(#()integer(1) integer(2) integer(3)operator(\))operator(\)) - -operator(()reserved(define) ident(*newarray*) - operator(()ident(list->vector) operator(()ident(reverse) operator(()ident(sort) operator(()ident(vector->list) ident(*array*)operator(\)) ident(<)operator(\))operator(\)) operator(\))operator(\)) - -comment(;; @@PLEAC@@_4.11) -operator(()reserved(define) ident(*array*) operator(')operator(#()integer(1) integer(2) integer(3) integer(4) integer(5) integer(6) integer(7) integer(8)operator(\))operator(\)) - -comment(;; ------------) - -comment(; Remove first 3 elements) -operator(()reserved(define) ident(*front*) operator(()ident(vector-delete) ident(*array*) integer(0) integer(3)operator(\))operator(\)) - -comment(; Remove last 3 elements) -operator(()reserved(define) ident(*end*) operator(()ident(vector-delete) ident(*array*) ident(-)integer(1) integer(3)operator(\))operator(\)) - -comment(;; ----------------------------) - -comment(; Another helper routine) -operator(()reserved(define) operator(()ident(vector-slice) ident(vec) ident(pos) ident(len)operator(\)) - operator(()reserved(let*) operator(()operator(()ident(vec-len) operator(()ident(vector-length) ident(vec)operator(\))operator(\)) - operator(()ident(pos) operator(()reserved(if) operator(()ident(<) ident(pos) integer(0)operator(\)) operator(()ident(+) ident(vec-len) ident(pos)operator(\)) ident(pos)operator(\))operator(\)) - operator(()ident(in-bounds) - operator(()ident(not) operator(()ident(>) operator(()ident(+) ident(pos) ident(len)operator(\)) ident(vec-len)operator(\))operator(\))operator(\))operator(\)) - operator(()reserved(if) ident(in-bounds) - operator(()reserved(let) operator(()operator(()ident(new-vec) operator(()ident(make-vector) ident(len)operator(\))operator(\))operator(\)) - operator(()reserved(let) ident(loop) operator(()operator(()ident(vec-idx) ident(pos)operator(\)) operator(()ident(new-vec-idx) integer(0)operator(\))operator(\)) - operator(()reserved(cond) - operator(()operator(()ident(=) ident(new-vec-idx) ident(len)operator(\)) ident(new-vec)operator(\)) - operator(()ident(else) - operator(()ident(vector-set!) ident(new-vec) ident(new-vec-idx) operator(()ident(vector-ref) ident(vec) ident(vec-idx)operator(\))operator(\)) - operator(()ident(loop) operator(()ident(+) ident(vec-idx) integer(1)operator(\)) operator(()ident(+) ident(new-vec-idx) integer(1)operator(\))operator(\))operator(\)) operator(\))operator(\))operator(\)) - comment(;else) - ident(vec)operator(\))operator(\))operator(\)) - -comment(; Both the following use, 'values', to return two values; this approach) -comment(; is quite contrived and is taken to mimic the Perl examples, not) -comment(; because it is a recommended one [returning a single list would probably) -comment(; be more sensible]) -operator(()reserved(define) operator(()ident(shift2) ident(vec)operator(\)) - operator(()reserved(let) operator(()operator(()ident(vec) operator(()ident(vector-slice) ident(vec) integer(0) integer(2)operator(\))operator(\))operator(\)) - operator(()ident(values) operator(()ident(vector-ref) ident(vec) integer(0)operator(\)) operator(()ident(vector-ref) ident(vec) integer(1)operator(\))operator(\)) operator(\))operator(\)) - -operator(()reserved(define) operator(()ident(pop2) ident(vec)operator(\)) - operator(()reserved(let) operator(()operator(()ident(vec) operator(()ident(vector-slice) ident(vec) ident(-)integer(1) integer(2)operator(\))operator(\))operator(\)) - operator(()ident(values) operator(()ident(vector-ref) ident(vec) integer(0)operator(\)) operator(()ident(vector-ref) ident(vec) integer(1)operator(\))operator(\)) operator(\))operator(\)) - -comment(;; ------------) - -operator(()reserved(define) ident(*friends*) operator(')operator(#()operator(')ident(Peter) operator(')ident(Paul) operator(')ident(Mary) operator(')ident(Jim) operator(')ident(Tim)operator(\))operator(\)) - -operator(()ident(let-values) operator(() operator(()operator(()ident(this) ident(that)operator(\)) operator(()ident(shift2) ident(*friends*)operator(\))operator(\)) operator(\)) - operator(()ident(print) ident(this) string<delimiter(")content(:)delimiter(")> ident(that)operator(\))operator(\)) - -comment(;; ------------) - -operator(()reserved(define) ident(*beverages*) operator(')operator(#()operator(')ident(Dew) operator(')ident(Jolt) operator(')ident(Cola) operator(')ident(Sprite) operator(')ident(Fresca)operator(\))operator(\)) - -operator(()ident(let-values) operator(() operator(()operator(()ident(d1) ident(d2)operator(\)) operator(()ident(pop2) ident(*beverages*)operator(\))operator(\)) operator(\)) - operator(()ident(print) ident(d1) string<delimiter(")content(:)delimiter(")> ident(d2)operator(\))operator(\)) - -comment(;; @@PLEAC@@_4.12) -comment(; SRFI-1 [list manipulation] routines are ideal for the types of task) -comment(; in this and the next section, in particular, 'for-each' and 'find',) -comment(; 'list-index', and many others for more specialist functions. The same) -comment(; applies to vectors with the SRFI-43 routines, 'vector-index' and) -comment(; 'vector-skip', though the approach taken in this chapter has been to) -comment(; implement functionally similar vector manipulation routines to more) -comment(; closely mimic the Perl examples) - -comment(; Return #f, or first index for which 'pred' returns true) -operator(()reserved(define) operator(()ident(vector-first-idx) ident(pred) ident(vec)operator(\)) - operator(()reserved(let) operator(()operator(()ident(vec-len) operator(()ident(vector-length) ident(vec)operator(\))operator(\))operator(\)) - operator(()reserved(let) ident(loop) operator(()operator(()ident(idx) integer(0)operator(\))operator(\)) - operator(()reserved(cond) - operator(()operator(()ident(=) ident(idx) ident(vec-len)operator(\)) pre_constant(#f)operator(\)) - operator(()ident(else) - operator(()reserved(if) operator(()ident(pred) operator(()ident(vector-ref) ident(vec) ident(idx)operator(\))operator(\)) - ident(idx) - comment(;else) - operator(()ident(loop) operator(()ident(+) ident(idx) integer(1)operator(\))operator(\))operator(\)) operator(\))operator(\))operator(\))operator(\))operator(\)) - -comment(; Return #f, or first index for which 'pred' returns true) -operator(()reserved(define) operator(()ident(list-first-idx) ident(pred) ident(list)operator(\)) - operator(()reserved(let) ident(loop) operator(()operator(()ident(idx) integer(0)operator(\)) operator(()ident(list) ident(list)operator(\))operator(\)) - operator(()reserved(cond) - operator(()operator(()ident(null?) ident(list)operator(\)) pre_constant(#f)operator(\)) - operator(()ident(else) - operator(()reserved(if) operator(()ident(pred) operator(()ident(car) ident(list)operator(\))operator(\)) - ident(idx) - comment(;else) - operator(()ident(loop) operator(()ident(+) ident(idx) integer(1)operator(\)) operator(()ident(cdr) ident(list)operator(\))operator(\))operator(\)) operator(\))operator(\))operator(\))operator(\)) - -comment(;; ------------) - -operator(()reserved(define) ident(*array*) operator(')operator(#()integer(1) integer(2) integer(3) integer(4) integer(5) integer(6) integer(7) integer(8)operator(\))operator(\)) - -operator(()ident(print) - operator(()ident(vector-first-idx) - operator(()reserved(lambda) operator(()ident(x)operator(\)) operator(()ident(=) ident(x) integer(9)operator(\))operator(\)) - ident(*array*)operator(\))operator(\)) - -comment(;; ----) - -operator(()reserved(define) ident(*list*) operator(')operator(()integer(1) integer(2) integer(3) integer(4) integer(5) integer(6) integer(7) integer(8)operator(\))operator(\)) - -operator(()ident(print) - operator(()ident(list-first-idx) - operator(()reserved(lambda) operator(()ident(x)operator(\)) operator(()ident(=) ident(x) integer(4)operator(\))operator(\)) - ident(*list*)operator(\))operator(\)) - -comment(;; ----) - -operator(()ident(use-modules) operator(()ident(srfi) ident(srfi-1)operator(\))operator(\)) - -operator(()ident(print) - operator(()ident(list-index) - operator(()reserved(lambda) operator(()ident(x)operator(\)) operator(()ident(=) ident(x) integer(4)operator(\))operator(\)) - ident(*list*)operator(\))operator(\)) - -comment(;; ----------------------------) - -comment(; The Perl 'highest paid engineer' example isn't really a 'first match') -comment(; type of problem - the routines shown earlier really aren't suited to) -comment(; this. Better suited, instead, are the SRFI-1 routines like 'fold',) -comment(; 'fold-right' and 'reduce', even old standbys like 'filter' and 'for-each') - -operator(()reserved(define) ident(+)ident(null-salary-rec+) - operator(()ident(list) operator(')operator(()operator(\)) integer(0) operator(')operator(()operator(\))operator(\))operator(\)) - -operator(()reserved(define) ident(*salaries*) - operator(()ident(list) - operator(()ident(list) operator(')ident(engineer) integer(43000) operator(')ident(Bob)operator(\)) - operator(()ident(list) operator(')ident(programmer) integer(48000) operator(')ident(Andy)operator(\)) - operator(()ident(list) operator(')ident(engineer) integer(35000) operator(')ident(Champ)operator(\)) - operator(()ident(list) operator(')ident(engineer) integer(49000) operator(')ident(Bubbles)operator(\)) - operator(()ident(list) operator(')ident(programmer) integer(47000) operator(')ident(Twig)operator(\)) - operator(()ident(list) operator(')ident(engineer) integer(34000) operator(')ident(Axel)operator(\)) operator(\))operator(\)) - -comment(;; ----------------------------) - -operator(()reserved(define) ident(*highest-paid-engineer*) - operator(()ident(reduce) - operator(()reserved(lambda) operator(()ident(salary-rec) ident(acc)operator(\)) - operator(()reserved(if) - operator(()reserved(and) - operator(()ident(eq?) operator(()ident(car) ident(salary-rec)operator(\)) operator(')ident(engineer)operator(\)) - operator(()ident(>) operator(()ident(cadr) ident(salary-rec)operator(\)) operator(()ident(cadr) ident(acc)operator(\))operator(\))operator(\)) - ident(salary-rec) - comment(;else) - ident(acc)operator(\))operator(\)) - ident(+)ident(null-salary-rec+) - ident(*salaries*)operator(\))operator(\)) - -operator(()ident(print) ident(*highest-paid-engineer*)operator(\)) - -comment(;; ------------) - -operator(()reserved(define) ident(*highest-paid-engineer*) - operator(()ident(fold-right) - operator(()reserved(lambda) operator(()ident(salary-rec) ident(acc)operator(\)) - operator(()reserved(if) operator(()ident(>) operator(()ident(cadr) ident(salary-rec)operator(\)) operator(()ident(cadr) ident(acc)operator(\))operator(\)) - ident(salary-rec) - comment(;else) - ident(acc)operator(\))operator(\)) - ident(+)ident(null-salary-rec+) - operator(()ident(filter) - operator(()reserved(lambda) operator(()ident(salary-rec)operator(\)) - operator(()ident(eq?) operator(()ident(car) ident(salary-rec)operator(\)) operator(')ident(engineer)operator(\))operator(\)) - ident(*salaries*)operator(\))operator(\)) operator(\)) - -operator(()ident(print) ident(*highest-paid-engineer*)operator(\)) - -comment(;; ------------) - -operator(()reserved(define) ident(*highest-paid-engineer*) ident(+)ident(null-salary-rec+)operator(\)) - -operator(()ident(for-each) - operator(()reserved(lambda) operator(()ident(salary-rec)operator(\)) - operator(()reserved(if) - operator(()reserved(and) - operator(()ident(eq?) operator(()ident(car) ident(salary-rec)operator(\)) operator(')ident(engineer)operator(\)) - operator(()ident(>) operator(()ident(cadr) ident(salary-rec)operator(\)) operator(()ident(cadr) ident(*highest-paid-engineer*)operator(\))operator(\))operator(\)) - operator(()reserved(set!) ident(*highest-paid-engineer*) ident(salary-rec)operator(\))operator(\))operator(\)) - ident(*salaries*)operator(\)) - -operator(()ident(print) ident(*highest-paid-engineer*)operator(\)) - -comment(;; @@PLEAC@@_4.13) -comment(; All tasks in this section consist of either generating a collection,) -comment(; or filtering a larger collection, of elements matching some criteria;) -comment(; obvious candidates are the 'filter' and 'array-filter' routines, though) -comment(; others like 'for-each' can also be applied) - -operator(()reserved(define) ident(*list-matching*) operator(()ident(filter) ident(PRED) ident(LIST)operator(\))operator(\)) -operator(()reserved(define) ident(*vector-matching*) operator(()ident(array-filter) ident(PRED) ident(ARRAY)operator(\))operator(\)) - -comment(;; ----------------------------) - -operator(()reserved(define) ident(*nums*) operator(')operator(()integer(1e7) integer(3e7) integer(2e7) integer(4e7) integer(1e7) integer(3e7) integer(2e7) integer(4e7)operator(\))operator(\)) - -operator(()reserved(define) ident(*bigs*) - operator(()ident(filter) - operator(()reserved(lambda) operator(()ident(num)operator(\)) operator(()ident(>) ident(num) integer(1000000)operator(\))operator(\)) - ident(*nums*)operator(\))operator(\)) - -comment(;; ------------) - -operator(()reserved(define) ident(*users*) - operator(()ident(list) - operator(')operator(()ident(u1) operator(.) integer(2e7)operator(\)) - operator(')operator(()ident(u2) operator(.) integer(1e7)operator(\)) - operator(')operator(()ident(u3) operator(.) integer(4e7)operator(\)) - operator(')operator(()ident(u4) operator(.) integer(3e7)operator(\)) operator(\))operator(\)) - -operator(()reserved(define) ident(*pigs*) - operator(()ident(fold-right) - operator(()reserved(lambda) operator(()ident(pair) ident(accum)operator(\)) operator(()reserved(cons) operator(()ident(car) ident(pair)operator(\)) ident(accum)operator(\))operator(\)) - operator(')operator(()operator(\)) - operator(()ident(filter) - operator(()reserved(lambda) operator(()ident(pair)operator(\)) operator(()ident(>) operator(()ident(cdr) ident(pair)operator(\)) integer(1e7)operator(\))operator(\)) - ident(*users*)operator(\))operator(\))operator(\)) - -operator(()ident(print) ident(*pigs*)operator(\)) - -comment(;; ------------) - -operator(()reserved(define) ident(*salaries*) - operator(()ident(list) - operator(()ident(list) operator(')ident(engineer) integer(43000) operator(')ident(Bob)operator(\)) - operator(()ident(list) operator(')ident(programmer) integer(48000) operator(')ident(Andy)operator(\)) - operator(()ident(list) operator(')ident(engineer) integer(35000) operator(')ident(Champ)operator(\)) - operator(()ident(list) operator(')ident(engineer) integer(49000) operator(')ident(Bubbles)operator(\)) - operator(()ident(list) operator(')ident(programmer) integer(47000) operator(')ident(Twig)operator(\)) - operator(()ident(list) operator(')ident(engineer) integer(34000) operator(')ident(Axel)operator(\)) operator(\))operator(\)) - -operator(()reserved(define) ident(*engineers*) - operator(()ident(filter) - operator(()reserved(lambda) operator(()ident(salary-rec)operator(\)) - operator(()ident(eq?) operator(()ident(car) ident(salary-rec)operator(\)) operator(')ident(engineer)operator(\))operator(\)) - ident(*salaries*)operator(\))operator(\)) - -operator(()ident(print) ident(*engineers*)operator(\)) - -comment(;; ------------) - -operator(()reserved(define) ident(*applicants*) - operator(()ident(list) - operator(()ident(list) operator(')ident(a1) integer(26000) operator(')ident(Bob)operator(\)) - operator(()ident(list) operator(')ident(a2) integer(28000) operator(')ident(Andy)operator(\)) - operator(()ident(list) operator(')ident(a3) integer(24000) operator(')ident(Candy)operator(\)) operator(\))operator(\)) - -operator(()reserved(define) ident(*secondary-assistance*) - operator(()ident(filter) - operator(()reserved(lambda) operator(()ident(salary-rec)operator(\)) - operator(()reserved(and) - operator(()ident(>) operator(()ident(cadr) ident(salary-rec)operator(\)) integer(26000)operator(\)) - operator(()ident(<) operator(()ident(cadr) ident(salary-rec)operator(\)) integer(30000)operator(\))operator(\))operator(\)) - ident(*applicants*)operator(\))operator(\)) - -operator(()ident(print) ident(*secondary-assistance*)operator(\)) - -comment(;; @@PLEAC@@_4.14) -comment(; Sorting numeric data in Scheme is very straightforward ...) - -operator(()reserved(define) ident(*unsorted*) operator(')operator(()integer(5) integer(8) integer(1) integer(7) integer(4) integer(2) integer(3) integer(6)operator(\))operator(\)) - -comment(;; ------------) - -comment(; Ascending sort - use '<' as comparator) -operator(()reserved(define) ident(*sorted*) - operator(()ident(sort) - ident(*unsorted*) - ident(<)operator(\))operator(\)) - -operator(()ident(print) ident(*sorted*)operator(\)) - -comment(;; ------------) - -comment(; Descending sort - use '>' as comparator) -operator(()reserved(define) ident(*sorted*) - operator(()ident(sort) - ident(*unsorted*) - ident(>)operator(\))operator(\)) - -operator(()ident(print) ident(*sorted*)operator(\)) - -comment(;; @@PLEAC@@_4.15) -comment(; A customised lambda may be passed as comparator to 'sort', so) -comment(; sorting on one or more 'fields' is quite straightforward) - -operator(()reserved(define) ident(*unordered*) operator(')operator(() ident(...) operator(\))operator(\)) - -comment(; COMPARE is some comparator suited for the element type being) -comment(; sorted) -operator(()reserved(define) ident(*ordered*) - operator(()ident(sort) - ident(*unordered*) - operator(()reserved(lambda) operator(()ident(left) ident(right)operator(\)) - operator(()ident(COMPARE) ident(left) ident(right)operator(\))operator(\))operator(\))operator(\)) - -comment(;; ------------) - -operator(()reserved(define) ident(*unordered*) - operator(()ident(list) - operator(()reserved(cons) operator(')ident(s) integer(34)operator(\)) - operator(()reserved(cons) operator(')ident(e) integer(12)operator(\)) - operator(()reserved(cons) operator(')ident(c) integer(45)operator(\)) - operator(()reserved(cons) operator(')ident(q) integer(11)operator(\)) - operator(()reserved(cons) operator(')ident(g) integer(24)operator(\)) operator(\))operator(\)) - -operator(()reserved(define) ident(*pre-computed*) - operator(()ident(map) - comment(; Here element is returned unaltered, but it would normally be) - comment(; transformed in som way) - operator(()reserved(lambda) operator(()ident(element)operator(\)) ident(element)operator(\)) - ident(*unordered*)operator(\))operator(\)) - -operator(()reserved(define) ident(*ordered-pre-computed*) - operator(()ident(sort) - ident(*pre-computed*) - comment(; Sort on the first field [assume it is the 'key'] ) - operator(()reserved(lambda) operator(()ident(left) ident(right)operator(\)) - operator(()ident(string<?) - operator(()ident(symbol->string) operator(()ident(car) ident(left)operator(\))operator(\)) - operator(()ident(symbol->string) operator(()ident(car) ident(right)operator(\))operator(\))operator(\))operator(\))operator(\))operator(\)) - -comment(; Extract the second field [assume it is the 'value']) -operator(()reserved(define) ident(*ordered*) - operator(()ident(map) - operator(()reserved(lambda) operator(()ident(element)operator(\)) operator(()ident(cdr) ident(element)operator(\))operator(\)) - ident(*ordered-pre-computed*)operator(\))operator(\)) - -comment(;; ----------------------------) - -operator(()reserved(define) ident(*employees*) - operator(()ident(list) - operator(()ident(list) operator(')ident(Bob) integer(43000) integer(123) integer(42)operator(\)) - operator(()ident(list) operator(')ident(Andy) integer(48000) integer(124) integer(35)operator(\)) - operator(()ident(list) operator(')ident(Champ) integer(35000) integer(125) integer(37)operator(\)) - operator(()ident(list) operator(')ident(Bubbles) integer(49000) integer(126) integer(34)operator(\)) - operator(()ident(list) operator(')ident(Twig) integer(47000) integer(127) integer(36)operator(\)) - operator(()ident(list) operator(')ident(Axel) integer(34000) integer(128) integer(31)operator(\)) operator(\))operator(\)) - -operator(()reserved(define) ident(*ordered*) - operator(()ident(sort) - ident(*employees*) - operator(()reserved(lambda) operator(()ident(left) ident(right)operator(\)) - operator(()ident(string<?) - operator(()ident(symbol->string) operator(()ident(car) ident(left)operator(\))operator(\)) - operator(()ident(symbol->string) operator(()ident(car) ident(right)operator(\))operator(\))operator(\))operator(\))operator(\))operator(\)) - -comment(;; ------------) - -operator(()ident(for-each) - operator(()reserved(lambda) operator(()ident(employee)operator(\)) - operator(()ident(print) operator(()ident(car) ident(employee)operator(\)) string<delimiter(")content(earns $)delimiter(")> operator(()ident(cadr) ident(employee)operator(\))operator(\))operator(\)) - operator(()ident(sort) - ident(*employees*) - operator(()reserved(lambda) operator(()ident(left) ident(right)operator(\)) - operator(()ident(string<?) - operator(()ident(symbol->string) operator(()ident(car) ident(left)operator(\))operator(\)) - operator(()ident(symbol->string) operator(()ident(car) ident(right)operator(\))operator(\))operator(\))operator(\))operator(\))operator(\)) - -comment(;; ------------) - -operator(()reserved(define) ident(*bonus*) - operator(()ident(list) - operator(')operator(()integer(125) operator(.) integer(1000)operator(\)) - operator(')operator(()integer(127) operator(.) integer(1500)operator(\)) operator(\))operator(\)) - -operator(()ident(for-each) - operator(()reserved(lambda) operator(()ident(employee)operator(\)) - operator(()reserved(let) operator(()operator(()ident(bonus) operator(()ident(assoc-ref) ident(*bonus*) operator(()ident(caddr) ident(employee)operator(\))operator(\))operator(\))operator(\)) - operator(()reserved(if) operator(()ident(not) ident(bonus)operator(\)) - operator(')operator(()operator(\)) - comment(;else) - operator(()ident(print) operator(()ident(car) ident(employee)operator(\)) string<delimiter(")content(earned bonus)delimiter(")> ident(bonus)operator(\)) operator(\))operator(\))operator(\)) - operator(()ident(sort) - ident(*employees*) - operator(()reserved(lambda) operator(()ident(left) ident(right)operator(\)) - operator(()ident(string<?) - operator(()ident(symbol->string) operator(()ident(car) ident(left)operator(\))operator(\)) - operator(()ident(symbol->string) operator(()ident(car) ident(right)operator(\))operator(\))operator(\))operator(\))operator(\))operator(\)) - -comment(;; ----------------------------) - -operator(()ident(use-modules) operator(()ident(srfi) ident(srfi-1)operator(\)) operator(()ident(ice-9) ident(rdelim)operator(\)) operator(()ident(ice-9) ident(regex)operator(\))operator(\)) - -operator(()reserved(define) ident(*filename*) string<delimiter(")content(/etc/passwd)delimiter(")>operator(\)) -operator(()reserved(define) ident(*users*) operator(')operator(()operator(\))operator(\)) - -operator(()reserved(let) operator(()operator(()ident(port) operator(()ident(open-input-file) ident(*filename*)operator(\))operator(\))operator(\)) - operator(()reserved(let) ident(loop) operator(()operator(()ident(line&terminator) operator(()ident(read-line) ident(port) operator(')ident(split)operator(\))operator(\))operator(\)) - operator(()reserved(cond) - operator(()operator(()ident(eof-object?) operator(()ident(cdr) ident(line&terminator)operator(\))operator(\)) operator(')operator(()operator(\))operator(\)) - operator(()ident(else) - operator(()reserved(set!) ident(*users*) - operator(()ident(assoc-set!) - ident(*users*) - operator(()ident(car) operator(()ident(string-split) operator(()ident(car) ident(line&terminator)operator(\)) char(#\\:)operator(\))operator(\)) - pre_constant(#t)operator(\))operator(\)) - operator(()ident(loop) operator(()ident(read-line) ident(port) operator(')ident(split)operator(\))operator(\)) operator(\))operator(\))operator(\)) - operator(()ident(close-input-port) ident(port)operator(\))operator(\)) - -operator(()ident(for-each) - operator(()reserved(lambda) operator(()ident(user)operator(\)) operator(()ident(print) operator(()ident(car) ident(user)operator(\))operator(\))operator(\)) - operator(()ident(sort) - ident(*users*) - operator(()reserved(lambda) operator(()ident(left) ident(right)operator(\)) - operator(()ident(string<?) - operator(()ident(car) ident(left)operator(\)) - operator(()ident(car) ident(right)operator(\))operator(\))operator(\))operator(\))operator(\)) - -comment(;; @@PLEAC@@_4.16) -comment(; Use SRFI-1's 'circular-list' routine to build a circular list) -operator(()ident(use-modules) operator(()ident(srfi) ident(srfi-1)operator(\))operator(\)) - -operator(()reserved(define) ident(*processes*) operator(()ident(circular-list) integer(1) integer(2) integer(3) integer(4) integer(5)operator(\))operator(\)) - -operator(()reserved(let) ident(loop) operator(()operator(()ident(processes) ident(*processes*)operator(\))operator(\)) - operator(()ident(print) string<delimiter(")content(Handling process)delimiter(")> operator(()ident(car) ident(processes)operator(\))operator(\)) - operator(()ident(sleep) integer(1)operator(\)) - operator(()ident(loop) operator(()ident(cdr) ident(processes)operator(\))operator(\))operator(\)) - -comment(;; @@PLEAC@@_4.17) -operator(()ident(use-modules) operator(()ident(srfi) ident(srfi-1)operator(\))operator(\)) - -comment(; Implements Fischer-Yates shuffle algorithm) -operator(()reserved(define) operator(()ident(vector-shuffle!) ident(vec)operator(\)) - operator(()reserved(let) operator(()operator(()ident(vector-length) operator(()ident(vector-length) ident(vec)operator(\))operator(\))operator(\)) - operator(()reserved(let) ident(loop) operator(()operator(()ident(i) ident(vector-length)operator(\)) operator(()ident(j) operator(()ident(+) integer(1) operator(()ident(random) ident(vector-length)operator(\))operator(\))operator(\))operator(\)) - operator(()reserved(cond) - operator(()operator(()ident(=) ident(i) integer(1)operator(\)) operator(')operator(()operator(\))operator(\)) - operator(()operator(()ident(not) operator(()ident(=) ident(i) ident(j)operator(\))operator(\)) - operator(()ident(vector-ref-swap!) ident(vec) operator(()ident(-) ident(i) integer(1)operator(\)) operator(()ident(-) ident(j) integer(1)operator(\))operator(\)) - operator(()ident(loop) operator(()ident(-) ident(i) integer(1)operator(\)) operator(()ident(+) integer(1) operator(()ident(random) operator(()ident(-) ident(i) integer(1)operator(\))operator(\))operator(\))operator(\))operator(\)) - operator(()ident(else) - operator(()ident(loop) operator(()ident(-) ident(i) integer(1)operator(\)) operator(()ident(+) integer(1) operator(()ident(random) operator(()ident(-) ident(i) integer(1)operator(\))operator(\))operator(\))operator(\))operator(\)) operator(\))operator(\))operator(\))operator(\)) - -operator(()reserved(define) operator(()ident(vector-ref-swap!) ident(vec) ident(idx1) ident(idx2)operator(\)) - operator(()reserved(let) operator(()operator(()ident(tmp) operator(()ident(vector-ref) ident(vec) ident(idx1)operator(\))operator(\))operator(\)) - operator(()ident(vector-set!) ident(vec) ident(idx1) operator(()ident(vector-ref) ident(vec) ident(idx2)operator(\))operator(\)) - operator(()ident(vector-set!) ident(vec) ident(idx2) ident(tmp)operator(\))operator(\))operator(\)) - -comment(; Generate vector of values 1 .. 10) -operator(()reserved(define) ident(*irange*) operator(()ident(list->vector) operator(()ident(iota) integer(10) integer(1) integer(1)operator(\))operator(\))operator(\)) - -comment(; Shuffle array values) -operator(()ident(vector-shuffle!) ident(*irange*)operator(\)) - -comment(;; @@PLEAC@@_4.18) -comment(;; @@INCOMPLETE@@) -comment(;; @@INCOMPLETE@@) - -comment(;; @@PLEAC@@_4.19) -comment(;; @@INCOMPLETE@@) -comment(;; @@INCOMPLETE@@) - -comment(;; @@PLEAC@@_5.0) -comment(;; ---------------------------------------------------------------------) -comment(;; Scheme offers two dictionary types:) -comment(;;) -comment(;; * Association list [list of pairs e.g. '((k1 . v1\) (k2 . v2\) ...\)]) -comment(;; * Hash table [vector of pairs plus hash algorithm]) -comment(;;) -comment(;; Implementation differences aside, they are remarkably similar in that) -comment(;; the functions operating on them are similar named, and offer the same) -comment(;; interface. Examples:) -comment(;;) -comment(;; * Retrieve an item: (assoc-ref hash key\) (hash-ref hash key\)) -comment(;; * Update an item: (assoc-set! hash key value\) (hash-set! hash key value\) ) -comment(;;) -comment(;; Hash tables would tend to be used where performance was critical e.g.) -comment(;; near constant-time lookups, or where entry updates are frequent, whilst) -comment(;; association lists would be used where table-level traversals and ) -comment(;; manipulations require maximum flexibility) -comment(;;) -comment(;; Many of the sections include examples using both association lists and) -comment(;; hash tables. However, where only one of these is shown, implementing) -comment(;; the other is usually a trivial exercise. Finally, any helper functions) -comment(;; will be included in the Appendix) -comment(;; ---------------------------------------------------------------------) - -comment(; Association lists) -operator(()reserved(define) ident(*age*) - operator(()ident(list) - operator(()reserved(cons) operator(')ident(Nat) integer(24)operator(\)) - operator(()reserved(cons) operator(')ident(Jules) integer(25)operator(\)) - operator(()reserved(cons) operator(')ident(Josh) integer(17)operator(\))operator(\))operator(\)) - -comment(;; or, perhaps more compactly:) -operator(()reserved(define) ident(*age*) - operator(()ident(list) - operator(')operator(()ident(Nat) operator(.) integer(24)operator(\)) - operator(')operator(()ident(Jules) operator(.) integer(25)operator(\)) - operator(')operator(()ident(Josh) operator(.) integer(17)operator(\))operator(\))operator(\)) - -comment(;; ------------) - -comment(; Guile built-in association list support) -operator(()reserved(define) ident(*age*) operator(()ident(acons) operator(')ident(Nat) integer(24) operator(')operator(()operator(\))operator(\))operator(\)) -operator(()reserved(set!) ident(*age*) operator(()ident(acons) operator(')ident(Jules) integer(25) ident(*age*)operator(\))operator(\)) -operator(()reserved(set!) ident(*age*) operator(()ident(acons) operator(')ident(Josh) integer(17) ident(*age*)operator(\))operator(\)) - -comment(;; ----) - -comment(; SRFI-1 association list support) -operator(()ident(use-modules) operator(()ident(srfi) ident(srfi-1)operator(\))operator(\)) - -operator(()reserved(define) ident(*age*) operator(()ident(alist-cons) operator(')ident(Nat) integer(24) operator(')operator(()operator(\))operator(\))operator(\)) -operator(()reserved(set!) ident(*age*) operator(()ident(alist-cons) operator(')ident(Jules) integer(25) ident(*age*)operator(\))operator(\)) -operator(()reserved(set!) ident(*age*) operator(()ident(alist-cons) operator(')ident(Josh) integer(17) ident(*age*)operator(\))operator(\)) - -comment(;; ------------) - -operator(()reserved(define) ident(*food-colour*) - operator(()ident(list) - operator(')operator(()ident(Apple) operator(.) string<delimiter(")content(red)delimiter(")>operator(\)) - operator(')operator(()ident(Banana) operator(.) string<delimiter(")content(yellow)delimiter(")>operator(\)) - operator(')operator(()ident(Lemon) operator(.) string<delimiter(")content(yellow)delimiter(")>operator(\)) - operator(')operator(()ident(Carrot) operator(.) string<delimiter(")content(orange)delimiter(")>operator(\))operator(\))operator(\)) - -comment(;; ----------------------------) - -comment(; Hash tables. Guile offers an implementation, and it is also ) -comment(; possible to use SRFI-69 hash tables; only the former will be) -comment(; illustrated here) - -operator(()reserved(define) ident(*age*) operator(()ident(make-hash-table) integer(20)operator(\))operator(\)) -comment(; or) -operator(()reserved(define) ident(*age*) operator(()ident(make-vector) integer(20) operator(')operator(()operator(\))operator(\))operator(\)) - -operator(()ident(hash-set!) ident(*age*) operator(')ident(Nat) integer(24)operator(\)) -operator(()ident(hash-set!) ident(*age*) operator(')ident(Jules) integer(25)operator(\)) -operator(()ident(hash-set!) ident(*age*) operator(')ident(Josh) integer(17)operator(\)) - -operator(()ident(hash-for-each) - operator(()reserved(lambda) operator(()ident(key) ident(value)operator(\)) operator(()ident(print) ident(key)operator(\))operator(\)) - ident(*age*)operator(\)) - -comment(; or, if vector used as hash table, can also use:) - -operator(()ident(array-for-each) - operator(()reserved(lambda) operator(()ident(pair)operator(\)) - operator(()reserved(if) operator(()ident(not) operator(()ident(null?) ident(pair)operator(\))operator(\)) operator(()ident(print) operator(()ident(car) ident(pair)operator(\))operator(\))operator(\))operator(\)) - ident(*age*)operator(\)) - -comment(;; ------------) - -operator(()reserved(define) ident(*food-colour*) operator(()ident(make-hash-table) integer(20)operator(\))operator(\)) - -operator(()ident(hash-set!) ident(*food-colour*) operator(')ident(Apple) string<delimiter(")content(red)delimiter(")>operator(\)) -operator(()ident(hash-set!) ident(*food-colour*) operator(')ident(Banana) string<delimiter(")content(yellow)delimiter(")>operator(\)) -operator(()ident(hash-set!) ident(*food-colour*) operator(')ident(Lemon) string<delimiter(")content(yellow)delimiter(")>operator(\)) -operator(()ident(hash-set!) ident(*food-colour*) operator(')ident(Carrot) string<delimiter(")content(orange)delimiter(")>operator(\)) - -comment(;; @@PLEAC@@_5.1) -operator(()reserved(set!) ident(*hash*) operator(()ident(acons) ident(key) ident(value) ident(*hash*)operator(\))operator(\)) - -comment(;; ------------) - -operator(()reserved(set!) ident(*food-colour*) operator(()ident(acons) operator(')ident(Raspberry) string<delimiter(")content(pink)delimiter(")> ident(*food-colour*)operator(\))operator(\)) - -operator(()ident(print) string<delimiter(")content(Known foods:)delimiter(")>operator(\)) -operator(()ident(for-each) - operator(()reserved(lambda) operator(()ident(pair)operator(\)) operator(()ident(print) operator(()ident(car) ident(pair)operator(\))operator(\))operator(\)) - ident(*food-colour*)operator(\)) - -comment(;; ----------------------------) - -operator(()ident(hash-set!) ident(*hash*) ident(key) ident(value)operator(\)) - -comment(;; ------------) - -operator(()ident(hash-set!) ident(*food-colour*) operator(')ident(Raspberry) string<delimiter(")content(pink)delimiter(")>operator(\)) - -operator(()ident(print) string<delimiter(")content(Known foods:)delimiter(")>operator(\)) -operator(()ident(hash-for-each) - operator(()reserved(lambda) operator(()ident(key) ident(value)operator(\)) operator(()ident(print) ident(key)operator(\))operator(\)) - ident(*food-colour*)operator(\)) - -comment(;; @@PLEAC@@_5.2) -comment(; 'assoc' returns the pair, (key . value\)) -operator(()reserved(if) operator(()ident(assoc) ident(key) ident(hash)operator(\)) - ident(...) ident(found) ident(...) -comment(;else) - ident(...) ident(not) ident(found) ident(...) - -comment(; 'assoc-ref' returns the value only) -operator(()reserved(if) operator(()ident(assoc-ref) ident(hash) ident(key)operator(\)) - ident(...) ident(found) ident(...) -comment(;else) - ident(...) ident(not) ident(found) ident(...) - -comment(;; ------------) - -comment(; *food-colour* association list from an earlier section) - -operator(()ident(for-each) - operator(()reserved(lambda) operator(()ident(name)operator(\)) - operator(()reserved(let) operator(()operator(()ident(pair) operator(()ident(assoc) ident(name) ident(*food-colour*)operator(\))operator(\))operator(\)) - operator(()reserved(if) ident(pair) - operator(()ident(print) operator(()ident(symbol->string) operator(()ident(car) ident(pair)operator(\))operator(\)) string<delimiter(")content(is a food)delimiter(")>operator(\)) - comment(;else) - operator(()ident(print) operator(()ident(symbol->string) ident(name)operator(\)) string<delimiter(")content(is a drink)delimiter(")>operator(\)) operator(\))operator(\))operator(\)) - operator(()ident(list) operator(')ident(Banana) operator(')ident(Martini)operator(\))operator(\)) - -comment(;; ----------------------------) - -comment(; 'hash-get-handle' returns the pair, (key . value\)) -operator(()reserved(if) operator(()ident(hash-get-handle) ident(hash) ident(key)operator(\)) - ident(...) ident(found) ident(...) -comment(;else) - ident(...) ident(not) ident(found) ident(...) - -comment(; 'hash-ref' returns the value only) -operator(()reserved(if) operator(()ident(hash-ref) ident(hash) ident(key)operator(\)) - ident(...) ident(found) ident(...) -comment(;else) - ident(...) ident(not) ident(found) ident(...) - -comment(;; ------------) - -comment(; *food-colour* hash table from an earlier section) - -operator(()ident(for-each) - operator(()reserved(lambda) operator(()ident(name)operator(\)) - operator(()reserved(let) operator(()operator(()ident(value) operator(()ident(hash-ref) ident(*food-colour*) ident(name)operator(\))operator(\))operator(\)) - operator(()reserved(if) ident(value) - operator(()ident(print) operator(()ident(symbol->string) ident(name)operator(\)) string<delimiter(")content(is a food)delimiter(")>operator(\)) - comment(;else) - operator(()ident(print) operator(()ident(symbol->string) ident(name)operator(\)) string<delimiter(")content(is a drink)delimiter(")>operator(\)) operator(\))operator(\))operator(\)) - operator(()ident(list) operator(')ident(Banana) operator(')ident(Martini)operator(\))operator(\)) - -comment(;; ----------------------------) - -operator(()reserved(define) ident(*age*) operator(()ident(make-hash-table) integer(20)operator(\))operator(\)) - -operator(()ident(hash-set!) ident(*age*) operator(')ident(Toddler) integer(3)operator(\)) -operator(()ident(hash-set!) ident(*age*) operator(')ident(Unborn) integer(0)operator(\)) -operator(()ident(hash-set!) ident(*age*) operator(')ident(Phantasm) operator(')operator(()operator(\))operator(\)) - -operator(()ident(for-each) - operator(()reserved(lambda) operator(()ident(thing)operator(\)) - operator(()reserved(let) operator(()operator(()ident(value) operator(()ident(hash-ref) ident(*age*) ident(thing)operator(\))operator(\))operator(\)) - operator(()ident(display) ident(thing)operator(\)) - operator(()reserved(if) ident(value) operator(()ident(display) string<delimiter(")content( Exists)delimiter(")>operator(\))operator(\)) - operator(()reserved(if) operator(()reserved(and) ident(value) operator(()ident(not) operator(()ident(string-null?) ident(value)operator(\))operator(\))operator(\)) operator(()ident(display) string<delimiter(")content( Defined)delimiter(")>operator(\))operator(\)) - comment(; Testing for non-zero as true is not applicable, so testing) - comment(; for non-equality with zero ) - operator(()reserved(if) operator(()reserved(and) ident(value) operator(()ident(not) operator(()ident(eq?) ident(value) integer(0)operator(\))operator(\))operator(\)) operator(()ident(display) string<delimiter(")content( True)delimiter(")>operator(\))operator(\)) - operator(()ident(print) string<delimiter(")delimiter(")>operator(\)) operator(\))operator(\)) - operator(()ident(list) operator(')ident(Toddler) operator(')ident(Unborn) operator(')ident(Phantasm) operator(')ident(Relic)operator(\))operator(\)) - -comment(;; @@PLEAC@@_5.3) -operator(()ident(assoc-remove!) ident(hash) ident(key)operator(\)) - -comment(;; ------------) - -operator(()ident(use-modules) operator(()ident(srfi) ident(srfi-1)operator(\))operator(\)) - -comment(; *food-colour* association list from an earlier section) - -operator(()reserved(define) operator(()ident(print-foods)operator(\)) - operator(()reserved(let) operator(()operator(()ident(foods) - operator(()ident(fold-right) - operator(()reserved(lambda) operator(()ident(pair) ident(accum)operator(\)) operator(()reserved(cons) operator(()ident(car) ident(pair)operator(\)) ident(accum)operator(\))operator(\)) - operator(')operator(()operator(\)) - ident(*food-colour*)operator(\))operator(\))operator(\)) - operator(()ident(display) string<delimiter(")content(Keys: )delimiter(")>operator(\)) operator(()ident(print) ident(foods)operator(\)) - operator(()ident(print) string<delimiter(")content(Values:)delimiter(")>operator(\)) - operator(()ident(for-each) - operator(()reserved(lambda) operator(()ident(food)operator(\)) - operator(()reserved(let) operator(()operator(()ident(colour) operator(()ident(assoc-ref) ident(*food-colour*) ident(food)operator(\))operator(\))operator(\)) - operator(()reserved(cond) - operator(()operator(()ident(string-null?) ident(colour)operator(\)) operator(()ident(display) string<delimiter(")content((undef\) )delimiter(")>operator(\))operator(\)) - operator(()ident(else) operator(()ident(display) operator(()ident(string-append) ident(colour) string<delimiter(")content( )delimiter(")>operator(\))operator(\))operator(\)) operator(\))operator(\))operator(\)) - ident(foods)operator(\))operator(\)) - operator(()ident(newline)operator(\))operator(\)) - -operator(()ident(print) string<delimiter(")content(Initially:)delimiter(")>operator(\)) -operator(()ident(print-foods)operator(\)) - -operator(()ident(print) string<delimiter(")content(\\n)content(With Banana undef)delimiter(")>operator(\)) -operator(()ident(assoc-set!) ident(*food-colour*) operator(')ident(Banana) string<delimiter(")delimiter(")>operator(\)) -operator(()ident(print-foods)operator(\)) - -operator(()ident(print) string<delimiter(")content(\\n)content(With Banana deleted)delimiter(")>operator(\)) -operator(()ident(assoc-remove!) ident(*food-colour*) operator(')ident(Banana)operator(\)) -operator(()ident(print-foods)operator(\)) - -comment(;; ----------------------------) - -operator(()ident(hash-remove!) ident(hash) ident(key)operator(\)) - -comment(;; ------------) - -operator(()ident(use-modules) operator(()ident(srfi) ident(srfi-1)operator(\))operator(\)) - -comment(; *food-colour* hash table from an earlier section) - -operator(()reserved(define) operator(()ident(print-foods)operator(\)) - operator(()reserved(let) operator(()operator(()ident(foods) - operator(()ident(hash-fold) - operator(()reserved(lambda) operator(()ident(key) ident(value) ident(accum)operator(\)) operator(()reserved(cons) ident(key) ident(accum)operator(\))operator(\)) - operator(')operator(()operator(\)) - ident(*food-colour*)operator(\))operator(\))operator(\)) - operator(()ident(display) string<delimiter(")content(Keys: )delimiter(")>operator(\)) operator(()ident(print) operator(()ident(reverse) ident(foods)operator(\))operator(\)) - operator(()ident(print) string<delimiter(")content(Values:)delimiter(")>operator(\)) - operator(()ident(for-each) - operator(()reserved(lambda) operator(()ident(food)operator(\)) - operator(()reserved(let) operator(()operator(()ident(colour) operator(()ident(hash-ref) ident(*food-colour*) ident(food)operator(\))operator(\))operator(\)) - operator(()reserved(cond) - operator(()operator(()ident(string-null?) ident(colour)operator(\)) operator(()ident(display) string<delimiter(")content((undef\) )delimiter(")>operator(\))operator(\)) - operator(()ident(else) operator(()ident(display) operator(()ident(string-append) ident(colour) string<delimiter(")content( )delimiter(")>operator(\))operator(\))operator(\)) operator(\))operator(\))operator(\)) - ident(foods)operator(\))operator(\)) - operator(()ident(newline)operator(\))operator(\)) - -operator(()ident(print) string<delimiter(")content(Initially:)delimiter(")>operator(\)) -operator(()ident(print-foods)operator(\)) - -operator(()ident(print) string<delimiter(")content(\\n)content(With Banana undef)delimiter(")>operator(\)) -operator(()ident(hash-set!) ident(*food-colour*) operator(')ident(Banana) string<delimiter(")delimiter(")>operator(\)) -operator(()ident(print-foods)operator(\)) - -operator(()ident(print) string<delimiter(")content(\\n)content(With Banana deleted)delimiter(")>operator(\)) -operator(()ident(hash-remove!) ident(*food-colour*) operator(')ident(Banana)operator(\)) -operator(()ident(print-foods)operator(\)) - -comment(;; @@PLEAC@@_5.4) -comment(; Since an association list is nothing more than a list of pairs, it) -comment(; may be traversed using 'for-each') -operator(()ident(for-each) - operator(()reserved(lambda) operator(()ident(pair)operator(\)) - operator(()reserved(let) operator(()operator(()ident(key) operator(()ident(car) ident(pair)operator(\))operator(\)) - operator(()ident(value) operator(()ident(cdr) ident(pair)operator(\))operator(\))operator(\)) - ident(...) reserved(do) ident(something) ident(with) ident(key) ident(/) ident(value) ident(...)operator(\))operator(\)) - ident(hash)operator(\)) - -comment(;; ----------------------------) - -comment(; A 'for-each'-like function is available for hash table traversal) -operator(()ident(hash-for-each) - operator(()reserved(lambda) operator(()ident(key) ident(value)operator(\)) - ident(...) reserved(do) ident(something) ident(with) ident(key) ident(/) ident(value) ident(...)operator(\)) - ident(hash)operator(\)) - -comment(; If the hash table is directly implemented as a vector, then it is) -comment(; also possible to traverse it using, 'array-for-each', though a ) -comment(; check for empty slots is needed ) -operator(()ident(array-for-each) - operator(()reserved(lambda) operator(()ident(pair)operator(\)) - operator(()reserved(if) operator(()ident(not) operator(()ident(null?) ident(pair)operator(\))operator(\)) ident(...) reserved(do) ident(something) ident(with) ident(key) ident(/) ident(value) ident(...)operator(\))operator(\)) - ident(hash)operator(\)) - -comment(;; ----------------------------) - -comment(; *food-colour* association list from an earlier section) - -operator(()ident(for-each) - operator(()reserved(lambda) operator(()ident(pair)operator(\)) - operator(()reserved(let) operator(()operator(()ident(food) operator(()ident(car) ident(pair)operator(\))operator(\)) - operator(()ident(colour) operator(()ident(cdr) ident(pair)operator(\))operator(\))operator(\)) - operator(()ident(print) operator(()ident(symbol->string) ident(food)operator(\)) string<delimiter(")content(is)delimiter(")> ident(colour)operator(\)) operator(\))operator(\)) - ident(*food-colour*)operator(\)) - -comment(;; ------------) - -comment(; *food-colour* association list from an earlier section) - -operator(()ident(for-each) - operator(()reserved(lambda) operator(()ident(food)operator(\)) - operator(()ident(print) operator(()ident(symbol->string) ident(food)operator(\)) string<delimiter(")content(is)delimiter(")> operator(()ident(assoc-ref) ident(*food-colour*) ident(food)operator(\))operator(\))operator(\)) - operator(()ident(sort) - operator(()ident(fold-right) - operator(()reserved(lambda) operator(()ident(pair) ident(accum)operator(\)) operator(()reserved(cons) operator(()ident(car) ident(pair)operator(\)) ident(accum)operator(\))operator(\)) - operator(')operator(()operator(\)) - ident(*food-colour*)operator(\)) - operator(()reserved(lambda) operator(()ident(left) ident(right)operator(\)) - operator(()ident(string<?) operator(()ident(symbol->string) ident(left)operator(\)) operator(()ident(symbol->string) ident(right)operator(\))operator(\))operator(\))operator(\))operator(\)) - -comment(;; ----------------------------) - -operator(()ident(use-modules) operator(()ident(srfi) ident(srfi-1)operator(\)) operator(()ident(ice-9) ident(rdelim)operator(\)) operator(()ident(ice-9) ident(regex)operator(\))operator(\)) - -operator(()reserved(define) ident(*filename*) string<delimiter(")content(from.txt)delimiter(")>operator(\)) -operator(()reserved(define) ident(*from*) operator(')operator(()operator(\))operator(\)) - -operator(()reserved(let) operator(()operator(()ident(port) operator(()ident(open-input-file) ident(*filename*)operator(\))operator(\))operator(\)) - operator(()reserved(let) ident(loop) operator(()operator(()ident(line&terminator) operator(()ident(read-line) ident(port) operator(')ident(split)operator(\))operator(\))operator(\)) - operator(()reserved(cond) - operator(()operator(()ident(eof-object?) operator(()ident(cdr) ident(line&terminator)operator(\))operator(\)) operator(')operator(()operator(\))operator(\)) - operator(()ident(else) - operator(()reserved(let*) operator(()operator(()ident(key) operator(()ident(string->symbol) - operator(()ident(match:substring) - operator(()ident(string-match) - string<delimiter(")content(^From: (.*\))delimiter(")> operator(()ident(car) ident(line&terminator)operator(\))operator(\)) - integer(1)operator(\)) operator(\))operator(\)) - operator(()ident(value) operator(()ident(assoc-ref) ident(*from*) ident(key)operator(\))operator(\))operator(\)) - operator(()reserved(if) operator(()ident(not) ident(value)operator(\)) operator(()reserved(set!) ident(value) integer(0)operator(\))operator(\)) - operator(()reserved(set!) ident(*from*) operator(()ident(assoc-set!) ident(*from*) ident(key) operator(()ident(+) integer(1) ident(value)operator(\))operator(\))operator(\))operator(\)) - operator(()ident(loop) operator(()ident(read-line) ident(port) operator(')ident(split)operator(\))operator(\)) operator(\))operator(\))operator(\)) - operator(()ident(close-input-port) ident(port)operator(\))operator(\)) - -operator(()ident(for-each) - operator(()reserved(lambda) operator(()ident(person)operator(\)) - operator(()ident(print) operator(()ident(symbol->string) ident(person)operator(\)) string<delimiter(")content(:)delimiter(")> operator(()ident(number->string) operator(()ident(assoc-ref) ident(*from*) ident(person)operator(\))operator(\))operator(\))operator(\)) - operator(()ident(sort) - operator(()ident(fold-right) - operator(()reserved(lambda) operator(()ident(pair) ident(accum)operator(\)) operator(()reserved(cons) operator(()ident(car) ident(pair)operator(\)) ident(accum)operator(\))operator(\)) - operator(')operator(()operator(\)) - ident(*from*)operator(\)) - operator(()reserved(lambda) operator(()ident(left) ident(right)operator(\)) - operator(()ident(string<?) operator(()ident(symbol->string) ident(left)operator(\)) operator(()ident(symbol->string) ident(right)operator(\))operator(\))operator(\))operator(\))operator(\)) - -comment(;; @@PLEAC@@_5.5) -comment(; All approaches shown in the previous section apply here also, so) -comment(; there is little to be gained by repeating those examples [i.e. the) -comment(; use of 'for-each' and similar]. It is always possible, of course,) -comment(; to directly recurse over an association list:) - -comment(; *food-colour* association list from an earlier section) - -operator(()reserved(define) ident(*sorted-food-colour*) - operator(()ident(sort) - ident(*food-colour*) - operator(()reserved(lambda) operator(()ident(left) ident(right)operator(\)) - operator(()ident(string<?) - operator(()ident(symbol->string) operator(()ident(car) ident(left)operator(\))operator(\)) - operator(()ident(symbol->string) operator(()ident(car) ident(right)operator(\))operator(\))operator(\))operator(\)) operator(\))operator(\)) - -operator(()reserved(let) ident(loop) operator(()operator(()ident(hash) ident(*sorted-food-colour*)operator(\))operator(\)) - operator(()reserved(cond) - operator(()operator(()ident(null?) ident(hash)operator(\)) operator(')operator(()operator(\))operator(\)) - operator(()ident(else) - operator(()ident(print) - operator(()ident(symbol->string) operator(()ident(car) operator(()ident(car) ident(hash)operator(\))operator(\))operator(\)) string<delimiter(")content(=>)delimiter(")> operator(()ident(cdr) operator(()ident(car) ident(hash)operator(\))operator(\)) operator(\)) - operator(()ident(loop) operator(()ident(cdr) ident(hash)operator(\))operator(\))operator(\)) operator(\))operator(\)) - -comment(;; @@PLEAC@@_5.6) -comment(; AFAIK, Scheme doesn't offer a facility similar to Perl's 'Tie::IxHash'.) -comment(; Therefore, use an association list if retrieval [from a dictionary) -comment(; type container] in insertion order is required.) - -operator(()reserved(define) ident(*food-colour*) operator(()ident(acons) operator(')ident(Banana) string<delimiter(")content(Yellow)delimiter(")> operator(')operator(()operator(\))operator(\))operator(\)) -operator(()reserved(set!) ident(*food-colour*) operator(()ident(acons) operator(')ident(Apple) string<delimiter(")content(Green)delimiter(")> ident(*food-colour*)operator(\))operator(\)) -operator(()reserved(set!) ident(*food-colour*) operator(()ident(acons) operator(')ident(Lemon) string<delimiter(")content(yellow)delimiter(")> ident(*food-colour*)operator(\))operator(\)) - -operator(()ident(print) string<delimiter(")content(In insertion order, the foods are:)delimiter(")>operator(\)) -operator(()ident(for-each) - operator(()reserved(lambda) operator(()ident(pair)operator(\)) - operator(()reserved(let) operator(()operator(()ident(food) operator(()ident(car) ident(pair)operator(\))operator(\)) - operator(()ident(colour) operator(()ident(cdr) ident(pair)operator(\))operator(\))operator(\)) - operator(()ident(print) string<delimiter(")content( )delimiter(")> operator(()ident(symbol->string) ident(food)operator(\))operator(\)) operator(\))operator(\)) - ident(*food-colour*)operator(\)) - -operator(()ident(print) string<delimiter(")content(Still in insertion order, the food's colours are:)delimiter(")>operator(\)) -operator(()ident(for-each) - operator(()reserved(lambda) operator(()ident(pair)operator(\)) - operator(()reserved(let) operator(()operator(()ident(food) operator(()ident(car) ident(pair)operator(\))operator(\)) - operator(()ident(colour) operator(()ident(cdr) ident(pair)operator(\))operator(\))operator(\)) - operator(()ident(print) operator(()ident(symbol->string) ident(food)operator(\)) string<delimiter(")content(is coloured)delimiter(")> ident(colour)operator(\)) operator(\))operator(\)) - ident(*food-colour*)operator(\)) - -comment(;; ----------------------------) - -comment(; Of course, insertion order is lost if the association list is sorted,) -comment(; or elements removed, so if maintaining insertion order is vital, it) -comment(; might pay to associate data with a timestamp [e.g. create a timestamped) -comment(; record / structure], and manipulate those entities [no example given]) - -comment(;; @@PLEAC@@_5.7) -operator(()reserved(define) ident(*ttys*) operator(')operator(()operator(\))operator(\)) - -operator(()ident(for-each) - operator(()reserved(lambda) operator(()ident(user-tty-pair)operator(\)) - operator(()reserved(let*) operator(()operator(()ident(user-tty-pair) operator(()ident(string-split) ident(user-tty-pair) char(#\\space)operator(\))operator(\)) - operator(()ident(user) operator(()ident(string->symbol) operator(()ident(car) ident(user-tty-pair)operator(\))operator(\))operator(\)) - operator(()ident(newtty) operator(()ident(cadr) ident(user-tty-pair)operator(\))operator(\)) - operator(()ident(current-ttys) operator(()ident(assoc-ref) ident(*ttys*) ident(user)operator(\))operator(\))operator(\)) - operator(()reserved(set!) ident(*ttys*) - operator(()ident(assoc-set!) ident(*ttys*) ident(user) - operator(()reserved(if) operator(()ident(not) ident(current-ttys)operator(\)) - ident(newtty) - operator(()ident(string-append) ident(current-ttys) string<delimiter(")content( )delimiter(")> ident(newtty)operator(\))operator(\)) operator(\))operator(\))operator(\))operator(\)) - operator(()ident(string-split) operator(()ident(qx) string<delimiter(")content(who|cut -d' ' -f1,2)delimiter(")>operator(\)) char(#\\newline)operator(\))operator(\)) - -operator(()ident(for-each) - operator(()reserved(lambda) operator(()ident(user-ttys)operator(\)) - operator(()ident(print) operator(()ident(symbol->string) operator(()ident(car) ident(user-ttys)operator(\))operator(\)) string<delimiter(")content(:)delimiter(")> operator(()ident(cdr) ident(user-ttys)operator(\))operator(\))operator(\)) - operator(()ident(sort) - ident(*ttys*) - operator(()reserved(lambda) operator(()ident(left) ident(right)operator(\)) - operator(()ident(string<?) - operator(()ident(symbol->string) operator(()ident(car) ident(left)operator(\))operator(\)) - operator(()ident(symbol->string) operator(()ident(car) ident(right)operator(\))operator(\))operator(\))operator(\))operator(\)) operator(\)) - -comment(;; ----------------------------) - -operator(()ident(use-modules) operator(()ident(ice-9) ident(regex)operator(\))operator(\)) - -operator(()reserved(define) operator(()ident(multi-hash-delete) ident(hash) ident(key) ident(value)operator(\)) - operator(()reserved(let) operator(()operator(()ident(value-found) operator(()ident(assoc-ref) ident(hash) ident(key)operator(\))operator(\))operator(\)) - operator(()reserved(if) ident(value-found) - operator(()ident(assoc-ref) ident(hash) ident(key) - operator(()ident(regexp-substitute/global) - pre_constant(#f) operator(()ident(string-match) ident(value) ident(value-found)operator(\)) operator(')ident(pre) string<delimiter(")delimiter(")> operator(')ident(post) string<delimiter(")delimiter(")>operator(\))operator(\))operator(\))operator(\))operator(\)) - -comment(;; @@PLEAC@@_5.8) -comment(; Alternate implementatons of a hash inversion function; both assume) -comment(; key is a symbol, value is a string) - -operator(()reserved(define) operator(()ident(assoc-invert) ident(assoc)operator(\)) - operator(()ident(map) - operator(()reserved(lambda) operator(()ident(pair)operator(\)) - operator(()reserved(cons) - operator(()ident(string->symbol) operator(()ident(cdr) ident(pair)operator(\))operator(\)) - operator(()ident(symbol->string) operator(()ident(car) ident(pair)operator(\))operator(\))operator(\))operator(\)) - ident(assoc)operator(\))operator(\)) - -comment(;; ------------) - -operator(()reserved(define) operator(()ident(assoc-invert) ident(assoc)operator(\)) - operator(()reserved(let) ident(loop) operator(()operator(()ident(assoc) ident(assoc)operator(\)) operator(()ident(new-assoc) operator(')operator(()operator(\))operator(\))operator(\)) - operator(()reserved(cond) - operator(()operator(()ident(null?) ident(assoc)operator(\)) ident(new-assoc)operator(\)) - operator(()ident(else) - operator(()ident(loop) operator(()ident(cdr) ident(assoc)operator(\)) - operator(()ident(acons) - operator(()ident(string->symbol) operator(()ident(cdar) ident(assoc)operator(\))operator(\)) - operator(()ident(symbol->string) operator(()ident(caar) ident(assoc)operator(\))operator(\)) ident(new-assoc)operator(\))operator(\)) operator(\))operator(\)) operator(\))operator(\)) - -comment(;; ----------------------------) - -operator(()reserved(define) ident(*surname*) - operator(()ident(list) - operator(')operator(()ident(Mickey) operator(.) string<delimiter(")content(Mantle)delimiter(")>operator(\)) - operator(')operator(()ident(Babe) operator(.) string<delimiter(")content(Ruth)delimiter(")>operator(\))operator(\))operator(\)) - -operator(()reserved(define) ident(*first-name*) operator(()ident(assoc-invert) ident(*surname*)operator(\))operator(\)) - -operator(()ident(print) operator(()ident(assoc-ref) ident(*first-name*) operator(')ident(Mantle)operator(\))operator(\)) - -comment(;; ----------------------------) - -comment(; foodfind) - -operator(()reserved(define) ident(*given*) operator(()ident(string->symbol) operator(()ident(cadr) operator(()ident(command-line)operator(\))operator(\))operator(\))operator(\)) - -operator(()reserved(define) ident(*colour*) - operator(()ident(list) - operator(')operator(()ident(Apple) operator(.) string<delimiter(")content(red)delimiter(")>operator(\)) - operator(')operator(()ident(Lemon) operator(.) string<delimiter(")content(yellow)delimiter(")>operator(\)) - operator(')operator(()ident(Carrot) operator(.) string<delimiter(")content(orange)delimiter(")>operator(\))operator(\))operator(\)) - -operator(()reserved(define) ident(*food*) operator(()ident(assoc-invert) ident(*colour*)operator(\))operator(\)) - -operator(()reserved(if) operator(()ident(assoc-ref) ident(*colour*) ident(*given*)operator(\)) - operator(()ident(print) - operator(()ident(symbol->string) ident(*given*)operator(\)) - string<delimiter(")content(is a food with colour)delimiter(")> - operator(()ident(assoc-ref) ident(*colour*) ident(*given*)operator(\))operator(\))operator(\)) - -operator(()reserved(if) operator(()ident(assoc-ref) ident(*food*) ident(*given*)operator(\)) - operator(()ident(print) - operator(()ident(assoc-ref) ident(*food*) ident(*given*)operator(\)) - string<delimiter(")content(is a food with colour)delimiter(")> - operator(()ident(symbol->string) ident(*given*)operator(\))operator(\))operator(\)) - -comment(;; @@PLEAC@@_5.9) -comment(; *food-colour* association list from an earlier section) - -comment(; Use 'sort' to sort the entire hash, on key or on value, ascending or) -comment(; descending order) -operator(()reserved(define) ident(*sorted-on-key:food-colour*) - operator(()ident(sort) - ident(*food-colour*) - operator(()reserved(lambda) operator(()ident(left) ident(right)operator(\)) - operator(()ident(string<?) - operator(()ident(symbol->string) operator(()ident(car) ident(left)operator(\))operator(\)) - operator(()ident(symbol->string) operator(()ident(car) ident(right)operator(\))operator(\))operator(\))operator(\)) operator(\))operator(\)) - -operator(()reserved(define) ident(*sorted-on-value:food-colour*) - operator(()ident(sort) - ident(*food-colour*) - operator(()reserved(lambda) operator(()ident(left) ident(right)operator(\)) - operator(()ident(string<?) - operator(()ident(cdr) ident(left)operator(\)) - operator(()ident(cdr) ident(right)operator(\))operator(\))operator(\)) operator(\))operator(\)) - -comment(;; ------------) - -operator(()ident(for-each) - operator(()reserved(lambda) operator(()ident(pair)operator(\)) - operator(()reserved(let) operator(()operator(()ident(food) operator(()ident(car) ident(pair)operator(\))operator(\)) - operator(()ident(colour) operator(()ident(cdr) ident(pair)operator(\))operator(\))operator(\)) - operator(()ident(print) - operator(()ident(symbol->string) ident(food)operator(\)) - string<delimiter(")content(is)delimiter(")> - ident(colour)operator(\))operator(\))operator(\)) - ident(*sorted-on-key:food-colour*)operator(\)) - -comment(;; ----------------------------) - -comment(; Alternatively, generate a list of keys or values, sort as required,) -comment(; and use list to guide the hash traversal) - -operator(()reserved(define) ident(*sorted-food-colour-keys*) - operator(()ident(sort) - operator(()ident(fold-right) - operator(()reserved(lambda) operator(()ident(pair) ident(accum)operator(\)) operator(()reserved(cons) operator(()ident(car) ident(pair)operator(\)) ident(accum)operator(\))operator(\)) - operator(')operator(()operator(\)) - ident(*food-colour*)operator(\)) - operator(()reserved(lambda) operator(()ident(left) ident(right)operator(\)) - operator(()ident(string<?) - operator(()ident(symbol->string) ident(left)operator(\)) - operator(()ident(symbol->string) ident(right)operator(\))operator(\))operator(\)) operator(\))operator(\)) - -operator(()reserved(define) ident(*sorted-food-colour-values*) - operator(()ident(sort) - operator(()ident(fold-right) - operator(()reserved(lambda) operator(()ident(pair) ident(accum)operator(\)) operator(()reserved(cons) operator(()ident(cdr) ident(pair)operator(\)) ident(accum)operator(\))operator(\)) - operator(')operator(()operator(\)) - ident(*food-colour*)operator(\)) - operator(()reserved(lambda) operator(()ident(left) ident(right)operator(\)) - operator(()ident(string<?) ident(left) ident(right)operator(\))operator(\)) operator(\))operator(\)) - -comment(;; ------------) - -operator(()ident(for-each) - operator(()reserved(lambda) operator(()ident(food)operator(\)) - operator(()ident(print) operator(()ident(symbol->string) ident(food)operator(\)) string<delimiter(")content(is)delimiter(")> operator(()ident(assoc-ref) ident(*food-colour*) ident(food)operator(\))operator(\))operator(\)) - ident(*sorted-food-colour-keys*)operator(\)) - -comment(;; @@PLEAC@@_5.10) -comment(; If merging is defined as the combining of the contents of two or more) -comment(; hashes, then it is simply a matter of copying the contents of each) -comment(; into a new hash) - -comment(; Association lists can simply be appended together) -operator(()reserved(define) ident(*food-colour*) - operator(()ident(list) - operator(')operator(()ident(Apple) operator(.) string<delimiter(")content(red)delimiter(")>operator(\)) - operator(')operator(()ident(Banana) operator(.) string<delimiter(")content(yellow)delimiter(")>operator(\)) - operator(')operator(()ident(Lemon) operator(.) string<delimiter(")content(yellow)delimiter(")>operator(\)) - operator(')operator(()ident(Carrot) operator(.) string<delimiter(")content(orange)delimiter(")>operator(\))operator(\))operator(\)) - -operator(()reserved(define) ident(*drink-colour*) - operator(()ident(list) - operator(')operator(()ident(Galliano) operator(.) string<delimiter(")content(yellow)delimiter(")>operator(\)) - operator(')operator(()ident(Mai) ident(Tai) operator(.) string<delimiter(")content(blue)delimiter(")>operator(\))operator(\))operator(\)) - -operator(()reserved(define) ident(*ingested-colour*) operator(()ident(append) ident(*food-colour*) ident(*drink-colour*)operator(\))operator(\)) - -comment(;; ----------------------------) - -comment(; Hash tables built from vectors can be copied element by element into) -comment(; a new vector, or spliced together using 'vector-join' [see Chapter 4]) - -operator(()reserved(define) ident(*food-colour*) operator(()ident(make-vector) integer(20) operator(')operator(()operator(\))operator(\)) -comment(; ...) -operator(()reserved(define) ident(*drink-colour*) operator(()ident(make-vector) integer(20) operator(')operator(()operator(\))operator(\)) -comment(; ...) - -operator(()reserved(define) ident(*ingested-colour*) - operator(()ident(vector-join) ident(*food-colour*) ident(*drink-colour*)operator(\))operator(\)) - -comment(;; @@PLEAC@@_5.11) -operator(()reserved(define) ident(*common*) operator(')operator(()operator(\))operator(\)) -operator(()reserved(define) ident(*this-not-that*) operator(')operator(()operator(\))operator(\)) - -comment(;; ------------) - -operator(()reserved(define) ident(*dict1*) - operator(()ident(list) - operator(')operator(()ident(Apple) operator(.) string<delimiter(")content(red)delimiter(")>operator(\)) - operator(')operator(()ident(Lemon) operator(.) string<delimiter(")content(yellow)delimiter(")>operator(\)) - operator(')operator(()ident(Carrot) operator(.) string<delimiter(")content(orange)delimiter(")>operator(\))operator(\))operator(\)) - -operator(()reserved(define) ident(*dict2*) - operator(()ident(list) - operator(')operator(()ident(Apple) operator(.) string<delimiter(")content(red)delimiter(")>operator(\)) - operator(')operator(()ident(Carrot) operator(.) string<delimiter(")content(orange)delimiter(")>operator(\))operator(\))operator(\)) - -comment(;; ------------) - -comment(; Find items common to '*dict1*' and '*dict2*') -operator(()ident(for-each) - operator(()reserved(lambda) operator(()ident(pair)operator(\)) - operator(()reserved(let) operator(()operator(()ident(key) operator(()ident(car) ident(pair)operator(\))operator(\)) - operator(()ident(value) operator(()ident(cdr) ident(pair)operator(\))operator(\))operator(\)) - operator(()reserved(if) operator(()ident(assoc-ref) ident(*dict2*) ident(key)operator(\)) - operator(()reserved(set!) ident(*common*) operator(()reserved(cons) ident(key) ident(*common*)operator(\))operator(\))operator(\)) operator(\))operator(\)) - ident(*dict1*)operator(\)) - -comment(;; ------------) - -comment(; Find items in '*dict1*' but not '*dict2*') -operator(()ident(for-each) - operator(()reserved(lambda) operator(()ident(pair)operator(\)) - operator(()reserved(let) operator(()operator(()ident(key) operator(()ident(car) ident(pair)operator(\))operator(\)) - operator(()ident(value) operator(()ident(cdr) ident(pair)operator(\))operator(\))operator(\)) - operator(()reserved(if) operator(()ident(not) operator(()ident(assoc-ref) ident(*dict2*) ident(key)operator(\))operator(\)) - operator(()reserved(set!) ident(*this-not-that*) operator(()reserved(cons) ident(key) ident(*this-not-that*)operator(\))operator(\))operator(\)) operator(\))operator(\)) - ident(*dict1*)operator(\)) - -comment(;; ----------------------------) - -operator(()reserved(define) ident(*non-citrus*) operator(')operator(()operator(\))operator(\)) - -operator(()reserved(define) ident(*citrus-colour*) - operator(()ident(list) - operator(')operator(()ident(Lemon) operator(.) string<delimiter(")content(yellow)delimiter(")>operator(\)) - operator(')operator(()ident(Orange) operator(.) string<delimiter(")content(orange)delimiter(")>operator(\)) - operator(')operator(()ident(Lime) operator(.) string<delimiter(")content(green)delimiter(")>operator(\))operator(\))operator(\)) - -operator(()reserved(define) ident(*food-colour*) - operator(()ident(list) - operator(')operator(()ident(Apple) operator(.) string<delimiter(")content(red)delimiter(")>operator(\)) - operator(')operator(()ident(Banana) operator(.) string<delimiter(")content(yellow)delimiter(")>operator(\)) - operator(')operator(()ident(Lemon) operator(.) string<delimiter(")content(yellow)delimiter(")>operator(\)) - operator(')operator(()ident(Carrot) operator(.) string<delimiter(")content(orange)delimiter(")>operator(\))operator(\))operator(\)) - -operator(()ident(for-each) - operator(()reserved(lambda) operator(()ident(pair)operator(\)) - operator(()reserved(let) operator(()operator(()ident(key) operator(()ident(car) ident(pair)operator(\))operator(\)) - operator(()ident(value) operator(()ident(cdr) ident(pair)operator(\))operator(\))operator(\)) - operator(()reserved(if) operator(()ident(not) operator(()ident(assoc-ref) ident(*citrus-colour*) ident(key)operator(\))operator(\)) - operator(()reserved(set!) ident(*non-citrus*) operator(()reserved(cons) ident(key) ident(*non-citrus*)operator(\))operator(\))operator(\)) operator(\))operator(\)) - ident(*food-colour*)operator(\)) - -comment(;; @@PLEAC@@_5.12) -comment(; All objects [including functions] are first class entities, so there) -comment(; is no problem / special treatment needed to use any object, including) -comment(; those classed as 'references' [e.g. file handles or ports] as keys) - -operator(()ident(use-modules) operator(()ident(srfi) ident(srfi-1)operator(\)) operator(()ident(srfi) ident(srfi-13)operator(\))operator(\)) - -operator(()reserved(define) ident(*ports*) operator(')operator(()operator(\))operator(\)) - -operator(()ident(for-each) - operator(()reserved(lambda) operator(()ident(filename)operator(\)) - operator(()reserved(let) operator(()operator(()ident(port) operator(()ident(open-input-file) ident(filename)operator(\))operator(\))operator(\)) - operator(()reserved(set!) ident(*ports*) operator(()ident(assoc-set!) ident(*ports*) ident(port) ident(filename)operator(\))operator(\)) operator(\))operator(\)) - operator(')operator(()string<delimiter(")content(/etc/termcap)delimiter(")> string<delimiter(")content(/vmlinux)delimiter(")> string<delimiter(")content(/bin/cat)delimiter(")>operator(\))operator(\)) - -operator(()ident(print) - operator(()ident(string-append) string<delimiter(")content(open files: )delimiter(")> - operator(()ident(string-drop) - operator(()ident(fold-right) - operator(()reserved(lambda) operator(()ident(pair) ident(accum)operator(\)) operator(()ident(string-append) string<delimiter(")content(, )delimiter(")> operator(()ident(cdr) ident(pair)operator(\)) ident(accum)operator(\))operator(\)) - string<delimiter(")delimiter(")> - ident(*ports*)operator(\)) - integer(2)operator(\))operator(\))operator(\)) - -operator(()ident(for-each) - operator(()reserved(lambda) operator(()ident(pair)operator(\)) - operator(()reserved(let) operator(()operator(()ident(port) operator(()ident(car) ident(pair)operator(\))operator(\)) - operator(()ident(filename) operator(()ident(cdr) ident(pair)operator(\))operator(\))operator(\)) - operator(()ident(seek) ident(port) integer(0) ident(SEEK_END)operator(\)) - operator(()ident(print) ident(filename) string<delimiter(")content(is)delimiter(")> operator(()ident(number->string) operator(()ident(ftell) ident(port)operator(\))operator(\)) string<delimiter(")content(bytes long.)delimiter(")>operator(\)) - operator(()ident(close-input-port) ident(port)operator(\)) operator(\))operator(\)) - ident(*ports*)operator(\)) - -comment(;; @@PLEAC@@_5.13) -comment(; An association list takes on the size of the number of elements with) -comment(; which it is initialised, so presizing is implicit) - -operator(()reserved(define) ident(*hash*) operator(')operator(()operator(\))operator(\)) comment(; zero elements) - -comment(;; ------------) - -operator(()reserved(define) ident(*hash*) comment(; three elements) - operator(()ident(list) - operator(')operator(()ident(Apple) operator(.) string<delimiter(")content(red)delimiter(")>operator(\)) - operator(')operator(()ident(Lemon) operator(.) string<delimiter(")content(yellow)delimiter(")>operator(\)) - operator(')operator(()ident(Carrot) operator(.) string<delimiter(")content(orange)delimiter(")>operator(\))operator(\))operator(\)) - -comment(;; ----------------------------) - -comment(; A size [i.e. number of entries] must be specified when a hash table) -comment(; is created, so presizing is implicit) - -operator(()reserved(define) ident(*hash*) operator(()ident(make-hash-table) integer(100)operator(\))operator(\)) - -comment(;; ------------) - -operator(()reserved(define) ident(*hash*) operator(()ident(make-vector) integer(100) operator(')operator(()operator(\))operator(\))operator(\)) - -comment(;; @@PLEAC@@_5.14) -operator(()reserved(define) ident(*array*) - operator(()ident(list) operator(')ident(a) operator(')ident(b) operator(')ident(c) operator(')ident(d) operator(')ident(d) operator(')ident(a) operator(')ident(a) operator(')ident(c) operator(')ident(d) operator(')ident(d) operator(')ident(e)operator(\))operator(\)) - -comment(;; ----------------------------) - -operator(()reserved(define) ident(*count*) operator(')operator(()operator(\))operator(\)) - -operator(()ident(for-each) - operator(()reserved(lambda) operator(()ident(element)operator(\)) - operator(()reserved(let) operator(()operator(()ident(value) operator(()ident(assoc-ref) ident(*count*) ident(element)operator(\))operator(\))operator(\)) - operator(()reserved(if) operator(()ident(not) ident(value)operator(\)) operator(()reserved(set!) ident(value) integer(0)operator(\))operator(\)) - operator(()reserved(set!) ident(*count*) operator(()ident(assoc-set!) ident(*count*) ident(element) operator(()ident(+) integer(1) ident(value)operator(\))operator(\))operator(\))operator(\))operator(\)) - ident(*array*)operator(\)) - -comment(;; ----------------------------) - -operator(()reserved(define) ident(*count*) operator(()ident(make-hash-table) integer(20)operator(\))operator(\)) - -operator(()ident(for-each) - operator(()reserved(lambda) operator(()ident(element)operator(\)) - operator(()reserved(let) operator(()operator(()ident(value) operator(()ident(hash-ref) ident(*count*) ident(element)operator(\))operator(\))operator(\)) - operator(()reserved(if) operator(()ident(not) ident(value)operator(\)) operator(()reserved(set!) ident(value) integer(0)operator(\))operator(\)) - operator(()ident(hash-set!) ident(*count*) ident(element) operator(()ident(+) integer(1) ident(value)operator(\))operator(\))operator(\))operator(\)) - ident(*array*)operator(\)) - -comment(;; @@PLEAC@@_5.15) -operator(()reserved(define) ident(*father*) - operator(()ident(list) - operator(')operator(()ident(Cain) operator(.) ident(Adam)operator(\)) - operator(')operator(()ident(Abel) operator(.) ident(Adam)operator(\)) - operator(')operator(()ident(Seth) operator(.) ident(Adam)operator(\)) - operator(')operator(()ident(Enoch) operator(.) ident(Cain)operator(\)) - operator(')operator(()ident(Irad) operator(.) ident(Enoch)operator(\)) - operator(')operator(()ident(Mehujael) operator(.) ident(Irad)operator(\)) - operator(')operator(()ident(Methusael) operator(.) ident(Mehujael)operator(\)) - operator(')operator(()ident(Lamech) operator(.) ident(Methusael)operator(\)) - operator(')operator(()ident(Jabal) operator(.) ident(Lamech)operator(\)) - operator(')operator(()ident(Jubal) operator(.) ident(Lamech)operator(\)) - operator(')operator(()ident(Tubalcain) operator(.) ident(Lamech)operator(\)) - operator(')operator(()ident(Enos) operator(.) ident(Seth)operator(\))operator(\))operator(\)) - -comment(;; ------------) - -operator(()ident(use-modules) operator(()ident(srfi) ident(srfi-1)operator(\)) operator(()ident(ice-9) ident(rdelim)operator(\))operator(\)) - -operator(()reserved(let) operator(()operator(()ident(port) operator(()ident(open-input-file) ident(*filename*)operator(\))operator(\))operator(\)) - operator(()reserved(let) ident(loop) operator(()operator(()ident(line&terminator) operator(()ident(read-line) ident(port) operator(')ident(split)operator(\))operator(\))operator(\)) - operator(()reserved(cond) - operator(()operator(()ident(eof-object?) operator(()ident(cdr) ident(line&terminator)operator(\))operator(\)) operator(')operator(()operator(\))operator(\)) - operator(()ident(else) - operator(()reserved(let) operator(()operator(()ident(person) operator(()ident(string->symbol) operator(()ident(car) ident(line&terminator)operator(\))operator(\))operator(\))operator(\)) - operator(()reserved(let) ident(loop) operator(()operator(()ident(father) operator(()ident(assoc-ref) ident(*father*) ident(person)operator(\))operator(\))operator(\)) - operator(()reserved(if) ident(father) - operator(()reserved(begin) - operator(()ident(print) ident(father)operator(\)) - operator(()ident(loop) operator(()ident(assoc-ref) ident(*father*) ident(father)operator(\))operator(\)) operator(\))operator(\))operator(\)) - operator(()ident(loop) operator(()ident(read-line) ident(port) operator(')ident(split)operator(\))operator(\)) operator(\))operator(\))operator(\))operator(\)) - operator(()ident(close-input-port) ident(port)operator(\))operator(\)) - -comment(;; ------------) - -operator(()ident(use-modules) operator(()ident(srfi) ident(srfi-1)operator(\)) operator(()ident(ice-9) ident(rdelim)operator(\))operator(\)) - -operator(()reserved(define) operator(()ident(assoc-invert-N:M) ident(assoc)operator(\)) - operator(()reserved(let) operator(()operator(()ident(new-assoc) operator(')operator(()operator(\))operator(\))operator(\)) - operator(()ident(for-each) - operator(()reserved(lambda) operator(()ident(pair)operator(\)) - operator(()reserved(let*) operator(()operator(()ident(old-key) operator(()ident(car) ident(pair)operator(\))operator(\)) - operator(()ident(new-key) operator(()ident(cdr) ident(pair)operator(\))operator(\)) - operator(()ident(new-key-found) operator(()ident(assoc-ref) ident(new-assoc) ident(new-key)operator(\))operator(\))operator(\)) - operator(()reserved(if) operator(()ident(not) ident(new-key-found)operator(\)) - operator(()reserved(set!) ident(new-assoc) operator(()ident(acons) ident(new-key) operator(()ident(list) ident(old-key)operator(\)) ident(new-assoc)operator(\))operator(\)) - comment(;else) - operator(()reserved(set!) ident(new-assoc) operator(()ident(assoc-set!) ident(new-assoc) ident(new-key) operator(()reserved(cons) ident(old-key) ident(new-key-found)operator(\))operator(\))operator(\)) operator(\))operator(\))operator(\)) - ident(assoc)operator(\)) - ident(new-assoc)operator(\))operator(\)) - -operator(()reserved(define) ident(*children*) operator(()ident(assoc-invert-N:M) ident(*father*)operator(\))operator(\)) - -operator(()reserved(let) operator(()operator(()ident(port) operator(()ident(open-input-file) ident(*filename*)operator(\))operator(\))operator(\)) - operator(()reserved(let) ident(loop) operator(()operator(()ident(line&terminator) operator(()ident(read-line) ident(port) operator(')ident(split)operator(\))operator(\))operator(\)) - operator(()reserved(cond) - operator(()operator(()ident(eof-object?) operator(()ident(cdr) ident(line&terminator)operator(\))operator(\)) operator(')operator(()operator(\))operator(\)) - operator(()ident(else) - operator(()reserved(let*) operator(()operator(()ident(person) operator(()ident(string->symbol) operator(()ident(car) ident(line&terminator)operator(\))operator(\))operator(\)) - operator(()ident(children-found) operator(()ident(assoc-ref) ident(*children*) ident(person)operator(\))operator(\))operator(\)) - operator(()ident(print) operator(()ident(symbol->string) ident(person)operator(\)) string<delimiter(")content(begat:)delimiter(")>operator(\)) - operator(()reserved(if) operator(()ident(not) ident(children-found)operator(\)) - operator(()ident(print) string<delimiter(")content(nobody)delimiter(")>operator(\)) - comment(;else) - operator(()ident(for-each) - operator(()reserved(lambda) operator(()ident(child)operator(\)) operator(()ident(print) operator(()ident(symbol->string) ident(child)operator(\)) string<delimiter(")content(,)delimiter(")>operator(\))operator(\)) - ident(children-found)operator(\))operator(\)) - operator(()ident(loop) operator(()ident(read-line) ident(port) operator(')ident(split)operator(\))operator(\)) operator(\))operator(\))operator(\))operator(\)) - operator(()ident(close-input-port) ident(port)operator(\))operator(\)) - -comment(;; @@PLEAC@@_5.16) -comment(;; @@INCOMPLETE@@) -comment(;; @@INCOMPLETE@@) - -comment(;; @@PLEAC@@_7.0) -comment(;; use (open-input-file filename\) or (open filename O_RDONLY\)) - -operator(()reserved(define) ident(input) operator(()ident(open-input-file) string<delimiter(")content(/usr/local/widgets/data)delimiter(")>operator(\))operator(\)) -operator(()reserved(let) ident(loop) operator(()operator(()ident(line) operator(()ident(read-line) ident(input) operator(')ident(concat)operator(\))operator(\))operator(\)) - operator(()reserved(cond) operator(()operator(()ident(not) operator(()ident(eof-object?) ident(line)operator(\))operator(\)) - operator(()reserved(if) operator(()ident(string-match) string<delimiter(")content(blue)delimiter(")> ident(line)operator(\)) - operator(()ident(display) ident(line)operator(\))operator(\)) - operator(()ident(loop) operator(()ident(read-line) ident(input) operator(')ident(concat)operator(\))operator(\))operator(\))operator(\))operator(\)) -operator(()ident(close) ident(input)operator(\)) - -comment(;; Many I/O functions default to the logical STDIN/OUT) - -comment(;; You can also explicitly get the standard ports with) -comment(;; [set-]current-{input,output,error}-port.) - -comment(;; format takes a port as the first argument. If #t is given, format) -comment(;; writes to stdout, if #f is given, format returns a string.) - -operator(()reserved(let) ident(loop) operator(()operator(()ident(line) operator(()ident(read-line)operator(\))operator(\))operator(\)) comment(; reads from stdin) - operator(()reserved(cond) operator(()operator(()ident(not) operator(()ident(eof-object?) ident(line)operator(\))operator(\)) - operator(()reserved(if) operator(()ident(not) operator(()ident(string-match) string<delimiter(")content([0-9])delimiter(")> ident(line)operator(\))operator(\)) - comment(;; writes to stderr) - operator(()ident(display) string<delimiter(")content(No digit found.)content(\\n)delimiter(")> operator(()ident(current-error-port)operator(\))operator(\)) - comment(;; writes to stdout) - operator(()ident(format) pre_constant(#t) string<delimiter(")content(Read: ~A)content(\\n)delimiter(")> ident(line)operator(\))operator(\)) - operator(()ident(loop) operator(()ident(read-line)operator(\))operator(\))operator(\))operator(\))operator(\)) - -comment(;; use open-output-file) - -operator(()reserved(define) ident(logfile) operator(()ident(open-output-file) string<delimiter(")content(/tmp/log)delimiter(")>operator(\))operator(\)) - -comment(;; increasingly specific ways of closing ports (it's safe to close a) -comment(;; closed port\)) - -operator(()ident(close) ident(logfile)operator(\)) comment(; #t) -operator(()ident(close-port) ident(logfile)operator(\)) comment(; #f (already closed\)) -operator(()ident(close-output-port) ident(logfile)operator(\)) comment(; unspecified) - -comment(;; you can rebind standard ports with set-current-<foo>-port:) - -operator(()reserved(let) operator(()operator(()ident(old-out) operator(()ident(current-output-port)operator(\))operator(\))operator(\)) - operator(()ident(set-current-output-port) ident(logfile)operator(\)) - operator(()ident(display) string<delimiter(")content(Countdown initiated ...)content(\\n)delimiter(")>operator(\)) - operator(()ident(set-current-output-port) ident(old-out)operator(\)) - operator(()ident(display) string<delimiter(")content(You have 30 seconds to reach minimum safety distance.)content(\\n)delimiter(")>operator(\))operator(\)) - -comment(;; or) - -operator(()ident(with-output-to-file) ident(logfile) - operator(()reserved(lambda) operator(()operator(\)) operator(()ident(display) string<delimiter(")content(Countdown initiated ...)content(\\n)delimiter(")>operator(\))operator(\))operator(\)) -operator(()ident(display) string<delimiter(")content(You have 30 seconds to reach minimum safety distance.)content(\\n)delimiter(")>operator(\)) - - -comment(;; @@PLEAC@@_7.1) -operator(()reserved(define) ident(source) operator(()ident(open-input-file) ident(path)operator(\))operator(\)) -operator(()reserved(define) ident(sink) operator(()ident(open-output-file) ident(path)operator(\))operator(\)) - -operator(()reserved(define) ident(source) operator(()ident(open) ident(path) ident(O_RDONLY)operator(\))operator(\)) -operator(()reserved(define) ident(sink) operator(()ident(open) ident(path) ident(O_WRONLY)operator(\))operator(\)) - -comment(;;-----------------------------) -operator(()reserved(define) ident(port) operator(()ident(open-input-file) ident(path)operator(\))operator(\)) -operator(()reserved(define) ident(port) operator(()ident(open-file) ident(path) string<delimiter(")content(r)delimiter(")>operator(\))operator(\)) -operator(()reserved(define) ident(port) operator(()ident(open) ident(path) ident(O_RDONLY)operator(\))operator(\)) -comment(;;-----------------------------) -operator(()reserved(define) ident(port) operator(()ident(open-output-file) ident(path)operator(\))operator(\)) -operator(()reserved(define) ident(port) operator(()ident(open-file) ident(path) string<delimiter(")content(w)delimiter(")>operator(\))operator(\)) -operator(()reserved(define) ident(port) operator(()ident(open) ident(path) operator(()ident(logior) ident(O_WRONLY) ident(O_TRUNC) ident(O_CREAT)operator(\))operator(\))operator(\)) -comment(;;-----------------------------) -operator(()reserved(define) ident(port) operator(()ident(open) ident(path) operator(()ident(logior) ident(O_WRONLY) ident(O_EXCL) ident(O_CREAT)operator(\))operator(\))operator(\)) -comment(;;-----------------------------) -operator(()reserved(define) ident(port) operator(()ident(open-file) ident(path) string<delimiter(")content(a)delimiter(")>operator(\))operator(\)) -operator(()reserved(define) ident(port) operator(()ident(open) ident(path) operator(()ident(logior) ident(O_WRONLY) ident(O_APPEND) ident(O_CREAT)operator(\))operator(\))operator(\)) -comment(;;-----------------------------) -operator(()reserved(define) ident(port) operator(()ident(open) ident(path) operator(()ident(logior) ident(O_WRONLY) ident(O_APPEND)operator(\))operator(\))operator(\)) -comment(;;-----------------------------) -operator(()reserved(define) ident(port) operator(()ident(open) ident(path) ident(O_RDWR)operator(\))operator(\)) -comment(;;-----------------------------) -operator(()reserved(define) ident(port) operator(()ident(open-file) ident(path) string<delimiter(")content(r+)delimiter(")>operator(\))operator(\)) -operator(()reserved(define) ident(port) operator(()ident(open) ident(path) operator(()ident(logior) ident(O_RDWR) ident(O_CREAT)operator(\))operator(\))operator(\)) -comment(;;-----------------------------) -operator(()reserved(define) ident(port) operator(()ident(open) ident(path) operator(()ident(logior) ident(O_RDWR) ident(O_EXCL) ident(O_CREAT)operator(\))operator(\))operator(\)) -comment(;;-----------------------------) - -comment(;; @@PLEAC@@_7.2) -comment(;; Nothing different needs to be done with Guile) - -comment(;; @@PLEAC@@_7.3) -operator(()reserved(define) ident(expand-user) - operator(()reserved(let) operator(()operator(()ident(rx) operator(()ident(make-regexp) string<delimiter(")content(^)content(\\\\)content(~([^/]+\)?)delimiter(")>operator(\))operator(\))operator(\)) - operator(()reserved(lambda) operator(()ident(filename)operator(\)) - operator(()reserved(let) operator(()operator(()ident(m) operator(()ident(regexp-exec) ident(rx) ident(filename)operator(\))operator(\))operator(\)) - operator(()reserved(if) ident(m) - operator(()ident(string-append) - operator(()reserved(if) operator(()ident(match:substring) ident(m) integer(1)operator(\)) - operator(()ident(passwd:dir) operator(()ident(getpwnam) operator(()ident(match:substring) ident(m) integer(1)operator(\))operator(\))operator(\)) - operator(()reserved(or) operator(()ident(getenv) string<delimiter(")content(HOME)delimiter(")>operator(\)) operator(()ident(getenv) string<delimiter(")content(LOGDIR)delimiter(")>operator(\)) - operator(()ident(passwd:dir) operator(()ident(getpwuid) operator(()ident(cuserid)operator(\))operator(\))operator(\)) string<delimiter(")delimiter(")>operator(\))operator(\)) - operator(()ident(substring) ident(filename) operator(()ident(match:end) ident(m)operator(\))operator(\))operator(\)) - ident(filename)operator(\))operator(\))operator(\))operator(\))operator(\)) - -comment(;; @@PLEAC@@_7.4) -operator(()reserved(define) ident(port) operator(()ident(open-file) ident(filename) ident(mode)operator(\))operator(\)) comment(; raise an exception on error) - -comment(;; use catch to trap errors) -operator(()ident(catch) operator(')ident(system-error) comment(; the type of error thrown) - operator(()reserved(lambda) operator(()operator(\)) operator(()reserved(set!) ident(port) operator(()ident(open-file) ident(filename) ident(mode)operator(\))operator(\))operator(\)) comment(; thunk to try) - operator(()reserved(lambda) operator(()ident(key) operator(.) ident(args)operator(\)) comment(; exception handler) - operator(()reserved(let) operator(()operator(()ident(fmt) operator(()ident(cadr) ident(args)operator(\))operator(\)) - operator(()ident(msg&path) operator(()ident(caddr) ident(args)operator(\))operator(\))operator(\)) - operator(()ident(format) operator(()ident(current-error-port)operator(\)) ident(fmt) operator(()ident(car) ident(msg&path)operator(\)) operator(()ident(cadr) ident(msg&path)operator(\))operator(\)) - operator(()ident(newline)operator(\))operator(\))operator(\))operator(\)) - -comment(;; @@PLEAC@@_7.5) -comment(;; use the POSIX tmpnam) -operator(()reserved(let) operator(()operator(()ident(name) operator(()ident(tmpnam)operator(\))operator(\))operator(\)) - operator(()ident(call-with-output-file) ident(name) - operator(()reserved(lambda) operator(()ident(port)operator(\)) - comment(;; ... output to port) - operator(\))operator(\))operator(\)) - -comment(;; better to test and be sure you have exclusive access to the file) -comment(;; (temp file name will be available as (port-filename port\)\)) -operator(()reserved(define) operator(()ident(open-temp-file)operator(\)) - operator(()reserved(let) ident(loop) operator(()operator(()ident(name) operator(()ident(tmpnam)operator(\))operator(\))operator(\)) - operator(()ident(catch) operator(')ident(system-error) - operator(()reserved(lambda) operator(()operator(\)) operator(()ident(open) ident(name) operator(()ident(logior) ident(O_RDWR) ident(O_CREAT) ident(O_EXCL)operator(\))operator(\))operator(\)) - operator(()reserved(lambda) operator(()ident(key) operator(.) ident(args)operator(\)) operator(()ident(loop) operator(()ident(tmpnam)operator(\))operator(\))operator(\))operator(\))operator(\))operator(\)) - -comment(;; or let mkstemp! do the work for you:) -operator(()reserved(define) ident(port) operator(()ident(mkstemp!) ident(template-string-ending-in-XXXXXX)operator(\))operator(\)) - -operator(()reserved(let*) operator(()operator(()ident(tmpl) string<delimiter(")content(/tmp/programXXXXXX)delimiter(")>operator(\)) - operator(()ident(port) operator(()ident(mkstemp!) ident(tmpl)operator(\))operator(\))operator(\)) - comment(;; tmpl now contains the name of the temp file,) - comment(;; e.g. "/tmp/programhVoEzw") - operator(()reserved(do) operator(()operator(()ident(i) integer(0) operator(()integer(1)ident(+) ident(i)operator(\))operator(\))operator(\)) - operator(()operator(()ident(=) ident(i) integer(10)operator(\))operator(\)) - operator(()ident(format) ident(port) string<delimiter(")content(~A)content(\\n)delimiter(")> ident(i)operator(\))operator(\)) - operator(()ident(seek) ident(port) integer(0) ident(SEEK_SET)operator(\)) - operator(()ident(display) string<delimiter(")content(Tmp file has:)content(\\n)delimiter(")>operator(\)) - operator(()reserved(do) operator(()operator(()ident(line) operator(()ident(read-line) ident(port) operator(')ident(concat)operator(\)) operator(()ident(read-line) ident(port) operator(')ident(concat)operator(\))operator(\))operator(\)) - operator(()operator(()ident(eof-object?) ident(line)operator(\))operator(\)) - operator(()ident(display) ident(line)operator(\))operator(\)) - operator(()ident(close) ident(port)operator(\))operator(\)) - -comment(;; @@PLEAC@@_7.6) -comment(;; string ports are ideal for this) - -operator(()reserved(define) ident(DATA) string<delimiter(")content( -your data goes here -)delimiter(")>operator(\)) - -operator(()ident(call-with-input-string) - ident(DATA) - operator(()reserved(lambda) operator(()ident(port)operator(\)) - comment(;; ... process input from port) - operator(\))operator(\)) - -comment(;; or) - -operator(()ident(with-input-from-string) ident(DATA) - operator(()reserved(lambda) operator(()operator(\)) - comment(;; ... stdin now comes from DATA) - operator(\))operator(\)) - -comment(;; @@PLEAC@@_7.7) -comment(;; to process lines of current-input-port:) -operator(()reserved(do) operator(()operator(()ident(line) operator(()ident(read-line)operator(\)) operator(()ident(read-line)operator(\))operator(\))operator(\)) - operator(()operator(()ident(eof-object?) ident(line)operator(\))operator(\)) - comment(;; ... do something with line) - operator(\)) - -comment(;; a general filter template:) - -operator(()reserved(define) operator(()ident(body)operator(\)) - operator(()reserved(do) operator(()operator(()ident(line) operator(()ident(read-line)operator(\)) operator(()ident(read-line)operator(\))operator(\))operator(\)) - operator(()operator(()ident(eof-object?) ident(line)operator(\))operator(\)) - operator(()ident(display) ident(line)operator(\)) - operator(()ident(newline)operator(\))operator(\))operator(\)) - -operator(()reserved(let) operator(()operator(()ident(args) operator(()ident(cdr) operator(()ident(command-line)operator(\))operator(\))operator(\))operator(\)) - comment(;; ... handle options here) - operator(()reserved(if) operator(()ident(null?) ident(args)operator(\)) - operator(()ident(body)operator(\)) comment(; no args, just call body on stdin) - operator(()ident(for-each) comment(; otherwise, call body with stdin set to each arg in turn) - operator(()reserved(lambda) operator(()ident(file)operator(\)) - operator(()ident(catch) operator(')ident(system-error) - operator(()reserved(lambda) operator(()operator(\)) - operator(()ident(with-input-from-file) ident(file) - ident(body)operator(\))operator(\)) - operator(()reserved(lambda) operator(()ident(key) operator(.) ident(args)operator(\)) - operator(()ident(format) operator(()ident(current-error-port)operator(\)) operator(()ident(cadr) ident(args)operator(\)) operator(()ident(caaddr) ident(args)operator(\)) - operator(()ident(car) operator(()ident(cdaddr) ident(args)operator(\))operator(\))operator(\)) - operator(()ident(newline) operator(()ident(current-error-port)operator(\))operator(\))operator(\))operator(\))operator(\)) - ident(args)operator(\))operator(\))operator(\)) - -comment(;; example: count-chunks:) -operator(()ident(use-modules) operator(()ident(srfi) ident(srfi-1)operator(\)) operator(()ident(srfi) ident(srfi-13)operator(\)) operator(()ident(ice-9) ident(format)operator(\)) operator(()ident(ice-9) ident(regex)operator(\))operator(\)) - -comment(;; also use directory-files from 9.5 and globbing functions from 9.6) - -comment(;; can use (ice-9 getopt-long\) described in chapter 15, or process) -comment(;; options by hand) -operator(()reserved(define) ident(opt-append) integer(0)operator(\)) -operator(()reserved(define) ident(opt-ignore-ints) integer(0)operator(\)) -operator(()reserved(define) ident(opt-nostdout) integer(0)operator(\)) -operator(()reserved(define) ident(opt-unbuffer) integer(0)operator(\)) - -operator(()reserved(define) ident(args) operator(()ident(cdr) operator(()ident(command-line)operator(\))operator(\))operator(\)) - -operator(()reserved(do) operator(()operator(()ident(opts) ident(args) operator(()ident(cdr) ident(opts)operator(\))operator(\))operator(\)) - operator(()operator(()reserved(or) operator(()ident(null?) ident(opts)operator(\)) operator(()ident(not) operator(()ident(eq?) operator(()ident(string-ref) operator(()ident(car) ident(opts)operator(\)) integer(0)operator(\)) char(#\\-)operator(\))operator(\))operator(\)) - operator(()reserved(set!) ident(args) ident(opts)operator(\))operator(\)) - operator(()reserved(let) operator(()operator(()ident(opt) operator(()ident(car) ident(opts)operator(\))operator(\))operator(\)) - operator(()reserved(cond) operator(()operator(()ident(string=?) ident(opt) string<delimiter(")content(-a)delimiter(")>operator(\)) operator(()reserved(set!) ident(opt-append) operator(()integer(1)ident(+) ident(opt-append)operator(\))operator(\))operator(\)) - operator(()operator(()ident(string=?) ident(opt) string<delimiter(")content(-i)delimiter(")>operator(\)) operator(()reserved(set!) ident(opt-ignore-ints) operator(()integer(1)ident(+) ident(opt-ignore-ints)operator(\))operator(\))operator(\)) - operator(()operator(()ident(string=?) ident(opt) string<delimiter(")content(-n)delimiter(")>operator(\)) operator(()reserved(set!) ident(opt-nostdout) operator(()integer(1)ident(+) ident(opt-nostdout)operator(\))operator(\))operator(\)) - operator(()operator(()ident(string=?) ident(opt) string<delimiter(")content(-u)delimiter(")>operator(\)) operator(()reserved(set!) ident(opt-unbuffer) operator(()integer(1)ident(+) ident(opt-unbuffer)operator(\))operator(\))operator(\)) - operator(()ident(else) operator(()ident(throw) operator(')ident(usage-error) string<delimiter(")content(Unexpected argument: ~A)delimiter(")> ident(opt)operator(\))operator(\))operator(\))operator(\))operator(\)) - -comment(;; default to all C source files) -operator(()reserved(if) operator(()ident(null?) ident(args)operator(\)) operator(()reserved(set!) ident(args) operator(()ident(glob) string<delimiter(")content(*.[Cch])delimiter(")> string<delimiter(")content(.)delimiter(")>operator(\))operator(\))operator(\)) - -operator(()reserved(define) operator(()ident(find-login)operator(\)) - operator(()reserved(do) operator(()operator(()ident(line) operator(()ident(read-line)operator(\)) operator(()ident(read-line)operator(\))operator(\))operator(\)) - operator(()operator(()ident(eof-object?) ident(line)operator(\))operator(\)) - operator(()reserved(cond) operator(()operator(()ident(string-match) string<delimiter(")content(login)delimiter(")> ident(line)operator(\)) - operator(()ident(display) ident(line)operator(\)) - operator(()ident(newline)operator(\))operator(\))operator(\))operator(\))operator(\)) - -operator(()reserved(define) operator(()ident(lowercase)operator(\)) - operator(()reserved(do) operator(()operator(()ident(line) operator(()ident(read-line)operator(\)) operator(()ident(read-line)operator(\))operator(\))operator(\)) - operator(()operator(()ident(eof-object?) ident(line)operator(\))operator(\)) - operator(()ident(display) operator(()ident(string-downcase) ident(line)operator(\))operator(\)) - operator(()ident(newline)operator(\))operator(\))operator(\)) - -operator(()reserved(define) operator(()ident(count-chunks)operator(\)) - operator(()reserved(do) operator(()operator(()ident(line) operator(()ident(read-line)operator(\)) operator(()ident(read-line)operator(\))operator(\)) - operator(()ident(chunks) integer(0)operator(\))operator(\)) - operator(()operator(()reserved(or) operator(()ident(eof-object?) ident(line)operator(\)) - operator(()ident(string=?) ident(line) string<delimiter(")content(__DATA__)delimiter(")>operator(\)) operator(()ident(string=?) ident(line) string<delimiter(")content(__END__)delimiter(")>operator(\))operator(\)) - operator(()ident(format) pre_constant(#t) string<delimiter(")content(Found ~A chunks)content(\\n)delimiter(")> ident(chunks)operator(\))operator(\)) - operator(()reserved(let) operator(()operator(()ident(tokens) - operator(()ident(string-tokenize) operator(()ident(string-take) ident(line) operator(()reserved(or) operator(()ident(string-index) ident(line) char(#\\#)operator(\)) - operator(()ident(string-length) ident(line)operator(\))operator(\))operator(\))operator(\))operator(\))operator(\)) - operator(()reserved(set!) ident(chunks) operator(()ident(+) ident(chunks) operator(()ident(length) ident(tokens)operator(\))operator(\))operator(\))operator(\))operator(\))operator(\)) - -operator(()reserved(if) operator(()ident(null?) ident(args)operator(\)) - operator(()ident(count-chunks)operator(\)) comment(; or find-login, lowercase, etc.) - operator(()ident(for-each) - operator(()reserved(lambda) operator(()ident(file)operator(\)) - operator(()ident(catch) operator(')ident(system-error) - operator(()reserved(lambda) operator(()operator(\)) - operator(()ident(with-input-from-file) ident(file) - ident(count-chunks)operator(\))operator(\)) - operator(()reserved(lambda) operator(()ident(key) operator(.) ident(args)operator(\)) - operator(()ident(format) operator(()ident(current-error-port)operator(\)) operator(()ident(cadr) ident(args)operator(\)) operator(()ident(caaddr) ident(args)operator(\)) - operator(()ident(car) operator(()ident(cdaddr) ident(args)operator(\))operator(\))operator(\)) - operator(()ident(newline) operator(()ident(current-error-port)operator(\))operator(\))operator(\))operator(\))operator(\)) - ident(args)operator(\))operator(\)) - -comment(;; @@PLEAC@@_7.8) -comment(;; write changes to a temporary file then rename it) -operator(()ident(with-input-from-file) ident(old) - operator(()reserved(lambda) operator(()operator(\)) - operator(()ident(with-output-to-file) ident(new) - operator(()reserved(lambda) operator(()operator(\)) - operator(()reserved(do) operator(()operator(()ident(line) operator(()ident(read-line)operator(\)) operator(()ident(read-line)operator(\))operator(\))operator(\)) - operator(()operator(()ident(eof-object?) ident(line)operator(\))operator(\)) - comment(;; change line, then...) - operator(()ident(write-line) ident(line)operator(\))operator(\))operator(\))operator(\))operator(\))operator(\)) -operator(()ident(rename-file) ident(old) operator(()ident(string-append) ident(old) string<delimiter(")content(.orig)delimiter(")>operator(\))operator(\)) -operator(()ident(rename-file) ident(new) ident(old)operator(\)) - -comment(;; @@PLEAC@@_7.9) -comment(;; no -i switch) - -comment(;; @@PLEAC@@_7.10) -comment(;; open the file in read/write mode, slurp up the contents, modify it,) -comment(;; then write it back out:) -operator(()reserved(let) operator(()operator(()ident(p) operator(()ident(open-file) ident(file) string<delimiter(")content(r+)delimiter(")>operator(\))operator(\)) - operator(()ident(lines) operator(')operator(()operator(\))operator(\))operator(\)) - comment(;; read in lines) - operator(()reserved(do) operator(()operator(()ident(line) operator(()ident(read-line) ident(p)operator(\)) operator(()ident(read-line) ident(p)operator(\))operator(\))operator(\)) - operator(()operator(()ident(eof-object?) ident(line)operator(\))operator(\)) - operator(()reserved(set!) ident(lines) operator(()reserved(cons) ident(line) ident(lines)operator(\))operator(\))operator(\)) - comment(;; modify (reverse lines\)) - operator(()ident(seek) ident(p) integer(0) ident(SEEK_SET)operator(\)) - comment(;; write out lines) - operator(()ident(for-each) operator(()reserved(lambda) operator(()ident(x)operator(\)) operator(()ident(write-line) ident(x) ident(p)operator(\))operator(\)) ident(lines)operator(\)) - comment(;; truncate the file) - operator(()ident(truncate-file) ident(p)operator(\)) - operator(()ident(close) ident(p)operator(\))operator(\)) - -operator(()reserved(let) operator(()operator(()ident(p) operator(()ident(open-file) string<delimiter(")content(foo)delimiter(")> string<delimiter(")content(r+)delimiter(")>operator(\))operator(\)) - operator(()ident(lines) operator(')operator(()operator(\))operator(\)) - operator(()ident(date) operator(()ident(date->string) operator(()ident(current-date)operator(\))operator(\))operator(\))operator(\)) - operator(()reserved(do) operator(()operator(()ident(line) operator(()ident(read-line) ident(p) operator(')ident(concat)operator(\)) operator(()ident(read-line) ident(p) operator(')ident(concat)operator(\))operator(\))operator(\)) - operator(()operator(()ident(eof-object?) ident(line)operator(\))operator(\)) - operator(()reserved(set!) ident(lines) operator(()reserved(cons) ident(line) ident(lines)operator(\))operator(\))operator(\)) - operator(()ident(seek) ident(p) integer(0) ident(SEEK_SET)operator(\)) - operator(()ident(for-each) - operator(()reserved(lambda) operator(()ident(x)operator(\)) - operator(()ident(regexp-substitute/global) ident(p) string<delimiter(")content(DATE)delimiter(")> ident(x) operator(')ident(pre) ident(date) operator(')ident(post)operator(\))operator(\)) - operator(()ident(reverse) ident(lines)operator(\))operator(\)) - operator(()ident(truncate-file) ident(p)operator(\)) - operator(()ident(close) ident(p)operator(\))operator(\)) - -comment(;; @@PLEAC@@_7.11) -operator(()reserved(define) ident(p) operator(()ident(open-file) ident(path) string<delimiter(")content(r+)delimiter(")>operator(\))operator(\)) -operator(()ident(flock) ident(p) ident(LOCK_EX)operator(\)) -comment(;; update the file, then...) -operator(()ident(close) ident(p)operator(\)) - -comment(;; to increment a number in a file) -operator(()reserved(define) ident(p) operator(()ident(open) string<delimiter(")content(numfile)delimiter(")> operator(()ident(logior) ident(O_RDWR) ident(O_CREAT)operator(\))operator(\))operator(\)) -operator(()ident(flock) ident(p) ident(LOCK_EX)operator(\)) -comment(;; Now we have acquired the lock, it's safe for I/O) -operator(()reserved(let*) operator(()operator(()ident(obj) operator(()ident(read) ident(p)operator(\))operator(\)) - operator(()ident(num) operator(()reserved(if) operator(()ident(eof-object?) ident(obj)operator(\)) integer(0) ident(obj)operator(\))operator(\))operator(\)) - operator(()ident(seek) ident(p) integer(0) ident(SEEK_SET)operator(\)) - operator(()ident(truncate-file) ident(p)operator(\)) - operator(()ident(write) operator(()integer(1)ident(+) ident(num)operator(\)) ident(p)operator(\)) - operator(()ident(newline) ident(p)operator(\))operator(\)) -operator(()ident(close) ident(p)operator(\)) - -comment(;; @@PLEAC@@_7.12) -comment(;; use force-output) -operator(()ident(force-output) ident(p)operator(\)) - -comment(;; flush all open ports) -operator(()ident(flush-all-ports)operator(\)) - -comment(;; @@PLEAC@@_7.13) -comment(;; use select) -operator(()ident(select) ident(inputs) ident(outputs) ident(exceptions) ident(seconds)operator(\)) -operator(()ident(select) operator(()ident(list) ident(p1) ident(p2) ident(p3)operator(\)) operator(')operator(()operator(\)) operator(')operator(()operator(\))operator(\)) - -operator(()reserved(let*) operator(()operator(()ident(nfound) operator(()ident(select) operator(()ident(list) ident(inport)operator(\)) operator(')operator(()operator(\)) operator(')operator(()operator(\))operator(\))operator(\)) - operator(()ident(inputs) operator(()ident(car) ident(nfound)operator(\))operator(\))operator(\)) - operator(()reserved(if) operator(()ident(not) operator(()ident(null?) ident(inputs)operator(\))operator(\)) - operator(()reserved(let) operator(()operator(()ident(line) operator(()ident(read-line) ident(inport)operator(\))operator(\))operator(\)) - operator(()ident(format) pre_constant(#t) string<delimiter(")content(I read ~A)content(\\n)delimiter(")> ident(line)operator(\))operator(\))operator(\))operator(\)) - -comment(;; or use char-ready? if you only need a single character) -operator(()reserved(if) operator(()ident(char-ready?) ident(p)operator(\)) - operator(()ident(format) pre_constant(#t) string<delimiter(")content(I read ~A)content(\\n)delimiter(")> operator(()ident(read-char) ident(p)operator(\))operator(\))operator(\)) - -comment(;; @@PLEAC@@_7.14) -comment(;; use the O_NONBLOCK option with open) -operator(()reserved(define) ident(modem) operator(()ident(open) string<delimiter(")content(/dev/cua0)delimiter(")> operator(()ident(logior) ident(O_RDWR) ident(O_NONBLOCK)operator(\))operator(\))operator(\)) - -comment(;; or use fcntl if you already have a port) -operator(()reserved(let) operator(()operator(()ident(flags) operator(()ident(fcntl) ident(p) ident(F_GETFD)operator(\))operator(\))operator(\)) - operator(()ident(fcntl) ident(p) ident(F_SETFD) operator(()ident(logior) ident(flags) ident(O_NONBLOCK)operator(\))operator(\))operator(\)) - -comment(;; @@PLEAC@@_7.15) -comment(;; use stat) -operator(()reserved(let) operator(()operator(()ident(buf) operator(()ident(make-string) operator(()ident(stat:size) operator(()ident(stat) ident(p)operator(\))operator(\))operator(\))operator(\))operator(\)) - operator(()ident(read-string!/partial) ident(buf) ident(input)operator(\))operator(\)) - -comment(;; @@PLEAC@@_7.16) -comment(;; not needed - ports are first class objects) - -comment(;; @@PLEAC@@_7.18) -comment(;; use for-each on the list of ports:) -operator(()ident(for-each) operator(()reserved(lambda) operator(()ident(p)operator(\)) operator(()ident(display) ident(stuff-to-print) ident(p)operator(\))operator(\)) ident(port-list)operator(\)) - -comment(;; or, if you don't want to keep track of the port list and know you) -comment(;; want to print to all open output ports, you can use port-for-each:) -operator(()ident(port-for-each) operator(()reserved(lambda) operator(()ident(p)operator(\)) operator(()reserved(if) operator(()ident(output-port?) ident(p)operator(\)) operator(()ident(display) ident(stuff) ident(p)operator(\))operator(\))operator(\))operator(\)) - -comment(;; @@PLEAC@@_7.19) -comment(;; use fdopen:) -operator(()reserved(define) ident(p) operator(()ident(fdopen) ident(num) ident(mode)operator(\))operator(\)) -operator(()reserved(define) ident(p) operator(()ident(fdopen) integer(3) string<delimiter(")content(r)delimiter(")>operator(\))operator(\)) - -operator(()reserved(define) ident(p) operator(()ident(fdopen) operator(()ident(string->number) operator(()ident(getenv) string<delimiter(")content(MHCONTEXTFD)delimiter(")>operator(\))operator(\)) string<delimiter(")content(r)delimiter(")>operator(\))operator(\)) -comment(;; after processing) -operator(()ident(close) ident(p)operator(\)) - -comment(;; @@PLEAC@@_7.20) -comment(;; ports are first class objects and can be aliased and passed around) -comment(;; like any other non-immediate variables:) -operator(()reserved(define) ident(alias) ident(original)operator(\)) -operator(()reserved(define) ident(old-in) operator(()ident(current-input-port)operator(\))operator(\)) - -comment(;; or you can open two separate ports on the same file:) -operator(()reserved(define) ident(p1) operator(()ident(open-input-file) ident(path)operator(\))operator(\)) -operator(()reserved(define) ident(p2) operator(()ident(open-input-file) ident(path)operator(\))operator(\)) - -comment(;; or use fdopen:) -operator(()reserved(define) ident(copy-of-p) operator(()ident(fdopen) operator(()ident(fileno) ident(p)operator(\)) ident(mode)operator(\))operator(\)) - -operator(()reserved(define) ident(old-out) operator(()ident(current-output-port)operator(\))operator(\)) -operator(()reserved(define) ident(old-err) operator(()ident(current-error-port)operator(\))operator(\)) - -operator(()reserved(define) ident(new-out) operator(()ident(open-output-file) string<delimiter(")content(/tmp/program.out)delimiter(")>operator(\))operator(\)) - -operator(()ident(set-current-output-port) ident(new-out)operator(\)) -operator(()ident(set-current-error-port) ident(new-out)operator(\)) - -operator(()ident(system) ident(joe-random-program)operator(\)) - -operator(()ident(close) ident(new-out)operator(\)) - -operator(()ident(set-current-output-port) ident(old-out)operator(\)) -operator(()ident(set-current-error-port) ident(old-out)operator(\)) - -comment(;; @@PLEAC@@_8.0) -comment(;; open the file and loop through the port with read-line:) -operator(()reserved(let) operator(()operator(()ident(p) operator(()ident(open-input-file) ident(file)operator(\))operator(\))operator(\)) - operator(()reserved(do) operator(()operator(()ident(line) operator(()ident(read-line) ident(p)operator(\)) operator(()ident(read-line) ident(p)operator(\))operator(\))operator(\)) - operator(()operator(()ident(eof-object?) ident(line)operator(\))operator(\)) - operator(()ident(format) pre_constant(#t) string<delimiter(")content(~A)content(\\n)delimiter(")> operator(()ident(string-length) ident(line)operator(\))operator(\))operator(\)) - operator(()ident(close) ident(p)operator(\))operator(\)) - -comment(;; you can use with-input-from-file to temporarily rebind stdin:) -operator(()ident(with-input-from-file) ident(file) - operator(()reserved(lambda) operator(()operator(\)) - operator(()reserved(do) operator(()operator(()ident(line) operator(()ident(read-line)operator(\)) operator(()ident(read-line)operator(\))operator(\))operator(\)) - operator(()operator(()ident(eof-object?) ident(line)operator(\))operator(\)) - operator(()ident(format) pre_constant(#t) string<delimiter(")content(~A)content(\\n)delimiter(")> operator(()ident(string-length) ident(line)operator(\))operator(\))operator(\))operator(\))operator(\)) - -comment(;; or define a utility procedure to do this) -operator(()reserved(define) operator(()ident(for-each-line) ident(proc) ident(file)operator(\)) - operator(()ident(with-input-from-file) ident(file) - operator(()reserved(lambda) operator(()operator(\)) - operator(()reserved(do) operator(()operator(()ident(line) operator(()ident(read-line)operator(\)) operator(()ident(read-line)operator(\))operator(\))operator(\)) - operator(()operator(()ident(eof-object?) ident(line)operator(\))operator(\)) - operator(()ident(proc) ident(line)operator(\))operator(\))operator(\))operator(\))operator(\)) -operator(()ident(for-each-line) operator(()reserved(lambda) operator(()ident(x)operator(\)) operator(()ident(format) pre_constant(#t) string<delimiter(")content(~A)content(\\n)delimiter(")> operator(()ident(string-length) ident(line)operator(\))operator(\))operator(\)) ident(file)operator(\)) - -comment(;; read in the file as a list of lines) -operator(()reserved(define) operator(()ident(read-lines) ident(file)operator(\)) - operator(()reserved(let) operator(()operator(()ident(ls) operator(')operator(()operator(\))operator(\))operator(\)) - operator(()ident(with-input-from-file) ident(file) - operator(()reserved(lambda) operator(()operator(\)) - operator(()reserved(do) operator(()operator(()ident(line) operator(()ident(read-line)operator(\)) operator(()ident(read-line)operator(\))operator(\))operator(\)) - operator(()operator(()ident(eof-object?) ident(line)operator(\))operator(\)) - operator(()reserved(set!) ident(ls) operator(()reserved(cons) ident(line) ident(ls)operator(\))operator(\))operator(\)) - operator(()ident(reverse) ident(ls)operator(\))operator(\))operator(\))operator(\))operator(\)) - -comment(;; read in the file as a single string) -operator(()reserved(define) operator(()ident(file-contents) ident(file)operator(\)) - operator(()ident(call-with-input-file) ident(file) - operator(()reserved(lambda) operator(()ident(p)operator(\)) - operator(()reserved(let*) operator(()operator(()ident(size) operator(()ident(stat:size) operator(()ident(stat) ident(p)operator(\))operator(\))operator(\)) - operator(()ident(buf) operator(()ident(make-string) ident(size)operator(\))operator(\))operator(\)) - operator(()ident(read-string!/partial) ident(buf) ident(p)operator(\)) - ident(buf)operator(\))operator(\))operator(\))operator(\)) - -comment(;; use display to print human readable output) -operator(()ident(display) operator(')operator(()string<delimiter(")content(One)delimiter(")> string<delimiter(")content(two)delimiter(")> string<delimiter(")content(three)delimiter(")>operator(\)) ident(port)operator(\)) comment(; (One two three\)) -operator(()ident(display) string<delimiter(")content(Baa baa black sheep.)content(\\n)delimiter(")>operator(\)) comment(; Sent to default output port) - -comment(;; use write to print machine readable output) -operator(()ident(write) operator(')operator(()string<delimiter(")content(One)delimiter(")> string<delimiter(")content(two)delimiter(")> string<delimiter(")content(three)delimiter(")>operator(\)) ident(port)operator(\)) comment(; ("One" "two" "three"\)) - -comment(;; use (ice-9 rw\) to read/write fixed-length blocks of data:) -operator(()ident(use-modules) operator(()ident(ice-9) ident(rw)operator(\))operator(\)) -operator(()reserved(let) operator(()operator(()ident(buffer) operator(()ident(make-string) integer(4096)operator(\))operator(\))operator(\)) - operator(()ident(read-string!/partial) ident(buffer) ident(port) integer(4096)operator(\))operator(\)) - -comment(;; truncate-file) -operator(()ident(truncate-file) ident(port) ident(length)operator(\)) comment(; truncate to length) -operator(()ident(truncate-file) ident(port)operator(\)) comment(; truncate to current pos) - -comment(;; ftell) -operator(()reserved(define) ident(pos) operator(()ident(ftell) ident(port)operator(\))operator(\)) -operator(()ident(format) pre_constant(#t) string<delimiter(")content(I'm ~A bytes from the start of DATAFILE.)content(\\n)delimiter(")> ident(pos)operator(\)) - -comment(;; seek) -operator(()ident(seek) ident(log-port) integer(0) ident(SEEK_END)operator(\)) comment(; seek to end) -operator(()ident(seek) ident(data-port) ident(pos) ident(SEEK_SET)operator(\)) comment(; seek to pos) -operator(()ident(seek) ident(out-port) ident(-)integer(20) ident(SEEK_CUR)operator(\)) comment(; seek back 20 bytes) - -comment(;; block read/write) -operator(()ident(use-modules) operator(()ident(ice-9) ident(rw)operator(\))operator(\)) -operator(()ident(write-string/partial) ident(mystring) ident(data-port) operator(()ident(string-length) ident(mystring)operator(\))operator(\)) -operator(()ident(read-string!/partial) ident(block) integer(256) integer(5)operator(\)) - -comment(;; @@PLEAC@@_8.1) -operator(()reserved(let) operator(()operator(()ident(rx) operator(()ident(make-regexp) string<delimiter(")content((.*\))content(\\\\)content(\\\\)content($)delimiter(")>operator(\))operator(\))operator(\)) comment(; or "(.*\)\\\\\\\\\\\\s*$") - operator(()ident(with-input-from-file) ident(file) - operator(()reserved(lambda) operator(()operator(\)) - operator(()reserved(let) ident(loop) operator(()operator(()ident(line) operator(()ident(read-line)operator(\))operator(\))operator(\)) - operator(()reserved(if) operator(()ident(not) operator(()ident(eof-object?) ident(line)operator(\))operator(\)) - operator(()reserved(let) operator(()operator(()ident(m) operator(()ident(regexp-exec) ident(rx) ident(line)operator(\))operator(\)) - operator(()ident(next) operator(()ident(read-line)operator(\))operator(\))operator(\)) - operator(()reserved(cond) operator(()operator(()reserved(and) ident(m) operator(()ident(not) operator(()ident(eof-object?) ident(next)operator(\))operator(\))operator(\)) - operator(()ident(loop) operator(()ident(string-append) operator(()ident(match:substring) ident(m) integer(1)operator(\)) ident(next)operator(\))operator(\))operator(\)) - operator(()ident(else) - comment(;; else process line here, then recurse) - operator(()ident(loop) ident(next)operator(\))operator(\))operator(\))operator(\))operator(\))operator(\))operator(\))operator(\))operator(\)) - -comment(;; @@PLEAC@@_8.2) -operator(()reserved(do) operator(()operator(()ident(line) operator(()ident(read-line) ident(p)operator(\)) operator(()ident(read-line) ident(p)operator(\))operator(\)) - operator(()ident(i) integer(0) operator(()integer(1)ident(+) ident(i)operator(\))operator(\))operator(\)) - operator(()operator(()ident(eof-object?) ident(line)operator(\)) ident(i)operator(\))operator(\)) - -comment(;; fastest way if your terminator is a single newline) -operator(()ident(use-modules) operator(()ident(ice-9) ident(rw)operator(\)) operator(()ident(srfi) ident(srfi-13)operator(\))operator(\)) -operator(()reserved(let) operator(()operator(()ident(buf) operator(()ident(make-string) operator(()ident(expt) integer(2) integer(16)operator(\))operator(\))operator(\)) - operator(()ident(count) integer(0)operator(\))operator(\)) - operator(()reserved(do) operator(()operator(()ident(len) operator(()ident(read-string!/partial) ident(buf) ident(p)operator(\)) operator(()ident(read-string!/partial) ident(buf) ident(p)operator(\))operator(\))operator(\)) - operator(()operator(()ident(not) ident(len)operator(\)) ident(count)operator(\)) - operator(()reserved(set!) ident(count) operator(()ident(+) ident(count) operator(()ident(string-count) ident(buf) char(#\\newline) integer(0) ident(len)operator(\))operator(\))operator(\))operator(\))operator(\)) - -comment(;; or use port-line) -operator(()reserved(let) ident(loop) operator(()operator(()ident(line) operator(()ident(read-line) ident(p)operator(\))operator(\))operator(\)) - operator(()reserved(if) operator(()ident(eof-object?) ident(line)operator(\)) operator(()ident(port-line) ident(p)operator(\)) operator(()ident(loop) operator(()ident(read-line) ident(p)operator(\))operator(\))operator(\))operator(\)) - -comment(;; @@PLEAC@@_8.3) -comment(;; default behaviour of string-tokenize is to split on whitespace:) -operator(()ident(use-modules) operator(()ident(srfi) ident(srfi-13)operator(\))operator(\)) -operator(()reserved(let) ident(loop) operator(()operator(()ident(line) operator(()ident(read-line) ident(p)operator(\))operator(\))operator(\)) - operator(()reserved(cond) operator(()operator(()ident(not) ident(eof-object?) ident(line)operator(\)) - operator(()ident(for-each) ident(some-function-of-word) operator(()ident(string-tokenize) ident(line)operator(\))operator(\)) - operator(()ident(loop) operator(()ident(read-line) ident(p)operator(\))operator(\))operator(\))operator(\))operator(\)) - -operator(()reserved(let) operator(()operator(()ident(table) operator(()ident(make-hash-table) integer(31)operator(\))operator(\))operator(\)) - operator(()reserved(let) ident(loop) operator(()operator(()ident(line) operator(()ident(read-line) ident(p)operator(\))operator(\))operator(\)) - operator(()reserved(cond) operator(()operator(()ident(not) operator(()ident(eof-object?) ident(line)operator(\))operator(\)) - operator(()ident(for-each) - operator(()reserved(lambda) operator(()ident(w)operator(\)) operator(()ident(hash-set!) ident(table) ident(w) operator(()integer(1)ident(+) operator(()ident(hash-ref) ident(table) ident(w) integer(0)operator(\))operator(\))operator(\))operator(\)) - operator(()ident(string-tokenize) ident(line)operator(\))operator(\)) - operator(()ident(loop) operator(()ident(read-line) ident(p)operator(\))operator(\))operator(\))operator(\))operator(\)) - operator(()ident(hash-fold) operator(()reserved(lambda) operator(()ident(k) ident(v) ident(p)operator(\)) operator(()ident(format) pre_constant(#t) string<delimiter(")content(~5D ~A)content(\\n)delimiter(")> ident(v) ident(k)operator(\))operator(\)) pre_constant(#f) ident(table)operator(\))operator(\)) - -comment(;; @@PLEAC@@_8.4) -comment(;; build up the list the reverse it or fold over it:) -operator(()reserved(define) ident(lines) operator(()ident(read-lines) ident(file)operator(\))operator(\)) -operator(()ident(for-each) operator(()reserved(lambda) operator(()ident(word)operator(\)) ident(do-something-with-word)operator(\)) operator(()ident(reverse) ident(lines)operator(\))operator(\)) -operator(()ident(fold) operator(()reserved(lambda) operator(()ident(word) ident(acc)operator(\)) ident(do-something-with-word)operator(\)) pre_constant(#f) ident(lines)operator(\)) - -comment(;; @@PLEAC@@_8.5) -comment(;; save the current position and reseek to it) -operator(()reserved(define) operator(()ident(tail) ident(file)operator(\)) - operator(()ident(call-with-input-file) ident(file) - operator(()reserved(lambda) operator(()ident(p)operator(\)) - operator(()reserved(let) ident(loop) operator(()operator(()ident(line) operator(()ident(read-line) ident(p)operator(\))operator(\))operator(\)) - operator(()reserved(cond) operator(()operator(()ident(eof-object?) ident(line)operator(\)) - operator(()ident(sleep) ident(sometime)operator(\)) - operator(()reserved(let) operator(()operator(()ident(pos) operator(()ident(ftell) ident(p)operator(\))operator(\))operator(\)) - operator(()ident(seek) ident(p) integer(0) ident(SEEK_SET)operator(\)) - operator(()ident(seek) ident(p) ident(pos) ident(SEEK_SET)operator(\))operator(\))operator(\)) - operator(()ident(else) - comment(;; process line) - operator(\))operator(\)) - operator(()ident(loop) operator(()ident(read-line) ident(p)operator(\))operator(\))operator(\))operator(\))operator(\))operator(\)) - -comment(;; @@PLEAC@@_8.6) -operator(()reserved(let) operator(()operator(()ident(rand-line) pre_constant(#f)operator(\))operator(\)) - operator(()reserved(let) ident(loop) operator(()operator(()ident(line) operator(()ident(read-line) ident(p)operator(\))operator(\))operator(\)) - operator(()reserved(cond) operator(()operator(()ident(not) operator(()ident(eof-object?) ident(line)operator(\))operator(\)) - operator(()reserved(if) operator(()ident(=) integer(0) operator(()ident(random) operator(()ident(port-line) ident(p)operator(\))operator(\))operator(\)) - operator(()reserved(set!) ident(rand-line) ident(line)operator(\))operator(\)) - operator(()ident(loop) operator(()ident(read-line) ident(p)operator(\))operator(\))operator(\))operator(\))operator(\)) - comment(;; rand-line is the random line) - operator(\)) - -comment(;; @@PLEAC@@_8.7) -operator(()reserved(define) operator(()ident(shuffle) ident(list)operator(\)) - operator(()reserved(let) operator(()operator(()ident(v) operator(()ident(list->vector) ident(list)operator(\))operator(\))operator(\)) - operator(()reserved(do) operator(()operator(()ident(i) operator(()integer(1)ident(-) operator(()ident(vector-length) ident(v)operator(\))operator(\)) operator(()integer(1)ident(-) ident(i)operator(\))operator(\))operator(\)) - operator(()operator(()ident(<) ident(i) integer(0)operator(\)) operator(()ident(vector->list) ident(v)operator(\))operator(\)) - operator(()reserved(let) operator(()operator(()ident(j) operator(()ident(random) operator(()integer(1)ident(+) ident(i)operator(\))operator(\))operator(\))operator(\)) - operator(()reserved(cond) operator(()operator(()ident(not) operator(()ident(=) ident(i) ident(j)operator(\))operator(\)) - operator(()reserved(let) operator(()operator(()ident(temp) operator(()ident(vector-ref) ident(v) ident(i)operator(\))operator(\))operator(\)) - operator(()ident(vector-set!) ident(v) ident(i) operator(()ident(vector-ref) ident(v) ident(j)operator(\))operator(\)) - operator(()ident(vector-set!) ident(v) ident(j) ident(temp)operator(\))operator(\))operator(\))operator(\))operator(\))operator(\))operator(\))operator(\)) - -operator(()reserved(define) ident(rand-lines) operator(()ident(shuffle) operator(()ident(read-lines) ident(file)operator(\))operator(\)) - -comment(;; @@PLEAC@@_8.8) -comment(;; looking for line number desired-line-number) -operator(()reserved(do) operator(()operator(()ident(line) operator(()ident(read-line) ident(p)operator(\)) operator(()ident(read-line) ident(p)operator(\))operator(\))operator(\)) - operator(()operator(()ident(=) operator(()operator(()ident(port-line) ident(p)operator(\)) ident(desired-line-number)operator(\)) ident(line)operator(\))operator(\))operator(\)) -comment(;; or read into a list) -operator(()reserved(define) ident(lines) operator(()ident(read-lines) ident(file)operator(\))operator(\)) -operator(()ident(list-ref) ident(lines) ident(desired-line-number)operator(\)) - -comment(;; @@INCOMPLETE@@) -comment(; (define (build-index data-file index-file\)) -comment(; \)) - -comment(; (define (line-with-index data-file index-file line-number\)) -comment(; \)) - -comment(;; @@PLEAC@@_8.9) -comment(;; use string-tokenize with an appropriate character set) -operator(()ident(use-modules) operator(()ident(srfi) ident(srfi-13)operator(\)) operator(()ident(srfi) ident(srfi-14)operator(\))operator(\)) -operator(()reserved(define) ident(fields) operator(()ident(string-tokenize) ident(line) operator(()ident(string->charset) string<delimiter(")content(+-)delimiter(")>operator(\))operator(\))operator(\)) -operator(()reserved(define) ident(fields) operator(()ident(string-tokenize) ident(line) operator(()ident(string->charset) string<delimiter(")content(:)delimiter(")>operator(\))operator(\))operator(\)) -operator(()reserved(define) ident(fields) operator(()ident(string-tokenize) ident(line)operator(\))operator(\)) - -comment(;; @@PLEAC@@_8.10) -operator(()reserved(let) operator(()operator(()ident(p) operator(()ident(open-file) ident(file) string<delimiter(")content(r+)delimiter(")>operator(\))operator(\))operator(\)) - operator(()reserved(let) operator(()operator(()ident(pos) integer(0)operator(\))operator(\)) - operator(()reserved(let) ident(loop) operator(()operator(()ident(line) operator(()ident(read-line) ident(p)operator(\))operator(\))operator(\)) - operator(()reserved(cond) operator(()operator(()ident(eof-object?) operator(()ident(peek-char) ident(p)operator(\))operator(\)) - operator(()ident(seek) ident(p) integer(0) ident(SEEK_SET)operator(\)) - operator(()ident(truncate-file) ident(p) ident(pos)operator(\)) - operator(()ident(close) ident(p)operator(\))operator(\)) - operator(()ident(else) - operator(()reserved(set!) ident(pos) operator(()ident(ftell) ident(p)operator(\))operator(\)) - operator(()ident(loop) operator(()ident(read-line) ident(p)operator(\))operator(\))operator(\))operator(\))operator(\))operator(\))operator(\)) - -comment(;; @@PLEAC@@_8.11) -comment(;; no equivalent - don't know how Guile under windows handles this) - -comment(;; @@PLEAC@@_8.12) -operator(()reserved(let*) operator(()operator(()ident(address) operator(()ident(*) ident(recsize) ident(recno)operator(\))operator(\)) - operator(()ident(buf) operator(()ident(make-string) ident(recsize)operator(\))operator(\))operator(\)) - operator(()ident(seek) ident(p) ident(address) ident(SEEK_SET)operator(\)) - operator(()ident(read-string!/partial) ident(buf) ident(p)operator(\)) - ident(buf)operator(\)) - -comment(;; @@PLEAC@@_8.13) -operator(()reserved(let*) operator(()operator(()ident(address) operator(()ident(*) ident(recsize) ident(recno)operator(\))operator(\)) - operator(()ident(buf) operator(()ident(make-string) ident(recsize)operator(\))operator(\))operator(\)) - operator(()ident(seek) ident(p) ident(address) ident(SEEK_SET)operator(\)) - operator(()ident(read-string!/partial) ident(buf) ident(p)operator(\)) - comment(;; modify buf, then write back with) - operator(()ident(seek) ident(p) ident(address) ident(SEEK_SET)operator(\)) - operator(()ident(write-string/partial) ident(buf) ident(p)operator(\)) - operator(()ident(close) ident(p)operator(\))operator(\)) - -comment(;; @@INCOMPLETE@@) -comment(;; weekearly) - -comment(;; @@PLEAC@@_8.14) -operator(()ident(seek) ident(p) ident(addr) ident(SEEK_SET)operator(\)) -operator(()reserved(define) ident(str) operator(()ident(read-delimited) operator(()ident(make-string) integer(1) char(#\\n)ident(ul)operator(\)) ident(p)operator(\))operator(\)) - -error(#)ident(!/usr/local/bin/guile) ident(-)ident(s) -ident(!)error(#) -comment(;; bgets -- get a string from an address in a binary file) -operator(()ident(use-modules) operator(()ident(ice-9) ident(format)operator(\))operator(\)) - -operator(()reserved(define) ident(args) operator(()ident(cdr) operator(()ident(command-line)operator(\))operator(\))operator(\)) -operator(()reserved(define) ident(file) operator(()ident(car) ident(args)operator(\))operator(\)) -operator(()reserved(define) ident(addrs) operator(()ident(map) ident(string->number) operator(()ident(cdr) ident(args)operator(\))operator(\))operator(\)) -operator(()reserved(define) ident(delims) operator(()ident(make-string) integer(1) char(#\\n)ident(ul)operator(\))operator(\)) - -operator(()ident(call-with-input-file) ident(file) - operator(()reserved(lambda) operator(()ident(p)operator(\)) - operator(()ident(for-each) - operator(()reserved(lambda) operator(()ident(addr)operator(\)) - operator(()ident(seek) ident(p) ident(addr) ident(SEEK_SET)operator(\)) - operator(()ident(format) pre_constant(#t) string<delimiter(")content(~X ~O ~D ~S)content(\\n)delimiter(")> ident(addr) ident(addr) ident(addr) - operator(()ident(read-delimited) ident(delims) ident(p)operator(\))operator(\))operator(\)) - ident(addrs)operator(\))operator(\))operator(\)) - -comment(;; @@INCOMPLETE@@) -comment(;; strings) - -comment(;; @@PLEAC@@_9.0) -operator(()reserved(define) ident(entry) operator(()ident(stat) string<delimiter(")content(/usr/bin/vi)delimiter(")>operator(\))operator(\)) -operator(()reserved(define) ident(entry) operator(()ident(stat) string<delimiter(")content(/usr/bin)delimiter(")>operator(\))operator(\)) -operator(()reserved(define) ident(entry) operator(()ident(stat) ident(port)operator(\))operator(\)) - -operator(()ident(use-modules) operator(()ident(ice-9) ident(posix)operator(\))operator(\)) - -operator(()reserved(define) ident(inode) operator(()ident(stat) string<delimiter(")content(/usr/bin/vi)delimiter(")>operator(\))operator(\)) -operator(()reserved(define) ident(ctime) operator(()ident(stat:ctime) ident(inode)operator(\))operator(\)) -operator(()reserved(define) ident(size) operator(()ident(stat:size) ident(inode)operator(\))operator(\)) - -operator(()reserved(define) ident(F) operator(()ident(open-input-file) ident(filename)operator(\))operator(\)) -comment(;; no equivalent - what defines -T?) -comment(; unless (-s F && -T _\) {) -comment(; die "$filename doesn't have text in it.\\n";) -comment(; }) - -operator(()reserved(define) ident(dir) operator(()ident(opendir) string<delimiter(")content(/usr/bin)delimiter(")>operator(\))operator(\)) -operator(()reserved(do) operator(()operator(()ident(filename) operator(()ident(readdir) ident(dir)operator(\)) operator(()ident(readdir) ident(dir)operator(\))operator(\))operator(\)) - operator(()operator(()ident(eof-object?) ident(filename)operator(\))operator(\)) - operator(()ident(format) pre_constant(#t) string<delimiter(")content(Inside /usr/bin is something called ~A)content(\\n)delimiter(")> ident(filename)operator(\))operator(\)) -operator(()ident(closedir) ident(dir)operator(\)) - -comment(;; @@PLEAC@@_9.1) -operator(()reserved(define) ident(inode) operator(()ident(stat) ident(filename)operator(\))operator(\)) -operator(()reserved(define) ident(readtime) operator(()ident(stat:atime) ident(inode)operator(\))operator(\)) -operator(()reserved(define) ident(writetime) operator(()ident(stat:mtime) ident(inode)operator(\))operator(\)) - -operator(()ident(utime) ident(newreadtime) ident(newwritetime) ident(filename)operator(\)) - -operator(()reserved(define) ident(seconds-per-day) operator(()ident(*) integer(60) integer(60) integer(24)operator(\))operator(\)) -operator(()reserved(define) ident(inode) operator(()ident(stat) ident(file)operator(\))operator(\)) -operator(()reserved(define) ident(atime) operator(()ident(stat:atime) ident(inode)operator(\))operator(\)) -operator(()reserved(define) ident(mtime) operator(()ident(stat:mtime) ident(inode)operator(\))operator(\)) -operator(()reserved(set!) ident(atime) operator(()ident(-) ident(atime) operator(()ident(*) integer(7) ident(seconds-per-day)operator(\))operator(\))operator(\)) -operator(()reserved(set!) ident(mtime) operator(()ident(-) ident(mtime) operator(()ident(*) integer(7) ident(seconds-per-day)operator(\))operator(\))operator(\)) -operator(()ident(utime) ident(file) ident(atime) ident(mtime)operator(\)) - -comment(;; mtime is optional) -operator(()ident(utime) ident(file) operator(()ident(current-time)operator(\))operator(\)) -operator(()ident(utime) ident(file) operator(()ident(stat:atime) operator(()ident(stat) ident(file)operator(\))operator(\)) operator(()ident(current-time)operator(\))operator(\)) - -error(#)ident(!/usr/local/bin/guile) ident(-)ident(s) -ident(!)error(#) -comment(;; uvi - vi a file without changing its access times) - -operator(()reserved(define) ident(file) operator(()ident(cadr) operator(()ident(command-line)operator(\))operator(\))operator(\)) -operator(()reserved(define) ident(inode) operator(()ident(stat) ident(file)operator(\))operator(\)) -operator(()reserved(define) ident(atime) operator(()ident(stat:atime) ident(inode)operator(\))operator(\)) -operator(()reserved(define) ident(mtime) operator(()ident(stat:mtime) ident(inode)operator(\))operator(\)) -operator(()ident(system) operator(()ident(string-append) operator(()reserved(or) operator(()ident(getenv) string<delimiter(")content(EDITOR)delimiter(")>operator(\)) string<delimiter(")content(vi)delimiter(")>operator(\)) string<delimiter(")content( )delimiter(")> ident(file)operator(\))operator(\)) -operator(()ident(utime) ident(file) ident(atime) ident(mtime)operator(\)) - -comment(;; @@PLEAC@@_9.2) -operator(()ident(delete-file) ident(file)operator(\)) - -operator(()reserved(let) operator(()operator(()ident(count) integer(0)operator(\))operator(\)) - operator(()ident(for-each) - operator(()reserved(lambda) operator(()ident(x)operator(\)) - operator(()ident(catch) pre_constant(#t) - operator(()reserved(lambda) operator(()operator(\)) operator(()ident(delete-file) ident(x)operator(\)) operator(()reserved(set!) ident(count) operator(()integer(1)ident(+) ident(count)operator(\))operator(\))operator(\)) - operator(()reserved(lambda) operator(()ident(err) operator(.) ident(args)operator(\)) pre_constant(#f)operator(\))operator(\))operator(\)) - ident(file-list)operator(\)) - operator(()reserved(if) operator(()ident(not) operator(()ident(=) ident(count) operator(()ident(length) ident(file-list)operator(\))operator(\))operator(\)) - operator(()ident(format) operator(()ident(current-error-port)operator(\)) string<delimiter(")content(could only delete ~A of ~A files)delimiter(")> - ident(count) operator(()ident(length) ident(file-list)operator(\))operator(\))operator(\))operator(\)) - -comment(;; @@PLEAC@@_9.3) -comment(;; use builtin copy-file) -operator(()ident(copy-file) ident(oldfile) ident(newfile)operator(\)) -operator(()ident(rename-file) ident(oldfile) ident(newfile)operator(\)) - -comment(;; or do it by hand (clumsy, error-prone\)) -operator(()ident(use-modules) operator(()ident(ice-9) ident(rw)operator(\)) operator(()ident(ice-9) ident(posix)operator(\))operator(\)) -operator(()ident(with-input-from-file) ident(oldfile) - operator(()reserved(lambda) operator(()operator(\)) - operator(()ident(call-with-output-file) ident(newfile) - operator(()reserved(lambda) operator(()ident(p)operator(\)) - operator(()reserved(let*) operator(()operator(()ident(inode) operator(()ident(stat) ident(oldfile)operator(\))operator(\)) - operator(()ident(blksize) operator(()reserved(if) ident(inode) operator(()ident(stat:size) ident(inode)operator(\)) integer(16384)operator(\))operator(\)) - operator(()ident(buf) operator(()ident(make-string) ident(blksize)operator(\))operator(\))operator(\)) - operator(()reserved(let) ident(loop) operator(()operator(()ident(len) operator(()ident(read-string!/partial) ident(buf)operator(\))operator(\))operator(\)) - operator(()reserved(cond) operator(()operator(()reserved(and) ident(len) operator(()ident(>) ident(len) integer(0)operator(\))operator(\)) - operator(()ident(write-string/partial) ident(buf) ident(p) integer(0) ident(len)operator(\)) - operator(()ident(loop) operator(()ident(read-string!/partial) ident(buf)operator(\))operator(\))operator(\))operator(\))operator(\))operator(\))operator(\))operator(\))operator(\))operator(\)) - -comment(;; or call out to the system (non-portable, insecure\)) -operator(()ident(system) operator(()ident(string-append) string<delimiter(")content(cp )delimiter(")> ident(oldfile) string<delimiter(")content( )delimiter(")> ident(newfile)operator(\))operator(\)) comment(; unix) -operator(()ident(system) operator(()ident(string-append) string<delimiter(")content(copy )delimiter(")> ident(oldfile) string<delimiter(")content( )delimiter(")> ident(newfile)operator(\))operator(\)) comment(; dos, vms) - -comment(;; @@PLEAC@@_9.4) -comment(;; use a hash lookup of inodes) -operator(()ident(use-modules) operator(()ident(ice-9) ident(posix)operator(\))operator(\)) -operator(()reserved(let) operator(()operator(()ident(seen) operator(()ident(make-hash-table) integer(31)operator(\))operator(\))operator(\)) - operator(()ident(for-each) - operator(()reserved(lambda) operator(()ident(file)operator(\)) - operator(()reserved(let*) operator(()operator(()ident(stats) operator(()ident(stat) ident(file)operator(\))operator(\)) - operator(()ident(key) operator(()reserved(cons) operator(()ident(stat:dev) ident(stats)operator(\)) operator(()ident(stat:ino) ident(stats)operator(\))operator(\))operator(\)) - operator(()ident(val) operator(()ident(hash-ref) ident(seen) ident(key) integer(0)operator(\))operator(\))operator(\)) - operator(()reserved(cond) operator(()operator(()ident(=) ident(val) integer(0)operator(\)) - comment(;; do something with new file) - operator(\))operator(\)) - operator(()ident(hash-set!) ident(seen) ident(key) operator(()integer(1)ident(+) ident(val)operator(\))operator(\))operator(\))operator(\)) - ident(file-names)operator(\))operator(\)) - -operator(()reserved(let) operator(()operator(()ident(seen) operator(()ident(make-hash-table) integer(31)operator(\))operator(\))operator(\)) - operator(()ident(for-each) - operator(()reserved(lambda) operator(()ident(file)operator(\)) - operator(()reserved(let*) operator(()operator(()ident(stats) operator(()ident(stat) ident(file)operator(\))operator(\)) - operator(()ident(key) operator(()reserved(cons) operator(()ident(stat:dev) ident(stats)operator(\)) operator(()ident(stat:ino) ident(stats)operator(\))operator(\))operator(\)) - operator(()ident(val) operator(()ident(hash-ref) ident(seen) ident(key) operator(')operator(()operator(\))operator(\))operator(\))operator(\)) - operator(()ident(hash-set!) ident(seen) ident(key) operator(()reserved(cons) ident(file) ident(val)operator(\))operator(\))operator(\))operator(\)) - ident(file-names)operator(\)) - operator(()ident(hash-fold) - operator(()reserved(lambda) operator(()ident(key) ident(value) ident(prior)operator(\)) - comment(;; process key == (dev . inode\), value == list of filenames) - operator(\)) - operator(')operator(()operator(\)) ident(seen)operator(\))operator(\)) - -comment(;; @@PLEAC@@_9.5) -comment(;; use opendir, readdir, closedir) -operator(()reserved(let) operator(()operator(()ident(p) operator(()ident(opendir) ident(dir)operator(\))operator(\))operator(\)) - operator(()reserved(let) ident(loop) operator(()operator(()ident(file) operator(()ident(readdir) ident(p)operator(\))operator(\))operator(\)) - operator(()reserved(if) operator(()ident(eof-object?) ident(file)operator(\)) - operator(()ident(close) ident(p)operator(\)) - comment(;; do something with file) - operator(\))operator(\))operator(\)) - -comment(;; or define a utility function for this) -operator(()reserved(define) operator(()ident(directory-files) ident(dir)operator(\)) - operator(()reserved(if) operator(()ident(not) operator(()ident(access?) ident(dir) ident(R_OK)operator(\))operator(\)) - operator(')operator(()operator(\)) - operator(()reserved(let) operator(()operator(()ident(p) operator(()ident(opendir) ident(dir)operator(\))operator(\))operator(\)) - operator(()reserved(do) operator(()operator(()ident(file) operator(()ident(readdir) ident(p)operator(\)) operator(()ident(readdir) ident(p)operator(\))operator(\)) - operator(()ident(ls) operator(')operator(()operator(\))operator(\))operator(\)) - operator(()operator(()ident(eof-object?) ident(file)operator(\)) operator(()ident(closedir) ident(p)operator(\)) operator(()ident(reverse!) ident(ls)operator(\))operator(\)) - operator(()reserved(set!) ident(ls) operator(()reserved(cons) ident(file) ident(ls)operator(\))operator(\))operator(\))operator(\))operator(\))operator(\)) - -comment(;; to skip . and ..) -operator(()ident(cddr) operator(()ident(directory-files) ident(dir)operator(\))operator(\)) - -comment(;; probably better to implement full Emacs style directory-files) -operator(()ident(use-modules) operator(()ident(ice-9) ident(posix)operator(\))operator(\)) -operator(()reserved(define) ident(plain-files) - operator(()reserved(let) operator(()operator(()ident(rx) operator(()ident(make-regexp) string<delimiter(")content(^)content(\\\\)content(.)delimiter(")>operator(\))operator(\))operator(\)) - operator(()reserved(lambda) operator(()ident(dir)operator(\)) - operator(()ident(sort) operator(()ident(filter) operator(()reserved(lambda) operator(()ident(x)operator(\)) operator(()ident(eq?) operator(')ident(regular) operator(()ident(stat:type) operator(()ident(stat) ident(x)operator(\))operator(\))operator(\))operator(\)) - operator(()ident(map) operator(()reserved(lambda) operator(()ident(x)operator(\)) operator(()ident(string-append) ident(dir) string<delimiter(")content(/)delimiter(")> ident(x)operator(\))operator(\)) - operator(()ident(remove) operator(()reserved(lambda) operator(()ident(x)operator(\)) operator(()ident(regexp-exec) ident(rx) ident(x)operator(\))operator(\)) - operator(()ident(cddr) operator(()ident(directory-files) ident(dir)operator(\))operator(\))operator(\))operator(\))operator(\)) - ident(string<)operator(\))operator(\))operator(\))operator(\)) - -comment(;; @@PLEAC@@_9.6) -operator(()reserved(define) operator(()ident(glob->regexp) ident(pat)operator(\)) - operator(()reserved(let) operator(()operator(()ident(len) operator(()ident(string-length) ident(pat)operator(\))operator(\)) - operator(()ident(ls) operator(')operator(()string<delimiter(")content(^)delimiter(")>operator(\))operator(\)) - operator(()ident(in-brace?) pre_constant(#f)operator(\))operator(\)) - operator(()reserved(do) operator(()operator(()ident(i) integer(0) operator(()integer(1)ident(+) ident(i)operator(\))operator(\))operator(\)) - operator(()operator(()ident(=) ident(i) ident(len)operator(\))operator(\)) - operator(()reserved(let) operator(()operator(()ident(char) operator(()ident(string-ref) ident(pat) ident(i)operator(\))operator(\))operator(\)) - operator(()reserved(case) ident(char) - operator(()operator(()char(#\\*)operator(\)) operator(()reserved(set!) ident(ls) operator(()reserved(cons) string<delimiter(")content([^.]*)delimiter(")> ident(ls)operator(\))operator(\))operator(\)) - operator(()operator(()char(#\\?)operator(\)) operator(()reserved(set!) ident(ls) operator(()reserved(cons) string<delimiter(")content([^.])delimiter(")> ident(ls)operator(\))operator(\))operator(\)) - operator(()operator(()char(#\\[)operator(\)) operator(()reserved(set!) ident(ls) operator(()reserved(cons) string<delimiter(")content([)delimiter(")> ident(ls)operator(\))operator(\))operator(\)) - operator(()operator(()char(#\\])operator(\)) operator(()reserved(set!) ident(ls) operator(()reserved(cons) string<delimiter(")content(])delimiter(")> ident(ls)operator(\))operator(\))operator(\)) - operator(()operator(()char(#\\\\)operator(\)) - operator(()reserved(set!) ident(i) operator(()integer(1)ident(+) ident(i)operator(\))operator(\)) - operator(()reserved(set!) ident(ls) operator(()reserved(cons) operator(()ident(make-string) integer(1) operator(()ident(string-ref) ident(pat) ident(i)operator(\))operator(\)) ident(ls)operator(\))operator(\)) - operator(()reserved(set!) ident(ls) operator(()reserved(cons) string<delimiter(")content(\\\\)delimiter(")> ident(ls)operator(\))operator(\))operator(\)) - operator(()ident(else) - operator(()reserved(set!) ident(ls) operator(()reserved(cons) operator(()ident(regexp-quote) operator(()ident(make-string) integer(1) ident(char)operator(\))operator(\)) ident(ls)operator(\))operator(\))operator(\))operator(\))operator(\))operator(\)) - operator(()ident(string-concatenate) operator(()ident(reverse) operator(()reserved(cons) string<delimiter(")content($)delimiter(")> ident(ls)operator(\))operator(\))operator(\))operator(\))operator(\)) - -operator(()reserved(define) operator(()ident(glob) ident(pat) ident(dir)operator(\)) - operator(()reserved(let) operator(()operator(()ident(rx) operator(()ident(make-regexp) operator(()ident(glob->regexp) ident(pat)operator(\))operator(\))operator(\))operator(\)) - operator(()ident(filter) operator(()reserved(lambda) operator(()ident(x)operator(\)) operator(()ident(regexp-exec) ident(rx) ident(x)operator(\))operator(\)) operator(()ident(directory-files) ident(dir)operator(\))operator(\))operator(\))operator(\)) - -operator(()reserved(define) ident(files) operator(()ident(glob) string<delimiter(")content(*.c)delimiter(")> string<delimiter(")content(.)delimiter(")>operator(\))operator(\)) -operator(()reserved(define) ident(files) operator(()ident(glob) string<delimiter(")content(*.[ch])delimiter(")> string<delimiter(")content(.)delimiter(")>operator(\))operator(\)) - -comment(;; Not sure if the Schwartzian Transform would really be more) -comment(;; efficient here... perhaps with a much larger directory where very) -comment(;; few files matched.) -operator(()reserved(define) ident(dirs) operator(()ident(filter) - operator(()reserved(lambda) operator(()ident(x)operator(\)) operator(()ident(eq?) operator(')ident(directory) operator(()ident(stat:type) operator(()ident(stat) ident(x)operator(\))operator(\))operator(\))operator(\)) - operator(()ident(map) operator(()reserved(lambda) operator(()ident(x)operator(\)) operator(()ident(string-append) ident(dir) string<delimiter(")content(/)delimiter(")> ident(x)operator(\))operator(\)) - operator(()ident(sort) operator(()ident(filter) operator(()reserved(lambda) operator(()ident(x)operator(\)) operator(()ident(string-match) string<delimiter(")content(^[0-9]+$)delimiter(")> ident(x)operator(\))operator(\)) - operator(()ident(directory-files) ident(dir)operator(\))operator(\)) - operator(()reserved(lambda) operator(()ident(a) ident(b)operator(\)) - operator(()ident(<) operator(()ident(string->number) ident(a)operator(\)) operator(()ident(string->number) ident(b)operator(\))operator(\))operator(\))operator(\))operator(\))operator(\))operator(\)) - -comment(;; @@PLEAC@@_9.7) -operator(()reserved(define) operator(()ident(find) ident(proc) operator(.) ident(dirs)operator(\)) - operator(()reserved(cond) operator(()operator(()ident(pair?) ident(dirs)operator(\)) - operator(()ident(for-each) ident(proc) operator(()ident(map) operator(()reserved(lambda) operator(()ident(x)operator(\)) operator(()ident(string-append) operator(()ident(car) ident(dirs)operator(\)) string<delimiter(")content(/)delimiter(")> ident(x)operator(\))operator(\)) - operator(()ident(directory-files) operator(()ident(car) ident(dirs)operator(\))operator(\))operator(\))operator(\)) - operator(()ident(apply) ident(find) ident(proc) operator(()ident(cdr) ident(dirs)operator(\))operator(\))operator(\))operator(\))operator(\)) - -operator(()ident(find) operator(()reserved(lambda) operator(()ident(x)operator(\)) operator(()ident(format) pre_constant(#t) string<delimiter(")content(~A~A)content(\\n)delimiter(")> ident(x) - operator(()reserved(if) operator(()ident(equal?) operator(()ident(stat:type) operator(()ident(stat) ident(x)operator(\))operator(\)) operator(')ident(directory)operator(\)) - string<delimiter(")content(/)delimiter(")> string<delimiter(")delimiter(")>operator(\))operator(\))operator(\)) string<delimiter(")content(.)delimiter(")>operator(\)) - -operator(()reserved(define) ident(saved-size) ident(-)integer(1)operator(\)) -operator(()reserved(define) ident(saved-name) string<delimiter(")delimiter(")>operator(\)) -operator(()reserved(define) operator(()ident(biggest) ident(file)operator(\)) - operator(()reserved(let) operator(()operator(()ident(stats) operator(()ident(stat) ident(file)operator(\))operator(\))operator(\)) - operator(()reserved(if) operator(()ident(eq?) operator(()ident(stat:type) ident(stats)operator(\)) operator(')ident(regular)operator(\)) - operator(()reserved(let) operator(()operator(()ident(size) operator(()ident(stat:size) operator(()ident(stat) ident(file)operator(\))operator(\))operator(\))operator(\)) - operator(()reserved(cond) operator(()operator(()ident(>) ident(size) ident(saved-size)operator(\)) - operator(()reserved(set!) ident(saved-size) ident(size)operator(\)) - operator(()reserved(set!) ident(saved-name) ident(file)operator(\))operator(\))operator(\))operator(\))operator(\))operator(\))operator(\)) -operator(()ident(apply) ident(find) ident(biggest) operator(()ident(cdr) operator(()ident(command-line)operator(\))operator(\))operator(\)) -operator(()ident(format) pre_constant(#t) string<delimiter(")content(Biggest file ~A in ~A is ~A bytes long.)content(\\n)delimiter(")> - ident(saved-name) operator(()ident(cdr) operator(()ident(command-line)operator(\))operator(\)) ident(saved-size)operator(\)) - -error(#)ident(!/usr/local/bin/guile) ident(-)ident(s) -ident(!)error(#) -comment(;; fdirs - find all directories) -operator(()reserved(define) operator(()ident(print-dirs) ident(f)operator(\)) - operator(()reserved(if) operator(()ident(eq?) operator(()ident(stat:type) operator(()ident(stat) ident(f)operator(\))operator(\)) operator(')ident(directory)operator(\)) - operator(()ident(write-line) ident(f)operator(\))operator(\))operator(\)) -operator(()ident(apply) ident(find) ident(print-dirs) operator(()ident(cdr) operator(()ident(command-line)operator(\))operator(\))operator(\)) - -comment(;; @@PLEAC@@_9.8) -error(#)ident(!/usr/local/bin/guile) ident(-)ident(s) -ident(!)error(#) -comment(;; rmtree - remove whole directory trees like rm -f) -operator(()reserved(define) operator(()ident(finddepth) ident(proc) operator(.) ident(dirs)operator(\)) - operator(()reserved(cond) operator(()operator(()ident(pair?) ident(dirs)operator(\)) - operator(()ident(apply) ident(finddepth) ident(proc) operator(()ident(cdr) ident(dirs)operator(\))operator(\)) - operator(()ident(for-each) ident(proc) operator(()ident(map) operator(()reserved(lambda) operator(()ident(x)operator(\)) operator(()ident(string-append) operator(()ident(car) ident(dirs)operator(\)) string<delimiter(")content(/)delimiter(")> ident(x)operator(\))operator(\)) - operator(()ident(directory-files) operator(()ident(car) ident(dirs)operator(\))operator(\))operator(\))operator(\))operator(\))operator(\))operator(\)) -operator(()reserved(define) operator(()ident(zap) ident(f)operator(\)) - operator(()reserved(let) operator(()operator(()ident(rm) operator(()reserved(if) operator(()ident(eq?) operator(()ident(stat:type) operator(()ident(stat) ident(f)operator(\))operator(\)) operator(')ident(directory)operator(\)) ident(rmdir) ident(delete-file)operator(\))operator(\))operator(\)) - operator(()ident(format) pre_constant(#t) string<delimiter(")content(deleting ~A)content(\\n)delimiter(")> ident(f)operator(\)) - operator(()ident(catch) pre_constant(#t) - operator(()reserved(lambda) operator(()operator(\)) operator(()ident(rm) ident(f)operator(\))operator(\)) - operator(()reserved(lambda) ident(args) operator(()ident(format) pre_constant(#t) string<delimiter(")content(couldn't delete ~A)content(\\n)delimiter(")> ident(f)operator(\))operator(\))operator(\))operator(\))operator(\)) -operator(()reserved(let) operator(()operator(()ident(args) operator(()ident(cdr) operator(()ident(command-line)operator(\))operator(\))operator(\))operator(\)) - operator(()reserved(if) operator(()ident(null?) ident(args)operator(\)) - operator(()ident(error) string<delimiter(")content(usage: rmtree dir ..)content(\\n)delimiter(")>operator(\)) - operator(()ident(apply) ident(finddepth) ident(zap) ident(args)operator(\))operator(\))operator(\)) - -comment(;; @@PLEAC@@_9.9) -operator(()ident(for-each) - operator(()reserved(lambda) operator(()ident(file)operator(\)) - operator(()reserved(let) operator(()operator(()ident(newname) operator(()ident(function-of) ident(file)operator(\))operator(\))operator(\)) - operator(()ident(catch) pre_constant(#t) - operator(()reserved(lambda) operator(()operator(\)) operator(()ident(rename-file) ident(file) ident(newname)operator(\))operator(\)) - operator(()reserved(lambda) ident(args) operator(()ident(format) operator(()ident(current-error-port)operator(\)) - string<delimiter(")content(couldn't rename ~A to ~A)content(\\n)delimiter(")> ident(file) ident(newname)operator(\))operator(\))operator(\))operator(\))operator(\)) - ident(names)operator(\)) - -error(#)ident(!/usr/local/bin/guile) ident(-)ident(s) -ident(!)error(#) -comment(;; rename - Guile's filename fixer) -operator(()ident(use-modules) operator(()ident(ice-9) ident(regex)operator(\))operator(\)) comment(; not needed, but often useful here) -operator(()reserved(define) ident(args) operator(()ident(cdr) operator(()ident(command-line)operator(\))operator(\))operator(\)) -operator(()reserved(if) operator(()ident(null?) ident(args)operator(\)) operator(()ident(error) string<delimiter(")content(usage: rename expr [files])content(\\n)delimiter(")>operator(\))operator(\)) -operator(()reserved(define) ident(proc) operator(()ident(eval-string) operator(()ident(car) ident(args)operator(\))operator(\))operator(\)) -operator(()ident(for-each) - operator(()reserved(lambda) operator(()ident(old)operator(\)) - operator(()reserved(let) operator(()operator(()ident(new) operator(()ident(proc) ident(old)operator(\))operator(\))operator(\)) - operator(()reserved(if) operator(()ident(not) operator(()ident(string=?) ident(old) ident(new)operator(\))operator(\)) - operator(()ident(catch) pre_constant(#t) - operator(()reserved(lambda) operator(()operator(\)) operator(()ident(rename-file) ident(old) ident(new)operator(\))operator(\)) - operator(()reserved(lambda) ident(args) operator(()ident(format) operator(()ident(current-error-port)operator(\)) - string<delimiter(")content(couldn't rename ~A to ~A)content(\\n)delimiter(")> ident(old) ident(new)operator(\))operator(\))operator(\))operator(\))operator(\))operator(\)) - operator(()ident(cdr) ident(args)operator(\))operator(\)) - -comment(;; command-line examples:) -comment(;; rename '(lambda (x\) (regexp-substitute/global #f "\\\\.orig\\$" x (quote pre\)\)\)' *.orig) -comment(;; rename string-downcase *) -comment(;; rename '(lambda (x\) (if (string-match "^Make" x\) x (string-downcase x\)\)\)' *) -comment(;; rename '(lambda (x\) (string-append x ".bad"\)\)' *.pl) -comment(;; rename '(lambda (x\) (format #t "~a: "\) (read-line\)\)' *) - -comment(;; @@PLEAC@@_9.10) -operator(()reserved(define) ident(base) operator(()ident(basename) ident(path)operator(\))operator(\)) -operator(()reserved(define) ident(base) operator(()ident(dirname) ident(path) ident(ext)operator(\))operator(\)) -operator(()reserved(define) ident(dir) operator(()ident(dirname) ident(path)operator(\))operator(\)) - -operator(()reserved(define) ident(path) string<delimiter(")content(/usr/lib/libc.a)delimiter(")>operator(\)) -operator(()reserved(define) ident(file) operator(()ident(basename) ident(path)operator(\))operator(\)) -operator(()reserved(define) ident(dir) operator(()ident(dirname) ident(path)operator(\))operator(\)) - -operator(()ident(format) pre_constant(#t) string<delimiter(")content(dir is ~A, file is ~A)content(\\n)delimiter(")> ident(dir) ident(file)operator(\)) - -operator(()ident(basename) ident(path) string<delimiter(")content(.a)delimiter(")>operator(\)) comment(; libc) - -operator(()ident(use-modules) operator(()ident(ice-9) ident(regex)operator(\))operator(\)) -operator(()reserved(define) operator(()ident(file-parse) ident(path) operator(.) ident(args)operator(\)) - operator(()reserved(let*) operator(()operator(()ident(ext) operator(()reserved(if) operator(()ident(null?) ident(args)operator(\)) string<delimiter(")content(\\\\)content(..*)delimiter(")> operator(()ident(car) ident(args)operator(\))operator(\))operator(\)) - operator(()ident(rx1) operator(()ident(string-append) string<delimiter(")content(^((.*\)/\)?(.*\)?()delimiter(")> ident(ext) string<delimiter(")content(\)$)delimiter(")>operator(\))operator(\)) - operator(()ident(rx2) operator(()ident(string-append) string<delimiter(")content(^((.*\)/\)?(.*\)?(\)$)delimiter(")>operator(\))operator(\))operator(\)) - operator(()reserved(let) operator(()operator(()ident(m) operator(()reserved(or) operator(()ident(string-match) ident(rx1) ident(path)operator(\)) operator(()ident(string-match) ident(rx2) ident(path)operator(\))operator(\))operator(\))operator(\)) - operator(()ident(list) operator(()ident(match:substring) ident(m) integer(2)operator(\)) operator(()ident(match:substring) ident(m) integer(3)operator(\)) - operator(()ident(match:substring) ident(m) integer(4)operator(\))operator(\))operator(\))operator(\))operator(\)) - -operator(()reserved(define) operator(()ident(extension) ident(path) operator(.) ident(args)operator(\)) - operator(()ident(caddr) operator(()ident(apply) ident(file-parse) ident(path) ident(args)operator(\))operator(\))operator(\)) - -comment(;; @@PLEAC@@_10.0) -comment(; Note: Some of the examples will show code blocks in this style:) -comment(;) -comment(; (define) -comment(; ... code here ...) -comment(; \)) -comment(;) -comment(; This is not generally considered good style, and is not recommended;) -comment(; it is only used here to more clearly highlight block scope ) - -comment(; By convention a 'global variable' i.e. a variable that is defined at) -comment(; the top-level, and as such, visible within any scope, is named with) -comment(; beginning and ending asterisks [and one to be used as a constant) -comment(; with beginning and ending plus signs]) - -operator(()reserved(define) ident(*greeted*) integer(0)operator(\)) - -operator(()reserved(define) operator(()ident(hello)operator(\)) - operator(()reserved(set!) ident(*greeted*) operator(()ident(+) ident(*greeted*) integer(1)operator(\))operator(\)) - operator(()ident(print) string<delimiter(")content(hi there!, this procedure has been called)delimiter(")> ident(*greeted*) string<delimiter(")content(times)delimiter(")>operator(\))operator(\)) - -operator(()reserved(define) operator(()ident(how-many-greetings)operator(\)) ident(*greeted*)operator(\)) - -comment(;; ------------) - -operator(()ident(hello)operator(\)) - -operator(()reserved(define) ident(*greetings*) operator(()ident(how-many-greetings)operator(\))operator(\)) - -operator(()ident(print) string<delimiter(")content(bye there!, there have been)delimiter(")> ident(*greetings*) string<delimiter(")content(greetings so far)delimiter(")>operator(\)) - -comment(;; @@PLEAC@@_10.1) -comment(; Subroutine parameters are named [whether directly, or indirectly in) -comment(; the case of variable arguments - see next example]; this is the only) -comment(; means of access [This contrasts with languages like Perl and REXX which) -comment(; allow access to arguments via array subscripting, and function calls,) -comment(; respectively]) -operator(()reserved(define) operator(()ident(hypotenuse) ident(side1) ident(side2)operator(\)) - operator(()ident(sqrt) operator(()ident(sum) operator(()ident(*) ident(side1) ident(side1)operator(\)) operator(()ident(*) ident(side2) ident(side2)operator(\))operator(\))operator(\))operator(\)) - -operator(()reserved(define) ident(*diag*) operator(()ident(hypotenuse) integer(3) integer(4)operator(\))operator(\)) - -comment(;; ----) - -comment(; 'other-sides' is the name of a list of containing any additional) -comment(; parameters. Note that a name is still used to access values) -operator(()reserved(define) operator(()ident(hypotenuse) ident(side1) operator(.) ident(other-sides)operator(\)) - operator(()reserved(let) operator(()operator(()ident(all-sides) operator(()reserved(cons) ident(side1) ident(other-sides)operator(\))operator(\))operator(\)) - operator(()ident(for-each) - operator(()reserved(lambda) operator(()ident(side)operator(\)) ident(...)operator(\)) - ident(all-sides)operator(\)) - ident(...)operator(\))operator(\)) - -comment(;; ----) - -operator(()reserved(define) ident(*diag*) operator(()ident(hypotenuse) integer(3) integer(4)operator(\))operator(\)) - -comment(;; ----) - -comment(; Possible to pack parameters into a single structure [e.g. list or) -comment(; array], and access values contained therein) -operator(()reserved(define) operator(()ident(hypotenuse) ident(sides)operator(\)) - operator(()reserved(let) operator(()operator(()ident(side1) operator(()ident(car) ident(sides)operator(\))operator(\)) operator(()ident(side2) operator(()ident(caar) ident(sides)operator(\))operator(\))operator(\)) - operator(()ident(sqrt) operator(()ident(sum) operator(()ident(*) ident(side1) ident(side1)operator(\)) operator(()ident(*) ident(side2) ident(side2)operator(\))operator(\))operator(\))operator(\))operator(\)) - -comment(;; ----) - -operator(()reserved(define) ident(*args*) operator(')operator(()integer(3) integer(4)operator(\))operator(\)) -operator(()reserved(define) ident(*diag*) operator(()ident(hypotenuse) ident(*args*)operator(\))operator(\)) - -comment(;; ------------) - -comment(; Parameters passed by reference, however, whether original object is) -comment(; modified depends on choice of functions used to manipulate them) -comment(; [most functions create copies and return these; mutating versions of) -comment(; same functions may also exist [see next example] ) -operator(()reserved(define) ident(*nums*) operator(()ident(vector) integer(1.4) integer(3.5) integer(6.7)operator(\))operator(\)) - -operator(()reserved(define) operator(()ident(int-all) ident(vec)operator(\)) - operator(()ident(vector-map-in-order) - operator(()reserved(lambda) operator(()ident(element)operator(\)) operator(()ident(inexact->exact) operator(()ident(round) ident(element)operator(\))operator(\))operator(\)) - ident(vec)operator(\))operator(\)) - -comment(; Copy created) -operator(()reserved(define) ident(*ints*) operator(()ident(int-all) ident(*nums*)operator(\))operator(\)) - -operator(()ident(print) ident(*nums*)operator(\)) -operator(()ident(print) ident(*ints*)operator(\)) - -comment(;; ----) - -operator(()reserved(define) ident(*nums*) operator(()ident(vector) integer(1.4) integer(3.5) integer(6.7)operator(\))operator(\)) - -operator(()reserved(define) operator(()ident(trunc-all) ident(vec)operator(\)) - operator(()ident(array-map-in-order!) - operator(()reserved(lambda) operator(()ident(element)operator(\)) operator(()ident(inexact->exact) operator(()ident(round) ident(element)operator(\))operator(\))operator(\)) - ident(vec)operator(\))operator(\)) - -comment(; Original modified) -operator(()ident(trunc-all) ident(*nums*)operator(\)) - -comment(;; @@PLEAC@@_10.2) -comment(; Scheme is lexically-scoped; variables defined within a block are) -comment(; visible only within that block. Whilst nested / subordinate blocks) -comment(; have access to those variables, neither the caller, nor any called) -comment(; procedures have direct access to those same variables) - -operator(()reserved(define) operator(()ident(some-func) ident(parm1) ident(parm2) ident(parm3)operator(\)) - ident(...) ident(paramaters) ident(visible) ident(here) ident(...) - - operator(()reserved(let) operator(()operator(()ident(var1) ident(...)operator(\)) operator(()ident(var2) ident(...)operator(\)) operator(()ident(var3) ident(...)operator(\)) ident(...)operator(\)) - ident(...) ident(parameters) ident(also) ident(visible) ident(here)error(,) ident(but) ident(variables)error(,) operator(')ident(var1)operator(') ident(etc) - ident(only) ident(visible) ident(within) ident(this) ident(block) ident(...) - operator(\)) - ident(...) ident(paramaters) ident(also) ident(visible) ident(here)error(,) ident(but) ident(still) ident(within) ident(procedure) ident(body) ident(...) -operator(\)) - -comment(;; ------------) - -comment(; Top-level definitions - accessable globally ) -operator(()reserved(define) ident(*name*) operator(()ident(caar) operator(()ident(command-line)operator(\))operator(\))operator(\)) -operator(()reserved(define) ident(*age*) operator(()ident(cadr) operator(()ident(command-line)operator(\))operator(\))operator(\)) - -operator(()reserved(define) ident(*start*) operator(()ident(fetch-time)operator(\))operator(\)) - -comment(;; ----) - -comment(; Lexical binding - accessable only within this block) -operator(()reserved(let) operator(()operator(()ident(name) operator(()ident(caar) operator(()ident(command-line)operator(\))operator(\))operator(\)) - operator(()ident(age) operator(()ident(cadr) operator(()ident(command-line)operator(\))operator(\))operator(\)) - operator(()ident(start) operator(()ident(fetch-time)operator(\))operator(\))operator(\)) - ident(...) ident(variables) ident(only) ident(visible) ident(here) ident(...) -operator(\)) - -comment(;; ------------) - -operator(()reserved(define) ident(*pair*) operator(')operator(()integer(1) operator(.) integer(2)operator(\))operator(\)) - -comment(; 'a' and 'b' need to be dereferenced and separately defined [Also,) -comment(; since globally defined, should really be named, '*a*', '*b*', etc]) -operator(()reserved(define) ident(a) operator(()ident(car) ident(*pair*)operator(\))operator(\)) -operator(()reserved(define) ident(b) operator(()ident(cdr) ident(*pair*)operator(\))operator(\)) -operator(()reserved(define) ident(c) operator(()ident(fetch-time)operator(\))operator(\)) - -operator(()reserved(define) operator(()ident(run-check)operator(\)) - ident(...) reserved(do) ident(something) ident(with) operator(')ident(a)operator(')error(,) operator(')ident(b)operator(')error(,) reserved(and) operator(')ident(c)operator(') ident(...) -operator(\)) - -operator(()reserved(define) operator(()ident(check-x) ident(x) ident(y)operator(\)) - operator(()reserved(if) operator(()ident(run-check)operator(\)) - operator(()ident(print) string<delimiter(")content(got)delimiter(")> ident(x)operator(\))operator(\))operator(\)) - -comment(; Calling 'check-x'; 'run-check' has access to 'a', 'b', and 'c') -operator(()ident(check-x) ident(...)operator(\)) - -comment(;; ----) - -comment(; If defined within a block, variables 'a', 'b', and 'c' are no longer) -comment(; accessable anywhere except that scope. Therefore, 'run-check' as) -comment(; defined above can no longer access these variables [in fact, the code) -comment(; will fail because variables 'a', 'b', and 'c' do not exist when) -comment(; 'run-check' is defined]) -operator(()reserved(let) operator(()operator(()ident(a) operator(()ident(car) ident(*pair*)operator(\))operator(\)) - operator(()ident(b) operator(()ident(cdr) ident(*pair*)operator(\))operator(\)) - operator(()ident(c) operator(()ident(fetch-time)operator(\))operator(\))operator(\)) - ident(...) - operator(()ident(check-x) ident(...)operator(\)) - ident(...) -operator(\)) - -comment(;; ----) - -comment(; The procedures, 'run-check' and 'check-x' are defined within the) -comment(; same block as variables, 'a', 'b', and 'c', so have direct access to) -comment(; them) -operator(()reserved(let*) operator(()operator(()ident(a) operator(()ident(car) ident(*pair*)operator(\))operator(\)) - operator(()ident(b) operator(()ident(cdr) ident(*pair*)operator(\))operator(\)) - operator(()ident(c) operator(()ident(fetch-time)operator(\))operator(\)) - - operator(()ident(run-check) - operator(()reserved(lambda) operator(()operator(\)) ident(...) reserved(do) ident(something) ident(with) operator(')ident(a)operator(')error(,) operator(')ident(b)operator(')error(,) reserved(and) operator(')ident(c)operator(') ident(...)operator(\))operator(\)) - - operator(()ident(check-x) - operator(()reserved(lambda) operator(()ident(x) ident(y)operator(\)) - operator(()reserved(if) operator(()ident(run-check)operator(\)) - operator(()ident(print) string<delimiter(")content(got)delimiter(")> ident(x)operator(\))operator(\))operator(\))operator(\)) operator(\)) - ident(...) - operator(()ident(check-x) ident(...)operator(\)) - ident(...) -operator(\)) - -comment(;; @@PLEAC@@_10.3) -comment(; Ordinarily, a variable must be initialised when it is defined,) -comment(; whether at the top-level: ) -operator(()reserved(define) ident(*variable*) integer(1)operator(\)) - -comment(; ... or within a 'let' binding) -operator(()reserved(let*) operator(()operator(()ident(variable) integer(1)operator(\)) - operator(()ident(mysub) - operator(()reserved(lambda) operator(()operator(\)) ident(...) ident(accessing) operator(')ident(variable)operator(') ident(...)operator(\))operator(\))operator(\)) - ident(...) reserved(do) ident(stuff) ident(...) -operator(\)) - -comment(; However, since Scheme allows syntactic extensions via 'macros' [of) -comment(; which there are two varieties: hygenic and LISP-based], it is) -comment(; possible to create new forms which alter this behaviour. For example,) -comment(; in this tutorial: http://home.comcast.net/~prunesquallor/macro.txt) -comment(; there is a macro implementation equivalent to 'let, 'called,) -comment(; 'bind-values', which allows variables to be defined without initial) -comment(; values; an example follows:) - -comment(; Initialisation values for 'a' and 'b' not specified) -operator(()ident(bind-values) operator(()operator(()ident(a)operator(\)) ident(b) operator(()ident(c) operator(()ident(+) ident(*global*) integer(5)operator(\))operator(\))operator(\)) - ident(...) reserved(do) ident(stuff) ident(...) -operator(\)) - -comment(; In Scheme many things are possible, but not all those things are) -comment(; offered as standard features :\) !) - -comment(;; ------------) - -operator(()reserved(let*) operator(()operator(()ident(counter) integer(42)operator(\)) - operator(()ident(next-counter) - operator(()reserved(lambda) operator(()operator(\)) operator(()reserved(set!) ident(counter) operator(()ident(+) ident(counter) integer(1)operator(\))operator(\)) ident(counter)operator(\))operator(\)) - operator(()ident(prev-counter) - operator(()reserved(lambda) operator(()operator(\)) operator(()reserved(set!) ident(counter) operator(()ident(-) ident(counter) integer(1)operator(\))operator(\)) ident(counter)operator(\))operator(\))operator(\)) - - ident(...) reserved(do) ident(stuff) ident(with) operator(')ident(next-counter)operator(') reserved(and) operator(')ident(prev-counter)operator(') ident(...) -operator(\)) - -comment(;; ----) - -comment(; A more complete, and practical, variation of the above code:) - -comment(; 'counter' constructor) -operator(()reserved(define) operator(()ident(make-counter) ident(start)operator(\)) - operator(()reserved(let*) operator(()operator(()ident(counter) integer(42)operator(\)) - operator(()ident(next-counter) - operator(()reserved(lambda) operator(()operator(\)) operator(()reserved(set!) ident(counter) operator(()ident(+) ident(counter) integer(1)operator(\))operator(\)) ident(counter)operator(\))operator(\)) - operator(()ident(prev-counter) - operator(()reserved(lambda) operator(()operator(\)) operator(()reserved(set!) ident(counter) operator(()ident(-) ident(counter) integer(1)operator(\))operator(\)) ident(counter)operator(\))operator(\))operator(\)) - operator(()reserved(lambda) operator(()ident(op)operator(\)) - operator(()reserved(cond) - operator(()operator(()ident(eq?) ident(op) operator(')ident(prev)operator(\)) ident(prev-counter)operator(\)) - operator(()operator(()ident(eq?) ident(op) operator(')ident(next)operator(\)) ident(next-counter)operator(\)) - operator(()ident(else) operator(()reserved(lambda) operator(()operator(\)) operator(()ident(display) string<delimiter(")content(error:counter)delimiter(")>operator(\))operator(\))operator(\)) operator(\))operator(\))operator(\))operator(\)) - -comment(; Interface functions to 'counter' functionality) -operator(()reserved(define) operator(()ident(prev-counter) ident(counter)operator(\)) operator(()ident(apply) operator(()ident(counter) operator(')ident(prev)operator(\)) operator(')operator(()operator(\))operator(\))operator(\)) -operator(()reserved(define) operator(()ident(next-counter) ident(counter)operator(\)) operator(()ident(apply) operator(()ident(counter) operator(')ident(next)operator(\)) operator(')operator(()operator(\))operator(\))operator(\)) - -comment(; Create a 'counter') -operator(()reserved(define) ident(*counter*) operator(()ident(make-counter) integer(42)operator(\))operator(\)) - -comment(; Use the 'counter' ...) -operator(()ident(print) operator(()ident(prev-counter) ident(*counter*)operator(\))operator(\)) -operator(()ident(print) operator(()ident(prev-counter) ident(*counter*)operator(\))operator(\)) -operator(()ident(print) operator(()ident(next-counter) ident(*counter*)operator(\))operator(\)) - -comment(;; @@PLEAC@@_10.4) -comment(; Scheme interpreters generally provide a rich collection of procedure) -comment(; metadata, as well as easy access to a program's current 'execution) -comment(; state'. Put simply, provision of a powerful, highly customisable) -comment(; debugging / tracing facility is almost taken for granted. However, using) -comment(; it to perform as trivial a task as obtaining the current function name) -comment(; is less than trivial [at least it seems so in Guile] as it appears to) -comment(; require quite some setup work. Additionally, the documentation talks) -comment(; about facilities e.g. trap installation, that don't appear to be) -comment(; available [at least, I couldn't find them].) -comment(;) -comment(; Example below uses in-built debugging facilities to dump a backtrace) -comment(; to a string port and extract the caller's name from the resulting) -comment(; string. Not exactly elegant ...) - -comment(; Execute using: guile --debug ... else no useful output seen) -operator(()ident(use-modules) operator(()ident(ice-9) ident(debug)operator(\))operator(\)) - -operator(()reserved(define) operator(()ident(child) ident(num)operator(\)) - comment(; Create stack [i.e. activation record] object, discarding) - comment(; irrelevant frames) - operator(()reserved(let) operator(()operator(()ident(s) operator(()ident(make-stack) pre_constant(#t) integer(3) integer(1)operator(\))operator(\)) - operator(()ident(trace-string-port) operator(()ident(open-output-string)operator(\))operator(\)) - operator(()ident(parent-name) string<delimiter(")delimiter(")>operator(\))operator(\)) - - comment(; Dump backtrace to string port) - operator(()ident(display-backtrace) ident(s) ident(trace-string-port)operator(\)) - - comment(; Extract caller's name from backtrace data) - comment(; [shamefully crude - don't do this at home !]) - operator(()reserved(set!) ident(parent-name) - operator(()ident(caddr) operator(()ident(string-tokenize) - operator(()ident(cadr) operator(()ident(string-split) - operator(()ident(get-output-string) ident(trace-string-port)operator(\)) - char(#\\newline)operator(\))operator(\)) - ident(char-set:graphic)operator(\))operator(\))operator(\)) - - comment(; Who's your daddy ?) - operator(()ident(print) ident(parent-name)operator(\))operator(\))operator(\)) - -comment(; Each invocation of 'child' should see 'parent' displayed as) -comment(; the caller) -operator(()reserved(define) operator(()ident(parent)operator(\)) - operator(()ident(child) integer(1)operator(\)) - operator(()ident(child) integer(2)operator(\)) - operator(()ident(child) integer(3)operator(\))operator(\)) - -operator(()ident(parent)operator(\)) - -comment(;; @@PLEAC@@_10.5) -comment(; Procedure parameters are references to entities, so there is no special) -comment(; treatment required. If an argument represents a mutable object such) -comment(; as an array, then care should be taken to not mutate the object within) -comment(; the procedure, or a copy of the object be made and used) - -operator(()ident(array-diff) ident(*array1*) ident(*array2*)operator(\)) - -comment(;; ------------) - -operator(()reserved(define) operator(()ident(add-vector-pair) ident(x) ident(y)operator(\)) - operator(()reserved(let*) operator(()operator(()ident(vector-length) operator(()ident(vector-length) ident(x)operator(\))operator(\)) - operator(()ident(new-vec) operator(()ident(make-vector) ident(vector-length)operator(\))operator(\))operator(\)) - operator(()reserved(let) ident(loop) operator(()operator(()ident(i) integer(0)operator(\))operator(\)) - operator(()reserved(cond) - operator(()operator(()ident(=) ident(i) ident(vector-length)operator(\)) ident(new-vec)operator(\)) - operator(()ident(else) - operator(()ident(vector-set!) ident(new-vec) ident(i) operator(()ident(+) operator(()ident(vector-ref) ident(x) ident(i)operator(\)) operator(()ident(vector-ref) ident(y) ident(i)operator(\))operator(\))operator(\)) - operator(()ident(loop) operator(()ident(+) ident(i) integer(1)operator(\))operator(\)) operator(\))operator(\))operator(\)) operator(\))operator(\)) - -comment(;; ----) - -operator(()reserved(define) ident(*a*) operator(')operator(#()integer(1) integer(2)operator(\))operator(\)) -operator(()reserved(define) ident(*b*) operator(')operator(#()integer(5) integer(8)operator(\))operator(\)) - -operator(()reserved(define) ident(*c*) operator(()ident(add-vector-pair) ident(*a*) ident(*b*)operator(\))operator(\)) - -operator(()ident(print) ident(*c*)operator(\)) - -comment(;; ----) - - ident(...) - - operator(()reserved(if) operator(()reserved(and) operator(()ident(vector?) ident(a1)operator(\)) operator(()ident(vector?) ident(a2)operator(\))operator(\)) - operator(()ident(print) operator(()ident(add-vector-pair) ident(a1) ident(a2)operator(\))operator(\)) - comment(;else) - operator(()ident(print) string<delimiter(")content(usage: add-vector-pair a1 a2)delimiter(")>operator(\))operator(\)) - - ident(...) - -comment(;; @@PLEAC@@_10.6) -comment(; AFAIK there is no Scheme equivalent to Perl's 'return context' where) -comment(; it is possible to use language primitives [e.g. 'wantarray'] to ) -comment(; dynamically specify the return type of a procedure. It is, however,) -comment(; possible to:) -comment(; * Return one of several types from a procedure, whether based on ) -comment(; processing results [e.g. 'false' on error, numeric on success], or) -comment(; perhaps specified via control argument) -comment(; * Check procedure return type and take appropriate action) - -operator(()reserved(define) operator(()ident(my-sub)operator(\)) - operator(()reserved(let*) operator(()operator(()ident(datatype) operator(()ident(vector) operator(')operator(()operator(\)) integer(7) operator(')operator(()integer(1) integer(2) integer(3)operator(\)) string<delimiter(")content(abc)delimiter(")> operator(')ident(sym)operator(\))operator(\))operator(\)) - operator(()ident(vector-ref) ident(datatype) operator(()ident(random) operator(()ident(vector-length) ident(datatype)operator(\))operator(\))operator(\)) operator(\))operator(\)) - -comment(;; ----) - -comment(; '*result*' is bound to a randomly chosen datatype) -operator(()reserved(define) ident(*result*) operator(()ident(my-sub)operator(\))operator(\)) - -operator(()reserved(cond) - comment(; It is common to return an empty list to represent 'void') - operator(()operator(()ident(null?) ident(*result*)operator(\)) operator(()ident(print) string<delimiter(")content(void context)delimiter(")>operator(\))operator(\)) - - operator(()operator(()ident(list?) ident(*result*)operator(\)) operator(()ident(print) string<delimiter(")content(list context)delimiter(")>operator(\))operator(\)) - operator(()operator(()ident(number?) ident(*result*)operator(\)) operator(()ident(print) string<delimiter(")content(scalar context)delimiter(")>operator(\))operator(\)) - operator(()operator(()ident(string?) ident(*result*)operator(\)) operator(()ident(print) string<delimiter(")content(string context)delimiter(")>operator(\))operator(\)) - operator(()operator(()ident(symbol?) ident(*result*)operator(\)) operator(()ident(print) string<delimiter(")content(atom context)delimiter(")>operator(\))operator(\)) - operator(()ident(else) operator(()ident(print) string<delimiter(")content(Unknown type)delimiter(")>operator(\))operator(\))operator(\)) - -comment(;; @@PLEAC@@_10.7) -comment(; Keyword parameters are fully supported. Note that pairs have) -comment(; replaced Perl strings in the examples since they are easier to) -comment(; manipulate) - -operator(()ident(use-modules) operator(()ident(ice-9) ident(optargs)operator(\))operator(\)) - -operator(()ident(define*) operator(()ident(the-func) error(#)ident(:key) operator(()ident(increment) operator(()reserved(cons) integer(10) operator(')ident(s)operator(\))operator(\)) - operator(()ident(finish) operator(()reserved(cons) integer(0) operator(')ident(m)operator(\))operator(\)) - operator(()ident(start) operator(()reserved(cons) integer(0) operator(')ident(m)operator(\))operator(\))operator(\)) - operator(()ident(print) ident(increment)operator(\)) - operator(()ident(print) ident(finish)operator(\)) - operator(()ident(print) ident(start)operator(\))operator(\)) - -operator(()ident(the-func)operator(\)) -operator(()ident(the-func) error(#)ident(:increment) operator(()reserved(cons) integer(20) operator(')ident(s)operator(\)) error(#)ident(:start) operator(()reserved(cons) integer(5) operator(')ident(m)operator(\)) error(#)ident(:finish) operator(()reserved(cons) integer(30) operator(')ident(m)operator(\))operator(\)) -operator(()ident(the-func) error(#)ident(:start) operator(()reserved(cons) integer(5) operator(')ident(m)operator(\)) error(#)ident(:finish) operator(()reserved(cons) integer(30) operator(')ident(m)operator(\))operator(\)) -operator(()ident(the-func) error(#)ident(:finish) operator(()reserved(cons) integer(30) operator(')ident(m)operator(\))operator(\)) -operator(()ident(the-func) error(#)ident(:start) operator(()reserved(cons) integer(5) operator(')ident(m)operator(\)) error(#)ident(:increment) operator(()reserved(cons) integer(20) operator(')ident(s)operator(\))operator(\)) - -comment(;; @@PLEAC@@_10.8) -comment(;; @@INCOMPLETE@@) -comment(;; @@INCOMPLETE@@) - -comment(;; @@PLEAC@@_10.9) -comment(; The return of multiple values, whether arrays or other items, may be ) -comment(; achieved via:) -comment(; * Packaging return items as a single list, structure or array, an) -comment(; approach which is usable across many languages, though can be) -comment(; clunky because the procedure caller must manually extract all) -comment(; items) -comment(; * The 'values' procedure, a more Schemish idiom, is usually used in) -comment(; conjunction with the 'call-with-values' procedure [the former combines) -comment(; multiple values, the latter captures and cleanly extracts them]. It) -comment(; comes into its own, however, when used to create a 'macro' [an) -comment(; extension to the Scheme language] like 'let-values', a variation of) -comment(; the 'let' form that allows multiple return values to be placed directly) -comment(; into separate variables. Implementation shown here is from 'The) -comment(; Scheme Programming Language, 3rd Edition' by R. Kent Dybvig, though) -comment(; there exists a more standard implementation in SRFI-11. There is also) -comment(; the 'receive' functionality accessable via: (use-modules (ice-9 receive\)\)) - -comment(; [1] Implementation of 'somefunc' returning muliple values via packaging) -comment(; items within a list that is returned) -operator(()reserved(define) operator(()ident(somefunc)operator(\)) - operator(()reserved(let) operator(()operator(()ident(a) operator(()ident(make-vector) integer(5)operator(\))operator(\)) - operator(()ident(h) operator(()ident(make-hash-table) integer(5)operator(\))operator(\))operator(\)) - operator(()ident(list) ident(a) ident(h)operator(\)) operator(\))operator(\)) - -comment(; Retrieving procedure values requires that the return list be captured) -comment(; and each contained item separately extracted ['let*' used in place of) -comment(; 'let' to ensure correct retrieval order]) -operator(()reserved(let*) operator(()operator(()ident(return-list) operator(()ident(somefunc)operator(\))operator(\)) - operator(()ident(a) operator(()ident(car) ident(return-list)operator(\))operator(\)) - operator(()ident(b) operator(()ident(cadr) ident(return-list)operator(\))operator(\))operator(\)) - - ident(...) reserved(do) ident(something) ident(with) operator(')ident(a)operator(') reserved(and) operator(')ident(b)operator(') ident(...)operator(\)) - -comment(;; ----------------------------) - -comment(; [2] Implementation of 'somefunc' returning muliple values using the) -comment(; 'values' procedure ) - -operator(()ident(use-syntax) operator(()ident(ice-9) ident(syncase)operator(\))operator(\)) - -comment(; 'let-values' from: http://www.scheme.com/tspl3/syntax.html#fullletvalues) -operator(()reserved(define-syntax) ident(let-values) - operator(()ident(syntax-rules) operator(()operator(\)) - operator(()operator(()ident(_) operator(()operator(\)) ident(f1) ident(f2) ident(...)operator(\)) operator(()reserved(let) operator(()operator(\)) ident(f1) ident(f2) ident(...)operator(\))operator(\)) - operator(()operator(()ident(_) operator(()operator(()ident(fmls1) ident(expr1)operator(\)) operator(()ident(fmls2) ident(expr2)operator(\)) ident(...)operator(\)) ident(f1) ident(f2) ident(...)operator(\)) - operator(()ident(lvhelp) ident(fmls1) operator(()operator(\)) operator(()operator(\)) ident(expr1) operator(()operator(()ident(fmls2) ident(expr2)operator(\)) ident(...)operator(\)) operator(()ident(f1) ident(f2) ident(...)operator(\))operator(\))operator(\))operator(\))operator(\)) - -operator(()reserved(define-syntax) ident(lvhelp) - operator(()ident(syntax-rules) operator(()operator(\)) - operator(()operator(()ident(_) operator(()ident(x1) operator(.) ident(fmls)operator(\)) operator(()ident(x) ident(...)operator(\)) operator(()ident(t) ident(...)operator(\)) ident(e) ident(m) ident(b)operator(\)) - operator(()ident(lvhelp) ident(fmls) operator(()ident(x) ident(...) ident(x1)operator(\)) operator(()ident(t) ident(...) ident(tmp)operator(\)) ident(e) ident(m) ident(b)operator(\))operator(\)) - operator(()operator(()ident(_) operator(()operator(\)) operator(()ident(x) ident(...)operator(\)) operator(()ident(t) ident(...)operator(\)) ident(e) ident(m) ident(b)operator(\)) - operator(()ident(call-with-values) - operator(()reserved(lambda) operator(()operator(\)) ident(e)operator(\)) - operator(()reserved(lambda) operator(()ident(t) ident(...)operator(\)) - operator(()ident(let-values) ident(m) operator(()reserved(let) operator(()operator(()ident(x) ident(t)operator(\)) ident(...)operator(\)) operator(.) ident(b)operator(\))operator(\))operator(\))operator(\))operator(\)) - operator(()operator(()ident(_) ident(xr) operator(()ident(x) ident(...)operator(\)) operator(()ident(t) ident(...)operator(\)) ident(e) ident(m) ident(b)operator(\)) - operator(()ident(call-with-values) - operator(()reserved(lambda) operator(()operator(\)) ident(e)operator(\)) - operator(()reserved(lambda) operator(()ident(t) ident(...) operator(.) ident(tmpr)operator(\)) - operator(()ident(let-values) ident(m) operator(()reserved(let) operator(()operator(()ident(x) ident(t)operator(\)) ident(...) operator(()ident(xr) ident(tmpr)operator(\))operator(\)) operator(.) ident(b)operator(\))operator(\))operator(\))operator(\))operator(\))operator(\))operator(\)) - -comment(;; ------------) - -operator(()reserved(define) operator(()ident(somefunc)operator(\)) - operator(()reserved(let) operator(()operator(()ident(a) operator(()ident(make-vector) integer(5)operator(\))operator(\)) - operator(()ident(h) operator(()ident(make-hash-table) integer(5)operator(\))operator(\))operator(\)) - operator(()ident(values) ident(a) ident(h)operator(\)) operator(\))operator(\)) - -comment(; Multiple return items placed directly into separate variables) -operator(()ident(let-values) operator(() operator(()operator(()ident(a) ident(h)operator(\)) operator(()ident(somefunc)operator(\))operator(\)) operator(\)) - operator(()ident(print) operator(()ident(array?) ident(a)operator(\))operator(\)) - operator(()ident(print) operator(()ident(hash-table?) ident(h)operator(\))operator(\))operator(\)) - -comment(;; @@PLEAC@@_10.10) -comment(; Like most modern languages, Scheme supports exceptions for handling) -comment(; failure, something that will be illustrated in another section. However,) -comment(; conventions exist as to the choice of value used to indicate failure:) -comment(; * Empty list i.e. '(\) is often used for this task, as is it's string) -comment(; counterpart, "", the empty string) -comment(; * Return false i.e. #f to indicate failed / not found etc, and a valid) -comment(; value otherwise [e.g. testing set membership: if not a member, return) -comment(; #f, but if a member, return the item itself rather than #t]) - -comment(; Return empty list as indicating 'failure') -operator(()reserved(define) operator(()ident(sub-failed)operator(\)) operator(')operator(()operator(\))operator(\)) - -comment(;; ------------) - -operator(()reserved(define) operator(()ident(look-for-something)operator(\)) - ident(...) - operator(()reserved(if) operator(()ident(something-found)operator(\)) - comment(; Item found, return the item) - ident(something) - comment(;else) - comment(; Not found, indicate failure) - pre_constant(#f) - operator(\))operator(\)) - -comment(;; ----) - -operator(()reserved(if) operator(()ident(not) operator(()ident(look-for-something)operator(\))operator(\)) - operator(()ident(print) string<delimiter(")content(Item could not be found ...)delimiter(")>operator(\)) -comment(;else) - comment(; do something with item ...) - ident(...) - -comment(;; ------------) - -comment(; An interesting variation on returning #f as a failure indicator is) -comment(; in using the, 'false-if-exception' procedure whereby a procedure is) -comment(; executed, any exceptions it may throw caught, and handled by simply) -comment(; returning #f. See example in section on Exception Handling below.) - -comment(;; ------------) - -operator(()reserved(define) operator(()ident(ioctl)operator(\)) ident(...) pre_constant(#f)operator(\)) - -operator(()reserved(or) operator(()ident(ioctl)operator(\)) operator(()reserved(begin) operator(()ident(print) string<delimiter(")content(can't ioctl)delimiter(")>operator(\)) operator(()ident(exit) integer(1)operator(\))operator(\))operator(\)) - -comment(;; @@PLEAC@@_10.11) -comment(; Whether Scheme is seen to support prototyping depends on the definition) -comment(; of this term used:) -comment(; * Prototyping along the lines used in Ada, Modula X, and even C / C++,) -comment(; in which a procedure's interface is declared separately from its) -comment(; implementation, is *not* supported) -comment(; * Prototyping in which, as part of the procedure definition, parameter ) -comment(; information must be supplied. This is a requirement in Scheme in that) -comment(; parameter number and names must be given, though there is no need to) -comment(; supply type information [optional and keyword parameters muddy the) -comment(; waters somewhat, but the general principle applies]) - -operator(()reserved(define) operator(()ident(func-with-no-arg)operator(\)) ident(...)operator(\)) -operator(()reserved(define) operator(()ident(func-with-one-arg) ident(arg1)operator(\)) ident(...)operator(\)) -operator(()reserved(define) operator(()ident(func-with-two-arg) ident(arg1) ident(arg2)operator(\)) ident(...)operator(\)) -operator(()reserved(define) operator(()ident(func-with-three-arg) ident(arg1) ident(arg2) ident(arg3)operator(\)) ident(...)operator(\)) - -comment(;; @@PLEAC@@_10.12) -comment(; Not exactly like the Perl example, but a way of immediately) -comment(; exiting from an application) -operator(()reserved(define) operator(()ident(die) ident(msg) operator(.) ident(error-code)operator(\)) - operator(()ident(display) operator(()ident(string-append) ident(msg) string<delimiter(")content(\\n)delimiter(")>operator(\)) operator(()ident(current-error-port)operator(\))operator(\)) - operator(()ident(exit) operator(()reserved(if) operator(()ident(null?) ident(error-code)operator(\)) integer(1) operator(()ident(car) ident(error-code)operator(\))operator(\))operator(\))operator(\)) - -comment(;; ----) - -operator(()ident(die) string<delimiter(")content(some message)delimiter(")>operator(\)) - -comment(;; ------------) - -comment(; An exception is thrown via 'throw'; argument must be a symbol) -operator(()ident(throw) operator(')ident(some-exception)operator(\)) - -comment(; Invalid attempts - these, themselves force a 'wrong-type-arg) -comment(; exception to be thrown) -operator(()ident(throw) pre_constant(#t)operator(\)) -operator(()ident(throw) string<delimiter(")content(my message)delimiter(")>operator(\)) -operator(()ident(throw) integer(1)operator(\)) - -comment(;; ------------) - -comment(; Example of a 'catch all' handler - 'proc' is executed, and any) -comment(; exception thrown is handled, in this case by simply returning false) -operator(()reserved(define) operator(()ident(false-if-exception) ident(proc)operator(\)) - operator(()ident(catch) pre_constant(#t) - ident(proc) - operator(()reserved(lambda) operator(()ident(key) operator(.) ident(args)operator(\)) pre_constant(#f)operator(\))operator(\))operator(\)) - -operator(()reserved(define) operator(()ident(func)operator(\)) - operator(()ident(print) string<delimiter(")content(Starting 'func' ...)delimiter(")>operator(\)) - operator(()ident(throw) operator(')ident(myexception) integer(1)operator(\)) - operator(()ident(print) string<delimiter(")content(Leaving 'func' ...)delimiter(")>operator(\))operator(\)) - -comment(;; ----) - -operator(()reserved(if) operator(()ident(not) operator(()ident(false-if-exception) ident(main)operator(\))operator(\)) - operator(()ident(print) string<delimiter(")content('func' raised an exception)delimiter(")>operator(\)) - operator(()ident(print) string<delimiter(")content('func' executed normally)delimiter(")>operator(\))operator(\)) - -comment(;; ------------) - -comment(; More typical exception handling example in which:) -comment(; * 'func' is executed) -comment(; * 'catch' either:) -comment(; - returns return value of 'func' [if successful]) -comment(; - executes handler(s\)) - -operator(()reserved(define) operator(()ident(full-moon-exception-handler) ident(key) operator(.) ident(args)operator(\)) - operator(()ident(print) string<delimiter(")content(I'm executing after stack unwound !)delimiter(")>operator(\))operator(\)) - -operator(()reserved(define) operator(()ident(full-moon-exception-prewind-handler) ident(key) operator(.) ident(args)operator(\)) - operator(()ident(print) string<delimiter(")content(I'm executing with the stack still intact !)delimiter(")>operator(\))operator(\)) - -operator(()reserved(define) operator(()ident(func)operator(\)) - operator(()ident(print) string<delimiter(")content(Starting 'func' ...)delimiter(")>operator(\)) - operator(()ident(throw) operator(')ident(full-moon-exception) integer(1)operator(\)) - operator(()ident(print) string<delimiter(")content(Leaving 'func' ...)delimiter(")>operator(\))operator(\)) - -operator(()ident(catch) operator(')ident(full-moon-exception) - ident(func) - ident(full-moon-exception-handler) - ident(full-moon-exception-prewind-handler)operator(\)) - -comment(;; @@PLEAC@@_10.13) -comment(; Scheme is lexically-scoped, so same-name, higher-level variables) -comment(; are merely shadowed in lower-level blocks. Upon exit from those) -comment(; blocks the higher-level values are again available. Therefore, the) -comment(; saving of global variables, as required by Perl, is not necessary) - -comment(; Global variable) -operator(()reserved(define) ident(age) integer(18)operator(\)) - -comment(; Procedure definition creates a closure - it captures the earlier) -comment(; version of, age', and will retain it) -operator(()reserved(define) operator(()ident(func)operator(\)) - operator(()ident(print) ident(age)operator(\))operator(\)) - -operator(()reserved(if) operator(()ident(condition)operator(\)) - comment(; New 'local' variable created which acts to shadow the global) - comment(; version) - operator(()reserved(let) operator(()operator(()ident(age) integer(23)operator(\))operator(\)) - - comment(; Prints 23 because the global variable is shadowed within ) - comment(; this block ) - operator(()ident(print) ident(age)operator(\)) - - comment(; However, lexical-scoping ensures 'func' still accesses the) - comment(; 'age' which was active when it was defined) - operator(()ident(func)operator(\)) operator(\))operator(\)) - -comment(; The use of 'fluid-let' allows for similar behaviour to Perl's i.e.) -comment(; it mimics dynamic scope, but it does so cleanly in that once its) -comment(; scope ends any affected global variables are restored to previous) -comment(; values) -operator(()reserved(if) operator(()ident(condition)operator(\)) - - comment(; This does not create a new 'local' variables but temporarily) - comment(; sets the global variable, 'age' to 23) - operator(()ident(fluid-let) operator(()operator(()ident(age) integer(23)operator(\))operator(\)) - - comment(; Prints 23 because it is accessing the global version of 'age') - operator(()ident(print) ident(age)operator(\)) - - comment(; Prints 23 because it is its lexically-scoped version of 'age') - comment(; that has its value altered, albeit temporarily) - operator(()ident(func)operator(\)) operator(\))operator(\)) - -comment(;; @@PLEAC@@_10.14) -comment(; Define two procedures, bind them to identifiers) -operator(()reserved(define) operator(()ident(grow)operator(\)) operator(()ident(print) string<delimiter(")content(grow)delimiter(")>operator(\))operator(\)) -operator(()reserved(define) operator(()ident(shrink)operator(\)) operator(()ident(print) string<delimiter(")content(shrink)delimiter(")>operator(\))operator(\)) - -comment(; Separate procedures executed) -operator(()ident(grow)operator(\)) -operator(()ident(shrink)operator(\)) - -comment(; Rebind identifier; now acts as alias for latter) -operator(()reserved(define) ident(grow) ident(shrink)operator(\)) - -comment(; Same procedure executed in both cases) -operator(()ident(grow)operator(\)) -operator(()ident(shrink)operator(\)) - -comment(;; ------------) - -comment(; As for previous except that rebinding is localised and) -comment(; ends once local scope exited) -operator(()reserved(let) operator(()operator(()ident(grow) ident(shrink)operator(\))operator(\)) - operator(()ident(grow)operator(\)) - operator(()ident(shrink)operator(\))operator(\)) - -comment(;; ----------------------------) - -comment(; Example of dynamically creating [from text data] and binding) -comment(; procedures. The example here is conceptually similar to the Perl) -comment(; example in that it makes use of an 'eval' type of facility to) -comment(; generate code from text. In Scheme such tasks are generally better) -comment(; dealt with using macros ) - -comment(; List of procedure name / first argument pairs) -operator(()reserved(define) ident(*colours*) - operator(()ident(list) - operator(')operator(()string<delimiter(")content(red)delimiter(")> operator(.) string<delimiter(")content(baron)delimiter(")>operator(\)) - operator(')operator(()string<delimiter(")content(blue)delimiter(")> operator(.) string<delimiter(")content(zephyr)delimiter(")>operator(\)) - operator(')operator(()string<delimiter(")content(green)delimiter(")> operator(.) string<delimiter(")content(beret)delimiter(")>operator(\)) - operator(')operator(()string<delimiter(")content(yellow)delimiter(")> operator(.) string<delimiter(")content(ribbon)delimiter(")>operator(\)) - operator(')operator(()string<delimiter(")content(orange)delimiter(")> operator(.) string<delimiter(")content(county)delimiter(")>operator(\)) - operator(')operator(()string<delimiter(")content(purple)delimiter(")> operator(.) string<delimiter(")content(haze)delimiter(")>operator(\)) - operator(')operator(()string<delimiter(")content(violet)delimiter(")> operator(.) string<delimiter(")content(temper)delimiter(")>operator(\)) operator(\))operator(\)) - -comment(; Build a series of procedures dynamically by traversing the) -comment(; *colours* list and obtaining:) -comment(; * Procedure name from first item of pair) -comment(; * Procedure argument from second item of pair) -operator(()ident(for-each) - operator(()reserved(lambda) operator(()ident(colour)operator(\)) - operator(()reserved(let) operator(()operator(()ident(proc-string) - operator(()ident(string-append) - string<delimiter(")content((define )delimiter(")> operator(()ident(car) ident(colour)operator(\)) string<delimiter(")content( (lambda (\) )delimiter(")> - string<delimiter(")content(\\")content(<FONT COLOR=)delimiter(")> operator(()ident(car) ident(colour)operator(\)) string<delimiter(")content(>)delimiter(")> operator(()ident(cdr) ident(colour)operator(\)) - string<delimiter(")content(</FONT>)content(\\")content(\)\))delimiter(")> operator(\))operator(\))operator(\)) - operator(()ident(eval-string) ident(proc-string)operator(\))operator(\))operator(\)) - ident(*colours*)operator(\)) - -comment(; Apply each of the dynamically-built procedures) -operator(()ident(for-each) - operator(()reserved(lambda) operator(()ident(colour)operator(\)) - operator(()ident(print) operator(()ident(apply) operator(()ident(string->procedure) operator(()ident(car) ident(colour)operator(\))operator(\)) operator(')operator(()operator(\))operator(\))operator(\))operator(\)) - ident(*colours*)operator(\)) - -comment(;; @@PLEAC@@_10.15) -comment(; AFAICT Guile doesn't implement an AUTOLOAD facility in which a) -comment(; 'replacement' function is available should another one fail to) -comment(; load [though there is an autoload feature available with modules) -comment(; which is a load-on-demand facility aimed at conserving memory and) -comment(; speeding up initial program load time].) -comment(;) -comment(; One might think it would be feasable, however, to use exception) -comment(; handling to provide roughly similar functionality:) - -comment(; Catch all exceptions) -operator(()ident(catch) pre_constant(#t) - comment(; Undefined procedure, 'x') - ident(x) - comment(; Exception handler could load missing code ?) - operator(()reserved(lambda) operator(()ident(key) operator(.) ident(args)operator(\)) ident(...) operator(\))operator(\)) - -comment(; However, an undefined function call is reported as:) -comment(;) -comment(; ERROR: Unbound variable: ...) -comment(;) -comment(; and this situation doesn't appear to be user-trappable. ) -comment(;) - -comment(;; @@PLEAC@@_10.16) -comment(; Both implementations below are correct, and exhibit identical) -comment(; behaviour ) - -operator(()reserved(define) operator(()ident(outer) ident(arg)operator(\)) - operator(()reserved(let*) operator(()operator(()ident(x) operator(()ident(+) ident(arg) integer(35)operator(\))operator(\)) - operator(()ident(inner) operator(()reserved(lambda) operator(()operator(\)) operator(()ident(*) ident(x) integer(19)operator(\))operator(\))operator(\))operator(\)) - operator(()ident(+) ident(x) operator(()ident(inner)operator(\))operator(\))operator(\))operator(\)) - -comment(;; ----------------------------) - -operator(()reserved(define) operator(()ident(outer) ident(arg)operator(\)) - operator(()reserved(let) operator(()operator(()ident(x) operator(()ident(+) ident(arg) integer(35)operator(\))operator(\))operator(\)) - operator(()reserved(define) operator(()ident(inner)operator(\)) operator(()ident(*) ident(x) integer(19)operator(\))operator(\)) - operator(()ident(+) ident(x) operator(()ident(inner)operator(\))operator(\))operator(\))operator(\)) - -comment(;; @@PLEAC@@_10.17) -comment(;; @@INCOMPLETE@@) -comment(;; @@INCOMPLETE@@) - -comment(;; @@PLEAC@@_13.0) -comment(;; Guile OOP is in the (oop goops\) module (based on CLOS\). All) -comment(;; following sections assume you have (oop goops loaded\).) -operator(()ident(use-modules) operator(()ident(oop) ident(goops)operator(\))operator(\)) -operator(()ident(define-class) ident(<data-encoder>) operator(()operator(\))operator(\)) -operator(()reserved(define) ident(obj) operator(()ident(make) ident(<data-encoder>)operator(\))operator(\)) - -operator(()reserved(define) ident(obj) operator(#()integer(3) integer(5)operator(\))operator(\)) -operator(()ident(format) pre_constant(#t) string<delimiter(")content(~A ~A)content(\\n)delimiter(")> operator(()ident(class-of) ident(obj)operator(\)) operator(()ident(array-ref) ident(obj) integer(1)operator(\))operator(\)) -operator(()ident(change-class) ident(v) ident(<human-cannibal>)operator(\)) comment(; has to be defined) -operator(()ident(format) pre_constant(#t) string<delimiter(")content(~A ~A)content(\\n)delimiter(")> operator(()ident(slot-ref) ident(obj) ident(stomach)operator(\)) operator(()ident(slot-ref) ident(obj) ident(name)operator(\))operator(\)) - -operator(()ident(slot-ref) ident(obj) operator(')ident(stomach)operator(\)) -operator(()ident(slot-set!) ident(obj) operator(')ident(stomach) string<delimiter(")content(Empty)delimiter(")>operator(\)) -operator(()ident(name) ident(obj)operator(\)) -operator(()reserved(set!) operator(()ident(name) ident(obj)operator(\)) string<delimiter(")content(Thag)delimiter(")>operator(\)) - -comment(;; inheritance) -operator(()ident(define-class) ident(<lawyer>) operator(()ident(<human-cannibal>)operator(\))operator(\)) - -operator(()reserved(define) ident(lector) operator(()ident(make) ident(<human-cannibal>)operator(\))operator(\)) -operator(()ident(feed) ident(lector) string<delimiter(")content(Zak)delimiter(")>operator(\)) -operator(()ident(move) ident(lector) string<delimiter(")content(New York)delimiter(")>operator(\)) - -comment(;; @@PLEAC@@_13.1) -operator(()ident(define-class) ident(<my-class>) operator(()operator(\)) - operator(()ident(start) error(#)ident(:init-form) operator(()ident(current-time)operator(\))operator(\)) - operator(()ident(age) error(#)ident(:init-value) integer(0)operator(\))operator(\)) - -comment(;; classes must have predefined slots, but you could use one as a) -comment(;; dictionary:) -operator(()ident(define-class) ident(<my-class>) operator(()operator(\)) - operator(()ident(start) error(#)ident(:init-form) operator(()ident(current-time)operator(\))operator(\)) - operator(()ident(age) error(#)ident(:init-value) integer(0)operator(\)) - operator(()ident(properties) error(#)ident(:init-value) operator(')operator(()operator(\))operator(\))operator(\)) -operator(()reserved(define) operator(()ident(initialize) operator(()ident(m) ident(<my-class>)operator(\)) ident(initargs)operator(\)) - operator(()ident(and-let*) operator(()operator(()ident(extra) operator(()ident(memq) error(#)ident(:extra) ident(initargs)operator(\))operator(\))operator(\)) - operator(()ident(slot-set!) ident(m) operator(')ident(properties) operator(()ident(cdr) ident(extra)operator(\))operator(\))operator(\))operator(\)) - -comment(;; @@PLEAC@@_13.2) -comment(;; For smobs (external C objects\), you can specify a callback to be) -comment(;; performed when the object is garbage collected with the C API) -comment(;; function `scm_set_smob_free'. This solves the problem of cleaning up) -comment(;; after external objects and connections. Guile doesn't use reference) -comment(;; count garbage collection, so circular data structures aren't a) -comment(;; problem.) - -comment(;; @@PLEAC@@_13.3) -comment(;; either use slot-ref/set!) -operator(()ident(slot-ref) ident(obj) operator(')ident(name)operator(\)) -operator(()ident(slot-set!) ident(obj) operator(')ident(name) ident(value)operator(\)) - -comment(;; or define the class with accessors) -operator(()ident(define-class) ident(<my-class>) operator(()operator(\)) - operator(()ident(name) error(#)ident(:accessor) ident(name)operator(\))operator(\)) -operator(()ident(name) ident(obj)operator(\)) -operator(()reserved(set!) operator(()ident(name) ident(obj)operator(\)) ident(value)operator(\)) - -comment(;; or use getters/setters to implement read/write-only slots) -operator(()ident(define-class) ident(<my-class>) operator(()operator(\)) - operator(()ident(name) error(#)ident(:getter) ident(name)operator(\)) - operator(()ident(age) error(#)ident(:setter) ident(age)operator(\))operator(\)) -operator(()ident(name) ident(obj)operator(\)) -operator(()reserved(set!) operator(()ident(age) ident(obj)operator(\)) ident(value)operator(\)) - -comment(;; or implement getters/setters manually) -operator(()ident(define-method) operator(()operator(()ident(setter) ident(name)operator(\)) operator(()ident(obj) ident(<my-class>)operator(\)) ident(value)operator(\)) - operator(()reserved(cond) operator(()operator(()ident(string-match) string<delimiter(")content([^-)content(\\\\)content(w0-9'])delimiter(")> ident(value)operator(\)) - operator(()ident(warn) string<delimiter(")content(funny characters in name)delimiter(")>operator(\))operator(\)) - operator(()operator(()ident(string-match) string<delimiter(")content([0-9])delimiter(")> ident(value)operator(\)) - operator(()ident(warn) string<delimiter(")content(numbers in name)delimiter(")>operator(\))operator(\)) - operator(()operator(()ident(not) operator(()ident(string-match) string<delimiter(")content(\\\\)content(w+)content(\\\\)content(W+)content(\\\\)content(w+)delimiter(")> ident(value)operator(\))operator(\)) - operator(()ident(warn) string<delimiter(")content(prefer multiword names)delimiter(")>operator(\))operator(\)) - operator(()operator(()ident(not) operator(()ident(string-match) string<delimiter(")content(\\\\)content(w)delimiter(")> ident(value)operator(\))operator(\)) - operator(()ident(warn) string<delimiter(")content(name is blank)delimiter(")>operator(\))operator(\))operator(\)) - operator(()ident(slot-set!) ident(obj) operator(')ident(name) operator(()ident(string-downcase) ident(value)operator(\))operator(\))operator(\)) - -comment(;; @@PLEAC@@_13.4) -comment(;; override the initialize method) -operator(()reserved(define) ident(body-count) integer(0)operator(\)) - -operator(()ident(define-method) operator(()ident(initialize) operator(()ident(obj) ident(<person>)operator(\)) ident(initargs)operator(\)) - operator(()reserved(set!) ident(body-count) operator(()integer(1)ident(+) ident(body-count)operator(\))operator(\)) - operator(()ident(next-method)operator(\))operator(\)) - -operator(()reserved(define) ident(people) operator(')operator(()operator(\))operator(\)) -operator(()reserved(do) operator(()operator(()ident(i) integer(1) operator(()integer(1)ident(+) ident(i)operator(\))operator(\))operator(\)) - operator(()operator(()ident(>) ident(i) integer(10)operator(\))operator(\)) - operator(()reserved(set!) ident(people) operator(()reserved(cons) operator(()ident(make) ident(<person>)operator(\)) ident(people)operator(\))operator(\))operator(\)) - -operator(()ident(format) pre_constant(#t) string<delimiter(")content(There are ~A people alive.)content(\\n)delimiter(")> ident(body-count)operator(\)) - -operator(()reserved(define) ident(him) operator(()ident(make) ident(<person>)operator(\))operator(\)) -operator(()ident(slot-set!) ident(him) operator(')ident(gender) string<delimiter(")content(male)delimiter(")>operator(\)) - -operator(()reserved(define) ident(her) operator(()ident(make) ident(<person>)operator(\))operator(\)) -operator(()ident(slot-set!) ident(her) operator(')ident(gender) string<delimiter(")content(female)delimiter(")>operator(\)) - -comment(;; use the :class allocation method) -operator(()ident(slot-set!) operator(()ident(make) ident(<fixed-array>)operator(\)) operator(')ident(max-bounds) integer(100)operator(\)) comment(; set for whole class) -operator(()reserved(define) ident(alpha) operator(()ident(make) ident(<fixed-array>)operator(\))operator(\)) -operator(()ident(format) pre_constant(#t) string<delimiter(")content(Bound on alpha is ~D)content(\\n)delimiter(")> operator(()ident(slot-ref) ident(alpha) operator(')ident(max-bounds)operator(\))operator(\)) -comment(;; 100) - -operator(()reserved(define) ident(beta) operator(()ident(make) ident(<fixed-array>)operator(\))operator(\)) -operator(()ident(slot-set!) ident(beta) operator(')ident(max-bounds) integer(50)operator(\)) comment(; still sets for whole class) -operator(()ident(format) pre_constant(#t) string<delimiter(")content(Bound on alpha is ~D)content(\\n)delimiter(")> operator(()ident(slot-ref) ident(alpha) operator(')ident(max-bounds)operator(\))operator(\)) -comment(;; 50) - -comment(;; defined simply as) -operator(()ident(define-class) ident(<fixed-array>) operator(()operator(\)) - operator(()ident(max-bounds) error(#)ident(:init-value) integer(7) error(#)ident(:allocation) error(#)ident(:class)operator(\))operator(\)) - -comment(;; @@PLEAC@@_13.5) -comment(;; Guile classes are basically structs by definition. If you don't care) -comment(;; about OO programming at all, you can use records, which are portable) -comment(;; across most Schemes. This is, however, an OO chapter so I'll stick) -comment(;; to classes.) -operator(()ident(define-class) ident(<person>) operator(()operator(\)) ident(name) ident(age) ident(peers)operator(\)) - -operator(()reserved(define) ident(p) operator(()ident(make) ident(<person>)operator(\))operator(\)) -operator(()ident(slot-set!) ident(p) operator(')ident(name) string<delimiter(")content(Jason Smythe)delimiter(")>operator(\)) -operator(()ident(slot-set!) ident(p) operator(')ident(age) integer(13)operator(\)) -operator(()ident(slot-set!) ident(p) operator(')ident(peers) operator(')operator(()string<delimiter(")content(Wilbur)delimiter(")> string<delimiter(")content(Ralph)delimiter(")> string<delimiter(")content(Fred)delimiter(")>operator(\))operator(\)) -operator(()ident(format) pre_constant(#t) string<delimiter(")content(At age ~D, ~A's first friend is ~A.)content(\\n)delimiter(")> - operator(()ident(slot-ref) ident(p) operator(')ident(age)operator(\)) operator(()ident(slot-ref) ident(p) operator(')ident(name)operator(\)) operator(()ident(car) operator(()ident(slot-ref) ident(p) operator(')ident(peers)operator(\))operator(\))operator(\)) - -comment(;; For type-checking and field validation, define the setters) -comment(;; accordingly.) -operator(()ident(define-class) ident(<person>) operator(()operator(\)) - operator(()ident(name) error(#)ident(:accessor) ident(name)operator(\)) - operator(()ident(age) error(#)ident(:accessor) ident(age)operator(\))operator(\)) - -operator(()ident(define-method) operator(()operator(()ident(setter) ident(age)operator(\)) operator(()ident(p) ident(<person>)operator(\)) ident(a)operator(\)) - operator(()reserved(cond) operator(()operator(()ident(not) operator(()ident(number?) ident(a)operator(\))operator(\)) - operator(()ident(warn) string<delimiter(")content(age)delimiter(")> ident(a) string<delimiter(")content(isn't numeric)delimiter(")>operator(\))operator(\)) - operator(()operator(()ident(>) ident(a) integer(150)operator(\)) - operator(()ident(warn) string<delimiter(")content(age)delimiter(")> ident(a) string<delimiter(")content(is unreasonable)delimiter(")>operator(\))operator(\))operator(\)) - operator(()ident(slot-set!) ident(p) operator(')ident(age) ident(a)operator(\))operator(\)) - -operator(()ident(define-class) ident(<family>) operator(()operator(\)) - operator(()ident(head) error(#)ident(:init-form) operator(()ident(make) ident(<person>)operator(\)) error(#)ident(:accessor) ident(head)operator(\)) - operator(()ident(address) error(#)ident(:init-value) string<delimiter(")delimiter(")> error(#)ident(:accessor) ident(address)operator(\)) - operator(()ident(members) error(#)ident(:init-value) operator(')operator(()operator(\)) error(#)ident(:accessor) ident(members)operator(\))operator(\)) - -operator(()reserved(define) ident(folks) operator(()ident(make) ident(<family>)operator(\))operator(\)) - -operator(()reserved(define) ident(dad) operator(()ident(head) ident(folks)operator(\))operator(\)) -operator(()reserved(set!) operator(()ident(name) ident(dad)operator(\)) string<delimiter(")content(John)delimiter(")>operator(\)) -operator(()reserved(set!) operator(()ident(age) ident(dad)operator(\)) integer(34)operator(\)) - -operator(()ident(format) pre_constant(#t) string<delimiter(")content(~A's age is ~D)content(\\n)delimiter(")> operator(()ident(name) ident(dad)operator(\)) operator(()ident(age) ident(dad)operator(\))operator(\)) - -comment(;; Macros are the usual way to add syntactic sugar) - -comment(;; For all fields of the same type, let's use _ to mean the slot name in) -comment(;; the options expansion.) -operator(()ident(define-macro) operator(()ident(define-uniform-class) ident(name) ident(supers) ident(slots) operator(.) ident(options)operator(\)) - error(`)operator(()ident(define-class) error(,)ident(name) error(,)ident(supers) - error(,)ident(@)operator(()ident(map) operator(()reserved(lambda) operator(()ident(s)operator(\)) operator(()reserved(cons) ident(s) operator(()ident(map) operator(()reserved(lambda) operator(()ident(o)operator(\)) operator(()reserved(if) operator(()ident(eq?) ident(o) operator(')ident(_)operator(\)) ident(s) ident(o)operator(\))operator(\)) ident(options)operator(\))operator(\))operator(\)) - ident(slots)operator(\))operator(\))operator(\)) - -operator(()ident(define-uniform-class) ident(<card>) operator(()ident(name) ident(color) ident(cost) ident(type) ident(release) ident(text)operator(\)) - error(#)ident(:accessor) ident(_) error(#)ident(:init-value) string<delimiter(")delimiter(")>operator(\)) - -comment(;; If you *really* wanted to enforce slot types you could use something) -comment(;; like the above with the custom setter. To illustrate reversing) -comment(;; normal slot definition args, we'll reverse an init-value:) -operator(()ident(define-macro) operator(()ident(define-default-class) ident(name) ident(supers) operator(.) ident(default&slots)operator(\)) - error(`)operator(()ident(define-class) error(,)ident(name) error(,)ident(supers) - error(,)ident(@)operator(()ident(map) operator(()reserved(lambda) operator(()ident(d&s)operator(\)) operator(()ident(list) operator(()ident(cadr) ident(d&s)operator(\)) - error(#)ident(:init-value) operator(()ident(car) ident(d&s)operator(\)) - error(#)ident(:accessor) operator(()ident(cadr) ident(d&s)operator(\))operator(\))operator(\)) - ident(default&slots)operator(\))operator(\))operator(\)) - -operator(()ident(define-default-class) ident(hostent) operator(()operator(\)) - operator(()string<delimiter(")delimiter(")> ident(name)operator(\)) - operator(()operator(')operator(()operator(\)) ident(aliases)operator(\)) - operator(()string<delimiter(")delimiter(")> ident(addrtype)operator(\)) - operator(()integer(0) ident(length)operator(\)) - operator(()operator(')operator(()operator(\)) ident(addr-list)operator(\))operator(\)) - -comment(;; Nothing special needed for Aliases - all names are equal) -operator(()reserved(define) ident(type) ident(addrtype)operator(\)) -operator(()ident(define-method) operator(()ident(addr) operator(()ident(h) ident(<hostent>)operator(\))operator(\)) - operator(()ident(car) operator(()ident(addr-list) ident(h)operator(\))operator(\))operator(\)) - -comment(;; @@PLEAC@@_13.6) -comment(;; A little more clear than the Perl, but not very useful.) -operator(()reserved(define) ident(obj1) operator(()ident(make) ident(<some-class>)operator(\))operator(\)) -operator(()reserved(define) ident(obj2) operator(()ident(make) operator(()ident(class-of) ident(obj1)operator(\))operator(\))operator(\)) - -comment(;; Use the shallow-clone or deep-clone methods to initialize from) -comment(;; another instance.) -operator(()reserved(define) ident(obj1) operator(()ident(make) ident(<widget>)operator(\))operator(\)) -operator(()reserved(define) ident(obj2) operator(()ident(deep-clone) ident(obj1)operator(\))operator(\)) - -comment(;; @@PLEAC@@_13.7) -comment(;; Use eval or a variant to convert from a symbol or string to the) -comment(;; actual method. As shown in 13.5 above, methods are first class and) -comment(;; you'd be more likely to store the actual method than the name in a) -comment(;; real Scheme program.) -operator(()reserved(define) ident(methname) string<delimiter(")content(flicker)delimiter(")>operator(\)) -operator(()ident(apply-generic) operator(()ident(eval-string) ident(methname)operator(\)) ident(obj) integer(10)operator(\)) - -operator(()ident(for-each) operator(()reserved(lambda) operator(()ident(m)operator(\)) operator(()ident(apply-generic) ident(obj) operator(()ident(eval-string) ident(m)operator(\))operator(\))operator(\)) - operator(')operator(()string<delimiter(")content(start)delimiter(")> string<delimiter(")content(run)delimiter(")> string<delimiter(")content(stop)delimiter(")>operator(\))operator(\)) - -comment(;; really, don't do this...) -operator(()reserved(define) ident(methods) operator(')operator(()string<delimiter(")content(name)delimiter(")> string<delimiter(")content(rank)delimiter(")> string<delimiter(")content(serno)delimiter(")>operator(\))operator(\)) -operator(()reserved(define) ident(his-info) - operator(()ident(map) operator(()reserved(lambda) operator(()ident(m)operator(\)) operator(()reserved(cons) ident(m) operator(()ident(apply-generic) operator(()ident(eval-string) ident(m)operator(\)) ident(obj)operator(\))operator(\))operator(\)) - ident(methods)operator(\))operator(\)) - -comment(;; same as this:) -operator(()reserved(define) ident(his-info) operator(()ident(list) operator(()reserved(cons) string<delimiter(")content(name)delimiter(")> operator(()ident(name) ident(obj)operator(\))operator(\)) - operator(()reserved(cons) string<delimiter(")content(rank)delimiter(")> operator(()ident(rank) ident(obj)operator(\))operator(\)) - operator(()reserved(cons) string<delimiter(")content(serno)delimiter(")> operator(()ident(serno) ident(obj)operator(\))operator(\))operator(\))operator(\)) - -comment(;; a closure works) -operator(()reserved(define) ident(fnref) operator(()reserved(lambda) ident(args) operator(()ident(method) ident(obj) ident(args)operator(\))operator(\))operator(\)) -operator(()ident(fnref) integer(10) string<delimiter(")content(fred)delimiter(")>operator(\)) -operator(()ident(method) ident(obj) integer(10) ident(fred)operator(\)) - -comment(;; @@PLEAC@@_13.8) -comment(;; use is-a?) -operator(()ident(is-a?) ident(obj) ident(<http-message>)operator(\)) -operator(()ident(is-a?) ident(<http-response>) ident(<http-message>)operator(\))
\ No newline at end of file diff --git a/test/scanners/scheme/pleac.in.scm b/test/scanners/scheme/pleac.in.scm deleted file mode 100644 index 7c8c4a5..0000000 --- a/test/scanners/scheme/pleac.in.scm +++ /dev/null @@ -1,5141 +0,0 @@ -;;; -*- scheme -*- - -;;; @@PLEAC@@_NAME -;;; @@SKIP@@ Guile 1.8 - -;;; @@PLEAC@@_WEB -;;; @@SKIP@@ http://www.gnu.org/software/guile/ - -;;; @@PLEAC@@_INTRO -;;; @@SKIP@@ Sections 1 - 3, and 7 - 9, largely completed using Guile 1.5; subsequent additions use Guile 1.8. - -;;; @@PLEAC@@_APPENDIX -;;; @@SKIP@@ General-purpose, custom functions that might be used in several sections, appear here - -;; Helper which aims to reduce code clutter by: -;; * Replacing the oft-used, '(display item) (newline)' combination -;; * Avoiding overuse of '(string-append)' for simple output tasks -(define (print item . rest) - (let ((all-item (cons item rest))) - (for-each - (lambda (item) (display item) (display " ")) - all-item)) - (newline)) - -;; ------------ - -;; Slightly modified version of '(qx)' from Chapter 4 -(use-modules (ice-9 popen) (srfi srfi-1) (srfi srfi-13)) - -(define (drain-output port) - (let loop ((chars '()) - (next (read-char port))) - (if (eof-object? next) - ; Modified to not return last 'line' with newline - (list->string (reverse! (cdr chars))) - (loop (cons next chars) - (read-char port))))) - -(define (qx pipeline) - (let* ((pipe (open-input-pipe pipeline)) - (output (drain-output pipe))) - (close-pipe pipe) - output)) - -;; ------------ - -;; @@PLEAC@@_1.0 -(define string "\\n") ; two characters, \ and an n -(define string "\n") ; a "newline" character -(define string "Jon \"Maddog\" Orwant") ; literal double quotes -(define string "Jon 'Maddog' Orwant") ; literal single quotes - -(define a "This is a multiline here document -terminated by a closing double quote") - -;; @@PLEAC@@_1.1 -;; Use substring - -(substring str start end) -(substring str start) - -;; You can fill portions of a string with another string - -(substring-move-right! str start end newstring newstart) -(substring-move-left! str start end newstring newstart) - -;; Guile has a separate character type, and you can treat strings as a -;; character array. - -(string-ref str pos) -(string-set! str pos char) -(string-fill! str char) -(substring-fill! str start end char) - -(define s "This is what you have") -(define first (substring s 0 1)) ; "T" -(define start (substring s 5 7)) ; "is" -(define rest (substring s 13)) ; "you have" -(define last (substring s (1- (string-length s)))) ; "e" -(define end (substring s (- (string-length s) 4))) ; "have" -(define piece (let ((len (string-length s))) - (substring s (- len 8) (- len 5)))) ; "you" - - -;;; Or use the string library SRFI-13 -(use-modules (srfi srfi-13)) - -(define s "This is what you have") -(define first (string-take s 1)) ; "T" -(define start (xsubstring s 5 7)) ; "is" -(define rest (xsubstring s 13 -1)) ; "you have" -(define last (string-take-right s 1)) ; "e" -(define end (string-take-right s 4)) ; "have" -(define piece (xsubstring s -8 -5)) ; "you" - -;; Mutation of different sized strings is not allowed. You have to -;; use set! to change the variable. - -(set! s (string-replace s "wasn't" 5 7)) -;; This wasn't what you have -(set! s (string-replace s "ondrous" 13 25)) -;; This wasn't wondrous -(set! s (string-take-right s (1- (string-length s)))) -;; his wasn't wondrous -(set! s (string-take s 9)) - -;; @@PLEAC@@_1.2 -(define a (or b c)) -(define a (if (defined? b) b c)) -(define a (or (and (defined? b) b) c)) - -;; @@PLEAC@@_1.3 -;; This doesn't really make sense in Scheme... temporary variables are -;; a natural construct and cheap. If you want to swap variables in a -;; block without introducing any new variable names, you can use let: - -(let ((a b) (b a)) - ;; ... - ) - -(let ((alpha beta) (beta production) (production alpha)) - ;; ... - ) - -;; @@PLEAC@@_1.4 -(define num (char->integer char)) -(define char (integer->char num)) - -(use-modules (srfi srfi-13)) -(let ((str "sample")) - (display (string-join - (map number->string - (map char->integer (string->list str))) " ")) - (newline)) - -(let ((lst '(115 97 109 112 108 101))) - (display (list->string (map integer->char lst))) - (newline)) - -(letrec ((next (lambda (c) (integer->char (1+ (char->integer c)))))) - (let* ((hal "HAL") - (ibm (list->string (map next (string->list hal))))) - (display ibm) - (newline))) - -;; @@PLEAC@@_1.5 -;; Convert the string to a list of characters -(map proc - (string->list str)) - -(use-modules (srfi srfi-1)) -(format #t "unique chars are: ~A\n" - (apply string (sort (delete-duplicates - (string->list "an apple a day")) char<?))) - -(let* ((str "an apple a day") - (sum (apply + (map char->integer (string->list str))))) - (format #t "sum is ~A\n" sum)) - -;;; or use string-fold/string-map/string-for-each from SRFI-13 -(use-modules (srfi srfi-13)) - -(let* ((str "an apple a day") - (sum (string-fold (lambda (c acc) (+ acc (char->integer c))) - 0 str))) - (format #t "sum is ~A\n" sum)) - -#!/usr/local/bin/guile -s -!# -;; sum - compute 16-bit checksum of all input files -(use-modules (srfi srfi-13)) -(define (checksum p) - (let loop ((line (read-line p 'concat)) (sum 0)) - (if (eof-object? line) - (format #t "~A ~A\n" sum (port-filename p)) - (let ((line-sum (string-fold (lambda (c acc) - (+ acc (char->integer c))) - 0 line))) - (loop (read-line p 'concat) (modulo (+ sum line-sum) - (1- (expt 2 16)))))))) -(let ((args (cdr (command-line)))) - (if (null? args) - (checksum (current-input-port)) - (for-each (lambda (f) (call-with-input-file f checksum)) args))) - -#!/usr/local/bin/guile -s -!# -;; slowcat - emulate a s l o w line printer -(use-modules (ice-9 regex) (srfi srfi-2) (srfi srfi-13)) -(define args (cdr (command-line))) -(define delay 1) -(and-let* ((p (pair? args)) - (m (string-match "^-([0-9]+)$" (car args)))) - (set! delay (string->number (match:substring m 1))) - (set! args (cdr args))) -(define (slowcat p) - (let loop ((line (read-line p 'concat))) - (cond ((not (eof-object? line)) - (string-for-each - (lambda (c) (display c) (usleep (* 5 delay))) line) - (loop (read-line p 'concat)))))) -(if (null? args) - (slowcat (current-input-port)) - (for-each (lambda (f) (call-with-input-file f slowcat)) args)) - -;; @@PLEAC@@_1.6 -(define revbytes (list->string (reverse (string->list str)))) - -;;; Or from SRFI-13 -(use-modules (srfi srfi-13)) -(define revbytes (string-reverse str)) -(string-reverse! str) ; modifies in place - -(define revwords (string-join (reverse (string-tokenize str)) " ")) - -(with-input-from-file "/usr/share/dict/words" - (lambda () - (do ((word (read-line) (read-line))) - ((eof-object? word)) - (if (and (> (string-length word) 5) - (string=? word (string-reverse word))) - (write-line word))))) - -;; A little too verbose on the command line -;; guile --use-srfi=13 -c '(with-input-from-file "/usr/share/dict/words" (lambda () (do ((word (read-line) (read-line))) ((eof-object? word)) (if (and (> (string-length word) 5) (string=? word (string-reverse word))) (write-line word)))))' - -;; @@PLEAC@@_1.7 -;; Use regexp-substitute/global -(regexp-substitute/global - #f "([^\t]*)(\t+)" str - (lambda (m) - (let* ((pre-string (match:substring m 1)) - (pre-len (string-length pre-string)) - (match-len (- (match:end m 2) (match:start m 2)))) - (string-append - pre-string - (make-string - (- (* match-len 8) - (modulo pre-len 8)) - #\space)))) - 'post) - -;; @@PLEAC@@_1.8 -;; just interpolate $abc in strings: -(define (varsubst str) - (regexp-substitute/global #f "\\$(\\w+)" str - 'pre (lambda (m) (eval (string->symbol (match:substring m 1)) - (current-module))) - 'post)) - -;; interpolate $abc with error messages: -(define (safe-varsubst str) - (regexp-substitute/global #f "\\$(\\w+)" str - 'pre (lambda (m) - (catch #t - (lambda () (eval (string->symbol (match:substring m 1)) - (current-module))) - (lambda args - (format #f "[NO VARIABLE: ~A]" (match:substring m 1))))) - 'post)) - -;; interpolate ${(any (scheme expression))} in strings: -(define (interpolate str) - (regexp-substitute/global #f "\\${([^{}]+)}" str - 'pre (lambda (m) (eval-string (match:substring m 1))) 'post)) - -;; @@PLEAC@@_1.9 -(use-modules (srfi srfi-13)) - -(string-upcase "bo beep") ; BO PEEP -(string-downcase "JOHN") ; john -(string-titlecase "bo") ; Bo -(string-titlecase "JOHN") ; John - -(string-titlecase "thIS is a loNG liNE") ; This Is A Long Line - -#!/usr/local/bin/guile -s -!# -;; randcap: filter to randomly capitalize 20% of the time -(use-modules (srfi srfi-13)) -(seed->random-state (current-time)) -(define (randcap p) - (let loop ((line (read-line p 'concat))) - (cond ((not (eof-object? line)) - (display (string-map (lambda (c) - (if (= (random 5) 0) - (char-upcase c) - (char-downcase c))) - line)) - (loop (read-line p 'concat)))))) -(let ((args (cdr (command-line)))) - (if (null? args) - (randcap (current-input-port)) - (for-each (lambda (f) (call-with-input-file f randcap)) args))) - -;; @@PLEAC@@_1.10 -;; You can do this with format. Lisp/Scheme format is a little -;; different from what you may be used to with C/Perl style printf -;; (actually far more powerful) , but if you keep in mind that we use -;; ~ instead of %, and , instead of . for the prefix characters, you -;; won't have trouble getting used to Guile's format. - -(format #f "I have ~A guanacos." n) - -;; @@PLEAC@@_1.11 -(define var " - your text - goes here") - -(use-modules (ice-9 regexp)) -(set! var (regexp-substitute/global #f "\n +" var 'pre "\n" 'post)) - -(use-modules (srfi srfi-13)) -(set! var (string-join (map string-trim (string-tokenize var #\newline)) "\n")) - -(use-modules (ice-9 regexp) (srfi srfi-13) (srfi srfi-14)) -(define (dequote str) - (let* ((str (if (char=? (string-ref str 0) #\newline) - (substring str 1) str)) - (lines (string-tokenize str #\newline)) - (rx (let loop ((leader (car lines)) (lst (cdr lines))) - (cond ((string= leader "") - (let ((pos (or (string-skip (car lines) - char-set:whitespace) 0))) - (make-regexp (format #f "^[ \\t]{1,~A}" pos) - regexp/newline))) - ((null? lst) - (make-regexp (string-append "^[ \\t]*" - (regexp-quote leader)) - regexp/newline)) - (else - (let ((pos (or (string-prefix-length leader (car lst)) 0))) - (loop (substring leader 0 pos) (cdr lst)))))))) - (regexp-substitute/global #f rx str 'pre 'post))) - -;; @@PLEAC@@_1.12 -(use-modules (srfi srfi-13)) - -(define text "Folding and splicing is the work of an editor, -not a mere collection of silicon -and -mobile electrons!") - -(define (wrap str max-col) - (let* ((words (string-tokenize str)) - (all '()) - (first (car words)) - (col (string-length first)) - (line (list first))) - (for-each - (lambda (x) - (let* ((len (string-length x)) - (new-col (+ col len 1))) - (cond ((> new-col max-col) - (set! all (cons (string-join (reverse! line) " ") all)) - (set! line (list x)) - (set! col len)) - (else - (set! line (cons x line)) - (set! col new-col))))) - (cdr words)) - (set! all (cons (string-join (reverse! line) " ") all)) - (string-join (reverse! all) "\n"))) - -(display (wrap text 20)) - -;; @@PLEAC@@_1.13 -(define str "Mom said, \"Don't do that.\"") -(set! str (regexp-substitute/global #f "['\"]" str 'pre "\\" - match:substring 'post)) -(set! str (regexp-substitute/global #f "[^A-Z]" str 'pre "\\" - match:substring 'post)) -(set! str (string-append "this " (regexp-substitute/global - #f "\W" "is a test!" 'pre "\\" - match:substring 'post))) - -;; @@PLEAC@@_1.14 -(use-modules (srfi srfi-13)) - -(define str " space ") -(string-trim str) ; "space " -(string-trim-right str) ; " space" -(string-trim-both str) ; "space" - -;; @@PLEAC@@_1.15 -(use-modules (srfi srfi-2) (srfi srfi-13) (ice-9 format)) - -(define parse-csv - (let* ((csv-match (string-join '("\"([^\"\\\\]*(\\\\.[^\"\\\\]*)*)\",?" - "([^,]+),?" - ",") - "|")) - (csv-rx (make-regexp csv-match))) - (lambda (text) - (let ((start 0) - (result '())) - (let loop ((start 0)) - (and-let* ((m (regexp-exec csv-rx text start))) - (set! result (cons (or (match:substring m 1) - (match:substring m 3)) - result)) - (loop (match:end m)))) - (reverse result))))) - -(define line "XYZZY,\"\",\"O'Reilly, Inc\",\"Wall, Larry\",\"a \\\"glug\\\" bit,\",5,\"Error, Core Dumped\"") - -(do ((i 0 (1+ i)) - (fields (parse-csv line) (cdr fields))) - ((null? fields)) - (format #t "~D : ~A\n" i (car fields))) - -;; @@PLEAC@@_1.16 -(use-modules (srfi srfi-13) (srfi srfi-14)) - -;; Knuth's soundex algorithm from The Art of Computer Programming, Vol 3 -(define soundex - (letrec ((chars "AEIOUYBFPVCGJKQSXZDTLMNR") - (nums "000000111122222222334556") - (skipchars (string->char-set "HW")) - (trans (lambda (c) - (let ((i (string-index chars c))) - (if i (string-ref nums i) c))))) - (lambda (str) - (let* ((ustr (string-upcase str)) - (f (string-ref ustr 0)) - (skip (trans f))) - (let* ((mstr (string-map trans (string-delete ustr skipchars 1))) - (dstr (string-map (lambda (c) - (cond ((eq? c skip) #\0) - (else (set! skip c) c))) - mstr)) - (zstr (string-delete dstr #\0))) - (substring (string-append (make-string 1 f) zstr "000") 0 4)))))) - -(soundex "Knuth") ; K530 -(soundex "Kant") ; K530 -(soundex "Lloyd") ; L300 -(soundex "Ladd") ; L300 - -;; @@PLEAC@@_1.17 -#!/usr/local/bin/guile -s -!# - -(use-modules (srfi srfi-13) - (srfi srfi-14) - (ice-9 rw) - (ice-9 regex)) - -(define data "analysed => analyzed -built-in => builtin -chastized => chastised -commandline => command-line -de-allocate => deallocate -dropin => drop-in -hardcode => hard-code -meta-data => metadata -multicharacter => multi-character -multiway => multi-way -non-empty => nonempty -non-profit => nonprofit -non-trappable => nontrappable -pre-define => predefine -preextend => pre-extend -re-compiling => recompiling -reenter => re-enter -turnkey => turn-key") - -(define input (if (null? (cdr (command-line))) - (current-input-port) - (open-input-file (cadr (command-line))))) - -(let* ((newline-char-set (string->char-set "\n")) - (assoc-char-set (string->char-set " =>")) - (dict (map - (lambda (line) - (string-tokenize line assoc-char-set)) - (string-tokenize data newline-char-set))) - (dict-match (string-join (map car dict) "|"))) - (let loop ((line (read-line input))) - (cond ((not (eof-object? line)) - (regexp-substitute/global - (current-output-port) dict-match line - 'pre - (lambda (x) - (cadr (assoc (match:substring x 0) dict))) - 'post) - (loop (read-line input 'concat)))))) - -(close-port input) - -;; @@PLEAC@@_2.1 -;; Strings and numbers are separate data types in Scheme, so this -;; isn't as important as it is in Perl. More often you would use the -;; type predicates, string? and number?. - -(if (string-match "[^\\d]" str) (display "has nondigits")) -(or (string-match "^\\d+$" str) (display "not a natural number")) -(or (string-match "^-?\\d+$" str) (display "not an integer")) -(or (string-match "^[\\-+]?\\d+$" str) (display "not an integer")) -(or (string-match "^-?\\d+\.?\d*$" str) (display "not a decimal number")) -(or (string-match "^-?(\d+(\.\d*)?|\.\d+)$" str) - (display "not a decimal number")) -(or (string-match "^([+-]?)(\d|\.\d)\d*(\.\d*)?([Ee]([+-]?\d+))?$" str) - (display "not a C float")) - -(define num1 (string->number str)) - -(define num2 (read)) - -;; @@PLEAC@@_2.2 -;; (approx-equal? num1 num2 accuracy) : returns #t if num1 and num2 are -;; equal to accuracy number of decimal places -(define (approx-equal? num1 num2 accuracy) - (< (abs (- num1 num2)) (expt 10.0 (- accuracy)))) - -(define wage 536) ;; $5.36/hour -(define week (* 40 wage)) ;; $214.40 -(format #t "One week's wage is: $~$\n" (/ week 100.0)) - -;; @@PLEAC@@_2.3 -(round num) ;; rounds to inexact whole number -(inexact->exact num) ;; rounds to exact integer - -;; You can also use format to convert numbers to more precisely -;; formatted strings. Note Guile has a builtin format which is a more -;; limited version of that found in the (ice-9 format) module, to save -;; load time. Basically, if you are doing anything you couldn't do -;; with a series of (display), (write) and (newline), then you'll need -;; to use the module. -(use-modules (ice-9 format)) - -(define a 0.255) -(define b (/ (round (* 100.0 a)) 100.0)) -(format #t "Unrounded: ~F\nRounded: ~F\n" a b) -(format #t "Unrounded: ~F\nRounded: ~,2F\n" a a) - -(define a '(3.3 3.5 3.7 -3.3)) -(display "number\tint\tfloor\tceil\n") -(for-each - (lambda (n) - (format #t "~,1F\t~,1F\t~,1F\t~,1F\n" - n (round n) (floor n) (ceiling n))) - a) - -;; @@PLEAC@@_2.4 -;; numbers are radix independent internally, so you usually only -;; convert on output, however to convert strings: -(define (dec->bin num) - (number->string (string->number num 10) 2)) - -(define (bin->dec num) - (number->string (string->number num 2) 10)) - -(define num (bin->dec "0110110")) ; 54 -(define binstr (dec->bin "54")) ; 110110 - -;; @@PLEAC@@_2.5 -;; do is the most general loop iterator -(do ((i x (1+ i))) ; var init-value step-value - ((> i y)) ; end when true - ;; i is set to every integer from x to y, inclusive - ;; ... - ) - -;; Guile also offers a while loop -(let ((i x)) - (while (<= i y) - ;; i is set to every integer from x to y, inclusive - ; ... - (set! i (1+ i)))) - -;; named let is another common loop -(let loop ((i x)) - (cond ((<= i y) - ;; i is set to every integer from x to y, step-size 7 - ;; ... - (loop (+ i 7))))) ; tail-recursive call - -(display "Infancy is: ") -(do ((i 0 (1+ i))) - ((> i 2)) - (format #t "~A " i)) -(newline) - -(display "Toddling is: ") -(let ((i 3)) - (while (<= i 4) - (format #t "~A " i) - (set! i (1+ i)))) -(newline) - -(display "Childhood is: ") -(let loop ((i 5)) - (cond ((<= i 12) - (format #t "~A " i) - (loop (1+ i))))) -(newline) - -;; @@PLEAC@@_2.6 -;; format can output roman numerals - use ~:@R - -(use-modules (ice-9 format)) - -(format #t "Roman for ~R is ~:@R\n" 15 15) - -;; @@PLEAC@@_2.7 -(random 5) ; an integer from 0 to 4 -(random 5.0) ; an inexact real in the range [0,5) - -;; char sets from SRFI-14 and string-unfold from SRFI-13 make a quick -;; way to generate passwords - -(use-modules (srfi srfi-13) (srfi srfi-14)) - -(define chars (char-set->string char-set:graphic)) -(define size (char-set-size char-set:graphic)) -(define password - (string-unfold (lambda (x) (= x 8)) - (lambda (x) (string-ref chars (random size))) - 1+ 0)) - -;; @@PLEAC@@_2.8 -;; if you're working with random numbers you'll probably want to set -;; the random seed - -(seed->random-state (current-time)) - -;; you can also save random states and pass them to any of the above -;; random functions - -(define state (copy-random-state)) -(random:uniform) -;; 0.939377327721761 -(random:uniform state) -;; 0.939377327721761 - -;; @@PLEAC@@_2.9 -;; @@INCOMPLETE@@ -;; very inefficient -(use-modules (ice-9 rw)) -(define make-true-random - (letrec ((bufsize 8) - (accum (lambda (c acc) (+ (* 256 acc) - (char->integer c)))) - (getbuf (lambda () - (call-with-input-file "/dev/urandom" - (lambda (p) - (let ((buf (make-string bufsize))) - (read-string!/partial buf p) - buf)))))) - (lambda (rand-proc) - (lambda args - (let ((state (seed->random-state (string-fold accum 0 (getbuf))))) - (apply rand-proc (append args (list state)))))))) - -(define urandom (make-true-random random)) -(define urandom:exp (make-true-random random:exp)) -(define urandom:normal (make-true-random random:normal)) -(define urandom:uniform (make-true-random random:uniform)) - -;; @@PLEAC@@_2.10 -;; Guile offers a number of random distributions - -(random:exp) ; an inexact real in an exponential dist with mean 1 -(random:normal) ; an inexact real in a standard normal distribution -(random:uniform) ; a uniformly distributed inexact real in [0,1) - -;; There are also functions to fill vectors with random distributions - -;; Fills vector v with inexact real random numbers the sum of whose -;; squares is equal to 1.0. -(random:hollow-sphere! v) - -;; Fills vector v with inexact real random numbers that are -;; independent and standard normally distributed (i.e., with mean 0 -;; and variance 1). -(random:normal-vector! v) - -;; Fills vector v with inexact real random numbers the sum of whose -;; squares is less than 1.0. -(random:solid-sphere! v) - -;; @@PLEAC@@_2.11 -;; Guile's trigonometric functions use radians. - -(define pi 3.14159265358979) - -(define (degrees->radians deg) - (* pi (/ deg 180.0))) - -(define (radians->degrees rad) - (* 180.0 (/ rad pi))) - -(define (degree-sine deg) - (sin (degrees->radians deg))) - -;; @@PLEAC@@_2.12 - -;; Guile provides the following standard trigonometric functions (and -;; their hyperbolic equivalents), defined for all real and complex -;; numbers: - -(sin z) -(cos z) -(tan z) -(asin z) -(acos z) -(atan z) - -(acos 3.7) ; 0.0+1.9826969446812i - -;; @@PLEAC@@_2.13 -;; Guile provides log in base e and 10 natively, defined for any real -;; or complex numbers: - -(log z) ; natural logarithm -(log10 z) ; base-10 logarithm - -;; For other bases, divide by the log of the base: - -(define (log-base n z) - (/ (log z) (log n))) - -;; To avoid re-computing (log n) for a base you want to use -;; frequently, you can create a custom log function: - -(define (make-log-base n) - (let ((divisor (log n))) - (lambda (z) (/ (log z) divisor)))) - -(define log2 (make-log-base 2)) - -(log2 1024) - -;; @@PLEAC@@_2.14 -;; In addition to simple vectors, Guile has builtin support for -;; uniform arrays of an arbitrary dimension. - -;; a rows x cols integer matrix -(define a (make-array 0 rows cols)) -(array-set! a 3 row col) -(array-ref a row col) - -;; a 3D matrix of reals -(define b (make-array 0.0 x y z)) - -;; a literal boolean truth table for logical and -'#2((#f #f) (#f #t)) - -;; simple matrix multiplication - -(define (matrix-mult m1 m2) - (let* ((d1 (array-dimensions m1)) - (d2 (array-dimensions m2)) - (m1rows (car d1)) - (m1cols (cadr d1)) - (m2rows (car d2)) - (m2cols (cadr d2))) - (if (not (= m1cols m2rows)) - (error 'index-error "matrices don't match")) - (let ((result (make-array 0 m1rows m2cols))) - (do ((i 0 (1+ i))) - ((= i m1rows)) - (do ((j 0 (1+ j))) - ((= j m2cols)) - (do ((k 0 (1+ k))) - ((= k m1cols)) - (array-set! result (+ (array-ref result i j) - (* (array-ref m1 i k) - (array-ref m2 k j))) - i j)))) - result))) - -(matrix-mult '#2((3 2 3) (5 9 8)) '#2((4 7) (9 3) (8 1))) - -;; @@PLEAC@@_2.15 -;; Guile has builtin support for complex numbers: - -(define i 0+1i) ; 0.0+1.0i -(define i (sqrt -1)) ; 0.0+1.0i - -(complex? i) ; #t -(real-part i) ; 0.0 -(imag-part i) ; 1.0 - -(* 3+5i 2-2i) ; 16+4i -(sqrt 3+4i) ; 2+i - -;; Classic identity: -e^(pi*i) => 1 -(inexact->exact (real-part (- (exp (* pi 0+1i))))) ; 1 - -;; @@PLEAC@@_2.16 -;; You can type in literal numbers in alternate radixes: - -#b01101101 ; 109 in binary -#o155 ; 109 in octal -#d109 ; 109 in decimal -#x6d ; 109 in hexadecimal - -;; number->string and string->number also take an optional radix: - -(define number (string->number hexadecimal 16)) -(define number (string->number octal 8)) - -;; format will also output in different radixes: - -(format #t "~B ~O ~D ~X\n" num num num num) - -;; converting Unix file permissions read from stdin: - -(let loop ((perm (read-line))) - (cond ((not (eof-object? perm)) - (format #t "The decimal value is ~D\n" (string->number perm 8)) - (loop (read-line))))) - -;; @@PLEAC@@_2.17 -;; once again, format is our friend :) -(use-modules (ice-9 format)) - -;; the : prefix to the D directive causes commas to be output every -;; three digits. -(format #t "~:D\n" (random 10000000000000000)) -; => 2,301,267,079,619,540 - -;; the third prefix arg to the D directive is the separator character -;; to use instead of a comma, useful for European style numbers: -(format #t "~,,'.:D\n" (random 10000000000000000)) -; => 6.486.470.447.356.534 - -;; the F directive, however, does not support grouping by commas. to -;; achieve this, we can format the integer and fractional parts -;; separately: -(define (commify num) - (let ((int (inexact->exact (truncate num)))) - (if (= num int) - (format #f "~:D" int) - (string-append (format #f "~:D" int) - (let ((str (format #f "~F" num))) - (substring str (or (string-index str #\.) - (string-length str)))))))) - -;; @@PLEAC@@_2.18 -;; format can handle simple 's' plurals with ~p, and 'y/ies' plurals -;; with the @ prefix: - -(format #t "It took ~D hour~P\n" hours hours) - -(format #t "It took ~D centur~@P\n" centuries centuries) - -(define noun-plural - (let* ((suffixes '(("ss" . "sses") - ("ph" . "phes") - ("sh" . "shes") - ("ch" . "ches") - ("z" . "zes") - ("ff" . "ffs") - ("f" . "ves") - ("ey" . "eys") - ("y" . "ies") - ("ix" . "ices") - ("s" . "ses") - ("x" . "xes") - ("ius" . "ii"))) - (suffix-match - (string-append "(" (string-join (map car suffixes) "|") ")$")) - (suffix-rx (make-regexp suffix-match))) - (lambda (noun) - (let ((m (regexp-exec suffix-rx noun))) - (if m - (string-append (regexp-substitute #f m 'pre) - (cdr (assoc (match:substring m) suffixes))) - (string-append noun "s")))))) - -;; @@PLEAC@@_2.19 -#!/usr/local/bin/guile -s -!# - -;; very naive factoring algorithm -(define (factor n) - (let ((factors '()) - (limit (inexact->exact (round (sqrt n)))) - (twos 0)) - ;; factor out 2's - (while (even? n) - (set! n (ash n -1)) - (set! twos (1+ twos))) - (if (> twos 0) (set! factors (list (cons 2 twos)))) - ;; factor out odd primes - (let loop ((i 3)) - (let ((r (remainder n i))) - (cond ((= r 0) - (set! n (quotient n i)) - (let* ((old-val (assv i factors)) - (new-val (if old-val (1+ (cdr old-val)) 1))) - (set! factors (assv-set! factors i new-val))) - (loop i)) - ((< i limit) - (loop (+ 2 i)))))) - ;; remainder - (if (> n 1) (set! factors (cons (cons n 1) factors))) - (reverse! factors))) - -;; pretty print a term of a factor -(define (pp-term pair) - (if (= (cdr pair) 1) - (number->string (car pair)) - (format #f "~A^~A" (car pair) (cdr pair)))) - -;; factor each number given on the command line -(for-each - (lambda (n) - (let ((factors (factor n))) - (format #t "~A = ~A" n (pp-term (car factors))) - (for-each - (lambda (x) (format #t " * ~A" (pp-term x))) - (cdr factors)) - (newline))) - (map string->number (cdr (command-line)))) - -;; @@PLEAC@@_3.0 -;; Use the builtin POSIX time functions - -;; get the current time -(current-time) ; number of seconds since the epoch -(gettimeofday) ; pair of seconds and microseconds since the epoch - -;; create a time object from an integer (e.g. returned by current-time) -(localtime time) ; in localtime -(gmtime time) ; in UTC - -;; get/set broken down components of a time object - -(tm:sec time) (set-tm:sec time secs) ; seconds (0-59) -(tm:min time) (set-tm:min time mins) ; minutes (0-59) -(tm:hour time) (set-tm:hour time hours) ; hours (0-23) -(tm:mday time) (set-tm:mday time mday) ; day of the month (1-31) -(tm:mon time) (set-tm:mon time month) ; month (0-11) -(tm:year time) (set-tm:year time year) ; year minus 1900 (70-) -(tm:wday time) (set-tm:wday time wday) ; day of the week (0-6) - ; where Sunday is 0 -(tm:yday time) (set-tm:yday time yday) ; day of year (0-365) -(tm:isdst time) (set-tm:isdst time isdst) ; daylight saving indicator - ; 0 for "no", > 0 for "yes", - ; < 0 for "unknown" -(tm:gmtoff time) (set-tm:gmtoff time off) ; time zone offset in seconds - ; west of UTC (-46800 to 43200) -(tm:zone time) (set-tm:zone time zone) ; Time zone label (a string), - ; not necessarily unique. - -(format #t "Today is day ~A of the current year.\n" - (tm:yday (localtime (current-time)))) - -;; Or use SRFI-19 - Time and Date Procedures -(use-modules (srfi srfi-19)) - -(define now (current-date)) ; immutable once created - -(date-nanosecond now) ; 0-9,999,999 -(date-second now) ; 0-60 (60 represents a leap second) -(date-minute now) ; 0-59 -(date-hour now) ; 0-23 -(date-day now) ; 0-31 -(date-month now) ; 1-12 -(date-year now) ; integer representing the year -(date-year-day now) ; day of year (Jan 1 is 1, etc.) -(date-week-day now) ; day of week (Sunday is 0, etc.) -(date-week-number now start) ; week of year, ignoring a first partial week - ; start is the first day of week as above -(date-zone-offset now) ; integer number of seconds east of GMT - -(format #t "Today is day ~A of the current year.\n" - (date-year-day (current-date))) - -;; @@PLEAC@@_3.1 -;; using format and POSIX time components -(use-modules (ice-9 format)) -(let ((now (localtime (current-time)))) - (format #t "The current date is ~4'0D ~2'0D ~2'0D\n" - (+ 1900 (tm:year now)) (tm:mon now) (tm:mday now))) - -;; using format and SRFI-19 time components -(use-modules (srfi srfi-19) (ice-9 format)) -(let ((now (current-date))) - (format #t "The current date is ~4'0d-~2'0D-~2'0D\n" - (date-year now) (date-month now) (date-day now))) - -;; using POSIX strftime with a libc time format string -(display (strftime "%Y-%m-%d\n" (localtime (current-time)))) - -;; @@PLEAC@@_3.2 -;; set the individual components of a time struct and use mktime -(define time (localtime (current-time))) -(set-tm:mday time mday) -(set-tm:mon time mon) -(set-tm:year time year) -(car (mktime time)) ; mktime returns a (epoch-seconds . time) pair - -;; or use SRFI-19's make-date and date->time-monotonic -(use-modules (srfi srfi-19)) -(date->time-monotonic - (make-date nanosecond second minute hour day month year zone-offset)) - -;; @@PLEAC@@_3.3 -;; use localtime or gmtime with the accessors mentioned in the -;; introduction to this chapter -(let ((time (localtime seconds))) ; or gmtime - (format #t "Dateline: ~2'0d:~2'0d:~2'0d-~4'0d/~2'0d/~2'0d\n" - (tm:hour time) (tm:min time) (tm:sec time) - (+ 1900 (tm:year time)) (1+ (tm:mon time)) (tm:mday time))) - -;; or use SRFI-19 -(use-modules (srfi srfi-19)) -(let* ((time (make-time time-monotonic nanosecond second))) - (display (date->string (time-monotonic->date time) "~T-~1\n"))) - -;; @@PLEAC@@_3.4 -;; just add or subtract epoch seconds -(define when (+ now difference)) -(define then (- now difference)) - -;; if you have DMYHMS values, you can convert them to times or add -;; them as seconds: -(define birthtime 96176750) -(define interval (+ 5 ; 5 seconds - (* 17 60) ; 17 minutes - (* 2 60 60) ; 2 hours - (* 55 60 60 24))) ; and 55 days -(define then (+ birthtime interval)) -(format #t "Then is ~A\n" (strftime "%a %b %d %T %Y" (localtime then))) - -;; @@PLEAC@@_3.5 -;; subtract the epoch seconds: -(define bree 361535725) -(define nat 96201950) -(define difference (- bree nat)) -(format #t "There were ~A seconds between Nat and Bree\n" difference) - -;; or use SRFI-19's time arithmetic procedures: -(use-modules (srfi srfi-19)) -(define time1 (make-time time-monotonic nano1 sec1)) -(define time2 (make-time time-monotonic nano2 sec2)) -(define duration (time-difference time1 time2)) -(time=? (subtract-duration time1 duration) time2) ; #t -(time=? (add-duration time2 duration) time1) ; #t - -;; @@PLEAC@@_3.6 -;; convert to a SRFI-19 date and use the accessors -(use-modules (srfi srfi-19)) -(date-day date) -(date-year-day date) -(date-week-day date) -(date-week-number date start-day-of-week) - -;; @@PLEAC@@_3.7 -;; use the strptime function: -(define time-pair (strptime "%Y-%m-%d" "1998-06-03")) -(format #t "Time is ~A\n." (strftime "%b %d, %Y" (car time-pair))) - -;; or use SRFI-19's string->date: -(use-modules (srfi srfi-19)) -(define date (string->date "1998-06-03" "~Y-~m-~d")) -(format #t "Time is ~A.\n" (date->string date)) - -;; @@PLEAC@@_3.8 -;; use the already seen strftime: -(format #t "strftime gives: ~A\n" - (strftime "%A %D" (localtime (current-time)))) - -;; or SRFI-19's date->string: -(use-modules (srfi srfi-19)) -(format #t "default date->string gives: ~A\n" (date->string (current-date))) -(format #t "date->string gives: ~A\n" - (date->string (current-date) "~a ~b ~e ~H:~M:~S ~z ~Y")) - -;; @@PLEAC@@_3.9 -;; gettimeofday will return seconds and microseconds: -(define t0 (gettimeofday)) -;; do your work here -(define t1 (gettimeofday)) -(format #t "You took ~A seconds and ~A microseconds\n" - (- (car t1) (car t0)) (- (cdr t1) (cdr t0))) - -;; you can also get more detailed info about the real and processor -;; times: -(define runtime (times)) -(tms:clock runtime) ; the current real time -(tms:utime runtime) ; the CPU time units used by the calling process -(tms:stime runtime) ; the CPU time units used by the system on behalf - ; of the calling process. -(tms:cutime runtime) ; the CPU time units used by terminated child - ; processes of the calling process, whose status - ; has been collected (e.g., using `waitpid'). -(tms:cstime runtime) ; the CPU times units used by the system on - ; behalf of terminated child processes - -;; you can also use the time module to time execution: -(use-modules (ice-9 time)) -(time (sleep 3)) -;; clock utime stime cutime cstime gctime -;; 3.01 0.00 0.00 0.00 0.00 0.00 -;; 0 - -;; @@PLEAC@@_3.10 -(sleep i) ; sleep for i seconds -(usleep i) ; sleep for i microseconds (not available on all platforms) - -;; @@PLEAC@@_4.0 -(define nested '("this" "that" "the" "other")) -(define nested '("this" "that" ("the" "other"))) -(define tune '("The" "Star-Spangled" "Banner")) - -;; @@PLEAC@@_4.1 -(define a '("quick" "brown" "fox")) -(define a '("Why" "are" "you" "teasing" "me?")) - -(use-modules (srfi srfi-13)) -(define lines - (map string-trim - (string-tokenize "\ - The boy stood on the burning deck, - It was as hot as glass." - #\newline))) - -(define bigarray - (with-input-from-file "mydatafile" - (lambda () - (let loop ((lines '()) - (next-line (read-line))) - (if (eof-object? next-line) - (reverse lines) - (loop (cons next-line lines) - (read-line))))))) - -(define banner "The Mines of Moria") - -(define name "Gandalf") -(define banner - (string-append "Speak, " name ", and enter!")) -(define banner - (format #f "Speak, ~A, and welcome!" name)) - -;; Advanced shell-like function is provided by guile-scsh, the Guile -;; port of SCSH, the Scheme shell. Here we roll our own using the -;; pipe primitives that come with core Guile. -(use-modules (ice-9 popen)) - -(define (drain-output port) - (let loop ((chars '()) - (next (read-char port))) - (if (eof-object? next) - (list->string (reverse! chars)) - (loop (cons next chars) - (read-char port))))) - -(define (qx pipeline) - (let* ((pipe (open-input-pipe pipeline)) - (output (drain-output pipe))) - (close-pipe pipe) - output)) - -(define his-host "www.perl.com") -(define host-info (qx (format #f "nslookup ~A" his-host))) - -(define perl-info (qx (format #f "ps ~A" (getpid)))) -(define shell-info (qx "ps $$")) - -(define banner '("Costs" "only" "$4.95")) -(define brax (map string (string->list "()<>{}[]"))) -(define rings (string-tokenize "Nenya Narya Vilya")) -(define tags (string-tokenize "LI TABLE TR TD A IMG H1 P")) -(define sample - (string-tokenize "The vertical bar (|) looks and behaves like a pipe.")) -(define ships '("Niña" "Pinta" "Santa MarÃa")) - -;; @@PLEAC@@_4.2 -(define array '("red" "yellow" "green")) - -(begin - (display "I have ") - (for-each display array) - (display " marbles.\n")) -;; I have redyellowgreen marbles. - -(begin - (display "I have ") - (for-each (lambda (colour) - (display colour) - (display " ")) - array) - (display "marbles.\n")) -;; I have red yellow green marbles. - -;; commify - insertion of commas into list output -(define (commify strings) - (let ((len (length strings))) - (case len - ((0) "") - ((1) (car strings)) - ((2) (string-append (car strings) " and " (cadr strings))) - ((3) (string-append (car strings) ", " - (cadr strings) ", and " - (caddr strings))) - (else - (string-append (car strings) ", " - (commify (cdr strings))))))) - -(define lists '(("just one thing") - ("Mutt" "Jeff") - ("Peter" "Paul" "Mary") - ("To our parents" "Mother Theresa" "God") - ("pastrami" "ham and cheese" "peanut butter and jelly" "tuna") - ("recycle tired, old phrases" "ponder big, happy thoughts") - ("recycle tired, old phrases" - "ponder big, happy thoughts" - "sleep and dream peacefully"))) - -(for-each (lambda (list) - (display "The list is: ") - (display (commify list)) - (display ".\n")) - lists) - -;; The list is: just one thing. -;; The list is: Mutt and Jeff. -;; The list is: Peter, Paul, and Mary. -;; The list is: To our parents, Mother Theresa, and God. -;; The list is: pastrami, ham and cheese, peanut butter and jelly, and tuna. -;; The list is: recycle tired, old phrases and ponder big, happy thoughts. -;; The list is: recycle tired, old phrases, ponder big, happy thoughts, and sleep and dream peacefully. - -;; @@PLEAC@@_4.3 -;;----------------------------- - -;; Scheme does not normally grow and shrink arrays in the way that -;; Perl can. The more usual operations are adding and removing from -;; the head of a list using the `cons' and `cdr' procedures. -;; However ... -(define (grow/shrink list new-size) - (let ((size (length list))) - (cond ((< size new-size) - (grow/shrink (cons "" list) new-size)) - ((> size new-size) - (grow/shrink (cdr list) new-size)) - (else list)))) - -(define (element list i) - (list-ref list (- (length list) i 1))) - -(define (set-element list i value) - (if (>= i (length list)) - (set! list (grow/shrink list (- i 1)))) - (set-car! (list-cdr-ref list (- (length list) i 1))) - list) - -(define (what-about list) - (let ((len (length list))) - (format #t "The array now has ~A elements.\n" len) - (format #t "The index of the last element is ~A.\n" (- len 1)) - (format #t "Element #3 is `~A'.\n" (if (> len 3) - (element list 3) - "")))) - -;; In the emulation of Perl arrays implemented here, the elements are -;; in reverse order when compared to normal Scheme lists. -(define people (reverse '("Crosby" "Stills" "Nash" "Young"))) -(what-about people) -;;----------------------------- -;; The array now has 4 elements. -;; The index of the last element is 3. -;; Element #3 is `Young'. -;;----------------------------- -(set! people (grow/shrink people 3)) -(what-about people) -;;----------------------------- -;; The array now has 3 elements. -;; The index of the last element is 2. -;; Element #3 is `'. -;;----------------------------- -(set! people (grow/shrink people 10001)) -(what-about people) -;;----------------------------- -;; The array now has 10001 elements. -;; The index of the last element is 10000. -;; Element #3 is `'. -;;----------------------------- - -;; @@PLEAC@@_4.4 -; Using a 'list' i.e. chain of pairs -(define *mylist* '(1 2 3)) - -; Apply procedure to each member of 'mylist' -(for-each - (lambda (item) (print item)) - *mylist*) - -;; ------------ - -; Using a 'vector' i.e. one-dimensional array -(define *bad-users* '#("lou" "mo" "sterling" "john")) - -(define (complain user) - (print "You're a *bad user*," user)) - -(array-for-each - (lambda (user) (complain user)) - *bad-users*) - -;; ------------ - -; Could probably get away with sorting a list of strings ... -(define *sorted-environ* - (sort (environ) string<?)) - -(for-each - (lambda (var) (display var) (newline)) - *sorted-environ*) - -;; ---- - -; ... but the intent here is to sort a hash table, so we'll use -; an 'assoc', Scheme's native dictionary type, which is really -; nothing more than a list of conses / dotted pairs [hash tables -; will be used in later examples] -(define (cons->env-string a) - (string-append (car a) "=" (cdr a))) - -(define (env-string->cons s) - (let ((key-value (string-split s #\=))) - (cons (car key-value) (cadr key-value)))) - -(define *sorted-environ-assoc* - (sort - (map - (lambda (var) (env-string->cons var)) - (environ)) - (lambda (left right) (string<? (car left) (car right))) )) - -(for-each - (lambda (var) - (print (car var) "=" (cdr var))) - *sorted-environ-assoc*) - -;; ---------------------------- - -(define *MAX-QUOTA* 100) - -(define (get-all-users) ...) -(define (get-usage user) ...) -(define (complain user) ...) - -(for-each - (lambda (user) - (let ((disk-usage (get-usage user))) - (if (> disk-usage *MAX-QUOTA*) - (complain user)))) - (get-all-users)) - -;; ---------------------------- - -(for-each - (lambda (user) (if (string=? user "tchrist") (print user))) - (string-split (qx "who|cut -d' ' -f1|uniq") #\newline)) - -;; ---------------------------- - -(use-modules (srfi srfi-13) (srfi srfi-14)) - -(do ((line (read-line) (read-line))) - ((eof-object? line)) - (for-each - (lambda (word) (print (string-reverse word))) - (string-tokenize line char-set:graphic))) - -;; ---------------------------- - -; Updates vector in-place [accepts variable number of vectors] -; See also the library function, 'array-map-in-order!' and its -; brethren -(define (vector-map-in-order! proc vec . rest) - (let ((all-vec (cons vec rest))) - (for-each - (lambda (vec) - (let ((end (vector-length vec))) - (let loop ((idx 0)) - (cond - ((= idx end) '()) - (else - (vector-set! vec idx (apply proc (list (vector-ref vec idx)))) - (loop (+ idx 1)))) ))) - all-vec))) - -;; ---- - -; A non-mutating version - illustration only, as library routines -; [SRFI-43 and built-ins] should be preferred -(define (vector-map-in-order proc vec . rest) - (let* ((all-vec (cons vec rest)) - (new-vec-len (reduce + 0 (map vector-length all-vec))) - (new-vec (make-vector new-vec-len)) - (new-vec-idx 0)) - (let loop ((all-vec all-vec)) - (cond - ((= new-vec-idx new-vec-len) new-vec) - (else - (array-for-each - (lambda (element) - (vector-set! new-vec new-vec-idx (apply proc (list element))) - (set! new-vec-idx (+ new-vec-idx 1))) - (car all-vec)) - (loop (cdr all-vec)) ))) )) - -;; ------------ - -(define *array* '#(1 2 3)) - -(array-for-each - (lambda (item) - (print "i =" item)) - *array*) - -;; ------------ - -(define *array* '#(1 2 3)) - -(array-for-each - (lambda (item) - (print "i =" item)) - *array*) - -; Since a 'vector' is mutable, in-place updates allowed -(vector-map-in-order! - (lambda (item) (- item 1)) - *array*) - -(print *array*) - -;; ------------ - -(define *a* '#(0.5 3)) -(define *b* '#(0 1)) - -(vector-map-in-order! - (lambda (item) (* item 7)) - *a* *b*) - -(print *a* *b*) - -;; ---------------------------- - -; Using 'for-each' to iterate over several container items is a -; simple matter of passing a list of those items e.g. a list of -; strings, or of arrays etc. -; -; However, complications arise when: -; * Heterogenous list of items e.g. list contains all of arrays, -; hashes, strings, etc. Necesitates different handling based on type -; * Item needs updating. It is not possible to alter the item reference -; and updating an item's internals is only possible if the relevant -; mutating procedures are implemented e.g. specified string characters -; may be altered in-place, but character deletion requires a new be -; created [i.e. altering the item reference], so is not possible - -(define *scalar* "123 ") -(define *array* '#(" 123 " "456 ")) -(define *hash* (list (cons "key1" "123 ") (cons "key2" " 456"))) - -; Illustrates iteration / handling of heterogenous types -(for-each - (lambda (item) - (cond - ((string? item) (do-stuff-with-string item)) - ((vector? item) (do-stuff-with-vector item)) - ((pair? item) (do-stuff-with-hash item)) - (else (print "unknown type")))) - (list *scalar* *array* *hash*)) - -; So, for item-replacement-based updating you need to use explicit -; iteration e.g. 'do' loop, or recursion [as is done in the code for -; 'vector-map-in-order!'] - examples in next section. Or, you could -; create a new 'for-each' type control structure using Scheme's -; macro facility [example not shown] - -;; @@PLEAC@@_4.5 -(define *array* '#(1 2 3)) - -;; ---- - -; Whilst a 'vector' is mutable, 'array-for-each' passes only a copy -; of each cell, thus there is no way to perform updates -(array-for-each - (lambda (item) - ... do some non-array-mutating task with 'item'...) - *array*) - -;; ------------ - -; For mutating operations, use one of the mutating 'array-map-...' routines -; or the custom, 'vector-map-in-order!' -(vector-map-in-order! - (lambda (item) - ... do some array-mutating task with 'item'...) - *array*) - -;; ------------ - -; Alternatively, use 'do' to iterate over the array and directly update -(let ((vector-length (vector-length *array*))) - (do ((i 0 (+ i 1))) - ((= i vector-length)) - ... do some array-mutating task with current array element ...)) - -;; ------------ - -; Alternatively, use a 'named let' to iterate over array and directly update -(let ((vector-length (vector-length *array*))) - (let loop ((i 0)) - (cond - ((= i vector-length) '()) - (else - ... do some array-mutating task with current array element ... - (loop (+ i 1)))) )) - -;; ---------------------------- - -(define *fruits* '#("Apple" "Blackberry")) - -;; ------------ - -(array-for-each - (lambda (fruit) - (print fruit "tastes good in a pie.")) - *fruits*) - -;; ------------ - -(let ((vector-length (vector-length *fruits*))) - (do ((i 0 (+ i 1))) - ((= i vector-length)) - (print (vector-ref *fruits* i) "tastes good in a pie.") )) - -;; ---------------------------- - -(define *rogue-cats* '("Blacky" "Ginger" "Puss")) - -(define *name-list* (acons 'felines *rogue-cats* '())) - -;; ------------ - -(for-each - (lambda (cat) - (print cat "purrs hypnotically..")) - (cdr (assoc 'felines *name-list*))) - -;; ------------ - -(let loop ((felines (cdr (assoc 'felines *name-list*)))) - (cond - ((null? felines) '()) - (else - (print (car felines) "purrs hypnotically..") - (loop (cdr felines))))) - -;; @@PLEAC@@_4.6 -(use-modules (srfi srfi-1)) - -; Simplest [read: least code] means of removing duplicates is to use -; SRFI-1's 'delete-duplicates' routine - -(define *non-uniq-num-list* '(1 2 3 1 2 3)) -(define *uniq* (delete-duplicates *my-non-uniq-num-list*) - -;; ------------ - -(use-modules (srfi srfi-1)) - -; Another simple alternative is to use SRFI-1's 'lset-union' routine. In -; general, the 'lset-...' routines: -; - convenient, but not fast; probably best avoided for 'large' sets -; - operate on standard lists, so simple matter of type-converting arrays and such -; - care needs to be taken in choosing the needed equality function - -(define *non-uniq-string-list* '("abc" "def" "ghi" "abc" "def" "ghi")) -(define *uniq* (lset-union string=? *non-uniq-string-list* *non-uniq-string-list*)) - -;; ---- - -(define *non-uniq-sym-list* '('a 'b 'c 'a 'b 'c)) -(define *uniq* (lset-union equal? *my-non-uniq-sym-list* *my-non-uniq-sym-list*)) - -;; ---- - -(define *non-uniq-num-list* '(1 2 3 1 2 3)) -(define *uniq* (lset-union = *my-non-uniq-num-list* *my-non-uniq-num-list*)) - -;; ---------------------------- - -;; Perl Cookbook-based examples - illustrative only, *not* recommended approaches - -(use-modules (srfi srfi-1)) - -(define *list* '(1 2 3 1 2 7 8 1 8 2 1 3)) -(define *seen* '()) - -; Use hash to filter out unique items -(for-each - (lambda (item) - (if (not (assoc-ref *seen* item)) - (set! *seen* (assoc-set! *seen* item #t)))) - *list*) - -; Generate list of unique items -(define *uniq* - (fold-right - (lambda (pair accum) (cons (car pair) accum)) - '() - *seen*)) - -;; ------------ - -(define *list* '(1 2 3 1 2 7 8 1 8 2 1 3)) -(define *seen* '()) - -; Build list of unique items by checking set membership -(for-each - (lambda (item) - (if (not (member item *seen*)) - (set! *seen* (cons item *seen*)))) - *list*) - -;; ------------ - -(define *users* - (sort - (string-split (qx "who|cut -d' ' -f1") #\newline) - string<?)) - -(define *seen* '()) - -; Build list of unique users by checking set membership -(for-each - (lambda (user) - (if (not (member user *seen*)) - (set! *seen* (cons item *seen*)))) - *list*) - -;; @@PLEAC@@_4.7 -; All problems in this section involve, at core, set difference -; operations. Thus, the most compact and straightforward approach is -; to utilise SRFI-1's 'lset-difference' routine - -(use-modules (srfi srfi-1)) - -(define *a* '(1 3 5 6 7 8)) -(define *b* '(2 3 5 7 9)) - -; *difference* contains elements in *a* but not in *b*: 1 6 8 -(define *difference* (lset-difference = *a* *b*)) - -; *difference* contains elements in *b* but not in *a*: 2 9 -(set! *difference* (lset-difference = *b* *a*)) - -;; ---------------------------- - -;; Perl Cookbook-based example - illustrative only, *not* recommended approaches - -(use-modules (srfi srfi-1)) - -(define *a* '(1 3 5 6 7 8)) -(define *b* '(2 3 5 7 9)) - -(define *a-only* '()) - -; Build list of items in *a* but not in *b* -(for-each - (lambda (item) - (if (not (member item *b*)) - (set! *a-only* (cons item *a-only*)))) - *a*) - -;; @@PLEAC@@_4.8 -; The SRFI-1 'lset-xxx' routines are appropriate here - -(use-modules (srfi srfi-1)) - -(define *a* '(1 3 5 6 7 8)) -(define *b* '(2 3 5 7 9)) - -; Combined elements of *a* and *b* sans duplicates: 1 2 3 5 6 7 8 9 -(define *union* (lset-union = *a* *b*)) - -; Elements common to both *a* and *b*: 3 5 7 -(define *intersection* (lset-intersection = *a* *b*)) - -; Elements in *a* but not in *b*: 1 6 8 -(define *difference* (lset-difference = *a* *b*)) - -;; ---------------------------- - -;; Perl Cookbook-based example - illustrative only, *not* recommended approaches - -(use-modules (srfi srfi-1)) - -(define *a* '(1 3 5 6 7 8)) -(define *b* '(2 3 5 7 9)) - -(define *union* '()) -(define *isect* '()) -(define *diff* '()) - -;; ------------ - -; Union and intersection -(for-each - (lambda (item) (set! *union* (assoc-set! *union* item #t))) - *a*) - -(for-each - (lambda (item) - (if (assoc-ref *union* item) - (set! *isect* (assoc-set! *isect* item #t))) - (set! *union* (assoc-set! *union* item #t))) - *b*) - -; Difference *a* and *b* -(for-each - (lambda (item) - (if (not (assoc-ref *isect* item)) - (set! *diff* (assoc-set! *diff* item #t)))) - *a*) - -(set! *union* - (fold - (lambda (pair accum) (cons (car pair) accum)) - '() - *union*)) - -(set! *isect* - (fold - (lambda (pair accum) (cons (car pair) accum)) - '() - *isect*)) - -(set! *diff* - (fold - (lambda (pair accum) (cons (car pair) accum)) - '() - *diff*)) - -(print "Union count: " (length *union*)) -(print "Intersection count:" (length *isect*)) -(print "Difference count: " (length *diff*)) - -;; @@PLEAC@@_4.9 -; Arrays, specifically vectors in the current context, are fixed-size -; entities; joining several such together requires copying of their -; contents into a new, appropriately-sized, array. This task may be -; performed: - -; * Directly: loop through existing arrays copying elements into a -; newly-created array - -(define (vector-join vec . rest) - (let* ((all-vec (cons vec rest)) - (new-vec-len (reduce + 0 (map vector-length all-vec))) - (new-vec (make-vector new-vec-len)) - (new-vec-idx 0)) - (let loop ((all-vec all-vec)) - (cond - ((= new-vec-idx new-vec-len) new-vec) - (else - (array-for-each - (lambda (element) - (vector-set! new-vec new-vec-idx element) - (set! new-vec-idx (+ new-vec-idx 1))) - (car all-vec)) - (loop (cdr all-vec)) ))) )) - -;; ---- - -(define *array1* '#(1 2 3)) -(define *array2* '#(4 5 6)) - -(define *newarray* - (vector-join *array1* *array2*)) - -;; ---------------------------- - -; * Indirectly; convert arrays to lists, append the lists, convert -; resulting list back into an array - -(define *array1* '#(1 2 3)) -(define *array2* '#(4 5 6)) - -(define *newarray* - (list->vector (append (vector->list *array1*) (vector->list *array2*)) )) - -; Of course if random access is not required, it is probably best to simply -; use lists since a wealth of list manipulation routines are available - -;; ---------------------------- - -; While Perl offers an all-purpose 'splice' routine, a cleaner approach is -; to separate out such functionality; here three routines are implemented -; together offering an equivalent to 'splice'. The routines are: -; * vector-replace! [use with 'vector-copy' to avoid changing original] -; e.g. (vector-replace! vec ...) -; (set! new-vec (vector-replace! (vector-copy vec) ...)) -; * vector-delete -; * vector-insert - -(define (vector-replace! vec pos item . rest) - (let* ((all-items (cons item rest)) - (pos (if (< pos 0) (+ (vector-length vec) pos) pos)) - (in-bounds - (not (> (+ pos (length all-items)) (vector-length vec))))) - (if in-bounds - (let loop ((i pos) (all-items all-items)) - (cond - ((null? all-items) vec) - (else - (vector-set! vec i (car all-items)) - (loop (+ i 1) (cdr all-items))) )) - ;else - vec))) - -(define (vector-delete vec pos len) - (let* ((new-vec-len (- (vector-length vec) len)) - (new-vec #f) - (pos (if (< pos 0) (+ (vector-length vec) pos) pos))) - (cond - ((< new-vec-len 0) vec) - (else - (set! new-vec (make-vector new-vec-len)) - (let loop ((vec-idx 0) (new-vec-idx 0)) - (cond - ((= new-vec-idx new-vec-len) new-vec) - (else - (if (= vec-idx pos) (set! vec-idx (+ vec-idx len))) - (vector-set! new-vec new-vec-idx (vector-ref vec vec-idx)) - (loop (+ vec-idx 1) (+ new-vec-idx 1)) ))) )) )) - -; This routine would probably benefit from having 'cmd' implemented as a keyword -; argument. However, 'cmd' implemented as a positional to keep example simple -(define (vector-insert vec pos cmd item . rest) - (let* ((all-item-vec (list->array 1 (cons item rest))) - (all-item-vec-len (vector-length all-item-vec)) - (vec-len (vector-length vec)) - (new-vec (make-vector (+ vec-len all-item-vec-len))) - (pos (if (< pos 0) (+ (vector-length vec) pos) pos))) - (if (eq? cmd 'after) (set! pos (+ pos 1))) - (vector-move-left! vec 0 pos new-vec 0) - (vector-move-left! all-item-vec 0 all-item-vec-len new-vec pos) - (vector-move-left! vec pos vec-len new-vec (+ pos all-item-vec-len)) - new-vec)) - -;; ---- - -(define *members* '#("Time" "Flies")) -(define *initiates* '#("An" "Arrow")) - -(set! *members* (vector-join *members* *initiates*)) - -;; ------------ - -(set! *members* (vector-insert *members* 1 'after "Like" *initiates*)) -(print *members*) - -(set! *members* (vector-replace *members* 0 "Fruit")) -(set! *members* (vector-replace *members* -2 "A" "Banana")) -(print *members*) - -; was: '#("Time" "Flies" "An" "Arrow") -; now: '#("Fruit" "Flies" "Like" "A" "Banana") - -;; @@PLEAC@@_4.10 -; As for appending arrays, there is the choice of iterating through -; the array: -(define (vector-reverse! vec) - (let loop ((i 0) (j (- (vector-length vec) 1))) - (cond - ((>= i j) vec) - (else - (vector-ref-swap! vec i j) - (loop (+ i 1) (- j 1)))) )) - -;; ------------ - -(define *array* '#(1 2 3)) - -(vector-reverse! *array*) - -;; ------------ - -(define *array* '#(1 2 3)) - -(do ((i (- (vector-length *array*) 1) (- i 1))) - ((< i 0)) - ... do something with *array* ...) - -;; ---------------------------- - -; or of converting to / from a list, performing any manipulation using -; the list routines - -(define *array* '#(1 2 3)) - -(define *newarray* - (list->vector (reverse (sort (vector->list *array*) <)) )) - -;; @@PLEAC@@_4.11 -(define *array* '#(1 2 3 4 5 6 7 8)) - -;; ------------ - -; Remove first 3 elements -(define *front* (vector-delete *array* 0 3)) - -; Remove last 3 elements -(define *end* (vector-delete *array* -1 3)) - -;; ---------------------------- - -; Another helper routine -(define (vector-slice vec pos len) - (let* ((vec-len (vector-length vec)) - (pos (if (< pos 0) (+ vec-len pos) pos)) - (in-bounds - (not (> (+ pos len) vec-len)))) - (if in-bounds - (let ((new-vec (make-vector len))) - (let loop ((vec-idx pos) (new-vec-idx 0)) - (cond - ((= new-vec-idx len) new-vec) - (else - (vector-set! new-vec new-vec-idx (vector-ref vec vec-idx)) - (loop (+ vec-idx 1) (+ new-vec-idx 1))) ))) - ;else - vec))) - -; Both the following use, 'values', to return two values; this approach -; is quite contrived and is taken to mimic the Perl examples, not -; because it is a recommended one [returning a single list would probably -; be more sensible] -(define (shift2 vec) - (let ((vec (vector-slice vec 0 2))) - (values (vector-ref vec 0) (vector-ref vec 1)) )) - -(define (pop2 vec) - (let ((vec (vector-slice vec -1 2))) - (values (vector-ref vec 0) (vector-ref vec 1)) )) - -;; ------------ - -(define *friends* '#('Peter 'Paul 'Mary 'Jim 'Tim)) - -(let-values ( ((this that) (shift2 *friends*)) ) - (print this ":" that)) - -;; ------------ - -(define *beverages* '#('Dew 'Jolt 'Cola 'Sprite 'Fresca)) - -(let-values ( ((d1 d2) (pop2 *beverages*)) ) - (print d1 ":" d2)) - -;; @@PLEAC@@_4.12 -; SRFI-1 [list manipulation] routines are ideal for the types of task -; in this and the next section, in particular, 'for-each' and 'find', -; 'list-index', and many others for more specialist functions. The same -; applies to vectors with the SRFI-43 routines, 'vector-index' and -; 'vector-skip', though the approach taken in this chapter has been to -; implement functionally similar vector manipulation routines to more -; closely mimic the Perl examples - -; Return #f, or first index for which 'pred' returns true -(define (vector-first-idx pred vec) - (let ((vec-len (vector-length vec))) - (let loop ((idx 0)) - (cond - ((= idx vec-len) #f) - (else - (if (pred (vector-ref vec idx)) - idx - ;else - (loop (+ idx 1))) ))))) - -; Return #f, or first index for which 'pred' returns true -(define (list-first-idx pred list) - (let loop ((idx 0) (list list)) - (cond - ((null? list) #f) - (else - (if (pred (car list)) - idx - ;else - (loop (+ idx 1) (cdr list))) )))) - -;; ------------ - -(define *array* '#(1 2 3 4 5 6 7 8)) - -(print - (vector-first-idx - (lambda (x) (= x 9)) - *array*)) - -;; ---- - -(define *list* '(1 2 3 4 5 6 7 8)) - -(print - (list-first-idx - (lambda (x) (= x 4)) - *list*)) - -;; ---- - -(use-modules (srfi srfi-1)) - -(print - (list-index - (lambda (x) (= x 4)) - *list*)) - -;; ---------------------------- - -; The Perl 'highest paid engineer' example isn't really a 'first match' -; type of problem - the routines shown earlier really aren't suited to -; this. Better suited, instead, are the SRFI-1 routines like 'fold', -; 'fold-right' and 'reduce', even old standbys like 'filter' and 'for-each' - -(define +null-salary-rec+ - (list '() 0 '())) - -(define *salaries* - (list - (list 'engineer 43000 'Bob) - (list 'programmer 48000 'Andy) - (list 'engineer 35000 'Champ) - (list 'engineer 49000 'Bubbles) - (list 'programmer 47000 'Twig) - (list 'engineer 34000 'Axel) )) - -;; ---------------------------- - -(define *highest-paid-engineer* - (reduce - (lambda (salary-rec acc) - (if - (and - (eq? (car salary-rec) 'engineer) - (> (cadr salary-rec) (cadr acc))) - salary-rec - ;else - acc)) - +null-salary-rec+ - *salaries*)) - -(print *highest-paid-engineer*) - -;; ------------ - -(define *highest-paid-engineer* - (fold-right - (lambda (salary-rec acc) - (if (> (cadr salary-rec) (cadr acc)) - salary-rec - ;else - acc)) - +null-salary-rec+ - (filter - (lambda (salary-rec) - (eq? (car salary-rec) 'engineer)) - *salaries*)) ) - -(print *highest-paid-engineer*) - -;; ------------ - -(define *highest-paid-engineer* +null-salary-rec+) - -(for-each - (lambda (salary-rec) - (if - (and - (eq? (car salary-rec) 'engineer) - (> (cadr salary-rec) (cadr *highest-paid-engineer*))) - (set! *highest-paid-engineer* salary-rec))) - *salaries*) - -(print *highest-paid-engineer*) - -;; @@PLEAC@@_4.13 -; All tasks in this section consist of either generating a collection, -; or filtering a larger collection, of elements matching some criteria; -; obvious candidates are the 'filter' and 'array-filter' routines, though -; others like 'for-each' can also be applied - -(define *list-matching* (filter PRED LIST)) -(define *vector-matching* (array-filter PRED ARRAY)) - -;; ---------------------------- - -(define *nums* '(1e7 3e7 2e7 4e7 1e7 3e7 2e7 4e7)) - -(define *bigs* - (filter - (lambda (num) (> num 1000000)) - *nums*)) - -;; ------------ - -(define *users* - (list - '(u1 . 2e7) - '(u2 . 1e7) - '(u3 . 4e7) - '(u4 . 3e7) )) - -(define *pigs* - (fold-right - (lambda (pair accum) (cons (car pair) accum)) - '() - (filter - (lambda (pair) (> (cdr pair) 1e7)) - *users*))) - -(print *pigs*) - -;; ------------ - -(define *salaries* - (list - (list 'engineer 43000 'Bob) - (list 'programmer 48000 'Andy) - (list 'engineer 35000 'Champ) - (list 'engineer 49000 'Bubbles) - (list 'programmer 47000 'Twig) - (list 'engineer 34000 'Axel) )) - -(define *engineers* - (filter - (lambda (salary-rec) - (eq? (car salary-rec) 'engineer)) - *salaries*)) - -(print *engineers*) - -;; ------------ - -(define *applicants* - (list - (list 'a1 26000 'Bob) - (list 'a2 28000 'Andy) - (list 'a3 24000 'Candy) )) - -(define *secondary-assistance* - (filter - (lambda (salary-rec) - (and - (> (cadr salary-rec) 26000) - (< (cadr salary-rec) 30000))) - *applicants*)) - -(print *secondary-assistance*) - -;; @@PLEAC@@_4.14 -; Sorting numeric data in Scheme is very straightforward ... - -(define *unsorted* '(5 8 1 7 4 2 3 6)) - -;; ------------ - -; Ascending sort - use '<' as comparator -(define *sorted* - (sort - *unsorted* - <)) - -(print *sorted*) - -;; ------------ - -; Descending sort - use '>' as comparator -(define *sorted* - (sort - *unsorted* - >)) - -(print *sorted*) - -;; @@PLEAC@@_4.15 -; A customised lambda may be passed as comparator to 'sort', so -; sorting on one or more 'fields' is quite straightforward - -(define *unordered* '( ... )) - -; COMPARE is some comparator suited for the element type being -; sorted -(define *ordered* - (sort - *unordered* - (lambda (left right) - (COMPARE left right)))) - -;; ------------ - -(define *unordered* - (list - (cons 's 34) - (cons 'e 12) - (cons 'c 45) - (cons 'q 11) - (cons 'g 24) )) - -(define *pre-computed* - (map - ; Here element is returned unaltered, but it would normally be - ; transformed in som way - (lambda (element) element) - *unordered*)) - -(define *ordered-pre-computed* - (sort - *pre-computed* - ; Sort on the first field [assume it is the 'key'] - (lambda (left right) - (string<? - (symbol->string (car left)) - (symbol->string (car right)))))) - -; Extract the second field [assume it is the 'value'] -(define *ordered* - (map - (lambda (element) (cdr element)) - *ordered-pre-computed*)) - -;; ---------------------------- - -(define *employees* - (list - (list 'Bob 43000 123 42) - (list 'Andy 48000 124 35) - (list 'Champ 35000 125 37) - (list 'Bubbles 49000 126 34) - (list 'Twig 47000 127 36) - (list 'Axel 34000 128 31) )) - -(define *ordered* - (sort - *employees* - (lambda (left right) - (string<? - (symbol->string (car left)) - (symbol->string (car right)))))) - -;; ------------ - -(for-each - (lambda (employee) - (print (car employee) "earns $" (cadr employee))) - (sort - *employees* - (lambda (left right) - (string<? - (symbol->string (car left)) - (symbol->string (car right)))))) - -;; ------------ - -(define *bonus* - (list - '(125 . 1000) - '(127 . 1500) )) - -(for-each - (lambda (employee) - (let ((bonus (assoc-ref *bonus* (caddr employee)))) - (if (not bonus) - '() - ;else - (print (car employee) "earned bonus" bonus) ))) - (sort - *employees* - (lambda (left right) - (string<? - (symbol->string (car left)) - (symbol->string (car right)))))) - -;; ---------------------------- - -(use-modules (srfi srfi-1) (ice-9 rdelim) (ice-9 regex)) - -(define *filename* "/etc/passwd") -(define *users* '()) - -(let ((port (open-input-file *filename*))) - (let loop ((line&terminator (read-line port 'split))) - (cond - ((eof-object? (cdr line&terminator)) '()) - (else - (set! *users* - (assoc-set! - *users* - (car (string-split (car line&terminator) #\:)) - #t)) - (loop (read-line port 'split)) ))) - (close-input-port port)) - -(for-each - (lambda (user) (print (car user))) - (sort - *users* - (lambda (left right) - (string<? - (car left) - (car right))))) - -;; @@PLEAC@@_4.16 -; Use SRFI-1's 'circular-list' routine to build a circular list -(use-modules (srfi srfi-1)) - -(define *processes* (circular-list 1 2 3 4 5)) - -(let loop ((processes *processes*)) - (print "Handling process" (car processes)) - (sleep 1) - (loop (cdr processes))) - -;; @@PLEAC@@_4.17 -(use-modules (srfi srfi-1)) - -; Implements Fischer-Yates shuffle algorithm -(define (vector-shuffle! vec) - (let ((vector-length (vector-length vec))) - (let loop ((i vector-length) (j (+ 1 (random vector-length)))) - (cond - ((= i 1) '()) - ((not (= i j)) - (vector-ref-swap! vec (- i 1) (- j 1)) - (loop (- i 1) (+ 1 (random (- i 1))))) - (else - (loop (- i 1) (+ 1 (random (- i 1))))) )))) - -(define (vector-ref-swap! vec idx1 idx2) - (let ((tmp (vector-ref vec idx1))) - (vector-set! vec idx1 (vector-ref vec idx2)) - (vector-set! vec idx2 tmp))) - -; Generate vector of values 1 .. 10 -(define *irange* (list->vector (iota 10 1 1))) - -; Shuffle array values -(vector-shuffle! *irange*) - -;; @@PLEAC@@_4.18 -;; @@INCOMPLETE@@ -;; @@INCOMPLETE@@ - -;; @@PLEAC@@_4.19 -;; @@INCOMPLETE@@ -;; @@INCOMPLETE@@ - -;; @@PLEAC@@_5.0 -;; --------------------------------------------------------------------- -;; Scheme offers two dictionary types: -;; -;; * Association list [list of pairs e.g. '((k1 . v1) (k2 . v2) ...)] -;; * Hash table [vector of pairs plus hash algorithm] -;; -;; Implementation differences aside, they are remarkably similar in that -;; the functions operating on them are similar named, and offer the same -;; interface. Examples: -;; -;; * Retrieve an item: (assoc-ref hash key) (hash-ref hash key) -;; * Update an item: (assoc-set! hash key value) (hash-set! hash key value) -;; -;; Hash tables would tend to be used where performance was critical e.g. -;; near constant-time lookups, or where entry updates are frequent, whilst -;; association lists would be used where table-level traversals and -;; manipulations require maximum flexibility -;; -;; Many of the sections include examples using both association lists and -;; hash tables. However, where only one of these is shown, implementing -;; the other is usually a trivial exercise. Finally, any helper functions -;; will be included in the Appendix -;; --------------------------------------------------------------------- - -; Association lists -(define *age* - (list - (cons 'Nat 24) - (cons 'Jules 25) - (cons 'Josh 17))) - -;; or, perhaps more compactly: -(define *age* - (list - '(Nat . 24) - '(Jules . 25) - '(Josh . 17))) - -;; ------------ - -; Guile built-in association list support -(define *age* (acons 'Nat 24 '())) -(set! *age* (acons 'Jules 25 *age*)) -(set! *age* (acons 'Josh 17 *age*)) - -;; ---- - -; SRFI-1 association list support -(use-modules (srfi srfi-1)) - -(define *age* (alist-cons 'Nat 24 '())) -(set! *age* (alist-cons 'Jules 25 *age*)) -(set! *age* (alist-cons 'Josh 17 *age*)) - -;; ------------ - -(define *food-colour* - (list - '(Apple . "red") - '(Banana . "yellow") - '(Lemon . "yellow") - '(Carrot . "orange"))) - -;; ---------------------------- - -; Hash tables. Guile offers an implementation, and it is also -; possible to use SRFI-69 hash tables; only the former will be -; illustrated here - -(define *age* (make-hash-table 20)) -; or -(define *age* (make-vector 20 '())) - -(hash-set! *age* 'Nat 24) -(hash-set! *age* 'Jules 25) -(hash-set! *age* 'Josh 17) - -(hash-for-each - (lambda (key value) (print key)) - *age*) - -; or, if vector used as hash table, can also use: - -(array-for-each - (lambda (pair) - (if (not (null? pair)) (print (car pair)))) - *age*) - -;; ------------ - -(define *food-colour* (make-hash-table 20)) - -(hash-set! *food-colour* 'Apple "red") -(hash-set! *food-colour* 'Banana "yellow") -(hash-set! *food-colour* 'Lemon "yellow") -(hash-set! *food-colour* 'Carrot "orange") - -;; @@PLEAC@@_5.1 -(set! *hash* (acons key value *hash*)) - -;; ------------ - -(set! *food-colour* (acons 'Raspberry "pink" *food-colour*)) - -(print "Known foods:") -(for-each - (lambda (pair) (print (car pair))) - *food-colour*) - -;; ---------------------------- - -(hash-set! *hash* key value) - -;; ------------ - -(hash-set! *food-colour* 'Raspberry "pink") - -(print "Known foods:") -(hash-for-each - (lambda (key value) (print key)) - *food-colour*) - -;; @@PLEAC@@_5.2 -; 'assoc' returns the pair, (key . value) -(if (assoc key hash) - ... found ... -;else - ... not found ... - -; 'assoc-ref' returns the value only -(if (assoc-ref hash key) - ... found ... -;else - ... not found ... - -;; ------------ - -; *food-colour* association list from an earlier section - -(for-each - (lambda (name) - (let ((pair (assoc name *food-colour*))) - (if pair - (print (symbol->string (car pair)) "is a food") - ;else - (print (symbol->string name) "is a drink") ))) - (list 'Banana 'Martini)) - -;; ---------------------------- - -; 'hash-get-handle' returns the pair, (key . value) -(if (hash-get-handle hash key) - ... found ... -;else - ... not found ... - -; 'hash-ref' returns the value only -(if (hash-ref hash key) - ... found ... -;else - ... not found ... - -;; ------------ - -; *food-colour* hash table from an earlier section - -(for-each - (lambda (name) - (let ((value (hash-ref *food-colour* name))) - (if value - (print (symbol->string name) "is a food") - ;else - (print (symbol->string name) "is a drink") ))) - (list 'Banana 'Martini)) - -;; ---------------------------- - -(define *age* (make-hash-table 20)) - -(hash-set! *age* 'Toddler 3) -(hash-set! *age* 'Unborn 0) -(hash-set! *age* 'Phantasm '()) - -(for-each - (lambda (thing) - (let ((value (hash-ref *age* thing))) - (display thing) - (if value (display " Exists")) - (if (and value (not (string-null? value))) (display " Defined")) - ; Testing for non-zero as true is not applicable, so testing - ; for non-equality with zero - (if (and value (not (eq? value 0))) (display " True")) - (print "") )) - (list 'Toddler 'Unborn 'Phantasm 'Relic)) - -;; @@PLEAC@@_5.3 -(assoc-remove! hash key) - -;; ------------ - -(use-modules (srfi srfi-1)) - -; *food-colour* association list from an earlier section - -(define (print-foods) - (let ((foods - (fold-right - (lambda (pair accum) (cons (car pair) accum)) - '() - *food-colour*))) - (display "Keys: ") (print foods) - (print "Values:") - (for-each - (lambda (food) - (let ((colour (assoc-ref *food-colour* food))) - (cond - ((string-null? colour) (display "(undef) ")) - (else (display (string-append colour " "))) ))) - foods)) - (newline)) - -(print "Initially:") -(print-foods) - -(print "\nWith Banana undef") -(assoc-set! *food-colour* 'Banana "") -(print-foods) - -(print "\nWith Banana deleted") -(assoc-remove! *food-colour* 'Banana) -(print-foods) - -;; ---------------------------- - -(hash-remove! hash key) - -;; ------------ - -(use-modules (srfi srfi-1)) - -; *food-colour* hash table from an earlier section - -(define (print-foods) - (let ((foods - (hash-fold - (lambda (key value accum) (cons key accum)) - '() - *food-colour*))) - (display "Keys: ") (print (reverse foods)) - (print "Values:") - (for-each - (lambda (food) - (let ((colour (hash-ref *food-colour* food))) - (cond - ((string-null? colour) (display "(undef) ")) - (else (display (string-append colour " "))) ))) - foods)) - (newline)) - -(print "Initially:") -(print-foods) - -(print "\nWith Banana undef") -(hash-set! *food-colour* 'Banana "") -(print-foods) - -(print "\nWith Banana deleted") -(hash-remove! *food-colour* 'Banana) -(print-foods) - -;; @@PLEAC@@_5.4 -; Since an association list is nothing more than a list of pairs, it -; may be traversed using 'for-each' -(for-each - (lambda (pair) - (let ((key (car pair)) - (value (cdr pair))) - ... do something with key / value ...)) - hash) - -;; ---------------------------- - -; A 'for-each'-like function is available for hash table traversal -(hash-for-each - (lambda (key value) - ... do something with key / value ...) - hash) - -; If the hash table is directly implemented as a vector, then it is -; also possible to traverse it using, 'array-for-each', though a -; check for empty slots is needed -(array-for-each - (lambda (pair) - (if (not (null? pair)) ... do something with key / value ...)) - hash) - -;; ---------------------------- - -; *food-colour* association list from an earlier section - -(for-each - (lambda (pair) - (let ((food (car pair)) - (colour (cdr pair))) - (print (symbol->string food) "is" colour) )) - *food-colour*) - -;; ------------ - -; *food-colour* association list from an earlier section - -(for-each - (lambda (food) - (print (symbol->string food) "is" (assoc-ref *food-colour* food))) - (sort - (fold-right - (lambda (pair accum) (cons (car pair) accum)) - '() - *food-colour*) - (lambda (left right) - (string<? (symbol->string left) (symbol->string right))))) - -;; ---------------------------- - -(use-modules (srfi srfi-1) (ice-9 rdelim) (ice-9 regex)) - -(define *filename* "from.txt") -(define *from* '()) - -(let ((port (open-input-file *filename*))) - (let loop ((line&terminator (read-line port 'split))) - (cond - ((eof-object? (cdr line&terminator)) '()) - (else - (let* ((key (string->symbol - (match:substring - (string-match - "^From: (.*)" (car line&terminator)) - 1) )) - (value (assoc-ref *from* key))) - (if (not value) (set! value 0)) - (set! *from* (assoc-set! *from* key (+ 1 value)))) - (loop (read-line port 'split)) ))) - (close-input-port port)) - -(for-each - (lambda (person) - (print (symbol->string person) ":" (number->string (assoc-ref *from* person)))) - (sort - (fold-right - (lambda (pair accum) (cons (car pair) accum)) - '() - *from*) - (lambda (left right) - (string<? (symbol->string left) (symbol->string right))))) - -;; @@PLEAC@@_5.5 -; All approaches shown in the previous section apply here also, so -; there is little to be gained by repeating those examples [i.e. the -; use of 'for-each' and similar]. It is always possible, of course, -; to directly recurse over an association list: - -; *food-colour* association list from an earlier section - -(define *sorted-food-colour* - (sort - *food-colour* - (lambda (left right) - (string<? - (symbol->string (car left)) - (symbol->string (car right)))) )) - -(let loop ((hash *sorted-food-colour*)) - (cond - ((null? hash) '()) - (else - (print - (symbol->string (car (car hash))) "=>" (cdr (car hash)) ) - (loop (cdr hash))) )) - -;; @@PLEAC@@_5.6 -; AFAIK, Scheme doesn't offer a facility similar to Perl's 'Tie::IxHash'. -; Therefore, use an association list if retrieval [from a dictionary -; type container] in insertion order is required. - -(define *food-colour* (acons 'Banana "Yellow" '())) -(set! *food-colour* (acons 'Apple "Green" *food-colour*)) -(set! *food-colour* (acons 'Lemon "yellow" *food-colour*)) - -(print "In insertion order, the foods are:") -(for-each - (lambda (pair) - (let ((food (car pair)) - (colour (cdr pair))) - (print " " (symbol->string food)) )) - *food-colour*) - -(print "Still in insertion order, the food's colours are:") -(for-each - (lambda (pair) - (let ((food (car pair)) - (colour (cdr pair))) - (print (symbol->string food) "is coloured" colour) )) - *food-colour*) - -;; ---------------------------- - -; Of course, insertion order is lost if the association list is sorted, -; or elements removed, so if maintaining insertion order is vital, it -; might pay to associate data with a timestamp [e.g. create a timestamped -; record / structure], and manipulate those entities [no example given] - -;; @@PLEAC@@_5.7 -(define *ttys* '()) - -(for-each - (lambda (user-tty-pair) - (let* ((user-tty-pair (string-split user-tty-pair #\space)) - (user (string->symbol (car user-tty-pair))) - (newtty (cadr user-tty-pair)) - (current-ttys (assoc-ref *ttys* user))) - (set! *ttys* - (assoc-set! *ttys* user - (if (not current-ttys) - newtty - (string-append current-ttys " " newtty)) )))) - (string-split (qx "who|cut -d' ' -f1,2") #\newline)) - -(for-each - (lambda (user-ttys) - (print (symbol->string (car user-ttys)) ":" (cdr user-ttys))) - (sort - *ttys* - (lambda (left right) - (string<? - (symbol->string (car left)) - (symbol->string (car right))))) ) - -;; ---------------------------- - -(use-modules (ice-9 regex)) - -(define (multi-hash-delete hash key value) - (let ((value-found (assoc-ref hash key))) - (if value-found - (assoc-ref hash key - (regexp-substitute/global - #f (string-match value value-found) 'pre "" 'post ""))))) - -;; @@PLEAC@@_5.8 -; Alternate implementatons of a hash inversion function; both assume -; key is a symbol, value is a string - -(define (assoc-invert assoc) - (map - (lambda (pair) - (cons - (string->symbol (cdr pair)) - (symbol->string (car pair)))) - assoc)) - -;; ------------ - -(define (assoc-invert assoc) - (let loop ((assoc assoc) (new-assoc '())) - (cond - ((null? assoc) new-assoc) - (else - (loop (cdr assoc) - (acons - (string->symbol (cdar assoc)) - (symbol->string (caar assoc)) new-assoc)) )) )) - -;; ---------------------------- - -(define *surname* - (list - '(Mickey . "Mantle") - '(Babe . "Ruth"))) - -(define *first-name* (assoc-invert *surname*)) - -(print (assoc-ref *first-name* 'Mantle)) - -;; ---------------------------- - -; foodfind - -(define *given* (string->symbol (cadr (command-line)))) - -(define *colour* - (list - '(Apple . "red") - '(Lemon . "yellow") - '(Carrot . "orange"))) - -(define *food* (assoc-invert *colour*)) - -(if (assoc-ref *colour* *given*) - (print - (symbol->string *given*) - "is a food with colour" - (assoc-ref *colour* *given*))) - -(if (assoc-ref *food* *given*) - (print - (assoc-ref *food* *given*) - "is a food with colour" - (symbol->string *given*))) - -;; @@PLEAC@@_5.9 -; *food-colour* association list from an earlier section - -; Use 'sort' to sort the entire hash, on key or on value, ascending or -; descending order -(define *sorted-on-key:food-colour* - (sort - *food-colour* - (lambda (left right) - (string<? - (symbol->string (car left)) - (symbol->string (car right)))) )) - -(define *sorted-on-value:food-colour* - (sort - *food-colour* - (lambda (left right) - (string<? - (cdr left) - (cdr right))) )) - -;; ------------ - -(for-each - (lambda (pair) - (let ((food (car pair)) - (colour (cdr pair))) - (print - (symbol->string food) - "is" - colour))) - *sorted-on-key:food-colour*) - -;; ---------------------------- - -; Alternatively, generate a list of keys or values, sort as required, -; and use list to guide the hash traversal - -(define *sorted-food-colour-keys* - (sort - (fold-right - (lambda (pair accum) (cons (car pair) accum)) - '() - *food-colour*) - (lambda (left right) - (string<? - (symbol->string left) - (symbol->string right))) )) - -(define *sorted-food-colour-values* - (sort - (fold-right - (lambda (pair accum) (cons (cdr pair) accum)) - '() - *food-colour*) - (lambda (left right) - (string<? left right)) )) - -;; ------------ - -(for-each - (lambda (food) - (print (symbol->string food) "is" (assoc-ref *food-colour* food))) - *sorted-food-colour-keys*) - -;; @@PLEAC@@_5.10 -; If merging is defined as the combining of the contents of two or more -; hashes, then it is simply a matter of copying the contents of each -; into a new hash - -; Association lists can simply be appended together -(define *food-colour* - (list - '(Apple . "red") - '(Banana . "yellow") - '(Lemon . "yellow") - '(Carrot . "orange"))) - -(define *drink-colour* - (list - '(Galliano . "yellow") - '(Mai Tai . "blue"))) - -(define *ingested-colour* (append *food-colour* *drink-colour*)) - -;; ---------------------------- - -; Hash tables built from vectors can be copied element by element into -; a new vector, or spliced together using 'vector-join' [see Chapter 4] - -(define *food-colour* (make-vector 20 '()) -; ... -(define *drink-colour* (make-vector 20 '()) -; ... - -(define *ingested-colour* - (vector-join *food-colour* *drink-colour*)) - -;; @@PLEAC@@_5.11 -(define *common* '()) -(define *this-not-that* '()) - -;; ------------ - -(define *dict1* - (list - '(Apple . "red") - '(Lemon . "yellow") - '(Carrot . "orange"))) - -(define *dict2* - (list - '(Apple . "red") - '(Carrot . "orange"))) - -;; ------------ - -; Find items common to '*dict1*' and '*dict2*' -(for-each - (lambda (pair) - (let ((key (car pair)) - (value (cdr pair))) - (if (assoc-ref *dict2* key) - (set! *common* (cons key *common*))) )) - *dict1*) - -;; ------------ - -; Find items in '*dict1*' but not '*dict2*' -(for-each - (lambda (pair) - (let ((key (car pair)) - (value (cdr pair))) - (if (not (assoc-ref *dict2* key)) - (set! *this-not-that* (cons key *this-not-that*))) )) - *dict1*) - -;; ---------------------------- - -(define *non-citrus* '()) - -(define *citrus-colour* - (list - '(Lemon . "yellow") - '(Orange . "orange") - '(Lime . "green"))) - -(define *food-colour* - (list - '(Apple . "red") - '(Banana . "yellow") - '(Lemon . "yellow") - '(Carrot . "orange"))) - -(for-each - (lambda (pair) - (let ((key (car pair)) - (value (cdr pair))) - (if (not (assoc-ref *citrus-colour* key)) - (set! *non-citrus* (cons key *non-citrus*))) )) - *food-colour*) - -;; @@PLEAC@@_5.12 -; All objects [including functions] are first class entities, so there -; is no problem / special treatment needed to use any object, including -; those classed as 'references' [e.g. file handles or ports] as keys - -(use-modules (srfi srfi-1) (srfi srfi-13)) - -(define *ports* '()) - -(for-each - (lambda (filename) - (let ((port (open-input-file filename))) - (set! *ports* (assoc-set! *ports* port filename)) )) - '("/etc/termcap" "/vmlinux" "/bin/cat")) - -(print - (string-append "open files: " - (string-drop - (fold-right - (lambda (pair accum) (string-append ", " (cdr pair) accum)) - "" - *ports*) - 2))) - -(for-each - (lambda (pair) - (let ((port (car pair)) - (filename (cdr pair))) - (seek port 0 SEEK_END) - (print filename "is" (number->string (ftell port)) "bytes long.") - (close-input-port port) )) - *ports*) - -;; @@PLEAC@@_5.13 -; An association list takes on the size of the number of elements with -; which it is initialised, so presizing is implicit - -(define *hash* '()) ; zero elements - -;; ------------ - -(define *hash* ; three elements - (list - '(Apple . "red") - '(Lemon . "yellow") - '(Carrot . "orange"))) - -;; ---------------------------- - -; A size [i.e. number of entries] must be specified when a hash table -; is created, so presizing is implicit - -(define *hash* (make-hash-table 100)) - -;; ------------ - -(define *hash* (make-vector 100 '())) - -;; @@PLEAC@@_5.14 -(define *array* - (list 'a 'b 'c 'd 'd 'a 'a 'c 'd 'd 'e)) - -;; ---------------------------- - -(define *count* '()) - -(for-each - (lambda (element) - (let ((value (assoc-ref *count* element))) - (if (not value) (set! value 0)) - (set! *count* (assoc-set! *count* element (+ 1 value))))) - *array*) - -;; ---------------------------- - -(define *count* (make-hash-table 20)) - -(for-each - (lambda (element) - (let ((value (hash-ref *count* element))) - (if (not value) (set! value 0)) - (hash-set! *count* element (+ 1 value)))) - *array*) - -;; @@PLEAC@@_5.15 -(define *father* - (list - '(Cain . Adam) - '(Abel . Adam) - '(Seth . Adam) - '(Enoch . Cain) - '(Irad . Enoch) - '(Mehujael . Irad) - '(Methusael . Mehujael) - '(Lamech . Methusael) - '(Jabal . Lamech) - '(Jubal . Lamech) - '(Tubalcain . Lamech) - '(Enos . Seth))) - -;; ------------ - -(use-modules (srfi srfi-1) (ice-9 rdelim)) - -(let ((port (open-input-file *filename*))) - (let loop ((line&terminator (read-line port 'split))) - (cond - ((eof-object? (cdr line&terminator)) '()) - (else - (let ((person (string->symbol (car line&terminator)))) - (let loop ((father (assoc-ref *father* person))) - (if father - (begin - (print father) - (loop (assoc-ref *father* father)) ))) - (loop (read-line port 'split)) )))) - (close-input-port port)) - -;; ------------ - -(use-modules (srfi srfi-1) (ice-9 rdelim)) - -(define (assoc-invert-N:M assoc) - (let ((new-assoc '())) - (for-each - (lambda (pair) - (let* ((old-key (car pair)) - (new-key (cdr pair)) - (new-key-found (assoc-ref new-assoc new-key))) - (if (not new-key-found) - (set! new-assoc (acons new-key (list old-key) new-assoc)) - ;else - (set! new-assoc (assoc-set! new-assoc new-key (cons old-key new-key-found))) ))) - assoc) - new-assoc)) - -(define *children* (assoc-invert-N:M *father*)) - -(let ((port (open-input-file *filename*))) - (let loop ((line&terminator (read-line port 'split))) - (cond - ((eof-object? (cdr line&terminator)) '()) - (else - (let* ((person (string->symbol (car line&terminator))) - (children-found (assoc-ref *children* person))) - (print (symbol->string person) "begat:") - (if (not children-found) - (print "nobody") - ;else - (for-each - (lambda (child) (print (symbol->string child) ",")) - children-found)) - (loop (read-line port 'split)) )))) - (close-input-port port)) - -;; @@PLEAC@@_5.16 -;; @@INCOMPLETE@@ -;; @@INCOMPLETE@@ - -;; @@PLEAC@@_7.0 -;; use (open-input-file filename) or (open filename O_RDONLY) - -(define input (open-input-file "/usr/local/widgets/data")) -(let loop ((line (read-line input 'concat))) - (cond ((not (eof-object? line)) - (if (string-match "blue" line) - (display line)) - (loop (read-line input 'concat))))) -(close input) - -;; Many I/O functions default to the logical STDIN/OUT - -;; You can also explicitly get the standard ports with -;; [set-]current-{input,output,error}-port. - -;; format takes a port as the first argument. If #t is given, format -;; writes to stdout, if #f is given, format returns a string. - -(let loop ((line (read-line))) ; reads from stdin - (cond ((not (eof-object? line)) - (if (not (string-match "[0-9]" line)) - ;; writes to stderr - (display "No digit found.\n" (current-error-port)) - ;; writes to stdout - (format #t "Read: ~A\n" line)) - (loop (read-line))))) - -;; use open-output-file - -(define logfile (open-output-file "/tmp/log")) - -;; increasingly specific ways of closing ports (it's safe to close a -;; closed port) - -(close logfile) ; #t -(close-port logfile) ; #f (already closed) -(close-output-port logfile) ; unspecified - -;; you can rebind standard ports with set-current-<foo>-port: - -(let ((old-out (current-output-port))) - (set-current-output-port logfile) - (display "Countdown initiated ...\n") - (set-current-output-port old-out) - (display "You have 30 seconds to reach minimum safety distance.\n")) - -;; or - -(with-output-to-file logfile - (lambda () (display "Countdown initiated ...\n"))) -(display "You have 30 seconds to reach minimum safety distance.\n") - - -;; @@PLEAC@@_7.1 -(define source (open-input-file path)) -(define sink (open-output-file path)) - -(define source (open path O_RDONLY)) -(define sink (open path O_WRONLY)) - -;;----------------------------- -(define port (open-input-file path)) -(define port (open-file path "r")) -(define port (open path O_RDONLY)) -;;----------------------------- -(define port (open-output-file path)) -(define port (open-file path "w")) -(define port (open path (logior O_WRONLY O_TRUNC O_CREAT))) -;;----------------------------- -(define port (open path (logior O_WRONLY O_EXCL O_CREAT))) -;;----------------------------- -(define port (open-file path "a")) -(define port (open path (logior O_WRONLY O_APPEND O_CREAT))) -;;----------------------------- -(define port (open path (logior O_WRONLY O_APPEND))) -;;----------------------------- -(define port (open path O_RDWR)) -;;----------------------------- -(define port (open-file path "r+")) -(define port (open path (logior O_RDWR O_CREAT))) -;;----------------------------- -(define port (open path (logior O_RDWR O_EXCL O_CREAT))) -;;----------------------------- - -;; @@PLEAC@@_7.2 -;; Nothing different needs to be done with Guile - -;; @@PLEAC@@_7.3 -(define expand-user - (let ((rx (make-regexp "^\\~([^/]+)?"))) - (lambda (filename) - (let ((m (regexp-exec rx filename))) - (if m - (string-append - (if (match:substring m 1) - (passwd:dir (getpwnam (match:substring m 1))) - (or (getenv "HOME") (getenv "LOGDIR") - (passwd:dir (getpwuid (cuserid))) "")) - (substring filename (match:end m))) - filename))))) - -;; @@PLEAC@@_7.4 -(define port (open-file filename mode)) ; raise an exception on error - -;; use catch to trap errors -(catch 'system-error ; the type of error thrown - (lambda () (set! port (open-file filename mode))) ; thunk to try - (lambda (key . args) ; exception handler - (let ((fmt (cadr args)) - (msg&path (caddr args))) - (format (current-error-port) fmt (car msg&path) (cadr msg&path)) - (newline)))) - -;; @@PLEAC@@_7.5 -;; use the POSIX tmpnam -(let ((name (tmpnam))) - (call-with-output-file name - (lambda (port) - ;; ... output to port - ))) - -;; better to test and be sure you have exclusive access to the file -;; (temp file name will be available as (port-filename port)) -(define (open-temp-file) - (let loop ((name (tmpnam))) - (catch 'system-error - (lambda () (open name (logior O_RDWR O_CREAT O_EXCL))) - (lambda (key . args) (loop (tmpnam)))))) - -;; or let mkstemp! do the work for you: -(define port (mkstemp! template-string-ending-in-XXXXXX)) - -(let* ((tmpl "/tmp/programXXXXXX") - (port (mkstemp! tmpl))) - ;; tmpl now contains the name of the temp file, - ;; e.g. "/tmp/programhVoEzw" - (do ((i 0 (1+ i))) - ((= i 10)) - (format port "~A\n" i)) - (seek port 0 SEEK_SET) - (display "Tmp file has:\n") - (do ((line (read-line port 'concat) (read-line port 'concat))) - ((eof-object? line)) - (display line)) - (close port)) - -;; @@PLEAC@@_7.6 -;; string ports are ideal for this - -(define DATA " -your data goes here -") - -(call-with-input-string - DATA - (lambda (port) - ;; ... process input from port - )) - -;; or - -(with-input-from-string DATA - (lambda () - ;; ... stdin now comes from DATA - )) - -;; @@PLEAC@@_7.7 -;; to process lines of current-input-port: -(do ((line (read-line) (read-line))) - ((eof-object? line)) - ;; ... do something with line - ) - -;; a general filter template: - -(define (body) - (do ((line (read-line) (read-line))) - ((eof-object? line)) - (display line) - (newline))) - -(let ((args (cdr (command-line)))) - ;; ... handle options here - (if (null? args) - (body) ; no args, just call body on stdin - (for-each ; otherwise, call body with stdin set to each arg in turn - (lambda (file) - (catch 'system-error - (lambda () - (with-input-from-file file - body)) - (lambda (key . args) - (format (current-error-port) (cadr args) (caaddr args) - (car (cdaddr args))) - (newline (current-error-port))))) - args))) - -;; example: count-chunks: -(use-modules (srfi srfi-1) (srfi srfi-13) (ice-9 format) (ice-9 regex)) - -;; also use directory-files from 9.5 and globbing functions from 9.6 - -;; can use (ice-9 getopt-long) described in chapter 15, or process -;; options by hand -(define opt-append 0) -(define opt-ignore-ints 0) -(define opt-nostdout 0) -(define opt-unbuffer 0) - -(define args (cdr (command-line))) - -(do ((opts args (cdr opts))) - ((or (null? opts) (not (eq? (string-ref (car opts) 0) #\-))) - (set! args opts)) - (let ((opt (car opts))) - (cond ((string=? opt "-a") (set! opt-append (1+ opt-append))) - ((string=? opt "-i") (set! opt-ignore-ints (1+ opt-ignore-ints))) - ((string=? opt "-n") (set! opt-nostdout (1+ opt-nostdout))) - ((string=? opt "-u") (set! opt-unbuffer (1+ opt-unbuffer))) - (else (throw 'usage-error "Unexpected argument: ~A" opt))))) - -;; default to all C source files -(if (null? args) (set! args (glob "*.[Cch]" "."))) - -(define (find-login) - (do ((line (read-line) (read-line))) - ((eof-object? line)) - (cond ((string-match "login" line) - (display line) - (newline))))) - -(define (lowercase) - (do ((line (read-line) (read-line))) - ((eof-object? line)) - (display (string-downcase line)) - (newline))) - -(define (count-chunks) - (do ((line (read-line) (read-line)) - (chunks 0)) - ((or (eof-object? line) - (string=? line "__DATA__") (string=? line "__END__")) - (format #t "Found ~A chunks\n" chunks)) - (let ((tokens - (string-tokenize (string-take line (or (string-index line #\#) - (string-length line)))))) - (set! chunks (+ chunks (length tokens)))))) - -(if (null? args) - (count-chunks) ; or find-login, lowercase, etc. - (for-each - (lambda (file) - (catch 'system-error - (lambda () - (with-input-from-file file - count-chunks)) - (lambda (key . args) - (format (current-error-port) (cadr args) (caaddr args) - (car (cdaddr args))) - (newline (current-error-port))))) - args)) - -;; @@PLEAC@@_7.8 -;; write changes to a temporary file then rename it -(with-input-from-file old - (lambda () - (with-output-to-file new - (lambda () - (do ((line (read-line) (read-line))) - ((eof-object? line)) - ;; change line, then... - (write-line line)))))) -(rename-file old (string-append old ".orig")) -(rename-file new old) - -;; @@PLEAC@@_7.9 -;; no -i switch - -;; @@PLEAC@@_7.10 -;; open the file in read/write mode, slurp up the contents, modify it, -;; then write it back out: -(let ((p (open-file file "r+")) - (lines '())) - ;; read in lines - (do ((line (read-line p) (read-line p))) - ((eof-object? line)) - (set! lines (cons line lines))) - ;; modify (reverse lines) - (seek p 0 SEEK_SET) - ;; write out lines - (for-each (lambda (x) (write-line x p)) lines) - ;; truncate the file - (truncate-file p) - (close p)) - -(let ((p (open-file "foo" "r+")) - (lines '()) - (date (date->string (current-date)))) - (do ((line (read-line p 'concat) (read-line p 'concat))) - ((eof-object? line)) - (set! lines (cons line lines))) - (seek p 0 SEEK_SET) - (for-each - (lambda (x) - (regexp-substitute/global p "DATE" x 'pre date 'post)) - (reverse lines)) - (truncate-file p) - (close p)) - -;; @@PLEAC@@_7.11 -(define p (open-file path "r+")) -(flock p LOCK_EX) -;; update the file, then... -(close p) - -;; to increment a number in a file -(define p (open "numfile" (logior O_RDWR O_CREAT))) -(flock p LOCK_EX) -;; Now we have acquired the lock, it's safe for I/O -(let* ((obj (read p)) - (num (if (eof-object? obj) 0 obj))) - (seek p 0 SEEK_SET) - (truncate-file p) - (write (1+ num) p) - (newline p)) -(close p) - -;; @@PLEAC@@_7.12 -;; use force-output -(force-output p) - -;; flush all open ports -(flush-all-ports) - -;; @@PLEAC@@_7.13 -;; use select -(select inputs outputs exceptions seconds) -(select (list p1 p2 p3) '() '()) - -(let* ((nfound (select (list inport) '() '())) - (inputs (car nfound))) - (if (not (null? inputs)) - (let ((line (read-line inport))) - (format #t "I read ~A\n" line)))) - -;; or use char-ready? if you only need a single character -(if (char-ready? p) - (format #t "I read ~A\n" (read-char p))) - -;; @@PLEAC@@_7.14 -;; use the O_NONBLOCK option with open -(define modem (open "/dev/cua0" (logior O_RDWR O_NONBLOCK))) - -;; or use fcntl if you already have a port -(let ((flags (fcntl p F_GETFD))) - (fcntl p F_SETFD (logior flags O_NONBLOCK))) - -;; @@PLEAC@@_7.15 -;; use stat -(let ((buf (make-string (stat:size (stat p))))) - (read-string!/partial buf input)) - -;; @@PLEAC@@_7.16 -;; not needed - ports are first class objects - -;; @@PLEAC@@_7.18 -;; use for-each on the list of ports: -(for-each (lambda (p) (display stuff-to-print p)) port-list) - -;; or, if you don't want to keep track of the port list and know you -;; want to print to all open output ports, you can use port-for-each: -(port-for-each (lambda (p) (if (output-port? p) (display stuff p)))) - -;; @@PLEAC@@_7.19 -;; use fdopen: -(define p (fdopen num mode)) -(define p (fdopen 3 "r")) - -(define p (fdopen (string->number (getenv "MHCONTEXTFD")) "r")) -;; after processing -(close p) - -;; @@PLEAC@@_7.20 -;; ports are first class objects and can be aliased and passed around -;; like any other non-immediate variables: -(define alias original) -(define old-in (current-input-port)) - -;; or you can open two separate ports on the same file: -(define p1 (open-input-file path)) -(define p2 (open-input-file path)) - -;; or use fdopen: -(define copy-of-p (fdopen (fileno p) mode)) - -(define old-out (current-output-port)) -(define old-err (current-error-port)) - -(define new-out (open-output-file "/tmp/program.out")) - -(set-current-output-port new-out) -(set-current-error-port new-out) - -(system joe-random-program) - -(close new-out) - -(set-current-output-port old-out) -(set-current-error-port old-out) - -;; @@PLEAC@@_8.0 -;; open the file and loop through the port with read-line: -(let ((p (open-input-file file))) - (do ((line (read-line p) (read-line p))) - ((eof-object? line)) - (format #t "~A\n" (string-length line))) - (close p)) - -;; you can use with-input-from-file to temporarily rebind stdin: -(with-input-from-file file - (lambda () - (do ((line (read-line) (read-line))) - ((eof-object? line)) - (format #t "~A\n" (string-length line))))) - -;; or define a utility procedure to do this -(define (for-each-line proc file) - (with-input-from-file file - (lambda () - (do ((line (read-line) (read-line))) - ((eof-object? line)) - (proc line))))) -(for-each-line (lambda (x) (format #t "~A\n" (string-length line))) file) - -;; read in the file as a list of lines -(define (read-lines file) - (let ((ls '())) - (with-input-from-file file - (lambda () - (do ((line (read-line) (read-line))) - ((eof-object? line)) - (set! ls (cons line ls))) - (reverse ls))))) - -;; read in the file as a single string -(define (file-contents file) - (call-with-input-file file - (lambda (p) - (let* ((size (stat:size (stat p))) - (buf (make-string size))) - (read-string!/partial buf p) - buf)))) - -;; use display to print human readable output -(display '("One" "two" "three") port) ; (One two three) -(display "Baa baa black sheep.\n") ; Sent to default output port - -;; use write to print machine readable output -(write '("One" "two" "three") port) ; ("One" "two" "three") - -;; use (ice-9 rw) to read/write fixed-length blocks of data: -(use-modules (ice-9 rw)) -(let ((buffer (make-string 4096))) - (read-string!/partial buffer port 4096)) - -;; truncate-file -(truncate-file port length) ; truncate to length -(truncate-file port) ; truncate to current pos - -;; ftell -(define pos (ftell port)) -(format #t "I'm ~A bytes from the start of DATAFILE.\n" pos) - -;; seek -(seek log-port 0 SEEK_END) ; seek to end -(seek data-port pos SEEK_SET) ; seek to pos -(seek out-port -20 SEEK_CUR) ; seek back 20 bytes - -;; block read/write -(use-modules (ice-9 rw)) -(write-string/partial mystring data-port (string-length mystring)) -(read-string!/partial block 256 5) - -;; @@PLEAC@@_8.1 -(let ((rx (make-regexp "(.*)\\\\$"))) ; or "(.*)\\\\\\s*$" - (with-input-from-file file - (lambda () - (let loop ((line (read-line))) - (if (not (eof-object? line)) - (let ((m (regexp-exec rx line)) - (next (read-line))) - (cond ((and m (not (eof-object? next))) - (loop (string-append (match:substring m 1) next))) - (else - ;; else process line here, then recurse - (loop next))))))))) - -;; @@PLEAC@@_8.2 -(do ((line (read-line p) (read-line p)) - (i 0 (1+ i))) - ((eof-object? line) i)) - -;; fastest way if your terminator is a single newline -(use-modules (ice-9 rw) (srfi srfi-13)) -(let ((buf (make-string (expt 2 16))) - (count 0)) - (do ((len (read-string!/partial buf p) (read-string!/partial buf p))) - ((not len) count) - (set! count (+ count (string-count buf #\newline 0 len))))) - -;; or use port-line -(let loop ((line (read-line p))) - (if (eof-object? line) (port-line p) (loop (read-line p)))) - -;; @@PLEAC@@_8.3 -;; default behaviour of string-tokenize is to split on whitespace: -(use-modules (srfi srfi-13)) -(let loop ((line (read-line p))) - (cond ((not eof-object? line) - (for-each some-function-of-word (string-tokenize line)) - (loop (read-line p))))) - -(let ((table (make-hash-table 31))) - (let loop ((line (read-line p))) - (cond ((not (eof-object? line)) - (for-each - (lambda (w) (hash-set! table w (1+ (hash-ref table w 0)))) - (string-tokenize line)) - (loop (read-line p))))) - (hash-fold (lambda (k v p) (format #t "~5D ~A\n" v k)) #f table)) - -;; @@PLEAC@@_8.4 -;; build up the list the reverse it or fold over it: -(define lines (read-lines file)) -(for-each (lambda (word) do-something-with-word) (reverse lines)) -(fold (lambda (word acc) do-something-with-word) #f lines) - -;; @@PLEAC@@_8.5 -;; save the current position and reseek to it -(define (tail file) - (call-with-input-file file - (lambda (p) - (let loop ((line (read-line p))) - (cond ((eof-object? line) - (sleep sometime) - (let ((pos (ftell p))) - (seek p 0 SEEK_SET) - (seek p pos SEEK_SET))) - (else - ;; process line - )) - (loop (read-line p)))))) - -;; @@PLEAC@@_8.6 -(let ((rand-line #f)) - (let loop ((line (read-line p))) - (cond ((not (eof-object? line)) - (if (= 0 (random (port-line p))) - (set! rand-line line)) - (loop (read-line p))))) - ;; rand-line is the random line - ) - -;; @@PLEAC@@_8.7 -(define (shuffle list) - (let ((v (list->vector list))) - (do ((i (1- (vector-length v)) (1- i))) - ((< i 0) (vector->list v)) - (let ((j (random (1+ i)))) - (cond ((not (= i j)) - (let ((temp (vector-ref v i))) - (vector-set! v i (vector-ref v j)) - (vector-set! v j temp)))))))) - -(define rand-lines (shuffle (read-lines file)) - -;; @@PLEAC@@_8.8 -;; looking for line number desired-line-number -(do ((line (read-line p) (read-line p))) - ((= ((port-line p) desired-line-number) line))) -;; or read into a list -(define lines (read-lines file)) -(list-ref lines desired-line-number) - -;; @@INCOMPLETE@@ -; (define (build-index data-file index-file) -; ) - -; (define (line-with-index data-file index-file line-number) -; ) - -;; @@PLEAC@@_8.9 -;; use string-tokenize with an appropriate character set -(use-modules (srfi srfi-13) (srfi srfi-14)) -(define fields (string-tokenize line (string->charset "+-"))) -(define fields (string-tokenize line (string->charset ":"))) -(define fields (string-tokenize line)) - -;; @@PLEAC@@_8.10 -(let ((p (open-file file "r+"))) - (let ((pos 0)) - (let loop ((line (read-line p))) - (cond ((eof-object? (peek-char p)) - (seek p 0 SEEK_SET) - (truncate-file p pos) - (close p)) - (else - (set! pos (ftell p)) - (loop (read-line p))))))) - -;; @@PLEAC@@_8.11 -;; no equivalent - don't know how Guile under windows handles this - -;; @@PLEAC@@_8.12 -(let* ((address (* recsize recno)) - (buf (make-string recsize))) - (seek p address SEEK_SET) - (read-string!/partial buf p) - buf) - -;; @@PLEAC@@_8.13 -(let* ((address (* recsize recno)) - (buf (make-string recsize))) - (seek p address SEEK_SET) - (read-string!/partial buf p) - ;; modify buf, then write back with - (seek p address SEEK_SET) - (write-string/partial buf p) - (close p)) - -;; @@INCOMPLETE@@ -;; weekearly - -;; @@PLEAC@@_8.14 -(seek p addr SEEK_SET) -(define str (read-delimited (make-string 1 #\nul) p)) - -#!/usr/local/bin/guile -s -!# -;; bgets -- get a string from an address in a binary file -(use-modules (ice-9 format)) - -(define args (cdr (command-line))) -(define file (car args)) -(define addrs (map string->number (cdr args))) -(define delims (make-string 1 #\nul)) - -(call-with-input-file file - (lambda (p) - (for-each - (lambda (addr) - (seek p addr SEEK_SET) - (format #t "~X ~O ~D ~S\n" addr addr addr - (read-delimited delims p))) - addrs))) - -;; @@INCOMPLETE@@ -;; strings - -;; @@PLEAC@@_9.0 -(define entry (stat "/usr/bin/vi")) -(define entry (stat "/usr/bin")) -(define entry (stat port)) - -(use-modules (ice-9 posix)) - -(define inode (stat "/usr/bin/vi")) -(define ctime (stat:ctime inode)) -(define size (stat:size inode)) - -(define F (open-input-file filename)) -;; no equivalent - what defines -T? -; unless (-s F && -T _) { -; die "$filename doesn't have text in it.\n"; -; } - -(define dir (opendir "/usr/bin")) -(do ((filename (readdir dir) (readdir dir))) - ((eof-object? filename)) - (format #t "Inside /usr/bin is something called ~A\n" filename)) -(closedir dir) - -;; @@PLEAC@@_9.1 -(define inode (stat filename)) -(define readtime (stat:atime inode)) -(define writetime (stat:mtime inode)) - -(utime newreadtime newwritetime filename) - -(define seconds-per-day (* 60 60 24)) -(define inode (stat file)) -(define atime (stat:atime inode)) -(define mtime (stat:mtime inode)) -(set! atime (- atime (* 7 seconds-per-day))) -(set! mtime (- mtime (* 7 seconds-per-day))) -(utime file atime mtime) - -;; mtime is optional -(utime file (current-time)) -(utime file (stat:atime (stat file)) (current-time)) - -#!/usr/local/bin/guile -s -!# -;; uvi - vi a file without changing its access times - -(define file (cadr (command-line))) -(define inode (stat file)) -(define atime (stat:atime inode)) -(define mtime (stat:mtime inode)) -(system (string-append (or (getenv "EDITOR") "vi") " " file)) -(utime file atime mtime) - -;; @@PLEAC@@_9.2 -(delete-file file) - -(let ((count 0)) - (for-each - (lambda (x) - (catch #t - (lambda () (delete-file x) (set! count (1+ count))) - (lambda (err . args) #f))) - file-list) - (if (not (= count (length file-list))) - (format (current-error-port) "could only delete ~A of ~A files" - count (length file-list)))) - -;; @@PLEAC@@_9.3 -;; use builtin copy-file -(copy-file oldfile newfile) -(rename-file oldfile newfile) - -;; or do it by hand (clumsy, error-prone) -(use-modules (ice-9 rw) (ice-9 posix)) -(with-input-from-file oldfile - (lambda () - (call-with-output-file newfile - (lambda (p) - (let* ((inode (stat oldfile)) - (blksize (if inode (stat:size inode) 16384)) - (buf (make-string blksize))) - (let loop ((len (read-string!/partial buf))) - (cond ((and len (> len 0)) - (write-string/partial buf p 0 len) - (loop (read-string!/partial buf)))))))))) - -;; or call out to the system (non-portable, insecure) -(system (string-append "cp " oldfile " " newfile)) ; unix -(system (string-append "copy " oldfile " " newfile)) ; dos, vms - -;; @@PLEAC@@_9.4 -;; use a hash lookup of inodes -(use-modules (ice-9 posix)) -(let ((seen (make-hash-table 31))) - (for-each - (lambda (file) - (let* ((stats (stat file)) - (key (cons (stat:dev stats) (stat:ino stats))) - (val (hash-ref seen key 0))) - (cond ((= val 0) - ;; do something with new file - )) - (hash-set! seen key (1+ val)))) - file-names)) - -(let ((seen (make-hash-table 31))) - (for-each - (lambda (file) - (let* ((stats (stat file)) - (key (cons (stat:dev stats) (stat:ino stats))) - (val (hash-ref seen key '()))) - (hash-set! seen key (cons file val)))) - file-names) - (hash-fold - (lambda (key value prior) - ;; process key == (dev . inode), value == list of filenames - ) - '() seen)) - -;; @@PLEAC@@_9.5 -;; use opendir, readdir, closedir -(let ((p (opendir dir))) - (let loop ((file (readdir p))) - (if (eof-object? file) - (close p) - ;; do something with file - ))) - -;; or define a utility function for this -(define (directory-files dir) - (if (not (access? dir R_OK)) - '() - (let ((p (opendir dir))) - (do ((file (readdir p) (readdir p)) - (ls '())) - ((eof-object? file) (closedir p) (reverse! ls)) - (set! ls (cons file ls)))))) - -;; to skip . and .. -(cddr (directory-files dir)) - -;; probably better to implement full Emacs style directory-files -(use-modules (ice-9 posix)) -(define plain-files - (let ((rx (make-regexp "^\\."))) - (lambda (dir) - (sort (filter (lambda (x) (eq? 'regular (stat:type (stat x)))) - (map (lambda (x) (string-append dir "/" x)) - (remove (lambda (x) (regexp-exec rx x)) - (cddr (directory-files dir))))) - string<)))) - -;; @@PLEAC@@_9.6 -(define (glob->regexp pat) - (let ((len (string-length pat)) - (ls '("^")) - (in-brace? #f)) - (do ((i 0 (1+ i))) - ((= i len)) - (let ((char (string-ref pat i))) - (case char - ((#\*) (set! ls (cons "[^.]*" ls))) - ((#\?) (set! ls (cons "[^.]" ls))) - ((#\[) (set! ls (cons "[" ls))) - ((#\]) (set! ls (cons "]" ls))) - ((#\\) - (set! i (1+ i)) - (set! ls (cons (make-string 1 (string-ref pat i)) ls)) - (set! ls (cons "\\" ls))) - (else - (set! ls (cons (regexp-quote (make-string 1 char)) ls)))))) - (string-concatenate (reverse (cons "$" ls))))) - -(define (glob pat dir) - (let ((rx (make-regexp (glob->regexp pat)))) - (filter (lambda (x) (regexp-exec rx x)) (directory-files dir)))) - -(define files (glob "*.c" ".")) -(define files (glob "*.[ch]" ".")) - -;; Not sure if the Schwartzian Transform would really be more -;; efficient here... perhaps with a much larger directory where very -;; few files matched. -(define dirs (filter - (lambda (x) (eq? 'directory (stat:type (stat x)))) - (map (lambda (x) (string-append dir "/" x)) - (sort (filter (lambda (x) (string-match "^[0-9]+$" x)) - (directory-files dir)) - (lambda (a b) - (< (string->number a) (string->number b))))))) - -;; @@PLEAC@@_9.7 -(define (find proc . dirs) - (cond ((pair? dirs) - (for-each proc (map (lambda (x) (string-append (car dirs) "/" x)) - (directory-files (car dirs)))) - (apply find proc (cdr dirs))))) - -(find (lambda (x) (format #t "~A~A\n" x - (if (equal? (stat:type (stat x)) 'directory) - "/" ""))) ".") - -(define saved-size -1) -(define saved-name "") -(define (biggest file) - (let ((stats (stat file))) - (if (eq? (stat:type stats) 'regular) - (let ((size (stat:size (stat file)))) - (cond ((> size saved-size) - (set! saved-size size) - (set! saved-name file))))))) -(apply find biggest (cdr (command-line))) -(format #t "Biggest file ~A in ~A is ~A bytes long.\n" - saved-name (cdr (command-line)) saved-size) - -#!/usr/local/bin/guile -s -!# -;; fdirs - find all directories -(define (print-dirs f) - (if (eq? (stat:type (stat f)) 'directory) - (write-line f))) -(apply find print-dirs (cdr (command-line))) - -;; @@PLEAC@@_9.8 -#!/usr/local/bin/guile -s -!# -;; rmtree - remove whole directory trees like rm -f -(define (finddepth proc . dirs) - (cond ((pair? dirs) - (apply finddepth proc (cdr dirs)) - (for-each proc (map (lambda (x) (string-append (car dirs) "/" x)) - (directory-files (car dirs))))))) -(define (zap f) - (let ((rm (if (eq? (stat:type (stat f)) 'directory) rmdir delete-file))) - (format #t "deleting ~A\n" f) - (catch #t - (lambda () (rm f)) - (lambda args (format #t "couldn't delete ~A\n" f))))) -(let ((args (cdr (command-line)))) - (if (null? args) - (error "usage: rmtree dir ..\n") - (apply finddepth zap args))) - -;; @@PLEAC@@_9.9 -(for-each - (lambda (file) - (let ((newname (function-of file))) - (catch #t - (lambda () (rename-file file newname)) - (lambda args (format (current-error-port) - "couldn't rename ~A to ~A\n" file newname))))) - names) - -#!/usr/local/bin/guile -s -!# -;; rename - Guile's filename fixer -(use-modules (ice-9 regex)) ; not needed, but often useful here -(define args (cdr (command-line))) -(if (null? args) (error "usage: rename expr [files]\n")) -(define proc (eval-string (car args))) -(for-each - (lambda (old) - (let ((new (proc old))) - (if (not (string=? old new)) - (catch #t - (lambda () (rename-file old new)) - (lambda args (format (current-error-port) - "couldn't rename ~A to ~A\n" old new)))))) - (cdr args)) - -;; command-line examples: -;; rename '(lambda (x) (regexp-substitute/global #f "\\.orig\$" x (quote pre)))' *.orig -;; rename string-downcase * -;; rename '(lambda (x) (if (string-match "^Make" x) x (string-downcase x)))' * -;; rename '(lambda (x) (string-append x ".bad"))' *.pl -;; rename '(lambda (x) (format #t "~a: ") (read-line))' * - -;; @@PLEAC@@_9.10 -(define base (basename path)) -(define base (dirname path ext)) -(define dir (dirname path)) - -(define path "/usr/lib/libc.a") -(define file (basename path)) -(define dir (dirname path)) - -(format #t "dir is ~A, file is ~A\n" dir file) - -(basename path ".a") ; libc - -(use-modules (ice-9 regex)) -(define (file-parse path . args) - (let* ((ext (if (null? args) "\\..*" (car args))) - (rx1 (string-append "^((.*)/)?(.*)?(" ext ")$")) - (rx2 (string-append "^((.*)/)?(.*)?()$"))) - (let ((m (or (string-match rx1 path) (string-match rx2 path)))) - (list (match:substring m 2) (match:substring m 3) - (match:substring m 4))))) - -(define (extension path . args) - (caddr (apply file-parse path args))) - -;; @@PLEAC@@_10.0 -; Note: Some of the examples will show code blocks in this style: -; -; (define -; ... code here ... -; ) -; -; This is not generally considered good style, and is not recommended; -; it is only used here to more clearly highlight block scope - -; By convention a 'global variable' i.e. a variable that is defined at -; the top-level, and as such, visible within any scope, is named with -; beginning and ending asterisks [and one to be used as a constant -; with beginning and ending plus signs] - -(define *greeted* 0) - -(define (hello) - (set! *greeted* (+ *greeted* 1)) - (print "hi there!, this procedure has been called" *greeted* "times")) - -(define (how-many-greetings) *greeted*) - -;; ------------ - -(hello) - -(define *greetings* (how-many-greetings)) - -(print "bye there!, there have been" *greetings* "greetings so far") - -;; @@PLEAC@@_10.1 -; Subroutine parameters are named [whether directly, or indirectly in -; the case of variable arguments - see next example]; this is the only -; means of access [This contrasts with languages like Perl and REXX which -; allow access to arguments via array subscripting, and function calls, -; respectively] -(define (hypotenuse side1 side2) - (sqrt (sum (* side1 side1) (* side2 side2)))) - -(define *diag* (hypotenuse 3 4)) - -;; ---- - -; 'other-sides' is the name of a list of containing any additional -; parameters. Note that a name is still used to access values -(define (hypotenuse side1 . other-sides) - (let ((all-sides (cons side1 other-sides))) - (for-each - (lambda (side) ...) - all-sides) - ...)) - -;; ---- - -(define *diag* (hypotenuse 3 4)) - -;; ---- - -; Possible to pack parameters into a single structure [e.g. list or -; array], and access values contained therein -(define (hypotenuse sides) - (let ((side1 (car sides)) (side2 (caar sides))) - (sqrt (sum (* side1 side1) (* side2 side2))))) - -;; ---- - -(define *args* '(3 4)) -(define *diag* (hypotenuse *args*)) - -;; ------------ - -; Parameters passed by reference, however, whether original object is -; modified depends on choice of functions used to manipulate them -; [most functions create copies and return these; mutating versions of -; same functions may also exist [see next example] -(define *nums* (vector 1.4 3.5 6.7)) - -(define (int-all vec) - (vector-map-in-order - (lambda (element) (inexact->exact (round element))) - vec)) - -; Copy created -(define *ints* (int-all *nums*)) - -(print *nums*) -(print *ints*) - -;; ---- - -(define *nums* (vector 1.4 3.5 6.7)) - -(define (trunc-all vec) - (array-map-in-order! - (lambda (element) (inexact->exact (round element))) - vec)) - -; Original modified -(trunc-all *nums*) - -;; @@PLEAC@@_10.2 -; Scheme is lexically-scoped; variables defined within a block are -; visible only within that block. Whilst nested / subordinate blocks -; have access to those variables, neither the caller, nor any called -; procedures have direct access to those same variables - -(define (some-func parm1 parm2 parm3) - ... paramaters visible here ... - - (let ((var1 ...) (var2 ...) (var3 ...) ...) - ... parameters also visible here, but variables, 'var1' etc - only visible within this block ... - ) - ... paramaters also visible here, but still within procedure body ... -) - -;; ------------ - -; Top-level definitions - accessable globally -(define *name* (caar (command-line))) -(define *age* (cadr (command-line))) - -(define *start* (fetch-time)) - -;; ---- - -; Lexical binding - accessable only within this block -(let ((name (caar (command-line))) - (age (cadr (command-line))) - (start (fetch-time))) - ... variables only visible here ... -) - -;; ------------ - -(define *pair* '(1 . 2)) - -; 'a' and 'b' need to be dereferenced and separately defined [Also, -; since globally defined, should really be named, '*a*', '*b*', etc] -(define a (car *pair*)) -(define b (cdr *pair*)) -(define c (fetch-time)) - -(define (run-check) - ... do something with 'a', 'b', and 'c' ... -) - -(define (check-x x y) - (if (run-check) - (print "got" x))) - -; Calling 'check-x'; 'run-check' has access to 'a', 'b', and 'c' -(check-x ...) - -;; ---- - -; If defined within a block, variables 'a', 'b', and 'c' are no longer -; accessable anywhere except that scope. Therefore, 'run-check' as -; defined above can no longer access these variables [in fact, the code -; will fail because variables 'a', 'b', and 'c' do not exist when -; 'run-check' is defined] -(let ((a (car *pair*)) - (b (cdr *pair*)) - (c (fetch-time))) - ... - (check-x ...) - ... -) - -;; ---- - -; The procedures, 'run-check' and 'check-x' are defined within the -; same block as variables, 'a', 'b', and 'c', so have direct access to -; them -(let* ((a (car *pair*)) - (b (cdr *pair*)) - (c (fetch-time)) - - (run-check - (lambda () ... do something with 'a', 'b', and 'c' ...)) - - (check-x - (lambda (x y) - (if (run-check) - (print "got" x)))) ) - ... - (check-x ...) - ... -) - -;; @@PLEAC@@_10.3 -; Ordinarily, a variable must be initialised when it is defined, -; whether at the top-level: -(define *variable* 1) - -; ... or within a 'let' binding -(let* ((variable 1) - (mysub - (lambda () ... accessing 'variable' ...))) - ... do stuff ... -) - -; However, since Scheme allows syntactic extensions via 'macros' [of -; which there are two varieties: hygenic and LISP-based], it is -; possible to create new forms which alter this behaviour. For example, -; in this tutorial: http://home.comcast.net/~prunesquallor/macro.txt -; there is a macro implementation equivalent to 'let, 'called, -; 'bind-values', which allows variables to be defined without initial -; values; an example follows: - -; Initialisation values for 'a' and 'b' not specified -(bind-values ((a) b (c (+ *global* 5))) - ... do stuff ... -) - -; In Scheme many things are possible, but not all those things are -; offered as standard features :) ! - -;; ------------ - -(let* ((counter 42) - (next-counter - (lambda () (set! counter (+ counter 1)) counter)) - (prev-counter - (lambda () (set! counter (- counter 1)) counter))) - - ... do stuff with 'next-counter' and 'prev-counter' ... -) - -;; ---- - -; A more complete, and practical, variation of the above code: - -; 'counter' constructor -(define (make-counter start) - (let* ((counter 42) - (next-counter - (lambda () (set! counter (+ counter 1)) counter)) - (prev-counter - (lambda () (set! counter (- counter 1)) counter))) - (lambda (op) - (cond - ((eq? op 'prev) prev-counter) - ((eq? op 'next) next-counter) - (else (lambda () (display "error:counter"))) )))) - -; Interface functions to 'counter' functionality -(define (prev-counter counter) (apply (counter 'prev) '())) -(define (next-counter counter) (apply (counter 'next) '())) - -; Create a 'counter' -(define *counter* (make-counter 42)) - -; Use the 'counter' ... -(print (prev-counter *counter*)) -(print (prev-counter *counter*)) -(print (next-counter *counter*)) - -;; @@PLEAC@@_10.4 -; Scheme interpreters generally provide a rich collection of procedure -; metadata, as well as easy access to a program's current 'execution -; state'. Put simply, provision of a powerful, highly customisable -; debugging / tracing facility is almost taken for granted. However, using -; it to perform as trivial a task as obtaining the current function name -; is less than trivial [at least it seems so in Guile] as it appears to -; require quite some setup work. Additionally, the documentation talks -; about facilities e.g. trap installation, that don't appear to be -; available [at least, I couldn't find them]. -; -; Example below uses in-built debugging facilities to dump a backtrace -; to a string port and extract the caller's name from the resulting -; string. Not exactly elegant ... - -; Execute using: guile --debug ... else no useful output seen -(use-modules (ice-9 debug)) - -(define (child num) - ; Create stack [i.e. activation record] object, discarding - ; irrelevant frames - (let ((s (make-stack #t 3 1)) - (trace-string-port (open-output-string)) - (parent-name "")) - - ; Dump backtrace to string port - (display-backtrace s trace-string-port) - - ; Extract caller's name from backtrace data - ; [shamefully crude - don't do this at home !] - (set! parent-name - (caddr (string-tokenize - (cadr (string-split - (get-output-string trace-string-port) - #\newline)) - char-set:graphic))) - - ; Who's your daddy ? - (print parent-name))) - -; Each invocation of 'child' should see 'parent' displayed as -; the caller -(define (parent) - (child 1) - (child 2) - (child 3)) - -(parent) - -;; @@PLEAC@@_10.5 -; Procedure parameters are references to entities, so there is no special -; treatment required. If an argument represents a mutable object such -; as an array, then care should be taken to not mutate the object within -; the procedure, or a copy of the object be made and used - -(array-diff *array1* *array2*) - -;; ------------ - -(define (add-vector-pair x y) - (let* ((vector-length (vector-length x)) - (new-vec (make-vector vector-length))) - (let loop ((i 0)) - (cond - ((= i vector-length) new-vec) - (else - (vector-set! new-vec i (+ (vector-ref x i) (vector-ref y i))) - (loop (+ i 1)) ))) )) - -;; ---- - -(define *a* '#(1 2)) -(define *b* '#(5 8)) - -(define *c* (add-vector-pair *a* *b*)) - -(print *c*) - -;; ---- - - ... - - (if (and (vector? a1) (vector? a2)) - (print (add-vector-pair a1 a2)) - ;else - (print "usage: add-vector-pair a1 a2")) - - ... - -;; @@PLEAC@@_10.6 -; AFAIK there is no Scheme equivalent to Perl's 'return context' where -; it is possible to use language primitives [e.g. 'wantarray'] to -; dynamically specify the return type of a procedure. It is, however, -; possible to: -; * Return one of several types from a procedure, whether based on -; processing results [e.g. 'false' on error, numeric on success], or -; perhaps specified via control argument -; * Check procedure return type and take appropriate action - -(define (my-sub) - (let* ((datatype (vector '() 7 '(1 2 3) "abc" 'sym))) - (vector-ref datatype (random (vector-length datatype))) )) - -;; ---- - -; '*result*' is bound to a randomly chosen datatype -(define *result* (my-sub)) - -(cond - ; It is common to return an empty list to represent 'void' - ((null? *result*) (print "void context")) - - ((list? *result*) (print "list context")) - ((number? *result*) (print "scalar context")) - ((string? *result*) (print "string context")) - ((symbol? *result*) (print "atom context")) - (else (print "Unknown type"))) - -;; @@PLEAC@@_10.7 -; Keyword parameters are fully supported. Note that pairs have -; replaced Perl strings in the examples since they are easier to -; manipulate - -(use-modules (ice-9 optargs)) - -(define* (the-func #:key (increment (cons 10 's)) - (finish (cons 0 'm)) - (start (cons 0 'm))) - (print increment) - (print finish) - (print start)) - -(the-func) -(the-func #:increment (cons 20 's) #:start (cons 5 'm) #:finish (cons 30 'm)) -(the-func #:start (cons 5 'm) #:finish (cons 30 'm)) -(the-func #:finish (cons 30 'm)) -(the-func #:start (cons 5 'm) #:increment (cons 20 's)) - -;; @@PLEAC@@_10.8 -;; @@INCOMPLETE@@ -;; @@INCOMPLETE@@ - -;; @@PLEAC@@_10.9 -; The return of multiple values, whether arrays or other items, may be -; achieved via: -; * Packaging return items as a single list, structure or array, an -; approach which is usable across many languages, though can be -; clunky because the procedure caller must manually extract all -; items -; * The 'values' procedure, a more Schemish idiom, is usually used in -; conjunction with the 'call-with-values' procedure [the former combines -; multiple values, the latter captures and cleanly extracts them]. It -; comes into its own, however, when used to create a 'macro' [an -; extension to the Scheme language] like 'let-values', a variation of -; the 'let' form that allows multiple return values to be placed directly -; into separate variables. Implementation shown here is from 'The -; Scheme Programming Language, 3rd Edition' by R. Kent Dybvig, though -; there exists a more standard implementation in SRFI-11. There is also -; the 'receive' functionality accessable via: (use-modules (ice-9 receive)) - -; [1] Implementation of 'somefunc' returning muliple values via packaging -; items within a list that is returned -(define (somefunc) - (let ((a (make-vector 5)) - (h (make-hash-table 5))) - (list a h) )) - -; Retrieving procedure values requires that the return list be captured -; and each contained item separately extracted ['let*' used in place of -; 'let' to ensure correct retrieval order] -(let* ((return-list (somefunc)) - (a (car return-list)) - (b (cadr return-list))) - - ... do something with 'a' and 'b' ...) - -;; ---------------------------- - -; [2] Implementation of 'somefunc' returning muliple values using the -; 'values' procedure - -(use-syntax (ice-9 syncase)) - -; 'let-values' from: http://www.scheme.com/tspl3/syntax.html#fullletvalues -(define-syntax let-values - (syntax-rules () - ((_ () f1 f2 ...) (let () f1 f2 ...)) - ((_ ((fmls1 expr1) (fmls2 expr2) ...) f1 f2 ...) - (lvhelp fmls1 () () expr1 ((fmls2 expr2) ...) (f1 f2 ...))))) - -(define-syntax lvhelp - (syntax-rules () - ((_ (x1 . fmls) (x ...) (t ...) e m b) - (lvhelp fmls (x ... x1) (t ... tmp) e m b)) - ((_ () (x ...) (t ...) e m b) - (call-with-values - (lambda () e) - (lambda (t ...) - (let-values m (let ((x t) ...) . b))))) - ((_ xr (x ...) (t ...) e m b) - (call-with-values - (lambda () e) - (lambda (t ... . tmpr) - (let-values m (let ((x t) ... (xr tmpr)) . b))))))) - -;; ------------ - -(define (somefunc) - (let ((a (make-vector 5)) - (h (make-hash-table 5))) - (values a h) )) - -; Multiple return items placed directly into separate variables -(let-values ( ((a h) (somefunc)) ) - (print (array? a)) - (print (hash-table? h))) - -;; @@PLEAC@@_10.10 -; Like most modern languages, Scheme supports exceptions for handling -; failure, something that will be illustrated in another section. However, -; conventions exist as to the choice of value used to indicate failure: -; * Empty list i.e. '() is often used for this task, as is it's string -; counterpart, "", the empty string -; * Return false i.e. #f to indicate failed / not found etc, and a valid -; value otherwise [e.g. testing set membership: if not a member, return -; #f, but if a member, return the item itself rather than #t] - -; Return empty list as indicating 'failure' -(define (sub-failed) '()) - -;; ------------ - -(define (look-for-something) - ... - (if (something-found) - ; Item found, return the item - something - ;else - ; Not found, indicate failure - #f - )) - -;; ---- - -(if (not (look-for-something)) - (print "Item could not be found ...") -;else - ; do something with item ... - ... - -;; ------------ - -; An interesting variation on returning #f as a failure indicator is -; in using the, 'false-if-exception' procedure whereby a procedure is -; executed, any exceptions it may throw caught, and handled by simply -; returning #f. See example in section on Exception Handling below. - -;; ------------ - -(define (ioctl) ... #f) - -(or (ioctl) (begin (print "can't ioctl") (exit 1))) - -;; @@PLEAC@@_10.11 -; Whether Scheme is seen to support prototyping depends on the definition -; of this term used: -; * Prototyping along the lines used in Ada, Modula X, and even C / C++, -; in which a procedure's interface is declared separately from its -; implementation, is *not* supported -; * Prototyping in which, as part of the procedure definition, parameter -; information must be supplied. This is a requirement in Scheme in that -; parameter number and names must be given, though there is no need to -; supply type information [optional and keyword parameters muddy the -; waters somewhat, but the general principle applies] - -(define (func-with-no-arg) ...) -(define (func-with-one-arg arg1) ...) -(define (func-with-two-arg arg1 arg2) ...) -(define (func-with-three-arg arg1 arg2 arg3) ...) - -;; @@PLEAC@@_10.12 -; Not exactly like the Perl example, but a way of immediately -; exiting from an application -(define (die msg . error-code) - (display (string-append msg "\n") (current-error-port)) - (exit (if (null? error-code) 1 (car error-code)))) - -;; ---- - -(die "some message") - -;; ------------ - -; An exception is thrown via 'throw'; argument must be a symbol -(throw 'some-exception) - -; Invalid attempts - these, themselves force a 'wrong-type-arg -; exception to be thrown -(throw #t) -(throw "my message") -(throw 1) - -;; ------------ - -; Example of a 'catch all' handler - 'proc' is executed, and any -; exception thrown is handled, in this case by simply returning false -(define (false-if-exception proc) - (catch #t - proc - (lambda (key . args) #f))) - -(define (func) - (print "Starting 'func' ...") - (throw 'myexception 1) - (print "Leaving 'func' ...")) - -;; ---- - -(if (not (false-if-exception main)) - (print "'func' raised an exception") - (print "'func' executed normally")) - -;; ------------ - -; More typical exception handling example in which: -; * 'func' is executed -; * 'catch' either: -; - returns return value of 'func' [if successful] -; - executes handler(s) - -(define (full-moon-exception-handler key . args) - (print "I'm executing after stack unwound !")) - -(define (full-moon-exception-prewind-handler key . args) - (print "I'm executing with the stack still intact !")) - -(define (func) - (print "Starting 'func' ...") - (throw 'full-moon-exception 1) - (print "Leaving 'func' ...")) - -(catch 'full-moon-exception - func - full-moon-exception-handler - full-moon-exception-prewind-handler) - -;; @@PLEAC@@_10.13 -; Scheme is lexically-scoped, so same-name, higher-level variables -; are merely shadowed in lower-level blocks. Upon exit from those -; blocks the higher-level values are again available. Therefore, the -; saving of global variables, as required by Perl, is not necessary - -; Global variable -(define age 18) - -; Procedure definition creates a closure - it captures the earlier -; version of, age', and will retain it -(define (func) - (print age)) - -(if (condition) - ; New 'local' variable created which acts to shadow the global - ; version - (let ((age 23)) - - ; Prints 23 because the global variable is shadowed within - ; this block - (print age) - - ; However, lexical-scoping ensures 'func' still accesses the - ; 'age' which was active when it was defined - (func) )) - -; The use of 'fluid-let' allows for similar behaviour to Perl's i.e. -; it mimics dynamic scope, but it does so cleanly in that once its -; scope ends any affected global variables are restored to previous -; values -(if (condition) - - ; This does not create a new 'local' variables but temporarily - ; sets the global variable, 'age' to 23 - (fluid-let ((age 23)) - - ; Prints 23 because it is accessing the global version of 'age' - (print age) - - ; Prints 23 because it is its lexically-scoped version of 'age' - ; that has its value altered, albeit temporarily - (func) )) - -;; @@PLEAC@@_10.14 -; Define two procedures, bind them to identifiers -(define (grow) (print "grow")) -(define (shrink) (print "shrink")) - -; Separate procedures executed -(grow) -(shrink) - -; Rebind identifier; now acts as alias for latter -(define grow shrink) - -; Same procedure executed in both cases -(grow) -(shrink) - -;; ------------ - -; As for previous except that rebinding is localised and -; ends once local scope exited -(let ((grow shrink)) - (grow) - (shrink)) - -;; ---------------------------- - -; Example of dynamically creating [from text data] and binding -; procedures. The example here is conceptually similar to the Perl -; example in that it makes use of an 'eval' type of facility to -; generate code from text. In Scheme such tasks are generally better -; dealt with using macros - -; List of procedure name / first argument pairs -(define *colours* - (list - '("red" . "baron") - '("blue" . "zephyr") - '("green" . "beret") - '("yellow" . "ribbon") - '("orange" . "county") - '("purple" . "haze") - '("violet" . "temper") )) - -; Build a series of procedures dynamically by traversing the -; *colours* list and obtaining: -; * Procedure name from first item of pair -; * Procedure argument from second item of pair -(for-each - (lambda (colour) - (let ((proc-string - (string-append - "(define " (car colour) " (lambda () " - "\"<FONT COLOR=" (car colour) ">" (cdr colour) - "</FONT>\"))" ))) - (eval-string proc-string))) - *colours*) - -; Apply each of the dynamically-built procedures -(for-each - (lambda (colour) - (print (apply (string->procedure (car colour)) '()))) - *colours*) - -;; @@PLEAC@@_10.15 -; AFAICT Guile doesn't implement an AUTOLOAD facility in which a -; 'replacement' function is available should another one fail to -; load [though there is an autoload feature available with modules -; which is a load-on-demand facility aimed at conserving memory and -; speeding up initial program load time]. -; -; One might think it would be feasable, however, to use exception -; handling to provide roughly similar functionality: - -; Catch all exceptions -(catch #t - ; Undefined procedure, 'x' - x - ; Exception handler could load missing code ? - (lambda (key . args) ... )) - -; However, an undefined function call is reported as: -; -; ERROR: Unbound variable: ... -; -; and this situation doesn't appear to be user-trappable. -; - -;; @@PLEAC@@_10.16 -; Both implementations below are correct, and exhibit identical -; behaviour - -(define (outer arg) - (let* ((x (+ arg 35)) - (inner (lambda () (* x 19)))) - (+ x (inner)))) - -;; ---------------------------- - -(define (outer arg) - (let ((x (+ arg 35))) - (define (inner) (* x 19)) - (+ x (inner)))) - -;; @@PLEAC@@_10.17 -;; @@INCOMPLETE@@ -;; @@INCOMPLETE@@ - -;; @@PLEAC@@_13.0 -;; Guile OOP is in the (oop goops) module (based on CLOS). All -;; following sections assume you have (oop goops loaded). -(use-modules (oop goops)) -(define-class <data-encoder> ()) -(define obj (make <data-encoder>)) - -(define obj #(3 5)) -(format #t "~A ~A\n" (class-of obj) (array-ref obj 1)) -(change-class v <human-cannibal>) ; has to be defined -(format #t "~A ~A\n" (slot-ref obj stomach) (slot-ref obj name)) - -(slot-ref obj 'stomach) -(slot-set! obj 'stomach "Empty") -(name obj) -(set! (name obj) "Thag") - -;; inheritance -(define-class <lawyer> (<human-cannibal>)) - -(define lector (make <human-cannibal>)) -(feed lector "Zak") -(move lector "New York") - -;; @@PLEAC@@_13.1 -(define-class <my-class> () - (start #:init-form (current-time)) - (age #:init-value 0)) - -;; classes must have predefined slots, but you could use one as a -;; dictionary: -(define-class <my-class> () - (start #:init-form (current-time)) - (age #:init-value 0) - (properties #:init-value '())) -(define (initialize (m <my-class>) initargs) - (and-let* ((extra (memq #:extra initargs))) - (slot-set! m 'properties (cdr extra)))) - -;; @@PLEAC@@_13.2 -;; For smobs (external C objects), you can specify a callback to be -;; performed when the object is garbage collected with the C API -;; function `scm_set_smob_free'. This solves the problem of cleaning up -;; after external objects and connections. Guile doesn't use reference -;; count garbage collection, so circular data structures aren't a -;; problem. - -;; @@PLEAC@@_13.3 -;; either use slot-ref/set! -(slot-ref obj 'name) -(slot-set! obj 'name value) - -;; or define the class with accessors -(define-class <my-class> () - (name #:accessor name)) -(name obj) -(set! (name obj) value) - -;; or use getters/setters to implement read/write-only slots -(define-class <my-class> () - (name #:getter name) - (age #:setter age)) -(name obj) -(set! (age obj) value) - -;; or implement getters/setters manually -(define-method ((setter name) (obj <my-class>) value) - (cond ((string-match "[^-\\w0-9']" value) - (warn "funny characters in name")) - ((string-match "[0-9]" value) - (warn "numbers in name")) - ((not (string-match "\\w+\\W+\\w+" value)) - (warn "prefer multiword names")) - ((not (string-match "\\w" value)) - (warn "name is blank"))) - (slot-set! obj 'name (string-downcase value))) - -;; @@PLEAC@@_13.4 -;; override the initialize method -(define body-count 0) - -(define-method (initialize (obj <person>) initargs) - (set! body-count (1+ body-count)) - (next-method)) - -(define people '()) -(do ((i 1 (1+ i))) - ((> i 10)) - (set! people (cons (make <person>) people))) - -(format #t "There are ~A people alive.\n" body-count) - -(define him (make <person>)) -(slot-set! him 'gender "male") - -(define her (make <person>)) -(slot-set! her 'gender "female") - -;; use the :class allocation method -(slot-set! (make <fixed-array>) 'max-bounds 100) ; set for whole class -(define alpha (make <fixed-array>)) -(format #t "Bound on alpha is ~D\n" (slot-ref alpha 'max-bounds)) -;; 100 - -(define beta (make <fixed-array>)) -(slot-set! beta 'max-bounds 50) ; still sets for whole class -(format #t "Bound on alpha is ~D\n" (slot-ref alpha 'max-bounds)) -;; 50 - -;; defined simply as -(define-class <fixed-array> () - (max-bounds #:init-value 7 #:allocation #:class)) - -;; @@PLEAC@@_13.5 -;; Guile classes are basically structs by definition. If you don't care -;; about OO programming at all, you can use records, which are portable -;; across most Schemes. This is, however, an OO chapter so I'll stick -;; to classes. -(define-class <person> () name age peers) - -(define p (make <person>)) -(slot-set! p 'name "Jason Smythe") -(slot-set! p 'age 13) -(slot-set! p 'peers '("Wilbur" "Ralph" "Fred")) -(format #t "At age ~D, ~A's first friend is ~A.\n" - (slot-ref p 'age) (slot-ref p 'name) (car (slot-ref p 'peers))) - -;; For type-checking and field validation, define the setters -;; accordingly. -(define-class <person> () - (name #:accessor name) - (age #:accessor age)) - -(define-method ((setter age) (p <person>) a) - (cond ((not (number? a)) - (warn "age" a "isn't numeric")) - ((> a 150) - (warn "age" a "is unreasonable"))) - (slot-set! p 'age a)) - -(define-class <family> () - (head #:init-form (make <person>) #:accessor head) - (address #:init-value "" #:accessor address) - (members #:init-value '() #:accessor members)) - -(define folks (make <family>)) - -(define dad (head folks)) -(set! (name dad) "John") -(set! (age dad) 34) - -(format #t "~A's age is ~D\n" (name dad) (age dad)) - -;; Macros are the usual way to add syntactic sugar - -;; For all fields of the same type, let's use _ to mean the slot name in -;; the options expansion. -(define-macro (define-uniform-class name supers slots . options) - `(define-class ,name ,supers - ,@(map (lambda (s) (cons s (map (lambda (o) (if (eq? o '_) s o)) options))) - slots))) - -(define-uniform-class <card> (name color cost type release text) - #:accessor _ #:init-value "") - -;; If you *really* wanted to enforce slot types you could use something -;; like the above with the custom setter. To illustrate reversing -;; normal slot definition args, we'll reverse an init-value: -(define-macro (define-default-class name supers . default&slots) - `(define-class ,name ,supers - ,@(map (lambda (d&s) (list (cadr d&s) - #:init-value (car d&s) - #:accessor (cadr d&s))) - default&slots))) - -(define-default-class hostent () - ("" name) - ('() aliases) - ("" addrtype) - (0 length) - ('() addr-list)) - -;; Nothing special needed for Aliases - all names are equal -(define type addrtype) -(define-method (addr (h <hostent>)) - (car (addr-list h))) - -;; @@PLEAC@@_13.6 -;; A little more clear than the Perl, but not very useful. -(define obj1 (make <some-class>)) -(define obj2 (make (class-of obj1))) - -;; Use the shallow-clone or deep-clone methods to initialize from -;; another instance. -(define obj1 (make <widget>)) -(define obj2 (deep-clone obj1)) - -;; @@PLEAC@@_13.7 -;; Use eval or a variant to convert from a symbol or string to the -;; actual method. As shown in 13.5 above, methods are first class and -;; you'd be more likely to store the actual method than the name in a -;; real Scheme program. -(define methname "flicker") -(apply-generic (eval-string methname) obj 10) - -(for-each (lambda (m) (apply-generic obj (eval-string m))) - '("start" "run" "stop")) - -;; really, don't do this... -(define methods '("name" "rank" "serno")) -(define his-info - (map (lambda (m) (cons m (apply-generic (eval-string m) obj))) - methods)) - -;; same as this: -(define his-info (list (cons "name" (name obj)) - (cons "rank" (rank obj)) - (cons "serno" (serno obj)))) - -;; a closure works -(define fnref (lambda args (method obj args))) -(fnref 10 "fred") -(method obj 10 fred) - -;; @@PLEAC@@_13.8 -;; use is-a? -(is-a? obj <http-message>) -(is-a? <http-response> <http-message>)
\ No newline at end of file diff --git a/test/scanners/scheme/strange.expected.raydebug b/test/scanners/scheme/strange.expected.raydebug deleted file mode 100644 index 0319949..0000000 --- a/test/scanners/scheme/strange.expected.raydebug +++ /dev/null @@ -1,38 +0,0 @@ - -operator(()string<delimiter(")delimiter(")>operator(\)) -operator(()ident(string=?) string<delimiter(")content(K. Harper, M.D.)delimiter(")> comment(;; Taken from Section 6.3.3. (Symbols\) of the R5RS) - operator(()ident(symbol->string) - operator(()ident(string->symbol) string<delimiter(")content(K. Harper, M.D.)delimiter(")>operator(\))operator(\))operator(\)) -comment(;; BEGIN Factorial) -operator(()reserved(define) ident(factorial) - operator(()reserved(lambda) operator(()ident(n)operator(\)) - operator(()reserved(if) operator(()ident(=) ident(n) integer(1)operator(\)) - integer(1) - operator(()ident(*) ident(n) operator(()ident(factorial) operator(()ident(-) ident(n) integer(1)operator(\))operator(\))operator(\))operator(\))operator(\))operator(\)) -comment(;; END Factorial) - - comment(;; BEGIN Square) - operator(()reserved(define) ident(square) - operator(()reserved(lambda) operator(()ident(n)operator(\)) comment(;; My first lambda) - operator(()reserved(if) operator(()ident(=) ident(n) integer(0)operator(\)) - integer(0) - comment(;; BEGIN Recursive_Call) - operator(()ident(+) operator(()ident(square) operator(()ident(-) ident(n) integer(1)operator(\))operator(\)) - operator(()ident(-) operator(()ident(+) ident(n) ident(n)operator(\)) integer(1)operator(\))operator(\))operator(\))operator(\))operator(\)) - comment(;; END Recursive_Call) - comment(;; END Square) - -comment(;;LIST OF NUMBERS) -operator(()integer(#b-1111) integer(#xffa12) integer(#o755) integer(#o-755) ident(+)ident(i) ident(-)ident(i) ident(+)integer(2)ident(i) ident(-)integer(2)ident(i) integer(3+4i) integer(1.6440287493492101)ident(i+2) integer(1.344) integer(3/4) integer(#i23/70)operator(\)) - -comment(;;a vector) -operator(#()operator(')operator(()integer(1) integer(2) integer(3)operator(\)) char(#\\\\)ident(a) integer(3) pre_constant(#t) pre_constant(#f)operator(\)) - -comment(;;macros (USELESS AND INCORRECT, JUST TO CHECK THAT IDENTIFIERS ARE RECOGNIZED RIGHT\)) -operator(()reserved(syntax-case) operator(()operator(\)) - operator(()operator(()ident(_) ident(name) ident(field) ident(...)operator(\)) - operator(()ident(with-syntax) - operator(()operator(()ident(constructor) operator(()ident(gen-id) operator(()ident(syntax) ident(name)operator(\)) string<delimiter(")content(make-)delimiter(")> operator(()ident(syntax) ident(name)operator(\))operator(\))operator(\)) - operator(()ident(predicate) operator(()ident(gen-id) operator(()ident(syntax) ident(name)operator(\)) operator(()ident(syntax) ident(name)operator(\)) string<delimiter(")content(?)delimiter(")>operator(\))operator(\)) - operator(()operator(()ident(access) ident(...)operator(\)) - operator(()ident(map) operator(()reserved(lambda) operator(()ident(x)operator(\)) operator(()ident(gen-id) ident(x) string<delimiter(")content(set-)delimiter(")> operator(()ident(syntax) ident(name)operator(\)) string<delimiter(")content(-)delimiter(")> ident(x) string<delimiter(")content(!)delimiter(")>operator(\))operator(\))operator(\))operator(\))operator(\))operator(\))operator(\))operator(\))
\ No newline at end of file diff --git a/test/scanners/scheme/strange.in.scm b/test/scanners/scheme/strange.in.scm deleted file mode 100644 index 4cb9c18..0000000 --- a/test/scanners/scheme/strange.in.scm +++ /dev/null @@ -1,38 +0,0 @@ - -("") -(string=? "K. Harper, M.D." ;; Taken from Section 6.3.3. (Symbols) of the R5RS - (symbol->string - (string->symbol "K. Harper, M.D."))) -;; BEGIN Factorial -(define factorial - (lambda (n) - (if (= n 1) - 1 - (* n (factorial (- n 1)))))) -;; END Factorial - - ;; BEGIN Square - (define square - (lambda (n) ;; My first lambda - (if (= n 0) - 0 - ;; BEGIN Recursive_Call - (+ (square (- n 1)) - (- (+ n n) 1))))) - ;; END Recursive_Call - ;; END Square - -;;LIST OF NUMBERS -(#b-1111 #xffa12 #o755 #o-755 +i -i +2i -2i 3+4i 1.6440287493492101i+2 1.344 3/4 #i23/70) - -;;a vector -#('(1 2 3) #\\a 3 #t #f) - -;;macros (USELESS AND INCORRECT, JUST TO CHECK THAT IDENTIFIERS ARE RECOGNIZED RIGHT) -(syntax-case () - ((_ name field ...) - (with-syntax - ((constructor (gen-id (syntax name) "make-" (syntax name))) - (predicate (gen-id (syntax name) (syntax name) "?")) - ((access ...) - (map (lambda (x) (gen-id x "set-" (syntax name) "-" x "!"))))))))
\ No newline at end of file diff --git a/test/scanners/scheme/suite.rb b/test/scanners/scheme/suite.rb deleted file mode 100644 index ca390f5..0000000 --- a/test/scanners/scheme/suite.rb +++ /dev/null @@ -1,2 +0,0 @@ -class Scheme < CodeRay::TestCase -end |