aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--MacLibraries/CleanCompilerLibbin418883 -> 420096 bytes
-rw-r--r--backend/Clean System Files/backend_library2
-rw-r--r--backend/backend.dcl16
-rw-r--r--backend/backend.icl24
-rw-r--r--backend/backendconvert.icl46
-rw-r--r--backendC/CleanCompilerSources/backend.c52
-rw-r--r--backendC/CleanCompilerSources/backend.h26
-rw-r--r--backendC/CleanCompilerSources/compiledefines.h2
-rw-r--r--coclmaindll/backend.dllbin288256 -> 288768 bytes
9 files changed, 156 insertions, 12 deletions
diff --git a/MacLibraries/CleanCompilerLib b/MacLibraries/CleanCompilerLib
index 70dc278..1a58418 100644
--- a/MacLibraries/CleanCompilerLib
+++ b/MacLibraries/CleanCompilerLib
Binary files differ
diff --git a/backend/Clean System Files/backend_library b/backend/Clean System Files/backend_library
index 342803b..780b1b4 100644
--- a/backend/Clean System Files/backend_library
+++ b/backend/Clean System Files/backend_library
@@ -4,6 +4,8 @@ BEInit
BEFree
BEArg
BEDeclareModules
+BEBindSpecialModule
+BEBindSpecialFunction
BESpecialArrayFunctionSymbol
BEDictionarySelectFunSymbol
BEDictionaryUpdateFunSymbol
diff --git a/backend/backend.dcl b/backend/backend.dcl
index b144aa5..932338d 100644
--- a/backend/backend.dcl
+++ b/backend/backend.dcl
@@ -37,6 +37,7 @@ from StdString import String;
:: BEArrayFunKind :== Int;
:: BESelectorKind :== Int;
:: BEUpdateKind :== Int;
+:: BESpecialIdentIndex :== Int;
BEGetVersion :: (!Int,!Int,!Int);
// void BEGetVersion (int* current,int* oldestDefinition,int* oldestImplementation);
BEInit :: !Int !UWorld -> (!BackEnd,!UWorld);
@@ -47,6 +48,10 @@ BEArg :: !String !BackEnd -> BackEnd;
// void BEArg (CleanString arg);
BEDeclareModules :: !Int !BackEnd -> BackEnd;
// void BEDeclareModules (int nModules);
+BEBindSpecialModule :: !BESpecialIdentIndex !Int !BackEnd -> BackEnd;
+// void BEBindSpecialModule (BESpecialIdentIndex index,int moduleIndex);
+BEBindSpecialFunction :: !BESpecialIdentIndex !Int !Int !BackEnd -> BackEnd;
+// void BEBindSpecialFunction (BESpecialIdentIndex index,int functionIndex,int moduleIndex);
BESpecialArrayFunctionSymbol :: !BEArrayFunKind !Int !Int !BackEnd -> (!BESymbolP,!BackEnd);
// BESymbolP BESpecialArrayFunctionSymbol (BEArrayFunKind arrayFunKind,int functionIndex,int moduleIndex);
BEDictionarySelectFunSymbol :: !BackEnd -> (!BESymbolP,!BackEnd);
@@ -279,9 +284,9 @@ BEDeclareDynamicTypeSymbol :: !Int !Int !BackEnd -> BackEnd;
// void BEDeclareDynamicTypeSymbol (int typeIndex,int moduleIndex);
BEDynamicTempTypeSymbol :: !BackEnd -> (!BESymbolP,!BackEnd);
// BESymbolP BEDynamicTempTypeSymbol ();
-kBEVersionCurrent:==0x02000214;
+kBEVersionCurrent:==0x02000215;
kBEVersionOldestDefinition:==0x02000213;
-kBEVersionOldestImplementation:==0x02000214;
+kBEVersionOldestImplementation:==0x02000215;
kBEDebug:==1;
kPredefinedModuleIndex:==1;
BENoAnnot:==0;
@@ -354,6 +359,13 @@ BESelector_N:==5;
BEUpdateDummy:==0;
BEUpdate:==1;
BEUpdate_U:==2;
+BESpecialIdentStdMisc:==0;
+BESpecialIdentAbort:==1;
+BESpecialIdentUndef:==2;
+BESpecialIdentStdBool:==3;
+BESpecialIdentAnd:==4;
+BESpecialIdentOr:==5;
+BESpecialIdentCount:==6;
BELhsNodeId:==0;
BERhsNodeId:==1;
BEIsNotACaf:==0;
diff --git a/backend/backend.icl b/backend/backend.icl
index ac2c4b2..05ac802 100644
--- a/backend/backend.icl
+++ b/backend/backend.icl
@@ -37,6 +37,7 @@ from StdString import String;
:: BEArrayFunKind :== Int;
:: BESelectorKind :== Int;
:: BEUpdateKind :== Int;
+:: BESpecialIdentIndex :== Int;
BEGetVersion :: (!Int,!Int,!Int);
BEGetVersion = code {
@@ -68,6 +69,18 @@ BEDeclareModules a0 a1 = code {
};
// void BEDeclareModules (int nModules);
+BEBindSpecialModule :: !BESpecialIdentIndex !Int !BackEnd -> BackEnd;
+BEBindSpecialModule a0 a1 a2 = code {
+ ccall BEBindSpecialModule "II:V:I"
+};
+// void BEBindSpecialModule (BESpecialIdentIndex index,int moduleIndex);
+
+BEBindSpecialFunction :: !BESpecialIdentIndex !Int !Int !BackEnd -> BackEnd;
+BEBindSpecialFunction a0 a1 a2 a3 = code {
+ ccall BEBindSpecialFunction "III:V:I"
+};
+// void BEBindSpecialFunction (BESpecialIdentIndex index,int functionIndex,int moduleIndex);
+
BESpecialArrayFunctionSymbol :: !BEArrayFunKind !Int !Int !BackEnd -> (!BESymbolP,!BackEnd);
BESpecialArrayFunctionSymbol a0 a1 a2 a3 = code {
ccall BESpecialArrayFunctionSymbol "III:I:I"
@@ -763,9 +776,9 @@ BEDynamicTempTypeSymbol a0 = code {
ccall BEDynamicTempTypeSymbol ":I:I"
};
// BESymbolP BEDynamicTempTypeSymbol ();
-kBEVersionCurrent:==0x02000214;
+kBEVersionCurrent:==0x02000215;
kBEVersionOldestDefinition:==0x02000213;
-kBEVersionOldestImplementation:==0x02000214;
+kBEVersionOldestImplementation:==0x02000215;
kBEDebug:==1;
kPredefinedModuleIndex:==1;
BENoAnnot:==0;
@@ -838,6 +851,13 @@ BESelector_N:==5;
BEUpdateDummy:==0;
BEUpdate:==1;
BEUpdate_U:==2;
+BESpecialIdentStdMisc:==0;
+BESpecialIdentAbort:==1;
+BESpecialIdentUndef:==2;
+BESpecialIdentStdBool:==3;
+BESpecialIdentAnd:==4;
+BESpecialIdentOr:==5;
+BESpecialIdentCount:==6;
BELhsNodeId:==0;
BERhsNodeId:==1;
BEIsNotACaf:==0;
diff --git a/backend/backendconvert.icl b/backend/backendconvert.icl
index bea9282..1a5dbdf 100644
--- a/backend/backendconvert.icl
+++ b/backend/backendconvert.icl
@@ -363,6 +363,10 @@ beNoUniVarEquations
:== beFunction0 BENoUniVarEquations
beUniVarEquationsList
:== beFunction2 BEUniVarEquationsList
+beBindSpecialModule specialIdentIndex moduleIndex
+ :== beApFunction0 (BEBindSpecialModule specialIdentIndex moduleIndex)
+beBindSpecialFunction specialIdentIndex functionIndex moduleIndex
+ :== beApFunction0 (BEBindSpecialFunction specialIdentIndex functionIndex moduleIndex)
// temporary hack
beDynamicTempTypeSymbol
@@ -483,6 +487,7 @@ backEndConvertModulesH predefs {fe_icl =
with
dcl_common
= currentDcl.dcl_common
+ # backEnd = bindSpecialIdents predefs icl_used_module_numbers backEnd
#! backEnd = removeExpandedTypesFromDclModules fe_dcls icl_used_module_numbers backEnd
= (backEnd -*-> "backend done")
where
@@ -1076,6 +1081,47 @@ predefineSymbols {dcl_common} predefs
// ... sanity check
= appBackEnd (BEPredefineConstructorSymbol arity predefs.[index].pds_def cPredefinedModuleIndex symbolKind)
+
+bindSpecialIdents :: PredefinedSymbols NumberSet -> BackEnder
+bindSpecialIdents predefs usedModules
+ = foldState (bindSpecialModule predefs usedModules) specialModules
+ where
+ bindSpecialModule :: PredefinedSymbols NumberSet (Int, BESpecialIdentIndex, [(Int, BESpecialIdentIndex)]) -> BackEnder
+ bindSpecialModule predefs usedModules (predefIndex, specialIdentIndex, specialFunctions)
+ | moduleIndex == NoIndex || not (inNumberSet moduleIndex usedModules)
+ = identity
+ // otherwise
+ = beBindSpecialModule specialIdentIndex moduleIndex
+ o` foldState (bindSpecialFunction predefs) specialFunctions
+ where
+ predef
+ = predefs.[predefIndex]
+ moduleIndex
+ = predef.pds_def
+
+ bindSpecialFunction :: PredefinedSymbols (Int, BESpecialIdentIndex) -> BackEnder
+ bindSpecialFunction predefs (predefIndex, specialIdentIndex)
+ | predef.pds_def == NoIndex
+ = identity
+ // otherwise
+ = beBindSpecialFunction specialIdentIndex predef.pds_def predef.pds_module
+ where
+ predef
+ = predefs.[predefIndex]
+
+ specialModules
+ = [ (PD_StdMisc, BESpecialIdentStdMisc,
+ [ (PD_abort, BESpecialIdentAbort)
+ , (PD_undef, BESpecialIdentUndef)
+ ]
+ )
+ , (PD_StdBool, BESpecialIdentStdBool,
+ [ (PD_AndOp, BESpecialIdentAnd)
+ , (PD_OrOp, BESpecialIdentOr)
+ ]
+ )
+ ]
+
adjustStrictListFunctions :: [Int] [Int] {#PredefinedSymbol} {#DclModule} NumberSet Int *BackEndState -> *BackEndState;
adjustStrictListFunctions list_first_instance_indices tail_strict_list_first_instance_indices predefs dcls used_module_numbers main_dcl_module_n backEnd
| std_strict_list_module_index==NoIndex || not (inNumberSet std_strict_list_module_index used_module_numbers)
diff --git a/backendC/CleanCompilerSources/backend.c b/backendC/CleanCompilerSources/backend.c
index aef2907..c375a1d 100644
--- a/backendC/CleanCompilerSources/backend.c
+++ b/backendC/CleanCompilerSources/backend.c
@@ -170,6 +170,9 @@ static SymbolP gTupleSelectSymbols [MaxNodeArity];
static int number_of_node_ids=0;
+typedef IdentP *IdentH;
+static IdentH gSpecialIdents[BESpecialIdentCount];
+
static IdentP
Identifier (char *name)
{
@@ -536,6 +539,37 @@ GetArrayFunctionType (SymbDefP sdef, TypeNode *elementTypeP, TypeNode *arrayType
}
} /* GetArrayFunctionType */
+void
+BEBindSpecialModule (BESpecialIdentIndex index, int moduleIndex)
+{
+ BEModuleP module;
+
+ Assert (index >= 0 && index < BESpecialIdentCount);
+
+ Assert ((unsigned int) moduleIndex < gBEState.be_nModules);
+ module = &gBEState.be_modules [moduleIndex];
+
+ (*gSpecialIdents [index])->ident_name = module->bem_name;
+} /* BEBindSpecialModule */
+
+void
+BEBindSpecialFunction (BESpecialIdentIndex index, int functionIndex, int moduleIndex)
+{
+ SymbolP functionSymbol;
+ BEModuleP module;
+
+ Assert (index >= 0 && index < BESpecialIdentCount);
+
+ Assert ((unsigned int) moduleIndex < gBEState.be_nModules);
+ module = &gBEState.be_modules [moduleIndex];
+
+ Assert ((unsigned int) functionIndex < module->bem_nFunctions);
+ functionSymbol = &module->bem_functions [functionIndex];
+
+ if (functionSymbol->symb_kind == definition)
+ *gSpecialIdents [index] = functionSymbol->symb_def->sdef_ident;
+} /* BEBindSpecialFunction */
+
BESymbolP
BESpecialArrayFunctionSymbol (BEArrayFunKind arrayFunKind, int functionIndex, int moduleIndex)
{
@@ -3522,7 +3556,6 @@ BEInit (int argc)
/* +++ remove symbol table from backend */
ScanInitIdentStringTable ();
InitScanner (); /* for inlining */
- DeltaBId = Identifier ("StdBool");
ApplyId = Identifier ("AP");
ListId = Identifier ("List");
TupleId = Identifier ("Tuple");
@@ -3535,6 +3568,23 @@ BEInit (int argc)
DynamicId = Identifier ("Dynamic");
#endif
+#if SA_RECOGNIZES_ABORT_AND_UNDEF
+ StdMiscId = Identifier ("StdMisc");
+
+ abort_id = NULL;
+ undef_id = NULL;
+ gSpecialIdents [BESpecialIdentStdMisc] = &StdMiscId;
+ gSpecialIdents [BESpecialIdentAbort] = &abort_id;
+ gSpecialIdents [BESpecialIdentUndef] = &undef_id;
+#endif
+
+ DeltaBId = Identifier ("StdBool");
+ AndId = NULL;
+ OrId = NULL;
+ gSpecialIdents [BESpecialIdentStdBool] = &DeltaBId;
+ gSpecialIdents [BESpecialIdentAnd] = &AndId;
+ gSpecialIdents [BESpecialIdentOr] = &OrId;
+
UserDefinedArrayFunctions = NULL;
#if STRICT_LISTS
unboxed_record_cons_list=NULL;
diff --git a/backendC/CleanCompilerSources/backend.h b/backendC/CleanCompilerSources/backend.h
index 004eb88..8f80be5 100644
--- a/backendC/CleanCompilerSources/backend.h
+++ b/backendC/CleanCompilerSources/backend.h
@@ -1,15 +1,15 @@
/* version info */
// increment this for every release
-# define kBEVersionCurrent 0x02000214
+# define kBEVersionCurrent 0x02000215
-// change this to the same value as kBEVersionCurrent if the new release is not
-// upward compatible (for example when a function is added)
+// 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 0x02000213
-// 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 0x02000214
+// 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 0x02000215
# define kBEDebug 1
@@ -161,7 +161,15 @@ enum {
BEUpdateDummy, BEUpdate, BEUpdate_U
};
+typedef int BESpecialIdentIndex;
+Clean (::BESpecialIdentIndex :== Int)
+enum {
+ /* StdMisc */
+ BESpecialIdentStdMisc, BESpecialIdentAbort, BESpecialIdentUndef,
+ BESpecialIdentStdBool, BESpecialIdentAnd, BESpecialIdentOr,
+ BESpecialIdentCount
+};
/* functions */
void BEGetVersion (int *current, int *oldestDefinition, int *oldestImplementation);
@@ -179,6 +187,12 @@ Clean (BEArg :: String BackEnd -> BackEnd)
void BEDeclareModules (int nModules);
Clean (BEDeclareModules :: Int BackEnd -> BackEnd)
+void BEBindSpecialModule (BESpecialIdentIndex index, int moduleIndex);
+Clean (BEBindSpecialModule :: BESpecialIdentIndex Int BackEnd -> BackEnd)
+
+void BEBindSpecialFunction (BESpecialIdentIndex index, int functionIndex, int moduleIndex);
+Clean (BEBindSpecialFunction :: BESpecialIdentIndex Int Int BackEnd -> BackEnd)
+
BESymbolP BESpecialArrayFunctionSymbol (BEArrayFunKind arrayFunKind, int functionIndex, int moduleIndex);
Clean (BESpecialArrayFunctionSymbol :: BEArrayFunKind Int Int BackEnd -> (BESymbolP, BackEnd))
diff --git a/backendC/CleanCompilerSources/compiledefines.h b/backendC/CleanCompilerSources/compiledefines.h
index df91918..3c714ca 100644
--- a/backendC/CleanCompilerSources/compiledefines.h
+++ b/backendC/CleanCompilerSources/compiledefines.h
@@ -18,7 +18,7 @@
#define WRITE_DCL_MODIFICATION_TIME 1
-#define SA_RECOGNIZES_ABORT_AND_UNDEF 0
+#define SA_RECOGNIZES_ABORT_AND_UNDEF 1
#define STRICT_LISTS 1
diff --git a/coclmaindll/backend.dll b/coclmaindll/backend.dll
index faf8b12..352a89c 100644
--- a/coclmaindll/backend.dll
+++ b/coclmaindll/backend.dll
Binary files differ