# Miscellaneous

# Buffered channels

(import :std/misc/channel)

# make-channel

(make-channel [n = #f]) -> channel

  n := optional fixnum, number of values channel buffer can hold

Creates a new buffered channel, a synchronization construct useful for sending and receiving data between producers and consumers, implicitly locking when reading from or writing to the channel. Chaining multiple channels, one after another, allows building computation pipelines with ease. n specifies how many elements the channel buffer is allowed to hold before blocking, with #f never blocking at all.

> (import :std/iter :gerbil/gambit/threads)
> (def (consume ch)
    (let (val (channel-get ch))
      (unless (eof-object? val)
        (with ([src . num] val)
          (displayln "received " num " from " src)
          (consume ch)))))
> (def (produce ch count)
    (for (i (in-iota count))
      (channel-put ch (cons (current-thread)
                            (+ 10 (random-integer 90))))))
> (let* ((ch (make-channel 2))
         (consumer (spawn consume ch))
         (producers (for/collect (i (in-iota 3))
                      (spawn produce ch 3))))
    (for-each thread-join! producers)
    (channel-close ch)
    (thread-join! consumer))
received 36 from #<thread #4>
received 73 from #<thread #4>
received 69 from #<thread #4>
received 73 from #<thread #5>
received 52 from #<thread #5>
received 59 from #<thread #5>
received 69 from #<thread #6>
received 53 from #<thread #6>
received 81 from #<thread #6>

# channel?

(channel? ch) -> boolean

  ch := channel to check

Returns #t if ch is a channel, #f otherwise.

> (channel? (make-channel))
#t

> (make-channel 3)
#<channel #26>
> (channel-close #26)
> (channel? #26)
#t

# channel-put

(channel-put ch val [timeout = #f]) -> boolean | error

  ch      := channel to write to
  val     := value to write into ch
  timeout := optional, how long to wait when channel is full

Writes val to ch and returns a truth value indicating whether the send was successful or not. channel-put blocks when the channel's buffer is full, waiting indefinitely for an available slot or until the optional timeout, declared in seconds or as a relative time object, is reached. Sending data to an already closed channel will signal an error.

> (def ch (make-channel 3))
> (channel-put ch 'a)
#t
> (channel-put ch 'b)
#t
> (channel-put ch 'c)
#t
> (channel-put ch 'd 2)    ; buffer full, gives up after 2 seconds
#f
> (import :gerbil/gambit/threads)
> (spawn-thread (lambda () (thread-sleep! 2) (channel-get ch)))
#<thread #29>
> (channel-put ch 'e)      ; blocks until other thread retrieves value
#t
> (channel-put ch 'e)      ; blocks indefinitely, no other threads retrieve values
*** ERROR IN ##thread-deadlock-action! -- Deadlock detected

# channel-try-put

(channel-try-put ch val) -> boolean | error

  ch  := channel to write to
  val := value to write into ch

Similar to channel-put, but doesn't block when the channel's buffer is full, simply indicating success or failure via a truth value. Sending data to an already closed channel will signal an error.

> (def ch (make-channel 3))
> (channel-try-put ch 'a)
#t
> (channel-try-put ch 'b)
#t
> (channel-try-put ch 'c)
#t
> (channel-try-put ch 'd)    ; buffer full, doesn't block, gives up right away
#f

> (close-channel ch)
> (channel-try-put ch 'e)    ; channel already closed, no longer valid to right to it
error

# channel-sync

(channel-sync ch val ...) -> void | error

  ch      := channel to write to
  val ... := values to send to ch

Forcefully writes val ... to ch, ignoring the channel's buffer limit. Useful for sending special values that indicate a bi-directional out-of-band communication request between consumers and producers without blocking. Sending data to an already closed channel will signal an error.

> (import :std/iter :gerbil/gambit/threads)
> (def (consume ch)
    (let loop ((i 0))
      (match (channel-get ch)
        ((eq? #!eof)
         (displayln "we're done here"))
        ((cons (quote more?) (? thread? thread))
         (displayln "received: sync request")
         (thread-send thread (if (< i 10) 'yes 'no))
         (loop i))
        ((? number? num)
         (displayln "received: " num)
         (loop (1+ i))))))
> (def (produce ch)
    (let loop ()
      (if (channel-try-put ch (random-integer 100))
        (loop)
        (begin            ; if buffer full, ask consumer whether to produce more
          (channel-sync ch (cons 'more? (current-thread)))
          (match (thread-receive)
            ('yes (loop))
            ('no  (channel-close ch)))))))
> (let* ((ch (make-channel 4))
         (producer (spawn produce ch))
         (consumer (spawn consume ch)))
    (for-each thread-join! [producer consumer]))
received: 28
received: 67
received: 79
received: 67
received: sync request    ; out-of-band answer via thread-send: 'yes
received: 21
received: 43
received: 71
received: 54
received: sync request    ; answer: 'yes
received: 29
received: 19              ; consumer processed 10 items, target reached
received: 61
received: 88
received: sync request    ; answer: no; producer closes channel, consumer shuts down
we're done here

# channel-get

(channel-get ch [timeout = #f] [default = #f]) -> any | default | #!eof

  ch      := channel to read from
  timeout := optional, how long to wait when channel is empty
  default := optional, value to return when timeout reached

Reads a value from ch and returns it, or default if a timeout was set and reached, declared in seconds or as a relative time object. channel-get blocks when the channel's buffer is empty, waiting indefinitely for more data or until the optional timeout is reached. Reading data from an already closed channel is allowed, but will always return #!eof.

> (def ch (make-channel 3))
> (for-each (cut channel-try-put ch <>) (iota 10))
> (channel-get ch)
0
> (channel-get ch 2)           ; returns right away
1
> (channel-get ch 2 'EMPTY)
2
> (channel-get ch 2)           ; channel can only hold three values, waits two seconds
#f
> (channel-get ch 2 'EMPTY)
EMPTY
> (channel-close ch)
> (channel-get ch)
#!eof
> (channel-get ch 2 'EMPTY)    ; closed channel always returns #!eof
#!eof

# channel-try-get

(channel-try-get ch [default = #f]) -> any | default | #!eof

  ch      := channel to read from
  default := optional, value to return when channel empty

Similar to channel-get, but doesn't block when the channel's buffer is empty, simply returning default in that case. Reading data from an already closed channel is allowed, but will always return #!eof.

> (def ch (make-channel 3))
> (for-each (cut channel-try-put ch <>) (string->list "abcdef"))
> (channel-try-get ch)
#\a
> (channel-try-get ch)
#\b
> (channel-try-get ch 'EMPTY)
#\c
> (channel-try-get ch 'EMPTY)    ; returns right away, no blocking occurs
EMPTY
> (channel-close ch)
> (channel-try-get ch 'EMPTY)
#!eof

# Channel Iterator

(defmethod (:iter (ch channel)) (iter-channel ch)) -> iterator

  ch := channel to iterate over

The module defines a generic dispatch overload for buffered channels, allowing them to be iterated just like lists or hashes. Iterating ch will yield values, and block if necessary, until the channel is closed and its elements fully consumed.

> (import :std/iter :gerbil/gambit/threads)
> (def (consume ch)
    (for/fold (sum 0) (x ch)
      (+ x sum)))
> (def (produce ch count)
    (for (i (in-iota count))
      (channel-put ch (random-integer 100))))
> (let* ((ch (make-channel))
         (consumer (spawn consume ch))
         (producers (for/collect (i (in-iota 10))
                      (spawn produce ch 100))))
    (for-each thread-join! producers)
    (channel-close ch)
    (thread-join! consumer))
49644

# channel-close

(channel-close ch) -> void

  ch := channel to close

Closes a buffered channel, forbidding write access. Consumers are still allowed to retrieve values from such a closed channel, but once empty, it will simply return #!eof.

Note: Only senders should close channels. Furthermore, it's not an error to close a channel multiple times.

> (def ch (make-channel))
> (channel-put ch 1)
#t
> (channel-close ch)
> (channel-get ch)      ; reading from a closed channel is allowed
1
> (channel-get ch)
#!eof
> (channel-put ch 2)    ; writing to a closed channel signals an error
error

# channel-closed?

(channel-closed? ch) -> boolean

  ch := channel to check

Returns #t if ch is closed, #f otherwise.

> (def ch (make-channel))
> (channel-closed? ch)
#f
> (channel-close ch)
> (channel-closed? ch)
#t

# Channel Destructor

(defmethod {destroy <port>} channel-close)

The module also defines a destroy method for channels, so that they can be used in with-destroy forms and other primitives that use the destroy idiom, ensuring that channels will be closed even if an error is signaled somewhere within the body.

> (def ch (make-channel))
> (channel-put ch 10)
#t
> (channel-closed? ch)
#f
> (with-destroy ch
    (channel-get ch))
10
> (channel-closed? ch)
#t

# Bytes

This library provides primitives for operating on u8vectors as well as some utility functions.

(import :std/misc/bytes)

# endianness

(endianness big|little|native) -> endianness symbol

(def big 'big)
(def little 'little)
(def native 'native)
(def native-endianness ...)

Specifies the endianness for integer and floating point operations on u8vectors.

The supported endianness can be big, little, or native; native-endianness is bound at runtime to the native architecture endianness.

# u8vector-s8-ref

(u8vector-s8-ref v i) -> int

  v := u8vector
  i := integer; offset index in v

Retrieves the signed byte from v in position i, decoding from a 2's complement representation.

# u8vector-s8-set!

(u8vector-s8-set! v i n) -> unspecified

  v := u8vector
  i := integer; offset index in v
  n := signed byte

Sets the signed byte in v at position i from the value n, encoding to 2's complement representation.

# u8vector-uint-ref

(u8vector-uint-ref v i endianness size) -> exact nonnegative integer

  v          := u8vector
  i          := integer; offset index in v
  endianness := endianness symbol; the endianness of the binary representation of the integer
  size       := integer; the size of the integer in bytes

Retrieves an unsigned integer from its binary representation from v, starting at index i.

# u8vector-uint-set!

(u8vector-uint-set! v i n endianness size) -> unspecified

  v          := u8vector
  i          := integer; offset index in v
  n          := exact nonnegative integer; the value to set
  endianness := endianness symbol; the endianness of the binary representation of the integer
  size       := integer; the size of the integer in bytes

Encodes the unsigned integer n in its binary representation in v, starting at offset i.

# u8vector-sint-ref

(u8vector-sint-ref v i endianness size) -> exact integer

  v          := u8vector
  i          := integer; offset index in v
  endianness := endianness symbol; the endianness of the binary representation of the integer
  size       := integer; the size of the integer in bytes

Retrieves a signed integer from its binary representation from v, starting at index i.

# u8vector-sint-set!

(u8vector-sint-set! v i n endianness size) -> unspecified

  v          := u8vector
  i          := integer; offset index in v
  n          := exact integer; the value to set
  endianness := endianness symbol; the endianness of the binary representation of the integer
  size       := integer; the size of the integer in bytes

Encodes the signed integer n in its binary representation in v, starting at offset i.

# u8vector->uint-list

(u8vector->uint-list v endianness size) -> list of exact nonnegative integers

  v          := u8vector
  endianness := endianness symbol; the endianness of the binary representation of each integer
  size       := integer; the size of each integer in bytes

Decodes a u8vector v into a list of exact nonnegative integers.

# uint-list->u8vector

(uint-list->u8vector lst endianness size) -> u8vcetor

  lst        := list of exact nonnegative integers
  endianness := endianness symbol; the endianness of the binary representation of each integer
  size       := integer; the size of each integer in bytes

Encodes a list of unsigned integers to a u8vector.

# u8vector->sint-list

(u8vector->sint-list v endianness size) -> list of exact integers

  v          := u8vector
  endianness := endianness symbol; the endianness of the binary representation of each integer
  size       := integer; the size of each integer in bytes

Decodes a u8vector v into a list of exact integers.

# sint-list->u8vector

(uint-list->u8vector lst endianness size) -> u8vector

  lst        := list of exact integers
  endianness := endianness symbol; the endianness of the binary representation of each integer
  size       := integer; the size of each integer in bytes

Encodes a list of signed integers to a u8vector.

# Operations on Machine-size Integers

(u8vector-u16-ref v i endianness) -> u16
(u8vector-u16-native-ref v i) -> u16
(u8vector-u16-ref-set! v i n endianness) -> unspecified
(u8vector-u16-native-set! v i n) -> unspecified

(u8vector-s16-ref v i endianness) -> s16
(u8vector-s16-native-ref v i) -> s16
(u8vector-s16-ref-set! v i n endianness) -> unspecified
(u8vector-s16-native-set! v i n) -> unspecified

(u8vector-u32-ref v i endianness) -> u32
(u8vector-u32-native-ref v i) -> u32
(u8vector-u32-ref-set! v i n endianness) -> unspecified
(u8vector-u32-native-set! v i n) -> unspecified

(u8vector-s32-ref v i endianness) -> s32
(u8vector-s32-native-ref v i) -> s32
(u8vector-s32-ref-set! v i n endianness) -> unspecified
(u8vector-s32-native-set! v i n) -> unspecified

(u8vector-u64-ref v i endianness) -> u64
(u8vector-u64-native-ref v i) -> u64
(u8vector-u64-ref-set! v i n endianness) -> unspecified
(u8vector-u64-native-set! v i n) -> unspecified

(u8vector-s64-ref v i endianness) -> s64
(u8vector-s64-native-ref v i) -> s64
(u8vector-s64-ref-set! v i n endianness) -> unspecified
(u8vector-s64-native-set! v i n) -> unspecified

Operations for encoding and decoding machine-sized integers. When the endianness matches the native endianness, then a faster native implementation is used.

# Operations on Floating Point Numbers

(u8vector-float-ref v i endianness) -> flonum
(u8vector-float-native-ref v i) -> flonum
(u8vector-float-set! v i x endianness) -> unspecified
(u8vector-float-native-set! v i x) -> unspecified

(u8vector-double-ref v i endianness) -> flonum
(u8vector-double-native-ref v i) -> flonum
(u8vector-double-set! v i x endianness) -> unspecified
(u8vector-double-native-set! v i x) -> unspecified

Operations for encoding and decoding floating point numbers using the IEEE-754 representation.

# u8vector-swap!

(u8vector-swap! v i j) -> unspecified

  v := u8vector
  i := integer element position
  j := integer element position

Swaps elements i and j of u8vector v.

> (def u (u8vector 1 2))
> (u8vector-swap! u 0 1)
> u
#u8(2 1)

# u8vector-reverse!

(u8vector-reverse! v) -> void

  v := u8vector

Reverses the elements of u8vector v in-place. Mutates the vector.

> (def u (u8vector 1 2 3 4 5))
> (u8vector-reverse! u)
> u
#u8(5 4 3 2 1)

# u8vector-reverse

(u8vector-reverse v) -> u8vector

  v := u8vector

Reverses the elements of u8vector v. Produces a new u8vector.

> (def u (u8vector 1 2 3 4 5))
> (u8vector-reverse u)
#u8(5 4 3 2 1)

# u8vector->bytestring

(u8vector->bytestring v (delim #\space)) -> bytestring

  v     := u8vector
  delim := char

Constructs a string of bytes in hexadecimal from u8vector v.

Each byte is formatted as two uppercase hex characters and separated using the specified delimiter character; the delimiter can be #f to specify simple concatenation.

> (u8vector->bytestring (u8vector 255 127 11 1 0))
"FF 7F 0B 01 00"
> (displayln (u8vector->bytestring (u8vector 255 127 11 1 0)))
FF 7F 0B 01 00
> (u8vector->bytestring (u8vector 1 2 3) #f)
"010203"

# bytestring->u8vector

(bytestring->u8vector bs (delim #\space)) -> u8vector

  bs    := bytestring
  delim := char

Constructs a u8vector from bytestring bs.

This function expects a string of bytes delimited by delim, which can be #f to indicate no delimiter. Each byte consists of two hexadecimal characters.

> (bytestring->u8vector "FF AB 00")
#u8(255 171 0)
> (u8vector->bytestring (bytestring->u8vector "FF AB 00"))
"FF AB 00"
> (string->bytes "FF AB 00")
#u8(70 70 32 65 66 32 48 48)

# u8vector->uint

(u8vector->uint v (endianness big)) -> uint

  v          := u8vector
  endianness := endianness symbol

Decodes a u8vector as an unsigned integer.

# uint->u8vector

(uint->u8vector n (endianness big)) -> u8vector

  n          := exact nonnegative integer
  endianness := endianness symbol

Encodes an unsigned integer to its binary representation.

> (u8vector->uint #u8(0 1))
1
> (u8vector->uint (make-u8vector 2 #xFF))
65535
> (u8vector->uint (make-u8vector 8 #xFF))
18446744073709551615
> (equal? (- (expt 2 64) 1) (u8vector->uint (make-u8vector 8 #xFF)))
#t

# Aliases

The following aliases are defined, using the canonical Scheme naming of u8vectors as bytevectors.

(defalias bytevector-u8-ref u8vector-ref)
(defalias bytevector-u8-set! u8vector-set!)
(defalias bytevector-s8-ref u8vector-s8-ref)
(defalias bytevector-s8-set! u8vector-s8-set!)

(defalias bytevector-uint-ref u8vector-uint-ref)
(defalias bytevector-uint-set! u8vector-uint-set!)
(defalias bytevector-sint-ref u8vector-sint-ref)
(defalias bytevector-sint-set! u8vector-sint-set!)

(defalias bytevector->uint-list u8vector->uint-list)
(defalias bytevector->sint-list u8vector->sint-list)
(defalias uint-list->bytevector uint-list->u8vector)
(defalias sint-list->bytevector sint-list->u8vector)

(defalias bytevector-u16-ref u8vector-u16-ref)
(defalias bytevector-u16-native-ref u8vector-u16-native-ref)
(defalias bytevector-u16-set! u8vector-u16-set!)
(defalias bytevector-u16-native-set! u8vector-u16-native-set!)

(defalias bytevector-s16-ref u8vector-s16-ref)
(defalias bytevector-s16-native-ref u8vector-s16-native-ref)
(defalias bytevector-s16-set! u8vector-s16-set!)
(defalias bytevector-s16-native-set! u8vector-s16-native-set!)

(defalias bytevector-u32-ref u8vector-u32-ref)
(defalias bytevector-u32-native-ref u8vector-u32-native-ref)
(defalias bytevector-u32-set! u8vector-u32-set!)
(defalias bytevector-u32-native-set! u8vector-u32-native-set!)

(defalias bytevector-s32-ref u8vector-s32-ref)
(defalias bytevector-s32-native-ref u8vector-s32-native-ref)
(defalias bytevector-s32-set! u8vector-s32-set!)
(defalias bytevector-s32-native-set! u8vector-s32-native-set!)

(defalias bytevector-u64-ref u8vector-u64-ref)
(defalias bytevector-u64-native-ref u8vector-u64-native-ref)
(defalias bytevector-u64-set! u8vector-u64-set!)
(defalias bytevector-u64-native-set! u8vector-u64-native-set!)

(defalias bytevector-s64-ref u8vector-s64-ref)
(defalias bytevector-s64-native-ref u8vector-s64-native-ref)
(defalias bytevector-s64-set! u8vector-s64-set!)
(defalias bytevector-s64-native-set! u8vector-s64-native-set!)

(defalias bytevector-ieee-single-ref u8vector-float-ref)
(defalias bytevector-ieee-single-set! u8vector-float-set!)
(defalias bytevector-ieee-single-native-ref u8vector-float-native-ref)
(defalias bytevector-ieee-single-native-set! u8vector-float-native-set!)

(defalias bytevector-ieee-double-ref u8vector-double-ref)
(defalias bytevector-ieee-double-set! u8vector-double-set!)
(defalias bytevector-ieee-double-native-ref u8vector-double-native-ref)
(defalias bytevector-ieee-double-native-set! u8vector-double-native-set!)

(defalias bytevector-swap! u8vector-swap!)
(defalias bytevector-reverse! u8vector-reverse!)
(defalias bytevector-reverse u8vector-reverse)
(defalias bytevector->bytestring u8vector->bytestring)
(defalias bytestring->bytevector bytestring->u8vector)
(defalias bytevector->uint u8vector->uint)
(defalias uint->bytevector uint->u8vector)

# Low Level Unsafe Operations

The following low level unsafe operations are also exported.

(&u8vector-s8-ref v i) -> s8
(&u8vector-s8-set! v i n) -> unspecified

(&u8vector-uint-ref/be v i size) -> uint
(&u8vector-uint-ref/le v i size) -> uint
(&u8vector-uint-set!/be v i n size) -> unspecified
(&u8vector-uint-set!/le v i n size) -> unspecified

(&u8vector-sint-ref/be v i size) -> sint
(&u8vector-sint-ref/le v i size) -> sint
(&u8vector-sint-set!/be v i n size) -> unspecified
(&u8vector-sint-set!/le v i n size) -> unspecified

(&u8vector-u16-ref/native v i) -> u16
(&u8vector-u16-set!/native v i n) -> unspecified
(&u8vector-s16-ref/native v i) -> s16
(&u8vector-s16-set!/native v i n) -> unspecified

(&u8vector-u32-ref/native v i) -> u32
(&u8vector-u32-set!/native v i n) -> unspecified
(&u8vector-s32-ref/native v i) -> s32
(&u8vector-s32-set!/native v i n) -> unspecified

(&u8vector-u64-ref/native v i) -> u64
(&u8vector-u64-set!/native v i n) -> unspecified
(&u8vector-s64-ref/native v i) -> s64
(&u8vector-s64-set!/native v i n) -> unspecified

(&u8vector-float-ref/native v i) -> flonum
(&u8vector-float-set!/native v i x) -> unspecified
(&u8vector-double-ref/native v i) -> flonum
(&u8vector-double-set!/native v i x) -> unspecified

(&u8vector-swap! v i j) -> unspecified

# Asynchronous Completions

(import :std/misc/completion)

# make-completion

(make-completion) -> completion

Creates a new asynchronous completion, a synchronization construct which blocks until a thread signals that its task either succeeded or failed via completion-post! or completion-error!, respectively, notifying all waiting threads about the result.

> (import :gerbil/gambit/threads :std/iter :std/sugar)
> (def (task i c)
    (displayln i ": waiting")
    (try (displayln i ": " (completion-wait! c))
      (catch (ex) (displayln i ": " ex))
      (finally (displayln i ": exiting"))))
> (let* ((c (make-completion))
         (threads (for/collect (i (in-iota 3))
                    (spawn task i c))))
    (spawn-thread
      (lambda ()
        (displayln "error in computation, notifying all")
        (completion-error! c 'did-not-finish)))
    (for-each thread-join! threads))
0: waiting
1: waiting
2: waiting
error in computation, notifying all
0: did-not-finish
0: exiting
1: did-not-finish
1: exiting
2: did-not-finish
2: exiting

# completion?

(completion? c) -> boolean

  c := completion to check

Returns #t if c is a completion, #f otherwise.

> (completion? (make-completion))
#t

> (import :gerbil/gambit/threads)
> (completion? (make-condition-variable))
#f

# completion-ready?

(completion-ready? c) -> boolean

  c := completion to check

Returns #t if the completion is ready, #f otherwise. This operation is non-blocking.

> (def c (make-completion))
> (completion-ready? c)
#f
> (completion-post! c 'DONE)
> (completion-ready? c)
#t

# completion-wait!

(completion-wait! c) -> any | error

  c := completion to wait on

Waits on c until it has been posted with completion-post! or an error has been signaled with completion-error!. If the completion was posted, the posted value is returned. If an error was signalled, then it is raised as an exception.

> (def c (make-completion))
> (spawn completion-wait! c)
#<thread #3>
> (spawn completion-wait! c)
#<thread #4>
> (spawn completion-wait! c)
#<thread #5>
> (completion-post! c 'done)    ; all waiting threads will be notified
> (map thread-dead? [#3 #4 #5])
(#t #t #t)
> (completion-wait! c)          ; already completed, not waiting
done

> (def c (make-completion))
> (spawn completion-error! c 'failure)
#<thread #8>
> (completion-wait! c)
*** ERROR IN (console)@1986.1 -- This object was raised: failure

# completion-post!

(completion-post! c val) ->  void | error

  c   := completion to post
  val := result value

Signals to c that the current thread's computation is complete. All other waiting threads will be notified and receive val as the result.

Calling completion-post! on an already completed c will raise an error.

> (import :gerbil/gambit/threads :std/iter)
> (def (task i c)
    (displayln i ": waiting")
    (displayln i ": " (completion-wait! c)))
> (let* ((c (make-completion))
         (threads (for/collect (i (in-iota 3))
                    (spawn task i c))))
    (thread-sleep! 1)
    (displayln "main: done")
    (completion-post! c 'ok)
    (for-each thread-join! threads))
0: waiting
1: waiting
2: waiting
main: done
0: ok
1: ok
2: ok

;; Completions are expected to be posted once. The following would
;; be a race condition, either succeeding fine or raising an error:
> (let (c (make-completion))
    (spawn completion-post! c 'done)    ; silently fails in case of error
    (completion-post! c 'done)
    (completion-wait! c))
;; either of these:
*** ERROR IN (console)@2019.5 -- Completion has already been posted #<completion #26>
done

# completion-error!

(completion-error! c obj) -> void | error

  c   := completion to notify
  obj := exception object to raise

Signals an error to c, with obj being the exception argument that's raised, notifying all waiting threads that a problem occurred.

Calling completion-error! on an already completed c will raise an error.

> (import :gerbil/gambit/threads :std/sugar)
> (let (c (make-completion))
    (spawn completion-error! c 'failure)
    (try (completion-wait! c)    ; failure is raised in all waiting threads
      (catch (ex) (display-exception ex (current-error-port)))))
This object was raised: failure

# with-completion-error

(with-completion-error c body ...) -> any | error

  c        := completion to notify when error occurs
  body ... := expressions to evaluate

Wraps body ... with an exception handler that notifies c via completion-error! if any type of error is raised within the body expressions. Furthermore, errors will propagate upwards and need to be handled, terminating the thread otherwise.

> (import :gerbil/gambit/threads :std/sugar)
> (def (task c)
    (with-completion-error c
      (displayln (/ 7 0))    ; call completion-error! and silently terminate thread
      (completion-post! c)))
> (let (c (make-completion))
    (spawn task c)
    (try
      (completion-wait! c)
      (displayln "All done!")
      (catch (ex) (display-exception ex (current-error-port)))))
Divide by zero
(/ 7 0)

# completion

(defsyntax completion)

Completion type for user-defined generics and destructuring.

> (import :gerbil/gambit/threads)
> (def c (make-completion))
> (completion-post! c 'done)
> (with ((completion mut cond-var ready? val ex) c)
    (with-lock mut
      (cut displayln "value: " (if ready? val "not ready"))))
value: done

# Thread Barriers

(import :std/misc/barrier)

# make-barrier

(make-barrier n) -> barrier | error

  n := thread wait limit, fixnum

Creates a thread barrier, a synchronization construct that blocks up to n threads before it allows them to proceed. n needs to be a non-negative fixnum, otherwise an error is signaled.

> (import :gerbil/gambit/threads :std/iter)
> (def (thread-task b)
    (thread-sleep! (+ 2 (random-integer 3)))
    (displayln (current-thread) " completed its task. Waiting for others.")
    (barrier-post! b)
    (barrier-wait! b)
    (displayln (current-thread) " runs again."))

> (let* ((b (make-barrier 3))
         (threads (for/collect (i (in-iota 5))
                    (spawn thread-task b))))
    (for-each thread-join! threads)
    (displayln "All threads are done."))
#<thread #1> completed its task. Waiting for others.
#<thread #2> completed its task. Waiting for others.
#<thread #3> completed its task. Waiting for others.
#<thread #1> runs again.    ; barrier limit reached, notifying waiting threads
#<thread #2> runs again.
#<thread #3> runs again.
#<thread #4> completed its task. Waiting for others.
#<thread #4> runs again.    ; limit already reached, no need to wait
#<thread #5> completed its task. Waiting for others.
#<thread #5> runs again.
All threads are done.

# barrier?

(barrier? b) -> boolean

  b := barrier to check

Returns #t if b is a barrier, #f otherwise.

> (barrier? (make-barrier 3))
#t

(import :gerbil/gambit/threads)
> (barrier? (make-mutex 'barrier))
#f

# barrier-wait!

(barrier-wait! b) -> void | error

  b := barrier to wait on

Waits on b until it has been posted n times (as specified on barrier creation) with barrier-post! or an error has been signaled with barrier-error!. Errors will propagate upwards and need to be handled.

> (import :gerbil/gambit/threads :std/iter :std/format)
> (def (log msg)
    (printf "~a@~a: ~a\n" (current-thread) (time->seconds (current-time)) msg))
> (def (task b)
    (log "working")
    (thread-sleep! (random-integer 5))
    (barrier-post! b)
    (log "waiting for other threads")
    (barrier-wait! b)
    (log "done"))
> (let (b (make-barrier 3))
    (for-each thread-join! (for/collect (i (in-iota 3)) (spawn task b)))
    (barrier-wait! b)     ; barrier thread limit already reached, not waiting
    (barrier-error! b 'failure)
    (barrier-wait! b))    ; unhandled exception, terminates primordial thread
#<thread #1>@1558088315.312991:  working
#<thread #2>@1558088315.3137062: working
#<thread #3>@1558088315.3143606: working
#<thread #3>@1558088317.3152056: waiting for other threads
#<thread #1>@1558088318.313868:  waiting for other threads
#<thread #3>@1558088319.3144877: done
#<thread #1>@1558088319.314984:  done
#<thread #2>@1558088319.3154783: waiting for other threads
#<thread #2>@1558088319.3161075: done
*** ERROR IN (console)@1593.5 -- This object was raised: failure

# barrier-post!

(barrier-post! b) -> void

  b := barrier to signal to

Signals b that the current thread's computation is complete. All other waiting threads will be notified once b's post limit (as specified on barrier creation) is reached.

> (import :gerbil/gambit/threads)
> (let* ((b (make-barrier 2))
         (t1 (spawn barrier-post! b))
         (t2 (spawn barrier-post! b)))
    (barrier-wait! b)    ; signaled twice, good to go
    'OK)
OK

# barrier-error!

(barrier-error! b obj) -> void

  b   := barrier to signal error on
  obj := exception object to raise

Signals an error to b, with obj being the exception argument that's raised, notifying all waiting threads that a problem occurred.

> (import :gerbil/gambit/threads :std/sugar)
> (let* ((b (make-barrier 3))
         (t (spawn barrier-error! b 'failure)))
    (try (barrier-wait! b)    ; failure is raised in all waiting threads
      (catch (ex) (display-exception ex (current-error-port)))))
This object was raised: failure

# with-barrier-error

(with-barrier-error b body ...) -> any | error

  b        := barrier to notify when error occurs
  body ... := expressions to evaluate

Wraps body ... with an exception handler that notifies b via barrier-error! if any type of error is raised within the body expressions. Furthermore, errors will propagate upwards and need to be handled, terminating the thread otherwise.

> (import :gerbil/gambit/threads :std/sugar)
> (def (task b)
    (with-barrier-error b
      (displayln (/ 7 0))    ; call barrier-error! and silently terminate thread
      (barrier-post! b)))
> (let* ((b (make-barrier 2))
         (t (spawn task b)))
    (try
      (barrier-wait! b)
      (displayln "All done!")
      (catch (ex) (display-exception ex (current-error-port)))))
Divide by zero
(/ 7 0)

# barrier

(defsyntax barrier)

Barrier type for user-defined generics and destructuring.

> (import :gerbil/gambit/threads)
> (with ((barrier mut cond-var count limit ex) (make-barrier 3))
    (with-lock mut
      (cut displayln "limit: " count "/" limit)))
limit: 0/3

# Deques

(import :std/misc/deque)

# make-deque

(make-deque) -> deque

Creates a new empty deque, a double-ended queue, which allows adding and removing elements on both ends without walking the whole data structure first.

> (import :std/test)
> (let (dq (make-deque))
    (check (deque-empty? dq) => #t)
    (push-front! dq 10)
    (push-front! dq 20)
    (push-back!  dq 30)
    (check (deque-length dq) => 3)
    (deque->list dq))
... check (deque-empty? dq) is equal? to #t
... check (deque-length dq) is equal? to 3
(20 10 30)

# deque?

(deque? dq) -> boolean

  dq := deque to check

Returns #t if dq is a deque, #f otherwise.

> (let (dq (make-deque))
    (push-front! dq (make-deque))
    (and (deque? dq)
         (deque? (peek-front dq))
         (deque? (make-deque))))
#t

> (deque? (list 1 2 3))
#f

# deque-length

(deque-length dq) -> fixnum

  dq := deque to inspect

Returns the number of elements dq holds.

Similar to retrieving the length of a vector, this operations is O(1), since deques always keep track of their length.

> (let (dq (make-deque))
    (for-each (cut push-back! dq <>) '(A B C D E F))
    (deque-length dq))
6

> (deque-length (make-deque))
0

# deque-empty?

(deque-empty? dq) -> boolean

  dq := deque to check whether empty

Returns #t if dq has no elements queued, #f otherwise.

> (deque-empty? (make-deque))
#t

> (let (dq (make-deque))
    (push-back! dq (make-deque))
    (and (deque-empty? (peek-front dq))
         (deque-empty? dq)))
#f

# push-front!

(push-front! dq elem) -> unspecified

  dq   := deque to push onto
  elem := element to push to dq

Enqueues (pushes) elem to the front of the dq. Similar to set!, it's unspecified what push-front! returns afterwards.

> (let (dq (make-deque))
    (push-front! dq 30)
    (push-front! dq 20)
    (push-front! dq 10)
    (deque->list dq))
(10 20 30)

# push-back!

(push-back! dq elem) -> unspecified

  dq   := deque to push onto
  elem := element to push to dq

push-back! is similar to push-front!, but pushes elem to the back of dq instead of the front.

> (let (dq (make-deque))
    (push-back! dq #\a)
    (push-back! dq #\b)
    (push-back! dq #\c)
    (list->string (deque->list dq)))
"abc"

# pop-front!

(pop-front! dq [default = absent-obj]) -> any | default | error

  dq      := deque to pop from
  default := optional element returned when dq is empty

Pops the front of dq and returns that value. If dq is empty and a default value is supplied, then default is returned. Otherwise an error is raised.

> (let (dq (make-deque))
    (for-each (cut push-back! dq <>) [1 2 3])
    (displayln (pop-front! dq 0))
    (displayln (pop-front! dq 0))
    (displayln (pop-front! dq 0))
    ;; would signal error without default value:
    (displayln (pop-front! dq 0)))
1
2
3
0

# pop-back!

(pop-back! dq [default = absent-obj]) -> any | default | error

  dq      := deque to pop from
  default := optional element returned when dq is empty

pop-back! is similar to pop-front!, but pops the back of dq instead and returns that value. If dq is empty and a default value is supplied, then default is returned. Otherwise an error is raised.

> (import (group-in :std iter sugar))
> (let (dq (make-deque))
    (for ((x "ABCDEF") (y (in-naturals 1)))
      (push-front! dq (cons x y)))
    (until (deque-empty? dq)
      (displayln (pop-back! dq))))
(A . 1)
(B . 2)
(C . 3)
(D . 4)
(E . 5)
(F . 6)

# peek-front

(peek-front dq [default = absent-obj]) -> any | default | error

  dq      := deque to peek front
  default := optional element returned when dq is empty

Returns the front value of dq without popping it from the deque like pop-front! does. If dq is empty and a default value is supplied, then default is returned. Otherwise an error is raised.

> (let (dq (make-deque))
    (push-back! dq 10)
    (push-back! dq 20)
    (push-back! dq 30)
    (peek-front dq))
10

> (import :std/sugar :std/misc/func)
> (let (dq (make-deque))
    (for-each (cut push-front! dq <>)
              (repeat random-integer 10 10))
    (displayln (deque->list dq))
    (while (odd? (peek-front dq 0))
      (pop-front! dq))
    (deque->list dq))
(3 5 5 1 0 4 5 8 6 1)
(0 4 5 8 6 1)

# peek-back

(peek-back dq [default = absent-obj]) -> any | default | error

  dq      := deque to peek back
  default := optional element returned when dq is empty

Returns the back value of dq without popping it from the deque like pop-back! does. If dq is empty and a default value is supplied, then default is returned. Otherwise an error is raised.

> (let (dq (make-deque))
    (push-back! dq 'A)
    (push-back! dq 'B)
    (push-back! dq 'C)
    (displayln (peek-back dq))
    (pop-front! dq)
    (displayln (peek-back dq))
    (pop-back! dq)
    (displayln (peek-back dq)))
C
C
B

> (def dq (make-deque))
> (push-back! dq "xyz")
#<deque #15>    ; unspecified, don't depend on this
> (peek-back dq 'EMPTY)
"xyz"
> (pop-front! dq)
"xyz"
> (peek-back dq 'EMPTY)
EMPTY
> (peek-back dq)
error

# deque->list

(deque->list dq) -> list

  dq := deque to transform into list

Returns a new list of the elements queued in dq, in order.

> (let (dq (make-deque))
    (push-back! dq #\a)
    (push-back! dq 100)
    (push-back! dq "other")
    (deque->list dq))
(#\a 100 "other")

> (import :std/srfi/1)
> (let (dq (make-deque))
    (for-each (cut push-front! dq <>) (iota 100))
    (drop (deque->list dq) 90))
(9 8 7 6 5 4 3 2 1 0)

# deque

(defsyntax deque)

Deque type for user-defined generics and destructuring.

> (let (dq (make-deque))
    (push-back! dq "first")
    (push-back! dq "second")
    (push-back! dq "third")
    (match dq
      ((deque front back length)
       (displayln "front:  " front)
       (displayln "back:   " back)
       (displayln "length: " length))))
front:  #<node #17>
back:   #<node #18>
length: 3

# Hash-table utilities

(import :std/misc/hash)

# hash-ensure-ref

(hash-ensure-ref table key default) -> value

Checks whether the given key is present in the table. If it is, return the associated value. If it is not, call the default thunk, associate its return value to the key in the table, and then return the value.

# invert-hash

(invert-hash hash to: (to (hash))) -> hash-1

Returns the inverse of a hash table: a hash-table hash-1 whose keys are the values of those of hash, each mapped to one value that is a key that hash associates to the value. If the key is unique, it will be used; if it isn't, any single of those keys may be used.

If an existing hash-table is passed as a to argument, it will be used as hash-table populated with those inverse keys, instead of a new equal-hash-table. This feature can notably be used to provide a hash-table with different equality predicate, or a weak hash-table, or one that is already populated for other reasons.

# invert-hash/fold

(invert-hash/fold hash to: (to (hash)) nil: (nil '()) cons: (cons cons)) -> hash-1

Returns the inverse of a hash table: a hash-table hash-1 whose keys are the values of those of hash, each mapped to a value that is fold of all keys that hash associates to the value. By default, the fold consists in consing those keys into a list, in an unspecified order. It could instead create a hash-table of those keys, or a sorted list or tree of them, etc.

If an existing hash-table is passed as a to argument, it will be used as hash-table populated with those inverse keys, instead of a new equal-hash-table. This feature can notably be used to provide a hash-table with different equality predicate, or a weak hash-table, or one that is already populated for other reasons.

# invert-hash<-vector

(invert-hash<-vector vector
    start: (start 0) end: (end (vector-length from))
    to: (to (make-hash-table)) key: (key identity))
 -> hash

Returns the inverse of the section of a vector in the given range from start included to end excluded, a hash-table hash whose keys are extracted from values of those of vector by the function key (that defaults to identity, i.e. the value itself is the key), each mapped to one value that is an index that vector associates to the value. If the index is unique, it will be used; if it isn't, any single of those indexes may be used.

If an existing hash-table is passed as a to argument, it will be used as hash-table populated with those inverse keys, instead of a new equal-hash-table. This feature can notably be used to provide a hash-table with different equality predicate, or a weak hash-table, or one that is already populated for other reasons.

# invert-hash<-vector/fold

(invert-hash<-vector/fold
      from start: (start 0) end: (end (vector-length from))
      to: (to (make-hash-table)) nil: (nil '()) cons: (cons cons) key: (key identity)) -> to

Returns the inverse of the section of a vector in the given range from start included to end excluded, a hash-table hash whose keys are extracted from values of those of vector by the function key (that defaults to identity, i.e. the value itself is the key), each mapped to one value that is an index that vector associates to the value. Each time an index is found for a given key, it is combined together with previous indexes found using the function cons (which defaults to actual cons), with the value nil (which defaults to empty list ()) being assumed as the initial value before any index is found. If an existing hash-table is passed as a to argument, it will be used as hash-table populated with those inverse indexes, instead of a new equal-hash-table. This feature can notably be used to provide a hash-table with different equality predicate, or a weak hash-table, or one that is already populated for other reasons.

# hash-restrict-keys

(hash-restrict-keys hash key-list) -> hash-1

Returns a new hash-table hash-1 that has a subset of the keys in hash, associated to the same values as in hash. The key restriction is specified as a list key-list of acceptable keys; if the key in the list is present, the key-value pair is copied to the new table; if it is not present, it is ignored.

# hash-value-map

(hash-value-map hash fun) -> hash-1

Return a new hash-table that has the same keys as the original hash, but whose values have been transformed by calling the function fun.

# hash-key-value-map

(hash-key-value-map fun from (to (hash)) -> to

Modifies the to hash-table (by default, a new equal? hash-table), by calling a function fun on each key value pair of hash-table from (passed as two arguments key and value), which must return either #f or a cons pair (k1 . v1) that will be added to the destination hash-table to. If a key k1 appears multiple times, it is not guaranteed which will present in the end, only that one of them will.

> (hash->list/sort
    (hash-key-value-map
     (lambda (k v) (and (even? v) (cons (/ v 2) (string-append k k))))
     (hash ("a" 1) ("b" 2) ("c" 3) ("d" 4) ("e" 5) ("f" 6))) <)
((1 . "bb") (2 . "dd") (3 . "ff"))

# hash-filter

(hash-filter hash pred (to (hash))) -> hash-1

Return a new hash-table that has a subset of the key-value pairs in the original hash, those for which the predicate pred returns true when called with the key and value as its two arguments.

If the to argument is provided, it is used instead of a new hash-table, which allows to pre-populate it, use a different equality predicate than equal?, or to specify weakness.

# hash-remove

(hash-remove hash fun (to (hash))) -> hash-1

Return a new hash-table that has a subset of the key-value pairs in the original hash, those for which the predicate pred returns false when called with the key and value as its two arguments.

If the to argument is provided, it is used instead of a new hash-table, which allows to pre-populate it, use a different equality predicate than equal?, or to specify weakness.

# hash-remove-value

(hash-remove-value from val (to (hash))) -> hash-1

Return a new hash-table that has a subset of the key-value pairs in the original hash, those for which the value is different (not equal?) to the given argument val.

If the to argument is provided, it is used instead of a new hash-table, which allows to pre-populate it, to specify weakness, or to use a different equality predicate than equal? (beware though that comparison is still with equal? --- for a different one, use hash-remove instead with a suitable predicate).

# hash-ensure-removed!

(hash-ensure-removed! hash key) -> hash

Remove from the hash any entry with the given key, and return two values: (a) the value that was removed, if any, or #f if none was found, and (b) a boolean that tells if there was a value.

# hash-ensure-modify

(hash-ensure-modify! hash key default function) -> value

Modify entry for key in hash. If no entry exists yet, call the provided thunk to compute a default value. Return the new value, after modification.

# hash-empty?

(hash-empty? hash) -> bool

Return true if hash is empty.

# hash-merge/override

(hash-merge/override hash ...) -> hash

Similar to hash-merge, creates a new hash-table with the contents of all the arguments provided, but in case a same key is present in multiple arguments, choose the value in the rightmost argument (instead of the leftmost as with hash-merge).

# hash-merge/override!

(hash-merge/override! hash hash1 ...) -> hash

Similar to hash-merge!, modifies the first hash table by updating it with the contents of all the other arguments provided; however, as with hash-merge/override, in case a same key is present in multiple arguments, choose the value in the rightmost argument (instead of the leftmost as with hash-merge).

# hash->list/sort

(hash->list/sort hash pred) -> list

Similar to hash->list and table->list, this function returns a list of the key-value pairs in the hash table, but also sorts this list by keys according to the provided predicate pred.

> (hash->list/sort (hash (3 "c") (4 "d") (1 "a") (2 "b")) <)
((1 . "a") (2 . "b") (3 . "c") (4 . "d"))

# hash-get-set!

(hash-get-set! h k v) -> (void)

hash-get-set! is a synonym for hash-put! that makes it possible to (set! (hash-get h k) v).

> (def h (hash))
> (hash-get-set! h 2 "b")
> (hash-get h 2)
"b"
> (set! (hash-get h 2) "B")
> (hash-get h 2)
"B"

# hash-ref-set!

(hash-ref-set! h k v) -> (void)
(hash-ref-set! h k d v) -> (void)

hash-ref-set! is a variant of hash-put! that makes it possible to (set! (hash-ref h k) v) or (set! (hash-get h k default) v).

> (def h (hash))
> (hash-ref-set! h "a" 1)
> (hash-get h "a")
1
> (set! (hash-ref h "b") 2)
> (hash-get h "b")
2
> (defrules post-increment! () ((p x) (p x 1)) ((p x y ...) (begin0 x (set! x (+ x y ...)))))
> (post-increment! (hash-ref h "a") 10)
1
> (post-increment! (hash-ref h "a" 0))
11
> (post-increment! (hash-ref h "c" 0))
0
> (post-increment! (hash-ref h "c" 0))
1

# List utilities

(import :std/misc/list)

# length=?, length<? ... length>=?

(length=?  lst1 lst2) -> boolean
(length<?  lst1 lst2) -> boolean
(length<=? lst1 lst2) -> boolean
(length>?  lst1 lst2) -> boolean
(length>=? lst1 lst2) -> boolean

  lst1, lst2 := lists to compare

Compares the list lengths of both lst1 and lst2, and returns a truth value (#t or #f).

These functions are potentially more efficient because they only need to compare the lists up until the point where they start to differ from one another. They will short-circuit once they encounter a difference instead of calculating both lengths up-front.

Also, either of these two lists is allowed to be circular, but not both.

> (import :std/srfi/1)
> (def small (iota 10))   ; => (0 1 ... 9)
> (def large (iota 100))  ; => (0 1 ... 99)

> (length=? small large)
#f    ; comparison stops as soon as small runs out of elements

> (length<? large (circular-list 1 2 3))
#t    ; circular list never runs out of elements

> (length>=? (circular-list 0 1) [])
#t

# length=n?, length<n? ... length>=n?

(length=n?  lst n) -> boolean | error
(length<n?  lst n) -> boolean | error
(length<=n? lst n) -> boolean | error
(length>n?  lst n) -> boolean | error
(length>=n? lst n) -> boolean | error

  lst := list to compare
  n   := number

Checks how the length of lst compares to n and returns a truth value result (#t or #f). Signals an error when n isn't a valid number.

These functions are potentially more efficient because they only need to check the list for up to n elements instead of calculating lst's length up-front.

Also, lst is allowed to be circular.

> (length=n? [#\a #\b #\c] 3)
#t

> (import :std/srfi/1)
> (length>=n? (circular-list 0 1) 5)
#t

> (length<n? (circular-list 1 2 3) 10000)
#f    ; circular list never runs out of elements

# call-with-list-builder

(call-with-list-builder proc) -> list

  proc := procedure that takes two proc identifiers as input

Takes a procedure or lambda proc which itself takes two procedures that can have any name but are called put! and peek here:

• put! will append its input element onto an internal list (and thus modifies it) on each invocation.
• peek retrieves the elements collected so far, or [] if put! is never called.

Finally, call-with-list-builder returns the constructed list.

> (import :std/iter)
> (call-with-list-builder
    (lambda (put! peek)
      (for (x (in-range 5 10))
        (displayln (peek))
        (put! (random-integer (1+ x))))))
()           ; no prior put!
(5)
(5 6)
(5 6 2)
(5 6 2 8)    ; fifth explicit peek call
(5 6 2 8 6)  ; peek is called implicitly at the end

# with-list-builder

(with-list-builder (put! [peek]) body ...) -> list

  put! := function identifier that modifies internal list
  peek := optional function identifier that retrieves internal list

Syntax sugar for the call-with-list-builder procedure, so put! and peek can be used without wrapping them in a lambda first. with-list-builder returns the internal list at the end.

> (import :std/iter)
> (with-list-builder (put!)
    (for (n (in-iota 100 1))
      (let ((mod3 (zero? (modulo n 3)))
            (mod5 (zero? (modulo n 5))))
        (put! (cond ((and mod3 mod5) "fizzbuzz")
                    (mod3 "fizz")
                    (mod5 "buzz")
                    (else n))))))
(1 2 "fizz" 4 "buzz" "fizz" ... 97 98 "fizz" "buzz")

# snoc

(snoc elem lst) -> list | error

  elem := element to append to lst
  lst  := proper list

snoc is similar to cons, but appends elem at the end of lst instead of putting it at the front.

Different from cons: snoc will signal an error when lst is not a proper list. cons, in contrast, constructs a pair out of these two input values.

> (cons 4 [1 2 3])
(4 1 2 3)

> (snoc 4 [1 2 3])
(1 2 3 4)

> (cons 1 2)
(1 . 2)

> (snoc 1 2)
error    ; expects a list as second argument

> (snoc '(a b c) '())
((a b c))

# append1

(append1 lst elem) -> list | error

  lst  := proper list
  elem := element to append to lst

append1 is similar to append, but is constructing a proper list whereas the latter returns an improper list when appending a non-list elem to lst. append also joins two or more input lists while append1 simply adds the second list as-is.

Signals an error when lst is not a list.

> (append [1 2 3] 4)
(1 2 3 . 4)

> (append1 [1 2 3] 4)
(1 2 3 4)

> (append [1 2 3] [4 5 6])
(1 2 3 4 5 6)

> (append1 [1 2 3] [4 5 6])
(1 2 3 (4 5 6))

> (append1 "raise" "error")
error    ; expects a list as first argument

# for-each!

(for-each! lst proc) -> void

  lst  := proper or even improper list
  proc := procedure called for side-effects

for-each! is similar to for-each, but the arguments lst and proc are swapped which allows better nesting. Another slight difference: for-each! even accepts improper lists.

> (def exprs [[2 + 0] [2 - 0] [0 * 2] [2 / 0] [0 / 2]])

> (for-each (match <>
              ([x (eq? /) (? zero? y)]
               (displayln "div by zero!"))
              ([x op y]
               (displayln (op x y))))
            exprs)

> (for-each! exprs
    (match <>
      ([x (eq? /) (? zero? y)]
       (displayln "div by zero!"))
      ([x op y]
       (displayln (op x y)))))

;; both print:
2
2
0
div by zero!
0

> (for-each displayln '(1 2 . 3))
error    ; list expected

> (for-each! '(1 2 . 3) displayln)
1
2        ; dotted list ending not included

# push!

(push! elem lst) -> unspecified | error

  elem := element to cons onto lst
  lst  := list

Macro that conses elem onto lst and set!s lst accordingly. lst needs to be bound beforehand or it signals an error. It's unspecified what push! returns otherwise.

> (def lst [])
> (push! 10 lst)
> (push! 20 lst)
> (push! 30 lst)
> lst
(30 20 10)

> (def pair [#\b . #\a])
> (push! #\c pair)
> pair
(#\c #\b . #\a)

> (push! 1 [2 3])
error    ; uses set! internally, requires valid binding

# pop!

(pop! lst) -> #f | elem

  elem := first element from lst
  lst  := list, from which the first element will be removed

Macro that checks whether the lst is a cons cell, if so returns the car of that cons cell, and sets lst to the cdr of that cons cell, otherwise returns #f.

> (def lst [])
> (pop! lst)
#f
> (push! 10 lst)
> (push! 20 lst)
> (pop! lst)
20
> (pop! lst)
10
> (pop! lst)
#f

# flatten

(flatten lst) -> list

  lst := proper nested list-of-lists

Removes all layers of nesting from lst, which is expected to be a proper list-of-lists (or tree structure). It will ignore any empty lists it encounters while traversing, not adding them to the returned flattened list.

> (flatten [1 [2 3] [[4 5]]])
(1 2 3 4 5)

> (flatten [1 [] [2 [3 [] 4] 5]])
(1 2 3 4 5)  ; ignores empty sublists

> (flatten '((a . 1) (b . 2) (c . 3)))
(a b c)      ; expects proper non-dotted list-of-lists

# flatten1

(flatten1 lst) -> list | error

  lst := proper nested list-of-lists

flatten1 is a special variant of flatten which will not flatten the whole nested list-of-lists (or tree structure), but instead removes only a single layer of nesting from lst.

Note: lst is expected to be a list of proper lists, association lists will signal an error.

> (flatten1 [1 [2 3] [[4 5]]])
(1 2 3 (4 5))

> (flatten1 [1 [] [2 [3 [] 4] 5]])
(1 2 (3 () 4) 5)

> (import :std/srfi/1)
> (map (cut iota <>) [1 2 3 4]
((0) (0 1) (0 1 2) (0 1 2 3))
> (flatten (map (cut iota <>) [1 2 3 4]))
(0 0 1 0 1 2 0 1 2 3)

> (flatten1 '((a . 1) (b . 2) (c . 3)))
error    ; expects proper non-dotted list-of-lists

# unique

# unique!

(unique lst [test = equal?]) -> list

  lst  := proper list
  test := test procedure which takes two arguments, defaults to equal?

Alias for delete-duplicates and delete-duplicates! (SRFI 1).

> (unique [1 2 3 2])
(1 2 3)

> (let (lst [1 2])
    (unique [lst lst] ev?))
((1 2))

# duplicates

(duplicates lst [test = equal?] [key: #f]) -> list

  lst  := proper list
  test := test procedure which takes two arguments, defaults to equal?
  key  := optional unary procedure to get the to compare item out of a list element

duplicates returns a cons cells (item . count) for every element that occurs more than once in lst. If key: is not #f the unary procedure is applied to every element before comparison.

> (duplicates ['a 1 'a])
((a . 2))

> (duplicates [1 2 3])
()

> (duplicates '((a . 10) (b . 10)) key: cdr)
((10 . 2))

# rassoc

(rassoc elem alist [pred = eqv?]) -> pair | #f

  elem  := element to search for in alist
  alist := association list
  pred  := comparison predicate, optional

rassoc is similar to assoc, but instead of comparing elem with the first element of each pair in alist the optional predicate pred (which defaults to eqv?) will compare with the pair's second element.

Returns the first pair in alist whose cdr satisfies the predicate pred, or #f otherwise.

> (rassoc 2 '((a . 1) (b . 2) (c . 2) (d . 1)))
(b . 2)

> (rassoc "a" '((1 . "a") (2 . "b")))
#f       ; eqv? is used by default

> (rassoc "a" '((1 . "a") (2 . "b")) string=?)
(1 . "a")

> (rassoc '(5 6) '((a 1 2) (b 3 4) (c 5 6)) equal?)
(c 5 6)  ; equivalent to '(c . (5 6))

# when-list-or-empty

(when-list-or-empty lst body ...) -> body ... | []

  lst := value or list on which expansion depends

Macro which expands to body expressions only if lst is a non-empty list, otherwise an empty list is returned.

> (let (nums [1 2 3])
    (when-list-or-empty nums
      (cdr nums)))
(2 3)

> (when-list-or-empty []
    (cons "never" "expanded"))
()

# slice

(slice lst start [limit = #f]) -> list

  lst   := proper list
  start := start index
  limit := number of items to take from lst

Returns a list from lst, starting from the left at start, containing limit elements.

> (slice [1 2 3 4] 2)
(3 4)

> (slice [1 2 3 4] 2 1)
(3)

# slice-right

(slice-right lst start [limit = #f]) -> list

  lst   := proper list
  start := start index from the right of lst
  limit := number of items to take from lst

Returns a list from lst, starting from the right at start, containing limit elements.

> (slice-right [1 2 3 4] 2)
(1 2)

> (slice-right [1 2 3 4] 2 1)
(2)

# slice!

(slice! lst start [limit = #f]) -> list

  lst   := proper list
  start := start index
  limit := number of items to take from lst

Returns a sublist by potentially updating the input list lst. Starting from the left at start, containing limit elements.

> (def lst [1 2 3 4 5])
> (slice! lst 2 2)
(3 4)

# slice-right!

(slice-right! lst start [limit = #f]) -> list

  lst   := proper list
  start := start index from the right of lst
  limit := number of items to take from lst

Returns a sublist by potentially updating the input list lst. Starting from the right at start, containing limit elements.

> (def lst [1 2 3 4 5])
> (slice-right! lst 2 2)
(2 3)

# butlast

(butlast lst) -> list

  lst   := proper list

butlast returns a copy of the proper list lst, except the last element. When lst is empty, lst is returned as it is.

> (butlast [1 2 3])
(1 2)

> (butlast [])
()

# split

(split lst proc [limit = #f]) -> list

  lst   := proper list
  stop  := value or unary procedure
  limit := optional, split the list only limit times

split the list lst into a list-of-lists using the value or unary procedure stop. If limit is set, split the list only limit times.

(split '(1 2 "hi" 3 4) string?)
> ((1 2) (3 4))

(split [1 2 0 3 4 0 5 6] 0 1)
> ((1 2) (3 4 0 5 6))

(split [] number?)
> ()

# take-until

# take-until!

(take-until pred lst) -> list

  pred := predicate
  lst  := proper or circular list

take-until returns a list with all elements before pred returns #t. take-until! is the linear-update variant of take-until.

> (take-until number? ['a "hi" 1 'c])
(a "hi")

# drop-until

(drop-until pred lst) -> list

  pred := predicate
  lst  := proper or circular list

drop-until returns a list with all elements from the point on pred returns #t.

> (drop-until number? ['a [] "hi" 1 'c])
(1 c)

# group

(group lst [test = equal?]) -> list

  lst  := proper list
  test := optional, binary predicate

group consecutive elements of the list lst into a list-of-lists.

> (group [1 2 2 3 1 1])
((1) (2 2) (3) (1 1))

> (import :std/sort)
> (group (sort [1 2 2 3 1 1] <) eqv?)
((1 1 1) (2 2) (3))

# every-consecutive?

(every-consecutive? pred lst)

returns a boolean that is true if any two consecutive terms in the list satisfy the predicate. In particular, if the predicate is a partial order predicate (respectively a strict partial order predicate), then the list is totally ordered (respectively strictly totally ordered) according to the predicate.

> (every-consecutive? <= [1 2 2 3 10 100])
#t

> (every-consecutive? < [5 1 8 9])
#f

# first-and-only

(first-and-only lst)

returns the first and only value of a singleton list, or raises an error if the argument wasn't a singleton list.

> (first-and-only '(42))
42

> (first-and-only '())
*** ERROR IN std/misc/list#first-and-only, -515899390@648.11 -- Assertion failed (and (pair? x) (null? (cdr x)))

# A-List utilities

Utilities to manipulate alists, i.e. association lists, i.e. of key-value pairs.

(import :std/misc/alist)

# alist?

(alist? alist) -> boolean

  alist := association list to check

Checks whether alist is a proper association list and returns a truth value (#t or #f). alist needs to be finite, circular lists are not supported.

A proper association list is a list of pairs and may be of the following forms:

• ((key1 . value1) ...)
• ((key1 value1) ...)

> (alist? '((a . 1) (b . 2) (c . 3)))
#t

> (alist? [["one" #\1] ["two" #\2] ["three" #\3]])
#t

> (alist? '((a . 1) ("two" #\2) (1 2 3 4)))
#t    ; (1 2 3 4) is equivalent to (1 . (2 3 4))

> (alist? '(a 1 b 2 c 3))
#f    ; input is a plist, see plist? function

> (alist? '())
#t    ; edge-case, just like (list? '()) => #t

# plist->alist

(plist->alist plist) -> alist | error

  plist := property list to transform

Transforms a property list (k1 v1 k2 v2 ...) into an association list ((k1 . v1) (k2 . v2)...). plist needs to be finite, circular lists are not supported. Furthermore, an error is signaled when plist is a improper property list.

> (plist->alist [10 "cat" 11 "dog" 12 "bird"])
((10 . "cat") (11 . "dog") (12 . "bird"))

> (plist->alist ["semicolon" #\; "comma" #\, "dot"])
error    ; key "dot" has no associated property value

> (plist->alist [])
()

# assq-set!, assv-set!, assoc-set!

(asetq! alist key value)
(assq-set! key alist value)

(asetv! alist key value)
(assv-set! key alist value)

(aset! alist key value)
(assoc-set! key alist value)

These functions kind-of complement the assq, assv, assoc functions from the prelude, and enable the destructive update of an alist (association list), i.e. a association list that follows the [[key1 . value1] [key2 . value2] ... [keyN . valueN]], by either modifying in-place an entry with the given key, or adding a new entry. The functions all return #!void.

Just like the alist getter functions, these functions are distinguished by which equality predicate is used to compare keywords: eq?, eqv? or equal? respectively. eq? is best for keys being symbols and keywords, eqv? for numbers, and equal? for strings or lists, etc.

Each function comes in two variant: the first one accepts (asetq! alist key value) as the order of arguments, whereas the second one follows the convention so that you can use (set! (assq key alist) value) or (set! (assv key alist) value). Note that in the last case, assq, assv and assoc return a pair, whereas the setter functions take just the value as argument. That's why we say these setter functions only "kind-of" complement the respective getter functions.

Last but not least, destructive operations are not allowed on an empty alist. If you use aset! or its friends, you have to ensure your alists are never empty. For instance you may keep a dummy key at the end of your alist that never gets removed. If this constraint is not acceptable, you may instead storing your alist in a variable (or struct field), use the pure aset operation, and update the variable (or struct field) with the result of it.

(let (p [['a . 1]['b . 2]]) (asetq! p 'a 3) p)
> [['a . 3]['b . 2]]

(let (p [['a . 1]['b . 2]]) (asetq! p 'c 3) p)
> [['c . 3]['a . 1]['b . 4]]

# aremq!, aremv!, arem!

(aremq! key plist)
(aremv! key plist)
(arem! key plist)

These functions destructively modify an alist (association-list) to remove the entry for a given key. Just like the alist getter and setter functions, these functions are distinguished by which equality predicate is used to compare keywords: eq?, eqv? or equal? respectively. See aset! above about alists. The functions all return #!void.

It is not allowed to destructively remove the last entry in an alist. If you use arem! or its friends, you have to ensure your alists are never empty. For instance you may keep a dummy key at the end of your alist that never gets removed. If this constraint is not acceptable, you may instead storing your alist in a variable (or struct field), use the pure arem operation, and update the variable (or struct field) with the result of it.

(let (p [['a . 1]['b . 2]]) (aremq! 'a p) p)
> [['b . 2]]

(let (p [['a . 1]['b . 2]]) (arem! 'c p) p)
> [['a . 1]['b . 2]]

# acons

(acons k v alist) -> alst

  k := key
  v := value
  alist := association list
  alst := new association list with additional binding

Adds a new key-value pair to an existing alist in a pure way, a bit like aset. Unlike aset and its friends, however, acons does not try to replace older bindings for the same key, and will instead shadow them. This can cause performance issues if a same key is used a lot of times with acons, with the list growing ever longer; this can cause even more interesting correctness issues if arem is used subsequently used, which will remove only the most recent binding, revealing the previous one again, which may or may not be the desired behavior. Thus, we recommend only using acons when you otherwise know k is not yet bound in the alist.

acons is analogous to the same-named function from Common Lisp, and (acons k v l) is synonymous with (cons (cons k v) l).

> (acons 1 "a" '((2 . "b") (3 . "c")))
((1 . "a") (2 . "b") (3 . "c"))

> (acons 1 "a" '((1 . "b")))
((1 . "a") (1 . "b"))

# P-List utilities

Utilities to manipulate plists, i.e. property lists, i.e. even-length lists where each even-indexed element is a key, and each following odd-indexed element is the associated value.

(import :std/misc/plist)

# plist?

(plist? plist) -> boolean

  plist := property list to check

Checks whether plist is a proper property list and returns a truth value (#t or #f). plist needs to be finite, circular lists are not supported.

A proper property list is a list of alternating keys and values of the following form: ((key1 value1 key2 value2 ...))

> (plist? '(a 1 b 2 c 3 d 4))
#t

> (plist? ["uno" [1 2 3] "dos" [4 5 6] "tres" [7 8 9]])
#t

> (plist? '((a . 1) (b . 2)))
#t    ; key1 = (a . 1), value1 = (b . 2)

> (plist? '((a . 1) (b . 2) (c . 3)))
#f    ; key2 = (c . 3), but missing value2

> (plist? [])
#t    ; edge-case, just like (list? []) => #t

# alist->plist

(alist->plist alist) -> plist | error

  alist := association list to transform

Transforms an association list ((k1 . v1) (k2 . v2) ...) into a property list (k1 v1 k2 v2 ...). alist needs to be finite, circular lists are not supported. Furthermore, an error is signaled when alist is an improper association list.

> (alist->plist [[1 . 10] [2 . 20] [3 . 30]])
(1 10 2 20 3 30)

> (alist->plist [["fire" #\f] ["water" #\w] ["earth" #\e]])
("fire" (#\f) "water" (#\w) "earth" (#\e))

> (alist->plist '((1 2 3) (4 5 6) (7 8 9)))
(1 (2 3) 4 (5 6) 7 (8 9))

> (alist->plist '((a) (b) (c)))
(a () b () c ())

> (alist->plist [])
()

# psetq!, psetv!, pset!, pgetq-set!, pgetv-set!, pget-set!

(psetq! plist key value)
(pgetq-set! key plist [default] value)

(psetv! plist key value)
(psetv-set! key plist [default] value)

(pset! plist key value)
(pset-set! key plist [default] value)

These functions complement the pgetq, pgetv, pget functions from the prelude, and enable the destructive update of a plist (property-list), i.e. a association list that follows the [key1 value1 key2 value2 ... keyN valueN], by either modifying in-place an entry with the given key, or adding a new entry. The functions all return #!void.

Just like the plist getter functions, these functions are distinguished by which equality predicate is used to compare keywords: eq?, eqv? or equal? respectively. eq? is best for keys being symbols and keywords, eqv? for numbers, and equal? for strings or lists, etc.

Each function comes in two variant: the first one accepts (psetq! plist key value) as the order of arguments, whereas the second one follows the convention so that you can use (set! (pgetq key plist) value) or (set! (pgetq key plist default) value). In the last case, the default value is ignored, but accepted for compatibility with macros that use both a getter then a setter for a same expression.

Last but not least, destructive operations are not allowed on an empty plist. If you use pset! or its friends, you have to ensure your plists are never empty. For instance you may keep a dummy key at the end of your plist that never gets removed. If this constraint is not acceptable, you may instead storing your plist in a variable (or struct field), use the pure pset operation, and update the variable (or struct field) with the result of it.

(let (p ['a 1 'b 2]) (psetq! p 'a 3) p)
> ['a 3 'b 2]

(let (p ['a 1 'b 2]) (psetq! p 'c 3) p)
> ['c 3 'a 1 'b 4]

# premq!, premv!, prem!

(premq! key plist)
(premv! key plist)
(prem! key plist)

These functions destructively modify a plist (property-list) to remove the entry for a given key. Just like the plist getter and setter functions, these functions are distinguished by which equality predicate is used to compare keywords: eq?, eqv? or equal? respectively. See pset! above about plists. The functions all return #!void.

It is not allowed to destructively remove the last entry in a plist. If you use prem! or its friends, you have to ensure your plists are never empty. For instance you may keep a dummy key at the end of your plist that never gets removed. If this constraint is not acceptable, you may instead storing your plist in a variable (or struct field), use the pure prem operation, and update the variable (or struct field) with the result of it.

(let (p ['a 1 'b 2]) (premq! 'a p) p)
> ['b 2]

(let (p ['a 1 'b 2]) (prem! 'c p) p)
> ['a 1 'b 2]

# LRU caches

(import :std/misc/lru)

# make-lru-cache

(make-lru-cache cap) -> lru-cache | error

  cap := max capacity of cache, fixnum

Creates a new empty Least Recently Used (LRU) cache, a cache replacement data structure, which tracks element usage and drops seldom used ones when full to make room for new elements. cap is the capacity, i.e., the number of elements the cache can hold before purging older entries. cap needs to be at least 1, otherwise an error is signaled.

> (def lru (make-lru-cache 3))
> (lru-cache-put! lru 'a "heavy-load-01")
> (lru-cache-put! lru 'b "heavy-load-02")
> (lru-cache-put! lru 'c "heavy-load-03")
> (lru-cache-put! lru 'd "heavy-load-04")
> (lru-cache-put! lru 'e "heavy-load-05")
> (lru-cache-size lru)
3                  ; cache full, older entries are eviced first:
> (lru-cache->list lru)
((e . "heavy-load-05") (d . "heavy-load-04") (c . "heavy-load-03"))
> (lru-cache-get lru 'c)
"heavy-load-03"    ; cache hit, bring to front:
> (lru-cache->list lru)
((c . "heavy-load-03") (e . "heavy-load-05") (d . "heavy-load-04"))

> (import :std/iter)
> (for ((values key load) lru)
    (displayln "key: " key ", load: " load))
key: c, load: heavy-load-03
key: e, load: heavy-load-05
key: d, load: heavy-load-04

# lru-cache?

(lru-cache? lru) -> boolean

  lru := lru-cache to check

Returns #t if lru is an LRU cache, #f otherwise.

> (lru-cache? (make-lru-cache 25))
#t

# lru-cache-size

(lru-cache-size lru) -> fixnum

  lru := lru-cache to check

Returns the current size (i.e., the number of elements the LRU cache holds, not the capacity) of lru.

> (let (lru (make-lru-cache 3))
    (lru-cache-put! lru 1 #x01)
    (lru-cache-put! lru 2 #x02)
    (lru-cache-size lru))
2

> (lru-cache-size (make-lru-cache 1000))
0

# lru-cache-capacity

(lru-cache-capacity lru) -> fixnum

  lru := lru-cache to check

Returns the maximum number of elements lru can hold.

> (let (lru (make-lru-cache 3))
    (lru-cache-put! lru 1 #x01)
    (lru-cache-put! lru 2 #x02)
    (lru-cache-capacity lru))
3

> (lru-cache-capacity (make-lru-cache 1000))
1000

# lru-cache-put!

(lru-cache-put! lru key val) -> void

  lru      := lru-cache
  key, val := key-value association to insert into lru

Puts an association of key to val into lru, in the queue head position to be precise. If the cache is full, then the tail of the LRU queue (i.e., the value least recently used) is dropped from the cache.

> (defstruct resource (raw-data))
> (make-lru-cache 3)
#<lru-cache #35>
> (lru-cache-put! #35 1 (make-resource 'HUGE))
> (lru-cache-put! #35 2 (make-resource 'SMALL))
> (lru-cache-put! #35 3 (make-resource 'LARGE))
> (lru-cache->list #35)
((3 . #<resource #36>) (2 . #<resource #37>) (1 . #<resource #38>))
> (lru-cache-put! #35 4 'non-resource)    ; cache is full, evict old element
> (lru-cache->list #35)
((4 . non-resource) (3 . #<resource #36>) (2 . #<resource #37>))
> (resource-raw-data #38)
HUGE

# lru-cache-remove!

(lru-cache-remove! lru key) -> void

  lru := lru-cache to remove from
  key := key to look up

Removes the association of key from lru, making room for a new element in the lru cache.

> (make-lru-cache 3)
#<lru-cache #39>
> (lru-cache-put! #39 1 "this")
> (lru-cache-put! #39 1 "that")    ; same key, simply updated
> (lru-cache->list #39)
((1 . "that"))
> (lru-cache-remove! #39 1)
> (lru-cache->list #39)
()

# lru-cache-ref

(lru-cache-ref lru key [default = absent-obj]) -> any | default | error

  lru     := lru-cache to access
  key     := key to look up
  default := optional element returned when key can't be found

Returns the association of key in lru, and promotes the node to the head of the LRU queue. If there is no association, then default is returned. If the default is omitted, then an error is raised.

> (let (lru (make-lru-cache 3))
    (lru-cache-put! lru 'a "file-a")
    (lru-cache-put! lru 'b "file-b")
    (lru-cache-put! lru 'c "file-c")
    (displayln (lru-cache->list lru))
    (displayln (lru-cache-ref lru 'b 'NONE))
    (displayln (lru-cache->list lru))
    (lru-cache-ref lru 'd 'NONE))
((c . file-c) (b . file-b) (a . file-a))
file-b
((b . file-b) (c . file-c) (a . file-a))
NONE

# lru-cache-get

(lru-cache-ref lru key) -> any | #f

  lru := lru-cache to access
  key := key to look up

Same as (lru-cache-ref lru key #f).

> (lru-cache-get (make-lru-cache 3) 'not-in-here)
#f

# lru-cache-flush!

(lru-cache-flush! lru) -> lru-cache

  lru := lru-cache to clear

Removes all elements from lru and returns the empty LRU cache. The capacity remains unchanged.

> (let (lru (make-lru-cache 100))
    (lru-cache-put! lru "first"  '1st)
    (lru-cache-put! lru "second" '2nd)
    (lru-cache-put! lru "third"  '3rd)
    (displayln (lru-cache-size lru) " " (lru-cache-capacity lru))
    (displayln (lru-cache-flush! lru))
    (displayln (lru-cache-size lru) " " (lru-cache-capacity lru)))
3 100
#<lru-cache #12>
0 100

# lru-cache-for-each

(lru-cache-for-each proc lru) -> void

  proc := procedure to be called for each key-value pair in lru
  lru  := lru-cache

Applies (proc key val) for every key-value association in lru, in Most Recently Used (MRU) order. Isn't returning anything, executed for its side effects.

> (make-lru-cache 3)
#<lru-cache #43>
> (for-each (lambda (x) (lru-cache-put! #43 x (* x x))) [1 2 3 4 5])
> (lru-cache-for-each (lambda (k v) (displayln k " " v)) #43)
5 25
4 16
3 9

# lru-cache-walk

(lru-cache-walk proc lru) -> void

  proc := procedure to be called for each key-value pair in lru
  lru  := lru cache

Same as (lru-cache-for-each proc lru).

# lru-cache-fold

(lru-cache-fold proc init lru) -> any

  proc := procedure to be called for each key-value pair in lru
  init := initial value
  lru  := lru-cache

Folds lru in Most Recently Used (MRU) order.

proc's signature is expected to look like this: (proc key val prev-intermediate) -> next-intermediate). lru-cache-fold returns the last next-intermediate value produced by proc. Furthermore, prev-intermediate will be set to init at the beginning.

> (let (lru (make-lru-cache 3))
    (lru-cache-put! lru 'a "creatures")
    (lru-cache-put! lru 'b "fluffy")
    (lru-cache-put! lru 'c "are")
    (lru-cache-fold (lambda (k v i) (string-append i " " v))
                    "gerbils" lru))
"gerbils are fluffy creatures"

# lru-cache-foldr

(lru-cache-foldr proc init lru) -> any

  proc := procedure to be called for each key-value pair in lru
  init := initial value
  lru  := lru-cache

Where lru-cache-fold folds in Most Recently Used (MRU) order, lru-cache-foldr folds lru in Least Recently Used (LRU) order.

> (let (lru (make-lru-cache 5))
    (lru-cache-put! lru 'a (iota 5))
    (lru-cache-put! lru 'b (iota 4))
    (lru-cache-put! lru 'c (iota 3))
    (lru-cache-fold (lambda (k v i) (cons v i)) [] lru))
((0 1 2 3 4) (0 1 2 3) (0 1 2))

# lru-cache->list

(lru-cache->list lru) -> alist

  lru := lru-cache

Returns an alist of key-value associations in lru, in Most Recently Used (MRU) order.

> (import :std/srfi/14)
> (make-lru-cache 10)
#<lru-cache #47>
> (for-each (cut lru-cache-put! #47 <> <>) (iota 10) (char-set->list char-set:letter))
> (lru-cache->list #47)
((9 . #\J)
 (8 . #\I)
 (7 . #\H)
 (6 . #\G)
 (5 . #\F)
 (4 . #\E)
 (3 . #\D)
 (2 . #\C)
 (1 . #\B)
 (0 . #\A))

# in-lru-cache

(in-lru-cache lru) -> iterator

  lru := lru-cache to iterate over

Creates an iterator over lru, yielding key-value values in Most Recently Used (MRU) order.

> (import :std/iter)
> (let (lru (make-lru-cache 3))
    (lru-cache-put! lru 1 #\a)
    (lru-cache-put! lru 2 #\b)
    (lru-cache-put! lru 3 #\c)
    (for ((values k v) (in-lru-cache lru))    ; or short: (for ((values k v) lru) ...)
      (displayln k " -> " v)))
3 -> c
2 -> b
1 -> a

# in-lru-cache-keys

(in-lru-cache-keys lru) -> iterator

  lru := lru-cache to iterate over

Creates an iterator over lru, yielding keys in Most Recently Used (MRU) order.

> (import :std/iter)
> (let (lru (make-lru-cache 3))
    (lru-cache-put! lru 1 #\a)
    (lru-cache-put! lru 2 #\b)
    (lru-cache-put! lru 3 #\c)
    (for (x (in-lru-cache-keys lru))
      (displayln x)))
3
2
1

# in-lru-cache-values

(in-lru-cache-values lru) -> iterator

  lru := lru-cache to iterate over

Creates an iterator over lru, yielding values in Most Recently Used (MRU) order.

> (import :std/iter)
> (let (lru (make-lru-cache 3))
    (lru-cache-put! lru 1 #\a)
    (lru-cache-put! lru 2 #\b)
    (lru-cache-put! lru 3 #\c)
    (for (x (in-lru-cache-values lru))
      (displayln x)))
c
b
a

# lru-cache

(defsyntax lru-cache)

LRU cache type for user-defined generics and destructuring.

;; possible lru-cache iterator implementation:
(defmethod (:iter (lru lru-cache))
  (in-lru-cache lru))

(def (in-lru-cache lru)
  (def (iterate)
    (lru-cache-for-each yield lru))
  (in-coroutine iterate))

# Port utilities

(import :std/misc/ports)

# copy-port

(copy-port in out) -> void | error

  in  := input port to read from
  out := output port to write to

Copy all data from port in to port out. Signals an error when in and out aren't satisfying input-port? and output-port?, respectively.

> (def nums (string-join (map number->string [1 2 3 4 5]) "\n" 'suffix))
> (call-with-output-file "~/testing/nums.txt"
    (lambda (out)
      (call-with-input-string nums
        (lambda (in) (copy-port in out)))))

$ cat ~/testing/nums.txt    ; unix-like command-line
1
2
3
4
5

> (copy-port (current-input-port) (current-output-port))
hello,
hello,       ; duplicates what you type at the REPL
everyone!
everyone!    ; quit with Ctrl-D

# read-all-as-string

(read-all-as-string in) -> string | error

  in := input port to read from

Reads all the contents of port in, returning a single string including all newline characters. Signals an error when in can't be read.

> (import :std/srfi/13)
> (with-input-from-file "~/dev/gerbil/CHANGELOG.md"
    (lambda ()
      (string-take (read-all-as-string (current-input-port)) 80)))
"### 2-9-2019: Gerbil-v0.15.1\n\nPatch release to support Gambit v4.9.3\n\nDetails:\n-"

# read-all-as-lines

(read-all-as-lines in [separator: #\newline] [include-separator?: #f]) -> list | error

  in                 := input port to read from
  separator          := character to consider line ending
  include-separator? := truth value, whether to include separator char in results

Reads all the contents of port in as a list of strings. The optional separator related keyword parameters specify what is considered a line ending and whether to include these separator characters in the line strings. Signals an error when in can't be read.

> (import :std/srfi/1)
> (take (call-with-input-file "~/dev/gerbil/README.md" read-all-as-lines) 4)
("# Gerbil Scheme"
 ""
 "Gerbil is an opinionated dialect of Scheme designed for Systems Programming,"
 "with a state of the art macro and module system on top of the Gambit runtime.")

> (with-input-from-string "aa:bb:cc:dd::ff"
    (lambda () (read-all-as-lines (current-input-port) separator: #\:)))
("aa" "bb" "cc" "dd" "" "ff")

# read-file-string

(read-file-string path) -> string | error

  path := path to file to read contents from

Reads contents of the file at path, returning a single string including all newline characters. Signals an error when path can't be read.

Note: There is another optional settings keyword parameter not shown above, but it's not terribly interesting for this file reading procedure. Check section 17.7.1 Filesystem devices of the Gambit Manual if you want to know more.

$ cat ~/testing/nums.txt    ; unix-like command-line
1
2
3
4
5

(map string->number
     (string-split (read-file-string "~/testing/nums.txt") #\newline))
(1 2 3 4 5)

# read-file-lines

(read-file-lines path) -> list | error

  path := path to file to read contents from

Reads all lines of the file at path as a list of strings. Signals an error when path can't be read.

Note: There is another optional settings keyword parameter not shown above, but it's not terribly interesting for this file reading procedure. Check section 17.7.1 Filesystem devices of the Gambit Manual if you want to know more.

$ cat ~/testing/nums.txt    ; unix-like command-line
1
2
3
4
5

> (read-file-lines "~/testing/nums.txt")
("1" "2" "3" "4" "5")

;; Advent of code 2018, problem 01a: Sum a file of around 1000 exact integer values.
$ head -n5 ~/dev/aoc18/01/input.txt
+12
-13
+17
+17
-10

> (apply + (map string->number (read-file-lines "~/dev/aoc18/01/input.txt")))
508

# read-all-as-u8vector

(read-all-as-u8vector in (bufsize 8192)) -> u8vector | error

  in      := input port to read from
  bufsize := buffer size, defaults to 8192 bytes

Reads all the contents of port in, returning a single u8vector. Signals an error when in can't be read.

> (def u8 (call-with-input-file "/path/to/file" read-all-as-u8vector))
> (u8vector-length u8)
98526

# read-file-u8vector

(read-file-u8vector path settings: [] bufsize: 8192) -> u8vector | error

  path     := path to file to read contents from
  settings := port settings, defaults to the empty list
  bufsize  := buffer size, defaults to 8192 bytes

Reads contents of the file at path, returning a single u8vector. Signals an error when path can't be read.

Check section 17.7.1 Filesystem devices of the Gambit Manual if you want to know more about the settings parameter.

> (def u8 (read-file-u8vector "/path/to/file" bufsize: 1024))
> (u8vector-length u8)
98526

# write-file-string

(write-file-string file string settings: [] newline-ending: #t) -> void | error

  file           := the file to be written to
  string         := the string to write
  settings       := Gambit path-settings (default [])
  newline-ending := append newline if last character is not a newline (default #t)

Write string to file using the display procedure. Check section 17.7.1 Filesystem devices of the Gambit Manual if you want to know more about the settings parameter.

;; write "Hello, world!\n" to /tmp/foo.txt (may overwrite an existing file)
(write-file-string "/tmp/foo.txt" "Hello, world!")  ; \n is appended automatically

;; by using a path-setting we can append a string to an existing file
(write-file-string "/tmp/foo.txt" "hi" settings: [append: #t])

;; the file content is now: "Hello, world!\nhi\n"

;; let's append another string without auto-enforcement of a newline ending
(write-file-string "/tmp/foo.txt" "ho" settings: [append: #t] newline-ending: #f)

;; the final file content is: "Hello, world!\nhi\nho"  ; no trail newline character