;;;;
;;;; srfi-17.stk                -- General setters for lists
;;;;
;;;; Copyright © 2004-2021 Erick Gallesio - I3S-CNRS/ESSI <eg@essi.fr>
;;;;
;;;;
;;;; This program is free software; you can redistribute it and/or modify
;;;; it under the terms of the GNU General Public License as published by
;;;; the Free Software Foundation; either version 2 of the License, or
;;;; (at your option) any later version.
;;;;
;;;; This program is distributed in the hope that it will be useful,
;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
;;;; GNU General Public License for more details.
;;;;
;;;; You should have received a copy of the GNU General Public License
;;;; along with this program; if not, write to the Free Software
;;;; Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307,
;;;; USA.
;;;;
;;;;           Author: Erick Gallesio [eg@essi.fr]
;;;;    Creation date: 20-May-2004 17:14 (eg)
;;;;


(define-module srfi/17
  (export getter-with-setter)


  (define (getter-with-setter get set)
    (let ((proc (lambda args (apply get args))))
      (set! (setter proc) set)
      proc))

   ;; Define the setters on list accessors as required by
  ;; SRFI-17
  (set! (setter caar) (lambda (x v) (set-car! (car x) v)))
  (set! (setter cadr) (lambda (x v) (set-car! (cdr x) v)))

  (set! (setter cdar) (lambda (x v) (set-cdr! (car x) v)))
  (set! (setter cddr) (lambda (x v) (set-cdr! (cdr x) v)))



  (set! (setter caaar) (lambda (x v) (set-car! (caar x) v)))
  (set! (setter caadr) (lambda (x v) (set-car! (cadr x) v)))
  (set! (setter cadar) (lambda (x v) (set-car! (cdar x) v)))
  (set! (setter caddr) (lambda (x v) (set-car! (cddr x) v)))

  (set! (setter cdaar) (lambda (x v) (set-cdr! (caar x) v)))
  (set! (setter cdadr) (lambda (x v) (set-cdr! (cadr x) v)))
  (set! (setter cddar) (lambda (x v) (set-cdr! (cdar x) v)))
  (set! (setter cdddr) (lambda (x v) (set-cdr! (cddr x) v)))



  (set! (setter caaaar) (lambda (x v) (set-car! (caaar x) v)))
  (set! (setter caaadr) (lambda (x v) (set-car! (caadr x) v)))
  (set! (setter caadar) (lambda (x v) (set-car! (cadar x) v)))
  (set! (setter caaddr) (lambda (x v) (set-car! (caddr x) v)))
  (set! (setter cadaar) (lambda (x v) (set-car! (cdaar x) v)))
  (set! (setter cadadr) (lambda (x v) (set-car! (cdadr x) v)))
  (set! (setter caddar) (lambda (x v) (set-car! (cddar x) v)))
  (set! (setter cadddr) (lambda (x v) (set-car! (cdddr x) v)))

  (set! (setter cdaaar) (lambda (x v) (set-cdr! (caaar x) v)))
  (set! (setter cdaadr) (lambda (x v) (set-cdr! (caadr x) v)))
  (set! (setter cdadar) (lambda (x v) (set-cdr! (cadar x) v)))
  (set! (setter cdaddr) (lambda (x v) (set-cdr! (caddr x) v)))
  (set! (setter cddaar) (lambda (x v) (set-cdr! (cdaar x) v)))
  (set! (setter cddadr) (lambda (x v) (set-cdr! (cdadr x) v)))
  (set! (setter cdddar) (lambda (x v) (set-cdr! (cddar x) v)))
  (set! (setter cddddr) (lambda (x v) (set-cdr! (cdddr x) v))))

(provide "srfi/17")
