Changed the license to the AGPL3. Downcased all the lisp sources. Completed the READM...
[com-informatimago:com-informatimago.git] / cl-loaders / norvig-graph.lisp
1 ;;;; -*- coding:utf-8 -*-
2 ;;;;****************************************************************************
3 ;;;;FILE:               norvig-graph.lisp
4 ;;;;LANGUAGE:           Common-Lisp
5 ;;;;SYSTEM:             clisp
6 ;;;;USER-INTERFACE:     clisp
7 ;;;;DESCRIPTION
8 ;;;;    
9 ;;;;    This file extracts the requires sexps from the norvig sources and
10 ;;;;    builds a dependency graph to be displayed by dot(1).
11 ;;;;    
12 ;;;;AUTHORS
13 ;;;;    <PJB> Pascal Bourguignon
14 ;;;;MODIFICATIONS
15 ;;;;    2003-05-16 <PJB>  Created.
16 ;;;;BUGS
17 ;;;;LEGAL
18 ;;;;    AGPL3
19 ;;;;    
20 ;;;;    Copyright Pascal Bourguignon 2003 - 2003
21 ;;;;    
22 ;;;;    This program is free software: you can redistribute it and/or modify
23 ;;;;    it under the terms of the GNU Affero General Public License as published by
24 ;;;;    the Free Software Foundation, either version 3 of the License, or
25 ;;;;    (at your option) any later version.
26 ;;;;    
27 ;;;;    This program is distributed in the hope that it will be useful,
28 ;;;;    but WITHOUT ANY WARRANTY; without even the implied warranty of
29 ;;;;    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
30 ;;;;    GNU Affero General Public License for more details.
31 ;;;;    
32 ;;;;    You should have received a copy of the GNU Affero General Public License
33 ;;;;    along with this program.  If not, see <http://www.gnu.org/licenses/>.
34 ;;;;****************************************************************************
35
36
37 (load "PACKAGE:COM;INFORMATIMAGO;COMMON-LISP;GRAPH")
38 (load "PACKAGE:COM;INFORMATIMAGO;COMMON-LISP;GRAPH-DOT")
39 (load "PACKAGE:COM;INFORMATIMAGO;COMMON-LISP;LIST")
40 (load "PACKAGE:COM;INFORMATIMAGO;COMMON-LISP;UTILITY")
41 (use-package "COM.INFORMATIMAGO.COMMON-LISP.GRAPH")
42 (use-package "COM.INFORMATIMAGO.COMMON-LISP.GRAPH-DOT")
43 (use-package "COM.INFORMATIMAGO.COMMON-LISP.LIST")
44 (use-package "COM.INFORMATIMAGO.COMMON-LISP.UTILITY")
45
46 (defvar data)
47 (defvar g)
48
49 (setq data
50       (mapcan
51        (lambda (file)
52          (let ((requires
53                 (with-open-file (in file :direction :input)
54                   (let ((*readtable* (copy-readtable nil)))
55                     (set-dispatch-macro-character
56                      #\# #\. (lambda (&rest args) args))
57                     (do* ((eof (gensym "eof"))
58                           (sexp (read in nil eof) (read in nil eof))
59                           (result (list)))
60                         ((eq eof sexp) result)
61                       (when (and (consp sexp) (eq 'requires (car sexp)))
62                         (setq result (nconc (cdr sexp) result ))))))  ))
63            (when requires
64              (list (cons
65                     (let* ((name (file-namestring file))
66                            (posi (search ".lisp" name)))
67                       (if posi (subseq name 0 posi) name))
68                     requires)))
69            ))
70        (directory "NORVIG:*.LISP")))
71 (setq g (make-instance 'graph-class))
72 (set-property g :name "NORVIG")
73 (add-nodes  g (mapcar
74                (lambda (name) (let ((node (make-instance 'element-class)))
75                                 (set-property node :name name)
76                                 node))
77                (delete-duplicates (flatten data) :test (function string=))))
78 (mapc
79  (lambda (arcs)
80    (let* ((from (car arcs))
81           (from-node (car (find-nodes-with-property g :name from))))
82      (mapc
83       (lambda (to)
84         (let ((to-node (car (find-nodes-with-property g :name to))))
85           (add-edge-between-nodes g from-node to-node)))
86       (cdr arcs))))
87  data)
88
89 (let ((fname "norvig"))
90   (with-open-file (out (format nil "~A.dot" fname) :direction :output
91                        :if-exists :supersede :if-does-not-exist :create)
92     (princ (generate-dot g) out))
93   (ext:shell (format nil "n=~A ; (dot -Tps ${n}.dot -o ${n}.ps;gv ${n}.ps)&"
94                      fname))
95 ;;;   (EXT:SHELL (FORMAT NIL "n=~A ; (tred ${n}.dot > ${n}-tred.dot ;~
96 ;;;                           dot -Tps ${n}-tred.dot -o ${n}-tred.ps ;~
97 ;;;                           gv ${n}-tred.ps) & " FNAME))
98   )
99
100
101
102
103
104 ;; Give a list of conflicts, symbol defineds in two files.
105 (mapcon
106  (lambda (left-rest)
107    (let ((left (car left-rest)))
108      (mapcan (lambda (right)
109                ;; (FORMAT T "~2%LEFT = ~S~%RIGHT= ~S~%" (CDR LEFT) (CDR RIGHT))
110                (let ((res (intersection (cdr left) (cdr right)
111                                         :test (function string-equal))))
112                  (if res (list (cons (car left) (cons (car right) res))) nil)))
113              (cdr left-rest))))
114  (remove-if
115   (lambda (l) (= 1 (length l)))
116   (mapcar
117    (lambda (file)
118      (cons file
119            (mapcar
120             (lambda (item)
121               (cond
122                ((symbolp (second item))
123                 (second item))
124                ((and (consp   (second item))
125                      (symbolp (car (second item))))
126                 (car (second item)))
127                (t nil)))
128             (with-open-file (in file :direction :input)
129               (let ((*readtable* (copy-readtable nil)))
130                 (set-dispatch-macro-character
131                  #\# #\. (lambda (&rest args) args))
132                 (do* ((eof (gensym "eof"))
133                       (sexp (read in nil eof) (read in nil eof))
134                       (result ()))
135                     ((eq eof sexp) result)
136                   (when (and (consp sexp)
137                              (< 3 (length (string (car sexp))))
138                              (string-equal
139                               "DEF" (subseq (string (car sexp)) 0 3)))
140                     (push sexp result))))))))
141    (directory "NORVIG:*.LISP"))))
142
143
144
145  
146 (  
147
148  ("eliza.lisp" "intro.lisp" mappend)
149
150  ("eliza.lisp" "eliza1.lisp" *eliza-rules* mappend eliza)
151
152  ("eliza.lisp" "eliza-pm.lisp" eliza)
153
154  ("eliza.lisp" "unifgram.lisp" punctuation-p)
155
156  ("eliza.lisp" "auxfns.lisp" mappend)
157
158  ("prolog.lisp" "prolog1.lisp" variables-in   show-prolog-vars
159   top-level-prove prove prove-all ?- find-anywhere-if
160   unique-find-anywhere-if rename-variables clear-predicate clear-db
161   add-clause <- *db-predicates* predicate get-clauses clause-body
162   clause-head)
163
164  ("prolog.lisp" "krep2.lisp" show-prolog-vars top-level-prove prove
165   prove-all)
166
167  ("prolog.lisp" "prologc2.lisp" args)
168
169  ("prolog.lisp" "prologc1.lisp" args)
170
171  ("prolog.lisp" "krep.lisp" replace-?-vars)
172
173  ("prolog.lisp" "prologc.lisp" top-level-prove add-clause <- args)
174
175  ("prolog.lisp" "compile3.lisp" args)
176
177  ("intro.lisp" "eliza1.lisp" mappend)
178
179  ("intro.lisp"   "auxfns.lisp" mappend)
180
181  ("search.lisp" "mycin.lisp" is is)
182
183  ("search.lisp" "compile3.lisp" is is)
184
185  ("search.lisp" "gps.lisp"   find-path)
186
187  ("othello2.lisp" "othello.lisp" mobility all-squares)
188
189  ("othello2.lisp" "overview.lisp" node)
190
191  ("simple.lisp" "lexicon.lisp"   verb noun)
192
193  ("simple.lisp" "eliza1.lisp" random-elt)
194
195  ("simple.lisp"   "syntax3.lisp" *grammar*)
196
197  ("simple.lisp" "syntax2.lisp" *grammar*)
198
199  ("simple.lisp" "syntax1.lisp" *grammar*)
200
201  ("simple.lisp"   "auxfns.lisp" random-elt)
202
203  ("compopt.lisp" "mycin-r.lisp" nil)
204
205  ("eliza1.lisp" "eliza-pm.lisp" use-eliza-rules eliza)
206
207  ("eliza1.lisp"   "patmatch.lisp" segment-match segment-match
208   segment-pattern-p   pat-match extend-bindings match-variable
209   pat-match extend-bindings   lookup binding-val get-binding fail
210   variable-p)
211
212  ("eliza1.lisp"   "auxfns.lisp" random-elt mappend mklist flatten
213   pat-match   extend-bindings match-variable pat-match extend-bindings
214   lookup   get-binding fail variable-p)
215
216  ("eliza1.lisp" "cmacsyma.lisp"   variable-p)
217
218  ("eliza1.lisp" "macsyma.lisp" variable-p)
219
220  ("syntax3.lisp" "syntax2.lisp" integers 10*n+d infix-funcall
221   extend-parse parse terminal-tree-p apply-semantics lexical-rules
222   *open-categories* parser append1 complete-parses first-or-nil
223   rules-starting-with lexical-rules parse-lhs parse use tree rule
224   *grammar*)
225
226  ("syntax3.lisp" "syntax1.lisp" extend-parse parse   lexical-rules
227   *open-categories* parser append1 complete-parses
228   rules-starting-with lexical-rules parse-lhs parse use rule
229   *grammar*)
230
231  ("syntax3.lisp" "mycin.lisp" rule)
232
233  ("syntax3.lisp"   "loop.lisp" sum repeat)
234
235  ("syntax3.lisp" "unifgram.lisp" rule)
236
237  ("syntax3.lisp" "student.lisp" rule)
238
239  ("syntax3.lisp" "auxfns.lisp"   first-or-nil)
240
241  ("syntax3.lisp" "cmacsyma.lisp" rule)
242
243  ("syntax3.lisp"   "macsyma.lisp" rule)
244
245  ("syntax3.lisp" "compile3.lisp" arg2)
246
247  ("syntax3.lisp" "gps.lisp" use)
248
249  ("syntax2.lisp" "syntax1.lisp"   extend-parse parse *open-categories*
250   use parser append1   complete-parses rules-starting-with
251   lexical-rules parse-lhs parse   rule *grammar*)
252
253  ("syntax2.lisp" "mycin.lisp" rule)
254
255  ("syntax2.lisp"   "unifgram.lisp" rule)
256
257  ("syntax2.lisp" "student.lisp" rule)
258
259  ("syntax2.lisp" "auxfns.lisp" first-or-nil)
260
261  ("syntax2.lisp"   "cmacsyma.lisp" rule)
262
263  ("syntax2.lisp" "macsyma.lisp" rule)
264
265  ("syntax2.lisp" "gps.lisp" use)
266
267  ("syntax1.lisp" "mycin.lisp" rule)
268
269  ("syntax1.lisp" "unifgram.lisp" rule)
270
271  ("syntax1.lisp" "student.lisp"   rule)
272
273  ("syntax1.lisp" "cmacsyma.lisp" rule)
274
275  ("syntax1.lisp"   "macsyma.lisp" rule)
276
277  ("syntax1.lisp" "gps.lisp" use)
278
279  ("prolog1.lisp"   "krep2.lisp" show-prolog-vars top-level-prove
280   prove-all prove)
281
282  ("prolog1.lisp" "prologc.lisp" top-level-prove add-clause <-)
283
284  ("mycin.lisp" "unifgram.lisp" rule)
285
286  ("mycin.lisp" "overview.lisp"   true)
287
288  ("mycin.lisp" "student.lisp" rule)
289
290  ("mycin.lisp"   "cmacsyma.lisp" rule)
291
292  ("mycin.lisp" "macsyma.lisp" rule)
293
294  ("mycin.lisp" "compile3.lisp" is)
295
296  ("loop.lisp" "overview.lisp"   while)
297
298  ("patmatch.lisp" "auxfns.lisp" match-variable extend-bindings
299   lookup get-binding variable-p fail pat-match)
300
301  ("patmatch.lisp"   "cmacsyma.lisp" variable-p)
302
303  ("patmatch.lisp" "macsyma.lisp"   variable-p)
304
305  ("unifgram.lisp" "student.lisp" rule)
306
307  ("unifgram.lisp"   "cmacsyma.lisp" rule)
308
309  ("unifgram.lisp" "macsyma.lisp" rule)
310
311  ("krep2.lisp" "krep1.lisp" retrieve mapc-retrieve index)
312
313  ("krep2.lisp" "krep.lisp" add-fact index)
314
315  ("krep2.lisp"   "prologc.lisp" top-level-prove)
316
317  ("krep1.lisp" "krep.lisp"   dtree-index index)
318
319  ("prologc2.lisp" "prologc1.lisp" compile-clause   compile-predicate
320   proper-listp has-variable-p compile-arg   compile-unify =
321   def-prolog-compiler-macro prolog-compiler-macro   compile-call
322   compile-body make-= make-predicate make-parameters args
323   relation-arity clauses-with-arity prolog-compile var *var-counter*
324   undo-bindings!  set-binding! *trail* print-var set-binding! unify!
325   deref bound-p var unbound)
326
327  ("prologc2.lisp" "prologc.lisp"   bind-unbound-vars
328   maybe-add-undo-bindings compile-clause   compile-predicate
329   proper-listp has-variable-p compile-arg   compile-unify =
330   def-prolog-compiler-macro prolog-compiler-macro   compile-call
331   compile-body make-= make-predicate make-parameters args
332   relation-arity clauses-with-arity prolog-compile var *var-counter*
333   undo-bindings! set-binding! *trail* print-var set-binding! unify!
334   deref bound-p var unbound)
335
336  ("prologc2.lisp" "compile3.lisp" args)
337
338  ("prologc1.lisp" "prologc.lisp" proper-listp has-variable-p
339   compile-arg compile-unify = def-prolog-compiler-macro
340   prolog-compiler-macro compile-call compile-body make-=
341   compile-clause make-predicate make-parameters compile-predicate args
342   relation-arity clauses-with-arity prolog-compile var *var-counter*
343   undo-bindings! set-binding! *trail* print-var set-binding! unify!
344   deref bound-p var unbound)
345
346  ("prologc1.lisp" "compile3.lisp" args)
347
348  ("overview.lisp" "auxfns.lisp" find-all)
349
350  ("auxmacs.lisp"   "macsyma.lisp" find-anywhere)
351
352  ("auxmacs.lisp" "gps.lisp"   starts-with)
353
354  ("student.lisp" "cmacsyma.lisp" prefix->infix   binary-exp-p exp-args
355   exp-p exp rule)
356
357  ("student.lisp" "macsyma.lisp"   prefix->infix binary-exp-p exp-args
358   exp-p exp rule)
359
360  ("auxfns.lisp"   "interp1.lisp" delay delay)
361
362  ("auxfns.lisp" "cmacsyma.lisp"   variable-p)
363
364  ("auxfns.lisp" "macsyma.lisp" variable-p partition-if)
365
366  ("auxfns.lisp" "gps.lisp" member-equal)
367
368  ("prologc.lisp"   "compile3.lisp" args)
369
370  ("gps1.lisp" "gps.lisp" apply-op appropriate-p   achieve gps op
371   *ops*)
372
373  ("interp3.lisp" "interp2.lisp" interp)
374
375  ("interp3.lisp" "interp1.lisp" init-scheme-proc scheme interp)
376
377  ("interp3.lisp" "compile3.lisp" scheme)
378
379  ("interp2.lisp"   "interp1.lisp" interp)
380
381  ("interp1.lisp" "compile3.lisp" scheme)
382
383  ("interp1.lisp" "compile1.lisp" define)
384
385  ("cmacsyma.lisp"   "macsyma.lisp" prefix->infix *infix->prefix-rules*
386   variable-p   infix->prefix binary-exp-p exp-args exp-p exp rule)
387
388  ("compile3.lisp"   "compile2.lisp" *primitive-fns* optymize
389   init-scheme-comp assemble)
390
391  ("compile3.lisp" "compile1.lisp" show-fn)
392
393  ("compile2.lisp"   "compile1.lisp" comp-lambda gen-set comp-if
394   comp-begin comp)
395
396  )
397
398
399
400 ;;;; norvig-graph.lisp                -- 2003-05-16 07:11:44 -- pascal   ;;;;