(define docond-ht (make-eq-hashtable)) (hashtable-set! docond-ht '&condition '()) (define (docond expr) (syntax-case expr (define-condition-type) [(define-condition-type &name &parent make-name name? (field-name field-accessor) ...) (let ([pfields (hashtable-ref docond-ht #'&parent #f)]) (unless pfields (error 'docond "unrecognized parent ~s" #'&parent)) (printf "\\formdef{~s}{\\categorysyntax}{~s}\n" #'&name #'&name) (let ([fields (append pfields #'(field-name ...))]) (printf "\\formdef{~s}{\\categoryprocedure}{(~s~{ \\var{~s}~})}\n" #'make-name #'make-name fields) (hashtable-set! docond-ht #'&name fields)) (printf "\\returns a condition of type \\scheme{~s}\n" #'&name) (printf "\\formdef{~s}{\\categoryprocedure}{(~s \\var{obj})}\n" #'name? #'name?) (printf "\\returns \\scheme{#t} if \\var{obj} is a condition of type \\scheme{~s}, \\scheme{#f} otherwise\n" #'&name) (for-each (lambda (field get-field) (printf "\\formdef{~s}{\\categoryprocedure}{(~s \\var{condition})}\n" get-field get-field) (printf "\\returns the contents of \\var{condition}'s \\scheme{~s} field\n" field)) #'(field-name ...) #'(field-accessor ...)) (printf "\\listlibraries\n"))]))