Skip to content

GitLab

Commit 3730ffd3 authored by John van Groningen's avatar John van Groningen
Browse files

refactor. in module backendconvert remove functions beautifyAttributes,... 

refactor. in module backendconvert remove functions beautifyAttributes, convertSymbolTypeArgs and remove_first_arg_type and some unused code
parent 62fda8f6
Hide whitespace changes
Inline Side-by-side
backend/backendconvert.icl
View file @ 3730ffd3
......@@ -74,16 +74,6 @@ where
write_to_attr_heap ptr v beState
= {beState & bes_attrHeap = writePtr ptr v beState.bes_attrHeap}
/*
read_from_var_heap ptr heap be
= (sreadPtr ptr heap,be)
:: *BackEndState :== BackEnd
appBackEnd f beState :== f beState
accBackEnd f beState :== f beState
accVarHeap f beState :== f beState
*/
beApFunction0 f
:== appBackEnd f
......@@ -281,10 +271,6 @@ backEndConvertModulesH predefs {fe_icl =
iaci_start_index_generic_classes, iaci_not_exported_generic_classes }
}
main_dcl_module_n type_var_heap backEnd
// sanity check ...
// | cIclModIndex <> kIclModuleIndex || cPredefinedModuleIndex <> kPredefinedModuleIndex
// = undef <<- "backendconvert, backEndConvertModules: module index mismatch"
// ... sanity check
#! backEnd = appBackEnd (BESetMainDclModuleN main_dcl_module_n) backEnd
#! backEnd
= appBackEnd (BEDeclareModules (size fe_dcls)) backEnd
......@@ -521,9 +507,6 @@ where
(write_to_var_heap cons_type_ptr VI_Empty be0)
be0
(|>) infixl
(|>) s f :== f s
:: DeclVarsInput :== Ident
:: *DeclVarsState = { dvs_backEnd :: !BackEnd, dvs_varHeap :: !*VarHeap, dvs_sequenceNumber :: !Int }
......@@ -677,25 +660,24 @@ folds op l r :== folds l r
folds [] r = r
folds [a:x] r = folds x (op a r)
(|>) infixl
(|>) s f :== f s
declareGeneratedUnboxedRecordInstances
ali_array_first_instance_indices ali_list_first_instance_indices ali_tail_strict_list_first_instance_indices
ali_unboxed_maybe_first_instance_indices predefs main_dcl_module_n icl_functions fe_dcls backEnd
#! backEnd
= declareGeneratedUnboxedRecordInstancesOfClass ali_array_first_instance_indices PD_StdArray PD_ArrayClass predefs main_dcl_module_n icl_functions fe_dcls backEnd
#! backEnd
= declareGeneratedUnboxedRecordInstancesOfClass ali_list_first_instance_indices PD_StdStrictLists PD_UListClass predefs main_dcl_module_n icl_functions fe_dcls backEnd
#! backEnd
= declareGeneratedUnboxedRecordInstancesOfClass ali_tail_strict_list_first_instance_indices PD_StdStrictLists PD_UTSListClass predefs main_dcl_module_n icl_functions fe_dcls backEnd
#! backEnd
= declareGeneratedUnboxedRecordInstancesOfClass ali_unboxed_maybe_first_instance_indices PD_StdStrictMaybes PD_UMaybeClass predefs main_dcl_module_n icl_functions fe_dcls backEnd
= backEnd
|> declareGeneratedUnboxedRecordInstancesOfClass ali_array_first_instance_indices PD_StdArray PD_ArrayClass predefs main_dcl_module_n icl_functions fe_dcls
|> declareGeneratedUnboxedRecordInstancesOfClass ali_list_first_instance_indices PD_StdStrictLists PD_UListClass predefs main_dcl_module_n icl_functions fe_dcls
|> declareGeneratedUnboxedRecordInstancesOfClass ali_tail_strict_list_first_instance_indices PD_StdStrictLists PD_UTSListClass predefs main_dcl_module_n icl_functions fe_dcls
|> declareGeneratedUnboxedRecordInstancesOfClass ali_unboxed_maybe_first_instance_indices PD_StdStrictMaybes PD_UMaybeClass predefs main_dcl_module_n icl_functions fe_dcls
declareGeneratedUnboxedRecordInstancesOfClass :: [Int] Int Int PredefinedSymbols Int {#FunDef} {#DclModule} -> BackEnder
declareGeneratedUnboxedRecordInstancesOfClass [] predef_class_module_index predef_class_index predefs main_dcl_module_n functions dcls
= identity
declareGeneratedUnboxedRecordInstancesOfClass ali_first_instance_indices predef_class_module_index predef_class_index predefs main_dcl_module_n functions dcls
declareGeneratedUnboxedRecordInstancesOfClass :: [Int] Int Int PredefinedSymbols Int {#FunDef} {#DclModule} !*BackEndState -> *BackEndState
declareGeneratedUnboxedRecordInstancesOfClass [] predef_class_module_index predef_class_index predefs main_dcl_module_n functions dcls bes
= bes
declareGeneratedUnboxedRecordInstancesOfClass ali_first_instance_indices predef_class_module_index predef_class_index predefs main_dcl_module_n functions dcls bes
#! n_class_members=size dcls.[class_module_index].dcl_common.com_class_defs.[class_index].class_members
= folds (declareInstances 0 n_class_members) ali_first_instance_indices
= folds (declareInstances 0 n_class_members) ali_first_instance_indices bes
where
class_module_index = predefs.[predef_class_module_index].pds_def
class_index = predefs.[predef_class_index].pds_def
......@@ -761,33 +743,32 @@ declareFunTypes :: ModuleIndex {#FunType} [IndexRange] -> BackEnder
declareFunTypes moduleIndex funTypes ranges
= foldStateWithIndexA (declareFunType moduleIndex ranges) funTypes
declareFunType :: ModuleIndex [IndexRange] Int FunType -> BackEnder
declareFunType moduleIndex ranges functionIndex {ft_ident,ft_type_ptr,ft_specials}
= \be0 -> let (vi,be) = read_from_var_heap ft_type_ptr be0 in
(case vi of
VI_ExpandedType expandedType
| not ft_specials=:FSP_ABCCode _
-> beDeclareRuleType functionIndex moduleIndex (functionName ft_ident.id_name functionIndex ranges)
o` beDefineRuleType functionIndex moduleIndex (convertTypeAlt functionIndex moduleIndex expandedType)
-> be_f ft_specials with
be_f (FSP_ABCCode abc_code) be
# be = beDeclareRuleType functionIndex moduleIndex (functionName ft_ident.id_name functionIndex ranges) be
= beDefineRuleTypeWithCode functionIndex moduleIndex
(convertTypeAlt functionIndex moduleIndex expandedType)
(beAbcCodeBlock False (convertStrings abc_code)) be
_
-> identity) be
where
functionName :: {#Char} Int [IndexRange] -> {#Char}
functionName name functionIndex ranges
| index_in_ranges functionIndex ranges
= 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
declareFunType :: ModuleIndex [IndexRange] Int FunType !*BackEndState -> *BackEndState
declareFunType moduleIndex ranges functionIndex {ft_ident,ft_type_ptr,ft_specials} bes
# (vi,bes) = read_from_var_heap ft_type_ptr bes
= case vi of
VI_ExpandedType expandedType
| not ft_specials=:FSP_ABCCode _
-> (beDeclareRuleType functionIndex moduleIndex (functionName ft_ident.id_name functionIndex ranges)
o` beDefineRuleType functionIndex moduleIndex (convertTypeAlt functionIndex moduleIndex expandedType)) bes
# (FSP_ABCCode abc_code) = ft_specials
# bes = beDeclareRuleType functionIndex moduleIndex (functionName ft_ident.id_name functionIndex ranges) bes
-> beDefineRuleTypeWithCode functionIndex moduleIndex
(convertTypeAlt functionIndex moduleIndex expandedType)
(beAbcCodeBlock False (convertStrings abc_code)) bes
_
-> bes
where
functionName :: {#Char} Int [IndexRange] -> {#Char}
functionName name functionIndex ranges
| index_in_ranges functionIndex ranges
= 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
defineTypes :: !Int !Int ModuleIndex {#ConsDef} {#SelectorDef} {#CheckedTypeDef} !*TypeVarHeap !*BackEndState -> (!*TypeVarHeap,!*BackEndState)
defineTypes type_i type_i_stop moduleIndex constructors selectors types type_var_heap bes
......@@ -1040,9 +1021,6 @@ where
= convert_exported_generic_member_selector moduleIndex selectors (arg_is_strict index strictness) symbols.[index] field_list_p type_var_heap bes
= convertSelector moduleIndex selectors (arg_is_strict index strictness) symbols.[index] field_list_p type_var_heap bes
remove_first_arg_type expanded_member_type=:{st_args=[_:args],st_arity,st_args_strictness}
= {expanded_member_type & st_args = args, st_arity = st_arity-1, st_args_strictness = remove_first_n 1 st_args_strictness}
convertMemberSelector :: ModuleIndex {#SelectorDef} Bool FieldSymbol !BEFieldListP !*TypeVarHeap !*BackEndState -> (!BEFieldListP,!*TypeVarHeap,!*BackEndState)
convertMemberSelector moduleIndex selectorDefs is_strict {fs_index} field_list_p type_var_heap bes
# selectorDef = selectorDefs.[fs_index]
......@@ -1063,13 +1041,11 @@ convertMemberSelector moduleIndex selectorDefs is_strict {fs_index} field_list_p
-> (st_result,No,bes)
VI_ExpandedMemberType expanded_member_type (VI_ExpandedType {st_result})
# (dont_care_symbol_p,bes) = accBackEnd BEDontCareDefinitionSymbol bes
expanded_member_type = remove_first_arg_type expanded_member_type
(type_alt_p,bes) = convertTypeAltForSymbolP dont_care_symbol_p expanded_member_type bes
(type_alt_p,bes) = convertTypeAltForSymbolPWithoutFirstArg dont_care_symbol_p expanded_member_type bes
-> (st_result,Yes type_alt_p,bes)
VI_ExpandedMemberType expanded_member_type VI_Empty
# (dont_care_symbol_p,bes) = accBackEnd BEDontCareDefinitionSymbol bes
expanded_member_type = remove_first_arg_type expanded_member_type
(type_alt_p,bes) = convertTypeAltForSymbolP dont_care_symbol_p expanded_member_type bes
(type_alt_p,bes) = convertTypeAltForSymbolPWithoutFirstArg dont_care_symbol_p expanded_member_type bes
-> (sd_type.st_result,Yes type_alt_p,bes)
_
-> (sd_type.st_result,No,bes)
......@@ -1094,13 +1070,11 @@ convert_exported_generic_member_selector moduleIndex selectorDefs is_strict {fs_
-> (st_result,No,bes)
VI_ExpandedMemberType expanded_member_type (VI_ExpandedType {st_result})
# (dont_care_symbol_p,bes) = accBackEnd BEDontCareDefinitionSymbol bes
expanded_member_type = remove_first_arg_type expanded_member_type
(type_alt_p,bes) = convertExportedTypeAltForSymbolP dont_care_symbol_p expanded_member_type bes
(type_alt_p,bes) = convertExportedTypeAltForSymbolPWithoutFirstArg dont_care_symbol_p expanded_member_type bes
-> (st_result,Yes type_alt_p,bes)
VI_ExpandedMemberType expanded_member_type VI_Empty
# (dont_care_symbol_p,bes) = accBackEnd BEDontCareDefinitionSymbol bes
expanded_member_type = remove_first_arg_type expanded_member_type
(type_alt_p,bes) = convertExportedTypeAltForSymbolP dont_care_symbol_p expanded_member_type bes
(type_alt_p,bes) = convertExportedTypeAltForSymbolPWithoutFirstArg dont_care_symbol_p expanded_member_type bes
-> (sd_type.st_result,Yes type_alt_p,bes)
_
-> (sd_type.st_result,No,bes)
......@@ -1529,21 +1503,17 @@ convertRules rules main_dcl_module_n aliasDummyId be
= accBackEnd (BERules ruleP rulesP) be
= convert t rulesP be
convertRule :: Ident (Int,FunDef) Int -> BEMonad BEImpRuleP
convertRule aliasDummyId (index, {fun_type=Yes type, fun_body=body, fun_pos, fun_kind, fun_info}) main_dcl_module_n
convertRule :: Ident (Int,FunDef) Int !*BackEndState -> *(!BEImpRuleP,!*BackEndState)
convertRule aliasDummyId (index, {fun_type=Yes type, fun_body=body, fun_pos, fun_kind, fun_info}) main_dcl_module_n bes
| fun_info.fi_properties bitand FI_FusedMember<>0
#! instance_function_index = fun_info.fi_def_level;
= convert_fused_instance_member_function instance_function_index
with
convert_fused_instance_member_function instance_function_index bes
# bes & bes_backEnd = BESetInstanceFunctionOfFunction index instance_function_index bes.bes_backEnd
= beRule index (cafness fun_kind)
(convertTypeAlt index main_dcl_module_n type)
(convertFunctionBody index (positionToLineNumber fun_pos) aliasDummyId body main_dcl_module_n)
bes
# bes & bes_backEnd = BESetInstanceFunctionOfFunction index instance_function_index bes.bes_backEnd
= beRule index (cafness fun_kind)
(convertTypeAlt index main_dcl_module_n type)
(convertFunctionBody index (positionToLineNumber fun_pos) aliasDummyId body main_dcl_module_n)
(convertFunctionBody index (positionToLineNumber fun_pos) aliasDummyId body main_dcl_module_n) bes
= beRule index (cafness fun_kind)
(convertTypeAlt index main_dcl_module_n type)
(convertFunctionBody index (positionToLineNumber fun_pos) aliasDummyId body main_dcl_module_n) bes
where
cafness :: FunKind -> Int
cafness (FK_Function _)
......@@ -1561,31 +1531,38 @@ convertRule aliasDummyId (index, {fun_type=Yes type, fun_body=body, fun_pos, fun
positionToLineNumber _
= 0
beautifyAttributes :: SymbolType -> BEMonad SymbolType
beautifyAttributes st
= return st
// = accAttrHeap (beautifulizeAttributes st)
convertTypeAlt :: Int ModuleIndex SymbolType -> BEMonad BETypeAltP
convertTypeAlt functionIndex moduleIndex symbolType
= beFunctionSymbol functionIndex moduleIndex ==> \symbol_p ->
convertTypeAltForSymbolP symbol_p symbolType
convertTypeAltForSymbolP :: BESymbolP SymbolType -> BEMonad BETypeAltP
convertTypeAltForSymbolP symbol_p symbolType
= beautifyAttributes (symbolType) ==> \symbolType=:{st_result, st_attr_env, st_attr_vars}
-> resetAttrNumbers st_attr_vars
o` (beTypeAlt symbol_p
(convertSymbolTypeArgs symbolType)
(convertAnnotTypeNode st_result))
convertExportedTypeAltForSymbolP :: BESymbolP SymbolType -> BEMonad BETypeAltP
convertExportedTypeAltForSymbolP symbol_p symbolType
= beautifyAttributes symbolType ==> \ {st_args,st_args_strictness,st_result, st_attr_env, st_attr_vars}
-> resetAttrNumbers st_attr_vars
o` (beTypeAlt symbol_p
(convertAnnotatedExternalTypeArgs st_args st_args_strictness)
(convertAnnotExternalTypeNode st_result))
convertTypeAltForSymbolP :: BESymbolP SymbolType !*BackEndState -> (!BETypeAltP,!*BackEndState)
convertTypeAltForSymbolP symbol_p {st_args,st_result,st_attr_vars,st_args_strictness} bes
= resetAttrNumbers st_attr_vars bes
|> beTypeAlt symbol_p
(convertAnnotatedTypeArgs st_args st_args_strictness)
(convertAnnotTypeNode st_result)
convertTypeAltForSymbolPWithoutFirstArg :: BESymbolP SymbolType !*BackEndState -> (!BETypeAltP,!*BackEndState)
convertTypeAltForSymbolPWithoutFirstArg symbol_p {st_args=st_args=:[_:args],st_result,st_attr_vars,st_args_strictness} bes
= resetAttrNumbers st_attr_vars bes
|> beTypeAlt symbol_p
(convertAnnotatedTypeArgs args (remove_first_n 1 st_args_strictness))
(convertAnnotTypeNode st_result)
convertExportedTypeAltForSymbolP :: BESymbolP SymbolType !*BackEndState -> (!BETypeAltP,!*BackEndState)
convertExportedTypeAltForSymbolP symbol_p {st_args,st_result,st_attr_vars,st_args_strictness} bes
= resetAttrNumbers st_attr_vars bes
|> beTypeAlt symbol_p
(convertAnnotatedExternalTypeArgs st_args st_args_strictness)
(convertAnnotExternalTypeNode st_result)
convertExportedTypeAltForSymbolPWithoutFirstArg :: BESymbolP SymbolType !*BackEndState -> (!BETypeAltP,!*BackEndState)
convertExportedTypeAltForSymbolPWithoutFirstArg symbol_p {st_args=st_args=:[_:args],st_result,st_attr_vars,st_args_strictness} bes
= resetAttrNumbers st_attr_vars bes
|> beTypeAlt symbol_p
(convertAnnotatedExternalTypeArgs args (remove_first_n 1 st_args_strictness))
(convertAnnotExternalTypeNode st_result)
resetAttrNumbers :: [AttributeVar] *BackEndState -> *BackEndState
resetAttrNumbers attrVars state=:{bes_attrHeap}
......@@ -1598,10 +1575,6 @@ resetAttrNumbers attrVars state=:{bes_attrHeap}
resetAttrVar {av_info_ptr} attrHeap
= writePtr av_info_ptr AVI_Empty attrHeap
convertSymbolTypeArgs :: SymbolType -> BEMonad BETypeArgP
convertSymbolTypeArgs {st_args,st_args_strictness}
= convertAnnotatedTypeArgs st_args st_args_strictness
convertBasicTypeKind :: BasicType -> BETypeSymbKind
convertBasicTypeKind BT_Int
= BEIntType
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment