Miscellaneous Utilities

6.3.90.900

top ← prev up next →

Miscellaneous Utilities

Jan Dvořák <mordae@anilinux.org>

1 Syntax Extensions

(require misc1/syntax)

package: misc1

syntax
(producing ((name value) ...) body ...)

Recursively binds values to names for the duration of the body, producing the original values.

Example:

> (producing ((a (+ 1 2 3))
(b (* 1 2 3)))
(printf "a = ~s, b = ~s\n" a b))
a = 6, b = 6
6
6

syntax
(using ((name value) ...) body ...)

Recursively binds values to names for the duration of the body, producing (void).

Example:

> (using ((variable 40)
(coefficient -13))
(printf "result = ~s\n" (add1 (* variable coefficient))))
result = -519

syntax
(when* ((name value) ...) body ...)

Bind values to names and perform a few operations, provided the values are #true. Returns (void).

Example:

> (when* ((x 1)
(y 2))
(printf "x = ~s, y = ~s\n" x y))
x = 1, y = 2

syntax
(recursive (name ...) body ...)

Bind values produced by the body to specified names in a recursive manner. This form can be used to produce self-referential events and similar exotic constructs.

Examples:

> (recursive (a b)
    (values 1 2))
1
2
> ((recursive (fact)
     (λ (n)
       (if (= 0 n) 1
           (* n (fact (sub1 n)))))) 5)
120

syntax
(loop body ...)

Loop body indefinitely.

syntax
(while continue? body ...)

Loop body as long as the condition holds.

syntax
(until halt? body ...)

Loop body as long as the condition does not hold.

syntax
(loop-while-cond (test body ...) ...)

Loop as long as any cond-style clause matches. The else clause is reserved.

Example:

> (loop-while-cond
((< (random) 0.2) (display "jackpot!\n"))
((< (random) 0.7) (display "hit!\n")))
hit!
hit!
hit!
jackpot!
hit!

syntax
(loop-until-cond (test body ...) ...)

Loop until any cond-style clause matches. The else clause is reserved.

Example:

> (loop-until-cond
    ((> (random) 0.5)  (display "pressure too high!"))
    ((> (random) 0.3)  (display "boiler cracking!"))
    ((> (random) 0.1)  (display "office is a pressure coo...!")))
office is a pressure coo...!

syntax
(with-semaphore sema body ...)

Shortcut of (call-with-semaphore sema (λ _ body ...)).

Example:

