aboutsummaryrefslogtreecommitdiff
path: root/src/interp/sys-macros.lisp
diff options
context:
space:
mode:
Diffstat (limited to 'src/interp/sys-macros.lisp')
-rw-r--r--src/interp/sys-macros.lisp18
1 files changed, 18 insertions, 0 deletions
diff --git a/src/interp/sys-macros.lisp b/src/interp/sys-macros.lisp
index 3608e2ad..85f5434f 100644
--- a/src/interp/sys-macros.lisp
+++ b/src/interp/sys-macros.lisp
@@ -278,6 +278,24 @@
((EQCAR A 'CDR) (LIST 'RPLACD (CADR A) B))
((ERROR 'RPLAC))))))
+(defmacro |rplac| (&rest L)
+ (let (a b s)
+ (cond
+ ((EQCAR (SETQ A (CAR L)) 'ELT)
+ (COND ((AND (INTEGERP (SETQ B (CADDR A))) (>= B 0))
+ (SETQ S "CA")
+ (do ((i 1 (1+ i))) ((> i b)) (SETQ S (STRCONC S "D")))
+ (LIST 'RPLAC (LIST (INTERN (STRCONC S "R")) (CADR A)) (CADR L)))
+ ((ERROR "rplac"))))
+ ((PROGN
+ (SETQ A (CARCDREXPAND (CAR L) NIL))
+ (SETQ B (CADR L))
+ (COND
+ ((CDDR L) (ERROR 'RPLAC))
+ ((EQCAR A 'CAR) (LIST 'RPLACA (CADR A) B))
+ ((EQCAR A 'CDR) (LIST 'RPLACD (CADR A) B))
+ ((ERROR 'RPLAC))))))))
+
;;
;; -*- Association Lists -*-
;;