mydef_utils.def

include: macros_util/parse_regex.def

page: utils
    output_dir: lib/MyDef
    type: pm
    package: MyDef::utils

/*
fncode: get_tlist($t)
fncode: for_list_expand($pat, $list)
fncode: smart_split($param, $n)
fncode: proper_split($param)
fncode: expand_macro($line, $sub)
fncode: uniq_name($name, $hash)
fncode: string_symbol_name($s)
*/

#---- common in macros -------------------- 
fncode: get_tlist($t)
    my @vlist = split /,\s*/, $t
    my @tlist
    $foreach $v in @vlist
        $if $v=~/^(\w+)(?:\.\.|-)(.*)$/ -> $a,$t
            $if $t eq ""
                push @tlist, get_range_n($1, $last_tlist_count)
            $elif $t=~/^(\w+)$/ ->$b
                push @tlist, get_range($a, $b)
            $elif $t=~/^(\w+)(%.*x)$/ ->$b, $fmt
                push @tlist, get_range($a, $b, $fmt)
            $elif $t=~/^(\w+)\s*\/\s*(.+)$/ ->$b, $exclude
                # exclusion, eg. Lagrange Polynomial
                my @temp_list = get_range($a, $b)
                $foreach $t in @temp_list
                    $if $t ne $exclude
                        push @tlist, $t
            $else
                # warn "get_tlist error: [$t]\n"
                push @tlist, $v
        $else
            push @tlist, $v

    $global $last_tlist_count
    $last_tlist_count=@tlist
    return @tlist

fncode: get_range($a, $b, $fmt)
    my @tlist
    $if $fmt=~/^%\d*x$/ and $a=~/^[0-9a-f]+$/ and $b=~/^[0-9a-f]+$/
        ($a, $b) = (hex($a), hex($b))
        &call ab_range
            push @tlist, sprintf($fmt, $i)
    $elif $a=~/^\d+$/ and $b=~/^\d+$/
        &call ab_range
            push @tlist, $i
    $elif $a=~/^[a-zA-Z]$/ and $b=~/^[a-zA-Z]$/
        ($a, $b) = (ord($a), ord($b))
        &call ab_range
            push @tlist, chr($i)
    $elif $a=~/^0x(\d+)$/ and $b=~/^\d+$/
        $a = $1
        # 0x0 and 0x1 both means starting at 0x01
        $if $a>0
            $a-=1
            $b-=1
        &call ab_range
            push @tlist, sprintf("0x%x", 1<<$i)
    $else
        push @tlist, "$a-$b"

    return @tlist

    subcode: ab_range
        $if $a<=$b
            $for my $i=$a;$i<=$b;$i++
                BLOCK
        $else
            $for my $i=$a;$i>=$b;$i--
                BLOCK

fncode: get_range_n($a, $count)
    $if $a=~/^\d+$/
        return get_range($a, $a+$count-1)
    $elif $a=~/^[a-zA-Z]$/
        return get_range($a, chr(ord($a)+$count-1))
    $elif $a=~/^0x(\d+)$/
        return get_range($a, "0x".($1+$count-1))
    $else
        return ["$a-"]

