picrin/load_piclib.c

/**
 *                                !!NOTICE!!
 * This file was automatically generated by mkloader.pl, and includes all of
 * the prelude files required by Picrin. PLEASE DO NOT EDIT THIS FILE, changes
 * will be overwritten the next time the script runs.
 */

#include "picrin.h"
#include "picrin/error.h"

static const char *piclib_src__Users_yuichi_workspace_picrin_piclib_picrin_base =
"(define-library (picrin base)\n"
"  (import (rename (picrin base core) (define define*))\n"
"          (picrin base macro)\n"
"          (picrin base list)\n"
"          (picrin base symbol))\n"
"\n"
"  (define-syntax define\n"
"    (lambda (form use-env mac-env)\n"
"      (if (symbol? (car (cdr form)))\n"
"          (cons (make-identifier 'define* mac-env) (cdr form))\n"
"          (cons (make-identifier 'define mac-env)\n"
"                (cons (car (car (cdr form)))\n"
"                      (cons (cons (make-identifier 'lambda mac-env)\n"
"                                  (cons (cdr (car (cdr form)))\n"
"                                        (cdr (cdr form))))\n"
"                            '()))))))\n"
"\n"
"  (export define\n"
"          set!\n"
"          quote\n"
"          lambda\n"
"          if\n"
"          begin\n"
"          define-syntax))\n"
;

static const char *piclib_src__Users_yuichi_workspace_picrin_piclib_picrin_list =
"(define-library (picrin list)\n"
"  (import (picrin base list))\n"
"\n"
"  (export pair?\n"
"          cons\n"
"          car\n"
"          cdr\n"
"          set-car!\n"
"          set-cdr!\n"
"          null?\n"
"          caar\n"
"          cadr\n"
"          cdar\n"
"          cddr\n"
"          list?\n"
"          make-list\n"
"          list\n"
"          length\n"
"          append\n"
"          reverse\n"
"          list-tail\n"
"          list-ref\n"
"          list-set!\n"
"          list-copy\n"
"          memq\n"
"          memv\n"
"          member\n"
"          assq\n"
"          assv\n"
"          assoc))\n"
;

static const char *piclib_src__Users_yuichi_workspace_picrin_piclib_picrin_symbol =
"(define-library (picrin symbol)\n"
"  (import (picrin base symbol))\n"
"\n"
"  (export symbol?\n"
"          symbol=?\n"
"          symbol->string\n"
"          string->symbol))\n"
;

static const char *piclib_src__Users_yuichi_workspace_picrin_piclib_picrin_macro =
";;; Hygienic Macros\n"
"\n"
"(define-library (picrin macro)\n"
"  (import (picrin base macro)\n"
"          (picrin base)\n"
"          (picrin list)\n"
"          (picrin symbol)\n"
"          (scheme base)\n"
"          (picrin dictionary))\n"
"\n"
"  ;; assumes no derived expressions are provided yet\n"
"\n"
"  (define (walk proc expr)\n"
"    \"walk on symbols\"\n"
"    (if (null? expr)\n"
"        '()\n"
"        (if (pair? expr)\n"
"            (cons (walk proc (car expr))\n"
"                  (walk proc (cdr expr)))\n"
"            (if (vector? expr)\n"
"                (list->vector (walk proc (vector->list expr)))\n"
"                (if (symbol? expr)\n"
"                    (proc expr)\n"
"                    expr)))))\n"
"\n"
"  (define (memoize f)\n"
"    \"memoize on symbols\"\n"
"    (define cache (make-dictionary))\n"
"    (lambda (sym)\n"
"      (if (dictionary-has? cache sym)\n"
"          (dictionary-ref cache sym)\n"
"          (begin\n"
"            (define val (f sym))\n"
"            (dictionary-set! cache sym val)\n"
"            val))))\n"
"\n"
"  (define (identifier=? env1 sym1 env2 sym2)\n"
"\n"
"    (define (resolve sym env)\n"
"      (define x (make-identifier sym env))\n"
"      (define y (make-identifier sym env))\n"
"      (if (eq? x y)\n"
"          x\n"
"          sym))          ; resolved to no variable\n"
"\n"
"    (eq? (resolve sym1 env1)\n"
"         (resolve sym2 env2)))\n"
"\n"
"  (define (make-syntactic-closure env free form)\n"
"\n"
"    (define resolve\n"
"      (memoize\n"
"       (lambda (sym)\n"
"         (make-identifier sym env))))\n"
"\n"
"    (walk\n"
"     (lambda (sym)\n"
"       (if (memq sym free)\n"
"           sym\n"
"           (resolve sym)))\n"
"     form))\n"
"\n"
"  (define (close-syntax form env)\n"
"    (make-syntactic-closure env '() form))\n"
"\n"
"  (define-syntax capture-syntactic-environment\n"
"    (lambda (form use-env mac-env)\n"
"      (list (cadr form) (list (make-identifier 'quote mac-env) mac-env))))\n"
"\n"
"  (define (sc-macro-transformer f)\n"
"    (lambda (expr use-env mac-env)\n"
"      (make-syntactic-closure mac-env '() (f expr use-env))))\n"
"\n"
"  (define (rsc-macro-transformer f)\n"
"    (lambda (expr use-env mac-env)\n"
"      (make-syntactic-closure use-env '() (f expr mac-env))))\n"
"\n"
"  (define (er-macro-transformer f)\n"
"    (lambda (expr use-env mac-env)\n"
"\n"
"      (define rename\n"
"        (memoize\n"
"         (lambda (sym)\n"
"           (make-identifier sym mac-env))))\n"
"\n"
"      (define (compare x y)\n"
"        (if (not (symbol? x))\n"
"            #f\n"
"            (if (not (symbol? y))\n"
"                #f\n"
"                (identifier=? use-env x use-env y))))\n"
"\n"
"      (f expr rename compare)))\n"
"\n"
"  (define (ir-macro-transformer f)\n"
"    (lambda (expr use-env mac-env)\n"
"\n"
"      (define icache* (make-dictionary))\n"
"\n"
"      (define inject\n"
"        (memoize\n"
"         (lambda (sym)\n"
"           (define id (make-identifier sym use-env))\n"
"           (dictionary-set! icache* id sym)\n"
"           id)))\n"
"\n"
"      (define rename\n"
"        (memoize\n"
"         (lambda (sym)\n"
"           (make-identifier sym mac-env))))\n"
"\n"
"      (define (compare x y)\n"
"        (if (not (symbol? x))\n"
"            #f\n"
"            (if (not (symbol? y))\n"
"                #f\n"
"                (identifier=? mac-env x mac-env y))))\n"
"\n"
"      (walk (lambda (sym)\n"
"              (if (dictionary-has? icache* sym)\n"
"                  (dictionary-ref icache* sym)\n"
"                  (rename sym)))\n"
"            (f (walk inject expr) inject compare))))\n"
"\n"
"  (define (strip-syntax form)\n"
"    (walk ungensym form))\n"
"\n"
"  (define-syntax define-macro\n"
"    (er-macro-transformer\n"
"     (lambda (expr r c)\n"
"       (define formal (car (cdr expr)))\n"
"       (define body   (cdr (cdr expr)))\n"
"       (if (symbol? formal)\n"
"           (list (r 'define-syntax) formal\n"
"                 (list (r 'lambda) (list (r 'form) '_ '_)\n"
"                       (list (r 'apply) (car body) (list (r 'cdr) (r 'form)))))\n"
"           (list (r 'define-macro) (car formal)\n"
"                 (cons (r 'lambda)\n"
"                       (cons (cdr formal)\n"
"                             body)))))))\n"
"\n"
"  (export identifier?\n"
"          identifier=?\n"
"          make-identifier\n"
"          make-syntactic-closure\n"
"          close-syntax\n"
"          capture-syntactic-environment\n"
"          sc-macro-transformer\n"
"          rsc-macro-transformer\n"
"          er-macro-transformer\n"
"          ir-macro-transformer\n"
"          strip-syntax\n"
"          define-macro))\n"
;

