;;;; -*- 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   ;;;;
ViewGit