Merge branch 'master' of /home/dbane/public_repos/lsp

6 files changed, 72 insertions, 39 deletions

diff --git a/cabs-syn.lisp b/cabs-syn.lisp
index 12b9fd4..60b1a65 100644
--- a/cabs-syn.lisp
+++ b/cabs-syn.lisp
@@ -24,14 +24,17 @@
 ;; But classes seem better for the associated data, in discriminated unions.
 
 (defclass <expression> () () (:metaclass <abstract-class>))
-(defclass <exp-int> (<expression>) ((int :accessor int)))
+
+(defclass <exp-int> (<expression>) ((my-int :accessor my-int)))
+;; TODO: need another closer-mop:validate-superclass call here
+
 (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> () () (:metaclass <abstract-class>))
-(defclass <cmd-rem> (<command>) ((rem :accessor rem)))
+(defclass <cmd-rem> (<command>) ((remark :accessor remark)))
 (defclass <cmd-goto> (<command>) ((goto :accessor goto)))
 (defclass <cmd-print> (<command>) ((expr :accessor expr)))
 (defclass <cmd-input> (<command>) ((var :accessor var)))
@@ -51,7 +54,8 @@
     ((not) 1)
     ((uminus) 7)))
 
-(defun priority-binop (bin-op  (cond ((member bin-op '(mult div)) 6)
+(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)
diff --git a/cbasic.lisp b/cbasic.lisp
index a999223..0f2d63c 100644
--- a/cbasic.lisp
+++ b/cbasic.lisp
@@ -1,11 +1,31 @@
 ;;; I'm trying to write an interpreter for a BBC BASIC subset
 ;;; initially following the design of
 ;;; https://caml.inria.fr/pub/docs/oreilly-book/html/book-ora058.html
-;;; and later I can Frankenstein it with
-;;; https://github.com/Henry/BuddKaminInterpreters
+;;; then later I can optimise following
+;;; https://github.com/Henry/BuddKaminInterpreters and *maybe*
+;;; https://oleksandrmanzyuk.wordpress.com/2014/06/18/from-object-algebras-to-finally-tagless-interpreters-2/
+;;;
+;;; A BASIC interpreter already exists at
+;;; https://gitlab.com/com-informatimago/com-informatimago/-/tree/master/small-cl-pgms/basic
+;;; but it is idiomatic CL,
+;;; whereas I'm experimenting with a subset like ISLisp.
 
+;; Because this is the main package,
+;; 1) ql:quickload QuickLisp dependencies and
+(ql:quickload "closer-mop")
+;; 2) load local dependencies here.
 (load "cutil.lisp")
+(load "cabs-syn.lisp")
+(load "clex.lisp")
 (load "cparse.lisp")
+;;
+;; Use require & defpackage in each package from then on.
+;; NB: must have no circular dependencies, and topologically sort the loads.
+;;
+;; TODO: is it easier to just get started with ASDF?
+;;       ( https://lisp-lang.org/learn/writing-libraries )
+;;       Although this is beyond OpenLisp.
+
 (require "cparse")
 (defpackage #:cbasic
   (:use #:common-lisp)
@@ -17,7 +37,7 @@
 ;;; but try to keep the number of top-level functions the same as in OCaml.
 
 (defun one-command (st)
-  (format (standard-output) "> ")
+  (format *standard-output* "> ")
   (with-handler #'error-handler
     (let ((l (parse (read-line))))
       (case (car l)
@@ -32,8 +52,8 @@
 
 (defun main ()
   (catch 'end (lambda ()
-                (format (standard-output) "BASIC version 0.1~%~%")
+                (format *standard-output* "BASIC version 0.1~%~%")
                 (for ((st (create (class <state>))))
                      (catch 'error (one-command st)))))
-  (format (standard-output) "See you later...~%"))
+  (format *standard-output* "See you later...~%"))
 (provide "cbasic")
diff --git a/clex.lisp b/clex.lisp
index 3ce6aaa..cdd6025 100644
--- a/clex.lisp
+++ b/clex.lisp
@@ -1,5 +1,5 @@
 (defpackage #:clex
-  (:use #:common-lisp #:util)
+  (:use #:common-lisp #:cutil)
   (:export
    #:<lint>
    #:<lsymbol>
@@ -10,49 +10,49 @@
 (defclass <lexeme> () () (:metaclass <abstract-class>))
 (defclass <lint> (<lexeme>) ((int :reader int)))
 (defclass <lident> (<lexeme>) ((ident :reader ident)))
-(defclass <lsymbol> (<lexeme>) ((symbol :reader symbol)))
-(defclass <lstring> (<lexeme>) ((string :reader string)))
+(defclass <lsymbol> (<lexeme>) ((lsymbol :reader lsymbol)))
+(defclass <lstring> (<lexeme>) ((lstring :reader lstring)))
 (defclass <lend> (<lexeme>) ())
 
-(defclass <string-lexer> () ((string :initarg :s :accessor string)
+(defclass <string-lexer> () ((lstring :initarg :s :accessor lstring)
                              (current :initform 0 :accessor current)
                              (size :accessor size)))
 
 (defmethod initialize-object :after ((self <string-lexer>) initargs)
-   (setf (size self) (length (str self))))
+   (setf (size self) (length (lstring 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))
+   (let* ((st (lstring 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))))
+          (res nil))
+     (labels ((ext (n)
+		(if (and (< n (size cl)) (funcall pred (elt st n)))
+                    (ext (+ n 1))
+                    n)))
+       (setq res (ext pos))
+       (setf (current cl) res)
+       (subseq (lstring cl) pos (- res pos)))))
 
 (defgeneric extract-int (cl))
 (defmethod extract-int ((cl <string-lexer>))
-  ;; TODO: flet?
-  (let ((is-int (lambda (x)
-                  (and (char>= x #\0) (char<= x #\9)))))
-    (convert (extract is-int cl) <number>)))
+  (flet ((is-int (x)
+           (and (char>= x #\0) (char<= x #\9))))
+    (parse-integer (extract #'is-int cl))))
 
 (defgeneric extract-ident (cl))
 (defmethod extract-ident ((cl <string-lexer>))
-  (let ((is-alpha-num (lambda (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)))
+  (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 cl)))
 (provide "clex")
diff --git a/cparse.lisp b/cparse.lisp
index 5c8c6bb..602dc76 100644
--- a/cparse.lisp
+++ b/cparse.lisp
@@ -5,7 +5,7 @@
 (in-package #:cparse)
 
 (defclass <exp-elem> () () (:metaclass <abstract-class>))
-(defclass <elem-exp> (<exp-elem>) ((exp :accessor exp)))
+(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) ())
@@ -40,5 +40,4 @@
 		  (make-instance (find-class '<phrase-p-end>)))
 		 (t (error "Parse error"))))
 	  (t (error "Parse error")))))
-
-		 
+(provide "cparse")
diff --git a/cutil.lisp b/cutil.lisp
index 0b569e2..e651b11 100644
--- a/cutil.lisp
+++ b/cutil.lisp
@@ -4,8 +4,18 @@
    #:<abstract-class>))
 (in-package #:cutil)
 
-(defclass <abstract-class> () ())
+(defclass <abstract-class> (standard-class) ())
 (defmethod make-instance ((self <abstract-class>) &key)
-  (error "Cannot instantiate abstract class ~A" (class-name c)))
+  (error "Cannot instantiate abstract class ~A" (class-name self)))
+
+;;; These are copied from cl-abstract-classes in Quicklisp.
+;;; It turns out you do need both.
+;;; Maybe someday I'll understand why :-)
+(defmethod closer-mop:validate-superclass ((class <abstract-class>)
+					   (superclass cl:standard-class))
+  t)
+(defmethod closer-mop:validate-superclass ((class cl:standard-class)
+					   (superclass <abstract-class>))
+  t)
 
 (provide "cutil")
diff --git a/doc/breaking_rules.md b/doc/breaking_rules.md
index 5c622f8..51c5cf2 100644
--- a/doc/breaking_rules.md
+++ b/doc/breaking_rules.md
@@ -58,7 +58,7 @@ Reasons for choosing Common Lisp include:
 * Although the official ANSI standard is moribund,
   quasi-standard libaries are recommended on the
   [awesome list](https://github.com/CodyReichert/awesome-cl),
-  or [portability layers](https://github.com/CodyReichert/awesome-cl#portability-layers).
+  or [portability layers](http://portability.cl/).
 * Contrary to a lot of other languages, it is fairly paradigm-agnostic.
 
 At the same time, I want a clean subset of CL,