static const char *piclib_src__Users_yuichi_workspace_picrin_piclib_scheme_base =
"(define-library (scheme base)\n"
"  (import (picrin base)\n"
"          (picrin list)\n"
"          (picrin symbol)\n"
"          (picrin macro))\n"
"\n"
"  (export define set! lambda quote\n"
"          if begin define-syntax)\n"
"\n"
"  ;; core syntax\n"
"\n"
"  (define-syntax syntax-error\n"
"    (er-macro-transformer\n"
"     (lambda (expr rename compare)\n"
"       (apply error (cdr expr)))))\n"
"\n"
"  (define-syntax define-auxiliary-syntax\n"
"    (er-macro-transformer\n"
"     (lambda (expr r c)\n"
"       (list (r 'define-syntax) (cadr expr)\n"
"             (list (r 'lambda) '_\n"
"                   (list (r 'error) \"invalid use of auxiliary syntax\"))))))\n"
"\n"
"  (define-auxiliary-syntax else)\n"
"  (define-auxiliary-syntax =>)\n"
"  (define-auxiliary-syntax _)\n"
"  (define-auxiliary-syntax ...)\n"
"  (define-auxiliary-syntax unquote)\n"
"  (define-auxiliary-syntax unquote-splicing)\n"
"\n"
"  (define-syntax let\n"
"    (er-macro-transformer\n"
"     (lambda (expr r compare)\n"
"       (if (symbol? (cadr expr))\n"
"           (begin\n"
"             (define name     (car (cdr expr)))\n"
"             (define bindings (car (cdr (cdr expr))))\n"
"             (define body     (cdr (cdr (cdr expr))))\n"
"             (list (r 'let) '()\n"
"                   (list (r 'define) name\n"
"                         (cons (r 'lambda) (cons (map car bindings) body)))\n"
"                   (cons name (map cadr bindings))))\n"
"           (begin\n"
"             (set! bindings (cadr expr))\n"
"             (set! body (cddr expr))\n"
"             (cons (cons (r 'lambda) (cons (map car bindings) body))\n"
"                   (map cadr bindings)))))))\n"
"\n"
"  (define-syntax cond\n"
"    (er-macro-transformer\n"
"     (lambda (expr r compare)\n"
"       (let ((clauses (cdr expr)))\n"
"         (if (null? clauses)\n"
"             #f\n"
"             (begin\n"
"               (define clause (car clauses))\n"
"               (if (compare (r 'else) (car clause))\n"
"                   (cons (r 'begin) (cdr clause))\n"
"                   (if (if (>= (length clause) 2)\n"
"                           (compare (r '=>) (list-ref clause 1))\n"
"                           #f)\n"
"                       (list (r 'let) (list (list (r 'x) (car clause)))\n"
"                             (list (r 'if) (r 'x)\n"
"                                   (list (list-ref clause 2) (r 'x))\n"
"                                   (cons (r 'cond) (cdr clauses))))\n"
"                       (list (r 'if) (car clause)\n"
"                             (cons (r 'begin) (cdr clause))\n"
"                             (cons (r 'cond) (cdr clauses)))))))))))\n"
"\n"
"  (define-syntax and\n"
"    (er-macro-transformer\n"
"     (lambda (expr r compare)\n"
"       (let ((exprs (cdr expr)))\n"
"         (cond\n"
"          ((null? exprs)\n"
"           #t)\n"
"          ((= (length exprs) 1)\n"
"           (car exprs))\n"
"          (else\n"
"           (list (r 'let) (list (list (r 'it) (car exprs)))\n"
"                 (list (r 'if) (r 'it)\n"
"                       (cons (r 'and) (cdr exprs))\n"
"                       (r 'it)))))))))\n"
"\n"
"  (define-syntax or\n"
"    (er-macro-transformer\n"
"     (lambda (expr r compare)\n"
"       (let ((exprs (cdr expr)))\n"
"         (cond\n"
"          ((null? exprs)\n"
"           #t)\n"
"          ((= (length exprs) 1)\n"
"           (car exprs))\n"
"          (else\n"
"           (list (r 'let) (list (list (r 'it) (car exprs)))\n"
"                 (list (r 'if) (r 'it)\n"
"                       (r 'it)\n"
"                       (cons (r 'or) (cdr exprs))))))))))\n"
"\n"
"  (define-syntax quasiquote\n"
"    (ir-macro-transformer\n"
"     (lambda (form inject compare)\n"
"\n"
"       (define (quasiquote? form)\n"
"         (and (pair? form) (compare (car form) 'quasiquote)))\n"
"\n"
"       (define (unquote? form)\n"
"         (and (pair? form) (compare (car form) 'unquote)))\n"
"\n"
"       (define (unquote-splicing? form)\n"
"         (and (pair? form) (pair? (car form))\n"
"              (compare (car (car form)) 'unquote-splicing)))\n"
"\n"
"       (define (qq depth expr)\n"
"         (cond\n"
"          ;; unquote\n"
"          ((unquote? expr)\n"
"           (if (= depth 1)\n"
"               (car (cdr expr))\n"
"               (list 'list\n"
"                     (list 'quote (inject 'unquote))\n"
"                     (qq (- depth 1) (car (cdr expr))))))\n"
"          ;; unquote-splicing\n"
"          ((unquote-splicing? expr)\n"
"           (if (= depth 1)\n"
"               (list 'append\n"
"                     (car (cdr (car expr)))\n"
"                     (qq depth (cdr expr)))\n"
"               (list 'cons\n"
"                     (list 'list\n"
"                           (list 'quote (inject 'unquote-splicing))\n"
"                           (qq (- depth 1) (car (cdr (car expr)))))\n"
"                     (qq depth (cdr expr)))))\n"
"          ;; quasiquote\n"
"          ((quasiquote? expr)\n"
"           (list 'list\n"
"                 (list 'quote (inject 'quasiquote))\n"
"                 (qq (+ depth 1) (car (cdr expr)))))\n"
"          ;; list\n"
"          ((pair? expr)\n"
"           (list 'cons\n"
"                 (qq depth (car expr))\n"
"                 (qq depth (cdr expr))))\n"
"          ;; vector\n"
"          ((vector? expr)\n"
"           (list 'list->vector (qq depth (vector->list expr))))\n"
"          ;; simple datum\n"
"          (else\n"
"           (list 'quote expr))))\n"
"\n"
"       (let ((x (cadr form)))\n"
"         (qq 1 x)))))\n"
"\n"
"  (define-syntax let*\n"
"    (er-macro-transformer\n"
"     (lambda (form r compare)\n"
"       (let ((bindings (cadr form))\n"
"             (body (cddr form)))\n"
"         (if (null? bindings)\n"
"             `(,(r 'let) () ,@body)\n"
"             `(,(r 'let) ((,(caar bindings)\n"
"                           ,@(cdar bindings)))\n"
"               (,(r 'let*) (,@(cdr bindings))\n"
"                ,@body)))))))\n"
"\n"
"  (define-syntax letrec*\n"
"    (er-macro-transformer\n"
"     (lambda (form r compare)\n"
"       (let ((bindings (cadr form))\n"
"             (body (cddr form)))\n"
"         (let ((vars (map (lambda (v) `(,v #f)) (map car bindings)))\n"
"               (initials (map (lambda (v) `(,(r 'set!) ,@v)) bindings)))\n"
"           `(,(r 'let) (,@vars)\n"
"             ,@initials\n"
"             ,@body))))))\n"
"\n"
"  (define-syntax letrec\n"
"    (er-macro-transformer\n"
"     (lambda (form rename compare)\n"
"       `(,(rename 'letrec*) ,@(cdr form)))))\n"
"\n"
"  (define-syntax do\n"
"    (er-macro-transformer\n"
"     (lambda (form r compare)\n"
"       (let ((bindings (car (cdr form)))\n"
"             (finish   (car (cdr (cdr form))))\n"
"             (body     (cdr (cdr (cdr form)))))\n"
"         `(,(r 'let) ,(r 'loop) ,(map (lambda (x)\n"
"                                        (list (car x) (cadr x)))\n"
"                                      bindings)\n"
"           (,(r 'if) ,(car finish)\n"
"            (,(r 'begin) ,@(cdr finish))\n"
"            (,(r 'begin) ,@body\n"
"             (,(r 'loop) ,@(map (lambda (x)\n"
"                                  (if (null? (cddr x))\n"
"                                      (car x)\n"
"                                      (car (cddr x))))\n"
"                                bindings)))))))))\n"
"\n"
"  (define-syntax when\n"
"    (er-macro-transformer\n"
"     (lambda (expr rename compare)\n"
"       (let ((test (cadr expr))\n"
"             (body (cddr expr)))\n"
"         `(,(rename 'if) ,test\n"
"              (,(rename 'begin) ,@body)\n"
"              #f)))))\n"
"\n"
"  (define-syntax unless\n"
"    (er-macro-transformer\n"
"     (lambda (expr rename compare)\n"
"       (let ((test (cadr expr))\n"
"             (body (cddr expr)))\n"
"         `(,(rename 'if) ,test\n"
"              #f\n"
"              (,(rename 'begin) ,@body))))))\n"
"\n"
"  (define-syntax case\n"
"    (er-macro-transformer\n"
"     (lambda (expr r compare)\n"
"       (let ((key (cadr expr))\n"
"             (clauses (cddr expr)))\n"
"         `(,(r 'let) ((,(r 'key) ,key))\n"
"            ,(let loop ((clauses clauses))\n"
"               (if (null? clauses)\n"
"                   #f\n"
"                   (begin\n"
"                     (define clause (car clauses))\n"
"                     `(,(r 'if) ,(if (compare (r 'else) (car clause))\n"
"                                     '#t\n"
"                                     `(,(r 'or)\n"
"                                       ,@(map (lambda (x)\n"
"                                                `(,(r 'eqv?) ,(r 'key) (,(r 'quote) ,x)))\n"
"                                              (car clause))))\n"
"                       ,(if (compare (r '=>) (list-ref clause 1))\n"
"                            `(,(list-ref clause 2) ,(r 'key))\n"
"                            `(,(r 'begin) ,@(cdr clause)))\n"
"                       ,(loop (cdr clauses)))))))))))\n"
"\n"
"  (define-syntax letrec-syntax\n"
"    (er-macro-transformer\n"
"     (lambda (form r c)\n"
"       (let ((formal (car (cdr form)))\n"
"             (body   (cdr (cdr form))))\n"
"         `(let ()\n"
"            ,@(map (lambda (x)\n"
"                     `(,(r 'define-syntax) ,(car x) ,(cadr x)))\n"
"                   formal)\n"
"            ,@body)))))\n"
"\n"
"  (define-syntax let-syntax\n"
"    (er-macro-transformer\n"
"     (lambda (form r c)\n"
"       `(,(r 'letrec-syntax) ,@(cdr form)))))\n"
"\n"
"  (import (scheme read) (scheme file))\n"
"\n"
"  (define-syntax include\n"
"    (letrec ((read-file\n"
"              (lambda (filename)\n"
"                (let ((port (open-input-file filename)))\n"
"                  (dynamic-wind\n"
"                      (lambda () #f)\n"
"                      (lambda ()\n"
"                        (let loop ((expr (read port)) (exprs '()))\n"
"                          (if (eof-object? expr)\n"
"                              (reverse exprs)\n"
"                              (loop (read port) (cons expr exprs)))))\n"
"                      (lambda ()\n"
"                        (close-port port)))))))\n"
"      (er-macro-transformer\n"
"       (lambda (form rename compare)\n"
"         (let ((filenames (cdr form)))\n"
"           (let ((exprs (apply append (map read-file filenames))))\n"
"             `(,(rename 'begin) ,@exprs)))))))\n"
"\n"
"  (export let let* letrec letrec*\n"
"          quasiquote unquote unquote-splicing\n"
"          and or\n"
"          cond case else =>\n"
"          do when unless\n"
"          let-syntax letrec-syntax\n"
"          include\n"
"          _ ... syntax-error)\n"
"\n"
"\n"
"  ;; utility functions\n"
"\n"
"  (define (walk proc expr)\n"
"    (cond\n"
"     ((null? expr)\n"
"      '())\n"
"     ((pair? expr)\n"
"      (cons (walk proc (car expr))\n"
"            (walk proc (cdr expr))))\n"
"     ((vector? expr)\n"
"      (list->vector (map proc (vector->list expr))))\n"
"     (else\n"
"      (proc expr))))\n"
"\n"
"  (define (flatten expr)\n"
"    (let ((list '()))\n"
"      (walk\n"
"       (lambda (x)\n"
"         (set! list (cons x list)))\n"
"       expr)\n"
"      (reverse list)))\n"
"\n"
"  (define (reverse* l)\n"
"    ;; (reverse* '(a b c d . e)) => (e d c b a)\n"
"    (let loop ((a '())\n"
"	       (d l))\n"
"      (if (pair? d)\n"
"	  (loop (cons (car d) a) (cdr d))\n"
"	  (cons d a))))\n"
"\n"
"  (define (every? pred l)\n"
"    (if (null? l)\n"
"	#t\n"
"	(and (pred (car l)) (every? pred (cdr l)))))\n"
"\n"
"\n"
"  ;; extra syntax\n"
"\n"
"  (define-syntax let*-values\n"
"    (er-macro-transformer\n"
"     (lambda (form r c)\n"
"       (let ((formals (cadr form)))\n"
"         (if (null? formals)\n"
"             `(,(r 'let) () ,@(cddr form))\n"
"             `(,(r 'call-with-values) (,(r 'lambda) () ,@(cdar formals))\n"
"               (,(r 'lambda) (,@(caar formals))\n"
"                (,(r 'let*-values) (,@(cdr formals))\n"
"                 ,@(cddr form)))))))))\n"
"\n"
"  (define-syntax let-values\n"
"    (er-macro-transformer\n"
"     (lambda (form r c)\n"
"       `(,(r 'let*-values) ,@(cdr form)))))\n"
"\n"
"  (define uniq\n"
"    (let ((counter 0))\n"
"      (lambda (x)\n"
"        (let ((sym (string->symbol (string-append \"var$\" (number->string counter)))))\n"
"          (set! counter (+ counter 1))\n"
"          sym))))\n"
"\n"
"  (define-syntax define-values\n"
"    (ir-macro-transformer\n"
"     (lambda (form inject compare)\n"
"       (let* ((formal  (cadr form))\n"
"              (formal* (walk uniq formal))\n"
"              (exprs   (cddr form)))\n"
"         `(begin\n"
"            ,@(map\n"
"               (lambda (var) `(define ,var #f))\n"
"               (flatten formal))\n"
"            (call-with-values (lambda () ,@exprs)\n"
"              (lambda ,formal*\n"
"                ,@(map\n"
"                   (lambda (var val) `(set! ,var ,val))\n"
"                   (flatten formal)\n"
"                   (flatten formal*)))))))))\n"
"\n"
"  (export let-values\n"
"          let*-values\n"
"          define-values)\n"
"\n"
"  (define-syntax syntax-rules\n"
"    (er-macro-transformer\n"
"     (lambda (form r compare)\n"
"       (define _define (r 'define))\n"
"       (define _let (r 'let))\n"
"       (define _if (r 'if))\n"
"       (define _begin (r 'begin))\n"
"       (define _lambda (r 'lambda))\n"
"       (define _set! (r 'set!))\n"
"       (define _not (r 'not))\n"
"       (define _and (r 'and))\n"
"       (define _car (r 'car))\n"
"       (define _cdr (r 'cdr))\n"
"       (define _cons (r 'cons))\n"
"       (define _pair? (r 'pair?))\n"
"       (define _null? (r 'null?))\n"
"       (define _symbol? (r 'symbol?))\n"
"       (define _vector? (r 'vector?))\n"
"       (define _eqv? (r 'eqv?))\n"
"       (define _string=? (r 'string=?))\n"
"       (define _map (r 'map))\n"
"       (define _vector->list (r 'vector->list))\n"
"       (define _list->vector (r 'list->vector))\n"
"       (define _quote (r 'quote))\n"
"       (define _quasiquote (r 'quasiquote))\n"
"       (define _unquote (r 'unquote))\n"
"       (define _unquote-splicing (r 'unquote-splicing))\n"
"       (define _syntax-error (r 'syntax-error))\n"
"       (define _call/cc (r 'call/cc))\n"
"       (define _er-macro-transformer (r 'er-macro-transformer))\n"
"\n"
"       (define (var->sym v)\n"
"         (let loop ((cnt 0)\n"
"                    (v v))\n"
"           (if (symbol? v)\n"
"               (string->symbol\n"
"                (string-append (symbol->string v) \"/\" (number->string cnt)))\n"
"               (loop (+ 1 cnt) (car v)))))\n"
"\n"
"       (define push-var list)\n"
"\n"
"       (define (compile-match ellipsis literals pattern)\n"
"	 (letrec ((compile-match-base\n"
"		   (lambda (pattern)\n"
"		     (cond ((member pattern literals compare)\n"
"			    (values\n"
"			     `(,_if (,_and (,_symbol? expr) (cmp expr (rename ',pattern)))\n"
"				    #f\n"
"				    (exit #f))\n"
"			     '()))\n"
"			   ((compare pattern (r '_)) (values #f '()))\n"
"			   ((and ellipsis (compare pattern ellipsis))\n"
"			    (values `(,_syntax-error \"invalid pattern\") '()))\n"
"			   ((symbol? pattern)\n"
"			    (values `(,_set! ,(var->sym pattern) expr) (list pattern)))\n"
"			   ((pair? pattern)\n"
"			    (compile-match-list pattern))\n"
"			   ((vector? pattern)\n"
"			    (compile-match-vector pattern))\n"
"			   ((string? pattern)\n"
"			    (values\n"
"			     `(,_if (,_not (,_string=? ',pattern expr))\n"
"				    (exit #f))\n"
"			     '()))\n"
"			   (else\n"
"			    (values\n"
"			     `(,_if (,_not (,_eqv? ',pattern expr))\n"
"				    (exit #f))\n"
"			     '())))))\n"
"\n"
"		  (compile-match-list\n"
"		   (lambda (pattern)\n"
"		     (let loop ((pattern pattern)\n"
"				(matches '())\n"
"				(vars '())\n"
"				(accessor 'expr))\n"
"		       (cond ;; (hoge)\n"
"			((not (pair? (cdr pattern)))\n"
"			 (let*-values (((match1 vars1) (compile-match-base (car pattern)))\n"
"				       ((match2 vars2) (compile-match-base (cdr pattern))))\n"
"			   (values\n"
"			    `(,_begin ,@(reverse matches)\n"
"				      (,_if (,_pair? ,accessor)\n"
"					    (,_begin\n"
"					     (,_let ((expr (,_car ,accessor)))\n"
"						    ,match1)\n"
"					     (,_let ((expr (,_cdr ,accessor)))\n"
"						    ,match2))\n"
"					    (exit #f)))\n"
"			    (append vars (append vars1 vars2)))))\n"
"			;; (hoge ... rest args)\n"
"			((and ellipsis (compare (cadr pattern) ellipsis))\n"
"			 (let-values (((match-r vars-r) (compile-match-list-reverse pattern)))\n"
"			   (values\n"
"			    `(,_begin ,@(reverse matches)\n"
"				      (,_let ((expr (,_let loop ((a ())\n"
"								 (d ,accessor))\n"
"							   (,_if (,_pair? d)\n"
"								 (loop (,_cons (,_car d) a) (,_cdr d))\n"
"								 (,_cons d a)))))\n"
"					     ,match-r))\n"
"			    (append vars vars-r))))\n"
"			(else\n"
"			 (let-values (((match1 vars1) (compile-match-base (car pattern))))\n"
"			   (loop (cdr pattern)\n"
"				 (cons `(,_if (,_pair? ,accessor)\n"
"					      (,_let ((expr (,_car ,accessor)))\n"
"						     ,match1)\n"
"					      (exit #f))\n"
"				       matches)\n"
"				 (append vars vars1)\n"
"				 `(,_cdr ,accessor))))))))\n"
"\n"
"		  (compile-match-list-reverse\n"
"		   (lambda (pattern)\n"
"		     (let loop ((pattern (reverse* pattern))\n"
"				(matches '())\n"
"				(vars '())\n"
"				(accessor 'expr))\n"
"		       (cond ((and ellipsis (compare (car pattern) ellipsis))\n"
"			      (let-values (((match1 vars1) (compile-match-ellipsis (cadr pattern))))\n"
"				(values\n"
"				 `(,_begin ,@(reverse matches)\n"
"					   (,_let ((expr ,accessor))\n"
"						  ,match1))\n"
"				 (append vars vars1))))\n"
"			     (else\n"
"			      (let-values (((match1 vars1) (compile-match-base (car pattern))))\n"
"				(loop (cdr pattern)\n"
"				      (cons `(,_let ((expr (,_car ,accessor))) ,match1) matches)\n"
"				      (append vars vars1)\n"
"				      `(,_cdr ,accessor))))))))\n"
"\n"
"		  (compile-match-ellipsis\n"
"		   (lambda (pattern)\n"
"		     (let-values (((match vars) (compile-match-base pattern)))\n"
"		       (values\n"
"			`(,_let loop ((expr expr))\n"
"				(,_if (,_not (,_null? expr))\n"
"				      (,_let ,(map (lambda (var) `(,(var->sym var) '())) vars)\n"
"					     (,_let ((expr (,_car expr)))\n"
"						    ,match)\n"
"					     ,@(map\n"
"						(lambda (var)\n"
"						  `(,_set! ,(var->sym (push-var var))\n"
"							   (,_cons ,(var->sym var) ,(var->sym (push-var var)))))\n"
"						vars)\n"
"					     (loop (,_cdr expr)))))\n"
"			(map push-var vars)))))\n"
"\n"
"		  (compile-match-vector\n"
"		   (lambda (pattern)\n"
"		     (let-values (((match vars) (compile-match-base (vector->list pattern))))\n"
"		       (values\n"
"			`(,_if (,_vector? expr)\n"
"			       (,_let ((expr (,_vector->list expr)))\n"
"				      ,match)\n"
"			       (exit #f))\n"
"			vars)))))\n"
"\n"
"	   (let-values (((match vars) (compile-match-base (cdr pattern))))\n"
"	     (values `(,_let ((expr (,_cdr expr)))\n"
"			     ,match\n"
"			     #t)\n"
"		     vars))))\n"
"\n"
"       ;;; compile expand\n"
"       (define (compile-expand ellipsis reserved template)\n"
"	 (letrec ((compile-expand-base\n"
"		   (lambda (template ellipsis-valid)\n"
"		     (cond ((member template reserved eq?)\n"
"			    (values (var->sym template) (list template)))\n"
"			   ((symbol? template)\n"
"			    (values `(rename ',template) '()))\n"
"			   ((pair? template)\n"
"			    (compile-expand-list template ellipsis-valid))\n"
"			   ((vector? template)\n"
"			    (compile-expand-vector template ellipsis-valid))\n"
"			   (else\n"
"			    (values `',template '())))))\n"
"\n"
"		  (compile-expand-list\n"
"		   (lambda (template ellipsis-valid)\n"
"		     (let loop ((template template)\n"
"				(expands '())\n"
"				(vars '()))\n"
"		       (cond ;; (... hoge)\n"
"			((and ellipsis-valid\n"
"			      (pair? template)\n"
"			      (compare (car template) ellipsis))\n"
"			 (if (and (pair? (cdr template)) (null? (cddr template)))\n"
"			     (compile-expand-base (cadr template) #f)\n"
"			     (values '(,_syntax-error \"invalid template\") '())))\n"
"			;; hoge\n"
"			((not (pair? template))\n"
"			 (let-values (((expand1 vars1)\n"
"				       (compile-expand-base template ellipsis-valid)))\n"
"			   (values\n"
"			    `(,_quasiquote (,@(reverse expands) . (,_unquote ,expand1)))\n"
"			    (append vars vars1))))\n"
"			;; (a ... rest syms)\n"
"			((and ellipsis-valid\n"
"			      (pair? (cdr template))\n"
"			      (compare (cadr template) ellipsis))\n"
"			 (let-values (((expand1 vars1)\n"
"				       (compile-expand-base (car template) ellipsis-valid)))\n"
"			   (loop (cddr template)\n"
"				 (cons\n"
"				  `(,_unquote-splicing\n"
"				    (,_map (,_lambda ,(map var->sym vars1) ,expand1)\n"
"					   ,@(map (lambda (v) (var->sym (push-var v))) vars1)))\n"
"				  expands)\n"
"				 (append vars (map push-var vars1)))))\n"
"			(else\n"
"			 (let-values (((expand1 vars1)\n"
"				       (compile-expand-base (car template) ellipsis-valid)))\n"
"			   (loop (cdr template)\n"
"				 (cons\n"
"				  `(,_unquote ,expand1)\n"
"				  expands)\n"
"				 (append vars vars1))))))))\n"
"\n"
"		  (compile-expand-vector\n"
"		   (lambda (template ellipsis-valid)\n"
"		     (let-values (((expand1 vars1)\n"
"				   (compile-expand-base (vector->list template) ellipsis-valid)))\n"
"		       (values\n"
"			`(,_list->vector ,expand1)\n"
"			vars1)))))\n"
"\n"
"	   (compile-expand-base template ellipsis)))\n"
"\n"
"       (define (check-vars vars-pattern vars-template)\n"
"	 ;;fixme\n"
"	 #t)\n"
"\n"
"       (define (compile-rule ellipsis literals rule)\n"
"	 (let ((pattern (car rule))\n"
"	       (template (cadr rule)))\n"
"	   (let*-values (((match vars-match)\n"
"			  (compile-match ellipsis literals pattern))\n"
"			 ((expand vars-expand)\n"
"			  (compile-expand ellipsis (flatten vars-match) template)))\n"
"	     (if (check-vars vars-match vars-expand)\n"
"		 (list vars-match match expand)\n"
"		 'mismatch))))\n"
"\n"
"       (define (expand-clauses clauses rename)\n"
"	 (cond ((null? clauses)\n"
"		`(,_quote (syntax-error \"no matching pattern\")))\n"
"	       ((compare (car clauses) 'mismatch)\n"
"		`(,_syntax-error \"invalid rule\"))\n"
"	       (else\n"
"		(let ((vars (list-ref (car clauses) 0))\n"
"		      (match (list-ref (car clauses) 1))\n"
"		      (expand (list-ref (car clauses) 2)))\n"
"		  `(,_let ,(map (lambda (v) (list (var->sym v) '())) vars)\n"
"			  (,_let ((result (,_call/cc (,_lambda (exit) ,match))))\n"
"				 (,_if result\n"
"				       ,expand\n"
"				       ,(expand-clauses (cdr clauses) rename))))))))\n"
"\n"
"       (define (normalize-form form)\n"
"	 (if (and (list? form) (>= (length form) 2))\n"
"	     (let ((ellipsis '...)\n"
"		   (literals (cadr form))\n"
"		   (rules (cddr form)))\n"
"\n"
"	       (when (symbol? literals)\n"
"		     (set! ellipsis literals)\n"
"		     (set! literals (car rules))\n"
"		     (set! rules (cdr rules)))\n"
"\n"
"	       (if (and (symbol? ellipsis)\n"
"			(list? literals)\n"
"			(every? symbol? literals)\n"
"			(list? rules)\n"
"			(every? (lambda (l) (and (list? l) (= (length l) 2))) rules))\n"
"		   (if (member ellipsis literals compare)\n"
"		       `(syntax-rules #f ,literals ,@rules)\n"
"		       `(syntax-rules ,ellipsis ,literals ,@rules))\n"
"		   #f))\n"
"	     #f))\n"
"\n"
"       (let ((form (normalize-form form)))\n"
"	 (if form\n"
"	     (let ((ellipsis (list-ref form 1))\n"
"		   (literals (list-ref form 2))\n"
"		   (rules (list-tail form 3)))\n"
"	       (let ((clauses (map (lambda (rule) (compile-rule ellipsis literals rule))\n"
"				   rules)))\n"
"		 `(,_er-macro-transformer\n"
"		   (,_lambda (expr rename cmp)\n"
"			     ,(expand-clauses clauses r)))))\n"
"\n"
"	     `(,_syntax-error \"malformed syntax-rules\"))))))\n"
"\n"
"  (export syntax-rules)\n"
"\n"
"\n"
"  ;; 4.2.6. Dynamic bindings\n"
"\n"
"  (import (picrin parameter))\n"
"\n"
"  (define-syntax parameterize\n"
"    (ir-macro-transformer\n"
"     (lambda (form inject compare)\n"
"       (let ((formal (car (cdr form)))\n"
"             (body   (cdr (cdr form))))\n"
"         (let ((vars (map car formal))\n"
"               (vals (map cadr formal)))\n"
"           `(begin\n"
"              ,@(map (lambda (var val) `(parameter-push! ,var ,val)) vars vals)\n"
"              (let ((result (begin ,@body)))\n"
"                ,@(map (lambda (var) `(parameter-pop! ,var)) vars)\n"
"                result)))))))\n"
"\n"
"  (export parameterize make-parameter)\n"
"\n"
"\n"
"  ;; 4.2.7. Exception handling\n"
"\n"
"  (define-syntax guard-aux\n"
"    (syntax-rules (else =>)\n"
"      ((guard-aux reraise (else result1 result2 ...))\n"
"       (begin result1 result2 ...))\n"
"      ((guard-aux reraise (test => result))\n"
"       (let ((temp test))\n"
"         (if temp\n"
"             (result temp)\n"
"             reraise)))\n"
"      ((guard-aux reraise (test => result)\n"
"                  clause1 clause2 ...)\n"
"       (let ((temp test))\n"
"         (if temp\n"
"             (result temp)\n"
"             (guard-aux reraise clause1 clause2 ...))))\n"
"      ((guard-aux reraise (test))\n"
"       (or test reraise))\n"
"      ((guard-aux reraise (test) clause1 clause2 ...)\n"
"       (let ((temp test))\n"
"         (if temp\n"
"             temp\n"
"             (guard-aux reraise clause1 clause2 ...))))\n"
"      ((guard-aux reraise (test result1 result2 ...))\n"
"       (if test\n"
"           (begin result1 result2 ...)\n"
"           reraise))\n"
"      ((guard-aux reraise\n"
"                  (test result1 result2 ...)\n"
"                  clause1 clause2 ...)\n"
"       (if test\n"
"           (begin result1 result2 ...)\n"
"           (guard-aux reraise clause1 clause2 ...)))))\n"
"\n"
"  (define-syntax guard\n"
"    (syntax-rules ()\n"
"      ((guard (var clause ...) e1 e2 ...)\n"
"       ((call/cc\n"
"         (lambda (guard-k)\n"
"           (with-exception-handler\n"
"            (lambda (condition)\n"
"              ((call/cc\n"
"                (lambda (handler-k)\n"
"                  (guard-k\n"
"                   (lambda ()\n"
"                     (let ((var condition))\n"
"                       (guard-aux\n"
"                        (handler-k\n"
"                         (lambda ()\n"
"                           (raise-continuable condition)))\n"
"                        clause ...))))))))\n"
"            (lambda ()\n"
"              (call-with-values\n"
"                  (lambda () e1 e2 ...)\n"
"                (lambda args\n"
"                  (guard-k\n"
"                   (lambda ()\n"
"                     (apply values args)))))))))))))\n"
"\n"
"  (export guard)\n"
"\n"
"  ;; 5.5 Recored-type definitions\n"
"\n"
"  (import (picrin record)\n"
"          (scheme write))\n"
"\n"
"  (define ((default-record-writer ctor) obj)\n"
"    (let ((port (open-output-string)))\n"
"      (display \"#.(\" port)\n"
"      (display (car ctor) port)\n"
"      (for-each\n"
"       (lambda (field)\n"
"         (display \" \" port)\n"
"         (write (record-ref obj field) port))\n"
"       (cdr ctor))\n"
"      (display \")\" port)\n"
"      (get-output-string port)))\n"
"\n"
"  (define ((boot-make-record-type <meta-type>) name ctor)\n"
"    (let ((rectype (make-record <meta-type>)))\n"
"      (record-set! rectype 'name name)\n"
"      (record-set! rectype 'writer (default-record-writer ctor))\n"
"      rectype))\n"
"\n"
"  (define <record-type>\n"
"    (let ((<record-type>\n"
"           ((boot-make-record-type #t) 'record-type '(record-type name writer))))\n"
"      (record-set! <record-type> '@@type <record-type>)\n"
"      <record-type>))\n"
"\n"
"  (define make-record-type (boot-make-record-type <record-type>))\n"
"\n"
"  (define-syntax define-record-constructor\n"
"    (ir-macro-transformer\n"
"     (lambda (form inject compare?)\n"
"       (let ((rectype (car (cdr form)))\n"
"	     (name    (car (cdr (cdr form))))\n"
"	     (fields  (cdr (cdr (cdr form)))))\n"
"	 `(define (,name ,@fields)\n"
"	    (let ((record (make-record ,rectype)))\n"
"	      ,@(map (lambda (field)\n"
"		       `(record-set! record ',field ,field))\n"
"		     fields)\n"
"	      record))))))\n"
"\n"
"  (define-syntax define-record-predicate\n"
"    (ir-macro-transformer\n"
"     (lambda (form inject compare?)\n"
"       (let ((rectype (car (cdr form)))\n"
"	     (name    (car (cdr (cdr form)))))\n"
"	 `(define (,name obj)\n"
"	    (and (record? obj)\n"
"		 (eq? (record-type obj)\n"
"                      ,rectype)))))))\n"
"\n"
"  (define-syntax define-record-field\n"
"    (ir-macro-transformer\n"
"     (lambda (form inject compare?)\n"
"       (let ((pred       (car (cdr form)))\n"
"	     (field-name (car (cdr (cdr form))))\n"
"	     (accessor   (car (cdr (cdr (cdr form)))))\n"
"	     (modifier?  (cdr (cdr (cdr (cdr form))))))\n"
"	 (if (null? modifier?)\n"
"	     `(define (,accessor record)\n"
"		(if (,pred record)\n"
"		    (record-ref record ',field-name)\n"
"		    (error \"wrong record type\" record)))\n"
"	     `(begin\n"
"		(define (,accessor record)\n"
"		  (if (,pred record)\n"
"		      (record-ref record ',field-name)\n"
"		      (error \"wrong record type\" record)))\n"
"		(define (,(car modifier?) record val)\n"
"		  (if (,pred record)\n"
"		      (record-set! record ',field-name val)\n"
"		      (error \"wrong record type\" record)))))))))\n"
"\n"
"  (define-syntax define-record-type\n"
"    (ir-macro-transformer\n"
"     (lambda (form inject compare?)\n"
"       (let ((name   (car (cdr form)))\n"
"	     (ctor   (car (cdr (cdr form))))\n"
"	     (pred   (car (cdr (cdr (cdr form)))))\n"
"	     (fields (cdr (cdr (cdr (cdr form))))))\n"
"	 `(begin\n"
"	    (define ,name (make-record-type ',name ',ctor))\n"
"	    (define-record-constructor ,name ,@ctor)\n"
"	    (define-record-predicate ,name ,pred)\n"
"	    ,@(map (lambda (field) `(define-record-field ,pred ,@field))\n"
"		   fields))))))\n"
"\n"
"  (export define-record-type)\n"
"\n"
"  ;; 6.4 Pairs and lists\n"
"\n"
"  (export pair?\n"
"          cons\n"
"          car\n"
"          cdr\n"
"          set-car!\n"
"          set-cdr!\n"
"          null?\n"
"          caar\n"
"          cadr\n"
"          cdar\n"
"          cddr\n"
"          list?\n"
"          make-list\n"
"          list\n"
"          length\n"
"          append\n"
"          reverse\n"
"          list-tail\n"
"          list-ref\n"
"          list-set!\n"
"          list-copy\n"
"          memq\n"
"          memv\n"
"          member\n"
"          assq\n"
"          assv\n"
"          assoc)\n"
"\n"
"  ;; 6.5 Symbols\n"
"\n"
"  (export symbol?\n"
"          symbol=?\n"
"          symbol->string\n"
"          string->symbol)\n"
"\n"
"  ;; 6.6 Characters\n"
"\n"
"  (define-macro (define-char-transitive-predicate name op)\n"
"    `(define (,name . cs)\n"
"       (apply ,op (map char->integer cs))))\n"
"\n"
"  (define-char-transitive-predicate char=? =)\n"
"  (define-char-transitive-predicate char<? <)\n"
"  (define-char-transitive-predicate char>? >)\n"
"  (define-char-transitive-predicate char<=? <=)\n"
"  (define-char-transitive-predicate char>=? >=)\n"
"\n"
"  (export char=?\n"
"          char<?\n"
"          char>?\n"
"          char<=?\n"
"          char>=?)\n"
"\n"
"  ;; 6.7 String\n"
"\n"
"  (define (string->list string . opts)\n"
"    (let ((start (if (pair? opts) (car opts) 0))\n"
"          (end (if (>= (length opts) 2)\n"
"                   (cadr opts)\n"
"                   (string-length string))))\n"
"      (do ((i start (+ i 1))\n"
"           (res '()))\n"
"          ((= i end)\n"
"           (reverse res))\n"
"        (set! res (cons (string-ref string i) res)))))\n"
"\n"
"  (define (list->string list)\n"
"    (let ((len (length list)))\n"
"      (let ((v (make-string len)))\n"
"        (do ((i 0 (+ i 1))\n"
"             (l list (cdr l)))\n"
"            ((= i len)\n"
"             v)\n"
"          (string-set! v i (car l))))))\n"
"\n"
"  (define (string . objs)\n"
"    (list->string objs))\n"
"\n"
"  (export string string->list list->string)\n"
"\n"
"  ;; 6.8. Vector\n"
"\n"
"  (define (vector . objs)\n"
"    (list->vector objs))\n"
"\n"
"  (define (vector->string . args)\n"
"    (list->string (apply vector->list args)))\n"
"\n"
"  (define (string->vector . args)\n"
"    (list->vector (apply string->list args)))\n"
"\n"
"  (export vector vector->string string->vector)\n"
"\n"
"  ;; 6.9 bytevector\n"
"\n"
"  (define (bytevector->list v start end)\n"
"    (do ((i start (+ i 1))\n"
"         (res '()))\n"
"        ((= i end)\n"
"         (reverse res))\n"
"      (set! res (cons (bytevector-u8-ref v i) res))))\n"
"\n"
"  (define (list->bytevector list)\n"
"    (let ((len (length list)))\n"
"      (let ((v (make-bytevector len)))\n"
"        (do ((i 0 (+ i 1))\n"
"             (l list (cdr l)))\n"
"            ((= i len)\n"
"             v)\n"
"          (bytevector-u8-set! v i (car l))))))\n"
"\n"
"  (define (bytevector . objs)\n"
"    (list->bytevector objs))\n"
"\n"
"  (define (utf8->string v . opts)\n"
"    (let ((start (if (pair? opts) (car opts) 0))\n"
"          (end (if (>= (length opts) 2)\n"
"                   (cadr opts)\n"
"                   (bytevector-length v))))\n"
"      (list->string (map integer->char (bytevector->list v start end)))))\n"
"\n"
"  (define (string->utf8 s . opts)\n"
"    (let ((start (if (pair? opts) (car opts) 0))\n"
"          (end (if (>= (length opts) 2)\n"
"                   (cadr opts)\n"
"                   (string-length s))))\n"
"      (list->bytevector (map char->integer (string->list s start end)))))\n"
"\n"
"  (export bytevector\n"
"          bytevector->list\n"
"          list->bytevector\n"
"          utf8->string\n"
"          string->utf8)\n"
"\n"
"  ;; 6.10 control features\n"
"\n"
"  (define (string-map f . strings)\n"
"    (list->string (apply map f (map string->list strings))))\n"
"\n"
"  (define (string-for-each f . strings)\n"
"    (apply for-each f (map string->list strings)))\n"
"\n"
"  (define (vector-map f . vectors)\n"
"    (list->vector (apply map f (map vector->list vectors))))\n"
"\n"
"  (define (vector-for-each f . vectors)\n"
"    (apply for-each f (map vector->list vectors)))\n"
"\n"
"  (export string-map string-for-each\n"
"          vector-map vector-for-each)\n"
"\n"
"  ;; 6.13. Input and output\n"
"\n"
"  (define (call-with-port port proc)\n"
"    (dynamic-wind\n"
"        (lambda () #f)\n"
"        (lambda () (proc port))\n"
"        (lambda () (close-port port))))\n"
"\n"
"  (export call-with-port))\n"
;

