;;; Fragments.
(define-pluggable-parser module code (scanner pset)
- ;; `code' id `:' id [constraints] `{' c-fragment `}'
+ ;; `code' id `:' item-name [constraints] `{' c-fragment `}'
;;
;; constrains ::= `[' constraint-list `]'
- ;; constraint ::= id+
+ ;; constraint ::= item-name+
+ ;; item-name ::= id | `(' id+ `)'
(declare (ignore pset))
(with-parser-context (token-scanner-context :scanner scanner)
- (flet ((kw ()
- (parse (seq ((kw :id)) (intern (string-upcase kw) 'keyword)))))
+ (labels ((kw ()
+ (parse (seq ((kw :id))
+ (intern (frob-identifier kw) 'keyword))))
+ (item ()
+ (parse (or (kw)
+ (seq (#\( (names (list (:min 1) (kw))) #\))
+ names)))))
(parse (seq ("code"
(reason (kw))
#\:
- (name (kw))
+ (name (item))
(constraints (? (seq (#\[
(constraints (list (:min 1)
- (list (:min 1) (kw))
+ (list (:min 1)
+ (item))
#\,))
#\])
constraints)))
(cerror* "Error loading Lisp file ~S: ~A"
path error)))))))))))
+;;; Setting properties.
+
+(define-pluggable-parser module set (scanner pset)
+ ;; `set' property-list `;'
+ (with-parser-context (token-scanner-context :scanner scanner)
+ (parse (and "set"
+ (lisp (let ((module-pset (module-pset *module*)))
+ (when pset
+ (pset-map (lambda (prop)
+ (add-property module-pset
+ (p-name prop)
+ (p-value prop)
+ :type (p-type prop)
+ :location (p-location prop))
+ (setf (p-seenp prop) t))
+ pset))
+ (parse (skip-many (:min 0)
+ (error (:ignore-unconsumed t)
+ (parse-property scanner module-pset)
+ (skip-until (:keep-end t) #\, #\;))
+ #\,))))
+ #\;))))
+
;;; Lisp escape.
(define-pluggable-parser module lisp (scanner pset)
;; names.
(parse-declarator
scanner base-type
+ :keywordp t
:kernel (parser ()
(seq ((name-a :id)
(name-b (? (seq (#\. (id :id)) id))))
body sub-pset scanner))))
(parse-initializer ()
- ;; initializer ::= `=' c-fragment | `=' `{' c-fragment `}'
+ ;; initializer ::= `=' c-fragment
;;
- ;; Return (VALUE-KIND . VALUE-FORM), ready for passing to a
- ;; `sod-initializer' constructor.
-
- ;; This is kind of tricky because we have to juggle both
- ;; layers of the parsing machinery. The character scanner
- ;; will already have consumed the lookahead token (which, if
- ;; we're going to do anything, is `=').
- (let ((char-scanner (token-scanner-char-scanner scanner)))
-
- ;; First, skip the character-scanner past any whitespace.
- ;; We don't record this consumption, which is a bit
- ;; naughty, but nobody will actually mind.
- (loop
- (when (or (scanner-at-eof-p char-scanner)
- (not (whitespace-char-p
- (scanner-current-char char-scanner))))
- (return))
- (scanner-step char-scanner))
-
- ;; Now maybe read an initializer.
- (cond ((not (eql (token-type scanner) #\=))
- ;; It's not an `=' after all. There's no
- ;; initializer.
- (values '(#\=) nil nil))
-
- ((and (not (scanner-at-eof-p char-scanner))
- (char= (scanner-current-char char-scanner)
- #\{))
- ;; There's a brace after the `=', so we should
- ;; consume the `=' here, and read a compound
- ;; initializer enclosed in braces.
- (parse (seq (#\= (frag (parse-delimited-fragment
- scanner #\{ #\})))
- (cons :compound frag))))
-
- (t
- ;; No brace, so read from the `=' up to, but not
- ;; including, the trailing `,' or `;' delimiter.
- (parse (seq ((frag (parse-delimited-fragment
- scanner #\= '(#\; #\,)
- :keep-end t)))
- (cons :simple frag)))))))
+ ;; Return a VALUE, ready for passing to a `sod-initializer'
+ ;; constructor.
+ (parse-delimited-fragment scanner #\= (list #\, #\;)
+ :keep-end t))
(parse-slot-item (sub-pset base-type type name)
;; slot-item ::=
sub-pset scanner)
(when init
(make-sod-instance-initializer
- class nick name (car init) (cdr init)
- sub-pset scanner)))
+ class nick name init sub-pset scanner)))
(skip-many ()
(seq (#\,
(ds (parse-declarator scanner
sub-pset scanner)
(when init
(make-sod-instance-initializer
- class nick (cdr ds)
- (car init) (cdr init)
+ class nick (cdr ds) init
sub-pset scanner))))
#\;)))
(seq ((name-a :id) #\. (name-b :id)
(init (parse-initializer)))
(funcall constructor class
- name-a name-b
- (car init) (cdr init)
+ name-a name-b init
sub-pset scanner))
#\,)
#\;)))
~mdw / sod / blobdiff