call stack

Display ‘call stack’ info without a debuger

TODOs

for perl

• State “TODO” from “” [2016-05-24 Tue 22:24]

trace sub enter and exit

• State “DONE” from “TODO” [2016-05-23 Mon 11:33]

convert source code to tokens

• State “DONE” from “TODO” [2016-05-22 Sun 18:39]
• State “TODO” from “” [2016-05-21 Sat 21:55]

总体实现思路

tokens are in an array. each token has such property:

type;
value;

For our current purpose, when only need below tokens:

type	value
subname	sub\b+(name)?
literal	{
literal	}
other	all other contents

At any points, we match from top to bottom.

实现：

1. try match a subname
   if yes, goto 1
   if no, goto next
2. try match a '{'
   if yes, goto 1
   if no, goto next
3. try match a '}'
   if yes, goto 1
   if no, goto next
4. [optional] match 可能包含以上字符的 量， 比如 字符串，正则表达式，注释。但这步刚开始时可先不做。
   这些match 成功后， 也可放入当前的 other 变量（因为我们后续的操作并不关心这些类型）。 这也是个好主意。 哈哈。
5. forward one character, then goto 1 (this idea is quite *GOOD* and *simple*. Great!)
   and put the current character to the current other variable if it is not whitespace(We will discard all white space)
   latter we can match a string or regexp before this step, to avoid a '}' in a string that will cause error.

Note: if matching result is yes in steps 1,2,3, then first exit and save current other variable and create a new one.

方法论： 以上可以写成一个框架，重复使用，对于不同语言。

分步实现

source code迭代器封装接口 接口:

name	arguments	return value	description
new	a file name	a new iterator object	create a new iterator object
get	no	a single char string	return the current char at front
		if no more, then an empty string
get	a regexp	matched string if matched	try to match regexp at front.
		empty string if not matched
put	a char string	no	put the argument to the front

class name: FileCharIterator

implementation modle:generate token list This is just the translation of steps in 总体实现思路

use Aspk::FileCharIterator;
my $fciter=Aspk::FileCharIterator('test.pl');
my @token;

while (1) {
    my $t;
    my $current_other;

    # match a subname
    $t=$fciter->get(/sub\s+\w*/);
    if ($t ne '') {
        if ($current_other ne '') {
            push @token, {type=>other, value=>$current_other};
            $current_other='';
        }
        push @token, {type=>subname, value=>$t};
        next;
    }

    # match a { or }
    $t=$fciter->get(/{|}/);
    if ($t ne '') {
        if ($current_other ne '') {
            push @token, {type=>other, value=>$current_other};
            $current_other='';
        }
        push @token, {type=>literal, value=>$t};
        next;
    }

    # all other things
    $t=$fciter->get();
    $current_other.=$t if $t=~\s;

    last if ($t eq '');
}
  

这个可以做成一个通用的东西

如实现括号匹配。现在的代码就可以实现。 只匹配关心的数据，这个思路很好。不会太复杂。

convert tokens to list of sub definitions

• State “DONE” from “TODO” [2016-05-22 Sun 22:22]
  Great!! Works very good. See Dropbox/project/call-stack/ASTer.pm
• State “TODO” from “” [2016-05-21 Sat 21:55]

首先将tokens转换为一个树状的结构，根结点为 “ROOT“， 每个ELEMENT为

1. 一个sub definition sub definition可做为新的ROOT。
2. other 这个是叶结点。

实现：

current token is:
1. other
   yes: add a child node to current root. goto 1
   no: goto next
2. subname
   yes: add a child node to current root, and set current root to this child node. goto next
   no: goto next
3. literal '{'
   yes: add a child node to current root. and increase current 'left brace' by one. goto 1
   no: goto next
4. literal '}'
   yes: add a child node to current root. and descrease current 'left brace' by one. if then 'left brace' equals to 0, then exit current root, and recover the old current root. if 'left brace' less than 0, then error. goto 1
   no: impossiable no here.

有了这个树结构后，生成所有的sub definitions的list 就非常简单了。

add trace

