conservatory
/
picrin
4
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

reimplement macro expander in scheme

This commit is contained in:
Yuichi Nishiwaki 2017-04-04 14:54:58 +09:00
parent 82939650a4
commit 463b73f11f
23 changed files with 907 additions and 1088 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

5
Makefile
View File

@ -20,7 +20,6 @@ LIBPICRIN_SRCS = \
lib/vector.c\ lib/vector.c\
lib/weak.c\ lib/weak.c\
lib/ext/boot.c\ lib/ext/boot.c\
lib/ext/compile.c\
lib/ext/lib.c\ lib/ext/lib.c\
lib/ext/load.c\ lib/ext/load.c\
lib/ext/read.c\ lib/ext/read.c\
@ -77,8 +76,8 @@ src/init_contrib.c:
# libpicrin.so: $(LIBPICRIN_OBJS) # libpicrin.so: $(LIBPICRIN_OBJS)
# $(CC) -shared $(CFLAGS) -o $@ $(LIBPICRIN_OBJS) $(LDFLAGS) # $(CC) -shared $(CFLAGS) -o $@ $(LIBPICRIN_OBJS) $(LDFLAGS)
lib/ext/boot.c: piclib/boot.scm piclib/library.scm lib/ext/boot.c: piclib/boot.scm piclib/compile.scm piclib/library.scm
cat piclib/boot.scm piclib/library.scm | bin/picrin-bootstrap tools/mkboot.scm > lib/ext/boot.c cat piclib/boot.scm piclib/compile.scm piclib/library.scm | bin/picrin-bootstrap tools/mkboot.scm > lib/ext/boot.c
$(LIBPICRIN_OBJS) $(PICRIN_OBJS) $(CONTRIB_OBJS): lib/include/picrin.h lib/include/picrin/*.h lib/khash.h lib/object.h lib/state.h lib/vm.h $(LIBPICRIN_OBJS) $(PICRIN_OBJS) $(CONTRIB_OBJS): lib/include/picrin.h lib/include/picrin/*.h lib/khash.h lib/object.h lib/state.h lib/vm.h

BIN
bin/picrin-bootstrap
View File

Binary file not shown.

52
contrib/20.r7rs/scheme/base.scm
View File

@ -412,58 +412,6 @@
;; 5.5 Record-type definitions ;; 5.5 Record-type definitions
(define (make-record-type name)
(vector name)) ; TODO
(define-syntax (define-record-constructor type field-alist name . fields)
(let ((record #'record))
#`(define (#,name . #,fields)
(let ((#,record (make-record #,type (make-vector #,(length field-alist)))))
#,@(map
(lambda (field)
#`(vector-set! (record-datum #,record) #,(cdr (assq field field-alist)) #,field))
fields)
#,record))))
(define-syntax (define-record-predicate type name)
#`(define (#,name obj)
(and (record? obj)
(eq? (record-type obj) #,type))))
(define-syntax (define-record-accessor pred field-alist field accessor)
#`(define (#,accessor record)
(if (#,pred record)
(vector-ref (record-datum record) #,(cdr (assq field field-alist)))
(error (string-append (symbol->string '#,accessor) ": wrong record type") record))))
(define-syntax (define-record-modifier pred field-alist field modifier)
#`(define (#,modifier record val)
(if (#,pred record)
(vector-set! (record-datum record) #,(cdr (assq field field-alist)) val)
(error (string-append (symbol->string '#,modifier) ": wrong record type") record))))
(define-syntax (define-record-field pred field-alist field accessor . modifier-opt)
(if (null? modifier-opt)
#`(define-record-accessor #,pred #,field-alist #,field #,accessor)
#`(begin
(define-record-accessor #,pred #,field-alist #,field #,accessor)
(define-record-modifier #,pred #,field-alist #,field #,(car modifier-opt)))))
(define-syntax (define-record-type name ctor pred . fields)
(let ((field-alist (let lp ((fds fields) (idx 0) (alst '()))
(if (null? fds)
alst
(lp (cdr fds)
(+ idx 1)
(cons
(cons (if (pair? (car fds)) (car (car fds)) (car fds)) idx)
alst))))))
#`(begin
(define #,name (make-record-type '#,name))
(define-record-constructor #,name #,field-alist #,@ctor)
(define-record-predicate #,name #,pred)
#,@(map (lambda (field) #`(define-record-field #,pred #,field-alist #,@field)) fields))))
(export define-record-type) (export define-record-type)
;; 6.1. Equivalence predicates ;; 6.1. Equivalence predicates

2
contrib/20.r7rs/scheme/load.scm
View File

@ -1,4 +1,2 @@
(define-library (scheme load) (define-library (scheme load)
(import (picrin base))
(export load)) (export load))

4
contrib/60.repl/repl.scm
View File

@ -20,8 +20,10 @@
#f)))) #f))))
(define (init-env) (define (init-env)
(current-library '(picrin user))
(eval (eval
'(import (scheme base) '(import (picrin base)
(scheme base)
(scheme load) (scheme load)
(scheme process-context) (scheme process-context)
(scheme read) (scheme read)

3
contrib/70.main/main.scm
View File

@ -5,7 +5,6 @@
(scheme process-context) (scheme process-context)
(scheme load) (scheme load)
(scheme eval) (scheme eval)
(picrin base)
(picrin repl)) (picrin repl))
(define (print-help) (define (print-help)
@ -41,7 +40,7 @@
(lambda (in) (lambda (in)
(let loop ((expr (read in))) (let loop ((expr (read in)))
(unless (eof-object? expr) (unless (eof-object? expr)
(eval expr (find-library "picrin.user")) (eval expr '(picrin user))
(loop (read in))))))) (loop (read in)))))))
(define (main) (define (main)

12
lib/bool.c
View File

@ -79,18 +79,6 @@ internal_equal_p(pic_state *pic, pic_value x, pic_value y, int depth, khash_t(m)
} }
switch (pic_type(pic, x)) { switch (pic_type(pic, x)) {
case PIC_TYPE_ID: {
struct identifier *id1, *id2;
pic_value s1, s2;
id1 = pic_id_ptr(pic, x);
id2 = pic_id_ptr(pic, y);
s1 = pic_find_identifier(pic, obj_value(pic, id1->u.id), obj_value(pic, id1->env));
s2 = pic_find_identifier(pic, obj_value(pic, id2->u.id), obj_value(pic, id2->env));
return pic_eq_p(pic, s1, s2);
}
case PIC_TYPE_STRING: { case PIC_TYPE_STRING: {
int xlen, ylen; int xlen, ylen;
const char *xstr, *ystr; const char *xstr, *ystr;

2
lib/dict.c
View File

@ -5,7 +5,7 @@
#include "picrin.h" #include "picrin.h"
#include "object.h" #include "object.h"
KHASH_DEFINE(dict, symbol *, pic_value, kh_ptr_hash_func, kh_ptr_hash_equal) KHASH_DEFINE(dict, struct symbol *, pic_value, kh_ptr_hash_func, kh_ptr_hash_equal)
pic_value pic_value
pic_make_dict(pic_state *pic) pic_make_dict(pic_state *pic)

918
lib/ext/boot.c
View File

@ -2,218 +2,422 @@
#include "picrin/extra.h" #include "picrin/extra.h"
static const char boot_rom[][80] = { static const char boot_rom[][80] = {
"((core#lambda (.define-transformer.2228 .the.2229) ((core#lambda (.the-core-defi", "((core#lambda (.define-transformer.2149 .the.2150) ((core#lambda (.the-core-defi",
"ne.2230 .the-core-lambda.2231 .the-core-begin.2232 .the-core-quote.2233 .the-cor", "ne.2151 .the-core-lambda.2152 .the-core-begin.2153 .the-core-quote.2154 .the-cor",
"e-set!.2234 .the-core-if.2235 .the-core-define-macro.2236 .the-define.2237 .the-", "e-set!.2155 .the-core-if.2156 .the-core-define-macro.2157 .the-define.2158 .the-",
"lambda.2238 .the-begin.2239 .the-quote.2240 .the-set!.2241 .the-if.2242 .the-def", "lambda.2159 .the-begin.2160 .the-quote.2161 .the-set!.2162 .the-if.2163 .the-def",
"ine-macro.2243) (core#begin (.define-transformer.2228 (core#quote quote) (core#l", "ine-macro.2164) (core#begin (.define-transformer.2149 (core#quote quote) (core#l",
"ambda (.form.2248 .env.2249) (core#if (= (length .form.2248) 2) (cons .the-core-", "ambda (.form.2169 .env.2170) (core#if (= (length .form.2169) 2) (cons .the-core-",
"quote.2233 (cons (cadr .form.2248) (core#quote ()))) (error \"malformed quote\" .f", "quote.2154 (cons (cadr .form.2169) (core#quote ()))) (error \"malformed quote\" .f",
"orm.2248)))) (core#begin (.define-transformer.2228 (core#quote if) (core#lambda ", "orm.2169)))) (core#begin (.define-transformer.2149 (core#quote if) (core#lambda ",
"(.form.2250 .env.2251) ((core#lambda (.len.2252) (core#if (= .len.2252 3) (appen", "(.form.2171 .env.2172) ((core#lambda (.len.2173) (core#if (= .len.2173 3) (appen",
"d .form.2250 (cons (core#quote #undefined) (core#quote ()))) (core#if (= .len.22", "d .form.2171 (cons (core#quote #undefined) (core#quote ()))) (core#if (= .len.21",
"52 4) (cons .the-core-if.2235 (cdr .form.2250)) (error \"malformed if\" .form.2250", "73 4) (cons .the-core-if.2156 (cdr .form.2171)) (error \"malformed if\" .form.2171",
")))) (length .form.2250)))) (core#begin (.define-transformer.2228 (core#quote be", ")))) (length .form.2171)))) (core#begin (.define-transformer.2149 (core#quote be",
"gin) (core#lambda (.form.2253 .env.2254) ((core#lambda (.len.2255) (core#if (= .", "gin) (core#lambda (.form.2174 .env.2175) ((core#lambda (.len.2176) (core#if (= .",
"len.2255 1) #undefined (core#if (= .len.2255 2) (cadr .form.2253) (core#if (= .l", "len.2176 1) #undefined (core#if (= .len.2176 2) (cadr .form.2174) (core#if (= .l",
"en.2255 3) (cons .the-core-begin.2232 (cdr .form.2253)) (cons .the-core-begin.22", "en.2176 3) (cons .the-core-begin.2153 (cdr .form.2174)) (cons .the-core-begin.21",
"32 (cons (cadr .form.2253) (cons (cons .the-begin.2239 (cddr .form.2253)) (core#", "53 (cons (cadr .form.2174) (cons (cons .the-begin.2160 (cddr .form.2174)) (core#",
"quote ())))))))) (length .form.2253)))) (core#begin (.define-transformer.2228 (c", "quote ())))))))) (length .form.2174)))) (core#begin (.define-transformer.2149 (c",
"ore#quote set!) (core#lambda (.form.2256 .env.2257) (core#if (core#if (= (length", "ore#quote set!) (core#lambda (.form.2177 .env.2178) (core#if (core#if (= (length",
" .form.2256) 3) (identifier? (cadr .form.2256)) #f) (cons .the-core-set!.2234 (c", " .form.2177) 3) (identifier? (cadr .form.2177)) #f) (cons .the-core-set!.2155 (c",
"dr .form.2256)) (error \"malformed set!\" .form.2256)))) (core#begin (core#define ", "dr .form.2177)) (error \"malformed set!\" .form.2177)))) (core#begin (core#define ",
".check-formal.2244 (core#lambda (.formal.2258) ((core#lambda (.it.2259) (core#if", ".check-formal.2165 (core#lambda (.formal.2179) ((core#lambda (.it.2180) (core#if",
" .it.2259 .it.2259 ((core#lambda (.it.2260) (core#if .it.2260 .it.2260 ((core#la", " .it.2180 .it.2180 ((core#lambda (.it.2181) (core#if .it.2181 .it.2181 ((core#la",
"mbda (.it.2261) (core#if .it.2261 .it.2261 #f)) (core#if (pair? .formal.2258) (c", "mbda (.it.2182) (core#if .it.2182 .it.2182 #f)) (core#if (pair? .formal.2179) (c",
"ore#if (identifier? (car .formal.2258)) (.check-formal.2244 (cdr .formal.2258)) ", "ore#if (identifier? (car .formal.2179)) (.check-formal.2165 (cdr .formal.2179)) ",
"#f) #f)))) (identifier? .formal.2258)))) (null? .formal.2258)))) (core#begin (.d", "#f) #f)))) (identifier? .formal.2179)))) (null? .formal.2179)))) (core#begin (.d",
"efine-transformer.2228 (core#quote lambda) (core#lambda (.form.2262 .env.2263) (", "efine-transformer.2149 (core#quote lambda) (core#lambda (.form.2183 .env.2184) (",
"core#if (= (length .form.2262) 1) (error \"malformed lambda\" .form.2262) (core#if", "core#if (= (length .form.2183) 1) (error \"malformed lambda\" .form.2183) (core#if",
" (.check-formal.2244 (cadr .form.2262)) (cons .the-core-lambda.2231 (cons (cadr ", " (.check-formal.2165 (cadr .form.2183)) (cons .the-core-lambda.2152 (cons (cadr ",
".form.2262) (cons (cons .the-begin.2239 (cddr .form.2262)) (core#quote ())))) (e", ".form.2183) (cons (cons .the-begin.2160 (cddr .form.2183)) (core#quote ())))) (e",
"rror \"malformed lambda\" .form.2262))))) (core#begin (.define-transformer.2228 (c", "rror \"malformed lambda\" .form.2183))))) (core#begin (.define-transformer.2149 (c",
"ore#quote define) (core#lambda (.form.2264 .env.2265) ((core#lambda (.len.2266) ", "ore#quote define) (core#lambda (.form.2185 .env.2186) ((core#lambda (.len.2187) ",
"(core#if (= .len.2266 1) (error \"malformed define\" .form.2264) ((core#lambda (.f", "(core#if (= .len.2187 1) (error \"malformed define\" .form.2185) ((core#lambda (.f",
"ormal.2267) (core#if (identifier? .formal.2267) (core#if (= .len.2266 3) (cons .", "ormal.2188) (core#if (identifier? .formal.2188) (core#if (= .len.2187 3) (cons .",
"the-core-define.2230 (cdr .form.2264)) (error \"malformed define\" .form.2264)) (c", "the-core-define.2151 (cdr .form.2185)) (error \"malformed define\" .form.2185)) (c",
"ore#if (pair? .formal.2267) (cons .the-define.2237 (cons (car .formal.2267) (con", "ore#if (pair? .formal.2188) (cons .the-define.2158 (cons (car .formal.2188) (con",
"s (cons .the-lambda.2238 (cons (cdr .formal.2267) (cddr .form.2264))) (core#quot", "s (cons .the-lambda.2159 (cons (cdr .formal.2188) (cddr .form.2185))) (core#quot",
"e ())))) (error \"define: binding to non-varaible object\" .form.2264)))) (cadr .f", "e ())))) (error \"define: binding to non-varaible object\" .form.2185)))) (cadr .f",
"orm.2264)))) (length .form.2264)))) (core#begin (.define-transformer.2228 (core#", "orm.2185)))) (length .form.2185)))) (core#begin (.define-transformer.2149 (core#",
"quote define-macro) (core#lambda (.form.2268 .env.2269) (core#if (= (length .for", "quote define-macro) (core#lambda (.form.2189 .env.2190) (core#if (= (length .for",
"m.2268) 3) (core#if (identifier? (cadr .form.2268)) (cons .the-core-define-macro", "m.2189) 3) (core#if (identifier? (cadr .form.2189)) (cons .the-core-define-macro",
".2236 (cdr .form.2268)) (error \"define-macro: binding to non-variable object\" .f", ".2157 (cdr .form.2189)) (error \"define-macro: binding to non-variable object\" .f",
"orm.2268)) (error \"malformed define-macro\" .form.2268)))) (core#begin #undefined", "orm.2189)) (error \"malformed define-macro\" .form.2189)))) (core#begin #undefined",
" (core#begin (.define-transformer.2228 (core#quote else) (core#lambda ._.2270 (e", " (core#begin (.define-transformer.2149 (core#quote else) (core#lambda ._.2191 (e",
"rror \"invalid use of auxiliary syntax\" (core#quote else)))) (core#begin (.define", "rror \"invalid use of auxiliary syntax\" (core#quote else)))) (core#begin (.define",
"-transformer.2228 (core#quote =>) (core#lambda ._.2271 (error \"invalid use of au", "-transformer.2149 (core#quote =>) (core#lambda ._.2192 (error \"invalid use of au",
"xiliary syntax\" (core#quote =>)))) (core#begin (.define-transformer.2228 (core#q", "xiliary syntax\" (core#quote =>)))) (core#begin (.define-transformer.2149 (core#q",
"uote unquote) (core#lambda ._.2272 (error \"invalid use of auxiliary syntax\" (cor", "uote unquote) (core#lambda ._.2193 (error \"invalid use of auxiliary syntax\" (cor",
"e#quote unquote)))) (core#begin (.define-transformer.2228 (core#quote unquote-sp", "e#quote unquote)))) (core#begin (.define-transformer.2149 (core#quote unquote-sp",
"licing) (core#lambda ._.2273 (error \"invalid use of auxiliary syntax\" (core#quot", "licing) (core#lambda ._.2194 (error \"invalid use of auxiliary syntax\" (core#quot",
"e unquote-splicing)))) (core#begin (.define-transformer.2228 (core#quote let) (c", "e unquote-splicing)))) (core#begin (.define-transformer.2149 (core#quote let) (c",
"ore#lambda (.form.2274 .env.2275) (core#if (identifier? (cadr .form.2274)) ((cor", "ore#lambda (.form.2195 .env.2196) (core#if (identifier? (cadr .form.2195)) ((cor",
"e#lambda (.name.2276 .formal.2277 .body.2278) (cons (cons .the-lambda.2238 (cons", "e#lambda (.name.2197 .formal.2198 .body.2199) (cons (cons .the-lambda.2159 (cons",
" (core#quote ()) (cons (cons .the-define.2237 (cons (cons .name.2276 (map car .f", " (core#quote ()) (cons (cons .the-define.2158 (cons (cons .name.2197 (map car .f",
"ormal.2277)) .body.2278)) (cons (cons .name.2276 (map cadr .formal.2277)) (core#", "ormal.2198)) .body.2199)) (cons (cons .name.2197 (map cadr .formal.2198)) (core#",
"quote ()))))) (core#quote ()))) (car (cdr .form.2274)) (car (cdr (cdr .form.2274", "quote ()))))) (core#quote ()))) (car (cdr .form.2195)) (car (cdr (cdr .form.2195",
"))) (cdr (cdr (cdr .form.2274)))) ((core#lambda (.formal.2279 .body.2280) (cons ", "))) (cdr (cdr (cdr .form.2195)))) ((core#lambda (.formal.2200 .body.2201) (cons ",
"(cons .the-lambda.2238 (cons (map car .formal.2279) .body.2280)) (map cadr .form", "(cons .the-lambda.2159 (cons (map car .formal.2200) .body.2201)) (map cadr .form",
"al.2279))) (car (cdr .form.2274)) (cdr (cdr .form.2274)))))) (core#begin (.defin", "al.2200))) (car (cdr .form.2195)) (cdr (cdr .form.2195)))))) (core#begin (.defin",
"e-transformer.2228 (core#quote and) (core#lambda (.form.2281 .env.2282) (core#if", "e-transformer.2149 (core#quote and) (core#lambda (.form.2202 .env.2203) (core#if",
" (null? (cdr .form.2281)) #t (core#if (null? (cddr .form.2281)) (cadr .form.2281", " (null? (cdr .form.2202)) #t (core#if (null? (cddr .form.2202)) (cadr .form.2202",
") (cons .the-if.2242 (cons (cadr .form.2281) (cons (cons (.the.2229 (core#quote ", ") (cons .the-if.2163 (cons (cadr .form.2202) (cons (cons (.the.2150 (core#quote ",
"and)) (cddr .form.2281)) (cons (core#quote #f) (core#quote ()))))))))) (core#beg", "and)) (cddr .form.2202)) (cons (core#quote #f) (core#quote ()))))))))) (core#beg",
"in (.define-transformer.2228 (core#quote or) (core#lambda (.form.2283 .env.2284)", "in (.define-transformer.2149 (core#quote or) (core#lambda (.form.2204 .env.2205)",
" (core#if (null? (cdr .form.2283)) #f ((core#lambda (.tmp.2285) (cons (.the.2229", " (core#if (null? (cdr .form.2204)) #f ((core#lambda (.tmp.2206) (cons (.the.2150",
" (core#quote let)) (cons (cons (cons .tmp.2285 (cons (cadr .form.2283) (core#quo", " (core#quote let)) (cons (cons (cons .tmp.2206 (cons (cadr .form.2204) (core#quo",
"te ()))) (core#quote ())) (cons (cons .the-if.2242 (cons .tmp.2285 (cons .tmp.22", "te ()))) (core#quote ())) (cons (cons .the-if.2163 (cons .tmp.2206 (cons .tmp.22",
"85 (cons (cons (.the.2229 (core#quote or)) (cddr .form.2283)) (core#quote ()))))", "06 (cons (cons (.the.2150 (core#quote or)) (cddr .form.2204)) (core#quote ()))))",
") (core#quote ()))))) (make-identifier (core#quote it) .env.2284))))) (core#begi", ") (core#quote ()))))) (make-identifier (core#quote it) .env.2205))))) (core#begi",
"n (.define-transformer.2228 (core#quote cond) (core#lambda (.form.2286 .env.2287", "n (.define-transformer.2149 (core#quote cond) (core#lambda (.form.2207 .env.2208",
") ((core#lambda (.clauses.2288) (core#if (null? .clauses.2288) #undefined ((core", ") ((core#lambda (.clauses.2209) (core#if (null? .clauses.2209) #undefined ((core",
"#lambda (.clause.2289) (core#if (core#if (identifier? (car .clause.2289)) (ident", "#lambda (.clause.2210) (core#if (core#if (identifier? (car .clause.2210)) (ident",
"ifier=? (.the.2229 (core#quote else)) (make-identifier (car .clause.2289) .env.2", "ifier=? (.the.2150 (core#quote else)) (make-identifier (car .clause.2210) .env.2",
"287)) #f) (cons .the-begin.2239 (cdr .clause.2289)) (core#if (null? (cdr .clause", "208)) #f) (cons .the-begin.2160 (cdr .clause.2210)) (core#if (null? (cdr .clause",
".2289)) (cons (.the.2229 (core#quote or)) (cons (car .clause.2289) (cons (cons (", ".2210)) (cons (.the.2150 (core#quote or)) (cons (car .clause.2210) (cons (cons (",
".the.2229 (core#quote cond)) (cdr .clauses.2288)) (core#quote ())))) (core#if (c", ".the.2150 (core#quote cond)) (cdr .clauses.2209)) (core#quote ())))) (core#if (c",
"ore#if (identifier? (cadr .clause.2289)) (identifier=? (.the.2229 (core#quote =>", "ore#if (identifier? (cadr .clause.2210)) (identifier=? (.the.2150 (core#quote =>",
")) (make-identifier (cadr .clause.2289) .env.2287)) #f) ((core#lambda (.tmp.2290", ")) (make-identifier (cadr .clause.2210) .env.2208)) #f) ((core#lambda (.tmp.2211",
") (cons (.the.2229 (core#quote let)) (cons (cons (cons .tmp.2290 (cons (car .cla", ") (cons (.the.2150 (core#quote let)) (cons (cons (cons .tmp.2211 (cons (car .cla",
"use.2289) (core#quote ()))) (core#quote ())) (cons (cons .the-if.2242 (cons .tmp", "use.2210) (core#quote ()))) (core#quote ())) (cons (cons .the-if.2163 (cons .tmp",
".2290 (cons (cons (cadr (cdr .clause.2289)) (cons .tmp.2290 (core#quote ()))) (c", ".2211 (cons (cons (cadr (cdr .clause.2210)) (cons .tmp.2211 (core#quote ()))) (c",
"ons (cons (.the.2229 (core#quote cond)) (cddr .form.2286)) (core#quote ()))))) (", "ons (cons (.the.2150 (core#quote cond)) (cddr .form.2207)) (core#quote ()))))) (",
"core#quote ()))))) (make-identifier (core#quote tmp) .env.2287)) (cons .the-if.2", "core#quote ()))))) (make-identifier (core#quote tmp) .env.2208)) (cons .the-if.2",
"242 (cons (car .clause.2289) (cons (cons .the-begin.2239 (cdr .clause.2289)) (co", "163 (cons (car .clause.2210) (cons (cons .the-begin.2160 (cdr .clause.2210)) (co",
"ns (cons (.the.2229 (core#quote cond)) (cdr .clauses.2288)) (core#quote ()))))))", "ns (cons (.the.2150 (core#quote cond)) (cdr .clauses.2209)) (core#quote ()))))))",
"))) (car .clauses.2288)))) (cdr .form.2286)))) (core#begin (.define-transformer.", "))) (car .clauses.2209)))) (cdr .form.2207)))) (core#begin (.define-transformer.",
"2228 (core#quote quasiquote) (core#lambda (.form.2291 .env.2292) (core#begin (co", "2149 (core#quote quasiquote) (core#lambda (.form.2212 .env.2213) (core#begin (co",
"re#define .quasiquote?.2293 (core#lambda (.form.2297) (core#if (pair? .form.2297", "re#define .quasiquote?.2214 (core#lambda (.form.2218) (core#if (pair? .form.2218",
") (core#if (identifier? (car .form.2297)) (identifier=? (.the.2229 (core#quote q", ") (core#if (identifier? (car .form.2218)) (identifier=? (.the.2150 (core#quote q",
"uasiquote)) (make-identifier (car .form.2297) .env.2292)) #f) #f))) (core#begin ", "uasiquote)) (make-identifier (car .form.2218) .env.2213)) #f) #f))) (core#begin ",
"(core#define .unquote?.2294 (core#lambda (.form.2298) (core#if (pair? .form.2298", "(core#define .unquote?.2215 (core#lambda (.form.2219) (core#if (pair? .form.2219",
") (core#if (identifier? (car .form.2298)) (identifier=? (.the.2229 (core#quote u", ") (core#if (identifier? (car .form.2219)) (identifier=? (.the.2150 (core#quote u",
"nquote)) (make-identifier (car .form.2298) .env.2292)) #f) #f))) (core#begin (co", "nquote)) (make-identifier (car .form.2219) .env.2213)) #f) #f))) (core#begin (co",
"re#define .unquote-splicing?.2295 (core#lambda (.form.2299) (core#if (pair? .for", "re#define .unquote-splicing?.2216 (core#lambda (.form.2220) (core#if (pair? .for",
"m.2299) (core#if (pair? (car .form.2299)) (core#if (identifier? (caar .form.2299", "m.2220) (core#if (pair? (car .form.2220)) (core#if (identifier? (caar .form.2220",
")) (identifier=? (.the.2229 (core#quote unquote-splicing)) (make-identifier (caa", ")) (identifier=? (.the.2150 (core#quote unquote-splicing)) (make-identifier (caa",
"r .form.2299) .env.2292)) #f) #f) #f))) (core#begin (core#define .qq.2296 (core#", "r .form.2220) .env.2213)) #f) #f) #f))) (core#begin (core#define .qq.2217 (core#",
"lambda (.depth.2300 .expr.2301) (core#if (.unquote?.2294 .expr.2301) (core#if (=", "lambda (.depth.2221 .expr.2222) (core#if (.unquote?.2215 .expr.2222) (core#if (=",
" .depth.2300 1) (cadr .expr.2301) (list (.the.2229 (core#quote list)) (list (.th", " .depth.2221 1) (cadr .expr.2222) (list (.the.2150 (core#quote list)) (list (.th",
"e.2229 (core#quote quote)) (.the.2229 (core#quote unquote))) (.qq.2296 (- .depth", "e.2150 (core#quote quote)) (.the.2150 (core#quote unquote))) (.qq.2217 (- .depth",
".2300 1) (car (cdr .expr.2301))))) (core#if (.unquote-splicing?.2295 .expr.2301)", ".2221 1) (car (cdr .expr.2222))))) (core#if (.unquote-splicing?.2216 .expr.2222)",
" (core#if (= .depth.2300 1) (list (.the.2229 (core#quote append)) (car (cdr (car", " (core#if (= .depth.2221 1) (list (.the.2150 (core#quote append)) (car (cdr (car",
" .expr.2301))) (.qq.2296 .depth.2300 (cdr .expr.2301))) (list (.the.2229 (core#q", " .expr.2222))) (.qq.2217 .depth.2221 (cdr .expr.2222))) (list (.the.2150 (core#q",
"uote cons)) (list (.the.2229 (core#quote list)) (list (.the.2229 (core#quote quo", "uote cons)) (list (.the.2150 (core#quote list)) (list (.the.2150 (core#quote quo",
"te)) (.the.2229 (core#quote unquote-splicing))) (.qq.2296 (- .depth.2300 1) (car", "te)) (.the.2150 (core#quote unquote-splicing))) (.qq.2217 (- .depth.2221 1) (car",
" (cdr (car .expr.2301))))) (.qq.2296 .depth.2300 (cdr .expr.2301)))) (core#if (.", " (cdr (car .expr.2222))))) (.qq.2217 .depth.2221 (cdr .expr.2222)))) (core#if (.",
"quasiquote?.2293 .expr.2301) (list (.the.2229 (core#quote list)) (list (.the.222", "quasiquote?.2214 .expr.2222) (list (.the.2150 (core#quote list)) (list (.the.215",
"9 (core#quote quote)) (.the.2229 (core#quote quasiquote))) (.qq.2296 (+ .depth.2", "0 (core#quote quote)) (.the.2150 (core#quote quasiquote))) (.qq.2217 (+ .depth.2",
"300 1) (car (cdr .expr.2301)))) (core#if (pair? .expr.2301) (list (.the.2229 (co", "221 1) (car (cdr .expr.2222)))) (core#if (pair? .expr.2222) (list (.the.2150 (co",
"re#quote cons)) (.qq.2296 .depth.2300 (car .expr.2301)) (.qq.2296 .depth.2300 (c", "re#quote cons)) (.qq.2217 .depth.2221 (car .expr.2222)) (.qq.2217 .depth.2221 (c",
"dr .expr.2301))) (core#if (vector? .expr.2301) (list (.the.2229 (core#quote list", "dr .expr.2222))) (core#if (vector? .expr.2222) (list (.the.2150 (core#quote list",
"->vector)) (.qq.2296 .depth.2300 (vector->list .expr.2301))) (list (.the.2229 (c", "->vector)) (.qq.2217 .depth.2221 (vector->list .expr.2222))) (list (.the.2150 (c",
"ore#quote quote)) .expr.2301)))))))) ((core#lambda (.x.2302) (.qq.2296 1 .x.2302", "ore#quote quote)) .expr.2222)))))))) ((core#lambda (.x.2223) (.qq.2217 1 .x.2223",
")) (cadr .form.2291)))))))) (core#begin (.define-transformer.2228 (core#quote le", ")) (cadr .form.2212)))))))) (core#begin (.define-transformer.2149 (core#quote le",
"t*) (core#lambda (.form.2303 .env.2304) ((core#lambda (.bindings.2305 .body.2306", "t*) (core#lambda (.form.2224 .env.2225) ((core#lambda (.bindings.2226 .body.2227",
") (core#if (null? .bindings.2305) (cons (.the.2229 (core#quote let)) (cons (core", ") (core#if (null? .bindings.2226) (cons (.the.2150 (core#quote let)) (cons (core",
"#quote ()) .body.2306)) (cons (.the.2229 (core#quote let)) (cons (cons (cons (ca", "#quote ()) .body.2227)) (cons (.the.2150 (core#quote let)) (cons (cons (cons (ca",
"r (car .bindings.2305)) (cdr (car .bindings.2305))) (core#quote ())) (cons (cons", "r (car .bindings.2226)) (cdr (car .bindings.2226))) (core#quote ())) (cons (cons",
" (.the.2229 (core#quote let*)) (cons (cdr .bindings.2305) .body.2306)) (core#quo", " (.the.2150 (core#quote let*)) (cons (cdr .bindings.2226) .body.2227)) (core#quo",
"te ())))))) (car (cdr .form.2303)) (cdr (cdr .form.2303))))) (core#begin (.defin", "te ())))))) (car (cdr .form.2224)) (cdr (cdr .form.2224))))) (core#begin (.defin",
"e-transformer.2228 (core#quote letrec) (core#lambda (.form.2307 .env.2308) (cons", "e-transformer.2149 (core#quote letrec) (core#lambda (.form.2228 .env.2229) (cons",
" (.the.2229 (core#quote letrec*)) (cdr .form.2307)))) (core#begin (.define-trans", " (.the.2150 (core#quote letrec*)) (cdr .form.2228)))) (core#begin (.define-trans",
"former.2228 (core#quote letrec*) (core#lambda (.form.2309 .env.2310) ((core#lamb", "former.2149 (core#quote letrec*) (core#lambda (.form.2230 .env.2231) ((core#lamb",
"da (.bindings.2311 .body.2312) ((core#lambda (.variables.2313 .initials.2314) (c", "da (.bindings.2232 .body.2233) ((core#lambda (.variables.2234 .initials.2235) (c",
"ons (.the.2229 (core#quote let)) (cons .variables.2313 (append .initials.2314 (a", "ons (.the.2150 (core#quote let)) (cons .variables.2234 (append .initials.2235 (a",
"ppend .body.2312 (core#quote ())))))) (map (core#lambda (.v.2315) (cons .v.2315 ", "ppend .body.2233 (core#quote ())))))) (map (core#lambda (.v.2236) (cons .v.2236 ",
"(cons (core#quote #undefined) (core#quote ())))) (map car .bindings.2311)) (map ", "(cons (core#quote #undefined) (core#quote ())))) (map car .bindings.2232)) (map ",
"(core#lambda (.v.2316) (cons (.the.2229 (core#quote set!)) (append .v.2316 (core", "(core#lambda (.v.2237) (cons (.the.2150 (core#quote set!)) (append .v.2237 (core",
"#quote ())))) .bindings.2311))) (car (cdr .form.2309)) (cdr (cdr .form.2309)))))", "#quote ())))) .bindings.2232))) (car (cdr .form.2230)) (cdr (cdr .form.2230)))))",
" (core#begin (.define-transformer.2228 (core#quote let-values) (core#lambda (.fo", " (core#begin (.define-transformer.2149 (core#quote let-values) (core#lambda (.fo",
"rm.2317 .env.2318) (cons (.the.2229 (core#quote let*-values)) (append (cdr .form", "rm.2238 .env.2239) (cons (.the.2150 (core#quote let*-values)) (append (cdr .form",
".2317) (core#quote ()))))) (core#begin (.define-transformer.2228 (core#quote let", ".2238) (core#quote ()))))) (core#begin (.define-transformer.2149 (core#quote let",
"*-values) (core#lambda (.form.2319 .env.2320) ((core#lambda (.formals.2321 .body", "*-values) (core#lambda (.form.2240 .env.2241) ((core#lambda (.formals.2242 .body",
".2322) (core#if (null? .formals.2321) (cons (.the.2229 (core#quote let)) (cons (", ".2243) (core#if (null? .formals.2242) (cons (.the.2150 (core#quote let)) (cons (",
"core#quote ()) (append .body.2322 (core#quote ())))) ((core#lambda (.formal.2323", "core#quote ()) (append .body.2243 (core#quote ())))) ((core#lambda (.formal.2244",
") (cons (.the.2229 (core#quote call-with-values)) (cons (cons .the-lambda.2238 (", ") (cons (.the.2150 (core#quote call-with-values)) (cons (cons .the-lambda.2159 (",
"cons (core#quote ()) (cdr .formal.2323))) (cons (cons (.the.2229 (core#quote lam", "cons (core#quote ()) (cdr .formal.2244))) (cons (cons (.the.2150 (core#quote lam",
"bda)) (cons (car .formal.2323) (cons (cons (.the.2229 (core#quote let*-values)) ", "bda)) (cons (car .formal.2244) (cons (cons (.the.2150 (core#quote let*-values)) ",
"(cons (cdr .formals.2321) .body.2322)) (core#quote ())))) (core#quote ()))))) (c", "(cons (cdr .formals.2242) .body.2243)) (core#quote ())))) (core#quote ()))))) (c",
"ar .formals.2321)))) (cadr .form.2319) (cddr .form.2319)))) (core#begin (.define", "ar .formals.2242)))) (cadr .form.2240) (cddr .form.2240)))) (core#begin (.define",
"-transformer.2228 (core#quote define-values) (core#lambda (.form.2324 .env.2325)", "-transformer.2149 (core#quote define-values) (core#lambda (.form.2245 .env.2246)",
" ((core#lambda (.formal.2326 .body.2327) ((core#lambda (.tmps.2328) (cons .the-b", " ((core#lambda (.formal.2247 .body.2248) ((core#lambda (.tmps.2249) (cons .the-b",
"egin.2239 (append ((core#lambda () (core#begin (core#define .loop.2329 (core#lam", "egin.2160 (append ((core#lambda () (core#begin (core#define .loop.2250 (core#lam",
"bda (.formal.2330) (core#if (identifier? .formal.2330) (cons (cons .the-define.2", "bda (.formal.2251) (core#if (identifier? .formal.2251) (cons (cons .the-define.2",
"237 (cons .formal.2330 (cons (core#quote #undefined) (core#quote ())))) (core#qu", "158 (cons .formal.2251 (cons (core#quote #undefined) (core#quote ())))) (core#qu",
"ote ())) (core#if (pair? .formal.2330) (cons (cons .the-define.2237 (cons (car .", "ote ())) (core#if (pair? .formal.2251) (cons (cons .the-define.2158 (cons (car .",
"formal.2330) (cons (core#quote #undefined) (core#quote ())))) (.loop.2329 (cdr .", "formal.2251) (cons (core#quote #undefined) (core#quote ())))) (.loop.2250 (cdr .",
"formal.2330))) (core#quote ()))))) (.loop.2329 .formal.2326)))) (cons (cons (.th", "formal.2251))) (core#quote ()))))) (.loop.2250 .formal.2247)))) (cons (cons (.th",
"e.2229 (core#quote call-with-values)) (cons (cons .the-lambda.2238 (cons (core#q", "e.2150 (core#quote call-with-values)) (cons (cons .the-lambda.2159 (cons (core#q",
"uote ()) .body.2327)) (cons (cons .the-lambda.2238 (cons .tmps.2328 ((core#lambd", "uote ()) .body.2248)) (cons (cons .the-lambda.2159 (cons .tmps.2249 ((core#lambd",
"a () (core#begin (core#define .loop.2331 (core#lambda (.formal.2332 .tmps.2333) ", "a () (core#begin (core#define .loop.2252 (core#lambda (.formal.2253 .tmps.2254) ",
"(core#if (identifier? .formal.2332) (cons (cons .the-set!.2241 (cons .formal.233", "(core#if (identifier? .formal.2253) (cons (cons .the-set!.2162 (cons .formal.225",
"2 (cons .tmps.2333 (core#quote ())))) (core#quote ())) (core#if (pair? .formal.2", "3 (cons .tmps.2254 (core#quote ())))) (core#quote ())) (core#if (pair? .formal.2",
"332) (cons (cons .the-set!.2241 (cons (car .formal.2332) (cons (car .tmps.2333) ", "253) (cons (cons .the-set!.2162 (cons (car .formal.2253) (cons (car .tmps.2254) ",
"(core#quote ())))) (.loop.2331 (cdr .formal.2332) (cdr .tmps.2333))) (core#quote", "(core#quote ())))) (.loop.2252 (cdr .formal.2253) (cdr .tmps.2254))) (core#quote",
" ()))))) (.loop.2331 .formal.2326 .tmps.2328)))))) (core#quote ())))) (core#quot", " ()))))) (.loop.2252 .formal.2247 .tmps.2249)))))) (core#quote ())))) (core#quot",
"e ()))))) ((core#lambda () (core#begin (core#define .loop.2334 (core#lambda (.fo", "e ()))))) ((core#lambda () (core#begin (core#define .loop.2255 (core#lambda (.fo",
"rmal.2335) (core#if (identifier? .formal.2335) (make-identifier .formal.2335 .en", "rmal.2256) (core#if (identifier? .formal.2256) (make-identifier .formal.2256 .en",
"v.2325) (core#if (pair? .formal.2335) (cons (make-identifier (car .formal.2335) ", "v.2246) (core#if (pair? .formal.2256) (cons (make-identifier (car .formal.2256) ",
".env.2325) (.loop.2334 (cdr .formal.2335))) (core#quote ()))))) (.loop.2334 .for", ".env.2246) (.loop.2255 (cdr .formal.2256))) (core#quote ()))))) (.loop.2255 .for",
"mal.2326)))))) (cadr .form.2324) (cddr .form.2324)))) (core#begin (.define-trans", "mal.2247)))))) (cadr .form.2245) (cddr .form.2245)))) (core#begin (.define-trans",
"former.2228 (core#quote do) (core#lambda (.form.2336 .env.2337) ((core#lambda (.", "former.2149 (core#quote do) (core#lambda (.form.2257 .env.2258) ((core#lambda (.",
"bindings.2338 .test.2339 .cleanup.2340 .body.2341) ((core#lambda (.loop.2342) (c", "bindings.2259 .test.2260 .cleanup.2261 .body.2262) ((core#lambda (.loop.2263) (c",
"ons (.the.2229 (core#quote let)) (cons .loop.2342 (cons (map (core#lambda (.x.23", "ons (.the.2150 (core#quote let)) (cons .loop.2263 (cons (map (core#lambda (.x.22",
"43) (cons (car .x.2343) (cons (cadr .x.2343) (core#quote ())))) .bindings.2338) ", "64) (cons (car .x.2264) (cons (cadr .x.2264) (core#quote ())))) .bindings.2259) ",
"(cons (cons .the-if.2242 (cons .test.2339 (cons (cons .the-begin.2239 .cleanup.2", "(cons (cons .the-if.2163 (cons .test.2260 (cons (cons .the-begin.2160 .cleanup.2",
"340) (cons (cons .the-begin.2239 (append .body.2341 (cons (cons .loop.2342 (map ", "261) (cons (cons .the-begin.2160 (append .body.2262 (cons (cons .loop.2263 (map ",
"(core#lambda (.x.2344) (core#if (null? (cdr (cdr .x.2344))) (car .x.2344) (car (", "(core#lambda (.x.2265) (core#if (null? (cdr (cdr .x.2265))) (car .x.2265) (car (",
"cdr (cdr .x.2344))))) .bindings.2338)) (core#quote ())))) (core#quote ()))))) (c", "cdr (cdr .x.2265))))) .bindings.2259)) (core#quote ())))) (core#quote ()))))) (c",
"ore#quote ())))))) (make-identifier (core#quote loop) .env.2337))) (car (cdr .fo", "ore#quote ())))))) (make-identifier (core#quote loop) .env.2258))) (car (cdr .fo",
"rm.2336)) (car (car (cdr (cdr .form.2336)))) (cdr (car (cdr (cdr .form.2336)))) ", "rm.2257)) (car (car (cdr (cdr .form.2257)))) (cdr (car (cdr (cdr .form.2257)))) ",
"(cdr (cdr (cdr .form.2336)))))) (core#begin (.define-transformer.2228 (core#quot", "(cdr (cdr (cdr .form.2257)))))) (core#begin (.define-transformer.2149 (core#quot",
"e when) (core#lambda (.form.2345 .env.2346) ((core#lambda (.test.2347 .body.2348", "e when) (core#lambda (.form.2266 .env.2267) ((core#lambda (.test.2268 .body.2269",
") (cons .the-if.2242 (cons .test.2347 (cons (cons .the-begin.2239 (append .body.", ") (cons .the-if.2163 (cons .test.2268 (cons (cons .the-begin.2160 (append .body.",
"2348 (core#quote ()))) (cons (core#quote #undefined) (core#quote ())))))) (car (", "2269 (core#quote ()))) (cons (core#quote #undefined) (core#quote ())))))) (car (",
"cdr .form.2345)) (cdr (cdr .form.2345))))) (core#begin (.define-transformer.2228", "cdr .form.2266)) (cdr (cdr .form.2266))))) (core#begin (.define-transformer.2149",
" (core#quote unless) (core#lambda (.form.2349 .env.2350) ((core#lambda (.test.23", " (core#quote unless) (core#lambda (.form.2270 .env.2271) ((core#lambda (.test.22",
"51 .body.2352) (cons .the-if.2242 (cons .test.2351 (cons (core#quote #undefined)", "72 .body.2273) (cons .the-if.2163 (cons .test.2272 (cons (core#quote #undefined)",
" (cons (cons .the-begin.2239 (append .body.2352 (core#quote ()))) (core#quote ()", " (cons (cons .the-begin.2160 (append .body.2273 (core#quote ()))) (core#quote ()",
")))))) (car (cdr .form.2349)) (cdr (cdr .form.2349))))) (core#begin (.define-tra", ")))))) (car (cdr .form.2270)) (cdr (cdr .form.2270))))) (core#begin (.define-tra",
"nsformer.2228 (core#quote case) (core#lambda (.form.2353 .env.2354) ((core#lambd", "nsformer.2149 (core#quote case) (core#lambda (.form.2274 .env.2275) ((core#lambd",
"a (.key.2355 .clauses.2356) ((core#lambda (.the-key.2357) (cons (.the.2229 (core", "a (.key.2276 .clauses.2277) ((core#lambda (.the-key.2278) (cons (.the.2150 (core",
"#quote let)) (cons (cons (cons .the-key.2357 (cons .key.2355 (core#quote ()))) (", "#quote let)) (cons (cons (cons .the-key.2278 (cons .key.2276 (core#quote ()))) (",
"core#quote ())) (cons ((core#lambda () (core#begin (core#define .loop.2358 (core", "core#quote ())) (cons ((core#lambda () (core#begin (core#define .loop.2279 (core",
"#lambda (.clauses.2359) (core#if (null? .clauses.2359) #undefined ((core#lambda ", "#lambda (.clauses.2280) (core#if (null? .clauses.2280) #undefined ((core#lambda ",
"(.clause.2360) (cons .the-if.2242 (cons (core#if (core#if (identifier? (car .cla", "(.clause.2281) (cons .the-if.2163 (cons (core#if (core#if (identifier? (car .cla",
"use.2360)) (identifier=? (.the.2229 (core#quote else)) (make-identifier (car .cl", "use.2281)) (identifier=? (.the.2150 (core#quote else)) (make-identifier (car .cl",
"ause.2360) .env.2354)) #f) #t (cons (.the.2229 (core#quote or)) (append (map (co", "ause.2281) .env.2275)) #f) #t (cons (.the.2150 (core#quote or)) (append (map (co",
"re#lambda (.x.2361) (cons (.the.2229 (core#quote eqv?)) (cons .the-key.2357 (con", "re#lambda (.x.2282) (cons (.the.2150 (core#quote eqv?)) (cons .the-key.2278 (con",
"s (cons .the-quote.2240 (cons .x.2361 (core#quote ()))) (core#quote ()))))) (car", "s (cons .the-quote.2161 (cons .x.2282 (core#quote ()))) (core#quote ()))))) (car",
" .clause.2360)) (core#quote ())))) (cons (core#if (core#if (identifier? (cadr .c", " .clause.2281)) (core#quote ())))) (cons (core#if (core#if (identifier? (cadr .c",
"lause.2360)) (identifier=? (.the.2229 (core#quote =>)) (make-identifier (cadr .c", "lause.2281)) (identifier=? (.the.2150 (core#quote =>)) (make-identifier (cadr .c",
"lause.2360) .env.2354)) #f) (cons (car (cdr (cdr .clause.2360))) (cons .the-key.", "lause.2281) .env.2275)) #f) (cons (car (cdr (cdr .clause.2281))) (cons .the-key.",
"2357 (core#quote ()))) (cons .the-begin.2239 (append (cdr .clause.2360) (core#qu", "2278 (core#quote ()))) (cons .the-begin.2160 (append (cdr .clause.2281) (core#qu",
"ote ())))) (cons (.loop.2358 (cdr .clauses.2359)) (core#quote ())))))) (car .cla", "ote ())))) (cons (.loop.2279 (cdr .clauses.2280)) (core#quote ())))))) (car .cla",
"uses.2359))))) (.loop.2358 .clauses.2356)))) (core#quote ()))))) (make-identifie", "uses.2280))))) (.loop.2279 .clauses.2277)))) (core#quote ()))))) (make-identifie",
"r (core#quote key) .env.2354))) (car (cdr .form.2353)) (cdr (cdr .form.2353)))))", "r (core#quote key) .env.2275))) (car (cdr .form.2274)) (cdr (cdr .form.2274)))))",
" (.define-transformer.2228 (core#quote parameterize) (core#lambda (.form.2362 .e", " (core#begin (.define-transformer.2149 (core#quote parameterize) (core#lambda (.",
"nv.2363) ((core#lambda (.formal.2364 .body.2365) (cons (.the.2229 (core#quote wi", "form.2283 .env.2284) ((core#lambda (.formal.2285 .body.2286) (cons (.the.2150 (c",
"th-dynamic-environment)) (cons (cons (.the.2229 (core#quote list)) (append (map ", "ore#quote with-dynamic-environment)) (cons (cons (.the.2150 (core#quote list)) (",
"(core#lambda (.x.2366) (cons (.the.2229 (core#quote cons)) (cons (car .x.2366) (", "append (map (core#lambda (.x.2287) (cons (.the.2150 (core#quote cons)) (cons (ca",
"cons (cadr .x.2366) (core#quote ()))))) .formal.2364) (core#quote ()))) (cons (c", "r .x.2287) (cons (cadr .x.2287) (core#quote ()))))) .formal.2285) (core#quote ()",
"ons .the-lambda.2238 (cons (core#quote ()) (append .body.2365 (core#quote ()))))", "))) (cons (cons .the-lambda.2159 (cons (core#quote ()) (append .body.2286 (core#",
" (core#quote ()))))) (car (cdr .form.2362)) (cdr (cdr .form.2362))))))))))))))))", "quote ())))) (core#quote ()))))) (car (cdr .form.2283)) (cdr (cdr .form.2283))))",
")))))))))))))))))) (.the.2229 (core#quote core#define)) (.the.2229 (core#quote c", ") (.define-transformer.2149 (core#quote define-record-type) (core#lambda (.form.",
"ore#lambda)) (.the.2229 (core#quote core#begin)) (.the.2229 (core#quote core#quo", "2288 .env.2289) ((core#lambda (.type.2290 .ctor.2291 .pred.2292 .fields.2293) (c",
"te)) (.the.2229 (core#quote core#set!)) (.the.2229 (core#quote core#if)) (.the.2", "ons .the-begin.2160 (cons (cons .the-define.2158 (cons .ctor.2291 (cons (cons (.",
"229 (core#quote core#define-macro)) (.the.2229 (core#quote define)) (.the.2229 (", "the.2150 (core#quote make-record)) (cons (cons (core#quote quote) (cons .type.22",
"core#quote lambda)) (.the.2229 (core#quote begin)) (.the.2229 (core#quote quote)", "90 (core#quote ()))) (cons (cons (.the.2150 (core#quote vector)) (map (core#lamb",
") (.the.2229 (core#quote set!)) (.the.2229 (core#quote if)) (.the.2229 (core#quo", "da (.field.2294) (core#if (memq (car .field.2294) (cdr .ctor.2291)) (car .field.",
"te define-macro)))) (core#lambda (.name.2367 .transformer.2368) (dictionary-set!", "2294) #undefined)) .fields.2293)) (core#quote ())))) (core#quote ())))) (cons (c",
" (macro-objects) .name.2367 .transformer.2368)) (core#lambda (.var.2369) (make-i", "ons .the-define.2158 (cons .pred.2292 (cons (cons (.the.2150 (core#quote lambda)",
"dentifier .var.2369 default-environment)))", ") (cons (cons (core#quote obj) (core#quote ())) (cons (cons (.the.2150 (core#quo",
"te and)) (cons (cons (.the.2150 (core#quote record?)) (cons (core#quote obj) (co",
"re#quote ()))) (cons (cons (.the.2150 (core#quote eq?)) (cons (cons (.the.2150 (",
"core#quote record-type)) (cons (core#quote obj) (core#quote ()))) (cons (cons (c",
"ore#quote quote) (cons .type.2290 (core#quote ()))) (core#quote ())))) (core#quo",
"te ())))) (core#quote ())))) (core#quote ())))) ((core#lambda () (core#begin (co",
"re#define .loop.2295 (core#lambda (.fields.2296 .pos.2297 .acc.2298) (core#if (n",
"ull? .fields.2296) .acc.2298 ((core#lambda (.field.2299) ((core#lambda (.defs.23",
"00) (.loop.2295 (cdr .fields.2296) (+ .pos.2297 1) (append .defs.2300 .acc.2298)",
")) (cons (cons .the-define.2158 (cons (cons (cadr .field.2299) (cons (core#quote",
" obj) (core#quote ()))) (cons (cons .the-if.2163 (cons (cons .pred.2292 (cons (c",
"ore#quote obj) (core#quote ()))) (cons (cons (.the.2150 (core#quote vector-ref))",
" (cons (cons (.the.2150 (core#quote record-datum)) (cons (core#quote obj) (core#",
"quote ()))) (cons .pos.2297 (core#quote ())))) (cons (cons (.the.2150 (core#quot",
"e error)) (cons (core#quote \"record type mismatch\") (cons (core#quote obj) (cons",
" (cons (core#quote quote) (cons .type.2290 (core#quote ()))) (core#quote ())))))",
" (core#quote ()))))) (core#quote ())))) (core#if (null? (cddr .field.2299)) (cor",
"e#quote ()) (cons (cons .the-define.2158 (cons (cons (car (cddr .field.2299)) (c",
"ons (core#quote obj) (cons (core#quote value) (core#quote ())))) (cons (cons .th",
"e-if.2163 (cons (cons .pred.2292 (cons (core#quote obj) (core#quote ()))) (cons ",
"(cons (.the.2150 (core#quote vector-set!)) (cons (cons (.the.2150 (core#quote re",
"cord-datum)) (cons (core#quote obj) (core#quote ()))) (cons .pos.2297 (cons (cor",
"e#quote value) (core#quote ()))))) (cons (cons (.the.2150 (core#quote error)) (c",
"ons (core#quote \"record type mismatch\") (cons (core#quote obj) (cons (cons (core",
"#quote quote) (cons .type.2290 (core#quote ()))) (core#quote ()))))) (core#quote",
" ()))))) (core#quote ())))) (core#quote ())))))) (car .fields.2296))))) (.loop.2",
"295 .fields.2293 0 (core#quote ()))))))))) (car (cdr .form.2288)) (car (cdr (cdr",
" .form.2288))) (car (cdr (cdr (cdr .form.2288)))) (cdr (cdr (cdr (cdr .form.2288",
"))))))))))))))))))))))))))))))))))))) (.the.2150 (core#quote core#define)) (.the",
".2150 (core#quote core#lambda)) (.the.2150 (core#quote core#begin)) (.the.2150 (",
"core#quote core#quote)) (.the.2150 (core#quote core#set!)) (.the.2150 (core#quot",
"e core#if)) (.the.2150 (core#quote core#define-macro)) (.the.2150 (core#quote de",
"fine)) (.the.2150 (core#quote lambda)) (.the.2150 (core#quote begin)) (.the.2150",
" (core#quote quote)) (.the.2150 (core#quote set!)) (.the.2150 (core#quote if)) (",
".the.2150 (core#quote define-macro)))) (core#lambda (.name.2301 .transformer.230",
"2) (dictionary-set! (macro-objects) .name.2301 .transformer.2302)) (core#lambda ",
"(.var.2303) (make-identifier .var.2303 default-environment)))",
};
static const char boot_compile_rom[][80] = {
"(core#begin (core#define make-identifier #undefined) (core#begin (core#define id",
"entifier? #undefined) (core#begin (core#define identifier=? #undefined) (core#be",
"gin (core#define identifier-name #undefined) (core#begin (core#define identifier",
"-environment #undefined) (core#begin (core#define make-environment #undefined) (",
"core#begin (core#define default-environment #undefined) (core#begin (core#define",
" environment? #undefined) (core#begin (core#define find-identifier #undefined) (",
"core#begin (core#define add-identifier! #undefined) (core#begin (core#define set",
"-identifier! #undefined) (core#begin (core#define macro-objects #undefined) (cor",
"e#begin (core#define compile #undefined) (core#begin (core#define eval #undefine",
"d) (call-with-values (core#lambda () ((core#lambda () (core#begin (core#begin (c",
"ore#define .make-identifier.2304 (core#lambda (.name.2330 .env.2331) (make-recor",
"d (core#quote identifier) (vector .name.2330 .env.2331)))) (core#begin (core#def",
"ine .%identifier?.2305 (core#lambda (.obj.2332) (core#if (record? .obj.2332) (eq",
"? (record-type .obj.2332) (core#quote identifier)) #f))) (core#begin (core#defin",
"e .identifier-environment.2306 (core#lambda (.obj.2333) (core#if (.%identifier?.",
"2305 .obj.2333) (vector-ref (record-datum .obj.2333) 1) (error \"record type mism",
"atch\" .obj.2333 (core#quote identifier))))) (core#define .identifier-name.2307 (",
"core#lambda (.obj.2334) (core#if (.%identifier?.2305 .obj.2334) (vector-ref (rec",
"ord-datum .obj.2334) 0) (error \"record type mismatch\" .obj.2334 (core#quote iden",
"tifier)))))))) (core#begin (core#define .identifier?.2308 (core#lambda (.obj.233",
"5) ((core#lambda (.it.2336) (core#if .it.2336 .it.2336 ((core#lambda (.it.2337) ",
"(core#if .it.2337 .it.2337 #f)) (.%identifier?.2305 .obj.2335)))) (symbol? .obj.",
"2335)))) (core#begin (core#define .identifier=?.2309 (core#lambda (.id1.2338 .id",
"2.2339) (core#if (core#if (symbol? .id1.2338) (symbol? .id2.2339) #f) (eq? .id1.",
"2338 .id2.2339) (core#if (core#if (.%identifier?.2305 .id1.2338) (.%identifier?.",
"2305 .id2.2339) #f) (eq? (.find-identifier.2316 (.identifier-name.2307 .id1.2338",
") (.identifier-environment.2306 .id1.2338)) (.find-identifier.2316 (.identifier-",
"name.2307 .id2.2339) (.identifier-environment.2306 .id2.2339))) #f)))) (core#beg",
"in (core#set! equal? ((core#lambda (.e?.2340) (core#lambda (.x.2341 .y.2342) (co",
"re#if (.%identifier?.2305 .x.2341) (.identifier=?.2309 .x.2341 .y.2342) (.e?.234",
"0 .x.2341 .y.2342)))) equal?)) (core#begin (core#begin (core#define .%make-envir",
"onment.2310 (core#lambda (.parent.2343 .prefix.2344 .binding.2345) (make-record ",
"(core#quote environment) (vector .parent.2343 .prefix.2344 .binding.2345)))) (co",
"re#begin (core#define .environment?.2311 (core#lambda (.obj.2346) (core#if (reco",
"rd? .obj.2346) (eq? (record-type .obj.2346) (core#quote environment)) #f))) (cor",
"e#begin (core#define .environment-binding.2312 (core#lambda (.obj.2347) (core#if",
" (.environment?.2311 .obj.2347) (vector-ref (record-datum .obj.2347) 2) (error \"",
"record type mismatch\" .obj.2347 (core#quote environment))))) (core#begin (core#d",
"efine .environment-prefix.2313 (core#lambda (.obj.2348) (core#if (.environment?.",
"2311 .obj.2348) (vector-ref (record-datum .obj.2348) 1) (error \"record type mism",
"atch\" .obj.2348 (core#quote environment))))) (core#define .environment-parent.23",
"14 (core#lambda (.obj.2349) (core#if (.environment?.2311 .obj.2349) (vector-ref ",
"(record-datum .obj.2349) 0) (error \"record type mismatch\" .obj.2349 (core#quote ",
"environment))))))))) (core#begin (core#define .search-scope.2315 (core#lambda (.",
"id.2350 .env.2351) ((.environment-binding.2312 .env.2351) .id.2350))) (core#begi",
"n (core#define .find-identifier.2316 (core#lambda (.id.2352 .env.2353) ((core#la",
"mbda (.it.2354) (core#if .it.2354 .it.2354 ((core#lambda (.it.2355) (core#if .it",
".2355 .it.2355 #f)) ((core#lambda (.parent.2356) (core#if .parent.2356 (.find-id",
"entifier.2316 .id.2352 .parent.2356) (core#if (symbol? .id.2352) (.add-identifie",
"r!.2317 .id.2352 .env.2353) (.find-identifier.2316 (.identifier-name.2307 .id.23",
"52) (.identifier-environment.2306 .id.2352))))) (.environment-parent.2314 .env.2",
"353))))) (.search-scope.2315 .id.2352 .env.2353)))) (core#begin (core#define .ad",
"d-identifier!.2317 ((core#lambda (.uniq.2357) (core#lambda (.id.2358 .env.2359) ",
"((core#lambda (.it.2360) (core#if .it.2360 .it.2360 ((core#lambda (.it.2361) (co",
"re#if .it.2361 .it.2361 #f)) (core#if (core#if (not (.environment-parent.2314 .e",
"nv.2359)) (symbol? .id.2358) #f) (string->symbol (string-append (.environment-pr",
"efix.2313 .env.2359) (symbol->string .id.2358))) ((core#lambda (.uid.2362) (core",
"#begin (.set-identifier!.2318 .id.2358 .uid.2362 .env.2359) .uid.2362)) (.uniq.2",
"357 .id.2358)))))) (.search-scope.2315 .id.2358 .env.2359)))) ((core#lambda (.n.",
"2363) (core#lambda (.id.2364) ((core#lambda (.m.2365) (core#begin (core#set! .n.",
"2363 (+ .n.2363 1)) (string->symbol (string-append \".\" (symbol->string ((core#la",
"mbda () (core#begin (core#define .loop.2366 (core#lambda (.id.2367) (core#if (sy",
"mbol? .id.2367) .id.2367 (.loop.2366 (.identifier-name.2307 .id.2367))))) (.loop",
".2366 .id.2364))))) \".\" (number->string .m.2365))))) .n.2363))) 0))) (core#begin",
" (core#define .set-identifier!.2318 (core#lambda (.id.2368 .uid.2369 .env.2370) ",
"((.environment-binding.2312 .env.2370) .id.2368 .uid.2369))) (core#begin (core#d",
"efine .make-environment.2319 (core#lambda (.prefix.2371) (.%make-environment.231",
"0 #f (symbol->string .prefix.2371) (make-ephemeron-table)))) (core#begin (core#d",
"efine .default-environment.2320 ((core#lambda (.env.2372) (core#begin (for-each ",
"(core#lambda (.x.2373) (.set-identifier!.2318 .x.2373 .x.2373 .env.2372)) (core#",
"quote (core#define core#set! core#quote core#lambda core#if core#begin core#defi",
"ne-macro))) .env.2372)) (.make-environment.2319 (string->symbol \"\")))) (core#beg",
"in (core#define .extend-environment.2321 (core#lambda (.parent.2374) (.%make-env",
"ironment.2310 .parent.2374 #f (make-ephemeron-table)))) (core#begin (core#define",
" .global-macro-table.2322 (make-dictionary)) (core#begin (core#define .find-macr",
"o.2323 (core#lambda (.uid.2375) (core#if (dictionary-has? .global-macro-table.23",
"22 .uid.2375) (dictionary-ref .global-macro-table.2322 .uid.2375) #f))) (core#be",
"gin (core#define .add-macro!.2324 (core#lambda (.uid.2376 .expander.2377) (dicti",
"onary-set! .global-macro-table.2322 .uid.2376 .expander.2377))) (core#begin (cor",
"e#define .shadow-macro!.2325 (core#lambda (.uid.2378) (core#if (dictionary-has? ",
".global-macro-table.2322 .uid.2378) (dictionary-delete! .global-macro-table.2322",
" .uid.2378) #undefined))) (core#begin (core#define .macro-objects.2326 (core#lam",
"bda () .global-macro-table.2322)) (core#begin (core#define .expand.2327 ((core#l",
"ambda (.task-queue.2379) (core#begin (core#define .queue.2380 (core#lambda (.tas",
"k.2393) ((core#lambda (.tmp.2394) (core#begin (.task-queue.2379 (cons (cons .tmp",
".2394 .task.2393) (.task-queue.2379))) .tmp.2394)) (cons #f #f)))) (core#begin (",
"core#define .run-all.2381 (core#lambda () (for-each (core#lambda (.x.2395) ((cor",
"e#lambda (.task.2396 .skelton.2397) ((core#lambda (.x.2398) (core#begin (set-car",
"! .skelton.2397 (car .x.2398)) (set-cdr! .skelton.2397 (cdr .x.2398)))) (.task.2",
"396))) (cdr .x.2395) (car .x.2395))) (reverse (.task-queue.2379))))) (core#begin",
" (core#define .caddr.2382 (core#lambda (.x.2399) (car (cddr .x.2399)))) (core#be",
"gin (core#define .map*.2383 (core#lambda (.proc.2400 .list*.2401) (core#if (null",
"? .list*.2401) .list*.2401 (core#if (pair? .list*.2401) (cons (.proc.2400 (car .",
"list*.2401)) (.map*.2383 .proc.2400 (cdr .list*.2401))) (.proc.2400 .list*.2401)",
")))) (core#begin (core#define .literal?.2384 (core#lambda (.x.2402) (not ((core#",
"lambda (.it.2403) (core#if .it.2403 .it.2403 ((core#lambda (.it.2404) (core#if .",
"it.2404 .it.2404 #f)) (pair? .x.2402)))) (.identifier?.2308 .x.2402))))) (core#b",
"egin (core#define .call?.2385 (core#lambda (.x.2405) (core#if (list? .x.2405) (c",
"ore#if (not (null? .x.2405)) (.identifier?.2308 (car .x.2405)) #f) #f))) (core#b",
"egin (core#define .expand-variable.2386 (core#lambda (.var.2406 .env.2407) ((cor",
"e#lambda (.x.2408) ((core#lambda (.m.2409) (core#if .m.2409 (.expand-node.2391 (",
".m.2409 .var.2406 .env.2407) .env.2407) .x.2408)) (.find-macro.2323 .x.2408))) (",
".find-identifier.2316 .var.2406 .env.2407)))) (core#begin (core#define .expand-q",
"uote.2387 (core#lambda (.obj.2410) (cons (core#quote core#quote) (cons .obj.2410",
" (core#quote ()))))) (core#begin (core#define .expand-define.2388 (core#lambda (",
".var.2411 .form.2412 .env.2413) ((core#lambda (.uid.2414) (core#begin (.shadow-m",
"acro!.2325 .uid.2414) (cons (core#quote core#define) (cons .uid.2414 (cons (.exp",
"and-node.2391 .form.2412 .env.2413) (core#quote ())))))) (.add-identifier!.2317 ",
".var.2411 .env.2413)))) (core#begin (core#define .expand-lambda.2389 (core#lambd",
"a (.args.2415 .body.2416 .env.2417) ((core#lambda (.env.2418) ((core#lambda (.ar",
"gs.2419) (with-dynamic-environment (list (cons .task-queue.2379 (core#quote ()))",
") (core#lambda () ((core#lambda (.body.2420) (core#begin (.run-all.2381) (cons (",
"core#quote core#lambda) (cons .args.2419 (cons .body.2420 (core#quote ())))))) (",
".expand-node.2391 .body.2416 .env.2418))))) (.map*.2383 (core#lambda (.var.2421)",
" (.add-identifier!.2317 .var.2421 .env.2418)) .args.2415))) (.extend-environment",
".2321 .env.2417)))) (core#begin (core#define .expand-define-macro.2390 (core#lam",
"bda (.var.2422 .transformer.2423 .env.2424) ((core#lambda (.uid.2425) ((core#lam",
"bda (.expander.2426) (core#begin (.add-macro!.2324 .uid.2425 .expander.2426) #un",
"defined)) (load (.expand.2392 .transformer.2423 .env.2424)))) (.add-identifier!.",
"2317 .var.2422 .env.2424)))) (core#begin (core#define .expand-node.2391 (core#la",
"mbda (.expr.2427 .env.2428) (core#if (.literal?.2384 .expr.2427) .expr.2427 (cor",
"e#if (.identifier?.2308 .expr.2427) (.expand-variable.2386 .expr.2427 .env.2428)",
" (core#if (.call?.2385 .expr.2427) ((core#lambda (.functor.2429) ((core#lambda (",
".key.2430) (core#if ((core#lambda (.it.2431) (core#if .it.2431 .it.2431 #f)) (eq",
"v? .key.2430 (core#quote core#quote))) (.expand-quote.2387 (cadr .expr.2427)) (c",
"ore#if ((core#lambda (.it.2432) (core#if .it.2432 .it.2432 #f)) (eqv? .key.2430 ",
"(core#quote core#define))) (.expand-define.2388 (cadr .expr.2427) (.caddr.2382 .",
"expr.2427) .env.2428) (core#if ((core#lambda (.it.2433) (core#if .it.2433 .it.24",
"33 #f)) (eqv? .key.2430 (core#quote core#lambda))) (.queue.2380 (core#lambda () ",
"(.expand-lambda.2389 (cadr .expr.2427) (.caddr.2382 .expr.2427) .env.2428))) (co",
"re#if ((core#lambda (.it.2434) (core#if .it.2434 .it.2434 #f)) (eqv? .key.2430 (",
"core#quote core#define-macro))) (.expand-define-macro.2390 (cadr .expr.2427) (.c",
"addr.2382 .expr.2427) .env.2428) (core#if #t ((core#lambda (.m.2435) (core#if .m",
".2435 (.expand-node.2391 (.m.2435 .expr.2427 .env.2428) .env.2428) (map (core#la",
"mbda (.x.2436) (.expand-node.2391 .x.2436 .env.2428)) .expr.2427))) (.find-macro",
".2323 .functor.2429)) #undefined)))))) .functor.2429)) (.find-identifier.2316 (c",
"ar .expr.2427) .env.2428)) (core#if (list? .expr.2427) (map (core#lambda (.x.243",
"7) (.expand-node.2391 .x.2437 .env.2428)) .expr.2427) (error \"invalid expression",
"\" .expr.2427))))))) (core#begin (core#define .expand.2392 (core#lambda (.expr.24",
"38 .env.2439) ((core#lambda (.x.2440) (core#begin (.run-all.2381) .x.2440)) (.ex",
"pand-node.2391 .expr.2438 .env.2439)))) .expand.2392)))))))))))))) (make-paramet",
"er (core#quote ())))) (core#begin (core#define .compile.2328 (core#lambda (.expr",
".2441 . .env.2442) (.expand.2327 .expr.2441 (core#if (null? .env.2442) .default-",
"environment.2320 (car .env.2442))))) (core#begin (core#define .eval.2329 (core#l",
"ambda (.expr.2443 . .env.2444) (load (.compile.2328 .expr.2443 (core#if (null? .",
"env.2444) .default-environment.2320 (car .env.2444)))))) (values .make-identifie",
"r.2304 .identifier?.2308 .identifier=?.2309 .identifier-name.2307 .identifier-en",
"vironment.2306 .make-environment.2319 .default-environment.2320 .environment?.23",
"11 .find-identifier.2316 .add-identifier!.2317 .set-identifier!.2318 .macro-obje",
"cts.2326 .compile.2328 .eval.2329)))))))))))))))))))))))) (core#lambda (.make-id",
"entifier.2445 .identifier?.2446 .identifier=?.2447 .identifier-name.2448 .identi",
"fier-environment.2449 .make-environment.2450 .default-environment.2451 .environm",
"ent?.2452 .find-identifier.2453 .add-identifier!.2454 .set-identifier!.2455 .mac",
"ro-objects.2456 .compile.2457 .eval.2458) (core#begin (core#set! make-identifier",
" .make-identifier.2445) (core#begin (core#set! identifier? .identifier?.2446) (c",
"ore#begin (core#set! identifier=? .identifier=?.2447) (core#begin (core#set! ide",
"ntifier-name .identifier-name.2448) (core#begin (core#set! identifier-environmen",
"t .identifier-environment.2449) (core#begin (core#set! make-environment .make-en",
"vironment.2450) (core#begin (core#set! default-environment .default-environment.",
"2451) (core#begin (core#set! environment? .environment?.2452) (core#begin (core#",
"set! find-identifier .find-identifier.2453) (core#begin (core#set! add-identifie",
"r! .add-identifier!.2454) (core#begin (core#set! set-identifier! .set-identifier",
"!.2455) (core#begin (core#set! macro-objects .macro-objects.2456) (core#begin (c",
"ore#set! compile .compile.2457) (core#set! eval .eval.2458))))))))))))))))))))))",
"))))))))",
}; };
#if PIC_USE_LIBRARY #if PIC_USE_LIBRARY
@ -223,159 +427,161 @@ static const char boot_library_rom[][80] = {
"egin (core#define library-environment #undefined) (core#begin (core#define libra", "egin (core#define library-environment #undefined) (core#begin (core#define libra",
"ry-exports #undefined) (core#begin (core#define library-import #undefined) (core", "ry-exports #undefined) (core#begin (core#define library-import #undefined) (core",
"#begin (core#define library-export #undefined) (call-with-values (core#lambda ()", "#begin (core#define library-export #undefined) (call-with-values (core#lambda ()",
" ((core#lambda () (core#begin (core#define .mangle.2370 (core#lambda (.name.2379", " ((core#lambda () (core#begin (core#define .mangle.2459 (core#lambda (.name.2468",
") (core#begin (core#if (null? .name.2379) (error \"library name should be a list ", ") (core#begin (core#if (null? .name.2468) (error \"library name should be a list ",
"of at least one symbols\" .name.2379) #undefined) (core#begin (core#define .->str", "of at least one symbols\" .name.2468) #undefined) (core#begin (core#define .->str",
"ing.2380 (core#lambda (.n.2382) (core#if (symbol? .n.2382) ((core#lambda (.str.2", "ing.2469 (core#lambda (.n.2471) (core#if (symbol? .n.2471) ((core#lambda (.str.2",
"383) (core#begin (string-for-each (core#lambda (.c.2384) (core#if ((core#lambda ", "472) (core#begin (string-for-each (core#lambda (.c.2473) (core#if ((core#lambda ",
"(.it.2385) (core#if .it.2385 .it.2385 ((core#lambda (.it.2386) (core#if .it.2386", "(.it.2474) (core#if .it.2474 .it.2474 ((core#lambda (.it.2475) (core#if .it.2475",
" .it.2386 #f)) (char=? .c.2384 #\\:)))) (char=? .c.2384 #\\.)) (error \"elements of", " .it.2475 #f)) (char=? .c.2473 #\\:)))) (char=? .c.2473 #\\.)) (error \"elements of",
" library name may not contain '.' or ':'\" .n.2382) #undefined)) .str.2383) .str.", " library name may not contain '.' or ':'\" .n.2471) #undefined)) .str.2472) .str.",
"2383)) (symbol->string .n.2382)) (core#if (core#if (number? .n.2382) (core#if (e", "2472)) (symbol->string .n.2471)) (core#if (core#if (number? .n.2471) (core#if (e",
"xact? .n.2382) (<= 0 .n.2382) #f) #f) (number->string .n.2382) (error \"symbol or", "xact? .n.2471) (<= 0 .n.2471) #f) #f) (number->string .n.2471) (error \"symbol or",
" non-negative integer is required\" .n.2382))))) (core#begin (core#define .join.2", " non-negative integer is required\" .n.2471))))) (core#begin (core#define .join.2",
"381 (core#lambda (.strs.2387 .delim.2388) ((core#lambda () (core#begin (core#def", "470 (core#lambda (.strs.2476 .delim.2477) ((core#lambda () (core#begin (core#def",
"ine .loop.2389 (core#lambda (.res.2390 .strs.2391) (core#if (null? .strs.2391) .", "ine .loop.2478 (core#lambda (.res.2479 .strs.2480) (core#if (null? .strs.2480) .",
"res.2390 (.loop.2389 (string-append .res.2390 .delim.2388 (car .strs.2391)) (cdr", "res.2479 (.loop.2478 (string-append .res.2479 .delim.2477 (car .strs.2480)) (cdr",
" .strs.2391))))) (.loop.2389 (car .strs.2387) (cdr .strs.2387))))))) (core#if (s", " .strs.2480))))) (.loop.2478 (car .strs.2476) (cdr .strs.2476))))))) (core#if (s",
"ymbol? .name.2379) .name.2379 (string->symbol (.join.2381 (map .->string.2380 .n", "ymbol? .name.2468) .name.2468 (string->symbol (.join.2470 (map .->string.2469 .n",
"ame.2379) \".\")))))))) (core#begin (core#define .current-library.2371 (make-param", "ame.2468) \".\")))))))) (core#begin (core#define .current-library.2460 (make-param",
"eter (core#quote (picrin user)) .mangle.2370)) (core#begin (core#define .*librar", "eter (core#quote (picrin user)) .mangle.2459)) (core#begin (core#define .*librar",
"ies*.2372 (make-dictionary)) (core#begin (core#define .find-library.2373 (core#l", "ies*.2461 (make-dictionary)) (core#begin (core#define .find-library.2462 (core#l",
"ambda (.name.2392) (dictionary-has? .*libraries*.2372 (.mangle.2370 .name.2392))", "ambda (.name.2481) (dictionary-has? .*libraries*.2461 (.mangle.2459 .name.2481))",
")) (core#begin (core#define .make-library.2374 (core#lambda (.name.2393) ((core#", ")) (core#begin (core#define .make-library.2463 (core#lambda (.name.2482) ((core#",
"lambda (.name.2394) ((core#lambda (.env.2395 .exports.2396) (core#begin (set-ide", "lambda (.name.2483) ((core#lambda (.env.2484 .exports.2485) (core#begin (set-ide",
"ntifier! (core#quote define-library) (core#quote define-library) .env.2395) (cor", "ntifier! (core#quote define-library) (core#quote define-library) .env.2484) (cor",
"e#begin (set-identifier! (core#quote import) (core#quote import) .env.2395) (cor", "e#begin (set-identifier! (core#quote import) (core#quote import) .env.2484) (cor",
"e#begin (set-identifier! (core#quote export) (core#quote export) .env.2395) (cor", "e#begin (set-identifier! (core#quote export) (core#quote export) .env.2484) (cor",
"e#begin (set-identifier! (core#quote cond-expand) (core#quote cond-expand) .env.", "e#begin (set-identifier! (core#quote cond-expand) (core#quote cond-expand) .env.",
"2395) (dictionary-set! .*libraries*.2372 .name.2394 (cons .env.2395 .exports.239", "2484) (dictionary-set! .*libraries*.2461 .name.2483 (cons .env.2484 .exports.248",
"6))))))) (make-environment (string->symbol (string-append (symbol->string .name.", "5))))))) (make-environment (string->symbol (string-append (symbol->string .name.",
"2394) \":\"))) (make-dictionary))) (.mangle.2370 .name.2393)))) (core#begin (core#", "2483) \":\"))) (make-dictionary))) (.mangle.2459 .name.2482)))) (core#begin (core#",
"define .library-environment.2375 (core#lambda (.name.2397) (car (dictionary-ref ", "define .library-environment.2464 (core#lambda (.name.2486) (car (dictionary-ref ",
".*libraries*.2372 (.mangle.2370 .name.2397))))) (core#begin (core#define .librar", ".*libraries*.2461 (.mangle.2459 .name.2486))))) (core#begin (core#define .librar",
"y-exports.2376 (core#lambda (.name.2398) (cdr (dictionary-ref .*libraries*.2372 ", "y-exports.2465 (core#lambda (.name.2487) (cdr (dictionary-ref .*libraries*.2461 ",
"(.mangle.2370 .name.2398))))) (core#begin (core#define .library-import.2377 (cor", "(.mangle.2459 .name.2487))))) (core#begin (core#define .library-import.2466 (cor",
"e#lambda (.name.2399 .sym.2400 .alias.2401) ((core#lambda (.uid.2402) ((core#lam", "e#lambda (.name.2488 .sym.2489 .alias.2490) ((core#lambda (.uid.2491) ((core#lam",
"bda (.env.2403) (set-identifier! .alias.2401 .uid.2402 .env.2403)) (.library-env", "bda (.env.2492) (set-identifier! .alias.2490 .uid.2491 .env.2492)) (.library-env",
"ironment.2375 (.current-library.2371)))) (dictionary-ref (.library-exports.2376 ", "ironment.2464 (.current-library.2460)))) (dictionary-ref (.library-exports.2465 ",
".name.2399) .sym.2400)))) (core#begin (core#define .library-export.2378 (core#la", ".name.2488) .sym.2489)))) (core#begin (core#define .library-export.2467 (core#la",
"mbda (.sym.2404 .alias.2405) ((core#lambda (.env.2406 .exports.2407) (dictionary", "mbda (.sym.2493 .alias.2494) ((core#lambda (.env.2495 .exports.2496) (dictionary",
"-set! .exports.2407 .alias.2405 (find-identifier .sym.2404 .env.2406))) (.librar", "-set! .exports.2496 .alias.2494 (find-identifier .sym.2493 .env.2495))) (.librar",
"y-environment.2375 (.current-library.2371)) (.library-exports.2376 (.current-lib", "y-environment.2464 (.current-library.2460)) (.library-exports.2465 (.current-lib",
"rary.2371))))) (core#begin ((core#lambda (.define-transformer.2408) (core#begin ", "rary.2460))))) (core#begin ((core#lambda (.define-transformer.2497) (core#begin ",
"(.define-transformer.2408 (core#quote define-library) (core#lambda (.form.2409 .", "(.define-transformer.2497 (core#quote define-library) (core#lambda (.form.2498 .",
"_.2410) ((core#lambda (.name.2411 .body.2412) (core#begin ((core#lambda (.it.241", "_.2499) ((core#lambda (.name.2500 .body.2501) (core#begin ((core#lambda (.it.250",
"3) (core#if .it.2413 .it.2413 ((core#lambda (.it.2414) (core#if .it.2414 .it.241", "2) (core#if .it.2502 .it.2502 ((core#lambda (.it.2503) (core#if .it.2503 .it.250",
"4 #f)) (.make-library.2374 .name.2411)))) (.find-library.2373 .name.2411)) (with", "3 #f)) (.make-library.2463 .name.2500)))) (.find-library.2462 .name.2500)) (with",
"-dynamic-environment (list (cons .current-library.2371 .name.2411)) (core#lambda", "-dynamic-environment (list (cons .current-library.2460 .name.2500)) (core#lambda",
" () (for-each (core#lambda (.expr.2415) (eval .expr.2415 .name.2411)) .body.2412", " () (for-each (core#lambda (.expr.2504) (eval .expr.2504 .name.2500)) .body.2501",
"))))) (cadr .form.2409) (cddr .form.2409)))) (core#begin (.define-transformer.24", "))))) (cadr .form.2498) (cddr .form.2498)))) (core#begin (.define-transformer.24",
"08 (core#quote cond-expand) (core#lambda (.form.2416 ._.2417) ((core#lambda (.te", "97 (core#quote cond-expand) (core#lambda (.form.2505 ._.2506) ((core#lambda (.te",
"st.2418) (core#begin (core#set! .test.2418 (core#lambda (.form.2419) ((core#lamb", "st.2507) (core#begin (core#set! .test.2507 (core#lambda (.form.2508) ((core#lamb",
"da (.it.2420) (core#if .it.2420 .it.2420 ((core#lambda (.it.2421) (core#if .it.2", "da (.it.2509) (core#if .it.2509 .it.2509 ((core#lambda (.it.2510) (core#if .it.2",
"421 .it.2421 ((core#lambda (.it.2422) (core#if .it.2422 .it.2422 #f)) (core#if (", "510 .it.2510 ((core#lambda (.it.2511) (core#if .it.2511 .it.2511 #f)) (core#if (",
"pair? .form.2419) ((core#lambda (.key.2423) (core#if ((core#lambda (.it.2424) (c", "pair? .form.2508) ((core#lambda (.key.2512) (core#if ((core#lambda (.it.2513) (c",
"ore#if .it.2424 .it.2424 #f)) (eqv? .key.2423 (core#quote library))) (.find-libr", "ore#if .it.2513 .it.2513 #f)) (eqv? .key.2512 (core#quote library))) (.find-libr",
"ary.2373 (cadr .form.2419)) (core#if ((core#lambda (.it.2425) (core#if .it.2425 ", "ary.2462 (cadr .form.2508)) (core#if ((core#lambda (.it.2514) (core#if .it.2514 ",
".it.2425 #f)) (eqv? .key.2423 (core#quote not))) (not (.test.2418 (cadr .form.24", ".it.2514 #f)) (eqv? .key.2512 (core#quote not))) (not (.test.2507 (cadr .form.25",
"19))) (core#if ((core#lambda (.it.2426) (core#if .it.2426 .it.2426 #f)) (eqv? .k", "08))) (core#if ((core#lambda (.it.2515) (core#if .it.2515 .it.2515 #f)) (eqv? .k",
"ey.2423 (core#quote and))) ((core#lambda () (core#begin (core#define .loop.2427 ", "ey.2512 (core#quote and))) ((core#lambda () (core#begin (core#define .loop.2516 ",
"(core#lambda (.form.2428) ((core#lambda (.it.2429) (core#if .it.2429 .it.2429 ((", "(core#lambda (.form.2517) ((core#lambda (.it.2518) (core#if .it.2518 .it.2518 ((",
"core#lambda (.it.2430) (core#if .it.2430 .it.2430 #f)) (core#if (.test.2418 (car", "core#lambda (.it.2519) (core#if .it.2519 .it.2519 #f)) (core#if (.test.2507 (car",
" .form.2428)) (.loop.2427 (cdr .form.2428)) #f)))) (null? .form.2428)))) (.loop.", " .form.2517)) (.loop.2516 (cdr .form.2517)) #f)))) (null? .form.2517)))) (.loop.",
"2427 (cdr .form.2419))))) (core#if ((core#lambda (.it.2431) (core#if .it.2431 .i", "2516 (cdr .form.2508))))) (core#if ((core#lambda (.it.2520) (core#if .it.2520 .i",
"t.2431 #f)) (eqv? .key.2423 (core#quote or))) ((core#lambda () (core#begin (core", "t.2520 #f)) (eqv? .key.2512 (core#quote or))) ((core#lambda () (core#begin (core",
"#define .loop.2432 (core#lambda (.form.2433) (core#if (pair? .form.2433) ((core#", "#define .loop.2521 (core#lambda (.form.2522) (core#if (pair? .form.2522) ((core#",
"lambda (.it.2434) (core#if .it.2434 .it.2434 ((core#lambda (.it.2435) (core#if .", "lambda (.it.2523) (core#if .it.2523 .it.2523 ((core#lambda (.it.2524) (core#if .",
"it.2435 .it.2435 #f)) (.loop.2432 (cdr .form.2433))))) (.test.2418 (car .form.24", "it.2524 .it.2524 #f)) (.loop.2521 (cdr .form.2522))))) (.test.2507 (car .form.25",
"33))) #f))) (.loop.2432 (cdr .form.2419))))) (core#if #t #f #undefined)))))) (ca", "22))) #f))) (.loop.2521 (cdr .form.2508))))) (core#if #t #f #undefined)))))) (ca",
"r .form.2419)) #f)))) (core#if (symbol? .form.2419) (memq .form.2419 (features))", "r .form.2508)) #f)))) (core#if (symbol? .form.2508) (memq .form.2508 (features))",
" #f)))) (eq? .form.2419 (core#quote else))))) ((core#lambda () (core#begin (core", " #f)))) (eq? .form.2508 (core#quote else))))) ((core#lambda () (core#begin (core",
"#define .loop.2436 (core#lambda (.clauses.2437) (core#if (null? .clauses.2437) #", "#define .loop.2525 (core#lambda (.clauses.2526) (core#if (null? .clauses.2526) #",
"undefined (core#if (.test.2418 (caar .clauses.2437)) (cons (make-identifier (cor", "undefined (core#if (.test.2507 (caar .clauses.2526)) (cons (make-identifier (cor",
"e#quote begin) default-environment) (append (cdar .clauses.2437) (core#quote ())", "e#quote begin) default-environment) (append (cdar .clauses.2526) (core#quote ())",
")) (.loop.2436 (cdr .clauses.2437)))))) (.loop.2436 (cdr .form.2416))))))) #unde", ")) (.loop.2525 (cdr .clauses.2526)))))) (.loop.2525 (cdr .form.2505))))))) #unde",
"fined))) (core#begin (.define-transformer.2408 (core#quote import) (core#lambda ", "fined))) (core#begin (.define-transformer.2497 (core#quote import) (core#lambda ",
"(.form.2438 ._.2439) ((core#lambda (.caddr.2440 .prefix.2441 .getlib.2442) ((cor", "(.form.2527 ._.2528) ((core#lambda (.caddr.2529 .prefix.2530 .getlib.2531) ((cor",
"e#lambda (.extract.2443 .collect.2444) (core#begin (core#set! .extract.2443 (cor", "e#lambda (.extract.2532 .collect.2533) (core#begin (core#set! .extract.2532 (cor",
"e#lambda (.spec.2445) ((core#lambda (.key.2446) (core#if ((core#lambda (.it.2447", "e#lambda (.spec.2534) ((core#lambda (.key.2535) (core#if ((core#lambda (.it.2536",
") (core#if .it.2447 .it.2447 ((core#lambda (.it.2448) (core#if .it.2448 .it.2448", ") (core#if .it.2536 .it.2536 ((core#lambda (.it.2537) (core#if .it.2537 .it.2537",
" ((core#lambda (.it.2449) (core#if .it.2449 .it.2449 ((core#lambda (.it.2450) (c", " ((core#lambda (.it.2538) (core#if .it.2538 .it.2538 ((core#lambda (.it.2539) (c",
"ore#if .it.2450 .it.2450 #f)) (eqv? .key.2446 (core#quote except))))) (eqv? .key", "ore#if .it.2539 .it.2539 #f)) (eqv? .key.2535 (core#quote except))))) (eqv? .key",
".2446 (core#quote prefix))))) (eqv? .key.2446 (core#quote rename))))) (eqv? .key", ".2535 (core#quote prefix))))) (eqv? .key.2535 (core#quote rename))))) (eqv? .key",
".2446 (core#quote only))) (.extract.2443 (cadr .spec.2445)) (core#if #t (.getlib", ".2535 (core#quote only))) (.extract.2532 (cadr .spec.2534)) (core#if #t (.getlib",
".2442 .spec.2445) #undefined))) (car .spec.2445)))) (core#begin (core#set! .coll", ".2531 .spec.2534) #undefined))) (car .spec.2534)))) (core#begin (core#set! .coll",
"ect.2444 (core#lambda (.spec.2451) ((core#lambda (.key.2452) (core#if ((core#lam", "ect.2533 (core#lambda (.spec.2540) ((core#lambda (.key.2541) (core#if ((core#lam",
"bda (.it.2453) (core#if .it.2453 .it.2453 #f)) (eqv? .key.2452 (core#quote only)", "bda (.it.2542) (core#if .it.2542 .it.2542 #f)) (eqv? .key.2541 (core#quote only)",
")) ((core#lambda (.alist.2454) (map (core#lambda (.var.2455) (assq .var.2455 .al", ")) ((core#lambda (.alist.2543) (map (core#lambda (.var.2544) (assq .var.2544 .al",
"ist.2454)) (cddr .spec.2451))) (.collect.2444 (cadr .spec.2451))) (core#if ((cor", "ist.2543)) (cddr .spec.2540))) (.collect.2533 (cadr .spec.2540))) (core#if ((cor",
"e#lambda (.it.2456) (core#if .it.2456 .it.2456 #f)) (eqv? .key.2452 (core#quote ", "e#lambda (.it.2545) (core#if .it.2545 .it.2545 #f)) (eqv? .key.2541 (core#quote ",
"rename))) ((core#lambda (.alist.2457 .renames.2458) (map (core#lambda (.s.2459) ", "rename))) ((core#lambda (.alist.2546 .renames.2547) (map (core#lambda (.s.2548) ",
"((core#lambda (.it.2460) (core#if .it.2460 .it.2460 ((core#lambda (.it.2461) (co", "((core#lambda (.it.2549) (core#if .it.2549 .it.2549 ((core#lambda (.it.2550) (co",
"re#if .it.2461 .it.2461 #f)) .s.2459))) (assq (car .s.2459) .renames.2458))) .al", "re#if .it.2550 .it.2550 #f)) .s.2548))) (assq (car .s.2548) .renames.2547))) .al",
"ist.2457)) (.collect.2444 (cadr .spec.2451)) (map (core#lambda (.x.2462) (cons (", "ist.2546)) (.collect.2533 (cadr .spec.2540)) (map (core#lambda (.x.2551) (cons (",
"car .x.2462) (cadr .x.2462))) (cddr .spec.2451))) (core#if ((core#lambda (.it.24", "car .x.2551) (cadr .x.2551))) (cddr .spec.2540))) (core#if ((core#lambda (.it.25",
"63) (core#if .it.2463 .it.2463 #f)) (eqv? .key.2452 (core#quote prefix))) ((core", "52) (core#if .it.2552 .it.2552 #f)) (eqv? .key.2541 (core#quote prefix))) ((core",
"#lambda (.alist.2464) (map (core#lambda (.s.2465) (cons (.prefix.2441 (.caddr.24", "#lambda (.alist.2553) (map (core#lambda (.s.2554) (cons (.prefix.2530 (.caddr.25",
"40 .spec.2451) (car .s.2465)) (cdr .s.2465))) .alist.2464)) (.collect.2444 (cadr", "29 .spec.2540) (car .s.2554)) (cdr .s.2554))) .alist.2553)) (.collect.2533 (cadr",
" .spec.2451))) (core#if ((core#lambda (.it.2466) (core#if .it.2466 .it.2466 #f))", " .spec.2540))) (core#if ((core#lambda (.it.2555) (core#if .it.2555 .it.2555 #f))",
" (eqv? .key.2452 (core#quote except))) ((core#lambda (.alist.2467) ((core#lambda", " (eqv? .key.2541 (core#quote except))) ((core#lambda (.alist.2556) ((core#lambda",
" () (core#begin (core#define .loop.2468 (core#lambda (.alist.2469) (core#if (nul", " () (core#begin (core#define .loop.2557 (core#lambda (.alist.2558) (core#if (nul",
"l? .alist.2469) (core#quote ()) (core#if (memq (caar .alist.2469) (cddr .spec.24", "l? .alist.2558) (core#quote ()) (core#if (memq (caar .alist.2558) (cddr .spec.25",
"51)) (.loop.2468 (cdr .alist.2469)) (cons (car .alist.2469) (.loop.2468 (cdr .al", "40)) (.loop.2557 (cdr .alist.2558)) (cons (car .alist.2558) (.loop.2557 (cdr .al",
"ist.2469))))))) (.loop.2468 .alist.2467))))) (.collect.2444 (cadr .spec.2451))) ", "ist.2558))))))) (.loop.2557 .alist.2556))))) (.collect.2533 (cadr .spec.2540))) ",
"(core#if #t (dictionary-map (core#lambda (.x.2470) (cons .x.2470 .x.2470)) (.lib", "(core#if #t (dictionary-map (core#lambda (.x.2559) (cons .x.2559 .x.2559)) (.lib",
"rary-exports.2376 (.getlib.2442 .spec.2451))) #undefined)))))) (car .spec.2451))", "rary-exports.2465 (.getlib.2531 .spec.2540))) #undefined)))))) (car .spec.2540))",
")) ((core#lambda (.import.2471) (core#begin (core#set! .import.2471 (core#lambda", ")) ((core#lambda (.import.2560) (core#begin (core#set! .import.2560 (core#lambda",
" (.spec.2472) ((core#lambda (.lib.2473 .alist.2474) (for-each (core#lambda (.slo", " (.spec.2561) ((core#lambda (.lib.2562 .alist.2563) (for-each (core#lambda (.slo",
"t.2475) (.library-import.2377 .lib.2473 (cdr .slot.2475) (car .slot.2475))) .ali", "t.2564) (.library-import.2466 .lib.2562 (cdr .slot.2564) (car .slot.2564))) .ali",
"st.2474)) (.extract.2443 .spec.2472) (.collect.2444 .spec.2472)))) (for-each .im", "st.2563)) (.extract.2532 .spec.2561) (.collect.2533 .spec.2561)))) (for-each .im",
"port.2471 (cdr .form.2438)))) #undefined)))) #undefined #undefined)) (core#lambd", "port.2560 (cdr .form.2527)))) #undefined)))) #undefined #undefined)) (core#lambd",
"a (.x.2476) (car (cdr (cdr .x.2476)))) (core#lambda (.prefix.2477 .symbol.2478) ", "a (.x.2565) (car (cdr (cdr .x.2565)))) (core#lambda (.prefix.2566 .symbol.2567) ",
"(string->symbol (string-append (symbol->string .prefix.2477) (symbol->string .sy", "(string->symbol (string-append (symbol->string .prefix.2566) (symbol->string .sy",
"mbol.2478)))) (core#lambda (.name.2479) (core#if (.find-library.2373 .name.2479)", "mbol.2567)))) (core#lambda (.name.2568) (core#if (.find-library.2462 .name.2568)",
" .name.2479 (error \"library not found\" .name.2479)))))) (.define-transformer.240", " .name.2568 (error \"library not found\" .name.2568)))))) (.define-transformer.249",
"8 (core#quote export) (core#lambda (.form.2480 ._.2481) ((core#lambda (.collect.", "7 (core#quote export) (core#lambda (.form.2569 ._.2570) ((core#lambda (.collect.",
"2482 .export.2483) (core#begin (core#set! .collect.2482 (core#lambda (.spec.2484", "2571 .export.2572) (core#begin (core#set! .collect.2571 (core#lambda (.spec.2573",
") (core#if (symbol? .spec.2484) (cons .spec.2484 .spec.2484) (core#if (core#if (", ") (core#if (symbol? .spec.2573) (cons .spec.2573 .spec.2573) (core#if (core#if (",
"list? .spec.2484) (core#if (= (length .spec.2484) 3) (eq? (car .spec.2484) (core", "list? .spec.2573) (core#if (= (length .spec.2573) 3) (eq? (car .spec.2573) (core",
"#quote rename)) #f) #f) (cons (list-ref .spec.2484 1) (list-ref .spec.2484 2)) (", "#quote rename)) #f) #f) (cons (list-ref .spec.2573 1) (list-ref .spec.2573 2)) (",
"error \"malformed export\"))))) (core#begin (core#set! .export.2483 (core#lambda (", "error \"malformed export\"))))) (core#begin (core#set! .export.2572 (core#lambda (",
".spec.2485) ((core#lambda (.slot.2486) (.library-export.2378 (car .slot.2486) (c", ".spec.2574) ((core#lambda (.slot.2575) (.library-export.2467 (car .slot.2575) (c",
"dr .slot.2486))) (.collect.2482 .spec.2485)))) (for-each .export.2483 (cdr .form", "dr .slot.2575))) (.collect.2571 .spec.2574)))) (for-each .export.2572 (cdr .form",
".2480))))) #undefined #undefined))))))) (core#lambda (.name.2487 .macro.2488) (d", ".2569))))) #undefined #undefined))))))) (core#lambda (.name.2576 .macro.2577) (d",
"ictionary-set! (macro-objects) .name.2487 .macro.2488))) (core#begin ((core#lamb", "ictionary-set! (macro-objects) .name.2576 .macro.2577))) (core#begin ((core#lamb",
"da () (core#begin (.make-library.2374 (core#quote (picrin base))) (core#begin (s", "da () (core#begin (.make-library.2463 (core#quote (picrin base))) (core#begin (s",
"et-car! (dictionary-ref .*libraries*.2372 (.mangle.2370 (core#quote (picrin base", "et-car! (dictionary-ref .*libraries*.2461 (.mangle.2459 (core#quote (picrin base",
")))) default-environment) (core#begin ((core#lambda (.exports.2489) ((core#lambd", ")))) default-environment) (core#begin ((core#lambda (.exports.2578) ((core#lambd",
"a (.export-keyword.2490) ((core#lambda () (core#begin (for-each .export-keyword.", "a (.export-keyword.2579) ((core#lambda () (core#begin (for-each .export-keyword.",
"2490 (core#quote (define lambda quote set! if begin define-macro let let* letrec", "2579 (core#quote (define lambda quote set! if begin define-macro let let* letrec",
" letrec* let-values let*-values define-values quasiquote unquote unquote-splicin", " letrec* let-values let*-values define-values quasiquote unquote unquote-splicin",
"g and or cond case else => do when unless parameterize))) (core#begin (.export-k", "g and or cond case else => do when unless parameterize define-record-type))) (co",
"eyword.2490 (core#quote boolean?)) (dictionary-for-each .export-keyword.2490 (gl", "re#begin (.export-keyword.2579 (core#quote boolean?)) (dictionary-for-each .expo",
"obal-objects))))))) (core#lambda (.keyword.2491) (dictionary-set! .exports.2489 ", "rt-keyword.2579 (global-objects))))))) (core#lambda (.keyword.2580) (dictionary-",
".keyword.2491 .keyword.2491)))) (.library-exports.2376 (core#quote (picrin base)", "set! .exports.2578 .keyword.2580 .keyword.2580)))) (.library-exports.2465 (core#",
"))) (core#begin (core#set! eval ((core#lambda (.e.2492) (core#lambda (.expr.2493", "quote (picrin base)))) (core#begin (core#set! eval ((core#lambda (.e.2581) (core",
" . .lib.2494) ((core#lambda (.lib.2495) (.e.2492 .expr.2493 (.library-environmen", "#lambda (.expr.2582 . .lib.2583) ((core#lambda (.lib.2584) (with-dynamic-environ",
"t.2375 .lib.2495))) (core#if (null? .lib.2494) (.current-library.2371) (car .lib", "ment (list (cons .current-library.2460 .lib.2584)) (core#lambda () (.e.2581 .exp",
".2494))))) eval)) (.make-library.2374 (core#quote (picrin user))))))))) (values ", "r.2582 (.library-environment.2464 .lib.2584))))) (core#if (null? .lib.2583) (.cu",
".current-library.2371 .find-library.2373 .make-library.2374 .library-environment", "rrent-library.2460) (car .lib.2583))))) eval)) (.make-library.2463 (core#quote (",
".2375 .library-exports.2376 .library-import.2377 .library-export.2378)))))))))))", "picrin user))))))))) (values .current-library.2460 .find-library.2462 .make-libr",
")))) (core#lambda (.current-library.2496 .find-library.2497 .make-library.2498 .", "ary.2463 .library-environment.2464 .library-exports.2465 .library-import.2466 .l",
"library-environment.2499 .library-exports.2500 .library-import.2501 .library-exp", "ibrary-export.2467))))))))))))))) (core#lambda (.current-library.2585 .find-libr",
"ort.2502) (core#begin (core#set! current-library .current-library.2496) (core#be", "ary.2586 .make-library.2587 .library-environment.2588 .library-exports.2589 .lib",
"gin (core#set! find-library .find-library.2497) (core#begin (core#set! make-libr", "rary-import.2590 .library-export.2591) (core#begin (core#set! current-library .c",
"ary .make-library.2498) (core#begin (core#set! library-environment .library-envi", "urrent-library.2585) (core#begin (core#set! find-library .find-library.2586) (co",
"ronment.2499) (core#begin (core#set! library-exports .library-exports.2500) (cor", "re#begin (core#set! make-library .make-library.2587) (core#begin (core#set! libr",
"e#begin (core#set! library-import .library-import.2501) (core#set! library-expor", "ary-environment .library-environment.2588) (core#begin (core#set! library-export",
"t .library-export.2502))))))))))))))))", "s .library-exports.2589) (core#begin (core#set! library-import .library-import.2",
"590) (core#set! library-export .library-export.2591))))))))))))))))",
}; };
#endif #endif
void void
pic_boot(pic_state *pic) pic_boot(pic_state *pic)
{ {
pic_load_native(pic, &boot_compile_rom[0][0]);
pic_load_native(pic, &boot_rom[0][0]); pic_load_native(pic, &boot_rom[0][0]);
#if PIC_USE_LIBRARY #if PIC_USE_LIBRARY
pic_load_native(pic, &boot_library_rom[0][0]); pic_load_native(pic, &boot_library_rom[0][0]);

451
lib/ext/compile.c
View File

@ -1,451 +0,0 @@
/**
* See Copyright Notice in picrin.h
*/
#include "picrin.h"
#include "picrin/extra.h"
#include "../object.h"
#include "../state.h"
KHASH_DEFINE(env, struct identifier *, symbol *, kh_ptr_hash_func, kh_ptr_hash_equal)
pic_value
pic_make_env(pic_state *pic, pic_value prefix)
{
struct env *env;
env = (struct env *)pic_obj_alloc(pic, sizeof(struct env), PIC_TYPE_ENV);
env->up = NULL;
env->prefix = pic_str_ptr(pic, prefix);
kh_init(env, &env->map);
return obj_value(pic, env);
}
static pic_value
default_env(pic_state *pic)
{
return pic_ref(pic, "default-environment");
}
static pic_value
extend_env(pic_state *pic, pic_value up)
{
struct env *env;
env = (struct env *)pic_obj_alloc(pic, sizeof(struct env), PIC_TYPE_ENV);
env->up = pic_env_ptr(pic, up);
env->prefix = NULL;
kh_init(env, &env->map);
return obj_value(pic, env);
}
static bool
search_scope(pic_state *pic, pic_value id, pic_value env, pic_value *uid)
{
int it;
it = kh_get(env, &pic_env_ptr(pic, env)->map, pic_id_ptr(pic, id));
if (it == kh_end(&pic_env_ptr(pic, env)->map)) {
return false;
}
*uid = obj_value(pic, kh_val(&pic_env_ptr(pic, env)->map, it));
return true;
}
static bool
search(pic_state *pic, pic_value id, pic_value env, pic_value *uid)
{
struct env *e;
while (1) {
if (search_scope(pic, id, env, uid))
return true;
e = pic_env_ptr(pic, env)->up;
if (e == NULL)
break;
env = obj_value(pic, e);
}
return false;
}
pic_value
pic_find_identifier(pic_state *pic, pic_value id, pic_value env)
{
struct env *e;
pic_value uid;
while (! search(pic, id, env, &uid)) {
if (pic_sym_p(pic, id)) {
while (1) {
e = pic_env_ptr(pic, env);
if (e->up == NULL)
break;
env = obj_value(pic, e->up);
}
return pic_add_identifier(pic, id, env);
}
env = obj_value(pic, pic_id_ptr(pic, id)->env); /* do not overwrite id first */
id = obj_value(pic, pic_id_ptr(pic, id)->u.id);
}
return uid;
}
pic_value
pic_add_identifier(pic_state *pic, pic_value id, pic_value env)
{
const char *name, *prefix;
pic_value uid, str;
if (search_scope(pic, id, env, &uid)) {
return uid;
}
name = pic_str(pic, pic_id_name(pic, id), NULL);
if (pic_env_ptr(pic, env)->up == NULL && pic_sym_p(pic, id)) {
prefix = pic_str(pic, obj_value(pic, pic_env_ptr(pic, env)->prefix), NULL);
str = pic_strf_value(pic, "%s%s", prefix, name);
} else {
str = pic_strf_value(pic, ".%s.%d", name, pic->ucnt++);
}
uid = pic_intern(pic, str);
pic_set_identifier(pic, id, uid, env);
return uid;
}
void
pic_set_identifier(pic_state *pic, pic_value id, pic_value uid, pic_value env)
{
int it, ret;
it = kh_put(env, &pic_env_ptr(pic, env)->map, pic_id_ptr(pic, id), &ret);
kh_val(&pic_env_ptr(pic, env)->map, it) = pic_sym_ptr(pic, uid);
}
#define EQ(sym, lit) (strcmp(pic_sym(pic, sym), lit) == 0)
#define S(lit) (pic_intern_lit(pic, lit))
#define pic_sym(pic,sym) pic_str(pic, pic_sym_name(pic, (sym)), NULL)
static void
define_macro(pic_state *pic, pic_value uid, pic_value mac)
{
if (pic_dict_has(pic, pic->macros, uid)) {
pic_warnf(pic, "redefining syntax variable: %s", pic_sym(pic, uid));
}
pic_dict_set(pic, pic->macros, uid, mac);
}
static bool
find_macro(pic_state *pic, pic_value uid, pic_value *mac)
{
if (! pic_dict_has(pic, pic->macros, uid)) {
return false;
}
*mac = pic_dict_ref(pic, pic->macros, uid);
return true;
}
static void
shadow_macro(pic_state *pic, pic_value uid)
{
if (pic_dict_has(pic, pic->macros, uid)) {
pic_dict_del(pic, pic->macros, uid);
}
}
static pic_value expand(pic_state *, pic_value expr, pic_value env, pic_value deferred);
static pic_value expand_lambda(pic_state *, pic_value expr, pic_value env);
static pic_value
expand_var(pic_state *pic, pic_value id, pic_value env, pic_value deferred)
{
pic_value mac, functor;
functor = pic_find_identifier(pic, id, env);
if (find_macro(pic, functor, &mac)) {
return expand(pic, pic_call(pic, mac, 2, id, env), env, deferred);
}
return functor;
}
static pic_value
expand_quote(pic_state *pic, pic_value expr)
{
return pic_cons(pic, S("core#quote"), pic_cdr(pic, expr));
}
static pic_value
expand_list(pic_state *pic, pic_value obj, pic_value env, pic_value deferred)
{
size_t ai = pic_enter(pic);
pic_value x, head, tail;
if (pic_pair_p(pic, obj)) {
head = expand(pic, pic_car(pic, obj), env, deferred);
tail = expand_list(pic, pic_cdr(pic, obj), env, deferred);
x = pic_cons(pic, head, tail);
} else {
x = expand(pic, obj, env, deferred);
}
pic_leave(pic, ai);
pic_protect(pic, x);
return x;
}
static pic_value
expand_defer(pic_state *pic, pic_value expr, pic_value deferred)
{
pic_value skel = pic_cons(pic, pic_invalid_value(pic), pic_invalid_value(pic));
pic_set_car(pic, deferred, pic_cons(pic, pic_cons(pic, expr, skel), pic_car(pic, deferred)));
return skel;
}
static void
expand_deferred(pic_state *pic, pic_value deferred, pic_value env)
{
pic_value defer, val, src, dst, it;
deferred = pic_car(pic, deferred);
pic_for_each (defer, pic_reverse(pic, deferred), it) {
src = pic_car(pic, defer);
dst = pic_cdr(pic, defer);
val = expand_lambda(pic, src, env);
/* copy */
pic_set_car(pic, dst, pic_car(pic, val));
pic_set_cdr(pic, dst, pic_cdr(pic, val));
}
}
static pic_value
expand_lambda(pic_state *pic, pic_value expr, pic_value env)
{
pic_value formal, body;
pic_value in;
pic_value a, deferred;
in = extend_env(pic, env);
for (a = pic_cadr(pic, expr); pic_pair_p(pic, a); a = pic_cdr(pic, a)) {
pic_add_identifier(pic, pic_car(pic, a), in);
}
if (pic_id_p(pic, a)) {
pic_add_identifier(pic, a, in);
}
deferred = pic_list(pic, 1, pic_nil_value(pic));
formal = expand_list(pic, pic_list_ref(pic, expr, 1), in, deferred);
body = expand(pic, pic_list_ref(pic, expr, 2), in, deferred);
expand_deferred(pic, deferred, in);
return pic_list(pic, 3, S("core#lambda"), formal, body);
}
static pic_value
expand_define(pic_state *pic, pic_value expr, pic_value env, pic_value deferred)
{
pic_value uid, val;
uid = pic_add_identifier(pic, pic_list_ref(pic, expr, 1), env);
shadow_macro(pic, uid);
val = expand(pic, pic_list_ref(pic, expr, 2), env, deferred);
return pic_list(pic, 3, S("core#define"), uid, val);
}
static pic_value
expand_defmacro(pic_state *pic, pic_value expr, pic_value env)
{
pic_value uid, val;
uid = pic_add_identifier(pic, pic_list_ref(pic, expr, 1), env);
val = pic_load(pic, pic_compile(pic, pic_list_ref(pic, expr, 2), env));
if (! pic_proc_p(pic, val)) {
pic_error(pic, "macro definition evaluates to non-procedure object", 1, pic_list_ref(pic, expr, 1));
}
define_macro(pic, uid, val);
return pic_undef_value(pic);
}
static pic_value
expand_node(pic_state *pic, pic_value expr, pic_value env, pic_value deferred)
{
switch (pic_type(pic, expr)) {
case PIC_TYPE_ID:
case PIC_TYPE_SYMBOL: {
return expand_var(pic, expr, env, deferred);
}
case PIC_TYPE_PAIR: {
pic_value mac;
if (! pic_list_p(pic, expr)) {
pic_error(pic, "cannot expand improper list", 1, expr);
}
if (pic_id_p(pic, pic_car(pic, expr))) {
pic_value functor;
functor = pic_find_identifier(pic, pic_car(pic, expr), env);
if (EQ(functor, "core#define-macro")) {
return expand_defmacro(pic, expr, env);
}
else if (EQ(functor, "core#lambda")) {
return expand_defer(pic, expr, deferred);
}
else if (EQ(functor, "core#define")) {
return expand_define(pic, expr, env, deferred);
}
else if (EQ(functor, "core#quote")) {
return expand_quote(pic, expr);
}
if (find_macro(pic, functor, &mac)) {
return expand(pic, pic_call(pic, mac, 2, expr, env), env, deferred);
}
}
return expand_list(pic, expr, env, deferred);
}
default:
return expr;
}
}
static pic_value
expand(pic_state *pic, pic_value expr, pic_value env, pic_value deferred)
{
size_t ai = pic_enter(pic);
pic_value v;
v = expand_node(pic, expr, env, deferred);
pic_leave(pic, ai);
pic_protect(pic, v);
return v;
}
pic_value
pic_compile(pic_state *pic, pic_value expr, pic_value env)
{
pic_value v, deferred;
deferred = pic_list(pic, 1, pic_nil_value(pic));
v = expand(pic, expr, env, deferred);
expand_deferred(pic, deferred, env);
return v;
}
static pic_value
pic_compile_make_environment(pic_state *pic)
{
pic_value name;
pic_get_args(pic, "m", &name);
return pic_make_env(pic, pic_sym_name(pic, name));
}
static pic_value
pic_compile_set_identifier(pic_state *pic)
{
pic_value id, uid, env;
pic_get_args(pic, "omo", &id, &uid, &env);
TYPE_CHECK(pic, id, id);
TYPE_CHECK(pic, env, env);
pic_set_identifier(pic, id, uid, env);
return pic_undef_value(pic);
}
static pic_value
pic_compile_find_identifier(pic_state *pic)
{
pic_value id, env;
pic_get_args(pic, "oo", &id, &env);
TYPE_CHECK(pic, id, id);
TYPE_CHECK(pic, env, env);
return pic_find_identifier(pic, id, env);
}
static pic_value
pic_compile_macro_objects(pic_state *pic)
{
pic_get_args(pic, "");
return pic->macros;
}
static pic_value
pic_compile_compile(pic_state *pic)
{
pic_value program, env = default_env(pic);
pic_get_args(pic, "o|o", &program, &env);
TYPE_CHECK(pic, env, env);
return pic_compile(pic, program, env);
}
static pic_value
pic_compile_eval(pic_state *pic)
{
pic_value program, env = default_env(pic);
pic_get_args(pic, "o|o", &program, &env);
TYPE_CHECK(pic, env, env);
return pic_load(pic, pic_compile(pic, program, env));
}
#define add_keyword(name) do { \
pic_value var; \
var = pic_intern_lit(pic, name); \
pic_set_identifier(pic, var, var, env); \
} while (0)
void
pic_init_compile(pic_state *pic)
{
pic_value env = pic_make_env(pic, pic_lit_value(pic, ""));
add_keyword("core#define");
add_keyword("core#set!");
add_keyword("core#quote");
add_keyword("core#lambda");
add_keyword("core#if");
add_keyword("core#begin");
add_keyword("core#define-macro");
pic_define(pic, "default-environment", env);
pic_defun(pic, "make-environment", pic_compile_make_environment);
pic_defun(pic, "find-identifier", pic_compile_find_identifier);
pic_defun(pic, "set-identifier!", pic_compile_set_identifier);
pic_defun(pic, "macro-objects", pic_compile_macro_objects);
pic_defun(pic, "compile", pic_compile_compile);
pic_defun(pic, "eval", pic_compile_eval);
}

