mirror of
https://github.com/ashinn/chibi-scheme.git
synced 2025-05-20 06:09:18 +02:00
Traverse indirect procedure signatures via applied references.
This commit is contained in:
parent
89e5c7f87d
commit
07d2c8333b
2 changed files with 26 additions and 7 deletions
|
@ -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)
|
||||||
|
|
|
@ -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)
|
||||||
|
|
Loading…
Add table
Reference in a new issue