├── .gitignore ├── README.md ├── sexp-diff-doc ├── info.rkt └── sexp-diff │ ├── info.rkt │ └── sexp-diff.scrbl ├── sexp-diff-lib ├── info.rkt └── sexp-diff │ ├── main.rkt │ ├── sexp-diff.rkt │ ├── stx-diff.rkt │ └── utils.rkt ├── sexp-diff-test ├── info.rkt └── sexp-diff │ └── tests │ ├── sexp-diff.rkt │ └── stx-diff.rkt └── sexp-diff └── info.rkt /.gitignore: -------------------------------------------------------------------------------- 1 | *~ 2 | compiled/ 3 | doc/ 4 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | sexp-diff 2 | ========= 3 | 4 | diffs s-expressions based on Levenshtein-like edit distance. 5 | 6 | Ported more or less directly from Michael Weber's Common Lisp implementation. 7 | 8 | To install: `raco pkg install sexp-diff` 9 | 10 | [Docs](http://pkg-build.racket-lang.org/doc/sexp-diff@sexp-diff/index.html) 11 | 12 | This code is in the Public Domain. 13 | -------------------------------------------------------------------------------- /sexp-diff-doc/info.rkt: -------------------------------------------------------------------------------- 1 | #lang setup/infotab 2 | 3 | (define version "0.3") 4 | 5 | (define deps '("base")) 6 | (define build-deps '("scribble-lib" "rackunit-lib" "racket-doc" "sexp-diff-lib")) 7 | -------------------------------------------------------------------------------- /sexp-diff-doc/sexp-diff/info.rkt: -------------------------------------------------------------------------------- 1 | #lang setup/infotab 2 | (define scribblings '(["sexp-diff.scrbl" () (library)])) 3 | -------------------------------------------------------------------------------- /sexp-diff-doc/sexp-diff/sexp-diff.scrbl: -------------------------------------------------------------------------------- 1 | #lang scribble/doc 2 | 3 | @(require 4 | scribble/example 5 | scribble/manual 6 | (for-label 7 | racket/base 8 | syntax/parse 9 | racket/contract)) 10 | 11 | @(define the-eval 12 | (let ([the-eval (make-base-eval)]) 13 | (the-eval '(require sexp-diff syntax/parse)) 14 | the-eval)) 15 | 16 | @begin[(require (for-label sexp-diff))] 17 | @(declare-exporting sexp-diff) 18 | 19 | @title[#:tag "top"]{sexp-diff} 20 | @author[ 21 | @author+email["Vincent St-Amour" "stamourv@racket-lang.org"] 22 | @author+email["William J. Bowman" "wjb@williamjbowman.com"] 23 | ] 24 | 25 | This package provides an S-expression-aware diffing tool based on 26 | Levenshtein-like tree edit distance. 27 | 28 | @defproc[(sexp-diff [e1 sexp?] [e2 sexp?] 29 | [#:old-marker old-marker (or/c any/c (-> any/c list?)) '#:old] 30 | [#:new-marker new-marker (or/c any/c (-> any/c list?)) '#:new]) 31 | sexp?]{ 32 | Produces a tree that corresponds to the common structure of @racket[e1] and 33 | @racket[e2], with @racket[e1]-specific parts tagged with @racket[old-marker] 34 | and @racket[e2]-specific parts tagged with @racket[new-marker]. 35 | 36 | If either @racket[old-marker] or @racket[new-marker] is a @racket[procedure?], 37 | then it will be called on the node instead of inserted as a literal in the 38 | tree. 39 | This can be used to replace the node with a new s-expression whose head is the 40 | marker, rather than inserting the marker as a sibling of the node, enabling the 41 | marker to be interpreted as a function in some DSL. 42 | It may make more sense to use this feature in @racket[stx-diff]. 43 | 44 | @examples[#:eval the-eval 45 | (sexp-diff 46 | '(define (f x) (+ (* x 2) 1)) 47 | '(define (f x) (- (* x 2) 3 1))) 48 | (sexp-diff 49 | '(define (f x) (+ (* x 2) 4 1)) 50 | '(define (f x) (- (* x 2) 5 3 1))) 51 | (sexp-diff 52 | '(define (f x) (+ (* x 2) 4 4 1)) 53 | '(define (f x) (- (* x 2) 5 5 3 1))) 54 | (sexp-diff 55 | #:old-marker '#:expected #:new-marker '#:actual 56 | '(1 2 3 4) 57 | '(1 2 2 4)) 58 | (sexp-diff 59 | #:old-marker (lambda (x) `((highlight:old ,x))) 60 | #:new-marker (lambda (x) `((highlight:new ,x))) 61 | '(1 2 3 4) 62 | '(1 2 2 4)) 63 | (sexp-diff 64 | '((1) 2 3 4) 65 | '([1] 2 2 4)) 66 | ] 67 | 68 | } 69 | 70 | @defproc[(stx-diff [e1 syntax?] [e2 syntax?] 71 | [#:old-marker old-marker (or/c any/c (-> any/c syntax?)) '#:old] 72 | [#:new-marker new-marker (or/c any/c (-> any/c syntax?)) '#:new]) 73 | syntax?]{ 74 | Produces a syntax object that corresponds to the common structure of @racket[e1] and 75 | @racket[e2], with @racket[e1]-specific parts tagged with @racket[old-marker] 76 | and @racket[e2]-specific parts tagged with @racket[new-marker]. 77 | 78 | The algorithm ignores syntax properties and source location when determining 79 | equality, instead comparing up to @racket[free-identifier=?], but attempts to 80 | reconstruct source locations and syntax properties in the generated syntax object. 81 | 82 | If either @racket[old-marker] or @racket[new-marker] is a @racket[procedure?], 83 | then it is in essence a macro that will transformer node instead of inserting a 84 | a literal as a sibling in the syntax object. 85 | The marker procedure must return a syntax object that represents a list. 86 | 87 | @examples[#:eval the-eval 88 | #:escape UNSYNTAX 89 | #:preserve-source-locations 90 | (stx-diff 91 | #'(define (f x) (+ (* x 2) 1)) 92 | #'(define (f x) (- (* x 2) 3 1))) 93 | (stx-diff 94 | #'(define (f x) (+ (* x 2) 4 1)) 95 | #'(define (f x) (- (* x 2) 5 3 1))) 96 | #;(stx-diff 97 | #:old-marker (lambda (x) #`((highlight:old #,x))) 98 | #:new-marker (lambda (x) #`((highlight:new #,x))) 99 | #'(1 2 3 4) 100 | #'(1 2 2 4)) 101 | (stx-diff 102 | #'((1) 2 3 4) 103 | #'([1] 2 2 4)) 104 | (define x1 #'((1) 2 3 4)) 105 | (define x2 #'([1] 2 2 4)) 106 | x1 107 | x2 108 | (syntax-parse (stx-diff x1 x2) 109 | [((any ...)) 110 | (map (lambda (x) 111 | (format "~a:~a" (syntax-line x) (syntax-column x))) 112 | (attribute any))]) 113 | (syntax-parse (stx-diff x1 x2) 114 | [((head any ...)) 115 | (syntax-property #'head 'paren-shape)]) 116 | ] 117 | } 118 | -------------------------------------------------------------------------------- /sexp-diff-lib/info.rkt: -------------------------------------------------------------------------------- 1 | #lang setup/infotab 2 | 3 | (define version "0.3") 4 | 5 | (define collection 'multi) 6 | 7 | (define deps '("base")) 8 | -------------------------------------------------------------------------------- /sexp-diff-lib/sexp-diff/main.rkt: -------------------------------------------------------------------------------- 1 | #lang racket/base 2 | 3 | (require 4 | "sexp-diff.rkt" 5 | "stx-diff.rkt") 6 | 7 | (provide sexp-diff stx-diff) 8 | -------------------------------------------------------------------------------- /sexp-diff-lib/sexp-diff/sexp-diff.rkt: -------------------------------------------------------------------------------- 1 | #lang racket/base 2 | 3 | ;;; sexp-diff.rkt -- diffs s-expressions based on Levenshtein-like edit distance. 4 | ;;; Ported more or less directly from Michael Weber's Common Lisp implementation. 5 | 6 | ;; This code is in the Public Domain. 7 | 8 | ;;; Description: 9 | 10 | ;; sexp-diff computes a diff between two s-expressions which minimizes 11 | ;; the number of atoms in the result tree, also counting edit 12 | ;; conditionals #:new, #:old. 13 | 14 | ;;; Todo: 15 | 16 | ;; * Support for moved subtrees 17 | ;; * The algorithm treats vectors, arrays, etc. as opaque objects 18 | ;; * This article might describe a better method (unchecked): 19 | ;; Hélène Touzet: "A linear tree edit distance algorithm for similar ordered trees" 20 | ;; LIFL - UMR CNRS 8022 - Université Lille 1 21 | ;; 59 655 Villeneuve d'Ascq cedex, France 22 | ;; Helene.Touzet@lifl.fr 23 | ;; * Format for reporting differences in improper lists is clunky 24 | 25 | 26 | ;;; Code: 27 | 28 | (require 29 | racket/list 30 | "utils.rkt") 31 | 32 | (provide sexp-diff) 33 | 34 | (define size (tree-size pair? map)) 35 | 36 | (define make-deletion-record 37 | (make-deletion-record-constructor size)) 38 | 39 | (define make-insertion-record 40 | (make-insertion-record-constructor size)) 41 | 42 | (define make-update-record 43 | (make-update-record-constructor size)) 44 | 45 | (define make-unchanged-record 46 | (make-unchanged-record-constructor size)) 47 | 48 | (define-values (make-compound-record 49 | make-empty-compound-record 50 | make-extend-compound-record) 51 | (make-compound-record-constructors map)) 52 | 53 | (define initial-distance 54 | (make-initial-distance make-empty-compound-record 55 | make-extend-compound-record)) 56 | 57 | (define (render-difference record old-marker new-marker) 58 | (cond [(insertion-record? record) 59 | (new-marker (insertion-record-change record))] 60 | [(deletion-record? record) 61 | (old-marker (deletion-record-change record))] 62 | [(update-record? record) 63 | `(,@(old-marker (update-record-old record)) 64 | ,@(new-marker (update-record-new record)))] 65 | [(unchanged-record? record) 66 | (list (unchanged-record-change record))] 67 | [(compound-record? record) 68 | (list (for/fold ((res '())) 69 | ((r (reverse (compound-record-changes record)))) 70 | (append res (render-difference r old-marker new-marker))))])) 71 | 72 | ;; Calculates the minimal edits needed to transform OLD-TREE into NEW-TREE. 73 | ;; It minimizes the number of atoms in the result tree, also counting 74 | ;; edit conditionals. 75 | (define (levenshtein-tree-edit old-tree new-tree) 76 | (cond 77 | ((equal? old-tree new-tree) 78 | (make-unchanged-record old-tree)) 79 | ((not (and (pair? old-tree) (pair? new-tree))) 80 | (make-update-record old-tree new-tree)) 81 | (else 82 | (min/edit 83 | (make-update-record old-tree new-tree) 84 | (let* ((best-edit #f) 85 | (row (initial-distance make-deletion-record old-tree)) 86 | (col (initial-distance make-insertion-record new-tree))) 87 | (for ((new-part (in-list new-tree)) 88 | (current (in-list (drop (vector->list col) 1)))) 89 | (for ((old-part (in-list old-tree)) 90 | (row-idx (in-naturals))) 91 | (set! best-edit (min/edit (make-extend-compound-record (vector-ref row (add1 row-idx)) 92 | (make-insertion-record new-part)) 93 | (make-extend-compound-record current 94 | (make-deletion-record old-part)) 95 | (make-extend-compound-record (vector-ref row row-idx) 96 | (levenshtein-tree-edit old-part new-part)))) 97 | (vector-set! row row-idx current) 98 | (set! current best-edit)) 99 | (vector-set! row (sub1 (vector-length row)) best-edit)) 100 | best-edit))))) 101 | 102 | ;; Computes a diff between OLD-TREE and NEW-TREE which minimizes the 103 | ;; number of atoms in the result tree, also counting inserted edit conditionals 104 | ;; #:new, #:old. 105 | (define (sexp-diff old-tree new-tree 106 | #:old-marker [old-marker '#:old] 107 | #:new-marker [new-marker '#:new]) 108 | (let ([old-marker-proc 109 | (if (procedure? old-marker) 110 | old-marker 111 | (lambda (x) 112 | `(,old-marker ,x)))] 113 | [new-marker-proc 114 | (if (procedure? new-marker) 115 | new-marker 116 | (lambda (x) 117 | `(,new-marker ,x)))]) 118 | (render-difference (levenshtein-tree-edit old-tree new-tree) 119 | old-marker-proc new-marker-proc))) 120 | -------------------------------------------------------------------------------- /sexp-diff-lib/sexp-diff/stx-diff.rkt: -------------------------------------------------------------------------------- 1 | #lang racket/base 2 | 3 | ;;; stx-diff.rkt -- diffs syntax objects based on Levenshtein-like edit distance. 4 | ;;; Ported more or less directly from Michael Weber's Common Lisp implementation. 5 | 6 | ;; This code is in the Public Domain. 7 | 8 | ;;; Description: 9 | 10 | ;; stx-diff computes a diff between two syntax objects which minimizes 11 | ;; the number of atoms in the result tree, also counting edit 12 | ;; conditionals #:new, #:old, and attempts to preserve syntax properties and 13 | ;; maintain sensible source location information. 14 | 15 | (require 16 | syntax/stx 17 | racket/list 18 | syntax/srcloc 19 | "utils.rkt") 20 | 21 | (provide stx-diff) 22 | 23 | (define stx-size (tree-size stx-pair? stx-map)) 24 | 25 | (define make-deletion-record 26 | (make-deletion-record-constructor stx-size)) 27 | 28 | (define make-insertion-record 29 | (make-insertion-record-constructor stx-size)) 30 | 31 | (define make-update-record 32 | (make-update-record-constructor stx-size)) 33 | 34 | (define make-unchanged-record 35 | (make-unchanged-record-constructor stx-size)) 36 | 37 | (define-values (make-compound-record 38 | make-empty-compound-record 39 | make-extend-compound-record) 40 | (make-compound-record-constructors stx-map)) 41 | 42 | (struct compound-stx-record compound-record (props srcloc)) 43 | 44 | (define (make-inherit-compound-stx-record props srcloc super) 45 | (compound-stx-record 46 | (edit-record-edit-distance super) 47 | (compound-record-changes super) 48 | props 49 | srcloc)) 50 | 51 | (define (make-compound-stx-record props srcloc changes) 52 | (make-inherit-compound-stx-record 53 | props srcloc 54 | (make-compound-record changes))) 55 | 56 | (define (make-empty-compound-stx-record props srcloc) 57 | (make-inherit-compound-stx-record 58 | props srcloc 59 | (make-empty-compound-record))) 60 | 61 | (define (make-extend-compound-stx-record props srcloc r0 record) 62 | (make-inherit-compound-stx-record 63 | props srcloc 64 | (make-extend-compound-record r0 record))) 65 | 66 | (require racket/function) 67 | (define initial-distance 68 | (make-initial-distance (lambda () 69 | (make-empty-compound-stx-record '() 70 | (build-source-location-syntax #f))) 71 | (curry make-extend-compound-stx-record '() 72 | (build-source-location-syntax #f)))) 73 | 74 | #;(define (initial-distance function stx) 75 | (let ([lst (syntax->list stx)]) 76 | (let ((seq (make-vector (add1 (length lst)) (make-empty-compound-stx-record '() #f)))) 77 | (for ((i (in-naturals)) 78 | (elt (in-list lst))) 79 | (vector-set! seq (add1 i) 80 | (make-extend-compound-stx-record 81 | (syntax-property ) 82 | (vector-ref seq i) 83 | (function elt)))) 84 | seq))) 85 | 86 | (require racket/dict) 87 | (define (extract-props stx) 88 | (for/fold ([d '()]) 89 | ([key (syntax-property-symbol-keys stx)]) 90 | (dict-set d key (syntax-property stx key)))) 91 | 92 | (define (assign-props props stx) 93 | (for/fold ([stx stx]) 94 | ([(key value) (in-dict props)]) 95 | (syntax-property stx key value))) 96 | 97 | (define (render-difference record old-marker new-marker) 98 | (cond [(insertion-record? record) 99 | (quasisyntax/loc (insertion-record-change record) 100 | (#,@(new-marker (insertion-record-change record))))] 101 | [(deletion-record? record) 102 | (quasisyntax/loc (build-source-location-syntax #f) 103 | (#,@(old-marker (deletion-record-change record))))] 104 | [(update-record? record) 105 | (quasisyntax/loc (update-record-new record) 106 | (#,@(old-marker (update-record-old record)) 107 | #,@(new-marker (update-record-new record))))] 108 | [(unchanged-record? record) 109 | (quasisyntax/loc (unchanged-record-change record) 110 | (#,(unchanged-record-change record)))] 111 | [(compound-stx-record? record) 112 | (quasisyntax/loc (compound-stx-record-srcloc record) 113 | (#,(for/fold ((res '())) 114 | ((r (reverse (compound-record-changes record)))) 115 | (let ([c (render-difference r old-marker new-marker)]) 116 | (assign-props 117 | (compound-stx-record-props record) 118 | (quasisyntax/loc (compound-stx-record-srcloc record) 119 | (#,@res #,@c)))))))])) 120 | 121 | ;; Calculates the minimal edits needed to transform OLD-TREE into NEW-TREE. 122 | ;; It minimizes the number of atoms in the result tree, also counting 123 | ;; edit conditionals. 124 | (define (maybe/free-identifier=? id1 id2) 125 | (and (identifier? id1) (identifier? id2) (free-identifier=? id1 id2))) 126 | 127 | (define (levenshtein-stx-edit old-stx new-stx) 128 | (cond 129 | ((maybe/free-identifier=? old-stx new-stx) 130 | (make-unchanged-record new-stx)) 131 | ((and 132 | (or (not (identifier? old-stx)) 133 | (not (identifier? new-stx))) 134 | (equal? (syntax->datum old-stx) 135 | (syntax->datum new-stx))) 136 | (make-unchanged-record new-stx)) 137 | ((not (and (stx-pair? old-stx) (stx-pair? new-stx))) 138 | (make-update-record old-stx new-stx)) 139 | (else 140 | (min/edit 141 | (make-update-record old-stx new-stx) 142 | (let* ((best-edit #f) 143 | (row (initial-distance make-deletion-record (syntax->list old-stx))) 144 | (col (initial-distance make-insertion-record (syntax->list new-stx)))) 145 | (for ((new-part (in-list (syntax->list new-stx))) 146 | (current (in-list (drop (vector->list col) 1)))) 147 | (for ((old-part (in-list (syntax->list old-stx))) 148 | (row-idx (in-naturals))) 149 | (set! best-edit (min/edit (make-extend-compound-stx-record 150 | (extract-props new-stx) 151 | new-stx 152 | (vector-ref row (add1 row-idx)) 153 | (make-insertion-record new-part)) 154 | (make-extend-compound-stx-record 155 | (extract-props old-stx) 156 | new-stx 157 | current 158 | (make-deletion-record old-part)) 159 | (make-extend-compound-stx-record 160 | (extract-props new-stx) 161 | new-stx 162 | (vector-ref row row-idx) 163 | (levenshtein-stx-edit old-part new-part)))) 164 | (vector-set! row row-idx current) 165 | (set! current best-edit)) 166 | (vector-set! row (sub1 (vector-length row)) best-edit)) 167 | best-edit))))) 168 | 169 | ;; Computes a diff between OLD-STX and NEW-STX which minimizes the 170 | ;; number of atoms in the result tree, also counting inserted edit conditionals 171 | ;; #:new, #:old. 172 | (define (stx-diff old-stx new-stx 173 | #:old-marker [old-marker '#:old] 174 | #:new-marker [new-marker '#:new]) 175 | 176 | (let ([old-marker-proc 177 | (if (procedure? old-marker) 178 | old-marker 179 | (lambda (x) 180 | (quasisyntax/loc x 181 | (#,old-marker #,x))))] 182 | [new-marker-proc 183 | (if (procedure? new-marker) 184 | new-marker 185 | (lambda (x) 186 | (quasisyntax/loc x 187 | (#,new-marker #,x))))]) 188 | (render-difference (levenshtein-stx-edit old-stx new-stx) 189 | old-marker-proc new-marker-proc))) 190 | -------------------------------------------------------------------------------- /sexp-diff-lib/sexp-diff/utils.rkt: -------------------------------------------------------------------------------- 1 | #lang racket/base 2 | 3 | (provide (all-defined-out)) 4 | 5 | (struct edit-record (edit-distance)) 6 | 7 | (struct unchanged-record edit-record (change)) 8 | 9 | (struct deletion-record edit-record (change)) 10 | 11 | (define ((make-deletion-record-constructor tree-size) change) 12 | (deletion-record (add1 (tree-size change)) change)) 13 | 14 | (struct insertion-record edit-record (change)) 15 | 16 | (define ((make-insertion-record-constructor tree-size) 17 | change) 18 | (insertion-record (add1 (tree-size change)) change)) 19 | 20 | (struct update-record edit-record (old new)) 21 | 22 | (define ((make-update-record-constructor 23 | tree-size) old new) 24 | (update-record (+ 1 (tree-size old) 25 | 1 (tree-size new)) 26 | old new)) 27 | 28 | (define ((make-unchanged-record-constructor 29 | tree-size) change) 30 | (unchanged-record (tree-size change) change)) 31 | 32 | (struct compound-record edit-record (changes)) 33 | 34 | (define (make-compound-record-constructors 35 | tree-map) 36 | (let ([make-compound-record 37 | (lambda (changes) 38 | (compound-record (apply + (tree-map edit-record-edit-distance changes)) changes))]) 39 | (values 40 | make-compound-record 41 | (lambda () (make-compound-record '())) 42 | (lambda (r0 record) 43 | (make-compound-record (cons record (get-change r0))))))) 44 | 45 | (define (get-change record) 46 | (cond [(unchanged-record? record) (unchanged-record-change record)] 47 | [(deletion-record? record) (deletion-record-change record)] 48 | [(insertion-record? record) (insertion-record-change record)] 49 | [(compound-record? record) (compound-record-changes record)])) 50 | 51 | ;; Computes the number of atoms contained in TREE. 52 | (define ((tree-size [tree? pair?] [tree-map map]) 53 | tree) 54 | (let loop ([tree tree]) 55 | (if (tree? tree) 56 | (apply + 1 (tree-map loop tree)) 57 | 1))) 58 | 59 | ;; Returns record with minimum edit distance. 60 | (define (min/edit record . records) 61 | (foldr (lambda (a b) (if (<= (edit-record-edit-distance a) 62 | (edit-record-edit-distance b)) 63 | a b)) 64 | record records)) 65 | 66 | ;; Prepares initial data vectors for Levenshtein algorithm from LST. 67 | (define ((make-initial-distance make-empty-compound-record make-extend-compound-record) 68 | function lst) 69 | (let ((seq (make-vector (add1 (length lst)) (make-empty-compound-record)))) 70 | (for ((i (in-naturals)) 71 | (elt (in-list lst))) 72 | (vector-set! seq (add1 i) 73 | (make-extend-compound-record (vector-ref seq i) 74 | (function elt)))) 75 | seq)) 76 | -------------------------------------------------------------------------------- /sexp-diff-test/info.rkt: -------------------------------------------------------------------------------- 1 | #lang setup/infotab 2 | 3 | (define version "0.3") 4 | 5 | (define collection 'multi) 6 | 7 | (define deps '("base" "rackunit-lib" "sexp-diff-lib")) 8 | -------------------------------------------------------------------------------- /sexp-diff-test/sexp-diff/tests/sexp-diff.rkt: -------------------------------------------------------------------------------- 1 | #lang racket/base 2 | 3 | (require 4 | sexp-diff 5 | rackunit) 6 | 7 | (check-equal? 8 | (sexp-diff 9 | '(define (f x) (+ (* x 2) 1)) 10 | '(define (f x) (- (* x 2) 3 1))) 11 | '((define (f x) (#:new - #:old + (* x 2) #:new 3 1)))) 12 | 13 | (check-equal? 14 | (sexp-diff 15 | '(define (f x) (+ (* x 2) 4 1)) 16 | '(define (f x) (- (* x 2) 5 3 1))) 17 | '((define (f x) (#:new - #:old + (* x 2) #:new 5 #:new 3 #:old 4 1)))) 18 | 19 | (check-equal? 20 | (sexp-diff 21 | '(define (f x) (+ (* x 2) 4 4 1)) 22 | '(define (f x) (- (* x 2) 5 5 3 1))) 23 | '((define (f x) 24 | (#:new - #:old + (* x 2) #:new 5 #:new 5 #:new 3 #:old 4 #:old 4 1)))) 25 | 26 | (check-equal? 27 | (sexp-diff 28 | #:old-marker '#:expected #:new-marker '#:actual 29 | '(1 2 3 4) 30 | '(1 2 2 4)) 31 | '((1 #:actual 2 2 #:expected 3 4))) 32 | 33 | (check-equal? 34 | (sexp-diff 35 | '(define (f x) (+ (* x 2) 1)) 36 | '(define (f x) (- (* x 2) 3 1)) 37 | #:old-marker (lambda (x) 38 | `((highlight:old ,x))) 39 | #:new-marker (lambda (x) 40 | `((highlight:new ,x)))) 41 | '((define (f x) ((highlight:new -) (highlight:old +) (* x 2) (highlight:new 3) 1)))) 42 | -------------------------------------------------------------------------------- /sexp-diff-test/sexp-diff/tests/stx-diff.rkt: -------------------------------------------------------------------------------- 1 | #lang racket/base 2 | 3 | (require 4 | sexp-diff 5 | rackunit) 6 | 7 | (check-equal? 8 | (syntax->datum 9 | (stx-diff 10 | #'(define (f x) (+ (* x 2) 1)) 11 | #'(define (f x) (- (* x 2) 3 1)))) 12 | '((define (f x) (#:new - #:old + (* x 2) #:new 3 1)))) 13 | 14 | (check-equal? 15 | (syntax->datum 16 | (stx-diff 17 | #'(define (f x) (+ (* x 2) 4 1)) 18 | #'(define (f x) (- (* x 2) 5 3 1)))) 19 | '((define (f x) (#:new - #:old + (* x 2) #:new 5 #:new 3 #:old 4 1)))) 20 | 21 | (check-equal? 22 | (syntax->datum 23 | (stx-diff 24 | #'(define (f x) (+ (* x 2) 4 4 1)) 25 | #'(define (f x) (- (* x 2) 5 5 3 1)))) 26 | '((define (f x) 27 | (#:new - #:old + (* x 2) #:new 5 #:new 5 #:new 3 #:old 4 #:old 4 1)))) 28 | 29 | (check-equal? 30 | (syntax->datum 31 | (stx-diff 32 | #:old-marker '#:expected #:new-marker '#:actual 33 | #'(1 2 3 4) 34 | #'(1 2 2 4))) 35 | '((1 #:actual 2 2 #:expected 3 4))) 36 | 37 | (check-equal? 38 | (syntax->datum 39 | (stx-diff 40 | #'(define (f x) (+ (* x 2) 1)) 41 | #'(define (f x) (- (* x 2) 3 1)) 42 | #:old-marker (lambda (x) 43 | #`((highlight:old #,x))) 44 | #:new-marker (lambda (x) 45 | #`((highlight:new #,x))))) 46 | '((define (f x) ((highlight:new -) (highlight:old +) (* x 2) (highlight:new 3) 1)))) 47 | 48 | (require syntax/parse) 49 | (let ([diff (stx-diff 50 | #'((1) 2 3 4) 51 | #'([1] 2 2 4))]) 52 | (check-equal? 53 | (syntax-parse diff 54 | [((head any ...)) 55 | (syntax-property #'head 'paren-shape)]) 56 | #\[) 57 | 58 | (check-false 59 | (syntax-property diff 'paren-shape))) 60 | 61 | (let ([diff 62 | (stx-diff 63 | #'(e integer? (let ([x e]) e)) 64 | #'(e (let ([x v]) v) (v integer?)))]) 65 | 66 | (check-false 67 | (syntax-parse diff 68 | [((_ _ _ (let bs _ ...) . _)) 69 | (syntax-property #'bs 'paren-shape)])) 70 | 71 | (check-equal? 72 | (syntax-parse diff 73 | [((_ _ _ (let (b) _ ...) . _)) 74 | (syntax-property #'b 'paren-shape)]) 75 | #\[)) 76 | -------------------------------------------------------------------------------- /sexp-diff/info.rkt: -------------------------------------------------------------------------------- 1 | #lang setup/infotab 2 | 3 | (define version "0.3") 4 | 5 | (define collection 'multi) 6 | 7 | (define deps '("sexp-diff-lib" "sexp-diff-doc" "sexp-diff-test")) 8 | (define implies '("sexp-diff-lib" "sexp-diff-doc" "sexp-diff-test")) 9 | --------------------------------------------------------------------------------