syndicate-lang
/
minimart-2014
1
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

The appropriate unit to elide varies with the nesting level.

This commit is contained in:
Tony Garnock-Jones 2014-05-16 12:38:19 -04:00
parent 649b1b8e82
commit 25a912c900
1 changed files with 4 additions and 4 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

8
minimart/gestalt.rkt
View File

@ -96,7 +96,7 @@
(andmap (lambda (ls) (andmap (lambda (l) (and (matcher-empty? (car l)) (matcher-empty? (cdr l)))) ls))
(gestalt-metalevels g)))
(define (map-zip imbalance-handler item-handler ls1 ls2)
(define (map-zip imbalance-handler item-handler right-unit ls1 ls2)
(let walk ((ls1 ls1) (ls2 ls2))
(match* (ls1 ls2)
[('() '()) '()]
@ -105,13 +105,13 @@
[((cons l1 ls1) (cons l2 ls2))
(define new-item (item-handler l1 l2))
(define new-tail (walk ls1 ls2))
(if (and (null? new-tail) (equal? new-item '(#f . #f)))
(if (and (null? new-tail) (equal? new-item right-unit))
'()
(cons new-item new-tail))])))
(define (gestalt-combine g1 g2 imbalance-handler matcher-pair-combiner)
(define (yu ls1 ls2) (map-zip imbalance-handler matcher-pair-combiner ls1 ls2))
(define (xu mls1 mls2) (map-zip imbalance-handler yu mls1 mls2))
(define (yu ls1 ls2) (map-zip imbalance-handler matcher-pair-combiner '(#f . #f) ls1 ls2))
(define (xu mls1 mls2) (map-zip imbalance-handler yu '() mls1 mls2))
(gestalt (xu (gestalt-metalevels g1)
(gestalt-metalevels g2))))