diff options
| -rw-r--r-- | cabs-syn.lisp | 12 | ||||
| -rw-r--r-- | cbasic.lisp | 30 | ||||
| -rw-r--r-- | clex.lisp | 48 | ||||
| -rw-r--r-- | cparse.lisp | 5 | ||||
| -rw-r--r-- | cutil.lisp | 14 | ||||
| -rw-r--r-- | doc/breaking_rules.md | 2 |
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, |