committing both methods just for the sake of it

This commit is contained in:
~keith 2022-03-13 02:53:27 +00:00
parent 9096b01a71
commit a3337c1ad7
Signed by: keith
GPG key ID: 5BEBEEAB2C73D520

View file

@ -0,0 +1,59 @@
;;;; superfluous-parentheses.lisp
;;;; Adds support for [] and {} in place of normal parentheses
(defpackage superfluous-parentheses
(:use common-lisp))
(in-package superfluous-parentheses)
(defun read-bracketed-list (stream begin-char)
(let* ((end-char (cond ((char= begin-char #\[) #\])
((char= begin-char #\{) #\})
(t (error "Invalid bracket ~S" begin-char))))
(list-body (loop for next-char = (peek-char t stream t nil t)
until (or (char= next-char end-char) (char= next-char #\.))
collect (read stream t nil t)))
(last-char (read-char stream t nil t))) ;; discard the last peeked character
(cond ((char= last-char end-char) list-body)
((char= last-char #\.)
;; set the CDR of the list
(rplacd (last list-body) (read stream t nil t))
;; skip past whitespace
(peek-char t stream t nil t)
(unless (char= (read-char stream t nil t) end-char)
(error "Too many objects after . in list."))
list-body)
(t (error "Expected ~S or . but got ~S" end-char last-char)))))
#|
(declaim (special *cdr-value* *end-char*))
(defun read-bracketed-dot (stream char)
(declare (ignore char))
(let ((tail (read-delimited-list *end-char* stream t)))
(when (> (length tail) 1)
(error "Too many objects following . in list."))
(when (< (length tail) 1)
(error "Nothing appears after . in list."))
(setf *cdr-value* (car tail)))
;; put the closing bracket back, then return nothing
(unread-char *end-char* stream)
(values))
(defun read-bracketed-list (stream begin-char)
(let ((*end-char* (cond ((char= begin-char #\[) #\])
((char= begin-char #\{) #\})
(t (error "Invalid bracket ~S" begin-char))))
(*cdr-value* nil)
(*readtable* (copy-readtable)))
(set-macro-character #\. #'read-bracketed-dot t)
(let ((list-body (read-delimited-list *end-char* stream t)))
(when (and *cdr-value* (not list-body))
(error "Nothing appears before . in list."))
(rplacd (last list-body) *cdr-value*)
list-body)))
|#
(set-macro-character #\[ #'read-bracketed-list)
(set-macro-character #\] (get-macro-character #\)))
(set-macro-character #\{ #'read-bracketed-list)
(set-macro-character #\} (get-macro-character #\)))