/diff-scheme.ss
Scheme | 104 lines | 41 code | 31 blank | 32 comment | 3 complexity | 1c1b47010f2fc8c9285bdac46aab6486 MD5 | raw file
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