;;;; -*- coding:utf-8 -*-
;;;;****************************************************************************
;;;;FILE: norvig-graph.lisp
;;;;LANGUAGE: Common-Lisp
;;;;SYSTEM: clisp
;;;;USER-INTERFACE: clisp
;;;;DESCRIPTION
;;;;
;;;; This file extracts the requires sexps from the norvig sources and
;;;; builds a dependency graph to be displayed by dot(1).
;;;;
;;;;AUTHORS
;;;; <PJB> Pascal J. Bourguignon
;;;;MODIFICATIONS
;;;; 2003-05-16 <PJB> Created.
;;;;BUGS
;;;;LEGAL
;;;; AGPL3
;;;;
;;;; Copyright Pascal J. Bourguignon 2003 - 2016
;;;;
;;;; This program is free software: you can redistribute it and/or modify
;;;; it under the terms of the GNU Affero General Public License as published by
;;;; the Free Software Foundation, either version 3 of the License, or
;;;; (at your option) any later version.
;;;;
;;;; This program is distributed in the hope that it will be useful,
;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;;;; GNU Affero General Public License for more details.
;;;;
;;;; You should have received a copy of the GNU Affero General Public License
;;;; along with this program. If not, see <http://www.gnu.org/licenses/>
;;;;****************************************************************************
(eval-when (:compile-toplevel :load-toplevel :execute)
(setf *readtable* (copy-readtable nil)))
(load "PACKAGE:COM;INFORMATIMAGO;COMMON-LISP;GRAPH")
(load "PACKAGE:COM;INFORMATIMAGO;COMMON-LISP;GRAPH-DOT")
(load "PACKAGE:COM;INFORMATIMAGO;COMMON-LISP;LIST")
(load "PACKAGE:COM;INFORMATIMAGO;COMMON-LISP;UTILITY")
(use-package "COM.INFORMATIMAGO.COMMON-LISP.GRAPH")
(use-package "COM.INFORMATIMAGO.COMMON-LISP.GRAPH-DOT")
(use-package "COM.INFORMATIMAGO.COMMON-LISP.LIST")
(use-package "COM.INFORMATIMAGO.COMMON-LISP.UTILITY")
(defvar data)
(defvar g)
(setq data
(mapcan
(lambda (file)
(let ((requires
(with-open-file (in file :direction :input)
(let ((*readtable* (copy-readtable nil)))
(set-dispatch-macro-character
#\# #\. (lambda (&rest args) args))
(do* ((eof (gensym "eof"))
(sexp (read in nil eof) (read in nil eof))
(result (list)))
((eq eof sexp) result)
(when (and (consp sexp) (eq 'requires (car sexp)))
(setq result (nconc (cdr sexp) result )))))) ))
(when requires
(list (cons
(let* ((name (file-namestring file))
(posi (search ".lisp" name)))
(if posi (subseq name 0 posi) name))
requires)))
))
(directory "NORVIG:*.LISP")))
(setq g (make-instance 'graph-class))
(set-property g :name "NORVIG")
(add-nodes g (mapcar
(lambda (name) (let ((node (make-instance 'element-class)))
(set-property node :name name)
node))
(delete-duplicates (flatten data) :test (function string=))))
(mapc
(lambda (arcs)
(let* ((from (car arcs))
(from-node (car (find-nodes-with-property g :name from))))
(mapc
(lambda (to)
(let ((to-node (car (find-nodes-with-property g :name to))))
(add-edge-between-nodes g from-node to-node)))
(cdr arcs))))
data)
(let ((fname "norvig"))
(with-open-file (out (format nil "~A.dot" fname) :direction :output
:if-exists :supersede :if-does-not-exist :create)
(princ (generate-dot g) out))
(ext:shell (format nil "n=~A ; (dot -Tps ${n}.dot -o ${n}.ps;gv ${n}.ps)&"
fname))
;;; (EXT:SHELL (FORMAT NIL "n=~A ; (tred ${n}.dot > ${n}-tred.dot ;~
;;; dot -Tps ${n}-tred.dot -o ${n}-tred.ps ;~
;;; gv ${n}-tred.ps) & " FNAME))
)
;; Give a list of conflicts, symbol defineds in two files.
(mapcon
(lambda (left-rest)
(let ((left (car left-rest)))
(mapcan (lambda (right)
;; (FORMAT T "~2%LEFT = ~S~%RIGHT= ~S~%" (CDR LEFT) (CDR RIGHT))
(let ((res (intersection (cdr left) (cdr right)
:test (function string-equal))))
(if res (list (cons (car left) (cons (car right) res))) nil)))
(cdr left-rest))))
(remove-if
(lambda (l) (= 1 (length l)))
(mapcar
(lambda (file)
(cons file
(mapcar
(lambda (item)
(cond
((symbolp (second item))
(second item))
((and (consp (second item))
(symbolp (car (second item))))
(car (second item)))
(t nil)))
(with-open-file (in file :direction :input)
(let ((*readtable* (copy-readtable nil)))
(set-dispatch-macro-character
#\# #\. (lambda (&rest args) args))
(do* ((eof (gensym "eof"))
(sexp (read in nil eof) (read in nil eof))
(result ()))
((eq eof sexp) result)
(when (and (consp sexp)
(< 3 (length (string (car sexp))))
(string-equal
"DEF" (subseq (string (car sexp)) 0 3)))
(push sexp result))))))))
(directory "NORVIG:*.LISP"))))
(
("eliza.lisp" "intro.lisp" mappend)
("eliza.lisp" "eliza1.lisp" *eliza-rules* mappend eliza)
("eliza.lisp" "eliza-pm.lisp" eliza)
("eliza.lisp" "unifgram.lisp" punctuation-p)
("eliza.lisp" "auxfns.lisp" mappend)
("prolog.lisp" "prolog1.lisp" variables-in show-prolog-vars
top-level-prove prove prove-all ?- find-anywhere-if
unique-find-anywhere-if rename-variables clear-predicate clear-db
add-clause <- *db-predicates* predicate get-clauses clause-body
clause-head)
("prolog.lisp" "krep2.lisp" show-prolog-vars top-level-prove prove
prove-all)
("prolog.lisp" "prologc2.lisp" args)
("prolog.lisp" "prologc1.lisp" args)
("prolog.lisp" "krep.lisp" replace-?-vars)
("prolog.lisp" "prologc.lisp" top-level-prove add-clause <- args)
("prolog.lisp" "compile3.lisp" args)
("intro.lisp" "eliza1.lisp" mappend)
("intro.lisp" "auxfns.lisp" mappend)
("search.lisp" "mycin.lisp" is is)
("search.lisp" "compile3.lisp" is is)
("search.lisp" "gps.lisp" find-path)
("othello2.lisp" "othello.lisp" mobility all-squares)
("othello2.lisp" "overview.lisp" node)
("simple.lisp" "lexicon.lisp" verb noun)
("simple.lisp" "eliza1.lisp" random-elt)
("simple.lisp" "syntax3.lisp" *grammar*)
("simple.lisp" "syntax2.lisp" *grammar*)
("simple.lisp" "syntax1.lisp" *grammar*)
("simple.lisp" "auxfns.lisp" random-elt)
("compopt.lisp" "mycin-r.lisp" nil)
("eliza1.lisp" "eliza-pm.lisp" use-eliza-rules eliza)
("eliza1.lisp" "patmatch.lisp" segment-match segment-match
segment-pattern-p pat-match extend-bindings match-variable
pat-match extend-bindings lookup binding-val get-binding fail
variable-p)
("eliza1.lisp" "auxfns.lisp" random-elt mappend mklist flatten
pat-match extend-bindings match-variable pat-match extend-bindings
lookup get-binding fail variable-p)
("eliza1.lisp" "cmacsyma.lisp" variable-p)
("eliza1.lisp" "macsyma.lisp" variable-p)
("syntax3.lisp" "syntax2.lisp" integers 10*n+d infix-funcall
extend-parse parse terminal-tree-p apply-semantics lexical-rules
*open-categories* parser append1 complete-parses first-or-nil
rules-starting-with lexical-rules parse-lhs parse use tree rule
*grammar*)
("syntax3.lisp" "syntax1.lisp" extend-parse parse lexical-rules
*open-categories* parser append1 complete-parses
rules-starting-with lexical-rules parse-lhs parse use rule
*grammar*)
("syntax3.lisp" "mycin.lisp" rule)
("syntax3.lisp" "loop.lisp" sum repeat)
("syntax3.lisp" "unifgram.lisp" rule)
("syntax3.lisp" "student.lisp" rule)
("syntax3.lisp" "auxfns.lisp" first-or-nil)
("syntax3.lisp" "cmacsyma.lisp" rule)
("syntax3.lisp" "macsyma.lisp" rule)
("syntax3.lisp" "compile3.lisp" arg2)
("syntax3.lisp" "gps.lisp" use)
("syntax2.lisp" "syntax1.lisp" extend-parse parse *open-categories*
use parser append1 complete-parses rules-starting-with
lexical-rules parse-lhs parse rule *grammar*)
("syntax2.lisp" "mycin.lisp" rule)
("syntax2.lisp" "unifgram.lisp" rule)
("syntax2.lisp" "student.lisp" rule)
("syntax2.lisp" "auxfns.lisp" first-or-nil)
("syntax2.lisp" "cmacsyma.lisp" rule)
("syntax2.lisp" "macsyma.lisp" rule)
("syntax2.lisp" "gps.lisp" use)
("syntax1.lisp" "mycin.lisp" rule)
("syntax1.lisp" "unifgram.lisp" rule)
("syntax1.lisp" "student.lisp" rule)
("syntax1.lisp" "cmacsyma.lisp" rule)
("syntax1.lisp" "macsyma.lisp" rule)
("syntax1.lisp" "gps.lisp" use)
("prolog1.lisp" "krep2.lisp" show-prolog-vars top-level-prove
prove-all prove)
("prolog1.lisp" "prologc.lisp" top-level-prove add-clause <-)
("mycin.lisp" "unifgram.lisp" rule)
("mycin.lisp" "overview.lisp" true)
("mycin.lisp" "student.lisp" rule)
("mycin.lisp" "cmacsyma.lisp" rule)
("mycin.lisp" "macsyma.lisp" rule)
("mycin.lisp" "compile3.lisp" is)
("loop.lisp" "overview.lisp" while)
("patmatch.lisp" "auxfns.lisp" match-variable extend-bindings
lookup get-binding variable-p fail pat-match)
("patmatch.lisp" "cmacsyma.lisp" variable-p)
("patmatch.lisp" "macsyma.lisp" variable-p)
("unifgram.lisp" "student.lisp" rule)
("unifgram.lisp" "cmacsyma.lisp" rule)
("unifgram.lisp" "macsyma.lisp" rule)
("krep2.lisp" "krep1.lisp" retrieve mapc-retrieve index)
("krep2.lisp" "krep.lisp" add-fact index)
("krep2.lisp" "prologc.lisp" top-level-prove)
("krep1.lisp" "krep.lisp" dtree-index index)
("prologc2.lisp" "prologc1.lisp" compile-clause compile-predicate
proper-listp has-variable-p compile-arg compile-unify =
def-prolog-compiler-macro prolog-compiler-macro compile-call
compile-body make-= make-predicate make-parameters args
relation-arity clauses-with-arity prolog-compile var *var-counter*
undo-bindings! set-binding! *trail* print-var set-binding! unify!
deref bound-p var unbound)
("prologc2.lisp" "prologc.lisp" bind-unbound-vars
maybe-add-undo-bindings compile-clause compile-predicate
proper-listp has-variable-p compile-arg compile-unify =
def-prolog-compiler-macro prolog-compiler-macro compile-call
compile-body make-= make-predicate make-parameters args
relation-arity clauses-with-arity prolog-compile var *var-counter*
undo-bindings! set-binding! *trail* print-var set-binding! unify!
deref bound-p var unbound)
("prologc2.lisp" "compile3.lisp" args)
("prologc1.lisp" "prologc.lisp" proper-listp has-variable-p
compile-arg compile-unify = def-prolog-compiler-macro
prolog-compiler-macro compile-call compile-body make-=
compile-clause make-predicate make-parameters compile-predicate args
relation-arity clauses-with-arity prolog-compile var *var-counter*
undo-bindings! set-binding! *trail* print-var set-binding! unify!
deref bound-p var unbound)
("prologc1.lisp" "compile3.lisp" args)
("overview.lisp" "auxfns.lisp" find-all)
("auxmacs.lisp" "macsyma.lisp" find-anywhere)
("auxmacs.lisp" "gps.lisp" starts-with)
("student.lisp" "cmacsyma.lisp" prefix->infix binary-exp-p exp-args
exp-p exp rule)
("student.lisp" "macsyma.lisp" prefix->infix binary-exp-p exp-args
exp-p exp rule)
("auxfns.lisp" "interp1.lisp" delay delay)
("auxfns.lisp" "cmacsyma.lisp" variable-p)
("auxfns.lisp" "macsyma.lisp" variable-p partition-if)
("auxfns.lisp" "gps.lisp" member-equal)
("prologc.lisp" "compile3.lisp" args)
("gps1.lisp" "gps.lisp" apply-op appropriate-p achieve gps op
*ops*)
("interp3.lisp" "interp2.lisp" interp)
("interp3.lisp" "interp1.lisp" init-scheme-proc scheme interp)
("interp3.lisp" "compile3.lisp" scheme)
("interp2.lisp" "interp1.lisp" interp)
("interp1.lisp" "compile3.lisp" scheme)
("interp1.lisp" "compile1.lisp" define)
("cmacsyma.lisp" "macsyma.lisp" prefix->infix *infix->prefix-rules*
variable-p infix->prefix binary-exp-p exp-args exp-p exp rule)
("compile3.lisp" "compile2.lisp" *primitive-fns* optymize
init-scheme-comp assemble)
("compile3.lisp" "compile1.lisp" show-fn)
("compile2.lisp" "compile1.lisp" comp-lambda gen-set comp-if
comp-begin comp)
)
;;;; norvig-graph.lisp -- 2003-05-16 07:11:44 -- pascal ;;;;