static const char *piclib_src__Users_yuichi_workspace_picrin_piclib_picrin_record =
"(define-library (picrin record)\n"
"  (import (scheme base))\n"
"\n"
"  (define (define-record-writer* record-type writer)\n"
"    (record-set! record-type 'writer writer))\n"
"\n"
"  (define-syntax define-record-writer\n"
"    (syntax-rules ()\n"
"      ((_ (type obj) body ...)\n"
"       (define-record-writer* type\n"
"         (lambda (obj)\n"
"           body ...)))\n"
"      ((_ type writer)\n"
"       (define-record-writer* type\n"
"         writer))))\n"
"\n"
"  (export define-record-writer))\n"
;

static const char *piclib_src__Users_yuichi_workspace_picrin_piclib_picrin_array =
"(define-library (picrin array)\n"
"  (import (scheme base)\n"
"          (scheme write)\n"
"          (picrin record))\n"
"\n"
"  (define-record-type <array>\n"
"    (create-array data size head tail)\n"
"    array?\n"
"    (data array-data set-array-data!)\n"
"    (size array-size set-array-size!)\n"
"    (head array-head set-array-head!)\n"
"    (tail array-tail set-array-tail!))\n"
"\n"
"  (define (translate ary i)\n"
"    (floor-remainder i (array-size ary)))\n"
"\n"
"  (define (array-length ary)\n"
"    (let ((size (- (array-tail ary) (array-head ary))))\n"
"     (translate ary size)))\n"
"\n"
"  (define (array-rotate! ary)\n"
"    (when (< (array-tail ary) (array-head ary))\n"
"      (let ((xs (vector-copy (array-data ary) 0 (array-head ary)))\n"
"            (ys (vector-copy (array-data ary) (array-head ary))))\n"
"        (set-array-data! ary (vector-append ys xs))\n"
"        (set-array-tail! ary (array-length ary))\n"
"        (set-array-head! ary 0))))\n"
"\n"
"  (define (array-reserve! ary size)\n"
"    (set! size (+ size 1))              ; capa == size - 1\n"
"    (when (< (array-size ary) size)\n"
"      (array-rotate! ary)\n"
"      (set-array-data! ary (vector-append\n"
"                            (array-data ary)\n"
"                            (make-vector (- size (array-size ary)))))\n"
"      (set-array-size! ary size)))\n"
"\n"
"  (define (make-array . rest)\n"
"    (if (null? rest)\n"
"        (make-array 0)\n"
"        (let ((capacity (car rest))\n"
"              (ary (create-array (vector) 0 0 0)))\n"
"          (array-reserve! ary capacity)\n"
"          ary)))\n"
"\n"
"  (define (array-ref ary i)\n"
"    (let ((data (array-data ary)))\n"
"      (vector-ref data (translate ary (+ (array-head ary) i)))))\n"
"\n"
"  (define (array-set! ary i obj)\n"
"    (let ((data (array-data ary)))\n"
"      (vector-set! data (translate ary (+ (array-head ary) i)) obj)))\n"
"\n"
"  (define (array-push! ary obj)\n"
"    (array-reserve! ary (+ (array-length ary) 1))\n"
"    (array-set! ary (array-length ary) obj)\n"
"    (set-array-tail! ary (translate ary (+ (array-tail ary) 1))))\n"
"\n"
"  (define (array-pop! ary)\n"
"    (set-array-tail! ary (translate ary (- (array-tail ary) 1)))\n"
"    (array-ref ary (array-length ary)))\n"
"\n"
"  (define (array-shift! ary)\n"
"    (set-array-head! ary (translate ary (+ (array-head ary) 1)))\n"
"    (array-ref ary -1))\n"
"\n"
"  (define (array-unshift! ary obj)\n"
"    (array-reserve! ary (+ (array-length ary) 1))\n"
"    (array-set! ary -1 obj)\n"
"    (set-array-head! ary (translate ary (- (array-head ary) 1))))\n"
"\n"
"  (define (array->list ary)\n"
"    (do ((i 0 (+ i 1))\n"
"         (x '() (cons (array-ref ary i) x)))\n"
"        ((= i (array-length ary))\n"
"         (reverse x))))\n"
"\n"
"  (define (list->array list)\n"
"    (let ((ary (make-array)))\n"
"      (for-each (lambda (x) (array-push! ary x)) list)\n"
"      ary))\n"
"\n"
"  (define (array . objs)\n"
"    (list->array objs))\n"
"\n"
"  (define (array-map proc ary)\n"
"    (list->array (map proc (array->list ary))))\n"
"\n"
"  (define (array-for-each proc ary)\n"
"    (for-each proc (array->list ary)))\n"
"\n"
"  (define-record-writer (<array> array)\n"
"    (call-with-port (open-output-string)\n"
"     (lambda (port)\n"
"       (display \"#.(array\" port)\n"
"       (array-for-each\n"
"        (lambda (obj)\n"
"          (display \" \" port)\n"
"          (write obj port))\n"
"        array)\n"
"       (display \")\" port)\n"
"       (get-output-string port))))\n"
"\n"
"  (export make-array\n"
"          array\n"
"          array?\n"
"          array-length\n"
"          array-ref\n"
"          array-set!\n"
"          array-push!\n"
"          array-pop!\n"
"          array-shift!\n"
"          array-unshift!\n"
"          array-map\n"
"          array-for-each\n"
"          array->list\n"
"          list->array))\n"
;

static const char *piclib_src__Users_yuichi_workspace_picrin_piclib_picrin_dictionary =
"(define-library (picrin dictionary)\n"
"  (import (scheme base))\n"
"\n"
"  (define (dictionary-map proc dict)\n"
"    (let ((kvs '()))\n"
"      (dictionary-for-each\n"
"       (lambda (key val)\n"
"         (set! kvs (cons (proc key val) kvs)))\n"
"       dict)\n"
"      (reverse kvs)))\n"
"\n"
"  (define (dictionary->plist dict)\n"
"    (let ((kvs '()))\n"
"      (dictionary-for-each\n"
"       (lambda (key val)\n"
"         (set! kvs (cons val (cons key kvs))))\n"
"       dict)\n"
"      (reverse kvs)))\n"
"\n"
"  (define (plist->dictionary plist)\n"
"    (let ((dict (make-dictionary)))\n"
"      (do ((kv plist (cddr kv)))\n"
"          ((null? kv)\n"
"           dict)\n"
"        (dictionary-set! dict (car kv) (cadr kv)))))\n"
"\n"
"  (define (dictionary->alist dict)\n"
"    (dictionary-map\n"
"     (lambda (key val)\n"
"       (cons key val))\n"
"     dict))\n"
"\n"
"  (define (alist->dictionary alist)\n"
"    (let ((dict (make-dictionary)))\n"
"      (do ((kv alist (cdr kv)))\n"
"          ((null? kv)\n"
"           dict)\n"
"        (dictionary-set! dict (car kv) (cdr kv)))))\n"
"\n"
"  (define (dictionary . plist)\n"
"    (plist->dictionary plist))\n"
"\n"
"  (export dictionary\n"
"          dictionary-map\n"
"          dictionary->plist\n"
"          plist->dictionary\n"
"          dictionary->alist\n"
"          alist->dictionary))\n"
;

static const char *piclib_src__Users_yuichi_workspace_picrin_piclib_picrin_test =
"(define-library (picrin test)\n"
"  (import (scheme base)\n"
"          (scheme write)\n"
"          (scheme read)\n"
"          (scheme process-context))\n"
"  (define test-counter 0)\n"
"  (define counter 0)\n"
"  (define failure-counter 0)\n"
"\n"
"  (define fails '())\n"
"\n"
"  (define (print-statistics)\n"
"    (newline)\n"
"    (display \"Test Result: \")\n"
"    (write (- counter failure-counter))\n"
"    (display \" / \")\n"
"    (write counter)\n"
"    (display \" (\")\n"
"    (write (* (/ (- counter failure-counter) counter) 100))\n"
"    (display \"%)\")\n"
"    (display \" [PASS/TOTAL]\")\n"
"    (display \"\")\n"
"    (newline)\n"
"    (for-each\n"
"     (lambda (fail)\n"
"       (display fail))\n"
"     (reverse fails)))\n"
"\n"
"  (define (test-begin . o)\n"
"    (set! test-counter (+ test-counter 1)))\n"
"\n"
"  (define (test-end . o)\n"
"    (set! test-counter (- test-counter 1))\n"
"    (if (= test-counter 0)\n"
"        (print-statistics)))\n"
"\n"
"  (define-syntax test\n"
"    (syntax-rules ()\n"
"      ((test expected expr)\n"
"       (let ((res expr))\n"
"         (display \"case \")\n"
"         (write counter)\n"
"         (cond\n"
"          ((equal? res expected)\n"
"           (display \" PASS: \")\n"
"           (write 'expr)\n"
"           (display \" equals \")\n"
"           (write expected)\n"
"           (display \"\")\n"
"           (newline)\n"
"           )\n"
"          ((not (equal? res expected))\n"
"           (set! failure-counter (+ failure-counter 1))\n"
"           (let ((out (open-output-string)))\n"
"             (display \" FAIL: \" out)\n"
"             (write 'expr out)\n"
"             (newline out)\n"
"             (display \"   expected \" out)\n"
"             (write expected out)\n"
"             (display \" but got \" out)\n"
"             (write res out)\n"
"             (display \"\" out)\n"
"             (newline out)\n"
"             (let ((str (get-output-string out)))\n"
"               (set! fails (cons str fails))\n"
"               (display str)))))\n"
"         (set! counter (+ counter 1))))))\n"
"\n"
"  (define-syntax test-values\n"
"    (syntax-rules ()\n"
"      ((_ expect expr)\n"
"       (test (call-with-values (lambda () expect) (lambda results results))\n"
"             (call-with-values (lambda () expr) (lambda results results))))))\n"
"\n"
"\n"
"  (define (test-failure-count)\n"
"    (length fails))\n"
"\n"
"  (define (test-exit)\n"
"    (exit (zero? (test-failure-count))))\n"
"\n"
"  (define-syntax test-syntax-error\n"
"    (syntax-rules ()\n"
"      ((_) (syntax-error \"invalid use of test-syntax-error\"))))\n"
"\n"
"  (export test test-begin test-end test-values test-exit test-syntax-error))\n"
;

