Permalink
Browse files

Added macro FSETF which acts like SETF except that functionally modif…

…ies the

object and sets the symbol to the new value (thus leaving old instances intact).
  • Loading branch information...
smithzvk committed Jun 30, 2011
1 parent 29229d1 commit 665d3b4bd5a5f8babe440a6ccbe082cd17c69f39
Showing with 42 additions and 6 deletions.
  1. +16 −6 modf-test.lisp
  2. +25 −0 modf.lisp
  3. +1 −0 package.lisp
View
@@ -3,9 +3,25 @@
(in-root-suite)
+(deftest run-tests ()
+ (modf-eval-test)
+ (fsetf-tests)
+ (test-lists)
+ (test-arrays)
+ (test-structs)
+ (test-classes) )
+
(deftest modf-eval-test ()
(is (equal '(1 t 3 4) (modf (second (modf-eval '(1 2 3 4))) t))) )
+(deftest fsetf-tests ()
+ (let ((ima '((1 2 3) (4 5 6) (7 8 9))))
+ (fsetf (second ima) 'second)
+ (fsetf (second (first ima)) 'first-second
+ (third ima) 'third )
+ (is (equal '((1 first-second 3) second third)
+ ima )) ))
+
(defsuite* lisp-types)
(deftest test-lists ()
@@ -101,9 +117,3 @@
(is (eql 2 (test-struct1-b (modf (test-struct1-b s1) 2))))
(is (eql -1 (test-struct2-c (modf (test-struct2-c s2) -1)))) ))
-(deftest run-tests ()
- (modf-eval-test)
- (test-lists)
- (test-arrays)
- (test-structs)
- (test-classes) )
View
@@ -259,6 +259,31 @@ form."
(modf ,next-place ,next-value ,@next-more) ))
(modf-expand value place (gensym)) ))
+(defun find-container (place)
+ (cond ((atom place)
+ place )
+ ((gethash (car place) *modf-rewrites*)
+ (find-container (funcall (gethash (car place) *modf-rewrites*) place)) )
+ ((not (expandable? place))
+ (error "You can only use FSETF if you are modfifying a container. I don't have a place to set when given ~A." place) )
+ (t (let ((nth-arg (container-arg-n place)))
+ (unless nth-arg
+ (error "I can't figure out which argument is the container in ~A." place) )
+ (find-container (nth nth-arg place)) ))))
+
+;; <<>>=
+(defmacro fsetf (place value &rest more)
+ ;; First we need to find the "container" variable
+ (let ((container (find-container place)))
+ (with-gensyms (val-sym)
+ (if more
+ `(let ((,val-sym ,value))
+ (setf ,container (modf ,place ,val-sym))
+ (fsetf ,@more) )
+ `(let ((,val-sym ,value))
+ (setf ,container (modf ,place ,val-sym))
+ ,val-sym )))))
+
;; <<>>=
(defmacro modf-eval (&rest args)
`(progn ,@args) )
View
@@ -5,6 +5,7 @@
(:export #:modf
#:modf-eval
#:modf-fn
+ #:fsetf
#:define-modf-rewrite
#:define-modf-function
#:define-modf-method

0 comments on commit 665d3b4

Please sign in to comment.