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