static const char *piclib_src__Users_yuichi_workspace_picrin_piclib_picrin_experimental_lambda =
"(define-library (picrin experimental lambda)\n"
"  (import (scheme base)\n"
"          (picrin macro))\n"
"\n"
"  (define-syntax destructuring-bind\n"
"    (ir-macro-transformer\n"
"     (lambda (form inject compare)\n"
"       (let ((formal (car (cdr form)))\n"
"             (value  (car (cdr (cdr form))))\n"
"             (body   (cdr (cdr (cdr form)))))\n"
"         (cond\n"
"          ((symbol? formal)\n"
"           `(let ((,formal ,value))\n"
"              ,@body))\n"
"          ((pair? formal)\n"
"           `(let ((value# ,value))\n"
"              (destructuring-bind ,(car formal) (car value#)\n"
"                (destructuring-bind ,(cdr formal) (cdr value#)\n"
"                  ,@body))))\n"
"          ((vector? formal)\n"
"           ;; TODO\n"
"           (error \"fixme\"))\n"
"          (else\n"
"           `(if (equal? ,value ',formal)\n"
"                (begin\n"
"                  ,@body)\n"
"                (error \"match failure\" ,value ',formal))))))))\n"
"\n"
"  (define-syntax destructuring-lambda\n"
"    (ir-macro-transformer\n"
"     (lambda (form inject compare)\n"
"       (let ((args (car (cdr form)))\n"
"             (body (cdr (cdr form))))\n"
"         `(lambda formal# (destructuring-bind ,args formal# ,@body))))))\n"
"\n"
"  (define-syntax destructuring-define\n"
"    (ir-macro-transformer\n"
"     (lambda (form inject compare)\n"
"       (let ((maybe-formal (cadr form)))\n"
"         (if (symbol? maybe-formal)\n"
"             `(define ,@(cdr form))\n"
"             `(destructuring-define ,(car maybe-formal)\n"
"                (destructuring-lambda ,(cdr maybe-formal)\n"
"                  ,@(cddr form))))))))\n"
"\n"
"  (export (rename destructuring-bind bind)\n"
"          (rename destructuring-lambda lambda)\n"
"          (rename destructuring-define define)))\n"
;

static const char *piclib_src__Users_yuichi_workspace_picrin_piclib_picrin_promise =
"(define-library (picrin promise)\n"
"  (import (scheme base)\n"
"          (picrin experimental lambda))\n"
"\n"
"  (define (identity x)\n"
"    x)\n"
"\n"
"  (define-record-type <promise>\n"
"      (create-promise status reactors cache)\n"
"      promise?\n"
"    (status promise-status set-promise-status!)\n"
"    (reactors promise-reactors set-promise-reactors!)\n"
"    (cache promise-cache set-promise-cache!))\n"
"\n"
"  (define (push-promise-reactor! promise reactor)\n"
"    (set-promise-reactors! promise (cons reactor (promise-reactors promise))))\n"
"\n"
"  #;\n"
"  (define (print x)\n"
"    (write x)\n"
"    (newline)\n"
"    (flush-output-port)\n"
"    x)\n"
"\n"
"  (define (make-promise handler)\n"
"    (let ((self (create-promise 'pending '() #f)))\n"
"\n"
"      (define (on-resolved result)\n"
"        (when (eq? (promise-status self) 'pending)\n"
"          (for-each\n"
"           (lambda (((resolve . reject) on-resolved _))\n"
"             (call/cc\n"
"              (lambda (exit)\n"
"                (with-exception-handler\n"
"                 (lambda (e)\n"
"                   (reject e)\n"
"                   (exit #f))\n"
"                 (lambda ()\n"
"                   (resolve (on-resolved result)))))))\n"
"           (promise-reactors self))\n"
"          (set-promise-status! self 'resolved)\n"
"          (set-promise-cache! self result)\n"
"          (set-promise-reactors! self '())))\n"
"\n"
"      (define (on-rejected reason)\n"
"        (when (eq? (promise-status 'pending) 'pending)\n"
"          (for-each\n"
"           (lambda (((resolve . reject) _ on-rejected))\n"
"             (call/cc\n"
"              (lambda (exit)\n"
"                (with-exception-handler\n"
"                 (lambda (e)\n"
"                   (reject e)\n"
"                   (exit #f))\n"
"                 (lambda ()\n"
"                   (resolve (on-rejected reason)))))))\n"
"           (promise-reactors self))\n"
"          (set-promise-status! self 'rejected)\n"
"          (set-promise-cache! self reason)\n"
"          (set-promise-reactors! self '())))\n"
"\n"
"      (handler on-resolved on-rejected)\n"
"\n"
"      self))\n"
"\n"
"  (define (promise-chain self on-resolved on-rejected)\n"
"\n"
"    (define (handler resolve reject)\n"
"      (case (promise-status self)\n"
"        (pending\n"
"         (push-promise-reactor! self `((,resolve . ,reject) ,on-resolved ,on-rejected)))\n"
"        (resolved\n"
"         (call/cc\n"
"          (lambda (exit)\n"
"            (with-exception-handler\n"
"             (lambda (e)\n"
"               (reject e)\n"
"               (exit #f))\n"
"             (lambda ()\n"
"               (resolve (on-resolved (promise-cache self))))))))\n"
"        (rejected\n"
"         (call/cc\n"
"          (lambda (exit)\n"
"            (with-exception-handler\n"
"             (lambda (e)\n"
"               (reject e)\n"
"               (exit #f))\n"
"             (lambda ()\n"
"               (resolve (on-rejected (promise-cache self))))))))))\n"
"\n"
"    (make-promise handler))\n"
"\n"
"  (define (promise-then self on-resolved)\n"
"    (promise-chain self on-resolved identity))\n"
"\n"
"  (define (promise-else self on-rejected)\n"
"    (promise-chain self identity on-rejected))\n"
"\n"
"  (define (promise-all promises)\n"
"\n"
"    (define (handler resolve reject)\n"
"      (do ((i 0 (+ i 1))\n"
"           (x promises (cdr x))\n"
"           (c 0)\n"
"           (v (make-vector (length promises))))\n"
"          ((null? x))\n"
"\n"
"        (define (on-resolved result)\n"
"          (vector-set! v i result)\n"
"          (set! c (+ c 1))\n"
"          (when (= c (length promises))\n"
"            (resolve (vector->list v))))\n"
"\n"
"        (define (on-rejected reason)\n"
"          (reject reason))\n"
"\n"
"        (promise-chain (car x) on-resolved on-rejected)))\n"
"\n"
"    (make-promise handler))\n"
"\n"
"  (define (promise-any promises)\n"
"\n"
"    (define (handler resolve reject)\n"
"      (do ((i 0 (+ i 1))\n"
"           (x promises (cdr x))\n"
"           (c 0)\n"
"           (v (make-vector (length promises))))\n"
"          ((null? x))\n"
"\n"
"        (define (on-resolved result)\n"
"          (resolve result))\n"
"\n"
"        (define (on-rejected reason)\n"
"          (vector-set! v i reason)\n"
"          (set! c (+ c 1))\n"
"          (when (= c (length promises))\n"
"            (reject (vector->list v))))\n"
"\n"
"        (promise-chain (car x) on-resolved on-rejected)))\n"
"\n"
"    (make-promise handler))\n"
"\n"
"  ; experimental API\n"
"  (define (promise-race promises)\n"
"    (make-promise\n"
"     (lambda (resolve reject)\n"
"       (for-each\n"
"        (lambda (x)\n"
"          (promise-chain x resolve reject))\n"
"        promises))))\n"
"\n"
"  (export promise?\n"
"          make-promise\n"
"          promise-then\n"
"          promise-else\n"
"          promise-all\n"
"          promise-any))\n"
;

static const char *piclib_src__Users_yuichi_workspace_picrin_piclib_picrin_async =
"(define-library (picrin async)\n"
"  (import (scheme base)\n"
"          (picrin promise))\n"
"\n"
"  (define (async-timer ms)\n"
"    (make-promise\n"
"     (lambda (resolve reject)\n"
"       (set-timeout\n"
"        (lambda ()\n"
"          (resolve #t))\n"
"        ms))))\n"
"\n"
"  (export async-timer))\n"
;

static const char *piclib_src__Users_yuichi_workspace_picrin_piclib_scheme_cxr =
";;; Appendix A. Standard Libraries CxR\n"
"\n"
"(define-library (scheme cxr)\n"
"  (import (scheme base))\n"
"\n"
"  (define (caaar p) (car (caar p)))\n"
"  (define (caadr p) (car (cadr p)))\n"
"  (define (cadar p) (car (cdar p)))\n"
"  (define (caddr p) (car (cddr p)))\n"
"  (define (cdaar p) (cdr (caar p)))\n"
"  (define (cdadr p) (cdr (cadr p)))\n"
"  (define (cddar p) (cdr (cdar p)))\n"
"  (define (cdddr p) (cdr (cddr p)))\n"
"  (define (caaaar p) (caar (caar p)))\n"
"  (define (caaadr p) (caar (cadr p)))\n"
"  (define (caadar p) (caar (cdar p)))\n"
"  (define (caaddr p) (caar (cddr p)))\n"
"  (define (cadaar p) (cadr (caar p)))\n"
"  (define (cadadr p) (cadr (cadr p)))\n"
"  (define (caddar p) (cadr (cdar p)))\n"
"  (define (cadddr p) (cadr (cddr p)))\n"
"  (define (cdaaar p) (cdar (caar p)))\n"
"  (define (cdaadr p) (cdar (cadr p)))\n"
"  (define (cdadar p) (cdar (cdar p)))\n"
"  (define (cdaddr p) (cdar (cddr p)))\n"
"  (define (cddaar p) (cddr (caar p)))\n"
"  (define (cddadr p) (cddr (cadr p)))\n"
"  (define (cdddar p) (cddr (cdar p)))\n"
"  (define (cddddr p) (cddr (cddr p)))\n"
"\n"
"  (export caaar caadr cadar caddr\n"
"          cdaar cdadr cddar cdddr\n"
"          caaaar caaadr caadar caaddr\n"
"          cadaar cadadr caddar cadddr\n"
"          cdaaar cdaadr cdadar cdaddr\n"
"          cddaar cddadr cdddar cddddr))\n"
;

static const char *piclib_src__Users_yuichi_workspace_picrin_piclib_scheme_file =
"(define-library (scheme file)\n"
"  (import (scheme base))\n"
"\n"
"  (define (call-with-input-file filename callback)\n"
"    (call-with-port (open-input-file filename) callback))\n"
"\n"
"  (define (call-with-output-file filename callback)\n"
"    (call-with-port (open-output-file filename) callback))\n"
"\n"
"  (define (with-input-from-file filename thunk)\n"
"    (call-with-input-file filename\n"
"      (lambda (port)\n"
"        (parameterize ((current-input-port port))\n"
"          (thunk)))))\n"
"\n"
"  (define (with-output-to-file filename thunk)\n"
"    (call-with-output-file filename\n"
"      (lambda (port)\n"
"        (parameterize ((current-output-port port))\n"
"          (thunk)))))\n"
"\n"
"  (export call-with-input-file\n"
"          call-with-output-file\n"
"          with-input-from-file\n"
"          with-output-to-file))\n"
;

static const char *piclib_src__Users_yuichi_workspace_picrin_piclib_scheme_case_lambda =
"(define-library (scheme case-lambda)\n"
"  (import (scheme base))\n"
"\n"
"  (define-syntax case-lambda\n"
"    (syntax-rules ()\n"
"      ((case-lambda (params body0 ...) ...)\n"
"       (lambda args\n"
"         (let ((len (length args)))\n"
"           (letrec-syntax\n"
"               ((cl (syntax-rules ::: ()\n"
"                      ((cl)\n"
"                       (error \"no matching clause\"))\n"
"                      ((cl ((p :::) . body) . rest)\n"
"                       (if (= len (length '(p :::)))\n"
"                           (apply (lambda (p :::)\n"
"                                    . body)\n"
"                                  args)\n"
"                           (cl . rest)))\n"
"                      ((cl ((p ::: . tail) . body)\n"
"                           . rest)\n"
"                       (if (>= len (length '(p :::)))\n"
"                           (apply\n"
"                            (lambda (p ::: . tail)\n"
"                              . body)\n"
"                            args)\n"
"                           (cl . rest))))))\n"
"             (cl (params body0 ...) ...)))))))\n"
"\n"
"  (export case-lambda))\n"
;

static const char *piclib_src__Users_yuichi_workspace_picrin_piclib_scheme_lazy =
";;; Appendix A. Standard Libraries Lazy\n"
"\n"
"(define-library (scheme lazy)\n"
"  (import (scheme base)\n"
"	  (picrin macro))\n"
"\n"
"  (define-record-type <promise>\n"
"    (make-promise% done obj)\n"
"    promise?\n"
"    (done promise-done? promise-done!)\n"
"    (obj promise-value promise-value!))\n"
"\n"
"  (define-syntax delay-force\n"
"    (ir-macro-transformer\n"
"     (lambda (form rename compare?)\n"
"       (let ((expr (cadr form)))\n"
"	 `(make-promise% #f (lambda () ,expr))))))\n"
"\n"
"  (define-syntax delay\n"
"    (ir-macro-transformer\n"
"     (lambda (form rename compare?)\n"
"       (let ((expr (cadr form)))\n"
"	 `(delay-force (make-promise% #t ,expr))))))\n"
"\n"
"  (define (promise-update! new old)\n"
"    (promise-done! old (promise-done? new))\n"
"    (promise-value! old (promise-value new)))\n"
"\n"
"  (define (force promise)\n"
"    (if (promise-done? promise)\n"
"	(promise-value promise)\n"
"	(let ((promise* ((promise-value promise))))\n"
"	  (unless (promise-done? promise)\n"
"		  (promise-update! promise* promise))\n"
"	  (force promise))))\n"
"\n"
"  (define (make-promise obj)\n"
"    (if (promise? obj)\n"
"	obj\n"
"	(make-promise% #t obj)))\n"
"\n"
"  (export delay-force delay force make-promise promise?))\n"
;

static const char *piclib_src__Users_yuichi_workspace_picrin_piclib_scheme_eval =
"(define-library (scheme eval)\n"
"  (import (scheme base))\n"
"\n"
"  (define (null-environment n)\n"
"    (if (not (= n 5))\n"
"        (error \"unsupported environment version\" n)\n"
"        '(scheme null)))\n"
"\n"
"  (define (scheme-report-environment n)\n"
"    (if (not (= n 5))\n"
"        (error \"unsupported environment version\" n)\n"
"        '(scheme r5rs)))\n"
"\n"
"  (define environment\n"
"    (let ((counter 0))\n"
"      (lambda specs\n"
"        (let ((library-name `(picrin @@my-environment ,counter)))\n"
"          (set! counter (+ counter 1))\n"
"          (eval\n"
"           `(define-library ,library-name\n"
"              ,@(map (lambda (spec)\n"
"                       `(import ,spec))\n"
"                     specs))\n"
"           '(scheme base))\n"
"          library-name))))\n"
"\n"
"  (export null-environment\n"
"          scheme-report-environment\n"
"          environment))\n"
;

static const char *piclib_src__Users_yuichi_workspace_picrin_piclib_scheme_r5rs =
"(define-library (scheme r5rs)\n"
"  (import (scheme base)\n"
"          (scheme inexact)\n"
"          (scheme write)\n"
"          (scheme read)\n"
"          (scheme file)\n"
"          (scheme cxr)\n"
"          (scheme lazy)\n"
"          (scheme eval)\n"
"          (scheme load))\n"
"\n"
"  (export * + - / < <= = > >=\n"
"          abs acos and\n"
"          ;; angle\n"
"          append apply asin assoc assq assv atan\n"
"          begin boolean?\n"
"          caaaar caaadr caaar caadar caaddr caadr caar cadaar cadadr cadar caddar cadddr caddr cadr\n"
"          call-with-current-continuation\n"
"          call-with-input-file\n"
"          call-with-output-file\n"
"          call-with-values\n"
"          car case cdaaar cdaadr cdaar cdadar cdaddr cdadr cdar cddaar cddadr cddar cdddar cddddr cdddr cddr cdr\n"
"          ceiling\n"
"          ;; char->integer char-alphabetic? char-ci<=? char-ci<? char-ci=? char-ci>=? char-ci>? char-downcase char-lower-case? char-numeric? char-ready? char-upcase char-upper-case? char-whitespace? char<=? char<? char=? char>=? char>? char?\n"
"          close-input-port close-output-port complex? cond cons cos current-input-port current-output-port\n"
"          define define-syntax delay\n"
"          ;; denominator\n"
"          display do dynamic-wind\n"
"          eof-object? eq? equal? eqv? eval even?\n"
"          (rename inexact exact->inexact)\n"
"          exact? exp expt\n"
"          floor for-each force\n"
"          gcd\n"
"          if\n"
"          ;; imag-part\n"
"          (rename exact inexact->exact)\n"
"          inexact? input-port? integer->char integer?\n"
"          ;; interaction-environment\n"
"          lambda lcm length let\n"
"          peek-char procedure?\n"
"          quote\n"
"          rational? read\n"
"          ;; real-part\n"
"          remainder round\n"
"          scheme-report-environment\n"
"          set! set-cdr! sqrt string->list string->symbol\n"
"          ;; string-ci<=? string-ci=? string-ci>?\n"
"          string-fill! string-ref string<=? string=? string>? substring symbol?\n"
"          truncate\n"
"          vector vector-fill! vector-ref vector? with-output-to-file write-char\n"
"          output-port?\n"
"          let-syntax\n"
"          letrec-syntax\n"
"          list->string\n"
"          list-ref\n"
"          list?\n"
"          log\n"
"          ;; make-polar\n"
"          make-string\n"
"          map\n"
"          member\n"
"          memv\n"
"          modulo\n"
"          newline\n"
"          null-environment\n"
"          number->string\n"
"          ;; numerator\n"
"          open-input-file\n"
"          or\n"
"          pair?\n"
"          positive?\n"
"          quasiquote\n"
"          quotient\n"
"          ;; rationalize\n"
"          read-char\n"
"          real?\n"
"          reverse\n"
"          let*\n"
"          letrec\n"
"          list\n"
"          list->vector\n"
"          list-tail\n"
"          load\n"
"          ;; magnitude\n"
"          ;; make-rectangular\n"
"          make-vector\n"
"          max\n"
"          memq\n"
"          min\n"
"          negative?\n"
"          not\n"
"          null?\n"
"          number?\n"
"          odd?\n"
"          open-output-file\n"
"          set-car!\n"
"          sin\n"
"          string\n"
"          string->number\n"
"          string-append\n"
"          ;; string-ci<?\n"
"          ;; string-ci>=?\n"
"          string-copy\n"
"          string-length\n"
"          string-set!\n"
"          string<?\n"
"          string>=?\n"
"          string?\n"
"          symbol->string\n"
"          tan\n"
"          values\n"
"          vector->list\n"
"          vector-length\n"
"          vector-set!\n"
"          with-input-from-file\n"
"          write\n"
"          zero?\n"
"          ))\n"
;

static const char *piclib_src__Users_yuichi_workspace_picrin_piclib_scheme_null =
"(define-library (scheme null)\n"
"  (import (scheme base))\n"
"  (export define\n"
"          lambda\n"
"          if\n"
"          quote\n"
"          quasiquote\n"
"          unquote\n"
"          unquote-splicing\n"
"          begin\n"
"          set!\n"
"          define-syntax))\n"
;

