Skip to content

GitLab

Commit bf77a4f7 authored by Ronny Wichers Schreur's avatar Ronny Wichers Schreur 🏘
Browse files

uniqueness attributes in backend

parent 7c55c5cf
Hide whitespace changes
Inline Side-by-side
backend/Clean System Files/backend_library
View file @ bf77a4f7
......@@ -23,6 +23,12 @@ BENoTypeVars
BENormalTypeNode
BEAnnotateTypeNode
BEAttributeTypeNode
BEAttributeKind
BENoAttributeKinds
BEAttributeKinds
BEUniVarEquation
BENoUniVarEquations
BEUniVarEquationsList
BENoTypeArgs
BETypeArgs
BETypeAlt
......
backend/backend.dcl
View file @ bf77a4f7
......@@ -29,6 +29,8 @@ from StdString import String;
:: BEStringListP;
:: BENodeIdListP;
:: BENodeIdRefCountListP;
:: BEUniVarEquations;
:: BEAttributeKindList;
:: BEAnnotation :== Int;
:: BEAttribution :== Int;
:: BESymbKind :== Int;
......@@ -83,12 +85,24 @@ BEAnnotateTypeNode :: !BEAnnotation !BETypeNodeP !BackEnd -> (!BETypeNodeP,!Back
// BETypeNodeP BEAnnotateTypeNode (BEAnnotation annotation,BETypeNodeP typeNode);
BEAttributeTypeNode :: !BEAttribution !BETypeNodeP !BackEnd -> (!BETypeNodeP,!BackEnd);
// BETypeNodeP BEAttributeTypeNode (BEAttribution attribution,BETypeNodeP typeNode);
BEAttributeKind :: !BEAttribution !BackEnd -> (!BEAttributeKindList,!BackEnd);
// BEAttributeKindList BEAttributeKind (BEAttribution attributeKind);
BENoAttributeKinds :: !BackEnd -> (!BEAttributeKindList,!BackEnd);
// BEAttributeKindList BENoAttributeKinds ();
BEAttributeKinds :: !BEAttributeKindList !BEAttributeKindList !BackEnd -> (!BEAttributeKindList,!BackEnd);
// BEAttributeKindList BEAttributeKinds (BEAttributeKindList elem,BEAttributeKindList list);
BEUniVarEquation :: !BEAttribution !BEAttributeKindList !BackEnd -> (!BEUniVarEquations,!BackEnd);
// BEUniVarEquations BEUniVarEquation (BEAttribution demanded,BEAttributeKindList offered);
BENoUniVarEquations :: !BackEnd -> (!BEUniVarEquations,!BackEnd);
// BEUniVarEquations BENoUniVarEquations ();
BEUniVarEquationsList :: !BEUniVarEquations !BEUniVarEquations !BackEnd -> (!BEUniVarEquations,!BackEnd);
// BEUniVarEquations BEUniVarEquationsList (BEUniVarEquations elem,BEUniVarEquations list);
BENoTypeArgs :: !BackEnd -> (!BETypeArgP,!BackEnd);
// BETypeArgP BENoTypeArgs ();
BETypeArgs :: !BETypeNodeP !BETypeArgP !BackEnd -> (!BETypeArgP,!BackEnd);
// BETypeArgP BETypeArgs (BETypeNodeP node,BETypeArgP nextArgs);
BETypeAlt :: !BETypeNodeP !BETypeNodeP !BackEnd -> (!BETypeAltP,!BackEnd);
// BETypeAltP BETypeAlt (BETypeNodeP lhs,BETypeNodeP rhs);
BETypeAlt :: !BETypeNodeP !BETypeNodeP !BEUniVarEquations !BackEnd -> (!BETypeAltP,!BackEnd);
// BETypeAltP BETypeAlt (BETypeNodeP lhs,BETypeNodeP rhs,BEUniVarEquations attributeEquations);
BENormalNode :: !BESymbolP !BEArgP !BackEnd -> (!BENodeP,!BackEnd);
// BENodeP BENormalNode (BESymbolP symbol,BEArgP args);
BEMatchNode :: !Int !BESymbolP !BENodeP !BackEnd -> (!BENodeP,!BackEnd);
......@@ -247,9 +261,9 @@ BEDeclareDynamicTypeSymbol :: !Int !Int !BackEnd -> BackEnd;
// void BEDeclareDynamicTypeSymbol (int typeIndex,int moduleIndex);
BEDynamicTempTypeSymbol :: !BackEnd -> (!BESymbolP,!BackEnd);
// BESymbolP BEDynamicTempTypeSymbol ();
kBEVersionCurrent:==0x02000209;
kBEVersionOldestDefinition:==0x02000204;
kBEVersionOldestImplementation:==0x02000209;
kBEVersionCurrent:==0x02000210;
kBEVersionOldestDefinition:==0x02000210;
kBEVersionOldestImplementation:==0x02000210;
kBEDebug:==1;
kPredefinedModuleIndex:==1;
BENoAnnot:==0;
......
backend/backend.icl
View file @ bf77a4f7
......@@ -29,6 +29,8 @@ from StdString import String;
:: BEStringListP :== CPtr;
:: BENodeIdListP :== CPtr;
:: BENodeIdRefCountListP :== CPtr;
:: BEUniVarEquations :== CPtr;
:: BEAttributeKindList :== CPtr;
:: BEAnnotation :== Int;
:: BEAttribution :== Int;
:: BESymbKind :== Int;
......@@ -180,6 +182,42 @@ BEAttributeTypeNode a0 a1 a2 = code {
};
// BETypeNodeP BEAttributeTypeNode (BEAttribution attribution,BETypeNodeP typeNode);
BEAttributeKind :: !BEAttribution !BackEnd -> (!BEAttributeKindList,!BackEnd);
BEAttributeKind a0 a1 = code {
ccall BEAttributeKind "I:I:I"
};
// BEAttributeKindList BEAttributeKind (BEAttribution attributeKind);
BENoAttributeKinds :: !BackEnd -> (!BEAttributeKindList,!BackEnd);
BENoAttributeKinds a0 = code {
ccall BENoAttributeKinds ":I:I"
};
// BEAttributeKindList BENoAttributeKinds ();
BEAttributeKinds :: !BEAttributeKindList !BEAttributeKindList !BackEnd -> (!BEAttributeKindList,!BackEnd);
BEAttributeKinds a0 a1 a2 = code {
ccall BEAttributeKinds "II:I:I"
};
// BEAttributeKindList BEAttributeKinds (BEAttributeKindList elem,BEAttributeKindList list);
BEUniVarEquation :: !BEAttribution !BEAttributeKindList !BackEnd -> (!BEUniVarEquations,!BackEnd);
BEUniVarEquation a0 a1 a2 = code {
ccall BEUniVarEquation "II:I:I"
};
// BEUniVarEquations BEUniVarEquation (BEAttribution demanded,BEAttributeKindList offered);
BENoUniVarEquations :: !BackEnd -> (!BEUniVarEquations,!BackEnd);
BENoUniVarEquations a0 = code {
ccall BENoUniVarEquations ":I:I"
};
// BEUniVarEquations BENoUniVarEquations ();
BEUniVarEquationsList :: !BEUniVarEquations !BEUniVarEquations !BackEnd -> (!BEUniVarEquations,!BackEnd);
BEUniVarEquationsList a0 a1 a2 = code {
ccall BEUniVarEquationsList "II:I:I"
};
// BEUniVarEquations BEUniVarEquationsList (BEUniVarEquations elem,BEUniVarEquations list);
BENoTypeArgs :: !BackEnd -> (!BETypeArgP,!BackEnd);
BENoTypeArgs a0 = code {
ccall BENoTypeArgs ":I:I"
......@@ -192,11 +230,11 @@ BETypeArgs a0 a1 a2 = code {
};
// BETypeArgP BETypeArgs (BETypeNodeP node,BETypeArgP nextArgs);
BETypeAlt :: !BETypeNodeP !BETypeNodeP !BackEnd -> (!BETypeAltP,!BackEnd);
BETypeAlt a0 a1 a2 = code {
ccall BETypeAlt "II:I:I"
BETypeAlt :: !BETypeNodeP !BETypeNodeP !BEUniVarEquations !BackEnd -> (!BETypeAltP,!BackEnd);
BETypeAlt a0 a1 a2 a3 = code {
ccall BETypeAlt "III:I:I"
};
// BETypeAltP BETypeAlt (BETypeNodeP lhs,BETypeNodeP rhs);
// BETypeAltP BETypeAlt (BETypeNodeP lhs,BETypeNodeP rhs,BEUniVarEquations attributeEquations);
BENormalNode :: !BESymbolP !BEArgP !BackEnd -> (!BENodeP,!BackEnd);
BENormalNode a0 a1 a2 = code {
......@@ -671,9 +709,9 @@ BEDynamicTempTypeSymbol a0 = code {
ccall BEDynamicTempTypeSymbol ":I:I"
};
// BESymbolP BEDynamicTempTypeSymbol ();
kBEVersionCurrent:==0x02000209;
kBEVersionOldestDefinition:==0x02000204;
kBEVersionOldestImplementation:==0x02000209;
kBEVersionCurrent:==0x02000210;
kBEVersionOldestDefinition:==0x02000210;
kBEVersionOldestImplementation:==0x02000210;
kBEDebug:==1;
kPredefinedModuleIndex:==1;
BENoAnnot:==0;
......
backend/backendconvert.dcl
View file @ bf77a4f7
......@@ -3,4 +3,4 @@ definition module backendconvert
from backend import BackEnd
import frontend
backEndConvertModules :: PredefinedSymbols FrontEndSyntaxTree !Int *VarHeap *BackEnd -> (!*VarHeap,!*BackEnd)
backEndConvertModules :: PredefinedSymbols FrontEndSyntaxTree !Int *VarHeap *AttrVarHeap *BackEnd -> (!*VarHeap, *AttrVarHeap, !*BackEnd)
backend/backendconvert.icl
View file @ bf77a4f7
......@@ -37,7 +37,7 @@ BackEndBody x :== BackendBody x
:: BackEnder :== *BackEndState -> *BackEndState
//
:: *BackEndState = {bes_backEnd :: !BackEnd, bes_varHeap :: !*VarHeap}
:: *BackEndState = {bes_backEnd :: !BackEnd, bes_varHeap :: !*VarHeap, bes_attrHeap :: !*AttrVarHeap, bes_attr_number :: !Int}
appBackEnd f beState
:== {beState & bes_backEnd = bes_backEnd}
......@@ -57,6 +57,13 @@ accVarHeap f beState
where
(result, varHeap) = f beState.bes_varHeap
accAttrHeap f beState
:== (result, {beState & bes_attrHeap = attrHeap})
where
(result, attrHeap) = f beState.bes_attrHeap
read_from_var_heap :: VarInfoPtr BackEndState -> (VarInfo, BackEndState)
read_from_var_heap ptr beState
= (result, {beState & bes_varHeap = varHeap})
where
......@@ -64,6 +71,14 @@ where
write_to_var_heap ptr v beState
= {beState & bes_varHeap = writePtr ptr v beState.bes_varHeap}
read_from_attr_heap ptr beState
= (result, {beState & bes_attrHeap = attrHeap})
where
(result, attrHeap) = readPtr ptr beState.bes_attrHeap
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)
......@@ -219,7 +234,7 @@ beNoRuleAlts
beRuleAlts
:== beFunction2 BERuleAlts
beTypeAlt
:== beFunction2 BETypeAlt
:== beFunction3 BETypeAlt
beRule index isCaf
:== beFunction2 (BERule index isCaf)
beNoRules
......@@ -258,8 +273,8 @@ beField fieldIndex moduleIndex
:== beFunction1 (BEField fieldIndex moduleIndex)
beAnnotateTypeNode annotation
:== beFunction1 (BEAnnotateTypeNode annotation)
beAttributeTypeNode attribution
:== beFunction1 (BEAttributeTypeNode attribution)
beAttributeTypeNode
:== beFunction2 BEAttributeTypeNode
beDeclareRuleType functionIndex moduleIndex name
:== beApFunction0 (BEDeclareRuleType functionIndex moduleIndex name)
beDefineRuleType functionIndex moduleIndex
......@@ -324,6 +339,19 @@ beNodeIds
:== beFunction2 BENodeIds
beNodeIdListElem
:== beFunction1 BENodeIdListElem
beAttributeKind
:== beFunction1 BEAttributeKind
beNoAttributeKinds
:== beFunction0 BENoAttributeKinds
beAttributeKinds
:== beFunction2 BEAttributeKinds
beUniVarEquation
:== beFunction2 BEUniVarEquation
beNoUniVarEquations
:== beFunction0 BENoUniVarEquations
beUniVarEquationsList
:== beFunction2 BEUniVarEquationsList
// temporary hack
beDynamicTempTypeSymbol
:== beFunction0 BEDynamicTempTypeSymbol
......@@ -332,17 +360,20 @@ notYetImplementedExpr :: Expression
notYetImplementedExpr
= (BasicExpr (BVS "\"error in compiler (something was not implemented by lazy Ronny)\"") BT_Int)
backEndConvertModules :: PredefinedSymbols FrontEndSyntaxTree !Int *VarHeap *BackEnd -> (!*VarHeap,!*BackEnd)
backEndConvertModules :: PredefinedSymbols FrontEndSyntaxTree !Int *VarHeap *AttrVarHeap *BackEnd -> (!*VarHeap, *AttrVarHeap, !*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 {bes_varHeap=var_heap,bes_backEnd=be}
= (bes_varHeap,bes_backEnd)
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 :: PredefinedSymbols FrontEndSyntaxTree !Int *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 backEnd
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 backEnd
// sanity check ...
// | cIclModIndex <> kIclModuleIndex || cPredefinedModuleIndex <> kPredefinedModuleIndex
// = undef <<- "backendconvert, backEndConvertModules: module index mismatch"
......@@ -437,8 +468,6 @@ backEndConvertModulesH predefs {fe_icl = fe_icl =: {icl_name, icl_functions, icl
#! 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..]]
......@@ -484,8 +513,8 @@ declareDclModule moduleIndex {dcl_name, dcl_common, dcl_functions, dcl_module_ki
/*
defineCurrentDclModule :: IclModule DclModule {#Int} -> BackEnder
defineCurrentDclModule {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
= declareCurrentDclModuleTypes icl_common.com_type_defs typeConversions
o` defineCurrentDclModuleTypes dcl_common.com_cons_defs dcl_common.com_selector_defs dcl_common.com_type_defs typeConversions
*/
defineDclModule :: ModuleIndex DclModule -> BackEnder
defineDclModule moduleIndex {dcl_name, dcl_common, dcl_functions,dcl_instances}
......@@ -564,7 +593,7 @@ instance declareVars [a] | declareVars a where
= foldState (flip declareVars dvInput) list
instance declareVars (Ptr VarInfo) where
declareVars varInfoPtr _
declareVars varInfoPtr _
= declareVariable BELhsNodeId varInfoPtr "_var???" // +++ name
instance declareVars FreeVar where
......@@ -704,7 +733,7 @@ foldStateWithIndexRangeA function frm to array
declareArrayInstances :: IndexRange Int {#FunDef} -> BackEnder
declareArrayInstances {ir_from, ir_to} main_dcl_module_n functions
// | trace_tn ("declareArrayInstances "+++toString ir_from+++" "+++toString ir_to)
= foldStateWithIndexRangeA declareArrayInstance ir_from ir_to functions
= foldStateWithIndexRangeA (declareArrayInstance) ir_from ir_to functions
where
declareArrayInstance :: Index FunDef -> BackEnder
declareArrayInstance index {fun_symb={id_name}, fun_type=Yes type}
......@@ -1073,11 +1102,61 @@ convertRule aliasDummyId (index, {fun_type=Yes type, fun_body=body, fun_pos, fun
positionToLineNumber _
= -1
beautifyAttributes :: SymbolType -> BEMonad SymbolType
beautifyAttributes st
= return st
// = accAttrHeap (beautifulizeAttributes st)
convertTypeAlt :: Int ModuleIndex SymbolType -> BEMonad BETypeAltP
convertTypeAlt functionIndex moduleIndex symbol=:{st_result}
= beTypeAlt
(beNormalTypeNode (beFunctionSymbol functionIndex moduleIndex) (convertSymbolTypeArgs symbol))
convertTypeAlt functionIndex moduleIndex symbolType
= beautifyAttributes (symbolType) ==> \symbolType=:{st_result, st_attr_env, st_attr_vars}
-> resetAttrNumbers
o` (beTypeAlt
(beNormalTypeNode (beFunctionSymbol functionIndex moduleIndex) (convertSymbolTypeArgs symbolType))
(convertAnnotTypeNode st_result)
(convertAttributeInequalities (group st_attr_env)))
where
group :: [AttrInequality] -> [InequalityGroup]
group []
= []
group [{ai_demanded, ai_offered} : t]
= grouped ai_demanded [ai_offered] t
// copied grouped from typesupport.icl, apparently inequalities are already sorted by
// offered attributes
// grouped takes care that inequalities like [a<=c, b<=c] are printed like [a b <= c]
grouped :: AttributeVar [AttributeVar] [AttrInequality] -> [InequalityGroup]
grouped group_var accu []
= [{ ig_offered = accu, ig_demanded = group_var}]
grouped group_var accu [{ai_offered, ai_demanded}:ineqs]
| group_var==ai_demanded
= grouped group_var [ai_offered:accu] ineqs
=[{ ig_offered = accu, ig_demanded = group_var}: grouped ai_demanded [ai_offered] ineqs]
:: InequalityGroup =
{ ig_offered :: ![AttributeVar]
, ig_demanded:: !AttributeVar
}
resetAttrNumbers :: *BackEndState -> *BackEndState
resetAttrNumbers state
= {state & bes_attr_number = 0}
convertAttributeInequalities :: [InequalityGroup] -> BEMonad BEUniVarEquations
convertAttributeInequalities inequalities
= sfoldr (beUniVarEquationsList o convertAttributeInequality) beNoUniVarEquations inequalities
convertAttributeInequality :: InequalityGroup -> BEMonad BEUniVarEquations
convertAttributeInequality {ig_demanded, ig_offered}
= beUniVarEquation (convertAttributeVar ig_demanded) (convertAttributeKinds ig_offered)
convertAttributeKinds :: [AttributeVar] -> BEMonad BEAttributeKindList
convertAttributeKinds vars
= sfoldr (beAttributeKinds o convertAttributeKind) beNoAttributeKinds vars
convertAttributeKind :: AttributeVar -> BEMonad BEAttributeKindList
convertAttributeKind attributeVar
= beAttributeKind (convertAttributeVar attributeVar)
convertSymbolTypeArgs :: SymbolType -> BEMonad BETypeArgP
convertSymbolTypeArgs {st_args}
......@@ -1108,11 +1187,40 @@ convertAnnotation AN_None
convertAnnotation AN_Strict
= BEStrictAnnot
convertAttribution :: TypeAttribute -> BEAttribution
nextAttributeNumber :: *BackEndState -> (BEAttribution, *BackEndState)
nextAttributeNumber state=:{bes_attr_number}
= (bes_attr_number + BEFirstUniVarNumber, {state & bes_attr_number = bes_attr_number+1})
convertAttributeVar :: AttributeVar *BackEndState -> (BEAttribution, *BackEndState)
convertAttributeVar {av_info_ptr, av_name} state=:{bes_attr_number}
# (attrInfo, state)
= read_from_attr_heap av_info_ptr state
= case attrInfo of
AVI_SequenceNumber number
-> (number, state)
_
# (attrNumber, state)
= nextAttributeNumber state
-> (attrNumber, write_to_attr_heap av_info_ptr (AVI_SequenceNumber attrNumber) state)
convertAttribution :: TypeAttribute -> BEMonad BEAttribution
convertAttribution TA_Unique
= BEUniqueAttr
convertAttribution _ // +++ uni vars, etc.
= BENoUniAttr
= return BEUniqueAttr
convertAttribution TA_None
= return BENoUniAttr
convertAttribution TA_Multi
= return BENoUniAttr
convertAttribution TA_Anonymous
= nextAttributeNumber
convertAttribution (TA_Var attrVar)
= convertAttributeVar attrVar
convertAttribution (TA_RootVar attrVar)
= convertAttributeVar attrVar
convertAttribution TA_MultiOfPropagatingConsVar
= return BENoUniAttr
convertAttribution attr
= abort "backendconvert, convertAttribution: unknown TypeAttribute" <<- attr
convertAnnotTypeNode :: AType -> BEMonad BETypeNodeP
convertAnnotTypeNode {at_type, at_annotation, at_attribute}
......@@ -1139,14 +1247,14 @@ convertTypeNode (TB BT_Dynamic)
convertTypeNode (TB basicType)
= beNormalTypeNode (beBasicSymbol (convertBasicTypeKind basicType)) beNoTypeArgs
convertTypeNode (TA typeSymbolIdent typeArgs)
= beNormalTypeNode (convertTypeSymbolIdent typeSymbolIdent) (convertTypeArgs typeArgs)
= beNormalTypeNode (convertTypeSymbolIdent typeSymbolIdent) (convertTypeArgs typeArgs )
convertTypeNode (TV {tv_name})
= beVarTypeNode tv_name.id_name
convertTypeNode (TempQV n)
= beVarTypeNode ("_tqv" +++ toString n)
convertTypeNode (TempV n)
= beVarTypeNode ("_tv" +++ toString n)
convertTypeNode (a --> b)
convertTypeNode (a --> b)
= beNormalTypeNode (beBasicSymbol BEFunType) (convertTypeArgs [a, b])
convertTypeNode (a :@: b)
= beNormalTypeNode (beBasicSymbol BEApplySymb) (convertTypeArgs [{at_attribute=TA_Multi, at_annotation=AN_None, at_type = consVariableToType a} : b])
......@@ -1292,8 +1400,8 @@ convertCodeParameter {bind_src, bind_dst}
= beCodeParameter bind_src (convertVar (varInfoPtr bind_dst))
/*
convertTransformedLhs :: Int [FreeVar] -> BEMonad BENodeP
convertTransformedLhs functionIndex freeVars varHeap
= beNormalNode (beFunctionSymbol functionIndex cIclModIndex) (convertLhsArgs freeVars varHeap)
convertTransformedLhs functionIndex freeVars
= beNormalNode (beFunctionSymbol functionIndex cIclModIndex) (convertLhsArgs freeVars)
*/
convertPatterns :: [FunctionPattern] -> BEMonad BEArgP
......@@ -1341,7 +1449,7 @@ convertRootExpr aliasDummyId (Conditional {if_cond=cond, if_then=then, if_else=Y
(convertRhsNodeDefs aliasDummyId then main_dcl_module_n)
(convertRhsStrictNodeIds then)
(convertRootExpr aliasDummyId then main_dcl_module_n)
(convertRhsNodeDefs aliasDummyId else main_dcl_module_n)
(convertRhsNodeDefs aliasDummyId else main_dcl_module_n )
(convertRhsStrictNodeIds else)
(convertRootExpr aliasDummyId else main_dcl_module_n)
convertRootExpr aliasDummyId (Conditional {if_cond=cond, if_then=then, if_else=No}) main_dcl_module_n
......@@ -1577,7 +1685,7 @@ where
convertExpr (Conditional {if_cond=cond, if_then, if_else=Yes else})
= beIfNode (convertExpr cond) (convertExpr if_then) (convertExpr else)
convertExpr expr
convertExpr expr
= undef <<- ("backendconvert, convertExpr: unknown expression" , expr)
convertArgs :: [Expression] -> BEMonad BEArgP
......
backend/backendinterface.dcl
View file @ bf77a4f7
......@@ -2,4 +2,4 @@ definition module backendinterface
import frontend
backEndInterface :: !{#Char} [{#Char}] !PredefinedSymbols !FrontEndSyntaxTree !Int !*VarHeap !*File !*Files -> (!Bool,!*VarHeap, !*File, !*Files)
backEndInterface :: !{#Char} [{#Char}] !PredefinedSymbols !FrontEndSyntaxTree !Int !*VarHeap !*AttrVarHeap !*File !*Files -> (!Bool, !*VarHeap, !*AttrVarHeap, !*File, !*Files)
backend/backendinterface.icl
View file @ bf77a4f7
......@@ -19,8 +19,8 @@ checkVersion VersionObservedIsTooOld errorFile
= fwrites "[Backend] the back end library is too old\n" errorFile
= (False, errorFile)
backEndInterface :: !{#Char} [{#Char}] !PredefinedSymbols !FrontEndSyntaxTree !Int !*VarHeap !*File !*Files -> (!Bool,!*VarHeap, !*File, !*Files)
backEndInterface outputFileName commandLineArgs predef_symbols syntaxTree=:{fe_icl,fe_components} main_dcl_module_n var_heap errorFile files
backEndInterface :: !{#Char} [{#Char}] !PredefinedSymbols !FrontEndSyntaxTree !Int !*VarHeap !*AttrVarHeap !*File !*Files -> (!Bool, !*VarHeap, !*AttrVarHeap, !*File, !*Files)
backEndInterface outputFileName commandLineArgs predef_symbols syntaxTree=:{fe_icl,fe_components} main_dcl_module_n var_heap attrHeap errorFile files
# (observedCurrent, observedOldestDefinition, observedOldestImplementation)
= BEGetVersion
observedVersion =
......@@ -42,7 +42,7 @@ backEndInterface outputFileName commandLineArgs predef_symbols syntaxTree=:{fe_i
# (compatible, errorFile)
= checkVersion (versionCompare expectedVersion observedVersion) errorFile
| not compatible
= (False, var_heap,errorFile, files)
= (False, var_heap, attrHeap, errorFile, files)
# varHeap
= backEndPreprocess predef_symbols.[PD_DummyForStrictAliasFun].pds_ident functionIndices fe_icl var_heap
with
......@@ -54,10 +54,10 @@ backEndInterface outputFileName commandLineArgs predef_symbols syntaxTree=:{fe_i
= BEInit (length commandLineArgs) backEndFiles
# backEnd
= foldState BEArg commandLineArgs backEnd
# (var_heap,backEnd)
= backEndConvertModules predef_symbols syntaxTree main_dcl_module_n varHeap backEnd
# (var_heap, attrHeap, backEnd)
= backEndConvertModules predef_symbols syntaxTree main_dcl_module_n varHeap attrHeap backEnd
# (success, backEnd)
= BEGenerateCode outputFileName backEnd
# backEndFiles
= BEFree backEnd backEndFiles
= (backEndFiles == 0 && success, var_heap,errorFile, files)
= (backEndFiles == 0 && success, var_heap, attrHeap, errorFile, files)
backendC/CleanCompilerSources/backend.c
View file @ bf77a4f7
......@@ -18,6 +18,8 @@
# include "comsupport.h" /* CurrentModule */
# include "buildtree.h" /* TupleSymbol, ApplySymbol */
extern void InitARC_Info (void); /* from typeconv.h */
# include "backendsupport.h"
# define Clean(ignore)
......@@ -1155,6 +1157,7 @@ BENormalTypeNode (BESymbolP symbol, BETypeArgP args)
return (node);
} /* BENormalTypeNode */
BETypeNodeP
BEAttributeTypeNode (BEAttribution attribution, BETypeNodeP typeNode)
{
......@@ -1164,6 +1167,63 @@ BEAttributeTypeNode (BEAttribution attribution, BETypeNodeP typeNode)
return (typeNode);
} /* BEAttributeTypeNode */
BEAttributeKindList
BEAttributeKind (BEAttribution attributeKind)
{
AttributeKindList new;
new = ConvertAllocType (struct attr_kind_list);
new->akl_elem = attributeKind;
new->akl_next = NULL;
return (new);
} /* BEAttributeKind */
BEAttributeKindList
BENoAttributeKinds (void)
{
return (NULL);
} /* BENoAttributeKinds */
BEAttributeKindList
BEAttributeKinds (BEAttributeKindList elem, BEAttributeKindList list)
{
Assert (elem->akl_next == NULL);
elem->akl_next = list;
return (elem);
} /* BEAttributeKindList */
BEUniVarEquations
BEUniVarEquation (BEAttribution demanded, BEAttributeKindList offered)
{
UniVarEquations new;
new = ConvertAllocType (struct uni_var_equats);
new->uve_demanded = demanded;
new->uve_offered = offered;
new->uve_next = NULL;
return (new);
} /* BEUniVarEquation */
BEUniVarEquations
BENoUniVarEquations (void)
{
return (NULL);
} /* BENoUniVarEquations */
BEUniVarEquations
BEUniVarEquationsList (BEUniVarEquations elem, BEUniVarEquations list)
{
Assert (elem->uve_next == NULL);
elem->uve_next = list;
return (elem);
} /* BEUniVarEquations */
BETypeNodeP
BEAnnotateTypeNode (BEAnnotation annotation, BETypeNodeP typeNode)
{
......@@ -1193,7 +1253,7 @@ BETypeArgs (BETypeNodeP node, BETypeArgP nextArgs)
} /* BETypeArgs */
BETypeAltP
BETypeAlt (BETypeNodeP lhs, BETypeNodeP rhs)
BETypeAlt (BETypeNodeP lhs, BETypeNodeP rhs, BEUniVarEquations attributeEquations)
{
TypeAlt *alt;
......@@ -1203,7 +1263,7 @@ BETypeAlt (BETypeNodeP lhs, BETypeNodeP rhs)
alt->type_alt_rhs = rhs;
alt->type_alt_type_context = NULL; /* used in PrintType */
alt->type_alt_attr_equations = NULL; /* used in PrintType */
alt->type_alt_attr_equations = attributeEquations; /* used in PrintType */
return (alt);
} /* BETypeAlt */
......@@ -2380,6 +2440,7 @@ BETypeVar (CleanString name)
ident->ident_tv = typeVar;
typeVar->tv_ident = ident;
typeVar->tv_mark = 0;
typeVar->tv_argument_nr = 0; /* ??? */
return (typeVar);
......@@ -3200,6 +3261,7 @@ BEInit (int argc)
ClearOpenDefinitionModules ();
InitARC_Info ();