diff options
Diffstat (limited to 'src/parser.lisp')
| -rw-r--r-- | src/parser.lisp | 25 |
1 files changed, 15 insertions, 10 deletions
diff --git a/src/parser.lisp b/src/parser.lisp index 60e7ac4..f0821fc 100644 --- a/src/parser.lisp +++ b/src/parser.lisp @@ -1,7 +1,7 @@ (in-package #:chains) (defconstant +special-characters+ - '(#\\ #\% #\# #\@ #\$ #\{ #\} #\[ #\] #\Newline) + '(#\\ #\% #\@ #\$ #\{ #\} #\[ #\] #\Newline) "") (defconstant +whitespace+ '(#\Tab #\Newline #\Return #\Space) @@ -43,7 +43,8 @@ (ensure-list text))))) (defun atom-char-p (char) - (or (alphanumericp char) (eql 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" @@ -60,16 +61,14 @@ ((#\@ #\$) (let* ((text (read-if #'atom-char-p stream)) (value (read-from-string text)) - (type (cond ((symbolp value) 'symbol) - ((integerp value) 'integer) + (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)) - (cons type value))) - (#\# - (case (read-char stream nil) - (#\@ (cons 'raw-function (read-if #'alphanumericp stream))) - (#\$ (cons 'inline-raw-function (read-if #'alphanumericp stream))))) + (make-object type value))) (#\{ 'link-start) (#\} 'link-end) (#\[ 'raw-link-start) @@ -101,10 +100,16 @@ 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 (cons 'chain links) tree) rest)))) + (values (cons (make-chain links) tree) rest)))) (t (multiple-value-bind (tree rest) (build-tree tail) (values (cons head tree) rest))))))) |