version 1.0
This commit is contained in:
parent
a3337c1ad7
commit
cbf4c267df
2 changed files with 30 additions and 32 deletions
10
superfluous-parentheses.asd
Normal file
10
superfluous-parentheses.asd
Normal file
|
@ -0,0 +1,10 @@
|
||||||
|
;;;; superfluous-parentheses.asd
|
||||||
|
;;;; system definition file
|
||||||
|
|
||||||
|
(defsystem "superfluous-parentheses"
|
||||||
|
:description "Syntactic sugar to allow [] and {} in place of normal parentheses."
|
||||||
|
:version "1.0"
|
||||||
|
:author "keith"
|
||||||
|
:homepage "https://bytes.keithhacks.cyou/keith/superfluous-parentheses"
|
||||||
|
:license "Public Domain/CC0"
|
||||||
|
:components ((:file "superfluous-parentheses")))
|
|
@ -4,53 +4,41 @@
|
||||||
(:use common-lisp))
|
(:use common-lisp))
|
||||||
(in-package superfluous-parentheses)
|
(in-package superfluous-parentheses)
|
||||||
|
|
||||||
|
(define-condition simple-reader-error (simple-condition reader-error)
|
||||||
|
())
|
||||||
|
|
||||||
(defun read-bracketed-list (stream begin-char)
|
(defun read-bracketed-list (stream begin-char)
|
||||||
(let* ((end-char (cond ((char= begin-char #\[) #\])
|
(let* ((end-char (cond ((char= begin-char #\[) #\])
|
||||||
((char= begin-char #\{) #\})
|
((char= begin-char #\{) #\})
|
||||||
(t (error "Invalid bracket ~S" begin-char))))
|
(t (error 'simple-reader-error
|
||||||
|
:stream stream
|
||||||
|
:format-control "Invalid bracket ~S"
|
||||||
|
:format-arguments (list begin-char)))))
|
||||||
(list-body (loop for next-char = (peek-char t stream t nil t)
|
(list-body (loop for next-char = (peek-char t stream t nil t)
|
||||||
until (or (char= next-char end-char) (char= next-char #\.))
|
until (or (char= next-char end-char) (char= next-char #\.))
|
||||||
collect (read stream t nil t)))
|
collect (read stream t nil t)))
|
||||||
(last-char (read-char stream t nil t))) ;; discard the last peeked character
|
(last-char (read-char stream t nil t))) ;; discard the last peeked character
|
||||||
(cond ((char= last-char end-char) list-body)
|
(cond ((char= last-char end-char) list-body)
|
||||||
((char= last-char #\.)
|
((char= last-char #\.)
|
||||||
|
(unless list-body
|
||||||
|
(error 'simple-reader-error
|
||||||
|
:stream stream
|
||||||
|
:format-control "Nothing before . in list."
|
||||||
|
:format-arguments nil))
|
||||||
;; set the CDR of the list
|
;; set the CDR of the list
|
||||||
(rplacd (last list-body) (read stream t nil t))
|
(rplacd (last list-body) (read stream t nil t))
|
||||||
;; skip past whitespace
|
;; skip past whitespace
|
||||||
(peek-char t stream t nil t)
|
(peek-char t stream t nil t)
|
||||||
(unless (char= (read-char stream t nil t) end-char)
|
(unless (char= (read-char stream t nil t) end-char)
|
||||||
(error "Too many objects after . in list."))
|
(error 'simple-reader-error
|
||||||
|
:stream stream
|
||||||
|
:format-control "Multiple objects after . in list."
|
||||||
|
:format-arguments nil))
|
||||||
list-body)
|
list-body)
|
||||||
(t (error "Expected ~S or . but got ~S" end-char last-char)))))
|
(t (error 'simple-reader-error
|
||||||
|
:stream stream
|
||||||
#|
|
:format-control "Expected ~S or ., but got ~S."
|
||||||
(declaim (special *cdr-value* *end-char*))
|
:format-arguments (list end-char last-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 #\[ #'read-bracketed-list)
|
||||||
(set-macro-character #\] (get-macro-character #\)))
|
(set-macro-character #\] (get-macro-character #\)))
|
||||||
|
|
Loading…
Reference in a new issue