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