• State “DONE” from “TODO” [2016-05-23 Mon 11:03]

add trace node to AST tree

• State “DONE” from “TODO” [2016-05-23 Mon 11:03]
• State “TODO” from “” [2016-05-23 Mon 10:20]

input: AST output: traces added to all sub enter and exit position.

method: if node type is ‘subname’, then add a enter trace node as the second child, and an exit trace node as the last second child. Because the first child is ‘{’ and the last child is ‘}’.

Then should modify the add_child method of Tree, to given a second parameter to specify the position.

BUGs

1. ‘sub{}’ will not match as a subname, while ‘sub {}’ can.
2. string and comment and regexp and here doc will affect the result.

parse string, regexp, comment, here doc

• State “DONE” from “TODO” [2016-05-23 Mon 17:21]

parse string

• State “DONE” from “TODO” [2016-05-23 Mon 14:00]
• State “TODO” from “” [2016-05-23 Mon 13:21]

interface: string_or_empty get_string(fciter) get a string at front, and consume the fciter. If can’t get, then return empty string, and fciter not consumed.

impelment:

1. check first char if it is ’ or “, go to 2; else return “”;
2. for other char at any pos if it is the same as string starter, the string matched. return that string; if it is \, then read next char, and put both to result string, then go to 2. else put the char to result string, then go to 2.

code:

sub get_string {
    my $fciter=shift;
    my $starter=$fciter->get('\'|"');
    if ($starter eq '') {
        return '';
    }

    my $result = $starter;
    while (1){
        my $c=$fciter->get();
        last if $c eq '';

        if ($c eq $starter) {
            return $result.$c;
        } else if ($c eq '\\') {
            $result.=$c.$fciter->get();
        } else {
            $result.=$c;
        }
    }
    return $result;
}

parse comment

• State “DONE” from “TODO” [2016-05-23 Mon 16:33]
• State “TODO” from “TODO” [2016-05-23 Mon 14:01]

Interface: string_or_empty get_comment(fciter)

Implement: much like get_string.

1. check if first char is ‘#’ yes: goto 2 no: return ”;
2. if char is “\n”, then return the result else put the char to result string.

parse regexp

• State “DONE” from “TODO” [2016-05-23 Mon 17:21]
• State “TODO” from “” [2016-05-23 Mon 16:33]

Perl regexp syntax: m//xxx s///xxx qr//xxx

This should be much like get_string. Implement:

1. check if first chars are m/, s/ or qr/, yes, init wanted_end = 1 if m/ or qr/, 2 if s/. go to 2; no, return ”;
2. for any char at any pos
   1. if it is /, inc matched_end; if (wanted_end == matched_end), get the xxx part, and return result. else go to 2.
   2. if it is \, then read next char, and put both to result string, then go to 2.
   3. else put the char to result string, then go to 2.

[with bug] exit sub trace should be added before every ‘return statement’

• State “DONE” from “TODO” [2016-05-23 Mon 15:03]
• State “TODO” from “” [2016-05-23 Mon 14:40]

Or it will have no use.

implement: 查找subname的所有children, 将 exit trace加在 {literal, return} node之前。

BUGs

Not work in below two cases.

This one is invalid syntax in perl.

if (1)
    return 1;

return 1 if 1;

add filename, line number.

• State “DONE” from “TODO” [2016-05-23 Mon 20:19]
• State “TODO” from “” [2016-05-23 Mon 17:39]

add file name is quite simple, cause it is passed to main.pl. 可通过一次遍历来计算每个token的行号， 而不是在解析时。这样虽然多运行了一遍，但代码不容易乱。 则计算行号也可在main中进行。

实现： 对于每个token, calculate ‘\n’ char in value(see usage-string.org for how), and cumulated.

print arguments

• State “DONE” from “TODO” [2016-05-23 Mon 22:08]
• State “TODO” from “” [2016-05-23 Mon 17:39]

arguments is easy, just print @_. I will first add printing arguments.

implement: @_[N]: possible type: string, number, ref. format:

