Newer
Older
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
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
;; -*- Mode: Lisp ; Base: 10 ; Syntax: ANSI-Common-Lisp -*-
#+xcvb (module (:depends-on ("package")))
(in-package :scribble)
(eval-now
(define-condition simple-parse-error (simple-error parse-error)
())
(defun simple-parse-error (format &rest arguments)
(error 'simple-parse-error
:format-control format :format-arguments arguments))
; -----------------------------------------------------------------------------
;;; Markers
(defun mirror-char (x)
(check-type x (or null character))
(let* ((s "()[]{}<>pqbd")
(p (position x s)))
(if p
(aref s (logxor p 1))
x)))
(defun mirror-string (x)
(check-type x string)
(map 'string 'mirror-char (reverse x)))
(defun ascii-char-p (x)
(and (typep x 'base-char)
(<= (char-code x) 127)))
(defun expected-char-p (c expectation)
(check-type c (or null character))
(etypecase expectation
(null t)
(character (eql c expectation))
(sequence (find c expectation))
(function (funcall expectation c))))
(defvar *lf* (string #\newline))
(fmemo:define-memo-function n-spaces (n)
(make-string n :initial-element #\space :element-type 'base-char))
(defun expect-char (i &optional expectation)
(let ((c (peek-char nil i nil nil t)))
(and (expected-char-p c expectation) (read-char i))))
(defun expect-string (i s)
(loop :for c :across s :for l :from 0 :do
(unless (expect-char i c)
(return (values nil (subseq s l))))
:finally (return (values t l))))
(defun skip-whitespace-return-column (i &optional (col 0))
(loop :for c = (expect-char i #.(format nil " ~c" #\tab))
:while c :do
(ecase c
((#\space) (incf col))
((#\tab) (setf col (to-next-tab col))))
:finally (return col)))
(defun trim-ending-spaces (s)
(let ((p (position-if #'(lambda (c) (not (member c '(#\space #\tab)))) s :from-end t)))
(if p (subseq s 0 (1+ p)) nil)))
(defun read-to-char (c &optional (i *standard-input*))
(with-output-to-string (o)
(loop :for char = (expect-char i)
:until (eql c char)
:do (write-char char o))))
(defun read-paren-list (stream opening)
(let ((closing (mirror-char opening)))
(check-type closing character)
(read-delimited-list closing stream t)))
(defun unbalanced-paren (stream char)
(simple-parse-error "Unbalanced ~A on ~A @ ~A." char stream (file-position stream)))
);eval-now