std/std_macros.c

   1 /*
   2   std_macros.c - MaLa standard module macros
   3
   4   Copyright (C) 2005, 2006, Christian Thaeter <ct@pipapo.org>
   5
   6   This program is free software; you can redistribute it and/or modify
   7   it under the terms of the GNU General Public License version 2 as
   8   published by the Free Software Foundation.
   9
  10   This program is distributed in the hope that it will be useful,
  11   but WITHOUT ANY WARRANTY; without even the implied warranty of
  12   MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  13   GNU General Public License for more details.
  14
  15   You should have received a copy of the GNU General Public License
  16   along with this program; if not, contact me.
  17
  18 */
  19 \f
  20 #include <stdio.h>
  21 #include <string.h>
  22 #include <time.h>
  23
  24 #include "mala.h"
  25 #include "std_macros.h"
  26
  27 static void
  28 mala_stringlist_macrocheck (MalaStringList list, int * max_arg, mala_state argt[10]);
  29
  30 static void
  31 mala_string_macrocheck (MalaString string, int * max_arg, mala_state argt[10]);
  32
  33 static MalaString
  34 mala_string_new_macrosubst (MalaString src, MalaString args[10], MalaEngine eng);
  35
  36 static MalaStringList
  37 mala_stringlist_new_macrosubst (MalaStringList src, MalaString args[10], MalaEngine eng);
  38
  39 \f
  40
  41 static
  42 mala_actioninit std_macros[] =
  43   {
  44     MALA_PARSER_SIMPLE("--DEL", mala_delete_parser),
  45     MALA_PARSER_SIMPLE("--BEGIN", mala_begin_parser),
  46
  47     // MALA_PARSER_BRIEF("--BEGIN", "defines a block or list"),
  48     //TODO MALA_PARSER_SIGNATURE_TYPE("--BEGIN", ("SEQUENCE","END")),
  49     //TODO MALA_PARSER_SIGNATURE_USAGE("--BEGIN", ("content of the block", "a --END which closes the block")),
  50     //TODO MALA_PARSER_RESULT_TYPE("--BEGIN", ("BLOCK")),
  51     //TODO MALA_PARSER_RESULT_USAGE("--BEGIN", ("a unique name of the block")),
  52     //TODO MALA_PARSER_HELP("--BEGIN", ("Blocks can have % substitutions, Blocks are garbage collected, TODO")),
  53
  54
  55     MALA_PARSER_SIMPLE("--END", mala_end_parser),
  56     // TODO MALA_PARSER_BRIEF("--END", "closes a block"),
  57     //TODOMALA_PARSER_HELP("--END", ("an --END without a matching --BEGIN raises an error.")),
  58
  59     MALA_PARSER_SIMPLE("--DEF", mala_def_parser),
  60     //MALA_PARSER_BRIEF("--DEF", "defines a substitution"),
  61     //MALA_PARSER_SIGNATURE_TYPE("--DEF", ("WORD", "WORD-OR-BLOCK")),
  62     //TODO MALA_PARSER_SIGNATURE_USAGE("--DEF", ("word to be substituted",
  63     //                                    "replaced with this")),
  64     //TODO MALA_PARSER_HELP("--DEF", ("The second argument can be a block of words enclosed in --BEGIN ... --END with % substitution sequences. See help for --BEGIN for details.")),
  65     //TODO MALA_PARSER_EXAMPLE("--DEF", "--DEF `foo `bar\t expands foo to bar\n--DEF `--action --BEGIN foo bar --END\t --action will expand to foo bar"),
  66     //MALA_PARSER_BRIEF("MACROS", "TODO"),
  67     //MALA_PARSER_HELP("MACROS", ("TODO")),
  68
  69     /*
  70     MALA_PARSER("--", mala__parser, NULL, NULL, NULL),
  71     MALA_PARSER_BRIEF("--", ""),
  72     MALA_PARSER_HELP("--", ("TODO")),
  73     MALA_PARSER_SIGNATURE_TYPE("--", ("")),
  74     MALA_PARSER_SIGNATURE_USAGE("--", ("")),
  75     MALA_PARSER_RESULT_TYPE("--", ("")),
  76     MALA_PARSER_RESULT_USAGE("--", ("")),
  77
  78     MALA_PARSER("--FOREACH-WORD", mala_foreach_word_parser, NULL, NULL, NULL),
  79     MALA_PARSER_BRIEF("--", ""),
  80     MALA_PARSER_HELP("--", ("TODO")),
  81     MALA_PARSER_SIGNATURE_TYPE("--", ("")),
  82     MALA_PARSER_SIGNATURE_USAGE("--", ("")),
  83     MALA_PARSER_RESULT_TYPE("--", ("")),
  84     MALA_PARSER_RESULT_USAGE("--", ("")),
  85     */
  86
  87
  88
  89
  90     //MALA_PARSER_BRIEF("--DEL", "deletes a macro"),
  91     //TODO MALA_PARSER_SIGNATURE_TYPE("--DEL", ("WORD")),
  92     //TODO MALA_PARSER_SIGNATURE_USAGE("--DEL", ("name of the Macro to delete")),
  93     //TODO MALA_PARSER_HELP("--DEL", ("Removes the last definition of the most recent definition with the matching name and any childs which where attached to it (see --ATTACH)")),
  94
  95
  96     MALA_ACTIONS_END
  97   };
  98
  99
 100 mala_state
 101 mala_begin_parser (MalaProgram prg)
 102 {
 103   MalaStringList end;
 104   unsigned depth = 0;
 105
 106   TRACE (mala_module_std);
 107
 108   // find matching --END
 109   MalaStringList begin = mala_stringlist_next (prg->pptr);
 110   for (end = begin;
 111        !mala_stringlist_is_end (prg->program, end);
 112        mala_stringlist_fwd (&end))
 113     {
 114       if (mala_stringlist_string (end) == prg->engine->common_string[MALA_STRING_BEGIN])
 115         ++depth;
 116       else if (mala_stringlist_string (end) == prg->engine->common_string[MALA_STRING_END])
 117         --depth;
 118
 119       if (!depth)
 120         break;
 121     }
 122
 123   if (depth)
 124     return mala_program_commonexception (prg, MALA_STRING_ERROR_MISSING_END);
 125
 126   ACOGC_STACK_ENTER (&prg->engine->gcroot);
 127   ACOGC_STACK_PTR (MalaStringList, list);
 128   ACOGC_STACK_PTR (MalaString, name);
 129
 130   list.ptr = mala_stringlist_new (prg->engine);
 131   unsigned length = 0;
 132
 133   // move elements into destionation list
 134   while (mala_stringlist_next (begin) != end)
 135     {
 136       mala_stringlist_insert_tail (list.ptr, mala_stringlist_next (begin));
 137       ++length;
 138     }
 139
 140   MalaParserFunc parser;
 141   int max_arg = -1;
 142   mala_state argt[10] = {[0 ... 9] = MALA_EXCEPTION};
 143
 144   const char* templ;
 145   mala_state ret;
 146   void * data = NULL;
 147
 148   if (length == 0)
 149     {
 150       // --BEGIN --END becomes --PASS
 151       TODO ("direct --PASS substitute");
 152       parser = mala_pass_parser;
 153       templ = "--BLOCK_%08X";
 154       ret = MALA_BLOCK;
 155     }
 156   else if (length == 1)
 157     {
 158       data = mala_stringlist_string (mala_stringlist_head_get (list.ptr));
 159       mala_string_macrocheck ((MalaString) data, &max_arg, argt);
 160       if (max_arg == INT_MAX)
 161         {
 162           mala_stringlist_insert_after_stringlist (begin, list.ptr);
 163           ACOGC_STACK_LEAVE;
 164           return mala_program_commonexception (prg, MALA_STRING_ERROR_MACRO_SYNTAX);
 165         }
 166
 167       if (max_arg == -1)
 168         {
 169           // --BEGIN FOO --END becomes FOO
 170           TODO ("direct name substitute");
 171           parser = mala_substitute_parser;
 172           templ = "--BLOCK_%08X";
 173           ret = MALA_BLOCK;
 174         }
 175       else
 176         {
 177           parser = mala_macro_parser;
 178           templ = "--BLOCK_%08X";
 179           ret = MALA_BLOCK;
 180         }
 181     }
 182   else
 183     {
 184       data = list.ptr;
 185       mala_stringlist_macrocheck (list.ptr, &max_arg, argt);
 186       if (max_arg == INT_MAX)
 187         {
 188           mala_stringlist_insert_after_stringlist (begin, list.ptr);
 189           ACOGC_STACK_LEAVE;
 190           return mala_program_commonexception (prg, MALA_STRING_ERROR_MACRO_SYNTAX);
 191         }
 192
 193       if (max_arg == -1)
 194         {
 195           parser = mala_expand_parser;
 196           templ = "--BLOCK_%08X";
 197           ret = MALA_BLOCK;
 198         }
 199       else
 200         {
 201           parser = mala_macro_parser;
 202           templ = "--BLOCK_%08X";
 203           ret = MALA_BLOCK;
 204         }
 205     }
 206
 207   mala_stringlist_remove (mala_stringlist_next (prg->pptr));
 208
 209   MALA_MUTATOR_BEGIN
 210     {
 211       // insert new --nnn... in program
 212       name.ptr = mala_engine_tmpname (prg->engine, templ);
 213       TRACE (mala_module_std, "Block %s", mala_string_cstr (name.ptr) );
 214       mala_action_new (name.ptr, parser, data, data?ACOGC_GC:ACOGC_UNSET, prg->engine);
 215       ACOGC_STACK_PTR (MalaStringList, node);
 216       node.ptr = mala_stringlist_node_new (name.ptr, prg->engine);
 217       mala_stringlist_insert_after (end, node.ptr);
 218       mala_stringlist_remove (mala_stringlist_next (prg->pptr));
 219     }
 220   else
 221     {
 222       mala_stringlist_next (prg->pptr)->string = prg->engine->common_string[MALA_STRING_PASS];
 223     }
 224   MALA_MUTATOR_END;
 225
 226   ACOGC_STACK_LEAVE;
 227   return ret;
 228 }
 229
 230 mala_state
 231 mala_substitute_parser (MalaProgram prg)
 232 {
 233   TRACE (mala_module_std);
 234   MALA_MUTATOR_BEGIN
 235     {
 236       REQUIRE (acogc_object_type (mala_program_pptr_action (prg)->data)
 237                == &prg->engine->gcfactory_strings);
 238
 239       mala_stringlist_next (prg->pptr)->string = mala_action_string (mala_program_pptr_action (prg));
 240     }
 241   MALA_MUTATOR_END;
 242
 243   return MALA_MACRO;
 244 }
 245
 246 mala_state
 247 mala_expand_parser (MalaProgram prg)
 248 {
 249   TRACE (mala_module_std);
 250   MALA_MUTATOR_BEGIN
 251     {
 252       MalaAction act = mala_program_pptr_action (prg);
 253       REQUIRE (acogc_object_type (mala_action_dataptr (act))
 254                == &prg->engine->gcfactory_stringlists);
 255
 256       MalaStringList pos = mala_stringlist_next (prg->pptr);
 257       MalaStringList itr;
 258
 259       for (itr = mala_stringlist_tail_get (mala_action_stringlist (act));
 260            !mala_stringlist_is_end (mala_action_stringlist (act), itr);
 261            mala_stringlist_rev (&itr))
 262         {
 263           MalaStringList node = mala_stringlist_node_new (mala_stringlist_string (itr), prg->engine);
 264           mala_stringlist_insert_after (pos, node);
 265         }
 266     }
 267   MALA_MUTATOR_END;
 268
 269   mala_program_action_done (prg, 0);
 270   return MALA_MACRO;
 271 }
 272
 273
 274 mala_state
 275 mala_macro_parser (MalaProgram prg)
 276 {
 277   TRACE (mala_module_std);
 278
 279   /* How much to eveluate the argument (for now, likely extended in future):
 280      MALA_EXCEPTION is used as pseudo tag for unused arguments/initialization
 281      MALA_START doesn't evaluate the argument
 282      MALA_LITERAL will evaluate fully
 283      .. other destination states are reserved for future
 284   */
 285   int max_arg = -1;
 286   mala_state argt[10] = {[0 ... 9] = MALA_EXCEPTION};
 287   MalaAction act = mala_program_pptr_action (prg);
 288
 289   // scan for arguments
 290   AcogcFactory type = mala_action_data_type (act);
 291   if (type == &prg->engine->gcfactory_strings)
 292     {
 293       mala_string_macrocheck (mala_action_string (act), &max_arg, argt);
 294     }
 295   else if (type == &prg->engine->gcfactory_stringlists)
 296     {
 297       mala_stringlist_macrocheck (mala_action_stringlist (act), &max_arg, argt);
 298     }
 299   else
 300     NOTREACHED;
 301
 302   if (max_arg == INT_MAX)
 303     return mala_program_commonexception (prg, MALA_STRING_ERROR_MACRO_SYNTAX);
 304
 305   if (max_arg == -1)
 306     return mala_expand_parser (prg);
 307
 308   // evaluate args
 309   for (int i=1; i <= max_arg; ++i)
 310     {
 311       if (argt[i] <= MALA_START)
 312         {
 313           if (mala_program_eval_arg (prg, i, argt[i], NULL) > MALA_EFAULT)
 314             return mala_program_commonexception (prg, MALA_STRING_ERROR);
 315           TODO("use dst in arg_eval");
 316         }
 317     }
 318
 319   MALA_MUTATOR_BEGIN
 320     {
 321       // construct result list
 322       MalaString args[10];
 323       MalaStringList p = mala_stringlist_next (prg->pptr);
 324
 325       args[0] = mala_stringlist_string (p);
 326       for (int i=1; i <= max_arg; ++i)
 327         {
 328           mala_stringlist_fwd (&p);
 329           args[i] = mala_stringlist_string (p);
 330         }
 331
 332       ACOGC_STACK_ENTER (&prg->engine->gcroot);
 333       // constructing list
 334       if (type == &prg->engine->gcfactory_strings)
 335         {
 336           ACOGC_STACK_PTR (MalaString, string);
 337           string.ptr = mala_string_new_macrosubst (mala_action_string (act),
 338                                                    args, prg->engine);
 339
 340           MalaStringList n = mala_stringlist_node_new (string.ptr, prg->engine);
 341           mala_stringlist_insert_after (p, n);
 342         }
 343       else if (type == &prg->engine->gcfactory_stringlists)
 344         {
 345           ACOGC_STACK_PTR (MalaStringList, list);
 346           list.ptr = mala_stringlist_new_macrosubst (mala_action_stringlist (act),
 347                                                      args, prg->engine);
 348           mala_stringlist_insert_after_stringlist (p, list.ptr);
 349         }
 350       else
 351         NOTREACHED;
 352
 353       ACOGC_STACK_LEAVE;
 354     }
 355   MALA_MUTATOR_END;
 356
 357   mala_program_action_done (prg, max_arg);
 358   return MALA_MACRO;
 359 }
 360
 361 mala_state
 362 mala_end_parser (MalaProgram prg)
 363 {
 364   TRACE (mala_module_std);
 365   return mala_program_commonexception (prg, MALA_STRING_ERROR_END_WITHOUT_BEGIN);
 366 }
 367
 368 mala_state
 369 mala_def_parser (MalaProgram prg)
 370 {
 371   MalaStringList dst;
 372   MalaString name;
 373   MalaString expand;
 374
 375   TRACE (mala_module_std);
 376   // evaluate both args
 377   if (mala_program_eval_arg (prg, 1, MALA_LITERAL, &dst) > MALA_EFAULT)
 378     return mala_program_commonexception (prg, MALA_STRING_ERROR);
 379
 380   name = mala_stringlist_string (dst);
 381
 382   if (mala_program_eval_arg (prg, 2, MALA_BLOCK, &dst) > MALA_EFAULT)
 383     return mala_program_commonexception (prg, MALA_STRING_ERROR);
 384
 385   expand = mala_stringlist_string (dst);
 386
 387   TRACE (mala_module_std, "def %s as %s", mala_string_cstr (name), mala_string_cstr (expand));
 388
 389   MALA_MUTATOR_BEGIN
 390     {
 391       TODO("optimize direct expansions");
 392       int max_arg = -1;
 393       mala_state argt[10] = {[0 ... 9] = MALA_EXCEPTION};
 394       mala_string_macrocheck (expand, &max_arg, argt);
 395
 396       if (max_arg == INT_MAX)
 397         return mala_program_commonexception (prg, MALA_STRING_ERROR_MACRO_SYNTAX);
 398       else if (max_arg == -1)
 399         // register as simple substitute
 400         mala_action_new (name, mala_substitute_parser, expand, ACOGC_GC, prg->engine);
 401       else
 402         // register as macro
 403         mala_action_new (name, mala_macro_parser, expand, ACOGC_GC, prg->engine);
 404     }
 405   MALA_MUTATOR_END;
 406
 407   mala_program_action_done (prg, 2);
 408   return MALA_STATEMENT;
 409 }
 410
 411
 412 mala_state
 413 mala_delete_parser (MalaProgram prg)
 414 {
 415   TRACE (mala_module_std);
 416   MalaStringList dst;
 417
 418   if (mala_program_eval_arg (prg, 1, MALA_LITERAL, &dst) > MALA_EFAULT)
 419     return mala_program_commonexception (prg, MALA_STRING_ERROR);
 420
 421   MALA_MUTATOR_BEGIN
 422     {
 423       MalaAction act = mala_string_action (mala_stringlist_string (dst));
 424       if (act)
 425         mala_action_delete (mala_string_action (mala_stringlist_string (dst)));
 426       else
 427         return mala_program_commonexception (prg, MALA_STRING_ERROR_ACTION_NOT_DEFINED);
 428     }
 429   MALA_MUTATOR_END;
 430
 431   mala_program_action_done (prg, 1);
 432   return MALA_STATEMENT;
 433 }
 434
 435
 436 static void
 437 mala_stringlist_macrocheck (MalaStringList list, int * max_arg, mala_state argt[10])
 438 {
 439   LLIST_FOREACH (&list->node, itr)
 440     {
 441       MalaStringList l = LLIST_TO_STRUCTP(itr, mala_stringlist, node);
 442       mala_string_macrocheck (mala_stringlist_string (l), max_arg, argt);
 443       if (*max_arg == INT_MAX)
 444         return;
 445     }
 446 }
 447
 448 static void
 449 mala_string_macrocheck (MalaString string, int * max_arg, mala_state argt[10])
 450 {
 451   const char * c;
 452   for (c = mala_string_cstr (string); *c; ++c)
 453     {
 454       if (*c == '%')
 455         {
 456           ++c;
 457           if (*c == '%')
 458             {
 459               if (*max_arg == -1)
 460                 *max_arg = 0;
 461               continue;
 462             }
 463           if (*c == '^')
 464             {
 465               ++c;
 466               if (*c >= '0' && *c <= '9')
 467                 {
 468                   if (argt[*c - '0'] < MALA_EXCEPTION && argt[*c - '0'] != MALA_START)
 469                     goto esyntax;
 470                   if (*c > (char) *max_arg + '0')
 471                     *max_arg = *c - '0';
 472                   argt[*c - '0'] = MALA_START;
 473                 }
 474               else
 475                 goto esyntax;
 476             }
 477           else if (*c >= '0' && *c <= '9')
 478             {
 479               if (argt[*c - '0'] != MALA_EXCEPTION && argt[*c - '0'] != MALA_LITERAL)
 480                 goto esyntax;
 481               if (*c > (char) *max_arg + '0')
 482                 *max_arg = *c - '0';
 483               argt[*c - '0'] = MALA_LITERAL;
 484             }
 485           else
 486             goto esyntax;
 487         }
 488     }
 489   return;
 490
 491  esyntax:
 492   *max_arg = INT_MAX;
 493   return;
 494 }
 495
 496
 497 static MalaString
 498 mala_string_new_macrosubst (MalaString src, MalaString args[10], MalaEngine eng)
 499 {
 500   // 1st pass get size
 501   size_t size = mala_string_length (src);
 502   for (const char *c = mala_string_cstr (src); *c; ++c)
 503     {
 504       if (*c == '%')
 505         {
 506           ++c;
 507           --size;
 508           if (*c == '%')
 509             continue;
 510           if (*c == '^')
 511             {
 512               ++c;
 513               --size;
 514             }
 515           --size;
 516           TODO ("Handle %%^0");
 517           size += mala_string_length (args[*c - '0']);
 518         }
 519     }
 520
 521   // 2nd pass create string
 522   char* cstr = NULL;
 523   acogc_alloc (&cstr, size+1, &eng->gcroot);
 524
 525   char* p = cstr;
 526
 527   for (const char *c = mala_string_cstr (src); *c; ++c)
 528     {
 529       if (*c == '%')
 530         {
 531           ++c;
 532           if (*c == '%')
 533             {
 534               *p++ = *c;
 535               continue;
 536             }
 537           if (*c == '^')
 538             ++c;
 539
 540           TODO ("Handle %%^0");
 541
 542           strcpy (p, mala_string_cstr (args[*c - '0']));
 543           p += mala_string_length (args[*c - '0']);
 544         }
 545       else
 546         *p++ = *c;
 547     }
 548   *p = '\0';
 549
 550   return mala_string_new_attach_cstr (cstr, eng->words);
 551 }
 552
 553 static MalaStringList
 554 mala_stringlist_new_macrosubst (MalaStringList src, MalaString args[10], MalaEngine eng)
 555 {
 556   ACOGC_STACK_ENTER (&eng->gcroot);
 557   ACOGC_STACK_PTR (MalaStringList, ret);
 558   ACOGC_STACK_PTR (MalaString, str);
 559
 560   ret.ptr = mala_stringlist_new (eng);
 561
 562   LLIST_FOREACH (&src->node, node)
 563     {
 564       str.ptr = mala_string_new_macrosubst (mala_stringlist_string_from_llist(node), args, eng);
 565       MalaStringList n = mala_stringlist_node_new (str.ptr, eng);
 566       mala_stringlist_insert_tail (ret.ptr, n);
 567     }
 568
 569   ACOGC_STACK_LEAVE;
 570   return ret.ptr;
 571 }
 572
 573
 574
 575
 576
 577
 578 /*
 579   realloc a string to at least needed size
 580   return the amount really reserved or 0 on error
 581 */
 582 #if 0 // TODO acogc reserve!
 583 static size_t
 584 reserve_string (char ** s, size_t actual, size_t needed)
 585 {
 586   size_t n;
 587   char * r;
 588
 589   for (n = actual>64?actual:64; n <= needed; n += (n>>1)); /*n = n * 1.5*/
 590
 591   r = realloc (*s, n);
 592   if (!r)
 593     {
 594       /* that was to much, try conservatively */
 595       r = realloc (*s, n = needed);
 596       if (!r)
 597         return 0;
 598     }
 599   *s = r;
 600   return n;
 601 }
 602 #endif
 603
 604 int
 605 mala_module_std_macros_init (MalaEngine self)
 606 {
 607   return mala_engine_actions_register (self, std_macros);
 608 }
 609
 610 /*
 611 // Local Variables:
 612 // mode: C
 613 // c-file-style: "gnu"
 614 // End:
 615 // arch-tag: 4722e09b-a020-4206-9ecc-9442505826c5
 616 // end_of_file
 617 */