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
6b57219a
Commit
6b57219a
authored
Nov 02, 2000
by
Sjaak Smetsers
Browse files
Sjaak: Bug in instance types removed,
Attributes in higher order type applications fixed.
parent
80a54c10
Changes
1
Hide whitespace changes
Inline
Side-by-side
frontend/unitype.icl
View file @
6b57219a
...
...
@@ -77,6 +77,7 @@ determineAttributeCoercions off_type dem_type coercible position subst coercions
No
->
(
subst
,
crc_coercions
,
crc_td_infos
,
crc_type_heaps
,
error
)
// ---> ("determineAttributeCoercions",position, (off_type, dem_type,exp_off_type,exp_dem_type))
NotChecked
:==
-1
...
...
@@ -323,23 +324,25 @@ where
lift
modules
cons_vars
attr_type
=:{
at_attribute
,
at_type
}
subst
ls
#
(
changed
,
at_type
,
subst
,
ls
)
=
lift2
modules
cons_vars
at_type
subst
ls
|
changed
|
type
_is_non_coercible
at_type
|
type
IsNonCoercible
cons_vars
at_type
=
({
attr_type
&
at_type
=
at_type
},
subst
,
ls
)
=
({
attr_type
&
at_attribute
=
TA_TempVar
ls
.
ls_next_attr
,
at_type
=
at_type
},
subst
,
{
ls
&
ls_next_attr
=
inc
ls
.
ls_next_attr
})
|
type
_is_non_coercible
at_type
|
type
IsNonCoercible
cons_vars
at_type
=
(
attr_type
,
subst
,
ls
)
=
({
attr_type
&
at_attribute
=
TA_TempVar
ls
.
ls_next_attr
},
subst
,
{
ls
&
ls_next_attr
=
inc
ls
.
ls_next_attr
})
where
type_is_non_coercible
(
TempV
_)
=
True
type_is_non_coercible
(
TempQV
_)
=
True
type_is_non_coercible
(_
-->
_)
=
True
type_is_non_coercible
(_
:@:
_)
=
True
type_is_non_coercible
_
=
False
typeIsNonCoercible
_
(
TempV
_)
=
True
typeIsNonCoercible
_
(
TempQV
_)
=
True
typeIsNonCoercible
_
(_
-->
_)
=
True
typeIsNonCoercible
cons_vars
(
TempCV
tmp_var_id
:@:
_)
=
not
(
isPositive
tmp_var_id
cons_vars
)
typeIsNonCoercible
cons_vars
(_
:@:
_)
=
True
typeIsNonCoercible
_
_
=
False
class
lift2
a
::
!{#
CommonDefs
}
!{#
BOOLVECT
}
!
a
!*{!
Type
}
!*
LiftState
->
(!
Bool
,!
a
,
!*{!
Type
},
!*
LiftState
)
...
...
@@ -441,23 +444,12 @@ where
lift2
modules
cons_vars
attr_type
=:{
at_attribute
,
at_type
}
subst
ls
#
(
changed
,
at_type
,
subst
,
ls
)
=
lift2
modules
cons_vars
at_type
subst
ls
|
changed
|
type
_is_non_coercible
at_type
|
type
IsNonCoercible
cons_vars
at_type
=
(
True
,{
attr_type
&
at_type
=
at_type
},
subst
,
ls
)
=
(
True
,{
attr_type
&
at_attribute
=
TA_TempVar
ls
.
ls_next_attr
,
at_type
=
at_type
},
subst
,
{
ls
&
ls_next_attr
=
inc
ls
.
ls_next_attr
})
|
type
_is_non_coercible
at_type
|
type
IsNonCoercible
cons_vars
at_type
=
(
False
,
attr_type
,
subst
,
ls
)
=
(
True
,{
attr_type
&
at_attribute
=
TA_TempVar
ls
.
ls_next_attr
},
subst
,
{
ls
&
ls_next_attr
=
inc
ls
.
ls_next_attr
})
where
type_is_non_coercible
(
TempV
_)
=
True
type_is_non_coercible
(
TempQV
_)
=
True
type_is_non_coercible
(_
-->
_)
=
True
type_is_non_coercible
(_
:@:
_)
=
True
type_is_non_coercible
_
=
False
::
ExpansionState
=
{
es_type_heaps
::
!.
TypeHeaps
...
...
@@ -950,7 +942,6 @@ where
|
tsp_coercible
=
sign
=
TopSign
// ---> ("adjust_sign to top", type_name)
adjust_sign
sign
_
cons_vars
=
sign
...
...
@@ -1030,15 +1021,15 @@ coerceTypes sign defs cons_vars tpos {at_type = arg_type1 --> res_type1} {at_typ
|
Success
succ
=
coerce
sign
defs
cons_vars
[
1
:
tpos
]
res_type1
res_type2
cs
=
(
succ
,
cs
)
coerceTypes
_
defs
cons_vars
tpos
{
at_type
=
cons_var
:@:
types1
}
{
at_type
=
_
:@:
types2
}
cs
#
sign
=
determine_sign_of_arg_types
cons_var
cons_vars
coerceTypes
sign
defs
cons_vars
tpos
{
at_type
=
cons_var
:@:
types1
}
{
at_type
=
_
:@:
types2
}
cs
#
sign
=
determine_sign_of_arg_types
sign
cons_var
cons_vars
=
coercions_of_type_list
sign
defs
cons_vars
tpos
0
types1
types2
cs
where
determine_sign_of_arg_types
(
TempCV
tmp_var_id
)
cons_vars
determine_sign_of_arg_types
sign
(
TempCV
tmp_var_id
)
cons_vars
|
isPositive
tmp_var_id
cons_vars
=
PositiveS
ign
=
s
ign
=
TopSign
determine_sign_of_arg_types
_
cons_vars
determine_sign_of_arg_types
_
_
cons_vars
=
TopSign
coercions_of_type_list
sign
defs
cons_vars
tpos
arg_number
[
t1
:
ts1
]
[
t2
:
ts2
]
cs
...
...
Write
Preview
Supports
Markdown
0%
Try again
or
attach a new 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