Initial import

backend/Clean System Files/backend_library

+backend.dll
+BEInit
+BEFree
+BEFunctionSymbol
+BELiteralSymbol
+BEVarTypeNode
+BENormalTypeNode
+BENoTypeArgs
+BETypeArgs
+BETypeAlt
+BENormalNode
+BEIfNode
+BENoArgs
+BEArgs
+BERuleAlt
+BERuleAlts
+BENoRuleAlts
+BENoRules
+BERules
+BEDeclareFunction
+BEDefineRules
+BEGenerateCode
+BEBasicSymbol
+BEDeclareNodeId
+BENodeIdNode
+BENodeId
+BEConstructorSymbol
+BETypeSymbol
+BEPredefineConstructorSymbol
+BEPredefineTypeSymbol
+BENodeDef
+BENoNodeDefs
+BENodeDefs
+BERule
+BEAlgebraicType
+BEConstructor
+BEConstructors
+BEDeclareConstructor
+BEFlatType
+BEDeclareType
+BENoTypeVars
+BENoConstructors
+BENoTypes
+BETypeVars
+BETypeVar
+BETypes
+BEAnnotateTypeNode
+BEDeclarePredefinedModule
+BEDontCareDefinitionSymbol
+BEDeclareRuleType
+BEDefineRuleType
+BEDeclareModules
+BEDeclareIclModule
+BEDeclareDclModule
+BEDeclareField
+BEFieldSymbol
+BEField
+BEFields
+BENoFields
+BESelectorNode
+BERecordType
+BEBoolSymbol
+BEAbcCodeBlock
+BECodeAlt
+BEString
+BEStrings
+BENoStrings
+BEArg
+BEWildCardNodeId
+BEAdjustArrayFunction
+BEGuardNode
+BENoStrictNodeIds
+BEStrictNodeId
+BEStrictNodeIds
+BEExportType
+BEExportConstructor
+BEExportField
+BEExportFunction
+BECodeParameter
+BECodeParameters
+BENoCodeParameters
+BEAnyCodeBlock
+BETupleSelectNode
+BEMatchNode
+BEAttributeTypeNode
+BESpecialArrayFunctionSymbol
+BEUpdateNode
+BEDefineImportedObjsAndLibs
+BEDeclarePredefinedSymbols
+BEDictionarySelectFunSymbol
+BEDictionaryUpdateFunSymbol
+BEGetVersion
\ No newline at end of file

backend/backendconvert.dcl

+definition module backendconvert
+
+from backend import BackEnd
+import frontend
+
+backEndConvertModules :: PredefinedSymbols FrontEndSyntaxTree VarHeap *BackEnd -> *BackEnd

backend/backendinterface.dcl

