;; `inline') since it's meaningless to me.
(defclass declspec ()
- ;; This could have been done with DEFSTRUCT just as well, but a DEFCLASS
- ;; can be tweaked interactively, which is a win at the moment.
+ ;; Despite the fact that it looks pretty trivial, this can't be done with
+ ;; `defstruct' for the simple reason that we add more methods to the
+ ;; accessor functions later.
((label :type keyword :initarg :label :reader ds-label)
(name :type string :initarg :name :reader ds-name)
(kind :type (member type sign size qualifier)
;; A collection of declaration specifiers, and how to merge them together.
(defclass declspecs ()
- ;; Despite the fact that it looks pretty trivial, this can't be done with
- ;; DEFCLASS for the simple reason that we add more methods to the accessor
- ;; functions later.
+ ;; This could have been done with `defstruct' just as well, but a
+ ;; `defclass' can be tweaked interactively, which is a win at the moment.
((type :initform nil :initarg :type :reader ds-type)
(sign :initform nil :initarg :sign :reader ds-sign)
(size :initform nil :initarg :size :reader ds-size)
((null type)
(setf type (gethash :int *declspec-map*))))
(make-simple-type (format nil "~{~@[~A~^ ~]~}"
- (mapcar #'ds-label
+ (mapcar #'ds-name
(remove nil
(list sign size type))))
quals))
(values it t consumedp)
(values (list :declspec) nil consumedp)))))
+(export 'parse-c-type)
(defun parse-c-type (scanner)
"Parse a C type from declaration specifiers.
;;; (funcall FUNC TYPE) returns the derived type. The result of
;;; `parse-declarator' will be of this form.
-(defun parse-declarator (scanner base-type &key abstractp)
- (with-parser-context (token-scanner-context :scanner scanner)
+(export 'parse-declarator)
+(defun parse-declarator (scanner base-type &key centre abstractp)
+ "Parse a C declarator, returning a pair (C-TYPE . NAME).
- (labels ((qualifiers ()
- ;; QUALIFIER*
-
- (parse
- (seq ((quals (list ()
- (scan-declspec
- scanner
- :indicator :qualifier
- :predicate (lambda (ds)
- (and (typep ds 'declspec)
- (eq (ds-kind ds)
- 'qualifier)))))))
- (mapcar #'ds-label quals))))
-
- (star ()
- ;; Prefix: `*' QUALIFIERS
-
- (parse (seq (#\* (quals (qualifiers)))
- (preop "*" (state 9)
- (cons (lambda (type)
- (funcall (car state)
- (make-pointer-type type quals)))
- (cdr state))))))
-
- (prefix-lparen ()
- ;; Prefix: `('
- ;;
- ;; Opening parentheses are treated as prefix operators by the
- ;; expression parsing engine. There's an annoying ambiguity
- ;; in the syntax if abstract declarators are permitted: a `('
- ;; might be either the start of a nested subdeclarator or the
- ;; start of a postfix function argument list. The two are
- ;; disambiguated by stating that if the token following the
- ;; `(' is a `)' or a declaration specifier, then we have a
- ;; postfix argument list.
-
- (parse
- (peek (seq (#\(
- (nil (if (and abstractp
- (eq (token-type scanner) :id)
- (let ((id (token-value scanner)))
- (or (gethash id
- *module-type-map*)
- (gethash id
- *declspec-map*))))
- (values nil nil nil)
- (values t t nil))))
- (lparen #\))))))
-
- (centre ()
- ;; ID | empty
- ;;
- ;; The centre might be empty or contain an identifier,
- ;; depending on the setting of ABSTRACTP.
-
- (parse (or (when (not (eq abstractp t))
- (seq ((id :id)) (cons #'identity id)))
- (when abstractp
- (t (cons #'identity nil))))))
-
- (argument-list ()
- ;; [ ARGUMENT [ `,' ARGUMENT ]* ]
-
- (parse (list ()
- (seq ((base-type (parse-c-type scanner))
- (dtor (parse-declarator scanner
- base-type
- :abstractp :maybe)))
- (make-argument (cdr dtor) (car dtor)))
- #\,)))
-
- (postfix-lparen ()
- ;; Postfix: `(' ARGUMENT-LIST `)'
-
- (parse (seq (#\( (args (argument-list)) #\))
- (postop "()" (state 9)
- (cons (lambda (type)
- (funcall (car state)
- (make-function-type type args)))
- (cdr state))))))
-
- (dimension ()
- ;; `[' C-FRAGMENT ']'
-
- (parse-delimited-fragment scanner #\[ #\]))
-
- (lbracket ()
- ;; Postfix: DIMENSION+
-
- (parse (seq ((dims (list (:min 1) (dimension))))
- (postop "[]" (state 10)
- (cons (lambda (type)
- (funcall (car state)
- (make-array-type type dims)))
- (cdr state)))))))
-
- ;; And now we actually do the declarator parsing.
- (parse (seq ((value (expr (:nestedp nestedp)
-
- ;; An actual operand.
- (centre)
-
- ;; Binary operators. There aren't any.
- nil
-
- ;; Prefix operators.
- (or (star)
- (prefix-lparen))
-
- ;; Postfix operators.
- (or (postfix-lparen)
- (lbracket)
- (when nestedp (seq (#\)) (rparen #\))))))))
- (cons (funcall (car value) base-type) (cdr value)))))))
+ The SCANNER is a token scanner to read from. The BASE-TYPE is the type
+ extracted from the preceding declaration specifiers, as parsed by
+ `parse-c-type'.
+
+ The result contains both the resulting constructed C-TYPE (with any
+ qualifiers etc. as necessary), and the name from the middle of the
+ declarator. The name is parsed using the CENTRE parser provided, and
+ defaults to matching a simple identifier `:id'. This might, e.g., be
+ (? :id) to parse an `abstract declarator' which has optional names.
+
+ There's an annoying ambiguity in the syntax, if an empty CENTRE is
+ permitted. In this case, you must ensure that ABSTRACTP is true so that
+ the appropriate heuristic can be applied. As a convenience, if ABSTRACTP
+ is true then `(? :id)' is used as the default CENTRE."
+ (with-parser-context (token-scanner-context :scanner scanner)
+ (let ((centre-parser (cond (centre centre)
+ (abstractp (parser () (? :id)))
+ (t (parser () :id)))))
+
+ (labels ((qualifiers ()
+ ;; qualifier*
+
+ (parse
+ (seq ((quals (list ()
+ (scan-declspec
+ scanner
+ :indicator :qualifier
+ :predicate (lambda (ds)
+ (and (typep ds 'declspec)
+ (eq (ds-kind ds)
+ 'qualifier)))))))
+ (mapcar #'ds-label quals))))
+
+ (star ()
+ ;; Prefix: `*' qualifiers
+
+ (parse (seq (#\* (quals (qualifiers)))
+ (preop "*" (state 9)
+ (cons (lambda (type)
+ (funcall (car state)
+ (make-pointer-type type quals)))
+ (cdr state))))))
+
+ (next-declspec-p ()
+ ;; Ansert whether the next token is a valid declaration
+ ;; specifier, without consuming it.
+ (and (eq (token-type scanner) :id)
+ (let ((id (token-value scanner)))
+ (or (gethash id *module-type-map*)
+ (gethash id *declspec-map*)))))
+
+ (prefix-lparen ()
+ ;; Prefix: `('
+ ;;
+ ;; Opening parentheses are treated as prefix operators by
+ ;; the expression parsing engine. There's an annoying
+ ;; ambiguity in the syntax if abstract declarators are
+ ;; permitted: a `(' might be either the start of a nested
+ ;; subdeclarator or the start of a postfix function argument
+ ;; list. The two are disambiguated by stating that if the
+ ;; token following the `(' is a `)' or a declaration
+ ;; specifier, then we have a postfix argument list.
+ (parse
+ (peek (seq (#\(
+ (nil (if (and abstractp (next-declspec-p))
+ (values nil nil nil)
+ (values t t nil))))
+ (lparen #\))))))
+
+ (centre ()
+ (parse (seq ((name (funcall centre-parser)))
+ (cons #'identity name))))
+
+ (argument-list ()
+ ;; [ argument [ `,' argument ]* ]
+
+ (parse (list ()
+ (seq ((base-type (parse-c-type scanner))
+ (dtor (parse-declarator scanner
+ base-type
+ :abstractp t)))
+ (make-argument (cdr dtor) (car dtor)))
+ #\,)))
+
+ (postfix-lparen ()
+ ;; Postfix: `(' argument-list `)'
+
+ (parse (seq (#\( (args (argument-list)) #\))
+ (postop "()" (state 10)
+ (cons (lambda (type)
+ (funcall (car state)
+ (make-function-type type args)))
+ (cdr state))))))
+
+ (dimension ()
+ ;; `[' c-fragment ']'
+
+ (parse (seq ((frag (parse-delimited-fragment
+ scanner #\[ #\])))
+ (c-fragment-text frag))))
+
+ (lbracket ()
+ ;; Postfix: dimension+
+
+ (parse (seq ((dims (list (:min 1) (dimension))))
+ (postop "[]" (state 10)
+ (cons (lambda (type)
+ (funcall (car state)
+ (make-array-type type dims)))
+ (cdr state)))))))
+
+ ;; And now we actually do the declarator parsing.
+ (parse (seq ((value (expr (:nestedp nestedp)
+
+ ;; An actual operand.
+ (centre)
+
+ ;; Binary operators. There aren't any.
+ nil
+
+ ;; Prefix operators.
+ (or (star)
+ (prefix-lparen))
+
+ ;; Postfix operators.
+ (or (postfix-lparen)
+ (lbracket)
+ (when nestedp (seq (#\)) (rparen #\))))))))
+ (cons (funcall (car value) base-type) (cdr value))))))))
;;;----- That's all, folks --------------------------------------------------
~mdw / sod / blobdiff