Skip to content
GitLab
Projects
Groups
Snippets
Help
Loading...
Help
Help
Support
Community forum
Keyboard shortcuts
?
Submit feedback
Contribute to GitLab
Sign in
Toggle navigation
C
compiler
Project overview
Project overview
Details
Activity
Releases
Repository
Repository
Files
Commits
Branches
Tags
Contributors
Graph
Compare
Issues
16
Issues
16
List
Boards
Labels
Service Desk
Milestones
Operations
Operations
Incidents
Analytics
Analytics
Repository
Value Stream
Wiki
Wiki
Snippets
Snippets
Members
Members
Collapse sidebar
Close sidebar
Activity
Graph
Create a new issue
Commits
Issue Boards
Open sidebar
clean-compiler-and-rts
compiler
Commits
8c3a0f61
Commit
8c3a0f61
authored
Oct 25, 2019
by
johnvg@science.ru.nl
Browse files
Options
Browse Files
Download
Plain Diff
Merge remote-tracking branch 'origin/master' into itask
parents
da857bf8
893c83ef
Changes
1
Hide whitespace changes
Inline
Side-by-side
Showing
1 changed file
with
56 additions
and
54 deletions
+56
-54
frontend/check_instances.icl
frontend/check_instances.icl
+56
-54
No files found.
frontend/check_instances.icl
View file @
8c3a0f61
...
...
@@ -26,70 +26,70 @@ check_class_instances_of_module class_n module_n class_instances common_defs tvh
=
check_class_instances_of_module
(
class_n
+1
)
module_n
class_instances
common_defs
tvh
error_admin
#
class_fun_dep_vars
=
common_defs
.[
module_n
].
com_class_defs
.[
class_n
].
class_fun_dep_vars
|
class_fun_dep_vars
==
0
#
(
normal_instances
,
default_instances
,
remaining
_instances
,
tvh
)
#
(
normal_instances
,
default_instances
,
other
_instances
,
tvh
)
=
classify_and_sort_instances
instances
SI_Empty
SI_Empty
[]
common_defs
tvh
(
tvh
,
error_admin
)
=
check_if_sorted_instances_overlap
normal_instances
common_defs
tvh
error_admin
(
tvh
,
error_admin
)
=
check_if_sorted_instances_overlap
default_instances
common_defs
tvh
error_admin
(
tvh
,
error_admin
)
=
check_if_
remaining_instances_overlap
normal_instances
default_instances
remaining
_instances
common_defs
tvh
error_admin
(
tvh
,
error_admin
)
=
check_if_
other_instances_overlap
normal_instances
default_instances
other
_instances
common_defs
tvh
error_admin
=
check_class_instances_of_module
(
class_n
+1
)
module_n
class_instances
common_defs
tvh
error_admin
#
(
normal_instances
,
default_instances
,
remaining
_instances
,
tvh
)
#
(
normal_instances
,
default_instances
,
other
_instances
,
tvh
)
=
classify_and_sort_instances_with_fundeps
instances
class_fun_dep_vars
SI_Empty
SI_Empty
[]
common_defs
tvh
(
tvh
,
error_admin
)
=
check_if_sorted_instances_with_fundeps_overlap
normal_instances
class_fun_dep_vars
common_defs
tvh
error_admin
(
tvh
,
error_admin
)
=
check_if_sorted_instances_with_fundeps_overlap
default_instances
class_fun_dep_vars
common_defs
tvh
error_admin
(
tvh
,
error_admin
)
=
check_if_
remaining_instances_with_fundeps_overlap
normal_instances
default_instances
remaining
_instances
class_fun_dep_vars
common_defs
tvh
error_admin
=
check_if_
other_instances_with_fundeps_overlap
normal_instances
default_instances
other
_instances
class_fun_dep_vars
common_defs
tvh
error_admin
=
check_class_instances_of_module
(
class_n
+1
)
module_n
class_instances
common_defs
tvh
error_admin
=
(
class_instances
,
tvh
,
error_admin
)
classify_and_sort_instances
::
!
InstanceTree
!
SortedInstances
!
SortedInstances
![
Global
Index
]
!{#
CommonDefs
}
!*
TypeVarHeap
->
*(!
SortedInstances
,!
SortedInstances
,![
Global
Index
],!*
TypeVarHeap
)
classify_and_sort_instances
(
IT_Node
instance_index
=:{
glob_module
,
glob_object
}
left
right
)
normal_instances
default_instances
remaining
_instances
common_defs
tvh
classify_and_sort_instances
(
IT_Node
instance_index
=:{
glob_module
,
glob_object
}
left
right
)
normal_instances
default_instances
other
_instances
common_defs
tvh
#!
{
ins_type
={
it_types
},
ins_specials
}
=
common_defs
.[
glob_module
].
com_instance_defs
.[
glob_object
]
|
ins_specials
=:
SP_GenerateRecordInstances
=
classify_and_sort_left_and_right_instances
left
right
normal_instances
default_instances
remaining
_instances
common_defs
tvh
=
classify_and_sort_left_and_right_instances
left
right
normal_instances
default_instances
other
_instances
common_defs
tvh
#
(
is_normal_instance
,
tvh
)
=
instance_root_types_specified
it_types
common_defs
tvh
|
is_normal_instance
#
(
normal_instances
,
tvh
)
=
add_to_sorted_instances
instance_index
it_types
normal_instances
common_defs
tvh
=
classify_and_sort_left_and_right_instances
left
right
normal_instances
default_instances
remaining
_instances
common_defs
tvh
=
classify_and_sort_left_and_right_instances
left
right
normal_instances
default_instances
other
_instances
common_defs
tvh
#
(
is_default_instance
,
tvh
)
=
instance_root_types_specified_or_polymorphic
it_types
[]
common_defs
tvh
|
is_default_instance
#
(
default_instances
,
tvh
)
=
add_to_sorted_instances
instance_index
it_types
default_instances
common_defs
tvh
=
classify_and_sort_left_and_right_instances
left
right
normal_instances
default_instances
remaining
_instances
common_defs
tvh
#
remaining_instances
=
[
instance_index
:
remaining
_instances
]
=
classify_and_sort_left_and_right_instances
left
right
normal_instances
default_instances
remaining
_instances
common_defs
tvh
=
classify_and_sort_left_and_right_instances
left
right
normal_instances
default_instances
other
_instances
common_defs
tvh
#
other_instances
=
[
instance_index
:
other
_instances
]
=
classify_and_sort_left_and_right_instances
left
right
normal_instances
default_instances
other
_instances
common_defs
tvh
where
classify_and_sort_left_and_right_instances
left
right
normal_instances
default_instances
remaining
_instances
common_defs
tvh
#
(
normal_instances
,
default_instances
,
remaining
_instances
,
tvh
)
=
classify_and_sort_instances
left
normal_instances
default_instances
remaining
_instances
common_defs
tvh
#
(
normal_instances
,
default_instances
,
remaining
_instances
,
tvh
)
=
classify_and_sort_instances
right
normal_instances
default_instances
remaining
_instances
common_defs
tvh
=
(
normal_instances
,
default_instances
,
remaining
_instances
,
tvh
)
classify_and_sort_instances
IT_Empty
normal_instances
default_instances
remaining
_instances
common_defs
tvh
=
(
normal_instances
,
default_instances
,
remaining
_instances
,
tvh
)
classify_and_sort_left_and_right_instances
left
right
normal_instances
default_instances
other
_instances
common_defs
tvh
#
(
normal_instances
,
default_instances
,
other
_instances
,
tvh
)
=
classify_and_sort_instances
left
normal_instances
default_instances
other
_instances
common_defs
tvh
#
(
normal_instances
,
default_instances
,
other
_instances
,
tvh
)
=
classify_and_sort_instances
right
normal_instances
default_instances
other
_instances
common_defs
tvh
=
(
normal_instances
,
default_instances
,
other
_instances
,
tvh
)
classify_and_sort_instances
IT_Empty
normal_instances
default_instances
other
_instances
common_defs
tvh
=
(
normal_instances
,
default_instances
,
other
_instances
,
tvh
)
classify_and_sort_instances_with_fundeps
::
!
InstanceTree
!
Int
!
SortedInstances
!
SortedInstances
![
Global
Index
]
!{#
CommonDefs
}
!*
TypeVarHeap
->
*(!
SortedInstances
,!
SortedInstances
,![
Global
Index
],!*
TypeVarHeap
)
classify_and_sort_instances_with_fundeps
(
IT_Node
instance_index
=:{
glob_module
,
glob_object
}
left
right
)
class_fun_dep_vars
normal_instances
default_instances
remaining
_instances
common_defs
tvh
classify_and_sort_instances_with_fundeps
(
IT_Node
instance_index
=:{
glob_module
,
glob_object
}
left
right
)
class_fun_dep_vars
normal_instances
default_instances
other
_instances
common_defs
tvh
#!
{
ins_type
={
it_types
}}
=
common_defs
.[
glob_module
].
com_instance_defs
.[
glob_object
]
#
(
is_normal_instance
,
tvh
)
=
instance_with_fundeps_root_types_specified
it_types
class_fun_dep_vars
common_defs
tvh
|
is_normal_instance
#
(
normal_instances
,
tvh
)
=
add_to_sorted_instances_with_fundeps
instance_index
it_types
normal_instances
class_fun_dep_vars
common_defs
tvh
=
classify_and_sort_left_and_right_instances_with_fundeps
left
right
class_fun_dep_vars
normal_instances
default_instances
remaining
_instances
common_defs
tvh
=
classify_and_sort_left_and_right_instances_with_fundeps
left
right
class_fun_dep_vars
normal_instances
default_instances
other
_instances
common_defs
tvh
#
(
is_default_instance
,
tvh
)
=
instance_root_types_specified_or_polymorphic
it_types
[]
common_defs
tvh
|
is_default_instance
#
(
default_instances
,
tvh
)
=
add_to_sorted_instances_with_fundeps
instance_index
it_types
default_instances
class_fun_dep_vars
common_defs
tvh
=
classify_and_sort_left_and_right_instances_with_fundeps
left
right
class_fun_dep_vars
normal_instances
default_instances
remaining
_instances
common_defs
tvh
#
remaining_instances
=
[
instance_index
:
remaining
_instances
]
=
classify_and_sort_left_and_right_instances_with_fundeps
left
right
class_fun_dep_vars
normal_instances
default_instances
remaining
_instances
common_defs
tvh
=
classify_and_sort_left_and_right_instances_with_fundeps
left
right
class_fun_dep_vars
normal_instances
default_instances
other
_instances
common_defs
tvh
#
other_instances
=
[
instance_index
:
other
_instances
]
=
classify_and_sort_left_and_right_instances_with_fundeps
left
right
class_fun_dep_vars
normal_instances
default_instances
other
_instances
common_defs
tvh
where
classify_and_sort_left_and_right_instances_with_fundeps
left
right
class_fun_dep_vars
normal_instances
default_instances
remaining
_instances
common_defs
tvh
#
(
normal_instances
,
default_instances
,
remaining
_instances
,
tvh
)
=
classify_and_sort_instances_with_fundeps
left
class_fun_dep_vars
normal_instances
default_instances
remaining
_instances
common_defs
tvh
#
(
normal_instances
,
default_instances
,
remaining
_instances
,
tvh
)
=
classify_and_sort_instances_with_fundeps
right
class_fun_dep_vars
normal_instances
default_instances
remaining
_instances
common_defs
tvh
=
(
normal_instances
,
default_instances
,
remaining
_instances
,
tvh
)
classify_and_sort_instances_with_fundeps
IT_Empty
class_fun_dep_vars
normal_instances
default_instances
remaining
_instances
common_defs
tvh
=
(
normal_instances
,
default_instances
,
remaining
_instances
,
tvh
)
classify_and_sort_left_and_right_instances_with_fundeps
left
right
class_fun_dep_vars
normal_instances
default_instances
other
_instances
common_defs
tvh
#
(
normal_instances
,
default_instances
,
other
_instances
,
tvh
)
=
classify_and_sort_instances_with_fundeps
left
class_fun_dep_vars
normal_instances
default_instances
other
_instances
common_defs
tvh
#
(
normal_instances
,
default_instances
,
other
_instances
,
tvh
)
=
classify_and_sort_instances_with_fundeps
right
class_fun_dep_vars
normal_instances
default_instances
other
_instances
common_defs
tvh
=
(
normal_instances
,
default_instances
,
other
_instances
,
tvh
)
classify_and_sort_instances_with_fundeps
IT_Empty
class_fun_dep_vars
normal_instances
default_instances
other
_instances
common_defs
tvh
=
(
normal_instances
,
default_instances
,
other
_instances
,
tvh
)
add_to_sorted_instances
::
!(
Global
Index
)
![
Type
]
!
SortedInstances
!{#
CommonDefs
}
!*
TypeVarHeap
->
(!
SortedInstances
,!*
TypeVarHeap
)
add_to_sorted_instances
instance_index
instance_types
(
SI_Node
instances
=:[{
glob_module
,
glob_object
}:_]
left
right
)
common_defs
tvh
...
...
@@ -119,24 +119,24 @@ add_to_sorted_instances_with_fundeps instance_index instance_types (SI_Node inst
add_to_sorted_instances_with_fundeps
instance_index
instances_types
SI_Empty
class_fun_dep_vars
common_defs
tvh
=
(
SI_Node
[
instance_index
]
SI_Empty
SI_Empty
,
tvh
)
check_if_
remaining
_instances_overlap
::
SortedInstances
SortedInstances
![
Global
Index
]
!{#
CommonDefs
}
*
TypeVarHeap
!*
ErrorAdmin
check_if_
other
_instances_overlap
::
SortedInstances
SortedInstances
![
Global
Index
]
!{#
CommonDefs
}
*
TypeVarHeap
!*
ErrorAdmin
->
(!*
TypeVarHeap
,!*
ErrorAdmin
)
check_if_
remaining
_instances_overlap
normal_instances
default_instances
[]
common_defs
tvh
error_admin
check_if_
other
_instances_overlap
normal_instances
default_instances
[]
common_defs
tvh
error_admin
=
(
tvh
,
error_admin
)
check_if_
remaining_instances_overlap
normal_instances
default_instances
remaining
_instances
common_defs
tvh
error_admin
check_if_
other_instances_overlap
normal_instances
default_instances
other
_instances
common_defs
tvh
error_admin
#
instances
=
add_instances_from_tree
normal_instances
[]
common_defs
#
instances
=
add_instances_from_tree
default_instances
instances
common_defs
#
(_,
tvh
,
error_admin
)
=
check_if_instances_overlap
remaining
_instances
instances
common_defs
tvh
error_admin
#
(_,
tvh
,
error_admin
)
=
check_if_instances_overlap
other
_instances
instances
common_defs
tvh
error_admin
=
(
tvh
,
error_admin
)
check_if_
remaining
_instances_with_fundeps_overlap
::
SortedInstances
SortedInstances
![
Global
Index
]
!
Int
!{#
CommonDefs
}
*
TypeVarHeap
!*
ErrorAdmin
check_if_
other
_instances_with_fundeps_overlap
::
SortedInstances
SortedInstances
![
Global
Index
]
!
Int
!{#
CommonDefs
}
*
TypeVarHeap
!*
ErrorAdmin
->
(!*
TypeVarHeap
,!*
ErrorAdmin
)
check_if_
remaining
_instances_with_fundeps_overlap
normal_instances
default_instances
[]
class_fun_dep_vars
common_defs
tvh
error_admin
check_if_
other
_instances_with_fundeps_overlap
normal_instances
default_instances
[]
class_fun_dep_vars
common_defs
tvh
error_admin
=
(
tvh
,
error_admin
)
check_if_
remaining_instances_with_fundeps_overlap
normal_instances
default_instances
remaining
_instances
class_fun_dep_vars
common_defs
tvh
error_admin
check_if_
other_instances_with_fundeps_overlap
normal_instances
default_instances
other
_instances
class_fun_dep_vars
common_defs
tvh
error_admin
#
instances
=
add_instances_from_tree
normal_instances
[]
common_defs
#
instances
=
add_instances_from_tree
default_instances
instances
common_defs
#
(_,
tvh
,
error_admin
)
=
check_if_instances_with_fundeps_overlap
remaining
_instances
instances
class_fun_dep_vars
common_defs
tvh
error_admin
#
(_,
tvh
,
error_admin
)
=
check_if_instances_with_fundeps_overlap
other
_instances
instances
class_fun_dep_vars
common_defs
tvh
error_admin
=
(
tvh
,
error_admin
)
add_instances_from_tree
::
!
SortedInstances
![([
Type
],
Global
Int
)]
!{#
CommonDefs
}
->
[([
Type
],
Global
Int
)]
...
...
@@ -152,7 +152,7 @@ where
=
l
add_instances_from_tree
SI_Empty
l
common_defs
=
l
check_if_sorted_instances_overlap
::
!
SortedInstances
!{#
CommonDefs
}
!*
TypeVarHeap
!*
ErrorAdmin
->
(!*
TypeVarHeap
,!*
ErrorAdmin
)
check_if_sorted_instances_overlap
(
SI_Node
[_]
left
right
)
common_defs
tvh
error_admin
#
(
tvh
,
error_admin
)
=
check_if_sorted_instances_overlap
left
common_defs
tvh
error_admin
...
...
@@ -486,14 +486,6 @@ try_to_expand_in_unify_instances type=:(TA {type_index={glob_object,glob_module}
->
(
True
,
expanded_type
,
tvh
)
_
->
(
False
,
type
,
tvh
)
try_to_expand_in_unify_instances
type
=:(
TAS
{
type_index
={
glob_object
,
glob_module
}}
type_args
_)
common_defs
tvh
#!
{
td_rhs
,
td_args
}
=
common_defs
.[
glob_module
].
com_type_defs
.[
glob_object
]
=
case
td_rhs
of
SynType
{
at_type
}
#
(
expanded_type
,
tvh
)
=
substitute_instance_type
td_args
type_args
at_type
tvh
->
(
True
,
expanded_type
,
tvh
)
_
->
(
False
,
type
,
tvh
)
try_to_expand_in_unify_instances
type
common_defs
tvh
=
(
False
,
type
,
tvh
)
...
...
@@ -589,18 +581,28 @@ compare_root_types type1=:(TA {type_index=type_index1} args1) type2=:(TA {type_i
|
td_rhs
=:
SynType
_
=
compare_root_types_syn_type2
type1
td_rhs
td_args
args2
common_defs
tvh
=
compare_root_types_TAs
type_index1
args1
type_index2
args2
tvh
compare_root_types
(
TA
{
type_index
={
glob_object
,
glob_module
}}
type_args
)
type2
common_defs
tvh
#!
{
td_rhs
,
td_args
}
=
common_defs
.[
glob_module
].
com_type_defs
.[
glob_object
]
compare_root_types
type1
=:(
TA
{
type_index
=
type_index1
}
args1
)
type2
=:(
TAS
{
type_index
=
type_index2
}
args2
_)
common_defs
tvh
#!
{
td_rhs
,
td_args
}
=
common_defs
.[
type_index1
.
glob_module
].
com_type_defs
.[
type_index1
.
glob_object
]
|
td_rhs
=:
SynType
_
=
compare_root_types_syn_type1
td_rhs
td_args
args1
type2
common_defs
tvh
=
compare_root_types_TAs
type_index1
args1
type_index2
args2
tvh
compare_root_types
(
TA
{
type_index
=
type_index1
}
type_args
)
type2
common_defs
tvh
#!
{
td_rhs
,
td_args
}
=
common_defs
.[
type_index1
.
glob_module
].
com_type_defs
.[
type_index1
.
glob_object
]
|
td_rhs
=:
SynType
_
=
compare_root_types_syn_type1
td_rhs
td_args
type_args
type2
common_defs
tvh
=
(
Smaller
,
tvh
)
compare_root_types
type1
(
TA
{
type_index
={
glob_object
,
glob_module
}}
type_args
)
common_defs
tvh
#!
{
td_rhs
,
td_args
}
=
common_defs
.[
glob_module
].
com_type_defs
.[
glob_object
]
compare_root_types
(
TAS
{
type_index
=
type_index1
}
args1
_)
(
TAS
{
type_index
=
type_index2
}
args2
_)
common_defs
tvh
=
compare_root_types_TAs
type_index1
args1
type_index2
args2
tvh
compare_root_types
type1
=:(
TAS
{
type_index
=
type_index1
}
args1
_)
type2
=:(
TA
{
type_index
=
type_index2
}
args2
)
common_defs
tvh
#!
{
td_rhs
,
td_args
}
=
common_defs
.[
type_index2
.
glob_module
].
com_type_defs
.[
type_index2
.
glob_object
]
|
td_rhs
=:
SynType
_
=
compare_root_types_syn_type2
type1
td_rhs
td_args
args2
common_defs
tvh
=
compare_root_types_TAs
type_index1
args1
type_index2
args2
tvh
compare_root_types
type1
(
TA
{
type_index
=
type_index2
}
type_args
)
common_defs
tvh
#!
{
td_rhs
,
td_args
}
=
common_defs
.[
type_index2
.
glob_module
].
com_type_defs
.[
type_index2
.
glob_object
]
|
td_rhs
=:
SynType
_
=
compare_root_types_syn_type2
type1
td_rhs
td_args
type_args
common_defs
tvh
=
(
Greater
,
tvh
)
compare_root_types
(
TAS
{
type_index
=
type_index1
}
args1
_)
(
TAS
{
type_index
=
type_index2
}
args2
_)
common_defs
tvh
=
compare_root_types_TAs
type_index1
args1
type_index2
args2
tvh
compare_root_types
(
TB
bt1
)
(
TB
bt2
)
common_defs
tvh
|
equal_constructor
bt1
bt2
=
(
Equal
,
tvh
)
...
...
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