├── .github └── workflows │ └── test.yml ├── .gitignore ├── LICENSE ├── Makefile ├── README.md ├── THANKS.md ├── info.rkt └── rackjure ├── LICENSE ├── alist.rkt ├── app.rkt ├── base.rkt ├── base └── lang │ └── reader.rkt ├── bench.rkt ├── check-expansion.rkt ├── conditionals.rkt ├── dict.rkt ├── egal.rkt ├── info.rkt ├── lambda-reader.rkt ├── lang ├── language-info.rkt ├── reader.rkt └── runtime-config.rkt ├── main.rkt ├── rackjure.rkt ├── rackjure.scrbl ├── str.rkt ├── test.rkt ├── threading.rkt └── utils.rkt /.github/workflows/test.yml: -------------------------------------------------------------------------------- 1 | name: CI 2 | 3 | on: 4 | push: 5 | pull_request: 6 | 7 | jobs: 8 | test: 9 | runs-on: ubuntu-latest 10 | strategy: 11 | fail-fast: false 12 | matrix: 13 | racket_version: 14 | - '6.9' 15 | - 'stable' 16 | - 'current' 17 | name: Test Racket ${{ matrix.racket_version }} 18 | steps: 19 | - name: Checkout 20 | uses: actions/checkout@master 21 | - name: Install Racket 22 | uses: Bogdanp/setup-racket@v1.1 23 | with: 24 | architecture: 'x64' 25 | distribution: 'full' 26 | version: ${{ matrix.racket_version }} 27 | - name: Install Package 28 | run: make install 29 | - name: Check Deps 30 | run: make check-deps 31 | - name: Run Tests 32 | run: make test 33 | -------------------------------------------------------------------------------- /.gitignore: -------------------------------------------------------------------------------- 1 | .DS_Store 2 | compiled/ 3 | htmldocs/ 4 | doc/ 5 | *~ 6 | -------------------------------------------------------------------------------- /LICENSE: -------------------------------------------------------------------------------- 1 | Copyright (c) 2013-2017, Greg Hendershott. 2 | All rights reserved. 3 | 4 | Redistribution and use in source and binary forms, with or without 5 | modification, are permitted provided that the following conditions are 6 | met: 7 | 8 | - Redistributions of source code must retain the above copyright 9 | notice, this list of conditions and the following disclaimer. 10 | 11 | - Redistributions in binary form must reproduce the above copyright 12 | notice, this list of conditions and the following disclaimer in the 13 | documentation and/or other materials provided with the distribution. 14 | 15 | THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS 16 | "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT 17 | LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR 18 | A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT 19 | HOLDER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, 20 | SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT 21 | LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, 22 | DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY 23 | THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT 24 | (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE 25 | OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. 26 | -------------------------------------------------------------------------------- /Makefile: -------------------------------------------------------------------------------- 1 | PACKAGE-NAME=rackjure 2 | 3 | DEPS-FLAGS=--check-pkg-deps --unused-pkg-deps 4 | 5 | all: setup 6 | 7 | # Primarily for use by CI. 8 | # Installs dependencies as well as linking this as a package. 9 | install: 10 | raco pkg install --deps search-auto 11 | 12 | remove: 13 | raco pkg remove $(PACKAGE-NAME) 14 | 15 | # Primarily for day-to-day dev. 16 | # Note: Also builds docs (if any) and checks deps. 17 | setup: 18 | raco setup --tidy --avoid-main $(DEPS-FLAGS) --pkgs $(PACKAGE-NAME) 19 | 20 | # Note: Each collection's info.rkt can say what to clean, for example 21 | # (define clean '("compiled" "doc" "doc/")) to clean 22 | # generated docs, too. 23 | clean: 24 | raco setup --fast-clean --pkgs $(PACKAGE-NAME) 25 | 26 | # Primarily for use by CI, after make install -- since that already 27 | # does the equivalent of make setup, this tries to do as little as 28 | # possible except checking deps. 29 | check-deps: 30 | raco setup --no-docs $(DEPS-FLAGS) $(PACKAGE-NAME) 31 | 32 | # Suitable for both day-to-day dev and CI 33 | test: 34 | raco test -x -p $(PACKAGE-NAME) 35 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | [![CI](https://github.com/greghendershott/rackjure/workflows/CI/badge.svg)](https://github.com/greghendershott/rackjure/actions) 2 | [![raco pkg install rackjure](https://img.shields.io/badge/raco_pkg_install-rackjure-aa00ff.svg)](http:pkgs.racket-lang.org/#[rackjure]) 3 | [![Documentation](https://img.shields.io/badge/read-documentation-blue.svg)](http://pkg-build.racket-lang.org/doc/rackjure@rackjure/index.html) 4 | ![BSD License](https://img.shields.io/badge/license-BSD-green) 5 | 6 | # #lang rackjure 7 | 8 | Provide a few Clojure-inspired ideas in Racket. 9 | 10 | Where Racket and Clojure conflict, prefer Racket. 11 | 12 | [Documentation](http://pkg-build.racket-lang.org/doc/rackjure/index.html). 13 | -------------------------------------------------------------------------------- /THANKS.md: -------------------------------------------------------------------------------- 1 | # Thanks! 2 | 3 | ## Pull Requests 4 | 5 | Thanks to the following people for contributing pull requests! 6 | 7 | - [qerub](https://github.com/qerub) 8 | - [parentheticaluniverse](https://github.com/parentheticaluniverse) 9 | - [technomancy](https://github.com/technomancy) 10 | - [AlexKnauth](https://github.com/AlexKnauth) 11 | - [gus-massa](https://github.com/gus-massa) 12 | -------------------------------------------------------------------------------- /info.rkt: -------------------------------------------------------------------------------- 1 | #lang info 2 | (define license 'BSD-2-Clause) 3 | (define version "0.10") 4 | (define collection 'multi) 5 | (define deps '(["base" #:version "6.3"] 6 | "rackunit-lib" 7 | ["threading-lib" #:version "1.1"])) 8 | (define build-deps '("rackunit-lib" 9 | "racket-doc" 10 | "sandbox-lib" 11 | "scribble-lib" 12 | "threading-doc")) 13 | -------------------------------------------------------------------------------- /rackjure/LICENSE: -------------------------------------------------------------------------------- 1 | Copyright (c) 2013-2017, Greg Hendershott. 2 | Portions Copyright (c) 2013 Asumu Takikawa. 3 | 4 | Redistribution and use in source and binary forms, with or without 5 | modification, are permitted provided that the following conditions are 6 | met: 7 | 8 | - Redistributions of source code must retain the above copyright 9 | notice, this list of conditions and the following disclaimer. 10 | 11 | - Redistributions in binary form must reproduce the above copyright 12 | notice, this list of conditions and the following disclaimer in the 13 | documentation and/or other materials provided with the distribution. 14 | 15 | THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS 16 | "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT 17 | LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR 18 | A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT 19 | HOLDER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, 20 | SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT 21 | LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, 22 | DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY 23 | THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT 24 | (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE 25 | OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. 26 | -------------------------------------------------------------------------------- /rackjure/alist.rkt: -------------------------------------------------------------------------------- 1 | ;; Copyright (c) 2013-2022 by Greg Hendershott. 2 | ;; SPDX-License-Identifier: BSD-2-Clause 3 | 4 | #lang racket/base 5 | 6 | (provide alist alist?) 7 | 8 | (require racket/match) 9 | 10 | (define (alist . xs) 11 | (match xs 12 | [(list* k v more) (cons (cons k v) (apply alist more))] 13 | [(list x) (raise-arity-error 'alist (arity-at-least 2) x)] 14 | [(list) (list)])) 15 | 16 | (define (alist? xs) 17 | (and (list? xs) 18 | (for/and ([x (in-list xs)]) 19 | (pair? x)))) 20 | 21 | (module+ test 22 | (require rackunit) 23 | (check-equal? (alist 1 2 3 4 5 6) '([1 . 2][3 . 4][5 . 6])) 24 | (check-equal? (alist) '())) 25 | -------------------------------------------------------------------------------- /rackjure/app.rkt: -------------------------------------------------------------------------------- 1 | ;; Copyright (c) 2013-2022 by Greg Hendershott. 2 | ;; SPDX-License-Identifier: BSD-2-Clause 3 | 4 | #lang racket/base 5 | 6 | (require (for-syntax racket/base 7 | racket/list 8 | syntax/parse) 9 | racket/dict 10 | "alist.rkt") 11 | 12 | (provide -#%app 13 | alist 14 | alist? 15 | current-curly-dict) 16 | 17 | ;; Provide an alternative `#%app` to: 18 | ;; 19 | ;; [1] Implement applicable `dict?`s. 20 | ;; 21 | ;; (a) Handle a `dict?` in the first or second position. 22 | ;; 23 | ;; Downside: Adds a runtime `cond` check to normal applications of 24 | ;; arities 2 and 3. 25 | ;; 26 | ;; We can look for certain arities at compile time, but the real test 27 | ;; must be done at run time. For code size, do this in helper function 28 | ;; rather than expanding such test inline. 29 | ;; 30 | ;; One issue is how to handle the optional last argument to 31 | ;; `dict-ref`, which is the value to use if the key is not found. We 32 | ;; handle this slightly differently than `dict-ref`: 1. We use an 33 | ;; optional keyword argument #:else. This leaves arity 3 available to 34 | ;; mean `dict-set`. 2. When a default arg isn't supplied and the key 35 | ;; isn't found, `dict-ref` raises an error. Instead we return `#f`. 36 | ;; This is more convenient, especially when used with threading macros 37 | ;; ~> and ~>>. [It's smart that dict-ref lets you supply a specific 38 | ;; value to mean not-found -- because what if `#f` or 'not-found or 39 | ;; whatever could be a valid value in the `dict?`. But even smarter is 40 | ;; for the not-found behavior to be returning #f, by default, rather 41 | ;; than raising an error. That way, using #:else is required only for 42 | ;; the special case of a dict that needs to store #f values.] 43 | ;; 44 | ;; (b) Handle `(key #f)` as #f. This allows doing a `dict-has-key?` 45 | ;; over nested dicts with threading as `(~> dict 'a 'b 'c)`. Because 46 | ;; failure at any point will return #f, and we propogate the #f to the 47 | ;; end. 48 | ;; 49 | ;; [2] Expand `{k v ... ...}` as `((current-curly-dict) k v ... ...)`. 50 | ;; The current-curly-dict parameter may be e.g. `hash`, `hasheq`, 51 | ;; `alist`. 52 | 53 | (define (maybe-dict-ref x y) 54 | (cond [(dict? x) (dict-ref x y #f)] ;(dict key) 55 | [(not y) #f] ;(key #f) => #f 56 | [(dict? y) (dict-ref y x #f)] ;(key dict) 57 | [else (error 'applicable-dict 58 | "No dict? supplied\nin: (~v ~v)" x y)])) 59 | 60 | (define (maybe-dict-ref/else x y #:else d) 61 | (cond [(dict? x) (dict-ref x y d)] ;(dict key #:else default) 62 | [(dict? y) (dict-ref y x d)] ;(key dict #:else default) 63 | [else (error 'applicable-dict 64 | "No dict? supplied\nin: (~v ~v #:else ~a)" x y d)])) 65 | 66 | (define (maybe-dict-set x y z) 67 | (cond [(dict? x) (dict-set x y z)] ;(dict key val) 68 | [else (error 'applicable-dict 69 | "No dict? supplied\nin: (~a ~a ~a)" x y z)])) 70 | 71 | ;; What function does `{ k v ... ... }` expand to? Can be `hash`, 72 | ;; `hasheq`, `alist`, or similar signature function that returns a 73 | ;; `dict?`. 74 | (define current-curly-dict (make-parameter alist)) 75 | 76 | (define-syntax (-#%app stx) 77 | (syntax-parse stx 78 | ;; { key val ... ... } dict literals 79 | [(_ x:expr ...) #:when (eq? (syntax-property stx 'paren-shape) #\{) 80 | (define stxs (syntax->list #'(x ...))) 81 | (unless (zero? (remainder (length stxs) 2)) 82 | (raise-syntax-error 83 | '|{ }| 84 | "expected even number of keys and values for dictionary" 85 | #'(x ...) 86 | (last stxs))) 87 | #'((current-curly-dict) x ...)] 88 | ;; Arities that might be dict applications 89 | ; Test the normal case first/fast 90 | [(_ x:expr y:expr) #'(let ([x_ x] [y_ y]) 91 | (cond [(procedure? x_) (#%app x_ y_)] 92 | [else (maybe-dict-ref x_ y_)]))] 93 | [(_ x:expr y:expr #:else d:expr) #'(let ([x_ x] [y_ y] [d_ d]) 94 | (cond [(procedure? x_) (#%app x_ y_ #:else d_)] 95 | [else (maybe-dict-ref/else x_ y_ #:else d_)]))] 96 | [(_ x:expr y:expr z:expr) #'(let ([x_ x] [y_ y] [z_ z]) 97 | (cond [(procedure? x_) (#%app x_ y_ z_)] 98 | [else (maybe-dict-set x_ y_ z_)]))] 99 | ;; Else just the usual Racket #%app 100 | [(_ f a ...) #'(#%app f a ...)])) 101 | -------------------------------------------------------------------------------- /rackjure/base.rkt: -------------------------------------------------------------------------------- 1 | ;; Copyright (c) 2013-2022 by Greg Hendershott. 2 | ;; SPDX-License-Identifier: BSD-2-Clause 3 | 4 | #lang racket/base 5 | 6 | (require "app.rkt") 7 | 8 | (provide (except-out (all-from-out racket/base) #%app) 9 | (rename-out [-#%app #%app]) 10 | (except-out (all-from-out "app.rkt") -#%app)) 11 | -------------------------------------------------------------------------------- /rackjure/base/lang/reader.rkt: -------------------------------------------------------------------------------- 1 | #lang s-exp syntax/module-reader 2 | rackjure/base 3 | #:wrapper1 wrapper1 4 | 5 | (require "../../lambda-reader.rkt") 6 | -------------------------------------------------------------------------------- /rackjure/bench.rkt: -------------------------------------------------------------------------------- 1 | ;; Copyright (c) 2013-2022 by Greg Hendershott. 2 | ;; SPDX-License-Identifier: BSD-2-Clause 3 | 4 | #lang racket/base 5 | 6 | (module normal racket 7 | (displayln "#lang racket ----------") 8 | (define-syntax (time* stx) 9 | (syntax-case stx () 10 | [(_ e) 11 | (with-syntax ([ed (format "~s" (syntax->datum #'e))]) 12 | #`(begin 13 | (displayln ed) 14 | (for ([i 3]) (collect-garbage)) 15 | (time e) 16 | (newline)))])) 17 | ;; Normal function application 18 | (time* (for ([i 10000000]) 19 | (+ 1 1))) 20 | ) 21 | 22 | (module special rackjure/rackjure 23 | (displayln "#lang rackjure ----------") 24 | (define-syntax (time* stx) 25 | (syntax-case stx () 26 | [(_ e) 27 | (with-syntax ([ed (format "~s" (syntax->datum #'e))]) 28 | #`(begin 29 | (displayln ed) 30 | (for ([i 3]) (collect-garbage)) 31 | (time e) 32 | (newline)))])) 33 | ;; Normal function application 34 | (time* (for ([i 10000000]) 35 | (+ 1 1))) 36 | ;; Dict ref via various forms 37 | (let ([d {'a {'b {'c 0}}}]) 38 | (time* (for ([i 100000]) 39 | (dict-ref d 'a))) 40 | (time* (for ([i 100000]) 41 | (d 'a))) 42 | (time* (for ([i 100000]) 43 | ('a d)))) 44 | 45 | (let ([d {'a {'b {'c 0}}}]) 46 | (time* (for ([i 100000]) 47 | (dict-ref (dict-ref (dict-ref d 'a) 'b) 'c))) 48 | (time* (for ([i 100000]) 49 | (~> d 'a 'b 'c)))) 50 | ) 51 | 52 | (require 'normal) 53 | (require 'special) 54 | -------------------------------------------------------------------------------- /rackjure/check-expansion.rkt: -------------------------------------------------------------------------------- 1 | ;; Copyright (c) 2013-2022 by Greg Hendershott. 2 | ;; SPDX-License-Identifier: BSD-2-Clause 3 | 4 | #lang racket/base 5 | 6 | (require (for-syntax racket/base 7 | syntax/parse) 8 | rackunit) 9 | 10 | (provide check-expand-once 11 | check-expand-fully 12 | check-expand-once/both 13 | check-expand-fully/both) 14 | 15 | ;; 1. These are macros not functions so that check failure source 16 | ;; location will be correct. Also, note we need to use quasisyntax/loc 17 | ;; specifically on the `check-equal?` form, since it's inside another 18 | ;; form and quasisyntax/loc doesn't change the source for pieces 19 | ;; inside the form. 20 | ;; 21 | ;; 2. Setting `current-namespace` is required for this to work with 22 | ;; Racket 5.3.2, although not for later versions like 5.3.5. 23 | 24 | (begin-for-syntax 25 | (define-syntax-class anchor 26 | #:description "An identifier created with define-namespace-anchor" 27 | (pattern a:id))) 28 | 29 | (define-syntax (check-expansion stx) 30 | (syntax-parse stx 31 | [(_ expander-input:id expander-expected:id anchor:anchor input:expr expected:expr) 32 | #`(parameterize ([current-namespace (namespace-anchor->namespace anchor)]) 33 | #,(quasisyntax/loc stx 34 | (check-equal? (syntax->datum (expander-input input)) 35 | (syntax->datum (expander-expected expected)))))])) 36 | 37 | (define-syntax-rule (check-expand-once anchor input expected) 38 | (check-expansion expand-once values anchor input expected)) 39 | 40 | (define-syntax-rule (check-expand-fully anchor input expected) 41 | (check-expansion expand values anchor input expected)) 42 | 43 | (define-syntax-rule (check-expand-once/both anchor input expected) 44 | (check-expansion expand-once expand-once anchor input expected)) 45 | 46 | (define-syntax-rule (check-expand-fully/both anchor input expected) 47 | (check-expansion expand expand anchor input expected)) 48 | -------------------------------------------------------------------------------- /rackjure/conditionals.rkt: -------------------------------------------------------------------------------- 1 | ;; Copyright (c) 2013-2022 by Greg Hendershott. 2 | ;; SPDX-License-Identifier: BSD-2-Clause 3 | 4 | #lang racket/base 5 | 6 | (require syntax/parse/define) 7 | 8 | (provide if-let 9 | when-let 10 | if-not 11 | when-not) 12 | 13 | (define-simple-macro (if-let [binding:id value:expr] then:expr else:expr) 14 | (let ([binding value]) 15 | (if binding then else))) 16 | 17 | (define-simple-macro (when-let [binding:id value:expr] body:expr ...+) 18 | (let ([binding value]) 19 | (when binding body ...))) 20 | 21 | (define-simple-macro (if-not test:expr then:expr else:expr) 22 | (if (not test) then else)) 23 | 24 | (define-simple-macro (when-not test:expr body:expr ...+) 25 | (when (not test) body ...)) 26 | 27 | (module+ test 28 | (require rackunit 29 | "check-expansion.rkt") 30 | (define-namespace-anchor a) 31 | (check-expand-once a #'(if-let [x #t] 0 1) #'(let [(x #t)] (if x 0 1))) 32 | (check-expand-once a #'(when-let [x #t] 0 1) #'(let [(x #t)] (when x 0 1))) 33 | (check-expand-once a #'(if-not #t 0 1) #'(if (not #t) 0 1)) 34 | (check-expand-once a #'(when-not #t 0 1) #'(when (not #t) 0 1))) 35 | -------------------------------------------------------------------------------- /rackjure/dict.rkt: -------------------------------------------------------------------------------- 1 | ;; Copyright (c) 2013-2022 by Greg Hendershott. 2 | ;; SPDX-License-Identifier: BSD-2-Clause 3 | 4 | #lang racket/base 5 | 6 | (require racket/contract 7 | racket/dict 8 | racket/function 9 | "alist.rkt") 10 | 11 | (provide 12 | (contract-out 13 | [dict-merge (dict? dict? . -> . dict?)] 14 | [dict-merge-delete-value (parameter/c any/c)] 15 | [dict->curly-string (dict? . -> . string?)])) 16 | 17 | (module+ test 18 | (require rackunit)) 19 | 20 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 21 | 22 | ;; Functionally merge d1 into d0. Values in d0 are overriden by values 23 | ;; with the same key in d1, but otherwise values in d0 24 | ;; survive. Setting a value in d1 to 'DELETE causes it to be deleted 25 | ;; from d0 (it is not an error if it doesn't already exist in 26 | ;; d0). When a value in d1 is itself a dict?, then it is handled 27 | ;; recursively. 28 | (define dict-merge-delete-value (make-parameter 'DELETE)) 29 | (define (dict-merge d0 d1) 30 | (for/fold ([d0 d0]) ([(k v) (in-dict d1)]) 31 | (cond [(dict? v) 32 | (define (default d) 33 | (cond [(hash? d) (cond [(hash-eq? d) (hasheq)] 34 | [else (hash)])] 35 | [(alist? d) '()] 36 | [else (raise-type-error 'dict-merge 37 | "hash?, hasheq? or alist?" 38 | d)])) 39 | (dict-set d0 k (dict-merge (dict-ref d0 k (default (dict-ref d1 k))) 40 | (dict-ref d1 k)))] 41 | [(eq? (dict-merge-delete-value) v) (dict-remove d0 k)] 42 | [else (dict-set d0 k v)]))) 43 | 44 | (module+ test 45 | (check-equal? 46 | (dict-merge (hasheq 'foo "bar" 47 | 'bar "baz" 48 | 'request (hasheq 'delete-me "please")) 49 | (hasheq 50 | 'bar 'DELETE 51 | 'key "value" 52 | 'request (hasheq 'version 1.1 53 | 'delete-me 'DELETE 54 | 'headers (hasheq 'Content-Type "foo" 55 | 'Content-Length 10)) 56 | 'response (hasheq 'headers (hasheq 'Content-Type "foo" 57 | 'Content-Length 10)))) 58 | (hasheq 59 | 'key "value" 60 | 'request (hasheq 'version 1.1 61 | 'headers (hasheq 'Content-Length 10 62 | 'Content-Type "foo")) 63 | 'response (hasheq 'headers (hasheq 'Content-Length 10 64 | 'Content-Type "foo")) 65 | 'foo "bar"))) 66 | 67 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 68 | 69 | ;; Return a {} style string describing the nested dicts 70 | (define (dict->curly-string d) 71 | (define (~v v) (format "~v" v)) 72 | (let loop ([d d] 73 | [depth 0] 74 | [indent 0]) 75 | (string-append 76 | "{" 77 | (for/fold ([s ""]) 78 | ([(k v) (in-dict d)] 79 | [i (in-naturals)]) 80 | (string-append 81 | s 82 | (cond [(zero? i) ""] 83 | [else (make-string (+ indent depth 1) #\space)]) 84 | (~v k) 85 | " " 86 | (cond [(dict? v) (loop v 87 | (add1 depth) 88 | (+ 1 indent (string-length (~v k))))] 89 | [else (~v v)]) 90 | (cond [(= i (- (length (dict-keys d)) 1)) "}"] 91 | [else "\n"])))))) 92 | 93 | (module+ test 94 | (check-equal? 95 | (dict->curly-string 96 | '([a . 0] 97 | [b . 0] 98 | [c . ([a . 0] 99 | [b . 0] 100 | [c . ([a . 0] 101 | [b . 0] 102 | [c . 0])])])) 103 | #<immutable-string (string #\a)) 112 | (string->immutable-string (string #\a))) 113 | 114 | ;; Although #"bytes" literals are immutable, `bytes` isn't 115 | (= #"a" #"a") 116 | (≠ #"a" #"b") 117 | (≠ (bytes 0) (bytes 0)) 118 | (= (bytes->immutable-bytes (bytes 0)) 119 | (bytes->immutable-bytes (bytes 0))) 120 | 121 | ;; Although #(0) literals are immutable (as is obviously 122 | ;; `vector-immutable`), `vector` isn't. 123 | (= #(0) #(0)) 124 | (≠ #(0) #(1)) 125 | (≠ (vector 0) (vector 0)) 126 | (= (vector-immutable 0) (vector-immutable 0)) 127 | 128 | ;; immutable hash variants... 129 | (= (hash 0 0) (hash 0 0)) 130 | (≠ (hash 0 0) (hash 0 1)) 131 | (= (hasheq '0 0) (hasheq '0 0)) 132 | (≠ (hasheq '0 0) (hasheq '0 1)) 133 | (= (make-immutable-hash '([0 0])) (make-immutable-hash '([0 0]))) 134 | (≠ (make-immutable-hash '([0 0])) (make-immutable-hash '([0 1]))) 135 | (= (make-immutable-hasheq '([k 0])) (make-immutable-hasheq '([k 0]))) 136 | (≠ (make-immutable-hasheq '([k 0])) (make-immutable-hasheq '([k 1]))) 137 | ;; mutable hash variants... 138 | (≠ (make-hash '([0 0])) (make-hash '([0 0]))) 139 | (≠ (make-hasheq '([k 0])) (make-hash '([k 0]))) 140 | 141 | ;; stream? is true of many things we test here, but just use `list` 142 | (= (list 0 0) (list 0 0)) 143 | (≠ (list 0 0) (list 1 1)) 144 | 145 | (= (set 0) (set 0)) 146 | (≠ (set 0) (set 1))) 147 | 148 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 149 | ;; 150 | ;; `struct` immutability 151 | 152 | ;; As documented, `immutable?` does not work with `struct`s. Define a 153 | ;; predicate that does: 154 | (define (immutable-struct? v) 155 | (define-values (st skipped?) (struct-info v)) 156 | (and (not skipped?) ;unless most-specific type, can't assert immutability 157 | (immutable-struct-type? st))) 158 | 159 | (define (immutable-struct-type? st) 160 | (define-values (name init-field-cnt auto-field-cnt 161 | accessor-proc mutator-proc 162 | immutable-k-list 163 | super-type skipped?) (struct-type-info st)) 164 | (and (not skipped?) ;unless most-specific type, can't assert immutability 165 | ;; A struct-type is immutable if all its fields are immutable 166 | (= (+ init-field-cnt auto-field-cnt) 167 | (length immutable-k-list)) 168 | ;; AND all its super struct-types are immutable 169 | (or (not super-type) 170 | (immutable-struct-type? super-type)))) 171 | 172 | (module+ test 173 | (struct mutable (fld) #:mutable #:transparent) 174 | (define m (mutable 0)) 175 | (check-false (immutable-struct? m)) 176 | 177 | (struct immutable (fld) #:transparent) 178 | (define i (immutable 0)) 179 | (check-true (immutable-struct? i)) 180 | 181 | ;; An immutable struct derived from a mutable struct: Nope. 182 | (struct mutable:immutable mutable (fld2) #:transparent) 183 | (define m:i (mutable:immutable 0 1)) 184 | (check-false (immutable-struct? m:i)) 185 | 186 | ;; An immutable struct derived from an immutable struct: Yes. 187 | (struct immutable:immutable immutable (fld2) #:transparent) 188 | (define i:i (immutable:immutable 0 1)) 189 | (check-true (immutable-struct? i:i))) 190 | -------------------------------------------------------------------------------- /rackjure/info.rkt: -------------------------------------------------------------------------------- 1 | #lang setup/infotab 2 | (define name "rackjure") 3 | (define scribblings '(("rackjure.scrbl" ()))) 4 | (define clean '("compiled" "doc" "doc/rackjure")) 5 | -------------------------------------------------------------------------------- /rackjure/lambda-reader.rkt: -------------------------------------------------------------------------------- 1 | ;; Copyright (c) 2013-2022 by Greg Hendershott. 2 | ;; SPDX-License-Identifier: BSD-2-Clause 3 | 4 | #lang racket/base 5 | 6 | (require (for-syntax racket/base 7 | racket/list 8 | rackjure/threading) 9 | racket/match 10 | rackjure/threading 11 | (only-in racket/list filter-map remove-duplicates append*) 12 | (only-in racket/port input-port-append)) 13 | 14 | (provide wrapper1 15 | lambda-readtable 16 | make-lambda-readtable) 17 | 18 | (define-syntax (define-unbindable-ids stx) 19 | (syntax-case stx () 20 | [(_ [name id] ...) 21 | (with-syntax ([(gen-id ...) 22 | (for/list ([id (in-list (syntax->list #'(id ...)))]) 23 | (~> id syntax-e symbol->string string->uninterned-symbol))] 24 | [(n ...) (range -10 11)]) 25 | #'(begin 26 | (require (for-meta n (only-in racket/base [id gen-id] ...)) 27 | ...) 28 | (define name (quote-syntax gen-id)) 29 | ...))])) 30 | 31 | (define-unbindable-ids 32 | [lambda-id lambda] 33 | [define-syntax-id define-syntax] 34 | [app-id #%app] 35 | [make-rename-transformer-id make-rename-transformer] 36 | [syntax-id syntax]) 37 | 38 | (define (parse stx) 39 | (with-syntax ([lambda lambda-id] 40 | [define-syntax define-syntax-id] 41 | [app app-id] 42 | [make-rename-transformer make-rename-transformer-id] 43 | [syntax syntax-id] 44 | [args (parse-args stx)] 45 | [% (datum->syntax stx '% stx)] 46 | [%1 (datum->syntax stx '%1 stx)] 47 | [body stx]) 48 | #`(lambda args 49 | (define-syntax % (app make-rename-transformer #'%1)) 50 | body))) 51 | 52 | (module+ test 53 | (require rackunit) 54 | (define-check (check-thing= a b) 55 | (check-equal? (format "~s" a) (format "~s" b))) 56 | ;; These test `parse`. See test.rkt for tests of readtable use per se. 57 | (define chk (compose1 syntax->datum parse)) 58 | (check-thing= (chk #'(+)) 59 | '(lambda () 60 | (define-syntax % (#%app make-rename-transformer #'%1)) 61 | (+))) 62 | (check-thing= (chk #'(+ 2 %1 %1)) 63 | '(lambda (%1) 64 | (define-syntax % (#%app make-rename-transformer #'%1)) 65 | (+ 2 %1 %1))) 66 | (check-thing= (chk #'(+ 2 %3 %2 %1)) 67 | '(lambda (%1 %2 %3) 68 | (define-syntax % (#%app make-rename-transformer #'%1)) 69 | (+ 2 %3 %2 %1))) 70 | (check-thing= (chk #'(apply list* % %&)) 71 | '(lambda (%1 . %&) 72 | (define-syntax % (#%app make-rename-transformer #'%1)) 73 | (apply list* % %&)))) 74 | 75 | ;; parse-args : Stx -> KW-Formals-Stx 76 | (define (parse-args stx) 77 | ;; Filter the stxs to those that start with %, 78 | ;; find the maximum, find whether there are any 79 | ;; keyword arguments or a rest argument, and 80 | ;; produce kw-formals based on that. 81 | (define-values (max-num rest? kws) 82 | (find-arg-info stx)) 83 | (define datum-kw-formals 84 | (append (for/list ([n (in-range 1 (add1 max-num))]) 85 | (string->symbol (string-append "%" (number->string n)))) 86 | (append* 87 | (for/list ([kw (in-list kws)]) 88 | (list kw (string->symbol (string-append "%#:" (keyword->string kw)))))) 89 | (cond [rest? '%&] 90 | [else '()]))) 91 | (datum->syntax stx datum-kw-formals stx)) 92 | 93 | ;; find-arg-info : Any -> (Values Natural Boolean (Listof Keyword)) 94 | (define (find-arg-info v) 95 | (match (maybe-syntax-e v) 96 | [(? symbol? sym) (find-arg-info/sym sym)] 97 | [(? pair? pair) (find-arg-info/pair pair)] 98 | [_ (return)])) 99 | 100 | ;; find-arg-info/sym : Symbol -> (Values Natural Boolean (Listof Keyword)) 101 | (define (find-arg-info/sym sym) 102 | (match (~> sym symbol->string string->list) 103 | [(list) (return)] 104 | [(list #\%) (return #:max-num 1)] 105 | [(list #\% #\&) (return #:rest? #t)] 106 | [(list* #\% #\# #\: cs) 107 | (return #:kws (~> cs list->string string->keyword list))] 108 | [(list #\% (? char-numeric? cs) ...) 109 | (return #:max-num (~> cs list->string string->number))] 110 | [_ (return)])) 111 | 112 | ;; find-arg-info/pair : 113 | ;; (Cons Symbol Symbol) -> (Values Natural Boolean (Listof Keyword)) 114 | (define (find-arg-info/pair pair) 115 | (define-values (car.max-num car.rest? car.kws) 116 | (find-arg-info (car pair))) 117 | (define-values (cdr.max-num cdr.rest? cdr.kws) 118 | (find-arg-info (cdr pair))) 119 | (return #:max-num (max car.max-num cdr.max-num) 120 | #:rest? (or car.rest? cdr.rest?) 121 | #:kws (remove-duplicates (append car.kws cdr.kws)))) 122 | 123 | (define (return #:max-num [max-num 0] #:rest? [rest? #f] #:kws [kws '()]) 124 | (values max-num rest? kws)) 125 | 126 | (define (maybe-syntax-e stx) 127 | (cond [(syntax? stx) (syntax-e stx)] 128 | [else stx])) 129 | 130 | (define ((make-reader-proc [orig-readtable (current-readtable)]) ch in src line col pos) 131 | (define (normal-read-syntax src in) 132 | (parameterize ([current-readtable orig-readtable]) 133 | (read-syntax src in))) 134 | (define (unget-normal-read-syntax str src in) 135 | (normal-read-syntax src (input-port-append #f (open-input-string str) in))) 136 | (define (peek/read? str in) 137 | (and (equal? str (peek-string (string-length str) 0 in)) 138 | (read-string (string-length str) in))) 139 | (cond [(eq? ch #\l) 140 | (cond [(peek/read? "ambda" in) (~> (normal-read-syntax src in) parse)] 141 | [else (unget-normal-read-syntax "#l" src in)])] 142 | [(eq? ch #\f) 143 | (cond [(peek/read? "n" in) (~> (normal-read-syntax src in) parse)] 144 | [else (unget-normal-read-syntax "#f" src in)])] 145 | [else (~> (normal-read-syntax src in) parse)])) ;single letter e.g. #λ 146 | 147 | ;(define orig-readtable (current-readtable)) 148 | 149 | (define (make-lambda-readtable [orig-readtable (current-readtable)]) 150 | (define reader-proc (make-reader-proc orig-readtable)) 151 | (~> orig-readtable 152 | (make-readtable #\λ 'dispatch-macro reader-proc) 153 | (make-readtable #\f 'dispatch-macro reader-proc) 154 | (make-readtable #\l 'dispatch-macro reader-proc))) 155 | 156 | (define lambda-readtable (make-lambda-readtable)) 157 | ;(define reader-proc (make-reader-proc)) 158 | 159 | ;(current-readtable lambda-readtable) 160 | 161 | ;; A `#:wrapper1` for `syntax/module-reader` 162 | (define (wrapper1 thk) 163 | (define orig-readtable (current-readtable)) 164 | (parameterize ([current-readtable (make-lambda-readtable orig-readtable)]) 165 | (thk))) 166 | -------------------------------------------------------------------------------- /rackjure/lang/language-info.rkt: -------------------------------------------------------------------------------- 1 | ;; Copyright (c) 2013-2022 by Greg Hendershott. 2 | ;; SPDX-License-Identifier: BSD-2-Clause 3 | 4 | #lang racket/base 5 | 6 | (provide get-language-info) 7 | 8 | (define (get-language-info data) 9 | (lambda (key default) 10 | (case key 11 | [(configure-runtime) 12 | '(#[rackjure/lang/runtime-config configure #f])] 13 | [else default]))) 14 | -------------------------------------------------------------------------------- /rackjure/lang/reader.rkt: -------------------------------------------------------------------------------- 1 | #lang s-exp syntax/module-reader 2 | rackjure 3 | #:wrapper1 wrapper1 4 | #:language-info #(rackjure/lang/language-info get-language-info #f) 5 | 6 | (require "../lambda-reader.rkt") 7 | -------------------------------------------------------------------------------- /rackjure/lang/runtime-config.rkt: -------------------------------------------------------------------------------- 1 | #lang racket/base 2 | 3 | (provide configure) 4 | 5 | (require (only-in rackjure/lambda-reader make-lambda-readtable)) 6 | 7 | (define (configure data) 8 | (current-readtable (make-lambda-readtable (current-readtable)))) 9 | -------------------------------------------------------------------------------- /rackjure/main.rkt: -------------------------------------------------------------------------------- 1 | ;; Copyright (c) 2013-2022 by Greg Hendershott. 2 | ;; SPDX-License-Identifier: BSD-2-Clause 3 | 4 | #lang racket 5 | 6 | (require "alist.rkt" 7 | "app.rkt" 8 | "conditionals.rkt" 9 | "dict.rkt" 10 | "str.rkt" 11 | "threading.rkt" 12 | "utils.rkt") 13 | 14 | (provide (except-out (all-from-out racket) #%app) 15 | (rename-out [-#%app #%app]) 16 | (except-out (all-from-out "app.rkt") -#%app) 17 | (all-from-out "alist.rkt" 18 | "conditionals.rkt" 19 | "dict.rkt" 20 | "str.rkt" 21 | "threading.rkt" 22 | "utils.rkt")) 23 | -------------------------------------------------------------------------------- /rackjure/rackjure.rkt: -------------------------------------------------------------------------------- 1 | ;; Copyright (c) 2013-2022 by Greg Hendershott. 2 | ;; SPDX-License-Identifier: BSD-2-Clause 3 | 4 | #lang racket/base 5 | 6 | (require "main.rkt") 7 | (provide (all-from-out "main.rkt")) 8 | -------------------------------------------------------------------------------- /rackjure/rackjure.scrbl: -------------------------------------------------------------------------------- 1 | ;; Copyright (c) 2013-2022 by Greg Hendershott. 2 | ;; SPDX-License-Identifier: BSD-2-Clause 3 | 4 | #lang scribble/manual 5 | 6 | @(require racket/sandbox 7 | scribble/eval 8 | (for-label rackjure/alist 9 | rackjure/conditionals 10 | rackjure/dict 11 | rackjure/egal 12 | rackjure/str 13 | rackjure/threading 14 | rackjure/utils 15 | racket)) 16 | 17 | @(define EVAL 18 | (parameterize ([sandbox-output 'string] 19 | [sandbox-error-output 'string]) 20 | (make-evaluator 'rackjure))) 21 | 22 | @title{rackjure} 23 | 24 | @hyperlink["https://github.com/greghendershott/rackjure" "Source"]. 25 | 26 | @margin-note{This is tested on Racket versions 6.0 and newer.} 27 | 28 | @[table-of-contents] 29 | 30 | @section{Introduction} 31 | 32 | This package provides a few Clojure-inspired ideas in Racket. 33 | 34 | Asumu Takikawa's 35 | @hyperlink["https://github.com/takikawa/racket-clojure" "#lang 36 | clojure"] showed me what's possible and was the original basis. Why 37 | not just use that? Because I wanted to use some Clojure ideas in 38 | Racket, not use Clojure. 39 | 40 | When it must choose, @tt{#lang rackjure} chooses to be more Rackety. 41 | For example the threading macros are @racket[~>] and @racket[~>>] 42 | (using @tt{~} instead of @tt{-}) because Racket already uses 43 | @racket[->] for contracts. Plus as Danny Yoo pointed out to me, @tt{~} 44 | is more "thready". 45 | 46 | 47 | @;-------------------------------------------------------------------- 48 | @section{Using as a language vs. as a library} 49 | 50 | @defmodule[rackjure] 51 | 52 | Most features work if you merely @tt{(require rackjure)} --- or a 53 | specific module such as @tt{(require rackjure/threading)} --- in any 54 | module language such as @tt{racket} or @tt{racket/base}. 55 | 56 | However a few features only work as a module language --- by using 57 | @tt{#lang rackjure} at the start of your source file, or by supplying 58 | @tt{rackjure} as the language in a @racket[module] form. This is 59 | because they depend on redefining @racket[#%app] or extending the 60 | Racket reader. These are: 61 | 62 | @itemize[ 63 | @item{@secref["dict-app"].} 64 | @item{@secref["dict-init"].} 65 | @item{@secref["func-lit"].} 66 | ] 67 | 68 | Of course, because they must make @racket[#%app] do more work at 69 | runtime, there is some performance overhead. 70 | 71 | @margin-note{However the overhead is only for function applications 72 | @emph{within} a module using @tt{rackjure} as its language --- 73 | not for function applications in other modules.} 74 | 75 | If you do not need those features, you can @racket[(require rackjure)] 76 | or even just the specific modules you use, in a "leaner" @tt{lang} 77 | such as @tt{racket/base}. 78 | 79 | For example you can use just the threading macros @racket[~>] and 80 | @racket[~>>] in @tt{racket/base}: 81 | 82 | @codeblock{ 83 | #lang racket/base 84 | (require rackjure/threading) 85 | } 86 | 87 | @;-------------------------------------------------------------------- 88 | 89 | @section{Threading macros} 90 | 91 | @defmodule[rackjure/threading] 92 | 93 | As of version 0.9, instead of providing its own implementation, this 94 | module now re-provides all of the @racketmodname[threading #:indirect] 95 | package, which has additional features not described here. Please 96 | refer to its documentation. 97 | 98 | @defform[(~> expression form ...)]{ 99 | 100 | Threads @racket[expression] through the forms. Inserts 101 | @racket[expression] as the second item in the first @racket[form], 102 | making a list of it if it is not a list already. If there are more 103 | forms, inserts the first form as the second item in second form, etc. 104 | 105 | } 106 | 107 | @defform[(~>> expression form ...)]{ 108 | 109 | Like @racket[~>] but inserting as the @italic{last} item in each form. 110 | 111 | } 112 | 113 | @linebreak[] 114 | 115 | The "threading" macros let you thread values through a series of 116 | applications in data-flow order. Sometimes this is a clearer than 117 | deeply nested function calls. 118 | 119 | Although similar to the thrush combinator function (and you may hear 120 | them described that way), these are actually macros (in both Clojure 121 | and @tt{#lang rackjure}). 122 | 123 | And although similar to @racket[compose], the order is reversed, and 124 | again, these are macros. 125 | 126 | The @racket[~>] form "threads" values through a series of forms as the 127 | @italic{second} item of each form. (If a form is a function 128 | application, remember that the second item is the first argument.) 129 | 130 | For example, instead of: 131 | 132 | @racketblock[ 133 | (string->bytes/utf-8 (number->string (bytes-length #"foobar") 16)) 134 | ] 135 | 136 | You can write: 137 | 138 | @racketblock[ 139 | (~> #"foobar" 140 | bytes-length 141 | (number->string 16) 142 | string->bytes/utf-8) 143 | ] 144 | 145 | Or if you prefer on one line: 146 | 147 | @racketblock[ 148 | (~> #"foobar" bytes-length (number->string 16) string->bytes/utf-8) 149 | ] 150 | 151 | Notice that @racket[bytes-length] and @racket[string->bytes/utf-8] 152 | aren't enclosed in parentheses. A function that takes just one 153 | argument can be specified this way: The @racket[~>] macro 154 | automatically adds the parentheses. 155 | 156 | @defform[(some~> expression form ...)]{ 157 | 158 | Analogous to @tt{some->} in Clojure, i.e. stop threading at a 159 | @racket[#f] value. 160 | 161 | } 162 | 163 | @defform[(some~>> expression form ...)]{ 164 | 165 | Analogous to @tt{some->>} in Clojure, i.e. stop threading at a 166 | @racket[#f] value. 167 | 168 | } 169 | 170 | @;-------------------------------------------------------------------- 171 | 172 | @section[#:tag "dict-app"]{Applicable dictionaries} 173 | 174 | @tt{#lang rackjure} redefines @racket[#%app] to make applications work 175 | differently when a @racket[dict?] is in the @italic{first} 176 | position: 177 | 178 | @#reader scribble/comment-reader 179 | (racketblock 180 | ;; When (dict? d) is #t 181 | 182 | ;; Set 183 | (d key val) => (dict-set d key val) 184 | 185 | ;; Get 186 | (d key) => (dict-ref d key #f) 187 | (d key #:else default) => (dict-ref d key default) 188 | ) 189 | 190 | And also when a @racket[dict?] is in the @italic{second} position: 191 | 192 | @#reader scribble/comment-reader 193 | (racketblock 194 | ;; Get 195 | (key d) => (dict-ref d key) 196 | (key #f) => #f ; unless (or (procedure? `key`) (dict? `key`)) 197 | ) 198 | 199 | These last two variants, in combination with the @racket[~>] threading 200 | macro, provide concise notation for accessing nested 201 | @racket[dictionary] (for example the nested @racket[hasheq]s from Racket's 202 | @racket[json] module): 203 | 204 | @codeblock{ 205 | (~> dict 'a 'b 'c) 206 | } 207 | 208 | expands to: 209 | 210 | @codeblock{ 211 | ('c ('b ('a dict))) 212 | } 213 | 214 | which in turn is applied as: 215 | 216 | @racketblock[ 217 | (dict-ref (dict-ref (dict-ref dict 'a) 'b) 'c) 218 | ] 219 | 220 | Note that dictionary keys are not required to be Clojure style 221 | @tt{:keyword}s. They may be anything. 222 | 223 | @margin-note{This application syntax doesn't work for a @racket[dict?] 224 | that stores @racket[procedure?] as keys or values. The reason is that 225 | @tt{#lang rackjure} must provide its own @racket[#%app]. The only 226 | way (AFAIK) it can distinguish a normal function application from a 227 | dictionary application is to check for @racket[procedure?] in the 228 | first position. As a result, in those cases you'll have to use 229 | @racket[dict-ref] and @racket[dict-set].} 230 | 231 | Keep in mind that a @racket[dict?] is a Racket generic that covers 232 | a variety of things besides hash tables and association lists, such as 233 | @racket[vector]s and @racket[list]s. As a result if @racket[v] is a 234 | @racket[vector] then @racket[(vector-ref v 2)] can be written simply 235 | as @racket[(v 2)]. 236 | 237 | @subsection{Not-found values} 238 | 239 | One issue is how to handle the optional last argument to @racket[dict-ref], 240 | which is the value to use if the key is not found. We handle this 241 | slightly differently than @racket[dict-ref]: 242 | 243 | 1. We use an optional keyword argument, @racket[#:else]. This leaves 244 | arity 3 available to mean @racket[dict-set]. 245 | 246 | 2. If @racket[#:else] isn't supplied and the key isn't found we return 247 | @racket[#f] (whereas @racket[dict-ref] raises an error). Rationale: 248 | Returning @racket[#f] is more convenient when used with threading 249 | macros like @racket[some~>]. Admittedly, one person's "convenience" is 250 | another person's "magic behavior" and/or "latent bug". 251 | 252 | @;---------------------------------------------------------------------------- 253 | @section[#:tag "dict-init"]{Dictionary initialization using @racket[{}]} 254 | 255 | @tt{#lang rackjure} provides a more-concise way to create dictionaries. 256 | 257 | You can write 258 | 259 | @racketblock[ 260 | ((k0 . v0)(k1 . v1) ...) 261 | ] 262 | 263 | as 264 | 265 | @racketblock[ 266 | {k0 v0 k1 v1 ... ...} 267 | ] 268 | 269 | Especially handy with nested dicts: 270 | 271 | @racketblock[ 272 | {'key "value" 273 | 'key1 {'key "value" 274 | 'key1 "value1"}} 275 | ] 276 | 277 | The @racket[current-curly-dict] parameter says what this expands to. 278 | 279 | @defparam[current-curly-dict v procedure?]{ 280 | 281 | Defaults to @racket[alist]. May be set to @racket[hash], 282 | @racket[hasheq] or anything with the same @racket[(f k v ... ...)] 283 | signature. 284 | 285 | Examples: 286 | 287 | @codeblock{ 288 | > (parameterize ([current-curly-dict alist]) 289 | {'k0 0 'k1 1}) 290 | '((k0 . 0) (k1 . 1)) 291 | > (parameterize ([current-curly-dict hasheq]) 292 | {'k0 0 'k1 1}) 293 | '#hasheq((k0 . 0) (k1 . 1)) 294 | } 295 | 296 | } 297 | 298 | @defmodule[rackjure/alist] 299 | 300 | @defproc[(alist [key any/c] [val any/c] ... ...) (listof (cons any/c any/c))]{ 301 | 302 | Creates an association list. 303 | 304 | @examples[#:eval EVAL 305 | (alist 'k0 0 'k1 1 'k2 2) 306 | ] 307 | 308 | } 309 | 310 | @;---------------------------------------------------------------------------- 311 | @section{Dictionary utilities} 312 | 313 | @defmodule[rackjure/dict] 314 | 315 | A few utility functions for @racket[dict]s. 316 | 317 | @defproc[(dict-merge [d0 dict?] [d1 dict?]) dict?]{ 318 | 319 | Functionally merge @racket[d1] into @racket[d0]. Values in @racket[d0] 320 | are overriden by values with the same key in @racket[d1]. Nested 321 | @racket[dict]s are handled recursively. 322 | 323 | @codeblock{ 324 | > (dict-merge {} {'type 'line}) 325 | '((type . line)) 326 | > (dict-merge {'type 'triangle 'sides 3} 327 | {'type 'square 'sides 4}) 328 | '((type . square) (sides . 4)) 329 | > (dict-merge {'people {'john {'age 10} 330 | 'mary {'age 7}}} 331 | {'people {'john {'age 11}}}) 332 | '((people (john (age . 11)) (mary (age . 7)))) 333 | } 334 | 335 | Setting a value in @racket[d1] to the current value of the 336 | @racket[dict-merge-delete-value] parameter -- which defaults to 337 | @racket['DELETE] -- causes the key/value in @racket[d0] with that key 338 | to be deleted from the returned dictionary. 339 | 340 | @codeblock{ 341 | > (dict-merge '([a . a][b . b]) 342 | '([b . DELETE])) 343 | '([a . a]) 344 | } 345 | 346 | @defparam[dict-merge-delete-value v any/c]{ 347 | 348 | Defaults to @racket['DELETE]. Used to tell @racket[dict-merge] that a 349 | key/value pair with that key should be deleted. 350 | 351 | @codeblock{ 352 | > (parameterize ([dict-merge-delete-value 'DELETE]) 353 | (dict-merge '([a . a] 354 | [b . b]) 355 | '([b . DELETE]))) 356 | '([a . a]) 357 | > (parameterize ([dict-merge-delete-value 'FOO]) 358 | (dict-merge '([a . a] 359 | [b . b]) 360 | '([a . DELETE] 361 | [b . FOO]))) 362 | '((a . DELETE)) 363 | } 364 | 365 | } 366 | } 367 | 368 | @defproc[(dict->curly-string [d dict?]) string?]{ 369 | 370 | Returns a @tt{{}} @racket[style] string describing the @racket[dict] 371 | @racket[d], including any nested @racket[dict]s. 372 | 373 | @codeblock{ 374 | > (define sample-dict '([a . 0] 375 | [b . 0] 376 | [c . ([a . 0] 377 | [b . 0] 378 | [c . ([a . 0] 379 | [b . 0] 380 | [c . 0])])])) 381 | > (displayln (dict->curly-string sample-dict)) 382 | {'a 0 383 | 'b 0 384 | 'c {'a 0 385 | 'b 0 386 | 'c {'a 0 387 | 'b 0 388 | 'c 0}}} 389 | } 390 | 391 | } 392 | 393 | @;---------------------------------------------------------------------------- 394 | @section{Strings} 395 | 396 | @defmodule[rackjure/str] 397 | 398 | @defproc[(str 399 | [expression any/c] ... 400 | [#:fmt fmt ~a] 401 | [#:sep sep ""] 402 | ) (and/c string? immutable?)]{ 403 | 404 | @margin-note{Idiomatic Racket would probably use @racket[~a].} 405 | 406 | @racket[str] can be a succinct alternative to @racket[string-append] 407 | and/or @racket[format]. 408 | 409 | Also, it returns an immutable string (created via 410 | @racket[string->immutable-string]). 411 | 412 | 413 | @examples[#:eval EVAL 414 | (str) 415 | (str "hi") 416 | (str 1) 417 | (str #f) 418 | (str "Yo" "Yo") 419 | (str "Yo" "Yo" "Ma") 420 | (apply str '(0 1 2 3)) 421 | (str 0 1 2 3) 422 | (str '(0 1 2 3)) 423 | ] 424 | 425 | Our version adds optional keyword arguments, the defaults of which 426 | behave like Clojure's @tt{str}: 427 | 428 | @itemize[ 429 | 430 | @item{@racket[#:fmt]: The function to apply to each argument. Defaults 431 | to @racket[~a]. May be any @racket[(any/c . -> . string?)] function, 432 | e.g. @racket[~v].} 433 | 434 | @item{@racket[#:sep]: A @racket[string?] to add between each. Defaults 435 | to @racket[""].} 436 | 437 | ] 438 | 439 | @examples[#:eval EVAL 440 | (str #:fmt ~v "Yo" "Yo") 441 | (str #:sep " " "Yo" "Yo") 442 | (str #:fmt ~v #:sep " " "Yo" "Yo") 443 | ] 444 | 445 | } 446 | 447 | @;---------------------------------------------------------------------------- 448 | @section{Conditionals} 449 | 450 | @defmodule[rackjure/conditionals] 451 | 452 | @defform[(if-let [identifier test-expr] then-expr else-expr)]{ 453 | 454 | @margin-note{Idiomatic Racket would probably use @racket[match].} 455 | 456 | Combines @racket[if] and @racket[let]: 457 | 458 | @racketblock[ 459 | (let ([identifier test-expr]) 460 | (if identifier 461 | then-expr 462 | else-expr)) 463 | ] 464 | 465 | } 466 | 467 | @defform[(when-let [identifier test-expr] body ...+)]{ 468 | 469 | @margin-note{Idiomatic Racket would probably use @racket[match].} 470 | 471 | Combines @racket[when] with @racket[let]: 472 | 473 | @racketblock[ 474 | (let ([identifier test-expr]) 475 | (when identifier 476 | body ...)) 477 | ] 478 | 479 | } 480 | 481 | @defform[(if-not test-expr then-expr else-expr)]{ 482 | 483 | A shortcut for: 484 | 485 | @racketblock[ 486 | (if (not test-expr) 487 | then-expr 488 | else-expr) 489 | ] 490 | 491 | } 492 | 493 | @defform[(when-not test-expr body ...+)]{ 494 | 495 | @margin-note{Idiomatic Racket would use @racket[unless].} 496 | 497 | A shortcut for: 498 | 499 | @racketblock[ 500 | (when (not test-expr) 501 | body ...) 502 | ] 503 | 504 | } 505 | 506 | @;---------------------------------------------------------------------------- 507 | @section{Operational equivalence} 508 | 509 | @defmodule[rackjure/egal] 510 | 511 | @defproc[(egal? [v1 any/c] [v2 any/c]) boolean?]{ 512 | 513 | An implementation of @tt{egal?} as described in @hyperlink["http://home.pipeline.com/~hbaker1/ObjectIdentity.html" "Equal Rights for Functional Objects"]. 514 | 515 | An alternative to @racket[equal?] and @racket[eq?] that says whether 516 | two things are "operationally equivalent", by taking into account 517 | mutability. 518 | 519 | In general, two things that are @racket[equal?] will also be 520 | @racket[egal?] only if they are both immutable. Some things in Racket 521 | aren't immutable by default. For example, although 522 | @racket["string-constants"] are immutable, strings returned by 523 | @racket[string] or @racket[string-join] are mutable, unless you also 524 | run them through @racket[string->immutable-string]. Same with 525 | @racket[bytes]. Other things come in both mutable and immutable 526 | variants, such as hashes and vectors. 527 | 528 | For more details, see 529 | @hyperlink["https://github.com/greghendershott/rackjure/blob/master/rackjure/egal.rkt" "egal.rkt"] 530 | for the implementation and test cases. A few examples: 531 | 532 | @#reader scribble/comment-reader 533 | (examples #:eval EVAL 534 | (require rackjure/egal) 535 | ;; Although "string" literals are immutable... 536 | (egal? "a" "a") 537 | ;; @racket[string] is mutable... 538 | (egal? (string #\a) (string #\a)) 539 | ;; Immutable strings are (you guessed it) immutable... 540 | (egal? (string->immutable-string (string #\a)) 541 | (string->immutable-string (string #\a))) 542 | ) 543 | 544 | @subsection{@racket[egal?] and @racket[struct]s} 545 | 546 | For two @racket[struct]s to be @racket[egal?], all of the following 547 | must be true: 548 | 549 | 1. They must have the same field values. 550 | 551 | 2. They must be instances of the same structure type. 552 | 553 | 3. The structure type must be @racket[#:transparent]. (Regular 554 | @racket[equal?] does a field comparison for Racket @racket[struct]s 555 | only if they are @racket[#:transparent]. Otherwise the 556 | @racket[struct]s are opaque and @racket[eq?] is used.) 557 | 558 | 4. The structure type must @italic{not} be @racket[#:mutable], nor 559 | must any of the individual fields be @racket[#:mutable]. 560 | 561 | } 562 | 563 | @;---------------------------------------------------------------------------- 564 | @section{Other} 565 | 566 | @defmodule[rackjure/utils] 567 | 568 | @subsection{Partial application} 569 | 570 | @defproc[(partial [proc procedure?] [v any/c] ...) procedure?]{ 571 | 572 | Function for partial application. Differs from @racket[curry] in that 573 | it doesn't care about function arity. 574 | 575 | @codeblock{ 576 | ((partial + 1) 2) <=> (+ 1 2) 577 | } 578 | 579 | } 580 | 581 | @subsection{Atomic swap} 582 | 583 | @defproc[(box-swap! [box box?] [proc procedure?] [v any/c] ...) any/c]{ 584 | 585 | Like @tt{swap!} in Clojure, but for @racket[box?]. 586 | 587 | Essentially it is: 588 | 589 | @racketblock[ 590 | (define (box-swap! box f . args) 591 | (let loop () 592 | (let* ([old (unbox box)] 593 | [new (apply f old args)]) 594 | (if (box-cas! box old new) 595 | new 596 | (loop))))) 597 | ] 598 | 599 | } 600 | 601 | @;---------------------------------------------------------------------------- 602 | @section[#:tag "func-lit"]{Reader function literals} 603 | 604 | The Clojure reader lets you succinctly define anonymous function 605 | literals. For example 606 | 607 | @codeblock{ 608 | #(+ % %2) 609 | } 610 | 611 | is equivalent to this in Clojure: 612 | 613 | @codeblock{ 614 | (fn [% %2] (+ % %2)) 615 | } 616 | 617 | or in Racket: 618 | 619 | @racketblock[ 620 | (λ (% %2) (+ % %2)) 621 | (lambda (% %2) (+ % %2)) 622 | ] 623 | 624 | @itemize[ 625 | @item{@tt{%1} through @tt{%@italic{n}} are positional arguments} 626 | @item{@tt{%} is a synonym for @tt{%1}} 627 | @item{@tt{%&} is a rest argument} 628 | @item{@tt{%#:keyword} is a @racket[#:keyword] argument} 629 | ] 630 | 631 | The Racket reader already uses @litchar{#( )} for vector literals. 632 | Therefore Rackjure instead uses your choice of @litchar{#fn( )}, 633 | @litchar{#λ( )}, or @litchar{#lambda( )}. 634 | 635 | Examples: 636 | 637 | @verbatim{ 638 | > (map #λ(+ % 1) '(1 2 3)) 639 | '(2 3 4) 640 | > (map #λ(+ % %2) '(1 2 3) '(1 2 3)) 641 | '(2 4 6) 642 | 643 | ;; Rest argument 644 | > (#λ(apply list* % %&) 1 '(2 3)) 645 | '(1 2 3) 646 | 647 | ;; Keyword argument 648 | > (#λ(* 1/2 %#:m (* %#:v %#:v)) #:m 2 #:v 1) 649 | 1 650 | 651 | ;; Ignores unused arguments 652 | > (#λ(begin %2) "ignored" "used") 653 | "used" 654 | 655 | ;; Handles an arbitary number of arguments 656 | > (apply #λ(list %1 %42) (build-list 42 add1)) 657 | (list 1 42) 658 | } 659 | -------------------------------------------------------------------------------- /rackjure/str.rkt: -------------------------------------------------------------------------------- 1 | ;; Copyright (c) 2013-2022 by Greg Hendershott. 2 | ;; SPDX-License-Identifier: BSD-2-Clause 3 | 4 | #lang racket/base 5 | 6 | (require racket/contract 7 | racket/function 8 | racket/string) 9 | 10 | (provide 11 | (contract-out 12 | [str (() 13 | (#:fmt (any/c . -> . string?) #:sep string?) 14 | #:rest list? 15 | . ->* . 16 | (and/c immutable? string?))])) 17 | 18 | ;; #:fmt: The function to apply. Defaults to ~a. Could be ~v, or 19 | ;; anything that returns a string? 20 | ;; 21 | ;; #:sep: A string to add between each. Defaults to "". 22 | (define (str #:fmt [fmt (curry format "~a")] #:sep [sep ""] . xs) 23 | (string->immutable-string (string-join (map fmt xs) sep))) 24 | 25 | (module* test racket/base 26 | (require (submod "..") 27 | rackunit 28 | (only-in racket/function curry thunk)) 29 | (check-equal? (str) "") 30 | (check-equal? (str "hi") "hi") 31 | (check-equal? (str 1) "1") 32 | (check-equal? (str #f) "#f") 33 | (check-equal? (str "Yo" "Yo") "YoYo") 34 | (check-equal? (str "Yo" "Yo" "Ma") "YoYoMa") 35 | (check-equal? (str #:fmt (curry format "~v") "Yo" "Yo") "\"Yo\"\"Yo\"") 36 | (check-equal? (str #:sep " " "Yo" "Yo") "Yo Yo") 37 | (check-equal? (str #:fmt (curry format "~v") #:sep " " "Yo" "Yo") "\"Yo\" \"Yo\"") 38 | (check-equal? (str '(0 1 2 3 4 5 6 7 8 9)) "(0 1 2 3 4 5 6 7 8 9)") 39 | (check-equal? (apply str '(0 1 2 3 4 5 6 7 8 9)) "0123456789") 40 | (check-exn exn:fail:contract? 41 | (thunk (str #:fmt values 1))) ;; not (any/c -> string?) 42 | (check-exn exn:fail:contract? 43 | (thunk (str #:sep #f 1)))) ;; not string? 44 | -------------------------------------------------------------------------------- /rackjure/test.rkt: -------------------------------------------------------------------------------- 1 | ;; Copyright (c) 2013-2022 by Greg Hendershott. 2 | ;; SPDX-License-Identifier: BSD-2-Clause 3 | 4 | #lang rackjure 5 | 6 | ;;; Tests of #%app (not convenient to put in app.rkt). 7 | 8 | (module+ test 9 | (require rackunit 10 | syntax/strip-context) 11 | 12 | ;; Application with the `dict` in first or second position 13 | (define d (hasheq 'a #t)) 14 | (check-true (d 'a)) 15 | (check-true ('a d)) 16 | 17 | ;; vector is-a-kind-of dict 18 | (define v (vector 0 1 2 3)) 19 | (check-equal? (v 1) 1) 20 | (check-equal? (1 v) 1) 21 | 22 | ;; Nested using ~> (threading macro) 23 | (check-equal? (~> (hasheq 'a (hasheq 'b (hasheq 'c 42))) 24 | 'a 25 | 'b 26 | 'c) 27 | 42) 28 | 29 | ;; Nested dict-ref 30 | (check-equal? (~> {'a {'b {'c 0}}} 'a 'b 'c) 0) 31 | 32 | ;; Nested dict-has-key? 33 | (check-false (~> {'a {'b {'c 0}}} 'a 'b 'huh?)) 34 | (check-false (~> {'a {'b {'c 0}}} 'huh? 'b 'c)) 35 | 36 | ;; {} default `alist` 37 | (check-equal? 38 | {'key "value" 39 | 'request {'version 1.0 40 | 'headers {'Content-Type "foo" 41 | 'Content-Length 10}} 42 | 'response {'version 1.0 43 | 'headers {'Content-Type "foo" 44 | 'Content-Length 10}}} 45 | (alist 'key "value" 46 | 'request (alist 'version 1.0 47 | 'headers (alist 'Content-Type "foo" 48 | 'Content-Length 10)) 49 | 'response (alist 'version 1.0 50 | 'headers (alist 'Content-Type "foo" 51 | 'Content-Length 10)))) 52 | 53 | ;; {} using `current-curly-dict` parameter to specify `hasheq` 54 | (check-equal? 55 | (parameterize ([current-curly-dict hasheq]) 56 | {'key "value" 57 | 'request {'version 1.0 58 | 'headers {'Content-Type "foo" 59 | 'Content-Length 10}} 60 | 'response {'version 1.0 61 | 'headers {'Content-Type "foo" 62 | 'Content-Length 10}}}) 63 | (hasheq 'key "value" 64 | 'request (hasheq 'version 1.0 65 | 'headers (hasheq 'Content-Type "foo" 66 | 'Content-Length 10)) 67 | 'response (hasheq 'version 1.0 68 | 'headers (hasheq 'Content-Type "foo" 69 | 'Content-Length 10)))) 70 | 71 | ;; {} with odd number of elements raises exn:fail:syntax 72 | #;(check-exn exn:fail? 73 | (λ _ 74 | (parameterize ([current-namespace (make-base-namespace)]) 75 | (eval (namespace-syntax-introduce 76 | (strip-context 77 | #'(module m rackjure {0 1 2})))))) 78 | "expected even number of keys and values for dictionary")) 79 | 80 | ;;; Tests of lambda reader macro not convenient to put in lambda-reader.rkt 81 | 82 | (module+ test 83 | ;; Using #λ( ... ) 84 | (check-equal? (map #λ(+ % 1) '(1 2 3)) 85 | '(2 3 4)) 86 | (check-equal? (map #λ(+ % %2) '(1 2 3) '(1 2 3)) 87 | '(2 4 6)) 88 | (check-equal? (#λ(apply list* % %&) 1 '(2 3)) 89 | '(1 2 3)) 90 | ;; Using #lambda( ... ) 91 | (check-equal? (map #lambda(+ % 1) '(1 2 3)) 92 | '(2 3 4)) 93 | (check-equal? (map #lambda(+ % %2) '(1 2 3) '(1 2 3)) 94 | '(2 4 6)) 95 | (check-equal? (#lambda(apply list* % %&) 1 '(2 3)) 96 | '(1 2 3)) 97 | ;; Using #fn( ... ) 98 | (check-equal? (map #fn(+ % 1) '(1 2 3)) 99 | '(2 3 4)) 100 | (check-equal? (map #fn(+ % %2) '(1 2 3) '(1 2 3)) 101 | '(2 4 6)) 102 | (check-equal? (#fn(apply list* % %&) 1 '(2 3)) 103 | '(1 2 3)) 104 | ;; #fn doesn't interfere with #f 105 | (check-equal? #f #f) 106 | (check-false #f) 107 | ;; The examples from PR #38 108 | (check-equal? (map #λ(+ % 1) '(1 2 3)) 109 | '(2 3 4)) 110 | (check-equal? (map #λ(+ % %2) '(1 2 3) '(1 2 3)) 111 | '(2 4 6)) 112 | (check-equal? (#λ(apply list* % %&) 1 '(2 3)) 113 | '(1 2 3)) 114 | (check-equal? (#λ(* 1/2 %#:m (* %#:v %#:v)) #:m 2 #:v 1) 115 | 1) ;keyword-arguments 116 | (let ([x (#λ"I am x")]) 117 | (check-equal? (#λx) "I am x")) ;the body doesn't have to be in parens 118 | (check-equal? (#λ(+ % %1) 2) 119 | 4) ;% means exactly the same as %1, and you can 120 | ;even use both at the same time ... 121 | (check-equal? (#λ(begin (set! % "%") %1) "%1") 122 | "%") ;...and even set!-ing one set!s the other. 123 | (check-equal? (#λ(begin %2) "ignored" "used") 124 | "used") ;handles skipped arguments 125 | (check-equal? (apply #λ(list %1 %42) (build-list 42 add1)) 126 | (list 1 42)) ;handles an arbitrary number of arguments 127 | (check-equal? (let ([lambda "not lambda"] [define-syntax "not define-syntax"]) 128 | (#λ(+ % 1) 0)) 129 | 1) ; lambda literals should work even if `lambda` is shadowed 130 | ) 131 | -------------------------------------------------------------------------------- /rackjure/threading.rkt: -------------------------------------------------------------------------------- 1 | ;; Copyright (c) 2013-2022 by Greg Hendershott. 2 | ;; SPDX-License-Identifier: BSD-2-Clause 3 | 4 | #lang racket/base 5 | 6 | ;; Originally this had its own implementation. Now we use depend on 7 | ;; the `threading` package and re-provide all of it, plus rename its 8 | ;; and~> to some~> for backward compatibility. 9 | ;; 10 | ;; Preserving this module and doing the re-provide here, for programs 11 | ;; that (require rackjure/threading). 12 | ;; 13 | ;; Preserving some of the original tests to ensure compatability 14 | ;; during the transition and going forward. (The tests that checked 15 | ;; using expand-once needed to be changed because the threading 16 | ;; package implementation's intermediate expansion steps aren't not 17 | ;; necessarily the same -- but the fully-expanded forms should be.) 18 | 19 | (require threading) 20 | 21 | (provide (all-from-out threading) 22 | (rename-out [and~> some~>] 23 | [and~>> some~>>])) 24 | 25 | (module+ test 26 | (require "check-expansion.rkt") 27 | (define-namespace-anchor anchor) 28 | 29 | (check-expand-fully anchor #'(~> 1 (+ 2)) #'(#%app + (quote 1) (quote 2))) 30 | (check-expand-fully anchor #'(~> #t (if 1 2)) #'(if (quote #t) (quote 1) (quote 2))) 31 | ;; ^ Check that it works with syntax forms 32 | 33 | (check-expand-fully anchor #'(~>> 1 (+ 2)) #'(#%app + (quote 2) (quote 1))) 34 | (check-expand-fully anchor #'(~>> 1 + (~>> 1 +)) #'(#%app + '1 (#%app + '1))) 35 | ;; ^ Example from CLJ-1121 36 | 37 | 38 | ;; Confirm expansion using default #%app 39 | (module test-plain-app racket/base 40 | (require (submod ".." "..")) ;; for ~> 41 | (require "check-expansion.rkt") 42 | (define-namespace-anchor anchor) 43 | ;; 1. Directly; expanding ~> macro 44 | (check-expand-fully anchor 45 | #'(~> 1 +) 46 | #'(#%app + (quote 1))) 47 | ;; 2. Indirectly; no implicit require of wrong #%app 48 | (check-expand-fully anchor 49 | #'((hasheq 'a 42) 'a) 50 | #'(#%app (#%app hasheq (quote a) (quote 42)) (quote a)))) 51 | (require 'test-plain-app) 52 | 53 | ;; Confirm expansion using our applicative dict #%app 54 | (module test-dict-app racket/base 55 | (require (submod ".." "..")) ;; for ~> 56 | (require (rename-in "app.rkt" [-#%app #%app])) 57 | (require "check-expansion.rkt") 58 | (define-namespace-anchor anchor) 59 | ;; 1. Directly; expanding ~> macro 60 | (check-expand-fully/both anchor 61 | #'(~> 1 +) 62 | #'(#%app + (quote 1))) 63 | ;; 2. Indirectly; no implicit require of wrong #%app 64 | (check-expand-fully/both anchor 65 | #'((hasheq 'a 42) 'a) 66 | #'(#%app (#%app hasheq (quote a) (quote 42)) (quote a)))) 67 | (require 'test-dict-app)) 68 | -------------------------------------------------------------------------------- /rackjure/utils.rkt: -------------------------------------------------------------------------------- 1 | ;; Copyright (c) 2013-2022 by Greg Hendershott. 2 | ;; SPDX-License-Identifier: BSD-2-Clause 3 | 4 | #lang racket/base 5 | 6 | (provide partial 7 | box-swap!) 8 | 9 | (module+ test 10 | (require rackunit)) 11 | 12 | (define ((partial f . args1) . args2) 13 | (apply f (append args1 args2))) 14 | 15 | (module+ test 16 | ;; If we tested against the variable-arity `+` there would 17 | ;; be no difference between `partial` and `curry`. 18 | (define (+* x y) (+ x y)) 19 | 20 | (check-equal? ((partial +*) 1 2) 3) 21 | (check-equal? ((partial +* 1) 2) 3) 22 | (check-equal? ((partial +* 1 2)) 3)) 23 | 24 | (define (box-swap! box f . args) 25 | (let loop () 26 | (let* ([old (unbox box)] 27 | [new (apply f old args)]) 28 | (if (box-cas! box old new) 29 | new 30 | (loop))))) 31 | 32 | (module+ test 33 | (require racket/future) 34 | ;; Even with (module config info (define timeout 300)) this is 35 | ;; timing out on the pkg build server. No idea why it's taking >5 36 | ;; minutes, there, when it takes <10 secs on my laptop! For now, 37 | ;; disable this test completely, there. 38 | (unless (getenv "PLT_PKG_BUILD_SERVICE") 39 | (define shared (box 0)) 40 | (define n-iterations 10000000) 41 | (define n-futures 10) 42 | 43 | (define (futures) 44 | (define (thunk) 45 | (for ([_ (in-range n-iterations)]) 46 | ;; Use `+ 1` instead of `add1` to exercise `box-swap!` 47 | (box-swap! shared + 1))) 48 | 49 | (for/list ([_ n-futures]) 50 | (future thunk))) 51 | 52 | (for ([f (futures)]) 53 | (touch f)) 54 | (check-equal? (unbox shared) (* n-iterations n-futures)))) 55 | --------------------------------------------------------------------------------