+definition module backendinterface
+
+import frontend
+
+backEndInterface :: !{#Char} [{#Char}] !PredefinedSymbols !*FrontEndSyntaxTree !*File !*Files -> (!Bool, !*File, !*Files)

backend/backendinterface.icl

+implementation module backendinterface
+
+import StdEnv
+
+import frontend
+import backend
+import backendpreprocess, backendsupport, backendconvert
+import RWSDebug, Version
+
+checkVersion :: VersionsCompatability *File -> (!Bool, !*File)
+checkVersion VersionsAreCompatible errorFile
+	=	(True, errorFile)
+checkVersion VersionObservedIsTooNew errorFile
+	#	errorFile
+			=	fwrites "[Backend] the backend library is too new\n" errorFile
+	=	(False, errorFile)
+checkVersion VersionObservedIsTooOld errorFile
+	#	errorFile
+			=	fwrites "[Backend] the backend library is too old\n" errorFile
+	=	(False, errorFile)
+
+backEndInterface :: !{#Char} [{#Char}] !PredefinedSymbols !*FrontEndSyntaxTree !*File !*Files -> (!Bool, !*File, !*Files)
+backEndInterface outputFileName commandLineArgs predefs syntaxTree errorFile files
+	# (observedCurrent, observedOldestDefinition, observedOldestImplementation)
+		=	BEGetVersion
+	  observedVersion =
+		{	versionCurrent
+				=	observedCurrent
+		,	versionOldestDefinition
+				=	observedOldestDefinition
+		,	versionOldestImplementation
+				=	observedOldestImplementation
+		}
+	  expectedVersion =
+		{	versionCurrent
+				=	kBEVersionCurrent
+		,	versionOldestDefinition
+				=	kBEVersionOldestDefinition
+		,	versionOldestImplementation
+				=	kBEVersionOldestImplementation
+		}
+	# (compatible, errorFile)
+		=	checkVersion (versionCompare expectedVersion observedVersion) errorFile
+	| not compatible
+		=	(False, errorFile, files)
+	# varHeap
+		=	backendPreprocess functionIndices syntaxTree.fe_icl syntaxTree.fe_varHeap
+		with
+			functionIndices
+				=	flatten [[member \\ member <- group.group_members] \\ group <-: syntaxTree.fe_components]
+	  syntaxTree
+		=	{syntaxTree & fe_varHeap = varHeap}
+	# backEndFiles
+		=	0
+	# (backEnd, backEndFiles)
+		=	BEInit (length commandLineArgs) backEndFiles
+	# backEnd
+		=	foldState BEArg commandLineArgs backEnd
+	# backEnd
+		=	backEndConvertModules predefs syntaxTree varHeap backEnd
+	# (success, backEnd)
+		=	BEGenerateCode outputFileName backEnd
+	# backEndFiles
+		=	BEFree backEnd backEndFiles
+	=	(backEndFiles == 0 && success, errorFile, files)

backend/backendpreprocess.dcl

+definition module backendpreprocess
+
+import checksupport
+
+// assign sequence numbers to all variables in the syntax tree
+
+backendPreprocess :: ![Index] !IclModule !*VarHeap -> *VarHeap

backend/backendpreprocess.icl

+implementation module backendpreprocess
+
+// assign sequence numbers to all variables in the syntax tree
+
+import checksupport
+import Heap
+import backendsupport
+import RWSDebug
+
+backendPreprocess :: ![Index] !IclModule !*VarHeap -> *VarHeap
+backendPreprocess functionIndices iclModule varHeap
+	=	preprocess [iclModule.icl_functions.[i] \\ i <- functionIndices] varHeap
+
+class preprocess a :: a -> Preprocessor
+:: Preprocessor
+	:==	*PreprocessState -> *PreprocessState
+:: PreprocessState
+	:==	VarHeap
+
+instance preprocess {#a} | preprocess a & ArrayElem a where
+	preprocess array
+		=	foldStateA preprocess array
+
+instance preprocess [a] | preprocess a where
+	preprocess list
+		=	foldState preprocess list
+
+// +++ this assigns sequence numbers per function, should be per alternative and move to backendconvert
+instance preprocess FunDef where
+	preprocess funDef
+		=	fromSequencerToPreprocessor (sequence funDef.fun_body)
+
+class sequence a :: a -> Sequencer
+:: Sequencer
+	:== *SequenceState -> *SequenceState
+:: SequenceState
+	=	{ss_sequenceNumber :: !Int, ss_varHeap :: .VarHeap}
+
+toSequenceState varHeap
+	:==	{ss_sequenceNumber = 0, ss_varHeap = varHeap}
+fromSequenceState sequenceState
+	:==	sequenceState.ss_varHeap
+
+fromSequencerToPreprocessor sequencer
+	:==	toSequenceState
+	o`	sequencer
+	o`	fromSequenceState
+
+assignSequenceNumber varInfoPtr sequenceState
+	:==	{	sequenceState
+		&	ss_varHeap = writePtr varInfoPtr (VI_SequenceNumber sequenceState.ss_sequenceNumber) sequenceState.ss_varHeap
+		,	ss_sequenceNumber = sequenceState.ss_sequenceNumber + 1
+		}
+
+instance sequence [a] | sequence a where
+	sequence list
+		=	foldState sequence list
+
+instance sequence (Optional a) | sequence a where
+	sequence (Yes x)
+		=	sequence x
+	sequence No
+		=	identity
+
+// +++ this assigns sequence numbers per function, should be per alternative and moved to backendconvert
+instance sequence FunctionBody where
+	sequence (BackendBody backEndBodies)
+		=	sequence backEndBodies
+	sequence body
+		=	abort "preprocess (FunctionBody): unknown body" <<- body
+
+instance sequence BackendBody where
+	sequence body
+		=	sequence body.bb_args
+		o`	sequence body.bb_rhs
+
+instance sequence FreeVar where
+	sequence freeVar
+		=	sequence freeVar.fv_info_ptr
+
+instance sequence Expression where
+	sequence (Let {let_strict_binds, let_lazy_binds, let_expr})
+		=	sequence let_strict_binds
+		o`	sequence let_lazy_binds
+		o`	sequence let_expr
+	sequence (Conditional {if_then, if_else})
+		=	sequence if_then
+		o`	sequence if_else
+	sequence (App {app_args})
+		=	sequence app_args
+	sequence (f @ arg)
+		=	sequence f
+		o`	sequence arg
+	sequence (Selection _ exp selections)
+		=	sequence exp
+		o`	sequence selections
+	sequence (AnyCodeExpr _ outParams _)
+		=	sequence outParams
+	sequence _
+		=	identity
+
+instance sequence Selection where
+	sequence (RecordSelection _ _)
+		=	identity
+	sequence (ArraySelection _ _ index)
+		=	sequence index
+	sequence (DictionarySelection dictionaryVar dictionarySelections _ index)
+		=	sequence index
+
+instance sequence (Bind a b) | sequence b where
+	sequence bind
+		=	sequence bind.bind_dst
+
+instance sequence FunctionPattern where
+	sequence (FP_Algebraic _ subpatterns optionalVar)
+		=	sequence subpatterns
+		o`	sequence optionalVar
+	sequence (FP_Variable freeVar)
+		=	sequence freeVar
+	sequence (FP_Basic _ optionalVar)
+		=	sequence optionalVar
+	sequence FP_Empty
+		=	identity
+
+instance sequence (Ptr VarInfo) where
+	sequence varInfoPtr
+		=	assignSequenceNumber varInfoPtr

backend/backendsupport.dcl

+definition module backendsupport
+
+from StdArray import size, size_u
+from StdFunc import `bind`
+from StdInt import +, ==
+
+import utilities
+
+identity
+	:==	\x -> x
+
+// binding sugar
+(==>) infix
+(==>) f g
+	:== f `bind` g
+
+// o` :== flip o
+(o`) infixr
+(o`) f g
+	:==	\x -> g (f x)
+
+(:-) infixl
+(:-) a f
+	:== f a
+
+
+foldState function list
+	:== foldState list
+	where
+		foldState []
+			=	identity
+		foldState [hd:tl]
+			=	function hd
+			o`	foldState tl
+
+foldStateA function array
+	:== foldStateA 0
+	where
+		arraySize
+			=	size array
+		foldStateA index
+			| index == arraySize
+				=	identity
+			// otherwise
+				=	function array.[index]
+				o`	foldStateA (index+1)
+
+foldStateWithIndexA function array
+	:== foldStateWithIndexA 0
+	where
+		arraySize
+			=	size array
+		foldStateWithIndexA index
+			| index == arraySize
+				=	identity
+			// otherwise
+				=	function index array.[index]
+				o`	foldStateWithIndexA (index+1)
+
+foldrA function result array
+	:== foldrA result 0
+	where
+		arraySize
+			=	size array
+		foldrA result index
+			| index == arraySize
+				=	result
+			// otherwise
+				=	function array.[index] (foldrA result (index+1))

backend/backendsupport.icl

+implementation module backendsupport
+
+from StdArray import size, size_u
+from StdFunc import `bind`
+from StdInt import +, ==
+
+identity
+	:==	\x -> x
+
+// binding sugar
+(==>) infix
+(==>) f g
+	:== f `bind` g
+
+// o` :== flip o
+(o`) infixr
+(o`) f g
+	:==	\x -> g (f x)
+
+(:-) infixl
+(:-) a f
+	:== f a
+
+foldState function list
+	:== foldState list
+	where
+		foldState []
+			=	identity
+		foldState [hd:tl]
+			=	function hd
+			o`	foldState tl
+
+foldStateA function array
+	:== foldStateA 0
+	where
+		arraySize
+			=	size array
+		foldStateA index
+			| index == arraySize
+				=	identity
+			// otherwise
+				=	function array.[index]
+				o`	foldStateA (index+1)
+
+foldStateWithIndexA function array
+	:== foldStateWithIndexA 0
+	where
+		arraySize
+			=	size array
+		foldStateWithIndexA index
+			| index == arraySize
+				=	identity
+			// otherwise
+				=	function index array.[index]
+				o`	foldStateWithIndexA (index+1)
+
+foldrA function result array
+	:== foldrA result 0
+	where
+		arraySize
+			=	size array
+		foldrA result index
+			| index == arraySize
+				=	result
+			// otherwise
+				=	function array.[index] (foldrA result (index+1))