*

14 files changed, 2442 insertions, 0 deletions

diff --git a/js/games/nluqo.github.io/~bh/downloads/simply/database.scm b/js/games/nluqo.github.io/~bh/downloads/simply/database.scm
new file mode 100644
index 0000000..5f9c17f
--- /dev/null
+++ b/js/games/nluqo.github.io/~bh/downloads/simply/database.scm
@@ -0,0 +1,84 @@
+;;; Database.scm:  This file contains the code we show in the database
+;;; chapter of _Simply_Scheme_.  You should add your new work to this file.
+
+;;; The database ADT: a filename, list of fields and list of records
+
+(define (make-db filename fields records)
+  (vector filename fields records))
+
+(define (db-filename db)
+  (vector-ref db 0))
+
+(define (db-set-filename! db filename)
+  (vector-set! db 0 filename))
+
+(define (db-fields db)
+  (vector-ref db 1))
+
+(define (db-set-fields! db fields)
+  (vector-set! db 1 fields))
+
+(define (db-records db)
+  (vector-ref db 2))
+
+(define (db-set-records! db records)
+  (vector-set! db 2 records))
+
+
+;;; Stuff about the current state
+
+(define current-state (vector #f))
+
+(define (no-db?)
+  (not (vector-ref current-state 0)))
+
+(define (current-db)
+  (if (no-db?)
+      (error "No current database!")
+      (vector-ref current-state 0)))
+
+(define (set-current-db! db)
+  (vector-set! current-state 0 db))
+
+(define (current-fields)
+  (db-fields (current-db)))
+
+;; User commands
+
+(define (new-db filename fields)
+  (set-current-db! (make-db filename fields '()))
+  'created)
+
+(define (insert)
+  (let ((new-record (get-record)))
+    (db-insert new-record (current-db)))
+  (if (ask "Insert another? ")
+      (insert)
+      'inserted))
+
+(define (db-insert record db)
+  (db-set-records! db (cons record (db-records db))))
+
+(define (get-record)
+  (get-record-loop 0
+		   (make-vector (length (current-fields)))
+		   (current-fields)))
+
+(define (get-record-loop which-field record fields)
+  (if (null? fields)
+      record
+      (begin (display "Value for ")
+	     (display (car fields))
+	     (display "--> ")
+	     (vector-set! record which-field (read))
+	     (get-record-loop (+ which-field 1) record (cdr fields)))))
+
+;;; Utilities
+
+(define (ask question)
+  (display question)
+  (let ((answer (read)))
+    (cond ((equal? (first answer) 'y) #t)
+	  ((equal? (first answer) 'n) #f)
+	  (else (show "Please type Y or N.")
+		(ask question)))))
diff --git a/js/games/nluqo.github.io/~bh/downloads/simply/functions.scm b/js/games/nluqo.github.io/~bh/downloads/simply/functions.scm
new file mode 100644
index 0000000..e421ee3
--- /dev/null
+++ b/js/games/nluqo.github.io/~bh/downloads/simply/functions.scm
@@ -0,0 +1,244 @@
+;;; The functions program
+
+(define (functions)
+  (read-line)
+  (show "Welcome to the FUNCTIONS program.")
+  (functions-loop))
+
+(define (functions-loop)
+  (let ((fn-name (get-fn)))
+    (if (equal? fn-name 'exit)
+	"Thanks for using FUNCTIONS!"
+	(let ((args (get-args (arg-count fn-name))))
+	  (if (not (in-domain? args fn-name))
+	     (show "Argument(s) not in domain.")
+	     (show-answer (apply (scheme-function fn-name) args)))
+	  (functions-loop)))))
+
+(define (get-fn)
+  (display "Function: ")
+  (let ((line (read-line)))
+    (cond ((empty? line)
+	   (show "Please type a function!")
+	   (get-fn))
+	  ((not (= (count line) 1))
+	   (show "You typed more than one thing!  Try again.")
+	   (get-fn))
+	  ((not (valid-fn-name? (first line)))
+	   (show "Sorry, that's not a function.")
+	   (get-fn))
+	  (else (first line)))))
+
+(define (get-args n)
+  (if (= n 0)
+      '()
+      (let ((first (get-arg)))
+	(cons first (get-args (- n 1))))))
+
+(define (get-arg)
+  (display "Argument: ")
+  (let ((line (read-line)))
+    (cond ((empty? line)
+	   (show "Please type an argument!")
+	   (get-arg))
+	  ((and (equal? "(" (first (first line)))
+		(equal? ")" (last (last line))))
+	   (let ((sent (remove-first-paren (remove-last-paren line))))
+	     (if (any-parens? sent)
+		 (begin
+		  (show "Sentences can't have parentheses inside.")
+		  (get-arg))
+		 (map booleanize sent))))
+	  ((any-parens? line)
+	   (show "Bad parentheses")
+	   (get-arg))
+	  ((empty? (bf line)) (booleanize (first line)))
+	  ((member? (first (first line)) "\"'")
+	   (show "No quoting arguments in this program.  Try again.")
+	   (get-arg))
+	  (else (show "You typed more than one argument!  Try again.")
+		(get-arg)))))
+
+(define (any-parens? line)
+  (let ((letters (accumulate word line)))
+    (or (member? "(" letters)
+	(member? ")" letters))))
+
+(define (remove-first-paren line)
+  (if (equal? (first line) "(")
+      (bf line)
+      (se (bf (first line)) (bf line))))
+
+(define (remove-last-paren line)
+  (if (equal? (last line) ")")
+      (bl line)
+      (se (bl line) (bl (last line)))))
+
+(define (booleanize x)
+  (cond ((equal? x "#t") #t)
+	((equal? x "#f") #f)
+	(else x)))
+
+(define (show-answer answer)
+  (newline)
+  (display "The result is: ")
+  (if (not answer)
+      (show "#F")
+      (show answer))
+  (newline))
+
+(define (scheme-function fn-name)
+  (cadr (assoc fn-name *the-functions*)))
+
+(define (arg-count fn-name)
+  (caddr (assoc fn-name *the-functions*)))
+
+(define (type-predicate fn-name)
+  (cadddr (assoc fn-name *the-functions*)))
+
+(define (in-domain? args fn-name)
+  (apply (type-predicate fn-name) args))
+
+
+;; Type predicates
+
+(define (word-or-sent? x)
+  (or (word? x) (sentence? x)))
+
+(define (not-empty? x)
+  (and (word-or-sent? x) (not (empty? x))))
+
+(define (two-numbers? x y)
+  (and (number? x) (number? y)))
+
+(define (two-reals? x y)
+  (and (real? x) (real? y)))
+
+(define (two-integers? x y)
+  (and (integer? x) (integer? y)))
+
+(define (can-divide? x y)
+  (and (number? x) (number? y) (not (= y 0))))
+
+(define (dividable-integers? x y)
+  (and (two-integers? x y) (not (= y 0))))
+
+(define (trig-range? x)
+  (and (number? x) (<= (abs x) 1)))
+
+(define (hof-types-ok? fn-name stuff range-predicate)
+  (and (valid-fn-name? fn-name)
+       (= 1 (arg-count fn-name))
+       (word-or-sent? stuff)
+       (empty? (keep (lambda (element)
+		       (not ((type-predicate fn-name) element)))
+		     stuff))
+       (null? (filter (lambda (element)
+			(not (range-predicate element)))
+		      (map (scheme-function fn-name)
+			   (every (lambda (x) x) stuff))))))
+
+(define (member-types-ok? small big)
+  (and (word? small)
+       (or (sentence? big) (= (count small) 1))))
+
+
+;; Names of functions as functions
+
+(define (named-every fn-name list)
+  (every (scheme-function fn-name) list))
+
+(define (named-keep fn-name list)
+  (keep (scheme-function fn-name) list))
+
+(define (valid-fn-name? name)
+  (assoc name *the-functions*))
+
+
+;; The list itself
+          
+(define *the-functions*
+  (list (list '* * 2 two-numbers?)
+	(list '+ + 2 two-numbers?)
+	(list '- - 2 two-numbers?)
+	(list '/ / 2 can-divide?)
+	(list '< < 2 two-reals?)
+	(list '<= <= 2 two-reals?)
+	(list '= = 2 two-numbers?)
+	(list '> > 2 two-reals?)
+	(list '>= >= 2 two-reals?)
+	(list 'abs abs 1 real?)
+
+	(list 'acos acos 1 trig-range?)
+	(list 'and (lambda (x y) (and x y)) 2 
+	      (lambda (x y) (and (boolean? x) (boolean? y))))
+	(list 'appearances appearances 2 member-types-ok?)
+	(list 'asin asin 1 trig-range?)
+	(list 'atan atan 1 number?)
+	(list 'bf bf 1 not-empty?)
+	(list 'bl bl 1 not-empty?)
+	(list 'butfirst butfirst 1 not-empty?)
+	(list 'butlast butlast 1 not-empty?)
+	(list 'ceiling ceiling 1 real?)
+	(list 'cos cos 1 number?)
+	(list 'count count 1 word-or-sent?)
+	(list 'equal? equal? 2 (lambda (x y) #t))
+	(list 'even? even? 1 integer?)
+	(list 'every named-every 2
+	      (lambda (fn stuff)
+		(hof-types-ok? fn stuff word-or-sent?)))
+	(list 'exit '() 0 '())
+	   ; in case user applies number-of-arguments to exit
+	(list 'exp exp 1 number?)
+	(list 'expt expt 2
+	      (lambda (x y)
+		(and (number? x) (number? y)
+		     (or (not (real? x)) (>= x 0) (integer? y)))))
+	(list 'first first 1 not-empty?)
+	(list 'floor floor 1 real?)
+	(list 'gcd gcd 2 two-integers?)
+	(list 'if (lambda (pred yes no) (if pred yes no)) 3
+	      (lambda (pred yes no) (boolean? pred)))
+	(list 'item item 2
+	      (lambda (n stuff)
+		(and (integer? n) (> n 0)
+		     (word-or-sent? stuff) (<= n (count stuff)))))
+	(list 'keep named-keep 2
+	      (lambda (fn stuff)
+		(hof-types-ok? fn stuff boolean?)))
+	(list 'last last 1 not-empty?)
+	(list 'lcm lcm 2 two-integers?)
+	(list 'log log 1 (lambda (x) (and (number? x) (not (= x 0)))))
+	(list 'max max 2 two-reals?)
+	(list 'member? member? 2 member-types-ok?)
+	(list 'min min 2 two-reals?)
+	(list 'modulo modulo 2 dividable-integers?)
+	(list 'not not 1 boolean?)
+
+	(list 'number-of-arguments arg-count 1 valid-fn-name?)
+	(list 'odd? odd? 1 integer?)
+	(list 'or (lambda (x y) (or x y)) 2
+	      (lambda (x y) (and (boolean? x) (boolean? y))))
+	(list 'quotient quotient 2 dividable-integers?)
+	(list 'random random 1 (lambda (x) (and (integer? x) (> x 0))))
+	(list 'remainder remainder 2 dividable-integers?)
+	(list 'round round 1 real?)
+	(list 'se se 2
+	      (lambda (x y) (and (word-or-sent? x) (word-or-sent? y))))
+	(list 'sentence sentence 2
+	      (lambda (x y) (and (word-or-sent? x) (word-or-sent? y))))
+	(list 'sentence? sentence? 1 (lambda (x) #t))
+	(list 'sin sin 1 number?)
+	(list 'sqrt sqrt 1 (lambda (x) (and (real? x) (>= x 0))))
+	(list 'tan tan 1 number?)
+	(list 'truncate truncate 1 real?)
+	(list 'vowel?
+	      (lambda (x)
+		(and (word? x)
+		     (= (count x) 1)
+		     (member? x '(a e i o u))))
+	      1
+	      (lambda (x) #t))
+	(list 'word word 2 (lambda (x y) (and (word? x) (word? y))))
+	(list 'word? word? 1 (lambda (x) #t))))
+
diff --git a/js/games/nluqo.github.io/~bh/downloads/simply/index.html?C=D;O=A b/js/games/nluqo.github.io/~bh/downloads/simply/index.html?C=D;O=A
new file mode 100644
index 0000000..c03dd0f
--- /dev/null
+++ b/js/games/nluqo.github.io/~bh/downloads/simply/index.html?C=D;O=A
@@ -0,0 +1,21 @@
+<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 3.2 Final//EN">
+<html>
+ <head>
+  <title>Index of /~bh/downloads/simply</title>
+ </head>
+ <body>
+<h1>Index of /~bh/downloads/simply</h1>
+  <table>
+   <tr><th valign="top"><img src="../../../icons/blank.gif" alt="[ICO]"></th><th><a href="index.html?C=N%3BO=A">Name</a></th><th><a href="index.html?C=M%3BO=A">Last modified</a></th><th><a href="index.html?C=S%3BO=A">Size</a></th><th><a href="index.html?C=D%3BO=D">Description</a></th></tr>
+   <tr><th colspan="5"><hr></th></tr>
+<tr><td valign="top"><img src="../../../icons/back.gif" alt="[PARENTDIR]"></td><td><a href="../index.html">Parent Directory</a>       </td><td>&nbsp;</td><td align="right">  - </td><td>&nbsp;</td></tr>
+<tr><td valign="top"><img src="../../../icons/unknown.gif" alt="[   ]"></td><td><a href="database.scm">database.scm</a>           </td><td align="right">2006-07-05 04:59  </td><td align="right">1.9K</td><td>&nbsp;</td></tr>
+<tr><td valign="top"><img src="../../../icons/unknown.gif" alt="[   ]"></td><td><a href="functions.scm">functions.scm</a>          </td><td align="right">2006-07-05 04:59  </td><td align="right">6.7K</td><td>&nbsp;</td></tr>
+<tr><td valign="top"><img src="../../../icons/unknown.gif" alt="[   ]"></td><td><a href="match.scm">match.scm</a>              </td><td align="right">2006-07-05 04:59  </td><td align="right">3.3K</td><td>&nbsp;</td></tr>
+<tr><td valign="top"><img src="../../../icons/unknown.gif" alt="[   ]"></td><td><a href="newttt.scm">newttt.scm</a>             </td><td align="right">2006-07-05 04:59  </td><td align="right">1.6K</td><td>&nbsp;</td></tr>
+<tr><td valign="top"><img src="../../../icons/unknown.gif" alt="[   ]"></td><td><a href="simply.scm">simply.scm</a>             </td><td align="right">2006-07-05 04:59  </td><td align="right"> 32K</td><td>&nbsp;</td></tr>
+<tr><td valign="top"><img src="../../../icons/unknown.gif" alt="[   ]"></td><td><a href="spread.scm">spread.scm</a>             </td><td align="right">2006-07-05 04:59  </td><td align="right"> 14K</td><td>&nbsp;</td></tr>
+<tr><td valign="top"><img src="../../../icons/unknown.gif" alt="[   ]"></td><td><a href="ttt.scm">ttt.scm</a>                </td><td align="right">2006-07-05 04:59  </td><td align="right">2.8K</td><td>&nbsp;</td></tr>
+   <tr><th colspan="5"><hr></th></tr>
+</table>
+</body></html>
diff --git a/js/games/nluqo.github.io/~bh/downloads/simply/index.html?C=D;O=D b/js/games/nluqo.github.io/~bh/downloads/simply/index.html?C=D;O=D
new file mode 100644
index 0000000..26054d4
--- /dev/null
+++ b/js/games/nluqo.github.io/~bh/downloads/simply/index.html?C=D;O=D
@@ -0,0 +1,21 @@
+<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 3.2 Final//EN">
+<html>
+ <head>
+  <title>Index of /~bh/downloads/simply</title>
+ </head>
+ <body>
+<h1>Index of /~bh/downloads/simply</h1>
+  <table>
+   <tr><th valign="top"><img src="../../../icons/blank.gif" alt="[ICO]"></th><th><a href="index.html?C=N%3BO=A">Name</a></th><th><a href="index.html?C=M%3BO=A">Last modified</a></th><th><a href="index.html?C=S%3BO=A">Size</a></th><th><a href="index.html?C=D%3BO=A">Description</a></th></tr>
+   <tr><th colspan="5"><hr></th></tr>
+<tr><td valign="top"><img src="../../../icons/back.gif" alt="[PARENTDIR]"></td><td><a href="../index.html">Parent Directory</a>       </td><td>&nbsp;</td><td align="right">  - </td><td>&nbsp;</td></tr>
+<tr><td valign="top"><img src="../../../icons/unknown.gif" alt="[   ]"></td><td><a href="ttt.scm">ttt.scm</a>                </td><td align="right">2006-07-05 04:59  </td><td align="right">2.8K</td><td>&nbsp;</td></tr>
+<tr><td valign="top"><img src="../../../icons/unknown.gif" alt="[   ]"></td><td><a href="spread.scm">spread.scm</a>             </td><td align="right">2006-07-05 04:59  </td><td align="right"> 14K</td><td>&nbsp;</td></tr>
+<tr><td valign="top"><img src="../../../icons/unknown.gif" alt="[   ]"></td><td><a href="simply.scm">simply.scm</a>             </td><td align="right">2006-07-05 04:59  </td><td align="right"> 32K</td><td>&nbsp;</td></tr>
+<tr><td valign="top"><img src="../../../icons/unknown.gif" alt="[   ]"></td><td><a href="newttt.scm">newttt.scm</a>             </td><td align="right">2006-07-05 04:59  </td><td align="right">1.6K</td><td>&nbsp;</td></tr>
+<tr><td valign="top"><img src="../../../icons/unknown.gif" alt="[   ]"></td><td><a href="match.scm">match.scm</a>              </td><td align="right">2006-07-05 04:59  </td><td align="right">3.3K</td><td>&nbsp;</td></tr>
+<tr><td valign="top"><img src="../../../icons/unknown.gif" alt="[   ]"></td><td><a href="functions.scm">functions.scm</a>          </td><td align="right">2006-07-05 04:59  </td><td align="right">6.7K</td><td>&nbsp;</td></tr>
+<tr><td valign="top"><img src="../../../icons/unknown.gif" alt="[   ]"></td><td><a href="database.scm">database.scm</a>           </td><td align="right">2006-07-05 04:59  </td><td align="right">1.9K</td><td>&nbsp;</td></tr>
+   <tr><th colspan="5"><hr></th></tr>
+</table>
+</body></html>
diff --git a/js/games/nluqo.github.io/~bh/downloads/simply/index.html?C=M;O=A b/js/games/nluqo.github.io/~bh/downloads/simply/index.html?C=M;O=A
new file mode 100644
index 0000000..0fc3d16
--- /dev/null
+++ b/js/games/nluqo.github.io/~bh/downloads/simply/index.html?C=M;O=A
@@ -0,0 +1,21 @@
+<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 3.2 Final//EN">
+<html>
+ <head>
+  <title>Index of /~bh/downloads/simply</title>
+ </head>
+ <body>
+<h1>Index of /~bh/downloads/simply</h1>
+  <table>
+   <tr><th valign="top"><img src="../../../icons/blank.gif" alt="[ICO]"></th><th><a href="index.html?C=N%3BO=A">Name</a></th><th><a href="https://people.eecs.berkeley.edu/~bh/downloads/simply/?C=M;O=D">Last modified</a></th><th><a href="index.html?C=S%3BO=A">Size</a></th><th><a href="index.html?C=D%3BO=A">Description</a></th></tr>
+   <tr><th colspan="5"><hr></th></tr>
+<tr><td valign="top"><img src="../../../icons/back.gif" alt="[PARENTDIR]"></td><td><a href="../index.html">Parent Directory</a>       </td><td>&nbsp;</td><td align="right">  - </td><td>&nbsp;</td></tr>
+<tr><td valign="top"><img src="../../../icons/unknown.gif" alt="[   ]"></td><td><a href="database.scm">database.scm</a>           </td><td align="right">2006-07-05 04:59  </td><td align="right">1.9K</td><td>&nbsp;</td></tr>
+<tr><td valign="top"><img src="../../../icons/unknown.gif" alt="[   ]"></td><td><a href="functions.scm">functions.scm</a>          </td><td align="right">2006-07-05 04:59  </td><td align="right">6.7K</td><td>&nbsp;</td></tr>
+<tr><td valign="top"><img src="../../../icons/unknown.gif" alt="[   ]"></td><td><a href="match.scm">match.scm</a>              </td><td align="right">2006-07-05 04:59  </td><td align="right">3.3K</td><td>&nbsp;</td></tr>
+<tr><td valign="top"><img src="../../../icons/unknown.gif" alt="[   ]"></td><td><a href="newttt.scm">newttt.scm</a>             </td><td align="right">2006-07-05 04:59  </td><td align="right">1.6K</td><td>&nbsp;</td></tr>
+<tr><td valign="top"><img src="../../../icons/unknown.gif" alt="[   ]"></td><td><a href="simply.scm">simply.scm</a>             </td><td align="right">2006-07-05 04:59  </td><td align="right"> 32K</td><td>&nbsp;</td></tr>
+<tr><td valign="top"><img src="../../../icons/unknown.gif" alt="[   ]"></td><td><a href="spread.scm">spread.scm</a>             </td><td align="right">2006-07-05 04:59  </td><td align="right"> 14K</td><td>&nbsp;</td></tr>
+<tr><td valign="top"><img src="../../../icons/unknown.gif" alt="[   ]"></td><td><a href="ttt.scm">ttt.scm</a>                </td><td align="right">2006-07-05 04:59  </td><td align="right">2.8K</td><td>&nbsp;</td></tr>
+   <tr><th colspan="5"><hr></th></tr>
+</table>
+</body></html>
diff --git a/js/games/nluqo.github.io/~bh/downloads/simply/index.html?C=N;O=A b/js/games/nluqo.github.io/~bh/downloads/simply/index.html?C=N;O=A
new file mode 100644
index 0000000..761d1dd
--- /dev/null
+++ b/js/games/nluqo.github.io/~bh/downloads/simply/index.html?C=N;O=A
@@ -0,0 +1,21 @@
+<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 3.2 Final//EN">
+<html>
+ <head>
+  <title>Index of /~bh/downloads/simply</title>
+ </head>
+ <body>
+<h1>Index of /~bh/downloads/simply</h1>
+  <table>
+   <tr><th valign="top"><img src="../../../icons/blank.gif" alt="[ICO]"></th><th><a href="index.html?C=N%3BO=D">Name</a></th><th><a href="index.html?C=M%3BO=A">Last modified</a></th><th><a href="index.html?C=S%3BO=A">Size</a></th><th><a href="index.html?C=D%3BO=A">Description</a></th></tr>
+   <tr><th colspan="5"><hr></th></tr>
+<tr><td valign="top"><img src="../../../icons/back.gif" alt="[PARENTDIR]"></td><td><a href="../index.html">Parent Directory</a>       </td><td>&nbsp;</td><td align="right">  - </td><td>&nbsp;</td></tr>
+<tr><td valign="top"><img src="../../../icons/unknown.gif" alt="[   ]"></td><td><a href="database.scm">database.scm</a>           </td><td align="right">2006-07-05 04:59  </td><td align="right">1.9K</td><td>&nbsp;</td></tr>
+<tr><td valign="top"><img src="../../../icons/unknown.gif" alt="[   ]"></td><td><a href="functions.scm">functions.scm</a>          </td><td align="right">2006-07-05 04:59  </td><td align="right">6.7K</td><td>&nbsp;</td></tr>
+<tr><td valign="top"><img src="../../../icons/unknown.gif" alt="[   ]"></td><td><a href="match.scm">match.scm</a>              </td><td align="right">2006-07-05 04:59  </td><td align="right">3.3K</td><td>&nbsp;</td></tr>
+<tr><td valign="top"><img src="../../../icons/unknown.gif" alt="[   ]"></td><td><a href="newttt.scm">newttt.scm</a>             </td><td align="right">2006-07-05 04:59  </td><td align="right">1.6K</td><td>&nbsp;</td></tr>
+<tr><td valign="top"><img src="../../../icons/unknown.gif" alt="[   ]"></td><td><a href="simply.scm">simply.scm</a>             </td><td align="right">2006-07-05 04:59  </td><td align="right"> 32K</td><td>&nbsp;</td></tr>
+<tr><td valign="top"><img src="../../../icons/unknown.gif" alt="[   ]"></td><td><a href="spread.scm">spread.scm</a>             </td><td align="right">2006-07-05 04:59  </td><td align="right"> 14K</td><td>&nbsp;</td></tr>
+<tr><td valign="top"><img src="../../../icons/unknown.gif" alt="[   ]"></td><td><a href="ttt.scm">ttt.scm</a>                </td><td align="right">2006-07-05 04:59  </td><td align="right">2.8K</td><td>&nbsp;</td></tr>
+   <tr><th colspan="5"><hr></th></tr>
+</table>
+</body></html>
diff --git a/js/games/nluqo.github.io/~bh/downloads/simply/index.html?C=N;O=D b/js/games/nluqo.github.io/~bh/downloads/simply/index.html?C=N;O=D
new file mode 100644
index 0000000..26054d4
--- /dev/null
+++ b/js/games/nluqo.github.io/~bh/downloads/simply/index.html?C=N;O=D
@@ -0,0 +1,21 @@
+<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 3.2 Final//EN">
+<html>
+ <head>
+  <title>Index of /~bh/downloads/simply</title>
+ </head>
+ <body>
+<h1>Index of /~bh/downloads/simply</h1>
+  <table>
+   <tr><th valign="top"><img src="../../../icons/blank.gif" alt="[ICO]"></th><th><a href="index.html?C=N%3BO=A">Name</a></th><th><a href="index.html?C=M%3BO=A">Last modified</a></th><th><a href="index.html?C=S%3BO=A">Size</a></th><th><a href="index.html?C=D%3BO=A">Description</a></th></tr>
+   <tr><th colspan="5"><hr></th></tr>
+<tr><td valign="top"><img src="../../../icons/back.gif" alt="[PARENTDIR]"></td><td><a href="../index.html">Parent Directory</a>       </td><td>&nbsp;</td><td align="right">  - </td><td>&nbsp;</td></tr>
+<tr><td valign="top"><img src="../../../icons/unknown.gif" alt="[   ]"></td><td><a href="ttt.scm">ttt.scm</a>                </td><td align="right">2006-07-05 04:59  </td><td align="right">2.8K</td><td>&nbsp;</td></tr>
+<tr><td valign="top"><img src="../../../icons/unknown.gif" alt="[   ]"></td><td><a href="spread.scm">spread.scm</a>             </td><td align="right">2006-07-05 04:59  </td><td align="right"> 14K</td><td>&nbsp;</td></tr>
+<tr><td valign="top"><img src="../../../icons/unknown.gif" alt="[   ]"></td><td><a href="simply.scm">simply.scm</a>             </td><td align="right">2006-07-05 04:59  </td><td align="right"> 32K</td><td>&nbsp;</td></tr>
+<tr><td valign="top"><img src="../../../icons/unknown.gif" alt="[   ]"></td><td><a href="newttt.scm">newttt.scm</a>             </td><td align="right">2006-07-05 04:59  </td><td align="right">1.6K</td><td>&nbsp;</td></tr>
+<tr><td valign="top"><img src="../../../icons/unknown.gif" alt="[   ]"></td><td><a href="match.scm">match.scm</a>              </td><td align="right">2006-07-05 04:59  </td><td align="right">3.3K</td><td>&nbsp;</td></tr>
+<tr><td valign="top"><img src="../../../icons/unknown.gif" alt="[   ]"></td><td><a href="functions.scm">functions.scm</a>          </td><td align="right">2006-07-05 04:59  </td><td align="right">6.7K</td><td>&nbsp;</td></tr>
+<tr><td valign="top"><img src="../../../icons/unknown.gif" alt="[   ]"></td><td><a href="database.scm">database.scm</a>           </td><td align="right">2006-07-05 04:59  </td><td align="right">1.9K</td><td>&nbsp;</td></tr>
+   <tr><th colspan="5"><hr></th></tr>
+</table>
+</body></html>
diff --git a/js/games/nluqo.github.io/~bh/downloads/simply/index.html?C=S;O=A b/js/games/nluqo.github.io/~bh/downloads/simply/index.html?C=S;O=A
new file mode 100644
index 0000000..51fc0ca
--- /dev/null
+++ b/js/games/nluqo.github.io/~bh/downloads/simply/index.html?C=S;O=A
@@ -0,0 +1,21 @@
+<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 3.2 Final//EN">
+<html>
+ <head>
+  <title>Index of /~bh/downloads/simply</title>
+ </head>
+ <body>
+<h1>Index of /~bh/downloads/simply</h1>
+  <table>
+   <tr><th valign="top"><img src="../../../icons/blank.gif" alt="[ICO]"></th><th><a href="index.html?C=N%3BO=A">Name</a></th><th><a href="index.html?C=M%3BO=A">Last modified</a></th><th><a href="index.html?C=S%3BO=D">Size</a></th><th><a href="index.html?C=D%3BO=A">Description</a></th></tr>
+   <tr><th colspan="5"><hr></th></tr>
+<tr><td valign="top"><img src="../../../icons/back.gif" alt="[PARENTDIR]"></td><td><a href="../index.html">Parent Directory</a>       </td><td>&nbsp;</td><td align="right">  - </td><td>&nbsp;</td></tr>
+<tr><td valign="top"><img src="../../../icons/unknown.gif" alt="[   ]"></td><td><a href="newttt.scm">newttt.scm</a>             </td><td align="right">2006-07-05 04:59  </td><td align="right">1.6K</td><td>&nbsp;</td></tr>
+<tr><td valign="top"><img src="../../../icons/unknown.gif" alt="[   ]"></td><td><a href="database.scm">database.scm</a>           </td><td align="right">2006-07-05 04:59  </td><td align="right">1.9K</td><td>&nbsp;</td></tr>
+<tr><td valign="top"><img src="../../../icons/unknown.gif" alt="[   ]"></td><td><a href="ttt.scm">ttt.scm</a>                </td><td align="right">2006-07-05 04:59  </td><td align="right">2.8K</td><td>&nbsp;</td></tr>
+<tr><td valign="top"><img src="../../../icons/unknown.gif" alt="[   ]"></td><td><a href="match.scm">match.scm</a>              </td><td align="right">2006-07-05 04:59  </td><td align="right">3.3K</td><td>&nbsp;</td></tr>
+<tr><td valign="top"><img src="../../../icons/unknown.gif" alt="[   ]"></td><td><a href="functions.scm">functions.scm</a>          </td><td align="right">2006-07-05 04:59  </td><td align="right">6.7K</td><td>&nbsp;</td></tr>
+<tr><td valign="top"><img src="../../../icons/unknown.gif" alt="[   ]"></td><td><a href="spread.scm">spread.scm</a>             </td><td align="right">2006-07-05 04:59  </td><td align="right"> 14K</td><td>&nbsp;</td></tr>
+<tr><td valign="top"><img src="../../../icons/unknown.gif" alt="[   ]"></td><td><a href="simply.scm">simply.scm</a>             </td><td align="right">2006-07-05 04:59  </td><td align="right"> 32K</td><td>&nbsp;</td></tr>
+   <tr><th colspan="5"><hr></th></tr>
+</table>
+</body></html>
diff --git a/js/games/nluqo.github.io/~bh/downloads/simply/index.html?C=S;O=D b/js/games/nluqo.github.io/~bh/downloads/simply/index.html?C=S;O=D
new file mode 100644
index 0000000..2b4516e
--- /dev/null
+++ b/js/games/nluqo.github.io/~bh/downloads/simply/index.html?C=S;O=D
@@ -0,0 +1,21 @@
+<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 3.2 Final//EN">
+<html>
+ <head>
+  <title>Index of /~bh/downloads/simply</title>
+ </head>
+ <body>
+<h1>Index of /~bh/downloads/simply</h1>
+  <table>
+   <tr><th valign="top"><img src="../../../icons/blank.gif" alt="[ICO]"></th><th><a href="index.html?C=N%3BO=A">Name</a></th><th><a href="index.html?C=M%3BO=A">Last modified</a></th><th><a href="index.html?C=S%3BO=A">Size</a></th><th><a href="index.html?C=D%3BO=A">Description</a></th></tr>
+   <tr><th colspan="5"><hr></th></tr>
+<tr><td valign="top"><img src="../../../icons/back.gif" alt="[PARENTDIR]"></td><td><a href="../index.html">Parent Directory</a>       </td><td>&nbsp;</td><td align="right">  - </td><td>&nbsp;</td></tr>
+<tr><td valign="top"><img src="../../../icons/unknown.gif" alt="[   ]"></td><td><a href="simply.scm">simply.scm</a>             </td><td align="right">2006-07-05 04:59  </td><td align="right"> 32K</td><td>&nbsp;</td></tr>
+<tr><td valign="top"><img src="../../../icons/unknown.gif" alt="[   ]"></td><td><a href="spread.scm">spread.scm</a>             </td><td align="right">2006-07-05 04:59  </td><td align="right"> 14K</td><td>&nbsp;</td></tr>
+<tr><td valign="top"><img src="../../../icons/unknown.gif" alt="[   ]"></td><td><a href="functions.scm">functions.scm</a>          </td><td align="right">2006-07-05 04:59  </td><td align="right">6.7K</td><td>&nbsp;</td></tr>
+<tr><td valign="top"><img src="../../../icons/unknown.gif" alt="[   ]"></td><td><a href="match.scm">match.scm</a>              </td><td align="right">2006-07-05 04:59  </td><td align="right">3.3K</td><td>&nbsp;</td></tr>
+<tr><td valign="top"><img src="../../../icons/unknown.gif" alt="[   ]"></td><td><a href="ttt.scm">ttt.scm</a>                </td><td align="right">2006-07-05 04:59  </td><td align="right">2.8K</td><td>&nbsp;</td></tr>
+<tr><td valign="top"><img src="../../../icons/unknown.gif" alt="[   ]"></td><td><a href="database.scm">database.scm</a>           </td><td align="right">2006-07-05 04:59  </td><td align="right">1.9K</td><td>&nbsp;</td></tr>
+<tr><td valign="top"><img src="../../../icons/unknown.gif" alt="[   ]"></td><td><a href="newttt.scm">newttt.scm</a>             </td><td align="right">2006-07-05 04:59  </td><td align="right">1.6K</td><td>&nbsp;</td></tr>
+   <tr><th colspan="5"><hr></th></tr>
+</table>
+</body></html>
diff --git a/js/games/nluqo.github.io/~bh/downloads/simply/match.scm b/js/games/nluqo.github.io/~bh/downloads/simply/match.scm
new file mode 100644
index 0000000..f454f68
--- /dev/null
+++ b/js/games/nluqo.github.io/~bh/downloads/simply/match.scm
@@ -0,0 +1,107 @@
+(define (match pattern sent)
+  (match-using-known-values pattern sent '()))
+
+(define (match-using-known-values pattern sent known-values)
+  (cond ((empty? pattern)
+	 (if (empty? sent) known-values 'failed))
+	((special? (first pattern))
+	 (let ((placeholder (first pattern)))
+	   (match-special (first placeholder)
+			  (bf placeholder)
+			  (bf pattern)
+			  sent
+			  known-values)))
+	((empty? sent) 'failed)
+	((equal? (first pattern) (first sent))
+	 (match-using-known-values (bf pattern) (bf sent) known-values))
+	(else 'failed)))
+
+(define (special? wd)
+  (member? (first wd) '(* & ? !)))
+
+(define (match-special howmany name pattern-rest sent known-values)
+  (let ((old-value (lookup name known-values)))
+    (cond ((not (equal? old-value 'no-value))
+	   (if (length-ok? old-value howmany)
+	       (already-known-match
+		  old-value pattern-rest sent known-values)
+	       'failed))
+	  ((equal? howmany '?)
+	   (longest-match name pattern-rest sent 0 #t known-values))
+	  ((equal? howmany '!)
+	   (longest-match name pattern-rest sent 1 #t known-values))
+	  ((equal? howmany '*)
+	   (longest-match name pattern-rest sent 0 #f known-values))
+	  ((equal? howmany '&)
+	   (longest-match name pattern-rest sent 1 #f known-values)))))
+
+(define (length-ok? value howmany)
+  (cond ((empty? value) (member? howmany '(? *)))
+	((not (empty? (bf value))) (member? howmany '(* &)))
+	(else #t)))
+
+(define (already-known-match value pattern-rest sent known-values)
+  (let ((unmatched (chop-leading-substring value sent)))
+    (if (not (equal? unmatched 'failed))
+	(match-using-known-values pattern-rest unmatched known-values)
+	'failed)))
+
+(define (chop-leading-substring value sent)
+  (cond ((empty? value) sent)
+	((empty? sent) 'failed)
+	((equal? (first value) (first sent))
+	 (chop-leading-substring (bf value) (bf sent)))
+	(else 'failed)))
+
+(define (longest-match name pattern-rest sent min max-one? known-values)
+  (cond ((empty? sent)
+	 (if (= min 0)
+	     (match-using-known-values pattern-rest
+				       sent
+				       (add name '() known-values))
+	     'failed))
+	(max-one?
+	 (lm-helper name pattern-rest (se (first sent))
+		    (bf sent) min known-values))
+	(else (lm-helper name pattern-rest
+			 sent '() min known-values))))
+
+(define (lm-helper name pattern-rest
+		   sent-matched sent-unmatched min known-values)
+  (if (< (length sent-matched) min)
+      'failed
+      (let ((tentative-result (match-using-known-values
+			       pattern-rest
+			       sent-unmatched
+			       (add name sent-matched known-values))))
+	(cond ((not (equal? tentative-result 'failed)) tentative-result)
+	      ((empty? sent-matched) 'failed)
+	      (else (lm-helper name
+			       pattern-rest
+			       (bl sent-matched)
+			       (se (last sent-matched) sent-unmatched)
+			       min
+			       known-values))))))
+
+;;; Known values database abstract data type
+
+(define (lookup name known-values)
+  (cond ((empty? known-values) 'no-value)
+	((equal? (first known-values) name)
+	 (get-value (bf known-values)))
+	(else (lookup name (skip-value known-values)))))
+
+(define (get-value stuff)
+  (if (equal? (first stuff) '!)
+      '()
+      (se (first stuff) (get-value (bf stuff)))))
+
+(define (skip-value stuff)
+  (if (equal? (first stuff) '!)
+      (bf stuff)
+      (skip-value (bf stuff))))
+
+(define (add name value known-values)
+  (if (empty? name)
+      known-values
+      (se known-values name value '!)))
diff --git a/js/games/nluqo.github.io/~bh/downloads/simply/newttt.scm b/js/games/nluqo.github.io/~bh/downloads/simply/newttt.scm
new file mode 100644
index 0000000..368472e
--- /dev/null
+++ b/js/games/nluqo.github.io/~bh/downloads/simply/newttt.scm
@@ -0,0 +1,59 @@
+;;; ttt.scm
+;;; Tic-Tac-Toe program
+
+(define (ttt position me)
+  (one-okay-move (number-squares position) me))
+
+(define (one-okay-move position me)
+  (find-one (lambda (sq) (no-lose? (plug-in me sq position) me))
+	    (free-squares position)))
+
+(define (no-lose? position me)
+  (cond ((already-lost? position me) #f)
+	((already-won? position me) #t)
+	(else (not (find-one (lambda (pos) (not (one-okay-move pos me)))
+			     (extend position (opponent me)) )))))
+
+(define (free-squares pos)
+  (keep number? pos))
+
+(define (number-squares pos)
+  (ns-help pos 1))
+
+(define (ns-help pos num)
+  (cond ((empty? pos) "")
+	((equal? (first pos) '_) (word num (ns-help (bf pos) (+ num 1))))
+	(else (word (first pos) (ns-help (bf pos) (+ num 1)))) ))
+
+(define (plug-in letter sq pos)
+  (cond ((empty? pos) "")
+	((= sq 1) (word letter (bf pos)))
+	(else (word (first pos) (plug-in letter (- sq 1) (bf pos)))) ))
+
+(define (find-one pred stuff)
+  (cond ((empty? stuff) #f)
+	((pred (first stuff)) (first stuff))
+	(else (find-one pred (bf stuff))) ))
+
+(define (extend pos who)
+  (every (lambda (sq) (plug-in who sq pos))
+	 (free-squares pos)))
+
+(define (opponent letter)
+  (if (equal? letter 'x) 'o 'x))
+
+(define (already-won? pos me)
+  (find-one (lambda (win) (match-win? pos me win))
+	    '(yyynnnnnn nnnyyynnn nnnnnnyyy ynnynnynn nynnynnyn nnynnynny
+			ynnnynnny nnynynynn)))
+
+(define (already-lost? pos me)
+  (already-won? pos (opponent me)))
+
+(define (match-win? pos me win)
+  (cond ((empty? win) #t)
+	((equal? (first win) 'y)
+	 (if (equal? (first pos) me)
+	     (match-win? (bf pos) me (bf win))
+	     #f))
+	(else (match-win? (bf pos) me (bf win))) ))
diff --git a/js/games/nluqo.github.io/~bh/downloads/simply/simply.scm b/js/games/nluqo.github.io/~bh/downloads/simply/simply.scm
new file mode 100644
index 0000000..501a7da
--- /dev/null
+++ b/js/games/nluqo.github.io/~bh/downloads/simply/simply.scm
@@ -0,0 +1,1149 @@
+;;; simply.scm version 3.13 (8/11/98)
+;;; (Numbered to agree with berkeley.scm version.)
+
+
+;;; This file uses Scheme features we don't talk about in _Simply_Scheme_.
+;;; Read at your own risk.
+
+(if (equal? 'foo (symbol->string 'foo))
+    (error "Simply.scm already loaded!!")
+    #f)
+
+;; Make number->string remove leading "+" if necessary
+
+(if (char=? #\+ (string-ref (number->string 1.0) 0))
+    (let ((old-ns number->string)
+	  (char=? char=?)
+	  (string-ref string-ref)
+	  (substring substring)
+	  (string-length string-length))
+      (set! number->string
+	    (lambda args
+	      (let ((result (apply old-ns args)))
+		(if (char=? #\+ (string-ref result 0))
+		    (substring result 1 (string-length result))
+		    result)))))
+    'no-problem)
+
+(define number->string
+  (let ((old-ns number->string)
+	(string? string?))
+    (lambda args
+      (if (string? (car args))
+	  (car args)
+	  (apply old-ns args)))))
+
+;; Get strings in error messages to print nicely (especially "")
+
+(define whoops
+  (let ((string? string?)
+	(string-append string-append)
+	(error error)
+	(cons cons)
+	(map map)
+	(apply apply))
+    (define (error-printform x)
+      (if (string? x)
+	  (string-append "\"" x "\"")
+	  x))
+    (lambda (string . args)
+      (apply error (cons string (map error-printform args))))))
+
+
+;; ROUND returns an inexact integer if its argument is inexact,
+;; but we think it should always return an exact integer.
+;; (It matters because some Schemes print inexact integers as "+1.0".)
+;; The (exact 1) test is for PC Scheme, in which nothing is exact.
+(if (and (inexact? (round (sqrt 2))) (exact? 1))
+    (let ((old-round round)
+	  (inexact->exact inexact->exact))
+      (set! round
+	    (lambda (number)
+	      (inexact->exact (old-round number)))))
+    'no-problem)
+
+;; Remainder and quotient blow up if their argument isn't an integer.
+;; Unfortunately, in SCM, (* 365.25 24 60 60) *isn't* an integer.
+
+(if (inexact? (* .25 4))
+    (let ((rem remainder)
+	  (quo quotient)
+	  (inexact->exact inexact->exact)
+	  (integer? integer?))
+      (set! remainder
+	    (lambda (x y)
+	      (rem (if (integer? x) (inexact->exact x) x)
+		   (if (integer? y) (inexact->exact y) y))))
+      (set! quotient
+	    (lambda (x y)
+	      (quo (if (integer? x) (inexact->exact x) x)
+		   (if (integer? y) (inexact->exact y) y)))))
+    'done)
+
+
+;; Random
+;; If your version of Scheme has RANDOM, you should take this out.
+;; (It gives the same sequence of random numbers every time.) 
+
+(define random
+  (let ((*seed* 1) (quotient quotient) (modulo modulo) (+ +) (- -) (* *) (> >))
+    (lambda (x)
+      (let* ((hi (quotient *seed* 127773))
+	     (low (modulo *seed* 127773))
+	     (test (- (* 16807 low) (* 2836 hi))))
+	(if (> test 0)
+	    (set! *seed* test)
+	    (set! *seed* (+ test 2147483647))))
+      (modulo *seed* x))))
+
+
+;;; Logo-style word/sentence implementation
+
+(define word?
+  (let ((number? number?)
+	(symbol? symbol?)
+	(string? string?))
+    (lambda (x)
+      (or (symbol? x) (number? x) (string? x)))))
+
+(define sentence?
+  (let ((null? null?)
+	(pair? pair?)
+	(word? word?)
+	(car car)
+	(cdr cdr))    
+    (define (list-of-words? l)
+      (cond ((null? l) #t)
+	    ((pair? l)
+	     (and (word? (car l)) (list-of-words? (cdr l))))
+	    (else #f)))
+    list-of-words?))
+
+(define empty?
+  (let ((null? null?)
+	(string? string?)
+	(string=? string=?))
+    (lambda (x)
+      (or (null? x)
+	  (and (string? x) (string=? x ""))))))
+
+
+(define char-rank
+  ;; 0 Letter in good case or special initial
+  ;; 1 ., + or -
+  ;; 2 Digit
+  ;; 3 Letter in bad case or weird character
+  (let ((*the-char-ranks* (make-vector 256 3))
+	(= =)
+	(+ +)
+	(string-ref string-ref)
+	(string-length string-length)
+	(vector-set! vector-set!)
+	(char->integer char->integer)
+	(symbol->string symbol->string)
+	(vector-ref vector-ref))
+    (define (rank-string str rank)
+      (define (helper i len)
+	(if (= i len)
+	    'done
+	    (begin (vector-set! *the-char-ranks*
+				(char->integer (string-ref str i))
+				rank)
+		   (helper (+ i 1) len))))
+      (helper 0 (string-length str)))
+    (rank-string (symbol->string 'abcdefghijklmnopqrstuvwxyz) 0)
+    (rank-string "!$%&*/:<=>?~_^" 0)
+    (rank-string "+-." 1)
+    (rank-string "0123456789" 2)
+    (lambda (char)		    ;; value of char-rank
+      (vector-ref *the-char-ranks* (char->integer char)))))
+
+(define string->word
+  (let ((= =) (<= <=) (+ +) (- -)
+	(char-rank char-rank)
+	(string-ref string-ref)
+	(string-length string-length)
+	(string=? string=?)
+	(not not)
+	(char=? char=?)
+	(string->number string->number)
+	(string->symbol string->symbol))
+    (lambda (string)
+      (define (subsequents? string i length)
+	(cond ((= i length) #t)
+	      ((<= (char-rank (string-ref string i)) 2)
+	       (subsequents? string (+ i 1) length))
+	      (else #f)))
+      (define (special-id? string)
+	(or (string=? string "+")
+	    (string=? string "-")
+	    (string=? string "...")))
+      (define (ok-symbol? string)
+	(if (string=? string "")
+	    #f
+	    (let ((rank1 (char-rank (string-ref string 0))))
+	      (cond ((= rank1 0) (subsequents? string 1 (string-length string)))
+		    ((= rank1 1) (special-id? string))
+		    (else #f)))))
+      (define (nn-helper string i len seen-point?)
+	(cond ((= i len)
+	       (if seen-point?
+		   (not (char=? (string-ref string (- len 1)) #\0))
+		   #t))
+	      ((char=? #\. (string-ref string i))
+	       (cond (seen-point? #f)
+		     ((= (+ i 2) len) #t)  ; Accepts "23.0"
+		     (else (nn-helper string (+ i 1) len #t))))
+	      ((= 2 (char-rank (string-ref string i)))
+	       (nn-helper string (+ i 1) len seen-point?))
+	      (else #f)))
+      (define (narrow-number? string)
+	(if (string=? string "")
+	    #f
+	    (let* ((c0 (string-ref string 0))
+		   (start 0)
+		   (len (string-length string))
+		   (cn (string-ref string (- len 1))))
+	      (if (and (char=? c0 #\-) (not (= len 1)))
+		  (begin
+		   (set! start 1)
+		   (set! c0 (string-ref string 1)))
+		  #f)
+	      (cond ((not (= (char-rank cn) 2)) #f)  ; Rejects "-" among others
+		    ((char=? c0 #\.) #f)
+		    ((char=? c0 #\0)
+		     (cond ((= len 1) #t)  ; Accepts "0" but not "-0"
+			   ((= len 2) #f)  ; Rejects "-0" and "03"
+			   ((char=? (string-ref string (+ start 1)) #\.)
+			    (nn-helper string (+ start 2) len #t))
+			   (else #f)))
+		    (else (nn-helper string start len #f)))))) 
+
+      ;; The body of string->word:
+      (cond ((narrow-number? string) (string->number string))
+	    ((ok-symbol? string) (string->symbol string))
+	    (else string)))))
+
+(define char->word
+  (let ((= =)
+	(char-rank char-rank)
+	(make-string make-string)
+	(string->symbol string->symbol)
+	(string->number string->number)
+	(char=? char=?))
+    (lambda (char)
+      (let ((rank (char-rank char))
+	    (string (make-string 1 char)))
+	(cond ((= rank 0) (string->symbol string))
+	      ((= rank 2) (string->number string))
+	      ((char=? char #\+) '+)
+	      ((char=? char #\-) '-)
+	      (else string))))))
+
+(define word->string
+  (let ((number? number?)
+	(string? string?)
+	(number->string number->string)
+	(symbol->string symbol->string))
+    (lambda (wd)
+      (cond ((string? wd) wd)
+	    ((number? wd) (number->string wd))
+	    (else (symbol->string wd))))))
+
+(define count
+  (let ((word? word?)
+	(string-length string-length)
+	(word->string word->string)
+	(length length))
+    (lambda (stuff)
+      (if (word? stuff)
+	  (string-length (word->string stuff))
+	  (length stuff)))))
+
+(define word
+  (let ((string->word string->word)
+	(apply apply)
+	(string-append string-append)
+	(map map)
+	(word? word?)
+	(word->string word->string)
+	(whoops whoops))
+    (lambda x
+      (string->word
+       (apply string-append
+	      (map (lambda (arg)
+		     (if (word? arg)
+			 (word->string arg)
+			 (whoops "Invalid argument to WORD: " arg)))
+		   x))))))
+
+(define se
+  (let ((pair? pair?)
+	(null? null?)
+	(word? word?)
+	(car car)
+	(cons cons)
+	(cdr cdr)
+	(whoops whoops))
+    (define (paranoid-append a original-a b)
+      (cond ((null? a) b)
+	    ((word? (car a))
+	     (cons (car a) (paranoid-append (cdr a) original-a b)))
+	    (else (whoops "Argument to SENTENCE not a word or sentence"
+			 original-a ))))
+    (define (combine-two a b)                ;; Note: b is always a list
+      (cond ((pair? a) (paranoid-append a a b))
+	    ((null? a) b)
+	    ((word? a) (cons a b))
+	    (else (whoops "Argument to SENTENCE not a word or sentence:" a))))
+    ;; Helper function so recursive calls don't show up in TRACE
+    (define (real-se args)
+      (if (null? args)
+	  '()
+	  (combine-two (car args) (real-se (cdr args)))))
+    (lambda args
+      (real-se args))))
+
+(define sentence se)
+
+(define first
+  (let ((pair? pair?)
+	(char->word char->word)
+	(string-ref string-ref)
+	(word->string word->string)
+	(car car)
+	(empty? empty?)
+	(whoops whoops)
+	(word? word?))
+    (define (word-first wd)
+      (char->word (string-ref (word->string wd) 0)))
+    (lambda (x)
+      (cond ((pair? x) (car x))
+	    ((empty? x) (whoops "Invalid argument to FIRST: " x))
+	    ((word? x) (word-first x))
+	    (else (whoops "Invalid argument to FIRST: " x))))))
+
+(define last
+  (let ((pair? pair?)
+	(- -)
+	(word->string word->string)
+	(char->word char->word)
+	(string-ref string-ref)
+	(string-length string-length)
+	(empty? empty?)
+	(cdr cdr)
+	(car car)
+	(whoops whoops)
+	(word? word?))
+    (define (word-last wd)
+      (let ((s (word->string wd)))
+	(char->word (string-ref s (- (string-length s) 1)))))
+    (define (list-last lst)      
+      (if (empty? (cdr lst))
+	  (car lst)
+	  (list-last (cdr lst))))
+    (lambda (x)
+      (cond ((pair? x) (list-last x))
+	    ((empty? x) (whoops "Invalid argument to LAST: " x))
+	    ((word? x) (word-last x))
+	    (else (whoops "Invalid argument to LAST: " x))))))
+
+(define bf
+  (let ((pair? pair?)
+	(substring substring)
+	(string-length string-length)
+	(string->word string->word)
+	(word->string word->string)
+	(cdr cdr)
+	(empty? empty?)
+	(whoops whoops)
+	(word? word?))
+    (define string-bf
+      (lambda (s)
+      (substring s 1 (string-length s))))
+    (define (word-bf wd)
+      (string->word (string-bf (word->string wd))))
+    (lambda (x)
+      (cond ((pair? x) (cdr x))
+	    ((empty? x) (whoops "Invalid argument to BUTFIRST: " x))
+	    ((word? x) (word-bf x))
+	    (else (whoops "Invalid argument to BUTFIRST: " x))))))
+
+(define butfirst bf)
+
+(define bl
+  (let ((pair? pair?) (- -)
+	(cdr cdr)
+	(cons cons)
+	(car car)
+	(substring substring)
+	(string-length string-length)
+	(string->word string->word)
+	(word->string word->string)
+	(empty? empty?)
+	(whoops whoops)
+	(word? word?))
+    (define (list-bl list)
+      (if (null? (cdr list))
+	  '()
+	  (cons (car list) (list-bl (cdr list)))))
+    (define (string-bl s)
+      (substring s 0 (- (string-length s) 1)))  
+    (define (word-bl wd)
+      (string->word (string-bl (word->string wd))))
+    (lambda (x)
+      (cond ((pair? x) (list-bl x))
+	    ((empty? x) (whoops "Invalid argument to BUTLAST: " x))
+	    ((word? x) (word-bl x))
+	    (else (whoops "Invalid argument to BUTLAST: " x))))))
+
+(define butlast bl)
+
+(define item
+  (let ((> >) (- -) (< <) (integer? integer?) (list-ref list-ref)
+	(char->word char->word)
+	(string-ref string-ref)
+	(word->string word->string)
+	(not not)
+	(whoops whoops)
+	(count count)
+	(word? word?)
+	(list? list?))
+    (define (word-item n wd)
+      (char->word (string-ref (word->string wd) (- n 1))))
+    (lambda (n stuff)
+      (cond ((not (integer? n))
+	     (whoops "Invalid first argument to ITEM (must be an integer): "
+		     n))
+	    ((< n 1)
+	     (whoops "Invalid first argument to ITEM (must be positive): "
+		     n))
+	    ((> n (count stuff))
+	     (whoops "No such item: " n stuff))
+	    ((word? stuff) (word-item n stuff))
+	    ((list? stuff) (list-ref stuff (- n 1)))
+	    (else (whoops "Invalid second argument to ITEM: " stuff))))))
+
+(define equal?
+  ;; Note that EQUAL? assumes strings are numbers.
+  ;; (strings-are-numbers #f) doesn't change this behavior.
+  (let ((vector-length vector-length)
+	(= =)
+	(vector-ref vector-ref)
+	(+ +)
+	(string? string?)
+	(symbol? symbol?)
+	(null? null?)
+	(pair? pair?)
+	(car car)
+	(cdr cdr)
+	(eq? eq?)
+	(string=? string=?)
+	(symbol->string symbol->string)
+	(number? number?)
+	(string->word string->word)
+	(vector? vector?)
+	(eqv? eqv?))
+    (define (vector-equal? v1 v2)
+      (let ((len1 (vector-length v1))
+	    (len2 (vector-length v2)))
+	(define (helper i)
+	  (if (= i len1)
+	      #t
+	      (and (equal? (vector-ref v1 i) (vector-ref v2 i))
+		   (helper (+ i 1)))))
+	(if (= len1 len2)
+	    (helper 0)
+	    #f)))
+    (lambda (x y)
+      (cond ((null? x) (null? y))
+	    ((null? y) #f)
+	    ((pair? x)
+	     (and (pair? y)
+		  (equal? (car x) (car y))
+		  (equal? (cdr x) (cdr y))))
+	    ((pair? y) #f)
+	    ((symbol? x)
+	     (or (and (symbol? y) (eq? x y))
+		 (and (string? y) (string=? (symbol->string x) y))))
+	    ((symbol? y)
+	     (and (string? x) (string=? x (symbol->string y))))
+	    ((number? x)
+	     (or (and (number? y) (= x y))
+		 (and (string? y)
+		      (let ((possible-num (string->word y)))
+			(and (number? possible-num)
+			     (= x possible-num))))))
+	    ((number? y)
+	     (and (string? x)
+		  (let ((possible-num (string->word x)))
+		    (and (number? possible-num)
+			 (= possible-num y)))))
+	    ((string? x) (and (string? y) (string=? x y)))
+	    ((string? y) #f)
+	    ((vector? x) (and (vector? y) (vector-equal? x y)))
+	    ((vector? y) #f)
+	    (else (eqv? x y))))))
+
+(define member?
+  (let ((> >) (- -) (< <)
+	(null? null?)
+	(symbol? symbol?)
+	(eq? eq?)
+	(car car)
+	(not not)
+	(symbol->string symbol->string)
+	(string=? string=?)
+	(cdr cdr)
+	(equal? equal?)
+	(word->string word->string)
+	(string-length string-length)
+	(whoops whoops)
+	(string-ref string-ref)
+	(char=? char=?)
+	(list? list?)
+	(number? number?)
+	(empty? empty?)
+	(word? word?)
+	(string? string?))
+    (define (symbol-in-list? symbol string lst)
+      (cond ((null? lst) #f)
+	    ((and (symbol? (car lst))
+		  (eq? symbol (car lst))))
+	    ((string? (car lst))
+	     (cond ((not string)
+		    (symbol-in-list? symbol (symbol->string symbol) lst))
+		   ((string=? string (car lst)) #t)
+		   (else (symbol-in-list? symbol string (cdr lst)))))
+	    (else (symbol-in-list? symbol string (cdr lst)))))
+    (define (word-in-list? wd lst)
+      (cond ((null? lst) #f)
+	    ((equal? wd (car lst)) #t)
+	    (else (word-in-list? wd (cdr lst)))))
+    (define (word-in-word? small big)
+      (let ((one-letter-str (word->string small)))
+	(if (> (string-length one-letter-str) 1)
+	    (whoops "Invalid arguments to MEMBER?: " small big)
+	    (let ((big-str (word->string big)))
+	      (char-in-string? (string-ref one-letter-str 0)
+			       big-str
+			       (- (string-length big-str) 1))))))
+    (define (char-in-string? char string i)
+      (cond ((< i 0) #f)
+	    ((char=? char (string-ref string i)) #t)
+	    (else (char-in-string? char string (- i 1)))))
+    (lambda (x stuff)
+      (cond ((empty? stuff) #f)
+	    ((word? stuff) (word-in-word? x stuff))
+	    ((not (list? stuff))
+	     (whoops "Invalid second argument to MEMBER?: " stuff))
+	    ((symbol? x) (symbol-in-list? x #f stuff))
+	    ((or (number? x) (string? x))
+	     (word-in-list? x stuff))
+	    (else (whoops "Invalid first argument to MEMBER?: " x))))))
+
+(define before?
+  (let ((not not)
+	(word? word?)
+	(whoops whoops)
+	(string<? string<?)
+	(word->string word->string))
+    (lambda (wd1 wd2)
+      (cond ((not (word? wd1))
+	     (whoops "Invalid first argument to BEFORE? (not a word): " wd1))
+	    ((not (word? wd2))
+	     (whoops "Invalid second argument to BEFORE? (not a word): " wd2))
+	    (else (string<? (word->string wd1) (word->string wd2)))))))
+
+
+;;; Higher Order Functions
+
+(define filter
+  (let ((null? null?)
+	(car car)
+	(cons cons)
+	(cdr cdr)
+	(not not)
+	(procedure? procedure?)
+	(whoops whoops)
+	(list? list?))
+    (lambda (pred l)
+      ;; Helper function so recursive calls don't show up in TRACE
+      (define (real-filter l)
+	(cond ((null? l) '())
+	      ((pred (car l))
+	       (cons (car l) (real-filter (cdr l))))
+	      (else (real-filter (cdr l)))))
+      (cond ((not (procedure? pred))
+	     (whoops "Invalid first argument to FILTER (not a procedure): "
+		     pred))
+	    ((not (list? l))
+	     (whoops "Invalid second argument to FILTER (not a list): " l))
+	    (else (real-filter l))))))
+
+(define keep
+  (let ((+ +) (= =) (pair? pair?)
+	(substring substring)
+	(char->word char->word)
+	(string-ref string-ref)
+	(string-set! string-set!)
+	(word->string word->string)
+	(string-length string-length)
+	(string->word string->word)
+	(make-string make-string)
+	(procedure? procedure?)
+	(whoops whoops)
+	(word? word?)
+	(null? null?))
+    (lambda (pred w-or-s)
+      (define (keep-string in i out out-len len)
+	(cond ((= i len) (substring out 0 out-len))
+	      ((pred (char->word (string-ref in i)))
+	       (string-set! out out-len (string-ref in i))
+	       (keep-string in (+ i 1) out (+ out-len 1) len))
+	      (else (keep-string in (+ i 1) out out-len len))))
+      (define (keep-word wd)
+	(let* ((string (word->string wd))
+	       (len (string-length string)))
+	  (string->word
+	   (keep-string string 0 (make-string len) 0 len))))
+      (cond ((not (procedure? pred))
+	     (whoops "Invalid first argument to KEEP (not a procedure): "
+		    pred))
+	    ((pair? w-or-s) (filter pred w-or-s))
+	    ((word? w-or-s) (keep-word w-or-s))
+	    ((null? w-or-s) '())
+	    (else
+	     (whoops "Bad second argument to KEEP (not a word or sentence): "
+		     w-or-s))))))
+
+(define appearances
+  (let ((count count)
+	(keep keep)
+	(equal? equal?))
+    (lambda (item aggregate)
+      (count (keep (lambda (element) (equal? item element)) aggregate)))))
+
+(define every
+  (let ((= =) (+ +)
+	(se se)
+	(char->word char->word)
+	(string-ref string-ref)
+	(empty? empty?)
+	(first first)
+	(bf bf)
+	(not not)
+	(procedure? procedure?)
+	(whoops whoops)
+	(word? word?)
+	(word->string word->string)
+	(string-length string-length))
+    (lambda (fn stuff)
+      (define (string-every string i length)
+	(if (= i length)
+	    '()
+	    (se (fn (char->word (string-ref string i)))
+		(string-every string (+ i 1) length))))
+      (define (sent-every sent)
+	;; This proc. can't be optimized or else it will break the
+	;; exercise where we ask them to reimplement sentences as
+	;; vectors and then see if every still works.
+	(if (empty? sent)
+	    sent		; Can't be '() or exercise breaks.
+	    (se (fn (first sent))    
+		(sent-every (bf sent)))))
+      (cond ((not (procedure? fn))
+	     (whoops "Invalid first argument to EVERY (not a procedure):"
+		     fn))
+	    ((word? stuff)
+	     (let ((string (word->string stuff)))
+	       (string-every string 0 (string-length string))))
+	    (else (sent-every stuff))))))
+
+(define accumulate
+  (let ((not not)
+	(empty? empty?)
+	(bf bf)
+	(first first)
+	(procedure? procedure?)
+	(whoops whoops)
+	(member member)
+	(list list))
+    (lambda (combiner stuff)
+      (define (real-accumulate stuff)
+	(if (empty? (bf stuff))
+	    (first stuff)
+	    (combiner (first stuff) (real-accumulate (bf stuff)))))
+      (cond ((not (procedure? combiner))
+	     (whoops "Invalid first argument to ACCUMULATE (not a procedure):"
+		     combiner))
+	    ((not (empty? stuff)) (real-accumulate stuff))
+	    ((member combiner (list + * word se)) (combiner))
+	    (else
+	     (whoops "Can't accumulate empty input with that combiner"))))))
+
+(define reduce
+  (let ((null? null?)
+	(cdr cdr)
+	(car car)
+	(not not)
+	(procedure? procedure?)
+	(whoops whoops)
+	(member member)
+	(list list))
+    (lambda (combiner stuff)
+      (define (real-reduce stuff)
+	(if (null? (cdr stuff))
+	    (car stuff)
+	    (combiner (car stuff) (real-reduce (cdr stuff)))))
+      (cond ((not (procedure? combiner))
+	     (whoops "Invalid first argument to REDUCE (not a procedure):"
+		     combiner))
+	    ((not (null? stuff)) (real-reduce stuff))
+	    ((member combiner (list + * word se append)) (combiner))
+	    (else (whoops "Can't reduce empty input with that combiner"))))))
+
+(define repeated
+  (let ((= =) (- -))
+    (lambda (fn number)
+      (if (= number 0)
+	  (lambda (x) x)
+	  (lambda (x)
+	    ((repeated fn (- number 1)) (fn x)))))))
+
+
+;; Tree stuff
+(define make-node cons)
+(define datum car)
+(define children cdr)
+
+
+;; I/O
+        
+(define show
+  (let ((= =)
+	(length length)
+	(display display)
+	(car car)
+	(newline newline)
+	(not not)
+	(output-port? output-port?)
+	(apply apply)
+	(whoops whoops))
+    (lambda args
+      (cond
+       ((= (length args) 1)
+	(display (car args))
+	(newline))
+       ((= (length args) 2)
+	(if (not (output-port? (car (cdr args))))
+	    (whoops "Invalid second argument to SHOW (not an output port): "
+		    (car (cdr args))))
+	(apply display args)
+	(newline (car (cdr args))))
+       (else (whoops "Incorrect number of arguments to procedure SHOW"))))))
+
+(define show-line
+  (let ((>= >=)
+	(length length)
+	(whoops whoops)
+	(null? null?)
+	(current-output-port current-output-port)
+	(car car)
+	(not not)
+	(list? list?)
+	(display display)
+	(for-each for-each)
+	(cdr cdr)
+	(newline newline))
+    (lambda (line . args)
+      (if (>= (length args) 2)
+	  (whoops "Too many arguments to show-line")
+	  (let ((port (if (null? args) (current-output-port) (car args))))
+	    (cond ((not (list? line))
+		   (whoops "Invalid argument to SHOW-LINE (not a list):" line))
+		  ((null? line) #f)
+		  (else
+		   (display (car line) port)
+		   (for-each (lambda (wd) (display " " port) (display wd port))
+			     (cdr line))))
+	    (newline port))))))
+
+(define read-string
+  (let ((read-char read-char)
+	(eqv? eqv?)
+	(apply apply)
+	(string-append string-append)
+	(substring substring)
+	(reverse reverse)
+	(cons cons)
+	(>= >=) (+ +)
+	(string-set! string-set!)
+	(length length)
+	(whoops whoops)
+	(null? null?)
+	(current-input-port current-input-port)
+	(car car)
+	(cdr cdr)
+	(eof-object? eof-object?)
+	(list list)
+	(make-string make-string)
+	(peek-char peek-char))
+    (define (read-string-helper chars all-length chunk-length port)
+      (let ((char (read-char port))
+	    (string (car chars)))
+	(cond ((or (eof-object? char) (eqv? char #\newline))
+	       (apply string-append
+		      (reverse
+		       (cons
+			(substring (car chars) 0 chunk-length)
+			(cdr chars)))))
+	      ((>= chunk-length 80)
+	       (let ((newstring (make-string 80)))
+		 (string-set! newstring 0 char)
+		 (read-string-helper (cons newstring chars)
+				     (+ all-length 1)
+				     1
+				     port)))
+	      (else
+	       (string-set! string chunk-length char)
+	       (read-string-helper chars
+				   (+ all-length 1)
+				   (+ chunk-length 1)
+				   port)))))
+    (lambda args
+      (if (>= (length args) 2)
+	  (whoops "Too many arguments to read-string")
+	  (let ((port (if (null? args) (current-input-port) (car args))))
+	    (if (eof-object? (peek-char port))
+		(read-char port)
+		(read-string-helper (list (make-string 80)) 0 0 port)))))))
+
+(define read-line
+  (let ((= =)
+	(list list)
+	(string->word string->word)
+	(substring substring)
+	(char-whitespace? char-whitespace?)
+	(string-ref string-ref)
+	(+ +)
+	(string-length string-length)
+	(apply apply)
+	(read-string read-string))
+    (lambda args
+      (define (tokenize string)
+	(define (helper i start len)
+	  (cond ((= i len)
+		 (if (= i start)
+		     '()
+		     (list (string->word (substring string start i)))))
+		((char-whitespace? (string-ref string i))
+		 (if (= i start)
+		     (helper (+ i 1) (+ i 1) len)
+		     (cons (string->word (substring string start i))
+			   (helper (+ i 1) (+ i 1) len))))
+		(else (helper (+ i 1) start len))))
+        (if (eof-object? string)
+            string
+            (helper 0 0 (string-length string))))
+      (tokenize (apply read-string args)))))
+
+(define *the-open-inports* '())
+(define *the-open-outports* '())
+
+(define align
+  (let ((< <) (abs abs) (* *) (expt expt) (>= >=) (- -) (+ +) (= =)
+	(null? null?)
+	(car car)
+	(round round)
+	(number->string number->string)
+	(string-length string-length)
+	(string-append string-append)
+	(make-string make-string)
+	(substring substring)
+	(string-set! string-set!)
+	(number? number?)
+	(word->string word->string))
+    (lambda (obj width . rest)
+      (define (align-number obj width rest)
+	(let* ((sign (< obj 0))
+	       (num (abs obj))
+	       (prec (if (null? rest) 0 (car rest)))
+	       (big (round (* num (expt 10 prec))))
+	       (cvt0 (number->string big))
+	       (cvt (if (< num 1) (string-append "0" cvt0) cvt0))
+	       (pos-str (if (>= (string-length cvt0) prec)
+			    cvt
+			    (string-append
+			     (make-string (- prec (string-length cvt0)) #\0)
+			     cvt)))
+	       (string (if sign (string-append "-" pos-str) pos-str))
+	       (length (+ (string-length string)
+			  (if (= prec 0) 0 1)))
+	       (left (- length (+ 1 prec)))
+	       (result (if (= prec 0)
+			   string
+			   (string-append
+			    (substring string 0 left)
+			    "."
+			    (substring string left (- length 1))))))
+	  (cond ((= length width) result)
+		((< length width)
+		 (string-append (make-string (- width length) #\space) result))
+		(else (let ((new (substring result 0 width)))
+			(string-set! new (- width 1) #\+)
+			new)))))
+      (define (align-word string)
+	(let ((length (string-length string)))
+	  (cond ((= length width) string)
+		((< length width)
+		 (string-append string (make-string (- width length) #\space)))
+		(else (let ((new (substring string 0 width)))
+			(string-set! new (- width 1) #\+)
+			new)))))
+      (if (number? obj)
+	  (align-number obj width rest)
+	  (align-word (word->string obj))))))
+
+(define open-output-file
+  (let ((oof open-output-file)
+	(cons cons))
+    (lambda (filename)
+      (let ((port (oof filename)))
+	(set! *the-open-outports* (cons port *the-open-outports*))
+	port))))
+
+(define open-input-file
+  (let ((oif open-input-file)
+	(cons cons))
+    (lambda (filename)
+      (let ((port (oif filename)))
+	(set! *the-open-inports* (cons port *the-open-inports*))
+	port))))
+
+(define remove!
+  (let ((null? null?)
+	(cdr cdr)
+	(eq? eq?)
+	(set-cdr! set-cdr!)
+	(car car))
+    (lambda (thing lst)
+      (define (r! prev)
+	(cond ((null? (cdr prev)) lst)
+	      ((eq? thing (car (cdr prev)))
+	       (set-cdr! prev (cdr (cdr prev)))
+	       lst)
+	      (else (r! (cdr prev)))))
+      (cond ((null? lst) lst)
+	    ((eq? thing (car lst)) (cdr lst))
+	    (else (r! lst))))))
+
+(define close-input-port
+  (let ((cip close-input-port)
+	(remove! remove!))
+    (lambda (port)
+      (set! *the-open-inports* (remove! port *the-open-inports*))
+      (cip port))))
+
+(define close-output-port
+  (let ((cop close-output-port)
+	(remove! remove!))
+    (lambda (port)
+      (set! *the-open-outports* (remove! port *the-open-outports*))
+      (cop port))))
+
+(define close-all-ports
+  (let ((for-each for-each)
+	(close-input-port close-input-port)
+	(close-output-port close-output-port))
+    (lambda ()
+      (for-each close-input-port *the-open-inports*)
+      (for-each close-output-port *the-open-outports*)
+      'closed)))
+
+;; Make arithmetic work on numbers in string form:
+(define maybe-num
+  (let ((string? string?)
+    	(string->number string->number))
+    (lambda (arg)
+      (if (string? arg)
+	  (let ((num (string->number arg)))
+	    (if num num arg))
+	  arg))))
+
+(define logoize
+  (let ((apply apply)
+	(map map)
+	(maybe-num maybe-num))
+    (lambda (fn)
+      (lambda args
+	(apply fn (map maybe-num args))))))
+
+;; special case versions of logoize, since (lambda args ...) is expensive
+(define logoize-1
+  (let ((maybe-num maybe-num))
+    (lambda (fn)
+      (lambda (x) (fn (maybe-num x))))))
+
+(define logoize-2
+  (let ((maybe-num maybe-num))
+    (lambda (fn)
+      (lambda (x y) (fn (maybe-num x) (maybe-num y))))))
+
+(define strings-are-numbers
+  (let ((are-they? #f)
+        (real-* *)
+        (real-+ +)
+        (real-- -)
+        (real-/ /)
+        (real-< <)
+        (real-<= <=)
+        (real-= =)
+        (real-> >)
+        (real->= >=)
+        (real-abs abs)
+        (real-acos acos)
+        (real-asin asin)
+        (real-atan atan)
+        (real-ceiling ceiling)
+        (real-cos cos)
+        (real-even? even?)
+        (real-exp exp)
+        (real-expt expt)
+        (real-floor floor)
+	(real-align align)
+        (real-gcd gcd)
+        (real-integer? integer?)
+        (real-item item)
+        (real-lcm lcm)
+        (real-list-ref list-ref)
+        (real-log log)
+        (real-make-vector make-vector)
+        (real-max max)
+        (real-min min)
+        (real-modulo modulo)
+        (real-negative? negative?)
+        (real-number? number?)
+        (real-odd? odd?)
+        (real-positive? positive?)
+        (real-quotient quotient)
+        (real-random random)
+        (real-remainder remainder)
+        (real-repeated repeated)
+        (real-round round)
+        (real-sin sin)
+        (real-sqrt sqrt)
+        (real-tan tan)
+        (real-truncate truncate)
+        (real-vector-ref vector-ref)
+        (real-vector-set! vector-set!)
+        (real-zero? zero?)
+	(maybe-num maybe-num)
+	(number->string number->string)
+	(cons cons)
+	(car car)
+	(cdr cdr)
+	(eq? eq?)
+	(show show)
+	(logoize logoize)
+	(logoize-1 logoize-1)
+	(logoize-2 logoize-2)
+	(not not)
+	(whoops whoops))
+
+    (lambda (yesno)
+      (cond ((and are-they? (eq? yesno #t))
+	     (show "Strings are already numbers"))
+	    ((eq? yesno #t)
+	     (set! are-they? #t)
+	     (set! * (logoize real-*))
+	     (set! + (logoize real-+))
+	     (set! - (logoize real--))
+	     (set! / (logoize real-/))
+	     (set! < (logoize real-<))
+	     (set! <= (logoize real-<=))
+	     (set! = (logoize real-=))
+	     (set! > (logoize real->))
+	     (set! >= (logoize real->=))
+	     (set! abs (logoize-1 real-abs))
+	     (set! acos (logoize-1 real-acos))
+	     (set! asin (logoize-1 real-asin))
+	     (set! atan (logoize real-atan))
+	     (set! ceiling (logoize-1 real-ceiling))
+	     (set! cos (logoize-1 real-cos))
+	     (set! even? (logoize-1 real-even?))
+	     (set! exp (logoize-1 real-exp))
+	     (set! expt (logoize-2 real-expt))
+	     (set! floor (logoize-1 real-floor))
+	     (set! align (logoize align))
+	     (set! gcd (logoize real-gcd))
+	     (set! integer? (logoize-1 real-integer?))
+	     (set! item (lambda (n stuff)
+			  (real-item (maybe-num n) stuff)))
+	     (set! lcm (logoize real-lcm))
+	     (set! list-ref (lambda (lst k) 
+			      (real-list-ref lst (maybe-num k))))
+	     (set! log (logoize-1 real-log))
+	     (set! max (logoize real-max))
+	     (set! min (logoize real-min))
+	     (set! modulo (logoize-2 real-modulo))
+	     (set! negative? (logoize-1 real-negative?))
+	     (set! number? (logoize-1 real-number?))
+	     (set! odd? (logoize-1 real-odd?))
+	     (set! positive? (logoize-1 real-positive?))
+	     (set! quotient (logoize-2 real-quotient))
+	     (set! random (logoize real-random))
+	     (set! remainder (logoize-2 real-remainder))
+	     (set! round (logoize-1 real-round))
+	     (set! sin (logoize-1 real-sin))
+	     (set! sqrt (logoize-1 real-sqrt))
+
+	     (set! tan (logoize-1 real-tan))
+	     (set! truncate (logoize-1 real-truncate))
+	     (set! zero? (logoize-1 real-zero?))
+	     (set! vector-ref
+		   (lambda (vec i) (real-vector-ref vec (maybe-num i))))
+	     (set! vector-set!
+		   (lambda (vec i val)
+		     (real-vector-set! vec (maybe-num i) val)))
+	     (set! make-vector
+		   (lambda (num . args)
+		     (apply real-make-vector (cons (maybe-num num)
+						   args))))
+	     (set! list-ref
+		   (lambda (lst i) (real-list-ref lst (maybe-num i))))
+	     (set! repeated
+		   (lambda (fn n) (real-repeated fn (maybe-num n)))))
+	    ((and (not are-they?) (not yesno))
+	     (show "Strings are already not numbers"))
+	    ((not yesno)
+	     (set! are-they? #f) (set! * real-*) (set! + real-+)
+	     (set! - real--) (set! / real-/) (set! < real-<)
+	     (set! <= real-<=) (set! = real-=) (set! > real->)
+	     (set! >= real->=) (set! abs real-abs) (set! acos real-acos)
+	     (set! asin real-asin) (set! atan real-atan)
+	     (set! ceiling real-ceiling) (set! cos real-cos)
+	     (set! even? real-even?)
+	     (set! exp real-exp) (set! expt real-expt)
+	     (set! floor real-floor) (set! align real-align)
+	     (set! gcd real-gcd) (set! integer? real-integer?)
+	     (set! item real-item)
+	     (set! lcm real-lcm) (set! list-ref real-list-ref)
+	     (set! log real-log) (set! max real-max) (set! min real-min)
+	     (set! modulo real-modulo) (set! odd? real-odd?)
+	     (set! quotient real-quotient) (set! random real-random)
+	     (set! remainder real-remainder) (set! round real-round)
+	     (set! sin real-sin) (set! sqrt real-sqrt) (set! tan real-tan)
+	     (set! truncate real-truncate) (set! zero? real-zero?)
+	     (set! positive? real-positive?) (set! negative? real-negative?)
+	     (set! number? real-number?) (set! vector-ref real-vector-ref)
+	     (set! vector-set! real-vector-set!)
+	     (set! make-vector real-make-vector)
+	     (set! list-ref real-list-ref) (set! item real-item)
+	     (set! repeated real-repeated))
+	    (else (whoops "Strings-are-numbers: give a #t or a #f")))
+	    are-they?)))
+
+
+;; By default, strings are numbers:
+(strings-are-numbers #t)
diff --git a/js/games/nluqo.github.io/~bh/downloads/simply/spread.scm b/js/games/nluqo.github.io/~bh/downloads/simply/spread.scm
new file mode 100644
index 0000000..d52ebab
--- /dev/null
+++ b/js/games/nluqo.github.io/~bh/downloads/simply/spread.scm
@@ -0,0 +1,550 @@
+(define (spreadsheet)
+  (init-array)
+  (set-selection-cell-id! (make-id 1 1))
+  (set-screen-corner-cell-id! (make-id 1 1))
+  (command-loop))
+
+(define (command-loop)
+  (print-screen)
+  (let ((command-or-formula (read)))
+    (if (equal? command-or-formula 'exit)
+	"Bye!"
+	(begin (process-command command-or-formula)
+	       (command-loop)))))
+
+(define (process-command command-or-formula)
+  (cond ((and (list? command-or-formula)
+	      (command? (car command-or-formula)))
+	 (execute-command command-or-formula))
+	((command? command-or-formula)
+	 (execute-command (list command-or-formula 1)))
+	(else (exhibit (ss-eval (pin-down command-or-formula
+					  (selection-cell-id)))))))
+
+(define (execute-command command)
+  (apply (get-command (car command))
+	 (cdr command)))
+
+(define (exhibit val)
+  (show val)
+  (show "Type RETURN to redraw screen")
+  (read-line)
+  (read-line))
+
+
+;;; Commands
+
+;; Cell selection commands: F, B, N, P, and SELECT
+
+(define (prev-row delta)
+  (let ((row (id-row (selection-cell-id))))
+    (if (< (- row delta) 1)
+	(error "Already at top.")
+	(set-selected-row! (- row delta)))))
+
+(define (next-row delta)
+  (let ((row (id-row (selection-cell-id))))
+    (if (> (+ row delta) 30)
+	(error "Already at bottom.")
+	(set-selected-row! (+ row delta)))))
+
+(define (prev-col delta)
+  (let ((col (id-column (selection-cell-id))))
+    (if (< (- col delta) 1)
+	(error "Already at left.")
+	(set-selected-column! (- col delta)))))
+
+(define (next-col delta)
+  (let ((col (id-column (selection-cell-id))))
+    (if (> (+ col delta) 26)
+	(error "Already at right.")
+	(set-selected-column! (+ col delta)))))
+
+(define (set-selected-row! new-row)
+  (select-id! (make-id (id-column (selection-cell-id)) new-row)))
+
+(define (set-selected-column! new-column)
+  (select-id! (make-id new-column (id-row (selection-cell-id)))))
+
+(define (select-id! id)
+  (set-selection-cell-id! id)
+  (adjust-screen-boundaries))
+
+(define (select cell-name)
+  (select-id! (cell-name->id cell-name)))
+
+(define (adjust-screen-boundaries)
+  (let ((row (id-row (selection-cell-id)))
+	(col (id-column (selection-cell-id))))
+    (if (< row (id-row (screen-corner-cell-id)))
+	(set-corner-row! row)
+	'do-nothing)
+    (if (>= row (+ (id-row (screen-corner-cell-id)) 20))
+	(set-corner-row! (- row 19))
+	'do-nothing)
+    (if (< col (id-column (screen-corner-cell-id)))
+	(set-corner-column! col)
+	'do-nothing)
+    (if (>= col (+ (id-column (screen-corner-cell-id)) 6))
+	(set-corner-column! (- col 5))
+	'do-nothing)))
+
+(define (set-corner-row! new-row)
+  (set-screen-corner-cell-id!
+   (make-id (id-column (screen-corner-cell-id)) new-row)))
+
+(define (set-corner-column! new-column)
+  (set-screen-corner-cell-id!
+   (make-id new-column (id-row (screen-corner-cell-id)))))
+
+
+;; LOAD
+
+(define (spreadsheet-load filename)
+  (let ((port (open-input-file filename)))
+    (sl-helper port)
+    (close-input-port port)))
+
+(define (sl-helper port)
+  (let ((command (read port)))
+    (if (eof-object? command)
+	'done
+	(begin (show command)
+	       (process-command command)
+	       (sl-helper port)))))
+
+
+;; PUT
+
+(define (put formula . where)
+  (cond ((null? where)
+	 (put-formula-in-cell formula (selection-cell-id)))
+	((cell-name? (car where))
+	 (put-formula-in-cell formula (cell-name->id (car where))))
+	((number? (car where))
+	 (put-all-cells-in-row formula (car where)))
+	((letter? (car where))
+	 (put-all-cells-in-col formula (letter->number (car where))))
+	(else (error "Put it where?"))))
+
+(define (put-all-cells-in-row formula row)
+  (put-all-helper formula (lambda (col) (make-id col row)) 1 26))
+
+(define (put-all-cells-in-col formula col)
+  (put-all-helper formula (lambda (row) (make-id col row)) 1 30))
+
+(define (put-all-helper formula id-maker this max)
+  (if (> this max)
+      'done
+      (begin (try-putting formula (id-maker this))
+	     (put-all-helper formula id-maker (+ 1 this) max))))
+
+(define (try-putting formula id)
+  (if (or (null? (cell-value id)) (null? formula))
+      (put-formula-in-cell formula id)
+      'do-nothing))
+
+(define (put-formula-in-cell formula id)
+  (put-expr (pin-down formula id) id))
+
+
+;;; The Association List of Commands
+
+(define (command? name)
+  (assoc name *the-commands*))
+
+(define (get-command name)
+  (let ((result (assoc name *the-commands*)))
+    (if (not result)
+	#f
+	(cadr result))))
+
+(define *the-commands*
+  (list (list 'p prev-row)
+	(list 'n next-row)
+	(list 'b prev-col)
+	(list 'f next-col)
+	(list 'select select)
+	(list 'put put)
+	(list 'load spreadsheet-load)))
+
+
+;;; Pinning Down Formulas Into Expressions
+
+(define (pin-down formula id)
+  (cond ((cell-name? formula) (cell-name->id formula))
+	((word? formula) formula)
+	((null? formula) '())
+	((equal? (car formula) 'cell)
+	 (pin-down-cell (cdr formula) id))
+	(else (bound-check
+	       (map (lambda (subformula) (pin-down subformula id))
+		    formula)))))
+
+(define (bound-check form)
+  (if (member 'out-of-bounds form)
+      'out-of-bounds
+      form))
+
+(define (pin-down-cell args reference-id)
+  (cond ((null? args)
+	 (error "Bad cell specification: (cell)"))
+	((null? (cdr args))
+	 (cond ((number? (car args))         ; they chose a row
+		(make-id (id-column reference-id) (car args)))
+	       ((letter? (car args))         ; they chose a column
+		(make-id (letter->number (car args))
+			 (id-row reference-id)))
+	       (else (error "Bad cell specification:"
+			    (cons 'cell args)))))
+	(else
+	 (let ((col (pin-down-col (car args) (id-column reference-id)))
+	       (row (pin-down-row (cadr args) (id-row reference-id))))
+	   (if (and (>= col 1) (<= col 26) (>= row 1) (<= row 30))
+	       (make-id col row)
+	       'out-of-bounds)))))
+
+(define (pin-down-col new old)
+  (cond ((equal? new '*) old)
+	((equal? (first new) '>) (+ old (bf new)))
+	((equal? (first new) '<) (- old (bf new)))
+	((letter? new) (letter->number new))
+	(else (error "What column?"))))
+
+(define (pin-down-row new old)
+  (cond ((number? new) new)
+	((equal? new '*) old)
+	((equal? (first new) '>) (+ old (bf new)))
+	((equal? (first new) '<) (- old (bf new)))
+	(else (error "What row?"))))
+
+
+;;; Dependency Management
+
+(define (put-expr expr-or-out-of-bounds id)
+  (let ((expr (if (equal? expr-or-out-of-bounds 'out-of-bounds)
+		  '()
+		  expr-or-out-of-bounds)))
+    (for-each (lambda (old-parent)
+		(set-cell-children!
+		 old-parent
+		 (remove id (cell-children old-parent))))
+	      (cell-parents id))
+    (set-cell-expr! id expr)
+    (set-cell-parents! id (remdup (extract-ids expr)))
+    (for-each (lambda (new-parent)
+		(set-cell-children!
+		 new-parent
+		 (cons id (cell-children new-parent))))
+	      (cell-parents id))
+    (figure id)))
+
+(define (extract-ids expr)
+  (cond ((id? expr) (list expr))
+	((word? expr) '())
+	((null? expr) '())
+	(else (append (extract-ids (car expr))
+		      (extract-ids (cdr expr))))))
+
+(define (figure id)
+  (cond ((null? (cell-expr id)) (setvalue id '()))
+	((all-evaluated? (cell-parents id))
+	 (setvalue id (ss-eval (cell-expr id))))
+	(else (setvalue id '()))))
+
+(define (all-evaluated? ids)
+  (cond ((null? ids) #t)
+	((not (number? (cell-value (car ids)))) #f)
+	(else (all-evaluated? (cdr ids)))))
+
+(define (setvalue id value)
+  (let ((old (cell-value id)))
+    (set-cell-value! id value)
+    (if (not (equal? old value))
+	(for-each figure (cell-children id))
+	'do-nothing)))
+
+
+;;; Evaluating Expressions
+
+(define (ss-eval expr)
+  (cond ((number? expr) expr)
+	((quoted? expr) (quoted-value expr))
+	((id? expr) (cell-value expr))
+	((invocation? expr)
+	 (apply (get-function (car expr))
+		(map ss-eval (cdr expr))))
+	(else (error "Invalid expression:" expr))))
+
+(define (quoted? expr)
+  (or (string? expr)
+      (and (list? expr) (equal? (car expr) 'quote))))
+
+(define (quoted-value expr)
+  (if (string? expr)
+      expr
+      (cadr expr)))
+
+(define (invocation? expr)
+  (list? expr))
+
+(define (get-function name)
+  (let ((result (assoc name *the-functions*)))
+    (if (not result)
+	(error "No such function: " name)
+	(cadr result))))
+
+(define *the-functions*
+  (list (list '* *)
+	(list '+ +)
+	(list '- -)
+	(list '/ /)
+	(list 'abs abs)
+	(list 'acos acos)
+	(list 'asin asin)
+	(list 'atan atan)
+	(list 'ceiling ceiling)
+	(list 'cos cos)
+	(list 'count count)
+	(list 'exp exp)
+	(list 'expt expt)
+	(list 'floor floor)
+	(list 'gcd gcd)
+	(list 'lcm lcm)
+	(list 'log log)
+	(list 'max max)
+	(list 'min min)
+	(list 'modulo modulo)
+	(list 'quotient quotient)
+	(list 'remainder remainder)
+	(list 'round round)
+	(list 'sin sin)
+	(list 'sqrt sqrt)
+	(list 'tan tan)
+	(list 'truncate truncate)))
+
+;;; Printing the Screen
+
+(define (print-screen)
+  (newline)
+  (newline)
+  (newline)
+  (show-column-labels (id-column (screen-corner-cell-id)))
+  (show-rows 20
+	     (id-column (screen-corner-cell-id))
+	     (id-row (screen-corner-cell-id)))
+  (display-cell-name (selection-cell-id))
+  (display ":  ")
+  (show (cell-value (selection-cell-id)))
+  (display-expression (cell-expr (selection-cell-id)))
+  (newline)
+  (display "?? "))
+
+(define (display-cell-name id)
+  (display (number->letter (id-column id)))
+  (display (id-row id)))
+
+(define (show-column-labels col-number)
+  (display "  ")
+  (show-label 6 col-number)
+  (newline))
+
+(define (show-label to-go this-col-number)
+  (cond ((= to-go 0) '())
+	(else
+	 (display "  -----")
+	 (display (number->letter this-col-number))
+	 (display "----")
+	 (show-label (- to-go 1) (+ 1 this-col-number)))))
+
+(define (show-rows to-go col row)
+  (cond ((= to-go 0) 'done)
+	(else
+	 (display (align row 2 0))
+	 (display " ")
+	 (show-row 6 col row)
+	 (newline)
+	 (show-rows (- to-go 1) col (+ row 1)))))
+
+(define (show-row to-go col row)
+  (cond ((= to-go 0) 'done)
+	(else
+	   (display (if (selected-indices? col row) ">" " "))
+	   (display-value (cell-value-from-indices col row))
+	   (display (if (selected-indices? col row) "<" " "))
+	   (show-row (- to-go 1) (+ 1 col) row))))
+
+(define (selected-indices? col row)
+  (and (= col (id-column (selection-cell-id)))
+       (= row (id-row (selection-cell-id)))))
+
+(define (display-value val)
+  (display (align (if (null? val) "" val) 10 2)))
+
+(define (display-expression expr)
+  (cond ((null? expr) (display '()))
+	((quoted? expr) (display (quoted-value expr)))
+	((word? expr) (display expr))
+	((id? expr)
+	 (display-cell-name expr))
+	(else (display-invocation expr))))
+
+(define (display-invocation expr)
+  (display "(")
+  (display-expression (car expr))
+  (for-each (lambda (subexpr)
+	      (display " ")
+	      (display-expression subexpr))
+	    (cdr expr))
+  (display ")"))
+      
+
+;;; Abstract Data Types
+
+;; Special cells: the selected cell and the screen corner
+
+(define *special-cells* (make-vector 2))
+
+(define (selection-cell-id)
+  (vector-ref *special-cells* 0))
+
+(define (set-selection-cell-id! new-id)
+  (vector-set! *special-cells* 0 new-id))
+
+(define (screen-corner-cell-id)
+  (vector-ref *special-cells* 1))
+
+(define (set-screen-corner-cell-id! new-id)
+  (vector-set! *special-cells* 1 new-id))
+
+
+;; Cell names
+
+(define (cell-name? expr)
+  (and (word? expr)
+       (letter? (first expr))
+       (number? (bf expr))))
+
+(define (cell-name-column cell-name)
+  (letter->number (first cell-name)))
+
+(define (cell-name-row cell-name)
+  (bf cell-name))
+
+(define (cell-name->id cell-name)
+  (make-id (cell-name-column cell-name)
+	   (cell-name-row cell-name)))
+	
+;; Cell IDs
+
+(define (make-id col row)
+  (list 'id col row))
+
+(define (id-column id)
+  (cadr id))
+
+(define (id-row id)
+  (caddr id))
+
+(define (id? x)
+  (and (list? x)
+       (not (null? x))
+       (equal? 'id (car x))))
+
+;; Cells
+
+(define (make-cell)
+  (vector '() '() '() '()))
+
+(define (cell-value id)
+  (vector-ref (cell-structure id) 0))
+
+(define (cell-value-from-indices col row)
+  (vector-ref (cell-structure-from-indices col row) 0))
+
+(define (cell-expr id)
+  (vector-ref (cell-structure id) 1))
+
+(define (cell-parents id)
+  (vector-ref (cell-structure id) 2))
+
+(define (cell-children id)
+  (vector-ref (cell-structure id) 3))
+
+(define (set-cell-value! id val)
+  (vector-set! (cell-structure id) 0 val))
+
+(define (set-cell-expr! id val)
+  (vector-set! (cell-structure id) 1 val))
+
+(define (set-cell-parents! id val)
+  (vector-set! (cell-structure id) 2 val))
+
+(define (set-cell-children! id val)
+  (vector-set! (cell-structure id) 3 val))
+
+(define (cell-structure id)
+  (global-array-lookup (id-column id)
+		       (id-row id)))
+
+(define (cell-structure-from-indices col row)
+  (global-array-lookup col row))
+
+(define *the-spreadsheet-array* (make-vector 30))
+
+(define (global-array-lookup col row)
+  (if (and (<= row 30) (<= col 26))
+      (vector-ref (vector-ref *the-spreadsheet-array* (- row 1))
+		  (- col 1))
+      (error "Out of bounds")))
+
+(define (init-array)
+  (fill-array-with-rows 29))
+
+(define (fill-array-with-rows n)
+  (if (< n 0)
+      'done
+      (begin (vector-set! *the-spreadsheet-array* n (make-vector 26))
+	     (fill-row-with-cells
+	      (vector-ref *the-spreadsheet-array* n) 25)
+	     (fill-array-with-rows (- n 1)))))
+
+(define (fill-row-with-cells vec n)
+  (if (< n 0)
+      'done
+      (begin (vector-set! vec n (make-cell))
+	     (fill-row-with-cells vec (- n 1)))))
+
+;;; Utility Functions
+
+(define alphabet
+  '#(a b c d e f g h i j k l m n o p q r s t u v w x y z))
+
+(define (letter? something)
+  (and (word? something)
+       (= 1 (count something))
+       (vector-member something alphabet)))
+
+(define (number->letter num)
+  (vector-ref alphabet (- num 1)))
+
+(define (letter->number letter)
+  (+ (vector-member letter alphabet) 1))
+
+(define (vector-member thing vector)
+  (vector-member-helper thing vector 0))
+
+(define (vector-member-helper thing vector index)
+  (cond ((= index (vector-length vector)) #f)
+	((equal? thing (vector-ref vector index)) index)
+	(else (vector-member-helper thing vector (+ 1 index)))))
+
+(define (remdup lst)
+  (cond ((null? lst) '())
+	((member (car lst) (cdr lst))
+	 (remdup (cdr lst)))
+	(else (cons (car lst) (remdup (cdr lst))))))
+
+(define (remove bad-item lst)
+  (filter (lambda (item) (not (equal? item bad-item)))
+	  lst))
diff --git a/js/games/nluqo.github.io/~bh/downloads/simply/ttt.scm b/js/games/nluqo.github.io/~bh/downloads/simply/ttt.scm
new file mode 100644
index 0000000..71adb0b
--- /dev/null
+++ b/js/games/nluqo.github.io/~bh/downloads/simply/ttt.scm
@@ -0,0 +1,102 @@
+;;; ttt.scm
+;;; Tic-Tac-Toe program
+
+(define (ttt position me)
+  (ttt-choose (find-triples position) me))
+
+(define (find-triples position)
+  (every (lambda (comb) (substitute-triple comb position))
+         '(123 456 789 147 258 369 159 357)))
+
+(define (substitute-triple combination position)
+  (accumulate word
+	      (every (lambda (square)
+		       (substitute-letter square position))
+		     combination) ))
+
+(define (substitute-letter square position)
+  (if (equal? '_ (item square position))
+      square
+      (item square position) ))
+
+(define (ttt-choose triples me)
+  (cond ((i-can-win? triples me))
+        ((opponent-can-win? triples me))
+        ((i-can-fork? triples me))
+        ((i-can-advance? triples me))
+        (else (best-free-square triples)) ))
+
+(define (i-can-win? triples me)
+  (choose-win
+   (keep (lambda (triple) (my-pair? triple me))
+         triples)))
+
+(define (my-pair? triple me)
+  (and (= (appearances me triple) 2)
+       (= (appearances (opponent me) triple) 0)))
+
+(define (opponent letter)
+  (if (equal? letter 'x) 'o 'x))
+
+(define (choose-win winning-triples)
+  (if (empty? winning-triples)
+      #f
+      (keep number? (first winning-triples)) ))
+
+(define (opponent-can-win? triples me)
+  (i-can-win? triples (opponent me)) )
+
+(define (i-can-fork? triples me)
+  (first-if-any (pivots triples me)) )
+
+(define (first-if-any sent)
+  (if (empty? sent)
+      #f
+      (first sent) ))
+
+(define (pivots triples me)
+  (repeated-numbers (keep (lambda (triple) (my-single? triple me))
+                          triples)))
+
+(define (my-single? triple me)
+  (and (= (appearances me triple) 1)
+       (= (appearances (opponent me) triple) 0)))
+
+(define (repeated-numbers sent)
+  (every first
+         (keep (lambda (wd) (>= (count wd) 2))
+               (sort-digits (accumulate word sent)) )))
+
+(define (sort-digits number-word)
+  (every (lambda (digit) (extract-digit digit number-word))
+         '(1 2 3 4 5 6 7 8 9) ))
+
+(define (extract-digit desired-digit wd)
+  (keep (lambda (wd-digit) (equal? wd-digit desired-digit)) wd))
+
+(define (i-can-advance? triples me)
+  (best-move (keep (lambda (triple) (my-single? triple me)) triples)
+             triples
+             me))
+
+(define (best-move my-triples all-triples me)
+  (if (empty? my-triples)
+      #f
+      (best-square (first my-triples) all-triples me) ))
+
+(define (best-square my-triple triples me)
+  (best-square-helper (pivots triples (opponent me))
+		      (keep number? my-triple)))
+
+(define (best-square-helper opponent-pivots pair)
+  (if (member? (first pair) opponent-pivots)
+      (first pair)
+      (last pair)))
+
+(define (best-free-square triples)
+  (first-choice (accumulate word triples)
+                '(5 1 3 7 9 2 4 6 8)))
+
+(define (first-choice possibilities preferences)
+  (first (keep (lambda (square) (member? square possibilities))
+               preferences)))