diff options
| -rw-r--r-- | frontend/check.icl | 10 | ||||
| -rw-r--r-- | frontend/comparedefimp.dcl | 2 | ||||
| -rw-r--r-- | frontend/comparedefimp.icl | 98 | ||||
| -rw-r--r-- | frontend/syntax.dcl | 3 | ||||
| -rw-r--r-- | frontend/syntax.icl | 3 |
5 files changed, 66 insertions, 50 deletions
diff --git a/frontend/check.icl b/frontend/check.icl index 6b3461d..480b3f0 100644 --- a/frontend/check.icl +++ b/frontend/check.icl @@ -1118,7 +1118,7 @@ where #! {cons_type={st_arity},cons_priority} = com_cons_defs.[def_index] # def_index = convertIndex def_index (toInt STE_Constructor) dcl_conversions = (SK_Constructor { glob_object = def_index, glob_module = mod_index }, st_arity, cons_priority, cIsNotAFunction) - + determine_info_of_symbol {ste_kind=STE_Member, ste_index} _ e_input=:{ei_mod_index} e_state e_info=:{ef_member_defs} cs #! {me_type={st_arity},me_priority} = ef_member_defs.[ste_index] = (SK_OverloadedFunction { glob_object = ste_index, glob_module = ei_mod_index}, st_arity, me_priority, cIsAFunction, e_state, e_info, cs) @@ -2630,6 +2630,7 @@ checkModule {mod_type,mod_name,mod_imports,mod_imported_objects,mod_defs = cdefs (dcl_modules, class_instances, icl_functions, cs_predef_symbols) = adjust_instance_types_of_array_functions_in_std_array_icl dcl_modules class_instances icl_functions cs_predef_symbols + (untransformed_macro_funs_defs, icl_functions) = memcpy {ir_from = nr_of_global_funs, ir_to = first_inst_index } icl_functions (groups, icl_functions, dcl_modules, var_heap, expr_heap, cs_symbol_table, cs_error) = partitionateAndLiftFunctions [icl_global_function_range, icl_instances] cIclModIndex icl_functions dcl_modules var_heap expr_heap cs_symbol_table cs_error @@ -2642,7 +2643,7 @@ checkModule {mod_type,mod_name,mod_imports,mod_imported_objects,mod_defs = cdefs heaps = { heaps & hp_var_heap = var_heap, hp_expression_heap = expr_heap, hp_type_heaps = {hp_type_heaps & th_vars = th_vars}} (dcl_modules, icl_mod, heaps, cs_error) - = compareDefImp dcl_modules icl_mod heaps cs_error // MW++ + = compareDefImp (nr_of_global_funs, untransformed_macro_funs_defs) dcl_modules icl_mod heaps cs_error = (cs_error.ea_ok, icl_mod, dcl_modules, groups, dcl_icl_conversions, heaps, cs_predef_symbols, cs_symbol_table, cs_error.ea_file) # icl_common = { icl_common & com_type_defs = e_info.ef_type_defs, com_selector_defs = e_info.ef_selector_defs, com_class_defs = e_info.ef_class_defs, @@ -2831,6 +2832,11 @@ checkModule {mod_type,mod_name,mod_imports,mod_imported_objects,mod_defs = cdefs (Yes symbol_type) = inst_def.fun_type = { instance_defs & [ds_index] = { inst_def & fun_type = Yes (makeElemTypeOfArrayFunctionStrict symbol_type ins_offset offset_table) } } + memcpy :: !IndexRange !*{# FunDef} -> (!.{FunDef}, !*{# FunDef}) + memcpy {ir_from, ir_to} fun_defs + # new = createArray (ir_to-ir_from) (abort "check.icl: don't make that array strict !") + = iFoldSt (\i (dst, src=:{[i]=src_i})->({ dst & [i-ir_from] = src_i }, src)) ir_from ir_to (new, fun_defs) + check_needed_modules_are_imported mod_name extension cs=:{cs_needed_modules} # cs = case cs_needed_modules bitand cNeedStdDynamics of 0 -> cs diff --git a/frontend/comparedefimp.dcl b/frontend/comparedefimp.dcl index 242bf34..9cfd6ab 100644 --- a/frontend/comparedefimp.dcl +++ b/frontend/comparedefimp.dcl @@ -4,6 +4,6 @@ import syntax, checksupport // compare definition and implementation module -compareDefImp :: !*{# DclModule} !*IclModule !*Heaps !*ErrorAdmin +compareDefImp :: !(!Int, !{FunDef}) !*{# DclModule} !*IclModule !*Heaps !*ErrorAdmin -> (!.{# DclModule}, !.IclModule,!.Heaps,!.ErrorAdmin) diff --git a/frontend/comparedefimp.icl b/frontend/comparedefimp.icl index 296ab9c..0c36b74 100644 --- a/frontend/comparedefimp.icl +++ b/frontend/comparedefimp.icl @@ -53,6 +53,8 @@ import RWSDebug :: !.ErrorAdmin , ec_tc_state :: !.TypesCorrespondState + , ec_untransformed + :: !(!Int, !{ FunDef }) } :: ExpressionsCorrespondMonad @@ -82,9 +84,9 @@ class CorrespondenceNumber a where initial_hwn hwn_heap = { hwn_heap = hwn_heap, hwn_number = 0 } -compareDefImp :: !*{# DclModule} !*IclModule !*Heaps !*ErrorAdmin +compareDefImp :: !(!Int, !{FunDef}) !*{# DclModule} !*IclModule !*Heaps !*ErrorAdmin -> (!.{# DclModule}, !.IclModule,!.Heaps,!.ErrorAdmin) -compareDefImp dcl_modules icl_module heaps error_admin +compareDefImp untransformed dcl_modules icl_module heaps error_admin # (main_dcl_module, dcl_modules) = dcl_modules![cIclModIndex] = case main_dcl_module.dcl_conversions of No -> (dcl_modules, icl_module, heaps, error_admin) @@ -98,7 +100,7 @@ compareDefImp dcl_modules icl_module heaps error_admin com_selector_defs=icl_com_selector_defs, com_class_defs=icl_com_class_defs, com_member_defs=icl_com_member_defs, com_instance_defs = icl_com_instance_defs } = icl_common - (icl_type_defs, icl_com_type_defs) = copy icl_com_type_defs + (icl_type_defs, icl_com_type_defs) = memcpy icl_com_type_defs tc_state = { tc_type_vars = initial_hwn th_vars , tc_attr_vars = initial_hwn th_attrs @@ -125,11 +127,10 @@ compareDefImp dcl_modules icl_module heaps error_admin (icl_com_instance_defs, tc_state, error_admin) = compareWithConversions conversion_table.[cInstanceDefs] dcl_common.com_instance_defs icl_com_instance_defs tc_state error_admin -/* XXX macro comparision doesn't work yet (icl_functions, hp_var_heap, hp_expression_heap, tc_state, error_admin) - = compareMacrosWithConversion conversion_table.[cMacroDefs] dcl_macros + = compareMacrosWithConversion conversion_table.[cMacroDefs] dcl_macros untransformed icl_functions hp_var_heap hp_expression_heap tc_state error_admin -*/ + (icl_functions, tc_state, error_admin) = compareFunctionTypesWithConversions conversion_table.[cFunctionDefs] dcl_functions icl_functions tc_state error_admin @@ -145,17 +146,11 @@ compareDefImp dcl_modules icl_module heaps error_admin -> ( tc_dcl_modules, { icl_module & icl_common = icl_common, icl_functions = icl_functions }, heaps, error_admin ) where - copy original + memcpy :: !*{#CheckedTypeDef} -> (!.{CheckedTypeDef}, !.{#CheckedTypeDef}) + memcpy original #! size = size original # new = createArray size (abort "don't make that array strict !") - = memcpy size new original - memcpy :: !Int !*{CheckedTypeDef} !*{#CheckedTypeDef} -> (!.{CheckedTypeDef}, !.{#CheckedTypeDef}) - memcpy 0 dst src - = (dst, src) - memcpy i dst src - # i1 = i-1 - (src_i1, src) = src![i1] - = memcpy i1 { dst & [i1] = src_i1 } src + = iFoldSt (\i (dst, src=:{[i]=src_i}) -> ({ dst & [i] = src_i }, src)) 0 size (new, original) compareWithConversions conversions dclDefs iclDefs tc_state error_admin = iFoldSt (compareWithConversion conversions dclDefs) 0 (size conversions) (iclDefs, tc_state, error_admin) @@ -164,7 +159,10 @@ compareWithConversion :: !w:(a x:Int) !.(b c) !Int !(!u:(d c), !*TypesCorrespond -> (!v:(d c), !.TypesCorrespondState, !.ErrorAdmin) | Array .b & getIdentPos , select_u , t_corresponds , uselect_u c & Array .d & Array .a, [u <= v, w <= x]; compareWithConversion conversions dclDefs dclIndex (iclDefs, tc_state, error_admin) - # (iclDef, iclDefs) = iclDefs![conversions.[dclIndex]] + # icl_index = conversions.[dclIndex] + | icl_index==dclIndex + = (iclDefs, tc_state, error_admin) + # (iclDef, iclDefs) = iclDefs![icl_index] (corresponds, tc_state) = t_corresponds dclDefs.[dclIndex] iclDef tc_state | corresponds = (iclDefs, tc_state, error_admin) @@ -208,12 +206,13 @@ generate_error message iclDef iclDefs tc_state error_admin error_admin = checkError ident_pos.ip_ident message error_admin = (iclDefs, tc_state, popErrorAdmin error_admin) -compareMacrosWithConversion conversions macro_range icl_functions var_heap expr_heap tc_state error_admin +compareMacrosWithConversion conversions macro_range untransformed icl_functions var_heap expr_heap tc_state error_admin #! nr_of_functions = size icl_functions # correspondences = createArray nr_of_functions cNoCorrespondence ec_state = { ec_correspondences = correspondences, ec_var_heap = initial_hwn var_heap, ec_expr_heap = expr_heap, ec_icl_functions = icl_functions, - ec_error_admin = error_admin, ec_tc_state = tc_state } + ec_error_admin = error_admin, ec_tc_state = tc_state, + ec_untransformed = untransformed } ec_state = iFoldSt (compareMacroWithConversion conversions macro_range.ir_from) macro_range.ir_from macro_range.ir_to ec_state {ec_icl_functions, ec_var_heap, ec_expr_heap, ec_error_admin, ec_tc_state} = ec_state @@ -224,15 +223,32 @@ compareMacroWithConversion conversions ir_from dclIndex ec_state compareTwoMacroFuns :: !.Int !.Int !*ExpressionsCorrespondState -> .ExpressionsCorrespondState; compareTwoMacroFuns dclIndex iclIndex - ec_state=:{ec_correspondences, ec_icl_functions, ec_error_admin} + ec_state=:{ec_correspondences, ec_icl_functions, ec_untransformed} + | dclIndex==iclIndex + = ec_state # (dcl_function, ec_icl_functions) = ec_icl_functions![dclIndex] (icl_function, ec_icl_functions) = ec_icl_functions![iclIndex] ec_correspondences = { ec_correspondences & [dclIndex]=iclIndex, [iclIndex]=dclIndex } + ec_state = { ec_state & ec_correspondences = ec_correspondences, ec_icl_functions = ec_icl_functions } + need_to_be_compared + = case (dcl_function.fun_body, icl_function.fun_body) of + (TransformedBody _, CheckedBody _) + // the macro definition in the icl module is not used, so we don't need to compare + -> False + _ -> True + | not need_to_be_compared + = ec_state + # adjusted_icl_function + = case (dcl_function.fun_body, icl_function.fun_body) of + (CheckedBody _, TransformedBody _) + // the macro definition in the icl module is has been transformed but not the dcl + // module's definition: use the untransformed icl original for comparision + # (offset, untransformed_icl_functions) = ec_untransformed + -> untransformed_icl_functions.[iclIndex-offset] + _ -> icl_function ident_pos = getIdentPos dcl_function - ec_error_admin = pushErrorAdmin ident_pos ec_error_admin - ec_state = { ec_state & ec_correspondences = ec_correspondences, - ec_icl_functions = ec_icl_functions, ec_error_admin = ec_error_admin } - ec_state = e_corresponds dcl_function icl_function ec_state + ec_error_admin = pushErrorAdmin ident_pos ec_state.ec_error_admin + ec_state = e_corresponds dcl_function adjusted_icl_function { ec_state & ec_error_admin = ec_error_admin } = { ec_state & ec_error_admin = popErrorAdmin ec_state.ec_error_admin } instance getIdentPos (TypeDef a) where @@ -266,7 +282,9 @@ instance getIdentPos FunDef where instance CorrespondenceNumber VarInfo where toCorrespondenceNumber (VI_CorrespondenceNumber number) = CorrespondenceNumber number - toCorrespondenceNumber VI_Empty + toCorrespondenceNumber _ + // VarInfoPtrs are not initialized in this module. This doesnt harm because VI_CorrespondenceNumber should + // not be used outside this module = Unbound fromCorrespondenceNumber number @@ -350,12 +368,6 @@ instance t_corresponds (TypeDef TypeRhs) where = t_corresponds_TypeDef dclDef iclDef where t_corresponds_TypeDef dclDef iclDef tc_state - // sanity check ... - | dclDef.td_arity <> length dclDef.td_args - = undef <<- "t_corresponds (TypeDef): dclDef.td_arity <> length dclDef.td_args" - | iclDef.td_arity <> length iclDef.td_args - = undef <<- "t_corresponds (TypeDef): iclDef.td_arity <> length iclDef.td_args" - // ... sanity check # tc_state = { tc_state & tc_visited_syn_types.[dclDef.td_index] = True } tc_state = init_attr_vars dclDef.td_attrs tc_state tc_state = init_attr_vars iclDef.td_attrs tc_state @@ -548,17 +560,8 @@ instance t_corresponds Type where = t_corresponds dclDef iclDef t_corresponds (GTV dclDef) (GTV iclDef) = t_corresponds dclDef iclDef - t_corresponds dclDef iclDef - = type_var_bindings_correspond dclDef iclDef - where - type_var_bindings_correspond (TV {tv_info_ptr}) icl_type tc_state - #! tvi = sreadPtr tv_info_ptr tc_state.tc_type_vars.hwn_heap - = case tvi of - TVI_Type dcl_type - -> t_corresponds dcl_type icl_type tc_state - _ -> (True, tc_state) - type_var_bindings_correspond _ _ tc_state - = (False, tc_state) + t_corresponds _ _ + = return False instance t_corresponds ConsVariable where t_corresponds (CV dclVar) (CV iclVar) @@ -700,12 +703,15 @@ instance e_corresponds DefinedSymbol where = equal2 dclDef.ds_ident iclDef.ds_ident instance e_corresponds FunDef where + // both bodies are either CheckedBodies or TransformedBodies e_corresponds dclDef iclDef - = e_corresponds (fromBody dclDef.fun_body) (fromBody iclDef.fun_body) +// | False--->("compare", dclDef, iclDef) +// = undef + = e_corresponds (from_body dclDef.fun_body) (from_body iclDef.fun_body) where - fromBody (TransformedBody {tb_args, tb_rhs}) = (tb_args, [tb_rhs]) - fromBody (CheckedBody {cb_args, cb_rhs}) = (cb_args, cb_rhs) - + from_body (TransformedBody {tb_args, tb_rhs}) = (tb_args, [tb_rhs]) + from_body (CheckedBody {cb_args, cb_rhs}) = (cb_args, cb_rhs) + instance e_corresponds TransformedBody where e_corresponds dclDef iclDef = e_corresponds dclDef.tb_args iclDef.tb_args @@ -767,6 +773,8 @@ instance e_corresponds Expression where = e_corresponds dcl icl e_corresponds (TypeCodeExpression dcl) (TypeCodeExpression icl) = e_corresponds dcl icl + e_corresponds EE EE + = do_nothing e_corresponds _ _ = give_error "" diff --git a/frontend/syntax.dcl b/frontend/syntax.dcl index 816ffce..f48ef89 100644 --- a/frontend/syntax.dcl +++ b/frontend/syntax.dcl @@ -450,7 +450,8 @@ cIsALocalVar :== False VI_ClassVar !Ident !VarInfoPtr !Int | /* to hold dictionary variables during overloading */ VI_ForwardClassVar !VarInfoPtr | /* to hold the dictionary variable generated during overloading */ VI_Forward !BoundVar | VI_LetVar !LetVarInfo | VI_LetExpression !LetExpressionInfo | VI_CaseVar !VarInfoPtr | - VI_CorrespondenceNumber !Int | VI_SequenceNumber !Int | + VI_CorrespondenceNumber !Int | /* it is assumed that this alternative is _only_ used in module comparedefimp */ + VI_SequenceNumber !Int | VI_Used | /* for indicating that an imported function has been used */ VI_PropagationType !SymbolType | /* for storing the type with propagation environment of an imported function */ VI_ExpandedType !SymbolType | /* for storing the (expanded) type of an imported function */ diff --git a/frontend/syntax.icl b/frontend/syntax.icl index 548f3fd..51d1fab 100644 --- a/frontend/syntax.icl +++ b/frontend/syntax.icl @@ -427,7 +427,8 @@ cIsALocalVar :== False VI_ClassVar !Ident !VarInfoPtr !Int | /* to hold dictionary variables during overloading */ VI_ForwardClassVar !VarInfoPtr | /* to hold the dictionary variable generated during overloading */ VI_Forward !BoundVar | VI_LetVar !LetVarInfo | VI_LetExpression !LetExpressionInfo | VI_CaseVar !VarInfoPtr | - VI_CorrespondenceNumber !Int | VI_SequenceNumber !Int | + VI_CorrespondenceNumber !Int | /* it is assumed that this alternative is _only_ used in module comparedefimp */ + VI_SequenceNumber !Int | VI_Used | /* for indicating that an imported function has been used */ VI_PropagationType !SymbolType | /* for storing the type with propagation environment of an imported function */ VI_ExpandedType !SymbolType | /* for storing the (expanded) type of an imported function */ |