#--------
# similar to $(for:1,2,3)
fncode: for_list_expand($pat, $list)
    my ($mult, @vlist)
    $if $list=~/\s+(and)\s+/
        $mult = $1
        @vlist=split /\s+and\s+/, $list
    $elif $list=~/\s+(mul)\s+/
        $mult = $1
        @vlist=split /\s+mul\s+/, $list
    $else
        @vlist = ($list)

    my @tlist  # list of replacement list
    $foreach $v in @vlist
        my @t = MyDef::utils::get_tlist($v)
        push @tlist, \@t

    # $print [$m][$pat]
    my @plist
    $if !$mult
        my $replace
        $if $pat=~/\$1/
            $replace = 1
        $elif $pat=~/\*/
            $replace = 2
        $else
            die "for_list_expand: pattern invalid\n"
        # replaces * 
        $foreach $t in @{$tlist[0]}
            my $l = $pat
            $if $replace==1
                $l =~s/\$1/$t/g
            $else
                $l =~s/\*/$t/g
            push @plist, $l
    $elif $mult eq "and"
        # replaces $1, $2, ...
        my $n = @{$tlist[0]}
        $for $i=0:$n
            my $l = $pat
            my $j=1
            $foreach $tlist in @tlist
                $l=~s/\$$j/$tlist->[$i]/g
                $j++
            push @plist, $l
    $elif $mult eq "mul"
        my $m = @tlist
        my @idx
        $for $i=0:$m
            $idx[$i]=0
        iter_mul:
        $while 1
            # pat
            my $l = $pat
            $for $i=0:$m
                my $j=$i+1
                my $t = $tlist[$i]->[$idx[$i]]
                $l=~s/\$$j/$t/g
            push @plist, $l
            # inc
            my $i=$m-1
            $while $i>=0
                $idx[$i]++
                $if $idx[$i] < @{$tlist[$i]}
                    next iter_mul
                $else
                    $idx[$i]=0
                    $i--
            last iter_mul

    return \@plist

#-------------------------------------------------
fncode: smart_split($param, $n)
    my @tlist = split /,\s*/, $param
    $if $n==@tlist
        return @tlist
    $else
        return proper_split($param)

fncode: proper_split($param)
    my @tlist
    $if $param eq "0"
        return (0)
    $elif !$param
        return @tlist
    # print "proper_split [$param]\n"
    my @closure_stack
    my $t
    &call parse_loop, $param
        &call if_lex, (\s+)
            $if $t or @closure_stack
                $t.=$1
            $else
                #-skip
        $elif $param=~/\G(,)/gc
            $if @closure_stack
                $t.=$1
            $else
                push @tlist, $t
                undef $t
        $elif $param=~/\G($(normal))/gc
            $t.=$1
        $elif $param=~/\G($(dquote))/gc
            $t.=$1
        $elif $param=~/\G($(squote))/gc
            $t.=$1
        $elif $param=~/\G([\(\[\{])/gc
            $t.=$1
            push @closure_stack, $1
        $elif $param=~/\G([\)\]\}])/gc
            $t.=$1
            $if @closure_stack
                $call proper_split_close_bracket
        $elif $param=~/\G(.)/gc
            my $curfile=MyDef::compileutil::curfile_curline()
            $print "[$curfile]proper_split: unmatched $1 [$param]"
            $t.=$1

    $if $t
        $t=~s/\s+$//
    $if $t or @tlist
        push @tlist, $t
    return @tlist

    macros:
        normal: [^"'\(\[\{\)\]\},]+
        dquote: "([^"\\]|\\.)*"
        squote: '([^'\\]|\\.|'')*'

    subcode: proper_split_close_bracket
        my $match
        $if $1 eq ')'
            $match='('
        $elif $1 eq ']'
            $match='['
        $elif $1 eq '}'
            $match='{'
        my $pos=-1
        $for $i=0:@closure_stack
            $if $match==$closure_stack[$i]
                $pos=$i
        $if $pos>=0
            splice(@closure_stack, $pos)
        $else
            warn "proper_split: unbalanced [$param]\n"

