Rearrange
This commit is contained in:
parent
883fcb9b75
commit
1d67cbe65e
|
@ -1,47 +0,0 @@
|
||||||
#lang racket/base
|
|
||||||
|
|
||||||
(require rackunit)
|
|
||||||
|
|
||||||
(require (for-syntax racket/base))
|
|
||||||
(require (for-syntax "pattern.rkt"))
|
|
||||||
(require "pattern.rkt")
|
|
||||||
|
|
||||||
(struct foo (bar zot) #:prefab)
|
|
||||||
|
|
||||||
(define-syntax (check-analyse-pattern stx)
|
|
||||||
(syntax-case stx ()
|
|
||||||
[(_ expected-pat actual-stxpat fn)
|
|
||||||
#`(check-match (fn '#,(analyse-pattern #'actual-stxpat)) expected-pat)]
|
|
||||||
[(_ expected-pat actual-stxpat)
|
|
||||||
#'(check-analyse-pattern expected-pat actual-stxpat values)]))
|
|
||||||
|
|
||||||
(check-analyse-pattern `(compound ,_ (atom 123) (atom 234)) (foo 123 234))
|
|
||||||
(check-analyse-pattern `(compound ,_ (discard) (atom 234)) (foo _ 234))
|
|
||||||
(check-analyse-pattern `(compound ,_ (atom 123) (atom xyzzy)) (foo 123 xyzzy))
|
|
||||||
(check-analyse-pattern `(compound ,_ (atom 123) (capture cap (discard))) (foo 123 $cap))
|
|
||||||
(check-analyse-pattern `(compound ,_ (atom 123) (capture cap (atom 234))) (foo 123 ($ cap 234)))
|
|
||||||
|
|
||||||
(check-analyse-pattern `(atom (bar 123 234)) (bar 123 234))
|
|
||||||
(check-analyse-pattern `(atom (bar 123 $beep)) (bar 123 $beep))
|
|
||||||
|
|
||||||
(check-analyse-pattern `(compound list (atom 123) (capture q (discard))) (list 123 $q))
|
|
||||||
|
|
||||||
(define ((s->d f) desc) (syntax->datum (f desc)))
|
|
||||||
|
|
||||||
(check-analyse-pattern '() $cap desc->key)
|
|
||||||
(check-analyse-pattern '() $cap desc->skeleton-proj)
|
|
||||||
(check-analyse-pattern '((0)) $cap desc->capture-proj)
|
|
||||||
(check-analyse-pattern '#f $cap (s->d desc->skeleton-stx))
|
|
||||||
(check-analyse-pattern '? $cap (s->d desc->assertion-stx))
|
|
||||||
|
|
||||||
(check-analyse-pattern '(123) (foo 123 $cap) desc->key)
|
|
||||||
(check-analyse-pattern '((0 0)) (foo 123 $cap) desc->skeleton-proj)
|
|
||||||
(check-analyse-pattern '((0 1)) (foo 123 $cap) desc->capture-proj)
|
|
||||||
(check-analyse-pattern '(list foo? #f #f) (foo 123 $cap) (s->d desc->skeleton-stx))
|
|
||||||
(check-analyse-pattern '(foo 123 ?) (foo 123 $cap) (s->d desc->assertion-stx))
|
|
||||||
|
|
||||||
(check-analyse-pattern '((bar 'beep)) (foo (bar 'beep) $cap) desc->key)
|
|
||||||
(check-analyse-pattern '((0 0)) (foo (bar 'beep) $cap) desc->skeleton-proj)
|
|
||||||
(check-analyse-pattern '((0 1)) (foo (bar 'beep) $cap) desc->capture-proj)
|
|
||||||
(check-analyse-pattern '(list foo? #f #f) (foo (bar 'beep) $cap) (s->d desc->skeleton-stx))
|
|
||||||
(check-analyse-pattern '(foo (bar 'beep) ?) (foo (bar 'beep) $cap) (s->d desc->assertion-stx))
|
|
|
@ -1,6 +1,11 @@
|
||||||
#lang racket/base
|
#lang racket/base
|
||||||
|
|
||||||
(provide (all-defined-out))
|
(provide analyse-pattern
|
||||||
|
desc->key
|
||||||
|
desc->skeleton-proj
|
||||||
|
desc->capture-proj
|
||||||
|
desc->skeleton-stx
|
||||||
|
desc->assertion-stx)
|
||||||
|
|
||||||
(require racket/match)
|
(require racket/match)
|
||||||
(require racket/struct-info)
|
(require racket/struct-info)
|
||||||
|
|
|
@ -0,0 +1,50 @@
|
||||||
|
#lang racket/base
|
||||||
|
|
||||||
|
(module+ test
|
||||||
|
(require rackunit)
|
||||||
|
|
||||||
|
(require (for-syntax racket/base))
|
||||||
|
(require (for-syntax "pattern.rkt"))
|
||||||
|
(require "pattern.rkt")
|
||||||
|
|
||||||
|
(struct foo (bar zot) #:prefab)
|
||||||
|
|
||||||
|
(define-syntax (check-analyse-pattern stx)
|
||||||
|
(syntax-case stx ()
|
||||||
|
[(_ expected-pat actual-stxpat fn)
|
||||||
|
#`(check-match (fn '#,(analyse-pattern #'actual-stxpat)) expected-pat)]
|
||||||
|
[(_ expected-pat actual-stxpat)
|
||||||
|
#'(check-analyse-pattern expected-pat actual-stxpat values)]))
|
||||||
|
|
||||||
|
(check-analyse-pattern `(compound ,_ (atom 123) (atom 234)) (foo 123 234))
|
||||||
|
(check-analyse-pattern `(compound ,_ (discard) (atom 234)) (foo _ 234))
|
||||||
|
(check-analyse-pattern `(compound ,_ (atom 123) (atom xyzzy)) (foo 123 xyzzy))
|
||||||
|
(check-analyse-pattern `(compound ,_ (atom 123) (capture cap (discard))) (foo 123 $cap))
|
||||||
|
(check-analyse-pattern `(compound ,_ (atom 123) (capture cap (atom 234))) (foo 123 ($ cap 234)))
|
||||||
|
|
||||||
|
(check-analyse-pattern `(atom (bar 123 234)) (bar 123 234))
|
||||||
|
(check-analyse-pattern `(atom (bar 123 $beep)) (bar 123 $beep))
|
||||||
|
|
||||||
|
(check-analyse-pattern `(compound list (atom 123) (capture q (discard))) (list 123 $q))
|
||||||
|
|
||||||
|
(define ((s->d f) desc) (syntax->datum (f desc)))
|
||||||
|
|
||||||
|
(check-analyse-pattern '() $cap desc->key)
|
||||||
|
(check-analyse-pattern '() $cap desc->skeleton-proj)
|
||||||
|
(check-analyse-pattern '((0)) $cap desc->capture-proj)
|
||||||
|
(check-analyse-pattern '#f $cap (s->d desc->skeleton-stx))
|
||||||
|
(check-analyse-pattern '? $cap (s->d desc->assertion-stx))
|
||||||
|
|
||||||
|
(check-analyse-pattern '(123) (foo 123 $cap) desc->key)
|
||||||
|
(check-analyse-pattern '((0 0)) (foo 123 $cap) desc->skeleton-proj)
|
||||||
|
(check-analyse-pattern '((0 1)) (foo 123 $cap) desc->capture-proj)
|
||||||
|
(check-analyse-pattern '(list foo? #f #f) (foo 123 $cap) (s->d desc->skeleton-stx))
|
||||||
|
(check-analyse-pattern '(foo 123 ?) (foo 123 $cap) (s->d desc->assertion-stx))
|
||||||
|
|
||||||
|
(check-analyse-pattern '((bar 'beep)) (foo (bar 'beep) $cap) desc->key)
|
||||||
|
(check-analyse-pattern '((0 0)) (foo (bar 'beep) $cap) desc->skeleton-proj)
|
||||||
|
(check-analyse-pattern '((0 1)) (foo (bar 'beep) $cap) desc->capture-proj)
|
||||||
|
(check-analyse-pattern '(list foo? #f #f) (foo (bar 'beep) $cap) (s->d desc->skeleton-stx))
|
||||||
|
(check-analyse-pattern '(foo (bar 'beep) ?) (foo (bar 'beep) $cap) (s->d desc->assertion-stx))
|
||||||
|
|
||||||
|
)
|
Loading…
Reference in New Issue