20
lib/ext/write.c
View File

@ -409,6 +409,16 @@ write_dict(pic_state *pic, pic_value dict, pic_value port, struct writer_control
pic_fprintf(pic, port, ")"); pic_fprintf(pic, port, ")");
} }
static void
write_record(pic_state *pic, pic_value obj, pic_value port, struct writer_control *p)
{
pic_fprintf(pic, port, "#<");
write_core(pic, pic_record_type(pic, obj), port, p);
pic_fprintf(pic, port, " ");
write_core(pic, pic_record_datum(pic, obj), port, p);
pic_fprintf(pic, port, ">");
}
static const char * static const char *
typename(pic_state *pic, pic_value obj) typename(pic_state *pic, pic_value obj)
{ {
@ -444,8 +454,6 @@ typename(pic_state *pic, pic_value obj)
return "port"; return "port";
case PIC_TYPE_ERROR: case PIC_TYPE_ERROR:
return "error"; return "error";
case PIC_TYPE_ID:
return "identifier";
case PIC_TYPE_CXT: case PIC_TYPE_CXT:
return "context"; return "context";
case PIC_TYPE_IREP: case PIC_TYPE_IREP:
@ -453,8 +461,6 @@ typename(pic_state *pic, pic_value obj)
case PIC_TYPE_PROC_FUNC: case PIC_TYPE_PROC_FUNC:
case PIC_TYPE_PROC_IREP: case PIC_TYPE_PROC_IREP:
return "procedure"; return "procedure";
case PIC_TYPE_ENV:
return "environment";
case PIC_TYPE_DATA: case PIC_TYPE_DATA:
return "data"; return "data";
case PIC_TYPE_DICT: case PIC_TYPE_DICT:
@ -498,9 +504,6 @@ write_core(pic_state *pic, pic_value obj, pic_value port, struct writer_control
case PIC_TYPE_FALSE: case PIC_TYPE_FALSE:
pic_fprintf(pic, port, "#f"); pic_fprintf(pic, port, "#f");
break; break;
case PIC_TYPE_ID:
pic_fprintf(pic, port, "#<identifier %s>", pic_str(pic, pic_id_name(pic, obj), NULL));
break;
case PIC_TYPE_EOF: case PIC_TYPE_EOF:
pic_fprintf(pic, port, "#.(eof-object)"); pic_fprintf(pic, port, "#.(eof-object)");
break; break;
@ -531,6 +534,9 @@ write_core(pic_state *pic, pic_value obj, pic_value port, struct writer_control
case PIC_TYPE_DICT: case PIC_TYPE_DICT:
write_dict(pic, obj, port, p); write_dict(pic, obj, port, p);
break; break;
case PIC_TYPE_RECORD:
write_record(pic, obj, port, p);
break;
default: default:
pic_fprintf(pic, port, "#<%s %p>", typename(pic, obj), obj_ptr(pic, obj)); pic_fprintf(pic, port, "#<%s %p>", typename(pic, obj), obj_ptr(pic, obj));
break; break;

37
lib/gc.c
View File

@ -18,7 +18,7 @@ union header {
struct object { struct object {
union { union {
struct basic basic; struct basic basic;
struct identifier id; struct symbol sym;
struct string str; struct string str;
struct blob blob; struct blob blob;
struct pair pair; struct pair pair;
@ -27,7 +27,6 @@ struct object {
struct weak weak; struct weak weak;
struct data data; struct data data;
struct record rec; struct record rec;
struct env env;
struct proc proc; struct proc proc;
struct context cxt; struct context cxt;
struct port port; struct port port;
@ -389,28 +388,6 @@ gc_mark_object(pic_state *pic, struct object *obj)
case PIC_TYPE_BLOB: { case PIC_TYPE_BLOB: {
break; break;
} }
case PIC_TYPE_ID: {
gc_mark_object(pic, (struct object *)obj->u.id.u.id);
LOOP(obj->u.id.env);
break;
}
case PIC_TYPE_ENV: {
khash_t(env) *h = &obj->u.env.map;
int it;
for (it = kh_begin(h); it != kh_end(h); ++it) {
if (kh_exist(h, it)) {
gc_mark_object(pic, (struct object *)kh_key(h, it));
gc_mark_object(pic, (struct object *)kh_val(h, it));
}
}
if (obj->u.env.up) {
LOOP(obj->u.env.up);
} else {
LOOP(obj->u.env.prefix);
}
break;
}
case PIC_TYPE_DATA: { case PIC_TYPE_DATA: {
break; break;
} }
@ -432,7 +409,7 @@ gc_mark_object(pic_state *pic, struct object *obj)
break; break;
} }
case PIC_TYPE_SYMBOL: { case PIC_TYPE_SYMBOL: {
LOOP(obj->u.id.u.str); LOOP(obj->u.sym.str);
break; break;
} }
case PIC_TYPE_WEAK: { case PIC_TYPE_WEAK: {
@ -476,9 +453,6 @@ gc_mark_phase(pic_state *pic)
/* global variables */ /* global variables */
gc_mark(pic, pic->globals); gc_mark(pic, pic->globals);
/* macro objects */
gc_mark(pic, pic->macros);
/* error object */ /* error object */
gc_mark(pic, pic->err); gc_mark(pic, pic->err);
@ -536,10 +510,6 @@ gc_finalize_object(pic_state *pic, struct object *obj)
pic_rope_decref(pic, obj->u.str.rope); pic_rope_decref(pic, obj->u.str.rope);
break; break;
} }
case PIC_TYPE_ENV: {
kh_destroy(env, &obj->u.env.map);
break;
}
case PIC_TYPE_DATA: { case PIC_TYPE_DATA: {
if (obj->u.data.type->dtor) { if (obj->u.data.type->dtor) {
obj->u.data.type->dtor(pic, obj->u.data.data); obj->u.data.type->dtor(pic, obj->u.data.data);
@ -575,7 +545,6 @@ gc_finalize_object(pic_state *pic, struct object *obj)
case PIC_TYPE_PAIR: case PIC_TYPE_PAIR:
case PIC_TYPE_CXT: case PIC_TYPE_CXT:
case PIC_TYPE_ERROR: case PIC_TYPE_ERROR:
case PIC_TYPE_ID:
case PIC_TYPE_RECORD: case PIC_TYPE_RECORD:
case PIC_TYPE_PROC_FUNC: case PIC_TYPE_PROC_FUNC:
case PIC_TYPE_PROC_IREP: case PIC_TYPE_PROC_IREP:
@ -793,7 +762,7 @@ gc_sweep_phase(pic_state *pic)
int it; int it;
khash_t(weak) *h; khash_t(weak) *h;
khash_t(oblist) *s = &pic->oblist; khash_t(oblist) *s = &pic->oblist;
symbol *sym; struct symbol *sym;
struct object *obj; struct object *obj;
size_t total = 0, inuse = 0; size_t total = 0, inuse = 0;

1
lib/include/picrin/extra.h
View File

@ -21,7 +21,6 @@ pic_value pic_read_cstr(pic_state *, const char *);
pic_value pic_fopen(pic_state *, FILE *, const char *mode); pic_value pic_fopen(pic_state *, FILE *, const char *mode);
#endif #endif
pic_value pic_compile(pic_state *, pic_value form, pic_value env);
pic_value pic_load(pic_state *, pic_value irep); pic_value pic_load(pic_state *, pic_value irep);
void pic_load_native(pic_state *pic, const char *); void pic_load_native(pic_state *pic, const char *);

9
lib/include/picrin/value.h
View File

@ -26,8 +26,6 @@ enum {
PIC_TYPE_BLOB = 18, PIC_TYPE_BLOB = 18,
PIC_TYPE_PORT = 20, PIC_TYPE_PORT = 20,
PIC_TYPE_ERROR = 21, PIC_TYPE_ERROR = 21,
PIC_TYPE_ID = 22,
PIC_TYPE_ENV = 23,
PIC_TYPE_DATA = 24, PIC_TYPE_DATA = 24,
PIC_TYPE_DICT = 25, PIC_TYPE_DICT = 25,
PIC_TYPE_WEAK = 26, PIC_TYPE_WEAK = 26,
@ -227,7 +225,6 @@ DEFPRED(pic_blob_p, PIC_TYPE_BLOB)
DEFPRED(pic_error_p, PIC_TYPE_ERROR) DEFPRED(pic_error_p, PIC_TYPE_ERROR)
DEFPRED(pic_dict_p, PIC_TYPE_DICT) DEFPRED(pic_dict_p, PIC_TYPE_DICT)
DEFPRED(pic_weak_p, PIC_TYPE_WEAK) DEFPRED(pic_weak_p, PIC_TYPE_WEAK)
DEFPRED(pic_env_p, PIC_TYPE_ENV)
DEFPRED(pic_rec_p, PIC_TYPE_RECORD) DEFPRED(pic_rec_p, PIC_TYPE_RECORD)
DEFPRED(pic_sym_p, PIC_TYPE_SYMBOL) DEFPRED(pic_sym_p, PIC_TYPE_SYMBOL)
DEFPRED(pic_pair_p, PIC_TYPE_PAIR) DEFPRED(pic_pair_p, PIC_TYPE_PAIR)
@ -247,12 +244,6 @@ pic_proc_p(pic_state *pic, pic_value o)
return pic_proc_func_p(pic, o) || pic_proc_irep_p(pic, o); return pic_proc_func_p(pic, o) || pic_proc_irep_p(pic, o);
} }
PIC_STATIC_INLINE bool
pic_id_p(pic_state *pic, pic_value o)
{
return pic_type(pic, o) == PIC_TYPE_ID || pic_sym_p(pic, o);
}
#if PIC_NAN_BOXING #if PIC_NAN_BOXING
PIC_STATIC_INLINE bool PIC_STATIC_INLINE bool

38
lib/object.h
View File

@ -26,24 +26,9 @@ struct basic {
OBJECT_HEADER OBJECT_HEADER
}; };
struct identifier { struct symbol {
OBJECT_HEADER OBJECT_HEADER
union { struct string *str;
struct string *str;
struct identifier *id;
} u;
struct env *env;
};
typedef struct identifier symbol;
KHASH_DECLARE(env, struct identifier *, symbol *)
struct env {
OBJECT_HEADER
khash_t(env) map;
struct env *up;
struct string *prefix;
}; };
struct pair { struct pair {
@ -63,7 +48,7 @@ struct string {
struct rope *rope; struct rope *rope;
}; };
KHASH_DECLARE(dict, symbol *, pic_value) KHASH_DECLARE(dict, struct symbol *, pic_value)
struct dict { struct dict {
OBJECT_HEADER OBJECT_HEADER
@ -163,7 +148,7 @@ struct port {
struct error { struct error {
OBJECT_HEADER OBJECT_HEADER
symbol *type; struct symbol *type;
struct string *msg; struct string *msg;
pic_value irrs; pic_value irrs;
struct string *stack; struct string *stack;
@ -176,8 +161,6 @@ struct error {
#define TYPENAME_error "error" #define TYPENAME_error "error"
#define TYPENAME_proc "procedure" #define TYPENAME_proc "procedure"
#define TYPENAME_str "string" #define TYPENAME_str "string"
#define TYPENAME_id "identifier"
#define TYPENAME_env "environment"
#define TYPENAME_vec "vector" #define TYPENAME_vec "vector"
#define TYPE_CHECK(pic, v, type) do { \ #define TYPE_CHECK(pic, v, type) do { \
@ -259,8 +242,7 @@ obj_value(pic_state *PIC_UNUSED(pic), void *ptr)
#define pic_data_p(pic,o) (pic_data_p(pic,o,NULL)) #define pic_data_p(pic,o) (pic_data_p(pic,o,NULL))
#define pic_port_p(pic,o) (pic_port_p(pic,o,NULL)) #define pic_port_p(pic,o) (pic_port_p(pic,o,NULL))
DEFPTR(id, struct identifier) DEFPTR(sym, struct symbol)
DEFPTR(sym, symbol)
DEFPTR(str, struct string) DEFPTR(str, struct string)
DEFPTR(blob, struct blob) DEFPTR(blob, struct blob)
DEFPTR(pair, struct pair) DEFPTR(pair, struct pair)
@ -269,7 +251,6 @@ DEFPTR(dict, struct dict)
DEFPTR(weak, struct weak) DEFPTR(weak, struct weak)
DEFPTR(data, struct data) DEFPTR(data, struct data)
DEFPTR(proc, struct proc) DEFPTR(proc, struct proc)
DEFPTR(env, struct env)
DEFPTR(port, struct port) DEFPTR(port, struct port)
DEFPTR(error, struct error) DEFPTR(error, struct error)
DEFPTR(rec, struct record) DEFPTR(rec, struct record)
@ -279,16 +260,11 @@ DEFPTR(irep, struct irep)
struct object *pic_obj_alloc(pic_state *, size_t, int type); struct object *pic_obj_alloc(pic_state *, size_t, int type);
pic_value pic_make_identifier(pic_state *, pic_value id, pic_value env);
pic_value pic_make_proc(pic_state *, pic_func_t, int, pic_value *); pic_value pic_make_proc(pic_state *, pic_func_t, int, pic_value *);
pic_value pic_make_proc_irep(pic_state *, struct irep *, struct context *); pic_value pic_make_proc_irep(pic_state *, struct irep *, struct context *);
pic_value pic_make_env(pic_state *, pic_value prefix);
pic_value pic_make_record(pic_state *, pic_value type, pic_value datum); pic_value pic_make_record(pic_state *, pic_value type, pic_value datum);
pic_value pic_record_type(pic_state *pic, pic_value record);
pic_value pic_add_identifier(pic_state *, pic_value id, pic_value env); pic_value pic_record_datum(pic_state *pic, pic_value record);
pic_value pic_find_identifier(pic_state *, pic_value id, pic_value env);
void pic_set_identifier(pic_state *, pic_value id, pic_value uid, pic_value env);
pic_value pic_id_name(pic_state *, pic_value id);
struct rope *pic_rope_incref(struct rope *); struct rope *pic_rope_incref(struct rope *);
void pic_rope_decref(pic_state *, struct rope *); void pic_rope_decref(pic_state *, struct rope *);

16
lib/record.c
View File

@ -17,6 +17,18 @@ pic_make_record(pic_state *pic, pic_value type, pic_value datum)
return obj_value(pic, rec); return obj_value(pic, rec);
} }
pic_value
pic_record_type(pic_state *pic, pic_value rec)
{
return pic_rec_ptr(pic, rec)->type;
}
pic_value
pic_record_datum(pic_state *pic, pic_value rec)
{
return pic_rec_ptr(pic, rec)->datum;
}
static pic_value static pic_value
pic_rec_make_record(pic_state *pic) pic_rec_make_record(pic_state *pic)
{ {
@ -44,7 +56,7 @@ pic_rec_record_type(pic_state *pic)
pic_get_args(pic, "r", &rec); pic_get_args(pic, "r", &rec);
return pic_rec_ptr(pic, rec)->type; return pic_record_type(pic, rec);
} }
static pic_value static pic_value
@ -54,7 +66,7 @@ pic_rec_record_datum(pic_state *pic)
pic_get_args(pic, "r", &rec); pic_get_args(pic, "r", &rec);
return pic_rec_ptr(pic, rec)->datum; return pic_record_datum(pic, rec);
} }
void void

12
lib/state.c
View File

@ -106,8 +106,8 @@ void pic_init_write(pic_state *);
void pic_init_read(pic_state *); void pic_init_read(pic_state *);
void pic_init_dict(pic_state *); void pic_init_dict(pic_state *);
void pic_init_record(pic_state *); void pic_init_record(pic_state *);
void pic_init_compile(pic_state *);
void pic_init_weak(pic_state *); void pic_init_weak(pic_state *);
void pic_init_load(pic_state *);
void pic_boot(pic_state *); void pic_boot(pic_state *);
@ -137,8 +137,8 @@ pic_init_core(pic_state *pic)
pic_init_read(pic); DONE; pic_init_read(pic); DONE;
pic_init_dict(pic); DONE; pic_init_dict(pic); DONE;
pic_init_record(pic); DONE; pic_init_record(pic); DONE;
pic_init_compile(pic); DONE;
pic_init_weak(pic); DONE; pic_init_weak(pic); DONE;
pic_init_load(pic); DONE;
#if PIC_USE_WRITE #if PIC_USE_WRITE
pic_init_write(pic); DONE; pic_init_write(pic); DONE;
@ -201,15 +201,9 @@ pic_open(pic_allocf allocf, void *userdata)
/* symbol table */ /* symbol table */
kh_init(oblist, &pic->oblist); kh_init(oblist, &pic->oblist);
/* unique symbol count */
pic->ucnt = 0;
/* global variables */ /* global variables */
pic->globals = pic_invalid_value(pic); pic->globals = pic_invalid_value(pic);
/* macros */
pic->macros = pic_invalid_value(pic);
/* features */ /* features */
pic->features = pic_nil_value(pic); pic->features = pic_nil_value(pic);
@ -222,7 +216,6 @@ pic_open(pic_allocf allocf, void *userdata)
/* root tables */ /* root tables */
pic->globals = pic_make_dict(pic); pic->globals = pic_make_dict(pic);
pic->macros = pic_make_dict(pic);
pic->dyn_env = pic_list(pic, 1, pic_make_weak(pic)); pic->dyn_env = pic_list(pic, 1, pic_make_weak(pic));
/* turn on GC */ /* turn on GC */
@ -255,7 +248,6 @@ pic_close(pic_state *pic)
pic->arena_idx = 0; pic->arena_idx = 0;
pic->err = pic_invalid_value(pic); pic->err = pic_invalid_value(pic);
pic->globals = pic_invalid_value(pic); pic->globals = pic_invalid_value(pic);
pic->macros = pic_invalid_value(pic);
pic->features = pic_invalid_value(pic); pic->features = pic_invalid_value(pic);
pic->dyn_env = pic_invalid_value(pic); pic->dyn_env = pic_invalid_value(pic);

4
lib/state.h
View File

@ -23,7 +23,7 @@ struct callinfo {
struct context *up; struct context *up;
}; };
KHASH_DECLARE(oblist, struct string *, struct identifier *) KHASH_DECLARE(oblist, struct string *, struct symbol *)
struct pic_state { struct pic_state {
pic_allocf allocf; pic_allocf allocf;
@ -44,9 +44,7 @@ struct pic_state {
pic_value features; pic_value features;
khash_t(oblist) oblist; /* string to symbol */ khash_t(oblist) oblist; /* string to symbol */
int ucnt;
pic_value globals; /* dict */ pic_value globals; /* dict */
pic_value macros; /* dict */
bool gc_enable; bool gc_enable;
struct heap *heap; struct heap *heap;

112
lib/symbol.c
View File

@ -10,13 +10,13 @@
#define kh_pic_str_hash(a) (kh_str_hash_func(to_cstr(a))) #define kh_pic_str_hash(a) (kh_str_hash_func(to_cstr(a)))
#define kh_pic_str_cmp(a, b) (kh_str_cmp_func(to_cstr(a), to_cstr(b))) #define kh_pic_str_cmp(a, b) (kh_str_cmp_func(to_cstr(a), to_cstr(b)))
KHASH_DEFINE(oblist, struct string *, symbol *, kh_pic_str_hash, kh_pic_str_cmp) KHASH_DEFINE(oblist, struct string *, struct symbol *, kh_pic_str_hash, kh_pic_str_cmp)
pic_value pic_value
pic_intern(pic_state *pic, pic_value str) pic_intern(pic_state *pic, pic_value str)
{ {
khash_t(oblist) *h = &pic->oblist; khash_t(oblist) *h = &pic->oblist;
symbol *sym; struct symbol *sym;
int it; int it;
int ret; int ret;
@ -29,39 +29,17 @@ pic_intern(pic_state *pic, pic_value str)
kh_val(h, it) = NULL; /* dummy */ kh_val(h, it) = NULL; /* dummy */
sym = (symbol *)pic_obj_alloc(pic, offsetof(symbol, env), PIC_TYPE_SYMBOL); sym = (struct symbol *)pic_obj_alloc(pic, sizeof(struct symbol), PIC_TYPE_SYMBOL);
sym->u.str = pic_str_ptr(pic, str); sym->str = pic_str_ptr(pic, str);
kh_val(h, it) = sym; kh_val(h, it) = sym;
return obj_value(pic, sym); return obj_value(pic, sym);
} }
pic_value
pic_make_identifier(pic_state *pic, pic_value base, pic_value env)
{
struct identifier *id;
id = (struct identifier *)pic_obj_alloc(pic, sizeof(struct identifier), PIC_TYPE_ID);
id->u.id = pic_id_ptr(pic, base);
id->env = pic_env_ptr(pic, env);
return obj_value(pic, id);
}
pic_value pic_value
pic_sym_name(pic_state *PIC_UNUSED(pic), pic_value sym) pic_sym_name(pic_state *PIC_UNUSED(pic), pic_value sym)
{ {
return obj_value(pic, pic_sym_ptr(pic, sym)->u.str); return obj_value(pic, pic_sym_ptr(pic, sym)->str);
}
pic_value
pic_id_name(pic_state *pic, pic_value id)
{
while (! pic_sym_p(pic, id)) {
id = obj_value(pic, pic_id_ptr(pic, id)->u.id);
}
return pic_sym_name(pic, id);
} }
static pic_value static pic_value
@ -113,80 +91,6 @@ pic_symbol_string_to_symbol(pic_state *pic)
return pic_intern(pic, str); return pic_intern(pic, str);
} }
static pic_value
pic_symbol_identifier_p(pic_state *pic)
{
pic_value obj;
pic_get_args(pic, "o", &obj);
return pic_bool_value(pic, pic_id_p(pic, obj));
}
static pic_value
pic_symbol_make_identifier(pic_state *pic)
{
pic_value id, env;
pic_get_args(pic, "oo", &id, &env);
TYPE_CHECK(pic, id, id);
TYPE_CHECK(pic, env, env);
return pic_make_identifier(pic, id, env);
}
static pic_value
pic_symbol_identifier_base(pic_state *pic)
{
pic_value id;
pic_get_args(pic, "o", &id);
TYPE_CHECK(pic, id, id);
if (pic_sym_p(pic, id)) {
pic_error(pic, "non-symbol identifier required", 1, id);
}
return obj_value(pic, pic_id_ptr(pic, id)->u.id);
}
static pic_value
pic_symbol_identifier_environment(pic_state *pic)
{
pic_value id;
pic_get_args(pic, "o", &id);
TYPE_CHECK(pic, id, id);
if (pic_sym_p(pic, id)) {
pic_error(pic, "non-symbol identifier required", 1, id);
}
return obj_value(pic, pic_id_ptr(pic, id)->env);
}
static pic_value
pic_symbol_identifier_eq_p(pic_state *pic)
{
int argc, i;
pic_value *argv;
pic_get_args(pic, "*", &argc, &argv);
for (i = 0; i < argc; ++i) {
if (! pic_id_p(pic, argv[i])) {
return pic_false_value(pic);
}
if (! pic_equal_p(pic, argv[i], argv[0])) {
return pic_false_value(pic);
}
}
return pic_true_value(pic);
}
void void
pic_init_symbol(pic_state *pic) pic_init_symbol(pic_state *pic)
{ {
@ -194,10 +98,4 @@ pic_init_symbol(pic_state *pic)
pic_defun(pic, "symbol=?", pic_symbol_symbol_eq_p); pic_defun(pic, "symbol=?", pic_symbol_symbol_eq_p);
pic_defun(pic, "symbol->string", pic_symbol_symbol_to_string); pic_defun(pic, "symbol->string", pic_symbol_symbol_to_string);
pic_defun(pic, "string->symbol", pic_symbol_string_to_symbol); pic_defun(pic, "string->symbol", pic_symbol_string_to_symbol);
pic_defun(pic, "make-identifier", pic_symbol_make_identifier);
pic_defun(pic, "identifier?", pic_symbol_identifier_p);
pic_defun(pic, "identifier=?", pic_symbol_identifier_eq_p);
pic_defun(pic, "identifier-base", pic_symbol_identifier_base);
pic_defun(pic, "identifier-environment", pic_symbol_identifier_environment);
} }

31
piclib/boot.scm
View File

@ -330,4 +330,33 @@
(body (cdr (cdr form)))) (body (cdr (cdr form))))
`(,(the 'with-dynamic-environment) `(,(the 'with-dynamic-environment)
(,(the 'list) ,@(map (lambda (x) `(,(the 'cons) ,(car x) ,(cadr x))) formal)) (,(the 'list) ,@(map (lambda (x) `(,(the 'cons) ,(car x) ,(cadr x))) formal))
(,the-lambda () ,@body))))))) (,the-lambda () ,@body)))))
(define-transformer 'define-record-type
(lambda (form env)
(let ((type (car (cdr form)))
(ctor (car (cdr (cdr form))))
(pred (car (cdr (cdr (cdr form)))))
(fields (cdr (cdr (cdr (cdr form))))))
`(,the-begin
(,the-define ,ctor
(,(the 'make-record) ',type
(,(the 'vector) . ,(map (lambda (field) (if (memq (car field) (cdr ctor)) (car field) #undefined)) fields))))
(,the-define ,pred
(,(the 'lambda) (obj)
(,(the 'and) (,(the 'record?) obj) (,(the 'eq?) (,(the 'record-type) obj) ',type))))
. ,(let loop ((fields fields) (pos 0) (acc '()))
(if (null? fields)
acc
(let ((field (car fields)))
(let ((defs `((,the-define (,(cadr field) obj)
(,the-if (,pred obj)
(,(the 'vector-ref) (,(the 'record-datum) obj) ,pos)
(,(the 'error) "record type mismatch" obj ',type)))
. ,(if (null? (cddr field))
'()
`((,the-define (,(car (cddr field)) obj value)
(,the-if (,pred obj)
(,(the 'vector-set!) (,(the 'record-datum) obj) ,pos value)
(,(the 'error) "record type mismatch" obj ',type))))))))
(loop (cdr fields) (+ pos 1) `(,@defs . ,acc))))))))))))

