2 # aside from this initial boilerplate, this is actually -*- scheme -*- code
3 main='(module-ref (resolve-module '\''(scripts api-diff)) '\'main')'
4 exec ${GUILE-guile} -l $0 -c "(apply $main (cdr (command-line)))" "$@"
6 ;;; api-diff --- diff guile-api.alist files
8 ;; Copyright (C) 2002, 2006 Free Software Foundation, Inc.
10 ;; This program is free software; you can redistribute it and/or
11 ;; modify it under the terms of the GNU General Public License as
12 ;; published by the Free Software Foundation; either version 2, or
13 ;; (at your option) any later version.
15 ;; This program is distributed in the hope that it will be useful,
16 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
17 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
18 ;; General Public License for more details.
20 ;; You should have received a copy of the GNU General Public License
21 ;; along with this software; see the file COPYING. If not, write to
22 ;; the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
23 ;; Boston, MA 02110-1301 USA
25 ;;; Author: Thien-Thi Nguyen <ttn@gnu.org>
29 ;; Usage: api-diff [-d GROUPS] ALIST-FILE-A ALIST-FILE-B
31 ;; Read in the alists from files ALIST-FILE-A and ALIST-FILE-B
32 ;; 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.
37 ;; For scheme programming, this module exports the proc:
38 ;; (api-diff A-file B-file)
40 ;; Note that the convention is that the "older" alist/file is
43 ;; TODO: Develop scheme interface.
47 (define-module (scripts api-diff)
48 :use-module (ice-9 common-list)
49 :use-module (ice-9 format)
50 :use-module (ice-9 getopt-long)
51 :autoload (srfi srfi-13) (string-tokenize)
54 (define (read-alist-file file)
55 (with-input-from-file file
58 (define put set-object-property!)
59 (define get object-property)
61 (define (read-api-alist-file file)
62 (let* ((alist (read-alist-file file))
63 (meta (assq-ref alist 'meta))
64 (interface (assq-ref alist 'interface)))
65 (put interface 'meta meta)
66 (put interface 'groups (let ((ht (make-hash-table 31)))
67 (for-each (lambda (group)
68 (hashq-set! ht group '()))
69 (assq-ref meta 'groups))
73 (define (hang-by-the-roots interface)
74 (let ((ht (get interface 'groups)))
76 (for-each (lambda (group)
79 (hashq-ref ht group))))
80 (assq-ref x 'groups)))
85 (let ((result (set-difference a b)))
87 #f ; CL weenies bite me
90 (define (diff+note! a b note-removals note-additions note-same)
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))))
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
106 (format #t "groups-removed: ~A\n" removals))
108 (format #t "groups-added: ~A\n" additions))
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 : "
120 (let ((add-count 0) (sub-count 0))
124 (set! sub-count (length subs)))
126 (set! add-count (length adds)))
128 (format #t "~5@D ~5@D : ~5@D"
129 add-count (- sub-count) delta)))
131 (format #t "~5@A ~5@A : ~5@A" "-" "-" "-")))
132 (format #t " ~A\n" group)))
133 (sort (union g-old-names g-new-names)
135 (string<? (symbol->string a)
136 (symbol->string b))))))
137 ((assq-ref options 'details)
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))
149 (>>! 'removals removals))
151 (>>! 'additions additions))
153 (format #t "~A: no changes\n"
157 (error "api-diff: group-diff: bad options")))))
159 (define (api-diff . args)
160 (let* ((p (getopt-long (cons 'api-diff args)
161 '((details (single-char #\d)
165 (rest (option-ref p '() '("/dev/null" "/dev/null")))
166 (i-old (read-api-alist-file (car rest)))
167 (i-new (read-api-alist-file (cadr rest)))
169 (cond ((option-ref p 'details #f)
171 (set! options (cons (cons 'details
177 (apply group-diff i-old i-new options)))
179 (define main api-diff)
181 ;;; api-diff ends here