/
reader.lisp
50 lines (42 loc) · 1.67 KB
/
reader.lisp
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
;;;; -*- Mode: Lisp; indent-tabs-mode: nil -*-
;;;
;;; --- Reader utils
;;;
(in-package :iolib/base)
;; Literal object dispatcher
(defconstant +read-literal-dispatch-char+ #\#)
(defconstant +read-literal-sub-char+ #\/)
(defun read-literal-dispatcher (stream char arg)
(declare (ignore char arg))
(let* ((literal-syntax-name
(with-output-to-string (s)
(loop :for c := (read-char stream t nil t)
:do (if (char= c +read-literal-sub-char+)
(loop-finish)
(write-char c s)))))
(literal-reader
(getf (symbol-plist (read-from-string literal-syntax-name))
'read-literal-fn)))
(if (functionp literal-reader)
(funcall literal-reader stream)
(error 'unknown-literal-syntax
:stream stream
:name literal-syntax-name))))
(defun enable-literal-reader* (&optional (readtable *readtable*))
(set-dispatch-macro-character +read-literal-dispatch-char+
+read-literal-sub-char+
'read-literal-dispatcher
readtable))
(defmacro enable-literal-reader (&optional (readtable '*readtable*))
`(eval-when (:compile-toplevel)
(setf *readtable* (copy-readtable ,readtable))
(enable-literal-reader*)))
(defmacro define-literal-reader (name (stream) &body body)
`(setf (getf (symbol-plist ',name) 'read-literal-fn)
(lambda (,stream) ,@body)))
(defmacro fcase (&body clauses)
`(cond
,@(loop :for c :in clauses
:for test := (car c)
:for forms := (cdr c)
:collect `((featurep ',test) ,@forms))))