@_=("AAAAAAAAAAAAAAA", 234, "BBBBB", [1,3,4]);
$str = (join ", ", map {$____idx____++; my $a = "[$____idx____] $_"; if (length($a)>18) {substr($a, 18, 999999,"...");};$a;} @_);
print $str;

print return value

• State “DONE” from “TODO” [2016-05-26 Thu 13:27]
• State “TODO” from “” [2016-05-23 Mon 22:08]

return value is not that easy. we should get the remaining part of return statement, and extract it, and assign it to a variable, and print that variable and return variable. But, what type of variable should it be? It can be scalar or list, but we don’t know at runtime. So this seems impossiable?

I think maybe I can make use of *name to save the return value. =>This doen’t work.

implement: 先实现简单情况：

1. 识别 ; 作为一个token。 则 ; 和 return 之前的内容即为 返回值表达式。
2. 在exit trace中打印这个表达式。

这样的问题是：返回值表达式被多次执行，不知是否会造成问题。如果有问题，后期可以再修正。比如先做转换，然后再加。转换为返回值表达式总为一个变量。

具体步骤

1. 对于每个return结点，下一个结点为返回值或;结点。 如果下一个结点不为;结点，则将这个结点的字符串加到exit trace中。 用括号包起来。

transform return statement

• State “DONE” from “TODO” [2016-05-26 Thu 14:41]
• State “TODO” from “” [2016-05-26 Thu 13:27]

Doing below transformation

Orig:

sub aaa {
    my ($a, $b, $c)=(1,2,3);
    return $a+$b+$c;
}
print aaa();

to :

sub aaa {
    my ($a, $b, $c)=(1,2,3);
    if (wantarray()){
        my @a= ($a+$b+$c);
        return @a;
    } else {
        my $aa=($a+$b+$c);
        return $aa;
    }
}
$a = aaa();
print $a;

Therory: Because return value can only be a scalar or a list, so the two is equivalent.

steps

1. input a ‘return_exp’ AST tree node.
2. output a transformed ‘return_exp’ AST tree node. type will be ‘return_exp_transformed’;

Implements:

1. create a new node $node, with type ‘return_exp_transformed’.
2. add a child to $node, type:other, value: ‘if (wantarray()){\n my @___a___=(’
3. add second child of ‘return_exp’ to $node as child.
4. add a child to $node, type:other, value: ‘);\n’
5. create a new ‘return_exp’ $node_1, and add it to $node as a child.
6. add child: literal:return to $node_1
7. add child: new ‘exp’, which content other:’@___a___’, to $node_1
8. add child: literal:’;’ to $node_1
9. add a child to $node, type:other, value: ‘\n} else{\n my $___a___=(’
10. add second child of ‘return_exp’ to $node as child.
11. add a child to $node, type:other, value: ‘);\n’
12. create a new ‘return_exp’ $node_1, and add it to $node as a child.
13. add child: literal:return to $node_1
14. add child: new ‘exp’, which content other:’$___a___’, to $node_1
15. add child: literal:’;’ to $node_1
16. add a child to $node, type:other, value: ‘\n}’

Code:

sub transfrom_return_exp {
    my $return_exp=shift;
    my @children=@{$return_exp->prop(children)};
    # my $exp=$children[1];
    my $node=Aspk::Tree->new({data=>{type=>'return_exp_transformed'}});
    Aspk::Tree->new({data=>{type=>'other', value=>'if (wantarray()){\n my @___a___=('},
                            parent=>$node});
    $node->add_child($children[1]);
    Aspk::Tree->new({data=>{type=>'other', value=>');\n'}, parent=>$node});
    my $node_1 = Aspk::Tree->new({data=>{type=>'return_exp', value=>''}, parent=>$node});
    $node_1->add_child($children[0]);
    my $exp=Aspk::Tree->new({data=>{type=>'exp'}, parent=>$node_1});
    Aspk::Tree->new({data=>{type=>'other', value=>'@___a___'}, parent=>$node_1});
    Aspk::Tree->new({data=>{type=>'literal', value=>';'}, parent=>$node_1});

    return $node;
}

集成

