#!/usr/bin/tclsh
# Exceptions should be thrown by value and catched by reference.
# Moreover a rethrow must be done with throw;

proc createThrowMachine {line initState} {
    set machine [dict create name "throw" keywordLine $line state $initState bracesCounter 0 firstKeyword ""]
    return $machine
}

proc createCatchMachine {line initState} {
    set machine [dict create name "catch" keywordLine $line state $initState bracesCounter 0 catchedException ""]
    return $machine
}

foreach fileName [getSourceFileNames] {
    set machines [list]
    
    set lastIdentifier ""
    set prev1 ""
    set prev2 ""
    set prev3 ""
    foreach token [getTokens $fileName 1 0 -1 -1 {throw catch new leftbrace rightbrace greater and identifier rightparen semicolon}] {
        set type [lindex $token 3]
        set line [lindex $token 1]
        
        if {$type == "identifier"} {
            set lastIdentifier [lindex $token 0]
        }
        
        if {$type == "throw"} {
            lappend machines [createThrowMachine $line "beforeThrow"]
        } elseif {$type == "catch"} {
            lappend machines [createCatchMachine $line "waitingForLeftBrace"]
        }
        
        set machinesToKeep [list]
        foreach m $machines {
            set keepMachine 1
            dict with m {
                if {$name == "throw"} {
                    if {$state == "beforeThrow" && $type == "throw"} {
                        set state "catchFirstKeyword"
                    } elseif {$state == "catchFirstKeyword"} {
                        if {$type == "semicolon"} {
                            # This is a rethrow
                            set keepMachine 0
                        } else {
                            set firstKeyword $type
                            set state "waitForEndOfThrow"
                        }
                    } elseif {$state == "waitForEndOfThrow"} {
                        if {$type == "leftbrace"} {
                            # This is an exception specification
                            set keepMachine 0
                        } elseif {$type == "semicolon"} {
                            # This is a throw, check that the first keyword isn't
                            # new or &
                            if {$firstKeyword == "new" || $firstKeyword == "and"} {
                                report $fileName $keywordLine "Exceptions should be thrown by value. Not allocated with new or dereferenced with &."
                            }
                            set keepMachine 0
                        }
                    }
                } elseif {$name == "catch"} {
                    if {$state == "waitingForLeftBrace" && $type == "leftbrace"} {
                        set state "insideCatch"
                        
                        if {$prev2 == "identifier" &&  $prev1 == "rightparen"} {
                            set catchedException $lastIdentifier
                            
                            if {$prev3 != "and"} {
                                report $fileName $keywordLine "Exceptions should be catched by reference (exception catched: $catchedException)"
                            }
                        }
                    } elseif {$state == "insideCatch"} {
                        if {$type == "leftbrace"} {
                            incr bracesCounter
                        } elseif {$type == "rightbrace"} {
                            if {$bracesCounter > 0} {
                                incr bracesCounter -1
                            } else {
                                set keepMachine 0
                            }
                        } elseif {$prev2 == "throw" && $prev1 == "identifier" && $type == "semicolon"} {
                            if {$lastIdentifier == $catchedException} {
                                report $fileName $line "Exceptions should be rethrown with 'throw;' instead of 'throw ${catchedException};'"
                            }
                        }
                    }
                }
            }
            
            if {$keepMachine} {
                lappend machinesToKeep $m
            }
        }
        set machines $machinesToKeep
        
        set prev3 $prev2
        set prev2 $prev1
        set prev1 $type
    }
}