*** empty log message ***

original commit: aedfa47e449e4927abce7efcb27d0ecbe3bb8e4e
tokens
Scott Owens 23 years ago
parent f5f5202678
commit a261d785d0

@ -3,38 +3,7 @@
;; The things needed at compile time to handle definition of tokens ;; The things needed at compile time to handle definition of tokens
(provide make-terminals-def terminals-def-t terminals-def? define-tokens-helper) (provide make-terminals-def terminals-def-t terminals-def?)
(define-struct terminals-def (t)) (define-struct terminals-def (t))
(define (define-tokens-helper stx runtime empty?)
(syntax-case stx ()
((_ name (terms ...))
(andmap identifier? (syntax->list (syntax (terms ...))))
(datum->syntax-object
runtime
`(begin
(define-syntax ,(syntax name)
(make-terminals-def (quote-syntax ,(syntax (terms ...)))))
,@(map
(lambda (n)
(if (eq? (syntax-object->datum n) 'error)
(raise-syntax-error
#f
"Cannot define a token named error."
stx))
`(define (,(datum->syntax-object
n
(string->symbol
(format "token-~a" (syntax-object->datum n)))
n)
,@(if empty? '() '(x)))
(make-token ',n ,(if empty? #f 'x))))
(syntax->list (syntax (terms ...)))))
stx))
((_ ...)
(raise-syntax-error
#f
"must have the form (define-tokens name (symbol ...))"
stx))))
) )

@ -1,22 +1,48 @@
#cs #cs
(module token mzscheme (module token mzscheme
;; Defining tokens
(require-for-syntax "token-syntax.ss") (require-for-syntax "token-syntax.ss")
;; Defining tokens
(provide define-tokens define-empty-tokens make-token token-name token-value token?) (provide define-tokens define-empty-tokens make-token token-name token-value token?)
(define-struct token (name value) (make-inspector)) (define-struct token (name value) (make-inspector))
(define-syntax (define-tokens stx) (define-syntaxes (define-tokens define-empty-tokens)
(syntax-case stx () (let ((define-tokens-helper
((_ name ...) (lambda (stx empty?)
(define-tokens-helper stx #'here #f))))
(define-syntax (define-empty-tokens stx)
(syntax-case stx () (syntax-case stx ()
((_ name ...) ((_ name (terms ...))
(define-tokens-helper stx #'here #t)))) (andmap identifier? (syntax->list (syntax (terms ...))))
(datum->syntax-object
#'here
`(begin
(define-syntax ,(syntax name)
(make-terminals-def (quote-syntax ,(syntax (terms ...)))))
,@(map
(lambda (n)
(if (eq? (syntax-object->datum n) 'error)
(raise-syntax-error
#f
"Cannot define a token named error."
stx))
`(define (,(datum->syntax-object
n
(string->symbol
(format "token-~a" (syntax-object->datum n)))
n)
,@(if empty? '() '(x)))
(make-token ',n ,(if empty? #f 'x))))
(syntax->list (syntax (terms ...)))))
stx))
((_ ...)
(raise-syntax-error
#f
"must have the form (define-tokens name (symbol ...)) or (define-empty-tokens name (symbol ...))"
stx))))))
(values
(lambda (stx) (define-tokens-helper stx #f))
(lambda (stx) (define-tokens-helper stx #t)))))
) )

Loading…
Cancel
Save