gestalt-transform
This commit is contained in:
parent
53d0a67e96
commit
dbb7e8fe67
|
@ -19,6 +19,7 @@
|
||||||
gestalt-filter
|
gestalt-filter
|
||||||
gestalt-match
|
gestalt-match
|
||||||
gestalt-erase-path
|
gestalt-erase-path
|
||||||
|
gestalt-transform
|
||||||
strip-gestalt-label
|
strip-gestalt-label
|
||||||
label-gestalt
|
label-gestalt
|
||||||
pretty-print-gestalt
|
pretty-print-gestalt
|
||||||
|
@ -71,9 +72,6 @@
|
||||||
'()
|
'()
|
||||||
(cons a d)))
|
(cons a d)))
|
||||||
|
|
||||||
(define (guarded-map gcons f xs)
|
|
||||||
(foldr (lambda (e acc) (gcons (f e) acc)) '() xs))
|
|
||||||
|
|
||||||
(define empty-level '(#f . #f))
|
(define empty-level '(#f . #f))
|
||||||
(define empty-metalevel '())
|
(define empty-metalevel '())
|
||||||
|
|
||||||
|
@ -233,11 +231,18 @@
|
||||||
[(left-longer) x]
|
[(left-longer) x]
|
||||||
[(right-longer) '()]))
|
[(right-longer) '()]))
|
||||||
|
|
||||||
|
(define (gestalt-transform g f)
|
||||||
|
(gestalt (let loop-outer ((mls (gestalt-metalevels g)) (i 0))
|
||||||
|
(cond [(null? mls) '()]
|
||||||
|
[else (cons-metalevel
|
||||||
|
(let loop-inner ((ls (car mls)) (j 0))
|
||||||
|
(cond [(null? ls) '()]
|
||||||
|
[else (cons-level (f i j (car ls))
|
||||||
|
(loop-inner (cdr ls) (+ j 1)))]))
|
||||||
|
(loop-outer (cdr mls) (+ i 1)))]))))
|
||||||
|
|
||||||
(define (gestalt-matcher-transform g f)
|
(define (gestalt-matcher-transform g f)
|
||||||
(gestalt (guarded-map cons-metalevel
|
(gestalt-transform g (lambda (i j p) (cons (f (car p)) (f (cdr p))))))
|
||||||
(lambda (ls)
|
|
||||||
(guarded-map cons-level (lambda (p) (cons (f (car p)) (f (cdr p)))) ls))
|
|
||||||
(gestalt-metalevels g))))
|
|
||||||
|
|
||||||
(define (strip-gestalt-label g)
|
(define (strip-gestalt-label g)
|
||||||
(gestalt-matcher-transform g (lambda (m) (matcher-relabel m (lambda (v) #t)))))
|
(gestalt-matcher-transform g (lambda (m) (matcher-relabel m (lambda (v) #t)))))
|
||||||
|
|
Loading…
Reference in New Issue