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
|
|
|
}
|