aboutsummaryrefslogtreecommitdiff
path: root/frontend
diff options
context:
space:
mode:
Diffstat (limited to 'frontend')
-rw-r--r--frontend/typesupport.dcl1
-rw-r--r--frontend/typesupport.icl37
2 files changed, 25 insertions, 13 deletions
diff --git a/frontend/typesupport.dcl b/frontend/typesupport.dcl
index 342dd05..3bdf7ab 100644
--- a/frontend/typesupport.dcl
+++ b/frontend/typesupport.dcl
@@ -76,7 +76,6 @@ instance substitute AType, Type, TypeContext, AttrInequality, CaseType, [a] | su
instance <<< TempSymbolType
removeInequality :: !Int !Int !*Coercions -> .Coercions
-anonymizeAttrVars :: !SymbolType !*AttrVarHeap -> (!SymbolType, !.AttrVarHeap)
flattenCoercionTree :: !u:CoercionTree -> (![Int], !u:CoercionTree)
assignNumbersToAttrVars :: !SymbolType !*AttrVarHeap -> (!Int, ![AttributeVar], !.AttrVarHeap)
getImplicitAttrInequalities :: !SymbolType -> [AttrInequality]
diff --git a/frontend/typesupport.icl b/frontend/typesupport.icl
index 6ae7f59..11bd794 100644
--- a/frontend/typesupport.icl
+++ b/frontend/typesupport.icl
@@ -1239,7 +1239,7 @@ beautifulizeAttributes symbol_type th_attrs
st_attr_env
= coercionsToAttrEnv {el \\ el<-all_attr_vars } attr_env_coercions
(symbol_type, th_attrs)
- = anonymizeAttrVars { symbol_type & st_attr_env = st_attr_env } th_attrs
+ = anonymizeAttrVars { symbol_type & st_attr_env = st_attr_env } implicit_inequalities th_attrs
= (symbol_type, th_attrs)
where
pointers_to_int {ai_offered, ai_demanded} th_attrs
@@ -1361,14 +1361,18 @@ flattenCoercionTree tree
(accu, left) = flatten_ct ([i:accu], left)
= (accu, CT_Node i left right)
-anonymizeAttrVars :: !SymbolType !*AttrVarHeap -> (!SymbolType, !.AttrVarHeap)
-anonymizeAttrVars st=:{st_attr_vars, st_args, st_result, st_attr_env} th_attrs
+anonymizeAttrVars :: !SymbolType ![AttrInequality] !*AttrVarHeap -> (!SymbolType, !.AttrVarHeap)
+anonymizeAttrVars st=:{st_attr_vars, st_args, st_result, st_attr_env} implicit_inequalities th_attrs
# th_attrs
= countAttrVars st th_attrs
th_attrs
= foldSt markUsedAttrVars st_attr_env th_attrs
- (st_args, th_attrs) = mapSt anonymize_atype st_args th_attrs
- (st_result, th_attrs) = anonymize_atype st_result th_attrs
+ th_attrs
+ = foldSt mark_once_occurring_implicit_attr_var implicit_inequalities th_attrs
+ (st_args, th_attrs)
+ = mapSt anonymize_atype st_args th_attrs
+ (st_result, th_attrs)
+ = anonymize_atype st_result th_attrs
= ({ st & st_args = st_args, st_result = st_result }, th_attrs)
where
anonymize_atype atype=:{at_attribute=TA_Var {av_info_ptr}, at_type} th_attrs
@@ -1381,6 +1385,8 @@ anonymizeAttrVars st=:{st_attr_vars, st_args, st_result, st_attr_env} th_attrs
// number of occurences doesn't matter for type variables
-> ({ atype & at_type = at_type, at_attribute = TA_Anonymous }, th_attrs)
-> ({ atype & at_type = at_type }, th_attrs)
+ AVI_Attr TA_None
+ -> ({ atype & at_type = at_type, at_attribute = TA_None }, th_attrs)
_
-> ({ atype & at_type = at_type }, th_attrs)
where
@@ -1429,16 +1435,23 @@ anonymizeAttrVars st=:{st_attr_vars, st_args, st_result, st_attr_env} th_attrs
count_attr_vars_of_type _ th_attrs
= th_attrs
-
+ markUsedAttrVars {ai_offered, ai_demanded} th_attrs
+ = writePtr ai_offered.av_info_ptr (AVI_Forward 0)
+ (writePtr ai_demanded.av_info_ptr (AVI_Forward 0) th_attrs)
+ // misuse AVI_Forward to indicate that this attribute variable is referenced in
+ // the attribute inequalities
+
+ mark_once_occurring_implicit_attr_var {ai_offered={av_info_ptr}} th_attrs
+ # (avi, th_attrs) = readPtr av_info_ptr th_attrs
+ = case avi of
+ AVI_Count 1
+ -> writePtr av_info_ptr (AVI_Attr TA_None) th_attrs
+ _
+ -> th_attrs
+
initialise_to_AVI_Empty {av_info_ptr} th_attrs
= writePtr av_info_ptr AVI_Empty th_attrs
-markUsedAttrVars {ai_offered, ai_demanded} th_attrs
- = writePtr ai_offered.av_info_ptr (AVI_Forward 0)
- (writePtr ai_demanded.av_info_ptr (AVI_Forward 0) th_attrs)
- // misuse AVI_Forward to indicate that this attribute variable is referenced in
- // the attribute inequalities
-
removeInequality :: !Int !Int !*Coercions -> .Coercions
removeInequality offered demanded attr_env_coercions=:{coer_offered, coer_demanded}
# coer_offered = appCoercionTree (removeNode offered) demanded coer_offered