Commit cccf616b authored by Sjaak Smetsers's avatar Sjaak Smetsers

universally quantified attribute variables in typedefs added

bug fix: combination of caching and omitted clasdefs
parent ea184ced
This diff is collapsed.
......@@ -10,9 +10,6 @@ cModuleScope :== 0
cGlobalScope :== 1
cRankTwoScope :== 2
cIsNotADclModule :== False
cIsADclModule :== True
cNeedStdArray :== 1
cNeedStdEnum :== 2
cNeedStdDynamic :== 4
......@@ -84,8 +81,8 @@ cConversionTableSize :== 9 // AA
}
:: CopiedDefinitions =
{ copied_type_defs :: [Index]
, copied_class_defs :: [Index]
{ copied_type_defs :: {#Bool}
, copied_class_defs :: {#Bool}
}
:: IclModule =
......
......@@ -17,9 +17,6 @@ cModuleScope :== 0
cGlobalScope :== 1
cRankTwoScope :== 2
cIsNotADclModule :== False
cIsADclModule :== True
cNeedStdArray :== 1
cNeedStdEnum :== 2
cNeedStdDynamic :== 4
......@@ -97,8 +94,8 @@ where
}
:: CopiedDefinitions =
{ copied_type_defs :: [Index]
, copied_class_defs :: [Index]
{ copied_type_defs :: {#Bool}
, copied_class_defs :: {#Bool}
}
:: IclModule =
......
......@@ -2,7 +2,7 @@ definition module checktypes
import checksupport, typesupport
checkTypeDefs :: !Bool !*{# CheckedTypeDef} !Index !*{# ConsDef} !*{# SelectorDef} !*{# DclModule} !*VarHeap !*TypeHeaps !*CheckState
checkTypeDefs :: !Index !(Optional (CopiedDefinitions, Int)) !*{# CheckedTypeDef} !*{# ConsDef} !*{# SelectorDef} !*{# DclModule} !*VarHeap !*TypeHeaps !*CheckState
-> (!*{# CheckedTypeDef}, !*{# ConsDef}, !*{# SelectorDef}, !*{# DclModule}, !*VarHeap, !*TypeHeaps, !*CheckState)
checkFunctionType :: !Index !SymbolType !Specials !u:{# CheckedTypeDef} !v:{# ClassDef} !u:{# DclModule} !*TypeHeaps !*CheckState
......
......@@ -311,20 +311,26 @@ where
CS_Checked :== 1
CS_Checking :== 0
checkTypeDefs :: !Bool !*{# CheckedTypeDef} !Index !*{# ConsDef} !*{# SelectorDef} !*{# DclModule} !*VarHeap !*TypeHeaps !*CheckState
checkTypeDefs :: !Index !(Optional (CopiedDefinitions, Int)) !*{# CheckedTypeDef} !*{# ConsDef} !*{# SelectorDef} !*{# DclModule} !*VarHeap !*TypeHeaps !*CheckState
-> (!*{# CheckedTypeDef}, !*{# ConsDef}, !*{# SelectorDef}, !*{# DclModule}, !*VarHeap, !*TypeHeaps, !*CheckState)
checkTypeDefs is_main_dcl type_defs module_index cons_defs selector_defs modules var_heap type_heaps cs
checkTypeDefs module_index opt_icl_info type_defs cons_defs selector_defs modules var_heap type_heaps cs
#! nr_of_types = size type_defs
# ts = { ts_type_defs = type_defs, ts_cons_defs = cons_defs, ts_selector_defs = selector_defs, ts_modules = modules }
ti = { ti_type_heaps = type_heaps, ti_var_heap = var_heap, ti_used_types = [] }
= check_type_defs is_main_dcl 0 nr_of_types module_index ts ti cs
ti = { ti_type_heaps = type_heaps, ti_var_heap = var_heap, ti_used_types = [] }
({ts_type_defs,ts_cons_defs, ts_selector_defs, ts_modules}, {ti_var_heap,ti_type_heaps}, cs)
= iFoldSt (check_type_def module_index opt_icl_info) 0 nr_of_types (ts, ti, cs)
= (ts_type_defs, ts_cons_defs, ts_selector_defs, ts_modules, ti_var_heap, ti_type_heaps, cs)
where
check_type_defs is_main_dcl type_index nr_of_types module_index ts ti=:{ti_type_heaps,ti_var_heap} cs
| type_index == nr_of_types
= (ts.ts_type_defs, ts.ts_cons_defs, ts.ts_selector_defs, ts.ts_modules, ti_var_heap, ti_type_heaps, cs)
# (ts, ti, cs) = checkTypeDef type_index module_index ts ti cs
= check_type_defs is_main_dcl (inc type_index) nr_of_types module_index ts ti cs
check_type_def module_index opt_icl_info type_index (ts, ti, cs)
| has_to_be_checked module_index opt_icl_info type_index
= checkTypeDef type_index module_index ts ti cs
= (ts, ti, cs)
has_to_be_checked module_index No type_index
= True
has_to_be_checked module_index (Yes ({copied_type_defs}, n_cached_dcl_mods)) type_index
= not (module_index < n_cached_dcl_mods && type_index < size copied_type_defs && copied_type_defs.[type_index])
:: OpenTypeInfo =
{ oti_heaps :: !.TypeHeaps
......@@ -1218,7 +1224,7 @@ where
-> (!*{#ClassDef}, !w:{#DclModule}, !v:[SymbolPtr], !u:Indexes, !*TypeVarHeap, !*VarHeap, !*SymbolTable)
create_class_dictionary mod_index class_index class_defs =:{[class_index] = class_def } modules rev_dictionary_list
indexes type_var_heap var_heap symbol_table
# {class_name,class_args,class_arity,class_members,class_context,class_dictionary=ds=:{ds_ident={id_name,id_info}}} = class_def
# {class_name,class_args,class_arity,class_members,class_context,class_dictionary=ds=:{ds_ident={id_name}}} = class_def
# (type_id_info, symbol_table) = newPtr EmptySymbolTableEntry symbol_table
nr_of_members = size class_members
nr_of_fields = nr_of_members + length class_context
......
......@@ -15,24 +15,16 @@ instance_def_error = "instance definition in the impl module conflicts with the
compareError message pos error_admin
= popErrorAdmin (checkError "" message (pushErrorAdmin pos error_admin))
markCheckedDefinitions :: !Int ![Index] -> *{# Bool}
markCheckedDefinitions nr_of_defs not_to_be_checked
# marks = createArray nr_of_defs True
= foldSt mark_def not_to_be_checked marks
where
mark_def index marks = { marks & [index] = False }
compareTypeDefs :: !{# Int} ![Index] !{# CheckedTypeDef} !{# ConsDef} !u:{# CheckedTypeDef} !v:{# ConsDef} !*CompareState
compareTypeDefs :: !{# Int} !{#Bool} !{# CheckedTypeDef} !{# ConsDef} !u:{# CheckedTypeDef} !v:{# ConsDef} !*CompareState
-> (!u:{# CheckedTypeDef}, !v:{# ConsDef}, !*CompareState)
compareTypeDefs dcl_sizes copied_from_dcl dcl_type_defs dcl_cons_defs icl_type_defs icl_cons_defs comp_st
# nr_of_dcl_types = dcl_sizes.[cTypeDefs]
to_be_checked = markCheckedDefinitions nr_of_dcl_types copied_from_dcl
= iFoldSt (compare_type_defs to_be_checked dcl_type_defs dcl_cons_defs) 0 nr_of_dcl_types (icl_type_defs, icl_cons_defs, comp_st)
= iFoldSt (compare_type_defs copied_from_dcl dcl_type_defs dcl_cons_defs) 0 nr_of_dcl_types (icl_type_defs, icl_cons_defs, comp_st)
where
compare_type_defs :: !{# Bool} !{# CheckedTypeDef} !{# ConsDef} !Index (!u:{# CheckedTypeDef}, !v:{# ConsDef}, !*CompareState)
-> (!u:{# CheckedTypeDef}, !v:{# ConsDef}, !*CompareState)
compare_type_defs to_be_checked dcl_type_defs dcl_cons_defs type_index (icl_type_defs, icl_cons_defs, comp_st=:{comp_type_var_heap,comp_attr_var_heap})
| to_be_checked.[type_index]
compare_type_defs copied_from_dcl dcl_type_defs dcl_cons_defs type_index (icl_type_defs, icl_cons_defs, comp_st=:{comp_type_var_heap,comp_attr_var_heap})
| not copied_from_dcl.[type_index]
# dcl_type_def = dcl_type_defs.[type_index]
(icl_type_def, icl_type_defs) = icl_type_defs![type_index]
comp_type_var_heap = initialyseATypeVars dcl_type_def.td_args comp_type_var_heap
......@@ -102,17 +94,16 @@ where
= (False, icl_cons_defs, comp_st)
compareClassDefs :: !{# Int} ![Index] !{# ClassDef} !{# MemberDef} !u:{# ClassDef} !v:{# MemberDef} !*CompareState
compareClassDefs :: !{#Int} {#Bool} !{# ClassDef} !{# MemberDef} !u:{# ClassDef} !v:{# MemberDef} !*CompareState
-> (!u:{# ClassDef}, !v:{# MemberDef}, !*CompareState)
compareClassDefs dcl_sizes copied_from_dcl dcl_class_defs dcl_member_defs icl_class_defs icl_member_defs comp_st
# nr_of_dcl_classes = dcl_sizes.[cClassDefs]
to_be_checked = markCheckedDefinitions nr_of_dcl_classes copied_from_dcl
= iFoldSt (compare_class_defs to_be_checked dcl_class_defs dcl_member_defs) 0 nr_of_dcl_classes (icl_class_defs, icl_member_defs, comp_st)
= iFoldSt (compare_class_defs copied_from_dcl dcl_class_defs dcl_member_defs) 0 nr_of_dcl_classes (icl_class_defs, icl_member_defs, comp_st)
where
compare_class_defs :: !{# Bool} {# ClassDef} {# MemberDef} !Index (!u:{# ClassDef}, !v:{# MemberDef}, !*CompareState)
-> (!u:{# ClassDef}, v:{# MemberDef}, !*CompareState)
compare_class_defs to_be_checked dcl_class_defs dcl_member_defs class_index (icl_class_defs, icl_member_defs, comp_st)
| to_be_checked.[class_index]
compare_class_defs copied_from_dcl dcl_class_defs dcl_member_defs class_index (icl_class_defs, icl_member_defs, comp_st)
| not copied_from_dcl.[class_index]
# dcl_class_def = dcl_class_defs.[class_index]
(icl_class_def, icl_class_defs) = icl_class_defs![class_index]
# (ok, icl_member_defs, comp_st) = compare_classes dcl_class_def dcl_member_defs icl_class_def icl_member_defs comp_st
......
......@@ -20,6 +20,8 @@ instance <<< [a] | <<< a
:: Optional x = Yes !x | No
hasOption :: (Optional x) -> Bool
:: Choice a b = Either a | Or b
(--->) infix :: .a !b -> .a | <<< b
......
......@@ -17,6 +17,10 @@ cMAXINT :== 2147483647
:: BITVECT :== Int
hasOption :: (Optional x) -> Bool
hasOption (Yes _) = True
hasOption No = False
instance ~ Bool
where ~ b = not b
......
......@@ -499,7 +499,7 @@ freshCopyOfAttributeVar {av_name,av_info_ptr} attr_var_heap
AVI_Attr attr
-> (attr, attr_var_heap)
_
-> abort ("freshCopyOfAttributeVar (type,icl)" ---> av_name)
-> abort ("freshCopyOfAttributeVar (type,icl)" ---> (av_name,av_info_ptr))
freshCopyOfTypeAttribute (TA_Var avar) attr_var_heap
......@@ -586,8 +586,9 @@ where
# (exi_attr_vars, attr_store, th_attrs) = fresh_existential_attribute atv_attribute (exi_attr_vars, attr_store, th_attrs)
= (exi_attr_vars, var_store, attr_store, { type_heaps & th_vars = th_vars, th_attrs = th_attrs })
fresh_existential_attribute (TA_Var {av_info_ptr}) (exi_attr_vars, attr_store, attr_heap)
fresh_existential_attribute (TA_Var {av_name,av_info_ptr}) (exi_attr_vars, attr_store, attr_heap)
= ([ attr_store : exi_attr_vars ], inc attr_store, attr_heap <:= (av_info_ptr, AVI_Attr (TA_TempVar attr_store)))
// ---> ("fresh_existential_attribute", av_info_ptr,av_name)
fresh_existential_attribute attr state
= state
......@@ -645,8 +646,9 @@ freshAlgebraicType {glob_module, glob_object} patterns common_defs ts=:{ts_var_s
// ---> ("freshAlgebraicType", alg_type, cons_types)
where
fresh_symbol_types [{ap_symbol={glob_object},ap_expr}] cons_defs var_store attr_store type_heaps all_exis_variables
# {cons_type = {st_args,st_attr_env,st_result}, cons_index, cons_exi_vars} = cons_defs.[glob_object.ds_index]
# {cons_type = ct=:{st_args,st_attr_env,st_result}, cons_index, cons_exi_vars} = cons_defs.[glob_object.ds_index]
(exis_variables, var_store, attr_store, type_heaps) = freshExistentialVariables cons_exi_vars var_store attr_store type_heaps
// -?-> (not (isEmpty cons_exi_vars), ("fresh_symbol_types", cons_exi_vars, ct))
(attr_env, th_attrs) = fresh_environment st_attr_env [] type_heaps.th_attrs
(result_type, type_heaps) = freshCopy st_result { type_heaps & th_attrs = th_attrs }
(fresh_args, type_heaps) = freshCopy st_args type_heaps
......@@ -655,8 +657,9 @@ where
fresh_symbol_types [{ap_symbol={glob_object},ap_expr} : patterns] cons_defs var_store attr_store type_heaps all_exis_variables
# (cons_types, result_type, attr_env, var_store, attr_store, type_heaps, all_exis_variables)
= fresh_symbol_types patterns cons_defs var_store attr_store type_heaps all_exis_variables
{cons_type = {st_args,st_attr_env}, cons_index, cons_exi_vars} = cons_defs.[glob_object.ds_index]
{cons_type = ct=:{st_args,st_attr_env}, cons_index, cons_exi_vars} = cons_defs.[glob_object.ds_index]
(exis_variables, var_store, attr_store, type_heaps) = freshExistentialVariables cons_exi_vars var_store attr_store type_heaps
// -?-> (not (isEmpty cons_exi_vars), ("fresh_symbol_types", cons_exi_vars, ct))
(attr_env, th_attrs) = fresh_environment st_attr_env attr_env type_heaps.th_attrs
(fresh_args, type_heaps) = freshCopy st_args { type_heaps & th_attrs = th_attrs }
all_exis_variables = add_exis_variables ap_expr exis_variables all_exis_variables
......@@ -1037,8 +1040,9 @@ determineSymbolTypeOfFunction pos ident act_arity st=:{st_args,st_result,st_attr
-> currySymbolType copy_symb_type act_arity ts
standardFieldSelectorType pos {glob_object={ds_ident,ds_index},glob_module} {ti_common_defs} ts=:{ts_var_store,ts_attr_store,ts_type_heaps,ts_exis_variables}
# {sd_type,sd_exi_vars} = ti_common_defs.[glob_module].com_selector_defs.[ds_index]
# (st=:{sd_type,sd_exi_vars}) = ti_common_defs.[glob_module].com_selector_defs.[ds_index]
(new_exis_variables, ts_var_store, ts_attr_store, ts_type_heaps) = freshExistentialVariables sd_exi_vars ts_var_store ts_attr_store ts_type_heaps
// -?-> (not (isEmpty sd_exi_vars), ("standardFieldSelectorType", sd_exi_vars, st))
ts_exis_variables = addToExistentialVariables pos new_exis_variables ts_exis_variables
ts = { ts & ts_type_heaps = ts_type_heaps, ts_var_store = ts_var_store, ts_attr_store = ts_attr_store, ts_exis_variables = ts_exis_variables }
= freshSymbolType (Yes pos) cWithFreshContextVars sd_type ti_common_defs ts
......@@ -1049,15 +1053,26 @@ standardTupleSelectorType pos {ds_index} arg_nr {ti_common_defs} ts
= freshSymbolType (Yes pos) cWithFreshContextVars { cons_type & st_args = [cons_type.st_result], st_result = cons_type.st_args !! arg_nr } ti_common_defs ts
standardRhsConstructorType pos index mod arity {ti_common_defs} ts
#! {cons_symb, cons_type, cons_exi_vars } = ti_common_defs.[mod].com_cons_defs.[index]
# cons_type = { cons_type & st_vars = mapAppend (\{atv_variable} -> atv_variable) cons_exi_vars cons_type.st_vars }
# {cons_symb, cons_type=ct=:{st_vars,st_attr_vars}, cons_exi_vars } = ti_common_defs.[mod].com_cons_defs.[index]
(st_vars, st_attr_vars) = foldSt add_vars_and_attr cons_exi_vars (st_vars, st_attr_vars)
cons_type = { ct & st_vars = st_vars, st_attr_vars = st_attr_vars }
(fresh_type, ts) = freshSymbolType (Yes pos) cWithFreshContextVars cons_type ti_common_defs ts
= currySymbolType fresh_type arity ts
where
add_vars_and_attr {atv_variable, atv_attribute} (type_variables, attr_variables)
= ([ atv_variable : type_variables ], add_attr_var atv_attribute attr_variables)
add_attr_var (TA_Var avar) attr_variables
= [ avar : attr_variables ]
add_attr_var attr attr_variables
= attr_variables
// ---> ("standardRhsConstructorType", cons_symb, fresh_type)
standardLhsConstructorType pos index mod arity {ti_common_defs} ts=:{ts_var_store,ts_attr_store,ts_type_heaps,ts_exis_variables}
# {cons_symb, cons_type, cons_exi_vars } = ti_common_defs.[mod].com_cons_defs.[index]
(new_exis_variables, ts_var_store, ts_attr_store, ts_type_heaps) = freshExistentialVariables cons_exi_vars ts_var_store ts_attr_store ts_type_heaps
// -?-> (not (isEmpty cons_exi_vars), ("standardLhsConstructorType", cons_exi_vars, cons_type))
ts_exis_variables = addToExistentialVariables pos new_exis_variables ts_exis_variables
ts = { ts & ts_type_heaps = ts_type_heaps, ts_var_store = ts_var_store, ts_attr_store = ts_attr_store, ts_exis_variables = ts_exis_variables }
= freshSymbolType No cWithFreshContextVars cons_type ti_common_defs ts
......@@ -2522,6 +2537,10 @@ getPositionOfExpr expr var_heap
empty_id =: { id_name = "", id_info = nilPtr }
instance <<< (Ptr a)
where
(<<<) file ptr = file <<< ptrToInt ptr
instance <<< AttrCoercion
where
(<<<) file {ac_demanded,ac_offered} = file <<< "AttrCoercion: " <<< ac_demanded <<< '~' <<< ac_offered
......
Markdown is supported
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