PageRenderTime 38ms CodeModel.GetById 18ms RepoModel.GetById 0ms app.codeStats 0ms

/diff-scheme.ss

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