$str = '(one(two(three(four)))(()()))(()(()()))';


##  lexer -- read the input and create a token stream

sub lll {
    return (['L','']);
}

sub rrr {
    return (['R','']);
}

sub ttt {
    return (['T',$_[0]]);
}

%LLUT = (
    '('   => \&lll,
    ')'   => \&rrr,
    'ttt' => \&ttt,
);


@tokens = ();

for $i ($str =~ /(\(|\)|[^()]+)/g) {
    my $func = $LLUT{ $i } || $LLUT{'ttt'};
    push @tokens, &$func ($i);
}


##  parser -- read the token stream, and produce a syntax tree
$stack = [[]];

sub start_group {
    my $stack = shift;
    my $list  = ['group'];
    push @{ $stack->[-1] }, $list;
    push @$stack, $list;
    return;
}

sub end_group {
    my $stack = shift;
    pop @$stack;
}

sub literal {
    my $stack = shift;
    my $token = shift;
    
    push @{ $stack->[-1] }, ['literal',$token];
}

%PLUT = (
    'L' => \&start_group,
    'R' => \&end_group,
    'T' => \&literal,
);

for $t (@tokens) {
    $PLUT{ $t->[0] }($stack, $t->[1]);
}


##  walk the syntax tree and produce output

sub level_1 {
    my $list = shift;
    my $type = shift @$list;

    if ('literal' eq $type) {
        print @$list;
    } else {
        print "(";
        for $i (@$list) {
            &level_2 ($i);
        }
        print ")";
    }
    return;
}

sub level_2 {
    my $list = shift;
    my $type = shift @$list;

    if ('literal' eq $type) {
        print @$list;
    } else {
        print "[";
        for $i (@$list) {
            &deeper ($i);
        }
        print "]";
    }
    return;
}

sub deeper {
    my $list = shift;
    my $type = shift @$list;

    if ('literal' eq $type) {
        print @$list;
    } else {
        print "(";
        for $i (@$list) {
            &deeper ($i);
        }
        print ")";
    }
    return;
}


for $i (@{ $stack->[0] }) {
    &level_1 ($i);
}
[download]