Change naming convention around.

[sod] / src / fragment-parse.lisp

diff --git a/src/fragment-parse.lisp b/src/fragment-parse.lisp
new file mode 100644 (file)
index 0000000..5f58885
--- /dev/null
+++ b/src/fragment-parse.lisp
@@ -0,0 +1,131 @@
+;;; -*-lisp-*-
+;;;
+;;; Parsing C fragments from a scanner
+;;;
+;;; (c) 2010 Straylight/Edgeware
+;;;
+
+;;;----- Licensing notice ---------------------------------------------------
+;;;
+;;; This file is part of the Sensble 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 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 nil)
+       (stack nil))
+    (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.
+      (with-scanner-place (place char-scanner)
+
+       (flet ((push-delim (d)
+                (push delim stack)
+                (setf delim d))
+
+              (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
+           (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.  There's a small trick here: I
+             ;; capture the result in the `if-char' consequent to ensure
+             ;; that we don't include the delimiter.
+             ((if-char () (and (null delim) (member it end-chars))
+                (values (result) t t)
+                (values end-chars nil nil))
+              (return (values it t t)))
+             (:eof
+              (lexer-error char-scanner '(:any) cp)
+              (return (values (result) t t)))
+
+             ;; Opening and closing brackets.  Opening brackets push things
+             ;; onto a stack; closing brackets pop things off again.
+             (#\( (push-delim #\)))
+             (#\[ (push-delim #\]))
+             (#\{ (push-delim #\}))
+             ((or #\) #\] #\})
+              (if (eql it delim)
+                  (setf delim (pop stack))
+                  (cerror* "Unmatched `~C.'." it)))
+
+             ;; String and character literals.
+             ((seq ((quote (or #\" #\'))
+                    (nil (skip-many ()
+                             (or (and #\\ :any) (not quote))))
+                    (nil (char quote)))))
+
+             ;; Anything else.
+             (:any)
+
+             ;; This really shouldn't be able to happen.
+             (t
+              (assert cp)
+              (lexer-error char-scanner exp cp)))))))))
+
+(export 'parse-delimited-fragment)
+(defun parse-delimited-fragment (scanner begin end)
+  "Parse a C fragment delimited by BEGIN and END.
+
+   The BEGIN and END arguments are characters.  (Currently, BEGIN can be any
+  token type, but you probably shouldn't rely on this.)"
+
+  ;; 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 `[' 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 (eql (token-type scanner) begin)
+      (multiple-value-prog1 (values (scan-c-fragment scanner (list end)) t t)
+       (scanner-step scanner))
+      (values (list begin) nil nil)))
+
+;;;----- That's all, folks --------------------------------------------------