Commit 6b843949 authored by John van Groningen's avatar John van Groningen
Browse files

store macros and local functions in macros in separate {#{#FunDef}},

remove conversion table, except for macros
parent 18d1e786
...@@ -385,10 +385,12 @@ backEndConvertModules p s main_dcl_module_n var_heap attr_var_heap be ...@@ -385,10 +385,12 @@ backEndConvertModules p s main_dcl_module_n var_heap attr_var_heap be
# {bes_varHeap,bes_attrHeap,bes_backEnd} = backEndConvertModulesH p s main_dcl_module_n {bes_varHeap=var_heap,bes_attrHeap=attr_var_heap,bes_backEnd=be, bes_attr_number = 0} # {bes_varHeap,bes_attrHeap,bes_backEnd} = backEndConvertModulesH p s main_dcl_module_n {bes_varHeap=var_heap,bes_attrHeap=attr_var_heap,bes_backEnd=be, bes_attr_number = 0}
= (bes_varHeap,bes_attrHeap,bes_backEnd) = (bes_varHeap,bes_attrHeap,bes_backEnd)
import RWSDebug
backEndConvertModulesH :: PredefinedSymbols FrontEndSyntaxTree !Int *BackEndState -> *BackEndState backEndConvertModulesH :: PredefinedSymbols FrontEndSyntaxTree !Int *BackEndState -> *BackEndState
backEndConvertModulesH predefs {fe_icl = backEndConvertModulesH predefs {fe_icl =
fe_icl =: {icl_name, icl_modification_time, icl_functions, icl_common,icl_imported_objects,icl_used_module_numbers}, fe_icl =: {icl_name, icl_functions, icl_common,icl_global_functions,icl_imported_objects,icl_used_module_numbers, icl_modification_time},
fe_components, fe_dcls, fe_arrayInstances, fe_dclIclConversions, fe_iclDclConversions,fe_globalFunctions} fe_components, fe_dcls, fe_arrayInstances}
main_dcl_module_n backEnd main_dcl_module_n backEnd
// sanity check ... // sanity check ...
// | cIclModIndex <> kIclModuleIndex || cPredefinedModuleIndex <> kPredefinedModuleIndex // | cIclModIndex <> kIclModuleIndex || cPredefinedModuleIndex <> kPredefinedModuleIndex
...@@ -410,11 +412,7 @@ backEndConvertModulesH predefs {fe_icl = ...@@ -410,11 +412,7 @@ backEndConvertModulesH predefs {fe_icl =
# currentDcl # currentDcl
= fe_dcls.[main_dcl_module_n] = fe_dcls.[main_dcl_module_n]
typeConversions
= currentModuleTypeConversions icl_common.com_class_defs currentDcl.dcl_common.com_class_defs currentDcl.dcl_conversions
/* /*
# rstypes = reshuffleTypes (size icl_common.com_type_defs) typeConversions {type.td_name.id_name \\ type <-: currentDcl.dcl_common.com_type_defs}
types = {type.td_name.id_name \\ type <-: icl_common.com_type_defs}
# backEnd # backEnd
= backEnd ->> = backEnd ->>
( "dcl conversions" ( "dcl conversions"
...@@ -425,14 +423,12 @@ backEndConvertModulesH predefs {fe_icl = ...@@ -425,14 +423,12 @@ backEndConvertModulesH predefs {fe_icl =
, [selector.sd_symb.id_name \\ selector <-: currentDcl.dcl_common.com_selector_defs] , [selector.sd_symb.id_name \\ selector <-: currentDcl.dcl_common.com_selector_defs]
, "dcl types" , "dcl types"
, [type.td_name.id_name \\ type <-: currentDcl.dcl_common.com_type_defs] , [type.td_name.id_name \\ type <-: currentDcl.dcl_common.com_type_defs]
, "icl selectors" , "icl constructors"
, [constructor.cons_symb.id_name \\ constructor <-: icl_common.com_cons_defs] , [constructor.cons_symb.id_name \\ constructor <-: icl_common.com_cons_defs]
, "icl fields" , "icl selectors"
, [selector.sd_symb.id_name \\ selector <-: icl_common.com_selector_defs] , [selector.sd_symb.id_name \\ selector <-: icl_common.com_selector_defs]
, "icl types" , "icl types"
, [type.td_name.id_name \\ type <-: icl_common.com_type_defs] , [type.td_name.id_name \\ type <-: icl_common.com_type_defs]
, "compare names"
, (rstypes, types)
) )
*/ */
#! backEnd #! backEnd
...@@ -446,21 +442,13 @@ backEndConvertModulesH predefs {fe_icl = ...@@ -446,21 +442,13 @@ backEndConvertModulesH predefs {fe_icl =
#! backEnd #! backEnd
= defineDclModule main_dcl_module_n fe_dcls.[main_dcl_module_n] (backEnd -*-> "defineDclModule(cIclMoIndex)") = defineDclModule main_dcl_module_n fe_dcls.[main_dcl_module_n] (backEnd -*-> "defineDclModule(cIclMoIndex)")
#! backEnd
= reshuffleTypes (size icl_common.com_type_defs) typeConversions (backEnd -*-> "reshuffleTypes")
#! backEnd #! backEnd
= defineOtherDclModules fe_dcls main_dcl_module_n icl_used_module_numbers (backEnd -*-> "defineOtherDclModules") = defineOtherDclModules fe_dcls main_dcl_module_n icl_used_module_numbers (backEnd -*-> "defineOtherDclModules")
#! backEnd #! backEnd
= appBackEnd (BEDeclareIclModule icl_name.id_name icl_modification_time (size icl_functions) (size icl_common.com_type_defs) (size icl_common.com_cons_defs) (size icl_common.com_selector_defs)) (backEnd -*-> "BEDeclareIclModule") = appBackEnd (BEDeclareIclModule icl_name.id_name icl_modification_time (size icl_functions) (size icl_common.com_type_defs) (size icl_common.com_cons_defs) (size icl_common.com_selector_defs)) (backEnd -*-> "BEDeclareIclModule")
#! backEnd #! backEnd
= declareFunctionSymbols icl_functions (getConversions fe_iclDclConversions) functionIndices fe_globalFunctions (backEnd -*-> "declareFunctionSymbols") = declareFunctionSymbols icl_functions functionIndices icl_global_functions (backEnd -*-> "declareFunctionSymbols")
with
getConversions :: (Optional {#Int}) -> {#Int}
getConversions No
= {}
getConversions (Yes conversions)
= conversions
#! backEnd #! backEnd
= declare main_dcl_module_n icl_common (backEnd -*-> "declare (main_dcl_module_n)") = declare main_dcl_module_n icl_common (backEnd -*-> "declare (main_dcl_module_n)")
#! backEnd #! backEnd
...@@ -483,7 +471,7 @@ backEndConvertModulesH predefs {fe_icl = ...@@ -483,7 +471,7 @@ backEndConvertModulesH predefs {fe_icl =
(convertStrings [imported.io_name \\ imported <- icl_imported_objects | imported.io_is_library]) (convertStrings [imported.io_name \\ imported <- icl_imported_objects | imported.io_is_library])
(backEnd -*-> "beDefineImportedObjsAndLibs") (backEnd -*-> "beDefineImportedObjsAndLibs")
#! backEnd #! backEnd
= markExports fe_dcls.[main_dcl_module_n] dcl_common.com_class_defs dcl_common.com_type_defs icl_common.com_class_defs icl_common.com_type_defs fe_dclIclConversions (backEnd -*-> "markExports") = markExports fe_dcls.[main_dcl_module_n] dcl_common.com_class_defs dcl_common.com_type_defs icl_common.com_class_defs icl_common.com_type_defs (backEnd -*-> "markExports")
with with
dcl_common dcl_common
= currentDcl.dcl_common = currentDcl.dcl_common
...@@ -563,49 +551,6 @@ where ...@@ -563,49 +551,6 @@ where
_ _
-> identity) be -> identity) be
// move types from their dcl to icl positions
class swapTypes a :: Int Int *a -> *a
instance swapTypes BackEndState where
//instance swapTypes BackEnd where
swapTypes i j be
= appBackEnd (BESwapTypes i j) be
instance swapTypes {{#Char}} where
swapTypes i j a
= swap i j a
swap i j a
#! iValue = a.[i]
#! jValue = a.[j]
= {a & [i] = jValue, [j] = iValue}
reshuffleTypes :: Int {#Int} *a -> *a | swapTypes a
reshuffleTypes nIclTypes dclIclConversions be
= thd3 (foldStateWithIndexA (swapType nDclTypes) dclIclConversions (idP nDclTypes, idP nIclTypes, be))
where
nDclTypes
= size dclIclConversions
idP :: Int -> .{#Int}
idP n
= {i \\ i <- [0 .. n-1]}
swapType :: Int Int Int (*{#Int}, *{#Int}, *a) -> (*{#Int}, *{#Int}, *a) | swapTypes a
swapType nDclTypes dclIndex iclIndex state=:(p,p`,be)
#! frm
= p.[dclIndex]
#! to
= iclIndex
| frm == to
= state
// otherwise
#! frm` = dclIndex
#! to` = p`.[iclIndex]
#! to` = if (to` >= nDclTypes) frm` to`
= (swap frm` to` p, swap frm to p`, swapTypes frm to be)
:: DeclVarsInput :== Ident :: DeclVarsInput :== Ident
class declareVars a :: a !DeclVarsInput -> BackEnder class declareVars a :: a !DeclVarsInput -> BackEnder
...@@ -728,21 +673,25 @@ instance declare {#a} | declareWithIndex a & Array {#} a where ...@@ -728,21 +673,25 @@ instance declare {#a} | declareWithIndex a & Array {#} a where
declare moduleIndex array declare moduleIndex array
= foldStateWithIndexA (\i -> declareWithIndex i moduleIndex) array = foldStateWithIndexA (\i -> declareWithIndex i moduleIndex) array
declareFunctionSymbols :: {#FunDef} {#Int} [(Int, Int)] IndexRange *BackEndState -> *BackEndState declareFunctionSymbols :: {#FunDef} [(Int, Int)] [IndexRange] *BackEndState -> *BackEndState
declareFunctionSymbols functions iclDclConversions functionIndices globalFunctions backEnd declareFunctionSymbols functions functionIndices globalFunctions backEnd
= foldl (declare iclDclConversions) backEnd [(functionIndex, componentIndex, functions.[functionIndex]) \\ (componentIndex, functionIndex) <- functionIndices] = foldl declare backEnd [(functionIndex, componentIndex, functions.[functionIndex]) \\ (componentIndex, functionIndex) <- functionIndices]
where where
declare iclDclConversions backEnd (functionIndex, componentIndex, function) declare backEnd (functionIndex, componentIndex, function)
= appBackEnd (BEDeclareFunction (functionName function.fun_symb.id_name functionIndex iclDclConversions globalFunctions) = appBackEnd (BEDeclareFunction (functionName function.fun_symb.id_name functionIndex globalFunctions)
function.fun_arity functionIndex componentIndex) backEnd function.fun_arity functionIndex componentIndex) backEnd
where where
functionName :: {#Char} Int {#Int} IndexRange -> {#Char} functionName :: {#Char} Int [IndexRange] -> {#Char}
functionName name functionIndex iclDclConversions {ir_from, ir_to} functionName name functionIndex icl_global_functions
// | trace_t ("|"+++toString functionIndex) // | trace_t ("|"+++toString functionIndex)
| functionIndex >= ir_to || functionIndex < ir_from | index_in_ranges functionIndex icl_global_functions
= (name +++ ";" +++ toString iclDclConversions.[functionIndex])
// otherwise
= name = name
= (name +++ ";" +++ toString functionIndex)
where
index_in_ranges index [{ir_from, ir_to}:ranges]
= (index>=ir_from && index < ir_to) || index_in_ranges index ranges;
index_in_ranges index []
= False
// move to backendsupport // move to backendsupport
foldStateWithIndexRangeA function frm to array foldStateWithIndexRangeA function frm to array
...@@ -850,48 +799,7 @@ declareFunType moduleIndex nrOfDclFunctions functionIndex {ft_symb, ft_type_ptr} ...@@ -850,48 +799,7 @@ declareFunType moduleIndex nrOfDclFunctions functionIndex {ft_symb, ft_type_ptr}
// otherwise // otherwise
= name +++ ";" +++ toString functionIndex = name +++ ";" +++ toString functionIndex
currentModuleTypeConversions :: {#ClassDef} {#ClassDef} (Optional ConversionTable) -> {#Int} import StdDebug
currentModuleTypeConversions iclClasses dclClasses (Yes conversionTable)
// sanity check ...
| sort [dclClass.class_dictionary.ds_index \\ dclClass <-: dclClasses]
<> [size typeConversions .. size typeConversions + size dclClasses - 1]
= abort "backendconvert, currentModuleTypeConversions wrong index range for dcl dictionary types"
// ... sanity check
| nDclClasses == 0
= typeConversions
// otherwise
= {createArray (nDclTypes + nDclClasses) NoIndex
& [i] = typeConversion
\\ typeConversion <-: typeConversions & i <- [0..]}
:- foldStateWithIndexA (updateDictionaryTypeIndex classConversions) classConversions
where
typeConversions
= conversionTable.[cTypeDefs]
nDclTypes
= size typeConversions
classConversions
= conversionTable.[cClassDefs]
nDclClasses
= size classConversions
updateDictionaryTypeIndex :: {#Int} Int Int *{#Int} -> *{#Int}
updateDictionaryTypeIndex classConversions dclClassIndex iclClassIndex allTypeConversions
// sanity check ...
# (oldIndex, allTypeConversions)
= uselect allTypeConversions dclTypeIndex
| oldIndex <> NoIndex
= abort "backendconvert, updateDictionaryTypeIndex wrong index overwritten"
// ... sanity chechk
= {allTypeConversions & [dclTypeIndex] = iclTypeIndex}
where
dclTypeIndex
= dclClasses.[dclClassIndex].class_dictionary.ds_index
iclClassIndex
= classConversions.[dclClassIndex]
iclTypeIndex
= iclClasses.[iclClassIndex].class_dictionary.ds_index
currentModuleTypeConversions _ _ No
= {}
/* /*
declareCurrentDclModuleTypes :: {#CheckedTypeDef} {#Int} -> BackEnder declareCurrentDclModuleTypes :: {#CheckedTypeDef} {#Int} -> BackEnder
...@@ -1338,16 +1246,12 @@ convertRule aliasDummyId (index, {fun_type=Yes type, fun_body=body, fun_pos, fun ...@@ -1338,16 +1246,12 @@ convertRule aliasDummyId (index, {fun_type=Yes type, fun_body=body, fun_pos, fun
(convertTypeAlt index main_dcl_module_n (type -*-> ("convertRule", fun_symb.id_name, index, type))) (convertTypeAlt index main_dcl_module_n (type -*-> ("convertRule", fun_symb.id_name, index, type)))
(convertFunctionBody index (positionToLineNumber fun_pos) aliasDummyId body main_dcl_module_n) (convertFunctionBody index (positionToLineNumber fun_pos) aliasDummyId body main_dcl_module_n)
where where
cafness :: DefOrImpFunKind -> Int cafness :: FunKind -> Int
cafness (FK_DefFunction _) cafness (FK_Function _)
= BEIsNotACaf
cafness (FK_ImpFunction _)
= BEIsNotACaf
cafness FK_DefMacro
= BEIsNotACaf = BEIsNotACaf
cafness FK_ImpMacro cafness FK_Macro
= BEIsNotACaf = BEIsNotACaf
cafness FK_ImpCaf cafness FK_Caf
= BEIsACaf = BEIsACaf
cafness funKind cafness funKind
= BEIsNotACaf // <<- ("backendconvert, cafness: unknown fun kind", funKind) = BEIsNotACaf // <<- ("backendconvert, cafness: unknown fun kind", funKind)
...@@ -2222,13 +2126,23 @@ getVariableSequenceNumber varInfoPtr be ...@@ -2222,13 +2126,23 @@ getVariableSequenceNumber varInfoPtr be
vi vi
-> abort "getVariableSequenceNumber" // <<- vi -> abort "getVariableSequenceNumber" // <<- vi
markExports :: DclModule {#ClassDef} {#CheckedTypeDef} {#ClassDef} {#CheckedTypeDef} (Optional {#Int}) -> BackEnder foldStateWithIndexTwice function n
markExports {dcl_conversions = Yes conversionTable} dclClasses dclTypes iclClasses iclTypes (Yes functionConversions) :== foldStateWithIndexTwice 0
= foldStateA (\icl -> beExportType icl icl) conversionTable.[cTypeDefs] where
o foldStateWithIndexA beExportConstructor conversionTable.[cConstructorDefs] foldStateWithIndexTwice index
o foldStateWithIndexA beExportField conversionTable.[cSelectorDefs] | index == n
o foldStateWithIndexA (exportDictionary iclClasses iclTypes) conversionTable.[cClassDefs] = identity
o foldStateWithIndexA beExportFunction functionConversions // otherwise
= function index index
o` foldStateWithIndexTwice (index+1)
markExports :: DclModule {#ClassDef} {#CheckedTypeDef} {#ClassDef} {#CheckedTypeDef} -> BackEnder
markExports {dcl_functions,dcl_common={com_type_defs,com_cons_defs,com_selector_defs,com_class_defs}} dclClasses dclTypes iclClasses iclTypes
= foldStateWithIndexTwice beExportType (size com_type_defs)
o foldStateWithIndexTwice beExportConstructor (size com_cons_defs)
o foldStateWithIndexTwice beExportField (size com_selector_defs)
o foldStateWithIndexTwice (exportDictionary iclClasses iclTypes) (size com_class_defs)
o foldStateWithIndexTwice beExportFunction (size dcl_functions)
where where
exportDictionary :: {#ClassDef} {#CheckedTypeDef} Index Index -> BackEnder exportDictionary :: {#ClassDef} {#CheckedTypeDef} Index Index -> BackEnder
exportDictionary iclClasses iclTypes dclClassIndex iclClassIndex exportDictionary iclClasses iclTypes dclClassIndex iclClassIndex
...@@ -2245,5 +2159,5 @@ markExports {dcl_conversions = Yes conversionTable} dclClasses dclTypes iclClass ...@@ -2245,5 +2159,5 @@ markExports {dcl_conversions = Yes conversionTable} dclClasses dclTypes iclClass
exportDictionaryField :: FieldSymbol -> BackEnder exportDictionaryField :: FieldSymbol -> BackEnder
exportDictionaryField {fs_index} exportDictionaryField {fs_index}
= beExportField (-1) fs_index // remove -1 hack = beExportField (-1) fs_index // remove -1 hack
markExports _ _ _ _ _ _ markExports _ _ _ _ _
= identity = identity
...@@ -99,6 +99,7 @@ instance == Priority ...@@ -99,6 +99,7 @@ instance == Priority
where where
(==) NoPrio NoPrio = True (==) NoPrio NoPrio = True
(==) (Prio assoc1 prio1) (Prio assoc2 prio2) = assoc1==assoc2 && prio1==prio2 (==) (Prio assoc1 prio1) (Prio assoc2 prio2) = assoc1==assoc2 && prio1==prio2
(==) _ _ = False
instance == Assoc instance == Assoc
where where
...@@ -137,6 +138,7 @@ where ...@@ -137,6 +138,7 @@ where
// compare_indexes (SK_InternalFunction i1) (SK_InternalFunction i2) = i1 =< i2 // compare_indexes (SK_InternalFunction i1) (SK_InternalFunction i2) = i1 =< i2
compare_indexes (SK_OverloadedFunction i1) (SK_OverloadedFunction i2) = i1 =< i2 compare_indexes (SK_OverloadedFunction i1) (SK_OverloadedFunction i2) = i1 =< i2
compare_indexes (SK_GeneratedFunction _ i1) (SK_GeneratedFunction _ i2) = i1 =< i2 compare_indexes (SK_GeneratedFunction _ i1) (SK_GeneratedFunction _ i2) = i1 =< i2
compare_indexes (SK_LocalDclMacroFunction i1) (SK_LocalDclMacroFunction i2) = i1 =< i2
| less_constructor symb1 symb2 | less_constructor symb1 symb2
= Smaller = Smaller
......
...@@ -12,7 +12,7 @@ analyseTypeDefs :: !{#CommonDefs} !TypeGroups !*TypeDefInfos !*TypeVarHeap !*Err ...@@ -12,7 +12,7 @@ analyseTypeDefs :: !{#CommonDefs} !TypeGroups !*TypeDefInfos !*TypeVarHeap !*Err
determineKindsOfClasses :: !NumberSet !{#CommonDefs} !*TypeDefInfos !*TypeVarHeap !*ErrorAdmin determineKindsOfClasses :: !NumberSet !{#CommonDefs} !*TypeDefInfos !*TypeVarHeap !*ErrorAdmin
-> (!*ClassDefInfos, !*TypeDefInfos, !*TypeVarHeap, !*ErrorAdmin) -> (!*ClassDefInfos, !*TypeDefInfos, !*TypeVarHeap, !*ErrorAdmin)
checkKindsOfCommonDefsAndFunctions :: !Index !Index !NumberSet !IndexRange !{#CommonDefs} !u:{# FunDef} !v:{#DclModule} !*TypeDefInfos !*ClassDefInfos checkKindsOfCommonDefsAndFunctions :: !Index !Index !NumberSet ![IndexRange] !{#CommonDefs} !u:{# FunDef} !v:{#DclModule} !*TypeDefInfos !*ClassDefInfos
!*TypeVarHeap !*ErrorAdmin -> (!u:{# FunDef}, !v:{#DclModule}, !*TypeDefInfos, !*TypeVarHeap, !*ErrorAdmin) !*TypeVarHeap !*ErrorAdmin -> (!u:{# FunDef}, !v:{#DclModule}, !*TypeDefInfos, !*TypeVarHeap, !*ErrorAdmin)
isATopConsVar cv :== cv < 0 isATopConsVar cv :== cv < 0
......
...@@ -30,15 +30,32 @@ partionateAndExpandTypes :: !NumberSet !Index !*CommonDefs !*{#DclModule} !*Type ...@@ -30,15 +30,32 @@ partionateAndExpandTypes :: !NumberSet !Index !*CommonDefs !*{#DclModule} !*Type
-> (!TypeGroups, !*{# CommonDefs}, !*TypeDefInfos, !*CommonDefs, !*{#DclModule}, !*TypeHeaps, !*ErrorAdmin) -> (!TypeGroups, !*{# CommonDefs}, !*TypeDefInfos, !*CommonDefs, !*{#DclModule}, !*TypeHeaps, !*ErrorAdmin)
partionateAndExpandTypes used_module_numbers main_dcl_module_index icl_common=:{com_type_defs,com_class_defs} dcl_modules type_heaps error partionateAndExpandTypes used_module_numbers main_dcl_module_index icl_common=:{com_type_defs,com_class_defs} dcl_modules type_heaps error
#! nr_of_modules = size dcl_modules #! nr_of_modules = size dcl_modules
#! nr_of_types_in_icl_mod = size com_type_defs - size com_class_defs // #! nr_of_types_in_icl_mod = size com_type_defs - size com_class_defs
#! n_exported_dictionaries = size dcl_modules.[main_dcl_module_index].dcl_common.com_class_defs
#! index_of_first_not_exported_type_or_dictionary = size dcl_modules.[main_dcl_module_index].dcl_common.com_type_defs
#! n_exported_icl_types = index_of_first_not_exported_type_or_dictionary - n_exported_dictionaries
#! n_types_without_not_exported_dictionaries = size com_type_defs - (size com_class_defs - n_exported_dictionaries)
# (dcl_type_defs, dcl_modules, new_type_defs, new_marks, type_def_infos) # (dcl_type_defs, dcl_modules, new_type_defs, new_marks, type_def_infos)
= copy_type_defs_and_create_marks_and_infos used_module_numbers main_dcl_module_index nr_of_types_in_icl_mod nr_of_modules (com_type_defs, dcl_modules) = copy_type_defs_and_create_marks_and_infos used_module_numbers main_dcl_module_index n_types_without_not_exported_dictionaries nr_of_modules (com_type_defs, dcl_modules)
pi = {pi_marks = new_marks, pi_type_defs = new_type_defs, pi_type_def_infos = type_def_infos, pi = {pi_marks = new_marks, pi_type_defs = new_type_defs, pi_type_def_infos = type_def_infos,
pi_next_num = 0, pi_deps = [], pi_next_group_num = 0, pi_groups = [], pi_error = error } pi_next_num = 0, pi_deps = [], pi_next_group_num = 0, pi_groups = [], pi_error = error }
{pi_error,pi_groups,pi_type_defs,pi_type_def_infos} = iFoldSt partionate_type_defs 0 nr_of_modules pi {pi_error,pi_groups,pi_type_defs,pi_type_def_infos} = iFoldSt partionate_type_defs 0 nr_of_modules pi
with
partionate_type_defs mod_index pi=:{pi_marks}
#! nr_of_typedefs_to_be_examined = size pi_marks.[mod_index]
| mod_index == main_dcl_module_index
# pi = iFoldSt (partitionate_type_def mod_index) 0 n_exported_icl_types pi
= iFoldSt (partitionate_type_def mod_index) index_of_first_not_exported_type_or_dictionary nr_of_typedefs_to_be_examined pi
= iFoldSt (partitionate_type_def mod_index) 0 nr_of_typedefs_to_be_examined pi
where
partitionate_type_def module_index type_index pi=:{pi_marks}
# mark = pi_marks.[module_index, type_index]
| mark == cNotPartitionated
# (_, pi) = partitionateTypeDef {gi_module = module_index, gi_index = type_index} pi
= pi
= pi
| not pi_error.ea_ok | not pi_error.ea_ok
# (icl_type_defs, type_defs) = replace pi_type_defs main_dcl_module_index dcl_type_defs # (icl_type_defs, type_defs) = replace pi_type_defs main_dcl_module_index dcl_type_defs
(dcl_modules, common_defs) = update_modules_and_create_commondefs used_module_numbers type_defs nr_of_modules dcl_modules (dcl_modules, common_defs) = update_modules_and_create_commondefs used_module_numbers type_defs nr_of_modules dcl_modules
...@@ -50,38 +67,27 @@ partionateAndExpandTypes used_module_numbers main_dcl_module_index icl_common=:{ ...@@ -50,38 +67,27 @@ partionateAndExpandTypes used_module_numbers main_dcl_module_index icl_common=:{
(dcl_modules, common_defs) = update_modules_and_create_commondefs used_module_numbers type_defs nr_of_modules dcl_modules (dcl_modules, common_defs) = update_modules_and_create_commondefs used_module_numbers type_defs nr_of_modules dcl_modules
= (reverse pi_groups, common_defs, pi_type_def_infos, {icl_common & com_type_defs = icl_type_defs}, dcl_modules, type_heaps, error) = (reverse pi_groups, common_defs, pi_type_def_infos, {icl_common & com_type_defs = icl_type_defs}, dcl_modules, type_heaps, error)
where where
copy_type_defs_and_create_marks_and_infos used_module_numbers main_dcl_module_index nr_of_types_in_icl_mod nr_of_modules (icl_type_defs, dcl_modules) copy_type_defs_and_create_marks_and_infos used_module_numbers main_dcl_module_index n_types_without_not_exported_dictionaries nr_of_modules (icl_type_defs, dcl_modules)
# type_defs = { {} \\ module_nr <- [1..nr_of_modules] } # type_defs = { {} \\ module_nr <- [1..nr_of_modules] }
marks = { {} \\ module_nr <- [1..nr_of_modules] } marks = { {} \\ module_nr <- [1..nr_of_modules] }
type_def_infos = { {} \\ module_nr <- [1..nr_of_modules] } type_def_infos = { {} \\ module_nr <- [1..nr_of_modules] }
= iFoldSt (copy_type_def_and_create_marks_and_infos used_module_numbers main_dcl_module_index nr_of_types_in_icl_mod) 0 nr_of_modules = iFoldSt (copy_type_def_and_create_marks_and_infos used_module_numbers main_dcl_module_index n_types_without_not_exported_dictionaries) 0 nr_of_modules
(icl_type_defs, dcl_modules, type_defs, marks, type_def_infos) (icl_type_defs, dcl_modules, type_defs, marks, type_def_infos)
where where
copy_type_def_and_create_marks_and_infos used_module_numbers main_dcl_module_index nr_of_types_in_icl_mod module_index copy_type_def_and_create_marks_and_infos used_module_numbers main_dcl_module_index n_types_without_not_exported_dictionaries module_index
(icl_type_defs, dcl_modules, type_defs, marks, type_def_infos) (icl_type_defs, dcl_modules, type_defs, marks, type_def_infos)
| inNumberSet module_index used_module_numbers | inNumberSet module_index used_module_numbers
# ({com_type_defs,com_class_defs}, dcl_modules) = dcl_modules![module_index].dcl_common # ({com_type_defs,com_class_defs}, dcl_modules) = dcl_modules![module_index].dcl_common
| module_index == main_dcl_module_index | module_index == main_dcl_module_index
= ( { type_def \\ type_def <-: com_type_defs }, dcl_modules, { type_defs & [module_index] = icl_type_defs }, = ( { type_def \\ type_def <-: com_type_defs }, dcl_modules, { type_defs & [module_index] = icl_type_defs },
{ marks & [module_index] = createArray nr_of_types_in_icl_mod cNotPartitionated }, { marks & [module_index] = createArray n_types_without_not_exported_dictionaries cNotPartitionated },
{ type_def_infos & [module_index] = createArray nr_of_types_in_icl_mod EmptyTypeDefInfo }) { type_def_infos & [module_index] = createArray n_types_without_not_exported_dictionaries EmptyTypeDefInfo })
# nr_of_types = size com_type_defs - size com_class_defs # nr_of_types = size com_type_defs - size com_class_defs
= ( icl_type_defs, dcl_modules, { type_defs & [module_index] = { type_def \\ type_def <-: com_type_defs }}, = ( icl_type_defs, dcl_modules, { type_defs & [module_index] = { type_def \\ type_def <-: com_type_defs }},
{ marks & [module_index] = createArray nr_of_types cNotPartitionated }, { marks & [module_index] = createArray nr_of_types cNotPartitionated },
{ type_def_infos & [module_index] = createArray nr_of_types EmptyTypeDefInfo }) { type_def_infos & [module_index] = createArray nr_of_types EmptyTypeDefInfo })
= (icl_type_defs, dcl_modules, type_defs, marks,type_def_infos) = (icl_type_defs, dcl_modules, type_defs, marks,type_def_infos)
partionate_type_defs mod_index pi=:{pi_marks}
#! nr_of_typedefs_to_be_examined = size pi_marks.[mod_index]
= iFoldSt (partitionate_type_def mod_index) 0 nr_of_typedefs_to_be_examined pi
where
partitionate_type_def module_index type_index pi=:{pi_marks}
# mark = pi_marks.[module_index, type_index]
| mark == cNotPartitionated
# (_, pi) = partitionateTypeDef {gi_module = module_index, gi_index = type_index} pi
= pi
= pi
expand_synonym_types_of_group main_dcl_module_index group_members (type_defs, main_dcl_type_defs, type_heaps, error) expand_synonym_types_of_group main_dcl_module_index group_members (type_defs, main_dcl_type_defs, type_heaps, error)
= foldSt (expand_synonym_type main_dcl_module_index) group_members (type_defs, main_dcl_type_defs, type_heaps, error) = foldSt (expand_synonym_type main_dcl_module_index) group_members (type_defs, main_dcl_type_defs, type_heaps, error)
where where
...@@ -800,9 +806,9 @@ where ...@@ -800,9 +806,9 @@ where
# (kind_info_ptr, kind_heap) = newPtr KI_Const kind_heap # (kind_info_ptr, kind_heap) = newPtr KI_Const kind_heap
= ( type_var_heap <:= (tv_info_ptr, TVI_TypeKind kind_info_ptr), kind_heap <:= (kind_info_ptr, KI_Var kind_info_ptr)) = ( type_var_heap <:= (tv_info_ptr, TVI_TypeKind kind_info_ptr), kind_heap <:= (kind_info_ptr, KI_Var kind_info_ptr))
checkKindsOfCommonDefsAndFunctions :: !Index !Index !NumberSet !IndexRange !{#CommonDefs} !u:{# FunDef} !v:{#DclModule} !*TypeDefInfos !*ClassDefInfos checkKindsOfCommonDefsAndFunctions :: !Index !Index !NumberSet ![IndexRange] !{#CommonDefs} !u:{# FunDef} !v:{#DclModule} !*TypeDefInfos !*ClassDefInfos
!*TypeVarHeap !*ErrorAdmin -> (!u:{# FunDef}, !v:{#DclModule}, !*TypeDefInfos, !*TypeVarHeap, !*ErrorAdmin) !*TypeVarHeap !*ErrorAdmin -> (!u:{# FunDef}, !v:{#DclModule}, !*TypeDefInfos, !*TypeVarHeap, !*ErrorAdmin)
checkKindsOfCommonDefsAndFunctions first_uncached_module main_module_index used_module_numbers icl_fun_def_range common_defs icl_fun_defs dcl_modules checkKindsOfCommonDefsAndFunctions first_uncached_module main_module_index used_module_numbers icl_fun_def_ranges common_defs icl_fun_defs dcl_modules
type_def_infos class_infos type_var_heap error type_def_infos class_infos type_var_heap error
# as = # as =
{ as_td_infos = type_def_infos { as_td_infos = type_def_infos
...@@ -812,16 +818,19 @@ checkKindsOfCommonDefsAndFunctions first_uncached_module main_module_index used_ ...@@ -812,16 +818,19 @@ checkKindsOfCommonDefsAndFunctions first_uncached_module main_module_index used_
} }
# (icl_fun_defs, dcl_modules, class_infos, as) # (icl_fun_defs, dcl_modules, class_infos, as)
= iFoldSt (check_kinds_of_module first_uncached_module main_module_index used_module_numbers icl_fun_def_range common_defs) = iFoldSt (check_kinds_of_module first_uncached_module main_module_index used_module_numbers icl_fun_def_ranges common_defs)
0 (size common_defs) (icl_fun_defs, dcl_modules, class_infos, as) 0 (size common_defs) (icl_fun_defs, dcl_modules, class_infos, as)
= (icl_fun_defs, dcl_modules, as.as_td_infos, as.as_type_var_heap, as.as_error) = (icl_fun_defs, dcl_modules, as.as_td_infos, as.as_type_var_heap, as.as_error)
where where
check_kinds_of_module first_uncached_module main_module_index used_module_numbers {ir_from,ir_to} common_defs module_index check_kinds_of_module first_uncached_module main_module_index used_module_numbers icl_fun_def_ranges common_defs module_index
(icl_fun_defs, dcl_modules, class_infos, as) (icl_fun_defs, dcl_modules, class_infos, as)
| inNumberSet module_index used_module_numbers | inNumberSet module_index used_module_numbers
| module_index == main_module_index | module_index == main_module_index
# (class_infos, as) = check_kinds_of_class_instances common_defs 0 common_defs.[module_index].com_instance_defs class_infos as # (class_infos, as) = check_kinds_of_class_instances common_defs 0 common_defs.[module_index].com_instance_defs class_infos as
(icl_fun_defs, class_infos, as) = iFoldSt (check_kinds_of_icl_fuction common_defs) ir_from ir_to (icl_fun_defs, class_infos, as) # (icl_fun_defs, class_infos, as) = foldSt (check_kinds_of_icl_fuctions common_defs) icl_fun_def_ranges (icl_fun_defs, class_infos, as)
with
check_kinds_of_icl_fuctions common_defs {ir_from,ir_to} (icl_fun_defs, class_infos, as)
= iFoldSt (check_kinds_of_icl_fuction common_defs) ir_from ir_to (icl_fun_defs, class_infos, as)
= (icl_fun_defs, dcl_modules, class_infos, as) = (icl_fun_defs, dcl_modules, class_infos, as)
| module_index >= first_uncached_module | module_index >= first_uncached_module
# (class_infos, as) = check_kinds_of_class_instances common_defs 0 common_defs.[module_index].com_instance_defs class_infos as # (class_infos, as) = check_kinds_of_class_instances common_defs 0 common_defs.[module_index].com_instance_defs class_infos as
......
...@@ -310,9 +310,11 @@ propClassification :: !Index !Index ![PropClassification] !{# CommonDefs } !*Typ ...@@ -310,9 +310,11 @@ propClassification :: !Index !Index ![PropClassification] !{# CommonDefs } !*Typ
propClassification type_index module_index hio_props defs type_var_heap td_infos propClassification type_index module_index hio_props defs type_var_heap td_infos
| type_index >= size td_infos.[module_index] | type_index >= size td_infos.[module_index]
= (0, type_var_heap, td_infos) = (0, type_var_heap, td_infos)
# {td_args, td_name} = defs.[module_index].com_type_defs.[type_index] # (td_info, td_infos) = td_infos![module_index].[type_index]
(td_info, td_infos) = td_infos![module_index].[type_index] | td_info.tdi_group_nr== (-1) // is an exported dictionary ?
= determinePropClassOfTypeDef type_index module_index td_args td_info hio_props defs type_var_heap td_infos = (0, type_var_heap, td_infos)
# {td_args, td_name} = defs.[module_index].com_type_defs.[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) -> (!PropClassification,!*TypeVarHeap, !*TypeDefInfos)
......
system module cheat
//i :: !b -> a