forとforeachは何が同じなのか(未解決→解決)

手癖のようなもので、forではなくforeachを使うほうが多い。 同じものと説明されているけど、どのように同じなのか探してみることにした。

追記

forとforeachは何が同じなのか(未解決) - yujioramaの日記

<a href="https://github.com/Perl/perl5/blob/v5.37.7/toke.c#L8010-L8012" target="_blank" rel="noopener nofollow">https://github.com/Perl/perl5/blob/v5.37.7/toke.c#L8010-L8012</a> ？

2023/01/01 13:02

探してたのはそこでした。ありがとうございます。

字句解析をしてるのはtoke.c。 toke.c#L8010-L8012でforとforeachを同じ語として扱っている。

// toke.c L8010-L8012
    case KEY_for: 
    case KEY_foreach: 
         return yyl_foreach(aTHX_ s);

yyl_foreachは70行くらいの小さな関数。 後に続く文字列を見て、ポインタを進めるだけだった。

字句解析予約語

予約語を定義してるふうのkeywords.hには定数が並んでいる。まだ別の識別子ということか。

#define KEY_for          70
#define KEY_foreach     71

字句解析をしてるふうのkeywords.cを見ても、forとforeachを別々に認識している。 regen/keywords.plが自動生成しているソースコードだけど、語の文字数でswitchして、1文字ずつチェックしているのが面白い。 この時点で、もしかしたら文字数の少ないforのほうがプログラムに優しいのかもしれないと思い始めた。

// keywords.c L304-L310
        case 'f':
          if (name[1] == 'o' &&
              name[2] == 'r')
          {                                       /* for              */
            return KEY_for;
          }

// keywords.c L2082-L2105
        case 'f':
          switch (name[1])
          {
            case 'i':
              if (name[2] == 'n' &&
                  name[3] == 'a' &&
                  name[4] == 'l' &&
                  name[5] == 'l' &&
                  name[6] == 'y')
              {                                   /* finally          */
                return (all_keywords || FEATURE_TRY_IS_ENABLED ? KEY_finally : 0);
              }

              goto unknown;

            case 'o':
              if (name[2] == 'r' &&
                  name[3] == 'e' &&
                  name[4] == 'a' &&
                  name[5] == 'c' &&
                  name[6] == 'h')
              {                                   /* foreach          */
                return KEY_foreach;
              }

構文解析

Perlの構文はperly.yで定義している。bisonを知らなくてもうっすらとPerlのソースコードが見えてくる。 この辺がforに対応しているようだった。 foreachが見つからない。通り過ぎてしまったのかもしれない。

// perly.y L443-L511
    |   KW_FOR PERLY_PAREN_OPEN remember mnexpr[init_mnexpr] PERLY_SEMICOLON
            { parser->expect = XTERM; }
        texpr PERLY_SEMICOLON
            { parser->expect = XTERM; }
        mintro mnexpr[iterate_mnexpr] PERLY_PAREN_CLOSE
        mblock
            {
              OP *initop = $init_mnexpr;
              OP *forop = newWHILEOP(0, 1, NULL,
                      scalar($texpr), $mblock, $iterate_mnexpr, $mintro);
              if (initop) {
                  forop = op_prepend_elem(OP_LINESEQ, initop,
                  op_append_elem(OP_LINESEQ,
                      newOP(OP_UNSTACK, OPf_SPECIAL),
                      forop));
              }
              PL_hints |= HINT_BLOCK_SCOPE;
              $$ = block_end($remember, forop);
              parser->copline = (line_t)$KW_FOR;
            }
    |   KW_FOR KW_MY remember my_scalar PERLY_PAREN_OPEN mexpr PERLY_PAREN_CLOSE mblock cont
            {
              $$ = block_end($remember, newFOROP(0, $my_scalar, $mexpr, $mblock, $cont));
              parser->copline = (line_t)$KW_FOR;
            }
    |   KW_FOR KW_MY remember PERLY_PAREN_OPEN my_list_of_scalars PERLY_PAREN_CLOSE PERLY_PAREN_OPEN mexpr PERLY_PAREN_CLOSE mblock cont
            {
                          if ($my_list_of_scalars->op_type == OP_PADSV)
                            /* degenerate case of 1 var: for my ($x) ....
                               Flag it so it can be special-cased in newFOROP */
                                $my_list_of_scalars->op_flags |= OPf_PARENS;
              $$ = block_end($remember, newFOROP(0, $my_list_of_scalars, $mexpr, $mblock, $cont));
              parser->copline = (line_t)$KW_FOR;
            }
    |   KW_FOR scalar PERLY_PAREN_OPEN remember mexpr PERLY_PAREN_CLOSE mblock cont
            {
              $$ = block_end($remember, newFOROP(0,
                      op_lvalue($scalar, OP_ENTERLOOP), $mexpr, $mblock, $cont));
              parser->copline = (line_t)$KW_FOR;
            }
    |   KW_FOR my_refgen remember my_var
            { parser->in_my = 0; $<opval>$ = my($my_var); }[variable]
        PERLY_PAREN_OPEN mexpr PERLY_PAREN_CLOSE mblock cont
            {
              $$ = block_end(
                $remember,
                newFOROP(0,
                     op_lvalue(
                        newUNOP(OP_REFGEN, 0,
                            $<opval>variable),
                        OP_ENTERLOOP),
                     $mexpr, $mblock, $cont)
              );
              parser->copline = (line_t)$KW_FOR;
            }
    |   KW_FOR REFGEN refgen_topic PERLY_PAREN_OPEN remember mexpr PERLY_PAREN_CLOSE mblock cont
            {
              $$ = block_end($remember, newFOROP(
                0, op_lvalue(newUNOP(OP_REFGEN, 0,
                             $refgen_topic),
                         OP_ENTERLOOP), $mexpr, $mblock, $cont));
              parser->copline = (line_t)$KW_FOR;
            }
    |   KW_FOR PERLY_PAREN_OPEN remember mexpr PERLY_PAREN_CLOSE mblock cont
            {
              $$ = block_end($remember,
                  newFOROP(0, NULL, $mexpr, $mblock, $cont));
              parser->copline = (line_t)$KW_FOR;
            }