package /Mapping;

enum EntryStatus_t {
    ens_free,
    ens_empty,
    ens_used
};

export generic Mapper(type keyType, valueType) {
    export struct Entry_t {
	EntryStatus_t en_status;
	uint en_hash;
	keyType en_key;
	valueType en_value;
    };
    export type UintHash_t = proc(keyType key)uint;
    export type Equal_t = proc(keyType key1, key2)bool;
    export record MappingApi_t {
	UintHash_t ma_uintHash;
	Equal_t ma_equal;
    };
    export record Mapping_t {
	MappingApi_t m_api;
	[] Entry_t m_contents;
	uint m_entryCount;
    };

    proc
    clear([] Entry_t contents)void:
	for uint i from 0 upto getBound(contents) - 1 do
	    @ Entry_t en := @contents[i];
	    en@.en_status := ens_free;
	    en@.en_hash := 0;
	    en@.en_key := nil;
	    en@.en_value := nil;
	od;
    corp;

    export proc
    Create(MappingApi_t api; uint size)Mapping_t:
	[] Entry_t contents := matrix([size] Entry_t);
	clear(contents);
	Mapping_t(api, contents, 0)
    corp;

    proc
    search(Mapping_t m; keyType key; uint hash)uint:
	[] Entry_t entries := m.m_contents;
	uint size := getBound(entries),
	    pos := hash % size, start := pos, found;
	bool first := true, foundEmpty := false;
	while
	    if pos = start and not first then
		/* Scanned entire table - key not found - return the first of
		   the free slots we found. We must have found one, since we
		   only let the tables get 4/5th full. */
	       return found;
	    fi;
	    @ Entry_t en := @entries[pos];
	    EntryStatus_t ens := en@.en_status;
	    if ens = ens_free then
		/* Found an unused slot - key is not in table. */
		return if foundEmpty then found else pos fi;
	    fi;
	    if ens = ens_empty then
		/* Found a slot that was used in the past, so keep looking,
		   but remember this slot for entry if it is the first such. */
		if not foundEmpty then
		    foundEmpty := true;
		    found := pos;
		fi;
		true
	    elif en@.en_hash ~= hash then
		/* Match not possible - keep looking. */
		true
	    else
		/* Same hash - compare keys. */
		not {m.m_api.ma_equal}(en@.en_key, key)
	    fi
	do
	    pos := pos + 1;
	    if pos = size then
		pos := 0;
	    fi;
	    first := false;
	od;
	pos
    corp;

    export proc
    Enter(Mapping_t m; keyType key; valueType value)void:
	uint count := getBound(m.m_contents);
	if m.m_entryCount >= count * 4 / 5 then
	    /* Expand the table. */
	    [] Entry_t oldContents := m.m_contents;
	    [] Entry_t newContents := matrix([count * 2] Entry_t);
	    clear(newContents);
	    m.m_contents := newContents;
	    m.m_entryCount := 0;
	    for uint i from 0 upto count - 1 do
		@ Entry_t en := @oldContents[i];
		if en@.en_status = ens_used then
		    Enter(m, en@.en_key, en@.en_value);
		fi;
	    od;
	fi;
	uint hash := {m.m_api.ma_uintHash}(key);
	@ Entry_t en := @m.m_contents[search(m, key, hash)];
	en@.en_status := ens_used;
	en@.en_hash := hash;
	en@.en_key := key;
	en@.en_value := value;
	m.m_entryCount := m.m_entryCount + 1;
    corp;

    export proc
    Lookup(Mapping_t m; keyType key)valueType:
	@ Entry_t en :=
	    @m.m_contents[search(m, key, {m.m_api.ma_uintHash}(key))];
	if en@.en_status = ens_used then
	    en@.en_value
	else
	    nil
	fi
    corp;

    export proc
    Delete(Mapping_t m; keyType key)void:
	@ Entry_t en :=
	    @m.m_contents[search(m, key, {m.m_api.ma_uintHash}(key))];
	if en@.en_status = ens_used then
	    en@.en_status := ens_empty;
	    en@.en_hash := 0;
	    en@.en_key := nil;
	    en@.en_value := nil;
	    m.m_entryCount := m.m_entryCount - 1;
	fi;
    corp;
};



package /SymbolMapping;

use /Basic;
use /Mapping;

export record SymbolMappingEntry_t public {
    case SymbolMappingEntryKind_t sme_kind
    incase smek_uintConstant:
	Basic/Uint_t sme_uintConstant;
    incase smek_floatConstant:
	Basic/Float_t sme_floatConstant;
    incase smek_stringConstant:
	string sme_stringConstant;
    esac;
};

export instance SymbolMapper = Mapping/Mapper(string, SymbolMappingEntry_t);

export type SymbolEntry_t = SymbolMapper.Entry_t;

export type SymbolMapping_t = SymbolMapper.Mapping_t;

SymbolMapper.UintHash_t: proc
uintHash(string key)uint:
    Basic/StringHash(key)
corp;

SymbolMapper.Equal_t: proc
equal(string key1, key2)bool:
    key1 = key2
corp;

SymbolMapper.MappingApi_t SymbolMappingApi :=
    SymbolMapper.MappingApi_t(uintHash, equal);

export proc
Create(uint size)SymbolMapping_t:
    SymbolMapper.Create(SymbolMappingApi, size)
corp;

export proc
Enter(SymbolMapping_t m; string key; SymbolMappingEntry_t sme)void:
    SymbolMapper.Enter(m, key, sme);
corp;

export proc
Lookup(SymbolMapping_t m; string key)SymbolMappingEntry_t:
    SymbolMapper.Lookup(m, key)
corp;

