# parserunit.tcl --
#
#        Este fichero implementa el código Tcl para reconocer una expresión
#        de unidad válida.
#
# Copyright (c) 2000 CIMNE
#

package provide ParserUnit 0.1

namespace eval ParserUnit {
    namespace export Init Start

    variable LastToken   ""
    variable TokenValue  ""
    variable StrInput    ""
    variable LenInput    0
    variable PosInput    -1

    array set MsgError {
	IDENT      "Expected identifier"
	INTEGER    "Expected integer value"
	UNEXPECTED "Critical error"
    }
    variable Status      EMPTY

    variable Numerator   {}
    variable Denominator {}
    variable Where       Numerator
}

#  ParserUnit::Init --
#
#        Inicializa el estado de ParserUnit apartir de una cadena
#
#  Argumentos:
#
#        Input    Cadena de entrada a analizar.
#
#  Resultados:
#

proc ParserUnit::Init { Input } {
    variable LastToken   ""
    variable TokenValue  ""
    variable StrInput    $Input
    variable LenInput    [string length $Input]
    variable PosInput    0
    variable Numerator   {}
    variable Denominator {}
    variable Where       Numerator
    variable Status      INIT
}

#  ParserUnit::Start --
#
#        Analiza la cadena pasada en Init. Retorna error o la forma
#        interna generada.
#
#  Argumentos:
#
#  Resultados:
#

proc ParserUnit::Start {} {
    variable LastToken

    GetToken
    if { $LastToken == "TOK_IDENTIFIER" } {
	AppendIdent
	Operator
    } else {
	Error IDENT
    }
}

#  ParserUnit::Operator --
#
#  Argumentos:
#
#  Resultados:
#

proc ParserUnit::Operator {} {
    variable LastToken

    GetToken
    switch -- $LastToken {
	TOK_MULT {
	    GetToken
	    if { $LastToken == "TOK_IDENTIFIER" } {
		AppendIdent
		Operator
	    } else {
		Error IDENT
	    }
	}
	TOK_POWER {
	    GetToken
	    if { $LastToken == "TOK_INTEGER" } {
		AppendPower
		Operator
	    } else {
		Error INTEGER
	    }
	}
	TOK_DIVIDE {
	    ChangeToDenominator
	    Start
	}
	TOK_END {
	    End
	}
	default {
	    Error UNEXPECTED
	}
    }
}

#  ParserUnit::ChangeToDenominator --
#
#  Argumentos:
#
#  Resultados:
#

proc ParserUnit::ChangeToDenominator {} {
    variable Where Denominator
}

#  ParserUnit::AppendIdent --
#
#  Argumentos:
#
#  Resultados:
#

proc ParserUnit::AppendIdent {} {
    variable Where
    variable TokenValue

    upvar \#0 ParserUnit::$Where iform

    lappend iform $TokenValue
}

#  ParserUnit::AppendPower --
#
#  Argumentos:
#
#  Resultados:
#

proc ParserUnit::AppendPower {} {
    variable Where
    variable TokenValue

    upvar \#0 ParserUnit::$Where iform

    set LastID [lindex $iform end]
    set iform [lreplace $iform end end [list $LastID $TokenValue]]
}

#  ParserUnit::End --
#
#  Argumentos:
#
#  Resultados:
#

proc ParserUnit::End {} {
    variable Status END
}

#  ParserUnit::Error --
#
#  Argumentos:
#
#  Resultados:
#

proc ParserUnit::Error { CodErr } {
    variable Status
    variable MsgError
    variable PosInput
    variable StrInput

    set Status [list ERROR "'$StrInput' $MsgError($CodErr) at position $PosInput"]
}

proc ParserUnit::IsSpace {} {
    set chr [SeeChar]
    if { ($chr == " ") || ($chr == "\t") } {
	return 1
    } else {
	return 0
    }
}

proc ParserUnit::SkipSpace { } {
    while { [InputAvailable]  && [IsSpace] } {
	NextChar
    }
}

proc ParserUnit::GetChar { } {
    variable StrInput
    variable PosInput
    
    set chr [string index $StrInput $PosInput]
    incr PosInput
    return $chr
}

proc ParserUnit::SeeChar { } {
    variable StrInput
    variable PosInput

    return [string index $StrInput $PosInput]
}

proc ParserUnit::BackChar { } {
    variable PosInput

    incr PosInput -1
}

proc ParserUnit::NextChar { } {
    variable PosInput

    incr PosInput
}

proc ParserUnit::InputAvailable { } {
    variable PosInput
    variable LenInput

   
    return [expr $PosInput < $LenInput]
}

#  ParserUnit::GetToken --
#
#        Lee el próximo token de la cadena de entrada
#
#  Argumentos:
#
#  Resultados:
#
#        El último token leido queda en LastToken y su valor en
#        TokenValue.
#

proc ParserUnit::GetToken {} {
    variable LastToken    TOK_INVALID
    variable TokenValue   ""

    SkipSpace
    switch -regexp -- [set chr [GetChar]] {
	\\* {
	    set LastToken TOK_MULT
	}
	/ {
	    set LastToken TOK_DIVIDE
	}
	\\^ {
	    set LastToken TOK_POWER
	}
	- -
	[0-9] {
	    set TokenValue $chr

	    if { ($chr eq "-") } {
		set needdigit 1
	    } else {
		set needdigit 0
	    }
	    while { 1 } {
		set chr [SeeChar]
		if { $chr == "" || [IsSpace] || $chr == "*" || $chr == "^" || $chr == "/" } {
		    if { $needdigit } {
			set LastToken TOK_ERROR
		    } else {
			set LastToken TOK_INTEGER
		    }
		    return
		}
		if { $chr >= "0" && $chr <= "9" } {
		    set needdigit 0
		    append TokenValue $chr
		    NextChar
		} else {
		    set LastToken TOK_ERROR
		    return
		}
	    }
	}
	[\u00B0\u00BAa-zA-Z] {
	    set TokenValue $chr
	    while { 1 } {
		set chr [SeeChar]
		if { $chr == "" || [IsSpace] || $chr == "*" || $chr == "^" || $chr == "/" } {
		    set LastToken TOK_IDENTIFIER
		    return
		}
		if { ($chr >= "a" && $chr <= "z") || ($chr >= "A" && $chr <= "Z") } {
		    append TokenValue $chr
		    NextChar
		} else {
		    set LastToken TOK_ERROR
		    return
		}
	    }
	}
	default {
	    if { $chr == "" } {
		set LastToken TOK_END
		return
	    }
	}
    }
}