start refac

.github/workflows/ci.yml

@@ -1,43 +0,0 @@
-name: CI
-
-on: [push, pull_request]
-
-jobs:
-  run:
-    name: "Build using Racket '${{ matrix.racket-version }}' (${{ matrix.racket-variant }})"
-    runs-on: ubuntu-latest
-    strategy:
-      fail-fast: false
-      matrix:
-        racket-version: ["6.6", "6.7", "6.8", "6.9", "6.10.1", "6.11", "6.12", "7.0", "7.1", "7.2", "7.3", "7.4", "7.5", "7.6", "7.7", "7.8", "7.9", "current"]
-        racket-variant: ["BC", "CS"]
-        # CS builds are only provided for versions 7.4 and up so avoid
-        # running the job for prior versions.
-        exclude:
-          - {racket-version: "6.6",    racket-variant: "CS"}
-          - {racket-version: "6.7",    racket-variant: "CS"}
-          - {racket-version: "6.8",    racket-variant: "CS"}
-          - {racket-version: "6.9",    racket-variant: "CS"}
-          - {racket-version: "6.10.1", racket-variant: "CS"}
-          - {racket-version: "6.11",   racket-variant: "CS"}
-          - {racket-version: "6.12",   racket-variant: "CS"}
-          - {racket-version: "7.0",    racket-variant: "CS"}
-          - {racket-version: "7.1",    racket-variant: "CS"}
-          - {racket-version: "7.2",    racket-variant: "CS"}
-          - {racket-version: "7.3",    racket-variant: "CS"}
-
-    steps:
-    - name: Checkout
-      uses: actions/checkout@master
-
-    - uses: Bogdanp/setup-racket@v0.11
-      with:
-        distribution: 'full'
-        version: ${{ matrix.racket-version }}
-        variant: ${{ matrix.racket-variant }}
-
-    - name: Install Sugar and its dependencies
-      run: raco pkg install --auto --batch
-
-    - name: Run the tests
-      run: xvfb-run raco test -j 4 -p sugar

.travis.yml

@@ -0,0 +1,54 @@
+# adapted from
+# https://github.com/greghendershott/travis-racket/blob/master/.travis.yml
+# Thanks Greg!
+
+language: c
+sudo: false
+
+env:
+  global:
+    - RACKET_DIR=~/racket
+  matrix:
+    - RACKET_VERSION=6.0
+#    - RACKET_VERSION=6.1
+#    - RACKET_VERSION=6.2
+    - RACKET_VERSION=6.3
+#    - RACKET_VERSION=6.4
+#    - RACKET_VERSION=6.5
+    - RACKET_VERSION=6.6
+#    - RACKET_VERSION=6.7
+#    - RACKET_VERSION=6.8
+    - RACKET_VERSION=6.9
+#    - RACKET_VERSION=6.10
+#    - RACKET_VERSION=6.11
+    - RACKET_VERSION=6.12
+    - RACKET_VERSION=7.0
+ #   - RACKET_VERSION=7.1
+ #   - RACKET_VERSION=7.2
+    - RACKET_VERSION=7.3
+    - RACKET_VERSION=7.4
+    - RACKET_VERSION=7.5
+    - RACKET_VERSION=7.6
+    - RACKET_VERSION=HEAD
+    - RACKET_VERSION=HEADCS
+
+# You may want to test against certain versions of Racket, without
+# having them count against the overall success/failure.
+matrix:
+  allow_failures:
+  #  - env: RACKET_VERSION=HEAD
+  - env: RACKET_VERSION=HEADCS
+  # Fast finish: Overall build result is determined as soon as any of
+  # its rows have failed, or, all of its rows that aren't allowed to
+  # fail have succeeded.
+  fast_finish: true
+
+before_install:
+  - git clone https://github.com/mbutterick/travis-racket.git
+  - cat travis-racket/install-racket.sh | bash # pipe to bash not sh!
+  - export PATH="${RACKET_DIR}/bin:${PATH}" #install-racket.sh can't set for us
+
+script:
+ - cd ..   # Travis did a cd into the dir. Back up, for the next:
+ - raco pkg install --deps search-auto --link sugar
+ - raco test -p sugar

README.md

