Merge branch 'master' of tilde.institute:public_repos/lsp

9 files changed, 237 insertions, 126 deletions

diff --git a/basic.lsp b/basic.lsp
index 91c990a..5209832 100644
--- a/basic.lsp
+++ b/basic.lsp
@@ -9,7 +9,7 @@
 (defclass <exp-int> (<expression>) ((int :accessor int)))
 (defclass <exp-var> (<expression>) ((var :accessor var)))
 (defclass <exp-str> (<expression>) ((str :accessor str)))
-(defclass <exp-unr> (<expression>) ((op :accessor op) (exp :accessor exp)))
+(defclass <exp-unr> (<expression>) ((op :accessor op) (expr :accessor expr)))
 (defclass <exp-bin> (<expression>) ((exp1 :accessor exp1) (op :accessor op) (exp2 :accessor exp2)))
 
 (defclass <command> () () (:abstractp t))
@@ -67,7 +67,7 @@
 
 (defgeneric ppl (pr expr))
 (defmethod ppl (pr (expr <exp-int>))
-   (convert (num expr) <string>))
+   (convert (int expr) <string>))
 (defmethod ppl (pr (expr <exp-var>))
    (var expr))
 (defmethod ppl (pr (expr <exp-str>))
@@ -78,8 +78,8 @@
           (pr2 (priority-uop op))
           (res-e (ppl pr2 (expr expr))))
          (if (= pr 0)
-             (parenthesis (string-append res-op res-e))
-             (string-append res-op res-e))))
+             (string-append res-op res-e)
+             (parenthesis (string-append res-op res-e)))))
 (defmethod ppl (pr (expr <exp-bin>))
    (let* ((op (op expr))
           (pr2 (priority-binop op))
@@ -114,7 +114,7 @@
 (defmethod pp-command ((cmd <cmd-goto>))
    (string-append "GOTO " (convert (num cmd) <string>)))
 (defmethod pp-command ((cmd <cmd-print>))
-   (string-append "PRNT " (pp-expression (expr cmd))))
+   (string-append "PRINT " (pp-expression (expr cmd))))
 (defmethod pp-command ((cmd <cmd-input>))
    (string-append "INPUT " (var cmd)))
 (defmethod pp-command ((cmd <cmd-if>))
@@ -123,14 +123,14 @@
    (string-append "LET " (var cmd) " = " (pp-expression (expr cmd))))
 
 (defun pp-line (l)
-   (string-append (convert (car l) <string>) "  " (pp-command (cdr l))))
+   (string-append (convert (num l) <string>) "  " (pp-command (cmd l))))
 
 ;;; Lexing
 (defclass <lexeme> () () (:abstractp t))
-(defclass <lint> (<lexeme>) ((int :reader int)))
-(defclass <lident> (<lexeme>) ((ident :reader ident)))
-(defclass <lsymbol> (<lexeme>) ((lsymbol :reader lsymbol)))
-(defclass <lstring> (<lexeme>) ((lstring :reader lstring)))
+(defclass <lint> (<lexeme>) ((int :initarg i :reader int)))
+(defclass <lident> (<lexeme>) ((ident :initarg i :reader ident)))
+(defclass <lsymbol> (<lexeme>) ((lsymbol :initarg s :reader lsymbol)))
+(defclass <lstring> (<lexeme>) ((lstring :initarg s :reader lstring)))
 (defclass <lend> (<lexeme>) ())
 
 (defclass <string-lexer> () ((string :initarg s :accessor string)
@@ -138,41 +138,86 @@
                              (size :accessor size)))
 
 (defmethod initialize-object :after ((self <string-lexer>) initargs)
-   (setf (size self) (length (str self))))
+   (setf (size self) (length (string self))))
 
 (defgeneric forward (cl &rest args))
 (defmethod forward ((cl <string-lexer>) &rest args)
    (let ((incr (if (null args)
                    1
                    (car args))))
-        (setf (curr cl) (+ (curr cl) incr))))
+        (setf (current cl) (+ (current cl) incr))))
 
 (defgeneric extract (pred cl))
 (defmethod extract (pred (cl <string-lexer>))
-   (let* ((st (string cl))
-          (pos (current cl))
-          (ext (lambda (n)
-                  (if (and (< n (size cl)) (pred (elt st n)))
-                      (ext (+ n 1))
-                      n)))
-          (res (ext pos)))
+   (flet ((ext (n)
+             (if (and (< n (size cl)) (apply #'pred (elt st n)))
+                 (ext (+ n 1))
+                 n)))
+      (let* ((st (string cl))
+             (pos (current cl))
+             (res (ext pos)))
          (setf (current cl) res)
-         (subseq (string cl) pos (- res pos))))
+         (subseq (string cl) pos (- res pos)))))
+
+;; Some functions from C's ctype.h:
+(defun isdigit (c)
+   (and (char>= x #\0) (char<= x #\9)))
+(defun isalpha (c)
+   (or (and (char>= c #\a) (char<= c #\z))
+       (and (char>= c #\A) (char<= c #\Z))))
+(defun isalnum (c)
+   (or (isalpha c)
+       (isdigit c)))
 
 (defgeneric extract-int (cl))
 (defmethod extract-int ((cl <string-lexer>))
-   (flet ((is-int (x)
-             (and (char>= x #\0) (char<= x #\9))))
-      (convert (extract is-int cl) <number>)))
+   (convert (extract #'isdigit cl) <number>))
 
 (defgeneric extract-ident (cl))
 (defmethod extract-ident ((cl <string-lexer>))
    (flet ((is-alpha-num (x)
-             (or (and (char>= x #\a) (char<= x #\z))
-                 (and (char>= x #\A) (char<= x #\Z))
-                 (and (char>= x #\0) (char<= x #\9))
+             (or (isalnum x)
                  (char= x #\_))))
-      (extract is-alpha-num)))
+      (extract #'is-alpha-num)))
+
+(defgeneric lexer (cl))
+(defmethod lexer ((cl <string-lexer>))
+   (flet ((lexer-char (c)
+             (cond ((or (char= c #\space) (char= c #\tab))
+                    (forward cl)
+                    (lexer cl))
+                   ((isalpha c)
+                    (create (class <lident>) 'i (extract-ident cl)))
+                   ((isdigit c)
+                    (create (class <lint>) 'i (extract-int cl)))
+                   ((char= c #\")
+                    (forward cl)
+                    (let ((res (create (class <lstring>) 's (extract (lambda (c) (char/= c #\")) cl))))
+                         (forward cl)
+                         res))
+                   ((member c '(#\+ #\- #\* #\/ #\% #\& #\| #\! #\= #\( #\)))
+                    (forward cl)
+                    (create (class <lsymbol>) 's c))
+                   ((or (char= c #\<) (char= c #\>))
+                    (forward cl)
+                    (if (>= (current cl) (size cl))
+                        (crate (class <lsymbols>) 's c)
+                        (let ((cs (elt (string cl) (current cl))))
+                             (cond ((and (char= c #\<) (char= cs #\=))
+                                    (forward cl)
+                                    (create (class <lsymbol>) 's "<="))
+                                   ((and (char= c #\>) (char= cs #\=))
+                                    (forward cl)
+                                    (create (class <lsymbol>) 's ">="))
+                                   ((and (char= c #\<) (char= cs #\>))
+                                    (forward cl)
+                                    (create (class <lsymbol>) 's "<>"))
+                                   (t
+                                    (create (class <lsymbol>) c))))))
+                   (t (error "Lexer error")))))
+      (if (>= (current cl) (size cl))
+          (create (class <lend>))
+          (lexer-char (elt (string cl) (current cl))))))
 
 ;;; Parsing
 (defclass <exp-elem> () () (:abstractp t))
@@ -184,7 +229,7 @@
 (defun unr-symb (s)
   (cond ((string= s "!") 'not)
 	((string= s "-") 'uminus)
-	(t (error "Parse error"))))
+	(t (throw 'parse-failure))))
 
 (defun bin-symb (s)
   (cond ((string= s "+") 'plus)
@@ -195,7 +240,15 @@
 	((string= s "=") 'equal)
 	((string= s "<") 'less)
 	((string= s "<=") 'lesseq)
-	((string= s ">") 'great)))
+	((string= s ">") 'great)
+    ((string= s ">=") 'greateq)
+    ((string= s "<>") 'diff)
+    ((string= s "&") 'and)
+    ((string= s "|") 'or)
+    (t (throw 'parse-failure))))
+
+(defun tsymb (s)
+   (catch 'parse-failure (lambda 
 
 (defun parse (str)
   (let* ((cl (init-lex str))
diff --git a/bitmap.lsp b/bitmap.lsp
index 41d3f64..aaef3a5 100644
--- a/bitmap.lsp
+++ b/bitmap.lsp
@@ -1,6 +1,8 @@
 ;;; Bitmap
 ;;; This could be extended to a general drawing interface, but for now it's probably better to use Tk's canvas.
 
+(import "compat")
+
 (defconstant +black+ 0)
 (defconstant +white+ #xFFFFFF)
 (defconstant +red+ #xFF0000)
@@ -81,13 +83,16 @@
 
 (defconstant +whitespace-chars+ '(#\SPACE \#carriage-return #\TAB #\NEWLINE))
 
-(defun read-header-chars (stream &optional (delimiter-list +whitespace-chars+))
-   (do ((c (read-char stream nil :eof)
-           (read-char stream nil :eof))
-        (vals nil (if (or (null c) (char= c  #\#)) vals (cons c vals))))   ;;don't collect comment chars
-       ((or (eql c :eof) (member c delimiter-list)) (map 'string #'identity (nreverse vals)))   ;;return strings
-       (when (char= c #\#)   ;;skip comments
-             (read-line stream))))
+(defun read-header-chars (stream &rest args)
+   (let ((delimiter-list (if (null args)
+                             +whitespace-chars+
+                             (car args))))
+        (do ((c (read-char stream nil :eof)
+                (read-char stream nil :eof))
+             (vals nil (if (or (null c) (char= c  #\#)) vals (cons c vals))))   ;;don't collect comment chars
+            ((or (eql c :eof) (member c delimiter-list)) (map 'string #'identity (nreverse vals)))   ;;return strings
+            (when (char= c #\#)   ;;skip comments
+                  (read-line stream)))))
 
 (defun read-ppm-file-header (file)
    (with-open-file (s file :direction :input)
diff --git a/cap-muck.lsp b/cap-muck.lsp
index fd90626..36bffba 100644
--- a/cap-muck.lsp
+++ b/cap-muck.lsp
@@ -1,11 +1,8 @@
-(defpackage #:cap-muck
-  (:use #:openlisp)
-  (:export
-   #:main)
-  )
-(in-package #:cap-muck)
+;;; See https://github.com/chazu/16k_muds/tree/master/drveg%40pacbell.net
+
 (defglobal *terminate-program* nil)
 
+;; Hmm, I now think procedural interfaces are better than protocols
 (defconstant +bold+ "#\esc[1m")
 (defconstant +unbold+ "#\esc[0m")
 (defconstant +q+ #\")
@@ -109,9 +106,7 @@
   ())
 
 ;; TODO: Use the reader, for prototype at least?
-;;       Can switch to postmodern for production.
-;;
-;;       Or dbm?
+;;       Or dbm? (Espcially for production.)
 (defun read-room-database ()
   (setq *rooms* '())
   (with-open-input-file (file +rdb+)
@@ -175,9 +170,18 @@
   (with-open-output-file (file +adb+)
     (mapcar (lambda (a) (print-object a file)) *avatars*)))
 
+(defun establish-connection ()
+    (let ((c (create (class <connection-type>))))
+        (say c "Welcome to CapMUCK!")
+        (say c "Commands are all upper case, like HELP.")
+        (say c "")
+        (say c +name-prompt+)))
+
 (defun main ()
   (read-avatar-database)
   (read-room-database)
   (while (not *terminate-program*)
          (check-for-inputs)))
-(provide "cap-muck")
+(main)
+
+
diff --git a/cbasic.lisp b/cbasic.lisp
index 0f2d63c..2ddc5b4 100644
--- a/cbasic.lisp
+++ b/cbasic.lisp
@@ -5,6 +5,10 @@
 ;;; https://github.com/Henry/BuddKaminInterpreters and *maybe*
 ;;; https://oleksandrmanzyuk.wordpress.com/2014/06/18/from-object-algebras-to-finally-tagless-interpreters-2/
 ;;;
+;;; It might be worth reading the example in "Beautiful Racket" for
+;;; the extensions suggested on the OCaml page,
+;;; or more likely switch to COMAL.
+;;;
 ;;; A BASIC interpreter already exists at
 ;;; https://gitlab.com/com-informatimago/com-informatimago/-/tree/master/small-cl-pgms/basic
 ;;; but it is idiomatic CL,
diff --git a/dbc2.lsp b/dbc2.lsp
index 477dc38..5a2699d 100644
--- a/dbc2.lsp
+++ b/dbc2.lsp
@@ -1,23 +1,19 @@
-(defmacro unless (test :rest body)
-  `(if (not ,test) (progn ,@body)))
-;;(defun reduce (function sequence)
-;;  (let ((res 0))
-;;    (for ((xs sequence (cdr xs)))
-;;      ((null xs) res)
-;;      (setq res (+ res (car xs))))))
-;;(reduce #'+ (map '<list> #'abs values))
-(defun sum (sequence)
+(import "macro")                        ; For unless
+(defmacro assert (test)
+  `(unless ,test
+     (error "assert: value is false." ',test)))
+(defun my-sum (sequence)
   (let ((res 0))
     (for ((xs sequence (cdr xs)))
-      ((null xs) res)
-      (setq res (+ res (car xs))))))
+         ((null xs) res)
+         (setq res (+ res (car xs))))))
 (defun average-of-absolutes (values)
-  (the <list> values)
-  (unless (> (length values) 0)
-    (error "average-of-absolutes requires non-null list" values))
-  (let ((res (quotient (sum values) (length values))))
-    (unless (>= res 0)
-      (error "average-of-absolutes must ensure positive result" res))
-    (the <fixnum> res)))
+  (assure <list> values)
+  ;; requires non-null list
+  (assert (> (length values) 0))
+  (let ((res (quotient (my-sum (mapcar #'abs values)) (length values))))
+       ;; must ensure positive result
+       (assert (>= res 0))
+       (assure <number> res)))
 ;; (average-of-absolutes '(1 3))
 ;; (average-of-absolutes '())
diff --git a/doc/breaking_rules.md b/doc/breaking_rules.md
index db4f28c..a31a0a1 100644
--- a/doc/breaking_rules.md
+++ b/doc/breaking_rules.md
@@ -1,15 +1,12 @@
 title: Breaking the Rules: Refining Prototypes Into Products  
 author: Darren Bane  
-copyright: 2020 Darren Bane, CC BY-SA  
+copyright: 2020-21 Darren Bane, CC BY-SA  
 
 # Abstract
 
 Recommendations for a process to refine prototypes into production-quality code
 are made.
 
-*TODO*: Q: re-cast much of this document as Architecture
-Decision Records? A: N
-
 # Introduction
 
 The conventional wisdom is that prototypes should be discarded once the lessons
@@ -19,8 +16,6 @@ In the spirit of [1]
 I argue that improvements in development tools have
 invalidated this.
 
-*TODO*: case study
-
 # Previous Work
 
 There is a long history of recommending prototyping as a way to construct
@@ -28,16 +23,17 @@ systems.
 I would personally recommend [2]
 and [3].
 
-*NB*: I am almost certainly re-inventing a SmallTalk wheel.  However I
+The SmallTalk community probably pioneered this development process.
+However I
 argue that Lisp's combination of imperative & OO
 is an easier sell to industry
 whereas pure OO as in SmallTalk (or logic programming as in
-Prolog) is still niche.
+Prolog) is, perhaps undeservedly, more niche.
 
-A closely related are is that of "specification animation",
+A closely related area is that of "specification animation",
 quickly writing an implementation of some subset of a formal specification in
 for example Z or VDM.
-Prolog is a common choice for this, but I choose Lisp instead.
+Prolog is a common choice for this.
 
 However, as stated in the introduction, I differ in
 arguing that it is possible to *refine* a prototype into a product.
@@ -54,9 +50,7 @@ without earning money.
 
 ## Design Decisions
 
-The programming language chosen is a particular style of Common Lisp.
-For readability my
-[ISLisp-like subset of CL](bane.20.cdr15.md) should be followed where practical[5].
+The programming language chosen is ISLisp.
 Reasons for this decision include:
 
 * Contrary to a lot of other languages, Lisp is fairly paradigm-agnostic.
@@ -64,13 +58,13 @@ Reasons for this decision include:
 * The imperative and object-oriented paradigms are commonly taught,
   used in industry,
   and have a small "impedence mismatch" to current hardware.
-* The existence of quicklisp.
-  Popularity is not really a reason for choosing Common Lisp over ISLisp,
-  but slotting into quicklisp *is*.
+* The possible migration path of running under
+  [core-lisp](https://github.com/ruricolist/core-lisp)
+  and using the quicklisp libraries.
 
 Detailed implementations, libraries, etc. are as follows:
 
-* The SBCL compiler.
+* The Easy-ISLisp interpreter/compiler.
 * Avoid multi-threading at this stage,
   event-driven should do the job.
 * Not sure if this is relevant for a prototype, but you could do simple multi-user
@@ -83,41 +77,43 @@ it could be difficult to satisfy expectations.
 
 ### Dependencies
 
-For the prototyping phase,
-you should *really* limit yourself to the ISLisp subset.
-If absolutely necessary you can choose some of the libraries mentioned in the "Productisation" section below.
+Counterintuitively, I chose ISLisp partly *because* it imposes limits in the prototyping phase.
+Standard UNIX libraries like curses, catgets, xdr and dbm can still be used from compiled code using the FFI.
 
 ## Coding standards
 
 Even though this is a prototype, attention should be paid to basic craftsmanship.
 
-* Divide the system into packages, using the subset of CL that is
-  supported by OpenLisp.
+* Divide the system conceptually into packages.
   This can start from just "section headers" with lots of semicolons.
-* Write docstrings for at least each public fun, class and package.
-  There are good guidelines in the Elisp manual, but for now one sentence will suffice.
-* Use `declare`
-  to check the types of parameters in public interfaces (see below).
+* Write comments for at least each public fun, class and package.
+  There are guidelines in the Elisp manual, but for now one sentence will suffice.
+* Dynamically
+  check the types of parameters in public interfaces (see below).
 * Indent all the source code using Emacs.
 * Some minimal documentation, at least an overview like in [README driven development](https://tom.preston-werner.com/2010/08/23/readme-driven-development.html)
   and man (actually, [mdoc](https://manpages.bsd.lv/toc.html)) pages[7].
 * Certain parts of a system justify greater detail for a *complete* specification.
   These are (newly-designed) network protocols and complex persistent data models.
-  For new protocols, use JSON-RPC as a base and follow the documentation style of LSP.
+  For new protocols, use XDR with or without RPC but generated from rpcgen .x files.
   Data models should be documented as commented SQL DDL.
 
 ### Run-time type-checking
 
 As stated above,
-`declare` should be used for simple run-time type-checking of public functions.
+`the` should be used for simple run-time type-checking of public functions.
 For example, the following:
 
 ```lisp
 (defun f (x)
-  (declare (fixnum x))
-  (the fixnum (+ x 1)))
+  (the <fixnum> x)
+  (the <fixnum> (+ x 1)))
 ```
 
+`assure` might be better according to the standard,
+but for now only `the` is used for inference
+by the eisl compiler.
+
 # Refinement to Production-Quality
 
 Software at the level of the previous section is quite usable.
@@ -135,9 +131,10 @@ obviously at a maintenance cost.
 Ensure that the surrounding infrastructure is in place:
 
 * Configuration management. The prototype should already have been checked into git.
-* Build. Write an ASDF description, and install as a local quicklisp package.
+* Build. Split sections into different files, write simple Makefile.
+  In the absence of a standard module system, the elisp public/private convention can be copied.
 * Test.
-  Write FiveAM
+  Write *library/test.lsp*
   test cases.
   Extend the simple run-time type-checking to contracts where possible.
 * Track. Start using a defect tracking system.
@@ -145,13 +142,14 @@ Ensure that the surrounding infrastructure is in place:
 Then, the following code & documentation improvements should be made:
 
 * Document the system more exhaustively
-* Can use any of the "starred" libraries in quicklisp.
-* Maybe "lparallel" to take advantage of all cores
+* Can re-implement more interfaces from the OpenLisp manual using UNIX libraries.
+* Can port any of the `trivial-*` libraries from quicklisp.
+* Maybe multi-process to take advantage of all cores
 
 Since we have a working prototype,
 it may make sense to write the documentation (and contracts, and tests) "bottom-up":
 
-1. Contracts, static analysis
+1. Contracts
 2. Test cases
 3. Module interface specs
 4. Module guide, uses hierarchy
@@ -163,13 +161,13 @@ it may make sense to write the documentation (and contracts, and tests) "bottom-
 Depend only on GFM,
 in the same spirit as the software.
 The use of tools like
-nw2md and Pandoc should be minised.
+nw2md and Pandoc should be minimised.
 PlantUML *should* be used where it can replace ad-hoc text.
 
 Documents should be stored under git in a "doc" subdirectory of the project.
 
 It is recommended to keep the separation between library and UI code,
-e.g. for using ltk.
+e.g. for using a GUI like Tk.
 
 The following can be added as sections to the README:
 
@@ -194,52 +192,43 @@ However, some of this documentation is better in the source code:
 
 ```lisp
 (defun f (x)
-  (declare (fixnum x))
+  (the <fixnum> x)
   (assert (precondition x))
   (let ((res (+ x 1)))
     (assert (postcondition res))
-    (the fixnum res)))
+    (the <fixnum> res)))
 ```
 
-`lisp-critic` can be used to perform static analysis of the codebase.
-But it's not worth writing custom rules.
+I'm not aware of any static analysis tool.
 
 ## Dependencies
 
 For productisation you may want to add more features.
 
-Although the official ANSI standard is moribund,
-"community standard" (i.e. starred) libraries are recommended on the
-[Awesome-CL list](https://github.com/CodyReichert/awesome-cl),
-or [CL portability layers](http://portability.cl/).
+OpenLisp has idiomatic interfaces for several more UNIX features in its manual, which could be re-implemented.
+Also quicklisp (and as a second choice non-quicklisp) `trivial-*` libraries should be easy enough to port.
 Dependencies should be limited to these two
 initially.
-Ltk can implement a GUI to replace the
+Tk can implement a GUI to replace the
 prototype command-line or terminal-based UI,
 if it makes sense.
 
-A second round of productisation,
-which again may never actually be required,
-could include:
-
-* Any of the `trivial-` libraries from the Awesome-CL list. The `trivial-` libraries may be *forked* and maintained locally.
-* Any other `trivial-` libraries available in Quicklisp.
-* Other libraries available in Quicklisp.
+The order of preference is:
+1. Any UNIX interface documented in the OpenLisp manual.
+2. A port of any of the `trivial-` libraries from the Awesome-CL list.
+3. A port of any other `trivial-` libraries available in Quicklisp.
 
-Now it may also be worth taking on the complexity of a Web UI,
-using HTMX and the platform.sh stack.
-HTMX & ReST (following Fielding) seem simpler than single-page applications
-(outside the very specific case of drawing on a canvas using ParenScript).
+The complexity of a Web UI should be avoided in favour of simpler protocols like IRC, Gemini and maybe XMPP.
 
 ## Testing
 
-Unit (FiveAM) tests grow in parallel with the module interface specs.
+Unit tests grow in parallel with the module interface specs.
 Property-based testing would be nice here, but there doesn't seem to be a readily-available library.
 System tests grow in parallel with the requirements spec.
-It's ok for system tests to use the same interfaces as the ltk code.
+It's ok for system tests to use the same interfaces as the GUI code.
 All tests should be automated,
 except possibly for the UI/view layer.
-Q: These scripts could be generated from a literate test plan? A: yes, probably one of the few places to use nw2md.
+These scripts could be generated from a literate test plan, one of the places where it makes sense to use nw2md.
 
 As much of the testing work should be pushed "back" in the V model to contracts for the functions,
 following the pattern above.
@@ -247,7 +236,7 @@ following the pattern above.
 # Conclusion
 
 A method for developing software from an incomplete understanding of the requirements is given.
-It is hoped that this is more effective than most of what is currently-used.
+It is hoped that this is more effective than a lot of what is currently-used.
 
 # References
 
diff --git a/guess.lsp b/guess.lsp
new file mode 100644
index 0000000..d03d2e3
--- /dev/null
+++ b/guess.lsp
@@ -0,0 +1,59 @@
+;;; gopherlib
+;;; Distantly descended from Perl code that is (c) 2001, 2004 Cameron Kaiser.
+(import "unix")
+
+(defconstant +tab-chr+ (convert 9 <character>))
+(defconstant +cr-chr+ (convert 13 <character>))
+
+(defun offer (type name resc server port extent)
+   (format (standard-output) "~C~A~C~A~C~A~C~D" type name +tab-chr+ resc +tab-chr+ server +tab-chr+ port)
+   (if (not (null extent))
+       (format (standard-output) "~C~A" +tab-chr+ extent))
+   (format (standard-output) "~C~%" +cr-chr+))
+
+(defun dirname (path)
+   (if (null (char-index #\/ path))
+       path
+       (for ((prev-slash 0 next-slash)
+             (next-slash 0 (char-index #\/ path (+ prev-slash 1))))
+            ((null next-slash) (subseq path 0 (+ prev-slash 1))))))
+
+(defun offer-file (type name resc server port extent)
+   (assure <character> type)(assure <string> name)(assure <string> resc)(assure <fixnum> port)
+   (if (null server)
+       (setq server (getenv "SERVER_HOST")))
+   (if (= port 0)
+       (setq port (convert (getenv "SERVER_PORT") <integer>)))
+   (if (and (> (length resc) 0) (char/= (elt resc 0) #\/))
+       (setq resc (string-append (dirname (getenv "SELECTOR")) resc)))
+   (offer type name resc server port extent))
+
+(defun print-string (msg)
+   (assure <string> msg)
+   (offer-file #\i msg "" "null.host" 1 nil))
+
+;;; Main program
+(defconstant +target+ 45)
+
+(defun try-guess (guess)
+   (cond ((< guess +target+)
+          (let ((str (create-string-output-stream)))
+               (format str "Your guess of ~A was too low." guess)
+               (print-string (get-output-stream-string str)))
+          (offer-file #\7 "Guess again." "guess.cgi" nil 0 nil))
+         ((= guess +target+)
+          (print-string "Congratulations, you won!"))
+         ((> guess +target+)
+          (let ((str (create-string-output-stream)))
+               (format str "Your guess of ~A was too high." guess)
+               (print-string (get-output-stream-string str)))
+          (offer-file #\7 "Guess again." "guess.cgi" nil 0 nil))))
+
+(defun main ()
+   (let ((guess-str (getenv "QUERY_STRING")))
+        (if (null guess-str)
+            (print-string "No guess supplied")
+            (try-guess (convert guess-str <integer>)))))
+
+(main)
+(quit)
diff --git a/loot.lsp b/loot.lsp
index 4dfb2c8..74378fc 100644
--- a/loot.lsp
+++ b/loot.lsp
@@ -38,4 +38,4 @@
 	(for ((n 0 (+ n 1)))
              ((> n 99))
 	     (format (standard-output) "~A~%" (as-string (choose loot))))))
-(main)
+;; (main)
diff --git a/xdr.lsp b/xdr.lsp
index b3cf1ad..ffae67f 100644
--- a/xdr.lsp
+++ b/xdr.lsp
@@ -1,4 +1,5 @@
 ;;; Use (a subset of) CL and the xpc part of the "frpc" package from QuickLisp instead?
+;;; No, use eisl and ../build/xdr-tests-1.0.
 
 (require "olunit")
 (defpackage #:xdr