static const char *piclib_src__Users_yuichi_workspace_picrin_piclib_srfi_1 =
"(define-library (srfi 1)\n"
"  (import (scheme base)\n"
"          (scheme cxr))\n"
"\n"
"  ;; # Constructors\n"
"  ;; cons list\n"
"  ;; xcons cons* make-list list-tabulate\n"
"  ;; list-copy circular-list iota\n"
"  (define (xcons a b)\n"
"    (cons b a))\n"
"\n"
"  ;; means for inter-referential definition\n"
"  (define append-reverse #f)\n"
"\n"
"  (define (cons* x . args)\n"
"    (let rec ((acc '()) (x x) (lst args))\n"
"      (if (null? lst)\n"
"          (append-reverse acc x)\n"
"          (rec (cons x acc) (car lst) (cdr lst)))))\n"
"\n"
"  (define (list-tabulate n init-proc)\n"
"    (let rec ((acc '()) (n (- n 1)))\n"
"      (if (zero? n)\n"
"          (cons n acc)\n"
"          (rec (cons n acc) (- n 1)))))\n"
"\n"
"  (define (circular-list elt . args)\n"
"    (let ((lst (cons elt args)))\n"
"      (let rec ((l lst))\n"
"        (if (null? (cdr l))\n"
"            (set-cdr! l lst)\n"
"            (rec (cdr l))))\n"
"      lst))\n"
"\n"
"  (define (iota count . lst)\n"
"    (let ((start (if (pair? lst) (car lst) 0))\n"
"          (step (if (and (pair? lst) (pair? (cdr lst)))\n"
"                    (cadr lst) 1)))\n"
"      (let rec ((count (- count 1)) (acc '()))\n"
"        (if (zero? count)\n"
"            (cons start acc)\n"
"            (rec (- count 1)\n"
"                 (cons (+ start (* count step)) acc))))))\n"
"\n"
"  (export cons list xcons make-list list-tabulate list-copy circular-list iota)\n"
"\n"
"  ;; # Predicates\n"
"  ;; pair? null?\n"
"  ;; proper-list? circular-list? dotted-list?\n"
"  ;; not-pair? null-list?\n"
"  ;; list=\n"
"  (define (not-pair? x)\n"
"    (not (pair? x)))\n"
"  ;; detects circular list using Floyd's cycle-finding algorithm\n"
"  (define (circular-list? x)\n"
"    (let rec ((rapid x) (local x))\n"
"      (if (and (pair? rapid) (pair? (cdr rapid)))\n"
"          (if (eq? (cddr rapid) (cdr local))\n"
"              #t\n"
"              (rec (cddr rapid) (cdr local)))\n"
"          #f)))\n"
"\n"
"  (define proper-list? list?)\n"
"\n"
"  (define (dotted-list? x)\n"
"    (and (pair? x)\n"
"         (not (proper-list? x))\n"
"         (not (circular-list? x))))\n"
"\n"
"  (define (null-list? x)\n"
"    (cond ((pair? x) #f)\n"
"          ((null? x) #t)\n"
"          (else (error \"null-list?: argument out of domain\" x))))\n"
"\n"
"  (define (list= elt= . lists)\n"
"    (or (null? lists)\n"
"        (let rec1 ((list1 (car lists)) (others (cdr lists)))\n"
"          (or (null? others)\n"
"              (let ((list2 (car others))\n"
"                    (others (cdr others)))\n"
"                (if (eq? list1 list2)\n"
"                    (rec1 list2 others)\n"
"                    (let rec2 ((l1 list1) (l2 list2))\n"
"                      (if (null-list? l1)\n"
"                          (and (null-list? l2)\n"
"                               (rec1 list2 others))\n"
"                          (and (not (null-list? l2))\n"
"                               (elt= (car l1) (car l2))\n"
"                               (rec2 (cdr l1) (cdr l2)))))))))))\n"
"\n"
"  (export pair? null? not-pair? proper-list? circular-list? null-list? list=)\n"
"\n"
"  ;; # Selectors\n"
"  ;; car cdr ... cddadr cddddr list-ref\n"
"  ;; first second third fourth fifth sixth seventh eighth ninth tenth\n"
"  ;; car+cdr\n"
"  ;; take drop\n"
"  ;; take-right drop-right\n"
"  ;; take! drop-right!\n"
"  ;; split-at split-at!\n"
"  ;; last last-pair\n"
"  (define (car+cdr pair)\n"
"    (values (car pair) (cdr pair)))\n"
"\n"
"  (define (take x i)\n"
"    (if (zero? i)\n"
"        '()\n"
"        (cons (car x)\n"
"              (take (cdr x) (- i 1)))))\n"
"\n"
"  (define (drop x i)\n"
"    (if (zero? i)\n"
"        x\n"
"        (drop (cdr x) (- i 1))))\n"
"\n"
"  (define (take-right flist i)\n"
"    (let ((len (length flist)))\n"
"      (drop flist (- len i))))\n"
"\n"
"  (define (drop-right flist i)\n"
"    (let ((len (length flist)))\n"
"      (take flist (- len i))))\n"
"\n"
"  (define (take! x i)\n"
"    (let rec ((lis x) (n (- i 1)))\n"
"      (if (zero? n)\n"
"          (begin (set-cdr! lis '()) x)\n"
"          (rec (cdr lis) (- n 1)))))\n"
"\n"
"  (define (drop-right! flist i)\n"
"    (let ((lead (drop flist i)))\n"
"      (if (not-pair? lead)\n"
"          '()\n"
"          (let rec ((lis1 flist) (lis2 (cdr lead)))\n"
"            (if (pair? lis2)\n"
"                (rec (cdr lis1) (cdr lis2))\n"
"                (begin (set-cdr! lis1 '()) flist))))))\n"
"\n"
"  (define (split-at x i)\n"
"    (values (take x i) (drop x i)))\n"
"\n"
"  (define (split-at! x i)\n"
"    (values (take! x i) (drop x i)))\n"
"\n"
"  (define (last pair)\n"
"    (car (take-right pair 1)))\n"
"\n"
"  (define (last-pair pair)\n"
"    (take-right pair 1))\n"
"\n"
"  (define first car)\n"
"  (define second cadr)\n"
"  (define third caddr)\n"
"  (define fourth cadddr)\n"
"  (define (fifth pair)\n"
"    (list-ref pair 4))\n"
"  (define (sixth pair)\n"
"    (list-ref pair 5))\n"
"  (define (seventh pair)\n"
"    (list-ref pair 6))\n"
"  (define (eighth pair)\n"
"    (list-ref pair 7))\n"
"  (define (ninth pair)\n"
"    (list-ref pair 8))\n"
"  (define (tenth pair)\n"
"    (list-ref pair 9))\n"
"\n"
"\n"
"  (export car cdr car+cdr list-ref\n"
"          caar cadr cdar cddr caaar caadr cadar caddr cdaar cdadr cddar cdddr\n"
"          caaaar caaadr caadar caaddr cadaar cadadr caddar cadddr cdaaar cdaadr\n"
"          cdadar cdaddr cddaar cddadr cdddar cddddr\n"
"          first second third fourth fifth sixth seventh eighth ninth tenth\n"
"          take drop take-right drop-right take! drop-right!\n"
"          split-at split-at! last last-pair)\n"
"\n"
"  ;; # Miscellaneous\n"
"  ;; length length+\n"
"  ;; append concatenate reverse\n"
"  ;; append! concatenate! reverse!\n"
"  ;; append-reverse append-reverse!\n"
"  ;; zip unzip1 unzip2 unzip3 unzip4 unzip5\n"
"  ;; count\n"
"  (define (length+ lst)\n"
"    (if (not (circular-list? lst))\n"
"        (length lst)))\n"
"\n"
"  (define (concatenate lists)\n"
"    (apply append lists))\n"
"\n"
"  (define (append! . lists)\n"
"    (if (null? lists)\n"
"        '()\n"
"        (let rec ((lst lists))\n"
"          (if (not-pair? (cdr lst))\n"
"              (car lst)\n"
"              (begin (set-cdr! (last-pair (car lst)) (cdr lst))\n"
"                     (rec (cdr lst)))))))\n"
"\n"
"  (define (concatenate! lists)\n"
"    (apply append! lists))\n"
"\n"
"  (define (reverse! list)\n"
"    (let rec ((lst list) (acc '()))\n"
"      (if (null? lst)\n"
"          acc\n"
"          (let ((rst (cdr lst)))\n"
"            (set-cdr! lst acc)\n"
"            (rec rst lst)))))\n"
"\n"
"  (set! append-reverse\n"
"        (lambda (rev-head tail)\n"
"          (if (null? rev-head)\n"
"              tail\n"
"              (append-reverse (cdr rev-head) (cons (car rev-head) tail)))))\n"
"\n"
"  (define (append-reverse! rev-head tail)\n"
"    (let ((rst (cdr rev-head)))\n"
"      (if (null? rev-head)\n"
"          tail\n"
"          (begin (set-cdr! rev-head tail)\n"
"                 (append-reverse! rst rev-head)))))\n"
"\n"
"  (define (zip . lists)\n"
"    (apply map list lists))\n"
"\n"
"  (define (unzip1 list)\n"
"    (map first list))\n"
"\n"
"  (define (unzip2 list)\n"
"    (values (map first list)\n"
"            (map second list)))\n"
"\n"
"  (define (unzip3 list)\n"
"    (values (map first list)\n"
"            (map second list)\n"
"            (map third list)))\n"
"\n"
"  (define (unzip4 list)\n"
"    (values (map first list)\n"
"            (map second list)\n"
"            (map third list)\n"
"            (map fourth list)))\n"
"\n"
"  (define (unzip5 list)\n"
"    (values (map first list)\n"
"            (map second list)\n"
"            (map third list)\n"
"            (map fourth list)\n"
"            (map fifth list)))\n"
"\n"
"  (define (count pred . clists)\n"
"    (let rec ((tflst (apply map pred clists)) (n 0))\n"
"      (if (null? tflst)\n"
"          n\n"
"          (rec (cdr tflst) (if (car tflst) (+ n 1) n)))))\n"
"\n"
"  (export length length+\n"
"          append append! concatenate concatenate!\n"
"          reverse reverse! append-reverse append-reverse!\n"
"          zip unzip1 unzip2 unzip3 unzip4 unzip5\n"
"          count)\n"
"\n"
"  ;; # Fold, unfold & map\n"
"  ;; map for-each\n"
"  ;; fold unfold pair-fold reduce\n"
"  ;; fold-right unfold-right pair-fold right reduce-right\n"
"  ;; append-map append-map!\n"
"  ;; map! pair-for-each filter-map map-in-order\n"
"\n"
"  ;; means for inter-referential definition\n"
"  (define every #f)\n"
"\n"
"  (define (fold kons knil clist . clists)\n"
"    (if (null? clists)\n"
"        (let rec ((acc knil) (clist clist))\n"
"          (if (null? clist)\n"
"              acc\n"
"              (rec (kons (car clist) acc) (cdr clist))))\n"
"        (let rec ((acc knil) (clists (cons clist clists)))\n"
"          (if (every pair? clists)\n"
"              (rec (apply kons (append (map car clists) (list acc)))\n"
"                   (map cdr clists))\n"
"              acc))))\n"
"\n"
"  (define (fold-right kons knil clist . clists)\n"
"    (if (null? clists)\n"
"        (let rec ((clist clist) (cont values))\n"
"          (if (null? clist)\n"
"              (cont knil)\n"
"              (rec (cdr clist) (lambda (x) (cont (kons (car clist) x))))))\n"
"        (let rec ((clists (cons clist clists)) (cont values))\n"
"          (if (every pair? clists)\n"
"              (rec (map cdr clists)\n"
"                   (lambda (x)\n"
"                     (cont (apply kons (append (map car clists) (list x))))))\n"
"              (cont knil)))))\n"
"\n"
"  (define (pair-fold kons knil clist . clists)\n"
"    (if (null? clists)\n"
"        (let rec ((acc knil) (clist clist))\n"
"          (if (null? clist)\n"
"              acc\n"
"              (let ((tail (cdr clist)))\n"
"                (rec (kons clist acc) tail))))\n"
"        (let rec ((acc knil) (clists (cons clist clists)))\n"
"          (if (every pair? clists)\n"
"              (let ((tail (map cdr clists)))\n"
"                (rec (apply kons (append clists (list acc)))\n"
"                     tail))\n"
"              acc))))\n"
"\n"
"  (define (pair-fold-right kons knil clist . clists)\n"
"    (if (null? clists)\n"
"        (let rec ((clist clist) (cont values))\n"
"          (if (null? clist)\n"
"              (cont knil)\n"
"              (let ((tail (map cdr clists)))\n"
"                (rec tail (lambda (x) (cont (kons clist x)))))))\n"
"        (let rec ((clists (cons clist clists)) (cont values))\n"
"          (if (every pair? clists)\n"
"              (let ((tail (map cdr clists)))\n"
"                (rec tail\n"
"                     (lambda (x)\n"
"                       (cont (apply kons (append clists (list x)))))))\n"
"              (cont knil)))))\n"
"\n"
"  (define (reduce f ridentity list)\n"
"    (if (null? list)\n"
"        ridentity\n"
"        (fold f (car list) (cdr list))))\n"
"\n"
"  (define (reduce-right f ridentity list)\n"
"    (fold-right f ridentity list))\n"
"\n"
"  (define (unfold p f g seed . tail-gen)\n"
"    (let ((tail-gen (if (null? tail-gen)\n"
"                        (lambda (x) '())\n"
"                        (car tail-gen))))\n"
"      (let rec ((seed seed) (cont values))\n"
"        (if (p seed)\n"
"            (cont (tail-gen seed))\n"
"            (rec (g seed) (lambda (x) (cont (cons (f seed) x))))))))\n"
"\n"
"  (define (unfold-right p f g seed . tail)\n"
"    (let rec ((seed seed) (lst tail))\n"
"      (if (p seed)\n"
"          lst\n"
"          (rec (g seed) (cons (f seed) lst)))))\n"
"\n"
"  (define (append-map f . clists)\n"
"    (apply append (apply map f clists)))\n"
"\n"
"  (define (append-map! f . clists)\n"
"    (apply append! (apply map f clists)))\n"
"\n"
"  (define (pair-for-each f clist . clists)\n"
"    (if (null? clist)\n"
"        (let rec ((clist clist))\n"
"          (if (pair? clist)\n"
"              (begin (f clist) (rec (cdr clist)))))\n"
"        (let rec ((clists (cons clist clists)))\n"
"          (if (every pair? clists)\n"
"              (begin (apply f clists) (rec (map cdr clists)))))))\n"
"\n"
"  (define (map! f list . lists)\n"
"    (if (null? lists)\n"
"        (pair-for-each (lambda (x) (set-car! x (f (car x)))) list)\n"
"        (let rec ((list list) (lists lists))\n"
"          (if (pair? list)\n"
"              (let ((head (map car lists))\n"
"                    (rest (map cdr lists)))\n"
"                (set-car! list (apply f (car list) head))\n"
"                (rec (cdr list) rest)))))\n"
"    list)\n"
"\n"
"  (define (map-in-order f clist . clists)\n"
"    (if (null? clists)\n"
"        (let rec ((clist clist) (acc '()))\n"
"          (if (null? clist)\n"
"              (reverse! acc)\n"
"              (rec (cdr clist) (cons (f (car clist)) acc))))\n"
"        (let rec ((clists (cons clist clists)) (acc '()))\n"
"          (if (every pair? clists)\n"
"              (rec (map cdr clists)\n"
"                   (cons* (apply f (map car clists)) acc))\n"
"              (reverse! acc)))))\n"
"\n"
"  (define (filter-map f clist . clists)\n"
"    (let recur ((l (apply map f clist clists)))\n"
"      (cond ((null? l) '())\n"
"            ((car l)   (cons (car l) (recur (cdr l))))\n"
"            (else      (recur (cdr l))))))\n"
"\n"
"  (export map for-each\n"
"          fold unfold pair-fold reduce\n"
"          fold-right unfold-right pair-fold-right reduce-right\n"
"          append-map append-map!\n"
"          map! pair-for-each filter-map map-in-order)\n"
"\n"
"  ;; # Filtering & partitioning\n"
"  ;; filter partition remove\n"
"  ;; filter! partition! remove!\n"
"  (define (filter pred list)\n"
"    (let ((pcons (lambda (v acc) (if (pred v) (cons v acc) acc))))\n"
"      (reverse (fold pcons '() list))))\n"
"\n"
"  (define (remove pred list)\n"
"    (filter (lambda (x) (not (pred x))) list))\n"
"\n"
"  (define (partition pred list)\n"
"    (values (filter pred list)\n"
"            (remove pred list)))\n"
"\n"
"  (define (filter! pred list)\n"
"    (let rec ((lst list))\n"
"      (if (null? lst)\n"
"          lst\n"
"          (if (pred (car lst))\n"
"              (begin (set-cdr! lst (rec (cdr lst)))\n"
"                     lst)\n"
"              (rec (cdr lst))))))\n"
"\n"
"  (define (remove! pred list)\n"
"    (filter! (lambda (x) (not (pred x))) list))\n"
"\n"
"  (define (partition! pred list)\n"
"    (values (filter! pred list)\n"
"            (remove! pred list)))\n"
"\n"
"  (export filter partition remove\n"
"          filter! partition! remove!)\n"
"\n"
"  ;; # Searching\n"
"  ;; member memq memv\n"
"  ;; find find-tail\n"
"  ;; any every\n"
"  ;; list-index\n"
"  ;; take-while drop-while take-while!\n"
"  ;; span break span! break!\n"
"\n"
"  (define (find-tail pred list)\n"
"    (if (null? list)\n"
"        #f\n"
"        (if (pred (car list))\n"
"            list\n"
"            (find-tail pred (cdr list)))))\n"
"\n"
"  (define (find pred list)\n"
"    (let ((tail (find-tail pred list)))\n"
"      (if tail\n"
"          (car tail)\n"
"          #f)))\n"
"\n"
"  (define (take-while pred clist)\n"
"    (let rec ((clist clist) (cont values))\n"
"      (if (null? clist)\n"
"          (cont '())\n"
"          (if (pred (car clist))\n"
"              (rec (cdr clist)\n"
"                   (lambda (x) (cont (cons (car clist) x))))\n"
"              (cont '())))))\n"
"\n"
"  (define (take-while! pred clist)\n"
"    (let rec ((clist clist))\n"
"      (if (null? clist)\n"
"          '()\n"
"          (if (pred (car clist))\n"
"              (begin (set-cdr! clist (rec (cdr clist)))\n"
"                     clist)\n"
"              '()))))\n"
"\n"
"  (define (drop-while pred clist)\n"
"    (let rec ((clist clist))\n"
"      (if (null? clist)\n"
"          '()\n"
"          (if (pred (car clist))\n"
"              (rec (cdr clist))\n"
"              clist))))\n"
"\n"
"  (define (span pred clist)\n"
"    (values (take-while pred clist)\n"
"            (drop-while pred clist)))\n"
"\n"
"  (define (span! pred clist)\n"
"    (values (take-while! pred clist)\n"
"            (drop-while pred clist)))\n"
"\n"
"  (define (break pred clist)\n"
"    (values (take-while (lambda (x) (not (pred x))) clist)\n"
"            (drop-while (lambda (x) (not (pred x))) clist)))\n"
"\n"
"  (define (break! pred clist)\n"
"    (values (take-while! (lambda (x) (not (pred x))) clist)\n"
"            (drop-while (lambda (x) (not (pred x))) clist)))\n"
"\n"
"  (define (any pred clist . clists)\n"
"    (if (null? clists)\n"
"        (let rec ((clist clist))\n"
"          (if (pair? clist)\n"
"              (or (pred (car clist))\n"
"                  (rec (cdr clist)))))\n"
"        (let rec ((clists (cons clist clists)))\n"
"          (if (every pair? clists)\n"
"              (or (apply pred (map car clists))\n"
"                  (rec (map cdr clists)))))))\n"
"\n"
"  (set! every\n"
"        (lambda (pred clist . clists)\n"
"          (if (null? clists)\n"
"              (let rec ((clist clist))\n"
"                (or (null? clist)\n"
"                    (if (pred (car clist))\n"
"                        (rec (cdr clist)))))\n"
"              (let rec ((clists (cons clist clists)))\n"
"                (or (any null? clists)\n"
"                    (if (apply pred (map car clists))\n"
"                        (rec (map cdr clists))))))))\n"
"\n"
"  (define (list-index pred clist . clists)\n"
"    (if (null? clists)\n"
"        (let rec ((clist clist) (n 0))\n"
"          (if (pair? clist)\n"
"              (if (pred (car clist))\n"
"                  n\n"
"                  (rec (cdr clist) (+ n 1)))))\n"
"        (let rec ((clists (cons clist clists)) (n 0))\n"
"          (if (every pair? clists)\n"
"              (if (apply pred (map car clists))\n"
"                  n\n"
"                  (rec (map cdr clists) (+ n 1)))))))\n"
"\n"
"  (export member memq memv\n"
"          find find-tail\n"
"          any every\n"
"          list-index\n"
"          take-while drop-while take-while!\n"
"          span break span! break!)\n"
"\n"
"  ;; # Deleting\n"
"  ;; delete delete-duplicates\n"
"  ;; delete! delete-duplicates!\n"
"  (define (delete x list . =)\n"
"    (let ((= (if (null? =) equal? (car =))))\n"
"      (remove (lambda (a) (= x a)) list)))\n"
"\n"
"  (define (delete! x list . =)\n"
"    (let ((= (if (null? =) equal? (car =))))\n"
"      (remove! (lambda (a) (= x a)) list)))\n"
"\n"
"  (define (delete-duplicates list . =)\n"
"    (let ((= (if (null? =) equal? (car =))))\n"
"      (let rec ((list list) (cont values))\n"
"        (if (null? list)\n"
"            (cont '())\n"
"            (let* ((x (car list))\n"
"                   (rest (cdr list))\n"
"                   (deleted (delete x rest =)))\n"
"              (rec deleted (lambda (y) (cont (cons x y)))))))))\n"
"\n"
"  (define (delete-duplicates! list . =)\n"
"    (let ((= (if (null? =) equal? (car =))))\n"
"      (let rec ((list list) (cont values))\n"
"        (if (null? list)\n"
"            (cont '())\n"
"            (let* ((x (car list))\n"
"                   (rest (cdr list))\n"
"                   (deleted (delete! x list =)))\n"
"              (rec deleted (lambda (y) (cont (cons x y)))))))))\n"
"\n"
"  (export delete delete-duplicates\n"
"          delete! delete-duplicates!)\n"
"\n"
"  ;; # Association lists\n"
"  ;; assoc assq assv\n"
"  ;; alist-cons alist-copy\n"
"  ;; alist-delete alist-delete!\n"
"  (define (alist-cons key datum alist)\n"
"    (cons (cons key datum) alist))\n"
"\n"
"  (define (alist-copy alist)\n"
"    (map (lambda (elt) (cons (car elt) (cdr elt))) alist))\n"
"\n"
"  (define (alist-delete key alist . =)\n"
"    (let ((= (if (null? =) equal? (car =))))\n"
"      (remove (lambda (x) (= key (car x))) alist)))\n"
"\n"
"  (define (alist-delete! key alist . =)\n"
"    (let ((= (if (null? =) equal? (car =))))\n"
"      (remove! (lambda (x) (= key (car x))) alist)))\n"
"\n"
"  (export assoc assq assv\n"
"          alist-cons alist-copy\n"
"          alist-delete alist-delete!)\n"
"\n"
"  ;; # Set operations on lists\n"
"  ;; lset<= lset= lset-adjoin\n"
"  ;; lset-union lset-union!\n"
"  ;; lset-intersection lset-intersection!\n"
"  ;; lset-difference lset-difference!\n"
"  ;; lset-xor lset-xor!\n"
"  ;; lset-diff+intersenction lset-diff+intersection!\n"
"  (define (lset<= = . lists)\n"
"    (or (null? lists)\n"
"        (let rec ((head (car lists)) (rest (cdr lists)))\n"
"          (or (null? rest)\n"
"              (let ((next (car rest)) (rest (cdr rest)))\n"
"                (and (or (eq? head next)\n"
"                         (every (lambda (x) (member x next =)) head))\n"
"                     (rec next rest)))))))\n"
"\n"
"  (define (lset= = . lists)\n"
"    (or (null? lists)\n"
"        (let rec ((head (car lists)) (rest (cdr lists)))\n"
"          (or (null? rest)\n"
"              (let ((next (car rest)) (rest (cdr rest)))\n"
"                (and (or (eq? head next)\n"
"                         (and (every (lambda (x) (member x next =)) head)\n"
"                              (every (lambda (x) (member x head =)) next))\n"
"                         (rec next rest))))))))\n"
"\n"
"  (define (lset-adjoin = list . elts)\n"
"    (let rec ((list list) (elts elts))\n"
"      (if (null? elts)\n"
"          list\n"
"          (if (member (car elts) list)\n"
"              (rec list (cdr elts))\n"
"              (rec (cons (car elts) list) (cdr elts))))))\n"
"\n"
"  (define (lset-union = . lists)\n"
"    (if (null? lists)\n"
"        lists\n"
"        (let rec ((head (car lists)) (rest (cdr lists)))\n"
"          (if (null? rest)\n"
"              head\n"
"              (let ((next (car rest)) (rest (cdr rest)))\n"
"                (if (eq? head next)\n"
"                    (rec head rest)\n"
"                    (rec (apply lset-adjoin = head next) rest)))))))\n"
"\n"
"  (define (lset-intersection = . lists)\n"
"    (if (null? lists)\n"
"        lists\n"
"        (let rec ((head (car lists)) (rest (cdr lists)))\n"
"          (if (null? rest)\n"
"              head\n"
"              (let ((next (car rest)) (rest (cdr rest)))\n"
"                (if (eq? head next)\n"
"                    (rec head rest)\n"
"                    (rec (filter (lambda (x) (member x next =)) head)\n"
"                         rest)))))))\n"
"\n"
"  (define (lset-difference = list . lists)\n"
"    (let rec ((head list) (rest lists))\n"
"      (if (null? rest)\n"
"          head\n"
"          (let ((next (car rest)) (rest (cdr rest)))\n"
"            (if (eq? head next)\n"
"                '()\n"
"                (rec (remove (lambda (x) (member x next =)) head)\n"
"                     rest))))))\n"
"\n"
"  (define (lset-xor = . lists)\n"
"    (if (null? lists)\n"
"        lists\n"
"        (let rec ((head (car lists)) (rest (cdr lists)))\n"
"          (if (null? rest)\n"
"              head\n"
"              (let ((next (car rest)) (rest (cdr rest)))\n"
"                (if (eq? head next)\n"
"                    '()\n"
"                    (rec (append (remove (lambda (x) (member x next =)) head)\n"
"                                 (remove (lambda (x) (member x head =)) next))\n"
"                         rest)))))))\n"
"\n"
"  (define (lset-diff+intersection = list . lists)\n"
"    (values (apply lset-difference = list lists)\n"
"            (lset-intersection = list (apply lset-union lists))))\n"
"\n"
"  (define (lset-adjoin! = list . elts)\n"
"    (let rec ((list list) (elts elts))\n"
"      (if (null? elts)\n"
"          list\n"
"          (if (member (car elts) list)\n"
"              (rec list (cdr elts))\n"
"              (let ((tail (cdr elts)))\n"
"                (set-cdr! elts list)\n"
"                (rec elts tail))))))\n"
"\n"
"  (define (lset-union! = . lists)\n"
"    (letrec ((adjoin\n"
"              (lambda (lst1 lst2)\n"
"                (if (null? lst2)\n"
"                    lst1\n"
"                    (if (member (car lst2) lst1 =)\n"
"                        (adjoin lst1 (cdr lst2))\n"
"                        (let ((tail (cdr lst2)))\n"
"                          (set-cdr! lst2 lst1)\n"
"                          (adjoin lst2 tail)))))))\n"
"      (if (null? lists)\n"
"          lists\n"
"          (let rec ((head (car lists)) (rest (cdr lists)))\n"
"            (if (null? rest)\n"
"                head\n"
"                (let ((next (car rest)) (rest (cdr rest)))\n"
"                  (if (eq? head next)\n"
"                      (rec head rest)\n"
"                      (rec (adjoin head next) rest))))))))\n"
"\n"
"  (define (lset-intersection! = . lists)\n"
"    (if (null? lists)\n"
"        lists\n"
"        (let rec ((head (car lists)) (rest (cdr lists)))\n"
"          (if (null? rest)\n"
"              head\n"
"              (let ((next (car rest)) (rest (cdr rest)))\n"
"                (if (eq? head next)\n"
"                    (rec head rest)\n"
"                    (rec (filter! (lambda (x) (member x next =)) head)\n"
"                         rest)))))))\n"
"\n"
"  (define (lset-difference! = list . lists)\n"
"    (let rec ((head list) (rest lists))\n"
"      (if (null? rest)\n"
"          head\n"
"          (let ((next (car rest)) (rest (cdr rest)))\n"
"            (if (eq? head next)\n"
"                '()\n"
"                (rec (remove! (lambda (x) (member x next =)) head)\n"
"                     rest))))))\n"
"\n"
"  (define (lset-xor! = . lists)\n"
"    (if (null? lists)\n"
"        lists\n"
"        (let rec ((head (car lists)) (rest (cdr lists)))\n"
"          (if (null? rest)\n"
"              head\n"
"              (let ((next (car rest)) (rest (cdr rest)))\n"
"                (if (eq? head next)\n"
"                    '()\n"
"                    (rec (append! (remove! (lambda (x) (member x next =)) head)\n"
"                                  (remove! (lambda (x) (member x head =)) next))\n"
"                         rest)))))))\n"
"\n"
"  (define (lset-diff+intersection! = list . lists)\n"
"    (values (apply lset-difference! = list lists)\n"
"            (lset-intersection! = list (apply lset-union! lists))))\n"
"\n"
"  (export lset<= lset= lset-adjoin\n"
"          lset-union lset-union!\n"
"          lset-intersection lset-intersection!\n"
"          lset-difference lset-difference!\n"
"          lset-xor lset-xor!\n"
"          lset-diff+intersection lset-diff+intersection!)\n"
"\n"
"  ;; # Primitive side-effects\n"
"  ;; set-car! set-cdr!\n"
"  (export set-car! set-cdr!))\n"
;

