From 70a383550240314d9c8df8ff28e260aa92dec6c1 Mon Sep 17 00:00:00 2001 From: Matthew Butterick Date: Tue, 5 May 2020 22:30:04 -0700 Subject: [PATCH] start refac --- info.rkt | 5 -- sugar/sugar-define/info.rkt | 4 + sugar/{ => sugar-define/sugar}/define.rkt | 0 .../sugar}/private/syntax-utils.rkt | 0 sugar/sugar-lib/info.rkt | 4 + sugar/{ => sugar-lib/sugar}/cache.rkt | 2 +- sugar/{ => sugar-lib/sugar}/coerce.rkt | 0 sugar/{ => sugar-lib/sugar}/coerce/base.rkt | 0 .../{ => sugar-lib/sugar}/coerce/contract.rkt | 0 sugar/{ => sugar-lib/sugar}/debug.rkt | 2 +- sugar/{ => sugar-lib/sugar}/file.rkt | 0 sugar/{ => sugar-lib/sugar}/main.rkt | 0 sugar/{ => sugar-lib/sugar}/test.rkt | 0 .../sugar}/test/debug-meta-lang.rkt | 0 sugar/{ => sugar-lib/sugar}/test/main.rkt | 0 .../sugar}/test/test-require-modes.rkt | 0 sugar/{ => sugar-lib/sugar}/unstable/case.rkt | 0 .../{ => sugar-lib/sugar}/unstable/class.rkt | 0 .../sugar}/unstable/container.rkt | 0 .../sugar}/unstable/contract.rkt | 0 sugar/{ => sugar-lib/sugar}/unstable/dict.rkt | 0 .../sugar}/unstable/include.rkt | 0 sugar/{ => sugar-lib/sugar}/unstable/js.rkt | 0 sugar/{ => sugar-lib/sugar}/unstable/len.rkt | 0 sugar/{ => sugar-lib/sugar}/unstable/misc.rkt | 0 .../sugar}/unstable/no-lang-line-source.txt | 0 sugar/{ => sugar-lib/sugar}/unstable/port.rkt | 0 .../{ => sugar-lib/sugar}/unstable/source.rkt | 0 .../{ => sugar-lib/sugar}/unstable/string.rkt | 0 sugar/{ => sugar-lib/sugar}/unstable/stub.rkt | 0 sugar/{ => sugar-lib/sugar}/xml.rkt | 0 sugar/sugar-list/info.rkt | 4 + sugar/{ => sugar-list/sugar}/list.rkt | 77 ++++++++++--------- sugar/sugar/info.rkt | 4 + sugar/{ => sugar/sugar}/info.rkt | 0 .../{ => sugar/sugar}/scribblings/cache.scrbl | 0 .../sugar}/scribblings/coerce.scrbl | 0 .../sugar}/scribblings/container.scrbl | 0 .../{ => sugar/sugar}/scribblings/debug.scrbl | 0 .../sugar}/scribblings/file-extensions.scrbl | 0 .../sugar}/scribblings/include.scrbl | 0 .../sugar}/scribblings/installation.scrbl | 0 sugar/{ => sugar/sugar}/scribblings/len.scrbl | 0 .../sugar}/scribblings/license.scrbl | 0 .../{ => sugar/sugar}/scribblings/list.scrbl | 0 .../sugar}/scribblings/string.scrbl | 0 .../{ => sugar/sugar}/scribblings/sugar.scrbl | 0 sugar/{ => sugar/sugar}/scribblings/xml.scrbl | 0 48 files changed, 60 insertions(+), 42 deletions(-) delete mode 100644 info.rkt create mode 100644 sugar/sugar-define/info.rkt rename sugar/{ => sugar-define/sugar}/define.rkt (100%) rename sugar/{ => sugar-define/sugar}/private/syntax-utils.rkt (100%) create mode 100644 sugar/sugar-lib/info.rkt rename sugar/{ => sugar-lib/sugar}/cache.rkt (93%) rename sugar/{ => sugar-lib/sugar}/coerce.rkt (100%) rename sugar/{ => sugar-lib/sugar}/coerce/base.rkt (100%) rename sugar/{ => sugar-lib/sugar}/coerce/contract.rkt (100%) rename sugar/{ => sugar-lib/sugar}/debug.rkt (99%) rename sugar/{ => sugar-lib/sugar}/file.rkt (100%) rename sugar/{ => sugar-lib/sugar}/main.rkt (100%) rename sugar/{ => sugar-lib/sugar}/test.rkt (100%) rename sugar/{ => sugar-lib/sugar}/test/debug-meta-lang.rkt (100%) rename sugar/{ => sugar-lib/sugar}/test/main.rkt (100%) rename sugar/{ => sugar-lib/sugar}/test/test-require-modes.rkt (100%) rename sugar/{ => sugar-lib/sugar}/unstable/case.rkt (100%) rename sugar/{ => sugar-lib/sugar}/unstable/class.rkt (100%) rename sugar/{ => sugar-lib/sugar}/unstable/container.rkt (100%) rename sugar/{ => sugar-lib/sugar}/unstable/contract.rkt (100%) rename sugar/{ => sugar-lib/sugar}/unstable/dict.rkt (100%) rename sugar/{ => sugar-lib/sugar}/unstable/include.rkt (100%) rename sugar/{ => sugar-lib/sugar}/unstable/js.rkt (100%) rename sugar/{ => sugar-lib/sugar}/unstable/len.rkt (100%) rename sugar/{ => sugar-lib/sugar}/unstable/misc.rkt (100%) rename sugar/{ => sugar-lib/sugar}/unstable/no-lang-line-source.txt (100%) rename sugar/{ => sugar-lib/sugar}/unstable/port.rkt (100%) rename sugar/{ => sugar-lib/sugar}/unstable/source.rkt (100%) rename sugar/{ => sugar-lib/sugar}/unstable/string.rkt (100%) rename sugar/{ => sugar-lib/sugar}/unstable/stub.rkt (100%) rename sugar/{ => sugar-lib/sugar}/xml.rkt (100%) create mode 100644 sugar/sugar-list/info.rkt rename sugar/{ => sugar-list/sugar}/list.rkt (82%) create mode 100644 sugar/sugar/info.rkt rename sugar/{ => sugar/sugar}/info.rkt (100%) rename sugar/{ => sugar/sugar}/scribblings/cache.scrbl (100%) rename sugar/{ => sugar/sugar}/scribblings/coerce.scrbl (100%) rename sugar/{ => sugar/sugar}/scribblings/container.scrbl (100%) rename sugar/{ => sugar/sugar}/scribblings/debug.scrbl (100%) rename sugar/{ => sugar/sugar}/scribblings/file-extensions.scrbl (100%) rename sugar/{ => sugar/sugar}/scribblings/include.scrbl (100%) rename sugar/{ => sugar/sugar}/scribblings/installation.scrbl (100%) rename sugar/{ => sugar/sugar}/scribblings/len.scrbl (100%) rename sugar/{ => sugar/sugar}/scribblings/license.scrbl (100%) rename sugar/{ => sugar/sugar}/scribblings/list.scrbl (100%) rename sugar/{ => sugar/sugar}/scribblings/string.scrbl (100%) rename sugar/{ => sugar/sugar}/scribblings/sugar.scrbl (100%) rename sugar/{ => sugar/sugar}/scribblings/xml.scrbl (100%) diff --git a/info.rkt b/info.rkt deleted file mode 100644 index bc62223..0000000 --- a/info.rkt +++ /dev/null @@ -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")) diff --git a/sugar/sugar-define/info.rkt b/sugar/sugar-define/info.rkt new file mode 100644 index 0000000..3ff6f47 --- /dev/null +++ b/sugar/sugar-define/info.rkt @@ -0,0 +1,4 @@ +#lang info +(define collection 'multi) +(define version "0.3") +(define deps '(["base" #:version "6.3"])) \ No newline at end of file diff --git a/sugar/define.rkt b/sugar/sugar-define/sugar/define.rkt similarity index 100% rename from sugar/define.rkt rename to sugar/sugar-define/sugar/define.rkt diff --git a/sugar/private/syntax-utils.rkt b/sugar/sugar-define/sugar/private/syntax-utils.rkt similarity index 100% rename from sugar/private/syntax-utils.rkt rename to sugar/sugar-define/sugar/private/syntax-utils.rkt diff --git a/sugar/sugar-lib/info.rkt b/sugar/sugar-lib/info.rkt new file mode 100644 index 0000000..3ff6f47 --- /dev/null +++ b/sugar/sugar-lib/info.rkt @@ -0,0 +1,4 @@ +#lang info +(define collection 'multi) +(define version "0.3") +(define deps '(["base" #:version "6.3"])) \ No newline at end of file diff --git a/sugar/cache.rkt b/sugar/sugar-lib/sugar/cache.rkt similarity index 93% rename from sugar/cache.rkt rename to sugar/sugar-lib/sugar/cache.rkt index 6d681e5..04e317e 100644 --- a/sugar/cache.rkt +++ b/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) diff --git a/sugar/coerce.rkt b/sugar/sugar-lib/sugar/coerce.rkt similarity index 100% rename from sugar/coerce.rkt rename to sugar/sugar-lib/sugar/coerce.rkt diff --git a/sugar/coerce/base.rkt b/sugar/sugar-lib/sugar/coerce/base.rkt similarity index 100% rename from sugar/coerce/base.rkt rename to sugar/sugar-lib/sugar/coerce/base.rkt diff --git a/sugar/coerce/contract.rkt b/sugar/sugar-lib/sugar/coerce/contract.rkt similarity index 100% rename from sugar/coerce/contract.rkt rename to sugar/sugar-lib/sugar/coerce/contract.rkt diff --git a/sugar/debug.rkt b/sugar/sugar-lib/sugar/debug.rkt similarity index 99% rename from sugar/debug.rkt rename to sugar/sugar-lib/sugar/debug.rkt index 51631d4..1ad5ee0 100644 --- a/sugar/debug.rkt +++ b/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 diff --git a/sugar/file.rkt b/sugar/sugar-lib/sugar/file.rkt similarity index 100% rename from sugar/file.rkt rename to sugar/sugar-lib/sugar/file.rkt diff --git a/sugar/main.rkt b/sugar/sugar-lib/sugar/main.rkt similarity index 100% rename from sugar/main.rkt rename to sugar/sugar-lib/sugar/main.rkt diff --git a/sugar/test.rkt b/sugar/sugar-lib/sugar/test.rkt similarity index 100% rename from sugar/test.rkt rename to sugar/sugar-lib/sugar/test.rkt diff --git a/sugar/test/debug-meta-lang.rkt b/sugar/sugar-lib/sugar/test/debug-meta-lang.rkt similarity index 100% rename from sugar/test/debug-meta-lang.rkt rename to sugar/sugar-lib/sugar/test/debug-meta-lang.rkt diff --git a/sugar/test/main.rkt b/sugar/sugar-lib/sugar/test/main.rkt similarity index 100% rename from sugar/test/main.rkt rename to sugar/sugar-lib/sugar/test/main.rkt diff --git a/sugar/test/test-require-modes.rkt b/sugar/sugar-lib/sugar/test/test-require-modes.rkt similarity index 100% rename from sugar/test/test-require-modes.rkt rename to sugar/sugar-lib/sugar/test/test-require-modes.rkt diff --git a/sugar/unstable/case.rkt b/sugar/sugar-lib/sugar/unstable/case.rkt similarity index 100% rename from sugar/unstable/case.rkt rename to sugar/sugar-lib/sugar/unstable/case.rkt diff --git a/sugar/unstable/class.rkt b/sugar/sugar-lib/sugar/unstable/class.rkt similarity index 100% rename from sugar/unstable/class.rkt rename to sugar/sugar-lib/sugar/unstable/class.rkt diff --git a/sugar/unstable/container.rkt b/sugar/sugar-lib/sugar/unstable/container.rkt similarity index 100% rename from sugar/unstable/container.rkt rename to sugar/sugar-lib/sugar/unstable/container.rkt diff --git a/sugar/unstable/contract.rkt b/sugar/sugar-lib/sugar/unstable/contract.rkt similarity index 100% rename from sugar/unstable/contract.rkt rename to sugar/sugar-lib/sugar/unstable/contract.rkt diff --git a/sugar/unstable/dict.rkt b/sugar/sugar-lib/sugar/unstable/dict.rkt similarity index 100% rename from sugar/unstable/dict.rkt rename to sugar/sugar-lib/sugar/unstable/dict.rkt diff --git a/sugar/unstable/include.rkt b/sugar/sugar-lib/sugar/unstable/include.rkt similarity index 100% rename from sugar/unstable/include.rkt rename to sugar/sugar-lib/sugar/unstable/include.rkt diff --git a/sugar/unstable/js.rkt b/sugar/sugar-lib/sugar/unstable/js.rkt similarity index 100% rename from sugar/unstable/js.rkt rename to sugar/sugar-lib/sugar/unstable/js.rkt diff --git a/sugar/unstable/len.rkt b/sugar/sugar-lib/sugar/unstable/len.rkt similarity index 100% rename from sugar/unstable/len.rkt rename to sugar/sugar-lib/sugar/unstable/len.rkt diff --git a/sugar/unstable/misc.rkt b/sugar/sugar-lib/sugar/unstable/misc.rkt similarity index 100% rename from sugar/unstable/misc.rkt rename to sugar/sugar-lib/sugar/unstable/misc.rkt diff --git a/sugar/unstable/no-lang-line-source.txt b/sugar/sugar-lib/sugar/unstable/no-lang-line-source.txt similarity index 100% rename from sugar/unstable/no-lang-line-source.txt rename to sugar/sugar-lib/sugar/unstable/no-lang-line-source.txt diff --git a/sugar/unstable/port.rkt b/sugar/sugar-lib/sugar/unstable/port.rkt similarity index 100% rename from sugar/unstable/port.rkt rename to sugar/sugar-lib/sugar/unstable/port.rkt diff --git a/sugar/unstable/source.rkt b/sugar/sugar-lib/sugar/unstable/source.rkt similarity index 100% rename from sugar/unstable/source.rkt rename to sugar/sugar-lib/sugar/unstable/source.rkt diff --git a/sugar/unstable/string.rkt b/sugar/sugar-lib/sugar/unstable/string.rkt similarity index 100% rename from sugar/unstable/string.rkt rename to sugar/sugar-lib/sugar/unstable/string.rkt diff --git a/sugar/unstable/stub.rkt b/sugar/sugar-lib/sugar/unstable/stub.rkt similarity index 100% rename from sugar/unstable/stub.rkt rename to sugar/sugar-lib/sugar/unstable/stub.rkt diff --git a/sugar/xml.rkt b/sugar/sugar-lib/sugar/xml.rkt similarity index 100% rename from sugar/xml.rkt rename to sugar/sugar-lib/sugar/xml.rkt diff --git a/sugar/sugar-list/info.rkt b/sugar/sugar-list/info.rkt new file mode 100644 index 0000000..c3aeaa5 --- /dev/null +++ b/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")) \ No newline at end of file diff --git a/sugar/list.rkt b/sugar/sugar-list/sugar/list.rkt similarity index 82% rename from sugar/list.rkt rename to sugar/sugar-list/sugar/list.rkt index 6918f42..54aac75 100644 --- a/sugar/list.rkt +++ b/sugar/sugar-list/sugar/list.rkt @@ -1,13 +1,9 @@ #lang racket/base -(require (for-syntax - racket/base) +(require (for-syntax racket/base) racket/list racket/match racket/function - "define.rkt") - -(define (increasing-nonnegative-list? x) - (and (list? x) (or (empty? x) (apply < -1 x)))) + sugar/define) (define+provide+safe (trimf xs test-proc) (list? procedure? . -> . list?) @@ -109,18 +105,22 @@ (hash-update! counter item add1 0)) counter) -(define (->list x) - (match x - [(? list? x) x] - [(? vector?) (vector->list x)] - [(? string?) (string->list x)] - [else (raise-argument-error '->list "item that can be converted to list" x)])) +(define+provide+safe (->list xs) + (sequence? . -> . list?) + (unless (sequence? xs) + (raise-argument-error '->list "sequence" xs)) + (match xs + [(? 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?) - (match (->list x) - [(? list? x) (= (length (remove-duplicates x)) (length x))] - [_ (raise-argument-error 'members-unique? "list, vector, or string" x)])) + (sequence? . -> . boolean?) + (unless (sequence? x) + (raise-argument-error 'members-unique? "sequence" 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) - (list? exact-nonnegative-integer? exact-nonnegative-integer? . -> . list?) - (unless (list? xs) - (raise-argument-error 'sublist "list?" xs)) - (cond - [(> j (length xs)) (error 'sublist (format "ending index ~a exceeds length of list" j))] - [(>= j i) (for/list ([(x idx) (in-indexed xs)] - #:when (<= i idx (sub1 j))) - x)] - [else (raise-argument-error 'sublist (format "starting index larger than ending index" (list i j)))])) +(define+provide+safe (sublist seq i j) + (sequence? exact-nonnegative-integer? exact-nonnegative-integer? . -> . list?) + (unless (sequence? seq) + (raise-argument-error 'sublist "sequence?" seq)) + (define xs (->list seq)) + (when (> j (length 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))) + 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 - [(> abs-how-far (length xs)) - (raise-argument-error caller - (format "index not larger than list length ~a" (length xs)) - (* (if (eq? caller 'shift-left) -1 1) how-far))] - [(zero? how-far) xs] - [(positive? how-far) + (when (> abs-how-far (length xs)) + (raise-argument-error caller + (format "index not larger than list length ~a" (length xs)) + (* (if (eq? caller 'shift-left) -1 1) how-far))) + (match how-far + [0 xs] + [(? 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))])])) diff --git a/sugar/sugar/info.rkt b/sugar/sugar/info.rkt new file mode 100644 index 0000000..e501810 --- /dev/null +++ b/sugar/sugar/info.rkt @@ -0,0 +1,4 @@ +#lang info +(define collection 'multi) +(define version "0.3") +(define deps '(["base" #:version "6.3"])) diff --git a/sugar/info.rkt b/sugar/sugar/sugar/info.rkt similarity index 100% rename from sugar/info.rkt rename to sugar/sugar/sugar/info.rkt diff --git a/sugar/scribblings/cache.scrbl b/sugar/sugar/sugar/scribblings/cache.scrbl similarity index 100% rename from sugar/scribblings/cache.scrbl rename to sugar/sugar/sugar/scribblings/cache.scrbl diff --git a/sugar/scribblings/coerce.scrbl b/sugar/sugar/sugar/scribblings/coerce.scrbl similarity index 100% rename from sugar/scribblings/coerce.scrbl rename to sugar/sugar/sugar/scribblings/coerce.scrbl diff --git a/sugar/scribblings/container.scrbl b/sugar/sugar/sugar/scribblings/container.scrbl similarity index 100% rename from sugar/scribblings/container.scrbl rename to sugar/sugar/sugar/scribblings/container.scrbl diff --git a/sugar/scribblings/debug.scrbl b/sugar/sugar/sugar/scribblings/debug.scrbl similarity index 100% rename from sugar/scribblings/debug.scrbl rename to sugar/sugar/sugar/scribblings/debug.scrbl diff --git a/sugar/scribblings/file-extensions.scrbl b/sugar/sugar/sugar/scribblings/file-extensions.scrbl similarity index 100% rename from sugar/scribblings/file-extensions.scrbl rename to sugar/sugar/sugar/scribblings/file-extensions.scrbl diff --git a/sugar/scribblings/include.scrbl b/sugar/sugar/sugar/scribblings/include.scrbl similarity index 100% rename from sugar/scribblings/include.scrbl rename to sugar/sugar/sugar/scribblings/include.scrbl diff --git a/sugar/scribblings/installation.scrbl b/sugar/sugar/sugar/scribblings/installation.scrbl similarity index 100% rename from sugar/scribblings/installation.scrbl rename to sugar/sugar/sugar/scribblings/installation.scrbl diff --git a/sugar/scribblings/len.scrbl b/sugar/sugar/sugar/scribblings/len.scrbl similarity index 100% rename from sugar/scribblings/len.scrbl rename to sugar/sugar/sugar/scribblings/len.scrbl diff --git a/sugar/scribblings/license.scrbl b/sugar/sugar/sugar/scribblings/license.scrbl similarity index 100% rename from sugar/scribblings/license.scrbl rename to sugar/sugar/sugar/scribblings/license.scrbl diff --git a/sugar/scribblings/list.scrbl b/sugar/sugar/sugar/scribblings/list.scrbl similarity index 100% rename from sugar/scribblings/list.scrbl rename to sugar/sugar/sugar/scribblings/list.scrbl diff --git a/sugar/scribblings/string.scrbl b/sugar/sugar/sugar/scribblings/string.scrbl similarity index 100% rename from sugar/scribblings/string.scrbl rename to sugar/sugar/sugar/scribblings/string.scrbl diff --git a/sugar/scribblings/sugar.scrbl b/sugar/sugar/sugar/scribblings/sugar.scrbl similarity index 100% rename from sugar/scribblings/sugar.scrbl rename to sugar/sugar/sugar/scribblings/sugar.scrbl diff --git a/sugar/scribblings/xml.scrbl b/sugar/sugar/sugar/scribblings/xml.scrbl similarity index 100% rename from sugar/scribblings/xml.scrbl rename to sugar/sugar/sugar/scribblings/xml.scrbl