Skip to content
GitLab
Menu
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
6981a426
Commit
6981a426
authored
Dec 07, 2018
by
johnvg@science.ru.nl
Browse files
mark polymorphic instances of Array, UList and UTSList with SP_GenerateRecordInstances
parent
758e8e4a
Changes
6
Hide whitespace changes
Inline
Side-by-side
frontend/check.icl
View file @
6981a426
...
...
@@ -3391,16 +3391,10 @@ checkInstancesOfDclModule mod_index (nr_of_dcl_functions_and_instances, nr_of_dc
++
reverse
rev_special_defs
++
gen_funs
)
#
cs
=
{
cs
&
cs_predef_symbols
=
cs_predef_symbols
,
cs_error
=
cs_error
}
#!
mod_index_of_std_array
=
cs
.
cs_predef_symbols
.[
PD_StdArray
].
pds_def
#
cs
&
cs_predef_symbols
=
cs_predef_symbols
,
cs_error
=
cs_error
#
(
com_member_defs
,
com_instance_defs
,
dcl_functions
,
cs
)
=
case
mod_index_of_std_array
==
mod_index
of
False
->
(
com_member_defs
,
com_instance_defs
,
dcl_functions
,
cs
)
True
->
adjust_instance_types_of_array_functions_in_std_array_dcl
mod_index
com_member_defs
com_instance_defs
dcl_functions
cs
=
adjust_instance_types_of_std_array_and_std_list_functions
mod_index
com_member_defs
com_instance_defs
dcl_functions
cs
#!
dcl_mod
=
{
dcl_mod
&
dcl_functions
=
dcl_functions
,
dcl_specials
=
{
ir_from
=
nr_of_dcl_functions_and_instances
,
ir_to
=
nr_of_dcl_funs_insts_and_specs
},
...
...
@@ -3414,22 +3408,32 @@ checkInstancesOfDclModule mod_index (nr_of_dcl_functions_and_instances, nr_of_dc
dcl_modules
=
{
dcl_modules
&
[
mod_index
]
=
dcl_mod
}
=
(
dcl_modules
,
heaps
,
cs
)
where
adjust_instance_types_of_array_functions_in_std_array_dcl
array_mod_index
class_members
class_instances
fun_types
cs
=:{
cs_predef_symbols
}
#!
nr_of_instances
=
size
class_instances
#
({
pds_def
},
cs_predef_symbols
)
=
cs_predef_symbols
![
PD_ArrayClass
]
(
offset_table
,
class_members
,
cs_predef_symbols
)
=
arrayFunOffsetToPD_IndexTable
class_members
cs_predef_symbols
(
class_instances
,
fun_types
,
cs_predef_symbols
)
=
iFoldSt
(
adjust_instance_types_of_array_functions
array_mod_index
pds_def
offset_table
)
0
nr_of_instances
(
class_instances
,
fun_types
,
cs_predef_symbols
)
=
(
class_members
,
class_instances
,
fun_types
,
{
cs
&
cs_predef_symbols
=
cs_predef_symbols
})
adjust_instance_types_of_std_array_and_std_list_functions
mod_index
class_members
class_instances
fun_types
cs
=:{
cs_predef_symbols
}
|
mod_index
==
cs_predef_symbols
.[
PD_StdArray
].
pds_def
#!
nr_of_instances
=
size
class_instances
#
({
pds_def
},
cs_predef_symbols
)
=
cs_predef_symbols
![
PD_ArrayClass
]
(
offset_table
,
class_members
,
cs_predef_symbols
)
=
arrayFunOffsetToPD_IndexTable
class_members
cs_predef_symbols
(
class_instances
,
fun_types
,
cs_predef_symbols
)
=
iFoldSt
(
adjust_instance_types_of_array_functions
mod_index
pds_def
offset_table
)
0
nr_of_instances
(
class_instances
,
fun_types
,
cs_predef_symbols
)
=
(
class_members
,
class_instances
,
fun_types
,
{
cs
&
cs_predef_symbols
=
cs_predef_symbols
})
|
mod_index
==
cs_predef_symbols
.[
PD_StdStrictLists
].
pds_def
#!
n_of_instances
=
size
class_instances
#
(
class_instances
,
cs_predef_symbols
)
=
iFoldSt
(
adjust_instances_of__SystemStrictLists_module
mod_index
)
0
n_of_instances
(
class_instances
,
cs_predef_symbols
)
=
(
class_members
,
class_instances
,
fun_types
,
{
cs
&
cs_predef_symbols
=
cs_predef_symbols
})
=
(
class_members
,
class_instances
,
fun_types
,
cs
)
where
adjust_instance_types_of_array_functions
::
.
Index
!
Index
!{#
.
Index
}
!
Int
!*(!
u
:
{#
ClassInstance
},!*{#
FunType
},!
v
:{#
PredefinedSymbol
})
->
(!
u
:
{#
ClassInstance
},!*{#
FunType
},!
v
:{#
PredefinedSymbol
})
adjust_instance_types_of_array_functions
::
Index
!
Index
!{#
Index
}
!
Int
!*(!
*
{#
ClassInstance
},!*{#
FunType
},!
v
:{#
PredefinedSymbol
})
->
(!
*
{#
ClassInstance
},!*{#
FunType
},!
v
:{#
PredefinedSymbol
})
adjust_instance_types_of_array_functions
array_mod_index
array_class_index
offset_table
inst_index
(
class_instances
,
fun_types
,
predef_symbols
)
#
({
ins_class_index
={
gi_module
,
gi_index
},
ins_type
,
ins_members
},
class_instances
)
=
class_instances
![
inst_index
]
|
gi_module
==
array_mod_index
&&
gi_index
==
array_class_index
&&
elemTypeIsStrict
ins_type
.
it_types
predef_symbols
#
fun_types
=
iFoldSt
(
make_instance_strict
ins_members
offset_table
)
0
(
size
ins_members
)
fun_types
=
(
class_instances
,
fun_types
,
predef_symbols
)
|
is_polymorphic_unboxed_array_instance_type
ins_type
.
it_types
predef_symbols
#
class_instances
&
[
inst_index
].
ins_specials
=
SP_GenerateRecordInstances
=
(
class_instances
,
fun_types
,
predef_symbols
)
=
(
class_instances
,
fun_types
,
predef_symbols
)
=
(
class_instances
,
fun_types
,
predef_symbols
)
make_instance_strict
::
!{#
ClassInstanceMember
}
!{#
Index
}
!
Int
!*{#
FunType
}
->
*{#
FunType
}
...
...
@@ -3439,6 +3443,25 @@ checkInstancesOfDclModule mod_index (nr_of_dcl_functions_and_instances, nr_of_dc
(
Yes
symbol_type
)
=
inst_def
.
ft_type
=
{
instance_defs
&
[
cim_index
]
=
{
inst_def
&
ft_type
=
makeElemTypeOfArrayFunctionStrict
inst_def
.
ft_type
ins_offset
offset_table
}}
is_polymorphic_unboxed_array_instance_type
[
TA
{
type_index
={
glob_object
,
glob_module
}}
_,
TV
_
:
_]
predef_symbols
=
glob_module
==
predef_symbols
.[
PD_PredefinedModule
].
pds_def
&&
glob_object
==
predef_symbols
.[
PD_UnboxedArrayType
].
pds_def
is_polymorphic_unboxed_array_instance_type
_
_
=
False
adjust_instances_of__SystemStrictLists_module
::
!
Index
!
Int
!*(!*{#
ClassInstance
},!
v
:{#
PredefinedSymbol
})
->
(!*{#
ClassInstance
},!
v
:{#
PredefinedSymbol
})
adjust_instances_of__SystemStrictLists_module
strict_lists_mod_index
inst_index
(
class_instances
,
predef_symbols
)
#
({
ins_class_index
={
gi_module
,
gi_index
},
ins_type
={
it_types
}},
class_instances
)
=
class_instances
![
inst_index
]
|
gi_module
==
strict_lists_mod_index
&&
(
gi_index
==
predef_symbols
.[
PD_UListClass
].
pds_def
||
gi_index
==
predef_symbols
.[
PD_UTSListClass
].
pds_def
)
=
case
it_types
of
[
TV
_]
#
class_instances
&
[
inst_index
].
ins_specials
=
SP_GenerateRecordInstances
->
(
class_instances
,
predef_symbols
)
_
->
(
class_instances
,
predef_symbols
)
=
(
class_instances
,
predef_symbols
)
checkPredefinedDclModule
::
!
NumberSet
![
Int
]
!(
IntKeyHashtable
SolvedImports
)
!
Int
!
Bool
!
LargeBitvect
!
Bool
!(
Module
(
CollectedDefinitions
ClassInstance
))
!
Index
!*
ExplImpInfos
!*{#
DclModule
}
!*{#*{#
FunDef
}}
!*
Heaps
!*
CheckState
->
(!(!
Int
,!
Index
,![
FunType
]),
!(!*
ExplImpInfos
,!*{#
DclModule
},!*{#*{#
FunDef
}},!*
Heaps
,!*
CheckState
))
...
...
frontend/checktypes.icl
View file @
6981a426
...
...
@@ -1464,6 +1464,8 @@ checkSpecialTypeVars (SP_ParsedSubstitutions env) cs
=
(
SP_ParsedSubstitutions
env
,
cs
)
checkSpecialTypeVars
SP_None
cs
=
(
SP_None
,
cs
)
checkSpecialTypeVars
SP_GenerateRecordInstances
cs
=
(
SP_GenerateRecordInstances
,
cs
)
checkFunSpecialTypeVars
::
!
FunSpecials
!*
CheckState
->
(!
FunSpecials
,
!*
CheckState
)
checkFunSpecialTypeVars
(
FSP_ParsedSubstitutions
env
)
cs
...
...
@@ -1501,6 +1503,8 @@ checkSpecialTypes mod_index (SP_ParsedSubstitutions envs) type_defs modules heap
=
(
SP_Substitutions
specials
,
ots
.
ots_type_defs
,
ots
.
ots_modules
,
heaps
,
cs
)
checkSpecialTypes
mod_index
SP_None
type_defs
modules
heaps
cs
=
(
SP_None
,
type_defs
,
modules
,
heaps
,
cs
)
checkSpecialTypes
mod_index
SP_GenerateRecordInstances
type_defs
modules
heaps
cs
=
(
SP_GenerateRecordInstances
,
type_defs
,
modules
,
heaps
,
cs
)
checkFunSpecialTypes
::
!
Index
!
FunSpecials
!
v
:{#
CheckedTypeDef
}
!
u
:{#
DclModule
}
!*
TypeHeaps
!*
CheckState
->
(!
FunSpecials
,!
x
:{#
CheckedTypeDef
},!
w
:{#
DclModule
},!.
TypeHeaps
,!.
CheckState
),
[
u
v
<=
w
,
v
u
<=
x
];
...
...
frontend/overloading.icl
View file @
6981a426
...
...
@@ -304,7 +304,8 @@ where
get_specials
::
Specials
->
[
Special
]
get_specials
(
SP_ContextTypes
specials
)
=
specials
get_specials
SP_None
=
[]
get_specials
SP_None
=
[]
get_specials
SP_GenerateRecordInstances
=
[]
adjust_type_attributes
::
!{#
CommonDefs
}
![
Type
]
![
Type
]
!*
Coercions
!*
TypeHeaps
->
(
Bool
,
!*
Coercions
,
!*
TypeHeaps
)
adjust_type_attributes
defs
act_types
form_types
coercion_env
type_heaps
...
...
@@ -795,6 +796,8 @@ where
=
match
defs
(
t1
,
ts1
)
(
t2
,
ts2
)
type_heaps
match
defs
[]
[]
type_heaps
=
(
True
,
type_heaps
)
match
defs
_
_
type_heaps
// in case of a kind error
=
(
False
,
type_heaps
)
instance
match
ConsVariable
where
...
...
@@ -1029,7 +1032,7 @@ where
=
[(
index
,
new_ptrs
++
ptrs
)
:
dict_types
]
=
[(
new_index
,
new_ptrs
)
:
dt
]
selectFromDictionary
dict_mod
dict_index
member_index
defs
selectFromDictionary
dict_mod
dict_index
member_index
defs
#
(
RecordType
{
rt_fields
})
=
defs
.[
dict_mod
].
com_type_defs
.[
dict_index
].
td_rhs
{
fs_ident
,
fs_index
}
=
rt_fields
.[
member_index
]
=
{
glob_module
=
dict_mod
,
glob_object
=
{
ds_ident
=
fs_ident
,
ds_index
=
fs_index
,
ds_arity
=
1
}}
...
...
@@ -1060,7 +1063,7 @@ where
#
index
=
-1
-
cim_index
=
(
EI_Instance
{
glob_module
=
glob_module
,
glob_object
={
ds_ident
=
cim_ident
,
ds_arity
=
n_class_exprs
,
ds_index
=
index
}}
class_exprs
,
heaps_and_ptrs
)
adjust_member_application
defs
contexts
{
me_ident
,
me_offset
,
me_class
={
glob_module
,
glob_object
}}
(
CA_Context
tc
)
class_exprs
(
heaps
=:{
hp_type_heaps
},
ptrs
)
adjust_member_application
defs
contexts
{
me_offset
,
me_class
={
glob_module
,
glob_object
}}
(
CA_Context
tc
)
class_exprs
(
heaps
=:{
hp_type_heaps
},
ptrs
)
#
(
class_context
,
address
,
hp_type_heaps
)
=
determineContextAddress
contexts
defs
tc
hp_type_heaps
#
{
class_dictionary
={
ds_index
,
ds_ident
}}
=
defs
.[
glob_module
].
com_class_defs
.[
glob_object
]
selector
=
selectFromDictionary
glob_module
ds_index
me_offset
defs
...
...
frontend/syntax.dcl
View file @
6981a426
...
...
@@ -342,6 +342,7 @@ cNameLocationDependent :== True
|
SP_Substitutions
![
SpecialSubstitution
]
|
SP_ContextTypes
![
Special
]
|
SP_TypeOffset
!
Int
// index in SP_Substitutions for specialized instance
|
SP_GenerateRecordInstances
// for unboxed arrays and lists
|
SP_None
::
FunSpecials
...
...
frontend/syntax.icl
View file @
6981a426
...
...
@@ -313,7 +313,7 @@ where
(<<<)
file
(
BasicPatterns
type
patterns
)
=
file
<<<
" "
<<<
patterns
(<<<)
file
(
AlgebraicPatterns
type
patterns
)
=
file
<<<
patterns
(<<<)
file
(
DynamicPatterns
patterns
)
=
file
<<<
patterns
(<<<)
file
(
OverloadedListPatterns
type
decons_expr
patterns
)
=
file
<<<
decons_expr
<<<
" "
<<<
patterns
(<<<)
file
(
OverloadedListPatterns
type
decons_expr
patterns
)
=
file
<<<
' '
<<<
decons_expr
<<<
' '
<<<
patterns
(<<<)
file
(
NewTypePatterns
type
patterns
)
=
file
<<<
patterns
(<<<)
file
NoPattern
=
file
...
...
@@ -412,7 +412,7 @@ where
=
file
<<<
"DictionariesFunction "
<<<
dictionaries
<<<
expr
<<<
expr_type
(<<<)
file
ExprToBeRemoved
=
file
<<<
"** ExprToBeRemoved **"
(<<<)
file
expr
=
abort
(
"<<< (Expression)"
)
instance
<<<
LetBind
where
(<<<)
file
{
lb_dst
,
lb_src
}
...
...
@@ -673,6 +673,10 @@ where
=
file
<<<
" = "
<<<
data
(<<<)
file
(
RecordType
record
)
=
file
<<<
" = "
<<<
'{'
<<<
record
<<<
'}'
(<<<)
file
(
ExtensibleAlgType
data
)
=
file
<<<
" = "
<<<
data
<<<
" | .."
(<<<)
file
(
AlgConses
data
_)
=
file
<<<
" | "
<<<
data
(<<<)
file
_
=
file
...
...
frontend/trans.icl
View file @
6981a426
...
...
@@ -5059,11 +5059,12 @@ where
instance
<<<
Specials
where
(<<<)
file
spec
=
case
spec
of
SP_None
->
file
<<<
"SP_None"
(
SP_ParsedSubstitutions
_)
->
file
<<<
"SP_ParsedSubstitutions"
(
SP_Substitutions
_)
->
file
<<<
"SP_Substitutions"
(
SP_ContextTypes
l
)
->
file
<<<
"(SP_ContextTypes: "
<<<
l
<<<
")"
(
SP_TypeOffset
_)
->
file
<<<
"SP_TypeOffset"
SP_
None
->
file
<<<
"SP_None
"
SP_
GenerateRecordInstances
->
file
<<<
"SP_GenerateRecordInstances
"
instance
<<<
Special
where
...
...
Write
Preview
Markdown
is supported
0%
Try again
or
attach a new file
.
Attach a file
Cancel
You are about to add
0
people
to the discussion. Proceed with caution.
Finish editing this message first!
Cancel
Please
register
or
sign in
to comment