static const char *piclib_src__Users_yuichi_workspace_picrin_piclib_srfi_8 =
"(define-library (srfi 8)\n"
"  (import (scheme base))\n"
"\n"
"  (define-syntax receive\n"
"    (syntax-rules ()\n"
"      ((receive formals expression body ...)\n"
"       (call-with-values (lambda () expression)\n"
"         (lambda formals body ...)))))\n"
"\n"
"    (export receive))\n"
;

static const char *piclib_src__Users_yuichi_workspace_picrin_piclib_srfi_26 =
"(define-library (srfi 26)\n"
"  (import (scheme base)\n"
"	  (picrin macro)\n"
"	  (srfi 1))\n"
"\n"
"  (define-syntax cut%\n"
"    (ir-macro-transformer\n"
"     (lambda (form inject compare?)\n"
"       (let ((slots (second form))\n"
"	     (combi (third form))\n"
"	     (se (cdddr form)))\n"
"	 (cond ((null? se)\n"
"		`(lambda ,slots ((begin ,(car combi)) ,@(cdr combi))))\n"
"	       ((and (symbol? (car se))\n"
"		     (compare? (car se) '<...>))\n"
"		`(lambda (,@slots . rest-slot) (apply ,@combi rest-slot)))\n"
"	       ((and (symbol? (car se))\n"
"		     (compare? (car se) '<>))\n"
"		`(cut% (,@slots x) (,@combi x) ,@(cdr se)))\n"
"	       (else `(cut% ,slots (,@combi ,(car se)) ,@(cdr se))))))))\n"
"\n"
"  (define-syntax cute%\n"
"    (ir-macro-transformer\n"
"     (lambda (form inject compare?)\n"
"       (let ((slots (second form))\n"
"	     (binds (third form))\n"
"	     (combi (fourth form))\n"
"	     (se (cddddr form)))\n"
"	 (cond ((null? se)\n"
"		`(let ,binds\n"
"		   (lambda ,slots ((begin ,(car combi)) ,@(cdr combi)))))\n"
"	       ((and (symbol? (car se))\n"
"		     (compare? (car se) '<...>))\n"
"		`(let ,binds\n"
"		   (lambda (,@slots . rest-slot) (apply ,@combi rest-slot))))\n"
"	       ((and (symbol? (car se))\n"
"		     (compare? (car se) '<>))\n"
"		`(cute% (,@slots x) ,binds (,@combi x) ,@(cdr se)))\n"
"	       (else\n"
"		`(cute% ,slots ((x ,(car se)) ,@binds)\n"
"			(,@combi x) ,@(cdr se))))))))\n"
"  \n"
"  (define-syntax cut\n"
"    (ir-macro-transformer\n"
"     (lambda (form inject compare?)\n"
"       `(cut% () () ,@(cdr form)))))\n"
"\n"
"  (define-syntax cute\n"
"    (ir-macro-transformer\n"
"     (lambda (form inject compare?)\n"
"       `(cute% () () () ,@(cdr form)))))\n"
"\n"
"  (export cut cute))\n"
;

static const char *piclib_src__Users_yuichi_workspace_picrin_piclib_srfi_43 =
"(define-library (srfi 43)\n"
"  (import (scheme base)\n"
"          (srfi 8))\n"
"  \n"
"  ;; # Constructors\n"
"  (define (vector-unfold f length . seeds)\n"
"    (let ((seeds (if (null? seeds) '(0) seeds))\n"
"          (vect (make-vector length)))\n"
"      (letrec ((tabulate\n"
"                (lambda (count . args)\n"
"                  (if (= length count)\n"
"                      vect\n"
"                      (receive lst (apply f count args)\n"
"                               (vector-set! vect count (car lst))\n"
"                               (apply tabulate (+ 1 count) (cdr lst)))))))\n"
"        (apply tabulate 0 seeds))))\n"
"\n"
"  (define (vector-unfold-right f length . seeds)\n"
"    (let ((seeds (if (null? seeds) '(0) seeds))\n"
"          (vect (make-vector length)))\n"
"      (letrec ((tabulate\n"
"                (lambda (count . args)\n"
"                  (if (< count 0)\n"
"                      vect\n"
"                      (receive lst (apply f count args)\n"
"                               (vector-set! vect count (car lst))\n"
"                               (apply tabulate (- count 1) (cdr lst)))))))\n"
"        (apply tabulate (- length 1) seeds))))\n"
"\n"
"  (define (vector-reverse-copy vec . rst)\n"
"    (let* ((start (if (null? rst) 0 (car rst)))\n"
"           (end (if (or (null? rst) (null? (cdr rst)))\n"
"                    (vector-length vec)\n"
"                    (cadr rst)))\n"
"           (new-vect (make-vector (- end start))))\n"
"      (let loop ((i (- end 1)) (count 0))\n"
"        (if (< i start)\n"
"            new-vect\n"
"            (begin\n"
"              (vector-set! new-vect count (vector-ref vec i))\n"
"              (loop (- i 1) (+ 1 count)))))))\n"
"\n"
"  (define (vector-concatenate list-of-vectors)\n"
"    (apply vector-append list-of-vectors))\n"
"\n"
"  \n"
"  ;; # Predicates\n"
"  (define (vector-empty? vec)\n"
"    (zero? (vector-length vec)))\n"
"\n"
"                                        ; for the symmetry, this should be rather 'vector=?' than 'vector='.\n"
"  (define (vector= elt=? . vects)\n"
"    (letrec ((vector2=\n"
"              (lambda (v1 v2)\n"
"                (let ((ln1 (vector-length v1)))\n"
"                  (and (= ln1 (vector-length v2))\n"
"                       (let loop ((count 0))\n"
"                         (if (= ln1 count)\n"
"                             #t\n"
"                             (and (elt=? (vector-ref v1 count)\n"
"                                         (vector-ref v2 count))\n"
"                                  (loop (+ 1 count))))))))))\n"
"      (or (null? vects)\n"
"          (let rec1 ((vect1 (car vects)) (others (cdr vects)))\n"
"            (or (null? others)\n"
"                (let ((vect2 (car others))\n"
"                      (others (cdr others)))\n"
"                  (if (eq? vect1 vect2)\n"
"                      (rec1 vect1 others)\n"
"                      (and (vector2= vect1 vect2)\n"
"                           (rec1 vect2 others)))))))))\n"
"\n"
"  \n"
"  ;; # Iteration\n"
"  (define (vector-fold kons knil vec . vects)\n"
"    (let* ((vects (cons vec vects))\n"
"           (veclen (apply min (map vector-length vects))))\n"
"      (let rec ((acc knil) (count 0))\n"
"        (if (= count veclen)\n"
"            acc\n"
"            (rec (apply kons count acc\n"
"                        (map (lambda (v) (vector-ref v count)) vects))\n"
"                 (+ 1 count))))))\n"
"\n"
"  (define (vector-fold-right kons knil vec . vects)\n"
"    (let* ((vects (cons vec vects))\n"
"           (veclen (apply min (map vector-length vects))))\n"
"      (let rec ((acc knil) (count (- veclen 1)))\n"
"        (if (< count 0)\n"
"            acc\n"
"            (rec (apply kons count acc\n"
"                        (map (lambda (v) (vector-ref v count)) vects))\n"
"                 (- count 1))))))\n"
"\n"
"  (define (vector-map! f vec . vects)\n"
"    (let* ((vects (cons vec vects))\n"
"           (veclen (apply min (map vector-length vects)))\n"
"           (new-vect (make-vector veclen)))\n"
"      (let rec ((count 0))\n"
"        (if (< count veclen)\n"
"            (begin\n"
"              (vector-set! vec count\n"
"                           (apply f (map (lambda (v) (vector-ref v count))\n"
"                                         vects)))\n"
"              (rec (+ 1 count)))))))\n"
"\n"
"  (define (vector-count pred? vec . vects)\n"
"    (let* ((vects (cons vec vects))\n"
"           (veclen (apply min (map vector-length vects))))\n"
"      (let rec ((i 0) (count 0))\n"
"        (if (= i veclen)\n"
"            count\n"
"            (if (apply pred? count (map (lambda (v) (vector-ref v count)) vects))\n"
"                (rec (+ 1 i) (+ 1 count))\n"
"                (rec (+ 1 i) count))))))\n"
"\n"
"  ;; # Searching\n"
"  (define (vector-index pred? vec . vects)\n"
"    (let* ((vects (cons vec vects))\n"
"           (veclen (apply min (map vector-length vects))))\n"
"      (let rec ((count 0))\n"
"        (cond\n"
"         ((= count veclen) #f)\n"
"         ((apply pred? (map (lambda (v) (vector-ref v count)) vects))\n"
"          count)\n"
"         (else (rec (+ 1 count)))))))\n"
"\n"
"  (define (vector-index-right pred? vec . vects)\n"
"    (let ((vects (cons vec vects))\n"
"          (veclen (vector-length vec)))\n"
"      (let rec ((count (- veclen 1)))\n"
"        (cond\n"
"         ((< count 0) #f)\n"
"         ((apply pred? (map (lambda (v) (vector-ref v count)) vects))\n"
"          count)\n"
"         (else (rec (- count 1)))))))\n"
"\n"
"  (define (vector-skip pred? vec . vects)\n"
"    (apply vector-index (lambda args (not (apply pred? args))) vec vects))\n"
"\n"
"  (define (vector-skip-right pred? vec . vects)\n"
"    (apply vector-index-right (lambda args (not (apply pred? args))) vec vects))\n"
"\n"
"  (define (vector-binary-search vec value cmp)\n"
"    (let rec ((start 0) (end (vector-length vec)) (n -1))\n"
"      (let ((count (floor/ (+ start end) 2)))\n"
"        (if (or (= start end) (= count n))\n"
"            #f\n"
"            (let ((comparison (cmp (vector-ref vec count) value)))\n"
"              (cond\n"
"               ((zero? comparison) count)\n"
"               ((positive? comparison) (rec start count count))\n"
"               (else (rec count end count))))))))\n"
"\n"
"  (define (vector-any pred? vec . vects)\n"
"    (let* ((vects (cons vec vects))\n"
"           (veclen (vector-length vec)))\n"
"      (let rec ((count 0))\n"
"        (if (= count veclen)\n"
"            #f\n"
"            (or (apply pred? (map (lambda (v) (vector-ref v count)) vects))\n"
"                (rec (+ 1 count)))))))\n"
"\n"
"  (define (vector-every pred? vec . vects)\n"
"    (let* ((vects (cons vec vects))\n"
"           (veclen (vector-length vec)))\n"
"      (let rec ((count 0))\n"
"        (if (= count veclen)\n"
"            #t\n"
"            (and (apply pred? (map (lambda (v) (vector-ref v count)) vects))\n"
"                 (rec (+ 1 count)))))))\n"
"\n"
"  ;; # Mutators\n"
"  (define (vector-swap! vec i j)\n"
"    (let ((tmp (vector-ref vec i)))\n"
"      (vector-set! vec i (vector-ref vec j))\n"
"      (vector-set! vec j tmp)))\n"
"\n"
"  (define (vector-reverse! vec . rst)\n"
"    (let ((start (if (null? rst) 0 (car rst)))\n"
"          (end (if (or (null? rst) (cdr rst))\n"
"                   (vector-length vec)\n"
"                   (cadr rst))))\n"
"      (let rec ((i start) (j (- end 1)))\n"
"        (if (< i j)\n"
"            (begin\n"
"              (vector-swap! vec i j)\n"
"              (rec (+ 1 i) (- j 1)))))))\n"
"\n"
"  (define (vector-reverse-copy! target tstart source . rst)\n"
"    (let ((sstart (if (null? rst) 0 (car rst)))\n"
"          (send (if (or (null? rst) (cdr rst))\n"
"                    (vector-length source)\n"
"                    (cadr rst))))\n"
"      (let rec ((i tstart) (j (- send 1)))\n"
"        (if (>= j sstart)\n"
"            (begin\n"
"              (vector-set! target i (vector-ref source j))\n"
"              (rec (+ 1 i) (- j 1)))))))\n"
"\n"
"  ;; # Conversion\n"
"  (define (reverse-vector->list vec . rst)\n"
"    (let ((start (if (null? rst) 0 (car rst)))\n"
"          (end (if (or (null? rst) (cdr rst))\n"
"                   (vector-length vec)\n"
"                   (cadr rst))))\n"
"      (let rec ((i start) (acc '()))\n"
"        (if (= i end)\n"
"            acc\n"
"            (rec (+ 1 i) (cons (vector-ref vec i) acc))))))\n"
"\n"
"  (define (reverse-list->vector proper-list)\n"
"    (apply vector (reverse proper-list)))\n"
"\n"
"  (export vector?\n"
"          make-vector\n"
"          vector\n"
"          vector-length\n"
"          vector-ref\n"
"          vector-set!\n"
"          vector->list\n"
"          list->vector\n"
"          vector-fill!\n"
"          vector-copy!\n"
"\n"
"          vector-unfold\n"
"          vector-unfold-right\n"
"          vector-reverse-copy\n"
"          vector-concatenate\n"
"          vector-empty?\n"
"          vector=\n"
"          vector-fold\n"
"          vector-fold-right\n"
"          vector-map!\n"
"          vector-count\n"
"          vector-index\n"
"          vector-index-right\n"
"          vector-skip\n"
"          vector-skip-right\n"
"          vector-binary-search\n"
"          vector-any\n"
"          vector-every\n"
"          vector-swap!\n"
"          vector-reverse!\n"
"          vector-reverse-copy!\n"
"          reverse-vector->list\n"
"          reverse-list->vector))\n"
;

