|
|
|
|
@ -2,29 +2,28 @@
|
|
|
|
|
;; It has not been thoroughly tested. Also it will read an entire file into a
|
|
|
|
|
;; list of syntax objects, instead of returning one syntax object at a time
|
|
|
|
|
|
|
|
|
|
;; Everything in this module will be read with case sensitivity.
|
|
|
|
|
#cs
|
|
|
|
|
(module read mzscheme
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
(require (lib "lex.ss" "parser-tools")
|
|
|
|
|
(prefix : (lib "lex-sre.ss" "parser-tools"))
|
|
|
|
|
(lib "yacc.ss" "parser-tools")
|
|
|
|
|
(lib "readerr.ss" "syntax"))
|
|
|
|
|
|
|
|
|
|
(define-tokens data (DATUM))
|
|
|
|
|
(define-empty-tokens delim (OP CP HASHOP QUOTE QUASIQUOTE UNQUOTE UNQUOTE-SPLICING DOT EOF))
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
(define scheme-lexer
|
|
|
|
|
(lexer-src-pos
|
|
|
|
|
|
|
|
|
|
;; Skip comments, without accumulating extra position information
|
|
|
|
|
[(: whitespace comment) (return-without-pos (scheme-lexer input-port))]
|
|
|
|
|
|
|
|
|
|
[(:or scheme-whitespace comment) (return-without-pos (scheme-lexer input-port))]
|
|
|
|
|
|
|
|
|
|
["#t" (token-DATUM #t)]
|
|
|
|
|
["#f" (token-DATUM #f)]
|
|
|
|
|
[(@ "#\\" any) (token-DATUM (caddr (string->list lexeme)))]
|
|
|
|
|
[(:: "#\\" any-char) (token-DATUM (caddr (string->list lexeme)))]
|
|
|
|
|
["#\\space" (token-DATUM #\space)]
|
|
|
|
|
["#\\newline" (token-DATUM #\newline)]
|
|
|
|
|
[(: (@ initial (* subsequent)) "+" "-" "...") (token-DATUM (string->symbol lexeme))]
|
|
|
|
|
[(:or (:: initial (:* subsequent)) "+" "-" "...") (token-DATUM (string->symbol lexeme))]
|
|
|
|
|
[#\" (token-DATUM (list->string (get-string-token input-port)))]
|
|
|
|
|
[#\( 'OP]
|
|
|
|
|
[#\) 'CP]
|
|
|
|
|
@ -41,127 +40,129 @@
|
|
|
|
|
[",@" 'UNQUOTE-SPLICING]
|
|
|
|
|
["." 'DOT]
|
|
|
|
|
[(eof) 'EOF]))
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
(define get-string-token
|
|
|
|
|
(lexer
|
|
|
|
|
[(^ #\" #\\) (cons (car (string->list lexeme))
|
|
|
|
|
(get-string-token input-port))]
|
|
|
|
|
[(@ #\\ #\\) (cons #\\ (get-string-token input-port))]
|
|
|
|
|
[(@ #\\ #\") (cons #\" (get-string-token input-port))]
|
|
|
|
|
[(:~ #\" #\\) (cons (car (string->list lexeme))
|
|
|
|
|
(get-string-token input-port))]
|
|
|
|
|
[(:: #\\ #\\) (cons #\\ (get-string-token input-port))]
|
|
|
|
|
[(:: #\\ #\") (cons #\" (get-string-token input-port))]
|
|
|
|
|
[#\" null]))
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
(define-lex-abbrevs
|
|
|
|
|
[any (- #\000 #\377)]
|
|
|
|
|
[letter (: (- "a" "z") (- #\A #\Z))]
|
|
|
|
|
[digit (- #\0 #\9)]
|
|
|
|
|
[whitespace (: #\newline #\return #\tab #\space #\vtab)]
|
|
|
|
|
[initial (: letter "!" "$" "%" "&" "*" "/" ":" "<" "=" ">" "?" "^" "_" "~" "@")]
|
|
|
|
|
[subsequent (: initial digit "+" "-" #\. "@")]
|
|
|
|
|
[comment (@ #\; (* (^ #\newline)) #\newline)]
|
|
|
|
|
[letter (:or (:/ "a" "z") (:/ #\A #\Z))]
|
|
|
|
|
[digit (:/ #\0 #\9)]
|
|
|
|
|
[scheme-whitespace (:or #\newline #\return #\tab #\space #\vtab)]
|
|
|
|
|
[initial (:or letter (char-set "!$%&*/:<=>?^_~@"))]
|
|
|
|
|
[subsequent (:or initial digit (char-set "+-.@"))]
|
|
|
|
|
[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))]
|
|
|
|
|
;; See ${PLTHOME}/collects/syntax-color/scheme-lexer.ss for an example of
|
|
|
|
|
;; using regexp macros to avoid the cut and paste.
|
|
|
|
|
; [numR (:: prefixR complexR)]
|
|
|
|
|
; [complexR (:or realR
|
|
|
|
|
; (:: realR "@" realR)
|
|
|
|
|
; (:: realR "+" urealR "i")
|
|
|
|
|
; (:: realR "-" urealR "i")
|
|
|
|
|
; (:: realR "+i")
|
|
|
|
|
; (:: realR "-i")
|
|
|
|
|
; (:: "+" urealR "i")
|
|
|
|
|
; (:: "-" urealR "i")
|
|
|
|
|
; (:: "+i")
|
|
|
|
|
; (:: "-i"))]
|
|
|
|
|
; [realR (:: sign urealR)]
|
|
|
|
|
; [urealR (:or uintegerR (:: uintegerR "/" uintegerR) decimalR)]
|
|
|
|
|
; [uintegerR (:: (:+ digitR) (:* #\#))]
|
|
|
|
|
; [prefixR (:or (:: radixR exactness)
|
|
|
|
|
; (:: exactness radixR))]
|
|
|
|
|
|
|
|
|
|
[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))]
|
|
|
|
|
[num2 (:: prefix2 complex2)]
|
|
|
|
|
[complex2 (:or real2
|
|
|
|
|
(:: real2 "@" real2)
|
|
|
|
|
(:: real2 "+" ureal2 "i")
|
|
|
|
|
(:: real2 "-" ureal2 "i")
|
|
|
|
|
(:: real2 "+i")
|
|
|
|
|
(:: real2 "-i")
|
|
|
|
|
(:: "+" ureal2 "i")
|
|
|
|
|
(:: "-" ureal2 "i")
|
|
|
|
|
(:: "+i")
|
|
|
|
|
(:: "-i"))]
|
|
|
|
|
[real2 (:: sign ureal2)]
|
|
|
|
|
[ureal2 (:or uinteger2 (:: uinteger2 "/" uinteger2))]
|
|
|
|
|
[uinteger2 (:: (:+ digit2) (:* #\#))]
|
|
|
|
|
[prefix2 (:or (:: 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))]
|
|
|
|
|
[digit2 (:or "0" "1")]
|
|
|
|
|
[num8 (:: prefix8 complex8)]
|
|
|
|
|
[complex8 (:or real8
|
|
|
|
|
(:: real8 "@" real8)
|
|
|
|
|
(:: real8 "+" ureal8 "i")
|
|
|
|
|
(:: real8 "-" ureal8 "i")
|
|
|
|
|
(:: real8 "+i")
|
|
|
|
|
(:: real8 "-i")
|
|
|
|
|
(:: "+" ureal8 "i")
|
|
|
|
|
(:: "-" ureal8 "i")
|
|
|
|
|
(:: "+i")
|
|
|
|
|
(:: "-i"))]
|
|
|
|
|
[real8 (:: sign ureal8)]
|
|
|
|
|
[ureal8 (:or uinteger8 (:: uinteger8 "/" uinteger8))]
|
|
|
|
|
[uinteger8 (:: (:+ digit8) (:* #\#))]
|
|
|
|
|
[prefix8 (:or (:: radix8 exactness)
|
|
|
|
|
(:: exactness radix8))]
|
|
|
|
|
[radix8 "#o"]
|
|
|
|
|
[digit8 (- "0" "7")]
|
|
|
|
|
[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")]
|
|
|
|
|
[num10 (:: prefix10 complex10)]
|
|
|
|
|
[complex10 (:or real10
|
|
|
|
|
(:: real10 "@" real10)
|
|
|
|
|
(:: real10 "+" ureal10 "i")
|
|
|
|
|
(:: real10 "-" ureal10 "i")
|
|
|
|
|
(:: real10 "+i")
|
|
|
|
|
(:: real10 "-i")
|
|
|
|
|
(:: "+" ureal10 "i")
|
|
|
|
|
(:: "-" ureal10 "i")
|
|
|
|
|
(:: "+i")
|
|
|
|
|
(:: "-i"))]
|
|
|
|
|
[real10 (:: sign ureal10)]
|
|
|
|
|
[ureal10 (:or uinteger10 (:: uinteger10 "/" uinteger10) decimal10)]
|
|
|
|
|
[uinteger10 (:: (:+ digit10) (:* #\#))]
|
|
|
|
|
[prefix10 (:or (:: radix10 exactness)
|
|
|
|
|
(:: exactness radix10))]
|
|
|
|
|
[radix10 (:? "#d")]
|
|
|
|
|
[digit10 digit]
|
|
|
|
|
[decimal10 (: (@ uinteger10 suffix)
|
|
|
|
|
(@ #\. (+ digit10) (* #\#) suffix)
|
|
|
|
|
(@ (+ digit10) #\. (* digit10) (* #\#) suffix)
|
|
|
|
|
(@ (+ digit10) (+ #\#) #\. (* #\#) suffix))]
|
|
|
|
|
[decimal10 (:or (:: 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))]
|
|
|
|
|
[num16 (:: prefix16 complex16)]
|
|
|
|
|
[complex16 (:or real16
|
|
|
|
|
(:: real16 "@" real16)
|
|
|
|
|
(:: real16 "+" ureal16 "i")
|
|
|
|
|
(:: real16 "-" ureal16 "i")
|
|
|
|
|
(:: real16 "+i")
|
|
|
|
|
(:: real16 "-i")
|
|
|
|
|
(:: "+" ureal16 "i")
|
|
|
|
|
(:: "-" ureal16 "i")
|
|
|
|
|
"+i"
|
|
|
|
|
"-i")]
|
|
|
|
|
[real16 (:: sign ureal16)]
|
|
|
|
|
[ureal16 (:or uinteger16 (:: uinteger16 "/" uinteger16))]
|
|
|
|
|
[uinteger16 (:: (:+ digit16) (:* #\#))]
|
|
|
|
|
[prefix16 (:or (:: radix16 exactness)
|
|
|
|
|
(:: exactness radix16))]
|
|
|
|
|
[radix16 "#x"]
|
|
|
|
|
[digit16 (: digit (- #\a #\f) (- #\A #\F))]
|
|
|
|
|
|
|
|
|
|
[digit16 (:or digit (:/ #\a #\f) (:/ #\A #\F))]
|
|
|
|
|
|
|
|
|
|
[suffix (: (@) (@ exponent-marker sign (+ digit10)))]
|
|
|
|
|
[exponent-marker (: "e" "s" "f" "d" "l")]
|
|
|
|
|
[sign (: (@) "+" "-")]
|
|
|
|
|
[exactness (: (@) "#i" "#e")])
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
[suffix (:or "" (:: exponent-marker sign (:+ digit10)))]
|
|
|
|
|
[exponent-marker (:or "e" "s" "f" "d" "l")]
|
|
|
|
|
[sign (:or "" "+" "-")]
|
|
|
|
|
[exactness (:or "" "#i" "#e")])
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
(define stx-for-original-property (read-syntax #f (open-input-string "original")))
|
|
|
|
|
|
|
|
|
|
@ -197,7 +198,7 @@
|
|
|
|
|
(define (scheme-parser source-name)
|
|
|
|
|
(parser
|
|
|
|
|
(src-pos)
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
(start s)
|
|
|
|
|
(end EOF)
|
|
|
|
|
(error (lambda (a name val start end)
|
|
|
|
|
@ -235,7 +236,7 @@
|
|
|
|
|
(define readsyntax
|
|
|
|
|
(case-lambda ((sn) (rs sn (current-input-port)))
|
|
|
|
|
((sn ip) (rs sn ip))))
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
(provide (rename readsyntax read-syntax))
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
)
|
Scott Owens
20 years ago