From: Thien-Thi Nguyen Date: Sun, 12 May 2002 03:46:26 +0000 (+0000) Subject: Use modules (ice-9 format), (ice-9 getopt-long). X-Git-Url: https://git.hcoop.net/bpt/guile.git/commitdiff_plain/4ab4e780c61ef8abcc4f123aecfa833fd05902f3?ds=sidebyside Use modules (ice-9 format), (ice-9 getopt-long). 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. --- diff --git a/scripts/api-diff b/scripts/api-diff index 76e8d8582..cee9668ca 100755 --- a/scripts/api-diff +++ b/scripts/api-diff @@ -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 +;; Usage: api-diff [-d GROUPS] 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. +;; 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, the (scripts api-diff) module exports -;; two procedures: -;; (diff-alists A-alist B-alist report) +;; 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 (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 (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-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 (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 (display-list head ls) - (format #t ":: ~A -- ~A\n" head (length ls)) - (for-each (lambda (x) (format #t "~A\n" x)) ls) - (newline)) +(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) + (stringstring 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)