cgit.sxemacs.org Git - sxemacs/blob - modules/cl/cl-loop-parser.y

   1 %{
   2 /* format.y - SXEmacs format function
   3
   4    Copyright (C) 2006 Sebastian Freundt.
   5
   6 This file is part of SXEmacs.
   7
   8 SXEmacs is free software: you can redistribute it and/or modify it
   9 under the terms of the GNU General Public License as published by the
  10 Free Software Foundation, either version 3 of the License, or (at your
  11 option) any later version.
  12
  13 SXEmacs is distributed in the hope that it will be
  14 useful, but WITHOUT ANY WARRANTY; without even the implied warranty of
  15 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  16 General Public License for more details.
  17
  18 You should have received a copy of the GNU General Public License
  19 along with this program.  If not, see <http://www.gnu.org/licenses/>. */
  20
  21 /* Synched up with: Not in FSF. */
  22
  23 #include <config.h>
  24 #include <sxemacs.h>
  25 #include "cl-loop.h"
  26 #include "cl-loop-parser.h"
  27
  28 #define YYENABLE_NLS            0
  29 #define YYLTYPE_IS_TRIVIAL      1
  30
  31 static inline Lisp_Object
  32 cl_loop_frob_scanner(Lisp_Object *scanner)
  33         __attribute__((always_inline));
  34 static inline Lisp_Object
  35 cl_loop_frob_scanner(Lisp_Object *scanner)
  36 {
  37         if (!NILP(*scanner)) {
  38                 return XCAR(*scanner);
  39         } else {
  40                 Fsignal(Qinvalid_read_syntax, *scanner);
  41                 return Qnil;
  42         }
  43 }
  44
  45 static inline void
  46 cl_loop_step_scanner(Lisp_Object *scanner)
  47         __attribute__((always_inline));
  48 static inline void
  49 cl_loop_step_scanner(Lisp_Object *scanner)
  50 {
  51         if (!NILP(*scanner)) {
  52                 *scanner = XCDR(*scanner);
  53         }
  54 }
  55
  56 %}
  57
  58 %name-prefix="cl_loop_yy"
  59 %pure_parser
  60 %defines
  61
  62 %parse-param {Lisp_Object *yyscanner}
  63 %lex-param {Lisp_Object *yyscanner}
  64 %parse-param {cl_loop_sentence_t *lsen}
  65 %lex-param {cl_loop_sentence_t *lsen}
  66 %parse-param {Lisp_Object *context}
  67 %lex-param {Lisp_Object *context}
  68 %parse-param {Lisp_Object *token}
  69 %lex-param {Lisp_Object *token}
  70
  71 %token /* <forkeys> */
  72         FROM
  73         TO
  74         BELOW
  75         ABOVE
  76         BY
  77         IN
  78         ON
  79         THEN
  80         ACROSS
  81         EACH
  82         BEING
  83         HASH_KEY
  84         HASH_VALUE
  85         USING
  86
  87 %token /* <withkeys> */
  88         WITH
  89         EQUALS
  90
  91 %token /* <gatherers> */
  92         APPEND
  93         COLLECT
  94         NCONC
  95         SUM
  96         COUNT
  97         MINIMISE
  98         MAXIMISE
  99
 100 %token /* <terminators> */
 101         FOR
 102         REPEAT
 103         WHILE
 104         UNTIL
 105         ALWAYS
 106         NEVER
 107         THEREIS
 108
 109 %token /* <terminators> */
 110         DO
 111         IF
 112         WHEN
 113         UNLESS
 114         ELSE
 115         END
 116
 117 %token /* <misc> */
 118         AND
 119         RETURN
 120         INITIALLY
 121         FINALLY
 122         NAMED
 123         FORM
 124         INTO
 125
 126 %expect 0
 127
 128 %%
 129
 130 /* RULES */
 131 loop:
 132 /* EMPTY */ |
 133 clause loop;
 134
 135 clause:
 136 for_clauses |
 137 do_clause {
 138         dllist_t iter = XDLLIST(lsen->iteration);
 139         Lisp_Object do_clause = *context;
 140
 141         EMOD_CL_DEBUG_LOOP("accepting DO clause\n");
 142         dllist_append(iter, (void*)do_clause);
 143 } |
 144 with_clause {
 145         dllist_t pro = XDLLIST(lsen->prologue);
 146         Lisp_Object with_clause = *context;
 147
 148         EMOD_CL_DEBUG_LOOP("accepting WITH clause\n");
 149         dllist_append(pro, (void*)with_clause);
 150 } |
 151 repeat_clause {
 152         dllist_t pro = XDLLIST(lsen->prologue);
 153         dllist_t iter = XDLLIST(lsen->iteration);
 154         Lisp_Object repeat_clause = *context;
 155
 156         EMOD_CL_DEBUG_LOOP("accepting REPEAT clause\n");
 157         dllist_append(pro, (void*)repeat_clause);
 158         dllist_append(iter, (void*)repeat_clause);
 159 } |
 160 append_clause {
 161         dllist_t pro = XDLLIST(lsen->prologue);
 162         dllist_t iter = XDLLIST(lsen->iteration);
 163         dllist_t epi = XDLLIST(lsen->epilogue);
 164         Lisp_Object append_clause = *context;
 165
 166         EMOD_CL_DEBUG_LOOP("accepting APPEND clause\n");
 167         dllist_append(pro, (void*)append_clause);
 168         dllist_append(iter, (void*)append_clause);
 169         dllist_append(epi, (void*)append_clause);
 170 } |
 171 collect_clause {
 172         dllist_t pro = XDLLIST(lsen->prologue);
 173         dllist_t iter = XDLLIST(lsen->iteration);
 174         dllist_t epi = XDLLIST(lsen->epilogue);
 175         Lisp_Object collect_clause = *context;
 176
 177         EMOD_CL_DEBUG_LOOP("accepting COLLECT clause\n");
 178         dllist_append(pro, (void*)collect_clause);
 179         dllist_append(iter, (void*)collect_clause);
 180         dllist_append(epi, (void*)collect_clause);
 181 } |
 182 nconc_clause {
 183         dllist_t pro = XDLLIST(lsen->prologue);
 184         dllist_t iter = XDLLIST(lsen->iteration);
 185         dllist_t epi = XDLLIST(lsen->epilogue);
 186         Lisp_Object nconc_clause = *context;
 187
 188         EMOD_CL_DEBUG_LOOP("accepting NCONC clause\n");
 189         dllist_append(pro, (void*)nconc_clause);
 190         dllist_append(iter, (void*)nconc_clause);
 191         dllist_append(epi, (void*)nconc_clause);
 192 } |
 193 sum_clause {
 194         dllist_t pro = XDLLIST(lsen->prologue);
 195         dllist_t iter = XDLLIST(lsen->iteration);
 196         dllist_t epi = XDLLIST(lsen->epilogue);
 197         Lisp_Object accu_clause = *context;
 198
 199         EMOD_CL_DEBUG_LOOP("accepting SUM clause\n");
 200         dllist_append(pro, (void*)accu_clause);
 201         dllist_append(iter, (void*)accu_clause);
 202         dllist_append(epi, (void*)accu_clause);
 203 } |
 204 count_clause {
 205         dllist_t pro = XDLLIST(lsen->prologue);
 206         dllist_t iter = XDLLIST(lsen->iteration);
 207         dllist_t epi = XDLLIST(lsen->epilogue);
 208         Lisp_Object accu_clause = *context;
 209
 210         EMOD_CL_DEBUG_LOOP("accepting count clause\n");
 211         dllist_append(pro, (void*)accu_clause);
 212         dllist_append(iter, (void*)accu_clause);
 213         dllist_append(epi, (void*)accu_clause);
 214 } |
 215 maximise_clause {
 216         dllist_t pro = XDLLIST(lsen->prologue);
 217         dllist_t iter = XDLLIST(lsen->iteration);
 218         dllist_t epi = XDLLIST(lsen->epilogue);
 219         Lisp_Object accu_clause = *context;
 220
 221         EMOD_CL_DEBUG_LOOP("accepting MAXIMISE clause\n");
 222         dllist_append(pro, (void*)accu_clause);
 223         dllist_append(iter, (void*)accu_clause);
 224         dllist_append(epi, (void*)accu_clause);
 225 } |
 226 minimise_clause {
 227         dllist_t pro = XDLLIST(lsen->prologue);
 228         dllist_t iter = XDLLIST(lsen->iteration);
 229         dllist_t epi = XDLLIST(lsen->epilogue);
 230         Lisp_Object accu_clause = *context;
 231
 232         EMOD_CL_DEBUG_LOOP("accepting MINIMISE clause\n");
 233         dllist_append(pro, (void*)accu_clause);
 234         dllist_append(iter, (void*)accu_clause);
 235         dllist_append(epi, (void*)accu_clause);
 236 } |
 237 initially_clause {
 238         dllist_t pro = XDLLIST(lsen->prologue);
 239         Lisp_Object initially_clause = *context;
 240
 241         EMOD_CL_DEBUG_LOOP("accepting INITIALLY clause\n");
 242         dllist_append(pro, (void*)initially_clause);
 243 } |
 244 finally_clause {
 245         dllist_t epi = XDLLIST(lsen->epilogue);
 246         Lisp_Object finally_clause = *context;
 247
 248         EMOD_CL_DEBUG_LOOP("accepting FINALLY clause\n");
 249         dllist_append(epi, (void*)finally_clause);
 250 } |
 251 return_clause {
 252         dllist_t epi = XDLLIST(lsen->epilogue);
 253         Lisp_Object return_clause = *context;
 254
 255         EMOD_CL_DEBUG_LOOP("accepting RETURN clause\n");
 256         dllist_append(epi, (void*)return_clause);
 257 }
 258 /* | while | until | always | never | thereis
 259  *      if | when | unless | else | end | named
 260  */
 261 ;
 262
 263 /* clauses in greater detail */
 264 do_clause:
 265 DO
 266 {
 267         Lisp_Object form = cl_loop_frob_scanner(yyscanner);
 268
 269         EMOD_CL_DEBUG_LOOP("DO clause found\n");
 270         *context = cl_loop_make_do_clause(form);
 271         cl_loop_step_scanner(yyscanner);
 272 };
 273
 274 append_clause:
 275 append | append into;
 276
 277 collect_clause:
 278 collect | collect into;
 279
 280 nconc_clause:
 281 nconc | nconc into;
 282
 283 count_clause:
 284 count | count into;
 285
 286 sum_clause:
 287 sum | sum into;
 288
 289 minimise_clause:
 290 minimise | minimise into;
 291
 292 maximise_clause:
 293 maximise | maximise into;
 294
 295 append:
 296 APPEND
 297 {
 298         Lisp_Object form = cl_loop_frob_scanner(yyscanner);
 299
 300         EMOD_CL_DEBUG_LOOP("APPEND clause found\n");
 301         *context = cl_loop_make_append_clause(form);
 302         cl_loop_step_scanner(yyscanner);
 303 };
 304
 305 collect:
 306 COLLECT
 307 {
 308         Lisp_Object form = cl_loop_frob_scanner(yyscanner);
 309
 310         EMOD_CL_DEBUG_LOOP("COLLECT clause found\n");
 311         *context = cl_loop_make_collect_clause(form);
 312         cl_loop_step_scanner(yyscanner);
 313 };
 314
 315 nconc:
 316 NCONC
 317 {
 318         Lisp_Object form = cl_loop_frob_scanner(yyscanner);
 319
 320         EMOD_CL_DEBUG_LOOP("NCONC clause found\n");
 321         *context = cl_loop_make_nconc_clause(form);
 322         cl_loop_step_scanner(yyscanner);
 323 };
 324
 325 count:
 326 COUNT
 327 {
 328         Lisp_Object form = cl_loop_frob_scanner(yyscanner);
 329
 330         EMOD_CL_DEBUG_LOOP("COUNT clause found\n");
 331         *context = cl_loop_make_count_clause(form);
 332         cl_loop_step_scanner(yyscanner);
 333 };
 334
 335 sum:
 336 SUM
 337 {
 338         Lisp_Object form = cl_loop_frob_scanner(yyscanner);
 339
 340         EMOD_CL_DEBUG_LOOP("SUM clause found\n");
 341         *context = cl_loop_make_sum_clause(form);
 342         cl_loop_step_scanner(yyscanner);
 343 };
 344
 345 maximise:
 346 MAXIMISE
 347 {
 348         Lisp_Object form = cl_loop_frob_scanner(yyscanner);
 349
 350         EMOD_CL_DEBUG_LOOP("MAXIMISE clause found\n");
 351         *context = cl_loop_make_maximise_clause(form);
 352         cl_loop_step_scanner(yyscanner);
 353 };
 354
 355 minimise:
 356 MINIMISE
 357 {
 358         Lisp_Object form = cl_loop_frob_scanner(yyscanner);
 359
 360         EMOD_CL_DEBUG_LOOP("MINIMISE clause found\n");
 361         *context = cl_loop_make_minimise_clause(form);
 362         cl_loop_step_scanner(yyscanner);
 363 };
 364
 365 into:
 366 INTO
 367 {
 368         Lisp_Object acn_clause = *context;
 369         Lisp_Object form = cl_loop_frob_scanner(yyscanner);
 370
 371         EMOD_CL_DEBUG_LOOP("INTO found\n");
 372         if (EQ(get_dynacat_type(acn_clause), Qcl_loop_collect_clause)) {
 373                 cl_loop_accu_clause_t *cc = get_dynacat(acn_clause);
 374                 cc->into = form;
 375         } else if (EQ(get_dynacat_type(acn_clause), Qcl_loop_append_clause)) {
 376                 cl_loop_accu_clause_t *ac = get_dynacat(acn_clause);
 377                 ac->into = form;
 378         } else if (EQ(get_dynacat_type(acn_clause), Qcl_loop_nconc_clause)) {
 379                 cl_loop_accu_clause_t *nc = get_dynacat(acn_clause);
 380                 nc->into = form;
 381         } else if (EQ(get_dynacat_type(acn_clause), Qcl_loop_count_clause)) {
 382                 cl_loop_accu_clause_t *nc = get_dynacat(acn_clause);
 383                 nc->into = form;
 384         } else if (EQ(get_dynacat_type(acn_clause), Qcl_loop_sum_clause)) {
 385                 cl_loop_accu_clause_t *nc = get_dynacat(acn_clause);
 386                 nc->into = form;
 387         } else if (EQ(get_dynacat_type(acn_clause), Qcl_loop_minimise_clause)) {
 388                 cl_loop_accu_clause_t *nc = get_dynacat(acn_clause);
 389                 nc->into = form;
 390         } else if (EQ(get_dynacat_type(acn_clause), Qcl_loop_maximise_clause)) {
 391                 cl_loop_accu_clause_t *nc = get_dynacat(acn_clause);
 392                 nc->into = form;
 393         } else {
 394                 /* uh oh */
 395         }
 396         cl_loop_step_scanner(yyscanner);
 397 };
 398
 399 repeat_clause:
 400 REPEAT
 401 {
 402         Lisp_Object form = cl_loop_frob_scanner(yyscanner);
 403
 404         EMOD_CL_DEBUG_LOOP("REPEAT clause found\n");
 405         *context = cl_loop_make_repeat_clause(form);
 406         cl_loop_step_scanner(yyscanner);
 407 };
 408
 409 return_clause:
 410 RETURN
 411 {
 412         Lisp_Object form = cl_loop_frob_scanner(yyscanner);
 413
 414         EMOD_CL_DEBUG_LOOP("RETURN clause found\n");
 415         *context = cl_loop_make_return_clause(form);
 416         cl_loop_step_scanner(yyscanner);
 417 };
 418
 419 initially_clause:
 420 INITIALLY
 421 {
 422         Lisp_Object form = cl_loop_frob_scanner(yyscanner);
 423
 424         EMOD_CL_DEBUG_LOOP("INITIALLY clause found\n");
 425         *context = cl_loop_make_initially_clause(form);
 426         cl_loop_step_scanner(yyscanner);
 427 };
 428
 429 finally_clause:
 430 FINALLY
 431 {
 432         Lisp_Object form = cl_loop_frob_scanner(yyscanner);
 433
 434         EMOD_CL_DEBUG_LOOP("FINALLY clause found\n");
 435         *context = cl_loop_make_finally_clause(form);
 436         cl_loop_step_scanner(yyscanner);
 437 };
 438
 439 with_clause:
 440 with equals |
 441 with equals with_and_clause;
 442
 443 with_and_clause:
 444 and equals |
 445 and equals with_and_clause;
 446
 447 for_clauses:
 448 for_clause |
 449 for_clause for_and_clause;
 450
 451 for_and_clause:
 452 and_clause |
 453 and_clause for_and_clause;
 454
 455 for_clause:
 456 for_arith_clause {
 457         dllist_t pro = XDLLIST(lsen->prologue);
 458         dllist_t iter = XDLLIST(lsen->iteration);
 459         Lisp_Object for_clause = *context;
 460         cl_loop_for_clause_t *fc = get_dynacat(for_clause);
 461
 462         EMOD_CL_DEBUG_LOOP("accepting FOR clause, arithmetic form\n");
 463         fc->for_subclause = FOR_ARITHMETIC_CLAUSE;
 464         dllist_append(iter, (void*)for_clause);
 465         dllist_append(pro, (void*)for_clause);
 466 } |
 467 for_in_clause {
 468         dllist_t pro = XDLLIST(lsen->prologue);
 469         dllist_t iter = XDLLIST(lsen->iteration);
 470         Lisp_Object for_clause = *context;
 471         cl_loop_for_clause_t *fc = get_dynacat(for_clause);
 472
 473         EMOD_CL_DEBUG_LOOP("accepting FOR clause, in-list form\n");
 474         fc->for_subclause = FOR_IN_SUBLIST_CLAUSE;
 475         dllist_append(iter, (void*)for_clause);
 476         dllist_append(pro, (void*)for_clause);
 477 } |
 478 for_on_clause {
 479         dllist_t pro = XDLLIST(lsen->prologue);
 480         dllist_t iter = XDLLIST(lsen->iteration);
 481         Lisp_Object for_clause = *context;
 482         cl_loop_for_clause_t *fc = get_dynacat(for_clause);
 483
 484         EMOD_CL_DEBUG_LOOP("accepting FOR clause, on-list form\n");
 485         fc->for_subclause = FOR_ON_SUBLIST_CLAUSE;
 486         dllist_append(iter, (void*)for_clause);
 487         dllist_append(pro, (void*)for_clause);
 488 } |
 489 for_across_clause {
 490         dllist_t pro = XDLLIST(lsen->prologue);
 491         dllist_t iter = XDLLIST(lsen->iteration);
 492         Lisp_Object for_clause = *context;
 493         cl_loop_for_clause_t *fc = get_dynacat(for_clause);
 494
 495         EMOD_CL_DEBUG_LOOP("accepting FOR clause, across-array form\n");
 496         fc->for_subclause = FOR_ACROSS_ARRAY_CLAUSE;
 497         dllist_append(iter, (void*)for_clause);
 498         dllist_append(pro, (void*)for_clause);
 499 } |
 500 for_equals_then_clause {
 501         dllist_t pro = XDLLIST(lsen->prologue);
 502         dllist_t iter = XDLLIST(lsen->iteration);
 503         Lisp_Object for_clause = *context;
 504         cl_loop_for_clause_t *fc = get_dynacat(for_clause);
 505
 506         EMOD_CL_DEBUG_LOOP("accepting FOR clause, =-then form\n");
 507         fc->for_subclause = FOR_EQUALS_THEN_CLAUSE;
 508         dllist_append(pro, (void*)for_clause);
 509         dllist_append(iter, (void*)for_clause);
 510 } |
 511 for_hash_clause {
 512         dllist_t pro = XDLLIST(lsen->prologue);
 513         dllist_t iter = XDLLIST(lsen->iteration);
 514         Lisp_Object for_clause = *context;
 515         cl_loop_for_clause_t *fc = get_dynacat(for_clause);
 516
 517         EMOD_CL_DEBUG_LOOP("accepting FOR clause, of-hash-table form\n");
 518         fc->for_subclause = FOR_OF_HASHTABLE_CLAUSE;
 519         dllist_append(pro, (void*)for_clause);
 520         dllist_append(iter, (void*)for_clause);
 521 };
 522
 523 and_clause:
 524 and_arith_clause {
 525         cl_loop_for_clause_t *fc = get_dynacat(*context);
 526         EMOD_CL_DEBUG_LOOP("accepting FOR+AND clause, arithmetic form\n");
 527         fc->for_subclause = FOR_ARITHMETIC_CLAUSE;
 528 } |
 529 and_in_clause {
 530         cl_loop_for_clause_t *fc = get_dynacat(*context);
 531         EMOD_CL_DEBUG_LOOP("accepting FOR+AND clause, in-list form\n");
 532         fc->for_subclause = FOR_IN_SUBLIST_CLAUSE;
 533 } |
 534 and_on_clause {
 535         cl_loop_for_clause_t *fc = get_dynacat(*context);
 536         EMOD_CL_DEBUG_LOOP("accepting FOR+AND clause, on-list form\n");
 537         fc->for_subclause = FOR_ON_SUBLIST_CLAUSE;
 538 } |
 539 and_across_clause {
 540         cl_loop_for_clause_t *fc = get_dynacat(*context);
 541         EMOD_CL_DEBUG_LOOP("accepting FOR+AND clause, across-array form\n");
 542         fc->for_subclause = FOR_ACROSS_ARRAY_CLAUSE;
 543 } |
 544 and_equals_then_clause {
 545         cl_loop_for_clause_t *fc = get_dynacat(*context);
 546         EMOD_CL_DEBUG_LOOP("accepting FOR+AND clause, =-then form\n");
 547         fc->for_subclause = FOR_EQUALS_THEN_CLAUSE;
 548 } |
 549 and_hash_clause {
 550         cl_loop_for_clause_t *fc = get_dynacat(*context);
 551         EMOD_CL_DEBUG_LOOP("accepting FOR+AND clause, of-hash-table form\n");
 552         fc->for_subclause = FOR_OF_HASHTABLE_CLAUSE;
 553 };
 554
 555 for_in_clause:
 556 for in;
 557
 558 and_in_clause:
 559 and in;
 560
 561 for_on_clause:
 562 for on;
 563
 564 and_on_clause:
 565 and on;
 566
 567 for_across_clause:
 568 for across;
 569
 570 and_across_clause:
 571 and across;
 572
 573 for_equals_then_clause:
 574 for equals then;
 575
 576 and_equals_then_clause:
 577 and equals then;
 578
 579 for_hash_clause:
 580 for being_each_hash_key_in |
 581 for being_each_hash_value_in |
 582 for being_each_hash_key_in using |
 583 for being_each_hash_value_in using;
 584
 585 and_hash_clause:
 586 and being_each_hash_key_in |
 587 and being_each_hash_value_in |
 588 and being_each_hash_key_in using |
 589 and being_each_hash_value_in using;
 590
 591 for_arith_clause:
 592 for fromtoby |
 593 for frombelowby |
 594 for fromaboveby |
 595 for fromto |
 596 for fromby |
 597 for frombelow |
 598 for fromabove |
 599 for toby |
 600 for belowby |
 601 for aboveby |
 602 for from |
 603 for to |
 604 for by |
 605 for below |
 606 for above;
 607
 608 and_arith_clause:
 609 and fromtoby |
 610 and frombelowby |
 611 and fromaboveby |
 612 and fromto |
 613 and fromby |
 614 and frombelow |
 615 and fromabove |
 616 and toby |
 617 and belowby |
 618 and aboveby |
 619 and from |
 620 and to |
 621 and by |
 622 and below |
 623 and above;
 624
 625
 626 for:
 627 FOR
 628 {
 629         Lisp_Object form = cl_loop_frob_scanner(yyscanner);
 630
 631         EMOD_CL_DEBUG_LOOP("FOR clause found\n");
 632         *context = cl_loop_make_for_clause(form);
 633         cl_loop_step_scanner(yyscanner);
 634 };
 635
 636 fromtoby:
 637 from to by | from by to | to from by | to by from | by from to | by to from;
 638
 639 frombelowby:
 640 from below by | from by below | below from by | below by from |
 641 by from below | by below from;
 642
 643 fromaboveby:
 644 from above by | from by above | above from by | above by from |
 645 by from above | by above from;
 646
 647 fromto:
 648 from to | to from;
 649
 650 fromby:
 651 from by | by from;
 652
 653 frombelow:
 654 from below | below from;
 655
 656 fromabove:
 657 from above | above from;
 658
 659 toby:
 660 to by | by to;
 661
 662 belowby:
 663 below by | by below;
 664
 665 aboveby:
 666 above by | by above;
 667
 668 from:
 669 FROM
 670 {
 671         Lisp_Object for_clause = *context;
 672         cl_loop_for_clause_t *fc = get_dynacat(for_clause);
 673         Lisp_Object form = cl_loop_frob_scanner(yyscanner);
 674
 675         EMOD_CL_DEBUG_LOOP("FROM found\n");
 676         fc->from = form;
 677         if (EQ(*token, Qdownfrom)) {
 678                 EMOD_CL_DEBUG_LOOP("FROM found is even a DOWNFROM\n");
 679                 fc->torel = ASE_BINARY_REL_GREATERP;
 680                 fc->byop = ASE_BINARY_OP_DIFF;
 681         }
 682         cl_loop_step_scanner(yyscanner);
 683 };
 684
 685 to:
 686 TO
 687 {
 688         Lisp_Object for_clause = *context;
 689         cl_loop_for_clause_t *fc = get_dynacat(for_clause);
 690         Lisp_Object form = cl_loop_frob_scanner(yyscanner);
 691
 692         EMOD_CL_DEBUG_LOOP("TO found\n");
 693         fc->to = form;
 694         if (EQ(*token, Qdownto)) {
 695                 EMOD_CL_DEBUG_LOOP("TO found is even a DOWNTO\n");
 696                 fc->torel = ASE_BINARY_REL_GREATERP;
 697                 fc->byop = ASE_BINARY_OP_DIFF;
 698         }
 699         cl_loop_step_scanner(yyscanner);
 700 };
 701
 702 by:
 703 BY
 704 {
 705         Lisp_Object for_clause = *context;
 706         cl_loop_for_clause_t *fc = get_dynacat(for_clause);
 707         Lisp_Object form = cl_loop_frob_scanner(yyscanner);
 708
 709         EMOD_CL_DEBUG_LOOP("BY found\n");
 710         fc->by = form;
 711         cl_loop_step_scanner(yyscanner);
 712 };
 713
 714 below:
 715 BELOW
 716 {
 717         Lisp_Object for_clause = *context;
 718         cl_loop_for_clause_t *fc = get_dynacat(for_clause);
 719         Lisp_Object form = cl_loop_frob_scanner(yyscanner);
 720
 721         EMOD_CL_DEBUG_LOOP("BELOW found\n");
 722         fc->torel = ASE_BINARY_REL_LESSP;
 723         fc->torel_strictp = 1;
 724         fc->byop = ASE_BINARY_OP_SUM;
 725         fc->to = form;
 726         cl_loop_step_scanner(yyscanner);
 727 };
 728
 729
 730 above:
 731 ABOVE
 732 {
 733         Lisp_Object for_clause = *context;
 734         cl_loop_for_clause_t *fc = get_dynacat(for_clause);
 735         Lisp_Object form = cl_loop_frob_scanner(yyscanner);
 736
 737         EMOD_CL_DEBUG_LOOP("ABOVE found\n");
 738         fc->torel = ASE_BINARY_REL_GREATERP;
 739         fc->torel_strictp = 1;
 740         fc->byop = ASE_BINARY_OP_DIFF;
 741         fc->to = form;
 742         cl_loop_step_scanner(yyscanner);
 743 };
 744
 745 in:
 746 IN
 747 {
 748         Lisp_Object for_clause = *context;
 749         cl_loop_for_clause_t *fc = get_dynacat(for_clause);
 750         Lisp_Object form = cl_loop_frob_scanner(yyscanner);
 751
 752         EMOD_CL_DEBUG_LOOP("IN found\n");
 753         fc->inonacross = form;
 754         cl_loop_step_scanner(yyscanner);
 755 };
 756
 757 on:
 758 ON
 759 {
 760         Lisp_Object for_clause = *context;
 761         cl_loop_for_clause_t *fc = get_dynacat(for_clause);
 762         Lisp_Object form = cl_loop_frob_scanner(yyscanner);
 763
 764         EMOD_CL_DEBUG_LOOP("ON found\n");
 765         fc->inonacross = form;
 766         cl_loop_step_scanner(yyscanner);
 767 };
 768
 769 across:
 770 ACROSS
 771 {
 772         Lisp_Object for_clause = *context;
 773         cl_loop_for_clause_t *fc = get_dynacat(for_clause);
 774         Lisp_Object form = cl_loop_frob_scanner(yyscanner);
 775
 776         EMOD_CL_DEBUG_LOOP("ACROSS found\n");
 777         fc->inonacross = form;
 778         cl_loop_step_scanner(yyscanner);
 779 };
 780
 781 with:
 782 WITH
 783 {
 784         Lisp_Object form = cl_loop_frob_scanner(yyscanner);
 785
 786         EMOD_CL_DEBUG_LOOP("WITH clause found\n");
 787         *context = cl_loop_make_with_clause(form);
 788         cl_loop_step_scanner(yyscanner);
 789 };
 790
 791 and:
 792 AND
 793 {
 794         Lisp_Object clause = *context;
 795         Lisp_Object form = cl_loop_frob_scanner(yyscanner);
 796
 797         if (EQ(get_dynacat_type(clause), Qcl_loop_with_clause)) {
 798                 Lisp_Object newwf = cl_loop_make_with_clause(form);
 799                 cl_loop_with_clause_t *newwc = get_dynacat(newwf);
 800                 cl_loop_with_clause_t *oldwc = get_dynacat(clause);
 801
 802                 EMOD_CL_DEBUG_LOOP("WITH+AND clause found\n");
 803                 newwc->next = *context;
 804                 newwc->depth += oldwc->depth;
 805                 *context = newwf;
 806         } else if (EQ(get_dynacat_type(clause), Qcl_loop_for_clause)) {
 807                 Lisp_Object newff = cl_loop_make_for_clause(form);
 808                 cl_loop_for_clause_t *oldfc = get_dynacat(*context);
 809
 810                 EMOD_CL_DEBUG_LOOP("FOR+AND clause found\n");
 811                 oldfc->next = newff;
 812                 oldfc->depth++;
 813                 *context = newff;
 814         } else {
 815                 Fsignal(Qinvalid_read_syntax, *yyscanner);
 816                 return Qnil;
 817         }
 818         cl_loop_step_scanner(yyscanner);
 819 };
 820
 821 equals:
 822 EQUALS
 823 {
 824         Lisp_Object clause = *context;
 825         Lisp_Object form = cl_loop_frob_scanner(yyscanner);
 826
 827         if (EQ(get_dynacat_type(clause), Qcl_loop_with_clause)) {
 828                 cl_loop_with_clause_t *wc = get_dynacat(clause);
 829                 EMOD_CL_DEBUG_LOOP("= found in WITH context\n");
 830                 wc->valform = form;
 831         } else if (EQ(get_dynacat_type(clause), Qcl_loop_for_clause)) {
 832                 cl_loop_for_clause_t *fc = get_dynacat(clause);
 833                 EMOD_CL_DEBUG_LOOP("= found in FOR context\n");
 834                 fc->equals = form;
 835         } else {
 836                 Fsignal(Qinvalid_read_syntax, *yyscanner);
 837                 return Qnil;
 838         }
 839         cl_loop_step_scanner(yyscanner);
 840 };
 841
 842 then:
 843 THEN
 844 {
 845         Lisp_Object for_clause = *context;
 846         cl_loop_for_clause_t *fc = get_dynacat(for_clause);
 847         Lisp_Object form = cl_loop_frob_scanner(yyscanner);
 848
 849         EMOD_CL_DEBUG_LOOP("THEN found\n");
 850         fc->then = form;
 851         cl_loop_step_scanner(yyscanner);
 852 };
 853
 854 being_each_hash_key_in:
 855 BEING EACH HASH_KEY IN
 856 {
 857         Lisp_Object for_clause = *context;
 858         cl_loop_for_clause_t *fc = get_dynacat(for_clause);
 859         Lisp_Object form = cl_loop_frob_scanner(yyscanner);
 860
 861         EMOD_CL_DEBUG_LOOP("BEING EACH HASH_KEY found\n");
 862         fc->inonacross = form;
 863         fc->hash_keyvar = fc->form1;
 864         cl_loop_step_scanner(yyscanner);
 865 };
 866
 867 being_each_hash_value_in:
 868 BEING EACH HASH_VALUE IN
 869 {
 870         Lisp_Object for_clause = *context;
 871         cl_loop_for_clause_t *fc = get_dynacat(for_clause);
 872         Lisp_Object form = cl_loop_frob_scanner(yyscanner);
 873
 874         EMOD_CL_DEBUG_LOOP("BEING EACH HASH_VALUE found\n");
 875         fc->inonacross = form;
 876         fc->hash_valvar = fc->form1;
 877         cl_loop_step_scanner(yyscanner);
 878 };
 879
 880 using:
 881 USING
 882 {
 883         Lisp_Object for_clause = *context;
 884         cl_loop_for_clause_t *fc = get_dynacat(for_clause);
 885         Lisp_Object form = cl_loop_frob_scanner(yyscanner);
 886
 887         EMOD_CL_DEBUG_LOOP("USING found\n");
 888         if (CONSP(form) && CONSP(XCDR(form)) &&
 889             EQ(XCAR(form), Qhash_key)) {
 890                 EMOD_CL_DEBUG_LOOP("USING specifies HASH_KEY symbol\n");
 891                 fc->hash_keyvar = XCAR(XCDR(form));
 892         } else if (CONSP(form) && CONSP(XCDR(form)) &&
 893                    EQ(XCAR(form), Qhash_value)) {
 894                 EMOD_CL_DEBUG_LOOP("USING specifies HASH_VALUE symbol\n");
 895                 fc->hash_valvar = XCAR(XCDR(form));
 896         }
 897         cl_loop_step_scanner(yyscanner);
 898 };
 899
 900 %%
 901
 902 #undef yyscan_t
 903 #undef yylval
 904 #undef yylloc
 905