static const char *piclib_src__Users_yuichi_workspace_picrin_piclib_srfi_60 =
"(define-library (srfi 60)\n"
"  (import (scheme base)\n"
"          (srfi 1))\n"
"\n"
"  ;; # Bitwise Operations\n"
"  (define (logand . args)\n"
"    (letrec ((lgand\n"
"              (lambda (x y)\n"
"                (if (or (zero? x) (zero? y))\n"
"                    0\n"
"                    (+ (* (lgand (floor/ x 2) (floor/ y 2)) 2)\n"
"                       (if (or (even? x) (even? y)) 0 1))))))\n"
"      (fold lgand -1 args)))\n"
"\n"
"  (define bitwise-and logand)\n"
"\n"
"  (define (logior . args)\n"
"    (letrec ((lgior\n"
"              (lambda (x y)\n"
"                (cond\n"
"                 ((= x y) x)\n"
"                 ((zero? x) y)\n"
"                 ((zero? y) x)\n"
"                 (else\n"
"                  (+ (* (lgior (truncate-quotient x 2)\n"
"                               (truncate-quotient y 2))\n"
"                        2)\n"
"                     (if (and (even? x) (even? y)) 0 1)))))))\n"
"      (fold lgior 0 args)))\n"
"\n"
"  (define bitwise-ior logior)\n"
"\n"
"  (define (logxor . args)\n"
"    (letrec ((lgxor\n"
"              (lambda (x y)\n"
"                (cond\n"
"                 ((zero? x) y)\n"
"                 ((zero? y) x)\n"
"                 (else\n"
"                  (+ (* (lgxor (floor/ x 2) (floor/ y 2)) 2)\n"
"                     (if (even? x)\n"
"                         (if (even? y) 0 1)\n"
"                         (if (even? y) 1 0))))))))\n"
"      (fold lgxor 0 args)))\n"
"\n"
"  (define bitwise-xor logxor)\n"
"\n"
"  (define (lognot n)\n"
"    (- -1 n))\n"
"\n"
"  (define bitwise-not lognot)\n"
"\n"
"  (define (bitwise-if mask n0 n1)\n"
"    (logior (logand mask n0)\n"
"            (logand (lognot mask) n1)))\n"
"\n"
"  (define bitwise-merge bitwise-if)\n"
"\n"
"  (define (logtest j k)\n"
"    (not (zero? (logand j k))))\n"
"\n"
"  (define any-bits-set? logtest)\n"
"\n"
"  ;; # Integer Properties\n"
"  (define (logcount n)\n"
"    (letrec ((lgcnt\n"
"              (lambda (n)\n"
"                (if (zero? n) 0\n"
"                    (+ (lgcnt (floor/ n 2))\n"
"                       (if (even? n) 0 1))))))\n"
"      (if (negative? n)\n"
"          (lgcnt (lognot n))\n"
"          (lgcnt n))))\n"
"\n"
"  (define bit-count logcount)\n"
"\n"
"  (define (integer-length n)\n"
"    (let loop ((n n) (count 0))\n"
"      (if (zero? n)\n"
"          count\n"
"          (loop (floor/ n 2) (+ count 1)))))\n"
"\n"
"  (define (log2-binary-factors n)\n"
"    (+ -1 (integer-length (logand n (- n)))))\n"
"\n"
"  (define first-set-bit log2-binary-factors)\n"
"  \n"
"  ;; # Bit Within Word\n"
"  (define (logbit? index n)\n"
"    (logtest (expt 2 index) n))\n"
"\n"
"  (define bit-set? logbit?)\n"
"\n"
"  (define (copy-bit index from bit)\n"
"    (if bit\n"
"        (logior from (expt 2 index))\n"
"        (logand from (lognot (expt 2 index)))))\n"
"\n"
"\n"
"  ;; # Field of Bits\n"
"  (define (ash n count)\n"
"    (if (negative? count)\n"
"        (let ((k (expt 2 (- count))))\n"
"          (if (negative? n)\n"
"              (+ -1 (truncate-quotient (+ 1 n) k))\n"
"              (truncate-quotient n k)))\n"
"        (* (expt 2 count) n)))\n"
"\n"
"  (define arithmetic-shift ash)\n"
"\n"
"  (define (bit-field n start end)\n"
"    (logand (lognot (ash -1 (- end start)))\n"
"            (ash n (- start))))\n"
"\n"
"  (define (copy-bit-field to from start end)\n"
"    (bitwise-if (ash (lognot (ash -1 (- end start))) start)\n"
"                (ash from start)\n"
"                to))\n"
"\n"
"  (define (rotate-bit-field n count start end)\n"
"    (let* ((width (- start end))\n"
"           (count (floor-remainder count width))\n"
"           (mask (lognot (ash -1 width)))\n"
"           (zn (logand mask (ash n (- start)))))\n"
"      (logior (ash (logior (logand mask (ash zn count))\n"
"                           (ash zn (- count width)))\n"
"                   start)\n"
"              (logand (lognot (ash mask start)) n))))\n"
"\n"
"  (define (reverse-bit-field n start end)\n"
"    (letrec ((bit-reverse\n"
"              (lambda (k n)\n"
"                (let loop ((m (if (negative? n) (lognot n) n))\n"
"                           (k (- k 1))\n"
"                           (rvs 0))\n"
"                  (if (negative? k)\n"
"                      (if (negative? n) (lognot rvs) rvs)\n"
"                      (loop (ash m -1)\n"
"                            (- k 1)\n"
"                            (logior (ash rvs 1) (logand 1 m))))))))\n"
"      (let* ((width (- start end))\n"
"             (mask (lognot (ash -1 width)))\n"
"             (zn (logand mask (ash n (- start)))))\n"
"        (logior (ash (bit-reverse width zn) start)\n"
"                (logand (lognot (ash mask start)) n)))))\n"
"\n"
"  ;; Bits as Booleans\n"
"  (define (integer->list k . len)\n"
"    (let ((len (if (null? len) (integer-length k) len)))\n"
"      (let loop ((k k) (len len) (acc '()))\n"
"        (if (or (zero? k) (zero? len))\n"
"            acc\n"
"            (loop (floor/ k 2) (- len 1) (cons (if (even? k) #f #t) acc))))))\n"
"\n"
"  (define (list->integer lst)\n"
"    (let loop ((lst lst) (acc 0))\n"
"      (if (null? lst)\n"
"          acc\n"
"          (loop (cdr lst) (+ (* acc 2) (if (car lst) 1 0))))))\n"
"\n"
"  (define (booleans->integer . args)\n"
"    (list->integer args))\n"
"\n"
"  (export logand bitwise-and\n"
"          logior bitwise-ior\n"
"          logxor bitwise-xor\n"
"          lognot bitwise-not\n"
"          bitwise-if bitwise-merge\n"
"          logtest any-bits-set?\n"
"          logcount bit-count\n"
"          integer-length\n"
"          log2-binary-factors first-set-bit\n"
"          logbit? bit-set?\n"
"          copy-bit\n"
"          bit-field\n"
"          copy-bit-field\n"
"          ash arithmetic-shift\n"
"          rotate-bit-field\n"
"          reverse-bit-field\n"
"          integer->list\n"
"          list->integer\n"
"          booleans->integer))\n"
;

static const char *piclib_src__Users_yuichi_workspace_picrin_piclib_srfi_95 =
"(define-library (srfi 95)\n"
"  (import (scheme base)\n"
"          (scheme load)\n"
"          (srfi 1))\n"
"\n"
"  (define (list-sorted? ls less?)\n"
"    (let loop ((cur ls))\n"
"      (if (<= (length cur) 1)\n"
"          #t\n"
"          (if (less? (second cur) (first cur))\n"
"              #f\n"
"              (loop (cdr cur))))))\n"
"\n"
"  (define (identity x)\n"
"    x)\n"
"\n"
"  (define (merge ls1 ls2 less? . opt-key)\n"
"    (let ((key (if (null? opt-key) identity (car opt-key))))\n"
"      (let rec ((arg1 ls1) (arg2 ls2))\n"
"        (cond ((null? arg1)\n"
"               arg2)\n"
"              ((null? arg2)\n"
"               arg1)\n"
"              ((less? (key (car arg1)) (key (car arg2)))\n"
"               (cons (car arg1) (rec (cdr arg1) arg2)))\n"
"              (else\n"
"               (cons (car arg2) (rec arg1 (cdr arg2))))))))\n"
"\n"
"  (define (merge-sub! ls1 ls2 less? key)\n"
"    (let rec ((arg1 ls1) (arg2 ls2))\n"
"      (cond ((null? arg1)\n"
"             arg2)\n"
"            ((null? arg2)\n"
"             arg1)\n"
"            ((not (less? (key (car arg2)) (key (car arg1))))\n"
"             (set-cdr! arg1 (rec (cdr arg1) arg2)) arg1)\n"
"            (else\n"
"             (set-cdr! arg2 (rec arg1 (cdr arg2))) arg2))))\n"
"\n"
"  (define (merge! ls1 ls2 less? . opt-key)\n"
"    (let ((key (if (null? opt-key) identity (car opt-key)))\n"
"          (c1 (car ls1))\n"
"          (c2 (car ls2))\n"
"          (d1 (cdr ls1))\n"
"          (d2 (cdr ls2)))\n"
"      (when (less? (key c2) (key c1))\n"
"        (set-car! ls1 c2)\n"
"        (set-car! ls2 c1)\n"
"        (set-cdr! ls1 d2)\n"
"        (set-cdr! ls2 d1))\n"
"      (merge-sub! ls1 ls2 less? key)))\n"
"\n"
"  (define (merge-sort ls less?)\n"
"       (if (<= (length ls) 1)\n"
"           ls\n"
"           (let* ((n (length ls))\n"
"                  (p (quotient n 2))\n"
"                  (as (take ls p))\n"
"                  (bs (drop ls p))\n"
"                  (sa (merge-sort as less?))\n"
"                  (sb (merge-sort bs less?)))\n"
"             (merge sa sb less?))))\n"
"\n"
"  (define (merge-sort! ls less?)\n"
"    (if (<= (length ls) 1) ls\n"
"        (let* ((n (length ls))\n"
"               (p (quotient n 2))\n"
"               (bs (drop ls p))\n"
"               (as (take! ls p))\n"
"               (sa (merge-sort! as less?))\n"
"               (sb (merge-sort! bs less?)))\n"
"          (merge! sa sb less?))))\n"
"\n"
"  (export list-sorted?\n"
"          merge\n"
"          merge!\n"
"          merge-sort\n"
"          merge-sort!))\n"
;

static const char *piclib_src__Users_yuichi_workspace_picrin_piclib_srfi_111 =
"(define-library (srfi 111)\n"
"  (import (scheme base))\n"
"\n"
"  (define-record-type <box>\n"
"    (box value)\n"
"    box?\n"
"    (value unbox set-box!))\n"
"\n"
"  (export box box?\n"
"          unbox set-box!))\n"
;

static const char *piclib_src__Users_yuichi_workspace_picrin_piclib_picrin_user =
";  the default repl environment\n"
"\n"
"(define-library (picrin user)\n"
"  (import (scheme base)\n"
"          (scheme load)\n"
"          (scheme process-context)\n"
"          (scheme read)\n"
"          (scheme write)\n"
"          (scheme file)\n"
"          (scheme inexact)\n"
"          (scheme cxr)\n"
"          (scheme lazy)\n"
"          (scheme time)\n"
"          (picrin macro)\n"
"          (picrin dictionary)\n"
"          (picrin array)\n"
"          (picrin library)))\n"
;

static const char *piclib_src__Users_yuichi_workspace_picrin_piclib_picrin_repl =
"(define-library (picrin repl)\n"
"  (import (scheme base)\n"
"          (scheme read)\n"
"          (scheme file)\n"
"          (scheme write)\n"
"          (scheme eval)\n"
"          (scheme process-context))\n"
"\n"
"  (define (join sep strs)\n"
"    (let loop ((result (car strs)) (rest (cdr strs)))\n"
"      (if (null? rest)\n"
"          result\n"
"          (loop (string-append result sep (car rest)) (cdr rest)))))\n"
"\n"
"  (define (file->string file)\n"
"    (with-input-from-file file\n"
"      (lambda ()\n"
"        (let loop ((line (read-line)) (acc '()))\n"
"          (if (eof-object? line)\n"
"              (join \"\\n\" (reverse acc))\n"
"              (loop (read-line) (cons line acc)))))))\n"
"\n"
"  (define (print obj . port)\n"
"    (let ((port (if (null? port) (current-output-port) (car port))))\n"
"      (write obj port)\n"
"      (newline port)\n"
"      obj))\n"
"\n"
"  (define (print-help)\n"
"    (display \"picrin scheme\\n\")\n"
"    (display \"\\n\")\n"
"    (display \"Usage: picrin [options] [file]\\n\")\n"
"    (display \"\\n\")\n"
"    (display \"Options:\\n\")\n"
"    (display \"  -e [program]		run one liner script\\n\")\n"
"    (display \"  -h or --help		show this help\\n\"))\n"
"\n"
"  (define (getopt)\n"
"    (let ((args (cdr (command-line))))\n"
"      (if (null? args)\n"
"          #f\n"
"          (case (string->symbol (car args))\n"
"            ((-h --help)\n"
"             (print-help)\n"
"             (exit 1))\n"
"            ((-e)\n"
"             (cadr args))\n"
"            (else\n"
"             (file->string (car args)))))))\n"
"\n"
"  (define (main-loop in out on-err)\n"
"    (display \"> \" out)\n"
"    (let ((expr (read in)))\n"
"      (if (eof-object? expr)\n"
"          (newline out)                 ; exit\n"
"          (begin\n"
"            (call/cc\n"
"             (lambda (leave)\n"
"              (with-exception-handler\n"
"               (lambda (condition)\n"
"                 (display (error-object-message condition) (current-error-port))\n"
"                 (newline)\n"
"                 (if on-err\n"
"                     (on-err)\n"
"                     (leave)))\n"
"               (lambda ()\n"
"                 (print (eval expr '(picrin user)) out)))))\n"
"            (main-loop in out on-err)))))\n"
"\n"
"  (define (run-repl program)\n"
"    (let ((in (if program\n"
"                  (open-input-string program)\n"
"                  (current-input-port)))\n"
"          (out (if program\n"
"                   (open-output-string) ; ignore output\n"
"                   (current-output-port)))\n"
"          (on-err (if program\n"
"                      (lambda () (exit 1))\n"
"                      #f)))\n"
"      (main-loop in out on-err)))\n"
"\n"
"  (define (repl)\n"
"    (let ((program (getopt)))\n"
"      (run-repl program)))\n"
"\n"
"  (export repl))\n"
;

static const char *piclib_src__Users_yuichi_workspace_picrin_contrib_10_partcont_piclib_partcont =
"(define-library (picrin control)\n"
"  (import (scheme base))\n"
"\n"
"  ; based on paper \"Representing Monads\" (Filinski 1994)\n"
"\n"
"  (define m #f)\n"
"\n"
"  (define (abort t)\n"
"    (let ((v (t)))                      ; (t) may update m. do not place me like (m (t))\n"
"      (m v)))\n"
"\n"
"  (define (reset t)\n"
"    (let ((n m))\n"
"      (call/cc\n"
"       (lambda (k)\n"
"         (set! m (lambda (r)\n"
"                   (set! m n)\n"
"                   (k r)))\n"
"         (abort t)))))\n"
"\n"
"  (define (shift h)\n"
"    (call/cc\n"
"     (lambda (k)\n"
"       (abort\n"
"        (lambda ()\n"
"          (h (lambda (v)\n"
"               (reset (lambda ()\n"
"                        (k v))))))))))\n"
"\n"
"  (export shift\n"
"          reset))\n"
"\n"
;

