add `slicef` to sugar/list

sugar/list.rkt

@@ -14,6 +14,7 @@
 (define (integers? x) (and (list? x) (andmap integer? x)))
 
 (provide+safe [trimf (list? procedure? . -> . list?)]
+              [slicef (list? procedure? . -> . list-of-lists?)]
               [slicef-at ((list? procedure?) (boolean?) . ->* . list-of-lists?)]
               [slicef-after (list? procedure? . -> . list-of-lists?)]
               [slice-at ((list? (and/c integer? positive?)) (boolean?) . ->* . list-of-lists?)]

sugar/scribblings/list.scrbl

@@ -55,6 +55,19 @@ Divide @racket[_lst] into sublists of length @racket[_len]. If @racket[_lst] can
 (slice-at (range 5) 100000)
 (slice-at (range 5) 100000 #t)]
 
+@defproc[
+(slicef
+[lst list?]
+[pred procedure?])
+(listof list?)]
+Divide @racket[_lst] into sublists that are homogeneously @racket[_pred] or not @racket[_pred]. If none of the elements match @racket[_pred], there is no slice to be made, and the result is the whole input list.
+
+@examples[#:eval my-eval
+(slicef '(1 2 2 1 2) even?)
+(slicef (range 5) odd?)
+(slicef (range 5) string?)]
+
+
 @defproc[
 (slicef-at
 [lst list?]

sugar/test/main.rkt

@@ -141,6 +141,11 @@
  (check-equal? (slice-at (range 5) 3) '((0 1 2) (3 4)))
  (check-equal? (slice-at (range 5) 3 #t) '((0 1 2)))
  
+ (check-equal? (slicef '(1 2 2 1 1 1 2) odd?) '((1) (2 2) (1 1 1) (2)))
+ (check-equal? (slicef '(1 2 2 1 1 1 2) even?) (slicef '(1 2 2 1 1 1 2) odd?))
+ (check-equal? (slicef '(1 (1) (1) 1 1 1 (1)) list?) '((1) ((1) (1)) (1 1 1) ((1))))
+ (check-equal? (slicef '(1 2 3 4 5) list?) '((1 2 3 4 5)))
+ 
  (check-equal? (slicef-at (range 5) even?) '((0 1) (2 3) (4)))
  (check-equal? (slicef-at (range 5) odd?) '((0) (1 2) (3 4)))
  (check-equal? (slicef-at (range 5) odd? #t) '((1 2) (3 4)))
@@ -167,7 +172,7 @@
 
 
 (eval-as-untyped
-  (check-equal? (filter-split '("foo" " " "bar" "\n" "\n" "ino") (λ(x) (< (string-length x) 3))) '(("foo")("bar")("ino")))
+ (check-equal? (filter-split '("foo" " " "bar" "\n" "\n" "ino") (λ(x) (< (string-length x) 3))) '(("foo")("bar")("ino")))
  
  (check-exn exn:fail? (λ _ (slice-at (range 5) 0))) ; needs a positive integer as second arg
  (check-exn exn:fail? (λ _ (slicef-at (range 5) 3))) ; needs a procedure as second arg

typed/sugar/list.rkt

@@ -1,5 +1,5 @@
 #lang typed/racket/base
-(require (for-syntax racket/base racket/syntax))
+(require (for-syntax racket/base racket/syntax) racket/function)
 (require (except-in racket/list flatten dropf dropf-right) typed/sugar/define "coerce.rkt" "len.rkt")
 (require/typed racket/list [dropf (All (A) (Listof A) (A -> Boolean) -> (Listof A))]
                [dropf-right (All (A) (Listof A) (A -> Boolean) -> (Listof A))])
@@ -11,6 +11,14 @@
   (All (A) ((Listof A) (A -> Boolean) -> (Listof A)))
   (dropf-right (dropf xs test-proc) test-proc))
 
+(define/typed+provide (slicef xs pred)
+  (All (A) ((Listof A) (A -> Boolean) -> (Listof (Listof A))))
+  (let loop ([xs xs][acc : (Listof (Listof A)) empty])
+    (if (empty? xs)
+        (reverse acc)
+        (let-values ([(cdr-matches rest) (splitf-at (cdr xs) (if (pred (car xs)) pred (λ([x : A]) (not (pred x)))))])
+          (loop rest (cons (cons (car xs) cdr-matches) acc))))))
+
 (define/typed+provide slicef-at
   ;; with polymorphic function, use cased typing to simulate optional position arguments 
   (All (A) (case-> ((Listof A) (A -> Boolean) -> (Listof (Listof A)))
@@ -21,8 +29,8 @@
     [(xs pred force?)
      (define-values (last-list list-of-lists)
        (for/fold:
-           ([current-list : (Listof A) empty][list-of-lists : (Listof (Listof A)) empty])
-         ([x (in-list xs)])
+        ([current-list : (Listof A) empty][list-of-lists : (Listof (Listof A)) empty])
+        ([x (in-list xs)])
          (if (pred x)
              (values (cons x null) (if (not (empty? current-list))
                                        (cons (reverse current-list) list-of-lists)
@@ -39,7 +47,7 @@
   (All (A) ((Listof A) (A -> Boolean) -> (Listof (Listof A))))
   (define-values (last-list list-of-lists)
     (for/fold: ([current-list : (Listof A) empty][list-of-lists : (Listof (Listof A)) empty])
-      ([x (in-list xs)])
+               ([x (in-list xs)])
       (if (pred x)
           (values empty (cons (reverse (cons x current-list)) list-of-lists))
           (values (cons x current-list) list-of-lists))))
@@ -58,7 +66,7 @@
     [(xs len force?)
      (define-values (last-list list-of-lists)
        (for/fold: ([current-list : (Listof A) empty][list-of-lists : (Listof (Listof A)) empty])
-         ([x (in-list xs)][i (in-naturals)])
+                  ([x (in-list xs)][i (in-naturals)])
          (if (= (modulo (add1 i) len) 0)
              (values empty (cons (reverse (cons x current-list)) list-of-lists))
              (values (cons x current-list) list-of-lists))))
@@ -71,7 +79,7 @@
   (All (A) ((Listof A) (A -> Boolean) -> (Listof (Listof A))))
   (define-values (last-list list-of-lists)
     (for/fold: ([current-list : (Listof A) empty][list-of-lists : (Listof (Listof A)) empty])
-      ([x (in-list xs)])
+               ([x (in-list xs)])
       (if (pred x)
           (values empty (if (not (empty? current-list))
                             (cons (reverse current-list) list-of-lists)