mbutterick
/
br-parser-tools
1
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

*** empty log message ***

Browse Source 
original commit: 0193a2caf80ccc055e9262884243acdb661f4eb2
tokens
Scott Owens 20 years ago
parent 41597427bb
commit 71caee98aa
1 changed files with 118 additions and 117 deletions
Show Stats Download Patch File Download Diff File

235
collects/parser-tools/examples/read.ss
Unescape Escape View File

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