papyrus/token.scm

(define (make-token . s) (cons 'token s))
(define (token? s) (and (list? s) (eq? 'token (car s))))

(define (token-type token) (cadr token))
(define (token-location token) (cons (caddr token) (cadddr token)))
(define (token-args token) (cddddr token))

(define (atomic-token? token)
  (member (token-type token)
	  '(symbol number boolean character string)))
(define (mark-token? token)
  (member (token-type token)
	  '(quote unquote quasiquote)))
(define (dot-token? token)
  (equal? (token-type token) 'dot))
(define (open-token? token)
  (equal? (token-type token) 'open))
(define (close-token? token)
  (equal? (token-type token) 'close))