hygienic.scm

; syntax objects are true AST nodes, so they are an algebraic data type with data constructors and deconstructors:
;
; syntax = (syntax-null props) | (syntax-cons props syntax syntax) | (syntax-identifier props symbol) | (syntax-atom props datum)
;
; the constructors have dual deconstructors with names like syntax-car, syntax-cdr, syntax-identifier-symbol,
; and type predicates like syntax-null?, syntax-pair?, syntax-identifier?.
;
; props is just an open-ended plist of key-value pairs with optional information about things like source location
; and anything else you want to track. you can call syntax-props on any of the syntax variants to get the plist.
; as a convenience when calling the constructor functions, you can either pass in a props plist directly, or you can
; pass in a syntax object in which case the props will be copied from there.
;
; read-syntax is how you convert string data to a syntax object, analogously to the read function for S-expressions.
;
; read-syntax : string | port -> syntax
;
; in addition to the data constructors, there is a syntax-quote special form for easily generating syntax objects
; from a template while allowing splicing, akin to quasiquote for S-expression data. this just uses the above constructor
; functions to build syntax objects, and tags quoted data with props corresponding to their source code location in the
; syntax-quote form, while spliced-in data is passed through as is, so it retain its identity and props, and in particular
; its source location.
;
; in this framework, macros are basically the classical Lisp macros except they operate on syntax instead of S-expression data.
;
; on top of the constructors and deconstructors, you can easily build higher-level helper functions. here are some examples:

; syntax-list = (syntax-null props) | (syntax-cons props syntax syntax-list)

; syntax-map : (syntax ... -> syntax) syntax-list ... -> syntax-list
(define (syntax-map f . stxs)
  (cond ((all syntax-null? stxs)
         (car stxs))
        ((all syntax-pair? stxs)
         (syntax-cons (car stxs)
                      (apply f (map syntax-car stxs))
                      (apply syntax-map f (map syntax-cdr stxs))))
        (else
         (error))))

; syntax-first : syntax-list -> syntax
(define syntax-first syntax-car)

; syntax-second : syntax-list -> syntax
(define (syntax-second stx)
  (syntax-car (syntax-cdr stx)))

; syntax-gensym : syntax | props -> syntax-identifier
(define (syntax-gensym ctx)
  (syntax-identifier ctx (gensym)))

; (letrec ((var exp) ...)
;   body...)
; 
; =>
; 
; (let ((var '()) ...)
;  (let ((<tmp> exp) ...)
;    (set! var <tmp>)
;    ...
;    (begin
;      body...)))

(define-macro (letrec bindings . body)
  (let* ((vars (syntax-map syntax-first bindings))
         (exps (syntax-map syntax-second bindings))
         (tmps (syntax-map syntax-gensym vars)))
    #'(let ,(syntax-map (lambda (var) #'(,var '())) vars)
        (let ,(syntax-map (lambda (tmp exp) #'(,tmp ,exp)) tmps exps)
          ,@(syntax-map (lambda (var tmp) #'(set! ,var ,tmp)) vars tmps)
          (begin ,@body)))))

; let-it is an anamorphic macro that intentionally violates hygiene by binding e to the 'it' identifier in the caller's scope.
;
; (let-it exp body...)
;
; =>
;
; (let ((it exp)) body...)

(define-macro (let-it exp . body)
  #`(let (,(syntax-identifier exp 'it) ,exp)
      ,@body))

; syntax->datum : syntax -> datum
(define (syntax->datum stx)
  (cond ((syntax-null? stx)       '())
        ((syntax-pair? stx)       (cons (syntax->datum (syntax-car stx)) (syntax->datum (syntax-cdr stx))))
        ((syntax-identifier? stx) (syntax-identifier-symbol stx))
        ((syntax-atom? stx)       (syntax-atom-datum stx))
        (else                     (error))))

; datum->syntax : (props | syntax) datum -> syntax
(define (datum->syntax ctx x)
  (cond ((null? x)   (syntax-null ctx x))
        ((pair? x)   (syntax-cons ctx (datum->syntax ctx (car x)) (datum->syntax ctx (cdr x))))
        ((symbol? x) (syntax-identifier ctx x))
        ((atom? x)   (syntax-atom ctx x))
        (else        (error))))