f1bacffbdc
redex patterns a bunch: - repeats are turned into wrappers in sequences, - names are all explicit, - non-terminals are wrapped with `nt', - cross patterns always have the hyphens in them. - ellipses names are normalized (so there are no "hidden" name equalities); this also means that repeat patterns can have both a regular name and a mismatch name Also, added a match-a-pattern helper macro that checks to make sure that functions that process patterns don't miss any cases
135 lines
6.5 KiB
Racket
135 lines
6.5 KiB
Racket
#lang racket/base
|
|
(require (for-syntax "../private/rewrite-side-conditions.rkt"
|
|
racket/base)
|
|
"../private/term.rkt" ;; to get bindings for 'in-hole' etc
|
|
rackunit)
|
|
|
|
(define-syntax (rsc stx)
|
|
(syntax-case stx ()
|
|
[(_ pat (nts ...) bind-names?)
|
|
(with-syntax ([(pat (vars ...) (vars/ellipses ...))
|
|
(rewrite-side-conditions/check-errs
|
|
(syntax->datum #'(nts ...))
|
|
'rsc
|
|
(syntax-e #'bind-names?)
|
|
#'pat)])
|
|
#'(list `pat
|
|
`(vars ...)
|
|
`(vars/ellipses ...)))]))
|
|
|
|
(check-equal? (rsc 1 () #t) `(1 () ()))
|
|
(check-equal? (rsc (1) () #t) `((list 1) () ()))
|
|
(check-equal? (rsc (1 ...) () #t) `((list (repeat 1 #f #f)) () ()))
|
|
(check-equal? (rsc (1 ..._2) () #t) `((list (repeat 1 #f #f)) () ()))
|
|
(check-equal? (rsc (1 ..._2 1 ..._2) () #t) `((list (repeat 1 ..._2 #f) (repeat 1 ..._2 #f)) () ()))
|
|
(check-equal? (rsc (1 ..._!_3) () #t) `((list (repeat 1 #f #f)) () ()))
|
|
(check-equal? (rsc (1 ..._!_3 1 ..._!_3) () #t) `((list (repeat 1 #f ..._!_3) (repeat 1 #f ..._!_3)) () ()))
|
|
|
|
(check-equal? (rsc x (x) #t) `((name x (nt x)) (x) (x)))
|
|
(check-equal? (rsc x (x) #f) `((nt x) () ()))
|
|
(check-equal? (rsc x_1 (x) #t) `((name x_1 (nt x)) (x_1) (x_1)))
|
|
(check-equal? (rsc x_1 (x) #f) `((name x_1 (nt x)) (x_1) (x_1)))
|
|
(check-equal? (rsc any (x) #t) `((name any any) (any) (any)))
|
|
(check-equal? (rsc any (x) #f) `(any () ()))
|
|
(check-equal? (rsc any_1 (x) #t) `((name any_1 any) (any_1) (any_1)))
|
|
(check-equal? (rsc any_1 (x) #f) `((name any_1 any) (any_1) (any_1)))
|
|
(check-equal? (rsc ((x ...) ...) (x) #t)
|
|
`((list (repeat (list (repeat (name x (nt x)) #f #f)) #f #f))
|
|
(x)
|
|
(((x ...) ...))))
|
|
|
|
(check-equal? (rsc (in-hole (hole a #f (hide-hole hole)) (cross x)) '(x) #f)
|
|
`((in-hole (list hole a #f (hide-hole hole)) (cross x-x))
|
|
()
|
|
()))
|
|
|
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
;;
|
|
;; test the normalization of the ellipses underscores
|
|
;;
|
|
(check-equal? (car (rsc (x_1 ..._1 x_2 ..._2 x_2 ..._1) (x) #t))
|
|
'(list (repeat (name x_1 (nt x)) ..._1 #f)
|
|
(repeat (name x_2 (nt x)) ..._1 #f)
|
|
(repeat (name x_2 (nt x)) ..._1 #f)))
|
|
(check-equal? (car (rsc ((x_1 ..._1 x_1 ..._2) (x_2 ..._1 x_2 ..._2) x_3 ..._2) (x) #t))
|
|
'(list (list (repeat (name x_1 (nt x)) ..._2 #f)
|
|
(repeat (name x_1 (nt x)) ..._2 #f))
|
|
(list (repeat (name x_2 (nt x)) ..._2 #f)
|
|
(repeat (name x_2 (nt x)) ..._2 #f))
|
|
(repeat (name x_3 (nt x)) ..._2 #f)))
|
|
(check-equal? (car (rsc (x_1 ..._1 x ..._2 x_1 ..._2) (x) #t))
|
|
'(list (repeat (name x_1 (nt x)) ..._2 #f)
|
|
(repeat (name x (nt x)) ..._2 #f)
|
|
(repeat (name x_1 (nt x)) ..._2 #f)))
|
|
|
|
|
|
(check-equal? (car (rsc (x_1 ..._1 x_2 ..._2 (x_1 x_2) ..._3) (x) #t))
|
|
'(list (repeat (name x_1 (nt x)) ..._3 #f)
|
|
(repeat (name x_2 (nt x)) ..._3 #f)
|
|
(repeat (list (name x_1 (nt x)) (name x_2 (nt x))) ..._3 #f)))
|
|
(check-equal? (car (rsc ((x_1 ..._1) ..._2 x_2 ..._3 (x_1 ..._4 x_2) ..._5) (x) #t))
|
|
'(list (repeat (list (repeat (name x_1 (nt x)) ..._4 #f)) ..._5 #f)
|
|
(repeat (name x_2 (nt x)) ..._5 #f)
|
|
(repeat (list (repeat (name x_1 (nt x)) ..._4 #f)
|
|
(name x_2 (nt x)))
|
|
..._5
|
|
#f)))
|
|
(check-equal? (car (rsc ((x_1 ..._1) ..._2 (x_1 ..._3) ..._4 (x_1 ..._5) ..._6) (x) #t))
|
|
'(list (repeat (list (repeat (name x_1 (nt x)) ..._5 #f)) ..._6 #f)
|
|
(repeat (list (repeat (name x_1 (nt x)) ..._5 #f)) ..._6 #f)
|
|
(repeat (list (repeat (name x_1 (nt x)) ..._5 #f)) ..._6 #f)))
|
|
|
|
(check-equal? (car (rsc (x_1 ..._1 x_1 ..._2 x_2 ..._1 x_2 ..._4 x_2 ..._3) (x) #t))
|
|
'(list (repeat (name x_1 (nt x)) ..._3 #f)
|
|
(repeat (name x_1 (nt x)) ..._3 #f)
|
|
(repeat (name x_2 (nt x)) ..._3 #f)
|
|
(repeat (name x_2 (nt x)) ..._3 #f)
|
|
(repeat (name x_2 (nt x)) ..._3 #f)))
|
|
|
|
(check-equal? (car (rsc (x_1 ... x_1 ..._!_1 x_1 ..._1) (x) #t))
|
|
'(list (repeat (name x_1 (nt x)) ..._1 #f)
|
|
(repeat (name x_1 (nt x)) ..._1 #f)
|
|
(repeat (name x_1 (nt x)) ..._1 #f)))
|
|
|
|
(check-equal? (car (rsc (x_1 ... x_1 ..._!_1 x_1 ..._1 x_2 ..._!_1) (x) #t))
|
|
'(list (repeat (name x_1 (nt x)) ..._1 #f)
|
|
(repeat (name x_1 (nt x)) ..._1 ..._!_1)
|
|
(repeat (name x_1 (nt x)) ..._1 #f)
|
|
(repeat (name x_2 (nt x)) #f ..._!_1)))
|
|
|
|
(check-equal? (car (rsc ((3 ..._1) ..._2 (4 ..._1) ..._3) (x) #t))
|
|
'(list (repeat (list (repeat 3 ..._1 #f)) ..._3 #f)
|
|
(repeat (list (repeat 4 ..._1 #f)) ..._3 #f)))
|
|
|
|
(check-equal? (car (rsc (x ..._1 x ..._2
|
|
variable ..._2 variable ..._3 variable_1 ..._3 variable_1 ..._4)
|
|
(x) #t))
|
|
'(list (repeat (name x (nt x)) ..._4 #f)
|
|
(repeat (name x (nt x)) ..._4 #f)
|
|
(repeat (name variable variable) ..._4 #f)
|
|
(repeat (name variable variable) ..._4 #f)
|
|
(repeat (name variable_1 variable) ..._4 #f)
|
|
(repeat (name variable_1 variable) ..._4 #f)))
|
|
|
|
(check-equal? (car (rsc (z_1 ... z_2 ..._!_1 (z_1 z_2) ...) (z) #t))
|
|
'(list (repeat (name z_1 (nt z)) ..._r3 #f)
|
|
(repeat (name z_2 (nt z)) ..._r3 #f)
|
|
(repeat (list (name z_1 (nt z))
|
|
(name z_2 (nt z)))
|
|
..._r3
|
|
#f)))
|
|
|
|
(check-equal? (car (rsc (z_1 ... z_2 ..._!_1 z_3 ..._!_1 (z_1 z_2) ...) (z) #t))
|
|
'(list (repeat (name z_1 (nt z)) ..._r4 #f)
|
|
(repeat (name z_2 (nt z)) ..._r4 ..._!_1)
|
|
(repeat (name z_3 (nt z)) #f ..._!_1)
|
|
(repeat (list (name z_1 (nt z))
|
|
(name z_2 (nt z)))
|
|
..._r4
|
|
#f)))
|
|
|
|
;;
|
|
;; test the normalization of the ellipses underscores
|
|
;;
|
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|