aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat
-rw-r--r--MacLibraries/CleanCompilerLibbin420416 -> 421281 bytes
-rw-r--r--backend/Clean System Files/backend_library3
-rw-r--r--backend/backend.dcl10
-rw-r--r--backend/backend.icl22
-rw-r--r--backend/backendinterface.dcl2
-rw-r--r--backend/backendinterface.icl342
-rw-r--r--backendC/CleanCompilerSources/backend.c70
-rw-r--r--backendC/CleanCompilerSources/backend.h12
-rw-r--r--backendC/CleanCompilerSources/sa.c222
-rw-r--r--backendC/CleanCompilerSources/syntax_tree_types.h12
-rw-r--r--backendC/backend.link3
-rw-r--r--backendC/backend.rc2
-rw-r--r--coclmaindll/backend.dllbin288768 -> 289792 bytes
-rw-r--r--frontend/frontend.dcl7
-rw-r--r--frontend/frontend.icl17
-rw-r--r--frontend/syntax.dcl1
-rw-r--r--frontend/syntax.icl1
-rw-r--r--main/compile.icl31
18 files changed, 695 insertions, 62 deletions
diff --git a/MacLibraries/CleanCompilerLib b/MacLibraries/CleanCompilerLib
index 7c3bc25..c33a275 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 780b1b4..6eb2ebe 100644
--- a/backend/Clean System Files/backend_library
+++ b/backend/Clean System Files/backend_library
@@ -1,6 +1,7 @@
backend.dll
BEGetVersion
BEInit
+BECloseFiles
BEFree
BEArg
BEDeclareModules
@@ -120,5 +121,7 @@ BEExportField
BEExportFunction
BEDefineImportedObjsAndLibs
BESetMainDclModuleN
+BEStrictPositions
+BECopyInts
BEDeclareDynamicTypeSymbol
BEDynamicTempTypeSymbol
diff --git a/backend/backend.dcl b/backend/backend.dcl
index 932338d..9730e6a 100644
--- a/backend/backend.dcl
+++ b/backend/backend.dcl
@@ -42,6 +42,8 @@ BEGetVersion :: (!Int,!Int,!Int);
// void BEGetVersion (int* current,int* oldestDefinition,int* oldestImplementation);
BEInit :: !Int !UWorld -> (!BackEnd,!UWorld);
// BackEnd BEInit (int argc);
+BECloseFiles :: !BackEnd -> BackEnd;
+// void BECloseFiles ();
BEFree :: !BackEnd !UWorld -> UWorld;
// void BEFree (BackEnd backEnd);
BEArg :: !String !BackEnd -> BackEnd;
@@ -280,13 +282,17 @@ BEDefineImportedObjsAndLibs :: !BEStringListP !BEStringListP !BackEnd -> BackEnd
// void BEDefineImportedObjsAndLibs (BEStringListP objs,BEStringListP libs);
BESetMainDclModuleN :: !Int !BackEnd -> BackEnd;
// void BESetMainDclModuleN (int main_dcl_module_n_parameter);
+BEStrictPositions :: !Int !BackEnd -> (!Int,!Int,!BackEnd);
+// void BEStrictPositions (int functionIndex,int* bits,int** positions);
+BECopyInts :: !Int !Int !Int -> Int;
+// int BECopyInts (int cLength,int* ints,int* cleanArray);
BEDeclareDynamicTypeSymbol :: !Int !Int !BackEnd -> BackEnd;
// void BEDeclareDynamicTypeSymbol (int typeIndex,int moduleIndex);
BEDynamicTempTypeSymbol :: !BackEnd -> (!BESymbolP,!BackEnd);
// BESymbolP BEDynamicTempTypeSymbol ();
-kBEVersionCurrent:==0x02000215;
+kBEVersionCurrent:==0x02000216;
kBEVersionOldestDefinition:==0x02000213;
-kBEVersionOldestImplementation:==0x02000215;
+kBEVersionOldestImplementation:==0x02000216;
kBEDebug:==1;
kPredefinedModuleIndex:==1;
BENoAnnot:==0;
diff --git a/backend/backend.icl b/backend/backend.icl
index 05ac802..3f914cb 100644
--- a/backend/backend.icl
+++ b/backend/backend.icl
@@ -51,6 +51,12 @@ BEInit a0 a1 = code {
};
// BackEnd BEInit (int argc);
+BECloseFiles :: !BackEnd -> BackEnd;
+BECloseFiles a0 = code {
+ ccall BECloseFiles ":V:I"
+};
+// void BECloseFiles ();
+
BEFree :: !BackEnd !UWorld -> UWorld;
BEFree a0 a1 = code {
ccall BEFree "I:V:I"
@@ -765,6 +771,18 @@ BESetMainDclModuleN a0 a1 = code {
};
// void BESetMainDclModuleN (int main_dcl_module_n_parameter);
+BEStrictPositions :: !Int !BackEnd -> (!Int,!Int,!BackEnd);
+BEStrictPositions a0 a1 = code {
+ ccall BEStrictPositions "I:VII:I"
+};
+// void BEStrictPositions (int functionIndex,int* bits,int** positions);
+
+BECopyInts :: !Int !Int !Int -> Int;
+BECopyInts a0 a1 a2 = code {
+ ccall BECopyInts "III:I"
+};
+// int BECopyInts (int cLength,int* ints,int* cleanArray);
+
BEDeclareDynamicTypeSymbol :: !Int !Int !BackEnd -> BackEnd;
BEDeclareDynamicTypeSymbol a0 a1 a2 = code {
ccall BEDeclareDynamicTypeSymbol "II:V:I"
@@ -776,9 +794,9 @@ BEDynamicTempTypeSymbol a0 = code {
ccall BEDynamicTempTypeSymbol ":I:I"
};
// BESymbolP BEDynamicTempTypeSymbol ();
-kBEVersionCurrent:==0x02000215;
+kBEVersionCurrent:==0x02000216;
kBEVersionOldestDefinition:==0x02000213;
-kBEVersionOldestImplementation:==0x02000215;
+kBEVersionOldestImplementation:==0x02000216;
kBEDebug:==1;
kPredefinedModuleIndex:==1;
BENoAnnot:==0;
diff --git a/backend/backendinterface.dcl b/backend/backendinterface.dcl
index 20dde99..b380398 100644
--- a/backend/backendinterface.dcl
+++ b/backend/backendinterface.dcl
@@ -5,4 +5,4 @@ definition module backendinterface
import frontend
-backEndInterface :: !{#Char} [{#Char}] !PredefinedSymbols !FrontEndSyntaxTree !Int !*VarHeap !*AttrVarHeap !*File !*Files -> (!Bool, !*VarHeap, !*AttrVarHeap, !*File, !*Files)
+backEndInterface :: !{#Char} [{#Char}] !ListTypesOption !{#Char} !PredefinedSymbols !FrontEndSyntaxTree !Int !*VarHeap !*AttrVarHeap !*File !*Files -> (!Bool, !*VarHeap, !*AttrVarHeap, !*File, !*Files)
diff --git a/backend/backendinterface.icl b/backend/backendinterface.icl
index d16fb84..504e19f 100644
--- a/backend/backendinterface.icl
+++ b/backend/backendinterface.icl
@@ -8,7 +8,7 @@ import StdEnv
import frontend
import backend
import backendpreprocess, backendsupport, backendconvert
-import RWSDebug, Version
+import Version
checkVersion :: VersionsCompatability *File -> (!Bool, !*File)
checkVersion VersionsAreCompatible errorFile
@@ -22,8 +22,8 @@ checkVersion VersionObservedIsTooOld errorFile
= fwrites "[Backend] the back end library is too old\n" errorFile
= (False, errorFile)
-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
+backEndInterface :: !{#Char} [{#Char}] !ListTypesOption !{#Char} !PredefinedSymbols !FrontEndSyntaxTree !Int !*VarHeap !*AttrVarHeap !*File !*Files -> (!Bool, !*VarHeap, !*AttrVarHeap, !*File, !*Files)
+backEndInterface outputFileName commandLineArgs listTypes typesPath predef_symbols syntaxTree=:{fe_icl,fe_components,fe_dcls} main_dcl_module_n var_heap attrHeap errorFile files
# (observedCurrent, observedOldestDefinition, observedOldestImplementation)
= BEGetVersion
observedVersion =
@@ -61,6 +61,342 @@ backEndInterface outputFileName commandLineArgs predef_symbols syntaxTree=:{fe_i
= backEndConvertModules predef_symbols syntaxTree main_dcl_module_n varHeap attrHeap backEnd
# (success, backEnd)
= BEGenerateCode outputFileName backEnd
+ # backEnd
+ = BECloseFiles backEnd
+ # (attrHeap, files, backEnd)
+ // FIXME: should be type file
+ = optionallyPrintFunctionTypes listTypes typesPath (DictionaryToClassInfo main_dcl_module_n fe_icl fe_dcls) fe_components fe_icl.icl_functions attrHeap files backEnd
# backEndFiles
= BEFree backEnd backEndFiles
= (backEndFiles == 0 && success, var_heap, attrHeap, errorFile, files)
+import typesupport
+
+optionallyPrintFunctionTypes :: ListTypesOption {#Char} DictionaryToClassInfo {!Group} {#FunDef} *AttrVarHeap *Files !*BackEnd -> (*AttrVarHeap, *Files, *BackEnd)
+optionallyPrintFunctionTypes {lto_listTypesKind, lto_showAttributes} typesPath info components functions attrHeap files backEnd
+ | lto_listTypesKind == ListTypesStrictExports || lto_listTypesKind == ListTypesAll
+ # (opened, typesFile, files)
+ = fopen typesPath FAppendText files
+ | not opened
+ = abort ("couldn't open types file \"" +++ typesPath +++ "\"\n")
+ # (attrHeap, typesFile, backEnd)
+ = printFunctionTypes (lto_listTypesKind == ListTypesAll) lto_showAttributes info components functions attrHeap typesFile backEnd
+ # (closed, files)
+ = fclose typesFile files
+ | not closed
+ = abort ("couldn't close types file \"" +++ typesPath +++ "\"\n")
+ = (attrHeap, files, backEnd)
+ // otherwise
+ = (attrHeap, files, backEnd)
+
+printFunctionTypes :: Bool Bool DictionaryToClassInfo {!Group} {#FunDef} *AttrVarHeap *File *BackEnd -> (*AttrVarHeap, *File, *BackEnd)
+printFunctionTypes all attr info components functions attrHeap file backEnd
+ = foldSt (printFunctionType all attr info) [(index, functions.[index]) \\ (_, index) <- functionIndices] (attrHeap, file, backEnd)
+ where
+ functionIndices
+ = flatten [[(componentIndex, member) \\ member <- group.group_members] \\ group <-: components & componentIndex <- [1..]]
+
+printFunctionType :: Bool Bool DictionaryToClassInfo (Int, FunDef) (*AttrVarHeap, *File, *BackEnd) -> (*AttrVarHeap, *File, *BackEnd)
+printFunctionType all attr info (functionIndex, {fun_symb,fun_type=Yes type}) (attrHeap, file, backEnd)
+ | not all && functionIndex > size info.dtic_dclModules.[info.dtci_iclModuleIndex].dcl_functions
+ = (attrHeap, file, backEnd)
+ # (strictnessAdded, type, backEnd)
+ = addStrictnessFromBackEnd functionIndex fun_symb.id_name backEnd type
+ | not strictnessAdded && not all
+ = (attrHeap, file, backEnd)
+ // FIXME: shouldn't have to repair the invariant here
+ # (type, attrHeap)
+ = collectSymbolTypeAttrVars type attrHeap
+ # type
+ = dictionariesToClasses info type
+ # (type, attrHeap)
+ = beautifulizeAttributes type attrHeap
+ # file
+ = file <<< fun_symb <<< " :: "
+ <:: ({ form_properties = (if attr cAttributed 0) bitor cAnnotated, form_attr_position = No }, type, Yes initialTypeVarBeautifulizer) <<< '\n'
+ = (attrHeap, file, backEnd)
+
+addStrictnessFromBackEnd :: Int {#Char} *BackEnd SymbolType -> (Bool, SymbolType, *BackEnd)
+addStrictnessFromBackEnd functionIndex functionName backEnd type
+ # (bitSize, strictPositionsC, backEnd)
+ = BEStrictPositions functionIndex backEnd
+ | bitSize == 0 // short cut
+ = (False, type, backEnd)
+ # strictPositions
+ = copyInts ((bitSize+31)/32) strictPositionsC // assumes 32 bit ints
+ # strictnessInfo
+ = {si_robust_encoding = False, si_positions = strictPositions, si_size = bitSize, si_name = functionName}
+ offset
+ = 0
+ # (robust, offset)
+ = nextBit strictnessInfo offset
+ strictnessInfo
+ = {strictnessInfo & si_robust_encoding = robust}
+ # (anyStrictnessAdded, offset)
+ = nextBit strictnessInfo offset
+ # (type, offset)
+ = addStrictness strictnessInfo type offset
+ # type
+ = checkFinalOffset strictnessInfo offset type
+ = (anyStrictnessAdded, type, backEnd)
+
+:: StrictnessInfo =
+ { si_size :: !Int
+ , si_positions :: !LargeBitvect
+ , si_name :: {#Char}
+ , si_robust_encoding :: !Bool
+ }
+
+class addStrictness a :: !StrictnessInfo !a Int -> (!a, !Int)
+
+nextBit :: StrictnessInfo Int -> (Bool, Int)
+nextBit {si_size, si_positions, si_robust_encoding} offset
+ | offset < si_size
+ = (bitvectSelect offset si_positions, offset+1)
+ // otherwise
+ | si_robust_encoding
+ = abort "backendinterface, nextBit: bit vector too small"
+ // otherwise
+ = (False, offset)
+
+checkStrictness :: StrictnessInfo Bool Int -> Int
+checkStrictness info=:{si_robust_encoding} wasStrict offset
+ | si_robust_encoding
+ # (bit, offset)
+ = nextBit info offset
+ | bit <> wasStrict
+ = abort "backendinterface, checkStrictness: wrong info for strictness annotation"
+ = offset
+ // otherwise
+ = offset
+
+checkType :: StrictnessInfo Bool Int -> Int
+checkType info=:{si_robust_encoding} isTuple offset
+ | si_robust_encoding
+ # (bit, offset)
+ = nextBit info offset
+ | bit <> isTuple
+ = abort "backendinterface, checkType: wrong type"
+ = offset
+ // otherwise
+ = offset
+
+checkFinalOffset :: StrictnessInfo Int a -> a
+checkFinalOffset info=:{si_size, si_robust_encoding} offset value
+ | offset < si_size || (si_robust_encoding && offset > si_size)
+ = abort "backendinterface, checkFinalOffset: wrong offset"
+ // otherwise
+ = value
+
+instance addStrictness SymbolType where
+ addStrictness strictPositions=:{si_size} args offset
+ | offset >= si_size // short cut
+ = (args, offset)
+ addStrictness strictPositions type=:{st_args} offset
+ # (st_args, offset)
+ = addStrictness strictPositions st_args offset
+ = ({type & st_args = st_args}, offset)
+
+instance addStrictness [a] | addStrictness a where
+ addStrictness strictPositions l offset
+ = mapSt (addStrictness strictPositions) l offset
+
+instance addStrictness AType where
+ addStrictness strictPositions arg=:{at_annotation, at_type} offset
+ # (at_annotation, offset)
+ = addStrictness strictPositions at_annotation offset
+ # (at_type, offset)
+ = addStrictnessToType strictPositions (at_annotation == AN_Strict) at_type offset
+ = ({arg & at_annotation = at_annotation, at_type = at_type}, offset)
+
+instance addStrictness Annotation where
+ addStrictness info annotation offset
+ # offset
+ = checkStrictness info wasStrict offset
+ # (strictAdded, offset)
+ = nextBit info offset
+ | strictAdded
+ | wasStrict
+ = abort "backendinterface, addStrictness: already strict"
+ // otherwise
+ = (AN_Strict, offset)
+ // otherwise
+ = (annotation, offset)
+ where
+ wasStrict
+ = annotation == AN_Strict
+
+addStrictnessToType :: StrictnessInfo Bool Type Int -> (Type, Int)
+addStrictnessToType strictPositions isStrict type=:(TA ident=:{type_name,type_arity} args) offset
+ # offset
+ = checkType strictPositions isTuple offset
+ | isTuple && isStrict
+ # (args, offset)
+ = addStrictness strictPositions args offset
+ = (TA ident args, offset)
+ // otherwise
+ = (type, offset)
+ where
+ // FIXME: don't match on name but use predef info
+ isTuple
+ = type_name.id_name == "_Tuple" +++ toString type_arity
+addStrictnessToType strictPositions _ type offset
+ # offset
+ = checkType strictPositions False offset
+ = (type, offset)
+
+collectSymbolTypeAttrVars :: SymbolType *AttrVarHeap -> (SymbolType, *AttrVarHeap)
+collectSymbolTypeAttrVars type=:{st_attr_vars, st_result, st_args} attrVarHeap
+ # attrVarHeap
+ = foldSt markAttrVarCollected st_attr_vars attrVarHeap
+ # (st_attr_vars, attrVarHeap)
+ = collectAttrVars st_result (collectAttrVars st_args (st_attr_vars, attrVarHeap))
+ = ({type & st_attr_vars = st_attr_vars}, attrVarHeap)
+
+/* maybe should collect st_vars as well (these are not used currently) */
+class collectAttrVars a :: a ([AttributeVar], *AttrVarHeap) -> ([AttributeVar], *AttrVarHeap)
+
+instance collectAttrVars AType where
+ collectAttrVars {at_attribute, at_type} collect
+ = collectAttrVars at_attribute (collectAttrVars at_type collect)
+
+instance collectAttrVars TypeAttribute where
+ collectAttrVars (TA_Var attrVar) collect
+ = collectAttrVars attrVar collect
+ collectAttrVars (TA_RootVar attrVar) collect
+ = collectAttrVars attrVar collect
+ collectAttrVars (TA_List _ attribute) collect
+ = collectAttrVars attribute collect
+ collectAttrVars (TA_Locked attribute) collect
+ = collectAttrVars attribute collect
+ collectAttrVars _ collect
+ = collect
+
+instance collectAttrVars Type where
+ collectAttrVars (TA _ types) collect
+ = collectAttrVars types collect
+ collectAttrVars (type1 --> type2) collect
+ = collectAttrVars type1 (collectAttrVars type2 collect)
+ collectAttrVars (TArrow1 type) collect
+ = collectAttrVars type collect
+ collectAttrVars (_ :@: types) collect
+ = collectAttrVars types collect
+ collectAttrVars (TFA _ type) collect
+ = collectAttrVars type collect
+ collectAttrVars _ collect
+ = collect
+
+instance collectAttrVars AttributeVar where
+ collectAttrVars attrVar=:{av_info_ptr} (attrVars, attrVarHeap)
+ # (info, attrVarHeap)
+ = readPtr av_info_ptr attrVarHeap
+ = case info of
+ AVI_Collected
+ -> (attrVars, attrVarHeap)
+ _
+ -> ([attrVar : attrVars], markAttrVarCollected attrVar attrVarHeap)
+
+instance collectAttrVars [a] | collectAttrVars a where
+ collectAttrVars l collect
+ = foldSt collectAttrVars l collect
+
+markAttrVarCollected :: AttributeVar *AttrVarHeap -> *AttrVarHeap
+markAttrVarCollected {av_info_ptr} attrVarHeap
+ = writePtr av_info_ptr AVI_Collected attrVarHeap
+
+:: DictionaryToClassInfo =
+ { dtci_iclModuleIndex :: Int
+ , dtci_iclModule :: IclModule
+ , dtic_dclModules :: {#DclModule}
+ }
+
+DictionaryToClassInfo iclModuleIndex iclModule dclModules :==
+ { dtci_iclModuleIndex = iclModuleIndex
+ , dtci_iclModule = iclModule
+ , dtic_dclModules = dclModules
+ }
+
+dictionariesToClasses :: DictionaryToClassInfo SymbolType -> SymbolType
+dictionariesToClasses info type=:{st_args, st_arity, st_context=[]}
+ # (reversedTypes, reversedContexts)
+ = dictionaryArgsToClasses info st_args ([], [])
+ = {type & st_args = reverse reversedTypes, st_context = reverse reversedContexts,
+ st_arity = st_arity - length reversedContexts}
+
+dictionaryArgsToClasses :: DictionaryToClassInfo [AType] ([AType], [TypeContext]) -> ([AType], [TypeContext])
+dictionaryArgsToClasses info args result
+ = foldSt (dictionaryArgToClass info) args result
+
+dictionaryArgToClass :: DictionaryToClassInfo AType ([AType], [TypeContext]) -> ([AType], [TypeContext])
+dictionaryArgToClass info type=:{at_type=TA typeSymbol args} (reversedTypes, reversedContexts)
+ = case typeToClass info typeSymbol of
+ Yes klass
+ -> (reversedTypes, [context : reversedContexts])
+ with
+ context
+ = {tc_class = klass, tc_types = [at_type \\ {at_type} <- args], tc_var = nilPtr}
+ No
+ -> ([type : reversedTypes], reversedContexts)
+dictionaryArgToClass _ type (reversedTypes, reversedContexts)
+ = ([type : reversedTypes], reversedContexts)
+
+typeToClass :: DictionaryToClassInfo TypeSymbIdent -> Optional (Global DefinedSymbol)
+typeToClass info {type_name, type_arity, type_index={glob_module, glob_object}}
+ = case typeIndexToClassIndex info glob_module glob_object of
+ Yes classIndex
+ -> Yes {glob_module=glob_module, glob_object = {ds_ident = type_name, ds_arity = type_arity, ds_index = glob_object}}
+ No
+ -> No
+ where
+ /*
+ This how the types are organised (#classes == #dictionaries)
+
+ com_classes
+ +--------(1)-------+--------(2)-------+
+ | dcl classes | icl classes |
+ +------------------+------------------+
+ nDclClasses nIclClasses
+
+ com_type_defs
+ +-----------+--------(1)-------+-----------+--------(2)-------+
+ | dcl types | dcl dictionaries | icl types | icl dictionaries |
+ +-----------+------------------+-----------+------------------+
+ nDclTypes nIclTypes
+ */
+ typeIndexToClassIndex :: DictionaryToClassInfo Int Int -> Optional Int
+ typeIndexToClassIndex {dtci_iclModuleIndex, dtci_iclModule, dtic_dclModules} moduleIndex typeIndex
+ | moduleIndex <> dtci_iclModuleIndex || typeIndex < nDclTypes
+ = toClassIndex typeIndex nDclTypes nDclClasses 0
+ // otherwise
+ = toClassIndex (typeIndex-nDclTypes) (nIclTypes-nDclTypes) (nIclClasses-nDclClasses) nDclClasses
+ where
+ dclModule
+ = dtic_dclModules.[moduleIndex]
+ nDclTypes
+ = size dclModule.dcl_common.com_type_defs
+ nDclClasses
+ = size dclModule.dcl_common.com_class_defs
+ nIclTypes
+ = size dtci_iclModule.icl_common.com_type_defs
+ nIclClasses
+ = size dtci_iclModule.icl_common.com_class_defs
+
+ toClassIndex :: Int Int Int Int -> Optional Int
+ toClassIndex typeIndex nTypes nClasses offset
+ | classIndex < 0
+ = No
+ // otherwise
+ = Yes (classIndex + offset)
+ where
+ classIndex
+ = typeIndex - (nTypes - nClasses)
+
+copyInts :: !Int !Int -> {#Int}
+copyInts length cArray
+ = code {
+ push_b 0
+ create_array_ INT 0 1
+
+ push_a 0
+ ccall BECopyInts "IIA-I"
+ pop_b 1
+ }
diff --git a/backendC/CleanCompilerSources/backend.c b/backendC/CleanCompilerSources/backend.c
index c375a1d..74e2b3b 100644
--- a/backendC/CleanCompilerSources/backend.c
+++ b/backendC/CleanCompilerSources/backend.c
@@ -731,6 +731,7 @@ BESpecialArrayFunctionSymbol (BEArrayFunKind arrayFunKind, int functionIndex, in
newTypeAlt->type_alt_lhs = BENormalTypeNode (newFunctionSymbol, lhsArgs);
newTypeAlt->type_alt_rhs = rhs;
+ newTypeAlt->type_alt_strict_positions = NULL;
newIdent->ident_symbol = newFunctionSymbol;
newIdent->ident_name = functionName;
@@ -820,6 +821,7 @@ CreateLocallyDefinedFunction (int index, char ** abcCode, TypeArgs lhsArgs, Type
typeAlt->type_alt_attr_equations = NULL; /* used in PrintType */
typeAlt->type_alt_lhs = BENormalTypeNode (functionSymbol, lhsArgs);
typeAlt->type_alt_rhs = rhsType;
+ typeAlt->type_alt_strict_positions = NULL;
BERule (functionIndex, BEIsNotACaf, typeAlt, ruleAlt);
@@ -1509,6 +1511,7 @@ BETypeAlt (BETypeNodeP lhs, BETypeNodeP rhs, BEUniVarEquations attributeEquation
alt->type_alt_type_context = NULL; /* used in PrintType */
alt->type_alt_attr_equations = attributeEquations; /* used in PrintType */
+ alt->type_alt_strict_positions = NULL;
return (alt);
} /* BETypeAlt */
@@ -3381,6 +3384,57 @@ BEExportFunction (int dclFunctionIndex, int iclFunctionIndex)
dclDef->sdef_dcl_icl = iclDef;
} /* BEExportFunction */
+void
+BEStrictPositions (int functionIndex, int *bits, int **positions)
+{
+ BEModuleP module;
+ SymbolP functionSymbol;
+ SymbDef functionDefinition;
+ ImpRules rule;
+ TypeAlts ruleType;
+ StrictPositionsP strict_positions;
+
+ Assert ((unsigned int) main_dcl_module_n < gBEState.be_nModules);
+ module = &gBEState.be_modules [main_dcl_module_n];
+
+ Assert ((unsigned int) functionIndex < module->bem_nFunctions);
+ functionSymbol = &module->bem_functions [functionIndex];
+
+ Assert (functionSymbol->symb_kind == definition);
+ functionDefinition = functionSymbol->symb_def;
+
+ Assert (functionDefinition->sdef_kind == IMPRULE);
+ rule = functionDefinition->sdef_rule;
+
+ ruleType = rule->rule_type;
+ Assert (ruleType != NULL);
+
+ strict_positions = ruleType->type_alt_strict_positions;
+
+ Assert (strict_positions != NULL);
+
+ *bits = strict_positions->sp_size;
+ *positions = strict_positions->sp_bits;
+} /* BEStrictPositions */
+
+int
+BECopyInts (int cLength, int *ints, int *cleanArray)
+{
+ int cleanLength, truncate;
+
+ cleanLength = cleanArray [-2];
+
+ truncate = cleanLength < cLength;
+ if (truncate)
+ cLength = cleanLength;
+
+ memcpy (cleanArray, ints, cLength * sizeof (int));
+
+ Assert (!truncate);
+
+ return (!truncate);
+} /* BECopyInts */
+
static void
CheckBEEnumTypes (void)
{
@@ -3623,6 +3677,17 @@ BEInit (int argc)
} /* BEInit */
void
+BECloseFiles (void)
+{
+ if (StdErrorReopened)
+ fclose (StdError);
+ StdErrorReopened = False;
+ if (StdOutReopened)
+ fclose (StdOut);
+ StdOutReopened = False;
+} /* BECloseFiles */
+
+void
BEFree (BackEnd backEnd)
{
Assert (backEnd == (BackEnd) &gBEState);
@@ -3633,10 +3698,7 @@ BEFree (BackEnd backEnd)
Assert (gBEState.be_initialised);
gBEState.be_initialised = False;
- if (StdErrorReopened)
- fclose (StdError);
- if (StdOutReopened)
- fclose (StdOut);
+ BECloseFiles ();
} /* BEFree */
// temporary hack
diff --git a/backendC/CleanCompilerSources/backend.h b/backendC/CleanCompilerSources/backend.h
index 8f80be5..d690ce8 100644
--- a/backendC/CleanCompilerSources/backend.h
+++ b/backendC/CleanCompilerSources/backend.h
@@ -1,7 +1,7 @@
/* version info */
// increment this for every release
-# define kBEVersionCurrent 0x02000215
+# define kBEVersionCurrent 0x02000216
// change this to the same value as kBEVersionCurrent if the new release is
// not upward compatible (for example when a function is added)
@@ -9,7 +9,7 @@
// 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 kBEVersionOldestImplementation 0x02000216
# define kBEDebug 1
@@ -178,6 +178,9 @@ Clean (BEGetVersion :: (Int, Int, Int))
BackEnd BEInit (int argc);
Clean (BEInit :: Int UWorld -> (BackEnd, UWorld))
+void BECloseFiles (void);
+Clean (BECloseFiles :: BackEnd -> BackEnd)
+
void BEFree (BackEnd backEnd);
Clean (BEFree :: BackEnd UWorld -> UWorld)
@@ -541,6 +544,11 @@ Clean (BEDefineImportedObjsAndLibs :: BEStringListP BEStringListP BackEnd -> Bac
void BESetMainDclModuleN (int main_dcl_module_n_parameter);
Clean (BESetMainDclModuleN :: Int BackEnd -> BackEnd)
+void BEStrictPositions (int functionIndex, int *bits, int **positions);
+Clean (BEStrictPositions :: Int BackEnd -> (Int, Int, BackEnd))
+
+int BECopyInts (int cLength, int *ints, int *cleanArray);
+
// temporary hack
void BEDeclareDynamicTypeSymbol (int typeIndex, int moduleIndex);
Clean (BEDeclareDynamicTypeSymbol :: Int Int BackEnd -> BackEnd)
diff --git a/backendC/CleanCompilerSources/sa.c b/backendC/CleanCompilerSources/sa.c
index 4a75d97..ea8deab 100644
--- a/backendC/CleanCompilerSources/sa.c
+++ b/backendC/CleanCompilerSources/sa.c
@@ -2849,50 +2849,182 @@ static void ConvertStateInfoToStrictInfos (TypeAlts rule_type_alts, unsigned ari
InitStrictInfo (result, HnfStrict);
}
-static void UpdateStateInfoWithStrictInfo (TypeNode node, StrictInfo *s,Bool *strict_added_p,Bool *warning)
+#if CLEAN2
+
+/*
+ Encoding for strictness information:
+
+ The strictness information that is found by the strictness
+ analyser is encoded in a bit string. There are two encodings
+
+ compact (but fragile):
+ 0 a (s)* trailing zeros are removed
+
+ robust (but long):
+ 1 a (w s t)*
+
+ a any strictness added
+ ()* repeated for each argument position, recursively
+ for strict (after sa) tuples
+ w argument was strict
+ s argument strictness added
+ t argument is tuple
+
+ Example:
+ f :: ! a ( a, [a]) -> a // before sa
+ f :: ! a ! ( ! a, [a]) -> a // after sa
+
+ compact 0 1 0 1 1 0 => 01011 (trailing zeros removed)
+
+ robust 1 1 100 011 010 000 => 11100011010000
+
+ The bit string is represented by a bit count and an array of
+ ints (each 32 bits), where the least significant bit of an int
+ is the first bit in the bit string.
+*/
+
+#define StrictPositionsRobustEncoding 1
+
+#define kMaxStrictPositions 1024
+
+#if StrictPositionsRobustEncoding
+# define kBitsPerStrictPosition 3
+#else
+# define kBitsPerStrictPosition 1
+# endif
+
+#define kMaxStrictBits (2+kMaxStrictPositions*kBitsPerStrictPosition)
+#define kBitsPerInt (sizeof (int)*8)
+#define ceilingdiv(a, b) (((a)+(b)-1)/(b)) /* ceiling (a/b) */
+#define bits2ints(n) ceilingdiv(n, kBitsPerInt)
+
+static int strict_positions_last_one;
+static StrictPositionsP strict_positions;
+
+
+static void StrictPositionsClear (void)
{
- Bool is_strict_annotated;
-#ifndef SHOW_STRICT_EXPORTED_TUPLE_ELEMENTS
- Bool local_strict_added;
+ int i, sizeInts;
+
+ if (strict_positions == NULL)
+ {
+ int sizeBytes;
- local_strict_added = False;
+ sizeInts = bits2ints(kMaxStrictPositions);
+ sizeBytes = sizeof (StrictPositionsS) + (sizeInts-1) * sizeof (int);
+ strict_positions = CompAlloc (sizeBytes);
+
+ strict_positions->sp_size = 0;
+ }
+
+ sizeInts = bits2ints (strict_positions->sp_size);
+ for (i = 0; i < sizeInts; i++)
+ strict_positions->sp_bits[i] = 0;
+
+ strict_positions->sp_size = 0;
+ strict_positions_last_one = 0;
+}
+
+static void StrictPositionsAddBit (Bool bit)
+{
+ int size;
+ StrictPositionsP positions;
+
+ positions = strict_positions;
+ size = positions->sp_size;
+
+ if (bit)
+ {
+ Assume (size < kMaxStrictPositions, "too many strict positions", "AddStrictPositions");
+
+ positions->sp_bits [size/kBitsPerInt] |= 1 << (size % kBitsPerInt);
+ strict_positions_last_one = size+1;
+ }
+
+ positions->sp_size = size+1;
+}
+
+
+static StrictPositionsP StrictPositionsCopy (void)
+{
+ StrictPositionsP positions;
+ int sizeBits;
+
+#if StrictPositionsRobustEncoding
+ sizeBits = strict_positions->sp_size;
+#else
+ sizeBits = strict_positions_last_one;
#endif
+ Assume (size < kMaxStrictPositions, "too many strict positions", "StrictPositionsToInts");
+
+ if (sizeBits == 0)
+ {
+ static StrictPositionsS no_strict_postions = {0, {0}};
+
+ positions = &no_strict_postions;
+ }
+ else
+ {
+ int sizeInts, sizeBytes;
+
+ sizeInts = bits2ints(sizeBits);
+ sizeBytes = sizeof (StrictPositionsS) + (sizeInts-1) * sizeof (int);
+ positions = CompAlloc (sizeBytes);
+ memcpy (positions, strict_positions, sizeBytes);
+ }
+
+ return positions;
+}
+
+#define StrictPositionsStrictAdded(is_strict) StrictPositionsAddBit (is_strict)
+
+#if StrictPositionsRobustEncoding
+# define StrictPositionsWasStrict(is_strict_annotated) StrictPositionsAddBit (is_strict_annotated)
+# define StrictPositionsType(is_tuple) StrictPositionsAddBit (is_tuple)
+#else
+# define StrictPositionsWasStrict(is_strict_annotated)
+# define StrictPositionsType(is_tuple)
+#endif
+
+#endif /* CLEAN2 */
+
+static void UpdateStateInfoWithStrictInfo (TypeNode node, StrictInfo *s,Bool *strict_added_p,Bool *warning)
+{
+ Bool is_strict_annotated, is_strict, is_tuple, strict_added;
+
is_strict_annotated = node->type_node_annotation==StrictAnnot;
-
- if (IsTupleInfo (s)){
+ is_tuple = IsTupleInfo (s);
+ is_strict = (is_tuple ? GetTupleStrictKind (s) : GetStrictKind (s, 0)) != NotStrict;
+ strict_added = !is_strict_annotated && is_strict;
+
+#if CLEAN2
+ StrictPositionsWasStrict (is_strict_annotated);
+ StrictPositionsStrictAdded (strict_added);
+ StrictPositionsType (is_tuple);
+#endif
+
+ if (strict_added) {
+ node->type_node_annotation=StrictAnnot;
+ *strict_added_p = True;
+ }
+
+ if (is_strict_annotated && !is_strict && StrictChecks)
+ *warning = True;
+
+ if (is_tuple && (is_strict || is_strict_annotated)){
unsigned arity = s->strict_arity;
unsigned i;
TypeArgs args = node->type_node_arguments;
-
- if (GetTupleStrictKind (s) == NotStrict){
- if (StrictChecks && is_strict_annotated)
- *warning = True;
- return;
- }
-
- if (! is_strict_annotated){
- node->type_node_annotation=StrictAnnot;
- *strict_added_p = True;
- }
-
- for (i = 0; i < arity; i++, args = args->type_arg_next)
-#ifdef SHOW_STRICT_EXPORTED_TUPLE_ELEMENTS
- UpdateStateInfoWithStrictInfo (args->type_arg_node,&GetTupleInfo (s,i),strict_added_p,warning);
-#else
- UpdateStateInfoWithStrictInfo (args->type_arg_node,&GetTupleInfo (s,i),&local_strict_added,warning);
-#endif
- } else {
-#if 0
- printf ("%d %d %d\n",GetStrictKind (s, 0),GetStrictKind (s, 1),GetStrictKind (s, 2));
+
+ for (i = 0; i < arity; i++, args = args->type_arg_next) {
+#ifndef SHOW_STRICT_EXPORTED_TUPLE_ELEMENTS
+ Bool local_strict_added;
+
+ local_strict_added = False;
+ strict_added_p = &local_strict_added;
#endif
- if (GetStrictKind (s, 0) != NotStrict){
- if (!is_strict_annotated){
- node->type_node_annotation=StrictAnnot;
- *strict_added_p = True;
- }
- } else if (StrictChecks && GetStrictKind (s, 0) == NotStrict && is_strict_annotated){
- *warning = True;
+ UpdateStateInfoWithStrictInfo (args->type_arg_node,&GetTupleInfo (s,i),strict_added_p,warning);
}
}
}
@@ -2908,8 +3040,26 @@ static void UpdateStateInfosWithStrictInfos (TypeAlts rule, unsigned arity, Stri
/* do the arguments */
args = rule->type_alt_lhs->type_node_arguments;
- for (i = 0; i < arity; i++, args = args->type_arg_next)
+#if CLEAN2
+ StrictPositionsClear ();
+ StrictPositionsAddBit (StrictPositionsRobustEncoding);
+ StrictPositionsAddBit (False);
+#endif
+
+ for (i = 0; i < arity; i++, args = args->type_arg_next) {
UpdateStateInfoWithStrictInfo (args->type_arg_node,&strict_args[i], strict_added, warning);
+ }
+
+#if CLEAN2
+ if (*strict_added)
+ {
+ Assume (strict_positions->sp_size > 2, "not enough bits", "UpdateStateInfosWithStrictInfos");
+ Assume (strict_positions_last_one > 2, "not enough bits", "UpdateStateInfosWithStrictInfos");
+ strict_positions->sp_bits [0] |= 1 << 1;
+ }
+
+ rule->type_alt_strict_positions = StrictPositionsCopy ();
+#endif
/* the result has no sense at the moment */
}
diff --git a/backendC/CleanCompilerSources/syntax_tree_types.h b/backendC/CleanCompilerSources/syntax_tree_types.h
index ad6cebc..24e1987 100644
--- a/backendC/CleanCompilerSources/syntax_tree_types.h
+++ b/backendC/CleanCompilerSources/syntax_tree_types.h
@@ -427,16 +427,26 @@ typedef struct uni_var_equats
struct uni_var_equats * uve_next;
} * UniVarEquations;
+#if CLEAN2
+STRUCT (strict_positions, StrictPositions)
+{
+ int sp_size; /* size in bits */
+ int sp_bits [1]; /* variable size */
+};
+#endif
+
typedef struct type_alt
{
TypeNode type_alt_lhs;
TypeNode type_alt_rhs;
UniVarEquations type_alt_attr_equations;
TypeContext type_alt_type_context;
-
struct uni_var_admin * type_alt_attr_vars;
unsigned type_alt_line;
+#ifdef CLEAN2
+ StrictPositionsP type_alt_strict_positions;
+#endif
} TypeAlt;
typedef struct cons_var_list
diff --git a/backendC/backend.link b/backendC/backend.link
index 1363626..9c3498d 100644
--- a/backendC/backend.link
+++ b/backendC/backend.link
@@ -1,5 +1,6 @@
/EXPORT: BEGetVersion
/EXPORT: BEInit
+/EXPORT: BECloseFiles
/EXPORT: BEFree
/EXPORT: BEArg
/EXPORT: BEDeclareModules
@@ -119,5 +120,7 @@
/EXPORT: BEExportFunction
/EXPORT: BEDefineImportedObjsAndLibs
/EXPORT: BESetMainDclModuleN
+/EXPORT: BEStrictPositions
+/EXPORT: BECopyInts
/EXPORT: BEDeclareDynamicTypeSymbol
/EXPORT: BEDynamicTempTypeSymbol
diff --git a/backendC/backend.rc b/backendC/backend.rc
index 16b1c8f..489cd59 100644
--- a/backendC/backend.rc
+++ b/backendC/backend.rc
@@ -14,7 +14,7 @@
# define kFileFlags VS_FF_DEBUG | VS_FF_PRERELEASE
# define kFileFlagsMask VS_FF_DEBUG | VS_FF_PRERELEASE
-# define kFileVersionString "2.0.d.12"
+# define kFileVersionString "2.0.d.16"
VS_VERSION_INFO VERSIONINFO
FILEVERSION kFileVersion
diff --git a/coclmaindll/backend.dll b/coclmaindll/backend.dll
index 352a89c..5d6e544 100644
--- a/coclmaindll/backend.dll
+++ b/coclmaindll/backend.dll
Binary files differ
diff --git a/frontend/frontend.dcl b/frontend/frontend.dcl
index 2810e58..4b23a06 100644
--- a/frontend/frontend.dcl
+++ b/frontend/frontend.dcl
@@ -28,5 +28,12 @@ import checksupport, transform, overloading
| FrontEndPhaseConvertModules
| FrontEndPhaseAll
+:: ListTypesKind = ListTypesNone | ListTypesInferred | ListTypesStrictExports | ListTypesAll
+:: ListTypesOption =
+ { lto_showAttributes :: Bool
+ , lto_listTypesKind :: ListTypesKind
+ }
+instance == ListTypesKind
+
frontEndInterface :: !FrontEndOptions !Ident !SearchPaths !{#DclModule} !*{#*{#FunDef}} !(Optional Bool) !*PredefinedSymbols !*HashTable (ModTimeFunction *Files) !*Files !*File !*File !*File (!Optional !*File) !*Heaps
-> ( !Optional *FrontEndSyntaxTree,!*{#*{#FunDef}},!{#DclModule},!Int,!Int,!*PredefinedSymbols, !*HashTable, !*Files, !*File, !*File, !*File, !Optional !*File, !*Heaps)
diff --git a/frontend/frontend.icl b/frontend/frontend.icl
index 2c5fe9a..d2c4a3d 100644
--- a/frontend/frontend.icl
+++ b/frontend/frontend.icl
@@ -396,4 +396,21 @@ where
show_dcl_function {ft_symb, ft_type} file
= file <<< ft_symb <<< " :: " <<< ft_type <<< "\n"
+
+:: ListTypesKind = ListTypesNone | ListTypesInferred | ListTypesStrictExports | ListTypesAll
+:: ListTypesOption =
+ { lto_showAttributes :: Bool
+ , lto_listTypesKind :: ListTypesKind
+ }
+instance == ListTypesKind where
+ (==) ListTypesNone ListTypesNone
+ = True
+ (==) ListTypesInferred ListTypesInferred
+ = True
+ (==) ListTypesStrictExports ListTypesStrictExports
+ = True
+ (==) ListTypesAll ListTypesAll
+ = True
+ (==) _ _
+ = False
\ No newline at end of file
diff --git a/frontend/syntax.dcl b/frontend/syntax.dcl
index 32fc53e..1669b95 100644
--- a/frontend/syntax.dcl
+++ b/frontend/syntax.dcl
@@ -909,6 +909,7 @@ cNonRecursiveAppl :== False
| AVI_Used
| AVI_Count !Int /* auxiliary used in module typesupport */
| AVI_SequenceNumber !Int // RWS
+ | AVI_Collected // RWS
:: AttrVarInfoPtr :== Ptr AttrVarInfo
:: AttrVarHeap :== Heap AttrVarInfo
diff --git a/frontend/syntax.icl b/frontend/syntax.icl
index e60a9c3..0d4957e 100644
--- a/frontend/syntax.icl
+++ b/frontend/syntax.icl
@@ -888,6 +888,7 @@ cNotVarNumber :== -1
| AVI_Used
| AVI_Count !Int /* auxiliary used in module typesupport */
| AVI_SequenceNumber !Int // RWS
+ | AVI_Collected // RWS
:: AttrVarInfoPtr :== Ptr AttrVarInfo
:: AttrVarHeap :== Heap AttrVarInfo
diff --git a/main/compile.icl b/main/compile.icl
index bd114d6..2a4b557 100644
--- a/main/compile.icl
+++ b/main/compile.icl
@@ -1,3 +1,6 @@
+/*
+ module owner: Ronny Wichers Schreur
+*/
implementation module compile
import StdEnv
@@ -8,6 +11,7 @@ import portToNewSyntax
import compilerSwitches
//import RWSDebug
+
:: CoclOptions =
{ moduleName:: {#Char}
, pathName ::{#Char}
@@ -16,6 +20,7 @@ import compilerSwitches
, outPath:: {#Char}
, outMode:: Int
, searchPaths:: SearchPaths
+ , listTypes :: ListTypesOption
, compile_for_dynamics :: !Bool
, support_generics :: !Bool
, compile_with_fusion :: !Bool
@@ -30,6 +35,7 @@ InitialCoclOptions =
, outPath= "out"
, outMode= FWriteText
, searchPaths= {sp_locations = [], sp_paths = []}
+ , listTypes = {lto_showAttributes = True, lto_listTypesKind = ListTypesNone}
, compile_for_dynamics = False
, support_generics = False
, compile_with_fusion = False
@@ -90,6 +96,14 @@ parseCommandLine [arg1=:"-fusion":args] options
parseCommandLine ["-generics":args] options
// enable generics
= parseCommandLine args (SwitchGenerics {options & compile_with_generics = True} options)
+parseCommandLine ["-lattr":args] options
+ = parseCommandLine args {options & listTypes.lto_showAttributes = False}
+parseCommandLine ["-lt":args] options
+ = parseCommandLine args {options & listTypes.lto_listTypesKind = ListTypesInferred}
+parseCommandLine ["-lset":args] options
+ = parseCommandLine args {options & listTypes.lto_listTypesKind = ListTypesStrictExports}
+parseCommandLine ["-lat":args] options
+ = parseCommandLine args {options & listTypes.lto_listTypesKind = ListTypesAll}
parseCommandLine [arg : args] options
| arg.[0] == '-'
# (args,modules,options)= parseCommandLine args options
@@ -159,19 +173,14 @@ compile_modules [module_:modules] n_compiles cocl_options args_without_modules c
# (ok,cache,files)
= compileModule cocl_options (args_without_modules++[module_]) cache files;
| ok
-/*
- # heaps = { hp_var_heap = newHeap, hp_expression_heap = newHeap, hp_type_heaps = { th_vars = newHeap, th_attrs = newHeap }}
- # (predef_symbols, hash_table) = buildPredefinedSymbols newHashTable
- = compile_modules modules 0 cocl_options args_without_modules {} {} predef_symbols hash_table heaps files;
-*/
= compile_modules modules (n_compiles+1) cocl_options args_without_modules cache files;
-
+ // otherwise
= (ok,cache,files);
compile_modules [] n_compiles cocl_options args_without_modules cache files
= (True,cache,files);
compileModule :: CoclOptions [{#Char}] *DclCache *Files -> (!Bool,!*DclCache,!*Files)
-compileModule options commandLineArgs {dcl_modules,functions_and_macros,predef_symbols,hash_table,heaps} files
+compileModule options backendArgs {dcl_modules,functions_and_macros,predef_symbols,hash_table,heaps} files
# (opened, error, files)
= fopen options.errorPath options.errorMode files
| not opened
@@ -184,9 +193,11 @@ compileModule options commandLineArgs {dcl_modules,functions_and_macros,predef_s
= openTclFile options options.pathName files
# (io, files)
= stdio files
-// (moduleIdent, hash_table) = putIdentInHashTable options.moduleName IC_Module hash_table
# ({boxed_ident=moduleIdent}, hash_table) = putIdentInHashTable options.moduleName IC_Module hash_table
- # list_inferred_types = if (isMember "-lt" commandLineArgs) (Yes (not (isMember "-lattr" commandLineArgs))) No
+ # list_inferred_types
+ = if (options.listTypes.lto_listTypesKind == ListTypesInferred)
+ (Yes options.listTypes.lto_showAttributes)
+ No
# (optionalSyntaxTree,cached_functions_and_macros,cached_dcl_mods,n_functions_and_macros_in_dcl_modules,main_dcl_module_n,predef_symbols, hash_table, files, error, io, out,tcl_file,heaps)
= frontEndInterface {feo_up_to_phase=FrontEndPhaseAll,feo_generics=options.compile_with_generics,feo_fusion=options.compile_with_fusion} moduleIdent options.searchPaths dcl_modules functions_and_macros list_inferred_types predef_symbols hash_table fmodificationtime files error io out tcl_file heaps
# unique_copy_of_predef_symbols={predef_symbol\\predef_symbol<-:predef_symbols}
@@ -220,7 +231,7 @@ compileModule options commandLineArgs {dcl_modules,functions_and_macros,predef_s
<<< options.moduleName <<< '\n')
error
# (success, var_heap, attrHeap, error, files)
- = backEndInterface outputPath (map appendRedirection commandLineArgs) predef_symbols syntaxTree main_dcl_module_n var_heap attrHeap error files
+ = backEndInterface outputPath (map appendRedirection backendArgs) options.listTypes options.outPath predef_symbols syntaxTree main_dcl_module_n var_heap attrHeap error files
-> (success,functions_and_macros,n_functions_and_macros_in_dcl_modules,var_heap,attrHeap, error, files)
with
appendRedirection arg
generated by cgit v1.2.3 (git 2.39.1) at 2025-03-15 00:44:49 +0000