diff --git a/collects/parser-tools/examples/read.ss b/collects/parser-tools/examples/read.ss index ea659b6..68838a1 100644 --- a/collects/parser-tools/examples/read.ss +++ b/collects/parser-tools/examples/read.ss @@ -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)) - + ) \ No newline at end of file