From 9e46aa07a574762db4bc14fd98eca81c4f323f7f Mon Sep 17 00:00:00 2001
From: Darren Bane <dbane@tilde.institute>
Date: Sat, 16 May 2020 00:53:00 +0100
Subject: More playing around

---
 .gitignore   |  1 +
 README.md    |  6 ++++++
 btech.lsp    | 27 +++++++++++++++++++++++++++
 builtins.lsp | 16 ++++++++++++++++
 cmd.lsp      | 28 ++++++++++++++++++++++++++++
 comal.lsp    | 17 ++++++++++++++---
 dbc.lsp      | 11 +++++++++++
 7 files changed, 103 insertions(+), 3 deletions(-)
 create mode 100644 .gitignore
 create mode 100644 README.md
 create mode 100755 btech.lsp
 create mode 100644 builtins.lsp
 create mode 100644 cmd.lsp
 create mode 100644 dbc.lsp

diff --git a/.gitignore b/.gitignore
new file mode 100644
index 0000000..b25c15b
--- /dev/null
+++ b/.gitignore
@@ -0,0 +1 @@
+*~
diff --git a/README.md b/README.md
new file mode 100644
index 0000000..ad7e9a4
--- /dev/null
+++ b/README.md
@@ -0,0 +1,6 @@
+# Lisp playground
+
+This is an unstructured bag of code that I wrote while trying to learn Lisp.
+Mostly the ISLisp dialect.
+
+This code is highly likely to be broken.
diff --git a/btech.lsp b/btech.lsp
new file mode 100755
index 0000000..5a4d11b
--- /dev/null
+++ b/btech.lsp
@@ -0,0 +1,27 @@
+#!/home/dbane/openlisp-10.9.0/uxlisp -shell
+;;; ISLisp is fine so long as you do "read-line" from the same place you call the entry point fun.
+;;; So -shell with an immediate call doesn't work, something is closed after reading the Lisp source.
+;;; -shell -keep, supplying the call from the keyboard works fine.
+;;;
+;;; Calling entry point from a Lisp CLI (after "load") also works.
+;;; And this may be what I end up with, if I'm doing a view in Emacs.
+(require "cmd")
+(require "builtins")
+(defpackage #:btech
+  (:use #:cmd #:builtins)
+  (:export
+    #:main))
+(in-package #:btech)
+;; Favour symbols & objects over C-like numbers
+(defconstant +cmds+ (list
+                      (create-tab #'bt-quit "QUIT" 1)
+                      (create-tab #'help "help" 2)
+                      (create-tab #'look "look" 2)))
+(defun main ()
+  (read-line)                           ; Throw away LF
+  (format (standard-output) "> ")
+  (let* ((tab (lookup (parse (read-line)) +cmds+))
+          (f (fun tab)))
+    (funcall f)))                       ; I *think* this is better than (flet ...
+(provide "btech")
+(main)
diff --git a/builtins.lsp b/builtins.lsp
new file mode 100644
index 0000000..63d8d19
--- /dev/null
+++ b/builtins.lsp
@@ -0,0 +1,16 @@
+(defpackage #:builtins
+  (:use #:openlisp)
+  (:export
+    #:connect
+    #:bt-quit
+    #:help
+    #:look)
+  )
+(in-package #:builtins)
+(defun bt-quit ()
+  (format (standard-output) "TODO: quit~%"))
+(defun help ()
+  (format (standard-output) "TODO: help~%"))
+(defun look ()
+  (format (standard-output) "TODO: look~%"))
+(provide "builtins")
diff --git a/cmd.lsp b/cmd.lsp
new file mode 100644
index 0000000..e186a4e
--- /dev/null
+++ b/cmd.lsp
@@ -0,0 +1,28 @@
+(defpackage #:cmd
+  (:use #:openlisp)
+  (:export
+    #:parse
+    #:create-tab
+    #:fun
+    #:lookup)
+  )
+(in-package #:cmd)
+(defclass <buf> () ((buf :initarg b :reader buf)
+                     (f :initarg f :reader f)))
+(defconstant +ht+ (convert 9 <character>))
+(defun parse (p)
+  (let ((toks (string-split (list #\Space +ht+) p)))
+    (create (class <buf>) 'b (car toks) 'f toks)))
+(defclass <tab> () ((fun :initarg f :reader fun)
+                     (cmd :initarg c :reader cmd)
+                     (narg :initarg n :reader narg)))
+(defun create-tab (f c n)
+  (create (class <tab>) 'f f 'c c 'n n))
+(defgeneric lookup (buf tabs))
+(defmethod lookup ((buf <buf>) tabs)
+  (let ((cmd (buf buf)))
+    (find-if (lambda (tab)
+               (let ((c (cmd tab)))
+                 (string= c cmd)))
+      tabs)))
+(provide "cmd")
diff --git a/comal.lsp b/comal.lsp
index de603ad..7822706 100644
--- a/comal.lsp
+++ b/comal.lsp
@@ -1,12 +1,19 @@
-;; Does it make more sense to write everything in Lisp rather than a split Lisp/COMAL design?
+(defun error-handler (condition)
+   (cond
+         ((eq (class-of condition) (class <lexer-error>)) )))
 
 (defun one-command-h (c)
    (case (car c)
          ((line) (insert (cadr c)))
-         ((p-end) (signal-condition (create (class <simple-error>))))))
+         ((p-end) (throw 'end nil))))   ; ok? No condition stuff?
+
+(defun one-command (c)
+   (handler-bind ((error #'error-handler))
+      (one-command-h c)))
 
 (defun main-loop (program env)
-   
+   (format (standard-output) "> ")
+   (catch 'error (one-command-h)))
 
 (defun main-h ()
    (format (standard-output) "OpenCOMAL version 0.4~%~%")
@@ -14,3 +21,7 @@
 
 (defun bye ()
    (format (standard-output) "See you later...~%"))
+
+(defun go ()
+   (catch 'end (main-h))
+   (bye))
diff --git a/dbc.lsp b/dbc.lsp
new file mode 100644
index 0000000..3429896
--- /dev/null
+++ b/dbc.lsp
@@ -0,0 +1,11 @@
+;; Ported from https://rosettacode.org/wiki/Assertions_in_design_by_contract#Eiffel
+(require "contract")
+;; (set-dynamic *use-contract* nil)
+(defcontract average-of-absolutes (values)
+   (:in ()
+	(> (length values) 0))
+   (:out (res)
+	 (>= res 0))
+   (quotient (reduce #'+ (map '<list> #'abs values)) (length values)))
+;; (average-of-absolutes '(1 3))
+;; (average-of-absolutes '())
-- 
cgit 1.4.1-2-gfad0