1: /*
    2:  * macro.c - macro implementation
    3:  *
    4:  *   Copyright (c) 2000-2007  Shiro Kawai  <shiro@acm.org>
    5:  * 
    6:  *   Redistribution and use in source and binary forms, with or without
    7:  *   modification, are permitted provided that the following conditions
    8:  *   are met:
    9:  * 
   10:  *   1. Redistributions of source code must retain the above copyright
   11:  *      notice, this list of conditions and the following disclaimer.
   12:  *
   13:  *   2. Redistributions in binary form must reproduce the above copyright
   14:  *      notice, this list of conditions and the following disclaimer in the
   15:  *      documentation and/or other materials provided with the distribution.
   16:  *
   17:  *   3. Neither the name of the authors nor the names of its contributors
   18:  *      may be used to endorse or promote products derived from this
   19:  *      software without specific prior written permission.
   20:  *
   21:  *   THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
   22:  *   "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
   23:  *   LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR
   24:  *   A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT
   25:  *   OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
   26:  *   SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED
   27:  *   TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR
   28:  *   PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF
   29:  *   LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
   30:  *   NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
   31:  *   SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
   32:  *
   33:  *  $Id: macro.c,v 1.68 2007/08/24 23:55:43 shirok Exp $
   34:  */
   35: 
   36: #define LIBGAUCHE_BODY
   37: #include "gauche.h"
   38: #include "gauche/macro.h"
   39: #include "gauche/code.h"
   40: #include "gauche/vminsn.h"
   41: #include "gauche/builtin-syms.h"
   42: 
   43: /* avoid C++ reserved name conflict.
   44:    (I hate languages that take away names from programmers!) */
   45: #define template templat
   46: 
   47: /* define if you want to debug syntax-rule expander */
   48: /*#define DEBUG_SYNRULE*/
   49: 
   50: /*===================================================================
   51:  * Syntax object
   52:  */
   53: 
   54: static void syntax_print(ScmObj obj, ScmPort *port, ScmWriteContext *mode)
   55: {
   56:     Scm_Printf(port, "#<syntax %A>", SCM_SYNTAX(obj)->name);
   57: }
   58: 
   59: SCM_DEFINE_BUILTIN_CLASS_SIMPLE(Scm_SyntaxClass, syntax_print);
   60: 
   61: ScmObj Scm_MakeSyntax(ScmSymbol *name, ScmObj handler)
   62: {
   63:     ScmSyntax *s = SCM_NEW(ScmSyntax);
   64:     SCM_SET_CLASS(s, SCM_CLASS_SYNTAX);
   65:     s->name = name;
   66:     s->handler = handler;
   67:     return SCM_OBJ(s);
   68: }
   69: 
   70: /*===================================================================
   71:  * Macro object
   72:  */
   73: 
   74: static void macro_print(ScmObj obj, ScmPort *port, ScmWriteContext *mode)
   75: {
   76:     Scm_Printf(port, "#<macro %A>", SCM_MACRO(obj)->name);
   77: }
   78: 
   79: SCM_DEFINE_BUILTIN_CLASS_SIMPLE(Scm_MacroClass, macro_print);
   80: 
   81: ScmObj Scm_MakeMacro(ScmSymbol *name, ScmTransformerProc transformer,
   82:                      void *data)
   83: {
   84:     ScmMacro *s = SCM_NEW(ScmMacro);
   85:     SCM_SET_CLASS(s, SCM_CLASS_MACRO);
   86:     s->name = name;
   87:     s->transformer = transformer;
   88:     s->data = data;
   89:     return SCM_OBJ(s);
   90: }
   91: 
   92: /*===================================================================
   93:  * SyntaxPattern object
   94:  *   Internal object to construct pattern matcher
   95:  */
   96: 
   97: static void pattern_print(ScmObj obj, ScmPort *port, ScmWriteContext *ctx)
   98: {
   99:     Scm_Printf(port, "#<pattern:%d%S %S%s>",
  100:                SCM_SYNTAX_PATTERN(obj)->level,
  101:                SCM_SYNTAX_PATTERN(obj)->vars,
  102:                SCM_SYNTAX_PATTERN(obj)->pattern,
  103:                SCM_SYNTAX_PATTERN(obj)->repeat? " ..." : "");
  104: }
  105: 
  106: SCM_DEFINE_BUILTIN_CLASS_SIMPLE(Scm_SyntaxPatternClass, pattern_print);
  107: 
  108: ScmSyntaxPattern *make_syntax_pattern(int level, int repeat)
  109: {
  110:     ScmSyntaxPattern *p = SCM_NEW(ScmSyntaxPattern);
  111:     SCM_SET_CLASS(p, SCM_CLASS_SYNTAX_PATTERN);
  112:     p->pattern = SCM_NIL;
  113:     p->vars = SCM_NIL;
  114:     p->level = level;
  115:     p->repeat = repeat;
  116:     return p;
  117: }
  118: 
  119: /*===================================================================
  120:  * SyntaxRules object
  121:  *   Internal object to construct pattern matcher
  122:  */
  123: 
  124: static void synrule_print(ScmObj obj, ScmPort *port, ScmWriteContext *mode)
  125: {
  126:     int i;
  127:     ScmSyntaxRules *r = SCM_SYNTAX_RULES(obj);
  128: 
  129:     Scm_Printf(port, "#<syntax-rules(%d)\n", r->numRules);
  130:     for (i = 0; i < r->numRules; i++) {
  131:         Scm_Printf(port, "%2d: (numPvars=%d, maxLevel=%d)\n",
  132:                    i, r->rules[i].numPvars, r->rules[i].maxLevel);
  133:         Scm_Printf(port, "   pattern  = %S\n", r->rules[i].pattern);
  134:         Scm_Printf(port, "   template = %S\n", r->rules[i].template);
  135:     }
  136:     Scm_Printf(port, ">");
  137: }
  138: 
  139: SCM_DEFINE_BUILTIN_CLASS_SIMPLE(Scm_SyntaxRulesClass, synrule_print);
  140: 
  141: ScmSyntaxRules *make_syntax_rules(int nr) 
  142: {
  143:     ScmSyntaxRules *r = SCM_NEW2(ScmSyntaxRules *,
  144:                                  sizeof(ScmSyntaxRules)+(nr-1)*sizeof(ScmSyntaxRuleBranch));
  145:     SCM_SET_CLASS(r, SCM_CLASS_SYNTAX_RULES);
  146:     r->numRules = nr;
  147:     return r;
  148: }
  149: 
  150: /*===================================================================
  151:  * Macro for the new compiler
  152:  */
  153: 
  154: /* In the new compiler, macro transformers for hygienic and traditional
  155:  * macros are integrated.
  156:  * The lowest-level macro transformer can be introduced by define-syntax,
  157:  * let-syntax and letrec-syntax (but not syntax-case or syntax-rules; they
  158:  * are built on top of it).
  159:  *
  160:  *   (define-syntax foo <transformer>)
  161:  *
  162:  * Where <transformer> is a procedure that takes one argument, a syntactic
  163:  * closure.  It must return a syntactic closure as the result of trans
  164:  * formation.
  165:  *
  166:  * From the point of the compiler, define-syntax triggers the following
  167:  * actions.
  168:  *
  169:  *  - evaluate <transformer> in the compiler environment.
  170:  *  - encapsulate it into <macro> object, and insert it to the compiler
  171:  *    environment.
  172:  *  - insert the binding to foo in the runtime toplevel environment.
  173:  *
  174:  * Define-macro is also built on top of define-syntax.  Concepturally,
  175:  * it is transformed as follows.
  176:  *
  177:  *  (define-macro foo procedure)
  178:  *   => (define-syntax foo
  179:  *        (lambda (x)
  180:  *          (let ((env  (slot-ref x 'env))
  181:  *                (form (slot-ref x 'expr)))
  182:  *            (make-syntactic-closure
  183:  *              env () (apply procedure form)))))
  184:  */
  185: 
  186: static ScmObj macro_transform(ScmObj self, ScmObj form, ScmObj env,
  187:                               void *data)
  188: {
  189:     ScmObj proc = SCM_OBJ(data);
  190:     SCM_ASSERT(SCM_SYNTACTIC_CLOSURE_P(form));
  191:     return Scm_ApplyRec(proc, SCM_LIST1(form));
  192: }
  193: 
  194: ScmObj Scm_MakeMacroTransformer(ScmSymbol *name, ScmObj proc)
  195: {
  196:     return Scm_MakeMacro(name, macro_transform, (void*)proc);
  197: }
  198: 
  199: /*===================================================================
  200:  * Traditional Macro
  201:  */
  202: 
  203: /* TODO: how to retain debug info? */
  204: /* TODO: better error message on syntax error (macro invocation with
  205:    bad number of arguments) */
  206: 
  207: static ScmObj macro_transform_old(ScmObj self, ScmObj form,
  208:                                   ScmObj env, void *data)
  209: {
  210:     ScmObj proc = SCM_OBJ(data);
  211:     SCM_ASSERT(SCM_PAIRP(form));
  212:     return Scm_VMApply(proc, SCM_CDR(form));
  213: }
  214: 
  215: ScmObj Scm_MakeMacroTransformerOld(ScmSymbol *name, ScmProcedure *proc)
  216: {
  217:     return Scm_MakeMacro(name, macro_transform_old, (void*)proc);
  218: }
  219: 
  220: static ScmMacro *resolve_macro_autoload(ScmAutoload *adata)
  221: {
  222:     ScmObj mac = Scm_ResolveAutoload(adata, 0);
  223:     if (SCM_UNBOUNDP(mac)) {
  224:         Scm_Error("tried to autoload macro %S, but it caused circular autoload.", adata->name);
  225:     }
  226:     if (!SCM_MACROP(mac)) {
  227:         Scm_Error("tried to autoload macro %S, but it yields non-macro object: %S", adata->name, mac);
  228:     }
  229:     return SCM_MACRO(mac);
  230: }
  231: 
  232: static ScmObj macro_autoload(ScmObj self, ScmObj form, ScmObj env, void *data)
  233: {
  234:     ScmMacro *mac = resolve_macro_autoload(SCM_AUTOLOAD(data));
  235:     return mac->transformer(SCM_OBJ(mac), form, env, mac->data);
  236: }
  237: 
  238: ScmObj Scm_MakeMacroAutoload(ScmSymbol *name, ScmAutoload *adata)
  239: {
  240:     return Scm_MakeMacro(name, macro_autoload, (void*)adata);
  241: }
  242: 
  243: /*===================================================================
  244:  * R5RS Macro
  245:  */
  246: 
  247: /* Keeping hygienic reference
  248:  *
  249:  *  - symbols which a template inserts into the expanded form are
  250:  *    converted to identifiers at the macro definition time, encapsulating
  251:  *    the defining environment of the macro.   So it doesn't interfere
  252:  *    with the macro call environment.
  253:  *
  254:  *  - literal symbols provided to the syntax-rules are also converted
  255:  *    to identifiers encapsulating the defining environment, and the
  256:  *    environment information is used when comparing with the symbols
  257:  *    in the macro call.
  258:  *
  259:  *  - symbols in the macro call is treated as they are.  Since the result
  260:  *    of macro expansion is immediately compiled in the macro call 
  261:  *    environment, those symbols can refer proper bindings.
  262:  */
  263: 
  264: /*-------------------------------------------------------------------
  265:  * pattern language compiler
  266:  *   - convert literals into identifiers
  267:  *   - recognize repeatable subpatterns and replace it to SyntaxPattern node.
  268:  *   - convert free symbols in the template into identifiers
  269:  *   - convert pattern variables into LREF object.
  270:  */
  271: /* TODO: avoid unnecessary consing as much as possible */
  272: 
  273: /* context of pattern traversal */
  274: typedef struct {                
  275:     ScmObj name;                /* name of this macro (for error msg)*/
  276:     ScmObj form;                /* form being compiled (for error msg) */
  277:     ScmObj literals;            /* list of literal identifiers */
  278:     ScmObj pvars;               /* list of (pvar . pvref) */
  279:     int pvcnt;                  /* counter of pattern variables */
  280:     int maxlev;                 /* maximum level */
  281:     ScmObj tvars;               /* list of identifies inserted in template */
  282:     ScmModule *mod;             /* module where this macro is defined */
  283:     ScmObj env;                 /* compiler env of this macro definition */
  284: } PatternContext;
  285: 
  286: #define PVREF_P(pvref)         SCM_PVREF_P(pvref)
  287: #define PVREF_LEVEL(pvref)     (int)SCM_PVREF_LEVEL(pvref)
  288: #define PVREF_COUNT(pvref)     (int)SCM_PVREF_COUNT(pvref)
  289: 
  290: /* add pattern variable pvar.  called when compiling a pattern */
  291: static inline ScmObj add_pvar(PatternContext *ctx,
  292:                               ScmSyntaxPattern *pat,
  293:                               ScmObj pvar)
  294: {
  295:     ScmObj pvref = SCM_MAKE_PVREF(pat->level, ctx->pvcnt);
  296:     if (!SCM_FALSEP(Scm_Assq(pvar, ctx->pvars))) {
  297:         Scm_Error("pattern variable %S appears more than once in the macro definition of %S: %S", 
  298:                   pvar, ctx->name, ctx->form);
  299:     }
  300:     ctx->pvcnt++;
  301:     ctx->pvars = Scm_Acons(pvar, pvref, ctx->pvars);
  302:     pat->vars = Scm_Cons(pvref, pat->vars);
  303:     return pvref;
  304: }
  305: 
  306: /* returns pvref corresponds to the given pvar in template compilation.
  307:    if pvar is not a valid pvar, returns pvar itself. */
  308: static inline ScmObj pvar_to_pvref(PatternContext *ctx,
  309:                                    ScmSyntaxPattern *pat,
  310:                                    ScmObj pvar)
  311: {
  312:     ScmObj q = Scm_Assq(pvar, ctx->pvars), pvref;
  313:     if (!SCM_PAIRP(q)) return pvar;
  314:     pvref = SCM_CDR(q);
  315:     if (PVREF_LEVEL(pvref) > pat->level) {
  316:         Scm_Error("%S: Pattern variable %S is used in wrong level: %S",
  317:                   ctx->name, pvar, ctx->form);
  318:     }
  319:     return pvref;
  320: }
  321: 
  322: static inline ScmObj pvref_to_pvar(PatternContext *ctx, ScmObj pvref)
  323: {
  324:     int count = PVREF_COUNT(pvref);
  325:     ScmObj q = Scm_ListRef(ctx->pvars, count, SCM_UNBOUND);
  326:     SCM_ASSERT(SCM_PAIRP(q));
  327:     return SCM_CAR(q);
  328: }
  329: 
  330: /* search an identifier with name NAME from a list of identifiers */
  331: static ScmObj id_memq(ScmObj name, ScmObj list)
  332: {
  333:     ScmObj lp;
  334:     ScmObj n;
  335:     if (SCM_IDENTIFIERP(name)) {
  336:         n = SCM_OBJ(SCM_IDENTIFIER(name)->name);
  337:     } else {
  338:         n = name;
  339:     } 
  340:     SCM_FOR_EACH(lp, list) {
  341:         if (SCM_OBJ(SCM_IDENTIFIER(SCM_CAR(lp))->name) == name)
  342:             return SCM_CAR(lp);
  343:     }
  344:     return SCM_FALSE;
  345: }
  346: 
  347: #define ELLIPSIS_FOLLOWING(Pat) \
  348:     (SCM_PAIRP(SCM_CDR(Pat)) && SCM_CADR(Pat)==SCM_SYM_ELLIPSIS)
  349: 
  350: #define BAD_ELLIPSIS(Ctx)                                               \
  351:     Scm_Error("Bad ellipsis usage in macro definition of %S: %S",       \
  352:                Ctx->name, Ctx->form)
  353: 
  354: /* convert literal symbols into identifiers */
  355: static ScmObj preprocess_literals(ScmObj literals, ScmModule *mod, ScmObj env)
  356: {
  357:     ScmObj lp, h = SCM_NIL, t = SCM_NIL;
  358:     SCM_FOR_EACH(lp, literals) {
  359:         ScmObj lit = SCM_CAR(lp);
  360:         if (SCM_IDENTIFIERP(lit))
  361:             SCM_APPEND1(h, t, lit);
  362:         else if (SCM_SYMBOLP(lit))
  363:             SCM_APPEND1(h, t, Scm_MakeIdentifier(SCM_SYMBOL(lit), mod, env));
  364:         else
  365:             Scm_Error("literal list contains non-symbol: %S", literals);
  366:     }
  367:     if (!SCM_NULLP(lp))
  368:         Scm_Error("bad literal list in syntax-rules: %S", literals);
  369:     return h;
  370: }
  371: 
  372: /* compile a pattern or a template.
  373:    In a pattern, replace literal symbols for identifiers; leave
  374:    non-literal symbols (i.e. pattern variables) as they are, but
  375:    records it's presence in the context.   Also, when encounters
  376:    a repeatable subpattern, replace it with SyntaxPattern node.
  377:    In a template, replace symbols for identifiers except pattern variables.
  378: */
  379: 
  380: static ScmObj compile_rule1(ScmObj form,
  381:                             ScmSyntaxPattern *spat,
  382:                             PatternContext *ctx,
  383:                             int patternp)
  384: {
  385:     if (SCM_PAIRP(form)) {
  386:         ScmObj pp, h = SCM_NIL, t = SCM_NIL;
  387:         SCM_FOR_EACH(pp, form) {
  388:             if (ELLIPSIS_FOLLOWING(pp)) {
  389:                 ScmSyntaxPattern *nspat;
  390:                 if (patternp && !SCM_NULLP(SCM_CDDR(pp))) BAD_ELLIPSIS(ctx);
  391:                 nspat = make_syntax_pattern(spat->level+1, TRUE);
  392:                 if (ctx->maxlev <= spat->level) ctx->maxlev++;
  393:                 nspat->pattern = compile_rule1(SCM_CAR(pp), nspat, ctx,
  394:                                                patternp);
  395:                 SCM_APPEND1(h, t, SCM_OBJ(nspat));
  396:                 if (!patternp) {
  397:                     ScmObj vp;
  398:                     if (SCM_NULLP(nspat->vars)) {
  399:                         Scm_Error("in definition of macro %S: "
  400:                                   "a template contains repetition "
  401:                                   "of constant form: %S",
  402:                                   ctx->name, form);
  403:                     }
  404:                     SCM_FOR_EACH(vp, nspat->vars) {
  405:                         if (PVREF_LEVEL(SCM_CAR(vp)) >= nspat->level) break;
  406:                     }
  407:                     if (SCM_NULLP(vp)) {
  408:                         Scm_Error("in definition of macro %S: "
  409:                                   "template's ellipsis nesting"
  410:                                   " is deeper than pattern's: %S",
  411:                                   ctx->name, form);
  412:                     }
  413:                 }
  414:                 spat->vars = Scm_Append2(spat->vars, nspat->vars);
  415:                 pp = SCM_CDR(pp);
  416:             } else {
  417:                 SCM_APPEND1(h, t,
  418:                             compile_rule1(SCM_CAR(pp), spat, ctx, patternp));
  419:             }
  420:         }
  421:         if (!SCM_NULLP(pp))
  422:             SCM_APPEND(h, t, compile_rule1(pp, spat, ctx, patternp));
  423:         return h;
  424:     }
  425:     else if (SCM_VECTORP(form)) {
  426:         /* TODO: this is a sloppy implementation.
  427:            Eliminate intermediate list structure! */
  428:         ScmObj l = Scm_VectorToList(SCM_VECTOR(form), 0, -1);
  429:         return Scm_ListToVector(compile_rule1(l, spat, ctx, patternp), 0, -1);
  430:     }
  431: #if 0
  432:     else if (patternp && SCM_IDENTIFIERP(form)) {
  433:         /* this happens in a macro produced by another macro */
  434:         form = SCM_OBJ(SCM_IDENTIFIER(form)->name);
  435:     }
  436: #endif
  437:     if (SCM_SYMBOLP(form)||SCM_IDENTIFIERP(form)) {
  438:         ScmObj q;
  439:         if (form == SCM_SYM_ELLIPSIS) BAD_ELLIPSIS(ctx);
  440:         if (!SCM_FALSEP(q = id_memq(form, ctx->literals))) return q;
  441: 
  442:         if (patternp) {
  443:             return add_pvar(ctx, spat, form);
  444:         } else {
  445:             ScmObj id, pvref = pvar_to_pvref(ctx, spat, form);
  446:             if (pvref == form) {
  447:                 /* form is not a pattern variable.  make it an identifier. */
  448:                 if (!SCM_FALSEP(q = id_memq(form, ctx->tvars))) return q;
  449:                 if (SCM_IDENTIFIERP(form)) {
  450:                     id = form;
  451:                 } else {
  452:                     id = Scm_MakeIdentifier(SCM_SYMBOL(form),
  453:                                             ctx->mod, ctx->env);
  454:                 }
  455:                 ctx->tvars = Scm_Cons(id, ctx->tvars);
  456:                 return id;
  457:             } else {
  458:                 spat->vars = Scm_Cons(pvref, spat->vars);
  459:             }
  460:             return pvref;
  461:         }
  462:     }
  463:     return form;
  464: }
  465: 
  466: /* compile rules into ScmSyntaxRules structure */
  467: static ScmSyntaxRules *compile_rules(ScmObj name,
  468:                                      ScmObj literals,
  469:                                      ScmObj rules,
  470:                                      ScmModule *mod,
  471:                                      ScmObj env) /* compiler env */
  472: {
  473:     PatternContext ctx;
  474:     ScmSyntaxPattern *pat, *tmpl;
  475:     ScmSyntaxRules *sr;
  476:     ScmObj rp;
  477:     int numRules = Scm_Length(rules), i;
  478: 
  479:     if (numRules < 1) goto badform;
  480:     if (Scm_Length(literals) < 0) goto badform;
  481: 
  482:     ctx.name = name;
  483:     ctx.literals = preprocess_literals(literals, mod, env);
  484:     ctx.mod = mod;
  485:     ctx.env = env;
  486: 
  487:     sr = make_syntax_rules(numRules);
  488:     sr->name = name;
  489:     sr->numRules = numRules;
  490:     sr->maxNumPvars = 0;
  491:     for (i=0, rp = rules; i < numRules; i++, rp = SCM_CDR(rp)) {
  492:         ScmObj rule = SCM_CAR(rp);
  493:         if (Scm_Length(rule) != 2) goto badform;
  494: 
  495:         pat  = make_syntax_pattern(0, FALSE);
  496:         tmpl = make_syntax_pattern(0, FALSE);
  497:         ctx.pvars = SCM_NIL;
  498:         ctx.tvars = SCM_NIL;
  499:         ctx.pvcnt = 0;
  500:         ctx.maxlev = 0;
  501: 
  502:         ctx.form = SCM_CAR(rule);
  503:         if (!SCM_PAIRP(ctx.form)) goto badform;
  504:         pat->pattern = compile_rule1(SCM_CDR(ctx.form), pat, &ctx, TRUE);
  505: 
  506:         ctx.form = SCM_CADR(rule);
  507:         tmpl->pattern = compile_rule1(ctx.form, tmpl, &ctx, FALSE);
  508: 
  509:         sr->rules[i].pattern  = SCM_OBJ(pat->pattern);
  510:         sr->rules[i].template = SCM_OBJ(tmpl->pattern);
  511:         sr->rules[i].numPvars = ctx.pvcnt;
  512:         sr->rules[i].maxLevel = ctx.maxlev;
  513:         if (ctx.pvcnt > sr->maxNumPvars) sr->maxNumPvars = ctx.pvcnt;
  514:     }
  515:     return sr;
  516: 
  517:   badform:
  518:     Scm_Error("malformed macro %S: %S", name,
  519:               Scm_Cons(SCM_SYM_SYNTAX_RULES, Scm_Cons(literals, rules)));
  520:     return NULL;       /* dummy */
  521: }
  522: 
  523: /*-------------------------------------------------------------------
  524:  * pattern language matcher
  525:  */
  526: 
  527: /* Matchvec
  528:  *   A sort of shallow binding technique is used to bind pattern
  529:  *   variables with matched patterns.
  530:  *
  531:  *   Matchlist itself is an assoc list whose key is a pattern variable.
  532:  *   It's value is a tree of the same depth of the pattern variable.
  533:  *
  534:  *   Suppose you have a pattern
  535:  *      (?a (?b (?c ?d ...) ...) ...)
  536:  *   In it, pattern variable ?a is level 0, ?b is 1, ?c is 2 and ?d is 3.
  537:  *   When the pattern matches the following form:
  538:  *      (1 (2 (3 4 5) (6)) (7 (8 9) (10 11 12)))
  539:  *   trees bound to each pattern variables are like this:
  540:  *
  541:  *      ?a => 1
  542:  *      ?b => (2 7)
  543:  *      ?c => ((3 6) (8 10))
  544:  *      ?d => (((4 5) ()) ((9) (11 12)))
  545:  */
  546: 
  547: typedef struct {
  548:     ScmObj branch;              /* current level match */
  549:     ScmObj sprout;              /* current sprout */
  550:     ScmObj root;                /* root of the tree */
  551: } MatchVar;
  552: 
  553: static MatchVar *alloc_matchvec(int numPvars)
  554: {
  555:     return SCM_NEW_ARRAY(MatchVar, numPvars);
  556: }
  557: 
  558: static void init_matchvec(MatchVar *mvec, int numPvars)
  559: {
  560:     int i;
  561:     for (i=0; i<numPvars; i++) {
  562:         mvec[i].branch =