From 271a4b65865666de31c002d8bb6221b8423d228c Mon Sep 17 00:00:00 2001 From: Yuichi Nishiwaki Date: Wed, 10 Feb 2016 21:57:20 +0900 Subject: [PATCH] make-register -> make-ephemeron --- contrib/10.attribute/attr.scm | 2 +- contrib/10.macro/macro.scm | 30 +++--- contrib/20.r7rs/scheme/base.scm | 6 +- extlib/benz/boot.c | 170 ++++++++++++++++---------------- extlib/benz/include/picrin.h | 2 +- extlib/benz/weak.c | 8 +- 6 files changed, 109 insertions(+), 109 deletions(-) diff --git a/contrib/10.attribute/attr.scm b/contrib/10.attribute/attr.scm index dc80cd72..b342a1ca 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-register)) + (define attribute-table (make-ephemeron)) (define (attribute obj) (let ((r (attribute-table obj))) diff --git a/contrib/10.macro/macro.scm b/contrib/10.macro/macro.scm index 5d621946..b7c74388 100644 --- a/contrib/10.macro/macro.scm +++ b/contrib/10.macro/macro.scm @@ -40,13 +40,13 @@ (define (make-syntactic-closure env free form) (letrec - ((wrap (let ((register (make-register))) + ((wrap (let ((ephemeron (make-ephemeron))) (lambda (var) - (let ((id (register var))) + (let ((id (ephemeron var))) (if id (cdr id) (let ((id (make-identifier var env))) - (register var id) + (ephemeron var id) id)))))) (walk (lambda (f form) (cond @@ -102,13 +102,13 @@ (define (er-transformer f) (lambda (form use-env mac-env) (letrec - ((rename (let ((register (make-register))) + ((rename (let ((ephemeron (make-ephemeron))) (lambda (var) - (let ((id (register var))) + (let ((id (ephemeron var))) (if id (cdr id) (let ((id (make-identifier var mac-env))) - (register var id) + (ephemeron var id) id)))))) (compare (lambda (x y) (identifier=? @@ -118,27 +118,27 @@ (define (ir-transformer f) (lambda (form use-env mac-env) - (let ((register1 (make-register)) - (register2 (make-register))) + (let ((ephemeron1 (make-ephemeron)) + (ephemeron2 (make-ephemeron))) (letrec ((inject (lambda (var1) - (let ((var2 (register1 var1))) + (let ((var2 (ephemeron1 var1))) (if var2 (cdr var2) (let ((var2 (make-identifier var1 use-env))) - (register1 var1 var2) - (register2 var2 var1) + (ephemeron1 var1 var2) + (ephemeron2 var2 var1) var2))))) - (rename (let ((register (make-register))) + (rename (let ((ephemeron (make-ephemeron))) (lambda (var) - (let ((id (register var))) + (let ((id (ephemeron var))) (if id (cdr id) (let ((id (make-identifier var mac-env))) - (register var id) + (ephemeron var id) id)))))) (flip (lambda (var2) ; unwrap if injected, wrap if not injected - (let ((var1 (register2 var2))) + (let ((var1 (ephemeron2 var2))) (if var1 (cdr var1) (rename var2))))) diff --git a/contrib/20.r7rs/scheme/base.scm b/contrib/20.r7rs/scheme/base.scm index 30d2bacb..1d722289 100644 --- a/contrib/20.r7rs/scheme/base.scm +++ b/contrib/20.r7rs/scheme/base.scm @@ -360,13 +360,13 @@ #`(call-with-current-environment (lambda (env) (letrec - ((#,'rename (let ((reg (make-register))) + ((#,'rename (let ((wm (make-ephemeron))) (lambda (x) - (let ((y (reg x))) + (let ((y (wm x))) (if y (cdr y) (let ((id (make-identifier x env))) - (reg x id) + (wm x id) id))))))) (lambda #,'it #,(compile-rules rules)))))) diff --git a/extlib/benz/boot.c b/extlib/benz/boot.c index a134987a..8dff52fe 100644 --- a/extlib/benz/boot.c +++ b/extlib/benz/boot.c @@ -488,19 +488,19 @@ my $src = <<'EOL'; (define (transformer f) (lambda (form env) - (let ((register1 (make-register)) - (register2 (make-register))) + (let ((ephemeron1 (make-ephemeron)) + (ephemeron2 (make-ephemeron))) (letrec ((wrap (lambda (var1) - (let ((var2 (register1 var1))) + (let ((var2 (ephemeron1 var1))) (if var2 (cdr var2) (let ((var2 (make-identifier var1 env))) - (register1 var1 var2) - (register2 var2 var1) + (ephemeron1 var1 var2) + (ephemeron2 var2 var1) var2))))) (unwrap (lambda (var2) - (let ((var1 (register2 var2))) + (let ((var1 (ephemeron2 var2))) (if var1 (cdr var1) var2)))) @@ -925,85 +925,85 @@ const char pic_boot[][80] = { "? expr)\n (rename expr))\n ;; simple datum\n (else\n ", " (list (the 'quote) expr))))\n\n (let ((body (qq 1 (cadr form))))", "\n `(,(the 'let)\n ,(map cdr renames)\n ,body))))))\n", -"\n(define (transformer f)\n (lambda (form env)\n (let ((register1 (make-registe", -"r))\n (register2 (make-register)))\n (letrec\n ((wrap (lambd", -"a (var1)\n (let ((var2 (register1 var1)))\n ", -"(if var2\n (cdr var2)\n (let ((var", -"2 (make-identifier var1 env)))\n (register1 var1 var2)\n", -" (register2 var2 var1)\n var2", -")))))\n (unwrap (lambda (var2)\n (let ((var1 (regist", -"er2 var2)))\n (if var1\n (cdr var1", -")\n var2))))\n (walk (lambda (f form)\n ", -" (cond\n ((identifier? form)\n (f", -" form))\n ((pair? form)\n (cons (walk f (ca", -"r form)) (walk f (cdr form))))\n ((vector? form)\n ", -" (list->vector (walk f (vector->list form))))\n (else\n ", -" form)))))\n (let ((form (cdr form)))\n (walk u", -"nwrap (apply f (walk wrap form))))))))\n\n(define-macro define-syntax\n (lambda (f", -"orm env)\n (let ((formal (car (cdr form)))\n (body (cdr (cdr form)))", -")\n (if (pair? formal)\n `(,(the 'define-syntax) ,(car formal) (,the", -"-lambda ,(cdr formal) ,@body))\n `(,the-define-macro ,formal (,(the 'tra", -"nsformer) (,the-begin ,@body)))))))\n\n(define-macro letrec-syntax\n (lambda (form", -" env)\n (let ((formal (car (cdr form)))\n (body (cdr (cdr form))))\n ", -" `(let ()\n ,@(map (lambda (x)\n `(,(the 'define-synt", -"ax) ,(car x) ,(cadr x)))\n formal)\n ,@body))))\n\n(define-ma", -"cro let-syntax\n (lambda (form env)\n `(,(the 'letrec-syntax) ,@(cdr form))))\n", -"\n\n;;; library primitives\n\n(define-macro define-library\n (lambda (form _)\n (l", -"et ((name (cadr form))\n (body (cddr form)))\n (let ((new-library (o", -"r (find-library name) (make-library name))))\n (for-each (lambda (expr) (e", -"val expr new-library)) body)))))\n\n(define-macro cond-expand\n (lambda (form _)\n ", -" (letrec\n ((test (lambda (form)\n (or\n ", -"(eq? form 'else)\n (and (symbol? form)\n (m", -"emq form (features)))\n (and (pair? form)\n ", -" (case (car form)\n ((library) (find-library (cadr form))", -")\n ((not) (not (test (cadr form))))\n ", -" ((and) (let loop ((form (cdr form)))\n (or ", -"(null? form)\n (and (test (car form)) (loop ", -"(cdr form))))))\n ((or) (let loop ((form (cdr form)))\n ", -" (and (pair? form)\n ", -" (or (test (car form)) (loop (cdr form))))))\n (else", -" #f)))))))\n (let loop ((clauses (cdr form)))\n (if (null? clauses)\n ", -" #undefined\n (if (test (caar clauses))\n `(,th", -"e-begin ,@(cdar clauses))\n (loop (cdr clauses))))))))\n\n(define-ma", -"cro import\n (lambda (form _)\n (let ((caddr\n (lambda (x) (car (cdr ", -"(cdr x)))))\n (prefix\n (lambda (prefix symbol)\n (s", -"tring->symbol\n (string-append\n (symbol->string prefix", -")\n (symbol->string symbol))))))\n (letrec\n ((extract\n", -" (lambda (spec)\n (case (car spec)\n ((only", -" rename prefix except)\n (extract (cadr spec)))\n (", -"else\n (or (find-library spec) (error \"library not found\" spec)))", -")))\n (collect\n (lambda (spec)\n (case (car spec", -")\n ((only)\n (let ((alist (collect (cadr spec))))\n", -" (map (lambda (var) (assq var alist)) (cddr spec))))\n ", -" ((rename)\n (let ((alist (collect (cadr spec)))\n ", -" (renames (map (lambda (x) `((car x) . (cadr x))) (cddr spec))))\n ", -" (map (lambda (s) (or (assq (car s) renames) s)) alist)))\n ", -" ((prefix)\n (let ((alist (collect (cadr spec))))\n ", -" (map (lambda (s) (cons (prefix (caddr spec) (car s)) (cdr s))) alist", -")))\n ((except)\n (let ((alist (collect (cadr spec)", -")))\n (let loop ((alist alist))\n (if (null?", -" alist)\n '()\n (if (memq (caar al", -"ist) (cddr spec))\n (loop (cdr alist))\n ", -" (cons (car alist) (loop (cdr alist))))))))\n (else\n", -" (let ((lib (or (find-library spec) (error \"library not found\" s", -"pec))))\n (map (lambda (x) (cons x x)) (library-exports lib))))", -"))))\n (letrec\n ((import\n (lambda (spec)\n ", -" (let ((lib (extract spec))\n (alist (collect spec)", -"))\n (for-each\n (lambda (slot)\n ", -" (library-import lib (cdr slot) (car slot)))\n alist))", -")))\n (for-each import (cdr form)))))))\n\n(define-macro export\n (lambda ", -"(form _)\n (letrec\n ((collect\n (lambda (spec)\n (con", -"d\n ((symbol? spec)\n `(,spec . ,spec))\n ((an", -"d (list? spec) (= (length spec) 3) (eq? (car spec) 'rename))\n `(,(l", -"ist-ref spec 1) . ,(list-ref spec 2)))\n (else\n (error \"", -"malformed export\")))))\n (export\n (lambda (spec)\n (", -"let ((slot (collect spec)))\n (library-export (car slot) (cdr slot)", -")))))\n (for-each export (cdr form)))))\n\n(export define lambda quote set! if", -" begin define-macro\n let let* letrec letrec*\n let-values let*-valu", -"es define-values\n quasiquote unquote unquote-splicing\n and or\n ", -" cond case else =>\n do when unless\n parameterize\n define", -"-syntax\n syntax-quote syntax-unquote\n syntax-quasiquote syntax-unq", -"uote-splicing\n let-syntax letrec-syntax\n syntax-error)\n\n\n", +"\n(define (transformer f)\n (lambda (form env)\n (let ((ephemeron1 (make-epheme", +"ron))\n (ephemeron2 (make-ephemeron)))\n (letrec\n ((wrap (l", +"ambda (var1)\n (let ((var2 (ephemeron1 var1)))\n ", +" (if var2\n (cdr var2)\n (let ", +"((var2 (make-identifier var1 env)))\n (ephemeron1 var1 ", +"var2)\n (ephemeron2 var2 var1)\n ", +" var2)))))\n (unwrap (lambda (var2)\n (let ((var1 ", +"(ephemeron2 var2)))\n (if var1\n (", +"cdr var1)\n var2))))\n (walk (lambda (f form)\n", +" (cond\n ((identifier? form)\n ", +" (f form))\n ((pair? form)\n (cons (wa", +"lk f (car form)) (walk f (cdr form))))\n ((vector? form)\n ", +" (list->vector (walk f (vector->list form))))\n ", +" (else\n form)))))\n (let ((form (cdr form)))\n ", +" (walk unwrap (apply f (walk wrap form))))))))\n\n(define-macro define-syntax\n (l", +"ambda (form env)\n (let ((formal (car (cdr form)))\n (body (cdr (cdr", +" form))))\n (if (pair? formal)\n `(,(the 'define-syntax) ,(car forma", +"l) (,the-lambda ,(cdr formal) ,@body))\n `(,the-define-macro ,formal (,(", +"the 'transformer) (,the-begin ,@body)))))))\n\n(define-macro letrec-syntax\n (lamb", +"da (form env)\n (let ((formal (car (cdr form)))\n (body (cdr (cdr fo", +"rm))))\n `(let ()\n ,@(map (lambda (x)\n `(,(the 'def", +"ine-syntax) ,(car x) ,(cadr x)))\n formal)\n ,@body))))\n\n(d", +"efine-macro let-syntax\n (lambda (form env)\n `(,(the 'letrec-syntax) ,@(cdr f", +"orm))))\n\n\n;;; library primitives\n\n(define-macro define-library\n (lambda (form _", +")\n (let ((name (cadr form))\n (body (cddr form)))\n (let ((new-li", +"brary (or (find-library name) (make-library name))))\n (for-each (lambda (", +"expr) (eval expr new-library)) body)))))\n\n(define-macro cond-expand\n (lambda (f", +"orm _)\n (letrec\n ((test (lambda (form)\n (or\n ", +" (eq? form 'else)\n (and (symbol? form)\n ", +" (memq form (features)))\n (and (pair? form)\n ", +" (case (car form)\n ((library) (find-library (cad", +"r form)))\n ((not) (not (test (cadr form))))\n ", +" ((and) (let loop ((form (cdr form)))\n ", +" (or (null? form)\n (and (test (car form)", +") (loop (cdr form))))))\n ((or) (let loop ((form (cdr for", +"m)))\n (and (pair? form)\n ", +" (or (test (car form)) (loop (cdr form))))))\n ", +" (else #f)))))))\n (let loop ((clauses (cdr form)))\n (if (null? cla", +"uses)\n #undefined\n (if (test (caar clauses))\n ", +" `(,the-begin ,@(cdar clauses))\n (loop (cdr clauses))))))))\n\n(d", +"efine-macro import\n (lambda (form _)\n (let ((caddr\n (lambda (x) (c", +"ar (cdr (cdr x)))))\n (prefix\n (lambda (prefix symbol)\n ", +" (string->symbol\n (string-append\n (symbol->strin", +"g prefix)\n (symbol->string symbol))))))\n (letrec\n ((", +"extract\n (lambda (spec)\n (case (car spec)\n ", +" ((only rename prefix except)\n (extract (cadr spec)))\n ", +" (else\n (or (find-library spec) (error \"library not found\"", +" spec))))))\n (collect\n (lambda (spec)\n (case (", +"car spec)\n ((only)\n (let ((alist (collect (cadr s", +"pec))))\n (map (lambda (var) (assq var alist)) (cddr spec))))\n ", +" ((rename)\n (let ((alist (collect (cadr spec)))\n ", +" (renames (map (lambda (x) `((car x) . (cadr x))) (cddr spec", +"))))\n (map (lambda (s) (or (assq (car s) renames) s)) alist)))", +"\n ((prefix)\n (let ((alist (collect (cadr spec))))", +"\n (map (lambda (s) (cons (prefix (caddr spec) (car s)) (cdr s)", +")) alist)))\n ((except)\n (let ((alist (collect (ca", +"dr spec))))\n (let loop ((alist alist))\n (i", +"f (null? alist)\n '()\n (if (memq ", +"(caar alist) (cddr spec))\n (loop (cdr alist))\n ", +" (cons (car alist) (loop (cdr alist))))))))\n ", +" (else\n (let ((lib (or (find-library spec) (error \"library not ", +"found\" spec))))\n (map (lambda (x) (cons x x)) (library-exports", +" lib))))))))\n (letrec\n ((import\n (lambda (spec)\n", +" (let ((lib (extract spec))\n (alist (colle", +"ct spec)))\n (for-each\n (lambda (slot)\n ", +" (library-import lib (cdr slot) (car slot)))\n ", +" alist)))))\n (for-each import (cdr form)))))))\n\n(define-macro export\n ", +"(lambda (form _)\n (letrec\n ((collect\n (lambda (spec)\n ", +" (cond\n ((symbol? spec)\n `(,spec . ,spec))\n ", +" ((and (list? spec) (= (length spec) 3) (eq? (car spec) 'rename))\n ", +" `(,(list-ref spec 1) . ,(list-ref spec 2)))\n (else\n ", +"(error \"malformed export\")))))\n (export\n (lambda (spec)\n ", +" (let ((slot (collect spec)))\n (library-export (car slot) (c", +"dr slot))))))\n (for-each export (cdr form)))))\n\n(export define lambda quote", +" set! if begin define-macro\n let let* letrec letrec*\n let-values l", +"et*-values define-values\n quasiquote unquote unquote-splicing\n and", +" or\n cond case else =>\n do when unless\n parameterize\n ", +" define-syntax\n syntax-quote syntax-unquote\n syntax-quasiquote sy", +"ntax-unquote-splicing\n let-syntax letrec-syntax\n syntax-error)\n\n\n", "", "" }; diff --git a/extlib/benz/include/picrin.h b/extlib/benz/include/picrin.h index 36a56a34..88ed0176 100644 --- a/extlib/benz/include/picrin.h +++ b/extlib/benz/include/picrin.h @@ -87,7 +87,7 @@ struct pic_state { pic_code *ip; - pic_value ptable; /* list of registers */ + pic_value ptable; /* list of ephemerons */ struct pic_lib *lib, *prev_lib; diff --git a/extlib/benz/weak.c b/extlib/benz/weak.c index 353b5a76..196846b8 100644 --- a/extlib/benz/weak.c +++ b/extlib/benz/weak.c @@ -72,7 +72,7 @@ pic_weak_del(pic_state *pic, struct pic_weak *weak, void *key) it = kh_get(weak, h, key); if (it == kh_end(h)) { - pic_errorf(pic, "no slot named ~s found in register", pic_obj_value(key)); + pic_errorf(pic, "no slot named ~s found in ephemeron", pic_obj_value(key)); } kh_del(weak, h, it); } @@ -112,7 +112,7 @@ weak_call(pic_state *pic) n = pic_get_args(pic, "&o|o", &self, &key, &val); if (! pic_obj_p(key)) { - pic_errorf(pic, "attempted to set a non-object key '~s' in a register", key); + pic_errorf(pic, "attempted to set a non-object key '~s' in an ephemeron", key); } weak = pic_weak_ptr(pic_proc_env_ref(pic, self, "weak")); @@ -125,7 +125,7 @@ weak_call(pic_state *pic) } static pic_value -pic_weak_make_register(pic_state *pic) +pic_weak_make_ephemeron(pic_state *pic) { struct pic_weak *weak; struct pic_proc *proc; @@ -144,5 +144,5 @@ pic_weak_make_register(pic_state *pic) void pic_init_weak(pic_state *pic) { - pic_defun(pic, "make-register", pic_weak_make_register); + pic_defun(pic, "make-ephemeron", pic_weak_make_ephemeron); }