diff --git a/Makefile b/Makefile index 419f9598..eaece19f 100644 --- a/Makefile +++ b/Makefile @@ -1,7 +1,6 @@ LIBPICRIN_SRCS = \ lib/blob.c\ lib/bool.c\ - lib/boot.c\ lib/char.c\ lib/cont.c\ lib/data.c\ @@ -20,6 +19,7 @@ LIBPICRIN_SRCS = \ lib/var.c\ lib/vector.c\ lib/weak.c\ + lib/ext/boot.c\ lib/ext/eval.c\ lib/ext/lib.c\ lib/ext/load.c\ @@ -73,8 +73,8 @@ src/init_contrib.c: # libpicrin.so: $(LIBPICRIN_OBJS) # $(CC) -shared $(CFLAGS) -o $@ $(LIBPICRIN_OBJS) $(LDFLAGS) -lib/boot.c: piclib/boot.scm - bin/picrin-bootstrap tools/mkboot.scm < piclib/boot.scm > lib/boot.c +lib/ext/boot.c: piclib/boot.scm + bin/picrin-bootstrap tools/mkboot.scm < piclib/boot.scm > lib/ext/boot.c $(LIBPICRIN_OBJS) $(PICRIN_OBJS) $(CONTRIB_OBJS): lib/include/picrin.h lib/include/picrin/*.h lib/khash.h lib/object.h lib/state.h lib/vm.h @@ -93,7 +93,7 @@ test: test-contribs test-nostdlib test-issue test-contribs: picrin $(CONTRIB_TESTS) -test-nostdlib: lib/boot.c +test-nostdlib: lib/ext/boot.c $(CC) -I./lib -I./lib/include -D'PIC_USE_LIBC=0' -D'PIC_USE_STDIO=0' -D'PIC_USE_WRITE=0' -ffreestanding -nostdlib -Os -fPIC -shared -std=c89 -pedantic -Wall -Wextra -Werror -o libpicrin-tiny.so $(LIBPICRIN_SRCS) etc/libc_polyfill.c -fno-stack-protector strip libpicrin-tiny.so ls -lh libpicrin-tiny.so @@ -119,7 +119,7 @@ install: all clean: $(RM) picrin - $(RM) src/load_piclib.c src/init_contrib.c lib/boot.c + $(RM) src/load_piclib.c src/init_contrib.c lib/ext/boot.c $(RM) libpicrin.so libpicrin-tiny.so $(RM) $(LIBPICRIN_OBJS) $(RM) $(PICRIN_OBJS) diff --git a/contrib/10.attribute/attr.scm b/contrib/10.attribute/attr.scm index b342a1ca..7252d8e2 100644 --- a/contrib/10.attribute/attr.scm +++ b/contrib/10.attribute/attr.scm @@ -1,6 +1,6 @@ (define-library (picrin base) - (define attribute-table (make-ephemeron)) + (define attribute-table (make-ephemeron-table)) (define (attribute obj) (let ((r (attribute-table obj))) diff --git a/contrib/10.macro/macro.scm b/contrib/10.macro/macro.scm index 4b1d004f..ec3caf44 100644 --- a/contrib/10.macro/macro.scm +++ b/contrib/10.macro/macro.scm @@ -40,7 +40,7 @@ (define (make-syntactic-closure env free form) (letrec - ((wrap (let ((ephemeron (make-ephemeron))) + ((wrap (let ((ephemeron (make-ephemeron-table))) (lambda (var) (let ((id (ephemeron var))) (if id @@ -102,7 +102,7 @@ (define (er-transformer f) (lambda (form use-env mac-env) (letrec - ((rename (let ((ephemeron (make-ephemeron))) + ((rename (let ((ephemeron (make-ephemeron-table))) (lambda (var) (let ((id (ephemeron var))) (if id @@ -118,8 +118,8 @@ (define (ir-transformer f) (lambda (form use-env mac-env) - (let ((ephemeron1 (make-ephemeron)) - (ephemeron2 (make-ephemeron))) + (let ((ephemeron1 (make-ephemeron-table)) + (ephemeron2 (make-ephemeron-table))) (letrec ((inject (lambda (var1) (let ((var2 (ephemeron1 var1))) @@ -129,7 +129,7 @@ (ephemeron1 var1 var2) (ephemeron2 var2 var1) var2))))) - (rename (let ((ephemeron (make-ephemeron))) + (rename (let ((ephemeron (make-ephemeron-table))) (lambda (var) (let ((id (ephemeron var))) (if id diff --git a/contrib/20.r7rs/scheme/base.scm b/contrib/20.r7rs/scheme/base.scm index 17af9302..a65c5df0 100644 --- a/contrib/20.r7rs/scheme/base.scm +++ b/contrib/20.r7rs/scheme/base.scm @@ -359,7 +359,7 @@ #`(call-with-current-environment (lambda (env) (letrec - ((#,'rename (let ((wm (make-ephemeron))) + ((#,'rename (let ((wm (make-ephemeron-table))) (lambda (x) (let ((y (wm x))) (if y diff --git a/lib/boot.c b/lib/ext/boot.c similarity index 72% rename from lib/boot.c rename to lib/ext/boot.c index 5ed90dc3..708cbc92 100644 --- a/lib/boot.c +++ b/lib/ext/boot.c @@ -152,65 +152,65 @@ static const char boot_rom[][80] = { "pr)))) ((vector? expr) (list (the 'list->vector) (qq depth (vector->list expr)))", ") ((identifier? expr) (rename expr)) (else (list (the 'quote) expr)))) (let ((bo", "dy (qq 1 (cadr form)))) `(,(the 'let) ,(map cdr renames) ,body)))))) (define (tr", -"ansformer f) (lambda (form env) (let ((ephemeron1 (make-ephemeron)) (ephemeron2 ", -"(make-ephemeron))) (letrec ((wrap (lambda (var1) (let ((var2 (ephemeron1 var1)))", -" (if var2 (cdr var2) (let ((var2 (make-identifier var1 env))) (ephemeron1 var1 v", -"ar2) (ephemeron2 var2 var1) var2))))) (unwrap (lambda (var2) (let ((var1 (epheme", -"ron2 var2))) (if var1 (cdr var1) var2)))) (walk (lambda (f form) (cond ((identif", -"ier? form) (f form)) ((pair? form) (cons (walk f (car form)) (walk f (cdr form))", -")) ((vector? form) (list->vector (walk f (vector->list form)))) (else form))))) ", -"(let ((form (cdr form))) (walk unwrap (apply f (walk wrap form)))))))) (define-m", -"acro define-syntax (lambda (form env) (let ((formal (car (cdr form))) (body (cdr", -" (cdr form)))) (if (pair? formal) `(,(the 'define-syntax) ,(car formal) (,the-la", -"mbda ,(cdr formal) ,@body)) `(,the-define-macro ,formal (,(the 'transformer) (,t", -"he-begin ,@body))))))) (define-macro letrec-syntax (lambda (form env) (let ((for", -"mal (car (cdr form))) (body (cdr (cdr form)))) `(let () ,@(map (lambda (x) `(,(t", -"he 'define-syntax) ,(car x) ,(cadr x))) formal) ,@body)))) (define-macro let-syn", -"tax (lambda (form env) `(,(the 'letrec-syntax) ,@(cdr form)))) (define (mangle n", -"ame) (when (null? name) (error \"library name should be a list of at least one sy", -"mbols\" name)) (define (->string n) (cond ((symbol? n) (let ((str (symbol->string", -" n))) (string-for-each (lambda (c) (when (or (char=? c #\\.) (char=? c #\\/)) (err", -"or \"elements of library name may not contain '.' or '/'\" n))) str) str)) ((and (", -"number? n) (exact? n)) (number->string n)) (else (error \"symbol or integer is re", -"quired\" n)))) (define (join strs delim) (let loop ((res (car strs)) (strs (cdr s", -"trs))) (if (null? strs) res (loop (string-append res delim (car strs)) (cdr strs", -"))))) (join (map ->string name) \".\")) (define-macro define-library (lambda (form", -" _) (let ((lib (mangle (cadr form))) (body (cddr form))) (or (find-library lib) ", -"(make-library lib)) (for-each (lambda (expr) (eval expr lib)) body)))) (define-m", -"acro cond-expand (lambda (form _) (letrec ((test (lambda (form) (or (eq? form 'e", -"lse) (and (symbol? form) (memq form (features))) (and (pair? form) (case (car fo", -"rm) ((library) (find-library (mangle (cadr form)))) ((not) (not (test (cadr form", -")))) ((and) (let loop ((form (cdr form))) (or (null? form) (and (test (car form)", -") (loop (cdr form)))))) ((or) (let loop ((form (cdr form))) (and (pair? form) (o", -"r (test (car form)) (loop (cdr form)))))) (else #f))))))) (let loop ((clauses (c", -"dr form))) (if (null? clauses) #undefined (if (test (caar clauses)) `(,the-begin", -" ,@(cdar clauses)) (loop (cdr clauses)))))))) (define-macro import (lambda (form", -" _) (let ((caddr (lambda (x) (car (cdr (cdr x))))) (prefix (lambda (prefix symbo", -"l) (string->symbol (string-append (symbol->string prefix) (symbol->string symbol", -"))))) (getlib (lambda (name) (let ((lib (mangle name))) (if (find-library lib) l", -"ib (error \"library not found\" name)))))) (letrec ((extract (lambda (spec) (case ", -"(car spec) ((only rename prefix except) (extract (cadr spec))) (else (getlib spe", -"c))))) (collect (lambda (spec) (case (car spec) ((only) (let ((alist (collect (c", -"adr spec)))) (map (lambda (var) (assq var alist)) (cddr spec)))) ((rename) (let ", -"((alist (collect (cadr spec))) (renames (map (lambda (x) `((car x) cadr x)) (cdd", -"r spec)))) (map (lambda (s) (or (assq (car s) renames) s)) alist))) ((prefix) (l", -"et ((alist (collect (cadr spec)))) (map (lambda (s) (cons (prefix (caddr spec) (", -"car s)) (cdr s))) alist))) ((except) (let ((alist (collect (cadr spec)))) (let l", -"oop ((alist alist)) (if (null? alist) '() (if (memq (caar alist) (cddr spec)) (l", -"oop (cdr alist)) (cons (car alist) (loop (cdr alist)))))))) (else (map (lambda (", -"x) (cons x x)) (library-exports (getlib spec)))))))) (letrec ((import (lambda (s", -"pec) (let ((lib (extract spec)) (alist (collect spec))) (for-each (lambda (slot)", -" (library-import lib (cdr slot) (car slot))) alist))))) (for-each import (cdr fo", -"rm))))))) (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))", -"))) (export define lambda quote set! if begin define-macro let let* letrec letre", -"c* let-values let*-values define-values quasiquote unquote unquote-splicing and ", -"or cond case else => do when unless parameterize define-syntax syntax-quote synt", -"ax-unquote syntax-quasiquote syntax-unquote-splicing let-syntax letrec-syntax sy", -"ntax-error) ", +"ansformer f) (lambda (form env) (let ((ephemeron1 (make-ephemeron-table)) (ephem", +"eron2 (make-ephemeron-table))) (letrec ((wrap (lambda (var1) (let ((var2 (epheme", +"ron1 var1))) (if var2 (cdr var2) (let ((var2 (make-identifier var1 env))) (ephem", +"eron1 var1 var2) (ephemeron2 var2 var1) var2))))) (unwrap (lambda (var2) (let ((", +"var1 (ephemeron2 var2))) (if var1 (cdr var1) var2)))) (walk (lambda (f form) (co", +"nd ((identifier? form) (f form)) ((pair? form) (cons (walk f (car form)) (walk f", +" (cdr form)))) ((vector? form) (list->vector (walk f (vector->list form)))) (els", +"e form))))) (let ((form (cdr form))) (walk unwrap (apply f (walk wrap form))))))", +")) (define-macro define-syntax (lambda (form env) (let ((formal (car (cdr form))", +") (body (cdr (cdr form)))) (if (pair? formal) `(,(the 'define-syntax) ,(car form", +"al) (,the-lambda ,(cdr formal) ,@body)) `(,the-define-macro ,formal (,(the 'tran", +"sformer) (,the-begin ,@body))))))) (define-macro letrec-syntax (lambda (form env", +") (let ((formal (car (cdr form))) (body (cdr (cdr form)))) `(let () ,@(map (lamb", +"da (x) `(,(the 'define-syntax) ,(car x) ,(cadr x))) formal) ,@body)))) (define-m", +"acro let-syntax (lambda (form env) `(,(the 'letrec-syntax) ,@(cdr form)))) (defi", +"ne (mangle name) (when (null? name) (error \"library name should be a list of at ", +"least one symbols\" name)) (define (->string n) (cond ((symbol? n) (let ((str (sy", +"mbol->string n))) (string-for-each (lambda (c) (when (or (char=? c #\\.) (char=? ", +"c #\\/)) (error \"elements of library name may not contain '.' or '/'\" n))) str) s", +"tr)) ((and (number? n) (exact? n)) (number->string n)) (else (error \"symbol or i", +"nteger 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))))) (join (map ->string name) \".\")) (define-macro define-library (", +"lambda (form _) (let ((lib (mangle (cadr form))) (body (cddr form))) (or (find-l", +"ibrary lib) (make-library lib)) (for-each (lambda (expr) (eval expr lib)) body))", +")) (define-macro cond-expand (lambda (form _) (letrec ((test (lambda (form) (or ", +"(eq? form 'else) (and (symbol? form) (memq form (features))) (and (pair? form) (", +"case (car form) ((library) (find-library (mangle (cadr form)))) ((not) (not (tes", +"t (cadr form)))) ((and) (let loop ((form (cdr form))) (or (null? form) (and (tes", +"t (car form)) (loop (cdr form)))))) ((or) (let loop ((form (cdr form))) (and (pa", +"ir? form) (or (test (car form)) (loop (cdr form)))))) (else #f))))))) (let loop ", +"((clauses (cdr form))) (if (null? clauses) #undefined (if (test (caar clauses)) ", +"`(,the-begin ,@(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->s", +"tring symbol))))) (getlib (lambda (name) (let ((lib (mangle name))) (if (find-li", +"brary lib) lib (error \"library not found\" name)))))) (letrec ((extract (lambda (", +"spec) (case (car spec) ((only rename prefix except) (extract (cadr spec))) (else", +" (getlib spec))))) (collect (lambda (spec) (case (car spec) ((only) (let ((alist", +" (collect (cadr spec)))) (map (lambda (var) (assq var alist)) (cddr spec)))) ((r", +"ename) (let ((alist (collect (cadr spec))) (renames (map (lambda (x) `((car x) c", +"adr x)) (cddr spec)))) (map (lambda (s) (or (assq (car s) renames) s)) alist))) ", +"((prefix) (let ((alist (collect (cadr spec)))) (map (lambda (s) (cons (prefix (c", +"addr spec) (car s)) (cdr s))) alist))) ((except) (let ((alist (collect (cadr spe", +"c)))) (let loop ((alist alist)) (if (null? alist) '() (if (memq (caar alist) (cd", +"dr spec)) (loop (cdr alist)) (cons (car alist) (loop (cdr alist)))))))) (else (m", +"ap (lambda (x) (cons x x)) (library-exports (getlib spec)))))))) (letrec ((impor", +"t (lambda (spec) (let ((lib (extract spec)) (alist (collect spec))) (for-each (l", +"ambda (slot) (library-import lib (cdr slot) (car slot))) alist))))) (for-each im", +"port (cdr form))))))) (define-macro export (lambda (form _) (letrec ((collect (l", +"ambda (spec) (cond ((symbol? spec) `(,spec unquote spec)) ((and (list? spec) (= ", +"(length spec) 3) (eq? (car spec) 'rename)) `(,(list-ref spec 1) unquote (list-re", +"f spec 2))) (else (error \"malformed export\"))))) (export (lambda (spec) (let ((s", +"lot (collect spec))) (library-export (car slot) (cdr slot)))))) (for-each export", +" (cdr form))))) (export define lambda quote set! if begin define-macro let let* ", +"letrec letrec* let-values let*-values define-values quasiquote unquote unquote-s", +"plicing and or cond case else => do when unless parameterize define-syntax synta", +"x-quote syntax-unquote syntax-quasiquote syntax-unquote-splicing let-syntax letr", +"ec-syntax syntax-error) ", }; void diff --git a/lib/weak.c b/lib/weak.c index 1513f1e2..e5082305 100644 --- a/lib/weak.c +++ b/lib/weak.c @@ -97,7 +97,7 @@ weak_call(pic_state *pic) } static pic_value -pic_weak_make_ephemeron(pic_state *pic) +pic_weak_make_ephemeron_table(pic_state *pic) { pic_get_args(pic, ""); @@ -107,5 +107,5 @@ pic_weak_make_ephemeron(pic_state *pic) void pic_init_weak(pic_state *pic) { - pic_defun(pic, "make-ephemeron", pic_weak_make_ephemeron); + pic_defun(pic, "make-ephemeron-table", pic_weak_make_ephemeron_table); } diff --git a/piclib/boot.scm b/piclib/boot.scm index 03f533b7..ab092f0b 100644 --- a/piclib/boot.scm +++ b/piclib/boot.scm @@ -477,8 +477,8 @@ (define (transformer f) (lambda (form env) - (let ((ephemeron1 (make-ephemeron)) - (ephemeron2 (make-ephemeron))) + (let ((ephemeron1 (make-ephemeron-table)) + (ephemeron2 (make-ephemeron-table))) (letrec ((wrap (lambda (var1) (let ((var2 (ephemeron1 var1)))