Megatest

Diff
Login

Differences From Artifact [0604c01fa9]:

To Artifact [0b3bf4b4d7]:


127
128
129
130
131
132
133
134
135
136
137
138
139
140
141












142



                                        #f))
                                  atoms))))
                   (list proc file calls)))
               all-procs+file+atoms))
         (callers (get-callers-alist all-procs+file+calls))) ;; this is a handy cross-reference of callees to callers.  could be used elsewhere
    callers))

(define (main)
  (let* ((all-scm-files (glob "*.scm"))
         (xref (get-xref all-scm-files))
         (dangling-procs
          (map car (filter (lambda (x) (equal? 1 (length x))) xref))))
    (for-each print dangling-procs) ;; our product.
    ))













(main)










|







>
>
>
>
>
>
>
>
>
>
>
>
|
>
>
>
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
                                        #f))
                                  atoms))))
                   (list proc file calls)))
               all-procs+file+atoms))
         (callers (get-callers-alist all-procs+file+calls))) ;; this is a handy cross-reference of callees to callers.  could be used elsewhere
    callers))

(define (show-danglers)
  (let* ((all-scm-files (glob "*.scm"))
         (xref (get-xref all-scm-files))
         (dangling-procs
          (map car (filter (lambda (x) (equal? 1 (length x))) xref))))
    (for-each print dangling-procs) ;; our product.
    ))

(define (traceback-proc procname)
  (let* ((all-scm-files (glob "*.scm"))
         (xref (get-xref all-scm-files))
         (lookup (lambda (path procname depth)
                   (let* ((upcone (alist-ref procname xref equal? '()))
                          (uppath (conc procname "/" path))
                          (updepth (add1 depth)))
                     (if (null? upcode) (print uppath))
                     (for-each (lambda (x)
                                 (lookup uppath x updepth) )
                               upcone)))))
    (lookup "." procname 0)))


;(traceback-proc "run:run-tests")