cgit.sxemacs.org Git - sxemacs/blob - modules/cl/cl-loop.h

   1 /*
   2   cl-loop.h -- Common Lisp Goodness, the fast version
   3   Copyright (C) 2006-2012 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
  37 /* Synched up with: Not in FSF. */
  38
  39 #ifndef INCLUDED_cl_loop_h_
  40 #define INCLUDED_cl_loop_h_ 1
  41
  42 #include "cl.h"
  43 #include "ent/ent-optable.h"
  44 #include "ent/ent-binary-op.h"
  45 #include "ent/ent-binary-rel.h"
  46 #include "ent/ent-int.h"
  47 #include "ent/ent-indef.h"
  48
  49 #define EMOD_CL_DEBUG_LOOP(args...)     EMOD_CL_DEBUG("[loop]: " args)
  50
  51 extern Lisp_Object Qcl_loop_sentence, Qcl_loop_sentence_p;
  52 extern Lisp_Object Qcl_loop_for_clause, Qcl_loop_for_clause_p;
  53 extern Lisp_Object Qcl_loop_do_clause, Qcl_loop_do_clause_p;
  54 extern Lisp_Object Qcl_loop_with_clause, Qcl_loop_with_clause_p;
  55 extern Lisp_Object Qcl_loop_repeat_clause, Qcl_loop_repeat_clause_p;
  56 extern Lisp_Object Qcl_loop_append_clause, Qcl_loop_append_clause_p;
  57 extern Lisp_Object Qcl_loop_collect_clause, Qcl_loop_collect_clause_p;
  58 extern Lisp_Object Qcl_loop_nconc_clause, Qcl_loop_nconc_clause_p;
  59 extern Lisp_Object Qcl_loop_return_clause, Qcl_loop_return_clause_p;
  60 extern Lisp_Object Qcl_loop_initally_clause, Qcl_loop_initially_clause_p;
  61 extern Lisp_Object Qcl_loop_finally_clause, Qcl_loop_finally_clause_p;
  62 extern Lisp_Object Qcl_loop_count_clause, Qcl_loop_count_clause_p;
  63 extern Lisp_Object Qcl_loop_sum_clause, Qcl_loop_sum_clause_p;
  64 extern Lisp_Object Qcl_loop_maximise_clause, Qcl_loop_maximise_clause_p;
  65 extern Lisp_Object Qcl_loop_minimise_clause, Qcl_loop_minimise_clause_p;
  66
  67 extern Lisp_Object Qfor, Qas;
  68 extern Lisp_Object Qfrom, Qdownfrom, Qupfrom;
  69 extern Lisp_Object Qto, Qdownto, Qupto, Qabove, Qbelow, Qby;
  70 extern Lisp_Object Qin, Qon, Qthen, Qacross, Qeach, Qthe, Qbeing, Qof;
  71 extern Lisp_Object Qhash_key, Qhash_keys, Qhash_value, Qhash_values, Qusing;
  72 extern Lisp_Object Qdo, Qdoing;
  73 extern Lisp_Object Qtoken;
  74 extern Lisp_Object Qwith, Qequals, Qand;
  75 extern Lisp_Object Qrepeat;
  76 extern Lisp_Object Qappend, Qappending, Qcollect, Qcollecting;
  77 extern Lisp_Object Qnconc, Qnconcing, Qinto;
  78 extern Lisp_Object Qcount, Qcounting, Qsum, Qsumming;
  79 extern Lisp_Object Qmaximise, Qmaximising;
  80 extern Lisp_Object Qminimise, Qminimising;
  81 extern Lisp_Object Qinitially, Qfinally;
  82
  83 /* a whole loop sentence made up from various clauses */
  84 typedef struct cl_loop_sentence_s cl_loop_sentence_t;
  85 /* clauses */
  86 typedef struct cl_loop_for_clause_s cl_loop_for_clause_t;
  87 typedef struct cl_loop_do_clause_s cl_loop_do_clause_t;
  88 typedef struct cl_loop_with_clause_s cl_loop_with_clause_t;
  89 typedef struct cl_loop_repeat_clause_s cl_loop_repeat_clause_t;
  90 typedef struct cl_loop_append_clause_s cl_loop_append_clause_t;
  91 typedef struct cl_loop_accu_clause_s cl_loop_accu_clause_t;
  92 typedef struct cl_loop_inifinret_clause_s cl_loop_inifinret_clause_t;
  93
  94 #include "cl-loop-parser.h"
  95
  96 /* nasty nasty nasty
  97  * tg reported that bison 2.4.1 may not define YYSTYPE, we go the
  98  * utmost safe way and just define it here */
  99 #undef YYSTYPE
 100 #define YYSTYPE int
 101
 102 /* bison stuff */
 103 extern int
 104 cl_loop_yylex(YYSTYPE*, Lisp_Object*,
 105               cl_loop_sentence_t*, Lisp_Object*, Lisp_Object*);
 106 extern void
 107 cl_loop_yyerror(Lisp_Object*,
 108                 cl_loop_sentence_t*, Lisp_Object*, Lisp_Object*, char*);
 109 extern int
 110 cl_loop_yyparse(Lisp_Object*,
 111                 cl_loop_sentence_t*, Lisp_Object*, Lisp_Object*);
 112
 113 \f
 114 /* a loop sentence is a set of loop clauses */
 115 struct cl_loop_sentence_s {
 116         Lisp_Object prologue;
 117         Lisp_Object epilogue;
 118         Lisp_Object iteration;
 119
 120         /* during runtime */
 121         int state;
 122         Lisp_Object result;
 123 #if 0
 124         sxe_mutex_t lsen_mtx;
 125 #endif  /* not yet */
 126 };
 127
 128 struct cl_loop_for_clause_s {
 129         Lisp_Object form1;
 130
 131         enum {
 132                 FOR_INVALID_CLAUSE,
 133                 FOR_ARITHMETIC_CLAUSE,
 134                 FOR_IN_SUBLIST_CLAUSE,
 135                 FOR_ON_SUBLIST_CLAUSE,
 136                 FOR_ACROSS_ARRAY_CLAUSE,
 137                 FOR_EQUALS_THEN_CLAUSE,
 138                 FOR_OF_HASHTABLE_CLAUSE
 139         } for_subclause;
 140
 141         /* for the arith subclause */
 142         Lisp_Object from;
 143         Lisp_Object to;
 144         Lisp_Object by;
 145         ase_binary_operation_t byop;
 146         ase_binary_relation_t torel;
 147         int torel_strictp;
 148
 149         /* for the in, on, and across subclauses */
 150         Lisp_Object inonacross;
 151
 152         /* for the =-then subclause */
 153         Lisp_Object equals;
 154         Lisp_Object then;
 155
 156         /* for the being-each-hash-key/value subclause */
 157         Lisp_Object hash_keyvar;
 158         Lisp_Object hash_valvar;
 159
 160         /* for parallel stepping for clauses */
 161         Lisp_Object next;
 162         int depth;
 163
 164         /* during runtime */
 165         Lisp_Object curval;
 166         Lisp_Object curbound;
 167         Lisp_Object curstep;
 168         long counter;
 169         long bound;
 170         void *ptr1;
 171         void *ptr2;
 172 };
 173
 174 struct cl_loop_do_clause_s {
 175         Lisp_Object form;
 176 };
 177
 178 struct cl_loop_repeat_clause_s {
 179         Lisp_Object form;
 180         long counter;
 181 };
 182
 183 struct cl_loop_with_clause_s {
 184         Lisp_Object varform;
 185         Lisp_Object valform;
 186         /* for parallel with clauses */
 187         Lisp_Object next;
 188         int depth;
 189 };
 190
 191 struct cl_loop_accu_clause_s {
 192         Lisp_Object form;
 193         Lisp_Object into;
 194         /* state */
 195         Lisp_Object cur;
 196 };
 197
 198 struct cl_loop_inifinret_clause_s {
 199         Lisp_Object form;
 200 };
 201
 202 \f
 203 #define CL_LOOP_SENTENCEP(_i)                                           \
 204         (DYNACATP(_i) && EQ(XDYNACAT_TYPE(_i), Qcl_loop_sentence))
 205 #define CHECK_CL_LOOP_SENTENCE(x)                                       \
 206         do {                                                            \
 207                 if (!CL_LOOP_SENTENCEP(x))                              \
 208                         dead_wrong_type_argument(Qcl_loop_sentence_p, x); \
 209         } while (0)
 210 #define CONCHECK_CL_LOOP_SENTENCE(x)                                    \
 211         do {                                                            \
 212                 if (!CL_LOOP_SENTENCEP(x))                              \
 213                         x = wrong_type_argument(Qcl_loop_sentence_p, x); \
 214         } while (0)
 215 #define XCL_LOOP_SENTENCE(_x)   ((cl_loop_sentence_t*)get_dynacat(_x))
 216
 217
 218 extern Lisp_Object cl_loop_make_for_clause(Lisp_Object);
 219 extern Lisp_Object cl_loop_make_do_clause(Lisp_Object);
 220 extern Lisp_Object cl_loop_make_with_clause(Lisp_Object);
 221 extern Lisp_Object cl_loop_make_repeat_clause(Lisp_Object);
 222 extern Lisp_Object cl_loop_make_append_clause(Lisp_Object);
 223 extern Lisp_Object cl_loop_make_collect_clause(Lisp_Object);
 224 extern Lisp_Object cl_loop_make_nconc_clause(Lisp_Object);
 225 extern Lisp_Object cl_loop_make_return_clause(Lisp_Object);
 226 extern Lisp_Object cl_loop_make_initially_clause(Lisp_Object);
 227 extern Lisp_Object cl_loop_make_finally_clause(Lisp_Object);
 228 extern Lisp_Object cl_loop_make_count_clause(Lisp_Object);
 229 extern Lisp_Object cl_loop_make_sum_clause(Lisp_Object);
 230 extern Lisp_Object cl_loop_make_maximise_clause(Lisp_Object);
 231 extern Lisp_Object cl_loop_make_minimise_clause(Lisp_Object);
 232
 233 \f
 234 extern void cl_loop_LTX_init(void);
 235 extern void cl_loop_LTX_deinit(void);
 236 extern void cl_loop_LTX_reinit(void);
 237
 238 #endif  /* INCLUDED_cl_loop_h_ */