@@ -1,4 +1,4 @@
-## Sugar ![Build Status](https://github.com/mbutterick/sugar/workflows/CI/badge.svg)
+## Sugar [![Build Status](https://travis-ci.org/mbutterick/sugar.svg?branch=master)](https://travis-ci.org/mbutterick/sugar)
 
 Functions that improve the readability of Racket code in Racket 6.0+.
 
@@ -17,10 +17,4 @@ In safe mode (with contracts):
 You can [read the docs here](http://pkg-build.racket-lang.org/doc/sugar).
 
 
-## License 
+## License = MIT
-
-MIT
-
-## Project status
-
-Complete. Maintained but no improvements planned. I don’t disavow this code, exactly, and I maintain other projects that rely on it. But it arises from a more naive era of personal Racketeering. I would not necessarily recommend taking inspiration from the code herein.

info.rkt

@@ -1,5 +0,0 @@
-#lang info
-(define collection 'multi)
-(define version "0.3")
-(define deps '("base"))
-(define build-deps '("scribble-lib" "racket-doc" "rackunit-lib"))

sugar/sugar-define/info.rkt

@@ -0,0 +1,4 @@
+#lang info
+(define collection 'multi)
+(define version "0.3")
+(define deps '(["base" #:version "6.3"]))

sugar/sugar-lib/info.rkt

@@ -0,0 +1,4 @@
+#lang info
+(define collection 'multi)
+(define version "0.3")
+(define deps '(["base" #:version "6.3"]))

sugar/sugar-lib/sugar/cache.rkt

@@ -1,7 +1,7 @@
 #lang racket/base
 (require (for-syntax
           racket/base
-          "private/syntax-utils.rkt")
+          sugar/private/syntax-utils)
          "define.rkt")
 
 (define+provide+safe (make-caching-proc base-proc) 

sugar/sugar-lib/sugar/debug.rkt

@@ -1,7 +1,7 @@
 #lang racket/base
 (require racket/string
          (for-syntax racket/base)
-         "define.rkt")
+         sugar/define)
 
 (provide+safe report report/time time-name
               report/line report/file

sugar/sugar-list/info.rkt

@@ -0,0 +1,4 @@
+#lang info
+(define collection 'multi)
+(define version "0.3")
+(define deps '(["base" #:version "6.3"] "sugar-define"))

sugar/sugar-list/sugar/list.rkt

@@ -1,13 +1,9 @@
 #lang racket/base
-(require (for-syntax
+(require (for-syntax racket/base)
-          racket/base)
          racket/list
          racket/match
          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)
   (list? procedure? . -> . list?)
@@ -109,18 +105,22 @@
     (hash-update! counter item add1 0))
   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)
-  ((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)
   ((or/c list? vector? string?) . -> . boolean?)
@@ -138,23 +138,30 @@
   (syntax-case stx ()
     [(_ 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 idx (sub1 j)))
+  (when (> i j)
-                x)]
+    (raise-argument-error 'sublist (format "starting index larger than ending index" (list i j))))
-    [else (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)))
+    x))
+
+(define (increasing-nonnegative-list? x)
+   (or (empty? x) (and (list? x) (apply < -1 x))))
 
 (define+provide+safe (break-at xs bps-in)
   (list? any/c . -> . (listof list?))
   (unless (list? xs)
     (raise-argument-error 'break-at "list" xs))
   (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
                           (format "breakpoints not greater than or equal to input list length = ~a" (length xs)) bps))
   (unless (increasing-nonnegative-list? bps)
@@ -175,16 +182,16 @@
                           (modulo (abs how-far) (length xs))
                           (abs how-far)))
   (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))]
+  (match how-far 
-    [(zero? how-far) xs]
+    [0 xs]
-    [(positive? how-far)
+    [(? positive?)
      (match/values (split-at-right xs abs-how-far)
                    [(head tail) (append (make-fill tail) head)])]
-    [else ; how-far is negative
+    [_ ; how-far is negative
      (match/values (split-at xs abs-how-far)
                    [(head tail) (append tail (make-fill head))])]))
 

sugar/sugar/info.rkt

@@ -0,0 +1,4 @@
+#lang info
+(define collection 'multi)
+(define version "0.3")
+(define deps '(["base" #:version "6.3"]))