doc/concepts.tex: Typeset method rôle names as identifiers.

[sod] / src / fragment-parse.lisp

;;; -*-lisp-*-
;;;
;;; Parsing C fragments from a scanner
;;;
;;; (c) 2010 Straylight/Edgeware
;;;

;;;----- Licensing notice ---------------------------------------------------
;;;
;;; This file is part of the Sensible Object Design, an object system for C.
;;;
;;; SOD is free software; you can redistribute it and/or modify
;;; it under the terms of the GNU General Public License as published by
;;; the Free Software Foundation; either version 2 of the License, or
;;; (at your option) any later version.
;;;
;;; SOD is distributed in the hope that it will be useful,
;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
;;; GNU General Public License for more details.
;;;
;;; You should have received a copy of the GNU General Public License
;;; along with SOD; if not, write to the Free Software Foundation,
;;; Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.

(in-package #:sod)

;;;--------------------------------------------------------------------------
;;; Fragment parsing.

(export 'scan-c-fragment)
(defun scan-c-fragment (scanner end-chars)
  "Parse a C fragment from the SCANNER.

   SCANNER must be a `sod-token-scanner' instance.  The END-CHARS are a
   sequence of characters, any of which delimits the fragment.  The
   delimiting character is left current in the scanner.

   The parsing process is a simple approximation to C lexical analysis.  It
   takes into account comments (both C and C++ style), string and character
   literals."

  (let* ((char-scanner (token-scanner-char-scanner scanner))
	 (delim-match nil) (delim-found nil) (delim-loc nil)
	 (stack nil) (start nil) (tokstart nil) (eofwhine t))
    (with-parser-context (character-scanner-context :scanner char-scanner)

      ;; Hack.  If the first character is a newline then discard it
      ;; immediately.  If I don't, then the output will look strange and the
      ;; location information will be unhelpful.
      (parse #\newline)

      ;; This seems the easiest way of gathering stuff.
      (setf start (file-location char-scanner))
      (with-scanner-place (place char-scanner)

	(flet ((push-delim (found match)
		 (push (list delim-found delim-match delim-loc) stack)
		 (setf delim-found found
		       delim-match match
		       delim-loc tokstart))

	       (pop-delim ()
		 (destructuring-bind (found match loc) (pop stack)
		   (setf delim-found found
			 delim-match match
			 delim-loc loc)))

	       (result ()
		 (let* ((output (scanner-interval char-scanner place))
			(end (position-if (lambda (char)
					    (or (char= char #\newline)
						(not
						 (whitespace-char-p char))))
					  output :from-end t))
			(trimmed (if end (subseq output 0 (1+ end)) "")))
		   (make-instance 'c-fragment
				  :location (file-location place)
				  :text trimmed))))

	  ;; March through characters until we reach the end.
	  (loop
	    (setf tokstart (file-location char-scanner))
	    (cond-parse (:consumedp cp :expected exp)

	      ;; Whitespace and comments are universally dull.
	      ((satisfies whitespace-char-p) (parse :whitespace))
	      ((scan-comment char-scanner))

	      ;; See if we've reached the end.  We must leave the delimiter
	      ;; in the scanner, so `if-char' and its various friends aren't
	      ;; appropriate.
	      ((lisp (if (and (null delim-match)
			      (not (scanner-at-eof-p char-scanner))
			      (member (scanner-current-char char-scanner)
				      end-chars))
			 (values (result) t t)
			 (values end-chars nil nil)))
	       (return (values it t t)))
	      (:eof
	       (when eofwhine
		 (lexer-error char-scanner nil))
	       (loop
		 (unless delim-found (return))
		 (info-with-location delim-loc
				     "Unmatched `~C' found here" delim-found)
		 (pop-delim))
	       (info-with-location start "C fragment started here")
	       (return (values (result) t t)))

	      ;; Opening and closing brackets.  Opening brackets push things
	      ;; onto a stack; closing brackets pop things off again.  Pop a
	      ;; bracket even if it doesn't match, to encourage progress
	      ;; towards finding an end-delimiter.
	      (#\( (push-delim #\( #\)))
	      (#\[ (push-delim #\[ #\]))
	      (#\{ (push-delim #\{ #\}))
	      ((lisp (let ((char (scanner-current-char char-scanner)))
		       (case char
			 ((#\) #\] #\})
			  (unless (eql char delim-match)
			    (lexer-error char-scanner
					 (and delim-match
					      (list delim-match)))
			    (when delim-loc
			      (info-with-location
			       delim-loc
			       "Mismatched `~C' found here" delim-found)))
			  (scanner-step char-scanner)
			  (when delim-match (pop-delim))
			  (values char t t))
			 (t
			  (values '(#\) #\] #\}) nil nil))))))

	      ;; String and character literals.
	      ((seq ((quote (or #\" #\'))
		     (nil (skip-many ()
			    (or (and #\\ :any) (not quote))))
		     (nil (or (char quote)
			      (seq (:eof)
				(lexer-error char-scanner (list quote))
				(info-with-location tokstart
						    "Literal started here")
				(setf eofwhine nil)))))))

	      ;; Anything else.
	      (:any)

	      ;; This really shouldn't be able to happen.
	      (t
	       (assert cp)
	       (when (scanner-at-eof-p char-scanner)
		 (setf eofwhine nil))
	       (lexer-error char-scanner exp)))))))))

(export 'parse-delimited-fragment)
(defun parse-delimited-fragment (scanner begin end &key keep-end)
  "Parse a C fragment delimited by BEGIN and END.

   The BEGIN and END arguments are the start and end delimiters.  BEGIN can
   be any token type, but is usually a delimiter character; it may also be t
   to mean `don't care' -- but there must be an initial token of some kind
   for annoying technical reasons.  END may be either a character or a list
   of characters.  If KEEP-END is true, the trailing delimiter is left in the
   token scanner so that it's available for further parsing decisions: this
   is probably what you want if END is a list."

  ;; This is decidedly nasty.  The basic problem is that `scan-c-fragment'
  ;; works at the character level rather than at the lexical level, and if we
  ;; commit to the BEGIN character too early then `scanner-step' will eat the
  ;; first few characters of the fragment -- and then the rest of the parse
  ;; will get horrifically confused.

  (if (if (eq begin t)
	  (not (scanner-at-eof-p scanner))
	  (eql (token-type scanner) begin))
      (multiple-value-prog1
	  (values (scan-c-fragment scanner
				   (if (listp end) end
				       (list end)))
		  t
		  t)
	(scanner-step scanner)
	(unless keep-end (scanner-step scanner)))
      (values (list begin) nil nil)))

;;;----- That's all, folks --------------------------------------------------