suzanne.soy/xlist
1
0
Fork 0
Code Issues Pull Requests 1 Actions Packages Projects Releases Wiki Activity

Added xlist match expander. Added typed and untyped versions.

Browse Source
This commit is contained in:
Georges Dupéron 2016-09-21 18:33:57 +02:00
parent 7a6e258955
commit b2be71aa43
7 changed files with 363 additions and 0 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
.travis.yml
View File

@ -51,6 +51,8 @@ before_script:
script:
- raco test -x -p xlist
- raco setup --check-pkg-deps --pkgs xlist
- raco pkg install --deps search-auto doc-coverage
- raco doc-coverage xlist
after_success:
- raco pkg install --deps search-auto cover cover-coveralls

7
between.rkt Normal file
View File

@ -0,0 +1,7 @@
#lang typed/racket/base
(provide between/c)
(: between/c (→ Real Real (→ Real Boolean)))
(define ((between/c a b) v)
(and (<= a v) (<= v b)))

22
scribblings/identifiers.scrbl Normal file
View File

@ -0,0 +1,22 @@
#lang scribble/manual
@require[phc-toolkit/scribblings/utils
@for-label[xlist/untyped]]
@(def-orig typed [xlist]
xlist)
@title{Special identifiers recognised by @racket[xlist]}
@defmodule*[(xlist
xlist/untyped)
#:link-target? #f
#:use-sources
[(lib "xlist/infinity-identifier.rkt")
(lib "xlist/caret-identifier.rkt")]]
@defidform[^]{This identifier can only be used within xlist forms.}
@defthing[∞]{This identifier is meant to be used within xlist
forms, but is also equal to @racket[+inf.0] as a convenience. In the future,
this package will make it possible for other packages to overload the meaning
of the @racket[^] and @racket[∞] identifiers, so that the value of @racket[∞]
may depend on the packages loaded (for example a symbolic math package may want
to attach a special value to @racket[∞].}

12
scribblings/xlist-untyped.scrbl Normal file
View File

@ -0,0 +1,12 @@
#lang scribble/manual
@require[phc-toolkit/scribblings/utils
@for-label[xlist/untyped]]
@(def-orig typed [xlist]
xlist)
@title{Untyped versions of xlist}
@defmodule[xlist/untyped
#:use-sources
[(submod (lib "xlist/main.rkt") untyped)]]
@defidform[xlist]{Untyped version of @|typed:xlist|.}

159
test/test-match-typed.rkt Normal file
View File

@ -0,0 +1,159 @@
#lang typed/racket
(require xlist/untyped
typed/rackunit)
(test-begin
"(xlist 1 2 3 4 5)"
(check-true (match '() [(xlist) #t] [_ #f]))
(check-true (match '(1) [(xlist 1) #t] [_ #f]))
(check-true (match '(1 2) [(xlist 1 2) #t] [_ #f]))
(check-true (match '(1 2 3) [(xlist 1 2 3) #t] [_ #f]))
(check-true (match '(1 2 3 4) [(xlist 1 2 3 4) #t] [_ #f]))
(check-true (match '(1 2 3 4 5) [(xlist 1 2 3 4 5) #t] [_ #f]))
(check-false (match '() [(xlist 1) #t] [_ #f]))
(check-false (match '(1) [(xlist 1 2) #t] [_ #f]))
(check-false (match '(1 2) [(xlist 1 2 3) #t] [_ #f]))
(check-false (match '(1 2 3) [(xlist 1 2 3 4) #t] [_ #f]))
(check-false (match '(1 2 3 4) [(xlist 1 2 3 4 5) #t] [_ #f]))
(check-false (match '(1 2 3 4 5) [(xlist 1 2 3 4 5 6) #t] [_ #f]))
(check-false (match '(1) [(xlist) #t] [_ #f]))
(check-false (match '(1 2) [(xlist 1) #t] [_ #f]))
(check-false (match '(1 2 3) [(xlist 1 2) #t] [_ #f]))
(check-false (match '(1 2 3 4) [(xlist 1 2 3) #t] [_ #f]))
(check-false (match '(1 2 3 4 5) [(xlist 1 2 3 4) #t] [_ #f]))
(check-false (match '(1 2 3 4 5 6) [(xlist 1 2 3 4 5) #t] [_ #f]))
(void))
;; Should fail:
;(xlist ^ 1)
;(xlist ^ 1 +)
;(xlist ^ 1 *)
;(xlist +)
;(xlist *)
(test-begin
"(xlist 1 *) and (xlist 1 +) with or witout ^"
(check-true (match '() [(xlist 1 *) #t] [_ #f]))
(check-true (match '(1) [(xlist 1 *) #t] [_ #f]))
(check-true (match '(1 1) [(xlist 1 *) #t] [_ #f]))
(check-true (match '(1 1 1) [(xlist 1 *) #t] [_ #f]))
; NOT (check-true '() (xlist 1 +))
(check-true (match '(1) [(xlist 1 +) #t] [_ #f]))
(check-true (match '(1 1) [(xlist 1 +) #t] [_ #f]))
(check-true (match '(1 1 1) [(xlist 1 +) #t] [_ #f]))
(check-true (match '() [(xlist 1 ^ *) #t] [_ #f]))
(check-true (match '(1) [(xlist 1 ^ *) #t] [_ #f]))
(check-true (match '(1 1) [(xlist 1 ^ *) #t] [_ #f]))
(check-true (match '(1 1 1) [(xlist 1 ^ *) #t] [_ #f]))
; NOT (check-true '() (xlist 1 ^ +))
(check-true (match '(1) [(xlist 1 ^ +) #t] [_ #f]))
(check-true (match '(1 1) [(xlist 1 ^ +) #t] [_ #f]))
(check-true (match '(1 1 1) [(xlist 1 ^ +) #t] [_ #f]))
(void))
(test-begin
"(xlist (? number? n) *) and (xlist (? number? n) +) with or witout ^"
(check-equal? (match '() [(xlist (? number? n) *) n] [_ #f]) '())
(check-equal? (match '(1) [(xlist (? number? n) *) n] [_ #f]) '(1))
(check-equal? (match '(1 1) [(xlist (? number? n) *) n] [_ #f]) '(1 1))
(check-equal? (match '(1 1 1) [(xlist (? number? n) *) n] [_ #f]) '(1 1 1))
(check-false (match '() [(xlist (? number? n) +) n] [_ #f]))
(check-equal? (match '(1) [(xlist (? number? n) +) n] [_ #f]) '(1))
(check-equal? (match '(1 1) [(xlist (? number? n) +) n] [_ #f]) '(1 1))
(check-equal? (match '(1 1 1) [(xlist (? number? n) +) n] [_ #f]) '(1 1 1))
(check-equal? (match '() [(xlist (? number? n) ^ *) n] [_ #f]) '())
(check-equal? (match '(1) [(xlist (? number? n) ^ *) n] [_ #f]) '(1))
(check-equal? (match '(1 1) [(xlist (? number? n) ^ *) n] [_ #f]) '(1 1))
(check-equal? (match '(1 1 1) [(xlist (? number? n) ^ *) n] [_ #f]) '(1 1 1 ))
(check-false (match '() [(xlist (? number? n) ^ +) n] [_ #f]))
(check-equal? (match '(1) [(xlist (? number? n) ^ +) n] [_ #f]) '(1))
(check-equal? (match '(1 1) [(xlist (? number? n) ^ +) n] [_ #f]) '(1 1))
(check-equal? (match '(1 1 1) [(xlist (? number? n) ^ +) n] [_ #f]) '(1 1 1))
(void))
(test-begin
"(xlist (? number? n) *) and (xlist (? number? n) +) something after"
(check-equal? (match '() [(xlist (? number? n) * (? string? s) *) (cons n s)] [_ #f]) '(() . ()))
(check-equal? (match '(1) [(xlist (? number? n) * (? string? s) *) (cons n s)] [_ #f]) '((1) . ()))
(check-equal? (match '("b") [(xlist (? number? n) * (? string? s) *) (cons n s)] [_ #f]) '(() . ("b")))
(check-equal? (match '(1 "b") [(xlist (? number? n) * (? string? s) *) (cons n s)] [_ #f]) '((1) . ("b")))
(check-equal? (match '(1 1 1 "b" "b") [(xlist (? number? n) * (? string? s) *) (cons n s)] [_ #f]) '((1 1 1) . ("b" "b")))
(check-equal? (match '(1 1 1) [(xlist (? number? n) * (? string? s) *) (cons n s)] [_ #f]) '((1 1 1) . ()))
(check-equal? (match '("b" "b" "b") [(xlist (? number? n) * (? string? s) *) (cons n s)] [_ #f]) '(() . ("b" "b" "b")))
(check-false (match '() [(xlist (? number? n) + (? string? s) +) (cons n s)] [_ #f]))
(check-false (match '(1) [(xlist (? number? n) + (? string? s) +) (cons n s)] [_ #f]))
(check-false (match '("b") [(xlist (? number? n) + (? string? s) +) (cons n s)] [_ #f]))
(check-equal? (match '(1 "b") [(xlist (? number? n) + (? string? s) +) (cons n s)] [_ #f]) '((1) . ("b")))
(check-equal? (match '(1 1 "b") [(xlist (? number? n) + (? string? s) +) (cons n s)] [_ #f]) '((1 1) . ("b")))
(check-equal? (match '(1 "b" "b") [(xlist (? number? n) + (? string? s) +) (cons n s)] [_ #f]) '((1) . ("b" "b")))
(check-equal? (match '() [(xlist (? number? n) ^ * (? string? s) ^ *) (cons n s)] [_ #f]) '(() . ()))
(check-equal? (match '(1) [(xlist (? number? n) ^ * (? string? s) ^ *) (cons n s)] [_ #f]) '((1) . ()))
(check-equal? (match '("b") [(xlist (? number? n) ^ * (? string? s) ^ *) (cons n s)] [_ #f]) '(() . ("b")))
(check-equal? (match '(1 "b") [(xlist (? number? n) ^ * (? string? s) ^ *) (cons n s)] [_ #f]) '((1) . ("b")))
(check-equal? (match '(1 1 1 "b" "b") [(xlist (? number? n) ^ * (? string? s) ^ *) (cons n s)] [_ #f]) '((1 1 1) . ("b" "b")))
(check-equal? (match '(1 1 1) [(xlist (? number? n) ^ * (? string? s) ^ *) (cons n s)] [_ #f]) '((1 1 1) . ()))
(check-equal? (match '("b" "b" "b") [(xlist (? number? n) ^ * (? string? s) ^ *) (cons n s)] [_ #f]) '(() . ("b" "b" "b")))
(check-false (match '() [(xlist (? number? n) ^ + (? string? s) ^ +) (cons n s)] [_ #f]))
(check-false (match '(1) [(xlist (? number? n) ^ + (? string? s) ^ +) (cons n s)] [_ #f]))
(check-false (match '("b") [(xlist (? number? n) ^ + (? string? s) ^ +) (cons n s)] [_ #f]))
(check-equal? (match '(1 "b") [(xlist (? number? n) ^ + (? string? s) ^ +) (cons n s)] [_ #f]) '((1) . ("b")))
(check-equal? (match '(1 1 "b") [(xlist (? number? n) ^ + (? string? s) ^ +) (cons n s)] [_ #f]) '((1 1) . ("b")))
(check-equal? (match '(1 "b" "b") [(xlist (? number? n) ^ + (? string? s) ^ +) (cons n s)] [_ #f]) '((1) . ("b" "b")))
(void))
(test-begin
"(xlist (? number? n) ^ x +)"
(check-equal? (match '(1 1 1) [(xlist (? number? n) +) n] [_ #f]) '(1 1 1))
(check-equal? (match '(1 1 1) [(xlist (? number? n) ^ +) n] [_ #f]) '(1 1 1))
(check-equal? (match '(1 1 1) [(xlist (? number? n) ^ 0 +) n] [_ #f]) '(1 1 1))
(check-equal? (match '(1 1 1) [(xlist (? number? n) ^ 1 +) n] [_ #f]) '(1 1 1))
(check-equal? (match '(1 1 1) [(xlist (? number? n) ^ 2 +) n] [_ #f]) '(1 1 1))
(check-equal? (match '(1 1 1) [(xlist (? number? n) ^ 3 +) n] [_ #f]) '(1 1 1))
(void))
(test-begin
"(xlist (? number? n) ^ x - y)"
(check-equal? (match '() [(xlist (? number? n) ^ -) n] [_ #f]) '())
(check-equal? (match '(1 1 1) [(xlist (? number? n) ^ -) n] [_ #f]) '(1 1 1))
(check-equal? (match '() [(xlist (? number? n) ^ 0 -) n] [_ #f]) '())
(check-equal? (match '(1 1 1) [(xlist (? number? n) ^ 0 -) n] [_ #f]) '(1 1 1))
(check-equal? (match '(1 1 1) [(xlist (? number? n) ^ 1 -) n] [_ #f]) '(1 1 1))
(check-equal? (match '(1 1 1) [(xlist (? number? n) ^ 2 -) n] [_ #f]) '(1 1 1))
(check-equal? (match '(1 1 1) [(xlist (? number? n) ^ 3 -) n] [_ #f]) '(1 1 1))
(check-equal? (match '() [(xlist (? number? n) ^ - ∞) n] [_ #f]) '())
(check-equal? (match '(1 1 1) [(xlist (? number? n) ^ - ∞) n] [_ #f]) '(1 1 1))
(check-equal? (match '() [(xlist (? number? n) ^ 0 - ∞) n] [_ #f]) '())
(check-equal? (match '(1 1 1) [(xlist (? number? n) ^ 0 - ∞) n] [_ #f]) '(1 1 1))
(check-equal? (match '(1 1 1) [(xlist (? number? n) ^ 1 - ∞) n] [_ #f]) '(1 1 1))
(check-equal? (match '(1 1 1) [(xlist (? number? n) ^ 2 - ∞) n] [_ #f]) '(1 1 1))
(check-equal? (match '(1 1 1) [(xlist (? number? n) ^ 3 - ∞) n] [_ #f]) '(1 1 1))
(check-equal? (match '(1 1 1) [(xlist (? number? n) ^ 0 - 5) n] [_ #f]) '(1 1 1))
(check-equal? (match '(1 1 1) [(xlist (? number? n) ^ 3 - 5) n] [_ #f]) '(1 1 1))
(check-equal? (match '(1 1 1 1) [(xlist (? number? n) ^ 0 - 5) n] [_ #f]) '(1 1 1 1))
(check-equal? (match '(1 1 1 1) [(xlist (? number? n) ^ 3 - 5) n] [_ #f]) '(1 1 1 1))
(check-equal? (match '(1 1 1 1 1) [(xlist (? number? n) ^ 0 - 5) n] [_ #f]) '(1 1 1 1 1))
(check-equal? (match '(1 1 1 1 1) [(xlist (? number? n) ^ 3 - 5) n] [_ #f]) '(1 1 1 1 1))
(void))
(test-begin
"(xlist (? number? n) ^ x - (? string? s))"
(check-equal? (match '("b") [(xlist (? number? n) ^ - (? string? s)) (cons n s)] [_ #f]) '(() . "b"))
(check-equal? (match '(1 1 1 "b") [(xlist (? number? n) ^ - (? string? s)) (cons n s)] [_ #f]) '((1 1 1) . "b"))
(check-equal? (match '("b") [(xlist (? number? n) ^ 0 - (? string? s)) (cons n s)] [_ #f]) '(() . "b"))
(check-equal? (match '(1 1 1 "b") [(xlist (? number? n) ^ 0 - (? string? s)) (cons n s)] [_ #f]) '((1 1 1) . "b"))
(check-equal? (match '(1 1 1 "b") [(xlist (? number? n) ^ 1 - (? string? s)) (cons n s)] [_ #f]) '((1 1 1) . "b"))
(check-equal? (match '(1 1 1 "b") [(xlist (? number? n) ^ 2 - (? string? s)) (cons n s)] [_ #f]) '((1 1 1) . "b"))
(void))

159
test/test-match.rkt Normal file
View File

@ -0,0 +1,159 @@
#lang racket
(require xlist/untyped
rackunit)
(test-begin
"(xlist 1 2 3 4 5)"
(check-true (match '() [(xlist) #t] [_ #f]))
(check-true (match '(1) [(xlist 1) #t] [_ #f]))
(check-true (match '(1 2) [(xlist 1 2) #t] [_ #f]))
(check-true (match '(1 2 3) [(xlist 1 2 3) #t] [_ #f]))
(check-true (match '(1 2 3 4) [(xlist 1 2 3 4) #t] [_ #f]))
(check-true (match '(1 2 3 4 5) [(xlist 1 2 3 4 5) #t] [_ #f]))
(check-false (match '() [(xlist 1) #t] [_ #f]))
(check-false (match '(1) [(xlist 1 2) #t] [_ #f]))
(check-false (match '(1 2) [(xlist 1 2 3) #t] [_ #f]))
(check-false (match '(1 2 3) [(xlist 1 2 3 4) #t] [_ #f]))
(check-false (match '(1 2 3 4) [(xlist 1 2 3 4 5) #t] [_ #f]))
(check-false (match '(1 2 3 4 5) [(xlist 1 2 3 4 5 6) #t] [_ #f]))
(check-false (match '(1) [(xlist) #t] [_ #f]))
(check-false (match '(1 2) [(xlist 1) #t] [_ #f]))
(check-false (match '(1 2 3) [(xlist 1 2) #t] [_ #f]))
(check-false (match '(1 2 3 4) [(xlist 1 2 3) #t] [_ #f]))
(check-false (match '(1 2 3 4 5) [(xlist 1 2 3 4) #t] [_ #f]))
(check-false (match '(1 2 3 4 5 6) [(xlist 1 2 3 4 5) #t] [_ #f]))
(void))
;; Should fail:
;(xlist ^ 1)
;(xlist ^ 1 +)
;(xlist ^ 1 *)
;(xlist +)
;(xlist *)
(test-begin
"(xlist 1 *) and (xlist 1 +) with or witout ^"
(check-true (match '() [(xlist 1 *) #t] [_ #f]))
(check-true (match '(1) [(xlist 1 *) #t] [_ #f]))
(check-true (match '(1 1) [(xlist 1 *) #t] [_ #f]))
(check-true (match '(1 1 1) [(xlist 1 *) #t] [_ #f]))
; NOT (check-true '() (xlist 1 +))
(check-true (match '(1) [(xlist 1 +) #t] [_ #f]))
(check-true (match '(1 1) [(xlist 1 +) #t] [_ #f]))
(check-true (match '(1 1 1) [(xlist 1 +) #t] [_ #f]))
(check-true (match '() [(xlist 1 ^ *) #t] [_ #f]))
(check-true (match '(1) [(xlist 1 ^ *) #t] [_ #f]))
(check-true (match '(1 1) [(xlist 1 ^ *) #t] [_ #f]))
(check-true (match '(1 1 1) [(xlist 1 ^ *) #t] [_ #f]))
; NOT (check-true '() (xlist 1 ^ +))
(check-true (match '(1) [(xlist 1 ^ +) #t] [_ #f]))
(check-true (match '(1 1) [(xlist 1 ^ +) #t] [_ #f]))
(check-true (match '(1 1 1) [(xlist 1 ^ +) #t] [_ #f]))
(void))
(test-begin
"(xlist (? number? n) *) and (xlist (? number? n) +) with or witout ^"
(check-equal? (match '() [(xlist (? number? n) *) n] [_ #f]) '())
(check-equal? (match '(1) [(xlist (? number? n) *) n] [_ #f]) '(1))
(check-equal? (match '(1 1) [(xlist (? number? n) *) n] [_ #f]) '(1 1))
(check-equal? (match '(1 1 1) [(xlist (? number? n) *) n] [_ #f]) '(1 1 1))
(check-false (match '() [(xlist (? number? n) +) n] [_ #f]))
(check-equal? (match '(1) [(xlist (? number? n) +) n] [_ #f]) '(1))
(check-equal? (match '(1 1) [(xlist (? number? n) +) n] [_ #f]) '(1 1))
(check-equal? (match '(1 1 1) [(xlist (? number? n) +) n] [_ #f]) '(1 1 1))
(check-equal? (match '() [(xlist (? number? n) ^ *) n] [_ #f]) '())
(check-equal? (match '(1) [(xlist (? number? n) ^ *) n] [_ #f]) '(1))
(check-equal? (match '(1 1) [(xlist (? number? n) ^ *) n] [_ #f]) '(1 1))
(check-equal? (match '(1 1 1) [(xlist (? number? n) ^ *) n] [_ #f]) '(1 1 1 ))
(check-false (match '() [(xlist (? number? n) ^ +) n] [_ #f]))
(check-equal? (match '(1) [(xlist (? number? n) ^ +) n] [_ #f]) '(1))
(check-equal? (match '(1 1) [(xlist (? number? n) ^ +) n] [_ #f]) '(1 1))
(check-equal? (match '(1 1 1) [(xlist (? number? n) ^ +) n] [_ #f]) '(1 1 1))
(void))
(test-begin
"(xlist (? number? n) *) and (xlist (? number? n) +) something after"
(check-equal? (match '() [(xlist (? number? n) * (? string? s) *) (cons n s)] [_ #f]) '(() . ()))
(check-equal? (match '(1) [(xlist (? number? n) * (? string? s) *) (cons n s)] [_ #f]) '((1) . ()))
(check-equal? (match '("b") [(xlist (? number? n) * (? string? s) *) (cons n s)] [_ #f]) '(() . ("b")))
(check-equal? (match '(1 "b") [(xlist (? number? n) * (? string? s) *) (cons n s)] [_ #f]) '((1) . ("b")))
(check-equal? (match '(1 1 1 "b" "b") [(xlist (? number? n) * (? string? s) *) (cons n s)] [_ #f]) '((1 1 1) . ("b" "b")))
(check-equal? (match '(1 1 1) [(xlist (? number? n) * (? string? s) *) (cons n s)] [_ #f]) '((1 1 1) . ()))
(check-equal? (match '("b" "b" "b") [(xlist (? number? n) * (? string? s) *) (cons n s)] [_ #f]) '(() . ("b" "b" "b")))
(check-false (match '() [(xlist (? number? n) + (? string? s) +) (cons n s)] [_ #f]))
(check-false (match '(1) [(xlist (? number? n) + (? string? s) +) (cons n s)] [_ #f]))
(check-false (match '("b") [(xlist (? number? n) + (? string? s) +) (cons n s)] [_ #f]))
(check-equal? (match '(1 "b") [(xlist (? number? n) + (? string? s) +) (cons n s)] [_ #f]) '((1) . ("b")))
(check-equal? (match '(1 1 "b") [(xlist (? number? n) + (? string? s) +) (cons n s)] [_ #f]) '((1 1) . ("b")))
(check-equal? (match '(1 "b" "b") [(xlist (? number? n) + (? string? s) +) (cons n s)] [_ #f]) '((1) . ("b" "b")))
(check-equal? (match '() [(xlist (? number? n) ^ * (? string? s) ^ *) (cons n s)] [_ #f]) '(() . ()))
(check-equal? (match '(1) [(xlist (? number? n) ^ * (? string? s) ^ *) (cons n s)] [_ #f]) '((1) . ()))
(check-equal? (match '("b") [(xlist (? number? n) ^ * (? string? s) ^ *) (cons n s)] [_ #f]) '(() . ("b")))
(check-equal? (match '(1 "b") [(xlist (? number? n) ^ * (? string? s) ^ *) (cons n s)] [_ #f]) '((1) . ("b")))
(check-equal? (match '(1 1 1 "b" "b") [(xlist (? number? n) ^ * (? string? s) ^ *) (cons n s)] [_ #f]) '((1 1 1) . ("b" "b")))
(check-equal? (match '(1 1 1) [(xlist (? number? n) ^ * (? string? s) ^ *) (cons n s)] [_ #f]) '((1 1 1) . ()))
(check-equal? (match '("b" "b" "b") [(xlist (? number? n) ^ * (? string? s) ^ *) (cons n s)] [_ #f]) '(() . ("b" "b" "b")))
(check-false (match '() [(xlist (? number? n) ^ + (? string? s) ^ +) (cons n s)] [_ #f]))
(check-false (match '(1) [(xlist (? number? n) ^ + (? string? s) ^ +) (cons n s)] [_ #f]))
(check-false (match '("b") [(xlist (? number? n) ^ + (? string? s) ^ +) (cons n s)] [_ #f]))
(check-equal? (match '(1 "b") [(xlist (? number? n) ^ + (? string? s) ^ +) (cons n s)] [_ #f]) '((1) . ("b")))
(check-equal? (match '(1 1 "b") [(xlist (? number? n) ^ + (? string? s) ^ +) (cons n s)] [_ #f]) '((1 1) . ("b")))
(check-equal? (match '(1 "b" "b") [(xlist (? number? n) ^ + (? string? s) ^ +) (cons n s)] [_ #f]) '((1) . ("b" "b")))
(void))
(test-begin
"(xlist (? number? n) ^ x +)"
(check-equal? (match '(1 1 1) [(xlist (? number? n) +) n] [_ #f]) '(1 1 1))
(check-equal? (match '(1 1 1) [(xlist (? number? n) ^ +) n] [_ #f]) '(1 1 1))
(check-equal? (match '(1 1 1) [(xlist (? number? n) ^ 0 +) n] [_ #f]) '(1 1 1))
(check-equal? (match '(1 1 1) [(xlist (? number? n) ^ 1 +) n] [_ #f]) '(1 1 1))
(check-equal? (match '(1 1 1) [(xlist (? number? n) ^ 2 +) n] [_ #f]) '(1 1 1))
(check-equal? (match '(1 1 1) [(xlist (? number? n) ^ 3 +) n] [_ #f]) '(1 1 1))
(void))
(test-begin
"(xlist (? number? n) ^ x - y)"
(check-equal? (match '() [(xlist (? number? n) ^ -) n] [_ #f]) '())
(check-equal? (match '(1 1 1) [(xlist (? number? n) ^ -) n] [_ #f]) '(1 1 1))
(check-equal? (match '() [(xlist (? number? n) ^ 0 -) n] [_ #f]) '())
(check-equal? (match '(1 1 1) [(xlist (? number? n) ^ 0 -) n] [_ #f]) '(1 1 1))
(check-equal? (match '(1 1 1) [(xlist (? number? n) ^ 1 -) n] [_ #f]) '(1 1 1))
(check-equal? (match '(1 1 1) [(xlist (? number? n) ^ 2 -) n] [_ #f]) '(1 1 1))
(check-equal? (match '(1 1 1) [(xlist (? number? n) ^ 3 -) n] [_ #f]) '(1 1 1))
(check-equal? (match '() [(xlist (? number? n) ^ - ∞) n] [_ #f]) '())
(check-equal? (match '(1 1 1) [(xlist (? number? n) ^ - ∞) n] [_ #f]) '(1 1 1))
(check-equal? (match '() [(xlist (? number? n) ^ 0 - ∞) n] [_ #f]) '())
(check-equal? (match '(1 1 1) [(xlist (? number? n) ^ 0 - ∞) n] [_ #f]) '(1 1 1))
(check-equal? (match '(1 1 1) [(xlist (? number? n) ^ 1 - ∞) n] [_ #f]) '(1 1 1))
(check-equal? (match '(1 1 1) [(xlist (? number? n) ^ 2 - ∞) n] [_ #f]) '(1 1 1))
(check-equal? (match '(1 1 1) [(xlist (? number? n) ^ 3 - ∞) n] [_ #f]) '(1 1 1))
(check-equal? (match '(1 1 1) [(xlist (? number? n) ^ 0 - 5) n] [_ #f]) '(1 1 1))
(check-equal? (match '(1 1 1) [(xlist (? number? n) ^ 3 - 5) n] [_ #f]) '(1 1 1))
(check-equal? (match '(1 1 1 1) [(xlist (? number? n) ^ 0 - 5) n] [_ #f]) '(1 1 1 1))
(check-equal? (match '(1 1 1 1) [(xlist (? number? n) ^ 3 - 5) n] [_ #f]) '(1 1 1 1))
(check-equal? (match '(1 1 1 1 1) [(xlist (? number? n) ^ 0 - 5) n] [_ #f]) '(1 1 1 1 1))
(check-equal? (match '(1 1 1 1 1) [(xlist (? number? n) ^ 3 - 5) n] [_ #f]) '(1 1 1 1 1))
(void))
(test-begin
"(xlist (? number? n) ^ x - (? string? s))"
(check-equal? (match '("b") [(xlist (? number? n) ^ - (? string? s)) (cons n s)] [_ #f]) '(() . "b"))
(check-equal? (match '(1 1 1 "b") [(xlist (? number? n) ^ - (? string? s)) (cons n s)] [_ #f]) '((1 1 1) . "b"))
(check-equal? (match '("b") [(xlist (? number? n) ^ 0 - (? string? s)) (cons n s)] [_ #f]) '(() . "b"))
(check-equal? (match '(1 1 1 "b") [(xlist (? number? n) ^ 0 - (? string? s)) (cons n s)] [_ #f]) '((1 1 1) . "b"))
(check-equal? (match '(1 1 1 "b") [(xlist (? number? n) ^ 1 - (? string? s)) (cons n s)] [_ #f]) '((1 1 1) . "b"))
(check-equal? (match '(1 1 1 "b") [(xlist (? number? n) ^ 2 - (? string? s)) (cons n s)] [_ #f]) '((1 1 1) . "b"))
(void))

2
untyped.rkt Normal file
View File

@ -0,0 +1,2 @@
#lang reprovide
(submod "main.rkt" untyped)