TABLE OF CONTENTS

::fnml::parseContent

SYNOPSIS

proc ::fnml::parseContent {nmlName content} {

PURPOSE

Parse the content of the namelist and return the parsed namelist as variable-value pairs in format suitable for "array get" command. Note that implicit array assigments are returned as explicit assigments, except the "r*c" and "r*" forms are left intact.

ARGUMENTS

RETURN VALUE

Returns the parsed namelist as variable-value pairs in format suitable for "array set" command.

ERRORS

Upon detecting parsing (syntax) error in the namelist an error is triggered and error-code is set to PARSE_ERROR

SOURCE

    variable errInfo 
    variable errCode 

    if { [regexp {^(|[ \t\n]+)$} $content] } {
        # the namelist is empty; nothing to parse
        return
    }
    
    set nmlName &[string trimleft $nmlName &]
    
    set err_prefix "error parsing \"$nmlName\" namelist"
    
    # split namelist-content by delimiters [\t\n, ] and remove comments
    
    #set record [split [::fnml::preparse_ $content] =]
    set record [::fnml::preparse_ $content]
    set rtrim  [string trim $record "{}"]
    if { $rtrim == "" } {        
        # an empty namelist (namelist contained just a comment)
        return ""
    }
    if { [catch {set nr [llength $record]}] } {
        # if [llength] fails there is an "unmatched open quote in list" --> syntax error in namelist
        error "$err_prefix: unmatched open quote in the namelist\n" $errInfo $errCode
    }
    if { $nr == 1 } {
        # if nr == 1 --> there is no "=" in the namelist, but the namelist isn't empty
        error "$err_prefix: no assignment operator (=) found in a non-empty namelist\n" $errInfo $errCode
    }   

    foreach field $record {

        incr ind            
        
        if { ! [info exists next_var] } {

            # namelist's first field
            
            if { $ind == 1 && ([catch {set nf_ [llength $field]}] || $nf_ > 1) } {
                # the first field in the namelist should be a single word,
                # but here we have something like {var1 var2 ... = ...}
                error "$err_prefix: problem in the specs of the first variable in the namelist\n" $errInfo $errCode
            }       
            if { [catch {set next_var [lindex $field end]}] } {
                error "$err_prefix: unmatched open quote in the namelist" $errInfo $errCode
            }
            if { $next_var eq {} } {
                error "$err_prefix: namelist data probably start with the = operator\n" $errInfo $errCode
            } 
        } else {
            set var $next_var

            if { $var == {} } {
                error "$err_prefix: probably two consecutive = operators\n" $errInfo $errCode
            }
            
            if { $nr == $ind } {
                # last field
                set values $field
            } else {
                if { [catch {set nf [llength $field]}] } {
                    error "$err_prefix: probably unmatched open quote in the namelist\n" $errInfo $errCode
                }
                set values   [lrange $field  0  $nf-2]
                set next_var [lindex $field end]
            }

            #
            # assing value(s) to variable
            #
            
            if { [llength $values] <= 1 } {
                #
                # scalar variable (or explicitly specified element of an array)
                #
                set nml($var) [string trim $values "\{\}\t\n "]

            } else {
                #
                # it's an array
                #
                set index 1
                
                # fully implicit spec, i.e "var" instead of "var(index)"
                set re {\w+[%\w]*}
                
                # regexp for "post-index" (:n) form (note the index "n" of this form is ignored by gfortran and ifort)
                set re_post {(\w+[%\w]*)\( *: *([+-]?[0-9]*) *\)}
    
                # regexp for "pre-index" (n), (n:), or (n:m) forms, which all implies "n"
                set re_pre {(\w+[%\w]*)\( *([+-]?[0-9]+) *:? *([+-]?[0-9]*) *\)}
                
                # explicit multidimensional index specs, i.e. (m,n,k)
                set rem_expl {(\w+[%\w]*)\( *((([+-]?[0-9]+) *,)+( *[+-]?[0-9]+)) *\)}

                # implicit multidimensional index specs, various forms of (n:m,k:l*): this is NOT SUPPORTED
                set rem_impl {(\w+[%\w]*)\( *([+-]?[0-9]*) *: *([+-]?[0-9]*) *,}
                
                if { [regexp $rem_expl $var] || [regexp $rem_impl $var] } {
                    
                    error "$err_prefix: variable $var: implicit indexing for assignment of multidimensional arrays is not supported. Use explicit assigment instead.\n" $errInfo $errCode
                    
                } elseif { [regexp $re_pre $var] } {
                    
                    set index [regsub $re_pre $var {\2}]
                    set var   [lindex [split $var \(] 0]                    

                } elseif { [regexp $re_post $var] || [regexp $re $var] } {
                    
                    set index 1
                    set var   [lindex [split $var \(] 0]
                } else {
                    error "$err_prefix: this shouldn't happen. Please report the bug along with the namelist\n" $errInfo $errCode
                }

                foreach val $values {
                    set name ${var}($index)
                    set nml($name) [string trim $val "\{\}\t\n "]
                    incr index          
                }
            }
        }
    }
    
    return [array get nml]
}