static const char *piclib_src__Users_yuichi_workspace_picrin_contrib_10_pretty_print_pretty_print =
"(define-library (picrin pretty-print)\n"
"  (import (scheme base)\n"
"          (scheme write))\n"
"\n"
"  ; (reverse-string-append l) = (apply string-append (reverse l))\n"
"\n"
"  (define (reverse-string-append l)\n"
"\n"
"    (define (rev-string-append l i)\n"
"      (if (pair? l)\n"
"          (let* ((str (car l))\n"
"                 (len (string-length str))\n"
"                 (result (rev-string-append (cdr l) (+ i len))))\n"
"            (let loop ((j 0) (k (- (- (string-length result) i) len)))\n"
"              (if (< j len)\n"
"                  (begin\n"
"                    (string-set! result k (string-ref str j))\n"
"                    (loop (+ j 1) (+ k 1)))\n"
"                  result)))\n"
"          (make-string i)))\n"
"\n"
"    (rev-string-append l 0))\n"
"\n"
"  ;; We define a pretty printer for Scheme S-expressions (sexp). While\n"
"  ;; Petite Scheme supports that by its own, mzscheme does not. If you\n"
"  ;; get a sexp (like from proof-to-expr) prefix it with a call to spp and\n"
"  ;; the output is nicely formated to fit into pp-width many columns:\n"
"  ;;\n"
"  ;;  (spp (proof-to-expr (current-proof)))\n"
"  ;;\n"
"\n"
"  (define pp-width 80)\n"
"\n"
"  ;;\"genwrite.scm\" generic write used by pretty-print and truncated-print.\n"
"  ;; Copyright (c) 1991, Marc Feeley\n"
"  ;; Author: Marc Feeley (feeley@iro.umontreal.ca)\n"
"  ;; Distribution restrictions: none\n"
"  ;;\n"
"  ;; Modified for Minlog by Stefan Schimanski <schimans@math.lmu.de>\n"
"  ;; Taken from slib 2d6, genwrite.scm and pp.scm\n"
"\n"
"  (define genwrite:newline-str (make-string 1 #\\newline))\n"
"\n"
"  (define (generic-write obj display? width output)\n"
"\n"
"    (define (read-macro? l)\n"
"      (define (length1? l) (and (pair? l) (null? (cdr l))))\n"
"      (let ((head (car l)) (tail (cdr l)))\n"
"        (case head\n"
"          ((quote quasiquote unquote unquote-splicing) (length1? tail))\n"
"          (else                                        #f))))\n"
"\n"
"    (define (read-macro-body l)\n"
"      (cadr l))\n"
"\n"
"    (define (read-macro-prefix l)\n"
"      (let ((head (car l)) (tail (cdr l)))\n"
"        (case head\n"
"          ((quote)            \"'\")\n"
"          ((quasiquote)       \"`\")\n"
"          ((unquote)          \",\")\n"
"          ((unquote-splicing) \",@\"))))\n"
"\n"
"    (define (out str col)\n"
"      (and col (output str) (+ col (string-length str))))\n"
"\n"
"    (define (wr obj col)\n"
"\n"
"      (define (wr-lst l col)\n"
"        (if (pair? l)\n"
"            (let loop ((l (cdr l))\n"
"                       (col (and col (wr (car l) (out \"(\" col)))))\n"
"              (cond ((not col) col)\n"
"                    ((pair? l)\n"
"                     (loop (cdr l) (wr (car l) (out \" \" col))))\n"
"                    ((null? l) (out \")\" col))\n"
"                    (else      (out \")\" (wr l (out \" . \" col))))))\n"
"            (out \"()\" col)))\n"
"\n"
"      (define (wr-expr expr col)\n"
"        (if (read-macro? expr)\n"
"            (wr (read-macro-body expr) (out (read-macro-prefix expr) col))\n"
"            (wr-lst expr col)))\n"
"\n"
"      (cond ((pair? obj)        (wr-expr obj col))\n"
"            ((null? obj)        (wr-lst obj col))\n"
"            ((vector? obj)      (wr-lst (vector->list obj) (out \"#\" col)))\n"
"            ((boolean? obj)     (out (if obj \"#t\" \"#f\") col))\n"
"            ((number? obj)      (out (number->string obj) col))\n"
"            ((symbol? obj)      (out (symbol->string obj) col))\n"
"            ((procedure? obj)   (out \"#[procedure]\" col))\n"
"            ((string? obj)      (if display?\n"
"                                    (out obj col)\n"
"                                    (let loop ((i 0) (j 0) (col (out \"\\\"\" col)))\n"
"                                      (if (and col (< j (string-length obj)))\n"
"                                          (let ((c (string-ref obj j)))\n"
"                                            (if (or (char=? c #\\\\)\n"
"                                                    (char=? c #\\\"))\n"
"                                                (loop j\n"
"                                                      (+ j 1)\n"
"                                                      (out \"\\\\\"\n"
"                                                           (out (substring obj i j)\n"
"                                                                col)))\n"
"                                                (loop i (+ j 1) col)))\n"
"                                          (out \"\\\"\"\n"
"                                               (out (substring obj i j) col))))))\n"
"            ((char? obj)        (if display?\n"
"                                    (out (make-string 1 obj) col)\n"
"                                    (out (case obj\n"
"                                           ((#\\space)   \"space\")\n"
"                                           ((#\\newline) \"newline\")\n"
"                                           (else        (make-string 1 obj)))\n"
"                                         (out \"#\\\\\" col))))\n"
"            ((input-port? obj)  (out \"#[input-port]\" col))\n"
"            ((output-port? obj) (out \"#[output-port]\" col))\n"
"            ((eof-object? obj)  (out \"#[eof-object]\" col))\n"
"            (else               (out \"#[unknown]\" col))))\n"
"\n"
"    (define (pp obj col)\n"
"\n"
"      (define (spaces n col)\n"
"        (if (> n 0)\n"
"            (if (> n 7)\n"
"                (spaces (- n 8) (out \"        \" col))\n"
"                (out (substring \"        \" 0 n) col))\n"
"            col))\n"
"\n"
"      (define (indent to col)\n"
"        (and col\n"
"             (if (< to col)\n"
"                 (and (out genwrite:newline-str col) (spaces to 0))\n"
"                 (spaces (- to col) col))))\n"
"\n"
"      (define pp-list #f)\n"
"      (define pp-expr #f)\n"
"      (define pp-call #f)\n"
"      (define pp-down #f)\n"
"      (define pp-general #f)\n"
"      (define pp-width #f)\n"
"      (define pp-expr-list #f)\n"
"\n"
"      (define indent-general #f)\n"
"      (define max-expr-width #f)\n"
"      (define max-call-head-width #f)\n"
"      (define style #f)\n"
"\n"
"      (define pr\n"
"        (lambda (obj col extra pp-pair)\n"
"          (if (or (pair? obj) (vector? obj)) ; may have to split on multiple lines\n"
"              (let ((result '())\n"
"                    (left (min (+ (- (- width col) extra) 1) max-expr-width)))\n"
"                (generic-write obj display? #f\n"
"                               (lambda (str)\n"
"                                 (set! result (cons str result))\n"
"                                 (set! left (- left (string-length str)))\n"
"                                 (> left 0)))\n"
"                (if (> left 0)        ; all can be printed on one line\n"
"                    (out (reverse-string-append result) col)\n"
"                    (if (pair? obj)\n"
"                        (pp-pair obj col extra)\n"
"                        (pp-list (vector->list obj) (out \"#\" col) extra pp-expr))))\n"
"              (wr obj col))))\n"
"\n"
"      (set! pp-expr\n"
"        (lambda (expr col extra)\n"
"          (if (read-macro? expr)\n"
"              (pr (read-macro-body expr)\n"
"                  (out (read-macro-prefix expr) col)\n"
"                  extra\n"
"                  pp-expr)\n"
"              (let ((head (car expr)))\n"
"                (if (symbol? head)\n"
"                    (let ((proc (style head)))\n"
"                      (if proc\n"
"                          (proc expr col extra)\n"
"                          (if (> (string-length (symbol->string head))\n"
"                                 max-call-head-width)\n"
"                              (pp-general expr col extra #f #f #f pp-expr)\n"
"                              (pp-call expr col extra pp-expr))))\n"
"                    (pp-list expr col extra pp-expr))))))\n"
"\n"
"                                        ; (head item1\n"
"                                        ;       item2\n"
"                                        ;       item3)\n"
"      (set! pp-call\n"
"        (lambda (expr col extra pp-item)\n"
"          (let ((col* (wr (car expr) (out \"(\" col))))\n"
"            (and col\n"
"                 (pp-down (cdr expr) col* (+ col* 1) extra pp-item)))))\n"
"\n"
"                                        ; (item1\n"
"                                        ;  item2\n"
"                                        ;  item3)\n"
"      (set! pp-list\n"
"        (lambda (l col extra pp-item)\n"
"          (let ((col (out \"(\" col)))\n"
"            (pp-down l col col extra pp-item))))\n"
"\n"
"      (set! pp-down\n"
"        (lambda (l col1 col2 extra pp-item)\n"
"          (let loop ((l l) (col col1))\n"
"            (and col\n"
"                 (cond ((pair? l)\n"
"                        (let ((rest (cdr l)))\n"
"                          (let ((extra (if (null? rest) (+ extra 1) 0)))\n"
"                            (loop rest\n"
"                                  (pr (car l) (indent col2 col) extra pp-item)))))\n"
"                       ((null? l)\n"
"                        (out \")\" col))\n"
"                       (else\n"
"                        (out \")\"\n"
"                             (pr l\n"
"                                 (indent col2 (out \".\" (indent col2 col)))\n"
"                                 (+ extra 1)\n"
"                                 pp-item))))))))\n"
"\n"
"      (set! pp-general\n"
"        (lambda (expr col extra named? pp-1 pp-2 pp-3)\n"
"\n"
"          (define (tail3 rest col1 col2)\n"
"            (pp-down rest col2 col1 extra pp-3))\n"
"\n"
"          (define (tail2 rest col1 col2 col3)\n"
"            (if (and pp-2 (pair? rest))\n"
"                (let* ((val1 (car rest))\n"
"                       (rest (cdr rest))\n"
"                       (extra (if (null? rest) (+ extra 1) 0)))\n"
"                  (tail3 rest col1 (pr val1 (indent col3 col2) extra pp-2)))\n"
"                (tail3 rest col1 col2)))\n"
"\n"
"          (define (tail1 rest col1 col2 col3)\n"
"            (if (and pp-1 (pair? rest))\n"
"                (let* ((val1 (car rest))\n"
"                       (rest (cdr rest))\n"
"                       (extra (if (null? rest) (+ extra 1) 0)))\n"
"                  (tail2 rest col1 (pr val1 (indent col3 col2) extra pp-1) col3))\n"
"                (tail2 rest col1 col2 col3)))\n"
"\n"
"          (let* ((head (car expr))\n"
"                 (rest (cdr expr))\n"
"                 (col* (wr head (out \"(\" col))))\n"
"            (if (and named? (pair? rest))\n"
"                (let* ((name (car rest))\n"
"                       (rest (cdr rest))\n"
"                       (col** (wr name (out \" \" col*))))\n"
"                  (tail1 rest (+ col indent-general) col** (+ col** 1)))\n"
"                (tail1 rest (+ col indent-general) col* (+ col* 1))))))\n"
"\n"
"      (set! pp-expr-list\n"
"        (lambda (l col extra)\n"
"          (pp-list l col extra pp-expr)))\n"
"\n"
"      (define (pp-LAMBDA expr col extra)\n"
"        (pp-general expr col extra #f pp-expr-list #f pp-expr))\n"
"\n"
"      (define (pp-IF expr col extra)\n"
"        (pp-general expr col extra #f pp-expr #f pp-expr))\n"
"\n"
"      (define (pp-COND expr col extra)\n"
"        (pp-call expr col extra pp-expr-list))\n"
"\n"
"      (define (pp-CASE expr col extra)\n"
"        (pp-general expr col extra #f pp-expr #f pp-expr-list))\n"
"\n"
"      (define (pp-AND expr col extra)\n"
"        (pp-call expr col extra pp-expr))\n"
"\n"
"      (define (pp-LET expr col extra)\n"
"        (let* ((rest (cdr expr))\n"
"               (named? (and (pair? rest) (symbol? (car rest)))))\n"
"          (pp-general expr col extra named? pp-expr-list #f pp-expr)))\n"
"\n"
"      (define (pp-BEGIN expr col extra)\n"
"        (pp-general expr col extra #f #f #f pp-expr))\n"
"\n"
"      (define (pp-DO expr col extra)\n"
"        (pp-general expr col extra #f pp-expr-list pp-expr-list pp-expr))\n"
"\n"
"                                        ; define formatting style (change these to suit your style)\n"
"\n"
"      (set! indent-general 2)\n"
"\n"
"      (set! max-call-head-width 5)\n"
"\n"
"      (set! max-expr-width 50)\n"
"\n"
"      (set! style\n"
"        (lambda (head)\n"
"          (case head\n"
"            ((lambda let* letrec define) pp-LAMBDA)\n"
"            ((if set!)                   pp-IF)\n"
"            ((cond)                      pp-COND)\n"
"            ((case)                      pp-CASE)\n"
"            ((and or)                    pp-AND)\n"
"            ((let)                       pp-LET)\n"
"            ((begin)                     pp-BEGIN)\n"
"            ((do)                        pp-DO)\n"
"            (else                        #f))))\n"
"\n"
"      (pr obj col 0 pp-expr))\n"
"\n"
"    (if width\n"
"        (out genwrite:newline-str (pp obj 0))\n"
"        (wr obj 0)))\n"
"\n"
"  (define (pretty-print obj . opt)\n"
"    (let ((port (if (pair? opt) (car opt) (current-output-port))))\n"
"      (generic-write obj #f pp-width\n"
"                     (lambda (s) (display s port) #t))\n"
"      (display \"\")))\n"
"\n"
"  (export pretty-print))\n"
;

static const char *piclib_src__Users_yuichi_workspace_picrin_contrib_20_async_piclib_async =
"(define-library (picrin control async)\n"
"  (import (scheme base)\n"
"          (picrin control)\n"
"          (picrin promise))\n"
"\n"
" (define (promise-unit x)\n"
"   (make-promise\n"
"    (lambda (resolve _)\n"
"      (resolve x))))\n"
"\n"
" (define (promise-bind m f)\n"
"   (promise-then m f))\n"
"\n"
" (define-syntax async\n"
"   (syntax-rules ()\n"
"     ((_ x ...)\n"
"      (reset (lambda ()\n"
"               (promise-unit (begin x ...)))))))\n"
"\n"
" (define (await m)\n"
"   (shift (lambda (f)\n"
"            (promise-bind m f))))\n"
"\n"
" (export async await))\n"
;

static const char *piclib_src__Users_yuichi_workspace_picrin_contrib_20_for_piclib_for =
"(define-library (picrin control list)\n"
"  (import (scheme base)\n"
"          (picrin control))\n"
"\n"
"  (define-syntax for\n"
"    (syntax-rules ()\n"
"      ((_ expr)\n"
"       (reset (lambda () expr)))))\n"
"\n"
"  (define (in m)\n"
"    (shift (lambda (k)\n"
"             (apply append (map k m)))))\n"
"\n"
"  (define (yield x)\n"
"    (list x))\n"
"\n"
"  (define (null . x)\n"
"    '())\n"
"\n"
"  (export for in yield null))\n"
;

void
pic_load_piclib(pic_state *pic)
{
  pic_try {
    pic_load_cstr(pic, piclib_src__Users_yuichi_workspace_picrin_piclib_picrin_base);
    pic_load_cstr(pic, piclib_src__Users_yuichi_workspace_picrin_piclib_picrin_list);
    pic_load_cstr(pic, piclib_src__Users_yuichi_workspace_picrin_piclib_picrin_symbol);
    pic_load_cstr(pic, piclib_src__Users_yuichi_workspace_picrin_piclib_picrin_macro);
    pic_load_cstr(pic, piclib_src__Users_yuichi_workspace_picrin_piclib_scheme_base);
    pic_load_cstr(pic, piclib_src__Users_yuichi_workspace_picrin_piclib_picrin_record);
    pic_load_cstr(pic, piclib_src__Users_yuichi_workspace_picrin_piclib_picrin_array);
    pic_load_cstr(pic, piclib_src__Users_yuichi_workspace_picrin_piclib_picrin_dictionary);
    pic_load_cstr(pic, piclib_src__Users_yuichi_workspace_picrin_piclib_picrin_test);
    pic_load_cstr(pic, piclib_src__Users_yuichi_workspace_picrin_piclib_picrin_experimental_lambda);
    pic_load_cstr(pic, piclib_src__Users_yuichi_workspace_picrin_piclib_picrin_promise);
    pic_load_cstr(pic, piclib_src__Users_yuichi_workspace_picrin_piclib_picrin_async);
    pic_load_cstr(pic, piclib_src__Users_yuichi_workspace_picrin_piclib_scheme_cxr);
    pic_load_cstr(pic, piclib_src__Users_yuichi_workspace_picrin_piclib_scheme_file);
    pic_load_cstr(pic, piclib_src__Users_yuichi_workspace_picrin_piclib_scheme_case_lambda);
    pic_load_cstr(pic, piclib_src__Users_yuichi_workspace_picrin_piclib_scheme_lazy);
    pic_load_cstr(pic, piclib_src__Users_yuichi_workspace_picrin_piclib_scheme_eval);
    pic_load_cstr(pic, piclib_src__Users_yuichi_workspace_picrin_piclib_scheme_r5rs);
    pic_load_cstr(pic, piclib_src__Users_yuichi_workspace_picrin_piclib_scheme_null);
    pic_load_cstr(pic, piclib_src__Users_yuichi_workspace_picrin_piclib_srfi_1);
    pic_load_cstr(pic, piclib_src__Users_yuichi_workspace_picrin_piclib_srfi_8);
    pic_load_cstr(pic, piclib_src__Users_yuichi_workspace_picrin_piclib_srfi_26);
    pic_load_cstr(pic, piclib_src__Users_yuichi_workspace_picrin_piclib_srfi_43);
    pic_load_cstr(pic, piclib_src__Users_yuichi_workspace_picrin_piclib_srfi_60);
    pic_load_cstr(pic, piclib_src__Users_yuichi_workspace_picrin_piclib_srfi_95);
    pic_load_cstr(pic, piclib_src__Users_yuichi_workspace_picrin_piclib_srfi_111);
    pic_load_cstr(pic, piclib_src__Users_yuichi_workspace_picrin_piclib_picrin_user);
    pic_load_cstr(pic, piclib_src__Users_yuichi_workspace_picrin_piclib_picrin_repl);
    pic_load_cstr(pic, piclib_src__Users_yuichi_workspace_picrin_contrib_10_partcont_piclib_partcont);
    pic_load_cstr(pic, piclib_src__Users_yuichi_workspace_picrin_contrib_10_pretty_print_pretty_print);
    pic_load_cstr(pic, piclib_src__Users_yuichi_workspace_picrin_contrib_20_async_piclib_async);
    pic_load_cstr(pic, piclib_src__Users_yuichi_workspace_picrin_contrib_20_for_piclib_for);
  }
  pic_catch {
    /* error! */
    fputs("fatal error: failure in loading built-in.scm\n", stderr);
    fputs(pic_errmsg(pic), stderr);
    abort();
  }

#if DEBUG
  puts("successfully loaded stdlib");
#endif
}