picrin/lib/ext/boot.c

420 lines
33 KiB
C
Raw Normal View History

2016-03-03 04:59:07 -05:00
#include "picrin.h"
#include "picrin/extra.h"
static const char boot_rom[][80] = {
2017-04-03 10:39:30 -04:00
"(core#begin (core#define transformer (core#lambda (.f.172) (core#lambda (.form.1",
"73 .env.174) ((core#lambda (.ephemeron1.175 .ephemeron2.176) ((core#lambda (.wra",
"p.177 .unwrap.178 .walk.179) (core#begin (core#set! .wrap.177 (core#lambda (.var",
"1.180) ((core#lambda (.var2.181) (core#if .var2.181 (cdr .var2.181) ((core#lambd",
"a (.var2.182) (core#begin (.ephemeron1.175 .var1.180 .var2.182) (core#begin (.ep",
"hemeron2.176 .var2.182 .var1.180) .var2.182))) (make-identifier .var1.180 .env.1",
"74)))) (.ephemeron1.175 .var1.180)))) (core#begin (core#set! .unwrap.178 (core#l",
"ambda (.var2.183) ((core#lambda (.var1.184) (core#if .var1.184 (cdr .var1.184) .",
"var2.183)) (.ephemeron2.176 .var2.183)))) (core#begin (core#set! .walk.179 (core",
"#lambda (.f.185 .form.186) (core#if (identifier? .form.186) (.f.185 .form.186) (",
"core#if (pair? .form.186) (cons (.walk.179 .f.185 (car .form.186)) (.walk.179 .f",
".185 (cdr .form.186))) (core#if (vector? .form.186) (list->vector (.walk.179 .f.",
"185 (vector->list .form.186))) .form.186))))) ((core#lambda (.form.187) (.walk.1",
"79 .unwrap.178 (apply .f.172 (.walk.179 .wrap.177 .form.187)))) (cdr .form.173))",
")))) #f #f #f)) (make-ephemeron-table) (make-ephemeron-table))))) ((core#lambda ",
"() (core#begin (core#define .define-transformer.188 (core#lambda (.name.208 .tra",
"nsformer.209) (add-macro! .name.208 .transformer.209))) (core#begin (core#define",
" .the.189 (core#lambda (.var.210) (make-identifier .var.210 default-environment)",
")) (core#begin (core#define .the-core-define.190 (.the.189 (core#quote core#defi",
"ne))) (core#begin (core#define .the-core-lambda.191 (.the.189 (core#quote core#l",
"ambda))) (core#begin (core#define .the-core-begin.192 (.the.189 (core#quote core",
"#begin))) (core#begin (core#define .the-core-quote.193 (.the.189 (core#quote cor",
"e#quote))) (core#begin (core#define .the-core-set!.194 (.the.189 (core#quote cor",
"e#set!))) (core#begin (core#define .the-core-if.195 (.the.189 (core#quote core#i",
"f))) (core#begin (core#define .the-core-define-macro.196 (.the.189 (core#quote c",
"ore#define-macro))) (core#begin (core#define .the-define.197 (.the.189 (core#quo",
"te define))) (core#begin (core#define .the-lambda.198 (.the.189 (core#quote lamb",
"da))) (core#begin (core#define .the-begin.199 (.the.189 (core#quote begin))) (co",
"re#begin (core#define .the-quote.200 (.the.189 (core#quote quote))) (core#begin ",
"(core#define .the-set!.201 (.the.189 (core#quote set!))) (core#begin (core#defin",
"e .the-if.202 (.the.189 (core#quote if))) (core#begin (core#define .the-define-m",
"acro.203 (.the.189 (core#quote define-macro))) (core#begin (.define-transformer.",
"188 (core#quote quote) (core#lambda (.form.211 .env.212) (core#if (= (length .fo",
"rm.211) 2) (cons .the-core-quote.193 (cons (cadr .form.211) (core#quote ()))) (e",
"rror \"malformed quote\" .form.211)))) (core#begin (.define-transformer.188 (core#",
"quote if) (core#lambda (.form.213 .env.214) ((core#lambda (.len.215) (core#if (=",
" .len.215 3) (append .form.213 (cons (core#quote #undefined) (core#quote ()))) (",
"core#if (= .len.215 4) (cons .the-core-if.195 (cdr .form.213)) (error \"malformed",
" if\" .form.213)))) (length .form.213)))) (core#begin (.define-transformer.188 (c",
"ore#quote begin) (core#lambda (.form.216 .env.217) ((core#lambda (.len.218) (cor",
"e#if (= .len.218 1) #undefined (core#if (= .len.218 2) (cadr .form.216) (core#if",
" (= .len.218 3) (cons .the-core-begin.192 (cdr .form.216)) (cons .the-core-begin",
".192 (cons (cadr .form.216) (cons (cons .the-begin.199 (cddr .form.216)) (core#q",
"uote ())))))))) (length .form.216)))) (core#begin (.define-transformer.188 (core",
"#quote set!) (core#lambda (.form.219 .env.220) (core#if (core#if (= (length .for",
"m.219) 3) (identifier? (cadr .form.219)) #f) (cons .the-core-set!.194 (cdr .form",
".219)) (error \"malformed set!\" .form.219)))) (core#begin (core#define .check-for",
"mal.204 (core#lambda (.formal.221) ((core#lambda (.it.222) (core#if .it.222 .it.",
"222 ((core#lambda (.it.223) (core#if .it.223 .it.223 ((core#lambda (.it.224) (co",
"re#if .it.224 .it.224 #f)) (core#if (pair? .formal.221) (core#if (identifier? (c",
"ar .formal.221)) (.check-formal.204 (cdr .formal.221)) #f) #f)))) (identifier? .",
"formal.221)))) (null? .formal.221)))) (core#begin (.define-transformer.188 (core",
"#quote lambda) (core#lambda (.form.225 .env.226) (core#if (= (length .form.225) ",
"1) (error \"malformed lambda\" .form.225) (core#if (.check-formal.204 (cadr .form.",
"225)) (cons .the-core-lambda.191 (cons (cadr .form.225) (cons (cons .the-begin.1",
"99 (cddr .form.225)) (core#quote ())))) (error \"malformed lambda\" .form.225)))))",
" (core#begin (.define-transformer.188 (core#quote define) (core#lambda (.form.22",
"7 .env.228) ((core#lambda (.len.229) (core#if (= .len.229 1) (error \"malformed d",
"efine\" .form.227) ((core#lambda (.formal.230) (core#if (identifier? .formal.230)",
" (core#if (= .len.229 3) (cons .the-core-define.190 (cdr .form.227)) (error \"mal",
"formed define\" .form.227)) (core#if (pair? .formal.230) (cons .the-define.197 (c",
"ons (car .formal.230) (cons (cons .the-lambda.198 (cons (cdr .formal.230) (cddr ",
".form.227))) (core#quote ())))) (error \"define: binding to non-varaible object\" ",
".form.227)))) (cadr .form.227)))) (length .form.227)))) (core#begin (.define-tra",
"nsformer.188 (core#quote define-macro) (core#lambda (.form.231 .env.232) (core#i",
"f (= (length .form.231) 3) (core#if (identifier? (cadr .form.231)) (cons .the-co",
"re-define-macro.196 (cdr .form.231)) (error \"define-macro: binding to non-variab",
"le object\" .form.231)) (error \"malformed define-macro\" .form.231)))) (core#begin",
" (.define-transformer.188 (core#quote syntax-error) (core#lambda (.form.233 ._.2",
"34) (apply error (cdr .form.233)))) (core#begin #undefined (core#begin (.define-",
"transformer.188 (core#quote else) (core#lambda ._.235 (error \"invalid use of aux",
"iliary syntax\" (core#quote else)))) (core#begin (.define-transformer.188 (core#q",
"uote =>) (core#lambda ._.236 (error \"invalid use of auxiliary syntax\" (core#quot",
"e =>)))) (core#begin (.define-transformer.188 (core#quote unquote) (core#lambda ",
"._.237 (error \"invalid use of auxiliary syntax\" (core#quote unquote)))) (core#be",
"gin (.define-transformer.188 (core#quote unquote-splicing) (core#lambda ._.238 (",
"error \"invalid use of auxiliary syntax\" (core#quote unquote-splicing)))) (core#b",
"egin (.define-transformer.188 (core#quote syntax-unquote) (core#lambda ._.239 (e",
"rror \"invalid use of auxiliary syntax\" (core#quote syntax-unquote)))) (core#begi",
"n (.define-transformer.188 (core#quote syntax-unquote-splicing) (core#lambda ._.",
"240 (error \"invalid use of auxiliary syntax\" (core#quote syntax-unquote-splicing",
")))) (core#begin (.define-transformer.188 (core#quote let) (core#lambda (.form.2",
"41 .env.242) (core#if (identifier? (cadr .form.241)) ((core#lambda (.name.243 .f",
"ormal.244 .body.245) (cons (cons .the-lambda.198 (cons (core#quote ()) (cons (co",
"ns .the-define.197 (cons (cons .name.243 (map car .formal.244)) .body.245)) (con",
"s (cons .name.243 (map cadr .formal.244)) (core#quote ()))))) (core#quote ()))) ",
"(car (cdr .form.241)) (car (cdr (cdr .form.241))) (cdr (cdr (cdr .form.241)))) (",
"(core#lambda (.formal.246 .body.247) (cons (cons .the-lambda.198 (cons (map car ",
".formal.246) .body.247)) (map cadr .formal.246))) (car (cdr .form.241)) (cdr (cd",
"r .form.241)))))) (core#begin (.define-transformer.188 (core#quote and) (core#la",
"mbda (.form.248 .env.249) (core#if (null? (cdr .form.248)) #t (core#if (null? (c",
"ddr .form.248)) (cadr .form.248) (cons .the-if.202 (cons (cadr .form.248) (cons ",
"(cons (.the.189 (core#quote and)) (cddr .form.248)) (cons (core#quote #f) (core#",
"quote ()))))))))) (core#begin (.define-transformer.188 (core#quote or) (core#lam",
"bda (.form.250 .env.251) (core#if (null? (cdr .form.250)) #f ((core#lambda (.tmp",
".252) (cons (.the.189 (core#quote let)) (cons (cons (cons .tmp.252 (cons (cadr .",
"form.250) (core#quote ()))) (core#quote ())) (cons (cons .the-if.202 (cons .tmp.",
"252 (cons .tmp.252 (cons (cons (.the.189 (core#quote or)) (cddr .form.250)) (cor",
"e#quote ()))))) (core#quote ()))))) (make-identifier (core#quote it) .env.251)))",
")) (core#begin (.define-transformer.188 (core#quote cond) (core#lambda (.form.25",
"3 .env.254) ((core#lambda (.clauses.255) (core#if (null? .clauses.255) #undefine",
"d ((core#lambda (.clause.256) (core#if (core#if (identifier? (car .clause.256)) ",
"(identifier=? (.the.189 (core#quote else)) (make-identifier (car .clause.256) .e",
"nv.254)) #f) (cons .the-begin.199 (cdr .clause.256)) (core#if (null? (cdr .claus",
"e.256)) (cons (.the.189 (core#quote or)) (cons (car .clause.256) (cons (cons (.t",
"he.189 (core#quote cond)) (cdr .clauses.255)) (core#quote ())))) (core#if (core#",
"if (identifier? (cadr .clause.256)) (identifier=? (.the.189 (core#quote =>)) (ma",
"ke-identifier (cadr .clause.256) .env.254)) #f) ((core#lambda (.tmp.257) (cons (",
".the.189 (core#quote let)) (cons (cons (cons .tmp.257 (cons (car .clause.256) (c",
"ore#quote ()))) (core#quote ())) (cons (cons .the-if.202 (cons .tmp.257 (cons (c",
"ons (cadr (cdr .clause.256)) (cons .tmp.257 (core#quote ()))) (cons (cons (.the.",
"189 (core#quote cond)) (cddr .form.253)) (core#quote ()))))) (core#quote ())))))",
" (make-identifier (core#quote tmp) .env.254)) (cons .the-if.202 (cons (car .clau",
"se.256) (cons (cons .the-begin.199 (cdr .clause.256)) (cons (cons (.the.189 (cor",
"e#quote cond)) (cdr .clauses.255)) (core#quote ()))))))))) (car .clauses.255))))",
" (cdr .form.253)))) (core#begin (.define-transformer.188 (core#quote quasiquote)",
" (core#lambda (.form.258 .env.259) (core#begin (core#define .quasiquote?.260 (co",
"re#lambda (.form.264) (core#if (pair? .form.264) (core#if (identifier? (car .for",
"m.264)) (identifier=? (.the.189 (core#quote quasiquote)) (make-identifier (car .",
"form.264) .env.259)) #f) #f))) (core#begin (core#define .unquote?.261 (core#lamb",
"da (.form.265) (core#if (pair? .form.265) (core#if (identifier? (car .form.265))",
" (identifier=? (.the.189 (core#quote unquote)) (make-identifier (car .form.265) ",
".env.259)) #f) #f))) (core#begin (core#define .unquote-splicing?.262 (core#lambd",
"a (.form.266) (core#if (pair? .form.266) (core#if (pair? (car .form.266)) (core#",
"if (identifier? (caar .form.266)) (identifier=? (.the.189 (core#quote unquote-sp",
"licing)) (make-identifier (caar .form.266) .env.259)) #f) #f) #f))) (core#begin ",
"(core#define .qq.263 (core#lambda (.depth.267 .expr.268) (core#if (.unquote?.261",
" .expr.268) (core#if (= .depth.267 1) (cadr .expr.268) (list (.the.189 (core#quo",
"te list)) (list (.the.189 (core#quote quote)) (.the.189 (core#quote unquote))) (",
".qq.263 (- .depth.267 1) (car (cdr .expr.268))))) (core#if (.unquote-splicing?.2",
"62 .expr.268) (core#if (= .depth.267 1) (list (.the.189 (core#quote append)) (ca",
"r (cdr (car .expr.268))) (.qq.263 .depth.267 (cdr .expr.268))) (list (.the.189 (",
"core#quote cons)) (list (.the.189 (core#quote list)) (list (.the.189 (core#quote",
" quote)) (.the.189 (core#quote unquote-splicing))) (.qq.263 (- .depth.267 1) (ca",
"r (cdr (car .expr.268))))) (.qq.263 .depth.267 (cdr .expr.268)))) (core#if (.qua",
"siquote?.260 .expr.268) (list (.the.189 (core#quote list)) (list (.the.189 (core",
"#quote quote)) (.the.189 (core#quote quasiquote))) (.qq.263 (+ .depth.267 1) (ca",
"r (cdr .expr.268)))) (core#if (pair? .expr.268) (list (.the.189 (core#quote cons",
")) (.qq.263 .depth.267 (car .expr.268)) (.qq.263 .depth.267 (cdr .expr.268))) (c",
"ore#if (vector? .expr.268) (list (.the.189 (core#quote list->vector)) (.qq.263 .",
"depth.267 (vector->list .expr.268))) (list (.the.189 (core#quote quote)) .expr.2",
"68)))))))) ((core#lambda (.x.269) (.qq.263 1 .x.269)) (cadr .form.258)))))))) (c",
"ore#begin (.define-transformer.188 (core#quote let*) (core#lambda (.form.270 .en",
"v.271) ((core#lambda (.bindings.272 .body.273) (core#if (null? .bindings.272) (c",
"ons (.the.189 (core#quote let)) (cons (core#quote ()) .body.273)) (cons (.the.18",
"9 (core#quote let)) (cons (cons (cons (car (car .bindings.272)) (cdr (car .bindi",
"ngs.272))) (core#quote ())) (cons (cons (.the.189 (core#quote let*)) (cons (cdr ",
".bindings.272) .body.273)) (core#quote ())))))) (car (cdr .form.270)) (cdr (cdr ",
".form.270))))) (core#begin (.define-transformer.188 (core#quote letrec) (core#la",
"mbda (.form.274 .env.275) (cons (.the.189 (core#quote letrec*)) (cdr .form.274))",
")) (core#begin (.define-transformer.188 (core#quote letrec*) (core#lambda (.form",
".276 .env.277) ((core#lambda (.bindings.278 .body.279) ((core#lambda (.variables",
".280 .initials.281) (cons (.the.189 (core#quote let)) (cons .variables.280 (appe",
"nd .initials.281 (append .body.279 (core#quote ())))))) (map (core#lambda (.v.28",
"2) (cons .v.282 (cons (core#quote #undefined) (core#quote ())))) (map car .bindi",
"ngs.278)) (map (core#lambda (.v.283) (cons (.the.189 (core#quote set!)) (append ",
".v.283 (core#quote ())))) .bindings.278))) (car (cdr .form.276)) (cdr (cdr .form",
".276))))) (core#begin (.define-transformer.188 (core#quote let-values) (core#lam",
"bda (.form.284 .env.285) (cons (.the.189 (core#quote let*-values)) (append (cdr ",
".form.284) (core#quote ()))))) (core#begin (.define-transformer.188 (core#quote ",
"let*-values) (core#lambda (.form.286 .env.287) ((core#lambda (.formal.288 .body.",
"289) (core#if (null? .formal.288) (cons (.the.189 (core#quote let)) (cons (core#",
"quote ()) (append .body.289 (core#quote ())))) (cons (.the.189 (core#quote call-",
"with-values)) (cons (cons .the-lambda.198 (cons (core#quote ()) (append (cdr (ca",
"r .formal.288)) (core#quote ())))) (cons (cons (.the.189 (core#quote lambda)) (c",
"ons (append (car (car .formal.288)) (core#quote ())) (cons (cons (.the.189 (core",
"#quote let*-values)) (cons (append (cdr .formal.288) (core#quote ())) (append .b",
"ody.289 (core#quote ())))) (core#quote ())))) (core#quote ())))))) (car (cdr .fo",
"rm.286)) (cdr (cdr .form.286))))) (core#begin (.define-transformer.188 (core#quo",
"te define-values) (core#lambda (.form.290 .env.291) ((core#lambda (.formal.292 .",
"body.293) ((core#lambda (.arguments.294) (cons .the-begin.199 (append ((core#lam",
"bda () (core#begin (core#define .loop.295 (core#lambda (.formal.296) (core#if (p",
"air? .formal.296) (cons (cons .the-define.197 (cons (car .formal.296) (cons (cor",
"e#quote #undefined) (core#quote ())))) (append (.loop.295 (cdr .formal.296)) (co",
"re#quote ()))) (core#if (identifier? .formal.296) (cons (cons .the-define.197 (c",
"ons .formal.296 (cons (core#quote #undefined) (core#quote ())))) (core#quote ())",
") (core#quote ()))))) (.loop.295 .formal.292)))) (cons (cons (.the.189 (core#quo",
"te call-with-values)) (cons (cons .the-lambda.198 (cons (core#quote ()) (append ",
".body.293 (core#quote ())))) (cons (cons .the-lambda.198 (cons .arguments.294 (a",
"ppend ((core#lambda () (core#begin (core#define .loop.297 (core#lambda (.formal.",
"298 .args.299) (core#if (pair? .formal.298) (cons (cons .the-set!.201 (cons (car",
" .formal.298) (cons (cons (.the.189 (core#quote car)) (cons .args.299 (core#quot",
"e ()))) (core#quote ())))) (append (.loop.297 (cdr .formal.298) (cons (.the.189 ",
"(core#quote cdr)) (cons .args.299 (core#quote ())))) (core#quote ()))) (core#if ",
"(identifier? .formal.298) (cons (cons .the-set!.201 (cons .formal.298 (cons .arg",
"s.299 (core#quote ())))) (core#quote ())) (core#quote ()))))) (.loop.297 .formal",
".292 .arguments.294)))) (core#quote ())))) (core#quote ())))) (core#quote ()))))",
") (make-identifier (core#quote arguments) .env.291))) (car (cdr .form.290)) (cdr",
" (cdr .form.290))))) (core#begin (.define-transformer.188 (core#quote do) (core#",
"lambda (.form.300 .env.301) ((core#lambda (.bindings.302 .test.303 .cleanup.304 ",
".body.305) ((core#lambda (.loop.306) (cons (.the.189 (core#quote let)) (cons .lo",
"op.306 (cons (map (core#lambda (.x.307) (cons (car .x.307) (cons (cadr .x.307) (",
"core#quote ())))) .bindings.302) (cons (cons .the-if.202 (cons .test.303 (cons (",
"cons .the-begin.199 .cleanup.304) (cons (cons .the-begin.199 (append .body.305 (",
"cons (cons .loop.306 (map (core#lambda (.x.308) (core#if (null? (cdr (cdr .x.308",
"))) (car .x.308) (car (cdr (cdr .x.308))))) .bindings.302)) (core#quote ())))) (",
"core#quote ()))))) (core#quote ())))))) (make-identifier (core#quote loop) .env.",
"301))) (car (cdr .form.300)) (car (car (cdr (cdr .form.300)))) (cdr (car (cdr (c",
"dr .form.300)))) (cdr (cdr (cdr .form.300)))))) (core#begin (.define-transformer",
".188 (core#quote when) (core#lambda (.form.309 .env.310) ((core#lambda (.test.31",
"1 .body.312) (cons .the-if.202 (cons .test.311 (cons (cons .the-begin.199 (appen",
"d .body.312 (core#quote ()))) (cons (core#quote #undefined) (core#quote ()))))))",
" (car (cdr .form.309)) (cdr (cdr .form.309))))) (core#begin (.define-transformer",
".188 (core#quote unless) (core#lambda (.form.313 .env.314) ((core#lambda (.test.",
"315 .body.316) (cons .the-if.202 (cons .test.315 (cons (core#quote #undefined) (",
"cons (cons .the-begin.199 (append .body.316 (core#quote ()))) (core#quote ()))))",
")) (car (cdr .form.313)) (cdr (cdr .form.313))))) (core#begin (.define-transform",
"er.188 (core#quote case) (core#lambda (.form.317 .env.318) ((core#lambda (.key.3",
"19 .clauses.320) ((core#lambda (.the-key.321) (cons (.the.189 (core#quote let)) ",
"(cons (cons (cons .the-key.321 (cons .key.319 (core#quote ()))) (core#quote ()))",
" (cons ((core#lambda () (core#begin (core#define .loop.322 (core#lambda (.clause",
"s.323) (core#if (null? .clauses.323) #undefined ((core#lambda (.clause.324) (con",
"s .the-if.202 (cons (core#if (core#if (identifier? (car .clause.324)) (identifie",
"r=? (.the.189 (core#quote else)) (make-identifier (car .clause.324) .env.318)) #",
"f) #t (cons (.the.189 (core#quote or)) (append (map (core#lambda (.x.325) (cons ",
"(.the.189 (core#quote eqv?)) (cons .the-key.321 (cons (cons .the-quote.200 (cons",
" .x.325 (core#quote ()))) (core#quote ()))))) (car .clause.324)) (core#quote ())",
"))) (cons (core#if (core#if (identifier? (cadr .clause.324)) (identifier=? (.the",
".189 (core#quote =>)) (make-identifier (cadr .clause.324) .env.318)) #f) (cons (",
"car (cdr (cdr .clause.324))) (cons .the-key.321 (core#quote ()))) (cons .the-beg",
"in.199 (append (cdr .clause.324) (core#quote ())))) (cons (.loop.322 (cdr .claus",
"es.323)) (core#quote ())))))) (car .clauses.323))))) (.loop.322 .clauses.320))))",
" (core#quote ()))))) (make-identifier (core#quote key) .env.318))) (car (cdr .fo",
"rm.317)) (cdr (cdr .form.317))))) (core#begin (.define-transformer.188 (core#quo",
"te parameterize) (core#lambda (.form.326 .env.327) ((core#lambda (.formal.328 .b",
"ody.329) (cons (.the.189 (core#quote with-dynamic-environment)) (cons (cons (.th",
"e.189 (core#quote list)) (append (map (core#lambda (.x.330) (cons (.the.189 (cor",
"e#quote cons)) (cons (car .x.330) (cons (cadr .x.330) (core#quote ()))))) .forma",
"l.328) (core#quote ()))) (cons (cons .the-lambda.198 (cons (core#quote ()) (appe",
"nd .body.329 (core#quote ())))) (core#quote ()))))) (car (cdr .form.326)) (cdr (",
"cdr .form.326))))) (core#begin (.define-transformer.188 (core#quote syntax-quote",
") (core#lambda (.form.331 .env.332) ((core#lambda (.renames.333) ((core#lambda (",
".rename.334 .walk.335) (core#begin (core#set! .rename.334 (core#lambda (.var.336",
") ((core#lambda (.x.337) (core#if .x.337 (cadr .x.337) (core#begin (core#set! .r",
"enames.333 (cons (cons .var.336 (cons (make-identifier .var.336 .env.332) (cons ",
"(cons (.the.189 (core#quote make-identifier)) (cons (cons (core#quote quote) (co",
"ns .var.336 (core#quote ()))) (cons (cons (core#quote quote) (cons .env.332 (cor",
"e#quote ()))) (core#quote ())))) (core#quote ())))) .renames.333)) (.rename.334 ",
".var.336)))) (assq .var.336 .renames.333)))) (core#begin (core#set! .walk.335 (c",
"ore#lambda (.f.338 .form.339) (core#if (identifier? .form.339) (.f.338 .form.339",
") (core#if (pair? .form.339) (cons (.the.189 (core#quote cons)) (cons (cons (cor",
"e#quote walk) (cons (core#quote f) (cons (cons (core#quote car) (cons (core#quot",
"e 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.339) (cons ",
"(.the.189 (core#quote list->vector)) (cons (cons (core#quote walk) (cons (core#q",
"uote f) (cons (cons (core#quote vector->list) (cons (core#quote form) (core#quot",
"e ()))) (core#quote ())))) (core#quote ()))) (cons (.the.189 (core#quote quote))",
" (cons .form.339 (core#quote ())))))))) ((core#lambda (.form.340) (cons (.the.18",
"9 (core#quote let)) (cons (map cdr .renames.333) (cons .form.340 (core#quote ())",
")))) (.walk.335 .rename.334 (cadr .form.331)))))) #f #f)) (core#quote ())))) (co",
"re#begin (.define-transformer.188 (core#quote syntax-quasiquote) (core#lambda (.",
"form.341 .env.342) ((core#lambda (.renames.343) ((core#lambda (.rename.344) (cor",
"e#begin (core#set! .rename.344 (core#lambda (.var.349) ((core#lambda (.x.350) (c",
"ore#if .x.350 (cadr .x.350) (core#begin (core#set! .renames.343 (cons (cons .var",
".349 (cons (make-identifier .var.349 .env.342) (cons (cons (.the.189 (core#quote",
" make-identifier)) (cons (cons (core#quote quote) (cons .var.349 (core#quote ())",
")) (cons (cons (core#quote quote) (cons .env.342 (core#quote ()))) (core#quote (",
"))))) (core#quote ())))) .renames.343)) (.rename.344 .var.349)))) (assq .var.349",
" .renames.343)))) (core#begin (core#define .syntax-quasiquote?.345 (core#lambda ",
"(.form.351) (core#if (pair? .form.351) (core#if (identifier? (car .form.351)) (i",
"dentifier=? (.the.189 (core#quote syntax-quasiquote)) (make-identifier (car .for",
"m.351) .env.342)) #f) #f))) (core#begin (core#define .syntax-unquote?.346 (core#",
"lambda (.form.352) (core#if (pair? .form.352) (core#if (identifier? (car .form.3",
"52)) (identifier=? (.the.189 (core#quote syntax-unquote)) (make-identifier (car ",
".form.352) .env.342)) #f) #f))) (core#begin (core#define .syntax-unquote-splicin",
"g?.347 (core#lambda (.form.353) (core#if (pair? .form.353) (core#if (pair? (car ",
".form.353)) (core#if (identifier? (caar .form.353)) (identifier=? (.the.189 (cor",
"e#quote syntax-unquote-splicing)) (make-identifier (caar .form.353) .env.342)) #",
"f) #f) #f))) (core#begin (core#define .qq.348 (core#lambda (.depth.354 .expr.355",
") (core#if (.syntax-unquote?.346 .expr.355) (core#if (= .depth.354 1) (car (cdr ",
".expr.355)) (list (.the.189 (core#quote list)) (list (.the.189 (core#quote quote",
")) (.the.189 (core#quote syntax-unquote))) (.qq.348 (- .depth.354 1) (car (cdr .",
"expr.355))))) (core#if (.syntax-unquote-splicing?.347 .expr.355) (core#if (= .de",
"pth.354 1) (list (.the.189 (core#quote append)) (car (cdr (car .expr.355))) (.qq",
".348 .depth.354 (cdr .expr.355))) (list (.the.189 (core#quote cons)) (list (.the",
".189 (core#quote list)) (list (.the.189 (core#quote quote)) (.the.189 (core#quot",
"e syntax-unquote-splicing))) (.qq.348 (- .depth.354 1) (car (cdr (car .expr.355)",
")))) (.qq.348 .depth.354 (cdr .expr.355)))) (core#if (.syntax-quasiquote?.345 .e",
"xpr.355) (list (.the.189 (core#quote list)) (list (.the.189 (core#quote quote)) ",
"(.the.189 (core#quote quasiquote))) (.qq.348 (+ .depth.354 1) (car (cdr .expr.35",
"5)))) (core#if (pair? .expr.355) (list (.the.189 (core#quote cons)) (.qq.348 .de",
"pth.354 (car .expr.355)) (.qq.348 .depth.354 (cdr .expr.355))) (core#if (vector?",
" .expr.355) (list (.the.189 (core#quote list->vector)) (.qq.348 .depth.354 (vect",
"or->list .expr.355))) (core#if (identifier? .expr.355) (.rename.344 .expr.355) (",
"list (.the.189 (core#quote quote)) .expr.355))))))))) ((core#lambda (.body.356) ",
"(cons (.the.189 (core#quote let)) (cons (map cdr .renames.343) (cons .body.356 (",
"core#quote ()))))) (.qq.348 1 (cadr .form.341))))))))) #f)) (core#quote ())))) (",
"core#begin (.define-transformer.188 (core#quote define-syntax) (core#lambda (.fo",
"rm.357 .env.358) ((core#lambda (.formal.359 .body.360) (core#if (pair? .formal.3",
"59) (cons (.the.189 (core#quote define-syntax)) (cons (car .formal.359) (cons (c",
"ons .the-lambda.198 (cons (cdr .formal.359) (append .body.360 (core#quote ()))))",
" (core#quote ())))) (cons .the-define-macro.203 (cons .formal.359 (cons (cons (.",
"the.189 (core#quote transformer)) (cons (cons .the-begin.199 (append .body.360 (",
"core#quote ()))) (core#quote ()))) (core#quote ())))))) (car (cdr .form.357)) (c",
"dr (cdr .form.357))))) (core#begin (.define-transformer.188 (core#quote letrec-s",
"yntax) (core#lambda (.form.361 .env.362) ((core#lambda (.formal.363 .body.364) (",
"cons (core#quote let) (cons (core#quote ()) (append (map (core#lambda (.x.365) (",
"cons (.the.189 (core#quote define-syntax)) (cons (car .x.365) (cons (cadr .x.365",
") (core#quote ()))))) .formal.363) (append .body.364 (core#quote ())))))) (car (",
"cdr .form.361)) (cdr (cdr .form.361))))) (.define-transformer.188 (core#quote le",
"t-syntax) (core#lambda (.form.366 .env.367) (cons (.the.189 (core#quote letrec-s",
"yntax)) (append (cdr .form.366) (core#quote ()))))))))))))))))))))))))))))))))))",
")))))))))))))))))))))))))) ",
2017-04-03 09:09:19 -04:00
};
#if PIC_USE_LIBRARY
static const char boot_library_rom[][80] = {
"(define (mangle name) (when (null? name) (error \"library name should be a list o",
"f at least one symbols\" name)) (define (->string n) (cond ((symbol? n) (let ((st",
"r (symbol->string n))) (string-for-each (lambda (c) (when (or (char=? c #\\.) (ch",
"ar=? c #\\:)) (error \"elements of library name may not contain '.' or ':'\" n))) s",
"tr) str)) ((and (number? n) (exact? n) (<= 0 n)) (number->string n)) (else (erro",
"r \"symbol or non-negative integer is required\" n)))) (define (join strs delim) (",
"let loop ((res (car strs)) (strs (cdr strs))) (if (null? strs) res (loop (string",
"-append res delim (car strs)) (cdr strs))))) (if (symbol? name) name (string->sy",
"mbol (join (map ->string name) \".\")))) (define current-library (make-parameter '",
"(picrin base) mangle)) (define *libraries* (make-dictionary)) (define (find-libr",
"ary name) (dictionary-has? *libraries* (mangle name))) (define (make-library nam",
"e) (let ((name (mangle name))) (let ((env (make-environment (string->symbol (str",
"ing-append (symbol->string name) \":\")))) (exports (make-dictionary))) (set-ident",
"ifier! 'define-library 'define-library env) (set-identifier! 'import 'import env",
") (set-identifier! 'export 'export env) (set-identifier! 'cond-expand 'cond-expa",
"nd env) (dictionary-set! *libraries* name `(,env unquote exports))))) (define (l",
"ibrary-environment name) (car (dictionary-ref *libraries* (mangle name)))) (defi",
"ne (library-exports name) (cdr (dictionary-ref *libraries* (mangle name)))) (def",
"ine (library-import name sym alias) (let ((uid (dictionary-ref (library-exports ",
"name) sym))) (let ((env (library-environment (current-library)))) (set-identifie",
"r! alias uid env)))) (define (library-export sym alias) (let ((env (library-envi",
"ronment (current-library))) (exports (library-exports (current-library)))) (dict",
"ionary-set! exports alias (find-identifier sym env)))) (define-macro define-libr",
"ary (lambda (form _) (let ((name (cadr form)) (body (cddr form))) (or (find-libr",
"ary name) (make-library name)) (parameterize ((current-library name)) (for-each ",
"(lambda (expr) (eval expr name)) body))))) (define-macro cond-expand (lambda (fo",
"rm _) (letrec ((test (lambda (form) (or (eq? form 'else) (and (symbol? form) (me",
"mq form (features))) (and (pair? form) (case (car form) ((library) (find-library",
" (cadr form))) ((not) (not (test (cadr form)))) ((and) (let loop ((form (cdr for",
"m))) (or (null? form) (and (test (car form)) (loop (cdr form)))))) ((or) (let lo",
"op ((form (cdr form))) (and (pair? form) (or (test (car form)) (loop (cdr form))",
")))) (else #f))))))) (let loop ((clauses (cdr form))) (if (null? clauses) #undef",
2017-04-03 10:39:30 -04:00
"ined (if (test (caar clauses)) `(,(make-identifier 'begin default-environment) ,",
"@(cdar clauses)) (loop (cdr clauses)))))))) (define-macro import (lambda (form _",
") (let ((caddr (lambda (x) (car (cdr (cdr x))))) (prefix (lambda (prefix symbol)",
" (string->symbol (string-append (symbol->string prefix) (symbol->string symbol))",
"))) (getlib (lambda (name) (if (find-library name) name (error \"library not foun",
"d\" name))))) (letrec ((extract (lambda (spec) (case (car spec) ((only rename pre",
"fix except) (extract (cadr spec))) (else (getlib spec))))) (collect (lambda (spe",
"c) (case (car spec) ((only) (let ((alist (collect (cadr spec)))) (map (lambda (v",
"ar) (assq var alist)) (cddr spec)))) ((rename) (let ((alist (collect (cadr spec)",
")) (renames (map (lambda (x) `(,(car x) unquote (cadr x))) (cddr spec)))) (map (",
"lambda (s) (or (assq (car s) renames) s)) alist))) ((prefix) (let ((alist (colle",
"ct (cadr spec)))) (map (lambda (s) (cons (prefix (caddr spec) (car s)) (cdr s)))",
" alist))) ((except) (let ((alist (collect (cadr spec)))) (let loop ((alist alist",
")) (if (null? alist) '() (if (memq (caar alist) (cddr spec)) (loop (cdr alist)) ",
"(cons (car alist) (loop (cdr alist)))))))) (else (dictionary-map (lambda (x) (co",
"ns x x)) (library-exports (getlib spec)))))))) (letrec ((import (lambda (spec) (",
"let ((lib (extract spec)) (alist (collect spec))) (for-each (lambda (slot) (libr",
"ary-import lib (cdr slot) (car slot))) alist))))) (for-each import (cdr form))))",
"))) (define-macro export (lambda (form _) (letrec ((collect (lambda (spec) (cond",
" ((symbol? spec) `(,spec unquote spec)) ((and (list? spec) (= (length spec) 3) (",
"eq? (car spec) 'rename)) `(,(list-ref spec 1) unquote (list-ref spec 2))) (else ",
"(error \"malformed export\"))))) (export (lambda (spec) (let ((slot (collect spec)",
")) (library-export (car slot) (cdr slot)))))) (for-each export (cdr form))))) (l",
"et () (make-library '(picrin base)) (set-car! (dictionary-ref *libraries* (mangl",
"e '(picrin base))) default-environment) (let ((export-keywords (lambda (keywords",
") (let ((env (library-environment '(picrin base))) (exports (library-exports '(p",
"icrin base)))) (for-each (lambda (keyword) (dictionary-set! exports keyword keyw",
"ord)) keywords))))) (export-keywords '(define lambda quote set! if begin define-",
"macro let let* letrec letrec* let-values let*-values define-values quasiquote un",
"quote unquote-splicing and or cond case else => do when unless parameterize defi",
"ne-syntax syntax-quote syntax-unquote syntax-quasiquote syntax-unquote-splicing ",
"let-syntax letrec-syntax syntax-error)) (export-keywords '(features eq? eqv? equ",
"al? not boolean? boolean=? pair? cons car cdr null? set-car! set-cdr! caar cadr ",
"cdar cddr list? make-list list length append reverse list-tail list-ref list-set",
"! list-copy map for-each memq memv member assq assv assoc current-input-port cur",
"rent-output-port current-error-port port? input-port? output-port? port-open? cl",
"ose-port eof-object? eof-object read-u8 peek-u8 read-bytevector! write-u8 write-",
"bytevector flush-output-port open-input-bytevector open-output-bytevector get-ou",
"tput-bytevector number? exact? inexact? inexact exact = < > <= >= + - * / number",
"->string string->number procedure? apply symbol? symbol=? symbol->string string-",
">symbol make-identifier identifier? identifier=? identifier-base identifier-envi",
"ronment vector? vector make-vector vector-length vector-ref vector-set! vector-c",
"opy! vector-copy vector-append vector-fill! vector-map vector-for-each list->vec",
"tor vector->list string->vector vector->string bytevector? bytevector make-bytev",
"ector bytevector-length bytevector-u8-ref bytevector-u8-set! bytevector-copy! by",
"tevector-copy bytevector-append bytevector->list list->bytevector call-with-curr",
"ent-continuation call/cc values call-with-values char? char->integer integer->ch",
"ar char=? char<? char>? char<=? char>=? current-exception-handlers with-exceptio",
"n-handler raise raise-continuable error error-object? error-object-message error",
"-object-irritants error-object-type string? string make-string string-length str",
"ing-ref string-set! string-copy string-copy! string-fill! string-append string-m",
"ap string-for-each list->string string->list string=? string<? string>? string<=",
"? string>=? make-parameter with-dynamic-environment read make-dictionary diction",
"ary? dictionary dictionary-has? dictionary-ref dictionary-set! dictionary-delete",
"! dictionary-size dictionary-map dictionary-for-each dictionary->alist alist->di",
"ctionary dictionary->plist plist->dictionary make-record record? record-type rec",
"ord-datum default-environment make-environment find-identifier set-identifier! e",
"val compile add-macro! make-ephemeron-table write write-simple write-shared disp",
"lay)) (export-keywords '(find-library make-library current-library))) (set! eval",
" (let ((e eval)) (lambda (expr . lib) (let ((lib (if (null? lib) (current-librar",
"y) (car lib)))) (e expr (library-environment lib)))))) (make-library '(picrin us",
"er)) (current-library '(picrin user))) ",
2017-04-03 09:09:19 -04:00
2015-01-31 07:14:14 -05:00
};
2017-04-03 09:09:19 -04:00
#endif
2014-09-08 10:31:04 -04:00
2016-03-03 04:59:07 -05:00
void
pic_boot(pic_state *pic)
{
2017-04-03 10:39:30 -04:00
pic_call(pic, pic_compile(pic, pic_read_cstr(pic, &boot_rom[0][0])), 0);
2017-04-03 09:09:19 -04:00
#if PIC_USE_LIBRARY
pic_load_cstr(pic, &boot_library_rom[0][0]);
#endif
2016-03-03 04:59:07 -05:00
}