Changeset 4161

Timestamp:

10/01/03 17:45:35 (19 years ago)

Author:

piso

Message:

Work in progress.

File:

• trunk/j/src/org/armedbear/lisp/setf.lisp (modified) (3 diffs)

trunk/j/src/org/armedbear/lisp/setf.lisp

@@ -2 +2 @@
 ;;;
 ;;; Copyright (C) 2003 Peter Graves
-;;; $Id: setf.lisp,v 1.29 2003-10-01 14:29:36 piso Exp $
+;;; $Id: setf.lisp,v 1.30 2003-10-01 17:45:35 piso Exp $
 ;;;
 ;;; This program is free software; you can redistribute it and/or
@@ -34 +34 @@
       `(,(car form) ,@vars))))
 
+;;; If a macro, expand one level and try again.  If not, go for the
+;;; SETF function.
+(defun expand-or-get-setf-inverse (form environment)
+  (multiple-value-bind
+    (expansion expanded)
+    (macroexpand-1 form environment)
+    (if expanded
+  (get-setf-expansion expansion environment)
+  (get-setf-method-inverse form `(funcall #'(setf ,(car form)))
+         t))))
+
 (defun get-setf-expansion (form &optional environment)
   (let (temp)
@@ -46 +57 @@
     (t
      (expand-or-get-setf-inverse form environment)))))
-
-;;; If a macro, expand one level and try again.  If not, go for the
-;;; SETF function.
-(defun expand-or-get-setf-inverse (form environment)
-  (multiple-value-bind
-    (expansion expanded)
-    (macroexpand-1 form environment)
-    (if expanded
-  (get-setf-expansion expansion environment)
-  (get-setf-method-inverse form `(funcall #'(setf ,(car form)))
-         t))))
-
-(defun get-setf-method-inverse (form inverse setf-function)
-  (let ((new-var (gensym))
-  (vars nil)
-  (vals nil))
-    (dolist (x (cdr form))
-      (push (gensym) vars)
-      (push x vals))
-    (setq vals (nreverse vals))
-    (values vars vals (list new-var)
-      (if setf-function
-    `(,@inverse ,new-var ,@vars)
-    `(,@inverse ,@vars ,new-var))
-      `(,(car form) ,@vars))))
 
 ;;; ROTATEF (from GCL)