export proc
Delete(SymbolMapping_t m; string key)void:
    SymbolMapper.Delete(m, key);
corp;



package /User;

use /BI;
use /Basic;
use /Mapping;
use /SymbolMapping;

instance AnyMap = Mapping/Mapper(any, any);

AnyMap.UintHash_t: proc
anyUintHash(any key)uint:
    /* Use the value's address as its hash. */
    toUint(key)
corp;

AnyMap.Equal_t: proc
anyEqual(any key1, key2)bool:
    key1 = key2
corp;

record KeyType1_t {
    uint kt1_a, kt1_b;
};

record KeyType2_t {
    string kt2_a;
    float kt2_x, kt2_y;
};

uint N = 20;

[N] KeyType1_t Keys1;
[N] KeyType2_t Keys2;
[N] string Keys3;

AnyMap.Mapping_t MyAnyMap;

proc
createKeys()void:
    for uint i from 0 upto N - 1 do
	Keys1[i] := KeyType1_t(i + 5, i * 3);
	Keys2[i] := KeyType2_t(BI/UintToString(i), 1.0, 2.0);
	Keys3[i] := BI/UintToString(i * 13 + 7);
    od;
corp;

proc
checkKey(any key, val; string keyStr, valStr; uint i; string where)void:
    any foundVal := AnyMap.Lookup(MyAnyMap, key);
    if foundVal ~= val then
	BI/Print(where + ": did not find " + valStr + " value for " + keyStr +
		 " key, i = " + BI/UintToString(i) + "\n");
    fi;
corp;

proc
checkKeys(string where)void:
    for uint i from 0 upto N - 1 do
	checkKey(Keys1[i], Keys2[i], "Keys1", "Keys2", i, where);
	checkKey(Keys2[i], Keys1[i], "Keys2", "Keys1", i, where);
	checkKey(Keys3[i], Keys1[i], "string", "Keys1", i, where);
    od;
corp;

proc
mappingTest1()void:
    BI/Print("Checking AnyMap\n");
    createKeys();

    AnyMap.MappingApi_t anyMapApi :=
	AnyMap.MappingApi_t(anyUintHash, anyEqual);
    /* Create map smaller than entry count, so we test expansion. */
    MyAnyMap := AnyMap.Create(anyMapApi, N / 2);

    for uint i from 0 upto N - 1 do
	AnyMap.Enter(MyAnyMap, Keys1[i], Keys2[i]);
	AnyMap.Enter(MyAnyMap, Keys2[i], Keys1[i]);
	AnyMap.Enter(MyAnyMap, Keys3[i], Keys1[i]);
    od;
    checkKeys("All entered");

    AnyMap.Enter(MyAnyMap, Keys1[3], "Fred");
    checkKeys("Replaced Keys1[3]");

    AnyMap.Delete(MyAnyMap, Keys3[7]);
    checkKeys("Deleted Keys3[7]");

    AnyMap.Enter(MyAnyMap, Keys1[3], Keys2[3]);
    AnyMap.Enter(MyAnyMap, Keys3[7], Keys1[7]);
    checkKeys("Fixed both");
    BI/Print("Done AnyMap\n\n");
corp;

proc
checkSym(SymbolMapping/SymbolMapping_t sm; string tag)void:
    SymbolMapping/SymbolMappingEntry_t sme :=
	SymbolMapping/Lookup(sm, tag);
    BI/Print("  " + tag + ": ");
    if sme = nil then
	BI/Print("not found");
    else
	case sme.sme_kind
	incase SymbolMapping/smek_uintConstant:
	    BI/Print("uint constant " +
		     BI/UintToString(sme.sme_uintConstant.theUint));
	incase SymbolMapping/smek_floatConstant:
	    BI/Print("float constant " +
		     BI/FloatToString(sme.sme_floatConstant.theFloat));
	incase SymbolMapping/smek_stringConstant:
	    BI/Print("string constant '" + sme.sme_stringConstant + "'");
	esac;
    fi;
    BI/Print("\n");
corp;

proc
checkSyms(string runName; SymbolMapping/SymbolMapping_t sm)void:
    BI/Print(runName + ":\n");
    checkSym(sm, "first");
    checkSym(sm, "second");
    checkSym(sm, "third");
    checkSym(sm, "fourth");
corp;

proc
mappingTest2()void:
    BI/Print("Checking SymbolMapping\n");
    SymbolMapping/SymbolMapping_t sm := SymbolMapping/Create(10);
    SymbolMapping/SymbolMappingEntry_t sme :=
	SymbolMapping/SymbolMappingEntry_t.smek_uintConstant(Basic/Uint_t(10));
    SymbolMapping/Enter(sm, "first", sme);
    Basic/Float_t f := Basic/Float_t(123.456);
    sme := SymbolMapping/SymbolMappingEntry_t.smek_floatConstant(f);
    SymbolMapping/Enter(sm, "second", sme);
    sme := SymbolMapping/SymbolMappingEntry_t.smek_stringConstant("fred");
    SymbolMapping/Enter(sm, "third", sme);
    checkSyms("Run #1", sm);
    SymbolMapping/Delete(sm, "second");
    checkSyms("Run #2", sm);
    Basic/Uint_t u := Basic/Uint_t(123456);
    sme := SymbolMapping/SymbolMappingEntry_t.smek_uintConstant(u);
    SymbolMapping/Enter(sm, "third", sme);
    checkSyms("Run #3", sm);
    BI/Print("Done SymbolMapping\n\n");
corp;

export proc
main()void:
    BI/PutChar('\n');
    mappingTest1();
    mappingTest2();
corp;

package /;

export proc
main()void:
    User/main();
corp;