From a7ddec9573c2ea5ea3ceac1983221576f3c85320 Mon Sep 17 00:00:00 2001 From: Cameron Moy Date: Mon, 5 Apr 2021 20:11:09 -0400 Subject: [PATCH] Support pattern matching of stream and stream* --- .../scribblings/reference/match.scrbl | 2 +- .../scribblings/reference/sequences.scrbl | 12 +++++++---- .../racket-test-core/tests/racket/stream.rktl | 9 +++++++++ racket/collects/racket/match/define-forms.rkt | 13 ++++++------ racket/collects/racket/stream.rkt | 20 +++++++++++++++++-- 5 files changed, 42 insertions(+), 14 deletions(-) diff --git a/pkgs/racket-doc/scribblings/reference/match.scrbl b/pkgs/racket-doc/scribblings/reference/match.scrbl index d884858b73..33d3896862 100644 --- a/pkgs/racket-doc/scribblings/reference/match.scrbl +++ b/pkgs/racket-doc/scribblings/reference/match.scrbl @@ -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. diff --git a/pkgs/racket-doc/scribblings/reference/sequences.scrbl b/pkgs/racket-doc/scribblings/reference/sequences.scrbl index 5e2fd9bb99..b6fcae36d8 100644 --- a/pkgs/racket-doc/scribblings/reference/sequences.scrbl +++ b/pkgs/racket-doc/scribblings/reference/sequences.scrbl @@ -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 diff --git a/pkgs/racket-test-core/tests/racket/stream.rktl b/pkgs/racket-test-core/tests/racket/stream.rktl index 6b8bd2d8dc..e48a493e20 100644 --- a/pkgs/racket-test-core/tests/racket/stream.rktl +++ b/pkgs/racket-test-core/tests/racket/stream.rktl @@ -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) diff --git a/racket/collects/racket/match/define-forms.rkt b/racket/collects/racket/match/define-forms.rkt index b7825399e0..566847edc0 100644 --- a/racket/collects/racket/match/define-forms.rkt +++ b/racket/collects/racket/match/define-forms.rkt @@ -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 ...))])) diff --git a/racket/collects/racket/stream.rkt b/racket/collects/racket/stream.rkt index 3632342c0a..a616451874 100644 --- a/racket/collects/racket/stream.rkt +++ b/racket/collects/racket/stream.rkt @@ -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))