Commit ae7da8f1 authored by Martin Wierich's avatar Martin Wierich
Browse files

added new error message

"attribute variable of lifted argument appears in specified type"
parent 221eb7d1
......@@ -39,6 +39,7 @@ simplifyTypeApplication (TB _) _
:: CleanUpState =
{ cus_var_env :: !.VarEnv
, cus_attr_env :: !.AttributeEnv
, cus_appears_in_lifted_part :: !.LargeBitvect
, cus_heaps :: !.TypeHeaps
, cus_var_store :: !Int
, cus_attr_store :: !Int
......@@ -49,6 +50,7 @@ simplifyTypeApplication (TB _) _
{ cui_coercions :: !{! CoercionTree}
, cui_attr_part :: !AttributePartition
, cui_top_level :: !Bool
, cui_is_lifted_part :: !Bool
}
class clean_up a :: !CleanUpInput !a !*CleanUpState -> (!a, !*CleanUpState)
......@@ -69,7 +71,7 @@ where
= (TA_Unique, cus)
clean_up cui TA_Multi cus
= (TA_Multi, cus)
clean_up cui tv=:(TA_TempVar av_number) cus=:{cus_attr_env,cus_heaps,cus_attr_store,cus_error}
clean_up cui tv=:(TA_TempVar av_number) cus=:{cus_attr_env,cus_appears_in_lifted_part,cus_heaps,cus_attr_store,cus_error}
| cui.cui_top_level
# av_group_nr = cui.cui_attr_part.[av_number]
coercion_tree = cui.cui_coercions.[av_group_nr]
......@@ -78,12 +80,30 @@ where
| isUnique coercion_tree
= (TA_Unique, cus)
#! attr = cus_attr_env.[av_group_nr]
# (cus_appears_in_lifted_part, cus_error)
= case cui.cui_is_lifted_part of
True
-> (cus_appears_in_lifted_part, cus_error)
_
| bitvectSelect av_group_nr cus_appears_in_lifted_part
-> ( bitvectResetAll cus_appears_in_lifted_part // to prevent repetition of error message
, checkError "attribute variable of lifted argument appears in the specified type" "" cus_error)
-> (cus_appears_in_lifted_part, cus_error)
| attrIsUndefined attr
# (av_info_ptr, th_attrs) = newPtr AVI_Empty cus_heaps.th_attrs
new_attr_var = TA_Var { av_name = NewAttrVarId cus_attr_store, av_info_ptr = av_info_ptr }
cus_appears_in_lifted_part
= case cui.cui_is_lifted_part of
False
-> cus_appears_in_lifted_part
_
-> bitvectSet av_group_nr cus_appears_in_lifted_part
= (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})
= (attr, cus)
cus_appears_in_lifted_part = cus_appears_in_lifted_part,
cus_heaps = { cus_heaps & th_attrs = th_attrs }, cus_attr_store = inc cus_attr_store,
cus_error = cus_error})
= (attr, { cus & cus_appears_in_lifted_part = cus_appears_in_lifted_part,
cus_error = cus_error })
= (TA_Multi, cus)
clean_up cui TA_TempExVar cus
= PA_BUG (TA_Multi, cus) (abort "clean_up cui (TA_TempExVar)")
......@@ -266,18 +286,22 @@ cleanUpSymbolType is_start_rule spec_type tst=:{tst_arity,tst_args,tst_result,ts
coercions attr_part var_env attr_var_env heaps var_heap expr_heap error
#! nr_of_temp_vars = size var_env
#! max_attr_nr = size attr_var_env
# cus = { cus_var_env = var_env, cus_attr_env = attr_var_env, cus_heaps = heaps,
cus_var_store = 0, cus_attr_store = 0, cus_error = error }
cui = { cui_coercions = coercions, cui_attr_part = attr_part, cui_top_level = True }
# cus = { cus_var_env = var_env, cus_attr_env = attr_var_env, cus_appears_in_lifted_part = bitvectCreate max_attr_nr,
cus_heaps = heaps, cus_var_store = 0, cus_attr_store = 0, cus_error = error }
cui = { cui_coercions = coercions, cui_attr_part = attr_part, cui_top_level = True, cui_is_lifted_part = True }
(lifted_args, cus=:{cus_var_env}) = clean_up cui (take tst_lifted tst_args) cus
cui = { cui & cui_is_lifted_part = False }
(lifted_vars, cus_var_env) = determine_type_vars nr_of_temp_vars [] cus_var_env
(st_args, cus) = clean_up cui (drop tst_lifted tst_args) { cus & cus_var_env = cus_var_env }
(st_result, cus) = clean_up cui tst_result cus
(st_context, cus_var_env, var_heap, cus_error) = clean_up_type_contexts spec_type tst_context derived_context cus.cus_var_env var_heap cus.cus_error
(st_vars, cus_var_env) = determine_type_vars nr_of_temp_vars lifted_vars cus_var_env
(cus_attr_env, st_attr_vars, st_attr_env) = build_attribute_environment 0 max_attr_nr coercions cus.cus_attr_env [] []
(cus_attr_env, st_attr_vars, st_attr_env, cus_error)
= build_attribute_environment cus.cus_appears_in_lifted_part 0 max_attr_nr coercions cus.cus_attr_env [] [] cus_error
(expr_heap, {cus_var_env,cus_attr_env,cus_heaps,cus_error}) = update_expression_types { cui & cui_top_level = False } case_and_let_exprs
expr_heap { cus & cus_var_env = cus_var_env, cus_attr_env = cus_attr_env, cus_error = cus_error }
expr_heap { cus & cus_var_env = cus_var_env, cus_attr_env = cus_attr_env,
cus_appears_in_lifted_part = {el\\el<-:cus.cus_appears_in_lifted_part},
cus_error = cus_error }
st = { st_arity = tst_arity, st_vars = st_vars , st_args = lifted_args ++ st_args, st_result = st_result, st_context = st_context,
st_attr_env = st_attr_env, st_attr_vars = st_attr_vars }
cus_error = check_type_of_start_rule is_start_rule st cus_error
......@@ -339,32 +363,48 @@ where
| otherwise
= (collected_contexts, env, error)
build_attribute_environment :: !Index !Index !{! CoercionTree} !*AttributeEnv ![AttributeVar] ![AttrInequality]
-> (!*AttributeEnv, ![AttributeVar], ![AttrInequality])
build_attribute_environment attr_group_index max_attr_nr coercions attr_env attr_vars inequalities
build_attribute_environment :: !LargeBitvect !Index !Index !{! CoercionTree} !*AttributeEnv ![AttributeVar] ![AttrInequality] !*ErrorAdmin
-> (!*AttributeEnv, ![AttributeVar], ![AttrInequality], !*ErrorAdmin)
build_attribute_environment appears_in_lifted_part attr_group_index max_attr_nr coercions attr_env attr_vars inequalities error
| attr_group_index == max_attr_nr
= (attr_env, attr_vars, inequalities)
= (attr_env, attr_vars, inequalities, error)
#! attr = attr_env.[attr_group_index]
= case attr of
TA_Var attr_var
# (attr_env, inequalities) = build_inequalities attr_var coercions.[attr_group_index] coercions attr_env inequalities
-> build_attribute_environment (inc attr_group_index) max_attr_nr coercions attr_env [attr_var : attr_vars] inequalities
# (ok, attr_env, inequalities)
= build_inequalities appears_in_lifted_part (bitvectSelect attr_group_index appears_in_lifted_part)
attr_var coercions.[attr_group_index] coercions attr_env inequalities
error
= case ok of
True
-> error
_
-> checkError "attribute variable of lifted argument appears in derived attribute inequality"
"" error
-> build_attribute_environment appears_in_lifted_part (inc attr_group_index) max_attr_nr coercions attr_env [attr_var : attr_vars] inequalities error
TA_None
-> build_attribute_environment (inc attr_group_index) max_attr_nr coercions attr_env attr_vars inequalities
build_inequalities off_var (CT_Node dem_attr left right) coercions attr_env inequalities
# (attr_env, inequalities) = build_inequalities off_var left coercions attr_env inequalities
(attr_env, inequalities) = build_inequalities off_var right coercions attr_env inequalities
-> build_attribute_environment appears_in_lifted_part (inc attr_group_index) max_attr_nr coercions attr_env attr_vars inequalities error
build_inequalities appears_in_lifted_part off_appears_in_lifted_part off_var (CT_Node dem_attr left right)
coercions attr_env inequalities
# (ok1, attr_env, inequalities)
= build_inequalities appears_in_lifted_part off_appears_in_lifted_part off_var left coercions attr_env inequalities
(ok2, attr_env, inequalities)
= build_inequalities appears_in_lifted_part off_appears_in_lifted_part off_var right coercions attr_env inequalities
#! attr = attr_env.[dem_attr]
= case attr of
TA_Var attr_var
| is_new_inequality attr_var off_var inequalities
-> (attr_env, [{ ai_demanded = attr_var, ai_offered = off_var } : inequalities])
-> (attr_env, inequalities)
# ok3 = off_appears_in_lifted_part == bitvectSelect dem_attr appears_in_lifted_part
-> (ok1 && ok2 && ok3, attr_env, [{ ai_demanded = attr_var, ai_offered = off_var } : inequalities])
-> (ok1 && ok2, attr_env, inequalities)
TA_None
-> build_inequalities off_var coercions.[dem_attr] coercions attr_env inequalities
build_inequalities off_var tree coercions attr_env inequalities
= (attr_env, inequalities)
# (ok3, attr_env, inequalities)
= build_inequalities appears_in_lifted_part off_appears_in_lifted_part
off_var coercions.[dem_attr] coercions attr_env inequalities
-> (ok1 && ok2 && ok3, attr_env, inequalities)
build_inequalities _ _ off_var tree coercions attr_env inequalities
= (True, attr_env, inequalities)
is_new_inequality dem_var off_var []
= True
......
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