move simple macros to (picrin macro)

This commit is contained in:
Yuichi Nishiwaki 2017-04-04 02:16:18 +09:00
parent af5acb6c4f
commit 6c3c505aa4
6 changed files with 849 additions and 939 deletions

View File

@ -13,12 +13,13 @@
;; simple macro ;; simple macro
(export define-syntax (export define-syntax
let-syntax letrec-syntax
syntax-quote syntax-quote
syntax-quasiquote syntax-quasiquote
syntax-unquote syntax-unquote
syntax-unquote-splicing) syntax-unquote-splicing)
;; misc transformers ;; other transformers
(export call-with-current-environment (export call-with-current-environment
make-syntactic-closure make-syntactic-closure
@ -30,11 +31,173 @@
ir-macro-transformer) ir-macro-transformer)
;; environment extraction
(define-macro call-with-current-environment (define-macro call-with-current-environment
(lambda (form env) (lambda (form env)
`(,(cadr form) ',env))) `(,(cadr form) ',env)))
;; simple macro
(define-macro define-auxiliary-syntax
(lambda (form _)
`(define-macro ,(cadr form)
(lambda _
(error "invalid use of auxiliary syntax" ',(cadr form))))))
(define-auxiliary-syntax syntax-unquote)
(define-auxiliary-syntax syntax-unquote-splicing)
(define (transformer f)
(lambda (form env)
(let ((ephemeron1 (make-ephemeron-table))
(ephemeron2 (make-ephemeron-table)))
(letrec
((wrap (lambda (var1)
(or (ephemeron1 var1)
(let ((var2 (make-identifier var1 env)))
(ephemeron1 var1 var2)
(ephemeron2 var2 var1)
var2))))
(unwrap (lambda (var2)
(or (ephemeron2 var2)
var2)))
(walk (lambda (f form)
(cond
((identifier? form)
(f form))
((pair? form)
(cons (walk f (car form)) (walk f (cdr form))))
(else
form)))))
(let ((form (cdr form)))
(walk unwrap (apply f (walk wrap form))))))))
(define (the var)
(call-with-current-environment
(lambda (env)
(make-identifier var env))))
(define-macro syntax-quote
(lambda (form env)
(let ((renames '()))
(letrec
((rename (lambda (var)
(let ((x (assq var renames)))
(if x
(cadr x)
(begin
(set! renames `((,var ,(make-identifier var env) (,(the 'make-identifier) ',var ',env)) . ,renames))
(rename var))))))
(walk (lambda (f form)
(cond
((identifier? form)
(f form))
((pair? form)
`(,(the 'cons) (walk f (car form)) (walk f (cdr form))))
(else
`(,(the 'quote) ,form))))))
(let ((form (walk rename (cadr form))))
`(,(the 'let)
,(map cdr renames)
,form))))))
(define-macro syntax-quasiquote
(lambda (form env)
(let ((renames '()))
(letrec
((rename (lambda (var)
(let ((x (assq var renames)))
(if x
(cadr x)
(begin
(set! renames `((,var ,(make-identifier var env) (,(the 'make-identifier) ',var ',env)) . ,renames))
(rename var)))))))
(define (syntax-quasiquote? form)
(and (pair? form)
(identifier? (car form))
(identifier=? (the 'syntax-quasiquote) (make-identifier (car form) env))))
(define (syntax-unquote? form)
(and (pair? form)
(identifier? (car form))
(identifier=? (the 'syntax-unquote) (make-identifier (car form) env))))
(define (syntax-unquote-splicing? form)
(and (pair? form)
(pair? (car form))
(identifier? (caar form))
(identifier=? (the 'syntax-unquote-splicing) (make-identifier (caar form) env))))
(define (qq depth expr)
(cond
;; syntax-unquote
((syntax-unquote? expr)
(if (= depth 1)
(car (cdr expr))
(list (the 'list)
(list (the 'quote) (the 'syntax-unquote))
(qq (- depth 1) (car (cdr expr))))))
;; syntax-unquote-splicing
((syntax-unquote-splicing? expr)
(if (= depth 1)
(list (the 'append)
(car (cdr (car expr)))
(qq depth (cdr expr)))
(list (the 'cons)
(list (the 'list)
(list (the 'quote) (the 'syntax-unquote-splicing))
(qq (- depth 1) (car (cdr (car expr)))))
(qq depth (cdr expr)))))
;; syntax-quasiquote
((syntax-quasiquote? expr)
(list (the 'list)
(list (the 'quote) (the 'quasiquote))
(qq (+ depth 1) (car (cdr expr)))))
;; list
((pair? expr)
(list (the 'cons)
(qq depth (car expr))
(qq depth (cdr expr))))
;; identifier
((identifier? expr)
(rename expr))
;; simple datum
(else
(list (the 'quote) expr))))
(let ((body (qq 1 (cadr form))))
`(,(the 'let)
,(map cdr renames)
,body))))))
(define-macro define-syntax
(lambda (form env)
(let ((formal (car (cdr form)))
(body (cdr (cdr form))))
(if (pair? formal)
`(,(the 'define-syntax) ,(car formal) (,(the 'lambda) ,(cdr formal) ,@body))
`(,(the 'define-macro) ,formal (,(the 'transformer) (,(the 'begin) ,@body)))))))
(define-macro letrec-syntax
(lambda (form env)
(let ((formal (car (cdr form)))
(body (cdr (cdr form))))
`(let ()
,@(map (lambda (x)
`(,(the 'define-syntax) ,(car x) ,(cadr x)))
formal)
,@body))))
(define-macro let-syntax
(lambda (form env)
`(,(the 'letrec-syntax) ,@(cdr form))))
;; syntactic closure ;; syntactic closure

View File

@ -392,6 +392,10 @@
;; 4.3.3. Signaling errors in macro transformers ;; 4.3.3. Signaling errors in macro transformers
(define-macro syntax-error
(lambda (form _)
(apply error (cdr form))))
(export syntax-error) (export syntax-error)
;; 5.3. Variable definitions ;; 5.3. Variable definitions

View File

@ -1,5 +1,6 @@
(define-library (scheme eval) (define-library (scheme eval)
(import (picrin base)) (import (picrin base)
(picrin macro))
(define counter 0) (define counter 0)

View File

@ -2,489 +2,389 @@
#include "picrin/extra.h" #include "picrin/extra.h"
static const char boot_rom[][80] = { static const char boot_rom[][80] = {
"(core#begin (core#define transformer (core#lambda (.f.2252) (core#lambda (.form.", "((core#lambda () (core#begin (core#define .define-transformer.2252 (core#lambda ",
"2253 .env.2254) ((core#lambda (.ephemeron1.2255 .ephemeron2.2256) ((core#lambda ", "(.name.2272 .transformer.2273) (add-macro! .name.2272 .transformer.2273))) (core",
"(.wrap.2257 .unwrap.2258 .walk.2259) (core#begin (core#set! .wrap.2257 (core#lam", "#begin (core#define .the.2253 (core#lambda (.var.2274) (make-identifier .var.227",
"bda (.var1.2260) ((core#lambda (.it.2261) (core#if .it.2261 .it.2261 ((core#lamb", "4 default-environment))) (core#begin (core#define .the-core-define.2254 (.the.22",
"da (.it.2262) (core#if .it.2262 .it.2262 #f)) ((core#lambda (.var2.2263) (core#b", "53 (core#quote core#define))) (core#begin (core#define .the-core-lambda.2255 (.t",
"egin (.ephemeron1.2255 .var1.2260 .var2.2263) (core#begin (.ephemeron2.2256 .var", "he.2253 (core#quote core#lambda))) (core#begin (core#define .the-core-begin.2256",
"2.2263 .var1.2260) .var2.2263))) (make-identifier .var1.2260 .env.2254))))) (.ep", " (.the.2253 (core#quote core#begin))) (core#begin (core#define .the-core-quote.2",
"hemeron1.2255 .var1.2260)))) (core#begin (core#set! .unwrap.2258 (core#lambda (.", "257 (.the.2253 (core#quote core#quote))) (core#begin (core#define .the-core-set!",
"var2.2264) ((core#lambda (.it.2265) (core#if .it.2265 .it.2265 ((core#lambda (.i", ".2258 (.the.2253 (core#quote core#set!))) (core#begin (core#define .the-core-if.",
"t.2266) (core#if .it.2266 .it.2266 #f)) .var2.2264))) (.ephemeron2.2256 .var2.22", "2259 (.the.2253 (core#quote core#if))) (core#begin (core#define .the-core-define",
"64)))) (core#begin (core#set! .walk.2259 (core#lambda (.f.2267 .form.2268) (core", "-macro.2260 (.the.2253 (core#quote core#define-macro))) (core#begin (core#define",
"#if (identifier? .form.2268) (.f.2267 .form.2268) (core#if (pair? .form.2268) (c", " .the-define.2261 (.the.2253 (core#quote define))) (core#begin (core#define .the",
"ons (.walk.2259 .f.2267 (car .form.2268)) (.walk.2259 .f.2267 (cdr .form.2268)))", "-lambda.2262 (.the.2253 (core#quote lambda))) (core#begin (core#define .the-begi",
" .form.2268)))) ((core#lambda (.form.2269) (.walk.2259 .unwrap.2258 (apply .f.22", "n.2263 (.the.2253 (core#quote begin))) (core#begin (core#define .the-quote.2264 ",
"52 (.walk.2259 .wrap.2257 .form.2269)))) (cdr .form.2253)))))) #undefined #undef", "(.the.2253 (core#quote quote))) (core#begin (core#define .the-set!.2265 (.the.22",
"ined #undefined)) (make-ephemeron-table) (make-ephemeron-table))))) ((core#lambd", "53 (core#quote set!))) (core#begin (core#define .the-if.2266 (.the.2253 (core#qu",
"a () (core#begin (core#define .define-transformer.2270 (core#lambda (.name.2290 ", "ote if))) (core#begin (core#define .the-define-macro.2267 (.the.2253 (core#quote",
".transformer.2291) (add-macro! .name.2290 .transformer.2291))) (core#begin (core", " define-macro))) (core#begin (.define-transformer.2252 (core#quote quote) (core#",
"#define .the.2271 (core#lambda (.var.2292) (make-identifier .var.2292 default-en", "lambda (.form.2275 .env.2276) (core#if (= (length .form.2275) 2) (cons .the-core",
"vironment))) (core#begin (core#define .the-core-define.2272 (.the.2271 (core#quo", "-quote.2257 (cons (cadr .form.2275) (core#quote ()))) (error \"malformed quote\" .",
"te core#define))) (core#begin (core#define .the-core-lambda.2273 (.the.2271 (cor", "form.2275)))) (core#begin (.define-transformer.2252 (core#quote if) (core#lambda",
"e#quote core#lambda))) (core#begin (core#define .the-core-begin.2274 (.the.2271 ", " (.form.2277 .env.2278) ((core#lambda (.len.2279) (core#if (= .len.2279 3) (appe",
"(core#quote core#begin))) (core#begin (core#define .the-core-quote.2275 (.the.22", "nd .form.2277 (cons (core#quote #undefined) (core#quote ()))) (core#if (= .len.2",
"71 (core#quote core#quote))) (core#begin (core#define .the-core-set!.2276 (.the.", "279 4) (cons .the-core-if.2259 (cdr .form.2277)) (error \"malformed if\" .form.227",
"2271 (core#quote core#set!))) (core#begin (core#define .the-core-if.2277 (.the.2", "7)))) (length .form.2277)))) (core#begin (.define-transformer.2252 (core#quote b",
"271 (core#quote core#if))) (core#begin (core#define .the-core-define-macro.2278 ", "egin) (core#lambda (.form.2280 .env.2281) ((core#lambda (.len.2282) (core#if (= ",
"(.the.2271 (core#quote core#define-macro))) (core#begin (core#define .the-define", ".len.2282 1) #undefined (core#if (= .len.2282 2) (cadr .form.2280) (core#if (= .",
".2279 (.the.2271 (core#quote define))) (core#begin (core#define .the-lambda.2280", "len.2282 3) (cons .the-core-begin.2256 (cdr .form.2280)) (cons .the-core-begin.2",
" (.the.2271 (core#quote lambda))) (core#begin (core#define .the-begin.2281 (.the", "256 (cons (cadr .form.2280) (cons (cons .the-begin.2263 (cddr .form.2280)) (core",
".2271 (core#quote begin))) (core#begin (core#define .the-quote.2282 (.the.2271 (", "#quote ())))))))) (length .form.2280)))) (core#begin (.define-transformer.2252 (",
"core#quote quote))) (core#begin (core#define .the-set!.2283 (.the.2271 (core#quo", "core#quote set!) (core#lambda (.form.2283 .env.2284) (core#if (core#if (= (lengt",
"te set!))) (core#begin (core#define .the-if.2284 (.the.2271 (core#quote if))) (c", "h .form.2283) 3) (identifier? (cadr .form.2283)) #f) (cons .the-core-set!.2258 (",
"ore#begin (core#define .the-define-macro.2285 (.the.2271 (core#quote define-macr", "cdr .form.2283)) (error \"malformed set!\" .form.2283)))) (core#begin (core#define",
"o))) (core#begin (.define-transformer.2270 (core#quote quote) (core#lambda (.for", " .check-formal.2268 (core#lambda (.formal.2285) ((core#lambda (.it.2286) (core#i",
"m.2293 .env.2294) (core#if (= (length .form.2293) 2) (cons .the-core-quote.2275 ", "f .it.2286 .it.2286 ((core#lambda (.it.2287) (core#if .it.2287 .it.2287 ((core#l",
"(cons (cadr .form.2293) (core#quote ()))) (error \"malformed quote\" .form.2293)))", "ambda (.it.2288) (core#if .it.2288 .it.2288 #f)) (core#if (pair? .formal.2285) (",
") (core#begin (.define-transformer.2270 (core#quote if) (core#lambda (.form.2295", "core#if (identifier? (car .formal.2285)) (.check-formal.2268 (cdr .formal.2285))",
" .env.2296) ((core#lambda (.len.2297) (core#if (= .len.2297 3) (append .form.229", " #f) #f)))) (identifier? .formal.2285)))) (null? .formal.2285)))) (core#begin (.",
"5 (cons (core#quote #undefined) (core#quote ()))) (core#if (= .len.2297 4) (cons", "define-transformer.2252 (core#quote lambda) (core#lambda (.form.2289 .env.2290) ",
" .the-core-if.2277 (cdr .form.2295)) (error \"malformed if\" .form.2295)))) (lengt", "(core#if (= (length .form.2289) 1) (error \"malformed lambda\" .form.2289) (core#i",
"h .form.2295)))) (core#begin (.define-transformer.2270 (core#quote begin) (core#", "f (.check-formal.2268 (cadr .form.2289)) (cons .the-core-lambda.2255 (cons (cadr",
"lambda (.form.2298 .env.2299) ((core#lambda (.len.2300) (core#if (= .len.2300 1)", " .form.2289) (cons (cons .the-begin.2263 (cddr .form.2289)) (core#quote ())))) (",
" #undefined (core#if (= .len.2300 2) (cadr .form.2298) (core#if (= .len.2300 3) ", "error \"malformed lambda\" .form.2289))))) (core#begin (.define-transformer.2252 (",
"(cons .the-core-begin.2274 (cdr .form.2298)) (cons .the-core-begin.2274 (cons (c", "core#quote define) (core#lambda (.form.2291 .env.2292) ((core#lambda (.len.2293)",
"adr .form.2298) (cons (cons .the-begin.2281 (cddr .form.2298)) (core#quote ())))", " (core#if (= .len.2293 1) (error \"malformed define\" .form.2291) ((core#lambda (.",
"))))) (length .form.2298)))) (core#begin (.define-transformer.2270 (core#quote s", "formal.2294) (core#if (identifier? .formal.2294) (core#if (= .len.2293 3) (cons ",
"et!) (core#lambda (.form.2301 .env.2302) (core#if (core#if (= (length .form.2301", ".the-core-define.2254 (cdr .form.2291)) (error \"malformed define\" .form.2291)) (",
") 3) (identifier? (cadr .form.2301)) #f) (cons .the-core-set!.2276 (cdr .form.23", "core#if (pair? .formal.2294) (cons .the-define.2261 (cons (car .formal.2294) (co",
"01)) (error \"malformed set!\" .form.2301)))) (core#begin (core#define .check-form", "ns (cons .the-lambda.2262 (cons (cdr .formal.2294) (cddr .form.2291))) (core#quo",
"al.2286 (core#lambda (.formal.2303) ((core#lambda (.it.2304) (core#if .it.2304 .", "te ())))) (error \"define: binding to non-varaible object\" .form.2291)))) (cadr .",
"it.2304 ((core#lambda (.it.2305) (core#if .it.2305 .it.2305 ((core#lambda (.it.2", "form.2291)))) (length .form.2291)))) (core#begin (.define-transformer.2252 (core",
"306) (core#if .it.2306 .it.2306 #f)) (core#if (pair? .formal.2303) (core#if (ide", "#quote define-macro) (core#lambda (.form.2295 .env.2296) (core#if (= (length .fo",
"ntifier? (car .formal.2303)) (.check-formal.2286 (cdr .formal.2303)) #f) #f)))) ", "rm.2295) 3) (core#if (identifier? (cadr .form.2295)) (cons .the-core-define-macr",
"(identifier? .formal.2303)))) (null? .formal.2303)))) (core#begin (.define-trans", "o.2260 (cdr .form.2295)) (error \"define-macro: binding to non-variable object\" .",
"former.2270 (core#quote lambda) (core#lambda (.form.2307 .env.2308) (core#if (= ", "form.2295)) (error \"malformed define-macro\" .form.2295)))) (core#begin #undefine",
"(length .form.2307) 1) (error \"malformed lambda\" .form.2307) (core#if (.check-fo", "d (core#begin (.define-transformer.2252 (core#quote else) (core#lambda ._.2297 (",
"rmal.2286 (cadr .form.2307)) (cons .the-core-lambda.2273 (cons (cadr .form.2307)", "error \"invalid use of auxiliary syntax\" (core#quote else)))) (core#begin (.defin",
" (cons (cons .the-begin.2281 (cddr .form.2307)) (core#quote ())))) (error \"malfo", "e-transformer.2252 (core#quote =>) (core#lambda ._.2298 (error \"invalid use of a",
"rmed lambda\" .form.2307))))) (core#begin (.define-transformer.2270 (core#quote d", "uxiliary syntax\" (core#quote =>)))) (core#begin (.define-transformer.2252 (core#",
"efine) (core#lambda (.form.2309 .env.2310) ((core#lambda (.len.2311) (core#if (=", "quote unquote) (core#lambda ._.2299 (error \"invalid use of auxiliary syntax\" (co",
" .len.2311 1) (error \"malformed define\" .form.2309) ((core#lambda (.formal.2312)", "re#quote unquote)))) (core#begin (.define-transformer.2252 (core#quote unquote-s",
" (core#if (identifier? .formal.2312) (core#if (= .len.2311 3) (cons .the-core-de", "plicing) (core#lambda ._.2300 (error \"invalid use of auxiliary syntax\" (core#quo",
"fine.2272 (cdr .form.2309)) (error \"malformed define\" .form.2309)) (core#if (pai", "te unquote-splicing)))) (core#begin (.define-transformer.2252 (core#quote let) (",
"r? .formal.2312) (cons .the-define.2279 (cons (car .formal.2312) (cons (cons .th", "core#lambda (.form.2301 .env.2302) (core#if (identifier? (cadr .form.2301)) ((co",
"e-lambda.2280 (cons (cdr .formal.2312) (cddr .form.2309))) (core#quote ())))) (e", "re#lambda (.name.2303 .formal.2304 .body.2305) (cons (cons .the-lambda.2262 (con",
"rror \"define: binding to non-varaible object\" .form.2309)))) (cadr .form.2309)))", "s (core#quote ()) (cons (cons .the-define.2261 (cons (cons .name.2303 (map car .",
") (length .form.2309)))) (core#begin (.define-transformer.2270 (core#quote defin", "formal.2304)) .body.2305)) (cons (cons .name.2303 (map cadr .formal.2304)) (core",
"e-macro) (core#lambda (.form.2313 .env.2314) (core#if (= (length .form.2313) 3) ", "#quote ()))))) (core#quote ()))) (car (cdr .form.2301)) (car (cdr (cdr .form.230",
"(core#if (identifier? (cadr .form.2313)) (cons .the-core-define-macro.2278 (cdr ", "1))) (cdr (cdr (cdr .form.2301)))) ((core#lambda (.formal.2306 .body.2307) (cons",
".form.2313)) (error \"define-macro: binding to non-variable object\" .form.2313)) ", " (cons .the-lambda.2262 (cons (map car .formal.2306) .body.2307)) (map cadr .for",
"(error \"malformed define-macro\" .form.2313)))) (core#begin (.define-transformer.", "mal.2306))) (car (cdr .form.2301)) (cdr (cdr .form.2301)))))) (core#begin (.defi",
"2270 (core#quote syntax-error) (core#lambda (.form.2315 ._.2316) (apply error (c", "ne-transformer.2252 (core#quote and) (core#lambda (.form.2308 .env.2309) (core#i",
"dr .form.2315)))) (core#begin #undefined (core#begin (.define-transformer.2270 (", "f (null? (cdr .form.2308)) #t (core#if (null? (cddr .form.2308)) (cadr .form.230",
"core#quote else) (core#lambda ._.2317 (error \"invalid use of auxiliary syntax\" (", "8) (cons .the-if.2266 (cons (cadr .form.2308) (cons (cons (.the.2253 (core#quote",
"core#quote else)))) (core#begin (.define-transformer.2270 (core#quote =>) (core#", " and)) (cddr .form.2308)) (cons (core#quote #f) (core#quote ()))))))))) (core#be",
"lambda ._.2318 (error \"invalid use of auxiliary syntax\" (core#quote =>)))) (core", "gin (.define-transformer.2252 (core#quote or) (core#lambda (.form.2310 .env.2311",
"#begin (.define-transformer.2270 (core#quote unquote) (core#lambda ._.2319 (erro", ") (core#if (null? (cdr .form.2310)) #f ((core#lambda (.tmp.2312) (cons (.the.225",
"r \"invalid use of auxiliary syntax\" (core#quote unquote)))) (core#begin (.define", "3 (core#quote let)) (cons (cons (cons .tmp.2312 (cons (cadr .form.2310) (core#qu",
"-transformer.2270 (core#quote unquote-splicing) (core#lambda ._.2320 (error \"inv", "ote ()))) (core#quote ())) (cons (cons .the-if.2266 (cons .tmp.2312 (cons .tmp.2",
"alid use of auxiliary syntax\" (core#quote unquote-splicing)))) (core#begin (.def", "312 (cons (cons (.the.2253 (core#quote or)) (cddr .form.2310)) (core#quote ())))",
"ine-transformer.2270 (core#quote syntax-unquote) (core#lambda ._.2321 (error \"in", ")) (core#quote ()))))) (make-identifier (core#quote it) .env.2311))))) (core#beg",
"valid use of auxiliary syntax\" (core#quote syntax-unquote)))) (core#begin (.defi", "in (.define-transformer.2252 (core#quote cond) (core#lambda (.form.2313 .env.231",
"ne-transformer.2270 (core#quote syntax-unquote-splicing) (core#lambda ._.2322 (e", "4) ((core#lambda (.clauses.2315) (core#if (null? .clauses.2315) #undefined ((cor",
"rror \"invalid use of auxiliary syntax\" (core#quote syntax-unquote-splicing)))) (", "e#lambda (.clause.2316) (core#if (core#if (identifier? (car .clause.2316)) (iden",
"core#begin (.define-transformer.2270 (core#quote let) (core#lambda (.form.2323 .", "tifier=? (.the.2253 (core#quote else)) (make-identifier (car .clause.2316) .env.",
"env.2324) (core#if (identifier? (cadr .form.2323)) ((core#lambda (.name.2325 .fo", "2314)) #f) (cons .the-begin.2263 (cdr .clause.2316)) (core#if (null? (cdr .claus",
"rmal.2326 .body.2327) (cons (cons .the-lambda.2280 (cons (core#quote ()) (cons (", "e.2316)) (cons (.the.2253 (core#quote or)) (cons (car .clause.2316) (cons (cons ",
"cons .the-define.2279 (cons (cons .name.2325 (map car .formal.2326)) .body.2327)", "(.the.2253 (core#quote cond)) (cdr .clauses.2315)) (core#quote ())))) (core#if (",
") (cons (cons .name.2325 (map cadr .formal.2326)) (core#quote ()))))) (core#quot", "core#if (identifier? (cadr .clause.2316)) (identifier=? (.the.2253 (core#quote =",
"e ()))) (car (cdr .form.2323)) (car (cdr (cdr .form.2323))) (cdr (cdr (cdr .form", ">)) (make-identifier (cadr .clause.2316) .env.2314)) #f) ((core#lambda (.tmp.231",
".2323)))) ((core#lambda (.formal.2328 .body.2329) (cons (cons .the-lambda.2280 (", "7) (cons (.the.2253 (core#quote let)) (cons (cons (cons .tmp.2317 (cons (car .cl",
"cons (map car .formal.2328) .body.2329)) (map cadr .formal.2328))) (car (cdr .fo", "ause.2316) (core#quote ()))) (core#quote ())) (cons (cons .the-if.2266 (cons .tm",
"rm.2323)) (cdr (cdr .form.2323)))))) (core#begin (.define-transformer.2270 (core", "p.2317 (cons (cons (cadr (cdr .clause.2316)) (cons .tmp.2317 (core#quote ()))) (",
"#quote and) (core#lambda (.form.2330 .env.2331) (core#if (null? (cdr .form.2330)", "cons (cons (.the.2253 (core#quote cond)) (cddr .form.2313)) (core#quote ()))))) ",
") #t (core#if (null? (cddr .form.2330)) (cadr .form.2330) (cons .the-if.2284 (co", "(core#quote ()))))) (make-identifier (core#quote tmp) .env.2314)) (cons .the-if.",
"ns (cadr .form.2330) (cons (cons (.the.2271 (core#quote and)) (cddr .form.2330))", "2266 (cons (car .clause.2316) (cons (cons .the-begin.2263 (cdr .clause.2316)) (c",
" (cons (core#quote #f) (core#quote ()))))))))) (core#begin (.define-transformer.", "ons (cons (.the.2253 (core#quote cond)) (cdr .clauses.2315)) (core#quote ())))))",
"2270 (core#quote or) (core#lambda (.form.2332 .env.2333) (core#if (null? (cdr .f", ")))) (car .clauses.2315)))) (cdr .form.2313)))) (core#begin (.define-transformer",
"orm.2332)) #f ((core#lambda (.tmp.2334) (cons (.the.2271 (core#quote let)) (cons", ".2252 (core#quote quasiquote) (core#lambda (.form.2318 .env.2319) (core#begin (c",
" (cons (cons .tmp.2334 (cons (cadr .form.2332) (core#quote ()))) (core#quote ())", "ore#define .quasiquote?.2320 (core#lambda (.form.2324) (core#if (pair? .form.232",
") (cons (cons .the-if.2284 (cons .tmp.2334 (cons .tmp.2334 (cons (cons (.the.227", "4) (core#if (identifier? (car .form.2324)) (identifier=? (.the.2253 (core#quote ",
"1 (core#quote or)) (cddr .form.2332)) (core#quote ()))))) (core#quote ()))))) (m", "quasiquote)) (make-identifier (car .form.2324) .env.2319)) #f) #f))) (core#begin",
"ake-identifier (core#quote it) .env.2333))))) (core#begin (.define-transformer.2", " (core#define .unquote?.2321 (core#lambda (.form.2325) (core#if (pair? .form.232",
"270 (core#quote cond) (core#lambda (.form.2335 .env.2336) ((core#lambda (.clause", "5) (core#if (identifier? (car .form.2325)) (identifier=? (.the.2253 (core#quote ",
"s.2337) (core#if (null? .clauses.2337) #undefined ((core#lambda (.clause.2338) (", "unquote)) (make-identifier (car .form.2325) .env.2319)) #f) #f))) (core#begin (c",
"core#if (core#if (identifier? (car .clause.2338)) (identifier=? (.the.2271 (core", "ore#define .unquote-splicing?.2322 (core#lambda (.form.2326) (core#if (pair? .fo",
"#quote else)) (make-identifier (car .clause.2338) .env.2336)) #f) (cons .the-beg", "rm.2326) (core#if (pair? (car .form.2326)) (core#if (identifier? (caar .form.232",
"in.2281 (cdr .clause.2338)) (core#if (null? (cdr .clause.2338)) (cons (.the.2271", "6)) (identifier=? (.the.2253 (core#quote unquote-splicing)) (make-identifier (ca",
" (core#quote or)) (cons (car .clause.2338) (cons (cons (.the.2271 (core#quote co", "ar .form.2326) .env.2319)) #f) #f) #f))) (core#begin (core#define .qq.2323 (core",
"nd)) (cdr .clauses.2337)) (core#quote ())))) (core#if (core#if (identifier? (cad", "#lambda (.depth.2327 .expr.2328) (core#if (.unquote?.2321 .expr.2328) (core#if (",
"r .clause.2338)) (identifier=? (.the.2271 (core#quote =>)) (make-identifier (cad", "= .depth.2327 1) (cadr .expr.2328) (list (.the.2253 (core#quote list)) (list (.t",
"r .clause.2338) .env.2336)) #f) ((core#lambda (.tmp.2339) (cons (.the.2271 (core", "he.2253 (core#quote quote)) (.the.2253 (core#quote unquote))) (.qq.2323 (- .dept",
"#quote let)) (cons (cons (cons .tmp.2339 (cons (car .clause.2338) (core#quote ()", "h.2327 1) (car (cdr .expr.2328))))) (core#if (.unquote-splicing?.2322 .expr.2328",
"))) (core#quote ())) (cons (cons .the-if.2284 (cons .tmp.2339 (cons (cons (cadr ", ") (core#if (= .depth.2327 1) (list (.the.2253 (core#quote append)) (car (cdr (ca",
"(cdr .clause.2338)) (cons .tmp.2339 (core#quote ()))) (cons (cons (.the.2271 (co", "r .expr.2328))) (.qq.2323 .depth.2327 (cdr .expr.2328))) (list (.the.2253 (core#",
"re#quote cond)) (cddr .form.2335)) (core#quote ()))))) (core#quote ()))))) (make", "quote cons)) (list (.the.2253 (core#quote list)) (list (.the.2253 (core#quote qu",
"-identifier (core#quote tmp) .env.2336)) (cons .the-if.2284 (cons (car .clause.2", "ote)) (.the.2253 (core#quote unquote-splicing))) (.qq.2323 (- .depth.2327 1) (ca",
"338) (cons (cons .the-begin.2281 (cdr .clause.2338)) (cons (cons (.the.2271 (cor", "r (cdr (car .expr.2328))))) (.qq.2323 .depth.2327 (cdr .expr.2328)))) (core#if (",
"e#quote cond)) (cdr .clauses.2337)) (core#quote ()))))))))) (car .clauses.2337))", ".quasiquote?.2320 .expr.2328) (list (.the.2253 (core#quote list)) (list (.the.22",
")) (cdr .form.2335)))) (core#begin (.define-transformer.2270 (core#quote quasiqu", "53 (core#quote quote)) (.the.2253 (core#quote quasiquote))) (.qq.2323 (+ .depth.",
"ote) (core#lambda (.form.2340 .env.2341) (core#begin (core#define .quasiquote?.2", "2327 1) (car (cdr .expr.2328)))) (core#if (pair? .expr.2328) (list (.the.2253 (c",
"342 (core#lambda (.form.2346) (core#if (pair? .form.2346) (core#if (identifier? ", "ore#quote cons)) (.qq.2323 .depth.2327 (car .expr.2328)) (.qq.2323 .depth.2327 (",
"(car .form.2346)) (identifier=? (.the.2271 (core#quote quasiquote)) (make-identi", "cdr .expr.2328))) (core#if (vector? .expr.2328) (list (.the.2253 (core#quote lis",
"fier (car .form.2346) .env.2341)) #f) #f))) (core#begin (core#define .unquote?.2", "t->vector)) (.qq.2323 .depth.2327 (vector->list .expr.2328))) (list (.the.2253 (",
"343 (core#lambda (.form.2347) (core#if (pair? .form.2347) (core#if (identifier? ", "core#quote quote)) .expr.2328)))))))) ((core#lambda (.x.2329) (.qq.2323 1 .x.232",
"(car .form.2347)) (identifier=? (.the.2271 (core#quote unquote)) (make-identifie", "9)) (cadr .form.2318)))))))) (core#begin (.define-transformer.2252 (core#quote l",
"r (car .form.2347) .env.2341)) #f) #f))) (core#begin (core#define .unquote-splic", "et*) (core#lambda (.form.2330 .env.2331) ((core#lambda (.bindings.2332 .body.233",
"ing?.2344 (core#lambda (.form.2348) (core#if (pair? .form.2348) (core#if (pair? ", "3) (core#if (null? .bindings.2332) (cons (.the.2253 (core#quote let)) (cons (cor",
"(car .form.2348)) (core#if (identifier? (caar .form.2348)) (identifier=? (.the.2", "e#quote ()) .body.2333)) (cons (.the.2253 (core#quote let)) (cons (cons (cons (c",
"271 (core#quote unquote-splicing)) (make-identifier (caar .form.2348) .env.2341)", "ar (car .bindings.2332)) (cdr (car .bindings.2332))) (core#quote ())) (cons (con",
") #f) #f) #f))) (core#begin (core#define .qq.2345 (core#lambda (.depth.2349 .exp", "s (.the.2253 (core#quote let*)) (cons (cdr .bindings.2332) .body.2333)) (core#qu",
"r.2350) (core#if (.unquote?.2343 .expr.2350) (core#if (= .depth.2349 1) (cadr .e", "ote ())))))) (car (cdr .form.2330)) (cdr (cdr .form.2330))))) (core#begin (.defi",
"xpr.2350) (list (.the.2271 (core#quote list)) (list (.the.2271 (core#quote quote", "ne-transformer.2252 (core#quote letrec) (core#lambda (.form.2334 .env.2335) (con",
")) (.the.2271 (core#quote unquote))) (.qq.2345 (- .depth.2349 1) (car (cdr .expr", "s (.the.2253 (core#quote letrec*)) (cdr .form.2334)))) (core#begin (.define-tran",
".2350))))) (core#if (.unquote-splicing?.2344 .expr.2350) (core#if (= .depth.2349", "sformer.2252 (core#quote letrec*) (core#lambda (.form.2336 .env.2337) ((core#lam",
" 1) (list (.the.2271 (core#quote append)) (car (cdr (car .expr.2350))) (.qq.2345", "bda (.bindings.2338 .body.2339) ((core#lambda (.variables.2340 .initials.2341) (",
" .depth.2349 (cdr .expr.2350))) (list (.the.2271 (core#quote cons)) (list (.the.", "cons (.the.2253 (core#quote let)) (cons .variables.2340 (append .initials.2341 (",
"2271 (core#quote list)) (list (.the.2271 (core#quote quote)) (.the.2271 (core#qu", "append .body.2339 (core#quote ())))))) (map (core#lambda (.v.2342) (cons .v.2342",
"ote unquote-splicing))) (.qq.2345 (- .depth.2349 1) (car (cdr (car .expr.2350)))", " (cons (core#quote #undefined) (core#quote ())))) (map car .bindings.2338)) (map",
")) (.qq.2345 .depth.2349 (cdr .expr.2350)))) (core#if (.quasiquote?.2342 .expr.2", " (core#lambda (.v.2343) (cons (.the.2253 (core#quote set!)) (append .v.2343 (cor",
"350) (list (.the.2271 (core#quote list)) (list (.the.2271 (core#quote quote)) (.", "e#quote ())))) .bindings.2338))) (car (cdr .form.2336)) (cdr (cdr .form.2336))))",
"the.2271 (core#quote quasiquote))) (.qq.2345 (+ .depth.2349 1) (car (cdr .expr.2", ") (core#begin (.define-transformer.2252 (core#quote let-values) (core#lambda (.f",
"350)))) (core#if (pair? .expr.2350) (list (.the.2271 (core#quote cons)) (.qq.234", "orm.2344 .env.2345) (cons (.the.2253 (core#quote let*-values)) (append (cdr .for",
"5 .depth.2349 (car .expr.2350)) (.qq.2345 .depth.2349 (cdr .expr.2350))) (core#i", "m.2344) (core#quote ()))))) (core#begin (.define-transformer.2252 (core#quote le",
"f (vector? .expr.2350) (list (.the.2271 (core#quote list->vector)) (.qq.2345 .de", "t*-values) (core#lambda (.form.2346 .env.2347) ((core#lambda (.formals.2348 .bod",
"pth.2349 (vector->list .expr.2350))) (list (.the.2271 (core#quote quote)) .expr.", "y.2349) (core#if (null? .formals.2348) (cons (.the.2253 (core#quote let)) (cons ",
"2350)))))))) ((core#lambda (.x.2351) (.qq.2345 1 .x.2351)) (cadr .form.2340)))))", "(core#quote ()) (append .body.2349 (core#quote ())))) ((core#lambda (.formal.235",
"))) (core#begin (.define-transformer.2270 (core#quote let*) (core#lambda (.form.", "0) (cons (.the.2253 (core#quote call-with-values)) (cons (cons .the-lambda.2262 ",
"2352 .env.2353) ((core#lambda (.bindings.2354 .body.2355) (core#if (null? .bindi", "(cons (core#quote ()) (cdr .formal.2350))) (cons (cons (.the.2253 (core#quote la",
"ngs.2354) (cons (.the.2271 (core#quote let)) (cons (core#quote ()) .body.2355)) ", "mbda)) (cons (car .formal.2350) (cons (cons (.the.2253 (core#quote let*-values))",
"(cons (.the.2271 (core#quote let)) (cons (cons (cons (car (car .bindings.2354)) ", " (cons (cdr .formals.2348) .body.2349)) (core#quote ())))) (core#quote ()))))) (",
"(cdr (car .bindings.2354))) (core#quote ())) (cons (cons (.the.2271 (core#quote ", "car .formals.2348)))) (cadr .form.2346) (cddr .form.2346)))) (core#begin (.defin",
"let*)) (cons (cdr .bindings.2354) .body.2355)) (core#quote ())))))) (car (cdr .f", "e-transformer.2252 (core#quote define-values) (core#lambda (.form.2351 .env.2352",
"orm.2352)) (cdr (cdr .form.2352))))) (core#begin (.define-transformer.2270 (core", ") ((core#lambda (.formal.2353 .body.2354) ((core#lambda (.arguments.2355) (cons ",
"#quote letrec) (core#lambda (.form.2356 .env.2357) (cons (.the.2271 (core#quote ", ".the-begin.2263 (append ((core#lambda () (core#begin (core#define .loop.2356 (co",
"letrec*)) (cdr .form.2356)))) (core#begin (.define-transformer.2270 (core#quote ", "re#lambda (.formal.2357) (core#if (pair? .formal.2357) (cons (cons .the-define.2",
"letrec*) (core#lambda (.form.2358 .env.2359) ((core#lambda (.bindings.2360 .body", "261 (cons (car .formal.2357) (cons (core#quote #undefined) (core#quote ())))) (.",
".2361) ((core#lambda (.variables.2362 .initials.2363) (cons (.the.2271 (core#quo", "loop.2356 (cdr .formal.2357))) (core#if (identifier? .formal.2357) (cons (cons .",
"te let)) (cons .variables.2362 (append .initials.2363 (append .body.2361 (core#q", "the-define.2261 (cons .formal.2357 (cons (core#quote #undefined) (core#quote ())",
"uote ())))))) (map (core#lambda (.v.2364) (cons .v.2364 (cons (core#quote #undef", "))) (core#quote ())) (core#quote ()))))) (.loop.2356 .formal.2353)))) (cons (con",
"ined) (core#quote ())))) (map car .bindings.2360)) (map (core#lambda (.v.2365) (", "s (.the.2253 (core#quote call-with-values)) (cons (cons .the-lambda.2262 (cons (",
"cons (.the.2271 (core#quote set!)) (append .v.2365 (core#quote ())))) .bindings.", "core#quote ()) (append .body.2354 (core#quote ())))) (cons (cons .the-lambda.226",
"2360))) (car (cdr .form.2358)) (cdr (cdr .form.2358))))) (core#begin (.define-tr", "2 (cons .arguments.2355 (append ((core#lambda () (core#begin (core#define .loop.",
"ansformer.2270 (core#quote let-values) (core#lambda (.form.2366 .env.2367) (cons", "2358 (core#lambda (.formal.2359 .args.2360) (core#if (pair? .formal.2359) (cons ",
" (.the.2271 (core#quote let*-values)) (append (cdr .form.2366) (core#quote ())))", "(cons .the-set!.2265 (cons (car .formal.2359) (cons (cons (.the.2253 (core#quote",
")) (core#begin (.define-transformer.2270 (core#quote let*-values) (core#lambda (", " car)) (cons .args.2360 (core#quote ()))) (core#quote ())))) (.loop.2358 (cdr .f",
".form.2368 .env.2369) ((core#lambda (.formal.2370 .body.2371) (core#if (null? .f", "ormal.2359) (cons (.the.2253 (core#quote cdr)) (cons .args.2360 (core#quote ()))",
"ormal.2370) (cons (.the.2271 (core#quote let)) (cons (core#quote ()) (append .bo", "))) (core#if (identifier? .formal.2359) (cons (cons .the-set!.2265 (cons .formal",
"dy.2371 (core#quote ())))) (cons (.the.2271 (core#quote call-with-values)) (cons", ".2359 (cons .args.2360 (core#quote ())))) (core#quote ())) (core#quote ()))))) (",
" (cons .the-lambda.2280 (cons (core#quote ()) (append (cdr (car .formal.2370)) (", ".loop.2358 .formal.2353 .arguments.2355)))) (core#quote ())))) (core#quote ())))",
"core#quote ())))) (cons (cons (.the.2271 (core#quote lambda)) (cons (append (car", ") (core#quote ()))))) (make-identifier (core#quote arguments) .env.2352))) (cadr",
" (car .formal.2370)) (core#quote ())) (cons (cons (.the.2271 (core#quote let*-va", " .form.2351) (cddr .form.2351)))) (core#begin (.define-transformer.2252 (core#qu",
"lues)) (cons (append (cdr .formal.2370) (core#quote ())) (append .body.2371 (cor", "ote do) (core#lambda (.form.2361 .env.2362) ((core#lambda (.bindings.2363 .test.",
"e#quote ())))) (core#quote ())))) (core#quote ())))))) (car (cdr .form.2368)) (c", "2364 .cleanup.2365 .body.2366) ((core#lambda (.loop.2367) (cons (.the.2253 (core",
"dr (cdr .form.2368))))) (core#begin (.define-transformer.2270 (core#quote define", "#quote let)) (cons .loop.2367 (cons (map (core#lambda (.x.2368) (cons (car .x.23",
"-values) (core#lambda (.form.2372 .env.2373) ((core#lambda (.formal.2374 .body.2", "68) (cons (cadr .x.2368) (core#quote ())))) .bindings.2363) (cons (cons .the-if.",
"375) ((core#lambda (.arguments.2376) (cons .the-begin.2281 (append ((core#lambda", "2266 (cons .test.2364 (cons (cons .the-begin.2263 .cleanup.2365) (cons (cons .th",
" () (core#begin (core#define .loop.2377 (core#lambda (.formal.2378) (core#if (pa", "e-begin.2263 (append .body.2366 (cons (cons .loop.2367 (map (core#lambda (.x.236",
"ir? .formal.2378) (cons (cons .the-define.2279 (cons (car .formal.2378) (cons (c", "9) (core#if (null? (cdr (cdr .x.2369))) (car .x.2369) (car (cdr (cdr .x.2369))))",
"ore#quote #undefined) (core#quote ())))) (append (.loop.2377 (cdr .formal.2378))", ") .bindings.2363)) (core#quote ())))) (core#quote ()))))) (core#quote ())))))) (",
" (core#quote ()))) (core#if (identifier? .formal.2378) (cons (cons .the-define.2", "make-identifier (core#quote loop) .env.2362))) (car (cdr .form.2361)) (car (car ",
"279 (cons .formal.2378 (cons (core#quote #undefined) (core#quote ())))) (core#qu", "(cdr (cdr .form.2361)))) (cdr (car (cdr (cdr .form.2361)))) (cdr (cdr (cdr .form",
"ote ())) (core#quote ()))))) (.loop.2377 .formal.2374)))) (cons (cons (.the.2271", ".2361)))))) (core#begin (.define-transformer.2252 (core#quote when) (core#lambda",
" (core#quote call-with-values)) (cons (cons .the-lambda.2280 (cons (core#quote (", " (.form.2370 .env.2371) ((core#lambda (.test.2372 .body.2373) (cons .the-if.2266",
")) (append .body.2375 (core#quote ())))) (cons (cons .the-lambda.2280 (cons .arg", " (cons .test.2372 (cons (cons .the-begin.2263 (append .body.2373 (core#quote ())",
"uments.2376 (append ((core#lambda () (core#begin (core#define .loop.2379 (core#l", ")) (cons (core#quote #undefined) (core#quote ())))))) (car (cdr .form.2370)) (cd",
"ambda (.formal.2380 .args.2381) (core#if (pair? .formal.2380) (cons (cons .the-s", "r (cdr .form.2370))))) (core#begin (.define-transformer.2252 (core#quote unless)",
"et!.2283 (cons (car .formal.2380) (cons (cons (.the.2271 (core#quote car)) (cons", " (core#lambda (.form.2374 .env.2375) ((core#lambda (.test.2376 .body.2377) (cons",
" .args.2381 (core#quote ()))) (core#quote ())))) (append (.loop.2379 (cdr .forma", " .the-if.2266 (cons .test.2376 (cons (core#quote #undefined) (cons (cons .the-be",
"l.2380) (cons (.the.2271 (core#quote cdr)) (cons .args.2381 (core#quote ())))) (", "gin.2263 (append .body.2377 (core#quote ()))) (core#quote ())))))) (car (cdr .fo",
"core#quote ()))) (core#if (identifier? .formal.2380) (cons (cons .the-set!.2283 ", "rm.2374)) (cdr (cdr .form.2374))))) (core#begin (.define-transformer.2252 (core#",
"(cons .formal.2380 (cons .args.2381 (core#quote ())))) (core#quote ())) (core#qu", "quote case) (core#lambda (.form.2378 .env.2379) ((core#lambda (.key.2380 .clause",
"ote ()))))) (.loop.2379 .formal.2374 .arguments.2376)))) (core#quote ())))) (cor", "s.2381) ((core#lambda (.the-key.2382) (cons (.the.2253 (core#quote let)) (cons (",
"e#quote ())))) (core#quote ()))))) (make-identifier (core#quote arguments) .env.", "cons (cons .the-key.2382 (cons .key.2380 (core#quote ()))) (core#quote ())) (con",
"2373))) (car (cdr .form.2372)) (cdr (cdr .form.2372))))) (core#begin (.define-tr", "s ((core#lambda () (core#begin (core#define .loop.2383 (core#lambda (.clauses.23",
"ansformer.2270 (core#quote do) (core#lambda (.form.2382 .env.2383) ((core#lambda", "84) (core#if (null? .clauses.2384) #undefined ((core#lambda (.clause.2385) (cons",
" (.bindings.2384 .test.2385 .cleanup.2386 .body.2387) ((core#lambda (.loop.2388)", " .the-if.2266 (cons (core#if (core#if (identifier? (car .clause.2385)) (identifi",
" (cons (.the.2271 (core#quote let)) (cons .loop.2388 (cons (map (core#lambda (.x", "er=? (.the.2253 (core#quote else)) (make-identifier (car .clause.2385) .env.2379",
".2389) (cons (car .x.2389) (cons (cadr .x.2389) (core#quote ())))) .bindings.238", ")) #f) #t (cons (.the.2253 (core#quote or)) (append (map (core#lambda (.x.2386) ",
"4) (cons (cons .the-if.2284 (cons .test.2385 (cons (cons .the-begin.2281 .cleanu", "(cons (.the.2253 (core#quote eqv?)) (cons .the-key.2382 (cons (cons .the-quote.2",
"p.2386) (cons (cons .the-begin.2281 (append .body.2387 (cons (cons .loop.2388 (m", "264 (cons .x.2386 (core#quote ()))) (core#quote ()))))) (car .clause.2385)) (cor",
"ap (core#lambda (.x.2390) (core#if (null? (cdr (cdr .x.2390))) (car .x.2390) (ca", "e#quote ())))) (cons (core#if (core#if (identifier? (cadr .clause.2385)) (identi",
"r (cdr (cdr .x.2390))))) .bindings.2384)) (core#quote ())))) (core#quote ())))))", "fier=? (.the.2253 (core#quote =>)) (make-identifier (cadr .clause.2385) .env.237",
" (core#quote ())))))) (make-identifier (core#quote loop) .env.2383))) (car (cdr ", "9)) #f) (cons (car (cdr (cdr .clause.2385))) (cons .the-key.2382 (core#quote ())",
".form.2382)) (car (car (cdr (cdr .form.2382)))) (cdr (car (cdr (cdr .form.2382))", ")) (cons .the-begin.2263 (append (cdr .clause.2385) (core#quote ())))) (cons (.l",
")) (cdr (cdr (cdr .form.2382)))))) (core#begin (.define-transformer.2270 (core#q", "oop.2383 (cdr .clauses.2384)) (core#quote ())))))) (car .clauses.2384))))) (.loo",
"uote when) (core#lambda (.form.2391 .env.2392) ((core#lambda (.test.2393 .body.2", "p.2383 .clauses.2381)))) (core#quote ()))))) (make-identifier (core#quote key) .",
"394) (cons .the-if.2284 (cons .test.2393 (cons (cons .the-begin.2281 (append .bo", "env.2379))) (car (cdr .form.2378)) (cdr (cdr .form.2378))))) (.define-transforme",
"dy.2394 (core#quote ()))) (cons (core#quote #undefined) (core#quote ())))))) (ca", "r.2252 (core#quote parameterize) (core#lambda (.form.2387 .env.2388) ((core#lamb",
"r (cdr .form.2391)) (cdr (cdr .form.2391))))) (core#begin (.define-transformer.2", "da (.formal.2389 .body.2390) (cons (.the.2253 (core#quote with-dynamic-environme",
"270 (core#quote unless) (core#lambda (.form.2395 .env.2396) ((core#lambda (.test", "nt)) (cons (cons (.the.2253 (core#quote list)) (append (map (core#lambda (.x.239",
".2397 .body.2398) (cons .the-if.2284 (cons .test.2397 (cons (core#quote #undefin", "1) (cons (.the.2253 (core#quote cons)) (cons (car .x.2391) (cons (cadr .x.2391) ",
"ed) (cons (cons .the-begin.2281 (append .body.2398 (core#quote ()))) (core#quote", "(core#quote ()))))) .formal.2389) (core#quote ()))) (cons (cons .the-lambda.2262",
" ())))))) (car (cdr .form.2395)) (cdr (cdr .form.2395))))) (core#begin (.define-", " (cons (core#quote ()) (append .body.2390 (core#quote ())))) (core#quote ())))))",
"transformer.2270 (core#quote case) (core#lambda (.form.2399 .env.2400) ((core#la", " (car (cdr .form.2387)) (cdr (cdr .form.2387))))))))))))))))))))))))))))))))))))",
"mbda (.key.2401 .clauses.2402) ((core#lambda (.the-key.2403) (cons (.the.2271 (c", ")))))))))))))))",
"ore#quote let)) (cons (cons (cons .the-key.2403 (cons .key.2401 (core#quote ()))",
") (core#quote ())) (cons ((core#lambda () (core#begin (core#define .loop.2404 (c",
"ore#lambda (.clauses.2405) (core#if (null? .clauses.2405) #undefined ((core#lamb",
"da (.clause.2406) (cons .the-if.2284 (cons (core#if (core#if (identifier? (car .",
"clause.2406)) (identifier=? (.the.2271 (core#quote else)) (make-identifier (car ",
".clause.2406) .env.2400)) #f) #t (cons (.the.2271 (core#quote or)) (append (map ",
"(core#lambda (.x.2407) (cons (.the.2271 (core#quote eqv?)) (cons .the-key.2403 (",
"cons (cons .the-quote.2282 (cons .x.2407 (core#quote ()))) (core#quote ()))))) (",
"car .clause.2406)) (core#quote ())))) (cons (core#if (core#if (identifier? (cadr",
" .clause.2406)) (identifier=? (.the.2271 (core#quote =>)) (make-identifier (cadr",
" .clause.2406) .env.2400)) #f) (cons (car (cdr (cdr .clause.2406))) (cons .the-k",
"ey.2403 (core#quote ()))) (cons .the-begin.2281 (append (cdr .clause.2406) (core",
"#quote ())))) (cons (.loop.2404 (cdr .clauses.2405)) (core#quote ())))))) (car .",
"clauses.2405))))) (.loop.2404 .clauses.2402)))) (core#quote ()))))) (make-identi",
"fier (core#quote key) .env.2400))) (car (cdr .form.2399)) (cdr (cdr .form.2399))",
"))) (core#begin (.define-transformer.2270 (core#quote parameterize) (core#lambda",
" (.form.2408 .env.2409) ((core#lambda (.formal.2410 .body.2411) (cons (.the.2271",
" (core#quote with-dynamic-environment)) (cons (cons (.the.2271 (core#quote list)",
") (append (map (core#lambda (.x.2412) (cons (.the.2271 (core#quote cons)) (cons ",
"(car .x.2412) (cons (cadr .x.2412) (core#quote ()))))) .formal.2410) (core#quote",
" ()))) (cons (cons .the-lambda.2280 (cons (core#quote ()) (append .body.2411 (co",
"re#quote ())))) (core#quote ()))))) (car (cdr .form.2408)) (cdr (cdr .form.2408)",
")))) (core#begin (.define-transformer.2270 (core#quote syntax-quote) (core#lambd",
"a (.form.2413 .env.2414) ((core#lambda (.renames.2415) ((core#lambda (.rename.24",
"16 .walk.2417) (core#begin (core#set! .rename.2416 (core#lambda (.var.2418) ((co",
"re#lambda (.x.2419) (core#if .x.2419 (cadr .x.2419) (core#begin (core#set! .rena",
"mes.2415 (cons (cons .var.2418 (cons (make-identifier .var.2418 .env.2414) (cons",
" (cons (.the.2271 (core#quote make-identifier)) (cons (cons (core#quote quote) (",
"cons .var.2418 (core#quote ()))) (cons (cons (core#quote quote) (cons .env.2414 ",
"(core#quote ()))) (core#quote ())))) (core#quote ())))) .renames.2415)) (.rename",
".2416 .var.2418)))) (assq .var.2418 .renames.2415)))) (core#begin (core#set! .wa",
"lk.2417 (core#lambda (.f.2420 .form.2421) (core#if (identifier? .form.2421) (.f.",
"2420 .form.2421) (core#if (pair? .form.2421) (cons (.the.2271 (core#quote cons))",
" (cons (cons (core#quote walk) (cons (core#quote f) (cons (cons (core#quote car)",
" (cons (core#quote form) (core#quote ()))) (core#quote ())))) (cons (cons (core#",
"quote walk) (cons (core#quote f) (cons (cons (core#quote cdr) (cons (core#quote ",
"form) (core#quote ()))) (core#quote ())))) (core#quote ())))) (core#if (vector? ",
".form.2421) (cons (.the.2271 (core#quote list->vector)) (cons (cons (core#quote ",
"walk) (cons (core#quote f) (cons (cons (core#quote vector->list) (cons (core#quo",
"te form) (core#quote ()))) (core#quote ())))) (core#quote ()))) (cons (.the.2271",
" (core#quote quote)) (cons .form.2421 (core#quote ())))))))) ((core#lambda (.for",
"m.2422) (cons (.the.2271 (core#quote let)) (cons (map cdr .renames.2415) (cons .",
"form.2422 (core#quote ()))))) (.walk.2417 .rename.2416 (cadr .form.2413)))))) #u",
"ndefined #undefined)) (core#quote ())))) (core#begin (.define-transformer.2270 (",
"core#quote syntax-quasiquote) (core#lambda (.form.2423 .env.2424) ((core#lambda ",
"(.renames.2425) ((core#lambda (.rename.2426) (core#begin (core#set! .rename.2426",
" (core#lambda (.var.2431) ((core#lambda (.x.2432) (core#if .x.2432 (cadr .x.2432",
") (core#begin (core#set! .renames.2425 (cons (cons .var.2431 (cons (make-identif",
"ier .var.2431 .env.2424) (cons (cons (.the.2271 (core#quote make-identifier)) (c",
"ons (cons (core#quote quote) (cons .var.2431 (core#quote ()))) (cons (cons (core",
"#quote quote) (cons .env.2424 (core#quote ()))) (core#quote ())))) (core#quote (",
"))))) .renames.2425)) (.rename.2426 .var.2431)))) (assq .var.2431 .renames.2425)",
"))) (core#begin (core#define .syntax-quasiquote?.2427 (core#lambda (.form.2433) ",
"(core#if (pair? .form.2433) (core#if (identifier? (car .form.2433)) (identifier=",
"? (.the.2271 (core#quote syntax-quasiquote)) (make-identifier (car .form.2433) .",
"env.2424)) #f) #f))) (core#begin (core#define .syntax-unquote?.2428 (core#lambda",
" (.form.2434) (core#if (pair? .form.2434) (core#if (identifier? (car .form.2434)",
") (identifier=? (.the.2271 (core#quote syntax-unquote)) (make-identifier (car .f",
"orm.2434) .env.2424)) #f) #f))) (core#begin (core#define .syntax-unquote-splicin",
"g?.2429 (core#lambda (.form.2435) (core#if (pair? .form.2435) (core#if (pair? (c",
"ar .form.2435)) (core#if (identifier? (caar .form.2435)) (identifier=? (.the.227",
"1 (core#quote syntax-unquote-splicing)) (make-identifier (caar .form.2435) .env.",
"2424)) #f) #f) #f))) (core#begin (core#define .qq.2430 (core#lambda (.depth.2436",
" .expr.2437) (core#if (.syntax-unquote?.2428 .expr.2437) (core#if (= .depth.2436",
" 1) (car (cdr .expr.2437)) (list (.the.2271 (core#quote list)) (list (.the.2271 ",
"(core#quote quote)) (.the.2271 (core#quote syntax-unquote))) (.qq.2430 (- .depth",
".2436 1) (car (cdr .expr.2437))))) (core#if (.syntax-unquote-splicing?.2429 .exp",
"r.2437) (core#if (= .depth.2436 1) (list (.the.2271 (core#quote append)) (car (c",
"dr (car .expr.2437))) (.qq.2430 .depth.2436 (cdr .expr.2437))) (list (.the.2271 ",
"(core#quote cons)) (list (.the.2271 (core#quote list)) (list (.the.2271 (core#qu",
"ote quote)) (.the.2271 (core#quote syntax-unquote-splicing))) (.qq.2430 (- .dept",
"h.2436 1) (car (cdr (car .expr.2437))))) (.qq.2430 .depth.2436 (cdr .expr.2437))",
")) (core#if (.syntax-quasiquote?.2427 .expr.2437) (list (.the.2271 (core#quote l",
"ist)) (list (.the.2271 (core#quote quote)) (.the.2271 (core#quote quasiquote))) ",
"(.qq.2430 (+ .depth.2436 1) (car (cdr .expr.2437)))) (core#if (pair? .expr.2437)",
" (list (.the.2271 (core#quote cons)) (.qq.2430 .depth.2436 (car .expr.2437)) (.q",
"q.2430 .depth.2436 (cdr .expr.2437))) (core#if (vector? .expr.2437) (list (.the.",
"2271 (core#quote list->vector)) (.qq.2430 .depth.2436 (vector->list .expr.2437))",
") (core#if (identifier? .expr.2437) (.rename.2426 .expr.2437) (list (.the.2271 (",
"core#quote quote)) .expr.2437))))))))) ((core#lambda (.body.2438) (cons (.the.22",
"71 (core#quote let)) (cons (map cdr .renames.2425) (cons .body.2438 (core#quote ",
"()))))) (.qq.2430 1 (cadr .form.2423))))))))) #undefined)) (core#quote ())))) (c",
"ore#begin (.define-transformer.2270 (core#quote define-syntax) (core#lambda (.fo",
"rm.2439 .env.2440) ((core#lambda (.formal.2441 .body.2442) (core#if (pair? .form",
"al.2441) (cons (.the.2271 (core#quote define-syntax)) (cons (car .formal.2441) (",
"cons (cons .the-lambda.2280 (cons (cdr .formal.2441) (append .body.2442 (core#qu",
"ote ())))) (core#quote ())))) (cons .the-define-macro.2285 (cons .formal.2441 (c",
"ons (cons (.the.2271 (core#quote transformer)) (cons (cons .the-begin.2281 (appe",
"nd .body.2442 (core#quote ()))) (core#quote ()))) (core#quote ())))))) (car (cdr",
" .form.2439)) (cdr (cdr .form.2439))))) (core#begin (.define-transformer.2270 (c",
"ore#quote letrec-syntax) (core#lambda (.form.2443 .env.2444) ((core#lambda (.for",
"mal.2445 .body.2446) (cons (core#quote let) (cons (core#quote ()) (append (map (",
"core#lambda (.x.2447) (cons (.the.2271 (core#quote define-syntax)) (cons (car .x",
".2447) (cons (cadr .x.2447) (core#quote ()))))) .formal.2445) (append .body.2446",
" (core#quote ())))))) (car (cdr .form.2443)) (cdr (cdr .form.2443))))) (.define-",
"transformer.2270 (core#quote let-syntax) (core#lambda (.form.2448 .env.2449) (co",
"ns (.the.2271 (core#quote letrec-syntax)) (append (cdr .form.2448) (core#quote (",
")))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))",
}; };
#if PIC_USE_LIBRARY #if PIC_USE_LIBRARY
static const char boot_library_rom[][80] = { static const char boot_library_rom[][80] = {
"(core#begin (core#define mangle (core#lambda (.name.2450) (core#begin (core#if (", "(core#begin (core#define mangle (core#lambda (.name.2392) (core#begin (core#if (",
"null? .name.2450) (error \"library name should be a list of at least one symbols\"", "null? .name.2392) (error \"library name should be a list of at least one symbols\"",
" .name.2450) #undefined) (core#begin (core#define .->string.2451 (core#lambda (.", " .name.2392) #undefined) (core#begin (core#define .->string.2393 (core#lambda (.",
"n.2453) (core#if (symbol? .n.2453) ((core#lambda (.str.2454) (core#begin (string", "n.2395) (core#if (symbol? .n.2395) ((core#lambda (.str.2396) (core#begin (string",
"-for-each (core#lambda (.c.2455) (core#if ((core#lambda (.it.2456) (core#if .it.", "-for-each (core#lambda (.c.2397) (core#if ((core#lambda (.it.2398) (core#if .it.",
"2456 .it.2456 ((core#lambda (.it.2457) (core#if .it.2457 .it.2457 #f)) (char=? .", "2398 .it.2398 ((core#lambda (.it.2399) (core#if .it.2399 .it.2399 #f)) (char=? .",
"c.2455 #\\:)))) (char=? .c.2455 #\\.)) (error \"elements of library name may not co", "c.2397 #\\:)))) (char=? .c.2397 #\\.)) (error \"elements of library name may not co",
"ntain '.' or ':'\" .n.2453) #undefined)) .str.2454) .str.2454)) (symbol->string .", "ntain '.' or ':'\" .n.2395) #undefined)) .str.2396) .str.2396)) (symbol->string .",
"n.2453)) (core#if (core#if (number? .n.2453) (core#if (exact? .n.2453) (<= 0 .n.", "n.2395)) (core#if (core#if (number? .n.2395) (core#if (exact? .n.2395) (<= 0 .n.",
"2453) #f) #f) (number->string .n.2453) (error \"symbol or non-negative integer is", "2395) #f) #f) (number->string .n.2395) (error \"symbol or non-negative integer is",
" required\" .n.2453))))) (core#begin (core#define .join.2452 (core#lambda (.strs.", " required\" .n.2395))))) (core#begin (core#define .join.2394 (core#lambda (.strs.",
"2458 .delim.2459) ((core#lambda () (core#begin (core#define .loop.2460 (core#lam", "2400 .delim.2401) ((core#lambda () (core#begin (core#define .loop.2402 (core#lam",
"bda (.res.2461 .strs.2462) (core#if (null? .strs.2462) .res.2461 (.loop.2460 (st", "bda (.res.2403 .strs.2404) (core#if (null? .strs.2404) .res.2403 (.loop.2402 (st",
"ring-append .res.2461 .delim.2459 (car .strs.2462)) (cdr .strs.2462))))) (.loop.", "ring-append .res.2403 .delim.2401 (car .strs.2404)) (cdr .strs.2404))))) (.loop.",
"2460 (car .strs.2458) (cdr .strs.2458))))))) (core#if (symbol? .name.2450) .name", "2402 (car .strs.2400) (cdr .strs.2400))))))) (core#if (symbol? .name.2392) .name",
".2450 (string->symbol (.join.2452 (map .->string.2451 .name.2450) \".\")))))))) (c", ".2392 (string->symbol (.join.2394 (map .->string.2393 .name.2392) \".\")))))))) (c",
"ore#begin (core#define current-library (make-parameter (core#quote (picrin user)", "ore#begin (core#define current-library (make-parameter (core#quote (picrin user)",
") mangle)) (core#begin (core#define *libraries* (make-dictionary)) (core#begin (", ") mangle)) (core#begin (core#define *libraries* (make-dictionary)) (core#begin (",
"core#define find-library (core#lambda (.name.2463) (dictionary-has? *libraries* ", "core#define find-library (core#lambda (.name.2405) (dictionary-has? *libraries* ",
"(mangle .name.2463)))) (core#begin (core#define make-library (core#lambda (.name", "(mangle .name.2405)))) (core#begin (core#define make-library (core#lambda (.name",
".2464) ((core#lambda (.name.2465) ((core#lambda (.env.2466 .exports.2467) (core#", ".2406) ((core#lambda (.name.2407) ((core#lambda (.env.2408 .exports.2409) (core#",
"begin (set-identifier! (core#quote define-library) (core#quote define-library) .", "begin (set-identifier! (core#quote define-library) (core#quote define-library) .",
"env.2466) (core#begin (set-identifier! (core#quote import) (core#quote import) .", "env.2408) (core#begin (set-identifier! (core#quote import) (core#quote import) .",
"env.2466) (core#begin (set-identifier! (core#quote export) (core#quote export) .", "env.2408) (core#begin (set-identifier! (core#quote export) (core#quote export) .",
"env.2466) (core#begin (set-identifier! (core#quote cond-expand) (core#quote cond", "env.2408) (core#begin (set-identifier! (core#quote cond-expand) (core#quote cond",
"-expand) .env.2466) (dictionary-set! *libraries* .name.2465 (cons .env.2466 .exp", "-expand) .env.2408) (dictionary-set! *libraries* .name.2407 (cons .env.2408 .exp",
"orts.2467))))))) (make-environment (string->symbol (string-append (symbol->strin", "orts.2409))))))) (make-environment (string->symbol (string-append (symbol->strin",
"g .name.2465) \":\"))) (make-dictionary))) (mangle .name.2464)))) (core#begin (cor", "g .name.2407) \":\"))) (make-dictionary))) (mangle .name.2406)))) (core#begin (cor",
"e#define library-environment (core#lambda (.name.2468) (car (dictionary-ref *lib", "e#define library-environment (core#lambda (.name.2410) (car (dictionary-ref *lib",
"raries* (mangle .name.2468))))) (core#begin (core#define library-exports (core#l", "raries* (mangle .name.2410))))) (core#begin (core#define library-exports (core#l",
"ambda (.name.2469) (cdr (dictionary-ref *libraries* (mangle .name.2469))))) (cor", "ambda (.name.2411) (cdr (dictionary-ref *libraries* (mangle .name.2411))))) (cor",
"e#begin (core#define library-import (core#lambda (.name.2470 .sym.2471 .alias.24", "e#begin (core#define library-import (core#lambda (.name.2412 .sym.2413 .alias.24",
"72) ((core#lambda (.uid.2473) ((core#lambda (.env.2474) (set-identifier! .alias.", "14) ((core#lambda (.uid.2415) ((core#lambda (.env.2416) (set-identifier! .alias.",
"2472 .uid.2473 .env.2474)) (library-environment (current-library)))) (dictionary", "2414 .uid.2415 .env.2416)) (library-environment (current-library)))) (dictionary",
"-ref (library-exports .name.2470) .sym.2471)))) (core#begin (core#define library", "-ref (library-exports .name.2412) .sym.2413)))) (core#begin (core#define library",
"-export (core#lambda (.sym.2475 .alias.2476) ((core#lambda (.env.2477 .exports.2", "-export (core#lambda (.sym.2417 .alias.2418) ((core#lambda (.env.2419 .exports.2",
"478) (dictionary-set! .exports.2478 .alias.2476 (find-identifier .sym.2475 .env.", "420) (dictionary-set! .exports.2420 .alias.2418 (find-identifier .sym.2417 .env.",
"2477))) (library-environment (current-library)) (library-exports (current-librar", "2419))) (library-environment (current-library)) (library-exports (current-librar",
"y))))) (core#begin ((core#lambda (.define-transformer.2479) (core#begin (.define", "y))))) (core#begin ((core#lambda (.define-transformer.2421) (core#begin (.define",
"-transformer.2479 (core#quote define-library) (core#lambda (.form.2480 ._.2481) ", "-transformer.2421 (core#quote define-library) (core#lambda (.form.2422 ._.2423) ",
"((core#lambda (.name.2482 .body.2483) (core#begin ((core#lambda (.it.2484) (core", "((core#lambda (.name.2424 .body.2425) (core#begin ((core#lambda (.it.2426) (core",
"#if .it.2484 .it.2484 ((core#lambda (.it.2485) (core#if .it.2485 .it.2485 #f)) (", "#if .it.2426 .it.2426 ((core#lambda (.it.2427) (core#if .it.2427 .it.2427 #f)) (",
"make-library .name.2482)))) (find-library .name.2482)) (with-dynamic-environment", "make-library .name.2424)))) (find-library .name.2424)) (with-dynamic-environment",
" (list (cons current-library .name.2482)) (core#lambda () (for-each (core#lambda", " (list (cons current-library .name.2424)) (core#lambda () (for-each (core#lambda",
" (.expr.2486) (eval .expr.2486 .name.2482)) .body.2483))))) (cadr .form.2480) (c", " (.expr.2428) (eval .expr.2428 .name.2424)) .body.2425))))) (cadr .form.2422) (c",
"ddr .form.2480)))) (core#begin (.define-transformer.2479 (core#quote cond-expand", "ddr .form.2422)))) (core#begin (.define-transformer.2421 (core#quote cond-expand",
") (core#lambda (.form.2487 ._.2488) ((core#lambda (.test.2489) (core#begin (core", ") (core#lambda (.form.2429 ._.2430) ((core#lambda (.test.2431) (core#begin (core",
"#set! .test.2489 (core#lambda (.form.2490) ((core#lambda (.it.2491) (core#if .it", "#set! .test.2431 (core#lambda (.form.2432) ((core#lambda (.it.2433) (core#if .it",
".2491 .it.2491 ((core#lambda (.it.2492) (core#if .it.2492 .it.2492 ((core#lambda", ".2433 .it.2433 ((core#lambda (.it.2434) (core#if .it.2434 .it.2434 ((core#lambda",
" (.it.2493) (core#if .it.2493 .it.2493 #f)) (core#if (pair? .form.2490) ((core#l", " (.it.2435) (core#if .it.2435 .it.2435 #f)) (core#if (pair? .form.2432) ((core#l",
"ambda (.key.2494) (core#if ((core#lambda (.it.2495) (core#if .it.2495 .it.2495 #", "ambda (.key.2436) (core#if ((core#lambda (.it.2437) (core#if .it.2437 .it.2437 #",
"f)) (eqv? .key.2494 (core#quote library))) (find-library (cadr .form.2490)) (cor", "f)) (eqv? .key.2436 (core#quote library))) (find-library (cadr .form.2432)) (cor",
"e#if ((core#lambda (.it.2496) (core#if .it.2496 .it.2496 #f)) (eqv? .key.2494 (c", "e#if ((core#lambda (.it.2438) (core#if .it.2438 .it.2438 #f)) (eqv? .key.2436 (c",
"ore#quote not))) (not (.test.2489 (cadr .form.2490))) (core#if ((core#lambda (.i", "ore#quote not))) (not (.test.2431 (cadr .form.2432))) (core#if ((core#lambda (.i",
"t.2497) (core#if .it.2497 .it.2497 #f)) (eqv? .key.2494 (core#quote and))) ((cor", "t.2439) (core#if .it.2439 .it.2439 #f)) (eqv? .key.2436 (core#quote and))) ((cor",
"e#lambda () (core#begin (core#define .loop.2498 (core#lambda (.form.2499) ((core", "e#lambda () (core#begin (core#define .loop.2440 (core#lambda (.form.2441) ((core",
"#lambda (.it.2500) (core#if .it.2500 .it.2500 ((core#lambda (.it.2501) (core#if ", "#lambda (.it.2442) (core#if .it.2442 .it.2442 ((core#lambda (.it.2443) (core#if ",
".it.2501 .it.2501 #f)) (core#if (.test.2489 (car .form.2499)) (.loop.2498 (cdr .", ".it.2443 .it.2443 #f)) (core#if (.test.2431 (car .form.2441)) (.loop.2440 (cdr .",
"form.2499)) #f)))) (null? .form.2499)))) (.loop.2498 (cdr .form.2490))))) (core#", "form.2441)) #f)))) (null? .form.2441)))) (.loop.2440 (cdr .form.2432))))) (core#",
"if ((core#lambda (.it.2502) (core#if .it.2502 .it.2502 #f)) (eqv? .key.2494 (cor", "if ((core#lambda (.it.2444) (core#if .it.2444 .it.2444 #f)) (eqv? .key.2436 (cor",
"e#quote or))) ((core#lambda () (core#begin (core#define .loop.2503 (core#lambda ", "e#quote or))) ((core#lambda () (core#begin (core#define .loop.2445 (core#lambda ",
"(.form.2504) (core#if (pair? .form.2504) ((core#lambda (.it.2505) (core#if .it.2", "(.form.2446) (core#if (pair? .form.2446) ((core#lambda (.it.2447) (core#if .it.2",
"505 .it.2505 ((core#lambda (.it.2506) (core#if .it.2506 .it.2506 #f)) (.loop.250", "447 .it.2447 ((core#lambda (.it.2448) (core#if .it.2448 .it.2448 #f)) (.loop.244",
"3 (cdr .form.2504))))) (.test.2489 (car .form.2504))) #f))) (.loop.2503 (cdr .fo", "5 (cdr .form.2446))))) (.test.2431 (car .form.2446))) #f))) (.loop.2445 (cdr .fo",
"rm.2490))))) (core#if #t #f #undefined)))))) (car .form.2490)) #f)))) (core#if (", "rm.2432))))) (core#if #t #f #undefined)))))) (car .form.2432)) #f)))) (core#if (",
"symbol? .form.2490) (memq .form.2490 (features)) #f)))) (eq? .form.2490 (core#qu", "symbol? .form.2432) (memq .form.2432 (features)) #f)))) (eq? .form.2432 (core#qu",
"ote else))))) ((core#lambda () (core#begin (core#define .loop.2507 (core#lambda ", "ote else))))) ((core#lambda () (core#begin (core#define .loop.2449 (core#lambda ",
"(.clauses.2508) (core#if (null? .clauses.2508) #undefined (core#if (.test.2489 (", "(.clauses.2450) (core#if (null? .clauses.2450) #undefined (core#if (.test.2431 (",
"caar .clauses.2508)) (cons (make-identifier (core#quote begin) default-environme", "caar .clauses.2450)) (cons (make-identifier (core#quote begin) default-environme",
"nt) (append (cdar .clauses.2508) (core#quote ()))) (.loop.2507 (cdr .clauses.250", "nt) (append (cdar .clauses.2450) (core#quote ()))) (.loop.2449 (cdr .clauses.245",
"8)))))) (.loop.2507 (cdr .form.2487))))))) #undefined))) (core#begin (.define-tr", "0)))))) (.loop.2449 (cdr .form.2429))))))) #undefined))) (core#begin (.define-tr",
"ansformer.2479 (core#quote import) (core#lambda (.form.2509 ._.2510) ((core#lamb", "ansformer.2421 (core#quote import) (core#lambda (.form.2451 ._.2452) ((core#lamb",
"da (.caddr.2511 .prefix.2512 .getlib.2513) ((core#lambda (.extract.2514 .collect", "da (.caddr.2453 .prefix.2454 .getlib.2455) ((core#lambda (.extract.2456 .collect",
".2515) (core#begin (core#set! .extract.2514 (core#lambda (.spec.2516) ((core#lam", ".2457) (core#begin (core#set! .extract.2456 (core#lambda (.spec.2458) ((core#lam",
"bda (.key.2517) (core#if ((core#lambda (.it.2518) (core#if .it.2518 .it.2518 ((c", "bda (.key.2459) (core#if ((core#lambda (.it.2460) (core#if .it.2460 .it.2460 ((c",
"ore#lambda (.it.2519) (core#if .it.2519 .it.2519 ((core#lambda (.it.2520) (core#", "ore#lambda (.it.2461) (core#if .it.2461 .it.2461 ((core#lambda (.it.2462) (core#",
"if .it.2520 .it.2520 ((core#lambda (.it.2521) (core#if .it.2521 .it.2521 #f)) (e", "if .it.2462 .it.2462 ((core#lambda (.it.2463) (core#if .it.2463 .it.2463 #f)) (e",
"qv? .key.2517 (core#quote except))))) (eqv? .key.2517 (core#quote prefix))))) (e", "qv? .key.2459 (core#quote except))))) (eqv? .key.2459 (core#quote prefix))))) (e",
"qv? .key.2517 (core#quote rename))))) (eqv? .key.2517 (core#quote only))) (.extr", "qv? .key.2459 (core#quote rename))))) (eqv? .key.2459 (core#quote only))) (.extr",
"act.2514 (cadr .spec.2516)) (core#if #t (.getlib.2513 .spec.2516) #undefined))) ", "act.2456 (cadr .spec.2458)) (core#if #t (.getlib.2455 .spec.2458) #undefined))) ",
"(car .spec.2516)))) (core#begin (core#set! .collect.2515 (core#lambda (.spec.252", "(car .spec.2458)))) (core#begin (core#set! .collect.2457 (core#lambda (.spec.246",
"2) ((core#lambda (.key.2523) (core#if ((core#lambda (.it.2524) (core#if .it.2524", "4) ((core#lambda (.key.2465) (core#if ((core#lambda (.it.2466) (core#if .it.2466",
" .it.2524 #f)) (eqv? .key.2523 (core#quote only))) ((core#lambda (.alist.2525) (", " .it.2466 #f)) (eqv? .key.2465 (core#quote only))) ((core#lambda (.alist.2467) (",
"map (core#lambda (.var.2526) (assq .var.2526 .alist.2525)) (cddr .spec.2522))) (", "map (core#lambda (.var.2468) (assq .var.2468 .alist.2467)) (cddr .spec.2464))) (",
".collect.2515 (cadr .spec.2522))) (core#if ((core#lambda (.it.2527) (core#if .it", ".collect.2457 (cadr .spec.2464))) (core#if ((core#lambda (.it.2469) (core#if .it",
".2527 .it.2527 #f)) (eqv? .key.2523 (core#quote rename))) ((core#lambda (.alist.", ".2469 .it.2469 #f)) (eqv? .key.2465 (core#quote rename))) ((core#lambda (.alist.",
"2528 .renames.2529) (map (core#lambda (.s.2530) ((core#lambda (.it.2531) (core#i", "2470 .renames.2471) (map (core#lambda (.s.2472) ((core#lambda (.it.2473) (core#i",
"f .it.2531 .it.2531 ((core#lambda (.it.2532) (core#if .it.2532 .it.2532 #f)) .s.", "f .it.2473 .it.2473 ((core#lambda (.it.2474) (core#if .it.2474 .it.2474 #f)) .s.",
"2530))) (assq (car .s.2530) .renames.2529))) .alist.2528)) (.collect.2515 (cadr ", "2472))) (assq (car .s.2472) .renames.2471))) .alist.2470)) (.collect.2457 (cadr ",
".spec.2522)) (map (core#lambda (.x.2533) (cons (car .x.2533) (cadr .x.2533))) (c", ".spec.2464)) (map (core#lambda (.x.2475) (cons (car .x.2475) (cadr .x.2475))) (c",
"ddr .spec.2522))) (core#if ((core#lambda (.it.2534) (core#if .it.2534 .it.2534 #", "ddr .spec.2464))) (core#if ((core#lambda (.it.2476) (core#if .it.2476 .it.2476 #",
"f)) (eqv? .key.2523 (core#quote prefix))) ((core#lambda (.alist.2535) (map (core", "f)) (eqv? .key.2465 (core#quote prefix))) ((core#lambda (.alist.2477) (map (core",
"#lambda (.s.2536) (cons (.prefix.2512 (.caddr.2511 .spec.2522) (car .s.2536)) (c", "#lambda (.s.2478) (cons (.prefix.2454 (.caddr.2453 .spec.2464) (car .s.2478)) (c",
"dr .s.2536))) .alist.2535)) (.collect.2515 (cadr .spec.2522))) (core#if ((core#l", "dr .s.2478))) .alist.2477)) (.collect.2457 (cadr .spec.2464))) (core#if ((core#l",
"ambda (.it.2537) (core#if .it.2537 .it.2537 #f)) (eqv? .key.2523 (core#quote exc", "ambda (.it.2479) (core#if .it.2479 .it.2479 #f)) (eqv? .key.2465 (core#quote exc",
"ept))) ((core#lambda (.alist.2538) ((core#lambda () (core#begin (core#define .lo", "ept))) ((core#lambda (.alist.2480) ((core#lambda () (core#begin (core#define .lo",
"op.2539 (core#lambda (.alist.2540) (core#if (null? .alist.2540) (core#quote ()) ", "op.2481 (core#lambda (.alist.2482) (core#if (null? .alist.2482) (core#quote ()) ",
"(core#if (memq (caar .alist.2540) (cddr .spec.2522)) (.loop.2539 (cdr .alist.254", "(core#if (memq (caar .alist.2482) (cddr .spec.2464)) (.loop.2481 (cdr .alist.248",
"0)) (cons (car .alist.2540) (.loop.2539 (cdr .alist.2540))))))) (.loop.2539 .ali", "2)) (cons (car .alist.2482) (.loop.2481 (cdr .alist.2482))))))) (.loop.2481 .ali",
"st.2538))))) (.collect.2515 (cadr .spec.2522))) (core#if #t (dictionary-map (cor", "st.2480))))) (.collect.2457 (cadr .spec.2464))) (core#if #t (dictionary-map (cor",
"e#lambda (.x.2541) (cons .x.2541 .x.2541)) (library-exports (.getlib.2513 .spec.", "e#lambda (.x.2483) (cons .x.2483 .x.2483)) (library-exports (.getlib.2455 .spec.",
"2522))) #undefined)))))) (car .spec.2522)))) ((core#lambda (.import.2542) (core#", "2464))) #undefined)))))) (car .spec.2464)))) ((core#lambda (.import.2484) (core#",
"begin (core#set! .import.2542 (core#lambda (.spec.2543) ((core#lambda (.lib.2544", "begin (core#set! .import.2484 (core#lambda (.spec.2485) ((core#lambda (.lib.2486",
" .alist.2545) (for-each (core#lambda (.slot.2546) (library-import .lib.2544 (cdr", " .alist.2487) (for-each (core#lambda (.slot.2488) (library-import .lib.2486 (cdr",
" .slot.2546) (car .slot.2546))) .alist.2545)) (.extract.2514 .spec.2543) (.colle", " .slot.2488) (car .slot.2488))) .alist.2487)) (.extract.2456 .spec.2485) (.colle",
"ct.2515 .spec.2543)))) (for-each .import.2542 (cdr .form.2509)))) #undefined))))", "ct.2457 .spec.2485)))) (for-each .import.2484 (cdr .form.2451)))) #undefined))))",
" #undefined #undefined)) (core#lambda (.x.2547) (car (cdr (cdr .x.2547)))) (core", " #undefined #undefined)) (core#lambda (.x.2489) (car (cdr (cdr .x.2489)))) (core",
"#lambda (.prefix.2548 .symbol.2549) (string->symbol (string-append (symbol->stri", "#lambda (.prefix.2490 .symbol.2491) (string->symbol (string-append (symbol->stri",
"ng .prefix.2548) (symbol->string .symbol.2549)))) (core#lambda (.name.2550) (cor", "ng .prefix.2490) (symbol->string .symbol.2491)))) (core#lambda (.name.2492) (cor",
"e#if (find-library .name.2550) .name.2550 (error \"library not found\" .name.2550)", "e#if (find-library .name.2492) .name.2492 (error \"library not found\" .name.2492)",
"))))) (.define-transformer.2479 (core#quote export) (core#lambda (.form.2551 ._.", "))))) (.define-transformer.2421 (core#quote export) (core#lambda (.form.2493 ._.",
"2552) ((core#lambda (.collect.2553 .export.2554) (core#begin (core#set! .collect", "2494) ((core#lambda (.collect.2495 .export.2496) (core#begin (core#set! .collect",
".2553 (core#lambda (.spec.2555) (core#if (symbol? .spec.2555) (cons .spec.2555 .", ".2495 (core#lambda (.spec.2497) (core#if (symbol? .spec.2497) (cons .spec.2497 .",
"spec.2555) (core#if (core#if (list? .spec.2555) (core#if (= (length .spec.2555) ", "spec.2497) (core#if (core#if (list? .spec.2497) (core#if (= (length .spec.2497) ",
"3) (eq? (car .spec.2555) (core#quote rename)) #f) #f) (cons (list-ref .spec.2555", "3) (eq? (car .spec.2497) (core#quote rename)) #f) #f) (cons (list-ref .spec.2497",
" 1) (list-ref .spec.2555 2)) (error \"malformed export\"))))) (core#begin (core#se", " 1) (list-ref .spec.2497 2)) (error \"malformed export\"))))) (core#begin (core#se",
"t! .export.2554 (core#lambda (.spec.2556) ((core#lambda (.slot.2557) (library-ex", "t! .export.2496 (core#lambda (.spec.2498) ((core#lambda (.slot.2499) (library-ex",
"port (car .slot.2557) (cdr .slot.2557))) (.collect.2553 .spec.2556)))) (for-each", "port (car .slot.2499) (cdr .slot.2499))) (.collect.2495 .spec.2498)))) (for-each",
" .export.2554 (cdr .form.2551))))) #undefined #undefined))))))) (core#lambda (.n", " .export.2496 (cdr .form.2493))))) #undefined #undefined))))))) (core#lambda (.n",
"ame.2558 .macro.2559) (add-macro! .name.2558 .macro.2559))) ((core#lambda () (co", "ame.2500 .macro.2501) (add-macro! .name.2500 .macro.2501))) ((core#lambda () (co",
"re#begin (make-library (core#quote (picrin base))) (core#begin (set-car! (dictio", "re#begin (make-library (core#quote (picrin base))) (core#begin (set-car! (dictio",
"nary-ref *libraries* (mangle (core#quote (picrin base)))) default-environment) (", "nary-ref *libraries* (mangle (core#quote (picrin base)))) default-environment) (",
"core#begin ((core#lambda (.export-keywords.2560) (core#begin (.export-keywords.2", "core#begin ((core#lambda (.export-keywords.2502) (core#begin (.export-keywords.2",
"560 (core#quote (define lambda quote set! if begin define-macro let let* letrec ", "502 (core#quote (define lambda quote set! if begin define-macro let let* letrec ",
"letrec* let-values let*-values define-values quasiquote unquote unquote-splicing", "letrec* let-values let*-values define-values quasiquote unquote unquote-splicing",
" and or cond case else => do when unless parameterize define-syntax syntax-quote", " and or cond case else => do when unless parameterize))) (core#begin (.export-ke",
" syntax-unquote syntax-quasiquote syntax-unquote-splicing let-syntax letrec-synt", "ywords.2502 (core#quote (features eq? eqv? equal? not boolean? boolean=? pair? c",
"ax syntax-error))) (core#begin (.export-keywords.2560 (core#quote (features eq? ", "ons car cdr null? set-car! set-cdr! caar cadr cdar cddr list? make-list list len",
"eqv? equal? not boolean? boolean=? pair? cons car cdr null? set-car! set-cdr! ca", "gth append reverse list-tail list-ref list-set! list-copy map for-each memq memv",
"ar cadr cdar cddr list? make-list list length append reverse list-tail list-ref ", " member assq assv assoc current-input-port current-output-port current-error-por",
"list-set! list-copy map for-each memq memv member assq assv assoc current-input-", "t port? input-port? output-port? port-open? close-port eof-object? eof-object re",
"port current-output-port current-error-port port? input-port? output-port? port-", "ad-u8 peek-u8 read-bytevector! write-u8 write-bytevector flush-output-port open-",
"open? close-port eof-object? eof-object read-u8 peek-u8 read-bytevector! write-u", "input-bytevector open-output-bytevector get-output-bytevector number? exact? ine",
"8 write-bytevector flush-output-port open-input-bytevector open-output-bytevecto", "xact? inexact exact = < > <= >= + - * / number->string string->number procedure?",
"r get-output-bytevector number? exact? inexact? inexact exact = < > <= >= + - * ", " apply symbol? symbol=? symbol->string string->symbol make-identifier identifier",
"/ number->string string->number procedure? apply symbol? symbol=? symbol->string", "? identifier=? identifier-base identifier-environment vector? vector make-vector",
" string->symbol make-identifier identifier? identifier=? identifier-base identif", " vector-length vector-ref vector-set! vector-copy! vector-copy vector-append vec",
"ier-environment vector? vector make-vector vector-length vector-ref vector-set! ", "tor-fill! vector-map vector-for-each list->vector vector->list string->vector ve",
"vector-copy! vector-copy vector-append vector-fill! vector-map vector-for-each l", "ctor->string bytevector? bytevector make-bytevector bytevector-length bytevector",
"ist->vector vector->list string->vector vector->string bytevector? bytevector ma", "-u8-ref bytevector-u8-set! bytevector-copy! bytevector-copy bytevector-append by",
"ke-bytevector bytevector-length bytevector-u8-ref bytevector-u8-set! bytevector-", "tevector->list list->bytevector call-with-current-continuation call/cc values ca",
"copy! bytevector-copy bytevector-append bytevector->list list->bytevector call-w", "ll-with-values char? char->integer integer->char char=? char<? char>? char<=? ch",
"ith-current-continuation call/cc values call-with-values char? char->integer int", "ar>=? current-exception-handlers with-exception-handler raise raise-continuable ",
"eger->char char=? char<? char>? char<=? char>=? current-exception-handlers with-", "error error-object? error-object-message error-object-irritants error-object-typ",
"exception-handler raise raise-continuable error error-object? error-object-messa", "e string? string make-string string-length string-ref string-set! string-copy st",
"ge error-object-irritants error-object-type string? string make-string string-le", "ring-copy! string-fill! string-append string-map string-for-each list->string st",
"ngth string-ref string-set! string-copy string-copy! string-fill! string-append ", "ring->list string=? string<? string>? string<=? string>=? make-parameter with-dy",
"string-map string-for-each list->string string->list string=? string<? string>? ", "namic-environment read make-dictionary dictionary? dictionary dictionary-has? di",
"string<=? string>=? make-parameter with-dynamic-environment read make-dictionary", "ctionary-ref dictionary-set! dictionary-delete! dictionary-size dictionary-map d",
" dictionary? dictionary dictionary-has? dictionary-ref dictionary-set! dictionar", "ictionary-for-each dictionary->alist alist->dictionary dictionary->plist plist->",
"y-delete! dictionary-size dictionary-map dictionary-for-each dictionary->alist a", "dictionary make-record record? record-type record-datum default-environment make",
"list->dictionary dictionary->plist plist->dictionary make-record record? record-", "-environment find-identifier set-identifier! eval compile add-macro! make-epheme",
"type record-datum default-environment make-environment find-identifier set-ident", "ron-table write write-simple write-shared display))) (.export-keywords.2502 (cor",
"ifier! eval compile add-macro! make-ephemeron-table write write-simple write-sha", "e#quote (find-library make-library current-library)))))) (core#lambda (.keywords",
"red display))) (.export-keywords.2560 (core#quote (find-library make-library cur", ".2503) ((core#lambda (.env.2504 .exports.2505) (for-each (core#lambda (.keyword.",
"rent-library)))))) (core#lambda (.keywords.2561) ((core#lambda (.env.2562 .expor", "2506) (dictionary-set! .exports.2505 .keyword.2506 .keyword.2506)) .keywords.250",
"ts.2563) (for-each (core#lambda (.keyword.2564) (dictionary-set! .exports.2563 .", "3)) (library-environment (core#quote (picrin base))) (library-exports (core#quot",
"keyword.2564 .keyword.2564)) .keywords.2561)) (library-environment (core#quote (", "e (picrin base)))))) (core#begin (core#set! eval ((core#lambda (.e.2507) (core#l",
"picrin base))) (library-exports (core#quote (picrin base)))))) (core#begin (core", "ambda (.expr.2508 . .lib.2509) ((core#lambda (.lib.2510) (.e.2507 .expr.2508 (li",
"#set! eval ((core#lambda (.e.2565) (core#lambda (.expr.2566 . .lib.2567) ((core#", "brary-environment .lib.2510))) (core#if (null? .lib.2509) (current-library) (car",
"lambda (.lib.2568) (.e.2565 .expr.2566 (library-environment .lib.2568))) (core#i", " .lib.2509))))) eval)) (core#begin (make-library (core#quote (picrin user))) (cu",
"f (null? .lib.2567) (current-library) (car .lib.2567))))) eval)) (core#begin (ma", "rrent-library (core#quote (picrin user))))))))))))))))))))",
"ke-library (core#quote (picrin user))) (current-library (core#quote (picrin user",
"))))))))))))))))))))",
}; };
#endif #endif

View File

@ -1,30 +1,4 @@
(begin (let ()
;; FIXME
(define (transformer f)
(lambda (form env)
(let ((ephemeron1 (make-ephemeron-table))
(ephemeron2 (make-ephemeron-table)))
(letrec
((wrap (lambda (var1)
(or (ephemeron1 var1)
(let ((var2 (make-identifier var1 env)))
(ephemeron1 var1 var2)
(ephemeron2 var2 var1)
var2))))
(unwrap (lambda (var2)
(or (ephemeron2 var2)
var2)))
(walk (lambda (f form)
(cond
((identifier? form)
(f form))
((pair? form)
(cons (walk f (car form)) (walk f (cdr form))))
(else
form)))))
(let ((form (cdr form)))
(walk unwrap (apply f (walk wrap form))))))))
(let ()
(define (define-transformer name transformer) (define (define-transformer name transformer)
(add-macro! name transformer)) (add-macro! name transformer))
@ -114,10 +88,6 @@
(error "malformed define-macro" form)))) (error "malformed define-macro" form))))
(define-transformer 'syntax-error
(lambda (form _)
(apply error (cdr form))))
(define-macro define-auxiliary-syntax (define-macro define-auxiliary-syntax
(lambda (form _) (lambda (form _)
`(define-transformer ',(cadr form) `(define-transformer ',(cadr form)
@ -128,8 +98,6 @@
(define-auxiliary-syntax =>) (define-auxiliary-syntax =>)
(define-auxiliary-syntax unquote) (define-auxiliary-syntax unquote)
(define-auxiliary-syntax unquote-splicing) (define-auxiliary-syntax unquote-splicing)
(define-auxiliary-syntax syntax-unquote)
(define-auxiliary-syntax syntax-unquote-splicing)
(define-transformer 'let (define-transformer 'let
(lambda (form env) (lambda (form env)
@ -268,24 +236,24 @@
(define-transformer 'let*-values (define-transformer 'let*-values
(lambda (form env) (lambda (form env)
(let ((formal (car (cdr form))) (let ((formals (cadr form))
(body (cdr (cdr form)))) (body (cddr form)))
(if (null? formal) (if (null? formals)
`(,(the 'let) () ,@body) `(,(the 'let) () ,@body)
`(,(the 'call-with-values) (,the-lambda () ,@(cdr (car formal))) (let ((formal (car formals)))
(,(the 'lambda) (,@(car (car formal))) `(,(the 'call-with-values) (,the-lambda () . ,(cdr formal))
(,(the 'let*-values) (,@(cdr formal)) (,(the 'lambda) ,(car formal)
,@body))))))) (,(the 'let*-values) ,(cdr formals) . ,body))))))))
(define-transformer 'define-values (define-transformer 'define-values
(lambda (form env) (lambda (form env)
(let ((formal (car (cdr form))) (let ((formal (cadr form))
(body (cdr (cdr form)))) (body (cddr form)))
(let ((arguments (make-identifier 'arguments env))) (let ((arguments (make-identifier 'arguments env)))
`(,the-begin `(,the-begin
,@(let loop ((formal formal)) ,@(let loop ((formal formal))
(if (pair? formal) (if (pair? formal)
`((,the-define ,(car formal) #undefined) ,@(loop (cdr formal))) `((,the-define ,(car formal) #undefined) . ,(loop (cdr formal)))
(if (identifier? formal) (if (identifier? formal)
`((,the-define ,formal #undefined)) `((,the-define ,formal #undefined))
'()))) '())))
@ -294,7 +262,7 @@
,arguments ,arguments
,@(let loop ((formal formal) (args arguments)) ,@(let loop ((formal formal) (args arguments))
(if (pair? formal) (if (pair? formal)
`((,the-set! ,(car formal) (,(the 'car) ,args)) ,@(loop (cdr formal) `(,(the 'cdr) ,args))) `((,the-set! ,(car formal) (,(the 'car) ,args)) . ,(loop (cdr formal) `(,(the 'cdr) ,args)))
(if (identifier? formal) (if (identifier? formal)
`((,the-set! ,formal ,args)) `((,the-set! ,formal ,args))
'())))))))))) '()))))))))))
@ -359,125 +327,4 @@
(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 'syntax-quote
(lambda (form env)
(let ((renames '()))
(letrec
((rename (lambda (var)
(let ((x (assq var renames)))
(if x
(cadr x)
(begin
(set! renames `((,var ,(make-identifier var env) (,(the 'make-identifier) ',var ',env)) . ,renames))
(rename var))))))
(walk (lambda (f form)
(cond
((identifier? form)
(f form))
((pair? form)
`(,(the 'cons) (walk f (car form)) (walk f (cdr form))))
((vector? form)
`(,(the 'list->vector) (walk f (vector->list form))))
(else
`(,(the 'quote) ,form))))))
(let ((form (walk rename (cadr form))))
`(,(the 'let)
,(map cdr renames)
,form))))))
(define-transformer 'syntax-quasiquote
(lambda (form env)
(let ((renames '()))
(letrec
((rename (lambda (var)
(let ((x (assq var renames)))
(if x
(cadr x)
(begin
(set! renames `((,var ,(make-identifier var env) (,(the 'make-identifier) ',var ',env)) . ,renames))
(rename var)))))))
(define (syntax-quasiquote? form)
(and (pair? form)
(identifier? (car form))
(identifier=? (the 'syntax-quasiquote) (make-identifier (car form) env))))
(define (syntax-unquote? form)
(and (pair? form)
(identifier? (car form))
(identifier=? (the 'syntax-unquote) (make-identifier (car form) env))))
(define (syntax-unquote-splicing? form)
(and (pair? form)
(pair? (car form))
(identifier? (caar form))
(identifier=? (the 'syntax-unquote-splicing) (make-identifier (caar form) env))))
(define (qq depth expr)
(cond
;; syntax-unquote
((syntax-unquote? expr)
(if (= depth 1)
(car (cdr expr))
(list (the 'list)
(list (the 'quote) (the 'syntax-unquote))
(qq (- depth 1) (car (cdr expr))))))
;; syntax-unquote-splicing
((syntax-unquote-splicing? expr)
(if (= depth 1)
(list (the 'append)
(car (cdr (car expr)))
(qq depth (cdr expr)))
(list (the 'cons)
(list (the 'list)
(list (the 'quote) (the 'syntax-unquote-splicing))
(qq (- depth 1) (car (cdr (car expr)))))
(qq depth (cdr expr)))))
;; syntax-quasiquote
((syntax-quasiquote? expr)
(list (the 'list)
(list (the 'quote) (the 'quasiquote))
(qq (+ depth 1) (car (cdr expr)))))
;; list
((pair? expr)
(list (the 'cons)
(qq depth (car expr))
(qq depth (cdr expr))))
;; vector
((vector? expr)
(list (the 'list->vector) (qq depth (vector->list expr))))
;; identifier
((identifier? expr)
(rename expr))
;; simple datum
(else
(list (the 'quote) expr))))
(let ((body (qq 1 (cadr form))))
`(,(the 'let)
,(map cdr renames)
,body))))))
(define-transformer 'define-syntax
(lambda (form env)
(let ((formal (car (cdr form)))
(body (cdr (cdr form))))
(if (pair? formal)
`(,(the 'define-syntax) ,(car formal) (,the-lambda ,(cdr formal) ,@body))
`(,the-define-macro ,formal (,(the 'transformer) (,the-begin ,@body)))))))
(define-transformer 'letrec-syntax
(lambda (form env)
(let ((formal (car (cdr form)))
(body (cdr (cdr form))))
`(let ()
,@(map (lambda (x)
`(,(the 'define-syntax) ,(car x) ,(cadr x)))
formal)
,@body))))
(define-transformer 'let-syntax
(lambda (form env)
`(,(the 'letrec-syntax) ,@(cdr form))))))

View File

@ -210,12 +210,7 @@
and or and or
cond case else => cond case else =>
do when unless do when unless
parameterize parameterize))
define-syntax
syntax-quote syntax-unquote
syntax-quasiquote syntax-unquote-splicing
let-syntax letrec-syntax
syntax-error))
(export-keywords (export-keywords
'(features '(features
eq? eqv? equal? not boolean? boolean=? eq? eqv? equal? not boolean? boolean=?