aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--frontend/compilerSwitches.dcl1
-rw-r--r--frontend/frontend.icl51
-rw-r--r--frontend/parse.icl12
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