Compare commits

..

1 Commits

Author SHA1 Message Date
Matthew Butterick 70a3835502 start refac 5 years ago

@ -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

@ -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

@ -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+. 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). 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 dont 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.

@ -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"))

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

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

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

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

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

@ -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))])]))

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