X-Git-Url: https://git.distorted.org.uk/~mdw/sod/blobdiff_plain/aa14a4cddcb96b681d5c19a2ec8bad382f43b264..3c46cb3a94f2407959c3f5899f87f763a3e3865c:/src/fragment-parse.lisp diff --git a/src/fragment-parse.lisp b/src/fragment-parse.lisp index 5f58885..c958da3 100644 --- a/src/fragment-parse.lisp +++ b/src/fragment-parse.lisp @@ -7,7 +7,7 @@ ;;;----- Licensing notice --------------------------------------------------- ;;; -;;; This file is part of the Sensble Object Design, an object system for C. +;;; 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 @@ -32,7 +32,9 @@ (defun scan-c-fragment (scanner end-chars) "Parse a C fragment from the SCANNER. - SCANNER must be a `sod-token-scanner' instance. + 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 @@ -75,15 +77,17 @@ ((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)) + ;; 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) + (member (scanner-current-char char-scanner) + end-chars)) + (values (result) t t) + (values end-chars nil nil))) (return (values it t t))) (:eof - (lexer-error char-scanner '(:any) cp) + (lexer-error char-scanner '(:any)) (return (values (result) t t))) ;; Opening and closing brackets. Opening brackets push things @@ -94,7 +98,7 @@ ((or #\) #\] #\}) (if (eql it delim) (setf delim (pop stack)) - (cerror* "Unmatched `~C.'." it))) + (cerror* "Unmatched `~C'" it))) ;; String and character literals. ((seq ((quote (or #\" #\')) @@ -108,24 +112,37 @@ ;; This really shouldn't be able to happen. (t (assert cp) - (lexer-error char-scanner exp cp))))))))) + (lexer-error char-scanner exp))))))))) (export 'parse-delimited-fragment) -(defun parse-delimited-fragment (scanner begin end) +(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 characters. (Currently, BEGIN can be any - token type, but you probably shouldn't rely on this.)" + 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 `[' 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)) + ;; 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 --------------------------------------------------