• State “DONE” from “TODO” [2016-05-26 Thu 21:47]
• State “TODO” from “” [2016-05-26 Thu 17:09]

最终的程序名称： perl-call-stack

运行： perl-call-stack test.pl。 运行结果与 perl test.pl 相同，但增加了函数进入、退出的打印。并且不影响任何源文件。 当前目前下的.call-stack-files 记录需要处理的文件及模块名称，文件需要是全路径。

实现： 首先依次处理 .call-stack-files 文件中的所有文件，并将结果写入一个新的目录（如 /tmp/xxxx），并将这个新的目录加入perl lib 的搜索路径的最前面（则运行时，会使用这个处理过后版本）。

实现：

1. perl-call-stack test.pl
   1. 读取待处理源模块名到 @sources，从./call-stack-files文件。
   2. 创建一个文件夹， $root，用于保存处理后的源文件。
   3. 对于每个模块名
      1. 计算它的模块名称部分， (dir, dir, …, file)
      2. 在$root dir下创建需要的dir
      3. 根据模块名及@INC，打到模块文件
      4. 处理文件添加trace, 将且处理后的文件保存在dir下。
   4. 最后运行 perl test.pl

parse POD

• State “DONE” from “TODO” [2016-05-27 Fri 16:59]
• State “TODO” from “” [2016-05-27 Fri 16:11]

What is a POD: A line start with = is a documents. =cut end the documents.

Implement: add a new token type POD

Step:

1. see if we can get ‘\n=[\d\D]*\n=cut.*’ from file char iterator

Just one regexp and work done!

parse sub arglist

• State “DONE” from “TODO” [2016-05-27 Fri 17:20]
• State “TODO” from “” [2016-05-27 Fri 17:08]

if sub has arg list, enter trace will be added after it.

sub aaa () {
    1;
}

implement:

1. add parse literal ‘\(’ and ‘\)’ as token
2. modify parse subname in aster

Another simple way: just parse ‘()’ as part of token ‘subname’. I will use this way, because it is easy.

transform last line of a sub to a return statement

• State “TODO” from “” [2016-05-27 Fri 17:24]

return value will be changed if no return key word at last line in a sub

sub aaa {
    1;
}

If add trace, trace will be added after 1;, then return value will be changed. right way is first transforming last line to a return expression, then do adding traces.

There are two thing to do:

1. add return
2. add ; if needed.

Not that easy to implement.

Any easy way is:

1. first add the ‘;’ if missing, and remove if more at end of last line.
2. conside all nodes between last ‘;’ and last second ‘;’ as last line. but should also consider {}

ASTer 重构：将token先分解为行元素，然后一次次变形，得到最终结果

• State “TODO” from “” [2016-05-28 Sat 09:05]

行元素：任意元素+‘；‘， 或任意元素+一个{} pair. 这是第一遍处理，结果为一个TREE， 之后可再在这个基础上进行变形转换，得到最终结果。

比如要解析subname, 则可将一个 subname, pair 的组合变形为一个元素，sub，这个元素有三个子元素：literal sub, name name, arglist, pair body.

比如要解析 return expression, 则可再进行一遍处理。 如果当前行元素的第一个元素为literal return, 则将剩余的所有元素都作为expression 部分。

这每一步都比较简单，但组合起来，就可实现复杂的功能。

处理为行元素

• State “DONE” from “TODO” [2016-05-28 Sat 16:28]
• State “TODO” from “” [2016-05-28 Sat 15:39]

实现：

