syrup/syrup.lisp
2024-05-29 10:28:38 -04:00

61 lines
2.7 KiB
Common Lisp

(defpackage #:syrup
(:use #:cl))
(in-package #:syrup)
(define-condition simple-reader-error (simple-condition reader-error) ())
;; #^ - Inline symbol export macro
;; Use #^SYMBOL or #^(SYMBOL) to export a symbol at the location it's defined.
(defun read-exported-symbol (stream char arg)
"Read a symbol (optionally wrapped in parens) and export it"
(declare (ignore char arg))
(let ((sym (read stream t nil t)))
(when (and (consp sym) (not (cdr sym)))
(setf sym (car sym))) ;; allow wrapping symbol in parens
(unless (symbolp sym)
(error 'simple-reader-error
:stream stream
:format-control "Not a symbol: ~S"
:format-arguments (list sym)))
(export sym)
sym))
(set-dispatch-macro-character #\# #\^ #'read-exported-symbol)
;; Use [] and {} like normal parentheses
;; NOTE: You'll have to add superfluous-parentheses.el to Emacs to get it to recognize this syntax
(defun read-bracketed-list (stream begin-char)
(let* ((end-char (cond ((char= begin-char #\[) #\])
((char= 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)
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 #\.)
(unless list-body
(error 'simple-reader-error
:stream stream
:format-control "Nothing before . in list."
:format-arguments nil))
;; 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 'simple-reader-error
:stream stream
:format-control "Multiple objects after . in list."
:format-arguments nil))
list-body)
(t (error 'simple-reader-error
:stream stream
:format-control "Expected ~S or ., but got ~S."
:format-arguments (list end-char last-char))))))
(set-macro-character #\[ #'read-bracketed-list)
(set-macro-character #\] (get-macro-character #\)))
(set-macro-character #\{ #'read-bracketed-list)
(set-macro-character #\} (get-macro-character #\)))