cgit.sxemacs.org Git - sxemacs/blob - src/seq.h

   1 /*** seq.h -- generic sequence service
   2  *
   3  * Copyright (C) 2008 Sebastian Freundt
   4  *
   5  * Author:  Sebastian Freundt <hroptatyr@sxemacs.org>
   6  *
   7  * This file is part of SXEmacs.
   8  *
   9  * Redistribution and use in source and binary forms, with or without
  10  * modification, are permitted provided that the following conditions
  11  * are met:
  12  *
  13  * 1. Redistributions of source code must retain the above copyright
  14  *    notice, this list of conditions and the following disclaimer.
  15  *
  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.
  19  *
  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.
  23  *
  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.
  35  *
  36  * Commentary:
  37  * A sequence is defined like in maths: A mapping of an somewhat ordered
  38  * index set into a target space.  The target space hereby is usually the
  39  * universe of lisp objects, the index set hereby is usually undefined,
  40  * i.e. varying from sequence to sequence, moreover it's possibly infinite
  41  * and all we use is the `somewhat ordered' property, so it makes sense to
  42  * talk about the `next element' of a sequence.
  43  *
  44  * Sequences have the following operations:
  45  * - iter_init  -  initialise an iterator through the sequence
  46  * - iter_fini  -  finalise an iterator
  47  * - iter_next  -  return the next element of the sequence
  48  *
  49  * Finite sequences have the following operations:
  50  * - length     -  return the length of a sequence
  51  * - iter_init  -  initialise an iterator through the sequence
  52  * - iter_fini  -  finalise an iterator
  53  * - iter_next  -  return the next element of the sequence
  54  * - iter_reset -  reset the iterator, next iter_next() call will give the
  55  *                 first element again
  56  * - explode    -  given a pointer to an object array offload some elements
  57  *                 of the sequence there
  58  *
  59  ***/
  60
  61 #ifndef INCLUDED_seq_h_
  62 #define INCLUDED_seq_h_
  63
  64 #include "lrecord.h"
  65 #include "category.h"
  66 #include <stdbool.h>
  67
  68 #ifdef ALL_DEBUG_FLAGS
  69 #undef SEQ_DEBUG_FLAG
  70 #define SEQ_DEBUG_FLAG
  71 #endif
  72
  73 #define __SEQ_DEBUG__(args...)          fprintf(stderr, "SEQ " args)
  74 #ifndef SEQ_DEBUG_FLAG
  75 #define SEQ_DEBUG(args...)
  76 #else
  77 #define SEQ_DEBUG(args...)              __SEQ_DEBUG__(args)
  78 #endif
  79 #define SEQ_CRITICAL(args...)           __SEQ_DEBUG__("CRITICAL: " args)
  80
  81 typedef struct seq_s *seq_t;
  82 typedef struct seq_iter_s *seq_iter_t;
  83 typedef struct seq_impl_s *seq_impl_t;
  84
  85 typedef size_t(*seq_length_f)(const seq_t);
  86 typedef void(*seq_iter_init_f)(seq_t, seq_iter_t);
  87 typedef void(*seq_iter_next_f)(seq_iter_t, void**);
  88 typedef void(*seq_iter_fini_f)(seq_iter_t);
  89 typedef void(*seq_iter_reset_f)(seq_iter_t);
  90 typedef size_t(*seq_explode_f)(void*restrict[], size_t, const seq_t);
  91
  92 /* return the sequence implementation of an object */
  93 extern_inline seq_impl_t seq_impl(const void*);
  94 /* ... the same, but throw an error if the object has none */
  95 extern_inline seq_impl_t seq_impl_err(const void*);
  96
  97 extern_inline size_t seq_length(const seq_t);
  98 extern_inline bool seq_infinite_p(const seq_t);
  99 extern_inline bool seq_empty_p(const seq_t);
 100
 101 extern_inline void seq_iter_init(seq_t, seq_iter_t);
 102 extern_inline void seq_iter_fini(seq_iter_t);
 103 extern_inline void seq_iter_next(seq_iter_t, void**);
 104 extern_inline void seq_iter_reset(seq_iter_t);
 105 extern_inline size_t seq_explode(void*restrict[], size_t, const seq_t);
 106
 107 extern seq_impl_t seq_unsupp;
 108
 109 \f
 110 struct seq_impl_s {
 111         seq_length_f length_f;
 112         seq_iter_init_f iter_init_f;
 113         seq_iter_fini_f iter_fini_f;
 114         seq_iter_next_f iter_next_f;
 115         seq_iter_reset_f iter_reset_f;
 116         seq_explode_f explode_f;
 117 };
 118
 119 struct seq_s {
 120         struct lcrecord_header lheader;
 121         seq_impl_t impl;
 122         /* the dual approach */
 123         void *seq;
 124 };
 125
 126 struct seq_iter_s {
 127         seq_t seq;
 128         void *data;
 129 };
 130
 131 extern seq_impl_t seq_unsupported, seq_empty;
 132
 133 \f
 134 /* inlines */
 135 extern_inline seq_impl_t
 136 seq_impl(const void *obj)
 137 {
 138         if (UNLIKELY(INTP((Lisp_Object)obj) || CHARP((Lisp_Object)obj))) {
 139                 return NULL;
 140         } else if (UNLIKELY(NILP((Lisp_Object)obj))) {
 141                 return seq_empty;
 142         }
 143         return cat_morphism(obj, cat_mk_seq);
 144 }
 145
 146 extern_inline seq_impl_t
 147 seq_impl_err(const void *obj)
 148 {
 149         if (UNLIKELY(INTP((Lisp_Object)obj) || CHARP((Lisp_Object)obj))) {
 150                 (void)dead_wrong_type_argument(Qsequencep, (Lisp_Object)obj);
 151                 return NULL;
 152         } else if (UNLIKELY(NILP((Lisp_Object)obj))) {
 153                 return seq_empty;
 154         }
 155         return cat_morphism(obj, cat_mk_seq);
 156 }
 157
 158 extern_inline size_t
 159 seq_length(const seq_t d)
 160 {
 161 /* return the length of a finite sequence
 162  * may be applied to any sequence and in case of an infinite one this
 163  * returns (size_t)-1 */
 164         seq_impl_t si = seq_impl(d);
 165
 166         if (si != NULL) {
 167                 return si->length_f(d);
 168         } else {
 169                 /* is this right here? */
 170                 return wrong_type_argument(Qsequencep, (Lisp_Object)d);
 171         }
 172 }
 173
 174 extern_inline bool
 175 seq_empty_p(const seq_t d)
 176 {
 177         return seq_length(d) == 0;
 178 }
 179
 180 extern_inline bool
 181 seq_infinite_p(const seq_t d)
 182 {
 183         return seq_length(d) == (size_t)-1;
 184 }
 185
 186 extern_inline void
 187 seq_iter_init(seq_t d, seq_iter_t di)
 188 {
 189         seq_impl_t si = seq_impl(d);
 190
 191         if (si != NULL) {
 192                 si->iter_init_f(d, di);
 193         } else {
 194                 /* is this right here? */
 195                 (void)wrong_type_argument(Qsequencep, (Lisp_Object)d);
 196         }
 197         return;
 198 }
 199
 200 extern_inline void
 201 seq_iter_next(seq_iter_t di, void **elt)
 202 {
 203         seq_impl(di->seq)->iter_next_f(di, elt);
 204         return;
 205 }
 206
 207 extern_inline void
 208 seq_iter_fini(seq_iter_t di)
 209 {
 210         seq_impl(di->seq)->iter_fini_f(di);
 211         return;
 212 }
 213
 214 extern_inline void
 215 seq_iter_reset(seq_iter_t di)
 216 {
 217         seq_impl(di->seq)->iter_reset_f(di);
 218         return;
 219 }
 220
 221 extern_inline size_t
 222 seq_explode(void *restrict tgt[], size_t ntgt, const seq_t s)
 223 {
 224 /* put up to NTGT values of S into TGT, return the number of put elements */
 225         seq_impl_t si = seq_impl(s);
 226
 227         if (si != NULL) {
 228                 return si->explode_f(tgt, ntgt, s);
 229         } else {
 230                 (void)wrong_type_argument(Qsequencep, (const Lisp_Object)s);
 231                 return (size_t)-1;
 232         }
 233 }
 234
 235
 236 extern void seq_LTX_init(void);
 237 extern void seq_LTX_reinit(void);
 238 extern void seq_LTX_deinit(void);
 239
 240 #endif  /* INCLUDED_seq_h_ */