Artifact
85429a3289d3fe6bbbd6c2226653a2acaf7004df:
0000: 0a 3b 3b 20 67 6f 74 74 61 20 63 6f 6d 70 69 6c .;; gotta compil
0010: 65 20 77 69 74 68 20 63 73 63 2c 20 64 6f 65 73 e with csc, does
0020: 6e 27 74 20 77 6f 72 6b 20 77 69 74 68 20 63 73 n't work with cs
0030: 69 20 2d 73 20 66 6f 72 20 77 68 61 74 65 76 65 i -s for whateve
0040: 72 20 72 65 61 73 6f 6e 0a 0a 28 75 73 65 20 73 r reason..(use s
0050: 72 66 69 2d 36 39 29 0a 28 75 73 65 20 6d 61 74 rfi-69).(use mat
0060: 63 68 61 62 6c 65 29 0a 28 75 73 65 20 75 74 69 chable).(use uti
0070: 6c 73 29 0a 28 75 73 65 20 70 6f 72 74 73 29 0a ls).(use ports).
0080: 28 75 73 65 20 65 78 74 72 61 73 29 0a 28 75 73 (use extras).(us
0090: 65 20 73 72 66 69 2d 31 29 0a 28 75 73 65 20 70 e srfi-1).(use p
00a0: 6f 73 69 78 29 0a 28 75 73 65 20 73 72 66 69 2d osix).(use srfi-
00b0: 31 32 29 0a 0a 3b 3b 20 74 75 72 6e 20 73 63 68 12)..;; turn sch
00c0: 65 6d 65 20 66 69 6c 65 20 74 6f 20 61 20 6c 69 eme file to a li
00d0: 73 74 20 6f 66 20 73 65 78 70 73 2c 20 73 65 78 st of sexps, sex
00e0: 70 73 20 6f 66 20 69 6e 74 65 72 65 73 74 20 77 ps of interest w
00f0: 69 6c 6c 20 62 65 20 69 6e 20 74 68 65 20 66 6f ill be in the fo
0100: 72 6d 20 6f 66 20 28 64 65 66 69 6e 65 20 28 3c rm of (define (<
0110: 70 72 6f 63 6e 61 6d 65 3e 20 3c 61 72 67 73 3e procname> <args>
0120: 29 20 3c 62 6f 64 79 3e 20 29 0a 28 64 65 66 69 ) <body> ).(defi
0130: 6e 65 20 28 6c 6f 61 64 2d 73 63 6d 2d 66 69 6c ne (load-scm-fil
0140: 65 20 73 63 6d 2d 66 69 6c 65 29 0a 20 20 3b 3b e scm-file). ;;
0150: 28 70 72 69 6e 74 20 22 6c 6f 61 64 20 22 73 63 (print "load "sc
0160: 6d 2d 66 69 6c 65 29 0a 20 20 28 68 61 6e 64 6c m-file). (handl
0170: 65 2d 65 78 63 65 70 74 69 6f 6e 73 0a 20 20 20 e-exceptions.
0180: 65 78 6e 0a 20 20 20 27 28 29 0a 20 20 20 28 77 exn. '(). (w
0190: 69 74 68 2d 69 6e 70 75 74 2d 66 72 6f 6d 2d 73 ith-input-from-s
01a0: 74 72 69 6e 67 0a 20 20 20 20 20 20 20 28 63 6f tring. (co
01b0: 6e 63 20 22 28 22 0a 20 20 20 20 20 20 20 20 20 nc "(".
01c0: 20 20 20 20 28 77 69 74 68 2d 69 6e 70 75 74 2d (with-input-
01d0: 66 72 6f 6d 2d 66 69 6c 65 20 73 63 6d 2d 66 69 from-file scm-fi
01e0: 6c 65 20 72 65 61 64 2d 61 6c 6c 29 0a 20 20 20 le read-all).
01f0: 20 20 20 20 20 20 20 20 20 20 22 29 22 20 29 0a ")" ).
0200: 20 20 20 20 20 72 65 61 64 29 29 29 0a 0a 3b 3b read)))..;;
0210: 20 65 78 74 72 61 63 74 20 61 20 6c 69 73 74 20 extract a list
0220: 6f 66 20 70 72 6f 63 6e 61 6d 65 2c 20 66 69 6c of procname, fil
0230: 65 6e 61 6d 65 2c 20 61 72 67 73 20 61 6e 64 20 ename, args and
0240: 62 6f 64 79 20 6f 66 20 70 72 6f 63 65 64 75 72 body of procedur
0250: 65 73 20 64 65 66 69 6e 65 64 20 69 6e 20 66 69 es defined in fi
0260: 6c 65 6e 61 6d 65 2c 20 69 6e 70 75 74 20 66 72 lename, input fr
0270: 6f 6d 20 6c 6f 61 64 2d 73 63 6d 2d 66 69 6c 65 om load-scm-file
0280: 0a 3b 3b 20 20 20 2d 2d 20 62 65 20 61 64 76 69 .;; -- be advi
0290: 73 65 64 3a 0a 3b 3b 20 20 20 20 20 20 2a 20 74 sed:.;; * t
02a0: 68 69 73 20 6d 61 79 20 62 65 20 66 6f 6f 6c 65 his may be foole
02b0: 64 20 62 79 20 6d 61 63 72 6f 73 2c 20 73 69 6e d by macros, sin
02c0: 63 65 20 74 68 69 73 20 63 6f 64 65 20 64 6f 65 ce this code doe
02d0: 73 20 6e 6f 74 20 74 61 6b 65 20 74 68 65 6d 20 s not take them
02e0: 69 6e 74 6f 20 61 63 63 6f 75 6e 74 2e 0a 3b 3b into account..;;
02f0: 20 20 20 20 20 20 2a 20 74 68 69 73 20 63 6f 64 * this cod
0300: 65 20 64 6f 65 73 20 6f 6e 6c 79 20 63 68 65 63 e does only chec
0310: 6b 73 20 66 6f 72 20 66 6f 72 6d 20 28 64 65 66 ks for form (def
0320: 69 6e 65 20 28 3c 70 72 6f 63 6e 61 6d 65 3e 20 ine (<procname>
0330: 2e 2e 2e 20 29 20 3c 62 6f 64 79 3e 29 0a 3b 3b ... ) <body>).;;
0340: 20 20 20 20 20 20 20 20 20 20 20 73 6f 20 69 74 so it
0350: 20 65 78 63 6c 75 64 65 73 20 66 72 6f 6d 20 72 excludes from r
0360: 65 63 6b 6f 6e 69 6e 67 0a 3b 3b 20 20 20 20 20 eckoning.;;
0370: 20 20 20 20 20 20 20 20 20 20 2d 20 67 65 6e 65 - gene
0380: 72 61 74 65 64 20 66 75 6e 63 74 69 6f 6e 73 2c rated functions,
0390: 20 61 73 20 69 6e 20 74 68 69 6e 67 73 20 6c 69 as in things li
03a0: 6b 65 20 66 6f 6f 2d 73 65 74 21 20 66 72 6f 6d ke foo-set! from
03b0: 20 64 65 66 73 74 72 75 63 74 73 2c 0a 3b 3b 20 defstructs,.;;
03c0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 2d 20 -
03d0: 64 65 66 69 6e 65 2d 69 6e 6c 69 6e 65 2c 20 28 define-inline, (
03e0: 0a 3b 3b 20 20 20 20 20 20 20 20 20 20 20 20 20 .;;
03f0: 20 20 2d 20 64 65 66 69 6e 65 20 70 72 6f 63 6e - define procn
0400: 61 6d 65 20 28 6c 61 6d 62 64 61 20 2e 2e 0a 3b ame (lambda ...;
0410: 3b 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 ;
0420: 2d 20 65 74 63 2e 2e 2e 0a 28 64 65 66 69 6e 65 - etc....(define
0430: 20 28 67 65 74 2d 74 6f 70 6c 65 76 65 6c 2d 70 (get-toplevel-p
0440: 72 6f 63 73 2b 66 69 6c 65 2b 61 72 67 73 2b 62 rocs+file+args+b
0450: 6f 64 79 20 66 69 6c 65 6e 61 6d 65 29 0a 20 20 ody filename).
0460: 28 6c 65 74 2a 20 28 28 73 63 6d 2d 74 72 65 65 (let* ((scm-tree
0470: 20 28 6c 6f 61 64 2d 73 63 6d 2d 66 69 6c 65 20 (load-scm-file
0480: 66 69 6c 65 6e 61 6d 65 29 29 0a 20 20 20 20 20 filename)).
0490: 20 20 20 20 28 70 72 6f 63 73 0a 20 20 20 20 20 (procs.
04a0: 20 20 20 20 20 28 66 69 6c 74 65 72 20 69 64 65 (filter ide
04b0: 6e 74 69 74 79 0a 20 20 20 20 20 20 20 20 20 20 ntity.
04c0: 20 20 20 20 20 20 20 20 28 6d 61 70 0a 20 20 20 (map.
04d0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
04e0: 28 6d 61 74 63 68 2d 6c 61 6d 62 64 61 20 0a 20 (match-lambda .
04f0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
0500: 20 20 20 5b 28 27 64 65 66 69 6e 65 20 28 27 75 [('define ('u
0510: 73 65 73 20 61 72 67 73 20 2e 2e 2e 29 20 62 6f ses args ...) bo
0520: 64 79 20 2e 2e 2e 29 20 23 66 5d 20 3b 3b 20 66 dy ...) #f] ;; f
0530: 69 6c 74 65 72 20 6f 75 74 20 28 64 65 66 69 6e ilter out (defin
0540: 65 20 28 75 73 65 73 20 2e 2e 2e 0a 20 20 20 20 e (uses ....
0550: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
0560: 5b 28 27 64 65 66 69 6e 65 20 28 27 75 6e 69 74 [('define ('unit
0570: 20 61 72 67 73 20 2e 2e 2e 29 20 62 6f 64 79 20 args ...) body
0580: 2e 2e 2e 29 20 23 66 5d 20 3b 3b 20 66 69 6c 74 ...) #f] ;; filt
0590: 65 72 20 6f 75 74 20 28 64 65 66 69 6e 65 20 28 er out (define (
05a0: 75 6e 69 74 20 2e 2e 2e 0a 20 20 20 20 20 20 20 unit ....
05b0: 20 20 20 20 20 20 20 20 20 20 20 20 20 5b 28 27 [('
05c0: 64 65 66 69 6e 65 20 28 27 70 72 65 66 69 78 20 define ('prefix
05d0: 61 72 67 73 20 2e 2e 2e 29 20 62 6f 64 79 20 2e args ...) body .
05e0: 2e 2e 29 20 23 66 5d 20 3b 3b 20 66 69 6c 74 65 ..) #f] ;; filte
05f0: 72 20 6f 75 74 20 28 64 65 66 69 6e 65 20 28 70 r out (define (p
0600: 72 65 66 69 78 20 2e 2e 2e 0a 20 20 20 20 20 20 refix ....
0610: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 5b 28 [(
0620: 27 64 65 66 69 6e 65 20 28 64 65 66 6e 61 6d 65 'define (defname
0630: 20 61 72 67 73 20 2e 2e 2e 29 20 62 6f 64 79 20 args ...) body
0640: 2e 2e 2e 29 20 3b 3b 20 6d 61 74 63 68 20 28 64 ...) ;; match (d
0650: 65 66 69 6e 65 20 28 70 72 6f 63 6e 61 6d 65 20 efine (procname
0660: 3c 61 72 67 73 3e 29 20 3c 62 6f 64 79 3e 29 0a <args>) <body>).
0670: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
0680: 20 20 20 20 20 28 69 66 20 28 61 74 6f 6d 3f 20 (if (atom?
0690: 64 65 66 6e 61 6d 65 29 20 3b 3b 20 66 69 6c 74 defname) ;; filt
06a0: 65 72 20 6f 75 74 20 74 68 69 6e 67 73 20 77 65 er out things we
06b0: 20 64 6f 6e 74 20 75 6e 64 65 72 73 74 61 6e 64 dont understand
06c0: 20 28 70 72 6f 63 6e 61 6d 65 20 69 73 20 61 20 (procname is a
06d0: 6c 69 73 74 2c 20 77 68 61 74 3f 3f 29 0a 20 20 list, what??).
06e0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
06f0: 20 20 20 20 20 20 20 28 6c 69 73 74 20 64 65 66 (list def
0700: 6e 61 6d 65 20 66 69 6c 65 6e 61 6d 65 20 61 72 name filename ar
0710: 67 73 20 62 6f 64 79 29 0a 20 20 20 20 20 20 20 gs body).
0720: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
0730: 20 20 23 66 29 5d 0a 20 20 20 20 20 20 20 20 20 #f)].
0740: 20 20 20 20 20 20 20 20 20 20 20 5b 65 6c 73 65 [else
0750: 20 23 66 5d 20 29 20 73 63 6d 2d 74 72 65 65 29 #f] ) scm-tree)
0760: 29 29 29 0a 20 20 20 20 70 72 6f 63 73 29 29 0a ))). procs)).
0770: 0a 0a 3b 3b 20 67 69 76 65 6e 20 61 20 73 65 78 ..;; given a sex
0780: 70 2c 20 72 65 74 75 72 6e 20 61 20 66 6c 61 74 p, return a flat
0790: 20 6c 6f 73 74 20 6f 66 20 61 74 6f 6d 73 20 69 lost of atoms i
07a0: 6e 20 74 68 61 74 20 73 65 78 70 0a 28 64 65 66 n that sexp.(def
07b0: 69 6e 65 20 28 67 65 74 2d 61 74 6f 6d 73 2d 69 ine (get-atoms-i
07c0: 6e 2d 62 6f 64 79 20 62 6f 64 79 29 0a 20 20 28 n-body body). (
07d0: 63 6f 6e 64 0a 20 20 20 28 28 6e 75 6c 6c 3f 20 cond. ((null?
07e0: 62 6f 64 79 29 20 27 28 29 29 0a 20 20 20 28 28 body) '()). ((
07f0: 61 74 6f 6d 3f 20 62 6f 64 79 29 20 28 6c 69 73 atom? body) (lis
0800: 74 20 62 6f 64 79 29 29 0a 20 20 20 28 65 6c 73 t body)). (els
0810: 65 0a 20 20 20 20 28 61 70 70 6c 79 20 61 70 70 e. (apply app
0820: 65 6e 64 20 28 6d 61 70 20 67 65 74 2d 61 74 6f end (map get-ato
0830: 6d 73 2d 69 6e 2d 62 6f 64 79 20 62 6f 64 79 29 ms-in-body body)
0840: 29 29 29 29 0a 0a 3b 3b 20 20 67 69 76 65 6e 20 ))))..;; given
0850: 61 20 66 69 6c 65 2c 20 72 65 74 75 72 6e 20 61 a file, return a
0860: 20 6c 69 73 74 20 6f 66 20 70 72 6f 63 6e 61 6d list of procnam
0870: 65 2c 20 66 69 6c 65 2c 20 6c 69 73 74 20 6f 66 e, file, list of
0880: 20 61 74 6f 6d 73 20 69 6e 20 73 61 69 64 20 70 atoms in said p
0890: 72 6f 63 6e 61 6d 65 0a 28 64 65 66 69 6e 65 20 rocname.(define
08a0: 28 67 65 74 2d 70 72 6f 63 73 2b 66 69 6c 65 2b (get-procs+file+
08b0: 61 74 6f 6d 73 20 66 69 6c 65 29 0a 20 20 28 6c atoms file). (l
08c0: 65 74 2a 20 28 28 74 6f 70 6c 65 76 65 6c 2d 70 et* ((toplevel-p
08d0: 72 6f 63 2d 69 74 65 6d 73 20 28 67 65 74 2d 74 roc-items (get-t
08e0: 6f 70 6c 65 76 65 6c 2d 70 72 6f 63 73 2b 66 69 oplevel-procs+fi
08f0: 6c 65 2b 61 72 67 73 2b 62 6f 64 79 20 66 69 6c le+args+body fil
0900: 65 29 29 0a 20 20 20 20 20 20 20 20 20 28 72 65 e)). (re
0910: 73 0a 20 20 20 20 20 20 20 20 20 20 28 6d 61 70 s. (map
0920: 0a 20 20 20 20 20 20 20 20 20 20 20 28 6c 61 6d . (lam
0930: 62 64 61 20 28 69 74 65 6d 29 0a 20 20 20 20 20 bda (item).
0940: 20 20 20 20 20 20 20 20 28 6c 65 74 2a 20 28 28 (let* ((
0950: 70 72 6f 63 20 28 63 61 72 20 69 74 65 6d 29 29 proc (car item))
0960: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
0970: 20 20 20 20 20 28 66 69 6c 65 20 28 63 61 64 72 (file (cadr
0980: 20 69 74 65 6d 29 29 0a 20 20 20 20 20 20 20 20 item)).
0990: 20 20 20 20 20 20 20 20 20 20 20 20 28 61 72 67 (arg
09a0: 73 20 28 63 61 64 64 72 20 69 74 65 6d 29 29 0a s (caddr item)).
09b0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
09c0: 20 20 20 20 28 62 6f 64 79 20 28 63 61 64 64 64 (body (caddd
09d0: 72 20 69 74 65 6d 29 29 0a 20 20 20 20 20 20 20 r item)).
09e0: 20 20 20 20 20 20 20 20 20 20 20 20 20 28 61 74 (at
09f0: 6f 6d 73 20 28 61 70 70 65 6e 64 20 28 67 65 74 oms (append (get
0a00: 2d 61 74 6f 6d 73 2d 69 6e 2d 62 6f 64 79 20 61 -atoms-in-body a
0a10: 72 67 73 29 20 28 67 65 74 2d 61 74 6f 6d 73 2d rgs) (get-atoms-
0a20: 69 6e 2d 62 6f 64 79 20 62 6f 64 79 29 29 29 29 in-body body))))
0a30: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
0a40: 28 6c 69 73 74 20 70 72 6f 63 20 66 69 6c 65 20 (list proc file
0a50: 61 74 6f 6d 73 29 29 29 0a 20 20 20 20 20 20 20 atoms))).
0a60: 20 20 20 20 74 6f 70 6c 65 76 65 6c 2d 70 72 6f toplevel-pro
0a70: 63 2d 69 74 65 6d 73 29 29 29 0a 20 20 20 20 72 c-items))). r
0a80: 65 73 29 29 0a 0a 3b 3b 20 75 6e 69 71 75 69 66 es))..;; uniquif
0a90: 79 20 61 20 6c 69 73 74 20 6f 66 20 61 74 6f 6d y a list of atom
0aa0: 73 20 0a 28 64 65 66 69 6e 65 20 28 75 6e 69 71 s .(define (uniq
0ab0: 75 65 2d 61 74 6f 6d 73 20 6c 73 74 29 0a 20 20 ue-atoms lst).
0ac0: 28 6c 65 74 20 6c 6f 6f 70 20 28 28 6c 73 74 20 (let loop ((lst
0ad0: 28 66 6c 61 74 74 65 6e 20 6c 73 74 29 29 20 28 (flatten lst)) (
0ae0: 72 65 73 20 27 28 29 29 29 0a 20 20 20 20 28 69 res '())). (i
0af0: 66 20 28 6e 75 6c 6c 3f 20 6c 73 74 29 0a 20 20 f (null? lst).
0b00: 20 20 20 20 20 20 28 72 65 76 65 72 73 65 20 72 (reverse r
0b10: 65 73 29 0a 20 20 20 20 20 20 20 20 28 6c 65 74 es). (let
0b20: 20 28 28 63 20 28 63 61 72 20 6c 73 74 29 29 29 ((c (car lst)))
0b30: 0a 20 20 20 20 20 20 20 20 20 20 28 6c 6f 6f 70 . (loop
0b40: 20 28 63 64 72 20 6c 73 74 29 20 28 69 66 20 28 (cdr lst) (if (
0b50: 6d 65 6d 62 65 72 20 63 20 72 65 73 29 20 72 65 member c res) re
0b60: 73 20 28 63 6f 6e 73 20 63 20 72 65 73 29 29 29 s (cons c res)))
0b70: 29 29 29 29 0a 0a 3b 3b 20 67 69 76 65 6e 20 61 ))))..;; given a
0b80: 20 6c 69 73 74 20 6f 66 20 70 72 6f 63 6e 61 6d list of procnam
0b90: 65 2c 20 66 69 6c 65 6e 61 6d 65 2c 20 6c 69 73 e, filename, lis
0ba0: 74 20 6f 66 20 70 72 6f 63 73 20 63 61 6c 6c 65 t of procs calle
0bb0: 64 20 66 72 6f 6d 20 70 72 6f 63 6e 61 6d 65 2c d from procname,
0bc0: 20 63 72 6f 73 73 20 72 65 66 65 72 65 6e 63 65 cross reference
0bd0: 20 61 6e 64 20 72 65 76 65 72 73 65 0a 3b 3b 20 and reverse.;;
0be0: 72 65 74 75 72 6e 69 6e 67 20 61 6c 69 73 74 20 returning alist
0bf0: 6d 61 70 70 69 6e 67 20 70 72 6f 63 6e 61 6d 65 mapping procname
0c00: 20 74 6f 20 70 72 6f 63 6e 61 6d 65 20 74 68 61 to procname tha
0c10: 74 20 63 61 6c 6c 73 20 73 61 69 64 20 70 72 6f t calls said pro
0c20: 63 6e 61 6d 65 0a 28 64 65 66 69 6e 65 20 28 67 cname.(define (g
0c30: 65 74 2d 63 61 6c 6c 65 72 73 2d 61 6c 69 73 74 et-callers-alist
0c40: 20 61 6c 6c 2d 70 72 6f 63 73 2b 66 69 6c 65 2b all-procs+file+
0c50: 63 61 6c 6c 73 29 0a 20 20 28 6c 65 74 2a 20 28 calls). (let* (
0c60: 28 61 6c 6c 2d 70 72 6f 63 73 20 28 6d 61 70 20 (all-procs (map
0c70: 63 61 72 20 61 6c 6c 2d 70 72 6f 63 73 2b 66 69 car all-procs+fi
0c80: 6c 65 2b 63 61 6c 6c 73 29 29 0a 20 20 20 20 20 le+calls)).
0c90: 20 20 20 20 28 63 61 6c 6c 65 72 2d 68 74 20 28 (caller-ht (
0ca0: 6d 61 6b 65 2d 68 61 73 68 2d 74 61 62 6c 65 29 make-hash-table)
0cb0: 29 29 20 0a 20 20 20 20 3b 3b 20 6c 65 74 27 73 )) . ;; let's
0cc0: 20 63 72 6f 73 73 20 72 65 66 65 72 65 6e 63 65 cross reference
0cd0: 20 77 69 74 68 20 61 20 68 61 73 68 20 74 61 62 with a hash tab
0ce0: 6c 65 0a 20 20 20 20 28 66 6f 72 2d 65 61 63 68 le. (for-each
0cf0: 20 28 6c 61 6d 62 64 61 20 28 70 72 6f 63 29 20 (lambda (proc)
0d00: 28 68 61 73 68 2d 74 61 62 6c 65 2d 73 65 74 21 (hash-table-set!
0d10: 20 63 61 6c 6c 65 72 2d 68 74 20 70 72 6f 63 20 caller-ht proc
0d20: 27 28 29 29 29 20 61 6c 6c 2d 70 72 6f 63 73 29 '())) all-procs)
0d30: 0a 20 20 20 20 28 66 6f 72 2d 65 61 63 68 20 28 . (for-each (
0d40: 6c 61 6d 62 64 61 20 28 69 74 65 6d 29 0a 20 20 lambda (item).
0d50: 20 20 20 20 20 20 20 20 20 20 20 20 20 28 6c 65 (le
0d60: 74 2a 20 28 28 70 72 6f 63 20 28 63 61 72 20 69 t* ((proc (car i
0d70: 74 65 6d 29 29 0a 20 20 20 20 20 20 20 20 20 20 tem)).
0d80: 20 20 20 20 20 20 20 20 20 20 20 20 28 66 69 6c (fil
0d90: 65 20 28 63 61 64 72 20 69 74 65 6d 29 29 0a 20 e (cadr item)).
0da0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
0db0: 20 20 20 20 20 28 63 61 6c 6c 73 20 28 63 61 64 (calls (cad
0dc0: 64 72 20 69 74 65 6d 29 29 29 0a 20 20 20 20 20 dr item))).
0dd0: 20 20 20 20 20 20 20 20 20 20 20 20 28 66 6f 72 (for
0de0: 2d 65 61 63 68 20 28 6c 61 6d 62 64 61 20 28 63 -each (lambda (c
0df0: 61 6c 6c 65 65 29 0a 20 20 20 20 20 20 20 20 20 allee).
0e00: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
0e10: 20 20 20 20 28 68 61 73 68 2d 74 61 62 6c 65 2d (hash-table-
0e20: 73 65 74 21 20 63 61 6c 6c 65 72 2d 68 74 20 63 set! caller-ht c
0e30: 61 6c 6c 65 65 0a 20 20 20 20 20 20 20 20 20 20 allee.
0e40: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
0e50: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
0e60: 20 20 20 20 28 63 6f 6e 73 20 70 72 6f 63 0a 20 (cons proc.
0e70: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
0e80: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
0e90: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
0ea0: 20 20 20 28 68 61 73 68 2d 74 61 62 6c 65 2d 72 (hash-table-r
0eb0: 65 66 20 63 61 6c 6c 65 72 2d 68 74 20 63 61 6c ef caller-ht cal
0ec0: 6c 65 65 29 29 29 29 0a 20 20 20 20 20 20 20 20 lee)))).
0ed0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
0ee0: 20 20 20 63 61 6c 6c 73 29 29 29 0a 20 20 20 20 calls))).
0ef0: 20 20 20 20 20 20 20 20 20 20 61 6c 6c 2d 70 72 all-pr
0f00: 6f 63 73 2b 66 69 6c 65 2b 63 61 6c 6c 73 29 0a ocs+file+calls).
0f10: 20 20 20 20 28 6d 61 70 20 28 6c 61 6d 62 64 61 (map (lambda
0f20: 20 28 78 29 0a 20 20 20 20 20 20 20 20 20 20 20 (x).
0f30: 28 6c 65 74 20 28 28 6b 20 28 63 61 72 20 78 29 (let ((k (car x)
0f40: 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 ).
0f50: 20 20 20 28 72 20 28 75 6e 69 71 75 65 2d 61 74 (r (unique-at
0f60: 6f 6d 73 20 28 63 64 72 20 78 29 29 29 29 0a 20 oms (cdr x)))).
0f70: 20 20 20 20 20 20 20 20 20 20 20 20 28 63 6f 6e (con
0f80: 73 20 6b 20 72 29 29 29 20 20 20 20 20 20 20 20 s k r)))
0f90: 20 20 20 20 20 20 20 20 20 20 20 20 0a 20 20 20 .
0fa0: 20 20 20 20 20 20 28 68 61 73 68 2d 74 61 62 6c (hash-tabl
0fb0: 65 2d 3e 61 6c 69 73 74 20 63 61 6c 6c 65 72 2d e->alist caller-
0fc0: 68 74 29 29 29 29 0a 0a 3b 3b 20 63 72 65 61 74 ht))))..;; creat
0fd0: 65 20 61 20 68 61 6e 64 79 20 63 72 6f 73 73 2d e a handy cross-
0fe0: 72 65 66 65 72 65 6e 63 65 20 6f 66 20 63 61 6c reference of cal
0ff0: 6c 65 65 73 20 74 6f 20 63 61 6c 6c 65 72 73 20 lees to callers
1000: 69 6e 20 74 68 65 20 66 6f 72 6d 20 6f 66 20 61 in the form of a
1010: 6e 20 61 6c 69 73 74 2e 0a 28 64 65 66 69 6e 65 n alist..(define
1020: 20 28 67 65 74 2d 78 72 65 66 20 61 6c 6c 2d 73 (get-xref all-s
1030: 63 6d 2d 66 69 6c 65 73 29 0a 20 20 28 6c 65 74 cm-files). (let
1040: 2a 20 28 28 61 6c 6c 2d 70 72 6f 63 73 2b 66 69 * ((all-procs+fi
1050: 6c 65 2b 61 74 6f 6d 73 0a 20 20 20 20 20 20 20 le+atoms.
1060: 20 20 20 28 61 70 70 6c 79 20 61 70 70 65 6e 64 (apply append
1070: 20 28 6d 61 70 20 67 65 74 2d 70 72 6f 63 73 2b (map get-procs+
1080: 66 69 6c 65 2b 61 74 6f 6d 73 20 61 6c 6c 2d 73 file+atoms all-s
1090: 63 6d 2d 66 69 6c 65 73 29 29 29 0a 20 20 20 20 cm-files))).
10a0: 20 20 20 20 20 28 61 6c 6c 2d 70 72 6f 63 73 20 (all-procs
10b0: 28 6d 61 70 20 63 61 72 20 61 6c 6c 2d 70 72 6f (map car all-pro
10c0: 63 73 2b 66 69 6c 65 2b 61 74 6f 6d 73 29 29 0a cs+file+atoms)).
10d0: 20 20 20 20 20 20 20 20 20 28 61 6c 6c 2d 70 72 (all-pr
10e0: 6f 63 73 2b 66 69 6c 65 2b 63 61 6c 6c 73 20 20 ocs+file+calls
10f0: 3b 20 70 72 6f 63 20 63 61 6c 6c 73 20 74 68 69 ; proc calls thi
1100: 6e 67 73 20 69 6e 20 63 61 6c 6c 73 20 6c 69 73 ngs in calls lis
1110: 74 0a 20 20 20 20 20 20 20 20 20 20 28 6d 61 70 t. (map
1120: 20 28 6c 61 6d 62 64 61 20 28 69 74 65 6d 29 0a (lambda (item).
1130: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
1140: 20 28 6c 65 74 2a 20 28 28 70 72 6f 63 20 28 63 (let* ((proc (c
1150: 61 72 20 69 74 65 6d 29 29 0a 20 20 20 20 20 20 ar item)).
1160: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
1170: 20 20 28 66 69 6c 65 20 28 63 61 64 72 20 69 74 (file (cadr it
1180: 65 6d 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 em)).
1190: 20 20 20 20 20 20 20 20 20 20 20 20 20 28 61 74 (at
11a0: 6f 6d 73 20 28 63 61 64 64 72 20 69 74 65 6d 29 oms (caddr item)
11b0: 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 ).
11c0: 20 20 20 20 20 20 20 20 20 20 28 63 61 6c 6c 73 (calls
11d0: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
11e0: 20 20 20 20 20 20 20 20 20 20 28 66 69 6c 74 65 (filte
11f0: 72 20 69 64 65 6e 74 69 74 79 0a 20 20 20 20 20 r identity.
1200: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
1210: 20 20 20 20 20 20 20 20 20 20 20 20 28 6d 61 70 (map
1220: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
1230: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
1240: 20 20 20 28 6c 61 6d 62 64 61 20 28 78 29 0a 20 (lambda (x).
1250: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
1260: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
1270: 20 20 20 28 69 66 20 28 61 6e 64 20 3b 3b 20 28 (if (and ;; (
1280: 6e 6f 74 20 28 65 71 75 61 6c 3f 20 78 20 70 72 not (equal? x pr
1290: 6f 63 29 29 20 20 3b 3b 20 75 6e 63 6f 6d 6d 65 oc)) ;; uncomme
12a0: 6e 74 20 74 6f 20 70 72 65 76 65 6e 74 20 6c 69 nt to prevent li
12b0: 73 74 69 6e 67 20 73 65 6c 66 0a 20 20 20 20 20 sting self.
12c0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
12d0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
12e0: 20 20 20 20 28 6d 65 6d 62 65 72 20 78 20 61 6c (member x al
12f0: 6c 2d 70 72 6f 63 73 29 29 0a 20 20 20 20 20 20 l-procs)).
1300: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
1310: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
1320: 20 20 78 0a 20 20 20 20 20 20 20 20 20 20 20 20 x.
1330: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
1340: 20 20 20 20 20 20 20 20 20 20 20 20 23 66 29 29 #f))
1350: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
1360: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
1370: 20 20 20 61 74 6f 6d 73 29 29 29 29 0a 20 20 20 atoms)))).
1380: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
1390: 28 6c 69 73 74 20 70 72 6f 63 20 66 69 6c 65 20 (list proc file
13a0: 63 61 6c 6c 73 29 29 29 0a 20 20 20 20 20 20 20 calls))).
13b0: 20 20 20 20 20 20 20 20 61 6c 6c 2d 70 72 6f 63 all-proc
13c0: 73 2b 66 69 6c 65 2b 61 74 6f 6d 73 29 29 0a 20 s+file+atoms)).
13d0: 20 20 20 20 20 20 20 20 28 63 61 6c 6c 65 72 73 (callers
13e0: 20 28 67 65 74 2d 63 61 6c 6c 65 72 73 2d 61 6c (get-callers-al
13f0: 69 73 74 20 61 6c 6c 2d 70 72 6f 63 73 2b 66 69 ist all-procs+fi
1400: 6c 65 2b 63 61 6c 6c 73 29 29 29 20 0a 20 20 20 le+calls))) .
1410: 20 63 61 6c 6c 65 72 73 29 29 0a callers)).