diff options
Diffstat (limited to 'module/language/lua/lexer.scm')
-rw-r--r-- | module/language/lua/lexer.scm | 335 |
1 files changed, 335 insertions, 0 deletions
diff --git a/module/language/lua/lexer.scm b/module/language/lua/lexer.scm new file mode 100644 index 000000000..63c4ffac0 --- /dev/null +++ b/module/language/lua/lexer.scm @@ -0,0 +1,335 @@ +;;; Guile Lua --- tokenizer + +;;; Copyright (C) 2010 Free Software Foundation, Inc. +;;; +;;; This library is free software; you can redistribute it and/or +;;; modify it under the terms of the GNU Lesser General Public +;;; License as published by the Free Software Foundation; either +;;; version 3 of the License, or (at your option) any later version. +;;; +;;; This library 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 +;;; Lesser General Public License for more details. +;;; +;;; You should have received a copy of the GNU Lesser General Public +;;; License along with this library; if not, write to the Free Software +;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA + +;;; Code: + +;; This is a simple lexer. It generally matches up Lua data types with +;; Scheme. Reserved words in Lua, like 'not', are returned as keywords, +;; like '#:not'. Operators are returned as keywords like #:==, or +;; characters like #\+ when they're only a character long. Identifiers +;; are returned as symbols +(define-module (language lua lexer) + + #:use-module (srfi srfi-8) + #:use-module (srfi srfi-14) + #:use-module (srfi srfi-39) + + #:use-module (language lua common) + + #:export (make-lexer) + #:export-syntax (define-lua-lexer initialize-lua-lexer!)) + +(define stdout (current-output-port)) + +(define (source-info port) + `((backtrace . #f) + (filename . ,(port-filename port)) + (line . ,(port-line port)) + (column . ,(port-column port)))) + +;; Character predicates + +;; Lua only accepts ASCII characters as of 5.2, so we define our own +;; charsets here +(define (char-predicate string) + (define char-set (string->char-set string)) + (lambda (c) + (and (not (eof-object? c)) (char-set-contains? char-set c)))) + +(define is-digit? (char-predicate "0123456789")) +(define is-name-first? (char-predicate "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ_")) +(define (is-name? c) (or (is-name-first? c) (is-digit? c))) +(define (is-newline? c) (and (char? c) (or (char=? c #\newline) (char=? c #\cr)))) + +(define (possible-keyword token) + "Convert a symbol to a keyword if it is a reserved word in Lua" + (if (or-eqv? token '(return function end if then elseif else true false nil or and do while repeat until local for break in not)) + (symbol->keyword token) + token)) + +(define (make-lexer port) + ;; Buffer management + (define buffer (open-output-string)) + + (define (drop-buffer) + "Clear the buffer and drop the contents" + (truncate-file buffer 0)) + + (define (clear-buffer) + "Clear the buffer and return a string of the contents" + (define string (get-output-string buffer)) + (drop-buffer) + string) + + ;; Source code information + (define saved-source-info #f) + + (define (save-source-info) + "Save source code information for a particular location e.g. the beginning +of an identifier" + (set! saved-source-info (source-info port))) + + (define (get-source-info) + "Get source code information" + (if saved-source-info + saved-source-info + (source-info port))) + + (define (save-and-next!) + "Shorthand for (write-char (read-char))" + (write-char (read-char))) + + (define (eat-comment) + "Consume a comment" + (let consume ((c (read-char))) + (cond ((eof-object? c) #f) + ((eq? c #\newline) #f) + (else (consume (read-char)))))) + + (define (get-long-string-nesting-level) + "Return the nesting level of a bracketed string, or -1 if it is not one" + (define delimiter (read-char)) + (let* ((count + (let loop ((count 0)) + (if (eq? (peek-char) #\=) + (begin + (read-char) + (loop (+ count 1))) + count)))) + (if (eq? (peek-char) delimiter) count -1))) + + (define (read-long-string string? nest) + "Read a long string or comment" + ;; Skip second bracket + (read-char) + ;; Discard initial newlines, which is what Lua does + (while (is-newline? (peek-char)) + (read-char)) + ;; Read string contents + (let loop ((c (peek-char))) + (cond + ;; Error out if end-of-file is encountered + ((eof-object? c) + (syntax-error (get-source-info) (string-append "unfinished long " (if string? "string" "comment")))) + ;; Check to see if we've reached the end + ((char=? c #\]) + (let* ((nest2 (get-long-string-nesting-level))) + (if (= nest nest2) + (begin + (read-char) ;; drop ] + (if string? + (clear-buffer) + (drop-buffer))) + ;; Compensate for eating up the nesting levels + (begin + (save-and-next!) + (let lp ((n nest2)) + (if (= n 0) + #f + (begin + (write-char #\=) + (lp (- n 1))))) + (write-char #\]) + (loop (peek-char)))))) + ;; Save character and continue + (else (save-and-next!) + (loop (peek-char)))))) + + ;; read a single or double quoted string, with escapes + (define (read-string delimiter) + (read-char) ;; consume delimiter + (let loop ((c (peek-char))) + (cond + ;; string ends early + ((or (eof-object? c) (eq? c #\cr) (eq? c #\newline)) + (syntax-error (get-source-info) "unfinished string ~S" c)) + ;; string escape + ((char=? c #\\) + ;; discard \ and read next character + (let* ((escape (begin (read-char) (read-char)))) + (write-char + (case escape + ((#\a) #\alarm) + ((#\b) #\backspace) + ((#\f) #\page) + ((#\n) #\newline) + ((#\r) #\return) + ((#\t) #\tab) + ((#\v) #\vtab) + ((#\x) (syntax-error (get-source-info) "hex escapes unsupported")) + ((#\d) (syntax-error (get-source-info) "decimal escapes unsupported")) + (else escape))) + (loop (peek-char)))) + (else + (if (eq? c delimiter) + (read-char) ;; terminate loop and discard delimiter + (begin + (save-and-next!) + (loop (peek-char))))))) + (clear-buffer)) + + (define (read-number string) + (save-source-info) + (let* ((main (string-append (or string "") (begin + (while (or (is-digit? (peek-char)) (eq? (peek-char) #\.)) + (save-and-next!)) + (clear-buffer)))) + (exponent + (if (or (eq? (peek-char) #\e) (eq? (peek-char) #\E)) + (begin + (read-char) + (if (eq? (peek-char) #\+) + (read-char) + (if (eq? (peek-char) #\-) + (save-and-next!))) + (if (not (is-digit? (peek-char))) + (syntax-error (get-source-info) "expecting number after exponent sign")) + (while (is-digit? (peek-char)) + (save-and-next!)) + (clear-buffer)) + #f)) + (final (string->number main))) + (if exponent + (* final (expt 10 (string->number exponent))) + final))) + + (define (lex) + (parameterize ((current-input-port port) + (current-output-port buffer)) + (set! saved-source-info #f) + (let loop () + (define c (peek-char)) + (case c + ;; Skip spaces + ((#\newline #\return #\space #\page #\tab #\vtab) (read-char) (loop)) + + ;; Either a minus (-), or a long comment, which is a - followed by a bracketed string + ((#\-) + (read-char) + (if (eq? (peek-char) #\-) + ;; It's a comment + (begin + (read-char) + ;; Long comment + (if (eq? (peek-char) #\[) + (let* ((nest (get-long-string-nesting-level))) + (drop-buffer) + (if (not (negative? nest)) + (begin + (read-long-string #f nest) + (drop-buffer) + (loop)) + ;; If it's not actually a long comment, drop it + (begin (drop-buffer) (eat-comment) (loop)))) + (begin (eat-comment) (loop)))) + ;; It's a regular minus + #\-)) + + ;; ~= + ((#\~) + (read-char) + (if (eq? (peek-char) #\=) + (begin (read-char) #:~=) + (syntax-error (get-source-info) "expected = after ~ but got ~c" c))) + + ;; < or <= + ((#\<) + (read-char) + (if (eq? (peek-char) #\=) (begin (read-char) #:<=) #\<)) + + ;; > or >= + ((#\>) + (read-char) + (if (eq? (peek-char) #\=) (begin (read-char) #:>=) #\>)) + + ;; = or == + ((#\=) + (read-char) + (if (eq? (peek-char) #\=) + (begin (read-char) #:==) + #:=)) + + ;; . can mean one of: floating point number (.12345), table field access (plain .), + ;; concatenation operator (..) or the variable argument indicator (...) + ((#\.) + (read-char) + (if (is-digit? (peek-char)) + (read-number ".") + (if (eq? (peek-char) #\.) + (begin + (read-char) + (if (eq? (peek-char) #\.) + (begin (read-char) #:dots) + #:concat)) + #\.))) + + ;; Double-quoted string + ((#\") (read-string #\")) + + ;; Single-quoted string + ((#\') (read-string #\')) + + ;; Bracketed string + ((#\[) + (save-source-info) + (let* ((nest (get-long-string-nesting-level))) + (if (eq? nest -1) + #\[ + (read-long-string #t nest)))) + + ;; Characters that are allowed to fall through directly to the parser + ((#\; #\( #\) #\, + #\+ #\/ #\* + #\^ #\{ #\} #\] #\: #\#) (read-char)) + + ;; Numbers + ((#\0 #\1 #\2 #\3 #\4 #\5 #\6 #\7 #\8 #\9) + (save-source-info) + (save-and-next!) + (read-number #f)) + + (else + (cond ((eof-object? c) c) + ;; Identifier or keyword + ((is-name-first? c) + (save-and-next!) + (save-source-info) + (while (is-name? (peek-char)) + (save-and-next!)) + (possible-keyword (string->symbol (clear-buffer)))) + (else (syntax-error (get-source-info) "disallowed character ~c" c)))) + ) ; case + ) ; loop + ) ; parameterize + ) ; lex + (values get-source-info lex)) ; make-lexer + +(define-syntax define-lua-lexer + (syntax-rules () + ((_ a b) + (begin + (define a #f) + (define b #f))))) + +(define-syntax initialize-lua-lexer! + (syntax-rules () + ((_ port a b) + (receive (get-source-info lex) + (make-lexer port) + (set! a get-source-info) + (set! b lex)))))
\ No newline at end of file |