proc makecat {grammarp countp cat} {
    upvar $grammarp grammar
    upvar $countp count
    if {[llength $cat] > 1} {
	set grammar($count) [list "cat" $cat]
	incr count
	return expr {$count - 1}
    } else {
	return [lindex $cat 0]
    }
    
}
proc makealt {alt} {
    linsert $alt 0 "alt"
    return $alt
}
proc produce {nontermsref grammarref nodeid} {
    upvar $grammarref grammar
    upvar $nontermsref nonterms

    set item $grammar($nodeid)
    set type [lindex $item 0]
    set data [lrange $item 1 end]
    switch $type {
	"alt" {
	    set elements [llength $data]
	    set index [expr {int (rand() * $elements)}]
	    set element [lindex $data $index]
	    return [produce nonterms grammar $element]
	}
	"cat" {
	    set result ""
	    foreach item $data {
		set output [produce nonterms grammar $item]
		set result "$result$output"
	    }
	    return $result
	}
        "nonterm" {
	    return [produce nonterms grammar $nonterms([lindex $data 0])]
	}
	"term" {
	    return [lindex $data 0]
	}
	default {
	    return "default: $type"
	}
    }
}


proc parsegrammar {nontermsref grammarref count input depth} {
    upvar $grammarref grammar
    upvar $nontermsref nonterms
    set state "init"
    set nonterm ""
    while {[string length $input] > 0} {
	regexp {([a-zA-Z]+|[()|=;]|"([^"\\]*(\\")*)*")(.*)} $input foo token output output1 output2
	if {[string length $output1] > 0} {
	   set output $output1
	}
	if {[string length $output2] > 0} {
	    set output $output2
	}

	set input $output
	puts "Token $token"
	switch $state {
	    "init" {
		if {$token == "="} {
		    if {[string length $nonterm] == 0} {
			puts "Need a non-terminal before ="
			return
		    }
		    set state {cat}
		} else {
		    if {[string length $nonterm] > 0} {
			puts "nonterms must be one word, not $token"
			return
		    }
		    set nonterm $token
		}
	    }
	    "cat" {
		if {$token == "="} {
		    if {$depth > 0} {
			puts "Unexpected ="
			return
		    }
		} elseif {$token == ";"} {
		    if {$depth > 0} {
			puts "Mismatched parentheses"
			return
		    }
		    puts "Done with token $nonterm"

		    lappend alt [makecat grammar count $cat]
		    if {[llength $alt] > 1} {
			set grammar($count) [list "alt" $alt]
			set nonterms($nonterm) $count
			incr count
		    } else {
			set nonterms($nonterm) [lindex $alt 0]
		    }
		    set cat ""
		    set alt ""
		    set state "init"
		    set nonterm ""
		} elseif {$token == "|"} {
		    
		    lappend alt [makecat grammar count $cat]
		    set cat ""
		} elseif {$token  == ")"} {

		} else {
		    if {[string index $token 0] == "\"" } {
			set token [string range $token 0 [expr {[string length $token] - 1}]]
			set grammar($count) [list "term" $token]
			puts "term $token"
		    } else {
			set grammar($count) [list "nonterm" $token]
			puts "nonterm $token"
		    }
		    lappend cat $count
		    puts "new cat is $cat"
		    incr count
		}
	    }
	    default {
		puts "died in state '$state'"
		return
	    }
	}
    }
    if {$depth > 0} {
	puts "Mismatched parentheses"
	return
    }
    lappend alt [makecat grammar count $cat]

    if {[llength $alt] > 1} {
	set grammar($count) [list "alt" $alt]
	set nonterms($nonterm) $count
	incr count
    } else {
	set nonterms($nonterm) [lindex $alt 0]
    }
    puts "Done"
}


parsegrammar nonterms grammar 0 {S = A | B; A = "a"; B = "b"} 0
puts "[produce nonterms grammar 2]"