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
6b843949
Commit
6b843949
authored
Oct 18, 2001
by
John van Groningen
Browse files
store macros and local functions in macros in separate {#{#FunDef}},
remove conversion table, except for macros
parent
18d1e786
Changes
36
Hide whitespace changes
Inline
Side-by-side
backend/backendconvert.icl
View file @
6b843949
...
...
@@ -385,10 +385,12 @@ backEndConvertModules p s main_dcl_module_n var_heap attr_var_heap be
#
{
bes_varHeap
,
bes_attrHeap
,
bes_backEnd
}
=
backEndConvertModulesH
p
s
main_dcl_module_n
{
bes_varHeap
=
var_heap
,
bes_attrHeap
=
attr_var_heap
,
bes_backEnd
=
be
,
bes_attr_number
=
0
}
=
(
bes_varHeap
,
bes_attrHeap
,
bes_backEnd
)
import
RWSDebug
backEndConvertModulesH
::
PredefinedSymbols
FrontEndSyntaxTree
!
Int
*
BackEndState
->
*
BackEndState
backEndConvertModulesH
predefs
{
fe_icl
=
fe_icl
=:
{
icl_name
,
icl_
modification_time
,
icl_functions
,
icl_comm
on
,
icl_imported_objects
,
icl_used_module_numbers
},
fe_components
,
fe_dcls
,
fe_arrayInstances
,
fe_dclIclConversions
,
fe_iclDclConversions
,
fe_globalFunctions
}
fe_icl
=:
{
icl_name
,
icl_
functions
,
icl_common
,
icl_global_functi
on
s
,
icl_imported_objects
,
icl_used_module_numbers
,
icl_modification_time
},
fe_components
,
fe_dcls
,
fe_arrayInstances
}
main_dcl_module_n
backEnd
// sanity check ...
// | cIclModIndex <> kIclModuleIndex || cPredefinedModuleIndex <> kPredefinedModuleIndex
...
...
@@ -410,11 +412,7 @@ backEndConvertModulesH predefs {fe_icl =
#
currentDcl
=
fe_dcls
.[
main_dcl_module_n
]
typeConversions
=
currentModuleTypeConversions
icl_common
.
com_class_defs
currentDcl
.
dcl_common
.
com_class_defs
currentDcl
.
dcl_conversions
/*
# rstypes = reshuffleTypes (size icl_common.com_type_defs) typeConversions {type.td_name.id_name \\ type <-: currentDcl.dcl_common.com_type_defs}
types = {type.td_name.id_name \\ type <-: icl_common.com_type_defs}
# backEnd
= backEnd ->>
( "dcl conversions"
...
...
@@ -425,14 +423,12 @@ backEndConvertModulesH predefs {fe_icl =
, [selector.sd_symb.id_name \\ selector <-: currentDcl.dcl_common.com_selector_defs]
, "dcl types"
, [type.td_name.id_name \\ type <-: currentDcl.dcl_common.com_type_defs]
, "icl
sele
ctors"
, "icl
constru
ctors"
, [constructor.cons_symb.id_name \\ constructor <-: icl_common.com_cons_defs]
, "icl
field
s"
, "icl
selector
s"
, [selector.sd_symb.id_name \\ selector <-: icl_common.com_selector_defs]
, "icl types"
, [type.td_name.id_name \\ type <-: icl_common.com_type_defs]
, "compare names"
, (rstypes, types)
)
*/
#!
backEnd
...
...
@@ -446,21 +442,13 @@ backEndConvertModulesH predefs {fe_icl =
#!
backEnd
=
defineDclModule
main_dcl_module_n
fe_dcls
.[
main_dcl_module_n
]
(
backEnd
-*->
"defineDclModule(cIclMoIndex)"
)
#!
backEnd
=
reshuffleTypes
(
size
icl_common
.
com_type_defs
)
typeConversions
(
backEnd
-*->
"reshuffleTypes"
)
#!
backEnd
=
defineOtherDclModules
fe_dcls
main_dcl_module_n
icl_used_module_numbers
(
backEnd
-*->
"defineOtherDclModules"
)
#!
backEnd
=
appBackEnd
(
BEDeclareIclModule
icl_name
.
id_name
icl_modification_time
(
size
icl_functions
)
(
size
icl_common
.
com_type_defs
)
(
size
icl_common
.
com_cons_defs
)
(
size
icl_common
.
com_selector_defs
))
(
backEnd
-*->
"BEDeclareIclModule"
)
#!
backEnd
=
declareFunctionSymbols
icl_functions
(
getConversions
fe_iclDclConversions
)
functionIndices
fe_globalFunctions
(
backEnd
-*->
"declareFunctionSymbols"
)
with
getConversions
::
(
Optional
{#
Int
})
->
{#
Int
}
getConversions
No
=
{}
getConversions
(
Yes
conversions
)
=
conversions
=
declareFunctionSymbols
icl_functions
functionIndices
icl_global_functions
(
backEnd
-*->
"declareFunctionSymbols"
)
#!
backEnd
=
declare
main_dcl_module_n
icl_common
(
backEnd
-*->
"declare (main_dcl_module_n)"
)
#!
backEnd
...
...
@@ -483,7 +471,7 @@ backEndConvertModulesH predefs {fe_icl =
(
convertStrings
[
imported
.
io_name
\\
imported
<-
icl_imported_objects
|
imported
.
io_is_library
])
(
backEnd
-*->
"beDefineImportedObjsAndLibs"
)
#!
backEnd
=
markExports
fe_dcls
.[
main_dcl_module_n
]
dcl_common
.
com_class_defs
dcl_common
.
com_type_defs
icl_common
.
com_class_defs
icl_common
.
com_type_defs
fe_dclIclConversions
(
backEnd
-*->
"markExports"
)
=
markExports
fe_dcls
.[
main_dcl_module_n
]
dcl_common
.
com_class_defs
dcl_common
.
com_type_defs
icl_common
.
com_class_defs
icl_common
.
com_type_defs
(
backEnd
-*->
"markExports"
)
with
dcl_common
=
currentDcl
.
dcl_common
...
...
@@ -563,49 +551,6 @@ where
_
->
identity
)
be
// move types from their dcl to icl positions
class
swapTypes
a
::
Int
Int
*
a
->
*
a
instance
swapTypes
BackEndState
where
//instance swapTypes BackEnd where
swapTypes
i
j
be
=
appBackEnd
(
BESwapTypes
i
j
)
be
instance
swapTypes
{{#
Char
}}
where
swapTypes
i
j
a
=
swap
i
j
a
swap
i
j
a
#!
iValue
=
a
.[
i
]
#!
jValue
=
a
.[
j
]
=
{
a
&
[
i
]
=
jValue
,
[
j
]
=
iValue
}
reshuffleTypes
::
Int
{#
Int
}
*
a
->
*
a
|
swapTypes
a
reshuffleTypes
nIclTypes
dclIclConversions
be
=
thd3
(
foldStateWithIndexA
(
swapType
nDclTypes
)
dclIclConversions
(
idP
nDclTypes
,
idP
nIclTypes
,
be
))
where
nDclTypes
=
size
dclIclConversions
idP
::
Int
->
.{#
Int
}
idP
n
=
{
i
\\
i
<-
[
0
..
n
-1
]}
swapType
::
Int
Int
Int
(*{#
Int
},
*{#
Int
},
*
a
)
->
(*{#
Int
},
*{#
Int
},
*
a
)
|
swapTypes
a
swapType
nDclTypes
dclIndex
iclIndex
state
=:(
p
,
p`
,
be
)
#!
frm
=
p
.[
dclIndex
]
#!
to
=
iclIndex
|
frm
==
to
=
state
// otherwise
#!
frm`
=
dclIndex
#!
to`
=
p`
.[
iclIndex
]
#!
to`
=
if
(
to`
>=
nDclTypes
)
frm`
to`
=
(
swap
frm`
to`
p
,
swap
frm
to
p`
,
swapTypes
frm
to
be
)
::
DeclVarsInput
:==
Ident
class
declareVars
a
::
a
!
DeclVarsInput
->
BackEnder
...
...
@@ -728,21 +673,25 @@ instance declare {#a} | declareWithIndex a & Array {#} a where
declare
moduleIndex
array
=
foldStateWithIndexA
(\
i
->
declareWithIndex
i
moduleIndex
)
array
declareFunctionSymbols
::
{#
FunDef
}
{#
Int
}
[(
Int
,
Int
)]
IndexRange
*
BackEndState
->
*
BackEndState
declareFunctionSymbols
functions
iclDclConversions
functionIndices
globalFunctions
backEnd
=
foldl
(
declare
iclDclConversions
)
backEnd
[(
functionIndex
,
componentIndex
,
functions
.[
functionIndex
])
\\
(
componentIndex
,
functionIndex
)
<-
functionIndices
]
declareFunctionSymbols
::
{#
FunDef
}
[(
Int
,
Int
)]
[
IndexRange
]
*
BackEndState
->
*
BackEndState
declareFunctionSymbols
functions
functionIndices
globalFunctions
backEnd
=
foldl
declare
backEnd
[(
functionIndex
,
componentIndex
,
functions
.[
functionIndex
])
\\
(
componentIndex
,
functionIndex
)
<-
functionIndices
]
where
declare
iclDclConversions
backEnd
(
functionIndex
,
componentIndex
,
function
)
=
appBackEnd
(
BEDeclareFunction
(
functionName
function
.
fun_symb
.
id_name
functionIndex
iclDclConversions
globalFunctions
)
declare
backEnd
(
functionIndex
,
componentIndex
,
function
)
=
appBackEnd
(
BEDeclareFunction
(
functionName
function
.
fun_symb
.
id_name
functionIndex
globalFunctions
)
function
.
fun_arity
functionIndex
componentIndex
)
backEnd
where
functionName
::
{#
Char
}
Int
{#
Int
}
IndexRange
->
{#
Char
}
functionName
name
functionIndex
iclDclConversions
{
ir_from
,
ir_to
}
// | trace_t ("|"+++toString functionIndex)
|
functionIndex
>=
ir_to
||
functionIndex
<
ir_from
=
(
name
+++
";"
+++
toString
iclDclConversions
.[
functionIndex
])
// otherwise
functionName
::
{#
Char
}
Int
[
IndexRange
]
->
{#
Char
}
functionName
name
functionIndex
icl_global_functions
// | trace_t ("|"+++toString functionIndex)
|
index_in_ranges
functionIndex
icl_global_functions
=
name
=
(
name
+++
";"
+++
toString
functionIndex
)
where
index_in_ranges
index
[{
ir_from
,
ir_to
}:
ranges
]
=
(
index
>=
ir_from
&&
index
<
ir_to
)
||
index_in_ranges
index
ranges
;
index_in_ranges
index
[]
=
False
// move to backendsupport
foldStateWithIndexRangeA
function
frm
to
array
...
...
@@ -850,48 +799,7 @@ declareFunType moduleIndex nrOfDclFunctions functionIndex {ft_symb, ft_type_ptr}
// otherwise
=
name
+++
";"
+++
toString
functionIndex
currentModuleTypeConversions
::
{#
ClassDef
}
{#
ClassDef
}
(
Optional
ConversionTable
)
->
{#
Int
}
currentModuleTypeConversions
iclClasses
dclClasses
(
Yes
conversionTable
)
// sanity check ...
|
sort
[
dclClass
.
class_dictionary
.
ds_index
\\
dclClass
<-:
dclClasses
]
<>
[
size
typeConversions
..
size
typeConversions
+
size
dclClasses
-
1
]
=
abort
"backendconvert, currentModuleTypeConversions wrong index range for dcl dictionary types"
// ... sanity check
|
nDclClasses
==
0
=
typeConversions
// otherwise
=
{
createArray
(
nDclTypes
+
nDclClasses
)
NoIndex
&
[
i
]
=
typeConversion
\\
typeConversion
<-:
typeConversions
&
i
<-
[
0
..]}
:-
foldStateWithIndexA
(
updateDictionaryTypeIndex
classConversions
)
classConversions
where
typeConversions
=
conversionTable
.[
cTypeDefs
]
nDclTypes
=
size
typeConversions
classConversions
=
conversionTable
.[
cClassDefs
]
nDclClasses
=
size
classConversions
updateDictionaryTypeIndex
::
{#
Int
}
Int
Int
*{#
Int
}
->
*{#
Int
}
updateDictionaryTypeIndex
classConversions
dclClassIndex
iclClassIndex
allTypeConversions
// sanity check ...
#
(
oldIndex
,
allTypeConversions
)
=
uselect
allTypeConversions
dclTypeIndex
|
oldIndex
<>
NoIndex
=
abort
"backendconvert, updateDictionaryTypeIndex wrong index overwritten"
// ... sanity chechk
=
{
allTypeConversions
&
[
dclTypeIndex
]
=
iclTypeIndex
}
where
dclTypeIndex
=
dclClasses
.[
dclClassIndex
].
class_dictionary
.
ds_index
iclClassIndex
=
classConversions
.[
dclClassIndex
]
iclTypeIndex
=
iclClasses
.[
iclClassIndex
].
class_dictionary
.
ds_index
currentModuleTypeConversions
_
_
No
=
{}
import
StdDebug
/*
declareCurrentDclModuleTypes :: {#CheckedTypeDef} {#Int} -> BackEnder
...
...
@@ -1338,16 +1246,12 @@ convertRule aliasDummyId (index, {fun_type=Yes type, fun_body=body, fun_pos, fun
(
convertTypeAlt
index
main_dcl_module_n
(
type
-*->
(
"convertRule"
,
fun_symb
.
id_name
,
index
,
type
)))
(
convertFunctionBody
index
(
positionToLineNumber
fun_pos
)
aliasDummyId
body
main_dcl_module_n
)
where
cafness
::
DefOrImpFunKind
->
Int
cafness
(
FK_DefFunction
_)
=
BEIsNotACaf
cafness
(
FK_ImpFunction
_)
=
BEIsNotACaf
cafness
FK_DefMacro
cafness
::
FunKind
->
Int
cafness
(
FK_Function
_)
=
BEIsNotACaf
cafness
FK_
Imp
Macro
cafness
FK_Macro
=
BEIsNotACaf
cafness
FK_
Imp
Caf
cafness
FK_Caf
=
BEIsACaf
cafness
funKind
=
BEIsNotACaf
// <<- ("backendconvert, cafness: unknown fun kind", funKind)
...
...
@@ -2222,13 +2126,23 @@ getVariableSequenceNumber varInfoPtr be
vi
->
abort
"getVariableSequenceNumber"
// <<- vi
markExports
::
DclModule
{#
ClassDef
}
{#
CheckedTypeDef
}
{#
ClassDef
}
{#
CheckedTypeDef
}
(
Optional
{#
Int
})
->
BackEnder
markExports
{
dcl_conversions
=
Yes
conversionTable
}
dclClasses
dclTypes
iclClasses
iclTypes
(
Yes
functionConversions
)
=
foldStateA
(\
icl
->
beExportType
icl
icl
)
conversionTable
.[
cTypeDefs
]
o
foldStateWithIndexA
beExportConstructor
conversionTable
.[
cConstructorDefs
]
o
foldStateWithIndexA
beExportField
conversionTable
.[
cSelectorDefs
]
o
foldStateWithIndexA
(
exportDictionary
iclClasses
iclTypes
)
conversionTable
.[
cClassDefs
]
o
foldStateWithIndexA
beExportFunction
functionConversions
foldStateWithIndexTwice
function
n
:==
foldStateWithIndexTwice
0
where
foldStateWithIndexTwice
index
|
index
==
n
=
identity
// otherwise
=
function
index
index
o`
foldStateWithIndexTwice
(
index
+1
)
markExports
::
DclModule
{#
ClassDef
}
{#
CheckedTypeDef
}
{#
ClassDef
}
{#
CheckedTypeDef
}
->
BackEnder
markExports
{
dcl_functions
,
dcl_common
={
com_type_defs
,
com_cons_defs
,
com_selector_defs
,
com_class_defs
}}
dclClasses
dclTypes
iclClasses
iclTypes
=
foldStateWithIndexTwice
beExportType
(
size
com_type_defs
)
o
foldStateWithIndexTwice
beExportConstructor
(
size
com_cons_defs
)
o
foldStateWithIndexTwice
beExportField
(
size
com_selector_defs
)
o
foldStateWithIndexTwice
(
exportDictionary
iclClasses
iclTypes
)
(
size
com_class_defs
)
o
foldStateWithIndexTwice
beExportFunction
(
size
dcl_functions
)
where
exportDictionary
::
{#
ClassDef
}
{#
CheckedTypeDef
}
Index
Index
->
BackEnder
exportDictionary
iclClasses
iclTypes
dclClassIndex
iclClassIndex
...
...
@@ -2245,5 +2159,5 @@ markExports {dcl_conversions = Yes conversionTable} dclClasses dclTypes iclClass
exportDictionaryField
::
FieldSymbol
->
BackEnder
exportDictionaryField
{
fs_index
}
=
beExportField
(
-1
)
fs_index
// remove -1 hack
markExports
_
_
_
_
_
_
markExports
_
_
_
_
_
=
identity
frontend/StdCompare.icl
View file @
6b843949
...
...
@@ -99,6 +99,7 @@ instance == Priority
where
(==)
NoPrio
NoPrio
=
True
(==)
(
Prio
assoc1
prio1
)
(
Prio
assoc2
prio2
)
=
assoc1
==
assoc2
&&
prio1
==
prio2
(==)
_
_
=
False
instance
==
Assoc
where
...
...
@@ -137,6 +138,7 @@ where
// compare_indexes (SK_InternalFunction i1) (SK_InternalFunction i2) = i1 =< i2
compare_indexes
(
SK_OverloadedFunction
i1
)
(
SK_OverloadedFunction
i2
)
=
i1
=<
i2
compare_indexes
(
SK_GeneratedFunction
_
i1
)
(
SK_GeneratedFunction
_
i2
)
=
i1
=<
i2
compare_indexes
(
SK_LocalDclMacroFunction
i1
)
(
SK_LocalDclMacroFunction
i2
)
=
i1
=<
i2
|
less_constructor
symb1
symb2
=
Smaller
...
...
frontend/analtypes.dcl
View file @
6b843949
...
...
@@ -12,7 +12,7 @@ analyseTypeDefs :: !{#CommonDefs} !TypeGroups !*TypeDefInfos !*TypeVarHeap !*Err
determineKindsOfClasses
::
!
NumberSet
!{#
CommonDefs
}
!*
TypeDefInfos
!*
TypeVarHeap
!*
ErrorAdmin
->
(!*
ClassDefInfos
,
!*
TypeDefInfos
,
!*
TypeVarHeap
,
!*
ErrorAdmin
)
checkKindsOfCommonDefsAndFunctions
::
!
Index
!
Index
!
NumberSet
!
IndexRange
!{#
CommonDefs
}
!
u
:{#
FunDef
}
!
v
:{#
DclModule
}
!*
TypeDefInfos
!*
ClassDefInfos
checkKindsOfCommonDefsAndFunctions
::
!
Index
!
Index
!
NumberSet
!
[
IndexRange
]
!{#
CommonDefs
}
!
u
:{#
FunDef
}
!
v
:{#
DclModule
}
!*
TypeDefInfos
!*
ClassDefInfos
!*
TypeVarHeap
!*
ErrorAdmin
->
(!
u
:{#
FunDef
},
!
v
:{#
DclModule
},
!*
TypeDefInfos
,
!*
TypeVarHeap
,
!*
ErrorAdmin
)
isATopConsVar
cv
:==
cv
<
0
...
...
frontend/analtypes.icl
View file @
6b843949
...
...
@@ -30,15 +30,32 @@ partionateAndExpandTypes :: !NumberSet !Index !*CommonDefs !*{#DclModule} !*Type
->
(!
TypeGroups
,
!*{#
CommonDefs
},
!*
TypeDefInfos
,
!*
CommonDefs
,
!*{#
DclModule
},
!*
TypeHeaps
,
!*
ErrorAdmin
)
partionateAndExpandTypes
used_module_numbers
main_dcl_module_index
icl_common
=:{
com_type_defs
,
com_class_defs
}
dcl_modules
type_heaps
error
#!
nr_of_modules
=
size
dcl_modules
#!
nr_of_types_in_icl_mod
=
size
com_type_defs
-
size
com_class_defs
// #! nr_of_types_in_icl_mod = size com_type_defs - size com_class_defs
#!
n_exported_dictionaries
=
size
dcl_modules
.[
main_dcl_module_index
].
dcl_common
.
com_class_defs
#!
index_of_first_not_exported_type_or_dictionary
=
size
dcl_modules
.[
main_dcl_module_index
].
dcl_common
.
com_type_defs
#!
n_exported_icl_types
=
index_of_first_not_exported_type_or_dictionary
-
n_exported_dictionaries
#!
n_types_without_not_exported_dictionaries
=
size
com_type_defs
-
(
size
com_class_defs
-
n_exported_dictionaries
)
#
(
dcl_type_defs
,
dcl_modules
,
new_type_defs
,
new_marks
,
type_def_infos
)
=
copy_type_defs_and_create_marks_and_infos
used_module_numbers
main_dcl_module_index
n
r_of
_types_
in_icl_mod
nr_of_modules
(
com_type_defs
,
dcl_modules
)
=
copy_type_defs_and_create_marks_and_infos
used_module_numbers
main_dcl_module_index
n_types_
without_not_exported_dictionaries
nr_of_modules
(
com_type_defs
,
dcl_modules
)
pi
=
{
pi_marks
=
new_marks
,
pi_type_defs
=
new_type_defs
,
pi_type_def_infos
=
type_def_infos
,
pi_next_num
=
0
,
pi_deps
=
[],
pi_next_group_num
=
0
,
pi_groups
=
[],
pi_error
=
error
}
{
pi_error
,
pi_groups
,
pi_type_defs
,
pi_type_def_infos
}
=
iFoldSt
partionate_type_defs
0
nr_of_modules
pi
with
partionate_type_defs
mod_index
pi
=:{
pi_marks
}
#!
nr_of_typedefs_to_be_examined
=
size
pi_marks
.[
mod_index
]
|
mod_index
==
main_dcl_module_index
#
pi
=
iFoldSt
(
partitionate_type_def
mod_index
)
0
n_exported_icl_types
pi
=
iFoldSt
(
partitionate_type_def
mod_index
)
index_of_first_not_exported_type_or_dictionary
nr_of_typedefs_to_be_examined
pi
=
iFoldSt
(
partitionate_type_def
mod_index
)
0
nr_of_typedefs_to_be_examined
pi
where
partitionate_type_def
module_index
type_index
pi
=:{
pi_marks
}
#
mark
=
pi_marks
.[
module_index
,
type_index
]
|
mark
==
cNotPartitionated
#
(_,
pi
)
=
partitionateTypeDef
{
gi_module
=
module_index
,
gi_index
=
type_index
}
pi
=
pi
=
pi
|
not
pi_error
.
ea_ok
#
(
icl_type_defs
,
type_defs
)
=
replace
pi_type_defs
main_dcl_module_index
dcl_type_defs
(
dcl_modules
,
common_defs
)
=
update_modules_and_create_commondefs
used_module_numbers
type_defs
nr_of_modules
dcl_modules
...
...
@@ -50,38 +67,27 @@ partionateAndExpandTypes used_module_numbers main_dcl_module_index icl_common=:{
(
dcl_modules
,
common_defs
)
=
update_modules_and_create_commondefs
used_module_numbers
type_defs
nr_of_modules
dcl_modules
=
(
reverse
pi_groups
,
common_defs
,
pi_type_def_infos
,
{
icl_common
&
com_type_defs
=
icl_type_defs
},
dcl_modules
,
type_heaps
,
error
)
where
copy_type_defs_and_create_marks_and_infos
used_module_numbers
main_dcl_module_index
n
r_of
_types_
in_icl_mod
nr_of_modules
(
icl_type_defs
,
dcl_modules
)
copy_type_defs_and_create_marks_and_infos
used_module_numbers
main_dcl_module_index
n_types_
without_not_exported_dictionaries
nr_of_modules
(
icl_type_defs
,
dcl_modules
)
#
type_defs
=
{
{}
\\
module_nr
<-
[
1
..
nr_of_modules
]
}
marks
=
{
{}
\\
module_nr
<-
[
1
..
nr_of_modules
]
}
type_def_infos
=
{
{}
\\
module_nr
<-
[
1
..
nr_of_modules
]
}
=
iFoldSt
(
copy_type_def_and_create_marks_and_infos
used_module_numbers
main_dcl_module_index
n
r_of
_types_
in_icl_mod
)
0
nr_of_modules
=
iFoldSt
(
copy_type_def_and_create_marks_and_infos
used_module_numbers
main_dcl_module_index
n_types_
without_not_exported_dictionaries
)
0
nr_of_modules
(
icl_type_defs
,
dcl_modules
,
type_defs
,
marks
,
type_def_infos
)
where
copy_type_def_and_create_marks_and_infos
used_module_numbers
main_dcl_module_index
n
r_of
_types_
in_icl_mod
module_index
copy_type_def_and_create_marks_and_infos
used_module_numbers
main_dcl_module_index
n_types_
without_not_exported_dictionaries
module_index
(
icl_type_defs
,
dcl_modules
,
type_defs
,
marks
,
type_def_infos
)
|
inNumberSet
module_index
used_module_numbers
#
({
com_type_defs
,
com_class_defs
},
dcl_modules
)
=
dcl_modules
![
module_index
].
dcl_common
|
module_index
==
main_dcl_module_index
=
(
{
type_def
\\
type_def
<-:
com_type_defs
},
dcl_modules
,
{
type_defs
&
[
module_index
]
=
icl_type_defs
},
{
marks
&
[
module_index
]
=
createArray
n
r_of
_types_
in_icl_mod
cNotPartitionated
},
{
type_def_infos
&
[
module_index
]
=
createArray
n
r_of
_types_
in_icl_mod
EmptyTypeDefInfo
})
{
marks
&
[
module_index
]
=
createArray
n_types_
without_not_exported_dictionaries
cNotPartitionated
},
{
type_def_infos
&
[
module_index
]
=
createArray
n_types_
without_not_exported_dictionaries
EmptyTypeDefInfo
})
#
nr_of_types
=
size
com_type_defs
-
size
com_class_defs
=
(
icl_type_defs
,
dcl_modules
,
{
type_defs
&
[
module_index
]
=
{
type_def
\\
type_def
<-:
com_type_defs
}},
{
marks
&
[
module_index
]
=
createArray
nr_of_types
cNotPartitionated
},
{
type_def_infos
&
[
module_index
]
=
createArray
nr_of_types
EmptyTypeDefInfo
})
=
(
icl_type_defs
,
dcl_modules
,
type_defs
,
marks
,
type_def_infos
)
partionate_type_defs
mod_index
pi
=:{
pi_marks
}
#!
nr_of_typedefs_to_be_examined
=
size
pi_marks
.[
mod_index
]
=
iFoldSt
(
partitionate_type_def
mod_index
)
0
nr_of_typedefs_to_be_examined
pi
where
partitionate_type_def
module_index
type_index
pi
=:{
pi_marks
}
#
mark
=
pi_marks
.[
module_index
,
type_index
]
|
mark
==
cNotPartitionated
#
(_,
pi
)
=
partitionateTypeDef
{
gi_module
=
module_index
,
gi_index
=
type_index
}
pi
=
pi
=
pi
expand_synonym_types_of_group
main_dcl_module_index
group_members
(
type_defs
,
main_dcl_type_defs
,
type_heaps
,
error
)
=
foldSt
(
expand_synonym_type
main_dcl_module_index
)
group_members
(
type_defs
,
main_dcl_type_defs
,
type_heaps
,
error
)
where
...
...
@@ -800,9 +806,9 @@ where
#
(
kind_info_ptr
,
kind_heap
)
=
newPtr
KI_Const
kind_heap
=
(
type_var_heap
<:=
(
tv_info_ptr
,
TVI_TypeKind
kind_info_ptr
),
kind_heap
<:=
(
kind_info_ptr
,
KI_Var
kind_info_ptr
))
checkKindsOfCommonDefsAndFunctions
::
!
Index
!
Index
!
NumberSet
!
IndexRange
!{#
CommonDefs
}
!
u
:{#
FunDef
}
!
v
:{#
DclModule
}
!*
TypeDefInfos
!*
ClassDefInfos
checkKindsOfCommonDefsAndFunctions
::
!
Index
!
Index
!
NumberSet
!
[
IndexRange
]
!{#
CommonDefs
}
!
u
:{#
FunDef
}
!
v
:{#
DclModule
}
!*
TypeDefInfos
!*
ClassDefInfos
!*
TypeVarHeap
!*
ErrorAdmin
->
(!
u
:{#
FunDef
},
!
v
:{#
DclModule
},
!*
TypeDefInfos
,
!*
TypeVarHeap
,
!*
ErrorAdmin
)
checkKindsOfCommonDefsAndFunctions
first_uncached_module
main_module_index
used_module_numbers
icl_fun_def_range
common_defs
icl_fun_defs
dcl_modules
checkKindsOfCommonDefsAndFunctions
first_uncached_module
main_module_index
used_module_numbers
icl_fun_def_range
s
common_defs
icl_fun_defs
dcl_modules
type_def_infos
class_infos
type_var_heap
error
#
as
=
{
as_td_infos
=
type_def_infos
...
...
@@ -812,16 +818,19 @@ checkKindsOfCommonDefsAndFunctions first_uncached_module main_module_index used_
}
#
(
icl_fun_defs
,
dcl_modules
,
class_infos
,
as
)
=
iFoldSt
(
check_kinds_of_module
first_uncached_module
main_module_index
used_module_numbers
icl_fun_def_range
common_defs
)
=
iFoldSt
(
check_kinds_of_module
first_uncached_module
main_module_index
used_module_numbers
icl_fun_def_range
s
common_defs
)
0
(
size
common_defs
)
(
icl_fun_defs
,
dcl_modules
,
class_infos
,
as
)
=
(
icl_fun_defs
,
dcl_modules
,
as
.
as_td_infos
,
as
.
as_type_var_heap
,
as
.
as_error
)
where
check_kinds_of_module
first_uncached_module
main_module_index
used_module_numbers
{
ir_from
,
ir_to
}
common_defs
module_index
check_kinds_of_module
first_uncached_module
main_module_index
used_module_numbers
icl_fun_def_ranges
common_defs
module_index
(
icl_fun_defs
,
dcl_modules
,
class_infos
,
as
)
|
inNumberSet
module_index
used_module_numbers
|
module_index
==
main_module_index
#
(
class_infos
,
as
)
=
check_kinds_of_class_instances
common_defs
0
common_defs
.[
module_index
].
com_instance_defs
class_infos
as
(
icl_fun_defs
,
class_infos
,
as
)
=
iFoldSt
(
check_kinds_of_icl_fuction
common_defs
)
ir_from
ir_to
(
icl_fun_defs
,
class_infos
,
as
)
#
(
icl_fun_defs
,
class_infos
,
as
)
=
foldSt
(
check_kinds_of_icl_fuctions
common_defs
)
icl_fun_def_ranges
(
icl_fun_defs
,
class_infos
,
as
)
with
check_kinds_of_icl_fuctions
common_defs
{
ir_from
,
ir_to
}
(
icl_fun_defs
,
class_infos
,
as
)
=
iFoldSt
(
check_kinds_of_icl_fuction
common_defs
)
ir_from
ir_to
(
icl_fun_defs
,
class_infos
,
as
)
=
(
icl_fun_defs
,
dcl_modules
,
class_infos
,
as
)
|
module_index
>=
first_uncached_module
#
(
class_infos
,
as
)
=
check_kinds_of_class_instances
common_defs
0
common_defs
.[
module_index
].
com_instance_defs
class_infos
as
...
...
frontend/analunitypes.icl
View file @
6b843949
...
...
@@ -310,9 +310,11 @@ propClassification :: !Index !Index ![PropClassification] !{# CommonDefs } !*Typ
propClassification
type_index
module_index
hio_props
defs
type_var_heap
td_infos
|
type_index
>=
size
td_infos
.[
module_index
]
=
(
0
,
type_var_heap
,
td_infos
)
#
{
td_args
,
td_name
}
=
defs
.[
module_index
].
com_type_defs
.[
type_index
]
(
td_info
,
td_infos
)
=
td_infos
![
module_index
].[
type_index
]
=
determinePropClassOfTypeDef
type_index
module_index
td_args
td_info
hio_props
defs
type_var_heap
td_infos
#
(
td_info
,
td_infos
)
=
td_infos
![
module_index
].[
type_index
]
|
td_info
.
tdi_group_nr
==
(
-1
)
// is an exported dictionary ?
=
(
0
,
type_var_heap
,
td_infos
)
#
{
td_args
,
td_name
}
=
defs
.[
module_index
].
com_type_defs
.[
type_index
]
=
determinePropClassOfTypeDef
type_index
module_index
td_args
td_info
hio_props
defs
type_var_heap
td_infos
determinePropClassOfTypeDef
::
!
Int
!
Int
![
ATypeVar
]
!
TypeDefInfo
![
PropClassification
]
!{#
CommonDefs
}
!*
TypeVarHeap
!*
TypeDefInfos
->
(!
PropClassification
,!*
TypeVarHeap
,
!*
TypeDefInfos
)
...
...
frontend/cheat.dcl
0 → 100644
View file @
6b843949
system
module
cheat
//i :: !b -> a
uniqueCopy
::
!*
a
->
(!*
a
,
!*
a
)
frontend/check.dcl
View file @
6b843949
...
...
@@ -2,11 +2,15 @@ definition module check
import
syntax
,
transform
,
checksupport
,
typesupport
,
predef
checkModule
::
!
ScannedModule
!
IndexRange
![
FunDef
]
!
Int
!
Int
!(
Optional
ScannedModule
)
![
ScannedModule
]
!{#
DclModule
}
!{#
FunDef
}
!*
PredefinedSymbols
!*
SymbolTable
!*
File
!*
Heaps
->
(!
Bool
,
*
IclModule
,
*{#
DclModule
},
*{!
Group
},
!
(
Optional
{#
Index
}),
!.
{#
FunDef
},!
Int
,
!*
Heaps
,
!*
PredefinedSymbols
,
!*
SymbolTable
,
*
File
/* TD */
,
[
String
])
checkModule
::
!
ScannedModule
!
IndexRange
![
FunDef
]
!
Int
!
Int
!(
Optional
ScannedModule
)
![
ScannedModule
]
!{#
DclModule
}
!
*{#*
{#
FunDef
}
}
!*
PredefinedSymbols
!*
SymbolTable
!*
File
!*
Heaps
->
(!
Bool
,
*
IclModule
,
*{#
DclModule
},
*{!
Group
},
!
*{#*
{#
FunDef
}
}
,!
Int
,
!*
Heaps
,
!*
PredefinedSymbols
,
!*
SymbolTable
,
*
File
,
[
String
])
checkFunctions
::
!
Index
!
Level
!
Index
!
Index
!*{#
FunDef
}
!*
ExpressionInfo
!*
Heaps
!*
CheckState
->
(!*{#
FunDef
},
!*
ExpressionInfo
,
!*
Heaps
,
!*
CheckState
)
checkFunctions
::
!
Index
!
Level
!
Index
!
Index
!
Int
!*{#
FunDef
}
!*
ExpressionInfo
!*
Heaps
!*
CheckState
->
(!*{#
FunDef
},!*
ExpressionInfo
,!*
Heaps
,!*
CheckState
)
checkDclMacros
::
!
Index
!
Level
!
Index
!
Index
!*{#
FunDef
}
!*
ExpressionInfo
!*
Heaps
!*
CheckState
->
(!*{#
FunDef
},!*
ExpressionInfo
,!*
Heaps
,!*
CheckState
)
determineTypeOfMemberInstance
::
!
SymbolType
![
TypeVar
]
!
InstanceType
!
Specials
!*
TypeHeaps
!
u
:(
Optional
(
v
:{#
DclModule
},
w
:{#
CheckedTypeDef
},
Index
))
!*
ErrorAdmin
->
(!
SymbolType
,
!
Specials
,
!*
TypeHeaps
,
!
u
:
Optional
(
v
:{#
DclModule
},
w
:{#
CheckedTypeDef
}),
!*
ErrorAdmin
)
...
...
frontend/check.icl
View file @
6b843949
...
...
@@ -12,7 +12,6 @@ isMainModule :: ModuleKind -> Bool
isMainModule
MK_Main
=
True
isMainModule
_
=
False
// AA..
checkGenerics
::
!
Index
!
Index
!*{#
GenericDef
}
!*{#
ClassDef
}
!*{#
CheckedTypeDef
}
!*{#
DclModule
}
!*
TypeHeaps
!*
CheckState
->
(!*{#
GenericDef
},
!*{#
ClassDef
},
!*{#
CheckedTypeDef
},
!*{#
DclModule
},
!*
TypeHeaps
,
!*
CheckState
)
checkGenerics
...
...
@@ -239,7 +238,7 @@ where
(
instance_def
,
is
,
type_heaps
,
cs
)
=
check_instance
mod_index
instance_def
is
type_heaps
cs
=
check_instance_defs
(
inc
inst_index
)
mod_index
{
instance_defs
&
[
inst_index
]
=
instance_def
}
is
type_heaps
cs
=
(
instance_defs
,
is
,
type_heaps
,
cs
)
check_instance
::
!
Index
!
ClassInstance
!
u
:
InstanceSymbols
!*
TypeHeaps
!*
CheckState
->
(!
ClassInstance
,
!
u
:
InstanceSymbols
,
!*
TypeHeaps
,
!*
CheckState
)
check_instance
module_index
ins
=:{
ins_members
,
ins_class
={
glob_object
=
class_name
=:
{
ds_ident
=
{
id_name
,
id_info
},
ds_arity
}},
ins_type
,
ins_specials
,
ins_pos
,
ins_ident
}
...
...
@@ -284,9 +283,7 @@ where
ins
=:{
ins_members
,
ins_class
={
glob_object
=
class_name
=:
{
ds_ident
=
{
id_name
,
id_info
},
ds_arity
}},
ins_type
,
ins_specials
,
ins_pos
,
ins_ident
,
ins_generate
}
is
=:{
is_class_defs
,
is_modules
}
type_heaps
cs
=:{
cs_symbol_table
}
|
ins_generate
=
(
ins
,
is
,
type_heaps
=
(
ins
,
is
,
type_heaps
,
{
cs
&
cs_error
=
checkError
id_name
"cannot generate class instance"
cs
.
cs_error
}
)
|
class_def
.
class_arity
==
ds_arity
...
...
@@ -297,9 +294,7 @@ where
is
=
{
is
&
is_type_defs
=
is_type_defs
,
is_class_defs
=
is_class_defs
,
is_modules
=
is_modules
}
=
({
ins
&
ins_class
=
ins_class
,
ins_type
=
ins_type
,
ins_specials
=
ins_specials
},
is
,
type_heaps
,
cs
)
// otherwise
=
(
ins
,
is
,
type_heaps
=
(
ins
,
is
,
type_heaps
,
{
cs
&
cs_error
=
checkError
id_name
(
"wrong arity: expected "
+++
toString
class_def
.
class_arity
+++
" found "
+++
toString
ds_arity
)
cs
.
cs_error
}
)
check_generic_instance
::
GenericDef
!
Index
!
Index
!
Index
!
ClassInstance
!
u
:
InstanceSymbols
!*
TypeHeaps
!*
CheckState
->
(!
ClassInstance
,
!
u
:
InstanceSymbols
,
!*
TypeHeaps
,
!*
CheckState
)
...
...
@@ -307,14 +302,8 @@ where
{
gen_member_name
}
module_index
generic_index
generic_module_index
ins
=:{
ins_members
,
ins_class
={
glob_object
=
class_name
=:
{
ds_ident
=
{
id_name
,
id_info
},
ds_arity
,
ds_index
}
},
ins_type
,
ins_specials
,
ins_pos
,
ins_ident
,
ins_is_generic
,
ins_generate
ins_members
,
ins_type
,
ins_specials
,
ins_pos
,
ins_ident
,
ins_is_generic
,
ins_generate
}
is
=:{
is_class_defs
,
is_modules
}
type_heaps
...
...
@@ -357,7 +346,6 @@ where
!*
VarHeap
!*
TypeHeaps
!*
CheckState
->
(![(
Index
,
SymbolType
)],
!
x
:{#
ClassInstance
},
!
w
:{#
ClassDef
},
!
v
:{#
MemberDef
},
/*AA*/
!
w
:{#
GenericDef
},
!
nerd
:{#
CheckedTypeDef
},
!
u
:{#
DclModule
},
!*
VarHeap
,
!*
TypeHeaps
,
!*
CheckState
)
check_instances
inst_index
mod_index
instance_types
instance_defs
class_defs
member_defs
generic_defs
type_defs
modules
var_heap
type_heaps
cs
// AA..
|
inst_index
<
size
instance_defs
#
(
instance_def
=:{
ins_ident
,
ins_is_generic
,
ins_pos
},
instance_defs
)
=
instance_defs
![
inst_index
]
#
(
instance_types
,
class_defs
,
member_defs
,
generic_defs
,
type_defs
,
modules
,
var_heap
,
type_heaps
,
cs
)
=
...
...
@@ -366,7 +354,7 @@ where
=
check_instances
(
inc
inst_index
)
mod_index
instance_types
instance_defs
class_defs
member_defs
generic_defs
type_defs
modules
var_heap
type_heaps
cs
// otherwise
=
(
instance_types
,
instance_defs
,
class_defs
,
member_defs
,
generic_defs
,
type_defs
,
modules
,
var_heap
,
type_heaps
,
cs
)
check_class_instance
{
ins_pos
,
ins_class
,
ins_members
,
ins_type
}
mod_index
instance_types
class_defs
member_defs
generic_defs
type_defs
modules
var_heap
type_heaps
cs
#
({
class_members
,
class_name
},
class_defs
,
modules
)
=
getClassDef
ins_class
mod_index
class_defs
modules
class_size
=
size
class_members
...
...
@@ -378,7 +366,7 @@ where
// otherwise
#
cs
=
{
cs
&
cs_error
=
checkError
class_name
"different number of members specified"
cs
.
cs_error
}
=
(
instance_types
,
class_defs
,
member_defs
,
generic_defs
,
type_defs
,
modules
,
var_heap
,
type_heaps
,
cs
)
check_generic_instance
{
ins_class
,
ins_members
,
ins_generate
}
mod_index
instance_types
class_defs
member_defs
generic_defs
type_defs
modules
var_heap
type_heaps
cs
#
({
gen_name
,
gen_member_name
},
generic_defs
,
modules
)
=
getGenericDef
ins_class
mod_index
generic_defs
modules
//| ins_generate
...
...
@@ -392,7 +380,6 @@ where
=
(
instance_types
,
class_defs
,
member_defs
,
generic_defs
,
type_defs
,
modules
,
var_heap
,
type_heaps
,
cs
)
// otherwise
=
(
instance_types
,
class_defs
,
member_defs
,
generic_defs
,
type_defs
,
modules
,
var_heap
,
type_heaps
,
cs
)
// ..AA
check_member_instances
::
!
Index
!
Index
!
Int
!
Int
!{#
DefinedSymbol
}
!{#
DefinedSymbol
}
Ident
!
Position
!
InstanceType
![(
Index
,
SymbolType
)]
!
v
:{#
MemberDef
}
!
blah
:{#
CheckedTypeDef
}
!
u
:{#
DclModule
}
!*
VarHeap
!*
TypeHeaps
!*
CheckState
...
...
@@ -437,7 +424,6 @@ getMemberDef mem_mod mem_index mod_index member_defs modules
#
(
dcl_mod
,
modules
)
=
modules
![
mem_mod
]
=
(
dcl_mod
.
dcl_common
.
com_member_defs
.[
mem_index
],
member_defs
,
modules
)
// AA..
getGenericDef
::
!(
Global
DefinedSymbol
)
!
Int
!
u
:{#
GenericDef
}
!
v
:{#
DclModule
}
->
(!
GenericDef
,!
u
:{#
GenericDef
},!
v
:{#
DclModule
})
getGenericDef
{
glob_module
,
glob_object
={
ds_ident
,
ds_index
}}
mod_index
generic_defs
modules
|
glob_module
==
mod_index
...
...
@@ -445,7 +431,6 @@ getGenericDef {glob_module, glob_object={ds_ident, ds_index}} mod_index generic_
=
(
generic_def
,
generic_defs
,
modules
)
#
(
dcl_mod
,
modules
)
=
modules
![
glob_module
]
=
(
dcl_mod
.
dcl_common
.
com_generic_defs
.[
ds_index
],
generic_defs
,
modules
)
// ..AA
instantiateTypes
::
![
TypeVar
]
![
AttributeVar
]
![
AType
]
![
TypeContext
]
![
AttrInequality
]
!
SpecialSubstitution
![
SpecialSubstitution
]
!*
TypeHeaps
!*
ErrorAdmin
->
(![
TypeVar
],
![
AttributeVar
],
![
AType
],
![
TypeContext
],
![
AttrInequality
],
![
SpecialSubstitution
],
!*
TypeHeaps
,
!*
ErrorAdmin
)
...
...
@@ -796,23 +781,18 @@ where