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
6a582eb2
Commit
6a582eb2
authored
Apr 24, 2018
by
John van Groningen
Browse files
pass type_var_heap to and from function convertTypeDefToFlatType (was be_flat_type)
parent
d1f92911
Changes
1
Hide whitespace changes
Inline
Side-by-side
backend/backendconvert.icl
View file @
6a582eb2
...
...
@@ -814,13 +814,17 @@ defineTypes type_i type_i_stop moduleIndex constructors selectors types type_var
=
defineTypes
(
type_i
+1
)
type_i_stop
moduleIndex
constructors
selectors
types
type_var_heap
bes
=
(
type_var_heap
,
bes
)
convertTypeLhs
::
ModuleIndex
Index
TypeAttribute
[
ATypeVar
]
->
BEMonad
BEFlatTypeP
convertTypeLhs
moduleIndex
typeIndex
attribute
args
=
be_flat_type
(
beTypeSymbol
typeIndex
moduleIndex
)
attribute
args
be_flat_type
::
(
BEMonad
BESymbolP
)
TypeAttribute
[
ATypeVar
]
->
BEMonad
BEFlatTypeP
be_flat_type
type_symbol
attribute
args
=
beFlatType
type_symbol
(
convertAttribution
attribute
)
(
convertTypeVars
args
)
convertTypeLhs
::
ModuleIndex
Index
TypeAttribute
[
ATypeVar
]
!*
TypeVarHeap
!*
BackEndState
->
(!
BEFlatTypeP
,
!*
TypeVarHeap
,!*
BackEndState
)
convertTypeLhs
moduleIndex
typeIndex
attribute
args
type_var_heap
bes
=
convertTypeDefToFlatType
(
beTypeSymbol
typeIndex
moduleIndex
)
attribute
args
type_var_heap
bes
convertTypeDefToFlatType
::
(
BEMonad
BESymbolP
)
TypeAttribute
[
ATypeVar
]
!*
TypeVarHeap
!*
BackEndState
->
(!
BEFlatTypeP
,
!*
TypeVarHeap
,!*
BackEndState
)
convertTypeDefToFlatType
type_symbol_m
attribute
args
type_var_heap
bes
#
(
a1
,
bes
)
=
type_symbol_m
bes
(
a2
,
bes
)
=
convertAttribution
attribute
bes
(
a3
,
bes
)
=
convertTypeVars
args
bes
(
flat_type_p
,
bes
)
=
accBackEnd
(
BEFlatType
a1
a2
a3
)
bes
=
(
flat_type_p
,
type_var_heap
,
bes
)
convertTypeVars
::
[
ATypeVar
]
->
BEMonad
BETypeVarListP
convertTypeVars
typeVars
...
...
@@ -830,20 +834,20 @@ convertTypeVar :: ATypeVar -> BEMonad BETypeVarListP
convertTypeVar
typeVar
=
beTypeVarListElem
(
beTypeVar
typeVar
.
atv_variable
.
tv_ident
.
id_name
)
(
convertAttribution
typeVar
.
atv_attribute
)
defineType
::
ModuleIndex
{#
ConsDef
}
{#
SelectorDef
}
Index
CheckedTypeDef
!*
TypeVarHeap
*
BackEndState
->
(!*
TypeVarHeap
,!*
BackEndState
)
defineType
::
ModuleIndex
{#
ConsDef
}
{#
SelectorDef
}
Index
CheckedTypeDef
!*
TypeVarHeap
!
*
BackEndState
->
(!*
TypeVarHeap
,!*
BackEndState
)
defineType
moduleIndex
constructors
_
typeIndex
{
td_ident
,
td_attribute
,
td_args
,
td_rhs
=
AlgType
constructorSymbols
}
type_var_heap
be
#
(
flatType
,
be
)
=
convertTypeLhs
moduleIndex
typeIndex
td_attribute
td_args
be
#
(
flatType
,
type_var_heap
,
be
)
=
convertTypeLhs
moduleIndex
typeIndex
td_attribute
td_args
type_var_heap
be
(
constructors
,
be
)
=
convertConstructors
typeIndex
td_ident
.
id_name
moduleIndex
constructors
constructorSymbols
be
be
=
appBackEnd
(
BEAlgebraicType
flatType
constructors
)
be
=
(
type_var_heap
,
be
)
defineType
moduleIndex
constructors
selectors
typeIndex
{
td_attribute
,
td_args
,
td_rhs
=
RecordType
{
rt_constructor
,
rt_fields
,
rt_is_boxed_record
},
td_fun_index
}
type_var_heap
be
#
constructorIndex
=
rt_constructor
.
ds_index
constructorDef
=
constructors
.[
constructorIndex
]
#
(
flatType
,
be
)
(
flatType
,
type_var_heap
,
be
)
=
if
(
td_fun_index
<>
NoIndex
)
(
convertTypeLhs
moduleIndex
typeIndex
td_attribute
td_args
be
)
(
convertTypeLhs
moduleIndex
typeIndex
td_attribute
td_args
type_var_heap
be
)
// define the record without marking, to prevent code generation for many unused generic dictionaries
(
be_f
lat
_t
ype
(
beTypeSymbolNoMark
typeIndex
moduleIndex
)
td_attribute
td_args
be
)
(
convertTypeDefToF
lat
T
ype
(
beTypeSymbolNoMark
typeIndex
moduleIndex
)
td_attribute
td_args
type_var_heap
be
)
(
fields
,
be
)
=
convertSelectors
moduleIndex
selectors
rt_fields
constructorDef
.
cons_type
.
st_args_strictness
be
(
constructorType
,
be
)
...
...
@@ -853,29 +857,31 @@ defineType moduleIndex constructors selectors typeIndex {td_attribute, td_args,
(
beConstructorSymbol
moduleIndex
constructorIndex
)
(
convertSymbolTypeArgs
constructorType
)
be
#
be
=
appBackEnd
(
BERecordType
moduleIndex
flatType
constructorTypeNode
(
if
rt_is_boxed_record
1
0
)
fields
)
be
be
=
appBackEnd
(
BERecordType
moduleIndex
flatType
constructorTypeNode
(
if
rt_is_boxed_record
1
0
)
fields
)
be
=
(
type_var_heap
,
be
)
where
constructorTypeFunction
constructorDef
be
0
=
let
(
cons_type
,
be
)
=
read_from_var_heap
constructorDef
.
cons_type_ptr
be
0
in
(
case
cons_type
of
VI_ExpandedType
expandedType
->
(
expandedType
,
be
)
_
->
(
constructorDef
.
cons_type
,
be
)
)
constructorTypeFunction
constructorDef
be
s
#
(
cons_type
,
be
s
)
=
read_from_var_heap
constructorDef
.
cons_type_ptr
be
s
=
case
cons_type
of
VI_ExpandedType
expandedType
->
(
expandedType
,
be
s
)
_
->
(
constructorDef
.
cons_type
,
be
s
)
defineType
moduleIndex
_
_
typeIndex
{
td_attribute
,
td_args
,
td_rhs
=
AbstractType
_}
type_var_heap
be
#
be
=
beAbsType
(
convertTypeLhs
moduleIndex
typeIndex
td_attribute
td_args
)
be
#
(
flatType
,
type_var_heap
,
be
)
=
convertTypeLhs
moduleIndex
typeIndex
td_attribute
td_args
type_var_heap
be
be
=
appBackEnd
(
BEAbsType
flatType
)
be
=
(
type_var_heap
,
be
)
defineType
moduleIndex
_
_
typeIndex
{
td_attribute
,
td_args
,
td_rhs
=
AbstractSynType
_
_}
type_var_heap
be
#
be
=
beAbsType
(
convertTypeLhs
moduleIndex
typeIndex
td_attribute
td_args
)
be
#
(
flatType
,
type_var_heap
,
be
)
=
convertTypeLhs
moduleIndex
typeIndex
td_attribute
td_args
type_var_heap
be
be
=
appBackEnd
(
BEAbsType
flatType
)
be
=
(
type_var_heap
,
be
)
defineType
moduleIndex
constructors
_
typeIndex
{
td_ident
,
td_attribute
,
td_args
,
td_rhs
=
ExtensibleAlgType
constructorSymbols
}
type_var_heap
be
#
(
flatType
,
be
)
=
convertTypeLhs
moduleIndex
typeIndex
td_attribute
td_args
be
#
(
flatType
,
type_var_heap
,
be
)
=
convertTypeLhs
moduleIndex
typeIndex
td_attribute
td_args
type_var_heap
be
(
constructors
,
be
)
=
convertConstructors
typeIndex
td_ident
.
id_name
moduleIndex
constructors
constructorSymbols
be
be
=
appBackEnd
(
BEExtendableAlgebraicType
flatType
constructors
)
be
=
(
type_var_heap
,
be
)
defineType
moduleIndex
constructors
_
typeIndex
{
td_ident
,
td_attribute
,
td_args
,
td_rhs
=
AlgConses
constructorSymbols
_}
type_var_heap
be
#
(
flatType
,
be
)
=
convertTypeLhs
moduleIndex
typeIndex
td_attribute
td_args
be
#
(
flatType
,
type_var_heap
,
be
)
=
convertTypeLhs
moduleIndex
typeIndex
td_attribute
td_args
type_var_heap
be
(
constructors
,
be
)
=
convertConstructors
typeIndex
td_ident
.
id_name
moduleIndex
constructors
constructorSymbols
be
be
=
appBackEnd
(
BEExtendableAlgebraicType
flatType
constructors
)
be
=
(
type_var_heap
,
be
)
...
...
Write
Preview
Supports
Markdown
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