104 lines
3.9 KiB
Racket
104 lines
3.9 KiB
Racket
|
#lang racket
|
||
|
|
||
|
(require racket/trace)
|
||
|
|
||
|
(struct DISCARD ())
|
||
|
(struct CAPTURE (p))
|
||
|
|
||
|
(define (q p)
|
||
|
(match p
|
||
|
[(DISCARD) `(discard)]
|
||
|
[(CAPTURE p) `(capture ,(q p))]
|
||
|
[`(discard) `('discard)]
|
||
|
[`(capture ,p) `('capture ,(q p))]
|
||
|
[`(quote ,p) `('quote ,(q p))]
|
||
|
[`(,pa . ,pd) `(,(q pa) . ,(q pd))]
|
||
|
[a a]))
|
||
|
|
||
|
(define (uq p)
|
||
|
(match p
|
||
|
[`(discard) (DISCARD)]
|
||
|
[`(capture ,p) (CAPTURE (uq p))]
|
||
|
[`(quote ,p) p]
|
||
|
[`(,pa . ,pd) `(,(uq pa) . ,(uq pd))]
|
||
|
[a a]))
|
||
|
|
||
|
;; Goal: (uq (q p)) === p
|
||
|
|
||
|
;; (define (m p v k)
|
||
|
;; (match* (p v)
|
||
|
;; [(`(discard) _) (k '())]
|
||
|
;; [(`(capture ,p) v) (m p v (lambda (bs) (cons v bs)))]
|
||
|
;; [(`(quote ,p) v) (and (equal? p v) (k '()))]
|
||
|
;; [(`(,pa . ,pd) `(,va . ,vd)) (m pa va (lambda (bs) (m pd vd (lambda (cs) (k (append bs cs))))))]
|
||
|
;; [(p v) (and (equal? p v) (k '()))]))
|
||
|
|
||
|
(define (m p v k)
|
||
|
(match* (p v)
|
||
|
[((DISCARD) _) (k '())]
|
||
|
[((CAPTURE p) v) (m p v (lambda (bs) (cons v bs)))]
|
||
|
[(`(,pa . ,pd) `(,va . ,vd)) (m pa va (lambda (bs) (m pd vd (lambda (cs) (k (append bs cs))))))]
|
||
|
[(p v) (and (equal? p v) (k '()))]))
|
||
|
|
||
|
;; (trace m)
|
||
|
|
||
|
(module+ test
|
||
|
(require rackunit)
|
||
|
;; (define (M p v) (m p v values))
|
||
|
(define (M p v) (m (uq p) v values))
|
||
|
(check-equal? (M `(capture 1) 1) '(1))
|
||
|
(check-equal? (M `(discard) 1) '())
|
||
|
(check-equal? (M 1 1) '())
|
||
|
(check-equal? (M 2 1) #f)
|
||
|
(check-equal? (M `(capture 2) 1) #f)
|
||
|
|
||
|
(check-equal? (M `(record (capture (discard))) `(record value)) '(value))
|
||
|
(check-equal? (M `(record (capture (discard))) `(record 'value)) '('value))
|
||
|
(check-equal? (M `(record (capture (discard))) `(record (capture (discard))))
|
||
|
'((capture (discard))))
|
||
|
|
||
|
(check-equal? (M `(record ('capture (discard))) `(record (capture (discard))))
|
||
|
'())
|
||
|
(check-equal? (M `(record (capture ('capture (discard)))) `(record (capture (discard))))
|
||
|
'((capture (discard))))
|
||
|
(check-equal? (M `(record (capture ('capture (discard)))) `(record value))
|
||
|
#f)
|
||
|
(check-equal? (M `(record (capture ('capture (discard)))) `(record 'value))
|
||
|
#f)
|
||
|
(check-equal? (M `(record (capture ('capture (discard)))) `(record ('capture (discard))))
|
||
|
#f)
|
||
|
|
||
|
(check-equal? (M `(record '(capture (discard))) `(record (capture (discard))))
|
||
|
'())
|
||
|
(check-equal? (M `(record (capture '(capture (discard)))) `(record (capture (discard))))
|
||
|
'((capture (discard))))
|
||
|
(check-equal? (M `(record (capture '(capture (discard)))) `(record value))
|
||
|
#f)
|
||
|
(check-equal? (M `(record (capture '(capture (discard)))) `(record 'value))
|
||
|
#f)
|
||
|
(check-equal? (M `(record (capture '(capture (discard)))) `(record '(capture (discard))))
|
||
|
#f)
|
||
|
|
||
|
(check-equal? (M `(record ('quote value)) `(record (capture (discard)))) #f)
|
||
|
(check-equal? (M `(record (capture ('quote value))) `(record (capture (discard)))) #f)
|
||
|
(check-equal? (M `(record (capture ('quote value))) `(record value)) #f)
|
||
|
(check-equal? (M `(record (capture ('quote value))) `(record 'value)) '('value))
|
||
|
(check-equal? (M `(record (capture ('quote value))) `(record 'notvalue)) #f)
|
||
|
(check-equal? (M `(record ('quote value)) `(record 'value)) '())
|
||
|
(check-equal? (M `(record (capture ('quote value))) `(record ('quote value))) #f)
|
||
|
|
||
|
(check-equal? (M `(record ''value) `(record (capture (discard)))) #f)
|
||
|
(check-equal? (M `(record (capture ''value)) `(record (capture (discard)))) #f)
|
||
|
(check-equal? (M `(record (capture ''value)) `(record value)) #f)
|
||
|
(check-equal? (M `(record (capture ''value)) `(record 'value)) '('value))
|
||
|
(check-equal? (M `(record (capture ''value)) `(record 'notvalue)) #f)
|
||
|
(check-equal? (M `(record ''value) `(record 'value)) '())
|
||
|
(check-equal? (M `(record (capture ''value)) `(record ''value)) #f)
|
||
|
|
||
|
(check-equal? (q (CAPTURE 1)) `(capture 1))
|
||
|
(check-equal? (q (DISCARD)) `(discard))
|
||
|
(check-equal? (q `(capture 1)) `('capture 1))
|
||
|
(check-equal? (q `(discard)) `('discard))
|
||
|
|
||
|
)
|