1#!/usr/bin/guile -s 2!# 3;; Copyright (C) 2004 Free Software Foundation, Inc. 4;; GPL version 2 or later. 5 6;; Assumes that a defs file is composed of lists of symbols, strings, 7;; numbers, #t/#f, and other lists. Each toplevel list is assumed to 8;; have at least two elements. 9 10(use-modules (ice-9 pretty-print)) 11 12(define from-port #f) 13(define to-port #f) 14 15(define (usage) 16 (display "defs-diff FROM-FILE [TO-FILE]\n" (current-error-port)) 17 (display "If there is no TO-FILE, defs-diff will read from stdin.\n") 18 (exit 1)) 19 20(let ((args (program-arguments))) 21 (case (length args) 22 ((2) (set! to-port (current-input-port))) 23 ((3) (set! to-port (open-input-file (caddr args)))) 24 (else (usage))) 25 (set! from-port (open-input-file (cadr args)))) 26 27(define (form-comp-object f) 28 (case (car f) 29 ((define-object define-enum define-flags define-interface 30 define-boxed define-pointer define-function define-method) 31 (cadr (assq 'c-name (cddr f)))) 32 ((include) 33 (cadr f)) 34 (else 35 (error "unknown defs form type" (car f))))) 36 37;; If two forms should be treated as the same 38(define (form=? f1 f2) 39 (and (eq? (car f1) (car f2)) 40 (apply equal? (map form-comp-object (list f1 f2))))) 41 42(define (symbol<? x y) 43 (string<? (symbol->string x) (symbol->string y))) 44 45(define (form<? f1 f2) 46 (if (eq? (car f1) (car f2)) 47 (let ((c1 (form-comp-object f1)) 48 (c2 (form-comp-object f2))) 49 (if (symbol? c1) 50 (if (symbol? c2) (symbol<? c1 c2) #t) 51 (if (symbol? c2) #f (string<? c1 c2)))) 52 (symbol<? (car f1) (car f2)))) 53 54(define (collect-forms port) 55 (let lp ((out '())) 56 (let ((form (read port))) 57 (if (eof-object? form) 58 (sort! (reverse! out) form<?) 59 (lp (cons form out)))))) 60 61;; If two forms are really the same 62(define (form==? f1 f2) 63 (equal? f1 f2)) 64 65(let lp ((l1 (collect-forms from-port)) 66 (l2 (collect-forms to-port))) 67 (define (minus) 68 (display "-") 69 (pretty-print (car l1)) 70 (lp (cdr l1) l2)) 71 (define (plus) 72 (display "+") 73 (pretty-print (car l2)) 74 (lp l1 (cdr l2))) 75 (define (eq) 76 (lp (cdr l1) (cdr l2))) 77 (cond ((and (null? l1) (null? l2))) ; finished 78 ((null? l2) 79 (minus)) 80 ((null? l1) 81 (plus)) 82 ((or (form<? (car l1) (car l2)) 83 (and (form=? (car l1) (car l2)) 84 (not (form==? (car l1) (car l2))))) 85 (minus)) 86 ((or (not (form=? (car l1) (car l2))) 87 (and (form=? (car l1) (car l2)) 88 (not (form==? (car l1) (car l2))))) 89 (plus)) 90 (else 91 (or (form==? (car l1) (car l2)) 92 (error "wingo is stupid")) 93 (eq)))) 94