From 078ae5a0780015dfff775196d675fb23f0367060 Mon Sep 17 00:00:00 2001
From: Darren Bane <darren.bane@gmail.com>
Date: Fri, 4 Dec 2020 00:47:27 +0000
Subject: Can't get past that OpenLisp error; go back to sbcl

---
 cdbc.lisp   | 2 ++
 clex.lisp   | 8 +++++++-
 cparse.lisp | 2 +-
 cutil.lisp  | 6 +++++-
 4 files changed, 15 insertions(+), 3 deletions(-)

diff --git a/cdbc.lisp b/cdbc.lisp
index 9d790ab..57e04e5 100644
--- a/cdbc.lisp
+++ b/cdbc.lisp
@@ -1,5 +1,7 @@
 ;; Ported from https://rosettacode.org/wiki/Assertions_in_design_by_contract#Eiffel
 ;; Arguably not *quite* design-by-contract, but very close in vanilla CL
+;;
+;; NB: This has non-essential complexity compared to the ISLisp version.
 (defun average-of-absolutes (values)
   (declare (list values))
   (assert (> (length values) 0))
diff --git a/clex.lisp b/clex.lisp
index cdd6025..550ead4 100644
--- a/clex.lisp
+++ b/clex.lisp
@@ -4,7 +4,9 @@
    #:<lint>
    #:<lsymbol>
    #:<lstring>
-   #:<lend>))
+   #:<lend>
+   #:<lident>
+   #:ident))
 (in-package #:clex)
 
 (defclass <lexeme> () () (:metaclass <abstract-class>))
@@ -55,4 +57,8 @@
                (and (char>= x #\0) (char<= x #\9))
                (char= x #\_))))
     (extract #'is-alpha-num cl)))
+
+(defgeneric lexer (cl))
+(defmethod lexer ((cl <string-lexer>))
+  )
 (provide "clex")
diff --git a/cparse.lisp b/cparse.lisp
index 602dc76..31d7817 100644
--- a/cparse.lisp
+++ b/cparse.lisp
@@ -27,7 +27,7 @@
 	((string= s ">") 'great)))
 
 (defun parse (str)
-  (let* ((cl (init-lex str))
+  (let* ((cl (make-instance (find-class '<string-lexer>) 's str))
 	 (tok (lexer cl)))
     (cond ((instancep tok (find-class '<lint>))
 	   (make-instance (find-class '<line>) 'n n 'c (parse-cmd cl)))
diff --git a/cutil.lisp b/cutil.lisp
index e651b11..6b3f381 100644
--- a/cutil.lisp
+++ b/cutil.lisp
@@ -1,7 +1,8 @@
 (defpackage #:cutil
   (:use #:common-lisp)
   (:export
-   #:<abstract-class>))
+   #:<abstract-class>
+   #:instancep))
 (in-package #:cutil)
 
 (defclass <abstract-class> (standard-class) ())
@@ -18,4 +19,7 @@
 					   (superclass <abstract-class>))
   t)
 
+(defun instancep (obj cls)
+  (eq (class-of obj) cls))
+
 (provide "cutil")
-- 
cgit 1.4.1-2-gfad0