Commit a4c2cb04 authored by John van Groningen's avatar John van Groningen
Browse files

replace function NewAttrVarId by NewAttrVar, improve caching of uniqueness...

replace function NewAttrVarId by NewAttrVar, improve caching of uniqueness attribute variable identifiers
parent 4e35d0ec
......@@ -1294,8 +1294,8 @@ where
CT_NonUnique
-> ({ attr_var_array & [i] = TA_Multi}, th_attrs)
_
# (new_info_ptr, th_attrs) = newPtr AVI_Empty th_attrs
-> ({ attr_var_array & [i] = TA_Var { av_ident = NewAttrVarId i, av_info_ptr = new_info_ptr }}, th_attrs)
# (av, th_attrs) = NewAttrVar i th_attrs
-> ({attr_var_array & [i] = TA_Var av}, th_attrs)
coercionsToAttrEnv :: !{!TypeAttribute} !Coercions -> [AttrInequality]
coercionsToAttrEnv attr_vars {coer_demanded, coer_offered}
......@@ -2254,8 +2254,7 @@ where
= (cum_attr, attr_env, attr_store)
freshAttrVar attr_var th_attrs
# (new_info_ptr, th_attrs) = newPtr AVI_Empty th_attrs
= ({ av_ident = NewAttrVarId attr_var, av_info_ptr = new_info_ptr }, th_attrs)
:== NewAttrVar attr_var th_attrs
RepeatnAppendM n a l :== repeatn_append_ n a l
where
......@@ -3414,10 +3413,8 @@ renewVariables exprs var_heap
preprocess_local_var :: !FreeVar !RenewState -> (!FreeVar, !RenewState)
preprocess_local_var fv=:{fv_ident, fv_info_ptr} (new_vars_accu, free_vars_accu, var_heap)
# (evi, var_heap)
= readExtendedVarInfo fv_info_ptr var_heap
(new_var, var_heap)
= allocate_and_bind_new_var fv_ident fv_info_ptr evi var_heap
# (evi, var_heap) = readExtendedVarInfo fv_info_ptr var_heap
(new_var, var_heap) = allocate_and_bind_new_var fv_ident fv_info_ptr evi var_heap
= ( { fv & fv_info_ptr = new_var.var_info_ptr }
, (new_vars_accu, free_vars_accu, var_heap))
......@@ -4168,7 +4165,7 @@ where
showTail f [|x] = f <<< x <<< "] "
showTail f [|a:x] = showTail (f <<< a <<< ", ") x
showTail f [|] = f <<< "] "
instance <<< InstanceInfo
where
(<<<) file ii = (write_ii ii (file <<< "[")) <<< "]"
......
......@@ -41,7 +41,7 @@ cleanUpSymbolType :: !Bool !Bool !TempSymbolType ![TypeContext] ![ExprInfoPtr] !
equivalent :: !SymbolType !TempSymbolType !Int !{# CommonDefs} !*AttributeEnv !*TypeHeaps -> (!Bool, !*AttributeEnv, !*TypeHeaps)
NewAttrVarId :: !Int -> Ident
NewAttrVar :: !Int !*AttrVarHeap -> (!AttributeVar,!*AttrVarHeap)
beautifulizeAttributes :: !SymbolType !*AttrVarHeap -> (!SymbolType, !.AttrVarHeap)
......
implementation module typesupport
import StdEnv, compare_types
import StdEnv, StdStrictLists, compare_types
import syntax, expand_types, unitype, utilities, checktypes
:: Store :== Int
......@@ -22,7 +22,6 @@ import syntax, expand_types, unitype, utilities, checktypes
:: FunctionType = CheckedType !SymbolType | SpecifiedType !SymbolType ![AType] !TempSymbolType
| UncheckedType !TempSymbolType | ExpandedType !SymbolType !TempSymbolType !TempSymbolType | EmptyFunctionType
:: AttributeEnv :== {! TypeAttribute }
:: VarEnv :== {! Type }
......@@ -105,8 +104,8 @@ where
= cus
clean_up_attribute_variable av_group_nr (TA_None, cus=:{cus_heaps,cus_attr_store,cus_attr_env})
# (av_info_ptr, th_attrs) = newPtr AVI_Empty cus_heaps.th_attrs
new_attr_var = TA_Var { av_ident = NewAttrVarId cus_attr_store, av_info_ptr = av_info_ptr }
# (av, th_attrs) = NewAttrVar cus_attr_store cus_heaps.th_attrs
new_attr_var = TA_Var av
= (new_attr_var, { cus & cus_attr_env = { cus_attr_env & [av_group_nr] = new_attr_var},
cus_heaps = { cus_heaps & th_attrs = th_attrs }, cus_attr_store = inc cus_attr_store})
clean_up_attribute_variable av_group_nr attr_and_cus
......@@ -326,8 +325,7 @@ newAttributedVariables var_number attributed_variables clean_state=:(_,_,_) /* T
newAttributedVariable var_number (variables, attributes, type_heaps=:{th_vars,th_attrs})
# (tv_info_ptr, th_vars) = newPtr TVI_Empty th_vars
new_var = { tv_ident = NewVarId var_number, tv_info_ptr = tv_info_ptr }
(av_info_ptr, th_attrs) = newPtr AVI_Empty th_attrs
new_attr_var = { av_ident = NewAttrVarId var_number, av_info_ptr = av_info_ptr }
(new_attr_var, th_attrs) = NewAttrVar var_number th_attrs
= ({ at_attribute = TA_Var new_attr_var, at_type = TV new_var},
([ new_var : variables ], [ new_attr_var : attributes ], { type_heaps & th_vars = th_vars, th_attrs = th_attrs }))
......@@ -693,14 +691,25 @@ NewVarId var_store
= newIdent VarIdTable.[var_store]
= newIdent ("v" +++ toString var_store)
AttrVarIdTable :: {# String}
AttrVarIdTable =: { "u", "v", "w", "x", "y", "z" }
AttrVarIdTable :: {!Ident}
AttrVarIdTable =: {newIdent i \\ i<-: {# "u", "v", "w", "x", "y", "z" }}
AttrVarIdTables :: [#{!Ident}]
AttrVarIdTables
=: [# let first_i=12*(1<<p) in {!newIdent ("u" +++ toString (i-6)) \\ i<-[first_i..first_i+first_i-1]} \\ p<-[0..] ]
NewAttrVarId :: !Int -> Ident
NewAttrVarId attr_var_store
NewAttrVar :: !Int !*AttrVarHeap -> (!AttributeVar,!*AttrVarHeap)
NewAttrVar attr_var_store th_attrs
| attr_var_store < size AttrVarIdTable
= newIdent AttrVarIdTable.[attr_var_store]
= newIdent ("u" +++ toString attr_var_store)
# (av_info_ptr, th_attrs) = newPtr AVI_Empty th_attrs
= ({av_ident=AttrVarIdTable.[attr_var_store],av_info_ptr=av_info_ptr},th_attrs)
= getAttrVarId AttrVarIdTables (attr_var_store-6) 12 th_attrs
where
getAttrVarId [#attrVarIds_array:attrVarId_list] i p th_attrs
| i<p
# (av_info_ptr, th_attrs) = newPtr AVI_Empty th_attrs
= ({av_ident=attrVarIds_array.[i],av_info_ptr=av_info_ptr},th_attrs)
= getAttrVarId attrVarId_list (i-p) (p+p) th_attrs
class equiv a :: !a !a !*TypeHeaps -> (!Bool, !*TypeHeaps)
......@@ -1465,7 +1474,6 @@ beautifulizeAttributes symbol_type th_attrs
\\ offered <- fst (flattenCoercionTree offered_tree) ]
\\ offered_tree<-:coer_offered & demanded<-[0..] ]
removeRedundancy :: !AttrCoercion !(!*{#Bool}, !*Coercions) -> (!.{#Bool}, !.Coercions)
removeRedundancy {ac_offered, ac_demanded} (visited, attr_env_coercions=:{coer_demanded})
// all i:not visited.[i]
......
Supports Markdown
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment