;;;; various DEFSETFs, pulled into one file for convenience in doing
;;;; them as early in the build process as possible so as to avoid
;;;; hassles with invoking SETF FOO before DEFSETF FOO and thus
;;;; compiling a call to some nonexistent function #'(SETF FOO)

;;;; This software is part of the SBCL system. See the README file for
;;;; more information.
;;;;
;;;; This software is derived from the CMU CL system, which was
;;;; written at Carnegie Mellon University and released into the
;;;; public domain. The software is in the public domain and is
;;;; provided with absolutely no warranty. See the COPYING and CREDITS
;;;; files for more information.

(sb!int:/show0 "entering defsetfs.lisp")

;;; from alieneval.lisp
(in-package "SB!ALIEN")
(defsetf slot %set-slot)
(defsetf deref (alien &rest indices) (value)
  `(%set-deref ,alien ,value ,@indices))
(defsetf %heap-alien %set-heap-alien)

;;; from bignum.lisp
(in-package "SB!BIGNUM")
(defsetf %bignum-ref %bignum-set)

;;; from bit-bash.lisp
(in-package "SB!VM")
(defsetf word-sap-ref %set-word-sap-ref)

;;; from debug-int.lisp
(in-package "SB!DI")
(defsetf stack-ref %set-stack-ref)
(defsetf debug-var-value %set-debug-var-value)
(defsetf debug-var-value %set-debug-var-value)
(defsetf breakpoint-info %set-breakpoint-info)

;;; from defstruct.lisp
(in-package "SB!KERNEL")
(defsetf %instance-ref %instance-set)

(defsetf %raw-instance-ref/word %raw-instance-set/word)
(defsetf %raw-instance-ref/single %raw-instance-set/single)
(defsetf %raw-instance-ref/double %raw-instance-set/double)
(defsetf %raw-instance-ref/complex-single %raw-instance-set/complex-single)
(defsetf %raw-instance-ref/complex-double %raw-instance-set/complex-double)

(defsetf %instance-layout %set-instance-layout)
(defsetf %funcallable-instance-info %set-funcallable-instance-info)
(defsetf %funcallable-instance-layout %set-funcallable-instance-layout)

;;; from early-setf.lisp
(in-package "SB!IMPL")

;;; (setf aref/bit/sbit) are implemented using setf-functions,
;;; because they have to work with (setf (apply #'aref array subscripts))
;;; All other setfs can be done using setf-functions too, but I
;;; haven't found technical advantages or disatvantages for either
;;; scheme.
#-sb-xc-host (defsetf car %rplaca)
#-sb-xc-host (defsetf cdr %rplacd)
#-sb-xc-host (defsetf caar (x) (v) `(%rplaca (car ,x) ,v))
#-sb-xc-host (defsetf cadr (x) (v) `(%rplaca (cdr ,x) ,v))
#-sb-xc-host (defsetf cdar (x) (v) `(%rplacd (car ,x) ,v))
#-sb-xc-host (defsetf cddr (x) (v) `(%rplacd (cdr ,x) ,v))
#-sb-xc-host (defsetf caaar (x) (v) `(%rplaca (caar ,x) ,v))
#-sb-xc-host (defsetf cadar (x) (v) `(%rplaca (cdar ,x) ,v))
#-sb-xc-host (defsetf cdaar (x) (v) `(%rplacd (caar ,x) ,v))
#-sb-xc-host (defsetf cddar (x) (v) `(%rplacd (cdar ,x) ,v))
#-sb-xc-host (defsetf caadr (x) (v) `(%rplaca (cadr ,x) ,v))
#-sb-xc-host (defsetf caddr (x) (v) `(%rplaca (cddr ,x) ,v))
#-sb-xc-host (defsetf cdadr (x) (v) `(%rplacd (cadr ,x) ,v))
#-sb-xc-host (defsetf cdddr (x) (v) `(%rplacd (cddr ,x) ,v))
#-sb-xc-host (defsetf caaaar (x) (v) `(%rplaca (caaar ,x) ,v))
#-sb-xc-host (defsetf cadaar (x) (v) `(%rplaca (cdaar ,x) ,v))
#-sb-xc-host (defsetf cdaaar (x) (v) `(%rplacd (caaar ,x) ,v))
#-sb-xc-host (defsetf cddaar (x) (v) `(%rplacd (cdaar ,x) ,v))
#-sb-xc-host (defsetf caadar (x) (v) `(%rplaca (cadar ,x) ,v))
#-sb-xc-host (defsetf caddar (x) (v) `(%rplaca (cddar ,x) ,v))
#-sb-xc-host (defsetf cdadar (x) (v) `(%rplacd (cadar ,x) ,v))
#-sb-xc-host (defsetf cdddar (x) (v) `(%rplacd (cddar ,x) ,v))
#-sb-xc-host (defsetf caaadr (x) (v) `(%rplaca (caadr ,x) ,v))
#-sb-xc-host (defsetf cadadr (x) (v) `(%rplaca (cdadr ,x) ,v))
#-sb-xc-host (defsetf cdaadr (x) (v) `(%rplacd (caadr ,x) ,v))
#-sb-xc-host (defsetf cddadr (x) (v) `(%rplacd (cdadr ,x) ,v))
#-sb-xc-host (defsetf caaddr (x) (v) `(%rplaca (caddr ,x) ,v))
#-sb-xc-host (defsetf cadddr (x) (v) `(%rplaca (cdddr ,x) ,v))
#-sb-xc-host (defsetf cdaddr (x) (v) `(%rplacd (caddr ,x) ,v))
#-sb-xc-host (defsetf cddddr (x) (v) `(%rplacd (cdddr ,x) ,v))
#-sb-xc-host (defsetf first %rplaca)
#-sb-xc-host (defsetf second (x) (v) `(%rplaca (cdr ,x) ,v))
#-sb-xc-host (defsetf third (x) (v) `(%rplaca (cddr ,x) ,v))
#-sb-xc-host (defsetf fourth (x) (v) `(%rplaca (cdddr ,x) ,v))
#-sb-xc-host (defsetf fifth (x) (v) `(%rplaca (cddddr ,x) ,v))
#-sb-xc-host (defsetf sixth (x) (v) `(%rplaca (cdr (cddddr ,x)) ,v))
#-sb-xc-host (defsetf seventh (x) (v) `(%rplaca (cddr (cddddr ,x)) ,v))
#-sb-xc-host (defsetf eighth (x) (v) `(%rplaca (cdddr (cddddr ,x)) ,v))
#-sb-xc-host (defsetf ninth (x) (v) `(%rplaca (cddddr (cddddr ,x)) ,v))
#-sb-xc-host (defsetf tenth (x) (v) `(%rplaca (cdr (cddddr (cddddr ,x))) ,v))
#-sb-xc-host (defsetf rest %rplacd)
#-sb-xc-host (defsetf elt %setelt)
#-sb-xc-host (defsetf row-major-aref %set-row-major-aref)
#-sb-xc-host (defsetf svref %svset)
#-sb-xc-host (defsetf char %charset)
#-sb-xc-host (defsetf schar %scharset)
(defsetf %array-dimension %set-array-dimension)
(defsetf %vector-raw-bits %set-vector-raw-bits)
#-sb-xc-host (defsetf symbol-value set)
#-sb-xc-host (defsetf symbol-global-value set-symbol-global-value)
#-sb-xc-host (defsetf symbol-plist %set-symbol-plist)
#-sb-xc-host (defsetf nth %setnth)
#-sb-xc-host (defsetf fill-pointer %set-fill-pointer)
(defsetf sap-ref-8 %set-sap-ref-8)
(defsetf signed-sap-ref-8 %set-signed-sap-ref-8)
(defsetf sap-ref-16 %set-sap-ref-16)
(defsetf signed-sap-ref-16 %set-signed-sap-ref-16)
(defsetf sap-ref-32 %set-sap-ref-32)
(defsetf signed-sap-ref-32 %set-signed-sap-ref-32)
(defsetf sap-ref-64 %set-sap-ref-64)
(defsetf signed-sap-ref-64 %set-signed-sap-ref-64)
(defsetf sap-ref-word %set-sap-ref-word)
(defsetf signed-sap-ref-word %set-signed-sap-ref-word)
(defsetf sap-ref-sap %set-sap-ref-sap)
(defsetf sap-ref-lispobj %set-sap-ref-lispobj)
(defsetf sap-ref-single %set-sap-ref-single)
(defsetf sap-ref-double %set-sap-ref-double)
#!+long-float (defsetf sap-ref-long %set-sap-ref-long)
#-sb-xc-host (defsetf subseq (sequence start &optional (end nil)) (v)
            `(progn (replace ,sequence ,v :start1 ,start :end1 ,end)
                    ,v))

;;; from fdefinition.lisp
(in-package "SB!IMPL")
#-sb-xc-host (defsetf fdefinition %set-fdefinition)

;;; from kernel.lisp
(in-package "SB!KERNEL")
(defsetf code-header-ref code-header-set)

;;; from serve-event.lisp
(in-package "SB!IMPL")
(defsetf object-set-operation %set-object-set-operation
  #!+sb-doc
  "Set the handler function for an object set operation.")

;;; from x86-vm.lisp
(in-package "SB!VM")
(defsetf context-register %set-context-register)
(defsetf context-float-register %set-context-float-register)

(sb!int:/show0 "leaving defsetfs.lisp")
