diff options
| -rw-r--r-- | cabs-syn.lisp | 35 | ||||
| -rw-r--r-- | cbasic.lisp | 18 | ||||
| -rw-r--r-- | cconv.lisp | 11 | ||||
| -rw-r--r-- | clex.lisp | 7 | ||||
| -rw-r--r-- | cpprint.lisp | 82 | ||||
| -rw-r--r-- | cxdrt.lisp | 18 | ||||
| -rw-r--r-- | doc/bane.20.cdr15.md | 1 | ||||
| -rw-r--r-- | mc.lsp | 2 | ||||
| -rw-r--r-- | v.el | 2 | ||||
| -rw-r--r-- | xdr.lsp | 2 |
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) |