Commit cb25cd5b authored by clean's avatar clean
Browse files

optimizations and caching of dcl modules (without trans.icl)

parent e86f457f
......@@ -117,6 +117,7 @@ where
= compare_indexes symb1 symb2
with
compare_indexes (SK_Function i1) (SK_Function i2) = i1 =< i2
compare_indexes (SK_LocalMacroFunction i1) (SK_LocalMacroFunction i2) = i1 =< i2
// compare_indexes (SK_ClassRecord i1) (SK_ClassRecord i2) = i1 =< i2
compare_indexes (SK_Constructor i1) (SK_Constructor i2) = i1 =< i2
// compare_indexes (SK_DeltaFunction i1) (SK_DeltaFunction i2) = i1 =< i2
......
......@@ -2,7 +2,6 @@ definition module analtypes
import checksupport, typesupport
analTypeDefs :: !{#CommonDefs} !*TypeHeaps !*ErrorAdmin -> (!*TypeDefInfos, !*TypeHeaps, !*ErrorAdmin)
analTypeDefs :: !{#CommonDefs} !ModuleNumberSet !*TypeHeaps !*ErrorAdmin -> (!*TypeDefInfos, !*TypeHeaps, !*ErrorAdmin)
instance <<< TypeKind
......@@ -243,9 +243,11 @@ where
check_types_of_cons :: ![AType] !Bool !Index !Level ![TypeVar] !TypeAttribute ![AttrInequality] !Conditions !*TypeSymbols !*TypeInfo !*CheckState
-> *(![AType], ![[ATypeVar]], ![AttrInequality], !TypeProperties, !Conditions, !Int, !*TypeSymbols, !*TypeInfo, !*CheckState)
*/
new_local_kind_variables :: .[ATypeVar] *(*Heap TypeVarInfo,*Heap .KindInfo) -> (!Bool,!.Heap TypeVarInfo,!.Heap KindInfo);
new_local_kind_variables td_args (type_var_heap, as_kind_heap)
= foldSt new_kind td_args (True, type_var_heap, as_kind_heap)
where
new_kind :: ATypeVar *(.Bool,*Heap TypeVarInfo,*Heap .KindInfo) -> (!Bool,!.Heap TypeVarInfo,!.Heap KindInfo);
new_kind {atv_variable={tv_info_ptr},atv_attribute} (coercible, type_var_heap, kind_heap)
# (kind_info_ptr, kind_heap) = newPtr KI_Const kind_heap
= (coercible && is_not_a_variable atv_attribute, type_var_heap <:= (tv_info_ptr, TVI_TypeKind kind_info_ptr),
......@@ -293,6 +295,7 @@ emptyIdent name :== { id_name = name, id_info = nilPtr }
newKindVariables td_args (type_var_heap, as_kind_heap)
= mapSt new_kind td_args (type_var_heap, as_kind_heap)
where
new_kind :: ATypeVar *(*Heap TypeVarInfo,*Heap .KindInfo) -> (!.TypeKind,!(!.Heap TypeVarInfo,!.Heap KindInfo));
new_kind {atv_variable={tv_info_ptr}} (type_var_heap, kind_heap)
# (kind_info_ptr, kind_heap) = newPtr KI_Const kind_heap
= (KindVar kind_info_ptr, (type_var_heap <:= (tv_info_ptr, TVI_TypeKind kind_info_ptr), kind_heap <:= (kind_info_ptr, KI_Var kind_info_ptr)))
......@@ -451,13 +454,16 @@ where
is_a_top_var var_number []
= False
//import RWSDebug
analTypeDefs :: !{#CommonDefs} !*TypeHeaps !*ErrorAdmin -> (!*TypeDefInfos, !*TypeHeaps, !*ErrorAdmin)
analTypeDefs modules heaps error
analTypeDefs :: !{#CommonDefs} !ModuleNumberSet !*TypeHeaps !*ErrorAdmin -> (!*TypeDefInfos, !*TypeHeaps, !*ErrorAdmin)
analTypeDefs modules used_module_numbers heaps error
// #! modules = modules ---> "analTypeDefs"
# sizes = [ size mod.com_type_defs - size mod.com_class_defs \\ mod <-: modules ]
// # sizes = [ size mod.com_type_defs - size mod.com_class_defs \\ mod <-: modules ]
// # used_module_numbers = used_module_numbers <<- used_module_numbers
# sizes = [ if (in_module_number_set module_n used_module_numbers) (size mod.com_type_defs - size mod.com_class_defs) 0 \\ mod <-: modules & module_n<-[0..]]
check_marks = { createArray nr_of_types AS_NotChecked \\ nr_of_types <- sizes }
check_marks = { createArray nr_of_types AS_NotChecked \\ nr_of_types <- sizes }
type_def_infos = { createArray nr_of_types EmptyTypeDefInfo \\ nr_of_types <- sizes }
as = { as_check_marks = check_marks, as_kind_heap = newHeap, as_heaps = heaps, as_td_infos = type_def_infos,
......@@ -472,7 +478,6 @@ where
anal_type_defs _ _ [] as
= as
anal_type_def modules mod_index type_index as=:{as_check_marks}
| as_check_marks.[mod_index].[type_index] == AS_NotChecked
# (_, (_, as)) = analTypeDef modules mod_index type_index as
......
......@@ -11,4 +11,3 @@ signClassification :: !Index !Index ![SignClassification] !{# CommonDefs } !*T
propClassification :: !Index !Index ![PropClassification] !{# CommonDefs } !*TypeVarHeap !*TypeDefInfos
-> (!PropClassification, !*TypeVarHeap, !*TypeDefInfos)
......@@ -60,7 +60,7 @@ removeTopClasses _ _
, scs_rec_appls :: ![RecTypeApplication (Sign, [SignClassification])]
}
determineSignClassOfTypeDef :: !Int !Int ![ATypeVar] !TypeDefInfo ![SignClassification] {# CommonDefs} !*TypeVarHeap !*TypeDefInfos
determineSignClassOfTypeDef :: !Int !Int ![ATypeVar] !TypeDefInfo ![SignClassification] !{# CommonDefs} !*TypeVarHeap !*TypeDefInfos
-> (!SignClassification, !*TypeVarHeap,!*TypeDefInfos)
determineSignClassOfTypeDef type_index module_index td_args {tdi_classification,tdi_cons_vars,tdi_group_vars,tdi_group,tdi_group_nr}
hio_signs ci type_var_heap td_infos
......@@ -309,8 +309,7 @@ propClassification type_index module_index hio_props defs type_var_heap td_infos
(td_info, td_infos) = td_infos![module_index].[type_index]
= determinePropClassOfTypeDef type_index module_index td_args td_info hio_props defs type_var_heap td_infos
determinePropClassOfTypeDef :: !Int !Int ![ATypeVar] !TypeDefInfo ![PropClassification] {# CommonDefs} !*TypeVarHeap !*TypeDefInfos
determinePropClassOfTypeDef :: !Int !Int ![ATypeVar] !TypeDefInfo ![PropClassification] !{# CommonDefs} !*TypeVarHeap !*TypeDefInfos
-> (!PropClassification,!*TypeVarHeap, !*TypeDefInfos)
determinePropClassOfTypeDef type_index module_index td_args {tdi_classification, tdi_kinds, tdi_group, tdi_group_vars, tdi_cons_vars, tdi_group_nr}
hio_props ci type_var_heap td_infos
......
......@@ -4,8 +4,8 @@ import syntax, transform, checksupport, typesupport, predef
cPredefinedModuleIndex :== 1
checkModule :: !ScannedModule !IndexRange ![FunDef] !ScannedModule !ScannedModule ![ScannedModule] !*PredefinedSymbols !*SymbolTable !*File
-> (!Bool, !*IclModule, *{# DclModule}, *{! Group}, !(Optional {# Index}), !*Heaps, !*PredefinedSymbols, !*SymbolTable, *File)
checkModule :: !ScannedModule !IndexRange ![FunDef] !Int !Int !(Optional ScannedModule) ![ScannedModule] !{#DclModule} !{#FunDef} !*PredefinedSymbols !*SymbolTable !*File !*Heaps
-> (!Bool, !*IclModule, *{# DclModule}, *{! Group}, !(Optional {# Index}), !.{#FunDef},!Int, !*Heaps, !*PredefinedSymbols, !*SymbolTable, *File)
retrieveGlobalDefinition :: !SymbolTableEntry !STE_Kind !Index -> (!Index, !Index)
......
This diff is collapsed.
......@@ -3,8 +3,7 @@ definition module checksupport
import StdEnv
import syntax, predef
cIclModIndex :== 0
//cIclModIndex :== 0
CS_NotChecked :== -1
NotFound :== -1
......@@ -31,8 +30,9 @@ cNeedStdDynamics:== 4
:: ErrorAdmin = { ea_file :: !.File, ea_loc :: ![IdentPos], ea_ok :: !Bool }
:: CheckState = { cs_symbol_table :: !.SymbolTable, cs_predef_symbols :: !.PredefinedSymbols, cs_error :: !.ErrorAdmin,
cs_needed_modules :: !BITVECT } // MW++
:: CheckState = { cs_symbol_table :: !.SymbolTable, cs_predef_symbols :: !.PredefinedSymbols, cs_error :: !.ErrorAdmin,cs_x :: !CheckStateX }
:: CheckStateX = {x_needed_modules :: !BITVECT,x_main_dcl_module_n :: !Int }
// SymbolTable :== {# SymbolTableEntry}
......@@ -68,22 +68,31 @@ cConversionTableSize :== 8
, dcl_index :: !Index
}
:: Declarations =
{ dcls_import ::![Declaration]
:: Declarations = {
dcls_import ::!{!Declaration}
, dcls_local ::![Declaration]
, dcls_explicit ::![(!Declaration, !LineNr)]
, dcls_local_for_import ::!{!Declaration}
, dcls_explicit ::!{!ExplicitImport}
}
:: ExplicitImport = ExplicitImport !Declaration !LineNr;
:: IclModule =
{ icl_name :: !Ident
, icl_functions :: !.{# FunDef }
, icl_instances :: !IndexRange
, icl_specials :: !IndexRange
, icl_common :: !.CommonDefs
, icl_declared :: !Declarations
// , icl_declared :: !Declarations
, icl_import :: !{!Declaration}
, icl_imported_objects :: ![ImportedObject]
, icl_used_module_numbers :: !ModuleNumberSet
}
:: ModuleNumberSet = ModuleNumbers !Int !ModuleNumberSet | EndModuleNumbers;
in_module_number_set :: !Int !ModuleNumberSet -> Bool
:: DclModule =
{ dcl_name :: !Ident
, dcl_functions :: !{# FunType }
......@@ -96,6 +105,7 @@ cConversionTableSize :== 8
, dcl_declared :: !Declarations
, dcl_conversions :: !Optional ConversionTable
, dcl_is_system :: !Bool
, dcl_imported_module_numbers :: !ModuleNumberSet
}
class Erroradmin state
......@@ -125,10 +135,13 @@ instance toInt STE_Kind
instance <<< STE_Kind, IdentPos, Declaration
retrieveAndRemoveImportsFromSymbolTable :: ![(.a,.Declarations)] [Declaration] *(Heap SymbolTableEntry) -> ([Declaration],.Heap SymbolTableEntry);
retrieveAndRemoveImportsOfModuleFromSymbolTable :: ![.Declaration] ![.Declaration] ![.Declaration] !*(Heap SymbolTableEntry) -> ([Declaration],.Heap SymbolTableEntry);
//retrieveAndRemoveImportsOfModuleFromSymbolTable :: ![.Declaration] ![.Declaration] ![.Declaration] !*(Heap SymbolTableEntry) -> ([Declaration],.Heap SymbolTableEntry);
//retrieveAndRemoveImportsOfModuleFromSymbolTable :: !{!.Declaration} ![.Declaration] ![.Declaration] !*(Heap SymbolTableEntry) -> ([Declaration],.Heap SymbolTableEntry);
addLocalFunctionDefsToSymbolTable :: !Level !Index !Index !u:{#FunDef} !*SymbolTable !*ErrorAdmin -> (!u:{# FunDef}, !*SymbolTable, !*ErrorAdmin)
addDefToSymbolTable :: !Level !Index !Ident !STE_Kind !*SymbolTable !*ErrorAdmin -> (!* SymbolTable, !*ErrorAdmin)
addDeclaredSymbolsToSymbolTable :: .Bool .Int ![.Declaration] ![.Declaration] !*CheckState -> .CheckState;
//addDeclaredSymbolsToSymbolTable :: .Bool .Int ![.Declaration] ![.Declaration] !*CheckState -> .CheckState;
addDeclaredSymbolsToSymbolTable :: .Bool .Int ![.Declaration] !{!.Declaration} !*CheckState -> .CheckState;
addDeclaredSymbolsToSymbolTable2 :: .Bool .Int !{!.Declaration} !{!.Declaration} !*CheckState -> .CheckState;
//addLocalSymbolsToSymbolTable :: ![.Declaration] Int !*CheckState -> .CheckState;
addFieldToSelectorDefinition :: !Ident (Global .Int) !*CheckState -> .CheckState;
addGlobalDefinitionsToSymbolTable :: ![.Declaration] !*CheckState -> .CheckState;
......@@ -137,3 +150,4 @@ removeFieldFromSelectorDefinition :: !Ident .Int .Int !*(Heap SymbolTableEntry)
removeDeclarationsFromSymbolTable :: ![Declaration] !Int !*(Heap SymbolTableEntry) -> *Heap SymbolTableEntry;
removeLocalIdentsFromSymbolTable :: .Int !.[Ident] !*(Heap SymbolTableEntry) -> .Heap SymbolTableEntry;
removeIdentFromSymbolTable :: !.Int !Ident !*(Heap SymbolTableEntry) -> .Heap SymbolTableEntry;
removeImportsAndLocalsOfModuleFromSymbolTable :: !Declarations !*(Heap SymbolTableEntry) -> .Heap SymbolTableEntry
This diff is collapsed.
......@@ -196,7 +196,11 @@ checkRhsOfTypeDef {td_name,td_arity,td_args,td_rhs = td_rhs=:RecordType {rt_cons
attr_vars type_lhs [rec_cons] ts_ti_cs
# (rec_cons_def, ts) = ts!ts_cons_defs.[ds_index]
# {cons_type = { st_vars,st_args,st_result,st_attr_vars }, cons_exi_vars} = rec_cons_def
(ts_selector_defs, ti_var_heap, cs_error) = check_selectors 0 rt_fields cti_type_index st_args st_result st_vars st_attr_vars cons_exi_vars
| size rt_fields<>length st_args
= abort ("checkRhsOfTypeDef "+++rt_fields.[0].fs_name.id_name+++" "+++rec_cons_def.cons_symb.id_name+++toString ds_index)
# (ts_selector_defs, ti_var_heap, cs_error) = check_selectors 0 rt_fields cti_type_index st_args st_result st_vars st_attr_vars cons_exi_vars
ts.ts_selector_defs ti.ti_var_heap cs.cs_error
= (td_rhs, ({ ts & ts_selector_defs = ts_selector_defs }, { ti & ti_var_heap = ti_var_heap }, { cs & cs_error = cs_error}))
where
......@@ -582,7 +586,7 @@ where
= (TA_Multi, oti, cs)
//JVG: added type
checkOpenAType :: Int Int DemandedAttributeKind AType *(u:OpenTypeSymbols,*OpenTypeInfo,*CheckState) -> *(!AType,!*(!u:OpenTypeSymbols,!*OpenTypeInfo,!*CheckState));
checkOpenAType :: Int Int DemandedAttributeKind AType !*(!u:OpenTypeSymbols,!*OpenTypeInfo,!*CheckState) -> *(!AType,!*(!u:OpenTypeSymbols,!*OpenTypeInfo,!*CheckState));
checkOpenAType mod_index scope dem_attr type=:{at_type = TV tv, at_attribute} (ots, oti, cs)
# (tv, at_attribute, (oti, cs)) = checkTypeVar scope dem_attr tv at_attribute (oti, cs)
= ({ type & at_type = TV tv, at_attribute = at_attribute }, (ots, oti, cs))
......@@ -658,7 +662,11 @@ checkOpenAType mod_index scope dem_attr type=:{at_type = arg_type --> result_typ
= ({ type & at_type = arg_type --> result_type, at_attribute = new_attr }, (ots, oti, cs))
checkOpenAType mod_index scope dem_attr type=:{at_type = CV tv :@: types, at_attribute} (ots, oti, cs)
# (cons_var, _, (oti, cs)) = checkTypeVar scope DAK_None tv TA_Multi (oti, cs)
// JVG
(types, (ots, oti, cs)) = mapSt (checkOpenAType mod_index scope DAK_None) types (ots, oti, cs)
// dak_None = DAK_None
// (types, (ots, oti, cs)) = mapSt (checkOpenAType mod_index scope dak_None) types (ots, oti, cs)
(new_attr, oti, cs) = newAttribute dem_attr ":@:" at_attribute oti cs
= ({ type & at_type = CV cons_var :@: types, at_attribute = new_attr }, (ots, oti, cs))
checkOpenAType mod_index scope dem_attr type=:{at_attribute} (ots, oti, cs)
......@@ -673,7 +681,10 @@ checkOpenType mod_index scope dem_attr type cot_state
= (at_type, cot_state)
checkOpenATypes mod_index scope types cot_state
// JVG
= mapSt (checkOpenAType mod_index scope DAK_None) types cot_state
// # dak_None=DAK_None
// = mapSt (checkOpenAType mod_index scope dak_None) types cot_state
checkInstanceType :: !Index !InstanceType !Specials !u:{# CheckedTypeDef} !v:{# ClassDef} !u:{# DclModule} !*TypeHeaps !*CheckState
-> (!InstanceType, !Specials, !u:{# CheckedTypeDef}, !v:{# ClassDef}, !u:{# DclModule}, !*TypeHeaps, !*CheckState)
......
......@@ -4,6 +4,6 @@ import syntax, checksupport
// compare definition and implementation module
compareDefImp :: !{#Int} !{!FunctionBody} !*{# DclModule} !*IclModule !*Heaps !*ErrorAdmin
compareDefImp :: !{#Int} !{!FunctionBody} !Int !*{# DclModule} !*IclModule !*Heaps !*ErrorAdmin
-> (!.{# DclModule}, !.IclModule,!.Heaps,!.ErrorAdmin)
......@@ -35,6 +35,8 @@ import RWSDebug
:: !Conversions
, tc_visited_syn_types // to detect cycles in type synonyms
:: !.{#Bool}
, tc_main_dcl_module_n
:: !Int
}
:: TypesCorrespondMonad
......@@ -84,12 +86,13 @@ class CorrespondenceNumber a where
initial_hwn hwn_heap = { hwn_heap = hwn_heap, hwn_number = 0 }
compareDefImp :: !{#Int} !{!FunctionBody} !*{# DclModule} !*IclModule !*Heaps !*ErrorAdmin
compareDefImp :: !{#Int} !{!FunctionBody} !Int !*{# DclModule} !*IclModule !*Heaps !*ErrorAdmin
-> (!.{# DclModule}, !.IclModule,!.Heaps,!.ErrorAdmin)
compareDefImp size_uncopied_icl_defs untransformed dcl_modules icl_module heaps error_admin
compareDefImp size_uncopied_icl_defs untransformed main_dcl_module_n dcl_modules icl_module heaps error_admin
// icl definitions with indices >= size_uncopied_icl_defs.[def_type] don't have to be compared,
// because they are copies of definitions that appear exclusively in the dcl module
# (main_dcl_module, dcl_modules) = dcl_modules![cIclModIndex]
// # (main_dcl_module, dcl_modules) = dcl_modules![cIclModIndex]
# (main_dcl_module, dcl_modules) = dcl_modules![main_dcl_module_n]
= case main_dcl_module.dcl_conversions of
No -> (dcl_modules, icl_module, heaps, error_admin)
Yes conversion_table
......@@ -110,6 +113,7 @@ compareDefImp size_uncopied_icl_defs untransformed dcl_modules icl_module heaps
, tc_icl_type_defs = icl_type_defs
, tc_type_conversions = conversion_table.[cTypeDefs]
, tc_visited_syn_types = createArray (size dcl_common.com_type_defs) False
, tc_main_dcl_module_n = main_dcl_module_n
}
(icl_com_type_defs, tc_state, error_admin)
= compareWithConversions
......@@ -474,7 +478,8 @@ instance t_corresponds AType where
corresponds_with_expanded_syn_type {glob_module, glob_object} dclArgs icl_atype
tc_state
# is_defined_in_main_dcl = glob_module==cIclModIndex
// # is_defined_in_main_dcl = glob_module==cIclModIndex
# is_defined_in_main_dcl = glob_module==tc_state.tc_main_dcl_module_n
| is_defined_in_main_dcl && tc_state.tc_visited_syn_types.[glob_object]
= (False, tc_state) // cycle in synonym types in main dcl
# ({dcl_common}, tc_state) = tc_state!tc_dcl_modules.[glob_module]
......@@ -959,7 +964,9 @@ continuation_for_possibly_twice_defined_funs dcl_app_symb dcl_glob_index icl_app
ec_state
| dcl_glob_index==icl_glob_index
= ec_state
| dcl_glob_index.glob_module<>cIclModIndex || icl_glob_index.glob_module<>cIclModIndex
// | dcl_glob_index.glob_module<>cIclModIndex || icl_glob_index.glob_module<>cIclModIndex
#! main_dcl_module_n=ec_state.ec_tc_state.tc_main_dcl_module_n
| dcl_glob_index.glob_module<>main_dcl_module_n || icl_glob_index.glob_module<>main_dcl_module_n
= give_error icl_app_symb.symb_name ec_state
// two different functions from the main module were referenced. Check their correspondence
# dcl_index = dcl_glob_index.glob_object
......
......@@ -3,7 +3,7 @@ definition module convertDynamics
import syntax, transform, convertcases
convertDynamicPatternsIntoUnifyAppls :: {! GlobalTCType} !{# CommonDefs} !*{! Group} !*{#FunDef} !*PredefinedSymbols !*VarHeap !*TypeHeaps !*ExpressionHeap
convertDynamicPatternsIntoUnifyAppls :: {! GlobalTCType} !{# CommonDefs} !Int !*{! Group} !*{#FunDef} !*PredefinedSymbols !*VarHeap !*TypeHeaps !*ExpressionHeap
-> (!*{! Group}, !*{#FunDef}, !*PredefinedSymbols, !*{#{# CheckedTypeDef}}, !ImportedConstructors, !*VarHeap, !*TypeHeaps, !*ExpressionHeap)
/*
......
......@@ -34,9 +34,9 @@ import syntax, transform, utilities, convertcases
:: IndirectionVar :== BoundVar
convertDynamicPatternsIntoUnifyAppls :: {! GlobalTCType} !{# CommonDefs} !*{! Group} !*{#FunDef} !*PredefinedSymbols !*VarHeap !*TypeHeaps !*ExpressionHeap
convertDynamicPatternsIntoUnifyAppls :: {! GlobalTCType} !{# CommonDefs} !Int !*{! Group} !*{#FunDef} !*PredefinedSymbols !*VarHeap !*TypeHeaps !*ExpressionHeap
-> (!*{! Group}, !*{#FunDef}, !*PredefinedSymbols, !*{#{# CheckedTypeDef}}, !ImportedConstructors, !*VarHeap, !*TypeHeaps, !*ExpressionHeap)
convertDynamicPatternsIntoUnifyAppls global_type_instances common_defs groups fun_defs predefined_symbols var_heap type_heaps expr_heap
convertDynamicPatternsIntoUnifyAppls global_type_instances common_defs main_dcl_module_n groups fun_defs predefined_symbols var_heap type_heaps expr_heap
#! nr_of_funs = size fun_defs
# imported_types = {com_type_defs \\ {com_type_defs} <-: common_defs }
# (groups, (fun_defs, {ci_predef_symb, ci_var_heap, ci_expr_heap, ci_fun_heap, ci_new_functions}))
......@@ -47,7 +47,7 @@ convertDynamicPatternsIntoUnifyAppls global_type_instances common_defs groups fu
ci_used_tcs = [] })
(groups, new_fun_defs, imported_types, imported_conses, type_heaps, ci_var_heap)
= addNewFunctionsToGroups common_defs ci_fun_heap ci_new_functions groups imported_types [] type_heaps ci_var_heap
= addNewFunctionsToGroups common_defs ci_fun_heap ci_new_functions main_dcl_module_n groups imported_types [] type_heaps ci_var_heap
= (groups, { fundef \\ fundef <- [ fundef \\ fundef <-: fun_defs ] ++ new_fun_defs }, ci_predef_symb, imported_types, imported_conses, ci_var_heap, type_heaps, ci_expr_heap)
where
convert_groups group_nr groups global_type_instances fun_defs_and_ci
......
......@@ -4,17 +4,17 @@ import syntax, transform, trans
:: ImportedFunctions :== [Global Index]
convertCasesOfFunctionsIntoPatterns :: !*{! Group} !{# {# FunType} } !{# CommonDefs} !*{#FunDef} !*{#{# CheckedTypeDef}}
convertCasesOfFunctionsIntoPatterns :: !*{! Group} !Int !{# {# FunType} } !{# CommonDefs} !*{#FunDef} !*{#{# CheckedTypeDef}}
!ImportedConstructors !*VarHeap !*TypeHeaps !*ExpressionHeap
-> (!ImportedFunctions, !*{! Group}, !*{#FunDef}, !*{#{# CheckedTypeDef}}, !ImportedConstructors, !*VarHeap, !*TypeHeaps, !*ExpressionHeap)
convertImportedTypeSpecifications :: !{# DclModule} !{# {# FunType} } !{# CommonDefs} !ImportedConstructors !ImportedFunctions
convertImportedTypeSpecifications :: !Int !{# DclModule} !{# {# FunType} } !{# CommonDefs} !ImportedConstructors !ImportedFunctions
!*{# {#CheckedTypeDef}} !*TypeHeaps !*VarHeap -> (!*{#{#CheckedTypeDef}}, !*TypeHeaps, !*VarHeap)
convertDclModule :: !{# DclModule} !{# CommonDefs} !*{#{# CheckedTypeDef}} !ImportedConstructors !*VarHeap !*TypeHeaps
convertDclModule :: !Int !{# DclModule} !{# CommonDefs} !*{#{# CheckedTypeDef}} !ImportedConstructors !*VarHeap !*TypeHeaps
-> (!*{#{# CheckedTypeDef}}, !ImportedConstructors, !*VarHeap, !*TypeHeaps)
convertIclModule :: !{# CommonDefs} !*{#{# CheckedTypeDef}} !ImportedConstructors !*VarHeap !*TypeHeaps
convertIclModule :: !Int !{# CommonDefs} !*{#{# CheckedTypeDef}} !ImportedConstructors !*VarHeap !*TypeHeaps
-> (!*{#{# CheckedTypeDef}}, !ImportedConstructors, !*VarHeap, !*TypeHeaps)
......@@ -29,6 +29,6 @@ newFunction :: !(Optional Ident) !FunctionBody ![FreeVar] ![AType] !AType !Int !
copyExpression :: ![TypedVariable] !Expression !*VarHeap -> (![Expression], ![TypedVariable], ![FreeVar], !Expression, !*VarHeap)
addNewFunctionsToGroups :: !{#.CommonDefs} FunctionHeap ![FunctionInfoPtr] !*{! Group} !*{#{# CheckedTypeDef}} !ImportedFunctions !*TypeHeaps !*VarHeap
addNewFunctionsToGroups :: !{#.CommonDefs} FunctionHeap ![FunctionInfoPtr] !Int !*{! Group} !*{#{# CheckedTypeDef}} !ImportedFunctions !*TypeHeaps !*VarHeap
-> (!*{! Group}, ![FunDef], !*{#{# CheckedTypeDef}}, !ImportedConstructors, !*TypeHeaps, !*VarHeap)
This diff is collapsed.
......@@ -8,8 +8,19 @@ temporary_import_solution_XXX yes no :== yes
// This feature will be removed, when all programs are ported to Clean 2.0. The last Constructors of AtomType
// and StructureType should then be removed also
possibly_filter_decls :: ![ImportDeclaration] ![(!Index,!Declarations)] !(!FileName,!LineNr) !*{#DclModule} !*CheckState
-> (![(!Index,!Declarations)],!.{#DclModule},!.CheckState)
checkExplicitImportCompleteness :: !String ![(!Declaration,!Int)]
!*{#DclModule} !*{#FunDef} !*ExpressionHeap !*CheckState
-> (!.{#DclModule},!.{#FunDef},!.ExpressionHeap,!.CheckState)
//:: FunctionConsequence
possibly_filter_decls :: .[ImportDeclaration] u:[w:(.Index,y:Declarations)] (.FileName,.LineNr) *{#.DclModule} *CheckState -> (v:[x:(Index,z:Declarations)],.{#DclModule},.CheckState), [y <= z, w <= x, u <= v];
//possibly_filter_decls :: ![ImportDeclaration] ![(Index,Declarations)] !(!FileName,!LineNr) !*{#DclModule} !*CheckState -> (![(Index,Declarations)],!.{#DclModule},!.CheckState)
//check_completeness_of_module :: .Index !Int [(.Declaration,.Int)] .String *(*{!.FunctionConsequence},*{#.DclModule},*{#FunDef},*ExpressionHeap,*CheckState) -> (.{!FunctionConsequence},.{#DclModule},.{#FunDef},.ExpressionHeap,.CheckState);
/*
check_completeness_of_module :: .Index !Int [ExplicitImport] .String *(*{!.FunctionConsequence},*{#.DclModule},*{#FunDef},*ExpressionHeap,*CheckState) -> (.{!FunctionConsequence},.{#DclModule},.{#FunDef},.ExpressionHeap,.CheckState);
check_completeness_of_all_dcl_modules :: !Int !*{#DclModule} !*{#FunDef} !*ExpressionHeap !*CheckState
-> (!Int, !(!*{!FunctionConsequence}, !*{#DclModule}, !*{#FunDef}, !*ExpressionHeap, !*CheckState))
create_empty_consequences_array :: !Int -> *{!FunctionConsequence}
*/
//checkExplicitImportCompleteness :: !String ![(!Declaration,!Int)] !*{#DclModule} !*{#FunDef} !*ExpressionHeap !*CheckState -> (!.{#DclModule},!.{#FunDef},!.ExpressionHeap,!.CheckState)
checkExplicitImportCompleteness :: !String !Int ![ExplicitImport] !*{#DclModule} !*{#FunDef} !*ExpressionHeap !*CheckState -> (!.{#DclModule},!.{#FunDef},!.ExpressionHeap,!.CheckState)
......@@ -30,9 +30,7 @@ do_temporary_import_solution_XXX :== temporary_import_solution_XXX True False
:: OptimizeInfo :== Optional Index
// XXX change !(!FileName,!LineNr) into Position
possibly_filter_decls :: ![ImportDeclaration] ![(!Index,!Declarations)] !(!FileName,!LineNr) !*{#DclModule} !*CheckState
-> (![(!Index,!Declarations)],!.{#DclModule},!.CheckState)
possibly_filter_decls :: .[ImportDeclaration] u:[w:(.Index,y:Declarations)] (.FileName,.LineNr) *{#.DclModule} *CheckState -> (v:[x:(Index,z:Declarations)],.{#DclModule},.CheckState), [y <= z, w <= x, u <= v];
possibly_filter_decls [] decls_of_imported_module _ modules cs // implicit import can't go wrong
= (decls_of_imported_module, modules, cs)
possibly_filter_decls listed_symbols decls_of_imported_module (file_name, line_nr) modules cs
......@@ -55,21 +53,34 @@ filter_explicitly_imported_decl import_symbols [(index,{dcls_import,dcls_local,d
structures = flatten (map toStructure import_symbols)
(checked_atoms, cs) = checkAtoms atoms cs
unimported = (checked_atoms, structures)
((dcls_import,unimported), modules, cs)
= filter_decl dcls_import unimported undefined modules cs
(dcls_import,unimported, modules, cs) = filter_decl_array 0 dcls_import unimported undefined modules cs
((dcls_local,unimported), modules, cs)
= filter_decl dcls_local unimported index modules cs
cs_error = foldSt checkAtomError (fst unimported) cs.cs_error
cs_error = foldSt checkStructureError (snd unimported) cs_error
cs = { cs & cs_error=cs_error }
| (isEmpty dcls_import && isEmpty dcls_local && isEmpty dcls_explicit)
| isEmpty dcls_import && isEmpty dcls_local && size dcls_explicit==0
= filter_explicitly_imported_decl import_symbols new_decls akku line_nr modules cs
# local_imports = [ { declaration & dcl_kind = STE_Imported declaration.dcl_kind index }
\\ declaration <- dcls_local]
new_dcls_explicit = [ (dcls, line_nr) \\ dcls<-dcls_import++local_imports ]
newAkku = [(index, { dcls_import=dcls_import, dcls_local=dcls_local , dcls_explicit=new_dcls_explicit}) : akku]
# local_imports = [ { declaration & dcl_kind = STE_Imported declaration.dcl_kind index } \\ declaration <- dcls_local]
new_dcls_explicit = [ ExplicitImport dcls line_nr \\ dcls<-dcls_import++local_imports ]
dcls_import = {dcls_import\\dcls_import<-dcls_import}
newAkku = [(index, { dcls_import=dcls_import, dcls_local=dcls_local ,
dcls_local_for_import = {local_declaration_for_import decl index \\ decl<-dcls_local},
// dcls_explicit=new_dcls_explicit}) : akku]
dcls_explicit={new_dcls_explicit\\new_dcls_explicit<-new_dcls_explicit}}) : akku]
= filter_explicitly_imported_decl import_symbols new_decls newAkku line_nr modules cs
where
local_declaration_for_import decl=:{dcl_kind=STE_FunctionOrMacro _} module_n
= decl
local_declaration_for_import decl=:{dcl_kind=STE_Imported _ _} module_n
= abort "local_declaration_for_import"
local_declaration_for_import decl=:{dcl_kind} module_n
= {decl & dcl_kind = STE_Imported dcl_kind module_n}
toAtom (ID_Function {ii_ident})
= [(ii_ident, temporary_import_solution_XXX
(AT_stomme_funktion_die_alle_symbolen_kann_importeren_omdat_niemand_zin_heft_oude_pragrammen_naar_de_nieuwe_syntax_te_vertalen False)
......@@ -116,16 +127,16 @@ filter_explicitly_imported_decl import_symbols [(index,{dcls_import,dcls_local,d
checkAtoms l cs
# groups = grouped l
wrong = filter isErrornous groups
wrong = filter isErroneous groups
unique = map hd groups
| isEmpty wrong
= (unique, cs)
= (unique, foldSt error wrong cs)
where
isErrornous l=:[(_,AT_Type),_:_] = True
isErrornous l=:[(_,AT_AlgType),_:_] = True
isErrornous l=:[(_,AT_RecordType),_:_] = True
isErrornous _ = False
isErroneous l=:[(_,AT_Type),_:_] = True
isErroneous l=:[(_,AT_AlgType),_:_] = True
isErroneous l=:[(_,AT_RecordType),_:_] = True
isErroneous _ = False
error [(ident, atomType):_] cs
= { cs & cs_error = checkError ("type "+++ident.id_name) "imported more than once in one from statement"
......@@ -210,6 +221,17 @@ filter_decl [decl:decls] unimported index modules cs
= (([decl:recurs],unimported), modules, cs)
= filter_decl decls unimported index modules cs
filter_decl_array :: !Int {!.Declaration} ([(Ident,AtomType)],[(Ident,StructureInfo,StructureType,Optional Int)]) Int *{#DclModule} *CheckState -> (!.[Declaration],!([(Ident,AtomType)],![(Ident,StructureInfo,StructureType,Optional Int)]),!.{#DclModule},!.CheckState);
filter_decl_array decl_index decls unimported index modules cs
| decl_index<size decls
# (decl,decls) = decls![decl_index]
# ((appears,unimported), modules, cs) = decl_appears decl unimported index modules cs
| appears
# (recurs, unimported, modules, cs) = filter_decl_array (decl_index+1) decls unimported index modules cs
= ([decl:recurs],unimported, modules, cs)
= filter_decl_array (decl_index+1) decls unimported index modules cs
= ([], unimported, modules, cs)
decl_appears :: !Declaration !ExplicitImports !Index !*{#DclModule} !*CheckState
-> (!(!Bool, !ExplicitImports), !*{#DclModule}, !*CheckState)
......@@ -255,7 +277,6 @@ decl_appears {dcl_ident, dcl_kind, dcl_index} unimported index modules cs
isAtom STE_Type = True
isAtom STE_Instance = True
elementAppears :: .StructureType Ident !.Int !(.a,![(Ident,.StructureInfo,.StructureType,Optional .Int)]) !.Int !*{#.DclModule} !*CheckState -> (!(!Bool,(!.a,![(Ident,StructureInfo,StructureType,Optional Int)])),!.{#DclModule},!.CheckState);
elementAppears imported_st dcl_ident dcl_index (atomicImports, structureImports) index modules cs
# ((result, structureImports), modules, cs)
......@@ -516,19 +537,21 @@ element_appears_in_struct imported_st element_ident dcl_index struct_ident index
, ccs_error :: !.ErrorAdmin
, ccs_heap_changes_accu :: ![SymbolPtr]
}
:: *CheckCompletenessStateBox = { box_ccs :: !*CheckCompletenessState }
:: CheckCompletenessInput =
{ cci_line_nr :: !Int
, cci_filename :: !String
, cci_expl_imported_ident :: !Ident
, cci_main_dcl_module_n::!Int
}
:: CheckCompletenessInputBox = { box_cci :: !CheckCompletenessInput }
checkExplicitImportCompleteness :: !String ![(!Declaration,!Int)]
!*{#DclModule} !*{#FunDef} !*ExpressionHeap !*CheckState
-> (!.{#DclModule},!.{#FunDef},!.ExpressionHeap,!.CheckState)
checkExplicitImportCompleteness filename dcls_explicit dcl_modules icl_functions expr_heap
checkExplicitImportCompleteness :: !String !Int ![ExplicitImport] !*{#DclModule} !*{#FunDef} !*ExpressionHeap !*CheckState
-> (!.{#DclModule},!.{#FunDef},!.ExpressionHeap,!.CheckState)
checkExplicitImportCompleteness filename main_dcl_module_n dcls_explicit dcl_modules icl_functions expr_heap
cs=:{cs_symbol_table, cs_error}
#! nr_icl_functions = size icl_functions
box_ccs = { ccs_dcl_modules = dcl_modules, ccs_icl_functions = icl_functions,
......@@ -543,15 +566,15 @@ checkExplicitImportCompleteness filename dcls_explicit dcl_modules icl_functions
cs = { cs & cs_symbol_table = ccs_symbol_table, cs_error = ccs_error }
= (ccs_dcl_modules, ccs_icl_functions, ccs_expr_heap, cs)
where
checkCompleteness :: !String !(!Declaration, !Int) *CheckCompletenessStateBox -> *CheckCompletenessStateBox
checkCompleteness filename ({dcl_ident, dcl_index, dcl_kind=STE_FunctionOrMacro _}, line_nr) ccs
= checkCompletenessOfMacro filename dcl_ident dcl_index line_nr ccs
checkCompleteness filename ({dcl_ident, dcl_index, dcl_kind=STE_Imported (STE_FunctionOrMacro _) mod_index}, line_nr) ccs
= checkCompletenessOfMacro filename dcl_ident dcl_index line_nr ccs
checkCompleteness filename ({dcl_ident, dcl_index, dcl_kind=STE_Imported expl_imp_kind mod_index}, line_nr) ccs
checkCompleteness :: !String !ExplicitImport *CheckCompletenessStateBox -> *CheckCompletenessStateBox
checkCompleteness filename (ExplicitImport {dcl_ident, dcl_index, dcl_kind=STE_FunctionOrMacro _} line_nr) ccs
= checkCompletenessOfMacro filename dcl_ident dcl_index main_dcl_module_n line_nr ccs
checkCompleteness filename (ExplicitImport {dcl_ident, dcl_index, dcl_kind=STE_Imported (STE_FunctionOrMacro _) mod_index} line_nr) ccs
= checkCompletenessOfMacro filename dcl_ident dcl_index main_dcl_module_n line_nr ccs
checkCompleteness filename (ExplicitImport {dcl_ident, dcl_index, dcl_kind=STE_Imported expl_imp_kind mod_index} line_nr) ccs
#! ({dcl_common,dcl_functions}, ccs) = ccs!box_ccs.ccs_dcl_modules.[mod_index]
cci = { box_cci = { cci_line_nr = line_nr, cci_filename = filename, cci_expl_imported_ident = dcl_ident }}
/* XXX
cci = { box_cci = { cci_line_nr = line_nr, cci_filename = filename, cci_expl_imported_ident = dcl_ident,cci_main_dcl_module_n=main_dcl_module_n }}
/* XXX
this case expression causes the compiler to be not self compilable anymore (12.7.2000). The bug is probably
in module refmark. The corresponding continuation function can be compiled
= case expl_imp_kind of
......@@ -562,7 +585,7 @@ checkExplicitImportCompleteness filename dcls_explicit dcl_modules icl_functions
STE_Member -> check_completeness dcl_common.com_member_defs.[dcl_index] cci ccs
STE_Instance -> check_completeness dcl_common.com_instance_defs.[dcl_index] cci ccs
STE_DclFunction -> check_completeness dcl_functions.[dcl_index] cci ccs
*/
*/
= continuation expl_imp_kind dcl_common dcl_functions cci ccs
where