Commit 8c2c3ba6 authored by Martin Wierich's avatar Martin Wierich
Browse files

New algorithm for explicit imports that also works with cyclic module dependencies

parent befefab3
......@@ -415,24 +415,24 @@ backEndConvertModulesH predefs {fe_icl = fe_icl =: {icl_name, icl_functions, icl
functionIndices
= flatten [[(componentIndex, member) \\ member <- group.group_members] \\ group <-: fe_components & componentIndex <- [0..]]
declareOtherDclModules :: {#DclModule} Int ModuleNumberSet -> BackEnder
declareOtherDclModules :: {#DclModule} Int NumberSet -> BackEnder
declareOtherDclModules dcls main_dcl_module_n used_module_numbers
= foldStateWithIndexA declareOtherDclModule dcls
where
declareOtherDclModule :: ModuleIndex DclModule -> BackEnder
declareOtherDclModule moduleIndex dclModule
| moduleIndex == main_dcl_module_n || moduleIndex == cPredefinedModuleIndex || not (in_module_number_set moduleIndex used_module_numbers)
| moduleIndex == main_dcl_module_n || moduleIndex == cPredefinedModuleIndex || not (inNumberSet moduleIndex used_module_numbers)
= identity
// otherwise
= declareDclModule moduleIndex dclModule
defineOtherDclModules :: {#DclModule} Int ModuleNumberSet VarHeap -> BackEnder
defineOtherDclModules :: {#DclModule} Int NumberSet VarHeap -> BackEnder
defineOtherDclModules dcls main_dcl_module_n used_module_numbers varHeap
= foldStateWithIndexA (defineOtherDclModule varHeap) dcls
where
defineOtherDclModule :: VarHeap ModuleIndex DclModule -> BackEnder
defineOtherDclModule varHeap moduleIndex dclModule
| moduleIndex == main_dcl_module_n || moduleIndex == cPredefinedModuleIndex || not (in_module_number_set moduleIndex used_module_numbers)
| moduleIndex == main_dcl_module_n || moduleIndex == cPredefinedModuleIndex || not (inNumberSet moduleIndex used_module_numbers)
= identity
// otherwise
= defineDclModule varHeap moduleIndex dclModule
......@@ -455,13 +455,13 @@ defineDclModule varHeap moduleIndex {dcl_name, dcl_common, dcl_functions, dcl_is
= declare moduleIndex varHeap dcl_common
o` declareFunTypes moduleIndex dcl_functions dcl_instances.ir_from varHeap
removeExpandedTypesFromDclModules :: {#DclModule} ModuleNumberSet -> BackEnder
removeExpandedTypesFromDclModules :: {#DclModule} NumberSet -> BackEnder
removeExpandedTypesFromDclModules dcls used_module_numbers
= foldStateWithIndexA removeExpandedTypesFromDclModule dcls
where
removeExpandedTypesFromDclModule :: ModuleIndex DclModule -> BackEnder
removeExpandedTypesFromDclModule moduleIndex dclModule=:{dcl_functions}
| moduleIndex == cPredefinedModuleIndex || not (in_module_number_set moduleIndex used_module_numbers)
| moduleIndex == cPredefinedModuleIndex || not (inNumberSet moduleIndex used_module_numbers)
= identity
= foldStateWithIndexA (removeExpandedTypesFromFunType moduleIndex) dcl_functions
where
......@@ -877,7 +877,7 @@ predefineSymbols {dcl_common} predefs
, asai_varHeap :: !VarHeap
}
adjustArrayFunctions :: PredefinedSymbols IndexRange Int {#FunDef} {#DclModule} {#ClassInstance} ModuleNumberSet VarHeap -> BackEnder
adjustArrayFunctions :: PredefinedSymbols IndexRange Int {#FunDef} {#DclModule} {#ClassInstance} NumberSet VarHeap -> BackEnder
adjustArrayFunctions predefs arrayInstancesRange main_dcl_module_n functions dcls icl_instances used_module_numbers varHeap
= adjustStdArray arrayInfo predefs
(if (arrayModuleIndex == main_dcl_module_n) icl_instances stdArray.dcl_common.com_instance_defs)
......@@ -931,7 +931,7 @@ adjustArrayFunctions predefs arrayInstancesRange main_dcl_module_n functions dcl
adjustStdArray :: AdjustStdArrayInfo PredefinedSymbols {#ClassInstance} -> BackEnder
adjustStdArray arrayInfo predefs instances
| arrayModuleIndex == NoIndex || not (in_module_number_set arrayModuleIndex used_module_numbers)
| arrayModuleIndex == NoIndex || not (inNumberSet arrayModuleIndex used_module_numbers)
// || arrayModuleIndex <> main_dcl_module_n
= identity
// otherwise
......
......@@ -2,6 +2,6 @@ definition module analtypes
import checksupport, typesupport
analTypeDefs :: !{#CommonDefs} !ModuleNumberSet !*TypeHeaps !*ErrorAdmin -> (!*TypeDefInfos, !*TypeHeaps, !*ErrorAdmin)
analTypeDefs :: !{#CommonDefs} !NumberSet !*TypeHeaps !*ErrorAdmin -> (!*TypeDefInfos, !*TypeHeaps, !*ErrorAdmin)
instance <<< TypeKind
......@@ -199,7 +199,7 @@ where
# (mark, ({con_var_binds,con_top_var_binds}, as)) = analTypeDef modules module_index type_index as
= (mark, ({con_top_var_binds = con_top_var_binds ++ conds.con_top_var_binds, con_var_binds = con_var_binds ++ conds.con_var_binds}, as))
= (mark, (conds, as))
analTypes has_root_attr modules form_tvs (arg_type --> res_type) conds_as
# (arg_ldep, arg_kind, arg_type_props, conds_as) = analTypes has_root_attr modules form_tvs arg_type conds_as
(res_ldep, res_kind, res_type_props, (conds, as=:{as_kind_heap,as_error})) = analTypes has_root_attr modules form_tvs res_type conds_as
......@@ -456,12 +456,12 @@ where
//import RWSDebug
analTypeDefs :: !{#CommonDefs} !ModuleNumberSet !*TypeHeaps !*ErrorAdmin -> (!*TypeDefInfos, !*TypeHeaps, !*ErrorAdmin)
analTypeDefs :: !{#CommonDefs} !NumberSet !*TypeHeaps !*ErrorAdmin -> (!*TypeDefInfos, !*TypeHeaps, !*ErrorAdmin)
analTypeDefs modules used_module_numbers heaps error
// #! modules = modules ---> "analTypeDefs"
// # sizes = [ size mod.com_type_defs - size mod.com_class_defs \\ mod <-: modules ]
// # used_module_numbers = used_module_numbers <<- used_module_numbers
# sizes = [ if (in_module_number_set module_n used_module_numbers) (size mod.com_type_defs - size mod.com_class_defs) 0 \\ mod <-: modules & module_n<-[0..]]
# sizes = [ if (inNumberSet module_n used_module_numbers) (size mod.com_type_defs - size mod.com_class_defs) 0 \\ mod <-: modules & module_n<-[0..]]
check_marks = { createArray nr_of_types AS_NotChecked \\ nr_of_types <- sizes }
type_def_infos = { createArray nr_of_types EmptyTypeDefInfo \\ nr_of_types <- sizes }
......
This diff is collapsed.
definition module checksupport
import StdEnv
import syntax, predef
//cIclModIndex :== 0
import syntax, predef, containers, utilities
CS_NotChecked :== -1
NotFound :== -1
......@@ -14,11 +12,9 @@ cGlobalScope :== 1
cIsNotADclModule :== False
cIsADclModule :== True
// MW..
cNeedStdArray :== 1
cNeedStdEnum :== 2
cNeedStdDynamics:== 4
// ..MW
:: VarHeap :== Heap VarInfo
......@@ -61,21 +57,25 @@ cConversionTableSize :== 8
// , com_instance_types :: !.{ SymbolType}
}
:: Declaration =
{ dcl_ident :: !Ident
, dcl_pos :: !Position
, dcl_kind :: !STE_Kind
, dcl_index :: !Index
}
:: Declarations = {
dcls_import ::!{!Declaration}
, dcls_local ::![Declaration]
, dcls_local_for_import ::!{!Declaration}
, dcls_explicit ::!{!ExplicitImport}
}
:: ExplicitImport = ExplicitImport !Declaration !Position
:: ExplImpInfos :== {!{!.ExplImpInfo}}
:: ExplImpInfo
= ExplImpInfo Ident !.DeclaringModulesSet
| TemporarilyFetchedAway
:: DeclaringModulesSet :== IntKeyHashtable DeclarationInfo
:: DeclarationInfo =
{ di_decl :: !Declaration
, di_instances :: ![Declaration]
, di_belonging :: !NumberSet
}
:: IclModule =
{ icl_name :: !Ident
......@@ -86,13 +86,9 @@ cConversionTableSize :== 8
// , icl_declared :: !Declarations
, icl_import :: !{!Declaration}
, icl_imported_objects :: ![ImportedObject]
, icl_used_module_numbers :: !ModuleNumberSet
, icl_used_module_numbers :: !NumberSet
}
:: ModuleNumberSet = ModuleNumbers !Int !ModuleNumberSet | EndModuleNumbers;
in_module_number_set :: !Int !ModuleNumberSet -> Bool
:: DclModule =
{ dcl_name :: !Ident
, dcl_functions :: !{# FunType }
......@@ -105,7 +101,7 @@ in_module_number_set :: !Int !ModuleNumberSet -> Bool
, dcl_declared :: !Declarations
, dcl_conversions :: !Optional ConversionTable
, dcl_is_system :: !Bool
, dcl_imported_module_numbers :: !ModuleNumberSet
, dcl_imported_module_numbers :: !NumberSet
}
class Erroradmin state
......@@ -116,7 +112,7 @@ where
instance Erroradmin ErrorAdmin, CheckState
newPosition :: !Ident !Position -> IdentPos
newPosition :: !Ident !Position -> IdentPos
checkError :: !a !b !*ErrorAdmin -> *ErrorAdmin | <<< a & <<< b
checkWarning :: !a !b !*ErrorAdmin -> *ErrorAdmin | <<< a & <<< b
......@@ -132,7 +128,7 @@ instance toIdent ConsDef, (TypeDef a), ClassDef, MemberDef, FunDef, SelectorDef
instance toIdent SymbIdent, TypeSymbIdent, BoundVar, TypeVar, ATypeVar, Ident
instance toInt STE_Kind
instance <<< STE_Kind, IdentPos, Declaration
instance <<< IdentPos, ExplImpInfo, DeclarationInfo
:: ExpressionInfo =
{ ef_type_defs :: !.{# CheckedTypeDef}
......@@ -150,16 +146,14 @@ checkLocalFunctions :: !Index !Level !LocalDefs !*{#FunDef} !*ExpressionInfo !*H
convertIndex :: !Index !Index !(Optional ConversionTable) -> !Index
retrieveGlobalDefinition :: !SymbolTableEntry !STE_Kind !Index -> (!Index, !Index)
retrieveAndRemoveImportsFromSymbolTable :: ![(.a,.Declarations)] [Declaration] *(Heap SymbolTableEntry) -> ([Declaration],.Heap SymbolTableEntry);
//retrieveAndRemoveImportsFromSymbolTable :: !Index ![(.a,.Declarations)] !Int ![Declaration] !*ExplImpInfos !*(Heap SymbolTableEntry)
// -> (!Int, ![Declaration], !.ExplImpInfos, !.Heap SymbolTableEntry);
addLocalFunctionDefsToSymbolTable :: !Level !Index !Index !Bool !*{#FunDef} !*SymbolTable !*ErrorAdmin -> (!*{# FunDef}, !*SymbolTable, !*ErrorAdmin)
addDefToSymbolTable :: !Level !Index !Ident !STE_Kind !*SymbolTable !*ErrorAdmin -> (!* SymbolTable, !*ErrorAdmin)
addDeclaredSymbolsToSymbolTable :: .Bool .Int ![.Declaration] !{!.Declaration} !*CheckState -> .CheckState;
addDeclaredSymbolsToSymbolTable2 :: .Bool .Int !{!.Declaration} !{!.Declaration} !*CheckState -> .CheckState;
addFieldToSelectorDefinition :: !Ident (Global .Int) !*CheckState -> .CheckState;
addGlobalDefinitionsToSymbolTable :: ![.Declaration] !*CheckState -> .CheckState;
retrieveImportsFromSymbolTable :: ![Import ImportDeclaration] ![Declaration] !*{#DclModule} !*(Heap SymbolTableEntry) -> *(![Declaration],!*{#DclModule},!*Heap SymbolTableEntry);
addDeclaredSymbolsToSymbolTable2 :: .Bool .Int !{!Declaration} !{!Declaration} !*CheckState -> .CheckState;
addGlobalDefinitionsToSymbolTable :: ![Declaration] !*CheckState -> .CheckState;
removeFieldFromSelectorDefinition :: !Ident .Int .Int !*(Heap SymbolTableEntry) -> .Heap SymbolTableEntry;
removeDeclarationsFromSymbolTable :: ![Declaration] !Int !*(Heap SymbolTableEntry) -> *Heap SymbolTableEntry;
removeDeclarationsFromSymbolTable :: ![Declaration] !Int !*SymbolTable -> *SymbolTable
removeLocalIdentsFromSymbolTable :: .Int !.[Ident] !*(Heap SymbolTableEntry) -> .Heap SymbolTableEntry;
removeIdentFromSymbolTable :: !.Int !Ident !*(Heap SymbolTableEntry) -> .Heap SymbolTableEntry;
removeImportsAndLocalsOfModuleFromSymbolTable :: !Declarations !*(Heap SymbolTableEntry) -> .Heap SymbolTableEntry
......@@ -169,3 +163,24 @@ removeLocalsFromSymbolTable :: !Level ![Ident] !LocalDefs !u:{# FunDef} !*(Heap
newFreeVariable :: !FreeVar ![FreeVar] ->(!Bool, ![FreeVar])
local_declaration_for_import :: !u:Declaration .Index -> v:Declaration, [u <= v]
get_ident :: !ImportDeclaration -> Ident
getBelongingSymbolsFromID :: !ImportDeclaration -> Optional [ImportedIdent]
mw_addIndirectlyImportedSymbol :: !(Optional a) !Ident !Position !STE_Kind !STE_Kind !.Int !.Int !Int !*CheckState -> (!Bool, !.CheckState)
updateExplImpForMarkedSymbol :: !Index Declaration !SymbolTableEntry !u:{#DclModule} !{!{!*ExplImpInfo}} !*SymbolTable
-> (!u:{#DclModule}, !{!{!.ExplImpInfo}},!.SymbolTable)
:: BelongingSymbols
= BS_Constructors ![DefinedSymbol]
| BS_Fields !{#FieldSymbol}
| BS_Members !{#DefinedSymbol}
| BS_Nothing
getBelongingSymbols :: !Declaration !{#x:DclModule} -> (!.BelongingSymbols, !{#x:DclModule})
nrOfBelongingSymbols :: !BelongingSymbols -> Int
import_ident :: Ident
restoreHeap :: !Ident !*SymbolTable -> .SymbolTable
temp_try_a_new_thing_XXX yes no :== no
This diff is collapsed.
......@@ -26,3 +26,6 @@ clearBindingsOfTypeVarsAndAttributes :: !TypeAttribute ![ATypeVar] !*TypeHeaps -
isATopConsVar cv :== cv < 0
encodeTopConsVar cv :== dec (~cv)
decodeTopConsVar cv :== ~(inc cv)
expandSynonymTypes :: !.Index !*{#CheckedTypeDef} !*{#.DclModule} !*TypeHeaps !*ErrorAdmin
-> (!.{#CheckedTypeDef},!.{#DclModule},!.TypeHeaps,!.ErrorAdmin)
......@@ -422,7 +422,7 @@ where
| type_index == nr_of_types
| cs.cs_error.ea_ok && not is_main_dcl
# marks = createArray nr_of_types CS_NotChecked
{exp_type_defs,exp_modules,exp_type_heaps,exp_error} = expand_syn_types module_index 0 nr_of_types
{exp_type_defs,exp_modules,exp_type_heaps,exp_error} = (temp_try_a_new_thing_XXX id (expand_syn_types module_index 0 nr_of_types))
{ exp_type_defs = ts.ts_type_defs, exp_modules = ts.ts_modules, exp_marks = marks,
exp_type_heaps = ti_type_heaps, exp_error = cs.cs_error }
= (exp_type_defs, ts.ts_cons_defs, ts.ts_selector_defs, exp_modules, ti_var_heap, exp_type_heaps, { cs & cs_error = exp_error })
......@@ -430,14 +430,29 @@ where
# (ts, ti, cs) = checkTypeDef type_index module_index ts ti cs
= check_type_defs is_main_dcl (inc type_index) nr_of_types module_index ts ti cs
expand_syn_types module_index type_index nr_of_types expst
| type_index == nr_of_types
= expst
| expst.exp_marks.[type_index] == CS_NotChecked
# expst = expandSynType module_index type_index expst
= expand_syn_types module_index (inc type_index) nr_of_types expst
= expand_syn_types module_index (inc type_index) nr_of_types expst
expand_syn_types module_index type_index nr_of_types expst
| type_index == nr_of_types
= expst
| expst.exp_marks.[type_index] == CS_NotChecked
# expst = expandSynType module_index type_index expst
= expand_syn_types module_index (inc type_index) nr_of_types expst
= expand_syn_types module_index (inc type_index) nr_of_types expst
expandSynonymTypes :: !.Index !*{#CheckedTypeDef} !*{#.DclModule} !*TypeHeaps !*ErrorAdmin
-> (!.{#CheckedTypeDef},!.{#DclModule},!.TypeHeaps,!.ErrorAdmin)
expandSynonymTypes module_index exp_type_defs exp_modules exp_type_heaps exp_error
| temp_try_a_new_thing_XXX False True
= abort "expandSynonymTypes"
#! nr_of_types
= size exp_type_defs
# marks
= createArray nr_of_types CS_NotChecked
{exp_type_defs,exp_modules,exp_type_heaps,exp_error}
= expand_syn_types module_index 0 nr_of_types
{ exp_type_defs = exp_type_defs, exp_modules = exp_modules, exp_marks = marks,
exp_type_heaps = exp_type_heaps, exp_error = exp_error }
= (exp_type_defs,exp_modules,exp_type_heaps,exp_error)
:: OpenTypeInfo =
{ oti_heaps :: !.TypeHeaps
, oti_all_vars :: ![TypeVar]
......
definition module containers
from syntax import Optional
from StdOverloaded import toString
:: NumberSet = Numbers !Int !NumberSet | EndNumbers
addNr :: !Int !NumberSet -> NumberSet
inNumberSet :: !Int !NumberSet -> Bool
numberSetUnion :: !NumberSet !NumberSet -> NumberSet
nsFromTo :: !Int -> NumberSet
// all numbers from 0 to (i-1)
bitvectToNumberSet :: !LargeBitvect -> .NumberSet
:: LargeBitvect :== {#Int}
bitvectSelect :: !Int !LargeBitvect -> Bool
bitvectSet :: !Int !*LargeBitvect -> .LargeBitvect
bitvectCreate :: !Int -> .LargeBitvect
bitvectReset :: !*LargeBitvect -> .LargeBitvect
:: IntKey :== Int
:: IntKeyHashtable a =
{ ikh_rehash_threshold :: !Int
, ikh_nr_of_entries :: !Int
, ikh_bitmask :: !Int
, ikh_entries :: !.{!.IntKeyTree a}
}
:: IntKeyTree a = IKT_Leaf | IKT_Node !IntKey a !.(IntKeyTree a) !.(IntKeyTree a)
ikhEmpty :: .(IntKeyHashtable a)
ikhInsert :: !Bool !IntKey a !*(IntKeyHashtable a) -> (!Bool, !.IntKeyHashtable a)
// input bool: overide old value, output bool: a new element was inserted
ikhInsert` :: !Bool !IntKey a !*(IntKeyHashtable a) -> .IntKeyHashtable a
// bool: overide old value
ikhSearch :: !IntKey !(IntKeyHashtable a) -> .Optional a
ikhSearch` :: !IntKey !(IntKeyHashtable a) -> a
ikhUSearch :: !IntKey !*(IntKeyHashtable a) -> (!.Optional a, !*IntKeyHashtable a)
iktUInsert :: !Bool !IntKey a !*(IntKeyTree a) -> (!Bool, !.IntKeyTree a)
// input bool: overide old value, output bool: a new element was inserted
iktFlatten :: !(IntKeyTree a) -> [(IntKey, a)]
iktSearch :: !IntKey !(IntKeyTree a) -> .Optional a
iktSearch` :: !IntKey !(IntKeyTree a) -> a
iktUSearch :: !IntKey !*(IntKeyTree a) -> (!.Optional a,.IntKeyTree a)
instance toString (IntKeyTree a) | toString a, (IntKeyHashtable a) | toString a
implementation module containers
import StdEnv, utilities, syntax
:: NumberSet = Numbers !Int !NumberSet | EndNumbers
inNumberSet :: !Int !NumberSet -> Bool
inNumberSet n EndNumbers
= False;
inNumberSet n (Numbers module_numbers rest_module_numbers)
| n<32
= (module_numbers bitand (1<<n))<>0
= inNumberSet (n-32) rest_module_numbers
nsFromTo :: !Int -> NumberSet
// all numbers from 0 to (i-1)
nsFromTo i
| i<=0
= EndNumbers
| i<=31
= Numbers (bitnot ((-1)<<i)) EndNumbers
= Numbers (-1) (nsFromTo (i-32))
addNr :: !Int !NumberSet -> NumberSet
addNr n EndNumbers
| n<32
= Numbers (1<<n) EndNumbers
= Numbers 0 (addNr (n-32) EndNumbers)
addNr n (Numbers module_numbers rest_module_numbers)
| n<32
= Numbers (module_numbers bitor (1<<n)) rest_module_numbers
= Numbers module_numbers (addNr (n-32) rest_module_numbers)
numberSetUnion :: !NumberSet !NumberSet -> NumberSet
numberSetUnion EndNumbers x
= x
numberSetUnion x EndNumbers
= x
numberSetUnion (Numbers i1 tail1) (Numbers i2 tail2)
= Numbers (i1 bitor i2) (numberSetUnion tail1 tail2)
is_empty_module_n_set EndNumbers
= True;
is_empty_module_n_set (Numbers 0 module_numbers)
= is_empty_module_n_set module_numbers
is_empty_module_n_set _
= False;
remove_first_module_number (Numbers 0 rest_module_numbers)
# (bit_n,rest_module_numbers) = remove_first_module_number rest_module_numbers
= (bit_n+32,Numbers 0 rest_module_numbers)
remove_first_module_number (Numbers module_numbers rest_module_numbers)
# bit_n = first_one_bit module_numbers
= (bit_n,Numbers (module_numbers bitand (bitnot (1<<bit_n))) rest_module_numbers)
first_one_bit module_numbers
| module_numbers bitand 0xff<>0
= first_one_bit_in_byte 0 module_numbers
| module_numbers bitand 0xff00<>0
= first_one_bit_in_byte 8 module_numbers
| module_numbers bitand 0xff0000<>0
= first_one_bit_in_byte 16 module_numbers
= first_one_bit_in_byte 24 module_numbers
first_one_bit_in_byte n module_numbers
| module_numbers bitand (1<<n)<>0
= n
= first_one_bit_in_byte (n+1) module_numbers
bitvectToNumberSet :: !LargeBitvect -> .NumberSet
bitvectToNumberSet a
= loop a (size a - 1)
where
loop a (-1)
= EndNumbers
loop a i
| a.[i]==0
= loop a (i-1)
= loop2 a i EndNumbers
loop2 a (-1) accu
= accu
loop2 a i accu
= loop2 a (i-1) (Numbers a.[i] accu)
BITINDEX index :== index >> 5
BITNUMBER index :== index bitand 31
:: LargeBitvect :== {#Int}
bitvectSelect :: !Int !LargeBitvect -> Bool
bitvectSelect index a
= a.[BITINDEX index] bitand (1 << BITNUMBER index) <> 0
bitvectSet :: !Int !*LargeBitvect -> .LargeBitvect
bitvectSet index a
#! bit_index = BITINDEX index
a_bit_index = a.[bit_index]
= { a & [bit_index] = a_bit_index bitor (1 << BITNUMBER index)}
bitvectCreate :: !Int -> .LargeBitvect
bitvectCreate 0 = {}
bitvectCreate n_elements = createArray ((BITINDEX (n_elements-1)+1)) 0
bitvectReset :: !*LargeBitvect -> .LargeBitvect
bitvectReset arr
#! size
= size arr
= { arr & [i] = 0 \\ i<-[0..size-1] } // list should be optimized away
bitvectOr :: !u:LargeBitvect !*LargeBitvect -> (!Bool, !u:LargeBitvect, !*LargeBitvect)
// Boolean result: whether the unique bitvect has changed
bitvectOr op1 op2
#! size
= size op1
= iFoldSt word_or 0 size (False, op1, op2)
where
word_or i (has_changed, op1=:{[i]=op1_i}, op2=:{[i]=op2_i})
# or = op1_i bitor op2_i
| or==op2_i
= (has_changed, op1, op2)
= (True, op1, { op2 & [i] = or })
screw :== 80
:: IntKey :== Int
:: IntKeyHashtable a =
{ ikh_rehash_threshold :: !Int
, ikh_nr_of_entries :: !Int
, ikh_bitmask :: !Int
, ikh_entries :: !.{!.IntKeyTree a}
}
:: IntKeyTree a = IKT_Leaf | IKT_Node !IntKey a !.(IntKeyTree a) !.(IntKeyTree a)
ikhEmpty :: .(IntKeyHashtable a)
ikhEmpty = { ikh_rehash_threshold = 0, ikh_nr_of_entries = 0,
ikh_bitmask = 0, ikh_entries = {} }
ikhInsert :: !Bool !IntKey a !*(IntKeyHashtable a) -> (!Bool, !.IntKeyHashtable a)
ikhInsert overide int_key value ikh=:{ ikh_rehash_threshold, ikh_nr_of_entries, ikh_bitmask, ikh_entries }
| ikh_rehash_threshold<=ikh_nr_of_entries
= ikhInsert overide int_key value (grow ikh_entries)
#! hash_value
= int_key bitand ikh_bitmask
(tree, ikh_entries)
= replace ikh_entries hash_value IKT_Leaf
(is_new, tree)
= iktUInsert overide int_key value tree
ikh
= { ikh & ikh_entries = { ikh_entries & [hash_value] = tree }}
| is_new
= (is_new, { ikh & ikh_nr_of_entries = ikh_nr_of_entries+1 })
= (is_new, ikh)
grow :: !{!*(IntKeyTree a)} -> .(IntKeyHashtable a)
grow old_entries
#! size
= size old_entries
new_size
= if (size==0) 2 (2*size)
new_entries
= { IKT_Leaf \\ i<-[1..new_size] }
ikh
= { ikh_rehash_threshold = (new_size*screw)/100, ikh_nr_of_entries = 0,
ikh_bitmask = new_size-1, ikh_entries = new_entries }
(_, ikh)
= iFoldSt rehashTree 0 size (old_entries, ikh)
= ikh
where
rehashTree :: !Int (!{!*IntKeyTree a}, !*IntKeyHashtable a)
-> (!{!*IntKeyTree a}, !*IntKeyHashtable a)
rehashTree index (old_entries, ikh)
#! (tree, old_entries)
= replace old_entries index IKT_Leaf
list
= iktFlatten tree
ikh
= foldSt (\(key, value) ikh -> snd (ikhInsert False key value ikh)) list ikh
= (old_entries, ikh)
ikhInsert` :: !Bool !IntKey a !*(IntKeyHashtable a) -> .IntKeyHashtable a
ikhInsert` overide int_key value ikh
= snd (ikhInsert overide int_key value ikh)
ikhSearch :: !IntKey !(IntKeyHashtable a) -> .Optional a
ikhSearch int_key { ikh_bitmask, ikh_entries }
| size ikh_entries==0
= No
= iktSearch int_key ikh_entries.[int_key bitand ikh_bitmask]
ikhSearch` :: !IntKey !(IntKeyHashtable a) -> a
ikhSearch` int_key {ikh_bitmask, ikh_entries }
| size ikh_entries==0
= abort "ikhSearch`: key not found"
= iktSearch` int_key ikh_entries.[int_key bitand ikh_bitmask]
ikhUSearch :: !IntKey !*(IntKeyHashtable a) -> (!.Optional a, !*IntKeyHashtable a)
ikhUSearch int_key ikh=:{ikh_bitmask, ikh_entries}
| size ikh_entries==0
= (No, ikh)
# hash_value
= int_key bitand ikh_bitmask
(ikt, ikh_entries)
= replace ikh_entries hash_value IKT_Leaf
(opt_result, ikt)
= iktUSearch int_key ikt
ikh_entries
= { ikh_entries & [hash_value] = ikt }
= (opt_result, { ikh & ikh_entries = ikh_entries })
iktUInsert :: !Bool !IntKey a !*(IntKeyTree a) -> (!Bool, !.IntKeyTree a)
iktUInsert overide int_key value IKT_Leaf
= (True, IKT_Node int_key value IKT_Leaf IKT_Leaf)
iktUInsert overide int_key value (IKT_Node key2 value2 left right)
| int_key<key2
# (is_new, left`)
= iktUInsert overide int_key value left
= (is_new, IKT_Node key2 value2 left` right)