diff options
| -rw-r--r-- | README.md | 3 | ||||
| -rw-r--r-- | cabs-syn.lisp | 37 | ||||
| -rw-r--r-- | cbasic.lisp | 19 | ||||
| -rw-r--r-- | ceval.lisp | 23 | ||||
| -rw-r--r-- | clex.lisp | 41 | ||||
| -rw-r--r-- | cpprint.lisp | 83 | ||||
| -rw-r--r-- | doc/Makefile | 8 |
7 files changed, 209 insertions, 5 deletions
diff --git a/README.md b/README.md index ad7e9a4..1bdf02f 100644 --- a/README.md +++ b/README.md @@ -1,6 +1,7 @@ # Lisp playground This is an unstructured bag of code that I wrote while trying to learn Lisp. -Mostly the ISLisp dialect. +Most files are in the ISLisp dialect. +Files matching c\*.lisp are in Common Lisp. This code is highly likely to be broken. diff --git a/cabs-syn.lisp b/cabs-syn.lisp new file mode 100644 index 0000000..a339a47 --- /dev/null +++ b/cabs-syn.lisp @@ -0,0 +1,37 @@ +;; 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)) +(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 <cmd-rem> (<command>) ((rem :accessor rem))) +(defclass <cmd-goto> (<command>) ((goto :accessor goto))) +(defclass <cmd-print> (<command>) ((expr :accessor expr))) +(defclass <cmd-input> (<command>) ((var :accessor var))) +(defclass <cmd-if> (<command>) ((expr :accessor expr) (num :accessor num))) +(defclass <cmd-let> (<command>) ((var :accessor var) (expr :accessor expr))) + +(defclass <line> () ((num :accessor num) (cmd :accessor cmd))) + +(defclass <phrase> () () (:abstractp t)) +(defclass <phrase-line> (<phrase>) ((line :accessor line))) +(defclass <phrase-list> (<phrase>) ()) +(defclass <phrase-run> (<phrase>) ()) +(defclass <phrase-p-end> (<phrase>) ()) + +(defun priority-uop (unr-op) + (case unr-op + ((not) 1) + ((uminus) 7))) + +(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) + ((member bin-op '(and or)) 2))) diff --git a/cbasic.lisp b/cbasic.lisp new file mode 100644 index 0000000..99220fb --- /dev/null +++ b/cbasic.lisp @@ -0,0 +1,19 @@ +;;; 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. + +(defun one-command (st) + (with-handler #'error-handler + (let ((l parse (read-line))) + (case (car l) + ((line) (insert (cadr c))) + ((p-end) (throw 'end nil)))))) ; throw and conditions are orthogonal + +(defclass <state> () ((program :accessor prog) + (env :accessor env))) +(defmethod initialize-object :after ((self <state>) initargs) + (setf (program self) nil) + (setf (env self) nil)) + +(defun main () + (catch 'end (lambda () + (format (standard-output) "BASIC version 0.1 diff --git a/ceval.lisp b/ceval.lisp new file mode 100644 index 0000000..60a19c0 --- /dev/null +++ b/ceval.lisp @@ -0,0 +1,23 @@ +(defclass <value> () () (:abstractp t)) +(defclass <v-int> (<value>) ((int :accessor int))) +(defclass <v-str> (<value>) ((str :accessor str))) +(defclass <v-bool> (<value>) ((bool :accessor bool))) + +(defclass <environment> () ((env :accessor env))) + +(defun lookup-index (tprog num-line) + (block result-lookup-index + (for ((i 0 (+ i 1))) + ((>= i (length tprog))) + (let ((num-i (num (elt tprog i)))) + (if (= num-i num-line) + (return-from result-lookup-index i) + (if (> num-i num-line) + (return-from result-lookup-index -1))))) + -1)) + +(defun assemble (prog) + (let ((tprog (apply #'vector prog))) + (for ((i 0 (+ i 1))) + ((>= i (length tprog))) + ()))) diff --git a/clex.lisp b/clex.lisp new file mode 100644 index 0000000..52eb822 --- /dev/null +++ b/clex.lisp @@ -0,0 +1,41 @@ +(defclass <string-lexer> () ((string :initarg :s :accessor string) + (current :initform 0 :accessor current) + (size :accessor size))) + +(defmethod initialize-object :after ((self <string-lexer>) initargs) + (setf (size self) (length (str 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)))) + +(defgeneric extract (pred cl)) +(defmethod extract (pred (cl <string-lexer>)) + (let* ((st (string 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)))) + +(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>))) + +(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))) diff --git a/cpprint.lisp b/cpprint.lisp new file mode 100644 index 0000000..84dbfc1 --- /dev/null +++ b/cpprint.lisp @@ -0,0 +1,83 @@ +(defun pp-binop (bin-op) + (case bin-op + ((plus) "+") + ((mult) "*") + ((mod) "%") + ((minus) "-") + ((div) "/") + ((equal) " = ") + ((less) " < ") + ((lesseq) " <= ") + ((great) " > ") + ((greateq) " >= ") + ((diff) " <> ") + ((and) " & ") + ((or) " | "))) + +(defun pp-unrop (unr-op) + (case unr-op + ((uminus) "-") + ((not) "!"))) + +(defun parenthesis (x) + (string-append "(" x ")")) + +(defgeneric ppl (pr expr)) +(defmethod ppl (pr (expr <exp-int>)) + (convert (num expr) <string>)) +(defmethod ppl (pr (expr <exp-var>)) + (var expr)) +(defmethod ppl (pr (expr <exp-str>)) + (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)))) +(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)))) + +(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)))) +(defmethod ppr (pr (expr <exp-int>)) + (ppl pr expr)) +(defmethod ppr (pr (expr <exp-var>)) + (ppl pr expr)) +(defmethod ppr (pr (expr <exp-str>)) + (ppl pr expr)) +(defmethod ppr (pr (expr <exp-unr>)) + (ppl pr expr)) + +(defun pp-expression (expr) + (ppl 0 expr)) + +(defgeneric pp-command (cmd)) +(defmethod pp-command ((cmd <cmd-rem>)) + (string-append "REM " (str cmd))) +(defmethod pp-command ((cmd <cmd-goto>)) + (string-append "GOTO " (convert (num cmd) <string>))) +(defmethod pp-command ((cmd <cmd-print>)) + (string-append "PRNT " (pp-expression (expr cmd)))) +(defmethod pp-command ((cmd <cmd-input>)) + (string-append "INPUT " (var cmd))) +(defmethod pp-command ((cmd <cmd-if>)) + (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)))) + +(defun pp-line (l) + (string-append (convert (car l) <string>) " " (pp-command (cdr l)))) diff --git a/doc/Makefile b/doc/Makefile index adae890..deb3d8e 100644 --- a/doc/Makefile +++ b/doc/Makefile @@ -2,7 +2,7 @@ .DELETE_ON_ERROR: .PHONY: all -all: breaking_rules.pdf breaking_rules.html breaking_rules.txt +all: breaking_rules.pdf breaking_rules.html breaking_rules.txt bane.20.cdr15.html # Stick with gfm for as long as possible. # Use stuff beyond that only where absolutely necessary. @@ -12,8 +12,8 @@ breaking_rules.pdf: macros.ms breaking_rules.md refs.i ( cat macros.ms; lowdown -sTms breaking_rules.md ) | pdfroff -i -t -R -mspdf -k -Kutf8 > $@ # On macOS only, headers aren't emitted currently -breaking_rules.html: macros.ms breaking_rules.md refs.i - ( cat macros.ms; lowdown -sTms breaking_rules.md ) | groff -Txhtml -i -t -R -ms -k -Kutf8 > $@ +%.html: macros.ms %.md refs.i + ( cat macros.ms; lowdown -sTms $(filter %.md,$^) ) | groff -Txhtml -i -t -R -ms -k -Kutf8 > $@ breaking_rules.txt: macros.ms breaking_rules.md refs.i ( cat macros.ms; lowdown -sTms breaking_rules.md ) | env GROFF_NO_SGR=t groff -Tlatin1 -i -t -R -ms -k -Kutf8 -c | ul > $@ @@ -23,4 +23,4 @@ refs.i: refs .PHONY: clean clean: - $(RM) breaking_rules.pdf breaking_rules.html breaking_rules.txt + $(RM) breaking_rules.pdf breaking_rules.html breaking_rules.txt bane.20.cdr15.html |