;;; groups the other three kinds together and calls them all `type
;;; specifiers' (6.7.2).
+;; Let's not repeat ourselves.
+(macrolet ((define-declaration-specifiers (&rest defs)
+ (let ((mappings nil)
+ (deftypes nil)
+ (hashvar (gensym "HASH"))
+ (keyvar (gensym "KEY"))
+ (valvar (gensym "VAL")))
+ (dolist (def defs)
+ (destructuring-bind (kind &rest clauses) def
+ (let ((maps (mapcar (lambda (clause)
+ (if (consp clause)
+ clause
+ (cons (string-downcase clause)
+ clause)))
+ clauses)))
+ (push `(deftype ,(symbolicate 'decl- kind) ()
+ '(member ,@(mapcar #'cdr maps)))
+ deftypes)
+ (setf mappings (nconc (remove-if-not #'car maps)
+ mappings)))))
+ `(progn
+ ,@(nreverse deftypes)
+ (defparameter *declspec-map*
+ (let ((,hashvar (make-hash-table :test #'equal)))
+ (mapc (lambda (,keyvar ,valvar)
+ (setf (gethash ,keyvar ,hashvar) ,valvar))
+ ',(mapcar #'car mappings)
+ ',(mapcar #'cdr mappings))
+ ,hashvar))))))
+ (define-declaration-specifiers
+ (type :char :int :float :double :void)
+ (size :short :long (nil . :long-long))
+ (sign :signed :unsigned)
+ (qualifier :const :restrict :volatile)
+ (tagged :enum :struct :union)))
+
(defstruct (declspec
(:predicate declspecp))
"Represents a declaration specifier being built."
(qualifiers nil :type list)
- (sign nil :type (member nil :signed :unsigned))
- (size nil :type (member nil :short :long :long-long))
- (type nil :type (or (member nil :int :char :float :double :void) c-type)))
+ (sign nil :type (or decl-sign null))
+ (size nil :type (or decl-size null))
+ (type nil :type (or decl-type c-type null)))
(defun check-declspec (spec)
"Check that the declaration specifiers in SPEC are a valid combination.
(defun declaration-specifier-p (lexer)
"Answer whether the current token might be a declaration specifier."
- (case (token-type lexer)
- ((:const :volatile :restrict
- :signed :unsigned
- :short :long
- :void :char :int :float :double
- :enum :struct :union)
- t)
- (:id
- (gethash (token-value lexer) *type-map*))
- (t
- nil)))
+ (and (eq (token-type lexer) :id)
+ (let ((id (token-value lexer)))
+ (or (gethash id *declspec-map*)
+ (gethash id *type-map*)))))
(defun parse-c-type (lexer)
"Parse declaration specifiers from LEXER and return a C-TYPE."
(let ((spec (make-declspec))
- (found-any nil))
- (loop
- (let ((tok (token-type lexer)))
- (labels ((update (func value)
- (let ((new (funcall func spec value)))
- (cond (new (setf spec new))
- (t (cerror*
- "Invalid declaration specifier ~(~A~) after `~{~A~^ ~}' (ignored)"
- (format-token tok (token-value lexer))
- (declspec-keywords spec t))
- nil))))
- (tagged (class)
- (let ((kind tok))
- (setf tok (next-token lexer))
- (if (eql tok :id)
- (when (update #'update-declspec-type
- (make-instance
- class
- :tag (token-value lexer)))
- (setf found-any t))
- (cerror* "Expected ~(~A~) tag; found ~A"
- kind (format-token lexer))))))
- (case tok
- ((:const :volatile :restrict)
- (update #'update-declspec-qualifiers tok))
- ((:signed :unsigned)
- (when (update #'update-declspec-sign tok)
- (setf found-any t)))
- ((:short :long)
- (when (update #'update-declspec-size tok)
- (setf found-any t)))
- ((:void :char :int :float :double)
- (when (update #'update-declspec-type tok)
- (setf found-any t)))
- (:enum (tagged 'c-enum-type))
- (:struct (tagged 'c-struct-type))
- (:union (tagged 'c-union-type))
- (:id
- (let ((ty (gethash (token-value lexer) *type-map*)))
- (when (or found-any (not ty))
- (return))
- (when (update #'update-declspec-type ty)
- (setf found-any t))))
- (t
- (return))))
- (setf tok (next-token lexer))))
- (unless found-any
- (cerror* "Missing type name (guessing at `int')"))
- (declspec-c-type spec)))
+ (found-any nil)
+ tok)
+ (flet ((token (&optional (ty (next-token lexer)))
+ (setf tok
+ (or (and (eq ty :id)
+ (gethash (token-value lexer) *declspec-map*))
+ ty)))
+ (update (func value)
+ (let ((new (funcall func spec value)))
+ (cond (new (setf spec new))
+ (t (cerror* "Invalid declaration specifier ~(~A~) ~
+ following `~{~A~^ ~}' (ignored)"
+ (format-token tok (token-value lexer))
+ (declspec-keywords spec t))
+ nil)))))
+ (token (token-type lexer))
+ (loop
+ (typecase tok
+ (decl-qualifier (update #'update-declspec-qualifiers tok))
+ (decl-sign (when (update #'update-declspec-sign tok)
+ (setf found-any t)))
+ (decl-size (when (update #'update-declspec-size tok)
+ (setf found-any t)))
+ (decl-type (when (update #'update-declspec-type tok)
+ (setf found-any t)))
+ (decl-tagged (let ((class (ecase tok
+ (:enum 'c-enum-type)
+ (:struct 'c-struct-type)
+ (:union 'c-union-type))))
+ (let ((tag (require-token lexer :id)))
+ (when tag
+ (update #'update-declspec-type
+ (make-instance class :tag tag))))))
+ ((eql :id) (let ((ty (gethash (token-value lexer) *type-map*)))
+ (when (or found-any (not ty))
+ (return))
+ (when (update #'update-declspec-type ty)
+ (setf found-any t))))
+ (t (return)))
+ (token))
+ (unless found-any
+ (cerror* "Missing type name (guessing at `int')"))
+ (declspec-c-type spec))))
;;;--------------------------------------------------------------------------
;;; Parsing declarators.
(with-input-from-string (in "
// int stat(struct stat *st)
// void foo(void)
-// int vsnprintf(size_t n, char *buf, va_list ap)
+ int vsnprintf(size_t n, char *buf, va_list ap)
// size_t size_t;
// int (*signal(int sig, int (*handler)(int s)))(int t)
")
(let* ((stream (make-instance 'position-aware-input-stream
:file "<string>"
:stream in))
- (lex (make-instance 'sod-lexer :stream stream
- :keywords *sod-keywords*)))
+ (lex (make-instance 'sod-lexer :stream stream)))
(next-char lex)
(next-token lex)
(let ((ty (parse-c-type lex)))
~mdw / sod / blobdiff