;;; -*- Mode: Scheme; scheme48-package: stubber-descriptors -*-

;;;; Scheme48 Stubber
;;;; Stub Descriptor Data Types

;;; This is the interface between the usual code generator 

;;; This code is written by Taylor R. Campbell and placed in the Public
;;; Domain.  All warranties are disclaimed.

(define-syntax define-stub-descriptor
  (syntax-rules ()
    ((DEFINE-STUB-DESCRIPTOR name constructor
       (field-name accessor)
       ...)
     (BEGIN
       (DEFINE-SYNTAX constructor
         (LAMBDA (FORM RENAME COMPARE)
           (LET LOOP ((FIELDS (CDR FORM))
                      (FIELD-NAMES '(field-name ...)))
             (COND ((PAIR? FIELD-NAMES)
                    (IF (AND (PAIR? FIELDS)
                             (PAIR? (CAR FIELDS))
                             (PAIR? (CDAR FIELDS))
                             (NULL? (CDDAR FIELDS))
                             (EQ? (CAAR FIELDS) (CAR FIELD-NAMES)))
                        (LOOP (CDR FIELDS) (CDR FIELD-NAMES))
                        FORM))          ;Lose
                   ((NULL? FIELDS)
                    `(,(RENAME 'LIST)
                      (,(RENAME 'QUOTE) name)
                      ,@(MAP (LAMBDA (FIELD)
                               `(,(RENAME 'CONS)
                                 (,(RENAME 'QUOTE) ,(CAR FIELD))
                                 ,(CADR FIELD)))
                             (CDR FORM))))
                   (ELSE FORM))))       ;Lose
         (CONS QUOTE))    ;Auxiliary names
       (DEFINE (accessor DESCRIPTOR)
         (CDR (ASSQ 'field-name (CDR DESCRIPTOR))))
       ...))))

(define-stub-descriptor stub-descriptor:binding binding-descriptor
  (SCHEME-NAME binding/scheme-name)
  (C-BODY binding/c-body)
  (BINDING-NAME binding/binding-name)
  )

(define-stub-descriptor stub-descriptor:function function-descriptor
  (BINDING-NAME function/binding-name)
  (SCHEME-NAME function/scheme-name)
  (PARAMETERS function/parameters)
  (C-NAME function/c-name)
  (C-DECLARATIONS function/c-declarations)
  (C-BODY function/c-body)
  )

(define-stub-descriptor stub-descriptor:constant-enumeration
    constant-enumeration-descriptor
  (SCHEME-NAME constant-enumeration/scheme-name)
  (SCHEME-RTD constant-enumeration/scheme-rtd)
  (SCHEME-TYPE-PREDICATE constant-enumeration/scheme-type-predicate)
  (SCHEME-INSTANCE-VECTOR constant-enumeration/scheme-instance-vector)
  (SCHEME-NAME-ACCESSOR constant-enumeration/scheme-name-accessor)
  (SCHEME-INDEX-ACCESSOR constant-enumeration/scheme-index-accessor)
  (SCHEME-AVAILABLE-PREDICATE constant-enumeration/scheme-available-predicate)
  (SCHEME-ENUMERAND-NAMES constant-enumeration/scheme-enumerand-names)
  (INSTANCE-VECTOR-BINDING constant-enumeration/instance-vector-binding)
  (AVAILABLE-PREDICATE-BINDING
   constant-enumeration/available-predicate-binding)
  (C-TYPE constant-enumeration/c-type)
  (C-MAPPER constant-enumeration/c-mapper)
  (C-UNMAPPER constant-enumeration/c-unmapper)
  (C-ENUMERANDS constant-enumeration/c-enumerands)
  )