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
9b42d384
Commit
9b42d384
authored
Apr 30, 2018
by
John van Groningen
Browse files
use BENumberedTypeVar and BENumberedVarTypeNode for types in type definitions
parent
183d1167
Changes
2
Hide whitespace changes
Inline
Side-by-side
backend/backendconvert.icl
View file @
9b42d384
...
...
@@ -477,7 +477,6 @@ where
||
moduleIndex
==
cPredefinedModuleIndex
||
not
(
inNumberSet
moduleIndex
used_module_numbers
)
=
identity
// otherwise
=
declareDclModule
moduleIndex
dclModule
defineOtherDclModules
::
{#
DclModule
}
Int
NumberSet
!*
TypeVarHeap
!*
BackEndState
->
(!*
TypeVarHeap
,!*
BackEndState
)
...
...
@@ -792,7 +791,7 @@ convertTypeDefToFlatType :: (BEMonad BESymbolP) TypeAttribute [ATypeVar] !*TypeV
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
(
a3
,
type_var_heap
,
bes
)
=
convert
AndNumberLhs
TypeVars
args
0
type_var_heap
bes
(
flat_type_p
,
bes
)
=
accBackEnd
(
BEFlatType
a1
a2
a3
)
bes
=
(
flat_type_p
,
type_var_heap
,
bes
)
...
...
@@ -800,6 +799,28 @@ convertTypeVars :: [ATypeVar] -> BEMonad BETypeVarListP
convertTypeVars
typeVars
=
sfoldr
(
beTypeVars
o
convertTypeVar
)
beNoTypeVars
typeVars
convertAndNumberLhsTypeVars
::
[
ATypeVar
]
Int
!*
TypeVarHeap
!*
BackEndState
->
(!
BETypeVarListP
,!*
TypeVarHeap
,!*
BackEndState
)
convertAndNumberLhsTypeVars
[
a
=:{
atv_variable
={
tv_info_ptr
}}:
x
]
arg_n
type_var_heap
beState
#
type_var_heap
=
writePtr
tv_info_ptr
(
TVI_TypeVarArgN
arg_n
)
type_var_heap
(
a1
,
beState
)
=
convertNumberedTypeVar
a
arg_n
beState
(
a2
,
type_var_heap
,
beState
)
=
convertAndNumberLhsTypeVars
x
(
arg_n
+1
)
type_var_heap
beState
(
type_vars
,
beState
)
=
accBackEnd
(
BETypeVars
a1
a2
)
beState
=
(
type_vars
,
type_var_heap
,
beState
)
convertAndNumberLhsTypeVars
[]
arg_n
type_var_heap
beState
#
(
type_vars
,
beState
)
=
accBackEnd
BENoTypeVars
beState
=
(
type_vars
,
type_var_heap
,
beState
)
remove_TVI_TypeVarArgN_in_args
::
[
ATypeVar
]
!*
TypeVarHeap
->
*
TypeVarHeap
remove_TVI_TypeVarArgN_in_args
[{
atv_variable
={
tv_info_ptr
}}:
args
]
type_var_heap
#
type_var_heap
=
writePtr
tv_info_ptr
TVI_Empty
type_var_heap
=
remove_TVI_TypeVarArgN_in_args
args
type_var_heap
remove_TVI_TypeVarArgN_in_args
[]
type_var_heap
=
type_var_heap
convertNumberedTypeVar
::
ATypeVar
Int
->
BEMonad
BETypeVarListP
convertNumberedTypeVar
typeVar
arg_n
=
beTypeVarListElem
(
accBackEnd
(
BENumberedTypeVar
typeVar
.
atv_variable
.
tv_ident
.
id_name
arg_n
))
(
convertAttribution
typeVar
.
atv_attribute
)
convertTypeVar
::
ATypeVar
->
BEMonad
BETypeVarListP
convertTypeVar
typeVar
=
beTypeVarListElem
(
beTypeVar
typeVar
.
atv_variable
.
tv_ident
.
id_name
)
(
convertAttribution
typeVar
.
atv_attribute
)
...
...
@@ -810,6 +831,7 @@ defineType moduleIndex constructors _ typeIndex {td_ident, td_attribute, td_args
(
constructors
,
type_var_heap
,
be
)
=
convertConstructors
typeIndex
td_ident
.
id_name
moduleIndex
constructors
constructorSymbols
type_var_heap
be
be
=
appBackEnd
(
BEAlgebraicType
flatType
constructors
)
be
type_var_heap
=
remove_TVI_TypeVarArgN_in_args
td_args
type_var_heap
=
(
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
...
...
@@ -826,6 +848,7 @@ defineType moduleIndex constructors selectors typeIndex {td_attribute, td_args,
(
symbol_p
,
be
)
=
beConstructorSymbol
moduleIndex
constructorIndex
be
(
constructorTypeNode
,
be
)
=
accBackEnd
(
BENormalTypeNode
symbol_p
type_arg_p
)
be
be
=
appBackEnd
(
BERecordType
moduleIndex
flatType
constructorTypeNode
(
if
rt_is_boxed_record
1
0
)
fields
)
be
type_var_heap
=
remove_TVI_TypeVarArgN_in_args
td_args
type_var_heap
=
(
type_var_heap
,
be
)
where
constructorTypeFunction
constructorDef
bes
...
...
@@ -838,22 +861,26 @@ defineType moduleIndex constructors selectors typeIndex {td_attribute, td_args,
defineType
moduleIndex
_
_
typeIndex
{
td_attribute
,
td_args
,
td_rhs
=
AbstractType
_}
type_var_heap
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
=
remove_TVI_TypeVarArgN_in_args
td_args
type_var_heap
=
(
type_var_heap
,
be
)
defineType
moduleIndex
_
_
typeIndex
{
td_attribute
,
td_args
,
td_rhs
=
AbstractSynType
_
_}
type_var_heap
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
=
remove_TVI_TypeVarArgN_in_args
td_args
type_var_heap
=
(
type_var_heap
,
be
)
defineType
moduleIndex
constructors
_
typeIndex
{
td_ident
,
td_attribute
,
td_args
,
td_rhs
=
ExtensibleAlgType
constructorSymbols
}
type_var_heap
be
#
(
flatType
,
type_var_heap
,
be
)
=
convertTypeLhs
moduleIndex
typeIndex
td_attribute
td_args
type_var_heap
be
(
constructors
,
type_var_heap
,
be
)
=
convertConstructors
typeIndex
td_ident
.
id_name
moduleIndex
constructors
constructorSymbols
type_var_heap
be
be
=
appBackEnd
(
BEExtendableAlgebraicType
flatType
constructors
)
be
type_var_heap
=
remove_TVI_TypeVarArgN_in_args
td_args
type_var_heap
=
(
type_var_heap
,
be
)
defineType
moduleIndex
constructors
_
typeIndex
{
td_ident
,
td_attribute
,
td_args
,
td_rhs
=
AlgConses
constructorSymbols
_}
type_var_heap
be
#
(
flatType
,
type_var_heap
,
be
)
=
convertTypeLhs
moduleIndex
typeIndex
td_attribute
td_args
type_var_heap
be
(
constructors
,
type_var_heap
,
be
)
=
convertConstructors
typeIndex
td_ident
.
id_name
moduleIndex
constructors
constructorSymbols
type_var_heap
be
be
=
appBackEnd
(
BEExtendableAlgebraicType
flatType
constructors
)
be
type_var_heap
=
remove_TVI_TypeVarArgN_in_args
td_args
type_var_heap
=
(
type_var_heap
,
be
)
defineType
_
_
_
_
_
type_var_heap
be
=
(
type_var_heap
,
be
)
...
...
@@ -1495,17 +1522,23 @@ convertTypeDefTypeNode (TAS typeSymbolIdent typeArgs strictness) type_var_heap b
(
type_arg_p
,
type_var_heap
,
bes
)
=
convertTypeDefAnnotatedTypeArgs
typeArgs
strictness
type_var_heap
bes
(
type_node_p
,
bes
)
=
accBackEnd
(
BENormalTypeNode
symbol_p
type_arg_p
)
bes
=
(
type_node_p
,
type_var_heap
,
bes
)
convertTypeDefTypeNode
(
TV
{
tv_ident
})
type_var_heap
bes
#
(
type_node_p
,
bes
)
=
beVarTypeNode
tv_ident
.
id_name
bes
convertTypeDefTypeNode
(
TV
{
tv_ident
,
tv_info_ptr
})
type_var_heap
bes
#!
argument_n
=
case
sreadPtr
tv_info_ptr
type_var_heap
of
TVI_TypeVarArgN
type_var_arg_n
->
type_var_arg_n
_
->
-1
#
(
type_node_p
,
bes
)
=
accBackEnd
(
BENumberedVarTypeNode
tv_ident
.
id_name
argument_n
)
bes
=
(
type_node_p
,
type_var_heap
,
bes
)
convertTypeDefTypeNode
(
TempV
n
)
type_var_heap
bes
#
(
type_node_p
,
bes
)
=
be
VarTypeNode
(
"_tv"
+++
toString
n
)
bes
#
(
type_node_p
,
bes
)
=
accBackEnd
(
BENumbered
VarTypeNode
(
"_tv"
+++
toString
n
)
-1
)
bes
=
(
type_node_p
,
type_var_heap
,
bes
)
convertTypeDefTypeNode
(
TempQV
n
)
type_var_heap
bes
#
(
type_node_p
,
bes
)
=
be
VarTypeNode
(
"_tqv"
+++
toString
n
)
bes
#
(
type_node_p
,
bes
)
=
accBackEnd
(
BENumbered
VarTypeNode
(
"_tqv"
+++
toString
n
)
-1
)
bes
=
(
type_node_p
,
type_var_heap
,
bes
)
convertTypeDefTypeNode
(
TempQDV
n
)
type_var_heap
bes
#
(
type_node_p
,
bes
)
=
be
VarTypeNode
(
"_tqv"
+++
toString
n
)
bes
#
(
type_node_p
,
bes
)
=
accBackEnd
(
BENumbered
VarTypeNode
(
"_tqv"
+++
toString
n
)
-1
)
bes
=
(
type_node_p
,
type_var_heap
,
bes
)
convertTypeDefTypeNode
(
a
-->
b
)
type_var_heap
bes
#
(
symbol_p
,
bes
)
=
accBackEnd
(
BEBasicSymbol
BEFunType
)
bes
...
...
frontend/syntax.dcl
View file @
9b42d384
...
...
@@ -792,6 +792,7 @@ pIsSafe :== True
VI_Used
|
/* for indicating that an imported function has been used */
VI_PropagationType
!
SymbolType
|
/* for storing the type with propagation environment of an imported function */
VI_ExpandedType
!
SymbolType
|
/* for storing the (expanded) type of an imported function */
VI_ExpandedMemberType
!
SymbolType
!
VarInfo
/* VI_Empty or VI_ExpandedType */
|
// only in sd_type_ptr
VI_Record
![
AuxiliaryPattern
]
|
VI_Pattern
!
AuxiliaryPattern
|
VI_TypeCodeVariable
!
TypeCodeVariableInfo
|
...
...
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