Skip to content
GitLab
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
Expand all Hide whitespace changes
Inline Side-by-side
backend/backendconvert.icl
View file @ 8c2c3ba6
......@@ -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
......
frontend/analtypes.dcl
View file @ 8c2c3ba6
......@@ -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
frontend/analtypes.icl
View file @ 8c2c3ba6
......@@ -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 }
......
frontend/check.icl
View file @ 8c2c3ba6
This diff is collapsed.
frontend/checksupport.dcl
View file @ 8c2c3ba6
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
frontend/checksupport.icl
View file @ 8c2c3ba6
This diff is collapsed.
frontend/checktypes.dcl
View file @ 8c2c3ba6
......@@ -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)
frontend/checktypes.icl
View file @ 8c2c3ba6
......@@ -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]
......
frontend/containers.dcl 0 → 100644
View file @ 8c2c3ba6
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
frontend/containers.icl 0 → 100644
View file @ 8c2c3ba6
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)