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