Support pattern matching of stream and stream*

This commit is contained in:
Cameron Moy 2021-04-05 20:11:09 -04:00 committed by Matthias Felleisen
parent 5985d5559d
commit a7ddec9573
5 changed files with 42 additions and 14 deletions

View File

@ -138,7 +138,7 @@ In more detail, patterns match as follows:
@item{@racket[(#,(racketidfont "list") _lvp ...)] --- matches a list
of elements. In the case of @racket[(#,(racketidfont "list")
_pat ...)], the pattern matches a list with as many element as
_pat ...)], the pattern matches a list with as many elements as
@racket[_pat]s, and each element must match the corresponding
@racket[_pat]. In the more general case, each @racket[_lvp]
corresponds to a ``spliced'' list of greedy matches.

View File

@ -1152,15 +1152,19 @@ stream, but plain lists can be used as streams, and functions such as
@history[#:added "8.0.0.12"]}
@defform[(stream expr ...)]{
@defform[(stream e ...)]{
A shorthand for nested @racket[stream-cons]es ending with
@racket[empty-stream].
@racket[empty-stream]. As a match pattern, @racket[stream]
matches a stream with as many elements as @racket[e]s,
and each element must match the corresponding @racket[e] pattern.
}
@defform[(stream* expr ... rest-expr)]{
A shorthand for nested @racket[stream-cons]es, but the @racket[rest-expr]
@defform[(stream* e ... tail)]{
A shorthand for nested @racket[stream-cons]es, but the @racket[tail]
must produce a stream when it is forced, and that stream is used as the rest of the stream instead of
@racket[empty-stream]. Similar to @racket[list*] but for streams.
As a match pattern, @racket[stream*] is similar to a @racket[stream] pattern,
but the @racket[tail] pattern matches the ``rest'' of the stream after the last @racket[e].
@history[#:added "6.3"
#:changed "8.0.0.12" @elem{Changed to delay @racket[rest-expr] even

View File

@ -216,5 +216,14 @@
(check (lambda (s n) (stream-first (stream-tail s n))))
(check (lambda (s n) (stream-ref (stream-take s (add1 n)) n)))))
;; match tests
(test #t 'stream (match '() [(stream) #t]))
(test 1 'stream (match '(1) [(stream x) x]))
(test 3 'stream (match '(1 2) [(stream x y) (+ x y)]))
(test '(1 2) 'stream* (match '(1 2) [(stream* xs) xs]))
(test 1 'stream* (match '(1 2) [(stream* hd _) hd]))
(test '(2) 'stream* (match '(1 2) [(stream* _ tl) tl]))
(test -1 'stream* (match '(1 2 3 4) [(stream* x y tl) (- x y)]))
(test '(3 4) 'stream* (match '(1 2 3 4) [(stream* x y tl) tl]))
(report-errs)

View File

@ -3,7 +3,6 @@
(require (for-syntax racket/base
racket/syntax
(only-in racket/list append* remove-duplicates)
racket/sequence
syntax/parse/pre
syntax/parse/experimental/template
racket/lazy-require
@ -164,9 +163,9 @@
[(_ ((~and cl [pat exp]) ...) body1 body ...)
(quasisyntax/loc stx
(let ()
#,@(for/list ([c (in-syntax #'(cl ...))]
[p (in-syntax #'(pat ...))]
[e (in-syntax #'(exp ...))])
#,@(for/list ([c (in-list (syntax->list #'(cl ...)))]
[p (in-list (syntax->list #'(pat ...)))]
[e (in-list (syntax->list #'(exp ...)))])
(quasisyntax/loc c
(match-define-values/derived #,stx (#,p) #,e)))
body1 body ...))]))
@ -176,9 +175,9 @@
[(_ ((~and cl [(pat ...) exp]) ...) body1 body ...)
(quasisyntax/loc stx
(let ()
#,@(for/list ([c (in-syntax #'(cl ...))]
[ps (in-syntax #'((pat ...) ...))]
[e (in-syntax #'(exp ...))])
#,@(for/list ([c (in-list (syntax->list #'(cl ...)))]
[ps (in-list (syntax->list #'((pat ...) ...)))]
[e (in-list (syntax->list #'(exp ...)))])
(quasisyntax/loc c
(match-define-values/derived #,stx #,ps #,e)))
body1 body ...))]))

View File

@ -6,6 +6,7 @@
racket/contract/combinator
racket/function
racket/generator
racket/match
(rename-in "private/for.rkt"
[stream-ref stream-get-generics])
"private/sequence.rkt"
@ -66,7 +67,13 @@
(quote-syntax stream-first)
(quote-syntax stream-rest))))
(define-syntax stream
(define-match-expander stream
(syntax-rules ()
[(_) (? stream-empty?)]
[(_ hd tl ...)
(? stream-cons?
(app stream-first hd)
(app stream-rest (stream tl ...)))])
(syntax-rules ()
((_)
empty-stream)
@ -76,13 +83,22 @@
((_ hd tl ...)
(stream-cons hd (stream tl ...)))))
(define-syntax stream*
(define-match-expander stream*
(syntax-rules ()
[(_ tl) (? stream? tl)]
[(_ hd tl ...)
(? stream-cons?
(app stream-first hd)
(app stream-rest (stream* tl ...)))])
(syntax-rules ()
[(_ tl)
(stream-lazy #:who 'stream* tl)]
[(_ hd tl ...)
(stream-cons hd (stream* tl ...))]))
(define (stream-cons? st)
(and (stream? st) (not (stream-empty? st))))
(define (stream->list s)
(for/list ([v (in-stream s)]) v))