Making changes

10 files changed, 133 insertions, 45 deletions

diff --git a/cabs-syn.lisp b/cabs-syn.lisp
index a339a47..1a921a0 100644
--- a/cabs-syn.lisp
+++ b/cabs-syn.lisp
@@ -1,14 +1,42 @@
+(defpackage #:cabs-syn
+  (:use #:common-lisp)
+  (:export
+   #:<exp-int>
+   #:<exp-var>
+   #:<exp-str>
+   #:<exp-unr>
+   #:<exp-bin>
+   #:<cmd-rem>
+   #:<cmd-goto>
+   #:<cmd-print>
+   #:<cmd-input>
+   #:<cmd-if>
+   #:<cmd-let>
+   #:<phrase-line>
+   #:<phrase-list>
+   #:<phrase-run>
+   #:<phrase-p-end>
+   priority-uop
+   priority-binop))
+(in-package #:cabs-syn)
+
 ;; 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))
+;; Is it worth putting just 3 lines in a "cutils.lisp" or something?
+;; Not for now, since it's private.
+(defclass <abstract-class> () ())
+(defmethod make-instance ((self <abstract-class>) &key)
+  (error "Cannot instantiate abstract class ~A" (class-name c)))
+
+(defclass <expression> () () (:metaclass <abstract-class>))
 (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 <command> () () (:metaclass <abstract-class>))
 (defclass <cmd-rem> (<command>) ((rem :accessor rem)))
 (defclass <cmd-goto> (<command>) ((goto :accessor goto)))
 (defclass <cmd-print> (<command>) ((expr :accessor expr)))
@@ -18,7 +46,7 @@
 
 (defclass <line> () ((num :accessor num) (cmd :accessor cmd)))
 
-(defclass <phrase> () () (:abstractp t))
+(defclass <phrase> () () (:metaclass <abstract-class>))
 (defclass <phrase-line> (<phrase>) ((line :accessor line)))
 (defclass <phrase-list> (<phrase>) ())
 (defclass <phrase-run> (<phrase>) ())
