#----------------------------------------------------------------------
#
# uniquePrefixRegexp --
#
#	Composes a regexp that performs unique-prefix matching.  The
#	RE matches one of a supplied set of strings, or any unique
#	prefix thereof.
#
# Parameters:
#	data - List of alternating match-strings and values.
#	       Match-strings with distinct values are considered
#	       distinct.
#
# Results:
#	Returns a two-element list.  The first is a regexp that
#	matches any unique prefix of any of the strings.  The second
#	is a dictionary whose keys are match values from the regexp
#	and whose values are the corresponding values from 'data'.
#
# Side effects:
#	None.
#
#----------------------------------------------------------------------

proc uniquePrefixRegexp { data } {

    set prefixMapping {}
    set successors [dict create {} {}]

    foreach { key value } $data {
	set prefix {}
	foreach char [split $key {}] {
	    set oldPrefix $prefix
	    dict set successors $oldPrefix $char {}
	    append prefix $char
	    dict lappend prefixMapping $prefix $value
	    if { ![dict exists $successors $prefix] } {
		dict set successors $prefix {}
	    }
	}
    }

    set uniquePrefixMapping {}

    dict for { key valueList } $prefixMapping {
	if { [llength $valueList] == 1 } {
	    dict set uniquePrefixMapping $key [lindex $valueList 0]
	}
    }
    foreach { key value } $data {
	dict set uniquePrefixMapping $key $value
    }

    return [list \
		[makeUniquePrefixRegexp $successors $uniquePrefixMapping {}] \
		$uniquePrefixMapping]

}

proc makeUniquePrefixRegexp { successors uniquePrefixMapping prefixString } {

    set schars [dict get $successors $prefixString]
    if { [dict size $schars] == 0 } {
	return {}
    }
    set re {}
    set bracketed 0
    if { [dict exists $uniquePrefixMapping $prefixString] } {
	append re "(?:"
    } elseif { [dict size $schars] > 1 } {
	append re "(?:"
    }
    set sep ""
    dict for { c - } $schars {
	set nextPrefix $prefixString$c
	regsub -all {[^[:alnum:]]} $c \\\\& rechar
	append re $sep $rechar \
	    [makeUniquePrefixRegexp \
		 $successors $uniquePrefixMapping $nextPrefix]
	set sep |
    }
    if { [dict exists $uniquePrefixMapping $prefixString] } {
	append re ")?"
    }  elseif { [dict size $schars] > 1 } {
	append re ")"
    }

    return $re

}

puts [uniquePrefixRegexp {
    lundi -1 mardi -2 mercredi -3 jeudi -4 vendredi -5 samedi -6 dimanche -7
    janvier 1 février 2 fevrier 2 mars 3 avril 4 mai 5 juin 6 juillet 7
    août 8 aout 8 septembre 9 octobre 10 novembre 11 décembre 12
    decembre 12 
}]


