1 /*===========================================================================
2 * Filename : deep-cadrs.c
3 * About : Deep c[ad]+r operations of R5RS
4 *
5 * Copyright (C) 2005 Kazuki Ohta <mover AT hct.zaq.ne.jp>
6 * Copyright (C) 2005 Jun Inoue <jun.lambda AT gmail.com>
7 * Copyright (C) 2006 YAMAMOTO Kengo <yamaken AT bp.iij4u.or.jp>
8 * Copyright (c) 2007-2008 SigScheme Project <uim-en AT googlegroups.com>
9 *
10 * All rights reserved.
11 *
12 * Redistribution and use in source and binary forms, with or without
13 * modification, are permitted provided that the following conditions
14 * are met:
15 *
16 * 1. Redistributions of source code must retain the above copyright
17 * notice, this list of conditions and the following disclaimer.
18 * 2. Redistributions in binary form must reproduce the above copyright
19 * notice, this list of conditions and the following disclaimer in the
20 * documentation and/or other materials provided with the distribution.
21 * 3. Neither the name of authors nor the names of its contributors
22 * may be used to endorse or promote products derived from this software
23 * without specific prior written permission.
24 *
25 * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS ``AS
26 * IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO,
27 * THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR
28 * PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDERS OR
29 * CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL,
30 * EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,
31 * PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS;
32 * OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY,
33 * WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR
34 * OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF
35 * ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
36 ===========================================================================*/
37
38 #include <config.h>
39
40 #include "sigscheme.h"
41 #include "sigschemeinternal.h"
42
43 /*=======================================
44 File Local Macro Definitions
45 =======================================*/
46
47 /*=======================================
48 File Local Type Definitions
49 =======================================*/
50
51 /*=======================================
52 Variable Definitions
53 =======================================*/
54
55 /*=======================================
56 File Local Function Declarations
57 =======================================*/
58
59 /*=======================================
60 Function Definitions
61 =======================================*/
62 SCM_EXPORT ScmObj
scm_p_caaar(ScmObj lst)63 scm_p_caaar(ScmObj lst)
64 {
65 DECLARE_FUNCTION("caaar", procedure_fixed_1);
66
67 return scm_p_car(scm_p_car(scm_p_car(lst)));
68 }
69
70 SCM_EXPORT ScmObj
scm_p_caadr(ScmObj lst)71 scm_p_caadr(ScmObj lst)
72 {
73 DECLARE_FUNCTION("caadr", procedure_fixed_1);
74
75 return scm_p_car(scm_p_car(scm_p_cdr(lst)));
76 }
77
78 SCM_EXPORT ScmObj
scm_p_cadar(ScmObj lst)79 scm_p_cadar(ScmObj lst)
80 {
81 DECLARE_FUNCTION("cadar", procedure_fixed_1);
82
83 return scm_p_car(scm_p_cdr(scm_p_car(lst)));
84 }
85
86 SCM_EXPORT ScmObj
scm_p_cdaar(ScmObj lst)87 scm_p_cdaar(ScmObj lst)
88 {
89 DECLARE_FUNCTION("cdaar", procedure_fixed_1);
90
91 return scm_p_cdr(scm_p_car(scm_p_car(lst)));
92 }
93
94 SCM_EXPORT ScmObj
scm_p_cdadr(ScmObj lst)95 scm_p_cdadr(ScmObj lst)
96 {
97 DECLARE_FUNCTION("cdadr", procedure_fixed_1);
98
99 return scm_p_cdr(scm_p_car(scm_p_cdr(lst)));
100 }
101
102 SCM_EXPORT ScmObj
scm_p_cddar(ScmObj lst)103 scm_p_cddar(ScmObj lst)
104 {
105 DECLARE_FUNCTION("cddar", procedure_fixed_1);
106
107 return scm_p_cdr(scm_p_cdr(scm_p_car(lst)));
108 }
109
110 SCM_EXPORT ScmObj
scm_p_caaaar(ScmObj lst)111 scm_p_caaaar(ScmObj lst)
112 {
113 DECLARE_FUNCTION("caaaar", procedure_fixed_1);
114
115 return scm_p_car(scm_p_car(scm_p_car(scm_p_car(lst))));
116 }
117
118 SCM_EXPORT ScmObj
scm_p_caaadr(ScmObj lst)119 scm_p_caaadr(ScmObj lst)
120 {
121 DECLARE_FUNCTION("caaadr", procedure_fixed_1);
122
123 return scm_p_car(scm_p_car(scm_p_car(scm_p_cdr(lst))));
124 }
125
126 SCM_EXPORT ScmObj
scm_p_caadar(ScmObj lst)127 scm_p_caadar(ScmObj lst)
128 {
129 DECLARE_FUNCTION("caadar", procedure_fixed_1);
130
131 return scm_p_car(scm_p_car(scm_p_cdr(scm_p_car(lst))));
132 }
133
134 SCM_EXPORT ScmObj
scm_p_caaddr(ScmObj lst)135 scm_p_caaddr(ScmObj lst)
136 {
137 DECLARE_FUNCTION("caaddr", procedure_fixed_1);
138
139 return scm_p_car(scm_p_car(scm_p_cdr(scm_p_cdr(lst))));
140 }
141
142 SCM_EXPORT ScmObj
scm_p_cadaar(ScmObj lst)143 scm_p_cadaar(ScmObj lst)
144 {
145 DECLARE_FUNCTION("cadaar", procedure_fixed_1);
146
147 return scm_p_car(scm_p_cdr(scm_p_car(scm_p_car(lst))));
148 }
149
150 SCM_EXPORT ScmObj
scm_p_cadadr(ScmObj lst)151 scm_p_cadadr(ScmObj lst)
152 {
153 DECLARE_FUNCTION("cadadr", procedure_fixed_1);
154
155 return scm_p_car(scm_p_cdr(scm_p_car(scm_p_cdr(lst))));
156 }
157
158 SCM_EXPORT ScmObj
scm_p_caddar(ScmObj lst)159 scm_p_caddar(ScmObj lst)
160 {
161 DECLARE_FUNCTION("caddar", procedure_fixed_1);
162
163 return scm_p_car(scm_p_cdr(scm_p_cdr(scm_p_car(lst))));
164 }
165
166 SCM_EXPORT ScmObj
scm_p_cadddr(ScmObj lst)167 scm_p_cadddr(ScmObj lst)
168 {
169 DECLARE_FUNCTION("cadddr", procedure_fixed_1);
170
171 return scm_p_car(scm_p_cdr(scm_p_cdr(scm_p_cdr(lst))));
172 }
173
174 SCM_EXPORT ScmObj
scm_p_cdaaar(ScmObj lst)175 scm_p_cdaaar(ScmObj lst)
176 {
177 DECLARE_FUNCTION("cdaaar", procedure_fixed_1);
178
179 return scm_p_cdr(scm_p_car(scm_p_car(scm_p_car(lst))));
180 }
181
182 SCM_EXPORT ScmObj
scm_p_cdaadr(ScmObj lst)183 scm_p_cdaadr(ScmObj lst)
184 {
185 DECLARE_FUNCTION("cdaadr", procedure_fixed_1);
186
187 return scm_p_cdr(scm_p_car(scm_p_car(scm_p_cdr(lst))));
188 }
189
190 SCM_EXPORT ScmObj
scm_p_cdadar(ScmObj lst)191 scm_p_cdadar(ScmObj lst)
192 {
193 DECLARE_FUNCTION("cdadar", procedure_fixed_1);
194
195 return scm_p_cdr(scm_p_car(scm_p_cdr(scm_p_car(lst))));
196 }
197
198 SCM_EXPORT ScmObj
scm_p_cdaddr(ScmObj lst)199 scm_p_cdaddr(ScmObj lst)
200 {
201 DECLARE_FUNCTION("cdaddr", procedure_fixed_1);
202
203 return scm_p_cdr(scm_p_car(scm_p_cdr(scm_p_cdr(lst))));
204 }
205
206 SCM_EXPORT ScmObj
scm_p_cddaar(ScmObj lst)207 scm_p_cddaar(ScmObj lst)
208 {
209 DECLARE_FUNCTION("cddaar", procedure_fixed_1);
210
211 return scm_p_cdr(scm_p_cdr(scm_p_car(scm_p_car(lst))));
212 }
213
214 SCM_EXPORT ScmObj
scm_p_cddadr(ScmObj lst)215 scm_p_cddadr(ScmObj lst)
216 {
217 DECLARE_FUNCTION("cddadr", procedure_fixed_1);
218
219 return scm_p_cdr(scm_p_cdr(scm_p_car(scm_p_cdr(lst))));
220 }
221
222 SCM_EXPORT ScmObj
scm_p_cdddar(ScmObj lst)223 scm_p_cdddar(ScmObj lst)
224 {
225 DECLARE_FUNCTION("cdddar", procedure_fixed_1);
226
227 return scm_p_cdr(scm_p_cdr(scm_p_cdr(scm_p_car(lst))));
228 }
229
230 SCM_EXPORT ScmObj
scm_p_cddddr(ScmObj lst)231 scm_p_cddddr(ScmObj lst)
232 {
233 DECLARE_FUNCTION("cddddr", procedure_fixed_1);
234
235 return scm_p_cdr(scm_p_cdr(scm_p_cdr(scm_p_cdr(lst))));
236 }
237