From 86d58b15414f5515362841b9c8a24295f458e47e Mon Sep 17 00:00:00 2001
From: sjakie
Date: Thu, 2 Nov 2000 11:24:26 +0000
Subject: Sjaak: Bug in instance types removed, Attributes in higher order type
applications fixed.
git-svn-id: https://svn.cs.ru.nl/repos/clean-compiler/trunk@279 1f8540f1-abd5-4d5b-9d24-4c5ce8603e2d
---
frontend/unitype.icl | 55 ++++++++++++++++++++++------------------------------
1 file changed, 23 insertions(+), 32 deletions(-)
(limited to 'frontend/unitype.icl')
diff --git a/frontend/unitype.icl b/frontend/unitype.icl
index 5f9904e..f8219cb 100644
--- a/frontend/unitype.icl
+++ b/frontend/unitype.icl
@@ -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
+ | typeIsNonCoercible 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
+ | typeIsNonCoercible 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
+ | typeIsNonCoercible 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
+ | typeIsNonCoercible 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
- = PositiveSign
+ = sign
= 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
--
cgit v1.2.3