source: branches/qres/ccl/lib/setf-runtime.lisp @ 14308

Last change on this file since 14308 was 13070, checked in by gz, 10 years ago

r13066, r13067 from trunk: copyrights etc

  • Property svn:eol-style set to native
  • Property svn:keywords set to Author Date Id Revision
File size: 3.4 KB
Line 
1; -*- Mode: Lisp; Package: CCL; -*-
2;;;
3;;;   Copyright (C) 2009 Clozure Associates
4;;;   Copyright (C) 1994-2001 Digitool, Inc
5;;;   This file is part of Clozure CL. 
6;;;
7;;;   Clozure CL is licensed under the terms of the Lisp Lesser GNU Public
8;;;   License , known as the LLGPL and distributed with Clozure CL as the
9;;;   file "LICENSE".  The LLGPL consists of a preamble and the LGPL,
10;;;   which is distributed with Clozure CL as the file "LGPL".  Where these
11;;;   conflict, the preamble takes precedence. 
12;;;
13;;;   Clozure CL is referenced in the preamble as the "LIBRARY."
14;;;
15;;;   The LLGPL is also available online at
16;;;   http://opensource.franz.com/preamble.html
17
18;
19; setf-runtime.lisp - runtime support for setf expressions
20
21(in-package "CCL")
22
23(defun set-cadr (list new-value)
24  (set-car (cdr list) new-value))
25
26(defun set-cdar (list new-value)
27  (set-cdr (car list) new-value))
28
29(defun set-caar (list new-value)
30  (set-car (car list) new-value))
31
32(defun set-cddr (list new-value)
33  (set-cdr (cdr list) new-value))
34
35(defun %set-nthcdr (index list new-value)
36  "If INDEX is 0, just return NEW-VALUE."
37  (if (not (zerop index))
38    (rplacd (nthcdr (1- index) list)
39            new-value))
40  new-value)
41
42(defun set-fifth (list new-value)
43  (set-car (cddddr list) new-value))
44
45(defun set-sixth (list new-value)
46  (set-car (cdr (cddddr list)) new-value))
47
48(defun set-seventh (list new-value)
49  (set-car (cddr (cddddr list)) new-value))
50
51(defun set-eighth (list new-value)
52  (set-car (cdddr (cddddr list)) new-value))
53
54(defun set-ninth (list new-value)
55  (set-car (cddddr (cddddr list)) new-value))
56
57(defun set-tenth (list new-value)
58  (set-car (cdr (cddddr (cddddr list))) new-value))
59
60(defun set-caaar (list new-value)
61  (set-car (caar list) new-value))
62
63(defun set-caadr (list new-value)
64  (set-car (cadr list) new-value))
65
66(defun set-cadar (list new-value)
67  (set-car (cdar list) new-value))
68
69(defun set-caddr (list new-value)
70  (set-car (cddr list) new-value))
71
72(defun set-cdaar (list new-value)
73  (set-cdr (caar list) new-value))
74
75(defun set-cdadr (list new-value)
76  (set-cdr (cadr list) new-value))
77
78(defun set-cddar (list new-value)
79  (set-cdr (cdar list) new-value))
80
81(defun set-cdddr (list new-value)
82  (set-cdr (cddr list) new-value))
83
84(defun set-caaaar (list new-value)
85  (set-car (caaar list) new-value))
86
87(defun set-caaadr (list new-value)
88  (set-car (caadr list) new-value))
89
90(defun set-caadar (list new-value)
91  (set-car (cadar list) new-value))
92
93(defun set-caaddr (list new-value)
94  (set-car (caddr list) new-value))
95
96(defun set-cadaar (list new-value)
97  (set-car (cdaar list) new-value))
98
99(defun set-cadadr (list new-value)
100  (set-car (cdadr list) new-value))
101
102(defun set-caddar (list new-value)
103  (set-car (cddar list) new-value))
104
105(defun set-cadddr (list new-value)
106  (set-car (cdddr list) new-value))
107
108(defun set-cdaaar (list new-value)
109  (set-cdr (caaar list) new-value))
110
111(defun set-cdaadr (list new-value)
112  (set-cdr (caadr list) new-value))
113
114(defun set-cdadar (list new-value)
115  (set-cdr (cadar list) new-value))
116
117(defun set-cdaddr (list new-value)
118  (set-cdr (caddr list) new-value))
119
120(defun set-cddaar (list new-value)
121  (set-cdr (cdaar list) new-value))
122
123(defun set-cddadr (list new-value)
124  (set-cdr (cdadr list) new-value))
125
126(defun set-cdddar (list new-value)
127  (set-cdr (cddar list) new-value))
128
129(defun set-cddddr (list new-value)
130  (set-cdr (cdddr list) new-value))
131
132
133
134; End of setf-runtime.lisp
Note: See TracBrowser for help on using the repository browser.