Commit cb71daec authored by clean's avatar clean
Browse files

caching of dcl modules, return unique heap

parent 9207c4bf
......@@ -3,4 +3,4 @@ definition module backendconvert
from backend import BackEnd
import frontend
backEndConvertModules :: PredefinedSymbols FrontEndSyntaxTree VarHeap *BackEnd -> *BackEnd
backEndConvertModules :: PredefinedSymbols FrontEndSyntaxTree !Int *VarHeap *BackEnd -> (!*VarHeap,!*BackEnd)
......@@ -13,69 +13,90 @@ import RWSDebug
(-*->) infixl
(-*->) value trace
:== value // ---> trace
/*
sfoldr op r l
:== foldr l
where
foldr [] = r
foldr [a:x] = \s -> op a (foldr x) s
*/
sfoldr op r l s
:== foldr l s
where
foldr [] = r
foldr [a:x] = op a (foldr x)
:: BEMonad a :== St !*BackEndState !a
:: BEMonad a :== St !*BackEnd !a
:: BackEnder :== *BackEndState -> *BackEndState
//
:: *BackEndState = {bes_backEnd :: !BackEnd, bes_varHeap :: !*VarHeap}
:: BackEnder :== *BackEnd -> *BackEnd
appBackEnd f beState
:== {beState & bes_backEnd = bes_backEnd}
where
bes_backEnd = f beState.bes_backEnd
// fix spelling, this will be removed when cases are implemented in the back end
:: BackEndBody :== BackendBody
BackEndBody :== BackendBody
accBackEnd f beState
:== accBackEnd
where
accBackEnd
# (result, bes_backEnd) = f beState.bes_backEnd
#! beState2 = {beState & bes_backEnd = bes_backEnd}
= (result,beState2)
// foldr` :: (.a -> .(.b -> .b)) .b ![.a] -> .b // op e0 (op e1(...(op r e##)...)
foldr` op r l :== foldr l
accVarHeap f beState
:== (result, {beState & bes_varHeap = varHeap})
where
foldr [] = r
foldr [a:x] = op a (foldr x)
(result, varHeap) = f beState.bes_varHeap
flip` f x y
:== f y x
read_from_var_heap ptr _ beState
= (result, {beState & bes_varHeap = varHeap})
where
(result, varHeap) = readPtr ptr beState.bes_varHeap
/* +++
:: *BackEndState = {bes_backEnd :: BackEnd, bes_varHeap :: *VarHeap}
write_to_var_heap ptr v beState
= {beState & bes_varHeap = writePtr ptr v beState.bes_varHeap}
/*
read_from_var_heap ptr heap be
= (sreadPtr ptr heap,be)
appBackEnd f beState
# (result, bes_backEnd)
= f beState.bes_backEnd
= (result, {beState & bes_backEnd = bes_backEnd})
accVarHeap f beState
# (result, varHeap)
= f beState.bes_varHeap
= (result, {beState & bes_varHeap = varHeap})
*/
appBackEnd f :== f
:: *BackEndState :== BackEnd
appBackEnd f beState :== f beState
accBackEnd f beState :== f beState
accVarHeap f beState :== f beState
*/
beFunction0 f
beApFunction0 f
:== appBackEnd f
beFunction1 f m1
beApFunction1 f m1
:== m1 ==> \a1
-> appBackEnd (f a1)
beFunction2 f m1 m2
beApFunction2 f m1 m2
:== m1 ==> \a1
-> m2 ==> \a2
-> appBackEnd (f a1 a2)
beFunction3 f m1 m2 m3
beApFunction3 f m1 m2 m3
:== m1 ==> \a1
-> m2 ==> \a2
-> m3 ==> \a3
-> appBackEnd (f a1 a2 a3)
beFunction4 f m1 m2 m3 m4
beApFunction4 f m1 m2 m3 m4
:== m1 ==> \a1
-> m2 ==> \a2
-> m3 ==> \a3
-> m4 ==> \a4
-> appBackEnd (f a1 a2 a3 a4)
beFunction5 f m1 m2 m3 m4 m5
beApFunction5 f m1 m2 m3 m4 m5
:== m1 ==> \a1
-> m2 ==> \a2
-> m3 ==> \a3
-> m4 ==> \a4
-> m5 ==> \a5
-> appBackEnd (f a1 a2 a3 a4 a5)
beFunction6 f m1 m2 m3 m4 m5 m6
beApFunction6 f m1 m2 m3 m4 m5 m6
:== m1 ==> \a1
-> m2 ==> \a2
-> m3 ==> \a3
......@@ -83,7 +104,7 @@ beFunction6 f m1 m2 m3 m4 m5 m6
-> m5 ==> \a5
-> m6 ==> \a6
-> appBackEnd (f a1 a2 a3 a4 a5 a6)
beFunction7 f m1 m2 m3 m4 m5 m6 m7
beApFunction7 f m1 m2 m3 m4 m5 m6 m7
:== m1 ==> \a1
-> m2 ==> \a2
-> m3 ==> \a3
......@@ -93,6 +114,51 @@ beFunction7 f m1 m2 m3 m4 m5 m6 m7
-> m7 ==> \a7
-> appBackEnd (f a1 a2 a3 a4 a5 a6 a7)
beFunction0 f
:== accBackEnd f
beFunction1 f m1
:== m1 ==> \a1
-> accBackEnd (f a1)
beFunction2 f m1 m2
:== m1 ==> \a1
-> m2 ==> \a2
-> accBackEnd (f a1 a2)
beFunction3 f m1 m2 m3
:== m1 ==> \a1
-> m2 ==> \a2
-> m3 ==> \a3
-> accBackEnd (f a1 a2 a3)
beFunction4 f m1 m2 m3 m4
:== m1 ==> \a1
-> m2 ==> \a2
-> m3 ==> \a3
-> m4 ==> \a4
-> accBackEnd (f a1 a2 a3 a4)
beFunction5 f m1 m2 m3 m4 m5
:== m1 ==> \a1
-> m2 ==> \a2
-> m3 ==> \a3
-> m4 ==> \a4
-> m5 ==> \a5
-> accBackEnd (f a1 a2 a3 a4 a5)
beFunction6 f m1 m2 m3 m4 m5 m6
:== m1 ==> \a1
-> m2 ==> \a2
-> m3 ==> \a3
-> m4 ==> \a4
-> m5 ==> \a5
-> m6 ==> \a6
-> accBackEnd (f a1 a2 a3 a4 a5 a6)
beFunction7 f m1 m2 m3 m4 m5 m6 m7
:== m1 ==> \a1
-> m2 ==> \a2
-> m3 ==> \a3
-> m4 ==> \a4
-> m5 ==> \a5
-> m6 ==> \a6
-> m7 ==> \a7
-> accBackEnd (f a1 a2 a3 a4 a5 a6 a7)
changeArrayFunctionIndex selectIndex
:== selectIndex
......@@ -189,9 +255,9 @@ beAnnotateTypeNode annotation
beAttributeTypeNode attribution
:== beFunction1 (BEAttributeTypeNode attribution)
beDeclareRuleType functionIndex moduleIndex name
:== beFunction0 (BEDeclareRuleType functionIndex moduleIndex name)
:== beApFunction0 (BEDeclareRuleType functionIndex moduleIndex name)
beDefineRuleType functionIndex moduleIndex
:== beFunction1 (BEDefineRuleType functionIndex moduleIndex)
:== beApFunction1 (BEDefineRuleType functionIndex moduleIndex)
beCodeAlt lineNumber
:== beFunction3 (BECodeAlt lineNumber)
beString string
......@@ -211,9 +277,9 @@ beAbcCodeBlock inline
beAnyCodeBlock
:== beFunction3 BEAnyCodeBlock
beDeclareNodeId number lhsOrRhs name
:== beFunction0 (BEDeclareNodeId number lhsOrRhs name)
beAdjustArrayFunction backEndId functionIndex moduleIndex
:== beFunction0 (BEAdjustArrayFunction backEndId functionIndex moduleIndex)
:== beApFunction0 (BEDeclareNodeId number lhsOrRhs name)
beAdjustArrayFunction backendId functionIndex moduleIndex
:== beApFunction0 (BEAdjustArrayFunction backendId functionIndex moduleIndex)
beFlatType
:== beFunction2 BEFlatType
beNoTypeVars
......@@ -223,29 +289,38 @@ beTypeVars
beTypeVar name
:== beFunction0 (BETypeVar name)
beExportType dclTypeIndex iclTypeIndex
:== beFunction0 (BEExportType dclTypeIndex iclTypeIndex)
:== beApFunction0 (BEExportType dclTypeIndex iclTypeIndex)
beExportConstructor dclConstructorIndex iclConstructorIndex
:== beFunction0 (BEExportConstructor dclConstructorIndex iclConstructorIndex)
:== beApFunction0 (BEExportConstructor dclConstructorIndex iclConstructorIndex)
beExportField dclFieldIndex iclFieldIndex
:== beFunction0 (BEExportField dclFieldIndex iclFieldIndex)
:== beApFunction0 (BEExportField dclFieldIndex iclFieldIndex)
beExportFunction dclIndexFunctionIndex iclFunctionIndex
:== beFunction0 (BEExportFunction dclIndexFunctionIndex iclFunctionIndex)
:== beApFunction0 (BEExportFunction dclIndexFunctionIndex iclFunctionIndex)
beTupleSelectNode arity index
:== beFunction1 (BETupleSelectNode arity index)
beMatchNode arity
:== beFunction2 (BEMatchNode arity)
beDefineImportedObjsAndLibs
:== beFunction2 BEDefineImportedObjsAndLibs
:== beApFunction2 BEDefineImportedObjsAndLibs
beAbsType
:== beFunction1 BEAbsType
:== beApFunction1 BEAbsType
notYetImplementedExpr :: Expression
notYetImplementedExpr
= (BasicExpr (BVS "\"error in compiler (something was not implemented by lazy Ronny)\"") BT_Int)
backEndConvertModules :: PredefinedSymbols FrontEndSyntaxTree VarHeap *BackEnd -> *BackEnd
backEndConvertModules predefs {fe_icl = fe_icl =: {icl_name, icl_functions, icl_common, icl_imported_objects}, fe_components, fe_dcls, fe_arrayInstances, fe_dclIclConversions, fe_iclDclConversions, fe_globalFunctions} varHeap backEnd
// sanity check ...
backEndConvertModules :: PredefinedSymbols FrontEndSyntaxTree !Int *VarHeap *BackEnd -> (!*VarHeap,!*BackEnd)
/*
backEndConvertModules p s main_dcl_module_n v be
= (newHeap,backEndConvertModulesH p s v be)
*/
backEndConvertModules p s main_dcl_module_n var_heap be
# {bes_varHeap,bes_backEnd} = backEndConvertModulesH p s main_dcl_module_n newHeap {bes_varHeap=var_heap,bes_backEnd=be}
= (bes_varHeap,bes_backEnd)
backEndConvertModulesH :: PredefinedSymbols FrontEndSyntaxTree !Int VarHeap *BackEndState -> *BackEndState
backEndConvertModulesH predefs {fe_icl = fe_icl =: {icl_name, icl_functions, icl_common, icl_imported_objects,icl_used_module_numbers}, fe_components, fe_dcls, fe_arrayInstances, fe_dclIclConversions, fe_iclDclConversions,fe_globalFunctions} main_dcl_module_n varHeap backEnd
// sanity check ...
// | cIclModIndex <> kIclModuleIndex || cPredefinedModuleIndex <> kPredefinedModuleIndex
// = undef <<- "backendconvert, backEndConvertModules: module index mismatch"
// ... sanity check
......@@ -258,13 +333,14 @@ backEndConvertModules predefs {fe_icl = fe_icl =: {icl_name, icl_functions, icl_
# backEnd
= abort "front end abort" backEnd
*/
# backEnd
= BEDeclareModules (size fe_dcls) backEnd
# backEnd
#! backEnd = appBackEnd (BESetMainDclModuleN main_dcl_module_n) backEnd
#! backEnd
= appBackEnd (BEDeclareModules (size fe_dcls)) backEnd
#! backEnd
= predefineSymbols fe_dcls.[cPredefinedModuleIndex] predefs backEnd
# currentDcl
= fe_dcls.[cIclModIndex]
= fe_dcls.[main_dcl_module_n]
typeConversions
= currentModuleTypeConversions icl_common.com_class_defs currentDcl.dcl_common.com_class_defs currentDcl.dcl_conversions
/*
......@@ -290,20 +366,20 @@ backEndConvertModules predefs {fe_icl = fe_icl =: {icl_name, icl_functions, icl_
, (rstypes, types)
)
*/
# backEnd
= declareCurrentDclModule fe_icl fe_dcls.[cIclModIndex] (backEnd -*-> "declareCurrentDclModule")
# backEnd
= declareOtherDclModules fe_dcls (backEnd -*-> "declareOtherDclModules")
# backEnd
= defineDclModule varHeap cIclModIndex fe_dcls.[cIclModIndex] (backEnd -*-> "defineDclModule(cIclMoIndex)")
# backEnd
#! backEnd
= declareCurrentDclModule fe_icl fe_dcls.[main_dcl_module_n] main_dcl_module_n (backEnd -*-> "declareCurrentDclModule")
#! backEnd
= declareOtherDclModules fe_dcls main_dcl_module_n icl_used_module_numbers (backEnd -*-> "declareOtherDclModules")
#! backEnd
= defineDclModule varHeap 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 varHeap (backEnd -*-> "defineOtherDclModules")
#! backEnd
= defineOtherDclModules fe_dcls main_dcl_module_n icl_used_module_numbers varHeap (backEnd -*-> "defineOtherDclModules")
# backEnd
= BEDeclareIclModule icl_name.id_name (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
= appBackEnd (BEDeclareIclModule icl_name.id_name (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}
......@@ -311,82 +387,101 @@ backEndConvertModules predefs {fe_icl = fe_icl =: {icl_name, icl_functions, icl_
= {}
getConversions (Yes conversions)
= conversions
# backEnd
= declare cIclModIndex varHeap icl_common (backEnd -*-> "declare (cIclModIndex)")
# backEnd
= declareArrayInstances fe_arrayInstances icl_functions (backEnd -*-> "declareArrayInstances")
# backEnd
= adjustArrayFunctions predefs fe_arrayInstances icl_functions fe_dcls varHeap (backEnd -*-> "adjustArrayFunctions")
#! backEnd
= declare main_dcl_module_n varHeap icl_common (backEnd -*-> "declare (main_dcl_module_n)")
#! backEnd
= declareArrayInstances fe_arrayInstances main_dcl_module_n icl_functions (backEnd -*-> "declareArrayInstances")
#! backEnd
= adjustArrayFunctions predefs fe_arrayInstances main_dcl_module_n icl_functions fe_dcls icl_used_module_numbers varHeap (backEnd -*-> "adjustArrayFunctions")
#! (rules, backEnd)
= convertRules predefs.[PD_DummyForStrictAliasFun].pds_ident
[(index, icl_functions.[index]) \\ (_, index) <- functionIndices]
varHeap (backEnd -*-> "convertRules")
= convertRules [(index, icl_functions.[index]) \\ (_, index) <- functionIndices] main_dcl_module_n predefs.[PD_DummyForStrictAliasFun].pds_ident varHeap (backEnd -*-> "convertRules")
#! backEnd
= appBackEnd (BEDefineRules rules) (backEnd -*-> "BEDefineRules")
#! backEnd
= BEDefineRules rules (backEnd -*-> "BEDefineRules")
# backEnd
= beDefineImportedObjsAndLibs
(convertStrings [imported.io_name \\ imported <- icl_imported_objects | not imported.io_is_library])
(convertStrings [imported.io_name \\ imported <- icl_imported_objects | imported.io_is_library])
(backEnd -*-> "beDefineImportedObjsAndLibs")
# backEnd
= markExports fe_dcls.[cIclModIndex] dcl_common.com_class_defs dcl_common.com_type_defs icl_common.com_class_defs icl_common.com_type_defs fe_dclIclConversions (backEnd -*-> "markExports")
#! 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")
with
dcl_common
= currentDcl.dcl_common
= (backEnd -*-> "back end done")
#! backEnd = removeExpandedTypesFromDclModules fe_dcls icl_used_module_numbers backEnd
= (backEnd -*-> "backend done")
where
componentCount
= length functionIndices
functionIndices
= flatten [[(componentIndex, member) \\ member <- group.group_members] \\ group <-: fe_components & componentIndex <- [0..]]
declareOtherDclModules :: {#DclModule} -> BackEnder
declareOtherDclModules dcls
declareOtherDclModules :: {#DclModule} Int ModuleNumberSet -> BackEnder
declareOtherDclModules dcls main_dcl_module_n used_module_numbers
= foldStateWithIndexA declareOtherDclModule dcls
defineOtherDclModules :: {#DclModule} VarHeap -> BackEnder
defineOtherDclModules dcls varHeap
where
declareOtherDclModule :: ModuleIndex DclModule -> BackEnder
declareOtherDclModule moduleIndex dclModule
| moduleIndex == main_dcl_module_n || moduleIndex == cPredefinedModuleIndex || not (in_module_number_set moduleIndex used_module_numbers)
= identity
// otherwise
= declareDclModule moduleIndex dclModule
defineOtherDclModules :: {#DclModule} Int ModuleNumberSet VarHeap -> BackEnder
defineOtherDclModules dcls main_dcl_module_n used_module_numbers varHeap
= foldStateWithIndexA (defineOtherDclModule varHeap) dcls
declareCurrentDclModule :: IclModule DclModule -> BackEnder
declareCurrentDclModule {icl_common} {dcl_name, dcl_functions, dcl_is_system, dcl_common}
= BEDeclareDclModule cIclModIndex dcl_name.id_name dcl_is_system (size dcl_functions) (size icl_common.com_type_defs) (size dcl_common.com_cons_defs) (size dcl_common.com_selector_defs)
where
defineOtherDclModule :: VarHeap ModuleIndex DclModule -> BackEnder
defineOtherDclModule varHeap moduleIndex dclModule
| moduleIndex == main_dcl_module_n || moduleIndex == cPredefinedModuleIndex || not (in_module_number_set moduleIndex used_module_numbers)
= identity
// otherwise
= defineDclModule varHeap moduleIndex dclModule
declareCurrentDclModule :: IclModule DclModule Int -> BackEnder
declareCurrentDclModule {icl_common} {dcl_name, dcl_functions, dcl_is_system, dcl_common} main_dcl_module_n
= appBackEnd (BEDeclareDclModule main_dcl_module_n dcl_name.id_name dcl_is_system (size dcl_functions) (size icl_common.com_type_defs) (size dcl_common.com_cons_defs) (size dcl_common.com_selector_defs))
declareOtherDclModule :: ModuleIndex DclModule -> BackEnder
declareOtherDclModule moduleIndex dclModule
| moduleIndex == cIclModIndex || moduleIndex == cPredefinedModuleIndex
= identity
// otherwise
= declareDclModule moduleIndex dclModule
declareDclModule :: ModuleIndex DclModule -> BackEnder
declareDclModule moduleIndex {dcl_name, dcl_common, dcl_functions, dcl_is_system}
= BEDeclareDclModule moduleIndex dcl_name.id_name dcl_is_system (size dcl_functions) (size dcl_common.com_type_defs) (size dcl_common.com_cons_defs) (size dcl_common.com_selector_defs)
= appBackEnd (BEDeclareDclModule moduleIndex dcl_name.id_name dcl_is_system (size dcl_functions) (size dcl_common.com_type_defs) (size dcl_common.com_cons_defs) (size dcl_common.com_selector_defs))
/*
defineCurrentDclModule :: VarHeap IclModule DclModule {#Int} -> BackEnder
defineCurrentDclModule varHeap {icl_common} {dcl_name, dcl_common, dcl_functions, dcl_is_system, dcl_conversions} typeConversions
= declareCurrentDclModuleTypes icl_common.com_type_defs typeConversions varHeap
o` defineCurrentDclModuleTypes dcl_common.com_cons_defs dcl_common.com_selector_defs dcl_common.com_type_defs typeConversions varHeap
defineOtherDclModule :: VarHeap ModuleIndex DclModule -> BackEnder
defineOtherDclModule varHeap moduleIndex dclModule
| moduleIndex == cIclModIndex || moduleIndex == cPredefinedModuleIndex
= identity
// otherwise
= defineDclModule varHeap moduleIndex dclModule
*/
defineDclModule :: VarHeap ModuleIndex DclModule -> BackEnder
defineDclModule varHeap moduleIndex {dcl_name, dcl_common, dcl_instances, dcl_functions, dcl_is_system}
defineDclModule varHeap moduleIndex {dcl_name, dcl_common, dcl_functions, dcl_is_system,dcl_instances}
= declare moduleIndex varHeap dcl_common
o` declareFunTypes moduleIndex dcl_functions dcl_instances.ir_from varHeap
o` declareFunTypes moduleIndex dcl_functions dcl_instances.ir_from varHeap
removeExpandedTypesFromDclModules :: {#DclModule} ModuleNumberSet -> BackEnder
removeExpandedTypesFromDclModules dcls used_module_numbers
= foldStateWithIndexA removeExpandedTypesFromDclModule dcls
where
removeExpandedTypesFromDclModule :: ModuleIndex DclModule -> BackEnder
removeExpandedTypesFromDclModule moduleIndex dclModule=:{dcl_functions}
| moduleIndex == cPredefinedModuleIndex || not (in_module_number_set moduleIndex used_module_numbers)
= identity
= foldStateWithIndexA (removeExpandedTypesFromFunType moduleIndex) dcl_functions
where
removeExpandedTypesFromFunType :: ModuleIndex Index FunType -> BackEnder
removeExpandedTypesFromFunType moduleIndex functionIndex {ft_symb, ft_type_ptr}
= \be0 -> let (ft_type,be) = read_from_var_heap ft_type_ptr 0 be0 in
(case ft_type of
VI_ExpandedType expandedType
-> write_to_var_heap ft_type_ptr VI_Empty
_
-> identity) be
// move types from their dcl to icl positions
class swapTypes a :: Int Int *a -> *a
instance swapTypes BackEnd where
instance swapTypes BackEndState where
//instance swapTypes BackEnd where
swapTypes i j be
= BESwapTypes i j be
= appBackEnd (BESwapTypes i j) be
instance swapTypes {{#Char}} where
swapTypes i j a
......@@ -422,7 +517,6 @@ reshuffleTypes nIclTypes dclIclConversions be
#! to` = if (to` >= nDclTypes) frm` to`
= (swap frm` to` p, swap frm to p`, swapTypes frm to be)
:: DeclVarsInput :== (!Ident, !VarHeap)
class declareVars a :: a !DeclVarsInput -> BackEnder
......@@ -450,9 +544,10 @@ instance declareVars (Bind Expression FreeVar) where
declareVars {bind_dst=freeVar} (_, varHeap)
= declareVariable BERhsNodeId freeVar.fv_info_ptr freeVar.fv_name.id_name varHeap
declareVariable :: Int (Ptr VarInfo) {#Char} !VarHeap -> BackEnder
declareVariable :: Int (Ptr VarInfo) {#Char} VarHeap -> BackEnder
declareVariable lhsOrRhs varInfoPtr name varHeap
= beDeclareNodeId (getVariableSequenceNumber varInfoPtr varHeap) lhsOrRhs name
= \be0 -> let (variable_sequence_number,be) = getVariableSequenceNumber varInfoPtr varHeap be0 in
beDeclareNodeId variable_sequence_number lhsOrRhs name be
instance declareVars (Optional a) | declareVars a where
declareVars :: (Optional a) !DeclVarsInput -> BackEnder | declareVars a
......@@ -502,10 +597,10 @@ instance declareVars BackendBody where
= declareVars bb_args dvInput
o` declareVars bb_rhs dvInput
:: ModuleIndex :== Index
class declare a :: ModuleIndex !VarHeap a -> BackEnder
class declareWithIndex a :: Index ModuleIndex !VarHeap a -> BackEnder
//1.3
......@@ -519,15 +614,13 @@ instance declare {#a} | declareWithIndex a & Array {#} a where
declare moduleIndex varHeap array
= foldStateWithIndexA (\i -> declareWithIndex i moduleIndex varHeap) array
declareFunctionSymbols :: {#FunDef} {#Int} [(Int, Int)] IndexRange *BackEnd -> *BackEnd
declareFunctionSymbols :: {#FunDef} {#Int} [(Int, Int)] IndexRange *BackEndState -> *BackEndState
declareFunctionSymbols functions iclDclConversions functionIndices globalFunctions backEnd
= foldr` (declare iclDclConversions) backEnd [(functionIndex, componentIndex, functions.[functionIndex]) \\ (componentIndex, functionIndex) <- functionIndices]
= foldr (declare iclDclConversions) backEnd [(functionIndex, componentIndex, functions.[functionIndex]) \\ (componentIndex, functionIndex) <- functionIndices]
where
declare :: {#Int} (Int, Int, FunDef) *BackEnd -> *BackEnd
declare iclDclConversions (functionIndex, componentIndex, function) backEnd
= BEDeclareFunction
(functionName function.fun_symb.id_name functionIndex iclDclConversions globalFunctions)
function.fun_arity functionIndex componentIndex backEnd
= appBackEnd (BEDeclareFunction (functionName function.fun_symb.id_name functionIndex iclDclConversions globalFunctions)
function.fun_arity functionIndex componentIndex) backEnd
where
functionName :: {#Char} Int {#Int} IndexRange -> {#Char}
functionName name functionIndex iclDclConversions {ir_from, ir_to}
......@@ -547,14 +640,14 @@ foldStateWithIndexRangeA function frm to array
= function index array.[index]
o` foldStateWithIndexRangeA (index+1)
declareArrayInstances :: IndexRange {#FunDef} -> BackEnder
declareArrayInstances {ir_from, ir_to} functions
declareArrayInstances :: IndexRange Int {#FunDef} -> BackEnder
declareArrayInstances {ir_from, ir_to} main_dcl_module_n functions
= foldStateWithIndexRangeA declareArrayInstance ir_from ir_to functions
where
declareArrayInstance :: Index FunDef -> BackEnder
declareArrayInstance index {fun_symb={id_name}, fun_type=Yes type}
= beDeclareRuleType index cIclModIndex (id_name +++ ";" +++ toString index)
o` beDefineRuleType index cIclModIndex (convertTypeAlt index cIclModIndex type)
= beDeclareRuleType index main_dcl_module_n (id_name +++ ";" +++ toString index)
o` beDefineRuleType index main_dcl_module_n (convertTypeAlt index main_dcl_module_n type)
instance declare CommonDefs where
declare :: ModuleIndex VarHeap CommonDefs -> BackEnder
......@@ -565,7 +658,7 @@ instance declare CommonDefs where
instance declareWithIndex (TypeDef a) where
declareWithIndex :: Index ModuleIndex VarHeap (TypeDef a) -> BackEnder
declareWithIndex typeIndex moduleIndex _ {td_name}
= BEDeclareType typeIndex moduleIndex td_name.id_name
= appBackEnd (BEDeclareType typeIndex moduleIndex td_name.id_name)
declareFunTypes :: ModuleIndex {#FunType} Int VarHeap -> BackEnder
declareFunTypes moduleIndex funTypes nrOfDclFunctions varHeap
......@@ -573,12 +666,13 @@ declareFunTypes moduleIndex funTypes nrOfDclFunctions varHeap
declareFunType :: ModuleIndex VarHeap Index Int FunType -> BackEnder
declareFunType moduleIndex varHeap nrOfDclFunctions functionIndex {ft_symb, ft_type_ptr}
= case (sreadPtr ft_type_ptr varHeap) of
VI_ExpandedType expandedType
-> beDeclareRuleType functionIndex moduleIndex (functionName ft_symb.id_name functionIndex nrOfDclFunctions)
o` beDefineRuleType functionIndex moduleIndex (convertTypeAlt functionIndex moduleIndex expandedType)
_
-> identity
= \be0 -> let (vi,be) = read_from_var_heap ft_type_ptr varHeap be0 in
(case vi of
VI_ExpandedType expandedType
-> beDeclareRuleType functionIndex moduleIndex (functionName ft_symb.id_name functionIndex nrOfDclFunctions)
o` beDefineRuleType functionIndex moduleIndex (convertTypeAlt functionIndex moduleIndex expandedType)
_
-> identity) be
where
functionName :: {#Char} Int Int -> {#Char}
functionName name functionIndex nrOfDclFunctions
......@@ -630,22 +724,9 @@ currentModuleTypeConversions iclClasses dclClasses (Yes conversionTable)
currentModuleTypeConversions _ _ No
= {}
/*
declareCurrentDclModuleTypes :: {#CheckedTypeDef} {#Int} VarHeap -> BackEnder
declareCurrentDclModuleTypes dclTypes typeConversions varHeap
= foldStateWithIndexA (declareConvertedType dclTypes varHeap) typeConversions
where
declareConvertedType :: {#CheckedTypeDef} VarHeap Index Index -> BackEnder
declareConvertedType dclTypes varHeap dclIndex iclIndex
= declareWithIndex iclIndex cIclModIndex varHeap dclTypes.[dclIndex]
defineCurrentDclModuleTypes :: {#ConsDef} {#SelectorDef} {#CheckedTypeDef} {#Int} VarHeap -> BackEnder
defineCurrentDclModuleTypes dclConstructors dclSelectors dclTypes typeConversions varHeap
= foldStateWithIndexA (defineConvertedType dclTypes varHeap) typeConversions
where
defineConvertedType :: {#CheckedTypeDef</