diff options
author | Daniel Kraft <d@domob.eu> | 2009-08-26 19:48:06 +0200 |
---|---|---|
committer | Daniel Kraft <d@domob.eu> | 2009-08-26 19:48:06 +0200 |
commit | 5b1ee3bef15380745f6c2fc598768d9f3a46e85e (patch) | |
tree | beadb40314edb2afeda24da621d367c031fdbd81 | |
parent | 25512a940b30a9c4abe24b20b9ea4be78ab8127e (diff) | |
download | guile-5b1ee3bef15380745f6c2fc598768d9f3a46e85e.tar.gz |
Character and string literal support for the elisp lexer.
* module/language/elisp/lexer.scm: Handle character and string literals.
* test-suite/tests/elisp-reader.test: Test it.
-rw-r--r-- | module/language/elisp/lexer.scm | 182 | ||||
-rw-r--r-- | test-suite/tests/elisp-reader.test | 31 |
2 files changed, 208 insertions, 5 deletions
diff --git a/module/language/elisp/lexer.scm b/module/language/elisp/lexer.scm index c02d674d1..3dbce8676 100644 --- a/module/language/elisp/lexer.scm +++ b/module/language/elisp/lexer.scm @@ -27,6 +27,155 @@ ; instead of using some generator because I think that's most viable in this ; case and easy enough. +; Characters are handled internally as integers representing their +; code value. This is necessary because elisp allows a lot of fancy modifiers +; that set certain high-range bits and the resulting values would not fit +; into a real Scheme character range. Additionally, elisp wants characters +; as integers, so we just do the right thing... + +; TODO: Circular syntax markers like #1= or #1# +; TODO: #@count comments + + +; Report an error from the lexer (that is, invalid input given). + +(define (lexer-error port msg . args) + (apply error msg args)) + + +; In a character, set a given bit. This is just some bit-wise or'ing on the +; characters integer code and converting back to character. + +(define (set-char-bit chr bit) + (logior chr (ash 1 bit))) + + +; Check if a character equals some other. This is just like char=? except that +; the tested one could be EOF in which case it simply isn't equal. + +(define (is-char? tested should-be) + (and (not (eof-object? tested)) + (char=? tested should-be))) + + +; For a character (as integer code), find the real character it represents or +; #\nul if out of range. This is used to work with Scheme character functions +; like char-numeric?. + +(define (real-character chr) + (if (< chr 256) + (integer->char chr) + #\nul)) + + +; Return the control modified version of a character. This is not just setting +; a modifier bit, because ASCII conrol characters must be handled as such, and +; in elisp C-? is the delete character for historical reasons. +; Otherwise, we set bit 26. + +(define (add-control chr) + (let ((real (real-character chr))) + (if (char-alphabetic? real) + (- (char->integer (char-upcase real)) (char->integer #\@)) + (case real + ((#\?) 127) + ((#\@) 0) + (else (set-char-bit chr 26)))))) + + +; Parse a charcode given in some base, basically octal or hexadecimal are +; needed. A requested number of digits can be given (#f means it does +; not matter and arbitrary many are allowed), and additionally early +; return allowed (if fewer valid digits are found). +; These options are all we need to handle the \u, \U, \x and \ddd (octal digits) +; escape sequences. + +(define (charcode-escape port base digits early-return) + (let iterate ((result 0) + (procdigs 0)) + (if (and digits (>= procdigs digits)) + result + (let* ((cur (read-char port)) + (value (cond + ((char-numeric? cur) + (- (char->integer cur) (char->integer #\0))) + ((char-alphabetic? cur) + (let ((code (- (char->integer (char-upcase cur)) + (char->integer #\A)))) + (if (< code 0) + #f + (+ code 10)))) + (else #f))) + (valid (and value (< value base)))) + (if (not valid) + (if (or (not digits) early-return) + (begin + (unread-char cur port) + result) + (lexer-error port "invalid digit in escape-code" base cur)) + (iterate (+ (* result base) value) (1+ procdigs))))))) + + +; Read a character and process escape-sequences when necessary. The special +; in-string argument defines if this character is part of a string literal or +; a single character literal, the difference being that in strings the +; meta modifier sets bit 7, while it is bit 27 for characters. + +(define basic-escape-codes + '((#\a . 7) (#\b . 8) (#\t . 9) + (#\n . 10) (#\v . 11) (#\f . 12) (#\r . 13) + (#\e . 27) (#\s . 32) (#\d . 127))) + +(define (get-character port in-string) + (let ((meta-bits `((#\A . 22) (#\s . 23) (#\H . 24) + (#\S . 25) (#\M . ,(if in-string 7 27)))) + (cur (read-char port))) + (if (char=? cur #\\) + + ; Handle an escape-sequence. + (let* ((escaped (read-char port)) + (esc-code (assq-ref basic-escape-codes escaped)) + (meta (assq-ref meta-bits escaped))) + (cond + + ; Meta-check must be before esc-code check because \s- must be + ; recognized as the super-meta modifier if a - follows. + ; If not, it will be caught as \s -> space escape code. + ((and meta (is-char? (peek-char port) #\-)) + (if (not (char=? (read-char port) #\-)) + (error "expected - after control sequence")) + (set-char-bit (get-character port in-string) meta)) + + ; One of the basic control character escape names? + (esc-code esc-code) + + ; Handle \ddd octal code if it is one. + ((and (char>=? escaped #\0) (char<? escaped #\8)) + (begin + (unread-char escaped port) + (charcode-escape port 8 3 #t))) + + ; Check for some escape-codes directly or otherwise + ; use the escaped character literally. + (else + (case escaped + ((#\^) (add-control (get-character port in-string))) + ((#\C) + (if (is-char? (peek-char port) #\-) + (begin + (if (not (char=? (read-char port) #\-)) + (error "expected - after control sequence")) + (add-control (get-character port in-string))) + escaped)) + ((#\x) (charcode-escape port 16 #f #t)) + ((#\u) (charcode-escape port 16 4 #f)) + ((#\U) (charcode-escape port 16 8 #f)) + (else (char->integer escaped)))))) + + ; No escape-sequence, just the literal character. + ; But remember to get the code instead! + (char->integer cur)))) + ; Read a symbol or number from a port until something follows that marks the ; start of a new token (like whitespace or parentheses). The data read is @@ -103,7 +252,6 @@ (char-whitespace? (peek-char port))) (return 'dot #f)) - ; Continue checking for literal character values. (else (case c @@ -116,6 +264,32 @@ (lex port) (iterate))))) + ; A character literal. + ((#\?) + (return 'character (get-character port #f))) + + ; A literal string. This is mainly a sequence of characters just + ; as in the character literals, the only difference is that escaped + ; newline and space are to be completely ignored and that meta-escapes + ; set bit 7 rather than bit 27. + ((#\") + (let iterate ((result-chars '())) + (let ((cur (read-char port))) + (case cur + ((#\") + (return 'string (list->string (reverse result-chars)))) + ((#\\) + (let ((escaped (read-char port))) + (case escaped + ((#\newline #\space) + (iterate result-chars)) + (else + (unread-char escaped port) + (unread-char cur port) + (iterate (cons (integer->char (get-character port #t)) + result-chars)))))) + (else (iterate (cons cur result-chars))))))) + ; Parentheses and other special-meaning single characters. ((#\() (return 'paren-open #f)) ((#\)) (return 'paren-close #f)) @@ -144,14 +318,14 @@ (return 'integer (let ((num (inexact->exact (string->number str)))) (if (not (integer? num)) - (error "Expected integer" str num)) + (error "expected integer" str num)) num))) ((float) (return 'float (let ((num (string->number str))) (if (exact? num) - (error "Expected inexact float" str num)) + (error "expected inexact float" str num)) num))) - (else (error "Wrong number/symbol type" type))))))))))) + (else (error "wrong number/symbol type" type))))))))))) ; Build a lexer thunk for a port. This is the exported routine which can be diff --git a/test-suite/tests/elisp-reader.test b/test-suite/tests/elisp-reader.test index 51ba08858..15d5344b2 100644 --- a/test-suite/tests/elisp-reader.test +++ b/test-suite/tests/elisp-reader.test @@ -84,4 +84,33 @@ (equal? (lex-string "1500.0 15e2 15.e2 1.5e3 .15e4 -.345e-2") '((float . 1500.0) (float . 1500.0) (float . 1500.0) (float . 1500.0) (float . 1500.0) - (float . -0.00345))))) + (float . -0.00345)))) + + ; Check string lexing, this also checks basic character escape sequences + ; that are then (hopefully) also correct for character literals. + (pass-if "strings" + (equal? (lex-string "\"foo\\nbar +test\\ +\\\"ab\\\"\\\\ ab\\ cd +\\418\\0415\\u0041\\U0000000A\\Xab\\x0000000000000004fG.\" ") + '((string . "foo\nbar +test\"ab\"\\ abcd +!8!5A\nXabOG.")))) + (pass-if "ASCII control characters and meta in strings" + (equal? (lex-string "\"\\^?\\C-a\\C-A\\^z\\M-B\\M-\\^@\\M-\\C-a\"") + '((string . "\x7F\x01\x01\x1A\xC2\x80\x81")))) + + ; Character literals, taking into account that some escape sequences were + ; already checked in the strings. + (pass-if "characters" + (equal? (lex-string "?A?\\z ? ?\\x21 ?\\^j ?\\\\?\\n?\\\n") + `((character . 65) (character . ,(char->integer #\z)) + (character . 32) (character . ,(char->integer #\!)) + (character . 10) (character . ,(char->integer #\\)) + (character . 10) (character . 10)))) + (pass-if "meta characters" + (equal? (map cdr (lex-string "?\\C-[?\\M-\\S-Z?\\^X?\\A-\\s-\\H-\\s")) + `(,(+ (expt 2 26) (char->integer #\[)) + ,(+ (expt 2 27) (expt 2 25) (char->integer #\Z)) + ,(- (char->integer #\X) (char->integer #\@)) + ,(+ (expt 2 22) (expt 2 23) (expt 2 24) 32))))) |