X-Git-Url: https://git.distorted.org.uk/~mdw/sod/blobdiff_plain/3109662aca9c06495ac22c5c58b46e1c036aca5c..9ec578d9fe450b7e7f9030dc9d930185593aa991:/src/c-types-parse.lisp

diff --git a/src/c-types-parse.lisp b/src/c-types-parse.lisp
index a3ecae4..4a8e1d7 100644
--- a/src/c-types-parse.lisp
+++ b/src/c-types-parse.lisp
@@ -65,8 +65,9 @@
 ;; `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)
@@ -115,9 +116,8 @@
 ;; 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)
@@ -202,7 +202,7 @@
 		 ((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))
@@ -259,6 +259,7 @@
 	   (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.
 
@@ -288,122 +289,138 @@
 ;;; (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 kernel 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 KERNEL 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 KERNEL 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 KERNEL."
+  (with-parser-context (token-scanner-context :scanner scanner)
+    (let ((kernel-parser (cond (kernel kernel)
+			       (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 #\))))))
+
+	       (kernel ()
+		 (parse (seq ((name (funcall kernel-parser)))
+			  (cons #'identity name))))
+
+	       (argument-list ()
+		 ;; [ argument [ `,' argument ]* ]
+
+		 (parse (list (:min 0)
+			  (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.
+			      (kernel)
+
+			      ;; 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 --------------------------------------------------