shirok

;; -*- coding:utf-8 -*-
(use srfi-60) ; integer->list

;; "3:5b8" -> ((#f #t #f) (#t #t #f) (#t #t #t))
(define (parse input)
  (rxmatch-let (#/^(\d+):([\da-fA-F]+)/ input) (_ ssize data)
    (let1 size (x->integer ssize)
      ($ (cut take <> size) $ (cut slices <> size)
         $ integer->list (string->number data 16) (* 4 (string-length data))))))

shirok

(use util.match)
(use srfi-1)

(define-macro (def proc . xs)
  (let loop ([xs xs] [clauses '()])
    (if (null? xs)
      `(define ,proc (match-lambda* ,@(reverse clauses)))
      (receive (args rest) (break ($ eq? '-> $) xs)
        (loop (cddr rest)
              (cons (list args (cadr rest)) clauses))))))

shirok

(use gauche.generator)
;
#|
Scheme:generatorとdoとwhile
http://practical-scheme.net/wiliki/wiliki.cgi?Scheme%3agenerator%e3%81%a8do%e3%81%a8while#H-17qe7ru
|#
(define (generator-generate proc)
  (define next #f)
  (define return #f)
  (lambda ()

shirok

(use gauche.sequence)
(use math.prime)

(define (goedel n)
  ($ fold (^[p k s] (* s (expt p k))) 1 *primes*
     $ map digit->integer $ number->string n))

(define meertens
  (let1 n 0
    (rec (f) (inc! n) (if (= n (goedel n)) n (f)))))

shirok

(define %word ($->rope ($do [h ($one-of #[A-Za-z_$])]
                            [t ($many-chars #[A-Za-z0-9_$])]
                            ($return (cons h t)))))

(define %key ($or %word %string))

(define %object
  (let1 %member ($do [k %key] %ws
                     %name-separator
                     [v %value]

shirok

(defmacro def-coords-macro (kind)
  (let ((with-coords (intern (format nil "WITH-~a-COORDS" kind)))
        (checking    (intern (format nil "CHECKING-~a-COORDS" kind)))
        (box         (intern (format nil "BOX-~a" kind)))
        (unbox       (intern (format nil "UNBOX-~a" kind))))
    `(progn
       (defmacro ,box (v) `(cons ',',kind ,v))
       (defmacro ,unbox (v)
         (let ((vv (gensym)))
           `(let ((,vv ,v))

shirok

(define (copy-instance obj)
  (rlet1 new (make (class-of obj))
    (dolist [slot (class-slots (class-of obj))]
      (set! (~ new (slot-definition-name slot))
            (~ obj (slot-definition-name slot))))))

shirok

diff --git a/configure.ac b/configure.ac
index aa17d7c..d0f37ef 100644
--- a/configure.ac
+++ b/configure.ac
@@ -199,6 +199,12 @@ case $GAUCHE_THREAD_TYPE in
       THREADDLLIBS="-lpthread -lrt"
       GAUCHE_THREAD_TYPE=pthreads
       ;;
+    *-*-openbsd*)
+      AC_DEFINE(GC_OPENBSD_THREADS,1,[Define to use OpenBSD threads])

shirok

(define (rxmatch-substrings match)
  (if match
    (map (cut rxmatch-substring match <>) (iota (rxmatch-num-matches match)))
    '()))
(define (rxmatch-indices match)
  (if match
    (map (^i (cons (rxmatch-start match i) (rxmatch-end match i)))
         (iota (rxmatch-num-matches match)))
    '()))

shirok

diff --git a/makiki.scm b/makiki.scm
index 82d260b..2c8b302 100644
--- a/makiki.scm
+++ b/makiki.scm
@@ -564,29 +564,26 @@
         (cond [(null? uvs) dest]
               [else (u8vector-copy! dest pos (car uvs))
                     (loop (+ pos (u8vector-length (car uvs))) (cdr uvs))]))))
-  (define (header+content vec)
-    (let* ([p (open-input-uvector vec)]