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

make-ephemeron -> make-ephemeron-table

This commit is contained in:
Yuichi Nishiwaki 2017-03-31 15:59:22 +09:00
parent fc7b9a50f9
commit 690384c5b4
7 changed files with 75 additions and 75 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

10
Makefile
View File

@ -1,7 +1,6 @@
LIBPICRIN_SRCS = \ LIBPICRIN_SRCS = \
lib/blob.c\ lib/blob.c\
lib/bool.c\ lib/bool.c\
lib/boot.c\
lib/char.c\ lib/char.c\
lib/cont.c\ lib/cont.c\
lib/data.c\ lib/data.c\
@ -20,6 +19,7 @@ LIBPICRIN_SRCS = \
lib/var.c\ lib/var.c\
lib/vector.c\ lib/vector.c\
lib/weak.c\ lib/weak.c\
lib/ext/boot.c\
lib/ext/eval.c\ lib/ext/eval.c\
lib/ext/lib.c\ lib/ext/lib.c\
lib/ext/load.c\ lib/ext/load.c\
@ -73,8 +73,8 @@ src/init_contrib.c:
# libpicrin.so: $(LIBPICRIN_OBJS) # libpicrin.so: $(LIBPICRIN_OBJS)
# $(CC) -shared $(CFLAGS) -o $@ $(LIBPICRIN_OBJS) $(LDFLAGS) # $(CC) -shared $(CFLAGS) -o $@ $(LIBPICRIN_OBJS) $(LDFLAGS)
lib/boot.c: piclib/boot.scm lib/ext/boot.c: piclib/boot.scm
bin/picrin-bootstrap tools/mkboot.scm < piclib/boot.scm > lib/boot.c 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 $(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-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 $(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 strip libpicrin-tiny.so
ls -lh libpicrin-tiny.so ls -lh libpicrin-tiny.so
@ -119,7 +119,7 @@ install: all
clean: clean:
$(RM) picrin $(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.so libpicrin-tiny.so
$(RM) $(LIBPICRIN_OBJS) $(RM) $(LIBPICRIN_OBJS)
$(RM) $(PICRIN_OBJS) $(RM) $(PICRIN_OBJS)

2
contrib/10.attribute/attr.scm
View File

@ -1,6 +1,6 @@
(define-library (picrin base) (define-library (picrin base)
(define attribute-table (make-ephemeron)) (define attribute-table (make-ephemeron-table))
(define (attribute obj) (define (attribute obj)
(let ((r (attribute-table obj))) (let ((r (attribute-table obj)))

10
contrib/10.macro/macro.scm
View File

@ -40,7 +40,7 @@
(define (make-syntactic-closure env free form) (define (make-syntactic-closure env free form)
(letrec (letrec
((wrap (let ((ephemeron (make-ephemeron))) ((wrap (let ((ephemeron (make-ephemeron-table)))
(lambda (var) (lambda (var)
(let ((id (ephemeron var))) (let ((id (ephemeron var)))
(if id (if id
@ -102,7 +102,7 @@
(define (er-transformer f) (define (er-transformer f)
(lambda (form use-env mac-env) (lambda (form use-env mac-env)
(letrec (letrec
((rename (let ((ephemeron (make-ephemeron))) ((rename (let ((ephemeron (make-ephemeron-table)))
(lambda (var) (lambda (var)
(let ((id (ephemeron var))) (let ((id (ephemeron var)))
(if id (if id
@ -118,8 +118,8 @@
(define (ir-transformer f) (define (ir-transformer f)
(lambda (form use-env mac-env) (lambda (form use-env mac-env)
(let ((ephemeron1 (make-ephemeron)) (let ((ephemeron1 (make-ephemeron-table))
(ephemeron2 (make-ephemeron))) (ephemeron2 (make-ephemeron-table)))
(letrec (letrec
((inject (lambda (var1) ((inject (lambda (var1)
(let ((var2 (ephemeron1 var1))) (let ((var2 (ephemeron1 var1)))
@ -129,7 +129,7 @@
(ephemeron1 var1 var2) (ephemeron1 var1 var2)
(ephemeron2 var2 var1) (ephemeron2 var2 var1)
var2))))) var2)))))
(rename (let ((ephemeron (make-ephemeron))) (rename (let ((ephemeron (make-ephemeron-table)))
(lambda (var) (lambda (var)
(let ((id (ephemeron var))) (let ((id (ephemeron var)))
(if id (if id

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

@ -359,7 +359,7 @@
#`(call-with-current-environment #`(call-with-current-environment
(lambda (env) (lambda (env)
(letrec (letrec
((#,'rename (let ((wm (make-ephemeron))) ((#,'rename (let ((wm (make-ephemeron-table)))
(lambda (x) (lambda (x)
(let ((y (wm x))) (let ((y (wm x)))
(if y (if y

118
lib/boot.c → lib/ext/boot.c
View File

@ -152,65 +152,65 @@ static const char boot_rom[][80] = {
"pr)))) ((vector? expr) (list (the 'list->vector) (qq depth (vector->list expr)))", "pr)))) ((vector? expr) (list (the 'list->vector) (qq depth (vector->list expr)))",
") ((identifier? expr) (rename expr)) (else (list (the 'quote) expr)))) (let ((bo", ") ((identifier? expr) (rename expr)) (else (list (the 'quote) expr)))) (let ((bo",
"dy (qq 1 (cadr form)))) `(,(the 'let) ,(map cdr renames) ,body)))))) (define (tr", "dy (qq 1 (cadr form)))) `(,(the 'let) ,(map cdr renames) ,body)))))) (define (tr",
"ansformer f) (lambda (form env) (let ((ephemeron1 (make-ephemeron)) (ephemeron2 ", "ansformer f) (lambda (form env) (let ((ephemeron1 (make-ephemeron-table)) (ephem",
"(make-ephemeron))) (letrec ((wrap (lambda (var1) (let ((var2 (ephemeron1 var1)))", "eron2 (make-ephemeron-table))) (letrec ((wrap (lambda (var1) (let ((var2 (epheme",
" (if var2 (cdr var2) (let ((var2 (make-identifier var1 env))) (ephemeron1 var1 v", "ron1 var1))) (if var2 (cdr var2) (let ((var2 (make-identifier var1 env))) (ephem",
"ar2) (ephemeron2 var2 var1) var2))))) (unwrap (lambda (var2) (let ((var1 (epheme", "eron1 var1 var2) (ephemeron2 var2 var1) var2))))) (unwrap (lambda (var2) (let ((",
"ron2 var2))) (if var1 (cdr var1) var2)))) (walk (lambda (f form) (cond ((identif", "var1 (ephemeron2 var2))) (if var1 (cdr var1) var2)))) (walk (lambda (f form) (co",
"ier? form) (f form)) ((pair? form) (cons (walk f (car form)) (walk f (cdr form))", "nd ((identifier? form) (f form)) ((pair? form) (cons (walk f (car form)) (walk f",
")) ((vector? form) (list->vector (walk f (vector->list form)))) (else form))))) ", " (cdr form)))) ((vector? form) (list->vector (walk f (vector->list form)))) (els",
"(let ((form (cdr form))) (walk unwrap (apply f (walk wrap form)))))))) (define-m", "e form))))) (let ((form (cdr form))) (walk unwrap (apply f (walk wrap form))))))",
"acro define-syntax (lambda (form env) (let ((formal (car (cdr form))) (body (cdr", ")) (define-macro define-syntax (lambda (form env) (let ((formal (car (cdr form))",
" (cdr form)))) (if (pair? formal) `(,(the 'define-syntax) ,(car formal) (,the-la", ") (body (cdr (cdr form)))) (if (pair? formal) `(,(the 'define-syntax) ,(car form",
"mbda ,(cdr formal) ,@body)) `(,the-define-macro ,formal (,(the 'transformer) (,t", "al) (,the-lambda ,(cdr formal) ,@body)) `(,the-define-macro ,formal (,(the 'tran",
"he-begin ,@body))))))) (define-macro letrec-syntax (lambda (form env) (let ((for", "sformer) (,the-begin ,@body))))))) (define-macro letrec-syntax (lambda (form env",
"mal (car (cdr form))) (body (cdr (cdr form)))) `(let () ,@(map (lambda (x) `(,(t", ") (let ((formal (car (cdr form))) (body (cdr (cdr form)))) `(let () ,@(map (lamb",
"he 'define-syntax) ,(car x) ,(cadr x))) formal) ,@body)))) (define-macro let-syn", "da (x) `(,(the 'define-syntax) ,(car x) ,(cadr x))) formal) ,@body)))) (define-m",
"tax (lambda (form env) `(,(the 'letrec-syntax) ,@(cdr form)))) (define (mangle n", "acro let-syntax (lambda (form env) `(,(the 'letrec-syntax) ,@(cdr form)))) (defi",
"ame) (when (null? name) (error \"library name should be a list of at least one sy", "ne (mangle name) (when (null? name) (error \"library name should be a list of at ",
"mbols\" name)) (define (->string n) (cond ((symbol? n) (let ((str (symbol->string", "least one symbols\" name)) (define (->string n) (cond ((symbol? n) (let ((str (sy",
" n))) (string-for-each (lambda (c) (when (or (char=? c #\\.) (char=? c #\\/)) (err", "mbol->string n))) (string-for-each (lambda (c) (when (or (char=? c #\\.) (char=? ",
"or \"elements of library name may not contain '.' or '/'\" n))) str) str)) ((and (", "c #\\/)) (error \"elements of library name may not contain '.' or '/'\" n))) str) s",
"number? n) (exact? n)) (number->string n)) (else (error \"symbol or integer is re", "tr)) ((and (number? n) (exact? n)) (number->string n)) (else (error \"symbol or i",
"quired\" n)))) (define (join strs delim) (let loop ((res (car strs)) (strs (cdr s", "nteger is required\" n)))) (define (join strs delim) (let loop ((res (car strs)) ",
"trs))) (if (null? strs) res (loop (string-append res delim (car strs)) (cdr strs", "(strs (cdr strs))) (if (null? strs) res (loop (string-append res delim (car strs",
"))))) (join (map ->string name) \".\")) (define-macro define-library (lambda (form", ")) (cdr strs))))) (join (map ->string name) \".\")) (define-macro define-library (",
" _) (let ((lib (mangle (cadr form))) (body (cddr form))) (or (find-library lib) ", "lambda (form _) (let ((lib (mangle (cadr form))) (body (cddr form))) (or (find-l",
"(make-library lib)) (for-each (lambda (expr) (eval expr lib)) body)))) (define-m", "ibrary lib) (make-library lib)) (for-each (lambda (expr) (eval expr lib)) body))",
"acro cond-expand (lambda (form _) (letrec ((test (lambda (form) (or (eq? form 'e", ")) (define-macro cond-expand (lambda (form _) (letrec ((test (lambda (form) (or ",
"lse) (and (symbol? form) (memq form (features))) (and (pair? form) (case (car fo", "(eq? form 'else) (and (symbol? form) (memq form (features))) (and (pair? form) (",
"rm) ((library) (find-library (mangle (cadr form)))) ((not) (not (test (cadr form", "case (car form) ((library) (find-library (mangle (cadr form)))) ((not) (not (tes",
")))) ((and) (let loop ((form (cdr form))) (or (null? form) (and (test (car form)", "t (cadr form)))) ((and) (let loop ((form (cdr form))) (or (null? form) (and (tes",
") (loop (cdr form)))))) ((or) (let loop ((form (cdr form))) (and (pair? form) (o", "t (car form)) (loop (cdr form)))))) ((or) (let loop ((form (cdr form))) (and (pa",
"r (test (car form)) (loop (cdr form)))))) (else #f))))))) (let loop ((clauses (c", "ir? form) (or (test (car form)) (loop (cdr form)))))) (else #f))))))) (let loop ",
"dr form))) (if (null? clauses) #undefined (if (test (caar clauses)) `(,the-begin", "((clauses (cdr form))) (if (null? clauses) #undefined (if (test (caar clauses)) ",
" ,@(cdar clauses)) (loop (cdr clauses)))))))) (define-macro import (lambda (form", "`(,the-begin ,@(cdar clauses)) (loop (cdr clauses)))))))) (define-macro import (",
" _) (let ((caddr (lambda (x) (car (cdr (cdr x))))) (prefix (lambda (prefix symbo", "lambda (form _) (let ((caddr (lambda (x) (car (cdr (cdr x))))) (prefix (lambda (",
"l) (string->symbol (string-append (symbol->string prefix) (symbol->string symbol", "prefix symbol) (string->symbol (string-append (symbol->string prefix) (symbol->s",
"))))) (getlib (lambda (name) (let ((lib (mangle name))) (if (find-library lib) l", "tring symbol))))) (getlib (lambda (name) (let ((lib (mangle name))) (if (find-li",
"ib (error \"library not found\" name)))))) (letrec ((extract (lambda (spec) (case ", "brary lib) lib (error \"library not found\" name)))))) (letrec ((extract (lambda (",
"(car spec) ((only rename prefix except) (extract (cadr spec))) (else (getlib spe", "spec) (case (car spec) ((only rename prefix except) (extract (cadr spec))) (else",
"c))))) (collect (lambda (spec) (case (car spec) ((only) (let ((alist (collect (c", " (getlib spec))))) (collect (lambda (spec) (case (car spec) ((only) (let ((alist",
"adr spec)))) (map (lambda (var) (assq var alist)) (cddr spec)))) ((rename) (let ", " (collect (cadr spec)))) (map (lambda (var) (assq var alist)) (cddr spec)))) ((r",
"((alist (collect (cadr spec))) (renames (map (lambda (x) `((car x) cadr x)) (cdd", "ename) (let ((alist (collect (cadr spec))) (renames (map (lambda (x) `((car x) c",
"r spec)))) (map (lambda (s) (or (assq (car s) renames) s)) alist))) ((prefix) (l", "adr x)) (cddr spec)))) (map (lambda (s) (or (assq (car s) renames) s)) alist))) ",
"et ((alist (collect (cadr spec)))) (map (lambda (s) (cons (prefix (caddr spec) (", "((prefix) (let ((alist (collect (cadr spec)))) (map (lambda (s) (cons (prefix (c",
"car s)) (cdr s))) alist))) ((except) (let ((alist (collect (cadr spec)))) (let l", "addr spec) (car s)) (cdr s))) alist))) ((except) (let ((alist (collect (cadr spe",
"oop ((alist alist)) (if (null? alist) '() (if (memq (caar alist) (cddr spec)) (l", "c)))) (let loop ((alist alist)) (if (null? alist) '() (if (memq (caar alist) (cd",
"oop (cdr alist)) (cons (car alist) (loop (cdr alist)))))))) (else (map (lambda (", "dr spec)) (loop (cdr alist)) (cons (car alist) (loop (cdr alist)))))))) (else (m",
"x) (cons x x)) (library-exports (getlib spec)))))))) (letrec ((import (lambda (s", "ap (lambda (x) (cons x x)) (library-exports (getlib spec)))))))) (letrec ((impor",
"pec) (let ((lib (extract spec)) (alist (collect spec))) (for-each (lambda (slot)", "t (lambda (spec) (let ((lib (extract spec)) (alist (collect spec))) (for-each (l",
" (library-import lib (cdr slot) (car slot))) alist))))) (for-each import (cdr fo", "ambda (slot) (library-import lib (cdr slot) (car slot))) alist))))) (for-each im",
"rm))))))) (define-macro export (lambda (form _) (letrec ((collect (lambda (spec)", "port (cdr form))))))) (define-macro export (lambda (form _) (letrec ((collect (l",
" (cond ((symbol? spec) `(,spec unquote spec)) ((and (list? spec) (= (length spec", "ambda (spec) (cond ((symbol? spec) `(,spec unquote spec)) ((and (list? spec) (= ",
") 3) (eq? (car spec) 'rename)) `(,(list-ref spec 1) unquote (list-ref spec 2))) ", "(length spec) 3) (eq? (car spec) 'rename)) `(,(list-ref spec 1) unquote (list-re",
"(else (error \"malformed export\"))))) (export (lambda (spec) (let ((slot (collect", "f spec 2))) (else (error \"malformed export\"))))) (export (lambda (spec) (let ((s",
" spec))) (library-export (car slot) (cdr slot)))))) (for-each export (cdr form))", "lot (collect spec))) (library-export (car slot) (cdr slot)))))) (for-each export",
"))) (export define lambda quote set! if begin define-macro let let* letrec letre", " (cdr form))))) (export define lambda quote set! if begin define-macro let let* ",
"c* let-values let*-values define-values quasiquote unquote unquote-splicing and ", "letrec letrec* let-values let*-values define-values quasiquote unquote unquote-s",
"or cond case else => do when unless parameterize define-syntax syntax-quote synt", "plicing and or cond case else => do when unless parameterize define-syntax synta",
"ax-unquote syntax-quasiquote syntax-unquote-splicing let-syntax letrec-syntax sy", "x-quote syntax-unquote syntax-quasiquote syntax-unquote-splicing let-syntax letr",
"ntax-error) ", "ec-syntax syntax-error) ",
}; };
void void

4
lib/weak.c
View File

@ -97,7 +97,7 @@ weak_call(pic_state *pic)
} }
static pic_value static pic_value
pic_weak_make_ephemeron(pic_state *pic) pic_weak_make_ephemeron_table(pic_state *pic)
{ {
pic_get_args(pic, ""); pic_get_args(pic, "");
@ -107,5 +107,5 @@ pic_weak_make_ephemeron(pic_state *pic)
void void
pic_init_weak(pic_state *pic) 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);
} }

4
piclib/boot.scm
View File

@ -477,8 +477,8 @@
(define (transformer f) (define (transformer f)
(lambda (form env) (lambda (form env)
(let ((ephemeron1 (make-ephemeron)) (let ((ephemeron1 (make-ephemeron-table))
(ephemeron2 (make-ephemeron))) (ephemeron2 (make-ephemeron-table)))
(letrec (letrec
((wrap (lambda (var1) ((wrap (lambda (var1)
(let ((var2 (ephemeron1 var1))) (let ((var2 (ephemeron1 var1)))