suzanne.soy/typed-racket
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

Split syntax-classes out into separate file to reduce requires.

Browse Source 
original commit: 77b619b7c2c4c4ef89f7830949ab90bdda07f5a2
This commit is contained in:
Sam Tobin-Hochstadt 2011-09-03 18:11:10 -04:00
parent ba2fce22ce
commit a328126da4
2 changed files with 27 additions and 22 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

26
collects/typed-scheme/private/parse-classes.rkt Normal file
View File

@ -0,0 +1,26 @@
#lang racket/base
(require syntax/parse)
(provide star ddd ddd/bound)
(define-syntax-class star
#:description "*"
(pattern star:id
#:fail-unless (eq? '* (syntax-e #'star)) "missing *")
(pattern star:id
#:fail-unless (eq? '...* (syntax-e #'star)) "missing ...*"))
(define-syntax-class ddd
#:description "..."
(pattern ddd:id
#:fail-unless (eq? '... (syntax-e #'ddd)) "missing ..."))
(define-splicing-syntax-class ddd/bound
#:description "... followed by variable name"
#:attributes (bound)
(pattern i:id
#:attr s (symbol->string (syntax-e #'i))
#:fail-unless ((string-length (attribute s)) . > . 3) #f
#:fail-unless (equal? "..." (substring (attribute s) 0 3)) "missing ..."
#:attr bound (datum->syntax #'i (string->symbol (substring (attribute s) 3)) #'i #'i))
(pattern (~seq _:ddd bound:id)))

23
collects/typed-scheme/private/parse-type.rkt
View File

@ -8,6 +8,7 @@
syntax/parse
(env type-env-structs tvar-env type-name-env type-alias-env lexical-env index-env)
racket/match
"parse-classes.rkt"
(for-template scheme/base "../base-env/colon.rkt")
;; needed at this phase for tests
(combine-in (prefix-in t: "../base-env/base-types-extra.rkt") "../base-env/colon.rkt")
@ -30,28 +31,6 @@
(p stx*)))
(define-syntax-class star
#:description "*"
(pattern star:id
#:fail-unless (eq? '* (syntax-e #'star)) "missing *")
(pattern star:id
#:fail-unless (eq? '...* (syntax-e #'star)) "missing ...*"))
(define-syntax-class ddd
#:description "..."
(pattern ddd:id
#:fail-unless (eq? '... (syntax-e #'ddd)) "missing ..."))
(define-splicing-syntax-class ddd/bound
#:description "... followed by variable name"
#:attributes (bound)
(pattern i:id
#:attr s (symbol->string (syntax-e #'i))
#:fail-unless ((string-length (attribute s)) . > . 3) #f
#:fail-unless (equal? "..." (substring (attribute s) 0 3)) "missing ..."
#:attr bound (datum->syntax #'i (string->symbol (substring (attribute s) 3)) #'i #'i))
(pattern (~seq _:ddd bound:id)))
(define (parse-all-body s)
(syntax-parse s
[(ty)