@ -1,13 +1,9 @@
#lang racket/base
#lang racket/base
( require ( for-syntax
( require ( for-syntax racket/base )
racket/base )
racket/list
racket/list
racket/match
racket/match
racket/function
racket/function
" define.rkt " )
sugar/define )
( define ( increasing-nonnegative-list? x )
( and ( list? x ) ( or ( empty? x ) ( apply < -1 x ) ) ) )
( define+provide+safe ( trimf xs test-proc )
( define+provide+safe ( trimf xs test-proc )
( list? procedure? . -> . list? )
( list? procedure? . -> . list? )
@ -109,18 +105,22 @@
( hash-update! counter item add1 0 ) )
( hash-update! counter item add1 0 ) )
counter )
counter )
( define ( ->list x )
( define+provide+safe ( ->list xs )
( match x
( sequence? . -> . list? )
[ ( ? list? x ) x ]
( unless ( sequence? xs )
[ ( ? vector? ) ( vector->list x ) ]
( raise-argument-error ' ->list " sequence " xs ) )
[ ( ? string? ) ( string->list x ) ]
( match xs
[ else ( raise-argument-error ' ->list " item that can be converted to list " x ) ] ) )
[ ( ? list? ) xs ]
[ ( ? vector? ) ( vector->list xs ) ]
[ ( ? string? ) ( string->list xs ) ]
[ seq ( for/list ( [ x seq ] ) x ) ] ) )
( define+provide+safe ( members-unique? x )
( define+provide+safe ( members-unique? x )
( ( or/c list? vector? string? ) . -> . boolean? )
( sequence? . -> . boolean? )
( match ( ->list x )
( unless ( sequence? x )
[ ( ? list? x ) ( = ( length ( remove-duplicates x ) ) ( length x ) ) ]
( raise-argument-error ' members-unique? " sequence " x ) )
[ _ ( raise-argument-error ' members-unique? " list, vector, or string " x ) ] ) )
( define all-unique-signal ( gensym ) )
( eq? ( check-duplicates ( ->list x ) #:default all-unique-signal ) all-unique-signal ) )
( define+provide+safe ( members-unique?/error x )
( define+provide+safe ( members-unique?/error x )
( ( or/c list? vector? string? ) . -> . boolean? )
( ( or/c list? vector? string? ) . -> . boolean? )
@ -138,23 +138,30 @@
( syntax-case stx ( )
( syntax-case stx ( )
[ ( _ VALUES-EXPR ) #' ( call-with-values ( λ ( ) VALUES-EXPR ) list ) ] ) )
[ ( _ VALUES-EXPR ) #' ( call-with-values ( λ ( ) VALUES-EXPR ) list ) ] ) )
( define+provide+safe ( sublist xs i j )
( define+provide+safe ( sublist seq i j )
( list? exact-nonnegative-integer? exact-nonnegative-integer? . -> . list? )
( sequence? exact-nonnegative-integer? exact-nonnegative-integer? . -> . list? )
( unless ( list? xs )
( unless ( sequence? seq )
( raise-argument-error ' sublist " list? " xs ) )
( raise-argument-error ' sublist " sequence? " seq ) )
( cond
( define xs ( ->list seq ) )
[ ( > j ( length xs ) ) ( error ' sublist ( format " ending index ~a exceeds length of list " j ) ) ]
( when ( > j ( length xs ) )
[ ( >= j i ) ( for/list ( [ ( x idx ) ( in-indexed xs ) ]
( raise-argument-error ' sublist ( format " ending index ~a exceeds length of list " j ) ) )
( when ( > i j )
( raise-argument-error ' sublist ( format " starting index larger than ending index " ( list i j ) ) ) )
( for/list ( [ ( x idx ) ( in-indexed xs ) ]
#:when ( <= i idx ( sub1 j ) ) )
#:when ( <= i idx ( sub1 j ) ) )
x ) ]
x ) )
[ else ( raise-argument-error ' sublist ( format " starting index larger than ending index " ( list i j ) ) ) ] ) )
( define ( increasing-nonnegative-list? x )
( or ( empty? x ) ( and ( list? x ) ( apply < -1 x ) ) ) )
( define+provide+safe ( break-at xs bps-in )
( define+provide+safe ( break-at xs bps-in )
( list? any/c . -> . ( listof list? ) )
( list? any/c . -> . ( listof list? ) )
( unless ( list? xs )
( unless ( list? xs )
( raise-argument-error ' break-at " list " xs ) )
( raise-argument-error ' break-at " list " xs ) )
( define bps ( ( if ( list? bps-in ) values list ) bps-in ) )
( define bps ( ( if ( list? bps-in ) values list ) bps-in ) )
( when ( ormap ( λ ( bp ) ( <= ( length xs ) bp ) ) bps )
( when ( let ( [ lenxs ( length xs ) ] )
( for/or ( [ bp bps ] )
( <= lenxs bp ) ) )
( raise-argument-error ' break-at
( raise-argument-error ' break-at
( format " breakpoints not greater than or equal to input list length = ~a " ( length xs ) ) bps ) )
( format " breakpoints not greater than or equal to input list length = ~a " ( length xs ) ) bps ) )
( unless ( increasing-nonnegative-list? bps )
( unless ( increasing-nonnegative-list? bps )
@ -175,16 +182,16 @@
( modulo ( abs how-far ) ( length xs ) )
( modulo ( abs how-far ) ( length xs ) )
( abs how-far ) ) )
( abs how-far ) ) )
( define ( make-fill thing ) ( if cycle thing ( make-list abs-how-far fill-item ) ) )
( define ( make-fill thing ) ( if cycle thing ( make-list abs-how-far fill-item ) ) )
( cond
( when ( > abs-how-far ( length xs ) )
[ ( > abs-how-far ( length xs ) )
( raise-argument-error caller
( raise-argument-error caller
( format " index not larger than list length ~a " ( length xs ) )
( format " index not larger than list length ~a " ( length xs ) )
( * ( if ( eq? caller ' shift-left ) -1 1 ) how-far ) ) ]
( * ( if ( eq? caller ' shift-left ) -1 1 ) how-far ) ) )
[ ( zero? how-far ) xs ]
( match how-far
[ ( positive? how-far )
[ 0 xs ]
[ ( ? positive? )
( match/values ( split-at-right xs abs-how-far )
( match/values ( split-at-right xs abs-how-far )
[ ( head tail ) ( append ( make-fill tail ) head ) ] ) ]
[ ( head tail ) ( append ( make-fill tail ) head ) ] ) ]
[ else ; how-far is negative
[ _ ; how-far is negative
( match/values ( split-at xs abs-how-far )
( match/values ( split-at xs abs-how-far )
[ ( head tail ) ( append tail ( make-fill head ) ) ] ) ] ) )
[ ( head tail ) ( append tail ( make-fill head ) ) ] ) ] ) )