1;; cross refference
2
3(defmodule cross
4    ;; dasta ((name1 ref1 ref2 ... refn) (name2 ref1 ref2 ... refn)
5    (defglobal functions nil)
6    (defglobal globalvars nil)
7    (defglobal dynamicvars nil)
8    (defpublic cross (fn)
9        (let ((instream (open-input-file fn))
10              (sexp nil) )
11           (setq functions nil)
12           (setq globalvars nil)
13           (setq dynamicvars nil)
14           (while (setq sexp (read instream nil nil))
15              (analize sexp))
16           (close instream))
17        (format (standard-output) "---Function called-by---~%")
18        (display (reverse functions))
19        (format (standard-output) "---Global-var referrd-by---~%")
20        (display (reverse globalvars))
21        (format (standard-output) "---Dynamic-var refferd-by---~%")
22        (display (reverse dynamicvars))
23        t)
24
25    (defun display (x)
26        (cond ((null x) t)
27              (t (format (standard-output) "~A~%" (car x)) (display (cdr x)))))
28
29
30    (defun analize (x)
31        (cond ((eq (car x) 'defun)
32               (reg-fun (elt x 1))
33               (analize-defun (cdr (cdr (cdr x))) (elt x 1)))
34              ((eq (car x) 'defglobal) (reg-global (elt x 1)))
35              ((eq (car x) 'defdynamic) (reg-dynamic (elt x 1)))
36              ((eq (car x) 'defmodule) (analize-defmodule (cdr (cdr x))))
37              ((eq (car x) 'import) (eval x))))
38
39
40    (defun analize-defun (x fun)
41        (cond ((null x) t)
42              (t (analize-sexp (car x) fun) (analize-defun (cdr x) fun))))
43
44
45    (defun analize-defmodule (x)
46        (cond ((null x) t)
47              (t (analize (car x)) (analize-defmodule (cdr x)))))
48
49
50    (defun analize-sexp (x fun)
51        (cond ((null x) t)
52              ((and (atom x) (assoc x globalvars)) (add-global-ref fun x))
53              ((and (atom x) (assoc x dynamicvars)) (add-dynamic-ref fun x))
54              ((atom x) t)
55              ((subrp (car x)) (analize-args (cdr x) fun))
56              ((eq (car x) 'if) (analize-if (cdr x) fun))
57              ((eq (car x) 'cond) (analize-cond (cdr x) fun))
58              ((eq (car x) 'let) (analize-let (cdr x) fun))
59              ((eq (car x) 'let*) (analize-let (cdr x) fun))
60              ((eq (car x) 'quote) t)
61              ((eq (car x) 'setq) (analize-sexp (elt x 2) fun))
62              ((eq (car x) 'while) (analize-sexp (elt x 1) fun) (analize-progn (cdr (cdr x)) fun))
63              ((eq (car x) 'or) (analize-args (cdr x) fun))
64              ((eq (car x) 'and) (analize-args (cdr x) fun))
65              ((eq (car x) 'the) t)
66              ((eq (car x) 'catch) (analize-sexp (elt x 2) fun))
67              ((eq (car x) 'throw) t)
68              ((eq (car x) 'block) (analize-progn (cdr (cdr x)) fun))
69              ((eq (car x) 'return-from) t)
70              ((eq (car x) 'progn) (analize-progn (cdr x) fun))
71              ((eq (car x) 'lambda) (analize-progn (cdr (cdr x)) fun))
72              ((eq (car x) 'for) (analize-progn (cdr (cdr (cdr x))) fun))
73              ((eq (car x) 'labels) t)
74              ((eq (car x) 'flet) t)
75              ((eq (car x) 'setf) (analize-args (cdr x) fun))
76              ((eq (car x) 'convert) t)
77              ((eq (car x) 'dynamic) (add-dynamic-ref (elt x 1) fun))
78              ((eq (car x) 'import) t)
79              ((macrop (car x)) (analize-sexp (macroexpand-all x) fun))
80              (t (add-fun-ref (car x) fun) (analize-args (cdr x) fun))))
81
82    (defun analize-if (x fun)
83        (cond ((= (length x) 3)
84               (analize-sexp (elt x 0) fun)
85               (analize-sexp (elt x 1) fun)
86               (analize-sexp (elt x 2) fun))
87              (t (analize-sexp (elt x 0) fun) (analize-sexp (elt x 1) fun))))
88
89
90    (defun analize-cond (x fun)
91        (cond ((null x) t)
92              (t (analize-args (car x) fun) (analize-cond (cdr x) fun))))
93
94
95    (defun analize-let (x fun)
96        (analize-cond (elt x 0) fun)
97        (analize-progn (cdr x) fun))
98
99
100    (defun analize-progn (x fun)
101        (cond ((null x) t)
102              (t (analize-sexp (car x) fun) (analize-progn (cdr x) fun))))
103
104
105    (defun analize-args (x fun)
106        (cond ((null x) t)
107              (t (analize-sexp (car x) fun) (analize-args (cdr x) fun))))
108
109    (defun reg-fun (x)
110        (if (assoc x functions)
111            t
112            (setq functions (cons (cons x nil) functions))))
113
114    (defun reg-fun1 (x y)
115        (setq functions (cons (list x y) functions)))
116
117
118    (defun reg-global (x)
119        (if (member x globalvars)
120            t
121            (setq globalvars (cons (cons x nil) globalvars))))
122
123    (defun reg-dynamic (x)
124        (if (member x dynamicvars)
125            t
126            (setq dynamicvars (cons (cons x nil) dynamicvars))))
127
128
129    (defun add-fun-ref (x fun)
130        (let ((dt (assoc x functions)))
131           (cond ((null dt) (reg-fun1 x fun))
132                 ((member fun dt) t)
133                 (t (add-ref dt fun)))))
134
135
136    (defun add-ref (dt x)
137        (cond ((null (cdr dt)) (set-cdr (list x) dt))
138              (t (add-ref (cdr dt) x))))
139
140
141    (defun add-global-ref (x var)
142        (let ((dt (assoc var globalvars)))
143           (cond ((member x dt) t)
144                 (t (add-ref dt x)))))
145
146
147    (defun add-dynamic-ref (x var)
148        (let ((dt (assoc var dynamicvars)))
149           (cond ((member x dt) t)
150                 (t (add-ref dt x)))))
151
152)
153