#include "picrin.h" #include "picrin/extra.h" static const char boot_rom[][80] = { "(core#define-macro call-with-current-environment\n (core#lambda (form env)\n (", "list (cadr form) env)))\n\n(core#define here\n (call-with-current-environment\n (", "core#lambda (env)\n env)))\n\n(core#define the ; synonym fo", "r #'var\n (core#lambda (var)\n (make-identifier var here)))\n\n\n(core#define the", "-builtin-define (the (core#quote core#define)))\n(core#define the-builtin-lambda ", "(the (core#quote core#lambda)))\n(core#define the-builtin-begin (the (core#quote ", "core#begin)))\n(core#define the-builtin-quote (the (core#quote core#quote)))\n(cor", "e#define the-builtin-set! (the (core#quote core#set!)))\n(core#define the-builtin", "-if (the (core#quote core#if)))\n(core#define the-builtin-define-macro (the (core", "#quote core#define-macro)))\n\n(core#define the-define (the (core#quote define)))\n", "(core#define the-lambda (the (core#quote lambda)))\n(core#define the-begin (the (", "core#quote begin)))\n(core#define the-quote (the (core#quote quote)))\n(core#defin", "e the-set! (the (core#quote set!)))\n(core#define the-if (the (core#quote if)))\n(", "core#define the-define-macro (the (core#quote define-macro)))\n\n(core#define-macr", "o quote\n (core#lambda (form env)\n (core#if (= (length form) 2)\n (list t", "he-builtin-quote (cadr form))\n (error \"illegal quote form\" form))))\n\n(core#", "define-macro if\n (core#lambda (form env)\n ((core#lambda (len)\n (core#i", "f (= len 4)\n (cons the-builtin-if (cdr form))\n (core#if (= l", "en 3)\n (list the-builtin-if (list-ref form 1) (list-ref form 2) #u", "ndefined)\n (error \"illegal if form\" form))))\n (length form))))", "\n\n(core#define-macro begin\n (core#lambda (form env)\n ((core#lambda (len)\n ", " (if (= len 1)\n #undefined\n (if (= len 2)\n ", "(cadr form)\n (if (= len 3)\n (cons the-builtin-be", "gin (cdr form))\n (list the-builtin-begin\n ", " (cadr form)\n (cons the-begin (cddr form)))))))\n ", "(length form))))\n\n(core#define-macro set!\n (core#lambda (form env)\n (if (= (", "length form) 3)\n (if (identifier? (cadr form))\n (cons the-buil", "tin-set! (cdr form))\n (error \"illegal set! form\" form))\n (erro", "r \"illegal set! form\" form))))\n\n(core#define check-formal\n (core#lambda (formal", ")\n (if (null? formal)\n #t\n (if (identifier? formal)\n ", " #t\n (if (pair? formal)\n (if (identifier? (car formal)", ")\n (check-formal (cdr formal))\n #f)\n ", " #f)))))\n\n(core#define-macro lambda\n (core#lambda (form env)\n (if (", "= (length form) 1)\n (error \"illegal lambda form\" form)\n (if (check", "-formal (cadr form))\n (list the-builtin-lambda (cadr form) (cons the-", "begin (cddr form)))\n (error \"illegal lambda form\" form)))))\n\n(core#de", "fine-macro define\n (lambda (form env)\n ((lambda (len)\n (if (= len 1)\n ", " (error \"illegal define form\" form)\n (if (identifier? (cadr f", "orm))\n (if (= len 3)\n (cons the-builtin-define (", "cdr form))\n (error \"illegal define form\" form))\n ", " (if (pair? (cadr form))\n (list the-define\n ", " (car (cadr form))\n (cons the-lambda (cons (cdr (ca", "dr form)) (cddr form))))\n (error \"define: binding to non-varai", "ble object\" form)))))\n (length form))))\n\n(core#define-macro define-macro\n (", "lambda (form env)\n (if (= (length form) 3)\n (if (identifier? (cadr for", "m))\n (cons the-builtin-define-macro (cdr form))\n (error \"d", "efine-macro: binding to non-variable object\" form))\n (error \"illegal defi", "ne-macro form\" form))))\n\n\n(define-macro syntax-error\n (lambda (form _)\n (app", "ly error (cdr form))))\n\n(define-macro define-auxiliary-syntax\n (lambda (form _)", "\n (define message\n (string-append\n \"invalid use of auxiliary synta", "x: '\" (symbol->string (cadr form)) \"'\"))\n (list\n the-define-macro\n (c", "adr form)\n (list the-lambda '_\n (list (the 'error) message)))))\n\n(", "define-auxiliary-syntax else)\n(define-auxiliary-syntax =>)\n(define-auxiliary-syn", "tax unquote)\n(define-auxiliary-syntax unquote-splicing)\n(define-auxiliary-syntax", " syntax-unquote)\n(define-auxiliary-syntax syntax-unquote-splicing)\n\n(define-macr", "o let\n (lambda (form env)\n (if (identifier? (cadr form))\n (list\n ", " (list the-lambda '()\n (list the-define (cadr form)\n ", " (cons the-lambda\n (cons (map car (car (cddr ", "form)))\n (cdr (cddr form)))))\n (co", "ns (cadr form) (map cadr (car (cddr form))))))\n (cons\n (cons\n ", " the-lambda\n (cons (map car (cadr form))\n (cddr for", "m)))\n (map cadr (cadr form))))))\n\n(define-macro and\n (lambda (form env)", "\n (if (null? (cdr form))\n #t\n (if (null? (cddr form))\n ", " (cadr form)\n (list the-if\n (cadr form)\n ", " (cons (the 'and) (cddr form))\n #f)))))\n\n(define-macro o", "r\n (lambda (form env)\n (if (null? (cdr form))\n #f\n (let ((tmp ", "(make-identifier 'it env)))\n (list (the 'let)\n (list (li", "st tmp (cadr form)))\n (list the-if\n tmp\n ", " tmp\n (cons (the 'or) (cddr form))))))))\n\n", "(define-macro cond\n (lambda (form env)\n (let ((clauses (cdr form)))\n (i", "f (null? clauses)\n #undefined\n (let ((clause (car clauses)))\n ", " (if (and (identifier? (car clause))\n (identifier=", "? (the 'else) (make-identifier (car clause) env)))\n (cons the-beg", "in (cdr clause))\n (if (null? (cdr clause))\n (l", "et ((tmp (make-identifier 'tmp here)))\n (list (the 'let) (l", "ist (list tmp (car clause)))\n (list the-if tmp tmp (c", "ons (the 'cond) (cdr clauses)))))\n (if (and (identifier? (cad", "r clause))\n (identifier=? (the '=>) (make-identifier", " (cadr clause) env)))\n (let ((tmp (make-identifier 'tmp h", "ere)))\n (list (the 'let) (list (list tmp (car clause)))", "\n (list the-if tmp\n ", " (list (car (cddr clause)) tmp)\n (co", "ns (the 'cond) (cdr clauses)))))\n (list the-if (car claus", "e)\n (cons the-begin (cdr clause))\n ", " (cons (the 'cond) (cdr clauses)))))))))))\n\n(define-macro quasiquote", "\n (lambda (form env)\n\n (define (quasiquote? form)\n (and (pair? form)\n ", " (identifier? (car form))\n (identifier=? (the 'quasiquote) (ma", "ke-identifier (car form) env))))\n\n (define (unquote? form)\n (and (pair? ", "form)\n (identifier? (car form))\n (identifier=? (the 'unquote", ") (make-identifier (car form) env))))\n\n (define (unquote-splicing? form)\n ", " (and (pair? form)\n (pair? (car form))\n (identifier? (caar ", "form))\n (identifier=? (the 'unquote-splicing) (make-identifier (caar f", "orm) env))))\n\n (define (qq depth expr)\n (cond\n ;; unquote\n (", "(unquote? expr)\n (if (= depth 1)\n (car (cdr expr))\n ", " (list (the 'list)\n (list (the 'quote) (the 'unquote))\n ", " (qq (- depth 1) (car (cdr expr))))))\n ;; unquote-splicing\n ", " ((unquote-splicing? expr)\n (if (= depth 1)\n (list (the 'appen", "d)\n (car (cdr (car expr)))\n (qq depth (cdr exp", "r)))\n (list (the 'cons)\n (list (the 'list)\n ", " (list (the 'quote) (the 'unquote-splicing))\n ", " (qq (- depth 1) (car (cdr (car expr)))))\n (qq depth (cdr exp", "r)))))\n ;; quasiquote\n ((quasiquote? expr)\n (list (the 'list)", "\n (list (the 'quote) (the 'quasiquote))\n (qq (+ depth ", "1) (car (cdr expr)))))\n ;; list\n ((pair? expr)\n (list (the 'c", "ons)\n (qq depth (car expr))\n (qq depth (cdr expr))))\n ", " ;; vector\n ((vector? expr)\n (list (the 'list->vector) (qq dep", "th (vector->list expr))))\n ;; simple datum\n (else\n (list (the", " 'quote) expr))))\n\n (let ((x (cadr form)))\n (qq 1 x))))\n\n(define-macro l", "et*\n (lambda (form env)\n (let ((bindings (car (cdr form)))\n (body ", " (cdr (cdr form))))\n (if (null? bindings)\n `(,(the 'let) () ,@bo", "dy)\n `(,(the 'let) ((,(car (car bindings)) ,@(cdr (car bindings))))\n ", " (,(the 'let*) (,@(cdr bindings))\n ,@body))))))\n\n(define-mac", "ro letrec\n (lambda (form env)\n `(,(the 'letrec*) ,@(cdr form))))\n\n(define-ma", "cro letrec*\n (lambda (form env)\n (let ((bindings (car (cdr form)))\n ", " (body (cdr (cdr form))))\n (let ((variables (map (lambda (v) `(,v #f)) ", "(map car bindings)))\n (initials (map (lambda (v) `(,(the 'set!) ,@v)", ") bindings)))\n `(,(the 'let) (,@variables)\n ,@initials\n ", " ,@body)))))\n\n(define-macro let-values\n (lambda (form env)\n `(,(the 'let*-va", "lues) ,@(cdr form))))\n\n(define-macro let*-values\n (lambda (form env)\n (let (", "(formal (car (cdr form)))\n (body (cdr (cdr form))))\n (if (null? ", "formal)\n `(,(the 'let) () ,@body)\n `(,(the 'call-with-values) ", "(,the-lambda () ,@(cdr (car formal)))\n (,(the 'lambda) (,@(car (car f", "ormal)))\n (,(the 'let*-values) (,@(cdr formal))\n ,@body", ")))))))\n\n(define-macro define-values\n (lambda (form env)\n (let ((formal (car", " (cdr form)))\n (body (cdr (cdr form))))\n (let ((arguments (make-", "identifier 'arguments here)))\n `(,the-begin\n ,@(let loop ((forma", "l formal))\n (if (pair? formal)\n `((,the-define ,(c", "ar formal) #undefined) ,@(loop (cdr formal)))\n (if (identifier?", " formal)\n `((,the-define ,formal #undefined))\n ", " '())))\n (,(the 'call-with-values) (,the-lambda () ,@body)\n ", " (,the-lambda\n ,arguments\n ,@(let loop ((formal form", "al) (args arguments))\n (if (pair? formal)\n `((", ",the-set! ,(car formal) (,(the 'car) ,args)) ,@(loop (cdr formal) `(,(the 'cdr) ", ",args)))\n (if (identifier? formal)\n `(", "(,the-set! ,formal ,args))\n '()))))))))))\n\n(define-macro ", "do\n (lambda (form env)\n (let ((bindings (car (cdr form)))\n (test ", " (car (car (cdr (cdr form)))))\n (cleanup (cdr (car (cdr (cdr form))))", ")\n (body (cdr (cdr (cdr form)))))\n (let ((loop (make-identifie", "r 'loop here)))\n `(,(the 'let) ,loop ,(map (lambda (x) `(,(car x) ,(cadr ", "x))) bindings)\n (,the-if ,test\n (,the-begin\n ", " ,@cleanup)\n (,the-begin\n ,@body\n", " (,loop ,@(map (lambda (x) (if (null? (cdr (cdr x))) (car x) ", "(car (cdr (cdr x))))) bindings)))))))))\n\n(define-macro when\n (lambda (form env)", "\n (let ((test (car (cdr form)))\n (body (cdr (cdr form))))\n `(,t", "he-if ,test\n (,the-begin ,@body)\n #undefined))))\n\n", "(define-macro unless\n (lambda (form env)\n (let ((test (car (cdr form)))\n ", " (body (cdr (cdr form))))\n `(,the-if ,test\n #undefined\n", " (,the-begin ,@body)))))\n\n(define-macro case\n (lambda (form env)", "\n (let ((key (car (cdr form)))\n (clauses (cdr (cdr form))))\n ", " (let ((the-key (make-identifier 'key here)))\n `(,(the 'let) ((,the-key ", ",key))\n ,(let loop ((clauses clauses))\n (if (null? clauses)", "\n #undefined\n (let ((clause (car clauses)))\n ", " `(,the-if ,(if (and (identifier? (car clause))\n ", " (identifier=? (the 'else) (make-identifier (car clause) env", ")))\n #t\n `(,(t", "he 'or) ,@(map (lambda (x) `(,(the 'eqv?) ,the-key (,the-quote ,x))) (car clause", "))))\n ,(if (and (identifier? (cadr clause))\n ", " (identifier=? (the '=>) (make-identifier (cadr cl", "ause) env)))\n `(,(car (cdr (cdr clause))) ,the-", "key)\n `(,the-begin ,@(cdr clause)))\n ", " ,(loop (cdr clauses)))))))))))\n\n(define-macro parameterize\n (", "lambda (form env)\n (let ((formal (car (cdr form)))\n (body (cdr (cd", "r form))))\n `(,(the 'with-dynamic-environment)\n (,(the 'list) ,@(map", " (lambda (x) `(,(the 'cons) ,(car x) ,(cadr x))) formal))\n (,the-lambda (", ") ,@body)))))\n\n(define-macro syntax-quote\n (lambda (form env)\n (let ((rename", "s '()))\n (letrec\n ((rename (lambda (var)\n (let", " ((x (assq var renames)))\n (if x\n ", " (cadr x)\n (begin\n (set! ", "renames `((,var ,(make-identifier var env) (,(the 'make-identifier) ',var ',env)", ") . ,renames))\n (rename var))))))\n (walk (", "lambda (f form)\n (cond\n ((identifier? form)", "\n (f form))\n ((pair? form)\n ", " `(,(the 'cons) (walk f (car form)) (walk f (cdr form))))\n ", " ((vector? form)\n `(,(the 'list->vector) (walk f (vector-", ">list form))))\n (else\n `(,(the 'quote) ,f", "orm))))))\n (let ((form (walk rename (cadr form))))\n `(,(the 'let", ")\n ,(map cdr renames)\n ,form))))))\n\n(define-macro syntax-q", "uasiquote\n (lambda (form env)\n (let ((renames '()))\n (letrec\n ", "((rename (lambda (var)\n (let ((x (assq var renames)))\n ", " (if x\n (cadr x)\n ", " (begin\n (set! renames `((,var ,(make-identifie", "r var env) (,(the 'make-identifier) ',var ',env)) . ,renames))\n ", " (rename var)))))))\n\n (define (syntax-quasiquote? form)\n ", " (and (pair? form)\n (identifier? (car form))\n (id", "entifier=? (the 'syntax-quasiquote) (make-identifier (car form) env))))\n\n ", " (define (syntax-unquote? form)\n (and (pair? form)\n (iden", "tifier? (car form))\n (identifier=? (the 'syntax-unquote) (make-ide", "ntifier (car form) env))))\n\n (define (syntax-unquote-splicing? form)\n ", " (and (pair? form)\n (pair? (car form))\n (identi", "fier? (caar form))\n (identifier=? (the 'syntax-unquote-splicing) (", "make-identifier (caar form) env))))\n\n (define (qq depth expr)\n (", "cond\n ;; syntax-unquote\n ((syntax-unquote? expr)\n ", " (if (= depth 1)\n (car (cdr expr))\n (list (the 'li", "st)\n (list (the 'quote) (the 'syntax-unquote))\n ", " (qq (- depth 1) (car (cdr expr))))))\n ;; syntax-unquote-spli", "cing\n ((syntax-unquote-splicing? expr)\n (if (= depth 1)\n ", " (list (the 'append)\n (car (cdr (car expr)))\n ", " (qq depth (cdr expr)))\n (list (the 'cons)\n ", " (list (the 'list)\n (list (the 'quo", "te) (the 'syntax-unquote-splicing))\n (qq (- depth 1) ", "(car (cdr (car expr)))))\n (qq depth (cdr expr)))))\n ", " ;; syntax-quasiquote\n ((syntax-quasiquote? expr)\n (list ", "(the 'list)\n (list (the 'quote) (the 'quasiquote))\n ", " (qq (+ depth 1) (car (cdr expr)))))\n ;; list\n ((pair? ", "expr)\n (list (the 'cons)\n (qq depth (car expr))\n ", " (qq depth (cdr expr))))\n ;; vector\n ((vector? ", "expr)\n (list (the 'list->vector) (qq depth (vector->list expr))))\n ", " ;; identifier\n ((identifier? expr)\n (rename expr))\n", " ;; simple datum\n (else\n (list (the 'quote) expr)", ")))\n\n (let ((body (qq 1 (cadr form))))\n `(,(the 'let)\n ", " ,(map cdr renames)\n ,body))))))\n\n(define (transformer f)\n (lambda ", "(form env)\n (let ((ephemeron1 (make-ephemeron-table))\n (ephemeron2 (", "make-ephemeron-table)))\n (letrec\n ((wrap (lambda (var1)\n ", " (let ((var2 (ephemeron1 var1)))\n (if var2\n ", " (cdr var2)\n (let ((var2 (make-identifier", " var1 env)))\n (ephemeron1 var1 var2)\n ", " (ephemeron2 var2 var1)\n var2)))))\n ", " (unwrap (lambda (var2)\n (let ((var1 (ephemeron2 var2)))\n ", " (if var1\n (cdr var1)\n ", " var2))))\n (walk (lambda (f form)\n (con", "d\n ((identifier? form)\n (f form))\n ", " ((pair? form)\n (cons (walk f (car form)) (walk ", "f (cdr form))))\n ((vector? form)\n (list->", "vector (walk f (vector->list form))))\n (else\n ", " form)))))\n (let ((form (cdr form)))\n (walk unwrap (apply f ", "(walk wrap form))))))))\n\n(define-macro define-syntax\n (lambda (form env)\n (l", "et ((formal (car (cdr form)))\n (body (cdr (cdr form))))\n (if (pa", "ir? formal)\n `(,(the 'define-syntax) ,(car formal) (,the-lambda ,(cdr f", "ormal) ,@body))\n `(,the-define-macro ,formal (,(the 'transformer) (,the", "-begin ,@body)))))))\n\n(define-macro letrec-syntax\n (lambda (form env)\n (let ", "((formal (car (cdr form)))\n (body (cdr (cdr form))))\n `(let ()\n ", " ,@(map (lambda (x)\n `(,(the 'define-syntax) ,(car x) ,(", "cadr x)))\n formal)\n ,@body))))\n\n(define-macro let-syntax\n", " (lambda (form env)\n `(,(the 'letrec-syntax) ,@(cdr form))))\n;;; There are t", "wo ways to name a library: (foo bar) or foo.bar\n;;; The former is normalized to ", "the latter.\n\n(define (mangle name)\n (when (null? name)\n (error \"library name", " should be a list of at least one symbols\" name))\n\n (define (->string n)\n (c", "ond\n ((symbol? n)\n (let ((str (symbol->string n)))\n (string-for-", "each\n (lambda (c)\n (when (or (char=? c #\\.) (char=? c #\\:))\n ", " (error \"elements of library name may not contain '.' or ':'\" n)))\n ", " str)\n str))\n ((and (number? n) (exact? n) (<= 0 n))\n (numb", "er->string n))\n (else\n (error \"symbol or non-negative integer is requir", "ed\" n))))\n\n (define (join strs delim)\n (let loop ((res (car strs)) (strs (cd", "r strs)))\n (if (null? strs)\n res\n (loop (string-append re", "s delim (car strs)) (cdr strs)))))\n\n (if (symbol? name)\n name ", " ; TODO: check symbol names\n (string->symbol (join (map ->s", "tring name) \".\"))))\n\n(define current-library\n (make-parameter '(picrin base) ma", "ngle))\n\n(define *libraries*\n (make-dictionary))\n\n(define (find-library name)\n ", "(dictionary-has? *libraries* (mangle name)))\n\n(define (make-library name)\n (let", " ((name (mangle name)))\n (let ((env (make-environment\n (strin", "g->symbol (string-append (symbol->string name) \":\"))))\n (exports (make-", "dictionary)))\n ;; set up initial environment\n (set-identifier! 'define", "-library 'define-library env)\n (set-identifier! 'import 'import env)\n ", "(set-identifier! 'export 'export env)\n (set-identifier! 'cond-expand 'cond-", "expand env)\n (dictionary-set! *libraries* name `(,env . ,exports)))))\n\n(def", "ine (library-environment name)\n (car (dictionary-ref *libraries* (mangle name))", "))\n\n(define (library-exports name)\n (cdr (dictionary-ref *libraries* (mangle na", "me))))\n\n(define (library-import name sym alias)\n (let ((uid (dictionary-ref (li", "brary-exports name) sym)))\n (let ((env (library-environment (current-library)", ")))\n (set-identifier! alias uid env))))\n\n(define (library-export sym alias)", "\n (let ((env (library-environment (current-library)))\n (exports (library", "-exports (current-library))))\n (dictionary-set! exports alias (find-identifie", "r sym env))))\n\n\n\n;;; R7RS library syntax\n\n(define-macro define-library\n (lambda", " (form _)\n (let ((name (cadr form))\n (body (cddr form)))\n (or (", "find-library name) (make-library name))\n (parameterize ((current-library na", "me))\n (for-each\n (lambda (expr)\n (eval expr name)) ", " ; TODO parse library declarations\n body)))))\n\n(define-macro cond-expan", "d\n (lambda (form _)\n (letrec\n ((test (lambda (form)\n ", "(or\n (eq? form 'else)\n (and (symbol? form)\n ", " (memq form (features)))\n (and (pair? form)\n", " (case (car form)\n ((library) (fin", "d-library (cadr form)))\n ((not) (not (test (cadr form)))", ")\n ((and) (let loop ((form (cdr form)))\n ", " (or (null? form)\n (and (t", "est (car form)) (loop (cdr form))))))\n ((or) (let loop (", "(form (cdr form)))\n (and (pair? form)\n ", " (or (test (car form)) (loop (cdr form))))))\n ", " (else #f)))))))\n (let loop ((clauses (cdr form)))\n ", "(if (null? clauses)\n #undefined\n (if (test (caar clauses))", "\n `(,the-begin ,@(cdar clauses))\n (loop (cdr claus", "es))))))))\n\n(define-macro import\n (lambda (form _)\n (let ((caddr\n ", "(lambda (x) (car (cdr (cdr x)))))\n (prefix\n (lambda (prefix s", "ymbol)\n (string->symbol\n (string-append\n ", "(symbol->string prefix)\n (symbol->string symbol)))))\n (ge", "tlib\n (lambda (name)\n (if (find-library name)\n ", " name\n (error \"library not found\" name)))))\n (letrec\n ", " ((extract\n (lambda (spec)\n (case (car spec)\n ", " ((only rename prefix except)\n (extract (cadr spec)))", "\n (else\n (getlib spec)))))\n (collect\n ", " (lambda (spec)\n (case (car spec)\n ((only)\n", " (let ((alist (collect (cadr spec))))\n (map (l", "ambda (var) (assq var alist)) (cddr spec))))\n ((rename)\n ", " (let ((alist (collect (cadr spec)))\n (renames (map", " (lambda (x) `(,(car x) . ,(cadr x))) (cddr spec))))\n (map (la", "mbda (s) (or (assq (car s) renames) s)) alist)))\n ((prefix)\n ", " (let ((alist (collect (cadr spec))))\n (map (lambda", " (s) (cons (prefix (caddr spec) (car s)) (cdr s))) alist)))\n ((ex", "cept)\n (let ((alist (collect (cadr spec))))\n (", "let loop ((alist alist))\n (if (null? alist)\n ", " '()\n (if (memq (caar alist) (cddr spec))\n ", " (loop (cdr alist))\n (cons (ca", "r alist) (loop (cdr alist))))))))\n (else\n (dictio", "nary-map (lambda (x) (cons x x))\n (library-expor", "ts (getlib spec))))))))\n (letrec\n ((import\n (lam", "bda (spec)\n (let ((lib (extract spec))\n (a", "list (collect spec)))\n (for-each\n (lambda (", "slot)\n (library-import lib (cdr slot) (car slot)))\n ", " alist)))))\n (for-each import (cdr form)))))))\n\n(define-macr", "o export\n (lambda (form _)\n (letrec\n ((collect\n (lambda (spe", "c)\n (cond\n ((symbol? spec)\n `(,spec . ,spec)", ")\n ((and (list? spec) (= (length spec) 3) (eq? (car spec) 'rename))\n", " `(,(list-ref spec 1) . ,(list-ref spec 2)))\n (else\n ", " (error \"malformed export\")))))\n (export\n (lambda (s", "pec)\n (let ((slot (collect spec)))\n (library-export (c", "ar slot) (cdr slot))))))\n (for-each export (cdr form)))))\n\n\n;;; bootstrap..", ".\n(let ()\n (make-library '(picrin base))\n (set-car! (dictionary-ref *libraries", "* (mangle '(picrin base))) default-environment)\n (let ((export-keywords\n ", " (lambda (keywords)\n (let ((env (library-environment '(picrin base)))", "\n (exports (library-exports '(picrin base))))\n (for-", "each\n (lambda (keyword)\n (dictionary-set! exports ke", "yword keyword))\n keywords)))))\n (export-keywords\n '(define l", "ambda quote set! if begin define-macro\n let let* letrec letrec*\n l", "et-values let*-values define-values\n quasiquote unquote unquote-splicing\n", " and or\n cond case else =>\n do when unless\n paramete", "rize\n define-syntax\n syntax-quote syntax-unquote\n syntax-qu", "asiquote syntax-unquote-splicing\n let-syntax letrec-syntax\n syntax", "-error))\n (export-keywords\n '(features\n eq? eqv? equal? not boolean", "? boolean=?\n pair? cons car cdr null? set-car! set-cdr!\n caar cadr c", "dar cddr\n list? make-list list length append reverse\n list-tail list", "-ref list-set! list-copy\n map for-each memq memv member assq assv assoc\n ", " current-input-port current-output-port current-error-port\n port? inpu", "t-port? output-port? port-open? close-port\n eof-object? eof-object\n ", "read-u8 peek-u8 read-bytevector!\n write-u8 write-bytevector flush-output-p", "ort\n open-input-bytevector open-output-bytevector get-output-bytevector\n ", " number? exact? inexact? inexact exact\n = < > <= >= + - * /\n num", "ber->string string->number\n procedure? apply\n symbol? symbol=? symbo", "l->string string->symbol\n make-identifier identifier? identifier=? identif", "ier-base identifier-environment\n vector? vector make-vector vector-length ", "vector-ref vector-set!\n vector-copy! vector-copy vector-append vector-fill", "! vector-map vector-for-each\n list->vector vector->list string->vector vec", "tor->string\n bytevector? bytevector make-bytevector\n bytevector-leng", "th bytevector-u8-ref bytevector-u8-set!\n bytevector-copy! bytevector-copy ", "bytevector-append\n bytevector->list list->bytevector\n call-with-curr", "ent-continuation call/cc values call-with-values\n char? char->integer inte", "ger->char char=? char? char<=? char>=?\n current-exception-handlers", " with-exception-handler\n raise raise-continuable error\n error-object", "? error-object-message error-object-irritants\n error-object-type\n st", "ring? string make-string string-length string-ref string-set!\n string-copy", " string-copy! string-fill! string-append\n string-map string-for-each list-", ">string string->list\n string=? string? string<=? string>=?\n ", " make-parameter with-dynamic-environment\n read\n make-dictionary dic", "tionary? dictionary dictionary-has?\n dictionary-ref dictionary-set! dictio", "nary-delete! dictionary-size\n dictionary-map dictionary-for-each\n di", "ctionary->alist alist->dictionary dictionary->plist plist->dictionary\n mak", "e-record record? record-type record-datum\n default-environment make-enviro", "nment find-identifier set-identifier!\n eval\n make-ephemeron-table\n ", " write write-simple write-shared display))\n (export-keywords\n '(find-", "library make-library current-library)))\n (set! eval\n (let ((e eval))\n ", " (lambda (expr . lib)\n (let ((lib (if (null? lib) (current-libr", "ary) (car lib))))\n (e expr (library-environment lib))))))\n (make-l", "ibrary '(picrin user))\n (current-library '(picrin user)))\n\n", }; void pic_boot(pic_state *pic) { pic_load_cstr(pic, &boot_rom[0][0]); }