From oleg@pobox.com Tue Jul 07 16:18:18 1998
Path: News.CoLi.Uni-SB.DE! news.phil.uni-sb.de! wuff.mayn.de! news-nue1.dfn.de! news-mue1.dfn.de! news-stu1.dfn.de! news-kar1.dfn.de! news-was.dfn.de! nntp-out.monmouth.com! newspeer.monmouth.com! nntp2.dejanews.com! nnrp1.dejanews.com!not-for-mail
From: oleg@pobox.com Newsgroups: comp.lang.scheme Subject: setf -- a polymorphic, generic setter -- as a simple Scheme macro Date: Tue, 07 Jul 1998 16:18:18 GMT Organization: Deja News - The Leader in Internet Discussion Message-ID: <6nthoa$bvr$1@nnrp1.dejanews.com> Reply-To: oleg@pobox.com Summary: LISP's setf as a Scheme macro Keywords: polymorphism, setter, overloading, generic function, Scheme, LISP, macro X-Article-Creation-Date: Tue Jul 07 16:18:18 1998 GMT X-Http-User-Agent: Mozilla/4.05 (Macintosh; I; PPC, Nav) Xref: News.CoLi.Uni-SB.DE comp.lang.scheme:22273 Xcanpos: shelf.ccd0/199807172201!0005604418
This is to discuss how a LISP-like setf form can be used and implemented in Scheme. First, allow me to show a few examples of setf! usage:
> (define al '((1 "one") (2 "two")))
> (assv 1 al)
(1 "one")
> (setf! (cadr (assv 1 al)) "-one-")
> (assv 1 al)
(1 "-one-")
> (setf! (car (assv 1 al)) 3)
> (assv 1 al)
#f
> al
((3 "-one-") (2 "two"))
>
> (define s (string-append "abcd" ""))
> (string-ref s 1)
#\b
> (setf! (string-ref s 1) #\B)
> s
"aBcd"
>
> (define v (vector 1 2 '() ""))
> (vector-ref v 2)
()
> (setf! (vector-ref v 2) (list (vector-ref v 3) 3))
> v
#(1 2 ("" 3) "")
>
; a more elaborate, and admittedly, contrived, example
> (define tree #f)
> (setf! tree '((a . b) . (c . (e . f))))
(define (tree-ref tree . dirs)
(if (null? dirs) tree
(apply tree-ref (cons (if (car dirs) (cdr tree) (car tree)) (cdr dirs)))))
(define (tree-set! tree dirval1 dirval2 . dirs)
(if (null? dirs) ((if dirval1 set-cdr! set-car!) tree dirval2)
(apply tree-set! (cons (if dirval1 (cdr tree) (car tree))
(cons dirval2 dirs)))))
> (tree-ref tree #f #f)
a
> (setf! (tree-ref tree #f #f) 'x)
> (tree-ref tree #f #f)
x
> (tree-ref tree #f)
(x . b)
; the following prunes the tree
> (setf! (tree-ref tree #f) 'leaf)
> (tree-ref tree #f)
leaf
; and the following grows it back
> (setf! (tree-ref tree #f) '((z . u) . v))
> (tree-ref tree #f #f #t)
u
>
The setf! form is implemented as a Scheme macro. The following table
shows code re-writing it performs. The first column tells what one can
enter, while the second column shows what actually is being executed
by a Scheme system after macro expansion:
(setf! (car L) V) ==> (set-car! L V)
(setf! (cdr L) V) ==> (set-cdr! L V)
(setf! (car (cdr L)) V) ==> (set-car! (cdr L) V)
(setf! (cddr L)) V) ==> (set-cdr! (cdr L) V)
(setf! (string-ref s i) c) ==> (string-set! s i c)
(setf! (vector-ref v i) c) ==> (vector-set! v i c)
In general,
(setf! (ANYTHING-ref v ....) c) ==> (ANYTHING-set! v ... c)
where ANYTHING is, well, anything - any combination of allowed characters.
and (setf! X V) ==> (set! X V)
The setf! form is implemented as follows (Gambit-C 3.0):
; setf! - a polymorphic generic setter
(define-macro (setf! F V)
; symbol->string chopping off a trailing -ref if any
(define (-ref-less sym)
(let* ((str (symbol->string sym)) (suffix "-ref")
(s-pos (- (string-length str) (string-length suffix))))
(if (negative? s-pos) str
(let loop ((i 0))
(cond
((>= i (string-length suffix)) (substring str 0 s-pos))
((char=? (string-ref suffix i) (string-ref str (+ i s-pos)))
(loop (+ 1 i)))
(else str))))))
(if (not (pair? F)) `(set! ,F ,V)
(case (car F)
((car) `(set-car! ,@(cdr F) ,V))
((cdr) `(set-cdr! ,@(cdr F) ,V))
((cadr) `(setf! (car (cdr ,@(cdr F))) ,V))
((cddr) `(setf! (cdr (cdr ,@(cdr F))) ,V))
; I need to handle other cadda..vers but I'm tired...
(else `(,(string->symbol (string-append (-ref-less (car F)) "-set!"))
,@(cdr F) ,V)))))
oleg@pobox.com
http://pobox.com/~oleg/ftp/Scheme/
-----== Posted via Deja News, The Leader in Internet Discussion ==-----
http://www.dejanews.com/rg_mkgrp.xp Create Your Own Free
Member Forum