diff options
Diffstat (limited to 'backendC')
| -rw-r--r-- | backendC/CleanCompilerSources/backend.c | 156 | ||||
| -rw-r--r-- | backendC/CleanCompilerSources/backend.h | 80 |
2 files changed, 209 insertions, 27 deletions
diff --git a/backendC/CleanCompilerSources/backend.c b/backendC/CleanCompilerSources/backend.c index cf24592..6d22e0c 100644 --- a/backendC/CleanCompilerSources/backend.c +++ b/backendC/CleanCompilerSources/backend.c @@ -258,6 +258,24 @@ AddUserDefinedArrayFunction (SymbolP functionSymbol) UserDefinedArrayFunctions = elem; } /* AddUserDefinedArrayFunction */ +static Node +NewGuardNode (NodeP ifNode, NodeP node, NodeDefP nodeDefs, StrictNodeIdP stricts) +{ + NodeP guardNode; + + guardNode = ConvertAllocType (NodeS); + + guardNode->node_kind = GuardNode; + guardNode->node_node_defs = nodeDefs; + guardNode->node_arity = 2; + guardNode->node_guard_strict_node_ids = stricts; + + guardNode->node_arguments = BEArgs (ifNode, BEArgs (node, NULL)); + + return (guardNode); +} /* NewGuardNode */ + + static void DeclareModule (int moduleIndex, char *name, Bool isSystemModule, int nFunctions, int nTypes, int nConstructors, int nFields) @@ -332,7 +350,8 @@ DeclareModule (int moduleIndex, char *name, Bool isSystemModule, int nFunctions, static int main_dcl_module_n=0; -void BESetMainDclModuleN (int main_dcl_module_n_parameter) +void +BESetMainDclModuleN (int main_dcl_module_n_parameter) { main_dcl_module_n=main_dcl_module_n_parameter; } @@ -1249,7 +1268,7 @@ BEIfNode (BENodeP cond, BENodeP then, BENodeP elsje) node->node_annotation = NoAnnot; node->node_kind = NormalNode; node->node_symbol = gBasicSymbols [if_symb]; - node->node_arguments = BEArgs (cond, BEArgs (then, (BEArgs (elsje, NULL)))); + node->node_arguments = BEArgs (cond, BEArgs (then, BEArgs (elsje, NULL))); node->node_arity = 3; node->node_number = 0; @@ -1276,13 +1295,110 @@ BEGuardNode (BENodeP cond, BENodeDefP thenNodeDefs, BEStrictNodeIdP thenStricts, node->node_annotation = NoAnnot; node->node_kind = IfNode; node->node_contents.contents_if = thenElseInfo; - node->node_arguments = BEArgs (cond, BEArgs (then, (BEArgs (elsje, NULL)))); + node->node_arguments = BEArgs (cond, BEArgs (then, BEArgs (elsje, NULL))); node->node_number = 0; + switch (elsje->node_kind) + { + case SwitchNode: + thenElseInfo->if_else_node_defs = NULL; + thenElseInfo->if_else_strict_node_ids = NULL; + node->node_arguments->arg_next->arg_next->arg_node + = BENormalNode (BEBasicSymbol (BEFailSymb), BENoArgs ()); + + node = NewGuardNode (node, elsje, elseNodeDefs, elseStricts); + break; + case GuardNode: + /* move the GuardNode to the top */ + node->node_arguments->arg_next->arg_next->arg_node + = elsje->node_arguments->arg_node; + elsje->node_arguments->arg_node = node; + node = elsje; + break; + default: + break; + } + return (node); } /* BEGuardNode */ BENodeP +BESwitchNode (BENodeIdP nodeId, BEArgP cases) +{ + NodeP switchNode; + + switchNode = ConvertAllocType (NodeS); + + switchNode->node_kind = SwitchNode; + switchNode->node_node_id = nodeId; + switchNode->node_arity = 1; + switchNode->node_arguments = cases; + switchNode->node_annotation = NoAnnot; + +// --nodeId->nid_refcount; + + return (switchNode); +} /* BESwitchNode */ + +BENodeP +BECaseNode (int symbolArity, BESymbolP symbol, BENodeDefP nodeDefs, BEStrictNodeIdP strictNodeIds, BENodeP node) +{ + NodeP caseNode; + + caseNode = ConvertAllocType (NodeS); + + caseNode->node_kind = CaseNode; + caseNode->node_symbol = symbol; + caseNode->node_arity = symbolArity; + caseNode->node_node_defs = nodeDefs; + caseNode->node_arguments = NewArgument (node); + + caseNode->node_su.su_u.u_case = ConvertAllocType (CaseNodeContentsS); + caseNode->node_node_id_ref_counts = NULL; + caseNode->node_strict_node_ids = strictNodeIds; + + return (caseNode); +} /* BECaseNode */ + +BENodeP +BEDefaultNode (BENodeDefP nodeDefs, BEStrictNodeIdP strictNodeIds, BENodeP node) +{ + NodeP defaultNode; + + defaultNode = ConvertAllocType (NodeS); + + defaultNode->node_kind = DefaultNode; + defaultNode->node_node_defs = nodeDefs; + defaultNode->node_arity = 1; + defaultNode->node_arguments = NewArgument (node); + + defaultNode->node_su.su_u.u_case = ConvertAllocType (CaseNodeContentsS); + defaultNode->node_strict_node_ids = strictNodeIds; + + defaultNode->node_node_id_ref_counts = NULL; + + return (defaultNode); +} /* BEDefaultNode */ + +BENodeP +BEPushNode (int arity, BESymbolP symbol, BEArgP arguments, BENodeIdListP nodeIds) +{ + NodeP pushNode; + + pushNode = ConvertAllocType (NodeS); + + pushNode->node_kind = PushNode; + pushNode->node_arity = arity; + pushNode->node_arguments = arguments; + pushNode->node_record_symbol= symbol; + pushNode->node_node_ids = nodeIds; + + pushNode->node_number = 0; /* ??? if !=0 then unique */ + + return (pushNode); +} /* BEPushNode */ + +BENodeP BESelectorNode (BESelectorKind selectorKind, BESymbolP fieldSymbol, BEArgP args) { NodeP node; @@ -1622,6 +1738,7 @@ BECodeAlt (int line, BENodeDefP lhsDefs, BENodeP lhs, BECodeBlockP codeBlock) return (alt); } /* BECodeAlt */ + BERuleAltP BERuleAlts (BERuleAltP alt, BERuleAltP alts) { @@ -2281,6 +2398,38 @@ BENoStrings (void) return (NULL); } /* BENoStrings */ + +BENodeIdListP +BENodeIdListElem (BENodeIdP nodeId) +{ + struct node_id_list_element *elem; + + elem = ConvertAllocType (struct node_id_list_element); + + elem->nidl_node_id = nodeId; + /* ifdef DEBUG */ + elem->nidl_next = NULL; + /* endif */ + + return (elem); +} /* BENodeIdListElem */ + +BENodeIdListP +BENodeIds (BENodeIdListP nid, BENodeIdListP nids) +{ + Assert (nid->nidl_next == NULL); + + nid->nidl_next = nids; + + return (nid); +} /* BENodeIds*/ + +BENodeIdListP +BENoNodeIds (void) +{ + return (NULL); +} /* BENoNodeIds */ + BECodeBlockP BEAbcCodeBlock (int inlineFlag, BEStringListP instructions) { @@ -2713,7 +2862,6 @@ BEFree (BackEnd backEnd) fclose (StdOut); } /* BEFree */ - // temporary hack void diff --git a/backendC/CleanCompilerSources/backend.h b/backendC/CleanCompilerSources/backend.h index 2389f3f..0c46787 100644 --- a/backendC/CleanCompilerSources/backend.h +++ b/backendC/CleanCompilerSources/backend.h @@ -1,77 +1,90 @@ /* version info */ -# define kBEVersionCurrent 0x02000206 -# define kBEVersionOldestDefinition 0x02000204 +// increment this for every release +# define kBEVersionCurrent 0x02000207 + +// change this to the same value as kBEVersionCurrent if the new release is not +// upward compatible (for example when a function is added) +# define kBEVersionOldestDefinition 0x02000204 + +// change this to the same value as kBEVersionCurrent if the new release is not +// downward compatible (for example when a function is removed) # define kBEVersionOldestImplementation 0x02000206 + # define kBEDebug 1 /* pointer types */ +Clean (:: CPtr :== Int) + Clean (:: *UWorld :== Int) typedef struct BackEnd *BackEnd; -Clean (:: *BackEnd :== Int) +Clean (:: *BackEnd :== CPtr) typedef struct symbol *BESymbolP; -Clean (:: BESymbolP :== Int) +Clean (:: BESymbolP :== CPtr) typedef struct type_node *BETypeNodeP; -Clean (:: BETypeNodeP :== Int) +Clean (:: BETypeNodeP :== CPtr) typedef struct type_arg *BETypeArgP; -Clean (:: BETypeArgP :== Int) +Clean (:: BETypeArgP :== CPtr) typedef struct type_alt *BETypeAltP; -Clean (:: BETypeAltP :== Int) +Clean (:: BETypeAltP :== CPtr) typedef struct node *BENodeP; -Clean (:: BENodeP :== Int) +Clean (:: BENodeP :== CPtr) typedef struct arg *BEArgP; -Clean (:: BEArgP :== Int) +Clean (:: BEArgP :== CPtr) typedef struct rule_alt *BERuleAltP; -Clean (:: BERuleAltP :== Int) +Clean (:: BERuleAltP :== CPtr) typedef struct imp_rule *BEImpRuleP; -Clean (:: BEImpRuleP :== Int) +Clean (:: BEImpRuleP :== CPtr) typedef struct type *BETypeP; -Clean (:: BETypeP :== Int) +Clean (:: BETypeP :== CPtr) typedef struct flat_type *BEFlatTypeP; -Clean (:: BEFlatTypeP :== Int) +Clean (:: BEFlatTypeP :== CPtr) typedef struct type_var *BETypeVarP; -Clean (:: BETypeVarP :== Int) +Clean (:: BETypeVarP :== CPtr) typedef struct type_var_list *BETypeVarListP; -Clean (:: BETypeVarListP :== Int) +Clean (:: BETypeVarListP :== CPtr) typedef struct constructor_list *BEConstructorListP; -Clean (:: BEConstructorListP :== Int) +Clean (:: BEConstructorListP :== CPtr) typedef struct field_list *BEFieldListP; -Clean (:: BEFieldListP :== Int) +Clean (:: BEFieldListP :== CPtr) typedef struct node_id *BENodeIdP; -Clean (:: BENodeIdP :== Int) +Clean (:: BENodeIdP :== CPtr) typedef struct node_def *BENodeDefP; -Clean (:: BENodeDefP :== Int) +Clean (:: BENodeDefP :== CPtr) typedef struct strict_node_id *BEStrictNodeIdP; -Clean (:: BEStrictNodeIdP :== Int) +Clean (:: BEStrictNodeIdP :== CPtr) typedef struct parameter *BECodeParameterP; -Clean (:: BECodeParameterP :== Int) +Clean (:: BECodeParameterP :== CPtr) typedef struct code_block *BECodeBlockP; -Clean (:: BECodeBlockP :== Int) +Clean (:: BECodeBlockP :== CPtr) typedef struct string_list *BEStringListP; -Clean (:: BEStringListP :== Int) +Clean (:: BEStringListP :== CPtr) + +typedef struct node_id_list_element *BENodeIdListP; +Clean (:: BENodeIdListP :== CPtr) /* constants */ /* @@ -238,6 +251,18 @@ Clean (BEIfNode :: BENodeP BENodeP BENodeP BackEnd -> (BENodeP, BackEnd)) BENodeP BEGuardNode (BENodeP cond, BENodeDefP thenNodeDefs, BEStrictNodeIdP thenStricts, BENodeP then, BENodeDefP elseNodeDefs, BEStrictNodeIdP elseStricts, BENodeP elsje); Clean (BEGuardNode :: BENodeP BENodeDefP BEStrictNodeIdP BENodeP BENodeDefP BEStrictNodeIdP BENodeP BackEnd -> (BENodeP, BackEnd)) +BENodeP BESwitchNode (BENodeIdP nodeId, BEArgP caseNode); +Clean (BESwitchNode :: BENodeIdP BEArgP BackEnd -> (BENodeP, BackEnd)) + +BENodeP BECaseNode (int symbolArity, BESymbolP symbol, BENodeDefP nodeDefs, BEStrictNodeIdP strictNodeIds, BENodeP node); +Clean (BECaseNode :: Int BESymbolP BENodeDefP BEStrictNodeIdP BENodeP BackEnd -> (BENodeP, BackEnd)) + +BENodeP BEPushNode (int arity, BESymbolP symbol, BEArgP arguments, BENodeIdListP nodeIds); +Clean (BEPushNode :: Int BESymbolP BEArgP BENodeIdListP BackEnd -> (BENodeP, BackEnd)) + +BENodeP BEDefaultNode (BENodeDefP nodeDefs, BEStrictNodeIdP strictNodeIds, BENodeP node); +Clean (BEDefaultNode :: BENodeDefP BEStrictNodeIdP BENodeP BackEnd -> (BENodeP, BackEnd)) + BENodeP BESelectorNode (BESelectorKind selectorKind, BESymbolP fieldSymbol, BEArgP args); Clean (BESelectorNode :: BESelectorKind BESymbolP BEArgP BackEnd -> (BENodeP, BackEnd)) @@ -383,6 +408,15 @@ Clean (BECodeParameters:: BECodeParameterP BECodeParameterP BackEnd -> (BECodePa BECodeParameterP BENoCodeParameters (void); Clean (BENoCodeParameters:: BackEnd -> (BECodeParameterP, BackEnd)) +BENodeIdListP BENodeIdListElem (BENodeIdP nodeId); +Clean (BENodeIdListElem:: BENodeIdP BackEnd -> (BENodeIdListP, BackEnd)) + +BENodeIdListP BENodeIds (BENodeIdListP nid, BENodeIdListP nids); +Clean (BENodeIds:: BENodeIdListP BENodeIdListP BackEnd -> (BENodeIdListP, BackEnd)) + +BENodeIdListP BENoNodeIds (void); +Clean (BENoNodeIds:: BackEnd -> (BENodeIdListP, BackEnd)) + BECodeBlockP BEAbcCodeBlock (int inline, BEStringListP instructions); Clean (BEAbcCodeBlock:: Bool BEStringListP BackEnd -> (BECodeBlockP, BackEnd)) |