diff options
-rw-r--r-- | frontend/compilerSwitches.dcl | 1 | ||||
-rw-r--r-- | frontend/frontend.icl | 51 | ||||
-rw-r--r-- | frontend/parse.icl | 12 |
3 files changed, 25 insertions, 39 deletions
diff --git a/frontend/compilerSwitches.dcl b/frontend/compilerSwitches.dcl index 00cab48..417d562 100644 --- a/frontend/compilerSwitches.dcl +++ b/frontend/compilerSwitches.dcl @@ -2,5 +2,4 @@ definition module compilerSwitches SwitchPreprocessor preprocessor no_preprocessor :== preprocessor -SwitchGenerics on off :== on SwitchGenericInfo on off :== on diff --git a/frontend/frontend.icl b/frontend/frontend.icl index 8e8dd78..ddf7573 100644 --- a/frontend/frontend.icl +++ b/frontend/frontend.icl @@ -133,17 +133,13 @@ frontEndInterface options mod_ident search_paths cached_dcl_modules cached_dcl_m dcl_common_defs dcl_mods = {dcl_common \\ {dcl_common} <-: dcl_mods } - #! (ti_common_defs, components, fun_defs, generic_ranges, td_infos, heaps, hash_table, predef_symbols, dcl_mods, error_admin) = - SwitchGenerics - (case options.feo_generics of - True -> - convertGenerics - main_dcl_module_n icl_used_module_numbers ti_common_defs components fun_defs td_infos - heaps hash_table predef_symbols dcl_mods error_admin - False -> - (ti_common_defs, components, fun_defs, [], td_infos, heaps, hash_table, predef_symbols, dcl_mods, error_admin) - ) - (ti_common_defs, components, fun_defs, [], td_infos, heaps, hash_table, predef_symbols, dcl_mods, error_admin) + #! (ti_common_defs, components, fun_defs, generic_ranges, td_infos, heaps, hash_table, predef_symbols, dcl_mods, error_admin) + = case options.feo_generics of + True + -> convertGenerics main_dcl_module_n icl_used_module_numbers ti_common_defs components fun_defs + td_infos heaps hash_table predef_symbols dcl_mods error_admin + False + -> (ti_common_defs, components, fun_defs, [], td_infos, heaps, hash_table, predef_symbols, dcl_mods, error_admin) # (icl_common, ti_common_defs) = replace copied_ti_common_defs main_dcl_module_n saved_main_dcl_common with copied_ti_common_defs :: .{#CommonDefs} // needed for Clean 2.0 to disambiguate overloading of replace @@ -195,12 +191,7 @@ frontEndInterface options mod_ident search_paths cached_dcl_modules cached_dcl_m predef_symbols hash_table files error io out tcl_file icl_mod dcl_mods fun_defs components array_instances heaps # (stdStrictLists_module_n,predef_symbols) = get_StdStrictLists_module_n predef_symbols - with - get_StdStrictLists_module_n predef_symbols - # (pre_mod,predef_symbols) = predef_symbols![PD_StdStrictLists] - | pre_mod.pds_def<>NoIndex - = (pre_mod.pds_def,predef_symbols) - = (-1,predef_symbols) + # (cleanup_info, acc_args, components, fun_defs, var_heap, expression_heap) = analyseGroups common_defs imported_funs array_instances.ali_instances_range main_dcl_module_n stdStrictLists_module_n (components -*-> "Analyse") fun_defs var_heap expression_heap @@ -212,19 +203,13 @@ frontEndInterface options mod_ident search_paths cached_dcl_modules cached_dcl_m # error_admin = {ea_file = error, ea_loc = [], ea_ok = True } # {dcl_instances,dcl_specials,dcl_gencases,dcl_type_funs} = dcl_mods.[main_dcl_module_n] - # (start_rule_index,predef_symbols) = get_index_of_start_rule predef_symbols - with - get_index_of_start_rule predef_symbols - # ({pds_def, pds_module}, predef_symbols) = predef_symbols![PD_Start] - | pds_def <> NoIndex && pds_module == main_dcl_module_n - = (pds_def, predef_symbols) - = (NoIndex, predef_symbols) + # (start_function_index,predef_symbols) = get_index_of_start_rule main_dcl_module_n predef_symbols # (error_admin,predef_symbols,fun_defs) = checkForeignExportedFunctionTypes icl_foreign_exports error_admin predef_symbols fun_defs # [icl_exported_global_functions,icl_not_exported_global_functions:_] = icl_global_functions - # exported_global_functions = case start_rule_index of + # exported_global_functions = case start_function_index of NoIndex -> [icl_exported_global_functions] sri -> [{ir_from=sri,ir_to=inc sri},icl_exported_global_functions] # exported_functions = exported_global_functions ++ [dcl_instances,dcl_specials,dcl_gencases,dcl_type_funs] @@ -248,7 +233,7 @@ frontEndInterface options mod_ident search_paths cached_dcl_modules cached_dcl_m # (components,fun_defs,files) = case options.feo_dump_core of // True -// -> dumpCore components start_rule_index exported_global_functions icl_mod dcl_mods.[main_dcl_module_n] fun_defs acc_args def_min def_max files +// -> dumpCore components start_function_index exported_global_functions icl_mod dcl_mods.[main_dcl_module_n] fun_defs acc_args def_min def_max files _ -> (components,fun_defs,files) @@ -324,6 +309,18 @@ frontEndInterface options mod_ident search_paths cached_dcl_modules cached_dcl_m # cached_dcl_macros_i = {cached_dcl_macros_i & [j].fun_info.fi_group_index= (-1)} = clear_group_indices2 (j+1) cached_dcl_macros_i + get_StdStrictLists_module_n predef_symbols + # (pre_mod,predef_symbols) = predef_symbols![PD_StdStrictLists] + | pre_mod.pds_def<>NoIndex + = (pre_mod.pds_def,predef_symbols) + = (-1,predef_symbols) + + get_index_of_start_rule main_dcl_module_n predef_symbols + # ({pds_def, pds_module}, predef_symbols) = predef_symbols![PD_Start] + | pds_def <> NoIndex && pds_module == main_dcl_module_n + = (pds_def, predef_symbols) + = (NoIndex, predef_symbols) + newSymbolTable :: !Int -> *{# SymbolTableEntry} newSymbolTable size = createArray size { ste_index = NoIndex, ste_def_level = -1, ste_kind = STE_Empty, ste_previous = abort "PreviousPlaceholder"} @@ -351,7 +348,7 @@ showMacrosInModule dcl_index (macro_defs,file) # (macro,macro_defs) = macro_defs![dcl_index,macro_index] = (macro_defs, file <<< macro_index <<< macro <<< '\n') -showComponents :: !*{! Group} !Int !Bool !*{# FunDef} !*File -> (!*{! Group}, !*{# FunDef},!*File) +showComponents :: !u:{! Group} !Int !Bool !*{# FunDef} !*File -> (!u:{! Group}, !*{# FunDef},!*File) showComponents comps comp_index show_types fun_defs file | comp_index >= size comps = (comps, fun_defs, file) diff --git a/frontend/parse.icl b/frontend/parse.icl index 21fd4c7..a020dba 100644 --- a/frontend/parse.icl +++ b/frontend/parse.icl @@ -1519,8 +1519,6 @@ optionalCoercions pState wantGenericDefinition :: !ParseContext !Position !ParseState -> (!ParsedDefinition, !ParseState) wantGenericDefinition parseContext pos pState - | SwitchGenerics False True - = (PD_Erroneous, parseErrorSimple "generic definition" "generics are not supported by this compiler" pState) | not pState.ps_support_generics = (PD_Erroneous, parseErrorSimple "generic definition" "to enable generics use the command line flag -generics" pState) # (name, pState) = want_name pState @@ -1557,8 +1555,6 @@ wantGenericDefinition parseContext pos pState wantDeriveDefinition :: !ParseContext !Position !*ParseState -> (!ParsedDefinition, !*ParseState) wantDeriveDefinition parseContext pos pState - | SwitchGenerics False True - = (PD_Erroneous, parseErrorSimple "generic definition" "generics are not supported by this compiler" pState) | not pState.ps_support_generics = (PD_Erroneous, parseErrorSimple "generic definition" "to enable generics use the command line flag -generics" pState) # (name, pState) = want_name pState @@ -1730,7 +1726,7 @@ where = (PD_Type td, tokenBack pState) # name = td.td_ident.id_name = (PD_Type { td & td_rhs = EmptyRhs cAllBitsClear}, parseError "abstract type" No ("type attribute "+toString td_attribute+" for abstract type "+name+" is not") (tokenBack pState)) - + verify_annot_attr :: !Annotation !TypeAttribute !String !ParseState -> ParseState verify_annot_attr annot attr name pState | annot <> AN_None @@ -1759,7 +1755,6 @@ where (token, pState) = nextToken TypeContext pState | token == BarToken # (exi_vars, pState) = optionalExistentialQuantifiedVariables pState -// MW (token, pState) = nextToken TypeContext pState (token, pState) = nextToken GeneralContext pState (cons_list, pState) = want_constructor_list exi_vars token pState = ([cons : cons_list], pState) @@ -1836,7 +1831,6 @@ warnAnnotAndOptionalAttr pState // JVG added for strict lists: | token==SquareCloseToken = (False,TA_None,tokenBack (tokenBack pState)) -// Sjaak (_ , attr, pState) = optional_attribute token pState # (_ , attr, pState) = tryAttribute token pState # pState = parseWarning "" "! ignored" pState = (True, attr, pState) @@ -1851,7 +1845,6 @@ optionalAnnotAndAttr pState // JVG added for strict lists: | token==SquareCloseToken = (False,AN_None,TA_None,tokenBack (tokenBack pState)) -// Sjaak (_ , attr, pState) = optional_attribute token pState # (_ , attr, pState) = tryAttribute token pState = (True, AN_Strict, attr, pState) | otherwise // token <> ExclamationToken @@ -1866,7 +1859,6 @@ optionalAnnotAndAttrWithPosition pState // JVG added for strict lists: | token==SquareCloseToken = (False,NoAnnot,TA_None,tokenBack (tokenBack pState)) -// Sjaak (_ , attr, pState) = optional_attribute token pState # (position,pState) = getPosition pState # (_ , attr, pState) = tryAttribute token pState = (True, StrictAnnotWithPosition position, attr, pState) @@ -3946,8 +3938,6 @@ wantBeginGroup msg pState // AA.. wantKind :: !ParseState -> (!TypeKind, !ParseState) wantKind pState - | SwitchGenerics False True - = (KindConst, parseErrorSimple "kind" "generics are not supported by this compiler" pState) | not pState.ps_support_generics = (KindConst, parseErrorSimple "kind" "to enable generics use -generics command line flag" pState) # (token, pState) = nextToken TypeContext pState |