suzanne.soy/hyper-literate
1
0
Fork 0
Code Issues 4 Pull Requests 1 Actions Packages Projects Releases Wiki Activity

use new 'serialized=?' to tighten setup scribble fixpoint

Browse Source 
svn: r10428

original commit: 3f60a478ad5e955a723d34ca970060652279fd13
This commit is contained in:
Matthew Flatt 2008-06-23 19:28:08 +00:00
parent ab1949f40e
commit 0ffd48ae5e
1 changed files with 86 additions and 76 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

24
collects/scribble/search.ss
View File

@ -58,13 +58,14 @@
(let ([seen (make-hasheq)] (let ([seen (make-hasheq)]
[search-key #f]) [search-key #f])
(let loop ([queue (list (list (caddr b) (cadddr b) (list-ref b 4) (list-ref b 5) (list-ref b 6)))] (let loop ([queue (list (list (caddr b) (cadddr b) (list-ref b 4) (list-ref b 5) (list-ref b 6)))]
[rqueue null]) [rqueue null]
[need-result? #t])
(cond (cond
[(null? queue) [(null? queue)
(if (null? rqueue) (if (null? rqueue)
;; Not documented ;; Not documented
#f #f
(loop (reverse rqueue) null))] (loop (reverse rqueue) null need-result?))]
[else [else
(let ([mod (list-ref (car queue) 0)] (let ([mod (list-ref (car queue) 0)]
[id (list-ref (car queue) 1)] [id (list-ref (car queue) 1)]
@ -80,15 +81,21 @@
(not search-key)) (not search-key))
(set! search-key eb)) (set! search-key eb))
(let ([v (and eb (resolve-search search-key part ri `(dep ,eb)))]) (let ([v (and eb (resolve-search search-key part ri `(dep ,eb)))])
(or (and v (let* ([here-result
(and need-result?
v
(let ([v (resolve-get/tentative part ri `(form ,eb))]) (let ([v (resolve-get/tentative part ri `(form ,eb))])
(or (and v `(form ,eb)) (or (and v `(form ,eb))
`(def ,eb)))) `(def ,eb))))]
[need-result? (and need-result? (not here-result))])
;; Even if we've found `here-result', look deeper so that we have
;; consistent `dep' results.
(let ([nest-result
;; Maybe it's re-exported from this module... ;; Maybe it's re-exported from this module...
;; Try a shortcut: ;; Try a shortcut:
(if (eq? rmp (and (car b) (module-path-index-resolve (car b)))) (if (eq? rmp (and (car b) (module-path-index-resolve (car b))))
;; Not defined through this path, so keep looking ;; Not defined through this path, so keep looking
(loop queue rqueue) (loop queue rqueue need-result?)
;; Check parents, if we can get the source: ;; Check parents, if we can get the source:
(if (and (path? (resolved-module-path-name rmp)) (if (and (path? (resolved-module-path-name rmp))
(not (hash-ref seen rmp #f))) (not (hash-ref seen rmp #f)))
@ -142,7 +149,8 @@
0 0
0))) 0)))
(cadr a)) (cadr a))
rqueue)) rqueue)
need-result?)
(begin (begin
;; A dead end may not be our fault: the files could ;; A dead end may not be our fault: the files could
;; have changed in inconsistent ways. So just say #f ;; have changed in inconsistent ways. So just say #f
@ -153,4 +161,6 @@
id) id)
#f)))) #f))))
;; Can't get the module source, so continue with queue: ;; Can't get the module source, so continue with queue:
(loop queue rqueue)))))))]))))))) (loop queue rqueue need-result?)))])
(or here-result
nest-result))))))])))))))