47 lines
1.3 KiB
Scheme
47 lines
1.3 KiB
Scheme
|
; Copyright (c) 1993, 1994 Richard Kelsey and Jonathan Rees. See file COPYING.
|
||
|
|
|
||
|
|
|
||
|
|
; ,open interfaces packages meta-types sort syntactic
|
||
|
|
; ,config scheme
|
||
|
|
|
||
|
|
(define (list-interface thing)
|
||
|
|
(cond ((structure? thing)
|
||
|
|
(list-interface-1 (structure-interface thing)
|
||
|
|
(lambda (name)
|
||
|
|
(let ((x (structure-lookup thing name #t)))
|
||
|
|
(if (binding? x)
|
||
|
|
(binding-type x)
|
||
|
|
#f)))))
|
||
|
|
((interface? thing)
|
||
|
|
(list-interface-1 thing (lambda (name)
|
||
|
|
(interface-ref thing name))))
|
||
|
|
(else '?)))
|
||
|
|
|
||
|
|
(define (list-interface-1 int lookup)
|
||
|
|
(let ((l '()))
|
||
|
|
(for-each-declaration (lambda (name type)
|
||
|
|
(if (not (memq name l)) ;compound signatures...
|
||
|
|
(set! l (cons name l))))
|
||
|
|
int)
|
||
|
|
(for-each (lambda (name)
|
||
|
|
(write name)
|
||
|
|
(display (make-string
|
||
|
|
(max 0 (- 25 (string-length
|
||
|
|
(symbol->string name))))
|
||
|
|
#\space))
|
||
|
|
(write-char #\space)
|
||
|
|
(write (careful-type->sexp (lookup name))) ;( ...)
|
||
|
|
(newline))
|
||
|
|
(sort-list l (lambda (name1 name2)
|
||
|
|
(string<? (symbol->string name1)
|
||
|
|
(symbol->string name2)))))))
|
||
|
|
|
||
|
|
(define (careful-type->sexp thing)
|
||
|
|
(cond ((not thing) 'undefined)
|
||
|
|
((or (symbol? thing) (null? thing) (number? thing))
|
||
|
|
thing) ;?
|
||
|
|
((pair? thing) ;e.g. (variable #{Type :value})
|
||
|
|
(cons (careful-type->sexp (car thing))
|
||
|
|
(careful-type->sexp (cdr thing))))
|
||
|
|
(else (type->sexp thing #t))))
|