Skip to content
GitLab
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
Hide whitespace changes
Inline Side-by-side
backend/backendconvert.icl
View file @ 6b843949
......@@ -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)
import RWSDebug
backEndConvertModulesH :: PredefinedSymbols FrontEndSyntaxTree !Int *BackEndState -> *BackEndState
backEndConvertModulesH predefs {fe_icl =
fe_icl =: {icl_name, icl_modification_time, icl_functions, icl_common,icl_imported_objects,icl_used_module_numbers},
fe_components, fe_dcls, fe_arrayInstances, fe_dclIclConversions, fe_iclDclConversions,fe_globalFunctions}
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}
main_dcl_module_n backEnd
// sanity check ...
// | cIclModIndex <> kIclModuleIndex || cPredefinedModuleIndex <> kPredefinedModuleIndex
......@@ -410,11 +412,7 @@ backEndConvertModulesH predefs {fe_icl =
# currentDcl
= 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 ->>
( "dcl conversions"
......@@ -425,14 +423,12 @@ backEndConvertModulesH predefs {fe_icl =
, [selector.sd_symb.id_name \\ selector <-: currentDcl.dcl_common.com_selector_defs]
, "dcl types"
, [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]
, "icl fields"
, "icl selectors"
, [selector.sd_symb.id_name \\ selector <-: icl_common.com_selector_defs]
, "icl types"
, [type.td_name.id_name \\ type <-: icl_common.com_type_defs]
, "compare names"
, (rstypes, types)
)
*/
#! backEnd
......@@ -446,21 +442,13 @@ backEndConvertModulesH predefs {fe_icl =
#! backEnd
= 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
= defineOtherDclModules fe_dcls main_dcl_module_n icl_used_module_numbers (backEnd -*-> "defineOtherDclModules")
#! 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")
#! backEnd
= declareFunctionSymbols icl_functions (getConversions fe_iclDclConversions) functionIndices fe_globalFunctions (backEnd -*-> "declareFunctionSymbols")
with
getConversions :: (Optional {#Int}) -> {#Int}
getConversions No
= {}
getConversions (Yes conversions)
= conversions
= declareFunctionSymbols icl_functions functionIndices icl_global_functions (backEnd -*-> "declareFunctionSymbols")
#! backEnd
= declare main_dcl_module_n icl_common (backEnd -*-> "declare (main_dcl_module_n)")
#! backEnd
......@@ -483,7 +471,7 @@ backEndConvertModulesH predefs {fe_icl =
(convertStrings [imported.io_name \\ imported <- icl_imported_objects | imported.io_is_library])
(backEnd -*-> "beDefineImportedObjsAndLibs")
#! 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
dcl_common
= currentDcl.dcl_common
......@@ -563,49 +551,6 @@ where
_
-> 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
class declareVars a :: a !DeclVarsInput -> BackEnder
......@@ -728,21 +673,25 @@ instance declare {#a} | declareWithIndex a & Array {#} a where
declare moduleIndex array
= foldStateWithIndexA (\i -> declareWithIndex i moduleIndex) array
declareFunctionSymbols :: {#FunDef} {#Int} [(Int, Int)] IndexRange *BackEndState -> *BackEndState
declareFunctionSymbols functions iclDclConversions functionIndices globalFunctions backEnd
= foldl (declare iclDclConversions) backEnd [(functionIndex, componentIndex, functions.[functionIndex]) \\ (componentIndex, functionIndex) <- functionIndices]
declareFunctionSymbols :: {#FunDef} [(Int, Int)] [IndexRange] *BackEndState -> *BackEndState
declareFunctionSymbols functions functionIndices globalFunctions backEnd
= foldl declare backEnd [(functionIndex, componentIndex, functions.[functionIndex]) \\ (componentIndex, functionIndex) <- functionIndices]
where
declare iclDclConversions backEnd (functionIndex, componentIndex, function)
= appBackEnd (BEDeclareFunction (functionName function.fun_symb.id_name functionIndex iclDclConversions globalFunctions)
declare backEnd (functionIndex, componentIndex, function)
= appBackEnd (BEDeclareFunction (functionName function.fun_symb.id_name functionIndex globalFunctions)
function.fun_arity functionIndex componentIndex) backEnd
where
functionName :: {#Char} Int {#Int} IndexRange -> {#Char}
functionName name functionIndex iclDclConversions {ir_from, ir_to}
// | trace_t ("|"+++toString functionIndex)
| functionIndex >= ir_to || functionIndex < ir_from
= (name +++ ";" +++ toString iclDclConversions.[functionIndex])
// otherwise
functionName :: {#Char} Int [IndexRange] -> {#Char}
functionName name functionIndex icl_global_functions
// | trace_t ("|"+++toString functionIndex)
| index_in_ranges functionIndex icl_global_functions
= 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
foldStateWithIndexRangeA function frm to array
......@@ -850,48 +799,7 @@ declareFunType moduleIndex nrOfDclFunctions functionIndex {ft_symb, ft_type_ptr}
// otherwise
= name +++ ";" +++ toString functionIndex
currentModuleTypeConversions :: {#ClassDef} {#ClassDef} (Optional ConversionTable) -> {#Int}
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
= {}
import StdDebug
/*
declareCurrentDclModuleTypes :: {#CheckedTypeDef} {#Int} -> BackEnder
......@@ -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)))
(convertFunctionBody index (positionToLineNumber fun_pos) aliasDummyId body main_dcl_module_n)
where
cafness :: DefOrImpFunKind -> Int
cafness (FK_DefFunction _)
= BEIsNotACaf
cafness (FK_ImpFunction _)
= BEIsNotACaf
cafness FK_DefMacro
cafness :: FunKind -> Int
cafness (FK_Function _)
= BEIsNotACaf
cafness FK_ImpMacro
cafness FK_Macro
= BEIsNotACaf
cafness FK_ImpCaf
cafness FK_Caf
= BEIsACaf
cafness funKind
= BEIsNotACaf // <<- ("backendconvert, cafness: unknown fun kind", funKind)
......@@ -2222,13 +2126,23 @@ getVariableSequenceNumber varInfoPtr be
vi
-> abort "getVariableSequenceNumber" // <<- vi
markExports :: DclModule {#ClassDef} {#CheckedTypeDef} {#ClassDef} {#CheckedTypeDef} (Optional {#Int}) -> BackEnder
markExports {dcl_conversions = Yes conversionTable} dclClasses dclTypes iclClasses iclTypes (Yes functionConversions)
= foldStateA (\icl -> beExportType icl icl) conversionTable.[cTypeDefs]
o foldStateWithIndexA beExportConstructor conversionTable.[cConstructorDefs]
o foldStateWithIndexA beExportField conversionTable.[cSelectorDefs]
o foldStateWithIndexA (exportDictionary iclClasses iclTypes) conversionTable.[cClassDefs]
o foldStateWithIndexA beExportFunction functionConversions
foldStateWithIndexTwice function n
:== foldStateWithIndexTwice 0
where
foldStateWithIndexTwice index
| index == n
= identity
// 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
exportDictionary :: {#ClassDef} {#CheckedTypeDef} Index Index -> BackEnder
exportDictionary iclClasses iclTypes dclClassIndex iclClassIndex
......@@ -2245,5 +2159,5 @@ markExports {dcl_conversions = Yes conversionTable} dclClasses dclTypes iclClass
exportDictionaryField :: FieldSymbol -> BackEnder
exportDictionaryField {fs_index}
= beExportField (-1) fs_index // remove -1 hack
markExports _ _ _ _ _ _
markExports _ _ _ _ _
= identity
frontend/StdCompare.icl
View file @ 6b843949
......@@ -99,6 +99,7 @@ instance == Priority
where
(==) NoPrio NoPrio = True
(==) (Prio assoc1 prio1) (Prio assoc2 prio2) = assoc1==assoc2 && prio1==prio2
(==) _ _ = False
instance == Assoc
where
......@@ -137,6 +138,7 @@ where
// compare_indexes (SK_InternalFunction i1) (SK_InternalFunction 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_LocalDclMacroFunction i1) (SK_LocalDclMacroFunction i2) = i1 =< i2
| less_constructor symb1 symb2
= Smaller
......
frontend/analtypes.dcl
View file @ 6b843949
......@@ -12,7 +12,7 @@ analyseTypeDefs :: !{#CommonDefs} !TypeGroups !*TypeDefInfos !*TypeVarHeap !*Err
determineKindsOfClasses :: !NumberSet !{#CommonDefs} !*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)
isATopConsVar cv :== cv < 0
......
frontend/analtypes.icl
View file @ 6b843949
......@@ -30,15 +30,32 @@ partionateAndExpandTypes :: !NumberSet !Index !*CommonDefs !*{#DclModule} !*Type
-> (!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
#! 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)
= 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_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
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
# (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
......@@ -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
= (reverse pi_groups, common_defs, pi_type_def_infos, {icl_common & com_type_defs = icl_type_defs}, dcl_modules, type_heaps, error)
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] }
marks = { {} \\ 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)
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)
| inNumberSet module_index used_module_numbers
# ({com_type_defs,com_class_defs}, dcl_modules) = dcl_modules![module_index].dcl_common
| module_index == main_dcl_module_index
= ( { 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 },
{ type_def_infos & [module_index] = createArray nr_of_types_in_icl_mod EmptyTypeDefInfo })
{ marks & [module_index] = createArray n_types_without_not_exported_dictionaries cNotPartitionated },
{ type_def_infos & [module_index] = createArray n_types_without_not_exported_dictionaries EmptyTypeDefInfo })
# 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 }},
{ marks & [module_index] = createArray nr_of_types cNotPartitionated },
{ type_def_infos & [module_index] = createArray nr_of_types EmptyTypeDefInfo })
= (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)
= foldSt (expand_synonym_type main_dcl_module_index) group_members (type_defs, main_dcl_type_defs, type_heaps, error)
where
......@@ -800,9 +806,9 @@ where
# (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))
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)
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
# as =
{ as_td_infos = type_def_infos
......@@ -812,16 +818,19 @@ checkKindsOfCommonDefsAndFunctions first_uncached_module main_module_index used_
}
# (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)
= (icl_fun_defs, dcl_modules, as.as_td_infos, as.as_type_var_heap, as.as_error)
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)
| inNumberSet module_index used_module_numbers
| 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
(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)
| 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
......
frontend/analunitypes.icl
View file @ 6b843949
......@@ -310,9 +310,11 @@ propClassification :: !Index !Index ![PropClassification] !{# CommonDefs } !*Typ
propClassification type_index module_index hio_props defs type_var_heap td_infos
| type_index >= size td_infos.[module_index]
= (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]
= determinePropClassOfTypeDef type_index module_index td_args td_info hio_props defs type_var_heap td_infos
# (td_info, td_infos) = td_infos![module_index].[type_index]
| td_info.tdi_group_nr== (-1) // is an exported dictionary ?
= (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
-> (!PropClassification,!*TypeVarHeap, !*TypeDefInfos)
......
frontend/cheat.dcl 0 → 100644
View file @ 6b843949
system module cheat
//i :: !b -> a
uniqueCopy :: !*a -> (!*a, !*a)
frontend/check.dcl
View file @ 6b843949
......@@ -2,11 +2,15 @@ definition module check
import syntax, transform, checksupport, typesupport, predef
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 /* TD */, [String])
checkModule :: !ScannedModule !IndexRange ![FunDef] !Int !Int !(Optional ScannedModule) ![ScannedModule] !{#DclModule} !*{#*{#FunDef}} !*PredefinedSymbols !*SymbolTable !*File !*Heaps
-> (!Bool, *IclModule, *{# DclModule}, *{! Group}, !*{#*{#FunDef}},!Int, !*Heaps, !*PredefinedSymbols, !*SymbolTable, *File, [String])
checkFunctions :: !Index !Level !Index !Index !*{#FunDef} !*ExpressionInfo !*Heaps !*CheckState -> (!*{#FunDef}, !*ExpressionInfo, !*Heaps, !*CheckState)
checkFunctions :: !Index !Level !Index !Index !Int !*{#FunDef} !*ExpressionInfo !*Heaps !*CheckState
-> (!*{#FunDef},!*ExpressionInfo,!*Heaps,!*CheckState)
checkDclMacros :: !Index !Level !Index !Index !*{#FunDef} !*ExpressionInfo !*Heaps !*CheckState
-> (!*{#FunDef},!*ExpressionInfo,!*Heaps,!*CheckState)
determineTypeOfMemberInstance :: !SymbolType ![TypeVar] !InstanceType !Specials !*TypeHeaps !u:(Optional (v:{#DclModule}, w:{#CheckedTypeDef}, Index)) !*ErrorAdmin
-> (!SymbolType, !Specials, !*TypeHeaps, !u:Optional (v:{#DclModule}, w:{#CheckedTypeDef}), !*ErrorAdmin)
......
frontend/check.icl
View file @ 6b843949
......@@ -12,7 +12,6 @@ isMainModule :: ModuleKind -> Bool
isMainModule MK_Main = True
isMainModule _ = False
// AA..
checkGenerics :: !Index !Index !*{#GenericDef} !*{#ClassDef} !*{#CheckedTypeDef} !*{#DclModule} !*TypeHeaps !*CheckState
-> (!*{#GenericDef}, !*{#ClassDef}, !*{#CheckedTypeDef}, !*{#DclModule}, !*TypeHeaps, !*CheckState)
checkGenerics
......@@ -239,7 +238,7 @@ where
(instance_def, is, type_heaps, cs) = check_instance mod_index instance_def is type_heaps cs
= check_instance_defs (inc inst_index) mod_index { instance_defs & [inst_index] = instance_def } is type_heaps cs
= (instance_defs, is, type_heaps, cs)
check_instance :: !Index !ClassInstance !u:InstanceSymbols !*TypeHeaps !*CheckState -> (!ClassInstance, !u:InstanceSymbols, !*TypeHeaps, !*CheckState)
check_instance module_index
ins=:{ins_members,ins_class={glob_object = class_name =: {ds_ident = {id_name,id_info},ds_arity}},ins_type,ins_specials,ins_pos,ins_ident}
......@@ -284,9 +283,7 @@ where
ins=:{ins_members,ins_class={glob_object = class_name =: {ds_ident = {id_name,id_info},ds_arity}},ins_type,ins_specials,ins_pos,ins_ident,ins_generate}
is=:{is_class_defs,is_modules} type_heaps cs=:{cs_symbol_table}
| ins_generate
= ( ins
, is
, type_heaps
= ( ins, is, type_heaps
, { cs & cs_error = checkError id_name "cannot generate class instance" cs.cs_error }
)
| class_def.class_arity == ds_arity
......@@ -297,9 +294,7 @@ where
is = { is & is_type_defs = is_type_defs, is_class_defs = is_class_defs, is_modules = is_modules }
= ({ins & ins_class = ins_class, ins_type = ins_type, ins_specials = ins_specials}, is, type_heaps, cs)
// otherwise
= ( ins
, is
, type_heaps
= ( ins, is, type_heaps
, { cs & cs_error = checkError id_name ("wrong arity: expected "+++toString class_def.class_arity+++" found "+++toString ds_arity) cs.cs_error }
)
check_generic_instance :: GenericDef !Index !Index !Index !ClassInstance !u:InstanceSymbols !*TypeHeaps !*CheckState -> (!ClassInstance, !u:InstanceSymbols, !*TypeHeaps, !*CheckState)
......@@ -307,14 +302,8 @@ where
{gen_member_name}
module_index generic_index generic_module_index
ins=:{
ins_members,
ins_class={glob_object = class_name =: {ds_ident = {id_name,id_info},ds_arity, ds_index} },
ins_type,
ins_specials,
ins_pos,
ins_ident,
ins_is_generic,
ins_generate
ins_members, ins_type, ins_specials, ins_pos, ins_ident, ins_is_generic, ins_generate
}
is=:{is_class_defs,is_modules}
type_heaps
......@@ -357,7 +346,6 @@ where
!*VarHeap !*TypeHeaps !*CheckState
-> (![(Index,SymbolType)], !x:{# ClassInstance}, !w:{# ClassDef}, !v:{# MemberDef}, /*AA*/!w:{# GenericDef}, !nerd:{# CheckedTypeDef}, !u:{# DclModule}, !*VarHeap, !*TypeHeaps, !*CheckState)
check_instances inst_index mod_index instance_types instance_defs class_defs member_defs generic_defs type_defs modules var_heap type_heaps cs
// AA..
| inst_index < size instance_defs
# (instance_def=:{ins_ident,ins_is_generic, ins_pos}, instance_defs) = instance_defs![inst_index]
# (instance_types, class_defs, member_defs, generic_defs, type_defs, modules, var_heap, type_heaps, cs) =
......@@ -366,7 +354,7 @@ where
= check_instances (inc inst_index) mod_index instance_types instance_defs class_defs member_defs generic_defs type_defs modules var_heap type_heaps cs
// otherwise
= (instance_types, instance_defs, class_defs, member_defs, generic_defs, type_defs, modules, var_heap, type_heaps, cs)
check_class_instance {ins_pos,ins_class,ins_members,ins_type} mod_index instance_types class_defs member_defs generic_defs type_defs modules var_heap type_heaps cs
# ({class_members,class_name}, class_defs, modules) = getClassDef ins_class mod_index class_defs modules
class_size = size class_members
......@@ -378,7 +366,7 @@ where
// otherwise
# cs = { cs & cs_error = checkError class_name "different number of members specified" cs.cs_error }
= (instance_types, class_defs, member_defs, generic_defs, type_defs, modules, var_heap, type_heaps, cs)
check_generic_instance {ins_class, ins_members, ins_generate} mod_index instance_types class_defs member_defs generic_defs type_defs modules var_heap type_heaps cs
# ({gen_name, gen_member_name}, generic_defs, modules) = getGenericDef ins_class mod_index generic_defs modules
//| ins_generate
......@@ -392,7 +380,6 @@ where
= (instance_types, class_defs, member_defs, generic_defs, type_defs, modules, var_heap, type_heaps, cs)
// otherwise
= (instance_types, class_defs, member_defs, generic_defs, type_defs, modules, var_heap, type_heaps, cs)
// ..AA
check_member_instances :: !Index !Index !Int !Int !{#DefinedSymbol} !{#DefinedSymbol} Ident !Position !InstanceType ![(Index,SymbolType)]
!v:{# MemberDef} !blah:{# CheckedTypeDef} !u:{# DclModule} !*VarHeap !*TypeHeaps !*CheckState
......@@ -437,7 +424,6 @@ getMemberDef mem_mod mem_index mod_index member_defs modules
# (dcl_mod,modules) = modules![mem_mod]
= (dcl_mod.dcl_common.com_member_defs.[mem_index], member_defs, modules)
// AA..
getGenericDef :: !(Global DefinedSymbol) !Int !u:{#GenericDef} !v:{#DclModule} -> (!GenericDef,!u:{#GenericDef},!v:{#DclModule})
getGenericDef {glob_module, glob_object={ds_ident, ds_index}} mod_index generic_defs modules
| glob_module == mod_index
......@@ -445,7 +431,6 @@ getGenericDef {glob_module, glob_object={ds_ident, ds_index}} mod_index generic_
= (generic_def, generic_defs, modules)
# (dcl_mod, modules) = modules![glob_module]
= (dcl_mod.dcl_common.com_generic_defs.[ds_index], generic_defs, modules)
// ..AA
instantiateTypes :: ![TypeVar] ![AttributeVar] ![AType] ![TypeContext] ![AttrInequality] !SpecialSubstitution ![SpecialSubstitution] !*TypeHeaps !*ErrorAdmin
-> (![TypeVar], ![AttributeVar], ![AType], ![TypeContext], ![AttrInequality], ![SpecialSubstitution], !*TypeHeaps, !*ErrorAdmin)
......@@ -796,23 +781,18 @@ where