/[guile]/guile/guile-core/scripts/api-diff
ViewVC logotype

Diff of /guile/guile-core/scripts/api-diff

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1.1.2.2 by rlb, Sat Jul 20 21:11:20 2002 UTC revision 1.1.2.3 by rlb, Sat Jul 20 21:14:53 2002 UTC
# Line 26  exec ${GUILE-guile} -l $0 -c "(apply $ma Line 26  exec ${GUILE-guile} -l $0 -c "(apply $ma
26    
27  ;;; Commentary:  ;;; Commentary:
28    
29  ;; Usage: api-diff alist-file-A alist-file-B  ;; Usage: api-diff [-d GROUPS] ALIST-FILE-A ALIST-FILE-B
30    ;;
31  ;; Read in the alists from files ALIST-FILE-A and ALIST-FILE-B  ;; Read in the alists from files ALIST-FILE-A and ALIST-FILE-B
32  ;; and display four lists: old scheme, new scheme, old C, new C.  ;; and display a (count) summary of the groups defined therein.
33    ;; Optional arg "--details" (or "-d") specifies a comma-separated
34    ;; list of groups, in which case api-diff displays instead the
35    ;; elements added and deleted for each of the specified groups.
36  ;;  ;;
37  ;; For scheme programming, the (scripts api-diff) module exports  ;; For scheme programming, this module exports the proc:
 ;; two procedures:  
 ;;  (diff-alists A-alist B-alist report)  
