Skip to content
GitLab
Projects
Groups
Snippets
/
Help
Help
Support
Community forum
Keyboard shortcuts
?
Submit feedback
Contribute to GitLab
Sign in
Toggle navigation
Menu
Open sidebar
clean-compiler-and-rts
compiler
Commits
8c2c3ba6
Commit
8c2c3ba6
authored
Jan 12, 2001
by
Martin Wierich
Browse files
New algorithm for explicit imports that also works with cyclic module dependencies
parent
befefab3
Changes
18
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
Module
NumberSet
->
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_n
umber
_s
et
moduleIndex
used_module_numbers
)
|
moduleIndex
==
main_dcl_module_n
||
moduleIndex
==
cPredefinedModuleIndex
||
not
(
in
N
umber
S
et
moduleIndex
used_module_numbers
)
=
identity
// otherwise
=
declareDclModule
moduleIndex
dclModule
defineOtherDclModules
::
{#
DclModule
}
Int
Module
NumberSet
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_n
umber
_s
et
moduleIndex
used_module_numbers
)
|
moduleIndex
==
main_dcl_module_n
||
moduleIndex
==
cPredefinedModuleIndex
||
not
(
in
N
umber
S
et
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
}
Module
NumberSet
->
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_n
umber
_s
et
moduleIndex
used_module_numbers
)
|
moduleIndex
==
cPredefinedModuleIndex
||
not
(
in
N
umber
S
et
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
}
Module
NumberSet
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_n
umber
_s
et
arrayModuleIndex
used_module_numbers
)
|
arrayModuleIndex
==
NoIndex
||
not
(
in
N
umber
S
et
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
}
!
Module
NumberSet
!*
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
}
!
Module
NumberSet
!*
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_n
umber
_s
et
module_n
used_module_numbers
)
(
size
mod
.
com_type_defs
-
size
mod
.
com_class_defs
)
0
\\
mod
<-:
modules
&
module_n
<-[
0
..]]
#
sizes
=
[
if
(
in
N
umber
S
et
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.
Click to expand it.
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
::
!
Module
NumberSet
,
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
::
!
Module
NumberSet
,
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
,
Declaration
Info
::
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
SymbolTable
Entry
)
->
*
Heap
SymbolTable
Entry
;
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.
Click to expand it.
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