Merge part of unstable/syntax with racket/syntax.
This commit is contained in:
parent
1a7b71fb20
commit
36bb0e568c
|
@ -3,7 +3,7 @@
|
|||
(require (for-syntax racket/base
|
||||
racket/syntax
|
||||
(only-in racket/list append* remove-duplicates)
|
||||
unstable/sequence
|
||||
racket/sequence
|
||||
syntax/parse/pre
|
||||
syntax/parse/experimental/template
|
||||
racket/lazy-require
|
||||
|
|
|
@ -3,7 +3,9 @@
|
|||
(require "stream.rkt"
|
||||
"private/sequence.rkt"
|
||||
racket/contract/combinator
|
||||
racket/contract/base)
|
||||
racket/contract/base
|
||||
(for-syntax racket/base)
|
||||
syntax/stx)
|
||||
|
||||
(provide empty-sequence
|
||||
sequence->list
|
||||
|
@ -19,7 +21,10 @@
|
|||
sequence-filter
|
||||
sequence-add-between
|
||||
sequence-count
|
||||
sequence/c)
|
||||
sequence/c
|
||||
in-syntax
|
||||
in-pairs
|
||||
(contract-out [in-slice (exact-positive-integer? sequence? . -> . any)]))
|
||||
|
||||
(define empty-sequence
|
||||
(make-do-sequence
|
||||
|
@ -239,3 +244,42 @@
|
|||
[(list? seq) (sequence->list result-seq)]
|
||||
[(stream? seq) (sequence->stream result-seq)]
|
||||
[else result-seq])))))
|
||||
|
||||
|
||||
;; additional sequence constructors
|
||||
|
||||
(define-sequence-syntax in-syntax
|
||||
(λ () #'in-syntax/proc)
|
||||
(λ (stx)
|
||||
(syntax-case stx ()
|
||||
[[(id) (_ arg)]
|
||||
#'[(id) (in-list (in-syntax/proc arg))]])))
|
||||
|
||||
(define (in-syntax/proc stx)
|
||||
(or (stx->list stx)
|
||||
(raise-type-error 'in-syntax "stx-list" stx)))
|
||||
|
||||
(define (in-pairs seq)
|
||||
(make-do-sequence
|
||||
(λ ()
|
||||
(let-values ([(more? gen) (sequence-generate seq)])
|
||||
(values (λ (e) (let ([e (gen)]) (values (car e) (cdr e))))
|
||||
(λ (_) #t)
|
||||
#t
|
||||
(λ (_) (more?))
|
||||
(λ _ #t)
|
||||
(λ _ #t))))))
|
||||
|
||||
(define (in-slice k seq)
|
||||
(make-do-sequence
|
||||
(λ ()
|
||||
(define-values (more? get) (sequence-generate seq))
|
||||
(values
|
||||
(λ (_)
|
||||
(for/list ([i (in-range k)] #:when (more?))
|
||||
(get)))
|
||||
values
|
||||
#f
|
||||
#f
|
||||
(λ (val) (pair? val))
|
||||
#f))))
|
||||
|
|
|
@ -1,38 +1,8 @@
|
|||
#lang racket/base
|
||||
|
||||
(require (for-syntax racket/base) racket/contract/base syntax/stx)
|
||||
(require racket/sequence) ; for re-export
|
||||
|
||||
;; Added by samth:
|
||||
|
||||
(provide in-syntax in-pairs in-sequence-forever sequence-lift)
|
||||
|
||||
;; ELI: I don't see a point in this over using `syntax->list' directly.
|
||||
;; (Eg, the latter is something that can be used when the programmer
|
||||
;; knows that it's a list, in contrast to this code which will just
|
||||
;; throw an error.)
|
||||
(define-sequence-syntax in-syntax
|
||||
(λ () #'in-syntax/proc)
|
||||
(λ (stx)
|
||||
(syntax-case stx ()
|
||||
[[(id) (_ arg)]
|
||||
#'[(id) (in-list (in-syntax/proc arg))]])))
|
||||
|
||||
(define (in-syntax/proc stx)
|
||||
(or (stx->list stx)
|
||||
(raise-type-error 'in-syntax "stx-list" stx)))
|
||||
|
||||
;; ELI: This is very specific, and indeed there are no uses of it
|
||||
;; anywhere in the tree other than in TR where it came from.
|
||||
(define (in-pairs seq)
|
||||
(make-do-sequence
|
||||
(λ ()
|
||||
(let-values ([(more? gen) (sequence-generate seq)])
|
||||
(values (λ (e) (let ([e (gen)]) (values (car e) (cdr e))))
|
||||
(λ (_) #t)
|
||||
#t
|
||||
(λ (_) (more?))
|
||||
(λ _ #t)
|
||||
(λ _ #t))))))
|
||||
(provide in-syntax in-pairs in-sequence-forever sequence-lift in-slice)
|
||||
|
||||
;; ELI: Besides the awful name, this is the same as
|
||||
;; (in-sequences seq (in-cycle (in-value val)))
|
||||
|
@ -59,21 +29,3 @@
|
|||
(λ _ #t)
|
||||
(λ _ #t))))))
|
||||
|
||||
;; Added by stamourv (from David Vanderson (david.vanderson at gmail.com)):
|
||||
|
||||
(provide/contract
|
||||
[in-slice (exact-positive-integer? sequence? . -> . any)])
|
||||
|
||||
(define (in-slice k seq)
|
||||
(make-do-sequence
|
||||
(λ ()
|
||||
(define-values (more? get) (sequence-generate seq))
|
||||
(values
|
||||
(λ (_)
|
||||
(for/list ([i (in-range k)] #:when (more?))
|
||||
(get)))
|
||||
values
|
||||
#f
|
||||
#f
|
||||
(λ (val) (pair? val))
|
||||
#f))))
|
||||
|
|
Loading…
Reference in New Issue
Block a user