From 64bcf68692162463a4bdd1077c9ce70244f0c354 Mon Sep 17 00:00:00 2001 From: stibear Date: Mon, 14 Jul 2014 13:16:07 +0900 Subject: [PATCH 1/5] implements srfi-17(generalized-set!) --- piclib/srfi/17.scm | 70 ++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 70 insertions(+) create mode 100644 piclib/srfi/17.scm diff --git a/piclib/srfi/17.scm b/piclib/srfi/17.scm new file mode 100644 index 00000000..dc52063b --- /dev/null +++ b/piclib/srfi/17.scm @@ -0,0 +1,70 @@ +(define-library (srfi 17) + + (define-library (rename set!) + (import (scheme base)) + (export (rename set! %set!) + define + quasiquote + letrec + let + error + apply + define-syntax + syntax-rules + lambda + if + quote + begin + vector-ref + string-ref + bytevector-u8-ref + vector-set! + string-set! + bytevector-u8-set! + list-set!)) + + (import (rename set!) + (srfi 1)) + + (define-syntax set! + (syntax-rules () + ((_ (proc args ...) val) + ((setter proc) args ... val)) + ((_ var val) + (%set! var val)))) + + (define setter-alist '()) + + (define setter + (letrec ((setter + (lambda (proc) + (let ((probe (assv proc setter-alist))) + (if probe + (cdr probe) + (error "No setter for " proc))))) + (set-setter! + (lambda (proc setter) + (set! setter-alist + (alist-cons proc setter setter-alist))))) + (set-setter! setter set-setter!) + (set-setter! car set-car!) + (set-setter! cdr set-cdr!) + (set-setter! caar (lambda (p v) (set-car! (car p) v))) + (set-setter! cadr (lambda (p v) (set-car! (cdr p) v))) + (set-setter! cdar (lambda (p v) (set-cdr! (car p) v))) + (set-setter! cddr (lambda (p v) (set-cdr! (cdr p) v))) + (set-setter! vector-ref vector-set!) + (set-setter! string-ref string-set!) + (set-setter! bytevector-u8-ref bytevector-u8-set!) + (set-setter! list-ref list-set!) + setter)) + + (define (getter-with-setter get set) + (let ((proc (lambda args (apply get args)))) + (set! (setter proc) set) + proc)) + + (export set! + setter + getter-with-setter + setter-alist)) From 688c41a402be033db2e894d579ccdb702fa7bf00 Mon Sep 17 00:00:00 2001 From: stibear Date: Tue, 15 Jul 2014 22:04:24 +0900 Subject: [PATCH 2/5] Updates CMakeLists.txt --- piclib/CMakeLists.txt | 1 + 1 file changed, 1 insertion(+) diff --git a/piclib/CMakeLists.txt b/piclib/CMakeLists.txt index 43d5ab4a..21712355 100644 --- a/piclib/CMakeLists.txt +++ b/piclib/CMakeLists.txt @@ -22,6 +22,7 @@ list(APPEND PICLIB_SCHEME_LIBS ${PROJECT_SOURCE_DIR}/piclib/srfi/1.scm ${PROJECT_SOURCE_DIR}/piclib/srfi/8.scm + ${PROJECT_SOURCE_DIR}/piclib/srfi/17.scm ${PROJECT_SOURCE_DIR}/piclib/srfi/26.scm ${PROJECT_SOURCE_DIR}/piclib/srfi/43.scm ${PROJECT_SOURCE_DIR}/piclib/srfi/60.scm From a85de7ff73c9c0e2bdb920dbe86f41ae550d6035 Mon Sep 17 00:00:00 2001 From: stibear Date: Sat, 30 Aug 2014 14:42:35 +0900 Subject: [PATCH 3/5] implement by using (picrin attribute) --- piclib/srfi/17.scm | 65 ++++++++++++++-------------------------------- 1 file changed, 20 insertions(+), 45 deletions(-) diff --git a/piclib/srfi/17.scm b/piclib/srfi/17.scm index dc52063b..c070eb16 100644 --- a/piclib/srfi/17.scm +++ b/piclib/srfi/17.scm @@ -1,30 +1,11 @@ (define-library (srfi 17) - (define-library (rename set!) - (import (scheme base)) - (export (rename set! %set!) - define - quasiquote - letrec - let - error - apply - define-syntax - syntax-rules - lambda - if - quote - begin - vector-ref - string-ref - bytevector-u8-ref - vector-set! - string-set! - bytevector-u8-set! - list-set!)) - - (import (rename set!) - (srfi 1)) + (import (except (scheme base) set!) + (rename (prefix (only (scheme base) set!) %)) + (picrin dictionary) + (picrin attribute) + (srfi 1) + (srfi 8)) (define-syntax set! (syntax-rules () @@ -33,30 +14,18 @@ ((_ var val) (%set! var val)))) - (define setter-alist '()) - (define setter (letrec ((setter (lambda (proc) - (let ((probe (assv proc setter-alist))) - (if probe - (cdr probe) - (error "No setter for " proc))))) + (receive (setter exists) (dictionary-ref (attribute proc) + 'setter) + (if exists + setter + (error "No setter found"))))) (set-setter! (lambda (proc setter) - (set! setter-alist - (alist-cons proc setter setter-alist))))) + (dictionary-set! (attribute proc) 'setter setter)))) (set-setter! setter set-setter!) - (set-setter! car set-car!) - (set-setter! cdr set-cdr!) - (set-setter! caar (lambda (p v) (set-car! (car p) v))) - (set-setter! cadr (lambda (p v) (set-car! (cdr p) v))) - (set-setter! cdar (lambda (p v) (set-cdr! (car p) v))) - (set-setter! cddr (lambda (p v) (set-cdr! (cdr p) v))) - (set-setter! vector-ref vector-set!) - (set-setter! string-ref string-set!) - (set-setter! bytevector-u8-ref bytevector-u8-set!) - (set-setter! list-ref list-set!) setter)) (define (getter-with-setter get set) @@ -64,7 +33,13 @@ (set! (setter proc) set) proc)) + (set! (setter car) set-car!) + (set! (setter cdr) set-cdr!) + (set! (setter vector-ref) vector-set!) + (set! (setter string-ref) string-set!) + (set! (setter bytevector-u8-ref) bytevector-u8-set!) + (set! (setter list-ref) list-set!) + (export set! setter - getter-with-setter - setter-alist)) + getter-with-setter)) From 607e961525ee2a76cf298d65203637113429b3ae Mon Sep 17 00:00:00 2001 From: stibear Date: Sat, 30 Aug 2014 15:26:21 +0900 Subject: [PATCH 4/5] fixes small mistakes --- piclib/srfi/17.scm | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/piclib/srfi/17.scm b/piclib/srfi/17.scm index c070eb16..5b3c019d 100644 --- a/piclib/srfi/17.scm +++ b/piclib/srfi/17.scm @@ -1,7 +1,7 @@ (define-library (srfi 17) (import (except (scheme base) set!) - (rename (prefix (only (scheme base) set!) %)) + (prefix (only (scheme base) set!) %) (picrin dictionary) (picrin attribute) (srfi 1) @@ -18,7 +18,7 @@ (letrec ((setter (lambda (proc) (receive (setter exists) (dictionary-ref (attribute proc) - 'setter) + '@@setter) (if exists setter (error "No setter found"))))) From 6a52aa26109ac2650040060430417d662ec86ce7 Mon Sep 17 00:00:00 2001 From: stibear Date: Sat, 30 Aug 2014 15:31:26 +0900 Subject: [PATCH 5/5] setter -> @@setter --- piclib/srfi/17.scm | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/piclib/srfi/17.scm b/piclib/srfi/17.scm index 5b3c019d..eb02e66e 100644 --- a/piclib/srfi/17.scm +++ b/piclib/srfi/17.scm @@ -24,7 +24,7 @@ (error "No setter found"))))) (set-setter! (lambda (proc setter) - (dictionary-set! (attribute proc) 'setter setter)))) + (dictionary-set! (attribute proc) '@@setter setter)))) (set-setter! setter set-setter!) setter))