1. 当前token为 literal ‘;’, 则结束当前行元素，开始一个新的行元素。
2. 为literal ‘{‘， match 一个pair， 并且将这个pair加入到当前行元素，结束行元素，开始一个新的行元素。在match pair的内部，开始一个新的行元素。
3. 为其它， 加入当前行元素。

代码：

use Aspk::Tree;
sub parse_line_element{
    my $token_iter = shift;
    my $line_element=Aspk::Tree->new({data=>{type=>'line-element'}});
    while (1) {
        my $t = $token_iter->get();
        if ($t->{value} eq '}') {
            if (@{$line_element->prop(children)} == 0) {
                return undef;
            } else {
                return $line_element;
            }
        }

        if ($t->{value} eq ';') {
            return $line_element;
        } elsif ($t->{value} eq '{') {
            my $pair=Aspk::Tree->new({data=>{type=>'pair'}, parent=>$line_element});
            while (my $le=parse_line_element($token_iter)) {
                $pair->add_child($le);
            }
            $t=$token_iter->get();
            die "token should be }" if $t->{value} ne '}';
            return $line_element;
        } else {
            Aspk::Tree->new({data->$t,parent=>$line_element});
        }
    }
}

解析sub

• State “DONE” from “TODO” [2016-05-28 Sat 16:49]
• State “TODO” from “” [2016-05-28 Sat 16:29]

转换前： line-element … subname:xxxx pair …

转换后： line-element … sub subname:xxxx pair …

实现： 将 type:subname, and type:pair的两个元素合并为type:sub一个元素， 这个元素的子元素包含type:subname和type:pair这两个元素。

输入： 一个line element。 输出，一个新的line element, 但解析了sub元素。

代码：

sub parse_sub {
    my $sle = shift;
    my $dle = Aspk::Tree->new({data=>{type=>'line-element'}});
    my @children = @{$sle->prop(children)};
    for (my $i=0;$i<@children;$i++) {
        if ($children[$i]->prop(data)->{type} eq 'subname') {
            my $ssub=Aspk::Tree->new({data=>{type=>'sub'}, parent=>$dle});
            $ssub->add_child($children[$i]);
            ++$i;
            die "should be pair" if $children[$i]->prop(data)->{type} ne 'pair';
            $ssub->add_child($children[$i]);
        } else {
            $dle->add_child($children[$i]);
        }
    }
    $return $dle;
}

解析return expression

• State “DONE” from “TODO” [2016-05-28 Sat 23:06]
• State “TODO” from “” [2016-05-28 Sat 16:52]

将一个 line element， 如果其为一个return statement，则将其转换为以下格式：

转换前： line-element literal:return …. …

转换后： line-element return-exp literal: return exp … …

code:

sub parse_return_exp(){
    my $le = shift;
    my @children = @{$le->prop(children)};
    my @dchildren;
    for (my $i=0;$i<@children;$i++) {
        if ($children[$i]->prop(data)->{value} eq 'return') {
            my $ssub=Aspk::Tree->new({data=>{type=>'return_exp'}});
            push @dchildren, $ssub;
            $ssub->add_child($children[$i]);
            $ssub=Aspk::Tree->new({data=>{type=>'exp'}, parent=>$ssub});
            last;
        } else {
            push @dchildren, $children[$i];
        }
    }

    for (;$i<@children;$i++) {
        $ssub->add_child(@children[$i]);
    }
    $sle->prop(children, \@dchildren);
}

merge line elements for return statement

• State “TODO” from “” [2016-05-29 Sun 14:24]

目前一个return statement会被解析为多个line element. 比如： return $a->{name}->{type} ， 会被解析为两个line element

目标： 将一个return statement 的line element合并为一个line element

思路：

1. 标准： 以literal:return开头， 以literal:;结束的所有东西。 一

但有个问题：在寻找sub的最后一句话时，仍然会有当前这个问题。 采用这个方法，那这个问题解决不了。

找到sub的最后一句话。

• State “TODO” from “” [2016-05-29 Sun 14:57]

目前line element有问题，因此最后一句不是简单的最后一个line element in sub pair.

我觉得还是将line element的解析搞对才是根本的解决方案。

方法： 一步一步处理： 先根据‘；’将源文件分为line element 然后，再进一步提取需要的line element， 比如，sub, return expression, last expression. 但问题的关键就是如何判断last expression？ 在sub的pair里倒推，

更准确的line element parser

• State “DONE” from “TODO” [2016-05-30 Mon 10:37]
  昨天晚上已经完成。
• State “TODO” from “” [2016-05-30 Mon 10:37]

考虑 if block pair。

line element

1. 以;结尾，
2. 不以；结尾，仅限以下几种：
   1. {}
   2. sub …. {}
   3. if .. {} elsif {} else {}
   4. while …{}
   5. for … {}
   6. foreach .. {}

实现：

1. 当前token为literal:if 则parse if line element
2. 为literal:while/for/foreach/unless 等 公用点为： 都是 keywork .* () .* {} ;?
3. 为literal:;, 则结束当前line element, 并且开始一个新的。
4. 为其它，则加入当前line element。

可分步实现：

1. match pair必须为第一步
2. match line
3. match 其它

可能需要搞一个好的数据结构，因为现在需要经常替换树的几个child结点为一个结点，因此需要有一个公共的函数处理这个情况。

定义并实现语法表

• State “DONE” from “TODO” [2016-05-31 Tue 09:37]
  没有先想好怎么编，结果浪费了很多时间找问题，总算最终完成了。 下次一定要先想好怎么编，这个相当于总体的思路，指导。代码编写完成后，再找问题，很容易陷入细节中。
• State “TODO” from “” [2016-05-30 Mon 10:38]

在词法分析结果之上。

定义： 语法表应该是一个hash

{
    '_k{'=>[{value=>'$1', type=>'$2'},
            {type=>'pair',value=>'{'}],
    
    '_k({'=>[{value=>'$1'},
             {type=>'pair',value=>'('},
             {type=>'pair',value=>'{'}],
    
    'sub'=>[{syntax=>'_k{', para=>['', 'subname']}],
    
    'if'=>[{syntax=>'_k({', para=>'if'},
           {syntax=>'_k({', para=>'elsif', count=>[0]},
           {syntax=>'_k({', para=>'else', count=>[0,1]}],
    
    'for'=>[{syntax=>'_k({',para=>'for'}]
};

note:

1. key：标识一个语法规则，也做为匹配成功后的名称。以下划线开始，表示它不会被单独匹配，只是一个模块。
2. type, value: token的类型及值。二者不必同时存在，但至少存在一个。
3. count: 这个元素需要匹配的数目范围，如果不存在，则为[1,1]. if max ignored, then it is unlimmited，即[N] equals to [N, MAX_NUMBER].
4. syntax, 表示为另一个语法块。递归定义。当这个key存在时，type and value 将不会被check.
5. 接受参数的syntax块，参数用$N表示， $1表示第一个参数，$2 第二个，…
6. para: 调用另一个syntax块时，传入的参数，数组。数组元素为字符串。 如果只有一个参数，也可用scalar. 这个参数会依次先替换 $1， $2， 然后再进行匹配。

以下’_if’的两种定义方式完全等价，只不过第一种对于多种类似的结构要少写些字。

{
    '_k({'=>[{value=>'$1'},
             {type=>'pair',value=>'('},
             {type=>'pair',value=>'{'}],

    '_if'=>[{syntax=>'_k({', para=>'if'}]
};

# equals to 
{
    '_if'=>[{value=>'if'},
            {type=>'pair',value=>'('},
            {type=>'pair',value=>'{'}]
};

输入及输出： 处理前后的数据结构完全相同，处理的过程，只是将几个元素合并为一个元素，或将一个元素拆分为几个元素的过程。 定义一下专用的数据结构较好。目前直接用Aspk::Tree虽然可以，但太麻烦了。 输入是一个array,输出也是一个array.只不过有些元素合并或拆分了。

实现：

1. 将给定token iterator转换为AST。

   my %SyntaxTable=();
   my @MatchSet=qw(if sub for);
   
   sub build_ast {
       my ($tk_iter)=@_;
       my @rst;
       while ($tk_iter->get()) {
           $tk_iter->back();
           my $t;
           foreach (@MatchSet) {
               if ($t=parse($tk_iter, $_)) {
                   push @rst, $t;
                   last;
               }
           }
           # not matched in syntax table
           unless ($t){
               push @rst, $tk_iter->get();
           }
       }
   
       return @rst;
   }
   
   sub parse {
       my ($tk_iter, $id)=@_;
       my @syntax=@{$SyntaxTable{$id}};
       my $rst = Aspk::Tree({data=>{type=>$id}});
       foreach (@syntax) {
           if (exists $_->{syntax}) {
               # count and para not dealed.
               my $t=parse($tk_iter,$_->{syntax});
               if ($t) {
                   $rst->add_child($t);
               } else {
                   return undef;
               }
           } else {
               my $t=$tk_iter->get();
               return undef unless $t;
               if ($t->{type} eq $_->{type} &&
                   $t->{value} eq $_->{value}) {
                   $rst->add_child($t);
               } else {
                   $tk_iter->back();
                   return undef;
               }
           }
       }
       return $rst;
   }
       

2. DONE 定义 Element 结构。 继承自Tree, 保存type, value等数据。

   package Element
   use parent Aspk::Tree;
   use Aspk::Debug;
   
   sub new {
       my ($class, $spec)= @_;
       my $self;
       $self = $class->SUPER::new($spec);
   
       $self->prop(type, $spec->{type});
       $self->prop(value, $spec->{value});
   
       bless $self, $class;
       return $self;
   }
   
   1;
       

transform post if statement

• State “DONE” from “TODO” [2016-05-31 Tue 15:56] 遇到的问题：
  1. my $a, $b, $c 和预想的不一样， 其等价于 my $a;$b,$c
  2. last in do {} while 不起作用，他将会作用在外层loop.
  3. 由于以上两个反人类行为，花了很多时间才解决。
• State “TODO” from “” [2016-05-31 Tue 09:41]

问题定义： 将 $a='AAA' if not defined $a; 转换为 if (not defined $a) {$a='AAA';}

作用对象： 一个line element的所有子结点。且中途有一个literal:if的结点。

输入：一个line element的所有子结点，数组或迭代器。 输出：转换后的line element的所有子结点，数组。

方法：

1. 对所有结点迭代：
   1. 当前结点为literal:if，记录这个结点为 $b， 如果@a为空，则返回输入。
   2. 为其它，且$b不为undef，则将它push到@c; 否则，push到@a。
2. 组合： 去除@c最后一个元素，如果这个元素是literal:;

   @rst=$b + pair:( + pair:{

   其中pair:(的内容为@c， pair:{的内容为@a.

3. 解析@rst @rst = parse(ArrayIter->new(@rst), ‘if’, $SyntaxTable{‘if’}); 如果返回值为undefed, 则die.

代码：

sub transform_post_if {
    my ($iter) = @_;
    my @a, $b, @c;
    while (my $t=$iter->get()){
        if ($t->prop(type) eq 'literal' &&
            $t->prop(value) eq 'if') {
            $b = $t;
            if (@a == 0) {
                return undef;
            }
        } else {
            if ($b) {
                push @c, $t;
            } else {
                push @a, $t;
            }
        }
    }

    # 2.
    my $t=pop @c;
    unless ($t->prop(type) eq 'literal' &&
        $t->prop(value) eq ';') {
        push @c, $t;
    }

    my $p1 = Element->new({type=>'pair',value=>'('});
    $p1->prop(children, \@c);
    my $p2 = Element->new({type=>'pair',value=>'{'});
    $p2->prop(children, \@a);
    my @rst=($b, $p1, $p2);

    # 3.
    my $r = parse(ArrayIter->new(@rst), 'if', $SyntaxTable{'if'});
    die "Should not be undef" unless $r;

    return ($r);
}

调试： 以上代码，生成的if中的parent 关系有点混乱。从而导致错误。

BUGs

for perl

below sub will not be parsed as sub

return sub{my $a=”AAAA”; return $a;};

sub in return expression will not be parsed as sub

return sub{my $a=”AAAA”; return $a;};

parse line element error

below expression will be parsed as two line element.

$a->{name}->{type};

line element

1. 以;结尾，
2. 不以；结尾，仅限以下几种：
   1. {}
   2. sub …. {}
   3. if .. {} elsif {} else {}
   4. while …{}
   5. for … {}
   6. foreach .. {}