@@ -35,3 +63,4 @@
     ((eql bin-op 'mod) 4)
     ((member bin-op '(equal less lesseq great greateq diff)) 3)
     ((member bin-op '(and or)) 2)))
+(provide "cabs-syn")
diff --git a/cbasic.lisp b/cbasic.lisp
index 1974c24..858d491 100644
--- a/cbasic.lisp
+++ b/cbasic.lisp
@@ -1,10 +1,19 @@
 ;;; I'm trying to write an interpreter for a BBC BASIC subset
-;;; using a Frankenstein design following
-;;; https://caml.inria.fr/pub/docs/oreilly-book/html/book-ora058.html and
+;;; 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
 
-;;; 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.
+(require "cparse")
+(require "")
+(defpackage #:cbasic
+  (:use #:common-lisp)
+  (:export
+   #:main))
+(in-package #:cbasic)
+
+;;; Not sure if it's a good idea,
+;;; but try to keep the number of top-level functions the same as in OCaml.
 
 (defun one-command (st)
   (format (standard-output) "> ")
@@ -26,3 +35,4 @@
                 (for ((st (create (class <state>))))
                      (catch 'error (one-command st)))))
   (format (standard-output) "See you later...~%"))
+(provide "cbasic")
diff --git a/cconv.lisp b/cconv.lisp
new file mode 100644
index 0000000..1d4f949
--- /dev/null
+++ b/cconv.lisp
@@ -0,0 +1,11 @@
+(defpackage :cconv
+  (:use :common-lisp :ltk)
+  (:export #:main))
+
+(in-package :cconv)
+
+(defun main ()
+  (setf *debug-tk* nil)
+  (with-ltk ()
+    (wm-title "." "Feet to Meters")
+    ()))
diff --git a/clex.lisp b/clex.lisp
index 52eb822..16ce0ff 100644
--- a/clex.lisp
+++ b/clex.lisp
@@ -1,3 +1,9 @@
+(defpackage #:clex
+  (:use #:common-lisp)
+  (:export
+   ))
+(in-package #:clex)
+
 (defclass <string-lexer> () ((string :initarg :s :accessor string)
                              (current :initform 0 :accessor current)
                              (size :accessor size)))
@@ -39,3 +45,4 @@
                           (and (char>= x #\0) (char<= x #\9))
                           (char= x #\_)))))
     (extract is-alpha-num)))
+(provide "clex")
diff --git a/cpprint.lisp b/cpprint.lisp
index 84dbfc1..82dec08 100644
--- a/cpprint.lisp
+++ b/cpprint.lisp
@@ -1,3 +1,8 @@
+(defpackage #:cpprint
+  (:use #:common-lisp)
+  (:export pp-line))
+(in-package #:cpprint)
+
 (defun pp-binop (bin-op)
   (case bin-op
     ((plus) "+")
@@ -15,69 +20,70 @@
     ((or) " | ")))
 
 (defun pp-unrop (unr-op)
-   (case unr-op
-         ((uminus) "-")
-         ((not) "!")))
+  (case unr-op
+    ((uminus) "-")
+    ((not) "!")))
 
 (defun parenthesis (x)
-   (string-append "(" x ")"))
+  (string-append "(" x ")"))
 
 (defgeneric ppl (pr expr))
 (defmethod ppl (pr (expr <exp-int>))
-   (convert (num expr) <string>))
+  (convert (num expr) <string>))
 (defmethod ppl (pr (expr <exp-var>))
-   (var expr))
+  (var expr))
 (defmethod ppl (pr (expr <exp-str>))
-   (string-append "\"" (str expr) "\""))
+  (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))))
+  (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))))
+  (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))))
+  (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))
+  (ppl pr expr))
 (defmethod ppr (pr (expr <exp-var>))
-   (ppl pr expr))
+  (ppl pr expr))
 (defmethod ppr (pr (expr <exp-str>))
-   (ppl pr expr))
+  (ppl pr expr))
 (defmethod ppr (pr (expr <exp-unr>))
-   (ppl pr expr))
+  (ppl pr expr))
 
 (defun pp-expression (expr)
-   (ppl 0 expr))
+  (ppl 0 expr))
 
 (defgeneric pp-command (cmd))
 (defmethod pp-command ((cmd <cmd-rem>))
-   (string-append "REM " (str cmd)))
+  (string-append "REM " (str cmd)))
 (defmethod pp-command ((cmd <cmd-goto>))
-   (string-append "GOTO " (convert (num cmd) <string>)))
+  (string-append "GOTO " (convert (num cmd) <string>)))
 (defmethod pp-command ((cmd <cmd-print>))
-   (string-append "PRNT " (pp-expression (expr cmd))))
+  (string-append "PRINT " (pp-expression (expr cmd))))
 (defmethod pp-command ((cmd <cmd-input>))
-   (string-append "INPUT " (var cmd)))
+  (string-append "INPUT " (var cmd)))
 (defmethod pp-command ((cmd <cmd-if>))
-   (string-append "IF " (pp-expression (expr cmd)) " THEN " (convert (num cmd) <string>)))
+  (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))))
+  (string-append "LET " (var cmd) " = " (pp-expression (expr cmd))))
 
 (defun pp-line (l)
-   (string-append (convert (car l) <string>) "  " (pp-command (cdr l))))
+  (string-append (convert (car l) <string>) "  " (pp-command (cdr l))))
+(provide "cpprint")
diff --git a/cxdrt.lisp b/cxdrt.lisp
new file mode 100644
index 0000000..6c84657
--- /dev/null
+++ b/cxdrt.lisp
@@ -0,0 +1,18 @@
+(defun xwrt (fname)
+  (with-open-file (f fname :direction :output :if-exists :supersede :element-type '(unsigned-byte 8))
+    (frpc:write-xtype :int32 f 1234)
+    (frpc:write-xtype :real32 f 3.14159)
+    (frpc:write-xtype :real64 f 2.71828d0)
+    (frpc:write-xtype :int32 f -5678)
+    (frpc:write-xtype :string f "XDR and Common Lisp")
+    (frpc:write-xtype :int32 f 21845)))
+
+(defun xrdr (fname)
+  (with-open-file (f fname :direction :input :element-type '(unsigned-byte 8))
+    (format *standard-output* "~A ~A ~A ~A ~A~%~A~%"
+            (frpc:read-xtype :int32 f)
+            (frpc:read-xtype :real32 f)
+            (frpc:read-xtype :real64 f)
+            (frpc:read-xtype :int32 f)
+            (frpc:read-xtype :string f)
+            (frpc:read-xtype :int32 f))))
diff --git a/doc/bane.20.cdr15.md b/doc/bane.20.cdr15.md
index 844eaee..bb25021 100644
--- a/doc/bane.20.cdr15.md
+++ b/doc/bane.20.cdr15.md
@@ -22,6 +22,7 @@ Write an ISLisp program, making the following adaptations:
 
 | ISLisp            | CL                  |
 | ----------------- | ------------------- |
+| (:abstractp t)    | (:metaclass <abstract-class>) |
 | (class x)         | (find-class 'x)     |
 | create            | make-instance       |
 | defglobal         | defvar              |
diff --git a/mc.lsp b/mc.lsp
index 42b2f8b..5819438 100644
--- a/mc.lsp
+++ b/mc.lsp
@@ -1,5 +1,7 @@
 ;;; Port of https://stackoverflow.com/questions/3984296/model-view-controller-design-pattern-code-example.
 ;;; Model and Controller classes.
+;;;
+;;; Probably better to just use ltk.
 
 (require "json")
 (defpackage #:mc
diff --git a/v.el b/v.el
index bc96aef..7a5eb8b 100644
--- a/v.el
+++ b/v.el
@@ -1,5 +1,7 @@
 ;;; Port of https://stackoverflow.com/questions/3984296/model-view-controller-design-pattern-code-example.
 ;;; View class.
+;;;
+;;; Probably better to just use ltk.
 
 (require 'eieio)
 (eval-when-compile (require 'cl-lib))
diff --git a/xdr.lsp b/xdr.lsp
index ffbb868..ee1b2a7 100644
--- a/xdr.lsp
+++ b/xdr.lsp
@@ -1,3 +1,5 @@
+;;; Use (a subset of) CL and the xpc part of the "frpc" package from QuickLisp instead.
+
 (require "olunit")
 (defpackage #:xdr
   (:use #:openlisp #:olunit)