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
872f12c1
Commit
872f12c1
authored
Mar 25, 2002
by
Artem Alimarine
Browse files
new implementation of generics
parent
681324e3
Changes
39
Expand all
Hide whitespace changes
Inline
Side-by-side
frontend/StdCompare.dcl
View file @
872f12c1
...
...
@@ -15,7 +15,7 @@ instance =< Type, SymbIdent
instance
==
BasicType
,
TypeVar
,
AttributeVar
,
AttrInequality
,
TypeSymbIdent
,
DefinedSymbol
,
TypeContext
,
BasicValue
,
FunKind
,
(
Global
a
)
|
==
a
,
Priority
,
Assoc
,
Type
,
ConsVariable
,
SignClassification
ConsVariable
,
SignClassification
,
TypeCons
instance
<
MemberDef
...
...
frontend/StdCompare.icl
View file @
872f12c1
...
...
@@ -117,6 +117,11 @@ where
instance
==
SignClassification
where
(==)
sc1
sc2
=
sc1
.
sc_pos_vect
==
sc2
.
sc_pos_vect
&&
sc1
.
sc_neg_vect
==
sc2
.
sc_neg_vect
instance
==
TypeCons
where
(==)
(
TypeConsSymb
x
)
(
TypeConsSymb
y
)
=
x
==
y
(==)
(
TypeConsBasic
x
)
(
TypeConsBasic
y
)
=
x
==
y
(==)
TypeConsArrow
TypeConsArrow
=
True
::
CompareValue
:==
Int
Smaller
:==
-1
Greater
:==
1
...
...
frontend/analtypes.dcl
View file @
872f12c1
...
...
@@ -13,7 +13,7 @@ determineKindsOfClasses :: !NumberSet !{#CommonDefs} !*TypeDefInfos !*TypeVarHea
->
(!*
ClassDefInfos
,
!*
TypeDefInfos
,
!*
TypeVarHeap
,
!*
ErrorAdmin
)
checkKindsOfCommonDefsAndFunctions
::
!
Index
!
Index
!
NumberSet
![
IndexRange
]
!{#
CommonDefs
}
!
u
:{#
FunDef
}
!
v
:{#
DclModule
}
!*
TypeDefInfos
!*
ClassDefInfos
!*
TypeVarHeap
!*
ErrorAdmin
->
(!
u
:{#
FunDef
},
!
v
:{#
DclModule
},
!*
TypeDefInfos
,
!*
TypeVarHeap
,
!*
ErrorAdmin
)
!*
TypeVarHeap
!*
GenericHeap
!*
ErrorAdmin
->
(!
u
:{#
FunDef
},
!
v
:{#
DclModule
},
!*
TypeDefInfos
,
!*
TypeVarHeap
,
!*
GenericHeap
,
!*
ErrorAdmin
)
isATopConsVar
cv
:==
cv
<
0
encodeTopConsVar
cv
:==
dec
(~
cv
)
...
...
frontend/analtypes.icl
View file @
872f12c1
...
...
@@ -831,9 +831,9 @@ where
=
(
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
!*
TypeVarHeap
!*
ErrorAdmin
->
(!
u
:{#
FunDef
},
!
v
:{#
DclModule
},
!*
TypeDefInfos
,
!*
TypeVarHeap
,
!*
ErrorAdmin
)
!*
TypeVarHeap
!*
GenericHeap
!*
ErrorAdmin
->
(!
u
:{#
FunDef
},
!
v
:{#
DclModule
},
!*
TypeDefInfos
,
!*
TypeVarHeap
,
!*
GenericHeap
,
!*
ErrorAdmin
)
checkKindsOfCommonDefsAndFunctions
first_uncached_module
main_module_index
used_module_numbers
icl_fun_def_ranges
common_defs
icl_fun_defs
dcl_modules
type_def_infos
class_infos
type_var_heap
error
type_def_infos
class_infos
type_var_heap
gen_heap
error
#
as
=
{
as_td_infos
=
type_def_infos
,
as_type_var_heap
=
type_var_heap
...
...
@@ -841,27 +841,29 @@ checkKindsOfCommonDefsAndFunctions first_uncached_module main_module_index used_
,
as_error
=
error
}
#
(
icl_fun_defs
,
dcl_modules
,
class_infos
,
as
)
#
(
icl_fun_defs
,
dcl_modules
,
class_infos
,
gen_heap
,
as
)
=
iFoldSt
(
check_kinds_of_module
first_uncached_module
main_module_index
used_module_numbers
icl_fun_def_ranges
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
)
0
(
size
common_defs
)
(
icl_fun_defs
,
dcl_modules
,
class_infos
,
gen_heap
,
as
)
=
(
icl_fun_defs
,
dcl_modules
,
as
.
as_td_infos
,
as
.
as_type_var_heap
,
gen_heap
,
as
.
as_error
)
where
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
)
(
icl_fun_defs
,
dcl_modules
,
class_infos
,
gen_heap
,
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
#
(
class_infos
,
gen_heap
,
as
)
=
check_kinds_of_generics
common_defs
0
common_defs
.[
module_index
].
com_generic_defs
class_infos
gen_heap
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
)
=
(
icl_fun_defs
,
dcl_modules
,
class_infos
,
gen_heap
,
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
#
(
class_infos
,
gen_heap
,
as
)
=
check_kinds_of_generics
common_defs
0
common_defs
.[
module_index
].
com_generic_defs
class_infos
gen_heap
as
#
(
dcl_modules
,
class_infos
,
as
)
=
check_kinds_of_dcl_fuctions
common_defs
module_index
dcl_modules
class_infos
as
=
(
icl_fun_defs
,
dcl_modules
,
class_infos
,
as
)
=
(
icl_fun_defs
,
dcl_modules
,
class_infos
,
as
)
=
(
icl_fun_defs
,
dcl_modules
,
class_infos
,
as
)
=
(
icl_fun_defs
,
dcl_modules
,
class_infos
,
gen_heap
,
as
)
=
(
icl_fun_defs
,
dcl_modules
,
class_infos
,
gen_heap
,
as
)
=
(
icl_fun_defs
,
dcl_modules
,
class_infos
,
gen_heap
,
as
)
check_kinds_of_class_instances
common_defs
instance_index
instance_defs
class_infos
as
|
instance_index
==
size
instance_defs
...
...
@@ -870,9 +872,9 @@ where
=
check_kinds_of_class_instances
common_defs
(
inc
instance_index
)
instance_defs
class_infos
as
where
check_kinds_of_class_instance
::
!{#
CommonDefs
}
!
ClassInstance
!*
ClassDefInfos
!*
AnalyseState
->
(!*
ClassDefInfos
,
!*
AnalyseState
)
check_kinds_of_class_instance
common_defs
{
ins_
is_
gener
ic
,
ins_class
,
ins_ident
,
ins_pos
,
ins_type
={
it_vars
,
it_types
,
it_context
}}
class_infos
check_kinds_of_class_instance
common_defs
{
ins_gener
ated
,
ins_class
,
ins_ident
,
ins_pos
,
ins_type
={
it_vars
,
it_types
,
it_context
}}
class_infos
as
=:{
as_type_var_heap
,
as_kind_heap
,
as_error
}
|
ins_
is_
gener
ic
|
ins_gener
ated
// generic instances are cheched in the generic phase
=
(
class_infos
,
as
)
#
as_error
=
pushErrorAdmin
(
newPosition
ins_ident
ins_pos
)
as_error
...
...
@@ -882,6 +884,40 @@ where
[{
tc_class
=
ins_class
,
tc_types
=
it_types
,
tc_var
=
nilPtr
}
:
it_context
]
class_infos
as
=
(
class_infos
,
{
as
&
as_error
=
popErrorAdmin
as
.
as_error
})
check_kinds_of_generics
common_defs
index
generic_defs
class_infos
gen_heap
as
|
index
==
size
generic_defs
=
(
class_infos
,
gen_heap
,
as
)
#
(
class_infos
,
gen_heap
,
as
)
=
check_kinds_of_generic
common_defs
generic_defs
.[
index
]
class_infos
gen_heap
as
=
check_kinds_of_generics
common_defs
(
inc
index
)
generic_defs
class_infos
gen_heap
as
where
check_kinds_of_generic
::
!{#
CommonDefs
}
!
GenericDef
!*
ClassDefInfos
!*
GenericHeap
!*
AnalyseState
->
(!*
ClassDefInfos
,
!*
GenericHeap
,
!*
AnalyseState
)
check_kinds_of_generic
common_defs
{
gen_type
,
gen_name
,
gen_pos
,
gen_vars
,
gen_info_ptr
}
class_infos
gen_heap
as
#
as
=
{
as
&
as_error
=
pushErrorAdmin
(
newPosition
gen_name
gen_pos
)
as
.
as_error
}
#
(
class_infos
,
as
)
=
check_kinds_of_symbol_type
common_defs
gen_type
class_infos
as
#
(
kinds
,
as
)
=
mapSt
retrieve_tv_kind
gen_type
.
st_vars
as
#
as
=
check_kinds_of_generic_vars
(
take
(
length
gen_vars
)
kinds
)
as
#
(
gen_info
,
gen_heap
)
=
readPtr
gen_info_ptr
gen_heap
#
gen_heap
=
writePtr
gen_info_ptr
{
gen_info
&
gen_var_kinds
=
kinds
}
gen_heap
#
as
=
{
as
&
as_error
=
popErrorAdmin
as
.
as_error
}
=
(
class_infos
,
gen_heap
,
as
)
retrieve_tv_kind
::
!
TypeVar
!*
AnalyseState
->
(!
TypeKind
,
!*
AnalyseState
)
retrieve_tv_kind
tv
=:{
tv_info_ptr
}
as
=:{
as_type_var_heap
,
as_kind_heap
}
#!
(
TVI_TypeKind
kind_info_ptr
,
as_type_var_heap
)
=
readPtr
tv_info_ptr
as_type_var_heap
#!
(
kind_info
,
as_kind_heap
)
=
readPtr
kind_info_ptr
as_kind_heap
#!
(
kind
,
as_kind_heap
)
=
kindInfoToKind
kind_info
as_kind_heap
=
(
kind
,
{
as
&
as_kind_heap
=
as_kind_heap
,
as_type_var_heap
=
as_type_var_heap
})
check_kinds_of_generic_vars
::
![
TypeKind
]
!*
AnalyseState
->
!*
AnalyseState
check_kinds_of_generic_vars
[
gen_kind
:
gen_kinds
]
as
|
all
(\
k
->
k
==
gen_kind
)
gen_kinds
=
as
#
as_error
=
checkError
"conflicting kinds: "
"generic variables must have the same kind"
as
.
as_error
=
{
as
&
as_error
=
as_error
}
check_kinds_of_icl_fuction
common_defs
fun_index
(
icl_fun_defs
,
class_infos
,
as
)
#
({
fun_type
,
fun_symb
,
fun_pos
},
icl_fun_defs
)
=
icl_fun_defs
![
fun_index
]
=
case
fun_type
of
...
...
@@ -904,7 +940,7 @@ where
(
class_infos
,
as
)
=
check_kinds_of_symbol_type
common_defs
ft_type
class_infos
{
as
&
as_error
=
as_error
}
=
(
class_infos
,
{
as
&
as_error
=
popErrorAdmin
as
.
as_error
})
check_kinds_of_symbol_type
::
!{#
CommonDefs
}
!
SymbolType
!*
ClassDefInfos
!*
AnalyseState
->
(!*
ClassDefInfos
,
!*
AnalyseState
)
check_kinds_of_symbol_type
common_defs
{
st_vars
,
st_result
,
st_args
,
st_context
}
class_infos
as
=:{
as_type_var_heap
,
as_kind_heap
}
#
(
as_type_var_heap
,
as_kind_heap
)
=
bindFreshKindVariablesToTypeVars
st_vars
as_type_var_heap
as_kind_heap
...
...
frontend/check.icl
View file @
872f12c1
This diff is collapsed.
Click to expand it.
frontend/checkFunctionBodies.dcl
View file @
872f12c1
...
...
@@ -6,11 +6,12 @@ import syntax, checksupport
::
ExpressionState
=
{
es_expr_heap
::
!.
ExpressionHeap
,
es_var_heap
::
!.
VarHeap
,
es_type_heaps
::
!.
TypeHeaps
,
es_calls
::
![
FunCall
]
,
es_dynamics
::
!
Dynamics
,
es_fun_defs
::
!.{#
FunDef
}
,
es_var_heap
::
!.
VarHeap
,
es_type_heaps
::
!.
TypeHeaps
,
es_generic_heap
::
!.
GenericHeap
,
es_calls
::
![
FunCall
]
,
es_dynamics
::
![
ExprInfoPtr
]
,
es_fun_defs
::
!.{#
FunDef
}
}
::
ExpressionInput
=
...
...
frontend/checkFunctionBodies.icl
View file @
872f12c1
...
...
@@ -14,11 +14,12 @@ cEndWithSelection :== False
::
ExpressionState
=
{
es_expr_heap
::
!.
ExpressionHeap
,
es_var_heap
::
!.
VarHeap
,
es_type_heaps
::
!.
TypeHeaps
,
es_calls
::
![
FunCall
]
,
es_dynamics
::
!
Dynamics
,
es_fun_defs
::
!.{#
FunDef
}
,
es_var_heap
::
!.
VarHeap
,
es_type_heaps
::
!.
TypeHeaps
,
es_generic_heap
::
!.
GenericHeap
,
es_calls
::
![
FunCall
]
,
es_dynamics
::
![
ExprInfoPtr
]
,
es_fun_defs
::
!.{#
FunDef
}
}
::
ExpressionInput
=
...
...
@@ -308,8 +309,11 @@ where
#
(
var_expr_ptr
,
expr_heap
)
=
newPtr
EI_Empty
expr_heap
=
(
Var
{
var_name
=
fv_name
,
var_info_ptr
=
fv_info_ptr
,
var_expr_ptr
=
var_expr_ptr
},
result_expr
,
expr_heap
)
checkFunctionBodies
GeneratedBody
function_ident_for_errors
e_input
e_state
e_info
cs
=
(
GeneratedBody
,
[],
e_state
,
e_info
,
cs
)
//---> ("checkFunctionBodies: function to derive ", function_ident_for_errors)
checkFunctionBodies
_
function_ident_for_errors
e_input
=:{
ei_expr_level
,
ei_mod_index
}
e_state
=:{
es_var_heap
,
es_fun_defs
}
e_info
cs
=
abort
(
"checkFunctionBodies "
+++
toString
function_ident_for_errors
)
=
abort
(
"checkFunctionBodies "
+++
toString
function_ident_for_errors
+++
"
\n
"
)
removeLocalsFromSymbolTable
::
!
Index
!
Level
![
Ident
]
!
LocalDefs
!
Int
!*{#
FunDef
}
!*{#*{#
FunDef
}}
!*(
Heap
SymbolTableEntry
)
...
...
@@ -329,11 +333,11 @@ checkRhs free_vars rhs_alts rhs_locals e_input=:{ei_expr_level,ei_mod_index,ei_l
(
loc_defs
,
(
var_env
,
array_patterns
),
e_state
,
e_info
,
cs
)
=
checkLhssOfLocalDefs
ei_expr_level
ei_mod_index
rhs_locals
ei_local_functions_index_offset
e_state
e_info
cs
(
es_fun_defs
,
e_info
,
heaps
,
cs
)
=
checkLocalFunctions
ei_mod_index
ei_expr_level
rhs_locals
ei_local_functions_index_offset
e_state
.
es_fun_defs
e_info
{
hp_var_heap
=
e_state
.
es_var_heap
,
hp_expression_heap
=
e_state
.
es_expr_heap
,
hp_type_heaps
=
e_state
.
es_type_heaps
}
cs
{
hp_var_heap
=
e_state
.
es_var_heap
,
hp_expression_heap
=
e_state
.
es_expr_heap
,
hp_type_heaps
=
e_state
.
es_type_heaps
,
hp_generic_heap
=
e_state
.
es_generic_heap
}
cs
(
rhs_expr
,
free_vars
,
e_state
,
e_info
,
cs
)
=
check_opt_guarded_alts
free_vars
rhs_alts
{
e_input
&
ei_expr_level
=
ei_expr_level
}
{
e_state
&
es_fun_defs
=
es_fun_defs
,
es_var_heap
=
heaps
.
hp_var_heap
,
es_expr_heap
=
heaps
.
hp_expression_heap
,
es_type_heaps
=
heaps
.
hp_type_heaps
}
e_info
cs
es_type_heaps
=
heaps
.
hp_type_heaps
,
es_generic_heap
=
heaps
.
hp_generic_heap
}
e_info
cs
(
expr
,
free_vars
,
e_state
,
e_info
,
cs
)
=
addArraySelections
array_patterns
rhs_expr
free_vars
e_input
e_state
e_info
cs
(
expr
,
free_vars
,
e_state
,
e_info
,
cs
)
=
checkRhssAndTransformLocalDefs
free_vars
loc_defs
expr
e_input
e_state
e_info
cs
...
...
@@ -414,10 +418,11 @@ where
=
checkRhssAndTransformLocalDefs
free_vars
loc_defs
seq_let_expr
e_input
{
e_state
&
es_expr_heap
=
es_expr_heap
}
e_info
cs
(
es_fun_defs
,
e_info
,
heaps
,
cs
)
=
checkLocalFunctions
ei_mod_index
rhs_expr_level
ewl_locals
ei_local_functions_index_offset
e_state
.
es_fun_defs
e_info
{
hp_var_heap
=
e_state
.
es_var_heap
,
hp_expression_heap
=
e_state
.
es_expr_heap
,
hp_type_heaps
=
e_state
.
es_type_heaps
}
cs
{
hp_var_heap
=
e_state
.
es_var_heap
,
hp_expression_heap
=
e_state
.
es_expr_heap
,
hp_type_heaps
=
e_state
.
es_type_heaps
,
hp_generic_heap
=
e_state
.
es_generic_heap
}
cs
(
es_fun_defs
,
macro_defs
,
cs_symbol_table
)
=
removeLocalsFromSymbolTable
ei_mod_index
this_expr_level
var_env
ewl_locals
ei_local_functions_index_offset
es_fun_defs
e_info
.
ef_macro_defs
cs
.
cs_symbol_table
=
(
expr
,
free_vars
,
{
e_state
&
es_fun_defs
=
es_fun_defs
,
es_var_heap
=
heaps
.
hp_var_heap
,
es_expr_heap
=
heaps
.
hp_expression_heap
,
es_type_heaps
=
heaps
.
hp_type_heaps
},
{
e_info
&
ef_macro_defs
=
macro_defs
},
{
cs
&
cs_symbol_table
=
cs_symbol_table
}
)
es_expr_heap
=
heaps
.
hp_expression_heap
,
es_type_heaps
=
heaps
.
hp_type_heaps
,
es_generic_heap
=
heaps
.
hp_generic_heap
},
{
e_info
&
ef_macro_defs
=
macro_defs
},
{
cs
&
cs_symbol_table
=
cs_symbol_table
}
)
remove_seq_let_vars
level
[]
symbol_table
=
symbol_table
...
...
@@ -457,14 +462,14 @@ where
(
src_expr
,
free_vars
,
e_state
,
e_info
,
cs
)
=
addArraySelections
loc_array_patterns
src_expr
free_vars
e_input
e_state
e_info
cs
(
src_expr
,
free_vars
,
e_state
,
e_info
,
cs
)
=
checkRhssAndTransformLocalDefs
free_vars
loc_defs
src_expr
e_input
e_state
e_info
cs
(
es_fun_defs
,
e_info
,
{
hp_var_heap
,
hp_expression_heap
,
hp_type_heaps
},
cs
)
(
es_fun_defs
,
e_info
,
{
hp_var_heap
,
hp_expression_heap
,
hp_type_heaps
,
hp_generic_heap
},
cs
)
=
checkLocalFunctions
ei_mod_index
ei_expr_level
ndwl_locals
ei_local_functions_index_offset
e_state
.
es_fun_defs
e_info
{
hp_var_heap
=
e_state
.
es_var_heap
,
hp_expression_heap
=
e_state
.
es_expr_heap
,
hp_type_heaps
=
e_state
.
es_type_heaps
}
cs
{
hp_var_heap
=
e_state
.
es_var_heap
,
hp_expression_heap
=
e_state
.
es_expr_heap
,
hp_type_heaps
=
e_state
.
es_type_heaps
,
hp_generic_heap
=
e_state
.
es_generic_heap
}
cs
(
es_fun_defs
,
macro_defs
,
cs_symbol_table
)
=
removeLocalsFromSymbolTable
ei_mod_index
ei_expr_level
loc_env
ndwl_locals
ei_local_functions_index_offset
es_fun_defs
e_info
.
ef_macro_defs
cs
.
cs_symbol_table
(
pattern
,
accus
,
{
ps_fun_defs
,
ps_var_heap
},
e_info
,
cs
)
=
checkPattern
bind_dst
No
{
pi_def_level
=
ei_expr_level
,
pi_mod_index
=
ei_mod_index
,
pi_is_node_pattern
=
True
}
([],
[])
{
ps_var_heap
=
hp_var_heap
,
ps_fun_defs
=
es_fun_defs
}
{
e_info
&
ef_macro_defs
=
macro_defs
}
{
cs
&
cs_symbol_table
=
cs_symbol_table
}
e_state
=
{
e_state
&
es_var_heap
=
ps_var_heap
,
es_expr_heap
=
hp_expression_heap
,
es_type_heaps
=
hp_type_heaps
,
es_fun_defs
=
ps_fun_defs
}
e_state
=
{
e_state
&
es_var_heap
=
ps_var_heap
,
es_expr_heap
=
hp_expression_heap
,
es_type_heaps
=
hp_type_heaps
,
es_
generic_heap
=
hp_generic_heap
,
es_
fun_defs
=
ps_fun_defs
}
=
(
src_expr
,
pattern
,
accus
,
free_vars
,
e_state
,
e_info
,
popErrorAdmin
cs
)
build_sequential_lets
::
![(![
LetBind
],![
LetBind
])]
!
Expression
!
Position
!*
ExpressionHeap
->
(!
Position
,
!
Expression
,
!*
ExpressionHeap
)
...
...
@@ -606,11 +611,12 @@ checkExpression free_vars (PE_Let strict let_locals expr) e_input=:{ei_expr_leve
(
expr
,
free_vars
,
e_state
,
e_info
,
cs
)
=
checkRhssAndTransformLocalDefs
free_vars
loc_defs
expr
e_input
e_state
e_info
cs
(
es_fun_defs
,
e_info
,
heaps
,
cs
)
=
checkLocalFunctions
ei_mod_index
ei_expr_level
let_locals
ei_local_functions_index_offset
e_state
.
es_fun_defs
e_info
{
hp_var_heap
=
e_state
.
es_var_heap
,
hp_expression_heap
=
e_state
.
es_expr_heap
,
hp_type_heaps
=
e_state
.
es_type_heaps
}
cs
{
hp_var_heap
=
e_state
.
es_var_heap
,
hp_expression_heap
=
e_state
.
es_expr_heap
,
hp_type_heaps
=
e_state
.
es_type_heaps
,
hp_generic_heap
=
e_state
.
es_generic_heap
}
cs
(
es_fun_defs
,
macro_defs
,
cs_symbol_table
)
=
removeLocalsFromSymbolTable
ei_mod_index
ei_expr_level
var_env
let_locals
ei_local_functions_index_offset
es_fun_defs
e_info
.
ef_macro_defs
cs
.
cs_symbol_table
=
(
expr
,
free_vars
,
{
e_state
&
es_fun_defs
=
es_fun_defs
,
es_var_heap
=
heaps
.
hp_var_heap
,
es_expr_heap
=
heaps
.
hp_expression_heap
,
es_type_heaps
=
heaps
.
hp_type_heaps
},
{
e_info
&
ef_macro_defs
=
macro_defs
},
{
cs
&
cs_symbol_table
=
cs_symbol_table
})
es_type_heaps
=
heaps
.
hp_type_heaps
,
es_generic_heap
=
heaps
.
hp_generic_heap
},
{
e_info
&
ef_macro_defs
=
macro_defs
},
{
cs
&
cs_symbol_table
=
cs_symbol_table
})
checkExpression
free_vars
(
PE_Case
case_ident
expr
alts
)
e_input
e_state
e_info
cs
#
(
pattern_expr
,
free_vars
,
e_state
,
e_info
,
cs
)
=
checkExpression
free_vars
expr
e_input
e_state
e_info
cs
...
...
@@ -1187,13 +1193,14 @@ checkExpression free_vars (PE_Generic id=:{id_name,id_info} kind) e_input e_stat
add_kind
::
!
Index
!
TypeKind
!
u
:{#
GenericDef
}
!*
ExpressionState
->
(!
u
:{#
GenericDef
},
!*
ExpressionState
)
add_kind
generic_index
kind
generic_defs
e_state
=:{
es_type_heaps
=
es_type_heaps
=:{
th_vars
}}
#!
(
generic_def
=:{
gen_kinds_ptr
},
generic_defs
)
=
generic_defs
!
[
generic_index
]
#!
(
TVI_Kinds
kinds
,
th_vars
)
=
readPtr
gen_kinds_ptr
th_vars
#!
kinds
=
eqMerge
[
kind
]
kinds
#!
th_vars
=
writePtr
gen_kinds_ptr
(
TVI_Kinds
kinds
)
th_vars
#!
e_state
=
{
e_state
&
es_type_heaps
=
{
es_type_heaps
&
th_vars
=
th_vars
}}
=
(
generic_defs
,
e_state
)
add_kind
generic_index
kind
generic_defs
e_state
=:{
es_generic_heap
}
/*
#! ({gen_info_ptr}, generic_defs) = generic_defs ! [generic_index]
#! (gen_info, es_generic_heap) = readPtr gen_info_ptr es_generic_heap
#! gen_kinds = eqMerge [(kind,NoIndex)] gen_info.gen_kinds
#! es_generic_heap = writePtr gen_info_ptr {gen_info&gen_kinds=gen_kinds} es_generic_heap
*/
=
(
generic_defs
,
{
e_state
&
es_generic_heap
=
es_generic_heap
})
checkExpression
free_vars
expr
e_input
e_state
e_info
cs
=
abort
"checkExpression (checkFunctionBodies.icl, line 868)"
// <<- expr
...
...
frontend/checksupport.dcl
View file @
872f12c1
...
...
@@ -22,6 +22,7 @@ cNeedStdStrictLists :== 16
{
hp_var_heap
::!.
VarHeap
,
hp_expression_heap
::!.
ExpressionHeap
,
hp_type_heaps
::!.
TypeHeaps
,
hp_generic_heap
::!.
GenericHeap
}
::
ErrorAdmin
=
{
ea_file
::
!.
File
,
ea_loc
::
![
IdentPos
],
ea_ok
::
!
Bool
}
...
...
@@ -42,11 +43,12 @@ cSelectorDefs :== 2
cClassDefs
:==
3
cMemberDefs
:==
4
cGenericDefs
:==
5
cInstanceDefs
:==
6
cFunctionDefs
:==
7
cMacroDefs
:==
8
cGenericCaseDefs
:==
6
cInstanceDefs
:==
7
cFunctionDefs
:==
8
cMacroDefs
:==
9
cConversionTableSize
:==
9
cConversionTableSize
:==
10
::
CommonDefs
=
{
com_type_defs
::
!.{#
CheckedTypeDef
}
...
...
@@ -55,7 +57,8 @@ cConversionTableSize :== 9
,
com_class_defs
::
!.{#
ClassDef
}
,
com_member_defs
::
!.{#
MemberDef
}
,
com_instance_defs
::
!.{#
ClassInstance
}
,
com_generic_defs
::
!.{#
GenericDef
}
,
com_generic_defs
::
!.{#
GenericDef
}
// AA
,
com_gencase_defs
::
!.{#
GenericCaseDef
}
// AA
}
::
Declarations
=
{
...
...
@@ -81,6 +84,7 @@ cConversionTableSize :== 9
::
CopiedDefinitions
=
{
copied_type_defs
::
{#
Bool
}
,
copied_class_defs
::
{#
Bool
}
,
copied_generic_defs
::
{#
Bool
}
}
::
IclModule
=
...
...
@@ -89,6 +93,7 @@ cConversionTableSize :== 9
,
icl_global_functions
::
![
IndexRange
]
,
icl_instances
::
![
IndexRange
]
,
icl_specials
::
!
IndexRange
,
icl_gencases
::
![
IndexRange
]
,
icl_common
::
!.
CommonDefs
,
icl_import
::
!{!
Declaration
}
,
icl_imported_objects
::
![
ImportedObject
]
...
...
@@ -105,6 +110,7 @@ cConversionTableSize :== 9
,
dcl_instances
::
!
IndexRange
,
dcl_macros
::
!
IndexRange
,
dcl_specials
::
!
IndexRange
,
dcl_gencases
::
!
IndexRange
,
dcl_common
::
!
CommonDefs
,
dcl_sizes
::
!{#
Int
}
,
dcl_dictionary_info
::
!
DictionaryInfo
...
...
frontend/checksupport.icl
View file @
872f12c1
...
...
@@ -26,6 +26,7 @@ cNeedStdStrictLists :== 16
{
hp_var_heap
::!.
VarHeap
,
hp_expression_heap
::!.
ExpressionHeap
,
hp_type_heaps
::!.
TypeHeaps
,
hp_generic_heap
::!.
GenericHeap
}
::
ErrorAdmin
=
{
ea_file
::
!.
File
,
ea_loc
::
![
IdentPos
],
ea_ok
::
!
Bool
}
...
...
@@ -42,11 +43,12 @@ cSelectorDefs :== 2
cClassDefs
:==
3
cMemberDefs
:==
4
cGenericDefs
:==
5
cInstanceDefs
:==
6
cFunctionDefs
:==
7
cMacroDefs
:==
8
cGenericCaseDefs
:==
6
cInstanceDefs
:==
7
cFunctionDefs
:==
8
cMacroDefs
:==
9
cConversionTableSize
:==
9
cConversionTableSize
:==
10
instance
toInt
STE_Kind
where
...
...
@@ -55,6 +57,7 @@ where
toInt
(
STE_Field
_)
=
cSelectorDefs
toInt
STE_Class
=
cClassDefs
toInt
STE_Generic
=
cGenericDefs
toInt
STE_GenericCase
=
cGenericCaseDefs
toInt
STE_Member
=
cMemberDefs
toInt
(
STE_Instance
_)
=
cInstanceDefs
toInt
STE_DclFunction
=
cFunctionDefs
...
...
@@ -71,6 +74,7 @@ where
,
com_member_defs
::
!.{#
MemberDef
}
,
com_instance_defs
::
!.{#
ClassInstance
}
,
com_generic_defs
::
!.{#
GenericDef
}
// AA
,
com_gencase_defs
::
!.{#
GenericCaseDef
}
// AA
}
::
Declarations
=
{
...
...
@@ -96,6 +100,7 @@ where
::
CopiedDefinitions
=
{
copied_type_defs
::
{#
Bool
}
,
copied_class_defs
::
{#
Bool
}
,
copied_generic_defs
::
{#
Bool
}
}
::
IclModule
=
...
...
@@ -104,6 +109,7 @@ where
,
icl_global_functions
::
![
IndexRange
]
,
icl_instances
::
![
IndexRange
]
,
icl_specials
::
!
IndexRange
,
icl_gencases
::
![
IndexRange
]
,
icl_common
::
!.
CommonDefs
,
icl_import
::
!{!
Declaration
}
,
icl_imported_objects
::
![
ImportedObject
]
...
...
@@ -120,6 +126,7 @@ where
,
dcl_instances
::
!
IndexRange
,
dcl_macros
::
!
IndexRange
,
dcl_specials
::
!
IndexRange
,
dcl_gencases
::
!
IndexRange
,
dcl_common
::
!
CommonDefs
,
dcl_sizes
::
!{#
Int
}
,
dcl_dictionary_info
::
!
DictionaryInfo
...
...
frontend/checktypes.dcl
View file @
872f12c1
...
...
@@ -2,8 +2,8 @@ definition module checktypes
import
checksupport
,
typesupport
checkTypeDefs
::
!
Index
!(
Optional
(
CopiedDefinitions
,
Int
))
!*{#
CheckedTypeDef
}
!*{#
ConsDef
}
!*{#
SelectorDef
}
!*{#
DclModule
}
!*
VarHeap
!*
Type
Heaps
!*
CheckState
->
(!*{#
CheckedTypeDef
},
!*{#
ConsDef
},
!*{#
SelectorDef
},
!*{#
DclModule
},
!*
VarHeap
,
!*
Type
Heaps
,
!*
CheckState
)
checkTypeDefs
::
!
Index
!(
Optional
(
CopiedDefinitions
,
Int
))
!*{#
CheckedTypeDef
}
!*{#
ConsDef
}
!*{#
SelectorDef
}
!*{#
DclModule
}
!*
Heaps
!*
CheckState
->
(!*{#
CheckedTypeDef
},
!*{#
ConsDef
},
!*{#
SelectorDef
},
!*{#
DclModule
},
!*
Heaps
,
!*
CheckState
)
checkFunctionType
::
!
Index
!
SymbolType
!
Specials
!
u
:{#
CheckedTypeDef
}
!
v
:{#
ClassDef
}
!
u
:{#
DclModule
}
!*
TypeHeaps
!*
CheckState
->
(!
SymbolType
,
!
Specials
,
!
u
:{#
CheckedTypeDef
},
!
v
:{#
ClassDef
},
!
u
:{#
DclModule
},
!*
TypeHeaps
,
!*
CheckState
)
...
...
@@ -11,7 +11,12 @@ checkFunctionType :: !Index !SymbolType !Specials !u:{# CheckedTypeDef} !v:{# Cl
checkMemberType
::
!
Index
!
SymbolType
!
u
:{#
CheckedTypeDef
}
!
v
:{#
ClassDef
}
!
u
:{#
DclModule
}
!*
TypeHeaps
!*
CheckState
->
(!
SymbolType
,
!
u
:{#
CheckedTypeDef
},
!
v
:{#
ClassDef
},
!
u
:{#
DclModule
},
!*
TypeHeaps
,
!*
CheckState
)
//1.3
checkInstanceType
::
!
Index
!(
Global
DefinedSymbol
)
!
InstanceType
!
Specials
!
u
:{#
CheckedTypeDef
}
!
v
:{#
ClassDef
}
!
u
:{#
DclModule
}
!*
TypeHeaps
!*
CheckState
//3.1
/*2.0
checkInstanceType :: !Index !(Global DefinedSymbol) !InstanceType !Specials !u:{# CheckedTypeDef} !v:{# ClassDef} !u:{# DclModule} !*TypeHeaps !*CheckState
0.2*/
->
(!
InstanceType
,
!
Specials
,
!
u
:{#
CheckedTypeDef
},
!
v
:{#
ClassDef
},
!
u
:{#
DclModule
},
!*
TypeHeaps
,
!*
CheckState
)
checkSuperClasses
::
![
TypeVar
]
![
TypeContext
]
!
Index
!
u
:{#
CheckedTypeDef
}
!
v
:{#
ClassDef
}
!
u
:{#
DclModule
}
!*
TypeHeaps
!*
CheckState
...
...
frontend/checktypes.icl
View file @
872f12c1
...
...
@@ -326,15 +326,15 @@ where
CS_Checked
:==
1
CS_Checking
:==
0
checkTypeDefs
::
!
Index
!(
Optional
(
CopiedDefinitions
,
Int
))
!*{#
CheckedTypeDef
}
!*{#
ConsDef
}
!*{#
SelectorDef
}
!*{#
DclModule
}
!*
VarHeap
!*
Type
Heaps
!*
CheckState
->
(!*{#
CheckedTypeDef
},
!*{#
ConsDef
},
!*{#
SelectorDef
},
!*{#
DclModule
},
!*
VarHeap
,
!*
Type
Heaps
,
!*
CheckState
)
checkTypeDefs
module_index
opt_icl_info
type_defs
cons_defs
selector_defs
modules
var_heap
type_heaps
cs
checkTypeDefs
::
!
Index
!(
Optional
(
CopiedDefinitions
,
Int
))
!*{#
CheckedTypeDef
}
!*{#
ConsDef
}
!*{#
SelectorDef
}
!*{#
DclModule
}
!*
Heaps
!*
CheckState
->
(!*{#
CheckedTypeDef
},
!*{#
ConsDef
},
!*{#
SelectorDef
},
!*{#
DclModule
},
!*
Heaps
,
!*
CheckState
)
checkTypeDefs
module_index
opt_icl_info
type_defs
cons_defs
selector_defs
modules
heaps
=:{
hp_type_heaps
,
hp_var_heap
}
cs
#!
nr_of_types
=
size
type_defs
#
ts
=
{
ts_type_defs
=
type_defs
,
ts_cons_defs
=
cons_defs
,
ts_selector_defs
=
selector_defs
,
ts_modules
=
modules
}
ti
=
{
ti_type_heaps
=
type_heaps
,
ti_var_heap
=
var_heap
,
ti_used_types
=
[]
}
ti
=
{
ti_type_heaps
=
hp_
type_heaps
,
ti_var_heap
=
hp_
var_heap
,
ti_used_types
=
[]
}
({
ts_type_defs
,
ts_cons_defs
,
ts_selector_defs
,
ts_modules
},
{
ti_var_heap
,
ti_type_heaps
},
cs
)
=
iFoldSt
(
check_type_def
module_index
opt_icl_info
)
0
nr_of_types
(
ts
,
ti
,
cs
)
=
(
ts_type_defs
,
ts_cons_defs
,
ts_selector_defs
,
ts_modules
,
ti_var_heap
,
ti_type_heaps
,
cs
)
=
(
ts_type_defs
,
ts_cons_defs
,
ts_selector_defs
,
ts_modules
,
{
heaps
&
hp_var_heap
=
ti_var_heap
,
hp_type_heaps
=
ti_type_heaps
}
,
cs
)
where
check_type_def
module_index
opt_icl_info
type_index
(
ts
,
ti
,
cs
)
|
has_to_be_checked
module_index
opt_icl_info
type_index
...
...
@@ -371,6 +371,11 @@ determineAttributeVariable attr_var=:{av_name=attr_name=:{id_info}} oti=:{oti_he
=
({
attr_var
&
av_info_ptr
=
attr_ptr
},
oti
,
symbol_table
)
::
DemandedAttributeKind
=
DAK_Ignore
|
DAK_Unique
|
DAK_None
instance
toString
DemandedAttributeKind
where
toString
DAK_Ignore
=
"DAK_Ignore"
toString
DAK_Unique
=
"DAK_Unique"
toString
DAK_None
=
"DAK_None"
newAttribute
::
!
DemandedAttributeKind
{#
Char
}
TypeAttribute
!*
OpenTypeInfo
!*
CheckState
->
(!
TypeAttribute
,
!*
OpenTypeInfo
,
!*
CheckState
)
newAttribute
DAK_Ignore
var_name
attr
oti
cs
...
...
frontend/comparedefimp.icl
View file @
872f12c1
...
...
@@ -11,6 +11,7 @@ import syntax, checksupport, compare_constructor, utilities, StdCompare, compile
type_def_error
=
"type definition in the impl module conflicts with the def module"
class_def_error
=
"class definition in the impl module conflicts with the def module"
instance_def_error
=
"instance definition in the impl module conflicts with the def module"
generic_def_error
=
"generic definition in the impl module conflicts with the def module"
compareError
message
pos
error_admin
=
popErrorAdmin
(
checkError
""
message
(
pushErrorAdmin
pos
error_admin
))
...
...
@@ -160,6 +161,27 @@ where
// ---> ("compare_instance_defs", dcl_instance_def.ins_ident, dcl_instance_def.ins_type, icl_instance_def.ins_ident, icl_instance_def.ins_type)
compareGenericDefs
::
!{#
Int
}
!{#
Bool
}
!{#
GenericDef
}
!
u
:{#
GenericDef
}
!*
CompareState
->
(!
u
:{#
GenericDef
},
!*
CompareState
)
compareGenericDefs
dcl_sizes
copied_from_dcl
dcl_generic_defs
icl_generic_defs
comp_st
#
nr_of_dcl_generics
=
dcl_sizes
.[
cGenericDefs
]
=
iFoldSt
(
compare_generic_defs
copied_from_dcl
dcl_generic_defs
)
0
nr_of_dcl_generics
(
icl_generic_defs
,
comp_st
)
where
compare_generic_defs
::
!{#
Bool
}
!{#
GenericDef
}
!
Index
(!
u
:{#
GenericDef
},
!*
CompareState
)
->
(!
u
:{#
GenericDef
},
!*
CompareState
)
compare_generic_defs
copied_from_dcl
dcl_generic_defs
generic_index
(
icl_generic_defs
,
comp_st
)
|
not
copied_from_dcl
.[
generic_index
]
#
dcl_generic_def
=
dcl_generic_defs
.[
generic_index
]
(
icl_generic_def
,
icl_generic_defs
)
=
icl_generic_defs
![
generic_index
]
#
(
ok1
,
comp_st
)
=
compare
dcl_generic_def
.
gen_type
icl_generic_def
.
gen_type
comp_st
#
(
ok2
,
comp_st
)
=
compare
dcl_generic_def
.
gen_vars
icl_generic_def
.
gen_vars
comp_st
|
ok1
&&
ok2
=
(
icl_generic_defs
,
comp_st
)
#
comp_error
=
compareError
generic_def_error
(
newPosition
icl_generic_def
.
gen_name
icl_generic_def
.
gen_pos
)
comp_st
.
comp_error
=
(
icl_generic_defs
,
{
comp_st
&
comp_error
=
comp_error
})
|
otherwise
=
(
icl_generic_defs
,
comp_st
)
class
compare
a
::
!
a
!
a
!*
CompareState
->
(!
Bool
,
!*
CompareState
)
...
...
@@ -384,13 +406,14 @@ compareDefImp main_dcl_module_n main_dcl_module=:{dcl_macro_conversions=Yes macr
// && Trace_array macro_defs.[main_dcl_module_n]
#
{
dcl_functions
,
dcl_macros
,
dcl_common
}
=
main_dcl_module
{
icl_common
,
icl_functions
,
icl_copied_from_dcl
=
{
copied_type_defs
,
copied_class_defs
}}
{
icl_common
,
icl_functions
,
icl_copied_from_dcl
=
{
copied_type_defs
,
copied_class_defs
,
copied_generic_defs
}}
=
icl_module
{
hp_var_heap
,
hp_expression_heap
,
hp_type_heaps
={
th_vars
,
th_attrs
}}
=
heaps
{
com_cons_defs
=
icl_com_cons_defs
,
com_type_defs
=
icl_com_type_defs
,
com_selector_defs
=
icl_com_selector_defs
,
com_class_defs
=
icl_com_class_defs
,
com_member_defs
=
icl_com_member_defs
,
com_instance_defs
=
icl_com_instance_defs
}
com_member_defs
=
icl_com_member_defs
,
com_instance_defs
=
icl_com_instance_defs
,
com_generic_defs
=
icl_com_generic_defs
}
=
icl_common
comp_st
=
{
comp_type_var_heap
=
th_vars
...
...
@@ -408,6 +431,11 @@ compareDefImp main_dcl_module_n main_dcl_module=:{dcl_macro_conversions=Yes macr
(
icl_com_instance_defs
,
comp_st
)
=
compareInstanceDefs
main_dcl_module
.
dcl_sizes
dcl_common
.
com_instance_defs
icl_com_instance_defs
comp_st
(
icl_com_generic_defs
,
comp_st
)
=
compareGenericDefs
main_dcl_module
.
dcl_sizes
copied_generic_defs
dcl_common
.
com_generic_defs
icl_com_generic_defs
comp_st
{
comp_type_var_heap
=
th_vars
,
comp_attr_var_heap
=
th_attrs
,
comp_error
=
error_admin
}
=
comp_st
tc_state
...
...
@@ -424,9 +452,10 @@ compareDefImp main_dcl_module_n main_dcl_module=:{dcl_macro_conversions=Yes macr
icl_common
=
{
icl_common
&
com_cons_defs
=
icl_com_cons_defs
,
com_type_defs
=
icl_com_type_defs
,
com_selector_defs
=
icl_com_selector_defs
,
com_class_defs
=
icl_com_class_defs
,
com_member_defs
=
icl_com_member_defs
,
com_instance_defs
=
icl_com_instance_defs
}
heaps
=
{
hp_var_heap
=
hp_var_heap
,
hp_expression_heap
=
hp_expression_heap
,
com_member_defs
=
icl_com_member_defs
,
com_instance_defs
=
icl_com_instance_defs
,
com_generic_defs
=
icl_com_generic_defs
}
heaps
=
{
heaps
&
hp_var_heap
=
hp_var_heap
,
hp_expression_heap
=
hp_expression_heap
,
hp_type_heaps
=
{
th_vars
=
tc_type_vars
.
hwn_heap
,
th_attrs
=
tc_attr_vars
.
hwn_heap
}}
=
({
icl_module
&
icl_common
=
icl_common
,
icl_functions
=
icl_functions
},
macro_defs
,
heaps
,
error_admin
)
...
...
frontend/containers.dcl
View file @
872f12c1
...
...
@@ -18,6 +18,9 @@ nsFromTo :: !Int -> NumberSet
// all numbers from 0 to (i-1)
bitvectToNumberSet
::
!
LargeBitvect
->
.
NumberSet
numberSetToList
::
!
NumberSet
->
[
Int
]
::
LargeBitvect
:==
{#
Int
}
bitvectCreate
::
!
Int
->
.
LargeBitvect
...
...
frontend/containers.icl
View file @
872f12c1
...
...
@@ -512,4 +512,4 @@ instance toString (a, b) | toString a & toString b