Traverse indirect procedure signatures via applied references.

This commit is contained in:
Alex Shinn 2014-07-29 22:00:25 +09:00
parent 89e5c7f87d
commit 07d2c8333b
2 changed files with 26 additions and 7 deletions

View file

@ -709,9 +709,19 @@ div#footer {padding-bottom: 50px}
(cur (collect)) (cur (collect))
(ids (append (get-ids cur) ids))) (ids (append (get-ids cur) ids)))
;; ";;/" attaches the docs to the preceding form ;; ";;/" attaches the docs to the preceding form
(if (equal? line "/") ;; rather than the next
(lp '() '() (append cur res) ids depth last-line) (cond
(lp '() cur res ids depth last-line)))))) ((equal? line "/")
(lp '() '() (append cur res) ids depth last-line))
(else
(cond
((and (not (equal? line ""))
(eqv? #\/ (string-ref line 0)))
(display "WARNING: ;;/ line should be empty"
(current-error-port))
(write line (current-error-port))
(newline (current-error-port))))
(lp '() cur res ids depth last-line)))))))
((eqv? #\) (peek-char in)) ((eqv? #\) (peek-char in))
(read-char in) (read-char in)
(if (zero? depth) (if (zero? depth)

View file

@ -307,11 +307,20 @@
(define (procedure-signature x . o) (define (procedure-signature x . o)
(define (ast-sig x) (define (ast-sig x)
(cond (cond
((lambda? x) (cdr (lambda-type x))) ((lambda? x)
(cons (lambda-return-type x)
(if (pair? (lambda-param-types x))
(lambda-param-types x)
(lambda-params x))))
((seq? x) (ast-sig (last (seq-ls x)))) ((seq? x) (ast-sig (last (seq-ls x))))
((and (pair? x) (lambda? (car x))) (ast-sig (lambda-body x))) ((and (pair? x) (lambda? (car x))) (ast-sig (lambda-body (car x))))
;; ((and (pair? x) (ref? (car x)) (lambda? (cdr (ref-cell (car x))))) ;; TODO: improve the type inference so this isn't needed
;; (ast-sig (lambda-body (cdr (ref-cell (car x)))))) ((and (pair? x) (ref? (car x))
(pair? o) (apply procedure-analysis (ref-name (car x)) o))
=> (lambda (lam)
(and (lambda? lam)
(or (lambda-return-type lam)
(ast-sig (lambda-body lam))))))
(else #f))) (else #f)))
(cond (cond
((opcode? x) ((opcode? x)