mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-05-01 04:10:18 +02:00
Code Activity

Use modules (ice-9 format), (ice-9 getopt-long).

Browse source 
Autoload module (srfi srfi-13).
No longer export `diff-alists'.

(diff, diff-alists, display-list): Remove.
(put, get, read-api-alist-file, hang-by-the-roots, diff?,
diff+note!, group-diff): New.
(api-diff): Rewrite.
This commit is contained in:
Thien-Thi Nguyen 2002-05-12 03:46:26 +00:00
parent 689c126449
commit 4ab4e780c6
1 changed files with 117 additions and 34 deletions
Download patch file Download diff file Expand all files Collapse all files

151
scripts/api-diff
View file

@ -26,60 +26,143 @@ exec ${GUILE-guile} -l $0 -c "(apply $main (cdr (command-line)))" "$@"
;;; Commentary:
;; Usage: api-diff alist-file-A alist-file-B
;; Read in the alists from files ALIST-FILE-A and ALIST-FILE-B
;; and display four lists: old scheme, new scheme, old C, new C.
;; Usage: api-diff [-d GROUPS] ALIST-FILE-A ALIST-FILE-B
;;
;; For scheme programming, the (scripts api-diff) module exports
;; two procedures:
;; (diff-alists A-alist B-alist report)
;; Read in the alists from files ALIST-FILE-A and ALIST-FILE-B
;; and display a (count) summary of the groups defined therein.
;; Optional arg "--details" (or "-d") specifies a comma-separated
;; list of groups, in which case api-diff displays instead the
;; elements added and deleted for each of the specified groups.
;;
;; For scheme programming, this module exports the proc:
;; (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'.
;;
;; Note that the convention is that the "older" alist/file is
;; specified first.
;;
;; TODO: When the annotations support it, also detect/report
;; procedure signature, or other simple type, changes.
;; TODO: Develop scheme interface.
;;; Code:
(define-module (scripts api-diff)
:use-module (ice-9 common-list)
:export (diff-alists api-diff))
:use-module (ice-9 format)
:use-module (ice-9 getopt-long)
:autoload (srfi srfi-13) (string-tokenize)
:export (api-diff))
(define (read-alist-file file)
(with-input-from-file file
(lambda () (read))))
(define (diff x y) (set-difference (map car x) (map car y)))
(define put set-object-property!)
(define get object-property)
(define (diff-alists A B report)
(let* ((A-scheme (assq-ref A 'scheme))
(A-C (assq-ref A 'C))
(B-scheme (assq-ref B 'scheme))
(B-C (assq-ref B 'C))
(OLD-scheme (diff A-scheme B-scheme))
(NEW-scheme (diff B-scheme A-scheme))
(OLD-C (diff A-C B-C))
(NEW-C (diff B-C A-C)))
(report OLD-scheme NEW-scheme OLD-C NEW-C)))
(define (read-api-alist-file file)
(let* ((alist (read-alist-file file))
(meta (assq-ref alist 'meta))
(interface (assq-ref alist 'interface)))
(put interface 'meta meta)
(put interface 'groups (let ((ht (make-hash-table 31)))
(for-each (lambda (group)
(hashq-set! ht group '()))
(assq-ref meta 'groups))
ht))
interface))
(define (display-list head ls)
(format #t ":: ~A -- ~A\n" head (length ls))
(for-each (lambda (x) (format #t "~A\n" x)) ls)
(newline))
(define (hang-by-the-roots interface)
(let ((ht (get interface 'groups)))
(for-each (lambda (x)
(for-each (lambda (group)
(hashq-set! ht group
(cons (car x)
(hashq-ref ht group))))
(assq-ref x 'groups)))
interface))
interface)
(define (diff? a b)
(let ((result (set-difference a b)))
(if (null? result)
#f ; CL weenies bite me
result)))
(define (diff+note! a b note-removals note-additions note-same)
(let ((same? #t))
(cond ((diff? a b) => (lambda (x) (note-removals x) (set! same? #f))))
(cond ((diff? b a) => (lambda (x) (note-additions x) (set! same? #f))))
(and same? (note-same))))
(define (group-diff i-old i-new . options)
(let* ((i-old (hang-by-the-roots i-old))
(g-old (hash-fold acons '() (get i-old 'groups)))
(g-old-names (map car g-old))
(i-new (hang-by-the-roots i-new))
(g-new (hash-fold acons '() (get i-new 'groups)))
(g-new-names (map car g-new)))
(cond ((null? options)
(diff+note! g-old-names g-new-names
(lambda (removals)
(format #t "groups-removed: ~A\n" removals))
(lambda (additions)
(format #t "groups-added: ~A\n" additions))
(lambda () #t))
(for-each (lambda (group)
(let* ((old (assq-ref g-old group))
(new (assq-ref g-new group))
(old-count (and old (length old)))
(new-count (and new (length new)))
(delta (and old new (- new-count old-count))))
(format #t " ~5@A ~5@A ~5@A ~A\n"
(or old-count "-")
(or new-count "-")
(or delta "-")
group)))
(sort (union g-old-names g-new-names)
(lambda (a b)
(string<? (symbol->string a)
(symbol->string b))))))
((assq-ref options 'details)
=> (lambda (groups)
(for-each (lambda (group)
(let* ((old (or (assq-ref g-old group) '()))
(new (or (assq-ref g-new group) '()))
(>>! (lambda (label ls)
(format #t "~A ~A:\n" group label)
(for-each (lambda (x)
(format #t " ~A\n" x))
ls))))
(diff+note! old new
(lambda (removals)
(>>! 'removals removals))
(lambda (additions)
(>>! 'additions additions))
(lambda ()
(format #t "~A: no changes\n"
group)))))
groups)))
(else
(error "api-diff: group-diff: bad options")))))
(define (api-diff . args)
(diff-alists (read-alist-file (list-ref args 0))
(read-alist-file (list-ref args 1))
(lambda (OLD-scheme NEW-scheme OLD-C NEW-C)
(display-list "OLD (deleted) scheme" OLD-scheme)
(display-list "NEW scheme" NEW-scheme)
(display-list "OLD (deleted) C" OLD-C)
(display-list "NEW C" NEW-C))))
(let* ((p (getopt-long (cons 'api-diff args)
'((details (single-char #\d)
(value #t))
;; Add options here.
)))
(rest (option-ref p '() '("/dev/null" "/dev/null")))
(i-old (read-api-alist-file (car rest)))
(i-new (read-api-alist-file (cadr rest)))
(options '()))
(cond ((option-ref p 'details #f)
=> (lambda (groups)
(set! options (cons (cons 'details
(map string->symbol
(string-tokenize
groups
#\,)))
options)))))
(apply group-diff i-old i-new options)))
(define main api-diff)