#
# Copyright (c) 2010, W T Schueller
# All rights reserved.
# 
# Redistribution and use in source and binary forms, with or without modification,
# are permitted provided that the following conditions are met:
# 
# * Redistributions of source code must retain the above copyright notice,
#   this list of conditions and the following disclaimer.
# * Redistributions in binary form must reproduce the above copyright notice,
#   this list of conditions and the following disclaimer in the documentation
#   and/or other materials provided with the distribution.
# * Neither the name of the author nor the names of the contributors
#   may be used to endorse or promote products derived from this software
#   without specific prior written permission.
# 
# THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND
# ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
# WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE
# DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE FOR
# ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES
# (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES;
# LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON
# ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
# (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
# SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
#

##
# \file
#
# \author W T Schueller
#
# \brief Library functions for syntax tree manipulations
#

##
# \brief dump syntax tree
#
# Debug function. Dumps the syntax tree for manual review.
#
# \param tree syntax tree (see \ref parser.tcl)
#
# \param indent string for recursive indentation
#
# \return output string
#
proc dumptree { tree { indent "" } } {
    set r ""
    append r $indent
    append r [ lindex $tree 0 ]
    append r ":"
    switch -exact -- [ lindex $tree 0 ] {
        "script" -
        "command" -
        "word" -
        "\{list\}" -
        "\{script\}" -
        "\[script\]" {
            append r "\n"
            foreach i [ lindex $tree 1 ] {
                append r [ dumptree $i "$indent  " ]
            }
        }
        default {
            append r [ string map { \n \\n \t \\t } [ lindex $tree 1 ] ]
            append r "\n"
        }
    }
    return $r
}
##
# \brief generate output for doxygen
#
# \param tree syntax tree (see \ref parser.tcl)
# \param scriptlevel indicates whether we are inside a procedure
# or outside (at script level)
#
# \return output string
#
proc tree2doxy { tree { scriptlevel 0 } } {
    #puts $tree
    set r ""
    switch -exact -- [ lindex $tree 0 ] {
        "\{list\}" -
        "\{script\}" {
            append r "\{"
            foreach i [ lindex $tree 1 ] {
                append r [ tree2doxy $i $scriptlevel ]
            }
            append r "\}"
        }
        "\[script\]" {
            foreach i [ lindex $tree 1 ] {
                append r [ tree2doxy $i ]
            }
            set r [ string trimright $r ]
            set r [ string trimright $r ";" ]
        }
        "script" {
            foreach i [ lindex $tree 1 ] {
                append r [ tree2doxy $i $scriptlevel ]
            }
        }
        "word" {
            foreach i [ lindex $tree 1 ] {
                append r [ tree2doxy $i ]
            }
        }
        "comment" {
            set c [ string length [ regexp -inline {#*} [ lindex $tree 1 ] ] ]
            append r "/"
            append r [ string repeat "*" $c ]
            append r [ string range [ lindex $tree 1 ] $c end ]
            append r "*/"
        }
        "command" {
            append r [ convertcommand [ lindex $tree 1 ] $scriptlevel ]
        }
        "\{string\}" {
            set t [ lindex $tree 1 ]
            # escape all not already escaped double quotes
            # the re works only if there is a literal double quote at the end
            # the x character will absorb a backslash at the end of the string
            # if pressent, (very unlikely at the moment, because there is a brace
            # at the end, but more general)
            append t "x\""
            set t [ regsub -all {((?:[^\"\\]|\\.|\\\n|\n)*)(["])} ${t} {\1\\"} ]
            set t [ string range $t 0 end-3 ]
            append r "\"[ string range $t 1 end-1 ]\""
        }
        "\"string\"" -
        "string" -
        "wordsep" -
        "cmdsep" {
            append r [ lindex $tree 1 ]
        }
        default {
        }
    }
    return $r
}
##
# \brief convert variables and procedures names
#
# strips off leading colons, substitutes [] with ()
# strips of leading namespace qualifiers
#
# \param node node to convert
#
# \return converted name
#
proc node2name { node } {
    set r [ tree2doxy $node ]
    set r [ string trim $r ":" ]
    set t [ lindex [ split $r "(" ] 0 ]
    set t [ lrange [ split $t ":" ] 0 end-1 ]
    set i [ string length [ join $t ":" ] ]
    set r [ string range $r $i end ]
    set r [ string trim $r ":" ]
    if { [ string range $r end end ] eq ")" } then {
        regsub {[(]} $r {[} r
        set r [ string range $r 0 end-1 ]
        append r "\]"
    }
    return $r
}
##
# \brief convert variables and procedures names
#
# 
# generate a header with nested namespace commands
# and a trailer with closing braces
#
# \param node node to convert
#
# \return list of header and trailer
#
proc node2namespace { node } {
    set r [ tree2doxy $node ]
    set t [ string trim $r ":" ]
    set t [ lindex [ split $t "(" ] 0 ]
    set t [ lrange [ split $t ":" ] 0 end-1 ]
    set header ""
    set trailer ""
    foreach i $t {
        if { $i ne "" } then {
            append header "namespace $i \{ "
            append trailer "\}"
        }
    }
    return [ list $header $trailer ]
}
##
# \brief convert a command
#
# \param nodes list of the nodes
# \param scriptlevel indicates whether we are inside a procedure
# or outside (at script level)
#
# \return converted command
#
proc convertcommand { nodes scriptlevel } {
    #
    # start with empty result string
    set r ""
    #
    # a shortcut
    set nnodes [ llength $nodes ]
    #
    # trailing white space
    for { set i 0 } { $i < $nnodes } { incr i } {
        switch -exact -- [ lindex $nodes $i 0 ] {
            "wordsep" -
            "cmdsep" {
                append r [ lindex $nodes $i 1 ]
            }
            default {
                break
            }
        }
    }
    # the switch selects according to the first two words
    # and the total number of non separator words
    # also, we need the index of the last argument later
    # note: there may be a word separator at the end
    set c 0
    set li $i
    for { set j $i } { $j < $nnodes } { incr j } {
        set t [ lindex $nodes $j 0 ]
        if { $t ne "wordsep" && $t ne "cmdsep" } then {
            incr c
            set li $j
        }
    }
    set w1 [ yy::deparse [ lindex $nodes $i ] ]
    set w2 [ yy::deparse [ lindex $nodes [ expr { $i + 2 } ] ] ]
    #
    # the following switch should consider only the very first word
    regexp {([a-z]+)} $w1 dummy w1
    regexp {([a-z]+)} $w2 dummy w2
    switch -glob -- "$c $w1 $w2" {
        "3 set *" {
            incr i 2
            set ns [ node2namespace [ lindex $nodes $i ] ]
            append r [ lindex $ns 0 ]
            append r "string "
            append r [ node2name [ lindex $nodes $i ] ]
            incr i 2
            append r " = "
            for { } { $i < $nnodes } { incr i } {
                append r [ tree2doxy [ lindex $nodes $i ] ]
            }
            set r [ string trimright $r ]
            set r [ string trimright $r ";" ]
            if { [ lindex $ns 1 ] ne "" } then {
                append r [ lindex $ns 1 ]
            } else {
                append r ";"
            }
        }
        "4 array set" {
            incr i 4
            set ns [ node2namespace [ lindex $nodes $i ] ]
            append r [ lindex $ns 0 ]
            append r "map<string,string> "
            append r [ node2name [ lindex $nodes $i ] ]
            incr i 2
            append r " = "
            for { } { $i < $nnodes } { incr i } {
                append r [ tree2doxy [ lindex $nodes $i ] ]
            }
            set r [ string trimright $r ]
            set r [ string trimright $r ";" ]
            if { [ lindex $ns 1 ] ne "" } then {
                append r [ lindex $ns 1 ]
            } else {
                append r ";"
            }
        }
        "4 proc *" {
            incr i 2
            set ns [ node2namespace [ lindex $nodes $i ] ]
            append r [ lindex $ns 0 ]
            append r "string "
            append r [ node2name [ lindex $nodes $i ] ]
            append r "("
            incr i 1
            append r [ lindex $nodes $i 1 ]
            incr i 1
            set args [ yy::deparse [ lindex $nodes $i ] ]
            foreach arg [ lindex $args 0 ] {
                if { [ llength $arg ] == 2 } then {
                    append r "optional string "
                    append r [ lindex $arg 0 ]
                    append r " = \""
                    append r [ string trim [ lindex $arg 1 ] "\"" ]
                    append r "\", "
                } else {
                    append r "string $arg, "
                }
            }
            set r [ string trimright $r ]
            set r [ string trimright $r "," ]
            append r ") "
            incr i 2
            # the body argument
            # if it starts with left brace it will be the usual case
            # if not then we will add braces to satisfy doxygen
            if { [ string index [ yy::deparse [ lindex $nodes $i ] ] 0 ] eq "\{" } then {
                append r [ tree2doxy [ lindex $nodes $i ] ]
            } else {
                append r "\{"
                append r [ tree2doxy [ lindex $nodes $i ] ]
                append r "\}"
            }
            # there should be no more arguments, anyway we convert them
            incr i 1
            for { } { $i < $nnodes } { incr i } {
                append r [ tree2doxy [ lindex $nodes $i ] ]
            }
            if { [ lindex $ns 1 ] ne "" } then {
                set r [ string trimright $r ]
                set r [ string trimright $r ";" ]
                append r [ lindex $ns 1 ]
            }
        }
        "4 namespace eval" {
            incr i 4
            set ns [ node2namespace [ lindex $nodes $i ] ]
            append r [ lindex $ns 0 ]
            append r "namespace "
            append r [ node2name [ lindex $nodes $i ] ]
            incr i 1
            append r [ lindex $nodes $i 1 ]
            incr i 1
            for { } { $i < $nnodes } { incr i } {
                append r [ tree2doxy [ lindex $nodes $i ] $scriptlevel ]
            }
            if { [ lindex $ns 1 ] ne "" } then {
                set r [ string trimright $r ]
                set r [ string trimright $r ";" ]
                append r [ lindex $ns 1 ]
            }
        }
        default {
            if { !$scriptlevel } then {
                append r [ tree2doxy [ lindex $nodes $i ] ]
                append r "("
                incr i
                for { } { $i < $nnodes } { incr i } {
                    switch -exact -- [ lindex $nodes $i 0 ] {
                        "wordsep" {
                            append r [ lindex $nodes $i 1 ]
                        }
                        default {
                            append r [ tree2doxy [ lindex $nodes $i ] ]
                            set r [ string trimright $r ]
                            set r [ string trimright $r ";" ]
                            append r ","
                        }
                    }
                }
                set r [ string trimright $r ]
                set r [ string trimright $r "," ]
                append r ");"
            }
        }
    }
    return $r
}
#
# end of script
#
