*** empty log message ***
original commit: 6abac7d33207ff4508585c992906310695839daetokens
Scott Owens
23 years ago
parent
78f5e88e58
commit
621e178854
@ -0,0 +1,219 @@
|
|||||||
|
#cs
|
||||||
|
(module read mzscheme
|
||||||
|
|
||||||
|
(require (lib "lex.ss" "parser-tools")
|
||||||
|
(lib "util.ss" "parser-tools"))
|
||||||
|
|
||||||
|
(define scheme-lexer
|
||||||
|
(lexer
|
||||||
|
[(: (whitespace) (comment)) (scheme-lexer lex-buf)]
|
||||||
|
["#t" #t]
|
||||||
|
["#f" #f]
|
||||||
|
[(@ "#\\" (any)) (caddr (string->list (get-lexeme)))]
|
||||||
|
["#\\space" #\space]
|
||||||
|
["#\\newline" #\newline]
|
||||||
|
[(: (@ (initial) (* (subsequent))) + - "...") (string->symbol (get-lexeme))]
|
||||||
|
[#\" (list->string (get-string-token lex-buf))]
|
||||||
|
[#\( (make-OPEN-LIST)]
|
||||||
|
[#\) (make-CLOSE)]
|
||||||
|
["#(" (make-OPEN-VECTOR)]
|
||||||
|
[(num2) (string->number (get-lexeme) 2)]
|
||||||
|
[(num8) (string->number (get-lexeme) 8)]
|
||||||
|
[(num10) (string->number (get-lexeme) 10)]
|
||||||
|
[(num16) (string->number (get-lexeme) 16)]
|
||||||
|
["'" (make-QUOTE)]
|
||||||
|
["`" (make-QUASI-QUOTE)]
|
||||||
|
["," (make-UNQUOTE)]
|
||||||
|
[",@" (make-UNQUOTE-SPLICING)]
|
||||||
|
["." (make-DOT)]
|
||||||
|
[(eof) eof]))
|
||||||
|
|
||||||
|
(define get-string-token
|
||||||
|
(lexer
|
||||||
|
[(^ #\" #\\) (cons (car (string->list (get-lexeme)))
|
||||||
|
(get-string-token lex-buf))]
|
||||||
|
[(@ #\\ #\\) (cons #\\ (get-string-token lex-buf))]
|
||||||
|
[(@ #\\ #\") (cons #\" (get-string-token lex-buf))]
|
||||||
|
[#\" null]))
|
||||||
|
|
||||||
|
|
||||||
|
(define-lex-abbrevs
|
||||||
|
[initial (: (letter) ! $ % & * / : < = > ? ^ _ ~)]
|
||||||
|
[subsequent (: (initial) (digit) + - #\. @)]
|
||||||
|
[comment (@ #\; (* (^ #\newline)) #\newline)]
|
||||||
|
|
||||||
|
; [numR (@ (prefixR) (complexR))]
|
||||||
|
; [complexR (: (realR)
|
||||||
|
; (@ (realR) @ (realR))
|
||||||
|
; (@ (realR) + (urealR) i)
|
||||||
|
; (@ (realR) - (urealR) i)
|
||||||
|
; (@ (realR) + i)
|
||||||
|
; (@ (realR) - i)
|
||||||
|
; (@ + (urealR) i)
|
||||||
|
; (@ - (urealR) i)
|
||||||
|
; (@ + i)
|
||||||
|
; (@ - i))]
|
||||||
|
; [realR (@ (sign) (urealR))]
|
||||||
|
; [urealR (: (uintegerR) (@ (uintegerR) / (uintegerR)) (decimalR))]
|
||||||
|
; [uintegerR (@ (+ (digitR)) (* #\#))]
|
||||||
|
; [prefixR (: (@ (radixR) (exactness))
|
||||||
|
; (@ (exactness) (radixR)))]
|
||||||
|
; [numR (@ (prefixR) (complexR))]
|
||||||
|
; [complexR (: (realR)
|
||||||
|
; (@ (realR) @ (realR))
|
||||||
|
|
||||||
|
[num2 (@ (prefix2) (complex2))]
|
||||||
|
[complex2 (: (real2)
|
||||||
|
(@ (real2) @ (real2))
|
||||||
|
(@ (real2) + (ureal2) i)
|
||||||
|
(@ (real2) - (ureal2) i)
|
||||||
|
(@ (real2) + i)
|
||||||
|
(@ (real2) - i)
|
||||||
|
(@ + (ureal2) i)
|
||||||
|
(@ - (ureal2) i)
|
||||||
|
(@ + i)
|
||||||
|
(@ - i))]
|
||||||
|
[real2 (@ (sign) (ureal2))]
|
||||||
|
[ureal2 (: (uinteger2) (@ (uinteger2) / (uinteger2)))]
|
||||||
|
[uinteger2 (@ (+ (digit2)) (* #\#))]
|
||||||
|
[prefix2 (: (@ (radix2) (exactness))
|
||||||
|
(@ (exactness) (radix2)))]
|
||||||
|
[radix2 "#b"]
|
||||||
|
[digit2 (: #\0 #\1)]
|
||||||
|
|
||||||
|
[num8 (@ (prefix8) (complex8))]
|
||||||
|
[complex8 (: (real8)
|
||||||
|
(@ (real8) @ (real8))
|
||||||
|
(@ (real8) + (ureal8) i)
|
||||||
|
(@ (real8) - (ureal8) i)
|
||||||
|
(@ (real8) + i)
|
||||||
|
(@ (real8) - i)
|
||||||
|
(@ + (ureal8) i)
|
||||||
|
(@ - (ureal8) i)
|
||||||
|
(@ + i)
|
||||||
|
(@ - i))]
|
||||||
|
[real8 (@ (sign) (ureal8))]
|
||||||
|
[ureal8 (: (uinteger8) (@ (uinteger8) / (uinteger8)))]
|
||||||
|
[uinteger8 (@ (+ (digit8)) (* #\#))]
|
||||||
|
[prefix8 (: (@ (radix8) (exactness))
|
||||||
|
(@ (exactness) (radix8)))]
|
||||||
|
[radix8 "#o"]
|
||||||
|
[digit8 (- #\0 #\7)]
|
||||||
|
|
||||||
|
[num10 (@ (prefix10) (complex10))]
|
||||||
|
[complex10 (: (real10)
|
||||||
|
(@ (real10) @ (real10))
|
||||||
|
(@ (real10) + (ureal10) i)
|
||||||
|
(@ (real10) - (ureal10) i)
|
||||||
|
(@ (real10) + i)
|
||||||
|
(@ (real10) - i)
|
||||||
|
(@ + (ureal10) i)
|
||||||
|
(@ - (ureal10) i)
|
||||||
|
(@ + i)
|
||||||
|
(@ - i))]
|
||||||
|
[real10 (@ (sign) (ureal10))]
|
||||||
|
[ureal10 (: (uinteger10) (@ (uinteger10) / (uinteger10)) (decimal10))]
|
||||||
|
[uinteger10 (@ (+ (digit10)) (* #\#))]
|
||||||
|
[prefix10 (: (@ (radix10) (exactness))
|
||||||
|
(@ (exactness) (radix10)))]
|
||||||
|
[radix10 (: (@) "#d")]
|
||||||
|
[digit10 (digit)]
|
||||||
|
[decimal10 (: (@ (uinteger10) (suffix))
|
||||||
|
(@ #\. (+ (digit10)) (* #\#) (suffix))
|
||||||
|
(@ (+ (digit10)) #\. (* (digit10)) (* #\#) (suffix))
|
||||||
|
(@ (+ (digit10)) (+ #\#) #\. (* #\#) (suffix)))]
|
||||||
|
|
||||||
|
[num16 (@ (prefix16) (complex16))]
|
||||||
|
[complex16 (: (real16)
|
||||||
|
(@ (real16) @ (real16))
|
||||||
|
(@ (real16) + (ureal16) i)
|
||||||
|
(@ (real16) - (ureal16) i)
|
||||||
|
(@ (real16) + i)
|
||||||
|
(@ (real16) - i)
|
||||||
|
(@ + (ureal16) i)
|
||||||
|
(@ - (ureal16) i)
|
||||||
|
(@ + i)
|
||||||
|
(@ - i))]
|
||||||
|
[real16 (@ (sign) (ureal16))]
|
||||||
|
[ureal16 (: (uinteger16) (@ (uinteger16) / (uinteger16)))]
|
||||||
|
[uinteger16 (@ (+ (digit16)) (* #\#))]
|
||||||
|
[prefix16 (: (@ (radix16) (exactness))
|
||||||
|
(@ (exactness) (radix16)))]
|
||||||
|
[radix16 "#x"]
|
||||||
|
[digit16 (: (digit) (- #\a #\f) (- #\A #\F))]
|
||||||
|
|
||||||
|
|
||||||
|
[suffix (: (@) (@ (exponent-marker) (sign) (+ (digit10))))]
|
||||||
|
[exponent-marker (: e s f d l)]
|
||||||
|
[sign (: (@) + -)]
|
||||||
|
[exactness (: (@) "#i" "#e")]
|
||||||
|
)
|
||||||
|
|
||||||
|
|
||||||
|
(define r (build-reader scheme-lexer))
|
||||||
|
(provide r)
|
||||||
|
|
||||||
|
(define (compare s1 s2)
|
||||||
|
(for-each (lambda (x y)
|
||||||
|
(if (not (equal? x y))
|
||||||
|
(printf "~a~n~n~a" x y)))
|
||||||
|
s1 s2))
|
||||||
|
|
||||||
|
(define (read-all read)
|
||||||
|
(lambda (ip)
|
||||||
|
(let ((r (read ip)))
|
||||||
|
(cond
|
||||||
|
((eof-object? r)
|
||||||
|
null)
|
||||||
|
(else
|
||||||
|
(cons r ((read-all read) ip)))))))
|
||||||
|
|
||||||
|
(define (lex-all lexer)
|
||||||
|
(lambda (in)
|
||||||
|
(let ((lb (make-lex-buf in)))
|
||||||
|
(let loop ((t (lexer lb)))
|
||||||
|
(if (not (eof-object? t))
|
||||||
|
(loop (lexer lb)))))))
|
||||||
|
|
||||||
|
|
||||||
|
(require (lib "list.ss"))
|
||||||
|
(define files (filter (lambda (x)
|
||||||
|
(string=? ".scm"
|
||||||
|
(substring x
|
||||||
|
(- (string-length x) 4)
|
||||||
|
(string-length x))))
|
||||||
|
(directory-list)))
|
||||||
|
(define (test)
|
||||||
|
(printf "just lexing~n")
|
||||||
|
(time
|
||||||
|
(map (lambda (x)
|
||||||
|
(display x)
|
||||||
|
(newline)
|
||||||
|
(call-with-input-file x (lex-all scheme-lexer)))
|
||||||
|
files))
|
||||||
|
#|
|
||||||
|
(printf "reading~n")
|
||||||
|
(time
|
||||||
|
(map (lambda (x)
|
||||||
|
(display x)
|
||||||
|
(newline)
|
||||||
|
(call-with-input-file x (read-all r)))
|
||||||
|
files))
|
||||||
|
(printf "builtin read~n")
|
||||||
|
(time
|
||||||
|
(map (lambda (x)
|
||||||
|
(display x)
|
||||||
|
(newline)
|
||||||
|
(call-with-input-file x (read-all read)))
|
||||||
|
files))
|
||||||
|
(printf "testing~n")
|
||||||
|
(for-each (lambda (x)
|
||||||
|
(display x)
|
||||||
|
(newline)
|
||||||
|
(compare (call-with-input-file x (read-all read ))
|
||||||
|
(call-with-input-file x (read-all r))))
|
||||||
|
files)|#)
|
||||||
|
|
||||||
|
(provide test)
|
||||||
|
|
||||||
|
)
|
||||||
Loading…
Reference in New Issue