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 ...@@ -117,6 +117,7 @@ where
= compare_indexes symb1 symb2 = compare_indexes symb1 symb2
with with
compare_indexes (SK_Function i1) (SK_Function i2) = i1 =< i2 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_ClassRecord i1) (SK_ClassRecord i2) = i1 =< i2
compare_indexes (SK_Constructor i1) (SK_Constructor i2) = i1 =< i2 compare_indexes (SK_Constructor i1) (SK_Constructor i2) = i1 =< i2
// compare_indexes (SK_DeltaFunction i1) (SK_DeltaFunction i2) = i1 =< i2 // compare_indexes (SK_DeltaFunction i1) (SK_DeltaFunction i2) = i1 =< i2
......
...@@ -2,7 +2,6 @@ definition module analtypes ...@@ -2,7 +2,6 @@ definition module analtypes
import checksupport, typesupport import checksupport, typesupport
analTypeDefs :: !{#CommonDefs} !ModuleNumberSet !*TypeHeaps !*ErrorAdmin -> (!*TypeDefInfos, !*TypeHeaps, !*ErrorAdmin)
analTypeDefs :: !{#CommonDefs} !*TypeHeaps !*ErrorAdmin -> (!*TypeDefInfos, !*TypeHeaps, !*ErrorAdmin)
instance <<< TypeKind instance <<< TypeKind
...@@ -243,9 +243,11 @@ where ...@@ -243,9 +243,11 @@ where
check_types_of_cons :: ![AType] !Bool !Index !Level ![TypeVar] !TypeAttribute ![AttrInequality] !Conditions !*TypeSymbols !*TypeInfo !*CheckState check_types_of_cons :: ![AType] !Bool !Index !Level ![TypeVar] !TypeAttribute ![AttrInequality] !Conditions !*TypeSymbols !*TypeInfo !*CheckState
-> *(![AType], ![[ATypeVar]], ![AttrInequality], !TypeProperties, !Conditions, !Int, !*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) new_local_kind_variables td_args (type_var_heap, as_kind_heap)
= foldSt new_kind td_args (True, type_var_heap, as_kind_heap) = foldSt new_kind td_args (True, type_var_heap, as_kind_heap)
where 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) 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 # (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), = (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 } ...@@ -293,6 +295,7 @@ emptyIdent name :== { id_name = name, id_info = nilPtr }
newKindVariables td_args (type_var_heap, as_kind_heap) newKindVariables td_args (type_var_heap, as_kind_heap)
= mapSt new_kind td_args (type_var_heap, as_kind_heap) = mapSt new_kind td_args (type_var_heap, as_kind_heap)
where 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) new_kind {atv_variable={tv_info_ptr}} (type_var_heap, kind_heap)
# (kind_info_ptr, kind_heap) = newPtr KI_Const 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))) = (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 ...@@ -451,13 +454,16 @@ where
is_a_top_var var_number [] is_a_top_var var_number []
= False = False
//import RWSDebug
analTypeDefs :: !{#CommonDefs} !*TypeHeaps !*ErrorAdmin -> (!*TypeDefInfos, !*TypeHeaps, !*ErrorAdmin) analTypeDefs :: !{#CommonDefs} !ModuleNumberSet !*TypeHeaps !*ErrorAdmin -> (!*TypeDefInfos, !*TypeHeaps, !*ErrorAdmin)
analTypeDefs modules heaps error analTypeDefs modules used_module_numbers heaps error
// #! modules = modules ---> "analTypeDefs" // #! 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 } 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, as = { as_check_marks = check_marks, as_kind_heap = newHeap, as_heaps = heaps, as_td_infos = type_def_infos,
...@@ -472,7 +478,6 @@ where ...@@ -472,7 +478,6 @@ where
anal_type_defs _ _ [] as anal_type_defs _ _ [] as
= as = as
anal_type_def modules mod_index type_index as=:{as_check_marks} anal_type_def modules mod_index type_index as=:{as_check_marks}
| as_check_marks.[mod_index].[type_index] == AS_NotChecked | as_check_marks.[mod_index].[type_index] == AS_NotChecked
# (_, (_, as)) = analTypeDef modules mod_index type_index as # (_, (_, as)) = analTypeDef modules mod_index type_index as
......
...@@ -11,4 +11,3 @@ signClassification :: !Index !Index ![SignClassification] !{# CommonDefs } !*T ...@@ -11,4 +11,3 @@ signClassification :: !Index !Index ![SignClassification] !{# CommonDefs } !*T
propClassification :: !Index !Index ![PropClassification] !{# CommonDefs } !*TypeVarHeap !*TypeDefInfos propClassification :: !Index !Index ![PropClassification] !{# CommonDefs } !*TypeVarHeap !*TypeDefInfos
-> (!PropClassification, !*TypeVarHeap, !*TypeDefInfos) -> (!PropClassification, !*TypeVarHeap, !*TypeDefInfos)
...@@ -60,7 +60,7 @@ removeTopClasses _ _ ...@@ -60,7 +60,7 @@ removeTopClasses _ _
, scs_rec_appls :: ![RecTypeApplication (Sign, [SignClassification])] , 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) -> (!SignClassification, !*TypeVarHeap,!*TypeDefInfos)
determineSignClassOfTypeDef type_index module_index td_args {tdi_classification,tdi_cons_vars,tdi_group_vars,tdi_group,tdi_group_nr} 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 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 ...@@ -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] (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 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) -> (!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} 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 hio_props ci type_var_heap td_infos
......
...@@ -4,8 +4,8 @@ import syntax, transform, checksupport, typesupport, predef ...@@ -4,8 +4,8 @@ import syntax, transform, checksupport, typesupport, predef
cPredefinedModuleIndex :== 1 cPredefinedModuleIndex :== 1
checkModule :: !ScannedModule !IndexRange ![FunDef] !ScannedModule !ScannedModule ![ScannedModule] !*PredefinedSymbols !*SymbolTable !*File checkModule :: !ScannedModule !IndexRange ![FunDef] !Int !Int !(Optional ScannedModule) ![ScannedModule] !{#DclModule} !{#FunDef} !*PredefinedSymbols !*SymbolTable !*File !*Heaps
-> (!Bool, !*IclModule, *{# DclModule}, *{! Group}, !(Optional {# Index}), !*Heaps, !*PredefinedSymbols, !*SymbolTable, *File) -> (!Bool, !*IclModule, *{# DclModule}, *{! Group}, !(Optional {# Index}), !.{#FunDef},!Int, !*Heaps, !*PredefinedSymbols, !*SymbolTable, *File)
retrieveGlobalDefinition :: !SymbolTableEntry !STE_Kind !Index -> (!Index, !Index) retrieveGlobalDefinition :: !SymbolTableEntry !STE_Kind !Index -> (!Index, !Index)
......
This diff is collapsed.
...@@ -3,8 +3,7 @@ definition module checksupport ...@@ -3,8 +3,7 @@ definition module checksupport
import StdEnv import StdEnv
import syntax, predef import syntax, predef
//cIclModIndex :== 0
cIclModIndex :== 0
CS_NotChecked :== -1 CS_NotChecked :== -1
NotFound :== -1 NotFound :== -1
...@@ -31,8 +30,9 @@ cNeedStdDynamics:== 4 ...@@ -31,8 +30,9 @@ cNeedStdDynamics:== 4
:: ErrorAdmin = { ea_file :: !.File, ea_loc :: ![IdentPos], ea_ok :: !Bool } :: ErrorAdmin = { ea_file :: !.File, ea_loc :: ![IdentPos], ea_ok :: !Bool }
:: CheckState = { cs_symbol_table :: !.SymbolTable, cs_predef_symbols :: !.PredefinedSymbols, cs_error :: !.ErrorAdmin, :: CheckState = { cs_symbol_table :: !.SymbolTable, cs_predef_symbols :: !.PredefinedSymbols, cs_error :: !.ErrorAdmin,cs_x :: !CheckStateX }
cs_needed_modules :: !BITVECT } // MW++
:: CheckStateX = {x_needed_modules :: !BITVECT,x_main_dcl_module_n :: !Int }
// SymbolTable :== {# SymbolTableEntry} // SymbolTable :== {# SymbolTableEntry}
...@@ -68,22 +68,31 @@ cConversionTableSize :== 8 ...@@ -68,22 +68,31 @@ cConversionTableSize :== 8
, dcl_index :: !Index , dcl_index :: !Index
} }
:: Declarations = :: Declarations = {
{ dcls_import ::![Declaration] dcls_import ::!{!Declaration}
, dcls_local ::![Declaration] , dcls_local ::![Declaration]
, dcls_explicit ::![(!Declaration, !LineNr)] , dcls_local_for_import ::!{!Declaration}
, dcls_explicit ::!{!ExplicitImport}
} }
:: ExplicitImport = ExplicitImport !Declaration !LineNr;
:: IclModule = :: IclModule =
{ icl_name :: !Ident { icl_name :: !Ident
, icl_functions :: !.{# FunDef } , icl_functions :: !.{# FunDef }
, icl_instances :: !IndexRange , icl_instances :: !IndexRange
, icl_specials :: !IndexRange , icl_specials :: !IndexRange
, icl_common :: !.CommonDefs , icl_common :: !.CommonDefs
, icl_declared :: !Declarations // , icl_declared :: !Declarations
, icl_import :: !{!Declaration}
, icl_imported_objects :: ![ImportedObject] , icl_imported_objects :: ![ImportedObject]
, icl_used_module_numbers :: !ModuleNumberSet
} }
:: ModuleNumberSet = ModuleNumbers !Int !ModuleNumberSet | EndModuleNumbers;
in_module_number_set :: !Int !ModuleNumberSet -> Bool
:: DclModule = :: DclModule =
{ dcl_name :: !Ident { dcl_name :: !Ident
, dcl_functions :: !{# FunType } , dcl_functions :: !{# FunType }
...@@ -96,6 +105,7 @@ cConversionTableSize :== 8 ...@@ -96,6 +105,7 @@ cConversionTableSize :== 8
, dcl_declared :: !Declarations , dcl_declared :: !Declarations
, dcl_conversions :: !Optional ConversionTable , dcl_conversions :: !Optional ConversionTable
, dcl_is_system :: !Bool , dcl_is_system :: !Bool
, dcl_imported_module_numbers :: !ModuleNumberSet
} }
class Erroradmin state class Erroradmin state
...@@ -125,10 +135,13 @@ instance toInt STE_Kind ...@@ -125,10 +135,13 @@ instance toInt STE_Kind
instance <<< STE_Kind, IdentPos, Declaration instance <<< STE_Kind, IdentPos, Declaration
retrieveAndRemoveImportsFromSymbolTable :: ![(.a,.Declarations)] [Declaration] *(Heap SymbolTableEntry) -> ([Declaration],.Heap SymbolTableEntry); 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) addLocalFunctionDefsToSymbolTable :: !Level !Index !Index !u:{#FunDef} !*SymbolTable !*ErrorAdmin -> (!u:{# FunDef}, !*SymbolTable, !*ErrorAdmin)
addDefToSymbolTable :: !Level !Index !Ident !STE_Kind !*SymbolTable !*ErrorAdmin -> (!* 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; //addLocalSymbolsToSymbolTable :: ![.Declaration] Int !*CheckState -> .CheckState;
addFieldToSelectorDefinition :: !Ident (Global .Int) !*CheckState -> .CheckState; addFieldToSelectorDefinition :: !Ident (Global .Int) !*CheckState -> .CheckState;
addGlobalDefinitionsToSymbolTable :: ![.Declaration] !*CheckState -> .CheckState; addGlobalDefinitionsToSymbolTable :: ![.Declaration] !*CheckState -> .CheckState;
...@@ -137,3 +150,4 @@ removeFieldFromSelectorDefinition :: !Ident .Int .Int !*(Heap SymbolTableEntry) ...@@ -137,3 +150,4 @@ removeFieldFromSelectorDefinition :: !Ident .Int .Int !*(Heap SymbolTableEntry)
removeDeclarationsFromSymbolTable :: ![Declaration] !Int !*(Heap SymbolTableEntry) -> *Heap SymbolTableEntry; removeDeclarationsFromSymbolTable :: ![Declaration] !Int !*(Heap SymbolTableEntry) -> *Heap SymbolTableEntry;
removeLocalIdentsFromSymbolTable :: .Int !.[Ident] !*(Heap SymbolTableEntry) -> .Heap SymbolTableEntry; removeLocalIdentsFromSymbolTable :: .Int !.[Ident] !*(Heap SymbolTableEntry) -> .Heap SymbolTableEntry;
removeIdentFromSymbolTable :: !.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 ...@@ -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 attr_vars type_lhs [rec_cons] ts_ti_cs
# (rec_cons_def, ts) = ts!ts_cons_defs.[ds_index] # (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 # {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 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})) = (td_rhs, ({ ts & ts_selector_defs = ts_selector_defs }, { ti & ti_var_heap = ti_var_heap }, { cs & cs_error = cs_error}))
where where
...@@ -582,7 +586,7 @@ where ...@@ -582,7 +586,7 @@ where
= (TA_Multi, oti, cs) = (TA_Multi, oti, cs)
//JVG: added type //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) 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) # (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)) = ({ 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 ...@@ -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)) = ({ 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) 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) # (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) (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 (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)) = ({ 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) 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 ...@@ -673,7 +681,10 @@ checkOpenType mod_index scope dem_attr type cot_state
= (at_type, cot_state) = (at_type, cot_state)
checkOpenATypes mod_index scope types cot_state checkOpenATypes mod_index scope types cot_state
// JVG
= mapSt (checkOpenAType mod_index scope DAK_None) types cot_state = 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 checkInstanceType :: !Index !InstanceType !Specials !u:{# CheckedTypeDef} !v:{# ClassDef} !u:{# DclModule} !*TypeHeaps !*CheckState
-> (!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 ...@@ -4,6 +4,6 @@ import syntax, checksupport
// compare definition and implementation module // compare definition and implementation module
compareDefImp :: !{#Int} !{!FunctionBody} !*{# DclModule} !*IclModule !*Heaps !*ErrorAdmin compareDefImp :: !{#Int} !{!FunctionBody} !Int !*{# DclModule} !*IclModule !*Heaps !*ErrorAdmin
-> (!.{# DclModule}, !.IclModule,!.Heaps,!.ErrorAdmin) -> (!.{# DclModule}, !.IclModule,!.Heaps,!.ErrorAdmin)
...@@ -35,6 +35,8 @@ import RWSDebug ...@@ -35,6 +35,8 @@ import RWSDebug
:: !Conversions :: !Conversions
, tc_visited_syn_types // to detect cycles in type synonyms , tc_visited_syn_types // to detect cycles in type synonyms
:: !.{#Bool} :: !.{#Bool}
, tc_main_dcl_module_n
:: !Int
} }
:: TypesCorrespondMonad :: TypesCorrespondMonad
...@@ -84,12 +86,13 @@ class CorrespondenceNumber a where ...@@ -84,12 +86,13 @@ class CorrespondenceNumber a where
initial_hwn hwn_heap = { hwn_heap = hwn_heap, hwn_number = 0 } 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) -> (!.{# 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, // 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 // 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 = case main_dcl_module.dcl_conversions of
No -> (dcl_modules, icl_module, heaps, error_admin) No -> (dcl_modules, icl_module, heaps, error_admin)
Yes conversion_table Yes conversion_table
...@@ -110,6 +113,7 @@ compareDefImp size_uncopied_icl_defs untransformed dcl_modules icl_module heaps ...@@ -110,6 +113,7 @@ compareDefImp size_uncopied_icl_defs untransformed dcl_modules icl_module heaps
, tc_icl_type_defs = icl_type_defs , tc_icl_type_defs = icl_type_defs
, tc_type_conversions = conversion_table.[cTypeDefs] , tc_type_conversions = conversion_table.[cTypeDefs]
, tc_visited_syn_types = createArray (size dcl_common.com_type_defs) False , 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) (icl_com_type_defs, tc_state, error_admin)
= compareWithConversions = compareWithConversions
...@@ -474,7 +478,8 @@ instance t_corresponds AType where ...@@ -474,7 +478,8 @@ instance t_corresponds AType where
corresponds_with_expanded_syn_type {glob_module, glob_object} dclArgs icl_atype corresponds_with_expanded_syn_type {glob_module, glob_object} dclArgs icl_atype
tc_state 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] | is_defined_in_main_dcl && tc_state.tc_visited_syn_types.[glob_object]
= (False, tc_state) // cycle in synonym types in main dcl = (False, tc_state) // cycle in synonym types in main dcl
# ({dcl_common}, tc_state) = tc_state!tc_dcl_modules.[glob_module] # ({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 ...@@ -959,7 +964,9 @@ continuation_for_possibly_twice_defined_funs dcl_app_symb dcl_glob_index icl_app
ec_state ec_state
| dcl_glob_index==icl_glob_index | dcl_glob_index==icl_glob_index
= ec_state = 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 = give_error icl_app_symb.symb_name ec_state
// two different functions from the main module were referenced. Check their correspondence // two different functions from the main module were referenced. Check their correspondence
# dcl_index = dcl_glob_index.glob_object # dcl_index = dcl_glob_index.glob_object
......
...@@ -3,7 +3,7 @@ definition module convertDynamics ...@@ -3,7 +3,7 @@ definition module convertDynamics
import syntax, transform, convertcases 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) -> (!*{! Group}, !*{#FunDef}, !*PredefinedSymbols, !*{#{# CheckedTypeDef}}, !ImportedConstructors, !*VarHeap, !*TypeHeaps, !*ExpressionHeap)
/* /*
......
...@@ -34,9 +34,9 @@ import syntax, transform, utilities, convertcases ...@@ -34,9 +34,9 @@ import syntax, transform, utilities, convertcases
:: IndirectionVar :== BoundVar :: 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) -> (!*{! 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 #! nr_of_funs = size fun_defs
# imported_types = {com_type_defs \\ {com_type_defs} <-: common_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})) # (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 ...@@ -47,7 +47,7 @@ convertDynamicPatternsIntoUnifyAppls global_type_instances common_defs groups fu
ci_used_tcs = [] }) ci_used_tcs = [] })
(groups, new_fun_defs, imported_types, imported_conses, type_heaps, ci_var_heap) (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) = (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 where
convert_groups group_nr groups global_type_instances fun_defs_and_ci convert_groups group_nr groups global_type_instances fun_defs_and_ci
......
...@@ -4,17 +4,17 @@ import syntax, transform, trans ...@@ -4,17 +4,17 @@ import syntax, transform, trans
:: ImportedFunctions :== [Global Index] :: ImportedFunctions :== [Global Index]
convertCasesOfFunctionsIntoPatterns :: !*{! Group} !{# {# FunType} } !{# CommonDefs} !*{#FunDef} !*{#{# CheckedTypeDef}} convertCasesOfFunctionsIntoPatterns :: !*{! Group} !Int !{# {# FunType} } !{# CommonDefs} !*{#FunDef} !*{#{# CheckedTypeDef}}
!ImportedConstructors !*VarHeap !*TypeHeaps !*ExpressionHeap !ImportedConstructors !*VarHeap !*TypeHeaps !*ExpressionHeap
-> (!ImportedFunctions, !*{! Group}, !*{#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) !*{# {#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) -> (!*{#{# CheckedTypeDef}}, !ImportedConstructors, !*VarHeap, !*TypeHeaps)
convertIclModule :: !{# CommonDefs} !*{#{# CheckedTypeDef}} !ImportedConstructors !*VarHeap !*TypeHeaps convertIclModule :: !Int !{# CommonDefs} !*{#{# CheckedTypeDef}} !ImportedConstructors !*VarHeap !*TypeHeaps
-> (!*{#{# CheckedTypeDef}}, !ImportedConstructors, !*VarHeap, !*TypeHeaps) -> (!*{#{# CheckedTypeDef}}, !ImportedConstructors, !*VarHeap, !*TypeHeaps)
...@@ -29,6 +29,6 @@ newFunction :: !(Optional Ident) !FunctionBody ![FreeVar] ![AType] !AType !Int ! ...@@ -29,6 +29,6 @@ newFunction :: !(Optional Ident) !FunctionBody ![FreeVar] ![AType] !AType !Int !
copyExpression :: ![TypedVariable] !Expression !*VarHeap -> (![Expression], ![TypedVariable], ![FreeVar], !Expression, !*VarHeap) 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) -> (!*{! Group}, ![FunDef], !*{#{# CheckedTypeDef}}, !ImportedConstructors, !*TypeHeaps, !*VarHeap)
This diff is collapsed.
...@@ -8,8 +8,19 @@ temporary_import_solution_XXX yes no :== yes ...@@ -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 // 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 // and StructureType should then be removed also
possibly_filter_decls :: ![ImportDeclaration] ![(!Index,!Declarations)] !(!FileName,!LineNr) !*{#DclModule} !*CheckState //:: FunctionConsequence
-> (![(!Index,!Declarations)],!.{#DclModule},!.CheckState)
checkExplicitImportCompleteness :: !String ![(!Declaration,!Int)] 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];
!*{#DclModule} !*{#FunDef} !*ExpressionHeap !*CheckState