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