From a85de7ff73c9c0e2bdb920dbe86f41ae550d6035 Mon Sep 17 00:00:00 2001
From: stibear <stibear1996@gmail.com>
Date: Sat, 30 Aug 2014 14:42:35 +0900
Subject: [PATCH] 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))