scheme-interpreter-story/syntax.scm

#lang racket

(provide syx syx?
	 syx-type set-syx-type!
	 syx-metadata set-syx-metadata!
	 syx-data set-syx-data!

	 syx-atomic?
	 syx-id? syx-id
	 syx-special?

	 syx-set
	 
         syx->datum)

;; syntax objects (which we call syx) are either a 'syx' structure
;; or () or a pair of syntax objects

(struct syx ((type #:mutable)
	     (data #:mutable)
	     (metadata #:mutable))
	#:transparent)
;; type is one of:
;; * atomic - then data is a number, boolean, string
;; * id, special - then data is a symbol

(define (syx-atomic? x)
  (and (syx? x) (eq? 'atomic (syx-type x))))

(define (syx-id? x)
  (and (syx? x) (eq? 'id (syx-type x))))

(define (syx-special? x)
  (and (syx? x) (eq? 'special (syx-type x))))

(define (syx-id x)
  (unless (syx-id? x)
	  (error "syx-id: invalid input" x))
  (syx-data x))

(define (syx->datum e)
  (cond ((null? e) e)
	((pair? e) (cons (syx->datum (car e))
			 (syx->datum (cdr e))))
	((syx? e)
	 (case (syx-type e)
	   ((atomic) (syx-data e))
	   ((id special) (syx-data e))
	   (else (error "unknown type" e))))
	(else (error "unknown data type" e))))

(define (syx-set x)
  (cond ((assoc 'set (syx-metadata x))
	 => cdr)
	(else '())))