38  ;;  (api-diff A-file B-file)  ;;  (api-diff A-file B-file)
 ;; The latter implements the shell interface using the former.  
 ;; REPORT is a proc that takes the above four lists.  Its return  
 ;; value is returned by `diff-alists'.  
39  ;;  ;;
40  ;; Note that the convention is that the "older" alist/file is  ;; Note that the convention is that the "older" alist/file is
41  ;; specified first.  ;; specified first.
42  ;;  ;;
43  ;; TODO: When the annotations support it, also detect/report  ;; TODO: Develop scheme interface.
 ;;       procedure signature, or other simple type, changes.  
44    
45  ;;; Code:  ;;; Code:
46    
47  (define-module (scripts api-diff)  (define-module (scripts api-diff)
48    :use-module (ice-9 common-list)    :use-module (ice-9 common-list)
49    :export (diff-alists api-diff))    :use-module (ice-9 format)
50      :use-module (ice-9 getopt-long)
51      :autoload (srfi srfi-13) (string-tokenize)
52      :export (api-diff))
53    
54  (define (read-alist-file file)  (define (read-alist-file file)
55    (with-input-from-file file    (with-input-from-file file
56      (lambda () (read))))      (lambda () (read))))
57    
58  (define (diff x y) (set-difference (map car x) (map car y)))  (define put set-object-property!)
59    (define get object-property)
60    
61  (define (diff-alists A B report)  (define (read-api-alist-file file)
62    (let* ((A-scheme (assq-ref A 'scheme))    (let* ((alist (read-alist-file file))
63           (A-C      (assq-ref A 'C))           (meta (assq-ref alist 'meta))
64           (B-scheme (assq-ref B 'scheme))           (interface (assq-ref alist 'interface)))
65           (B-C      (assq-ref B 'C))      (put interface 'meta meta)
66           (OLD-scheme (diff A-scheme B-scheme))      (put interface 'groups (let ((ht (make-hash-table 31)))
67           (NEW-scheme (diff B-scheme A-scheme))                               (for-each (lambda (group)
68           (OLD-C      (diff A-C B-C))                                           (hashq-set! ht group '()))
69           (NEW-C      (diff B-C A-C)))                                         (assq-ref meta 'groups))
70      (report OLD-scheme NEW-scheme OLD-C NEW-C)))                               ht))
71        interface))
72  (define (display-list head ls)  
73    (format #t ":: ~A -- ~A\n" head (length ls))  (define (hang-by-the-roots interface)
74    (for-each (lambda (x) (format #t "~A\n" x)) ls)    (let ((ht (get interface 'groups)))
75    (newline))      (for-each (lambda (x)
76                    (for-each (lambda (group)
77                                (hashq-set! ht group
78                                            (cons (car x)
79                                                  (hashq-ref ht group))))
80                              (assq-ref x 'groups)))
81                  interface))
82      interface)
83    
84    (define (diff? a b)
85      (let ((result (set-difference a b)))
86        (if (null? result)
87            #f                              ; CL weenies bite me
88            result)))
89    
90    (define (diff+note! a b note-removals note-additions note-same)
91      (let ((same? #t))
92        (cond ((diff? a b) => (lambda (x) (note-removals x) (set! same? #f))))
93        (cond ((diff? b a) => (lambda (x) (note-additions x) (set! same? #f))))
94        (and same? (note-same))))
95    
96    (define (group-diff i-old i-new . options)
97      (let* ((i-old (hang-by-the-roots i-old))
98             (g-old (hash-fold acons '() (get i-old 'groups)))
99             (g-old-names (map car g-old))
100             (i-new (hang-by-the-roots i-new))
101             (g-new (hash-fold acons '() (get i-new 'groups)))
102             (g-new-names (map car g-new)))
103        (cond ((null? options)
104               (diff+note! g-old-names g-new-names
105                           (lambda (removals)
106                             (format #t "groups-removed: ~A\n" removals))
107                           (lambda (additions)
108                             (format #t "groups-added: ~A\n" additions))
109                           (lambda () #t))
110               (for-each (lambda (group)
111                           (let* ((old (assq-ref g-old group))
112                                  (new (assq-ref g-new group))
113                                  (old-count (and old (length old)))
114                                  (new-count (and new (length new)))
115                                  (delta (and old new (- new-count old-count))))
116                             (format #t " ~5@A  ~5@A  :  "
117                                     (or old-count "-")
118                                     (or new-count "-"))
119                             (cond ((and old new)
120                                    (let ((add-count 0) (sub-count 0))
121                                      (diff+note!
122                                       old new
123                                       (lambda (subs)
124                                         (set! sub-count (length subs)))
125                                       (lambda (adds)
126                                         (set! add-count (length adds)))
127                                       (lambda () #t))
128                                      (format #t "~5@D ~5@D : ~5@D"
129                                              add-count (- sub-count) delta)))
130                                   (else
131                                    (format #t "~5@A ~5@A : ~5@A" "-" "-" "-")))
132                             (format #t "     ~A\n" group)))
133                         (sort (union g-old-names g-new-names)
134                               (lambda (a b)
135                                 (string<? (symbol->string a)
136                                           (symbol->string b))))))
137              ((assq-ref options 'details)
138               => (lambda (groups)
139                    (for-each (lambda (group)
140                                (let* ((old (or (assq-ref g-old group) '()))
141                                       (new (or (assq-ref g-new group) '()))
142                                       (>>! (lambda (label ls)
143                                              (format #t "~A ~A:\n" group label)
144                                              (for-each (lambda (x)
145                                                          (format #t " ~A\n" x))
146                                                        ls))))
147                                  (diff+note! old new
148                                              (lambda (removals)
149                                                (>>! 'removals removals))
150                                              (lambda (additions)
151                                                (>>! 'additions additions))
152                                              (lambda ()
153                                                (format #t "~A: no changes\n"
154                                                        group)))))
155                              groups)))
156              (else
157               (error "api-diff: group-diff: bad options")))))
158    
159  (define (api-diff . args)  (define (api-diff . args)
160    (diff-alists (read-alist-file (list-ref args 0))    (let* ((p (getopt-long (cons 'api-diff args)
161                 (read-alist-file (list-ref args 1))                           '((details (single-char #\d)
162                 (lambda (OLD-scheme NEW-scheme OLD-C NEW-C)                                      (value #t))
163                   (display-list "OLD (deleted) scheme" OLD-scheme)                             ;; Add options here.
164                   (display-list "NEW scheme"           NEW-scheme)                             )))
165                   (display-list "OLD (deleted) C"      OLD-C)           (rest (option-ref p '() '("/dev/null" "/dev/null")))
166                   (display-list "NEW C"                NEW-C))))           (i-old (read-api-alist-file (car rest)))
167             (i-new (read-api-alist-file (cadr rest)))
168             (options '()))
169        (cond ((option-ref p 'details #f)
170               => (lambda (groups)
171                    (set! options (cons (cons 'details
172                                              (map string->symbol
173                                                   (string-tokenize
174                                                    groups
175                                                    #\,)))
176                                        options)))))
177        (apply group-diff i-old i-new options)))
178    
179  (define main api-diff)  (define main api-diff)
180    

Legend:
Removed from v.1.1.2.2  
changed lines
  Added in v.1.1.2.3

savannah-hackers-public@gnu.org
ViewVC Help
Powered by ViewVC 1.1.26