254
piclib/compile.scm Normal file
View File

@ -0,0 +1,254 @@
(define-values (make-identifier
identifier?
identifier=?
identifier-name
identifier-environment
make-environment
default-environment
environment?
find-identifier
add-identifier!
set-identifier!
macro-objects
compile
eval)
(let ()
;; identifier
(define-record-type identifier
(make-identifier name env)
%identifier?
(name identifier-name)
(env identifier-environment))
(define (identifier? obj)
(or (symbol? obj) (%identifier? obj)))
(define (identifier=? id1 id2)
(cond
((and (symbol? id1) (symbol? id2))
(eq? id1 id2))
((and (%identifier? id1) (%identifier? id2))
(eq? (find-identifier (identifier-name id1) (identifier-environment id1))
(find-identifier (identifier-name id2) (identifier-environment id2))))
(else
#f)))
(set! equal?
(let ((e? equal?))
(lambda (x y)
(if (%identifier? x)
(identifier=? x y)
(e? x y)))))
;; environment
(define-record-type environment
(%make-environment parent prefix binding)
environment?
(parent environment-parent)
(prefix environment-prefix)
(binding environment-binding))
(define (search-scope id env)
((environment-binding env) id))
(define (find-identifier id env)
(or (search-scope id env)
(let ((parent (environment-parent env)))
(if parent
(find-identifier id parent)
(if (symbol? id)
(add-identifier! id env)
(find-identifier (identifier-name id)
(identifier-environment id)))))))
(define add-identifier!
(let ((uniq
(let ((n 0))
(lambda (id)
(let ((m n))
(set! n (+ n 1))
(string->symbol
(string-append
"."
(symbol->string
(let loop ((id id))
(if (symbol? id)
id
(loop (identifier-name id)))))
"."
(number->string m))))))))
(lambda (id env)
(or (search-scope id env)
(if (and (not (environment-parent env)) (symbol? id))
(string->symbol
(string-append
(environment-prefix env)
(symbol->string id)))
(let ((uid (uniq id)))
(set-identifier! id uid env)
uid))))))
(define (set-identifier! id uid env)
((environment-binding env) id uid))
(define (make-environment prefix)
(%make-environment #f (symbol->string prefix) (make-ephemeron-table)))
(define default-environment
(let ((env (make-environment (string->symbol ""))))
(for-each
(lambda (x) (set-identifier! x x env))
'(core#define
core#set!
core#quote
core#lambda
core#if
core#begin
core#define-macro))
env))
(define (extend-environment parent)
(%make-environment parent #f (make-ephemeron-table)))
;; macro
(define global-macro-table
(make-dictionary))
(define (find-macro uid)
(and (dictionary-has? global-macro-table uid)
(dictionary-ref global-macro-table uid)))
(define (add-macro! uid expander) ; TODO warn on redefinition
(dictionary-set! global-macro-table uid expander))
(define (shadow-macro! uid)
(when (dictionary-has? global-macro-table uid)
(dictionary-delete! global-macro-table uid)))
(define (macro-objects)
global-macro-table)
;; expander
(define expand
(let ((task-queue (make-parameter '())))
(define (queue task)
(let ((tmp (cons #f #f)))
(task-queue `((,tmp . ,task) . ,(task-queue)))
tmp))
(define (run-all)
(for-each
(lambda (x)
(let ((task (cdr x)) (skelton (car x)))
(let ((x (task)))
(set-car! skelton (car x))
(set-cdr! skelton (cdr x)))))
(reverse (task-queue))))
(define (caddr x) (car (cddr x)))
(define (map* proc list*)
(cond
((null? list*) list*)
((pair? list*) (cons (proc (car list*)) (map* proc (cdr list*))))
(else (proc list*))))
(define (literal? x)
(not (or (identifier? x) (pair? x))))
(define (call? x)
(and (list? x)
(not (null? x))
(identifier? (car x))))
(define (expand-variable var env)
(let ((x (find-identifier var env)))
(let ((m (find-macro x)))
(if m
(expand-node (m var env) env)
x))))
(define (expand-quote obj)
`(core#quote ,obj))
(define (expand-define var form env)
(let ((uid (add-identifier! var env)))
(shadow-macro! uid)
`(core#define ,uid ,(expand-node form env))))
(define (expand-lambda args body env)
(let ((env (extend-environment env)))
(let ((args (map* (lambda (var) (add-identifier! var env)) args)))
(parameterize ((task-queue '()))
(let ((body (expand-node body env)))
(run-all)
`(core#lambda ,args ,body))))))
(define (expand-define-macro var transformer env)
(let ((uid (add-identifier! var env)))
(let ((expander (load (expand transformer env))))
(add-macro! uid expander)
#undefined)))
(define (expand-node expr env)
(cond
((literal? expr) expr)
((identifier? expr) (expand-variable expr env))
((call? expr)
(let ((functor (find-identifier (car expr) env)))
(case functor
((core#quote) (expand-quote (cadr expr)))
((core#define) (expand-define (cadr expr) (caddr expr) env))
((core#lambda) (queue (lambda () (expand-lambda (cadr expr) (caddr expr) env))))
((core#define-macro) (expand-define-macro (cadr expr) (caddr expr) env))
(else
(let ((m (find-macro functor)))
(if m
(expand-node (m expr env) env)
(map (lambda (x) (expand-node x env)) expr)))))))
((list? expr)
(map (lambda (x) (expand-node x env)) expr))
(else
(error "invalid expression" expr))))
(define (expand expr env)
(let ((x (expand-node expr env)))
(run-all)
x))
expand))
;; compile
(define (compile expr . env)
(expand expr (if (null? env) default-environment (car env))))
;; eval
(define (eval expr . env)
(load (compile expr (if (null? env) default-environment (car env)))))
(values make-identifier
identifier?
identifier=?
identifier-name
identifier-environment
make-environment
default-environment
environment?
find-identifier
add-identifier!
set-identifier!
macro-objects
compile
eval)))

7
piclib/library.scm
View File

@ -91,7 +91,7 @@
(parameterize ((current-library name)) (parameterize ((current-library name))
(for-each (for-each
(lambda (expr) (lambda (expr)
(eval expr name)) ; TODO parse library declarations (eval expr name)) ; TODO parse library declarations
body))))) body)))))
(define-transformer 'cond-expand (define-transformer 'cond-expand
@ -215,14 +215,15 @@
and or and or
cond case else => cond case else =>
do when unless do when unless
parameterize)) parameterize define-record-type))
(export-keyword 'boolean?) (export-keyword 'boolean?)
(dictionary-for-each export-keyword (global-objects))) (dictionary-for-each export-keyword (global-objects)))
(set! eval (set! eval
(let ((e eval)) (let ((e eval))
(lambda (expr . lib) (lambda (expr . lib)
(let ((lib (if (null? lib) (current-library) (car lib)))) (let ((lib (if (null? lib) (current-library) (car lib))))
(e expr (library-environment lib)))))) (parameterize ((current-library lib))
(e expr (library-environment lib)))))))
(make-library '(picrin user))) (make-library '(picrin user)))
(values current-library (values current-library

5
tools/mkboot.scm
View File

@ -55,6 +55,10 @@
,(generate-rom) ,(generate-rom)
"};\n" "};\n"
"\n" "\n"
"static const char boot_compile_rom[][80] = {\n"
,(generate-rom)
"};\n"
"\n"
"#if PIC_USE_LIBRARY\n" "#if PIC_USE_LIBRARY\n"
"static const char boot_library_rom[][80] = {\n" "static const char boot_library_rom[][80] = {\n"
,(generate-rom) ,(generate-rom)
@ -64,6 +68,7 @@
"void\n" "void\n"
"pic_boot(pic_state *pic)\n" "pic_boot(pic_state *pic)\n"
"{\n" "{\n"
" pic_load_native(pic, &boot_compile_rom[0][0]);\n"
" pic_load_native(pic, &boot_rom[0][0]);\n" " pic_load_native(pic, &boot_rom[0][0]);\n"
"#if PIC_USE_LIBRARY\n" "#if PIC_USE_LIBRARY\n"
" pic_load_native(pic, &boot_library_rom[0][0]);\n" " pic_load_native(pic, &boot_library_rom[0][0]);\n"