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

10 files changed, 539 insertions, 154 deletions

diff --git a/basic.lsp b/basic.lsp
index 11771e9..a63ab27 100644
--- a/basic.lsp
+++ b/basic.lsp
@@ -1,16 +1,278 @@
-#!/Users/dbane/openlisp-11.0.0/uxlisp -shell
+;;; BASIC interpreter
 
-(require "abs-syn")
-(require "lex")
-(require "parsing")
-(defpackage #:basic
-  (:use #:openlisp)
-  (:export
-   #:main))
-(in-package #:basic)
+;;; Abstract syntax
 
-;;; Not sure yet if it's a good idea or not,
-;;; but I'm trying to keep the number of top-level functions the same as in OCaml.
+;; If these were only C enums, without any payload, I'd just use symbols and (error) in the t case.
+;; But classes seem better for the associated data, in discriminated unions.
+
+(defclass <expression> () () (:abstractp t))
+(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-bin> (<expression>) ((exp1 :accessor exp1) (op :accessor op) (exp2 :accessor exp2)))
+
+(defclass <command> () () (:abstractp t))
+(defclass <cmd-rem> (<command>) ((rem :accessor rem)))
+(defclass <cmd-goto> (<command>) ((goto :accessor goto)))
+(defclass <cmd-print> (<command>) ((expr :accessor expr)))
+(defclass <cmd-input> (<command>) ((var :accessor var)))
+(defclass <cmd-if> (<command>) ((expr :accessor expr) (num :accessor num)))
+(defclass <cmd-let> (<command>) ((var :accessor var) (expr :accessor expr)))
+
+(defclass <line> () ((num :accessor num) (cmd :accessor cmd)))
+
+(defclass <phrase> () () (:abstractp t))
+(defclass <phrase-line> (<phrase>) ((line :accessor line)))
+(defclass <phrase-list> (<phrase>) ())
+(defclass <phrase-run> (<phrase>) ())
+(defclass <phrase-p-end> (<phrase>) ())
+
+(defun priority-uop (unr-op)
+  (case unr-op
+    ((not) 1)
+    ((uminus) 7)))
+
+(defun priority-binop (bin-op)
+  (cond ((member bin-op '(mult div)) 6)
+    ((member bin-op '(plus minus)) 5)
+    ((eql bin-op 'mod) 4)
+    ((member bin-op '(equal less lesseq great greateq diff)) 3)
+    ((member bin-op '(and or)) 2)))
+
+;;; Program pretty printing
+(defun pp-binop (bin-op)
+  (case bin-op
+    ((plus) "+")
+    ((mult) "*")
+    ((mod) "%")
+    ((minus) "-")
+    ((div) "/")
+    ((equal) " = ")
+    ((less) " < ")
+    ((lesseq) " <= ")
+    ((great) " > ")
+    ((greateq) " >= ")
+    ((diff) " <> ")
+    ((and) " & ")
+    ((or) " | ")))
+
+(defun pp-unrop (unr-op)
+   (case unr-op
+         ((uminus) "-")
+         ((not) "!")))
+
+(defun parenthesis (x)
+   (string-append "(" x ")"))
+
+(defgeneric ppl (pr expr))
+(defmethod ppl (pr (expr <exp-int>))
+   (convert (num expr) <string>))
+(defmethod ppl (pr (expr <exp-var>))
+   (var expr))
+(defmethod ppl (pr (expr <exp-str>))
+   (string-append "\"" (str expr) "\""))
+(defmethod ppl (pr (expr <exp-unr>))
+   (let* ((op (op expr))
+          (res-op (pp-unrop op))
+          (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))))
+(defmethod ppl (pr (expr <exp-bin>))
+   (let* ((op (op expr))
+          (pr2 (priority-binop op))
+          (res (string-append (ppl pr2 (expr1 expr)) (pp-binop op) (ppr pr2 (expr2 expr)))))
+         (if (>= pr2 pr)
+             res
+             (parenthesis res))))
+
+(defgeneric ppr (pr expr))
+(defmethod ppr (pr (expr <exp-bin>))
+   (let* ((op (op expr))
+          (pr2 (priority-binop op))
+          (res (string-append (ppl pr2 (expr1 expr)) (pp-binop op) (ppr pr2 (expr2 expr)))))
+         (if (> pr2 pr)
+             res
+             (parenthesis res))))
+(defmethod ppr (pr (expr <exp-int>))
+   (ppl pr expr))
+(defmethod ppr (pr (expr <exp-var>))
+   (ppl pr expr))
+(defmethod ppr (pr (expr <exp-str>))
+   (ppl pr expr))
+(defmethod ppr (pr (expr <exp-unr>))
+   (ppl pr expr))
+
+(defun pp-expression (expr)
+   (ppl 0 expr))
+
+(defgeneric pp-command (cmd))
+(defmethod pp-command ((cmd <cmd-rem>))
+   (string-append "REM " (str cmd)))
+(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))))
+(defmethod pp-command ((cmd <cmd-input>))
+   (string-append "INPUT " (var cmd)))
+(defmethod pp-command ((cmd <cmd-if>))
+   (string-append "IF " (pp-expression (expr cmd)) " THEN " (convert (num cmd) <string>)))
+(defmethod pp-command ((cmd <cmd-let>))
+   (string-append "LET " (var cmd) " = " (pp-expression (expr cmd))))
+
+(defun pp-line (l)
+   (string-append (convert (car l) <string>) "  " (pp-command (cdr 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 <lend> (<lexeme>) ())
+
+(defclass <string-lexer> () ((string :initarg s :accessor string)
+                             (current :initform 0 :accessor current)
+                             (size :accessor size)))
+
+(defmethod initialize-object :after ((self <string-lexer>) initargs)
+   (setf (size self) (length (str 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))))
+
+(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)))
+         (setf (current cl) res)
+         (subseq (string cl) pos (- res pos))))
+
+(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>)))
+
+(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))
+                 (char= x #\_))))
+      (extract is-alpha-num)))
+
+;;; Parsing
+(defclass <exp-elem> () () (:abstractp t))
+(defclass <elem-exp> (<exp-elem>) ((expr :accessor expr)))
+(defclass <elem-bin> (<exp-elem>) ((bin-op :accessor bin-op)))
+(defclass <elem-unr> (<exp-elem>) ((unr-op :accessor unr-op)))
+(defclass <elem-lp> (<exp-elem>) ())
+
+(defun unr-symb (s)
+  (cond ((string= s "!") 'not)
+	((string= s "-") 'uminus)
+	(t (error "Parse error"))))
+
+(defun bin-symb (s)
+  (cond ((string= s "+") 'plus)
+	((string= s "-") 'minus)
+	((string= s "*") 'mult)
+	((string= s "/") 'div)
+	((string= s "%") 'mod)
+	((string= s "=") 'equal)
+	((string= s "<") 'less)
+	((string= s "<=") 'lesseq)
+	((string= s ">") 'great)))
+
+(defun parse (str)
+  (let* ((cl (init-lex str))
+	 (tok (lexer cl)))
+    (cond ((instancep tok (class <lint>))
+	   (create (class <line>) 'n n 'c (parse-cmd cl)))
+	  ((instancep tok (class <lident>))
+	   (cond ((string= (ident tok) "LIST")
+		  (create (class <phrase-list>)))
+		 ((string= (ident tok) "RUN")
+		  (create (class <phrase-run>)))
+		 ((string= (ident tok) "END")
+		  (create (class <phrase-p-end>)))
+		 (t (error "Parse error"))))
+	  (t (error "Parse error")))))
+
+;;; Evaluation
+(defclass <value> () () (:abstractp t))
+(defclass <v-int> (<value>) ((int :accessor int)))
+(defclass <v-str> (<value>) ((str :accessor str)))
+(defclass <v-bool> (<value>) ((bool :accessor bool)))
+
+(defclass <environment> () ((env :accessor env)))
+
+(defclass <state-exec> () ((line :reader line)
+                           (xprog :reader xprog)
+                           (xenv :reader xenv)))
+
+(defun runerr (n)
+   (throw 'run-error n))
+
+;;;; Assembly
+(defun lookup-index (tprog num-line)
+  (block result-lookup-index
+    (for ((i 0 (+ i 1)))
+      ((>= i (length tprog)))
+      (let ((num-i (num (elt tprog i))))
+        (if (= num-i num-line)
+          (return-from result-lookup-index i)
+          (if (> num-i num-line)
+            (return-from result-lookup-index -1)))))
+    -1))
+
+(defun assemble (prog)
+  (let ((tprog (apply #'vector prog)))
+    (for ((i 0 (+ i 1)))
+      ((>= i (length tprog)))
+      ())))
+
+;;;; Expression evaluation
+(defgeneric eval-exp (n envt expr))
+(defmethod eval-exp (n envt (expr <exp-int>))
+   (create (class <v-int>) 'i (int expr)))
+(defmethod eval-exp (n envt (expr <exp-unr>))
+   (case (op expr)
+         ((uminus)
+          (let ((result (eval-exp (exp expr))))
+               (if (instancep result (class <v-int>))
+                   (progn (setf (exp result) (- (exp result)))
+                          result)
+                   (runerr n))))
+         ((not)
+          (let ((result (eval-exp (exp expr))))
+               (if (instancep result (class <v-bool>))
+                   (progn (setf (exp result) (not (exp result)))
+                          result)
+                   (runerr n))))))
+
+;;;; Command evaluation
+
+;;;; Program evaluation
+(defun run (state)
+
+;;; Finishing touches
+
+;; Not sure yet if it's a good idea or not,
+;; but I'm trying to keep the number of top-level functions the same as in OCaml.
 
 (defun one-command (st)
    (format (standard-output) "> ")
@@ -34,4 +296,3 @@
                        (format (standard-output) "> ")
                        (catch 'error (one-command st)))))
    (format (standard-output) "See you later...~%"))
-(provide "basic")
diff --git a/cap-muck.lsp b/cap-muck.lsp
new file mode 100644
index 0000000..fd90626
--- /dev/null
+++ b/cap-muck.lsp
@@ -0,0 +1,183 @@
+(defpackage #:cap-muck
+  (:use #:openlisp)
+  (:export
+   #:main)
+  )
+(in-package #:cap-muck)
+(defglobal *terminate-program* nil)
+
+(defconstant +bold+ "#\esc[1m")
+(defconstant +unbold+ "#\esc[0m")
+(defconstant +q+ #\")
+
+(defclass <avatar> () ((name :accessor name)
+                       (playing :reader playing :initform nil)
+                       (password :accessor password)))
+(defglobal *avatars* '())
+
+(defglobal *write-avatars* nil)
+
+(defclass <connection> () ((g :reader g)
+                           (socket :reader socket)
+                           (parser :reader parser)
+                           (avatar :reader avatar)
+                           (curr-room :reader curr-room)))
+(defglobal *connections* '())
+
+(defconstant +port-number+ 6565)
+
+(defconstant +vd-type+ #(n s e w u d))
+
+(defclass <room> () ((name :reader name)
+                     (desc :reader desc)
+                     (exits :reader exits)))
+(defglobal *rooms* '())
+
+(defglobal *write-rooms* nil)
+
+(defconstant +command-type+ #(say help quit look
+                              rooms make-room make-door teleport
+                              n s e w
+                              u d password shutdown))
+
+(defconstant +name-prompt+ "Please enter your character name:")
+
+(defconstant +rdb+ "room.tam")
+(defconstant +adb+ "avatar.tam")
+
+(defun first-substr (s)
+  ;; Return the first substring of s (delimited by a space).
+  (block result-first-substr
+    (do ((i 0 (+ i 1)))
+        ((>= i (length s)) s)
+      (if (char= (elt s i) #\space)
+          (return-from result-first-substr (subseq s 0 i))))))
+
+(defun rest-substr (s)
+  ;; Return the second part of s.
+  (block result-rest-substr
+    (let ((b nil))
+      (do ((i 0 (+ i 1)))
+          ((>= i (length s)) "")
+        (if (char= (elt s i) #\space)
+            (setq b t)
+            (if b
+                (return-from result-rest-substr (subseq s i (length s)))))))))
+
+(defun command (s)
+  (block result-command
+    (do ((i 0 (+ i 1)))
+        ((>= i (length +command-type+)) 'say)
+      (let ((c (elt +command-type+ i)))
+        (if (string= s (symbol-name c))
+            (return-from result-command c))))))
+
+(defun format-name (c)
+  (concatenate 'string +bold+ (name (avatar c)) +unbold+))
+
+(defun say (c s)
+  (if (g c)
+      (format (socket c) "~A~%" s)))
+
+(defun broadcast (s)
+  (do ((cs *connections* (cdr cs)))
+      ((null cs))
+    (let ((c (car cs)))
+      (say c s))))
+
+(defun say (r s)
+  (do ((cs *connections* (cdr cs)))
+      ((null cs))
+    (let ((c (car cs)))
+      (if (eq (curr-room c) r)
+          (say c s)))))
+
+(defun look (c)
+  (say c (concatenate 'string "Room: " (name (curr-room c))))
+  (do ((ds (desc (curr-room c)) (cdr ds)))
+      ((null ds))
+    (let ((d (car ds)))
+      (say c (line d))))
+  (say c "")
+  (say c "Exits:")
+  (do ((i 0 (+ i 1)))
+      ((>= i (length +vd-type+)))
+    (let ((e (elt (exits (curr-room c)) i)))
+      (if (not (null e))
+          (say c (concatenate 'string " " (symbol-name (elt +vd-type+ i)) " " (name e))))))
+  (say c "Avatars:")
+  ())
+
+;; TODO: Use the reader, for prototype at least?
+;;       Can switch to postmodern for production.
+;;
+;;       Or dbm?
+(defun read-room-database ()
+  (setq *rooms* '())
+  (with-open-input-file (file +rdb+)
+    (flet ((read-desc ()
+             (let ((ls '()))
+               (do ((l (read-line file) (read-line file)))
+                   ((string= l ".") ls)
+                 (setq ls (cons l ls)))))
+           (skip-lines (n)
+             (do ((i 0 (+ i 1)))
+                 ((> i n))
+               (read-line file))))
+      (do ((name (read-line file nil nil))
+           (desc (read-desc)))
+          ((or (null name) (null desc)))
+        (skip-lines (length +vd-type+))
+        (let ((r (make-instance (find-class '<room>))))
+          (setf (name r) name)
+          (setf (desc r) desc)
+          (setq *rooms* (cons r *rooms*))))
+      (file-position file 0)
+      ())))
+
+(defmethod print-object ((obj <room>) stream)
+  (flet ((write-desc (ds)
+           (mapcar (lambda (l)
+                     (format stream "~A~%" l))
+                   ds))
+         (write-exits (es)
+           (do ((i 0 (+ i 1)))
+               ((> i (length +vd-type+)))
+             (if (null (elt es) i)
+                 (format stream "nil~%")
+                 (format stream "~A~%" (name (elt es i)))))))
+    (format stream "~A~%" (name r))
+    (write-desc (desc r))
+    (format stream ".~%")
+    (write-exits (exits r))))
+
+(defun write-room-database ()
+  (with-open-output-file (file +rdb+)
+    (mapcar (lambda (r) (print-object r file)) *rooms*))
+  (setq *write-rooms* nil))
+
+(defun read-avatar-database ()
+  (setq *avatars* '())
+  (with-open-input-file (file +adb+)
+    (do ((name (read-line file nil nil))
+         (password (read-line file nil nil)))
+        ((or (null name) (null password)))
+      (let ((a (make-instance (find-class '<avatar>))))
+        (setf (name a) name)
+        (setf (password a) password)
+        (setq *avatars* (cons a *avatars*)))))
+  (setq *write-avatars* nil))
+
+(defmethod print-object ((obj <avatar>) stream)
+  (format stream "~A~%~A~%" (name a) (password a)))
+
+(defun write-avatar-database ()
+  (with-open-output-file (file +adb+)
+    (mapcar (lambda (a) (print-object a file)) *avatars*)))
+
+(defun main ()
+  (read-avatar-database)
+  (read-room-database)
+  (while (not *terminate-program*)
+         (check-for-inputs)))
+(provide "cap-muck")
diff --git a/cecho.lisp b/cecho.lisp
index 1f68f58..d5c61b6 100644
--- a/cecho.lisp
+++ b/cecho.lisp
@@ -1,3 +1,4 @@
+(ql:quickload "jsonrpc")
 (require "jsonrpc")
 (defun main ()
   (let ((server (jsonrpc:make-server)))
diff --git a/clex.lisp b/clex.lisp
index 7ca04f0..25d86d4 100644
--- a/clex.lisp
+++ b/clex.lisp
@@ -79,5 +79,5 @@
 		 ((member c '(#\< #\>))
 		  (forward cl)
 		  
-  )
+  ))))))
 (provide "clex")
diff --git a/cxdrt.lisp b/cxdrt.lisp
index 6c84657..3e95334 100644
--- a/cxdrt.lisp
+++ b/cxdrt.lisp
@@ -1,3 +1,6 @@
+;;; Depends on the "frpc" package from QuickLisp
+(ql:quickload "frpc")
+
 (defun xwrt (fname)
   (with-open-file (f fname :direction :output :if-exists :supersede :element-type '(unsigned-byte 8))
     (frpc:write-xtype :int32 f 1234)
diff --git a/dbc2.lsp b/dbc2.lsp
new file mode 100644
index 0000000..477dc38
--- /dev/null
+++ b/dbc2.lsp
@@ -0,0 +1,23 @@
+(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)
+  (let ((res 0))
+    (for ((xs sequence (cdr 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)))
+;; (average-of-absolutes '(1 3))
+;; (average-of-absolutes '())
diff --git a/dbm.lsp b/dbm.lsp
new file mode 100644
index 0000000..52a0a27
--- /dev/null
+++ b/dbm.lsp
@@ -0,0 +1,27 @@
+;; No package, this is for eisl
+
+(c-include "<ndbm.h>")
+
+(defclass <dbm> () (db :accessor db))
+
+(defgeneric clearerr (self))
+(defmethod clearerr ((self <dbm>))
+   (flet ((clearerr-h (db)
+             (c-lang "dbm_clearerr(DB);")))
+      (clearerr-h (db self))))
+
+(defgeneric close (self))
+
+(defgeneric delete (self key))
+
+(defgeneric open (self openflags))
+(defmethod open ((self <dbm>) file openflags)
+   (flet ((open-h (file openflags)
+             (c-lang "res = dbm_open(FILE, OPENFLAGS, MODE);")))
+      (setf (db self) (open-h file openflags))))
+
+(defgeneric create (self openflags modes))
+(defmethod create ((self <dbm>) file openflags modes)
+   (flet ((open-h (file openflags modes)
+             (c-lang "res = dbm_open(FILE, OPENFLAGS, MODE);")))
+      (setf (db self) (open-h file openflags modes))))
diff --git a/doc/breaking_rules.md b/doc/breaking_rules.md
index 2323140..db4f28c 100644
--- a/doc/breaking_rules.md
+++ b/doc/breaking_rules.md
@@ -92,8 +92,9 @@ If absolutely necessary you can choose some of the libraries mentioned in the "P
 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
-* Write docstrings for at least each public fun and class.
+  supported by OpenLisp.
+  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).
diff --git a/doc/macros.ms b/doc/macros.ms
deleted file mode 100755
index e95e98b..0000000
--- a/doc/macros.ms
+++ /dev/null
@@ -1,115 +0,0 @@
-.de F1
-.nr OI \\n(.iu
-.nr PW 1v
-.KF
-.sp 0.3v
-..
-.de T1
-.F1
-..
-.de F2
-.ds Fp Figure\ \\n(Fi
-.ds Fn Figure\ \\n+(Fi
-.ds Fq \\*(Fp
-.F0
-..
-.de T2
-.ds Tp Table\ \\n(Ti
-.ds Tn Table\ \\n+(Ti
-.ds Tq \\*(Tp
-.T0
-..
-.de F0
-.nr BD 1
-.if t .ps \\n(PS-1
-.ie \\n(VS>=41 .vs \\n(VSu-1p
-.el .vs \\n(VSp-1p
-.ft 1
-.di DD
-.ll \\n(.lu*3u/4u
-.in 0
-.fi
-.ad b
-.sp 0.5v
-\f3\\*(Fq\f1\ \ \c
-..
-.de T0
-.nr BD 1
-.if t .ps \\n(PS-1
-.ie \\n(VS>=41 .vs \\n(VSu-1p
-.el .vs \\n(VSp-1p
-.ft 1
-.di DD
-.ll \\n(.lu*3u/4u
-.in 0
-.fi
-.ad b
-.sp 0.5v
-\f3\\*(Tq\f1\ \ \c
-..
-.de F3
-.sp 0.5v
-.di
-.br
-.ll \\n(.lu*4u/3u
-.if \\n(dl>\\n(BD .nr BD \\n(dl
-.if \\n(BD<\\n(.l .in (\\n(.lu-\\n(BDu)/2u
-.nf
-.DD
-.in \\n(OIu
-.nr BD 0
-.fi
-.KE
-.ie \\n(VS>=41 .vs \\n(VSu
-.el .vs \\n(VSp
-..
-.de T3
-.F3
-..
-.de EX
-.\" P1
-.DS L
-.ft CW
-\s-4
-..
-.de EE
-\s+4
-.\" P2
-.ft
-.DE
-..
-.nr Fi 1 +1
-.nr Ti 1 +1
-.ds Fn Figure\ \\n(Fi
-.ds Tn Table\ \\n(Ti
-.nr XP 2	\" delta point size for program
-.nr XV 2p	\" delta vertical for programs
-.nr XT 4	\" delta tab stop for programs
-.nr DV .5v	\" space before start of program
-.\" FP lucidasans
-.nr PS 11
-.nr VS 13
-.\" nr LL 6.6i
-.\" nr PI 0	\" paragraph indent
-.nr PD 4p	\" extra space between paragraphs
-.\" pl 11i
-.rm CH
-.de L=
-.ie '\\$1'sec' .NH \\$2
-.el .ie '\\$1'table' .if !'\\$3'*' \{
-.DS C
-Table '\\$3' about here
-.DE
-\}
-.el .if '\\$1'fig' .if !'\\$3'*' \{
-.DS C
-Figure '\\$3' about here
-.DE
-\}
-..
-.de R1
-.ig R2
-..
-.\"
-.\" groff-specific:
-.ds FAM H
diff --git a/loot.lsp b/loot.lsp
index e5e9e81..4dfb2c8 100644
--- a/loot.lsp
+++ b/loot.lsp
@@ -1,4 +1,5 @@
 ;;; Port of https://en.wikipedia.org/wiki/ModernPascal#Code_Sample[3].
+;;; And then to CL and ISLisp.
 ;;; I prefer my version.
 (defconstant +max-probability+ 1000)
 ;; Because this is a simple enum and not a full sum/product type,
@@ -10,31 +11,31 @@
 (defclass <looter> () ((probabilities :accessor probabilities)))
 (defgeneric choose (self))
 (defmethod choose ((self <looter>))
-  (let ((random-value (random (- +max-probability+ 1))))
-    (for ((loop 0 (+ loop 1)))
-	((>= (elt (probabilities self) (mod loop 13)) random-value) (elt +loot-type+ (mod loop 13))))))
+   (let ((random-value (random (- +max-probability+ 1))))
+	(for ((loop 0 (+ loop 1)))
+	     ((>= (elt (probabilities self) (mod loop 13)) random-value) (elt +loot-type+ (mod loop 13))))))
 (defmethod initialize-object :after ((self <looter>) initargs)
-  (setf (probabilities self) (vector 10 77 105 125 142 159 172 200 201 202 216 282 +max-probability+)))
+   (setf (probabilities self) (vector 10 77 105 125 142 159 172 200 201 202 216 282 +max-probability+)))
 (defun as-string (l)
-  ;; Could use assoc here, but this is closer to the original.
-  ;; Also saves translating nil to "".
-  (case l
-    ((bloodstone) "Bloodstone")
-    ((copper) "Copper")
-    ((emeraldite) "Emeraldite")
-    ((gold) "Gold")
-    ((heronite) "Heronite")
-    ((platinum) "Platinum")
-    ((shadownite) "Shadownite")
-    ((silver) "Silver")
-    ((soranite) "Soranite")
-    ((umbrarite) "Umbrarite")
-    ((cobalt) "Cobalt")
-    ((iron) "Iron")
-    (t "")))
+   ;; Could use assoc here, but this is closer to the original.
+   ;; Also saves translating nil to "".
+   (case l
+	 ((bloodstone) "Bloodstone")
+	 ((copper) "Copper")
+	 ((emeraldite) "Emeraldite")
+	 ((gold) "Gold")
+	 ((heronite) "Heronite")
+	 ((platinum) "Platinum")
+	 ((shadownite) "Shadownite")
+	 ((silver) "Silver")
+	 ((soranite) "Soranite")
+	 ((umbrarite) "Umbrarite")
+	 ((cobalt) "Cobalt")
+	 ((iron) "Iron")
+	 (t "")))
 (defun main ()
-  (let ((loot (create (class <looter>))))
-    (for ((n 0 (+ n 1)))
-	((> n 99))
-	(format (standard-output) "~A~%" (as-string (choose loot))))))
+   (let ((loot (create (class <looter>))))
+	(for ((n 0 (+ n 1)))
+             ((> n 99))
+	     (format (standard-output) "~A~%" (as-string (choose loot))))))
 (main)