(herald (synclo simple))                                    ; -*- T -*-

;;;;;; Syntactic closures for T
;;;;;; Simple output library

;;; Taylor Campbell wrote this code; he places it in the public domain.

(define (output/sequence sequents)
  `(BLOCK ,@sequents))

(define (output/definition variant id exp)
  `(,(xcase variant
       ((DEFINE) 'DEFINE)
       ((LSET) 'LSET))
    ,id
    ,exp))

(define (output/combination operator operands)
  `(,operator ,@operands))

(define (output/literal datum)
  (if (self-evaluating? datum)
      datum
      `',datum))

(define (output/local-reference id)
  id)

(define (output/top-level-reference id vcell)
  (ignore vcell)
  id)

(define (output/free-reference id)
  id)

(define (output/local-assignment id exp)
  `(SET-VARIABLE-VALUE ,id ,exp))

(define (output/top-level-assignment id vcell exp)
  (ignore vcell)
  `(SET-VARIABLE-VALUE ,id ,exp))

(define (output/free-assignment id exp)
  `(SET-VARIABLE-VALUE ,id ,exp))

(define (output/local-var-locative id)
  `(VAR-LOCATIVE ,id))

(define (output/top-level-var-locative id vcell)
  (ignore vcell)
  `(VAR-LOCATIVE ,id))

(define (output/free-var-locative id)
  `(VAR-LOCATIVE ,id))

(define (output/lambda bvl body)
  `(LAMBDA ,bvl ,body))

(define (output/named-lambda id bvl body)
  `(NAMED-LAMBDA ,id ,bvl ,body))

(define (output/object proc methods)
  `(OBJECT ,proc ,@methods))

(define (output/labels ids exps body)
  `(LABELS ,(map list ids exps) ,body))

(define (output/conditional test consequent alternative)
  `(IF ,test ,consequent ,alternative))

(define (output/undefined-conditional-value)
  'UNDEFINED-IF-VALUE)

(define (output/unassigned-initializer)
  `',nil)

(define (rename-identifiers ids)
  (map generate-symbol ids))

(define (rename-top-level-identifier id)
  (generate-symbol id))

(define (self-evaluating? object)
  (or (number? object)
      (string? object)
      (char? object)))

(define (post-process-syntax-output output)
  output)