> (let ((sema (make-semaphore 1)))
(with-semaphore sema
'protected))
'protected

syntax
(spawn-thread body ...)

Shortcut of (thread (λ () body ...)).

Example:

> (thread-wait
(spawn-thread 'do-something))

syntax
(with-output-bytes body ...)

Shortcut of (with-output-to-bytes (λ _ body ...)).

Example:

> (with-output-bytes
(write-byte 64))
#"@"

syntax
(with-input-bytes bstr body ...)

Shortcut of (with-input-from-bytes bstr (λ _ body ...)).

Example:

> (with-input-bytes #"hello"
(read-byte))
104

syntax
(with-output-string body ...)

Shortcut of (with-output-to-string (λ _ body ...)).

Example:

> (with-output-string
(write-byte 64))
"@"

syntax
(with-input-string str body ...)

Shortcut of (with-input-from-string str (λ _ body ...)).

Example:

> (with-input-string "hello"
(read-byte))
104

syntax
(after body ... (cleanup cleanup-body ...))

Execute the body ... and then cleanup-body ..., even when the original body have been interrupted by an exception. Propagates the exception.

syntax
(when-defined name body ...)

Expands the body only when given name is defined.

Examples:

> (when-defined replace-evt 'have-replace-evt)
'have-replace-evt
> (when-defined frobnicate 'have-frobnication)
> (when-defined foldl 'have-folds)
'have-folds

2 Match Expanders

(require misc1/match)

package: misc1

syntax
(hash-lookup (key value) ...)

Simple hash table descructuring expander compatible with Typed Racket.

Example:

> (match #hasheq((temperature . 34)
                 (day-time . "afternoon"))
    ((hash-lookup ('temperature te)
                  ('day-time dt))
     (format "beautiful ~a, ~a°C" dt te)))
"beautiful afternoon, 34°C"

3 Dictionaries

(require misc1/dict)

package: misc1

procedure
(dict-mref dict [#:default default] key ...) → any
  dict : dict?
  default : any/c = undefined
  key : any/c

Return values of multiple dictionary keys at once.

The optional default keyword argument allows to define a substitute for mising keys’ values. If a procedure is specified, it’s return value is used.

Examples:

> (dict-mref (hasheq 'apples 4 'pears 2) 'apples 'pears)
4
2
> (dict-mref (hasheq 'pomelos 1) 'peaches #:default 0)
0

procedure
(dict-merge base other ...) → dict?
base : dict?
other : dict?

Merge multiple dictionaries. Type of the base dictionary dictes type of the result.

Example:

> (dict-merge (hasheq 'apples 1) '((pears . 2)))
'#hasheq((apples . 1) (pears . 2))

procedure
(dict-merge! base other ...) → void?
base : dict?
other : dict?

Merge multiple dictionaries into the base one. The base dictionary is mutated multiple times.

syntax
(let-dict (((name ...) value) ...) body ...)

Similar to let-values, but instead of multiple return values consuming dictionaries with keys identical to target names.

Example:

> (let-dict (((a b c) (hasheq 'a 1 'b 2 'c 3))
((d e f) '((d . 4) (e . 5) (f . 6))))
(+ a b c d e f))
21

4 Lists

(require misc1/list)

package: misc1

procedure
(list->values lst) → any
lst : list?

Convert a list to multiple return values. Basically just a shortcut for (apply values lst).

Example:

> (list->values '(1 2 3))
1
2
3

procedure
(values* value ... list-of-values) → any
value : any/c
list-of-values : list?

Analogous to list* but instead of creating a list, produces multiple return values.

Example:

> (values* 1 '(2 3))
1
2
3

procedure
(split-every lst idx) → (listof list?)
lst : list?
idx : exact-positive-integer?

Repeatedly split specified list at the given offset and produce multiple lists with given number of items.

Examples:

> (split-every '(1 2 3 4 5 6) 2)
'((1 2) (3 4) (5 6))
> (for/list ((part (split-every '(1 2 3 4 5 6) 3)))
(apply + part))
'(6 15)

syntax
(let-list (((name ...) value) ...) body ...)

Similar to let-values, but consuming lists instead of multiple value returns.

Example:

> (let-list (((a b c) '(1 2 3))
((d e f) '(4 5 6)))
(+ a b c d e f))
21

5 Exceptions

(require misc1/throw)

package: misc1

syntax
(throw make-exn compose-arg ...)
(throw (make-exn exn-arg ...) compose-arg ...)

Compose error message using the (compose-error-message compose-arg ...) formula and then pass it along with additional exception arguments to the defined exception constructor as (make-exn message marks exn-arg ...).

Raise the resulting exception.

Examples:

> (struct exn:fail:example exn:fail (number))
> (throw (exn:fail:example 42)
         'example "failed to understand"
                  "subject" "universe and everything")
example: failed to understand
  subject: universe and everything

6 Asynchronous Tasks

(require misc1/async)

package: misc1

This module provides a simple way to run a piece of code in a background thread, getting it’s result back via Racket’s integrated event system.

procedure
(async-task proc) → evt?
proc : (-> any)

Run thunk in a thread and obtain it’s cached result (or exception) using an event.

Examples:

> (define result-evt
(async-task (λ ()
(sleep 1/10) 42)))
> (sync/timeout 1/20 result-evt)
#f
> (sync/timeout 1/20 result-evt)
#f
> (sync/timeout 1/20 result-evt)
42

syntax
(async body ...)

Syntactic alternative to async-task.

Example:

> (sync (async (+ 1 1)))
2

7 Fast Channels

(require misc1/fast-channel)

package: misc1

Fast channels are an alternative to racket/async-channel that makes use of semaphores instead of a background thread, yielding a much greater throughput.

procedure
(make-fast-channel) → fast-channel?

Create new, empty fast channel.

Example:

> (define channel (make-fast-channel))

procedure
(fast-channel? v) → boolean?
v : any/c

Identifies a fast channel instance.

Example:

> (fast-channel? channel)
#t

procedure
(fast-channel-put channel value ...) → void?
channel : fast-channel?
value : any/c

Send another item through the channel.

There is no limit on number of items placed into a channel and the caller is never blocked.

Examples:

> (fast-channel-put channel 'carrot)
> (fast-channel-put channel 'apple)
> (fast-channel-put channel 'rose 'and 'cherry)

procedure
(fast-channel-get channel) → any
channel : fast-channel?

Remove an item from the channel in FIFO mode. The caller is blocked when the channel is empty. Since the channel works as a synchronizable event, it is possible to wait for items to arrive asynchronously.

Examples:

> (fast-channel-get channel)
'carrot
> (sync channel)
'apple

procedure
(fast-channel-try-get channel) → any
channel : fast-channel?

Try to wait for an item from the channel but return just #f if the waiting would block.

Please note that it is possible to send multiple values, but this function fails with just one. Make sure you expect proper return arity.

Examples:

> (fast-channel-try-get channel)
'rose
'and
'cherry
> (fast-channel-try-get channel)
#f

procedure
(fast-channel-peek channel) → any
channel : fast-channel?

Same as fast-channel-get, but does not actually remove the element from the channel.

Examples:

> (fast-channel-put channel 42)
> (fast-channel-peek channel)
42

procedure
(fast-channel-try-peek channel) → any
channel : fast-channel?

Again, same as fast-channel-try-get, but does not actually remove the element from the channel.

Examples:

> (fast-channel-try-peek channel)
42
> (fast-channel-get channel)
42
> (fast-channel-try-peek channel)
#f

procedure
(fast-channel-peek-evt channel) → evt?
channel : fast-channel?

Create an event that is ready for synchronization when there is at least one value waiting in the channel, but does not consume the value upon successfull synchronization.

Examples:

> (let ((peek-evt (fast-channel-peek-evt channel)))
(fast-channel-put channel 'hello)
(sync peek-evt))
'hello
> (fast-channel-get channel)
'hello

8 Events

Extended events, some building on the new replace-evt procedure when available.

(require misc1/evt)

package: misc1

procedure
(timer-evt msecs handler) → evt?
msecs : real?
handler : (-> any)

Recurring event that executes the handler immediately and then repeatedly after msecs milliseconds. It never produces any synchronization result.

Example:

> (sync (alarm-in-evt 1000)
(timer-evt 400 (λ _ (printf "hello\n"))))
hello
hello
hello
#<alarm-evt>

procedure
(recurring-evt base-evt [handler]) → evt?
base-evt : evt?
handler : procedure? = void

Recurring event that never produces any synchronization result.

Example:

> (let ((channel (make-async-channel)))
    (for ((i 3))
      (async-channel-put channel i))
    (sync (alarm-in-evt 1000)
          (recurring-evt channel
                         (λ (item)
                           (printf "item ~s\n" item)))))
item 0
item 1
item 2
#<alarm-evt>

procedure
(alarm-in-evt msecs) → evt?
msecs : real?

Create an alarm event that is up in given number of milliseconds, counting from now. Just an useful shortcut.

procedure
(constant-evt arg ...) → evt?
arg : any/c

Simple event that immediately produces specified arguments.

Example:

> (sync (constant-evt 1 2 3))
1
2
3

procedure
(cache-evt evt) → evt?
evt : evt?

Simple event that caches first result of it’s parent event, to return it if waited for more than once.

Examples:

> (define parent-evt (wrap-evt always-evt
(λ _ (printf "parent producing 42\n") 42)))
> (define child-evt (cache-evt parent-evt))
> (sync child-evt)
parent producing 42
42
> (sync child-evt)
42

procedure
(trigger-evt? v) → boolean?
v : any/c

Predicate to identify trigger events.

procedure
(make-trigger-evt) → evt?

Create an event that can be triggered later on.

Examples:

> (define t-e (make-trigger-evt))
> (sync/timeout 0 t-e)
#f

procedure
(trigger! evt v ...) → void?
evt : trigger-evt?
v : any/c

Cause specified trigger event to stop blocking and start producing given results instead.

Examples:

> (trigger! t-e 13 42)
> (sync/timeout 0 t-e)
13
42

procedure
(cancel! evt) → void?
evt : trigger-evt?

Cancel specified trigger event, causing it to block again.

Examples:

> (cancel! t-e)
> (sync/timeout 0 t-e)
#f

procedure
(epoch-evt? v) → boolean?
v : any/c

Predicate to identify epoch events.

procedure
(make-epoch-evt) → evt?

Create an event that can be triggered to unblock all waiters and start a new epoch, blocking newcomers.

Example:

> (define ee (make-epoch-evt))

procedure
(epoch-evt-advance! evt v ...) → void?
evt : epoch-evt?
v : any/c

Advance given epoch event, unblocking all threads waiting for it.

Examples:

> (thread (λ ()
(sleep 1)
(epoch-evt-advance! ee 'result)))
#<thread>
> (sync ee)
'result

9 Advanced Locking

Advanced locking tools, such as read-write locks and lock tables.

(require misc1/locking)

package: misc1

procedure
(make-rwlock [wlock]) → rwlock?
wlock : semaphore? = (make-semaphore 1)

Create new read-write lock, optionally reusing specified semaphore as write lock. External write lock can be useful for situations where the rwlock must start write-locked.

Example:

> (define lock (make-rwlock))

procedure
(rwlock? v) → boolean?
v : any/c

Predicate identifying a read-write lock.

Example:

> (rwlock? lock)
#t

syntax
(with-read-lock lock body ...)

Execute body protected by a shared reader lock. Waits for the lock to become available.

Example:

> (with-read-lock lock
'protected-from-writes)
'protected-from-writes

syntax
(with-write-lock lock body ...)

Execute body protected by an exclusive writer lock. Waits for the lock to become available.

Example:

> (with-write-lock lock
'exclusive-access)
'exclusive-access

procedure
(call-with-read-lock lock proc) → any
lock : rwlock?
proc : (-> any)

Executes the body proc protected by a shared reader lock.

procedure
(call-with-write-lock lock proc) → any
lock : rwlock?
proc : (-> any)

Executes the body proc protected by an exclusive writer lock.

top ← prev up next →

1	Syntax Extensions
2	Match Expanders
3	Dictionaries
4	Lists
5	Exceptions
6	Asynchronous Tasks
7	Fast Channels
8	Events
9	Advanced Locking