2 ent-binary-op.h -- Global Binary Operations
3 Copyright (C) 2006, 2007, 2008 Sebastian Freundt
5 Author: Sebastian Freundt <hroptatyr@sxemacs.org>
7 * This file is part of SXEmacs.
9 * Redistribution and use in source and binary forms, with or without
10 * modification, are permitted provided that the following conditions
13 * 1. Redistributions of source code must retain the above copyright
14 * notice, this list of conditions and the following disclaimer.
16 * 2. Redistributions in binary form must reproduce the above copyright
17 * notice, this list of conditions and the following disclaimer in the
18 * documentation and/or other materials provided with the distribution.
20 * 3. Neither the name of the author nor the names of any contributors
21 * may be used to endorse or promote products derived from this
22 * software without specific prior written permission.
24 * THIS SOFTWARE IS PROVIDED BY THE AUTHOR "AS IS" AND ANY EXPRESS OR
25 * IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
26 * WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE
27 * DISCLAIMED. IN NO EVENT SHALL THE REGENTS OR CONTRIBUTORS BE LIABLE
28 * FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
29 * CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
30 * SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR
31 * BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY,
32 * WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE
33 * OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN
34 * IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
37 /* Synched up with: Not in FSF. */
39 #ifndef INCLUDED_ent_binary_op_h_
40 #define INCLUDED_ent_binary_op_h_
44 #define ENT_DEBUG_BINOP(args...) ENT_DEBUG("[BINOP]: " args)
46 /*************************/
47 /* new ASE optable magic */
48 /*************************/
49 /* the binary optable */
50 typedef enum ase_binary_operation_e ase_binary_operation_t;
51 typedef Lisp_Object(*ase_binary_operation_f)(Lisp_Object, Lisp_Object);
53 enum ase_binary_operation_e {
55 ASE_BINARY_FIRST_OP = ASE_BINARY_OP_SUM,
63 ASE_BINARY_LAST_OP = ASE_BINARY_OP_POW,
67 extern int common_lisp_slash;
68 extern ase_binary_operation_f
69 ase_binary_optable[N_ASE_BINARY_OPS][ASE_OPTABLE_SIZE][ASE_OPTABLE_SIZE];
71 extern Lisp_Object ase_binary_operation_undefined(Lisp_Object, Lisp_Object);
74 ase_binary_operation_t op,
75 ase_object_type_t t1, ase_object_type_t t2,
76 ase_binary_operation_f opf);
79 ase_binary_operation_t op,
80 ase_object_type_t t1, ase_object_type_t t2);
81 extern_inline Lisp_Object
83 ase_binary_operation_t op,
84 ase_object_type_t l1t, Lisp_Object l1,
85 ase_object_type_t l2t, Lisp_Object l2);
86 extern_inline Lisp_Object
87 ent_binop(ase_binary_operation_t op, Lisp_Object l1, Lisp_Object l2);
88 extern_inline Lisp_Object
89 ent_binop_many(ase_binary_operation_t op, int nargs, Lisp_Object *args);
93 ent_binop_register(ase_binary_operation_t op,
94 ase_object_type_t t1, ase_object_type_t t2,
95 ase_binary_operation_f opf)
97 ase_binary_optable[op][t1][t2] = opf;
101 ent_binop_unregister(ase_binary_operation_t op,
102 ase_object_type_t t1, ase_object_type_t t2)
104 ase_binary_optable[op][t1][t2] = ase_binary_operation_undefined;
108 extern void ase_binary_optable_init(void);
110 extern_inline Lisp_Object
111 _ent_binop(ase_binary_operation_t op,
112 ase_object_type_t l1t, Lisp_Object l1,
113 ase_object_type_t l2t, Lisp_Object l2)
115 ase_binary_operation_f opf =
116 ase_binary_optable[op][l1t][l2t];
121 extern_inline Lisp_Object
122 ent_binop(ase_binary_operation_t op, Lisp_Object l1, Lisp_Object l2)
124 ase_object_type_t l1t = ase_optable_index(l1);
125 ase_object_type_t l2t = ase_optable_index(l2);
127 return _ent_binop(op, l1t, l1, l2t, l2);
130 extern_inline Lisp_Object
131 ent_binop_many(ase_binary_operation_t op, int nargs, Lisp_Object *args)
135 ase_object_type_t _acct, addt;
137 for (accum = args[0], i = 1; i < nargs; i++) {
138 _acct = ase_optable_index(accum);
139 addt = ase_optable_index(args[i]);
140 accum = _ent_binop(op, _acct, accum, addt, args[i]);
146 /* convenience funs (implement as macroes maybe?) */
148 extern_inline Lisp_Object
149 _ent_binop_sum(ase_object_type_t l1t, Lisp_Object l1,
150 ase_object_type_t l2t, Lisp_Object l2);
151 extern_inline Lisp_Object
152 ent_binop_sum(Lisp_Object l1, Lisp_Object l2);
155 ent_binop_register_sum(ase_object_type_t t1, ase_object_type_t t2,
156 ase_binary_operation_f opf);
158 ent_binop_unregister_sum(ase_object_type_t t1, ase_object_type_t t2,
159 ase_binary_operation_f opf);
163 #define Fplus Fent_binop_sum
164 #define Fminus Fent_binop_diff
165 #define Ftimes Fent_binop_prod
166 #define Fdiv Fent_binop_divX
167 #define Fquo Fent_binop_div
168 #define Fquo2 Fent_binop_quo
169 #define Frem Fent_binop_rem
170 #define Fmod Fent_binop_mod
171 #define Fpow Fent_binop_pow
173 EXFUN(Fent_binop_sum, MANY);
174 EXFUN(Fent_binop_diff, MANY);
175 EXFUN(Fent_binop_prod, MANY);
176 EXFUN(Fent_binop_div, MANY);
177 EXFUN(Fent_binop_divX, MANY);
178 EXFUN(Fent_binop_quo, MANY);
179 EXFUN(Fent_binop_rem, 2);
180 EXFUN(Fent_binop_mod, 2);
181 EXFUN(Fent_binop_pow, 2);
183 extern void syms_of_ent_binary_op(void);
184 extern void vars_of_ent_binary_op(void);
186 extern_inline Lisp_Object
188 ase_binary_operation_t op,
189 ase_object_type_t l1t, Lisp_Object l1,
190 ase_object_type_t l2t, Lisp_Object l2,
192 extern_inline Lisp_Object
194 ase_binary_operation_t op,
195 Lisp_Object l1, ase_object_type_t l2t, Lisp_Object l2,
197 extern_inline Lisp_Object
199 ase_binary_operation_t op,
200 Lisp_Object l1, Lisp_Object l2,
202 extern_inline Lisp_Object
204 ase_binary_operation_t op,
205 ase_object_type_t l1t, Lisp_Object l1,
206 ase_object_type_t l2t, Lisp_Object l2,
208 extern_inline Lisp_Object
210 ase_binary_operation_t op,
211 ase_object_type_t l1t, Lisp_Object l1, Lisp_Object l2,
213 extern_inline Lisp_Object
215 ase_binary_operation_t op,
216 Lisp_Object l1, Lisp_Object l2,
220 /* lift to first or second arg and perform an operation */
221 extern_inline Lisp_Object
222 __ent_binop_lift_1(ase_binary_operation_t op,
223 ase_object_type_t l1t, Lisp_Object l1,
224 ase_object_type_t l2t, Lisp_Object l2,
227 Lisp_Object l1n = _ent_lift(l1t, l1, l2t, la);
228 return _ent_binop(op, l2t, l1n, l2t, l2);
231 extern_inline Lisp_Object
232 _ent_binop_lift_1(ase_binary_operation_t op,
233 Lisp_Object l1, ase_object_type_t l2t, Lisp_Object l2,
236 /* lifts l1 to l2t and calls the native op */
237 ase_object_type_t l1t = ase_optable_index(l1);
238 return __ent_binop_lift_1(op, l1t, l1, l2t, l2, la);
241 extern_inline Lisp_Object
242 ent_binop_lift_1(ase_binary_operation_t op,
243 Lisp_Object l1, Lisp_Object l2,
246 /* lifts arg l1 to the world of l2 and calls the native op */
247 ase_object_type_t l2t = ase_optable_index(l2);
248 return _ent_binop_lift_1(op, l1, l2t, l2, la);
251 extern_inline Lisp_Object
252 __ent_binop_lift_2(ase_binary_operation_t op,
253 ase_object_type_t l1t, Lisp_Object l1,
254 ase_object_type_t l2t, Lisp_Object l2,
257 Lisp_Object l2n = _ent_lift(l2t, l2, l1t, la);
258 return _ent_binop(op, l1t, l1, l1t, l2n);
261 extern_inline Lisp_Object
262 _ent_binop_lift_2(ase_binary_operation_t op,
263 ase_object_type_t l1t, Lisp_Object l1, Lisp_Object l2,
266 /* lifts l2 to l1t and calls the native op */
267 ase_object_type_t l2t = ase_optable_index(l2);
268 return __ent_binop_lift_2(op, l1t, l1, l2t, l2, la);
271 extern_inline Lisp_Object
272 ent_binop_lift_2(ase_binary_operation_t op,
273 Lisp_Object l1, Lisp_Object l2,
276 /* lifts arg l2 to the world of l1 and calls the native op */
277 ase_object_type_t l1t = ase_optable_index(l1);
278 return _ent_binop_lift_2(op, l1t, l1, l2, la);
281 #endif /* INCLUDED_ent_binary_op_h_ */