blob: f0821fc70c187b2588aa32e701bdbb8b9d2d1a1a (
plain)
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
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
|
(in-package #:chains)
(defconstant +special-characters+
'(#\\ #\% #\@ #\$ #\{ #\} #\[ #\] #\Newline)
"")
(defconstant +whitespace+ '(#\Tab #\Newline #\Return #\Space)
"")
;; TODO: (read-char stream nil)
(defun read-if (predicate stream)
"Read characters from STREAM into a string as long as PREDICATE is true"
(let ((string (with-output-to-string (value)
(loop :for c = (read-char stream nil)
:while (and c (funcall predicate c))
:do (write-char c value)
:finally
(when c (unread-char c stream))))))
(if (emptyp string) nil string)))
(defun read-if-not (predicate stream)
"Read characters from STREAM into a string as long as PREDICATE is false"
(read-if (complement predicate) stream))
(defun read-text (stream start-of-line)
"Read text from STREAM"
(let* ((text (read-if-not #'special-char-p stream))
(peek (peek-char nil stream nil)))
(when text (setf start-of-line nil))
(cond ((and (null text) (null peek))
nil)
((and (not start-of-line) (newlinep peek))
(read-char stream nil)
(let ((rest (read-text stream t)))
(when (eq rest 'empty-line)
(setf rest nil)
(unread-char #\Newline stream))
(list* text (string #\Newline) rest)))
((newlinep peek)
(read-char stream nil)
'empty-line)
(t
(ensure-list text)))))
(defun atom-char-p (char)
"Is CHAR allowed as an atom char"
(or (alphanumericp char) (member char '(#\- #\*))))
(defun next-token (stream start-of-line &aux c)
"Read the next token inside STREAM"
(case (setf c (read-char stream nil))
('nil nil)
(#\\
(concat-text (make-text (string (read-char stream nil)))
(make-text (read-if-not #'special-char-p stream))))
(#\%
(peek-char #\Newline stream)
(read-char stream nil)
;;(next-token stream nil)
'separator)
((#\@ #\$)
(let* ((text (read-if #'atom-char-p stream))
(value (read-from-string text))
(type (cond ((symbolp value)
(setf value (intern (symbol-name value) *interpreter-package*))
:symbol)
((integerp value) :integer)
(t (error "Unknown type of object @~A~%" text)))))
;; (unless (or (symbolp value) (integerp value))
;; (error "Unknown type of object @~A~%" text))
(make-object type value)))
(#\{ 'link-start)
(#\} 'link-end)
(#\[ 'raw-link-start)
(#\] 'raw-link-end)
(t
(unread-char c stream)
(let ((text (read-text stream start-of-line)))
(cond ((null text) nil)
((symbolp text) text)
(t (make-text (apply #'concatenate 'string text))))))))
(defun build-tree (tokens)
"Groups a list of tokens into a tree. Returns a subtree and a list of unused
tokens."
(flet ((build-chain (tokens)
(loop :with tokens = tokens
:for (link rest) = (multiple-value-list (build-tree tokens))
:collect link :into links
:while (member (first rest) '(raw-link-start link-start))
:do (setf tokens (rest rest))
:finally
(setf tokens rest)
(return (values links tokens)))))
(destructuring-bind (&optional head &rest tail) tokens
(cond ((null head)
(values nil '()))
((or (eq head 'link-end) (eq head 'raw-link-end))
(values '() (rest tokens)))
((eq head 'separator)
(multiple-value-bind (tree rest) (build-tree tail)
(values tree rest)))
;; @a{...} <-> {@a}{...}
((and (object-symbolp head)
(eq (first tail) 'link-start))
(multiple-value-bind (links rest) (build-chain (rest tail))
(multiple-value-bind (tree rest) (build-tree rest)
(values (cons (make-chain (cons (list head) links)) tree) rest))))
((eq head 'link-start)
(multiple-value-bind (links rest) (build-chain tail)
(multiple-value-bind (tree rest) (build-tree rest)
(values (cons (make-chain links) tree) rest))))
(t
(multiple-value-bind (tree rest) (build-tree tail)
(values (cons head tree) rest)))))))
(defun read-raw-link (stream)
"Read argument of a raw function"
(flet ((squarep (x) (member x '(#\]))))
;; Text omits closing ], may therefore be nil, for example when reading ]]
(loop :for text = (read-if-not #'squarep stream)
:for c = (peek-char nil stream nil)
:when text :collect text :into text-list
:while (and c text (eql (last-elt text) #\\))
:collect (string (read-char stream nil)) :into text-list
:finally
;; Keep ] inside stream
(return (list (make-text (apply #'concat text-list)))))))
(defun start-of-line-p (last-token)
;; Keep track if new line starts a paragraph
(or (eq last-token 'empty-line)
(and (textp last-token)
(newlinep (last-elt (content last-token))))))
(defun read-tree (stream)
"Build a syntax tree from the contents of STREAM"
(loop :with start-of-line = t
:for token = (next-token stream start-of-line)
:while token
:if (eq token 'raw-link-start)
:append (cons 'raw-link-start (read-raw-link stream)) :into tokens
:and :do
(setf start-of-line nil)
:else
:collect token :into tokens :and :do
(setf start-of-line (start-of-line-p token))
:finally ;; (build-tree)
(return tokens)))
|