#---------------------------------------- 
fncode: expand_macro($line, $sub)
    my @paren_stack
    my $segs=[]
    $(set:dollar=\$(?![\(\.])) # $ not following (
    &call parse_loop, $line
        &call if_lex, \$\(
            push @paren_stack, $segs
            $segs=[]
            push @paren_stack, "\$\("
        $call @quick_macros
        $elif !@paren_stack
            # skip/copy non-macro part
            &call if_lex, ([^\$\x80-\xff]|$(dollar))+
                # not $ or $ -- not follow '('
                push @$segs, $&
        $else
            # inside $( ... )
            &call if_lex, \(
                # @paren_stack: [segs, '$(', segs, '(', ...]
                push @paren_stack, $segs
                $segs=[]
                push @paren_stack, "("
            &call if_lex, \)
                my $t=join('', @$segs)
                my $open=pop @paren_stack
                $segs=pop @paren_stack
                $if $open eq "(" or $t!~/^\w/
                    push @$segs, "$open$t)"
                $else
                    # must be $(w.*)
                    push @$segs, $sub->($t)
            &call if_lex, ([^\$\x80-\xff()]|$(dollar))+
                push @$segs, $&
        $(set:skip_else=1)

    $call check_paren_stack
    return join('', @$segs)

    subcode: check_paren_stack
        $while @paren_stack
            my $t = join('', @$segs)
            my $open = pop @paren_stack
            $segs = pop @paren_stack
            push @$segs, $open
            push @$segs, $t

    subcode: quick_macros
        &call if_lex, \$\.
            push @$segs, $sub->("this")
        &call if_lex, ([\x80-\xff]+)
            my $t = MyDef::compileutil::get_macro_word($1, 1)
            $if $t
                $MyDef::compileutil::n_get_macro++
                push @$segs, $t
            $else
                push @$segs, $1
#---------------------------------------------
fncode: uniq_name($name, $hash)
    $if !$hash->{$name}
        return $name
    $else
        my $i=2
        $if $name=~/[0-9_]/
            $name.="_"
        $while $hash->{"$name$i"}
            $i++
        return "$name$i"

#---------------------------------------- 
fncode: longline_split($l, $style)
    my @out
    my $n = 80
    $if $l=~/^(\s*)(.+)/ -> $sp, $t
        $n -= length($sp)
        $l=~s/\s+$//
        $call basic_split
    return @out

    subcode: basic_split
        $while length($l)>$n
            my $j=$n
            $while $j>0 && substr($l, $j, 1) ne ' '
                $j--
            $if $j==0
                $j = $n
                $while $j<length($l) && substr($l, $j, 1) ne ' '
                    $j++
                $if $j==length($l)
                    last
            $if $j>0
                push @out, $sp.substr($l, 0, $j)
                $l = substr($l, $j)
                $l=~s/^\s+//
        push @out, $sp.$l


#---------------------------------------- 
fncode: string_symbol_name($s)
    my $n=length($s)
    my $name=""
    $for $i=0:$n
        my $c = substr($s, $i, 1)
        $if $c=~/\w/
            $name.=$c
        $elif $c eq "+"
            $name.="Plus"
        $elif $c eq "-"
            $name.="Minus"
        $elif $c eq "*"
            $name.="Mult"
        $elif $c eq "/"
            $name.="Div"
        $elif $c eq "="
            $name.="Eq"
        $elif $c eq "!"
            $name.="Emark"
        $elif $c eq "~"
            $name.="Tilde"
        $elif $c eq "^"
            $name.="Ctrl"
        $elif $c eq "%"
            $name.="Mod"
        $elif $c eq ">"
            $name.="Gt"
        $elif $c eq "<"
            $name.="Lt"
        $elif $c eq "|"
            $name.="Or"
        $elif $c eq "&"
            $name.="And"
        $elif $c eq "("
            $name.="Lp"
        $elif $c eq ")"
            $name.="Rp"
        $elif $c eq "["
            $name.="Lb"
        $elif $c eq "]"
            $name.="Rb"
        $elif $c eq "{"
            $name.="Lc"
        $elif $c eq "}"
            $name.="Rc"
        $elif $c eq "\""
            $name.="Dq"
        $elif $c eq "'"
            $name.="Sq"
        $elif $c eq "`"
            $name.="Backtick"
        $elif $c eq ","
            $name.="Comma"
        $elif $c eq "."
            $name.="Dot"
        $elif $c eq ":"
            $name.="Colon"
        $elif $c eq "?"
            $name.="Qmark"
        $elif $c eq ";"
            $name.="Semi"
        $elif $c eq "\\"
            $name.="Backslash"
        $else
            die "string_symbol_name: [$c] not defined\n"

    return $name