/diff-scheme.ss

  1;; ydiff - a language-aware tool for comparing programs
  2;; Copyright (C) 2011 Yin Wang (yinwang0@gmail.com)
  3
  4;; This program is free software: you can redistribute it and/or modify
  5;; it under the terms of the GNU General Public License as published by
  6;; the Free Software Foundation, either version 3 of the License, or
  7;; (at your option) any later version.
  8
  9;; This program is distributed in the hope that it will be useful,
 10;; but WITHOUT ANY WARRANTY; without even the implied warranty of
 11;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
 12;; GNU General Public License for more details.
 13
 14;; You should have received a copy of the GNU General Public License
 15;; along with this program.  If not, see <http://www.gnu.org/licenses/>.
 16
 17
 18
 19(load "parse-scheme.ss")
 20(load "diff.ss")
 21
 22
 23
 24;-------------------------------------------------------------
 25;                         overrides
 26;-------------------------------------------------------------
 27
 28(define *keywords*
 29  '(define defun defvar lambda cond if else
 30     let let* let-values let*-values
 31     while for define-syntax syntax-rules
 32     define-minor-mode))
 33
 34(define *defs*
 35  '(define defun defvar define-syntax define-minor-mode))
 36
 37
 38;; helper for get-type
 39(define get-keyword
 40  (lambda (node)
 41    (match node
 42      [(Expr _ _ type elts)
 43       (cond
 44        [(null? elts) #f]
 45        [else
 46         (let ([sym (get-symbol (car elts))])
 47           (cond
 48            [(memq sym *keywords*) sym]
 49            [else #f]))])]
 50      [_ #f])))
 51
 52
 53; (get-keyword (car (parse-scheme "(defvar f 1)")))
 54
 55
 56;; We need to override get-type because
 57;; S-expression-based languages are flexible about their
 58;; syntax and don't have rigid types attached to their AST
 59;; nodes.
 60
 61;; override
 62(define get-type
 63  (lambda (node)
 64    (cond
 65     [(Expr? node)
 66      (get-keyword node)]
 67     [(Token? node) 'token]
 68     [(Comment? node) 'comment]
 69     [(Str? node) 'str]
 70     [(Char? node) 'char])))
 71
 72
 73
 74;; override
 75(define get-name
 76  (lambda (node)
 77    (let ([key (get-keyword node)])
 78      (cond
 79       [(and key (memq key *defs*))
 80        (get-symbol (cadr (Expr-elts node)))]
 81       [else #f]))))
 82
 83
 84;; (same-def? (car (parse-scheme "(define f 1)"))
 85;;            (car (parse-scheme "(define f 1)")))
 86
 87;; (different-def? (car (parse-scheme "(define f 1)"))
 88;;                 (car (parse-scheme "(define g 1)")))
 89
 90
 91
 92;-----------------------------------------
 93(define diff-scheme
 94  (lambda (file1 file2)
 95    (load "diff-scheme.ss")
 96    (diff file1 file2 parse-scheme)))
 97
 98
 99
100; (diff-scheme "tests/paredit20.el" "tests/paredit22.el")
101; (diff-scheme "tests/mk.scm" "tests/mk-c.scm")
102; (diff-scheme "tests/pass1.ss" "tests/pass2.ss")
103; (diff-scheme "parse-js.ss" "parse-cpp.ss")
104