;; Words with important meanings to us.
"class"
"import" "load" "lisp" "typename"
- "source" "header"
+ "code"
+ "extern"
;; Words with a meaning to C's type system.
"char" "int" "float" "void"
;; Strings.
((or (char= ch #\") (char= ch #\'))
- (with-default-error-location (file-location lexer)
+ (with-default-error-location ((file-location lexer))
(let* ((quote ch)
(string
(with-output-to-string (out)
(flet ((getch ()
(setf ch (next-char lexer))
(when (null ch)
- (cerror* floc
+ (cerror*
"Unexpected end of file in string/character constant")
(return))))
(getch)
;; If we last munched an interesting letter, we need to skip over
;; it. That's what the SKIP-CHAR flag is for.
+ ;;
+ ;; Danger, Will Robinson! If we're' just about to eat a radix
+ ;; letter, then the next thing must be a digit. For example,
+ ;; `0xfatenning' parses as a hex number followed by an identifier
+ ;; `0xfa ttening', but `0xturning' is an octal number followed
+ ;; by an identifier `0 xturning'.
(when skip-char
- (setf ch (next-char lexer)))
+ (let ((peek (next-char lexer)))
+ (unless (digit-char-p peek radix)
+ (pushback-char lexer ch)
+ (return-from scan-token (values :integer 0)))
+ (setf ch peek)))
;; Scan an integer. While there are digits, feed them into the
;; accumulator.
A C fragment is aware of its original location, and will bear proper #line
markers when written out."))
-(defgeneric write-fragment (fragment stream)
- (:documentation
- "Writes a fragment to the output stream, marking its source properly.")
-
- (:method ((fragment c-fragment) stream)
- (with-slots (location text) fragment
- (format stream "~&#line ~D ~S~%~A~&"
- (file-location-line location)
- (namestring (file-location-pathname location))
- text)
- (format stream "#line ~D ~S~%"
- (1+ (position-aware-stream-line stream))
- (namestring (stream-pathname stream))))))
+(defun output-c-excursion (stream location thunk)
+ "Invoke THUNK surrounding it by writing #line markers to STREAM.
+
+ The first marker describes LOCATION; the second refers to the actual
+ output position in STREAM. If LOCATION doesn't provide a line number then
+ no markers are output after all. If the output stream isn't
+ position-aware then no final marker is output."
+
+ (let* ((location (file-location location))
+ (line (file-location-line location))
+ (pathname (file-location-pathname location))
+ (namestring (and pathname (namestring pathname))))
+ (cond (line
+ (format stream "~&#line ~D~@[ ~S~]~%" line namestring)
+ (funcall thunk)
+ (when (typep stream 'position-aware-stream)
+ (fresh-line stream)
+ (format stream "~&#line ~D ~S~%"
+ (1+ (position-aware-stream-line stream))
+ (namestring (stream-pathname stream)))))
+ (t
+ (funcall thunk)))))
+
+(defmethod print-object ((fragment c-fragment) stream)
+ (let ((text (c-fragment-text fragment))
+ (location (c-fragment-location fragment)))
+ (if *print-escape*
+ (print-unreadable-object (fragment stream :type t)
+ (when location
+ (format stream "~A " location))
+ (cond ((< (length text) 40)
+ (prin1 text stream) stream)
+ (t
+ (prin1 (subseq text 0 40) stream)
+ (write-string "..." stream))))
+ (output-c-excursion stream location
+ (lambda () (write-string text stream))))))
+
+(defmethod make-load-form ((fragment c-fragment) &optional environment)
+ (make-load-form-saving-slots fragment :environment environment))
(defun scan-c-fragment (lexer end-chars)
"Snarfs a sequence of C tokens with balanced brackets.
;; Return the fragment we've collected.
(make-instance 'c-fragment
- :location floc
+ :location start-floc
:text (get-output-stream-string output)))))
(defun c-fragment-reader (stream char arg)
(next-char lexer)
(scan-c-fragment lexer '(#\}))))
+#+interactive
+(set-dispatch-macro-character #\# #\{ 'c-fragment-reader)
+
;;;--------------------------------------------------------------------------
;;; Testing cruft.
(with-input-from-string (in "
{ foo } 'x' /?/***/!
123 0432 0b010123 0xc0ffee __burp_32 class
+
+0xturning 0xfattening
...
class integer : integral_domain {
~mdw / sod / blobdiff