1 files changed, 173 insertions, 0 deletions
diff --git a/frontend/Debug.icl b/frontend/Debug.icl
new file mode 100644
index 0000000..75092ad
--- /dev/null
+++ b/frontend/Debug.icl
@@ -0,0 +1,173 @@
+implementation module Debug
+
+import StdArray, StdEnum
+from StdFile	import <<<, ferror, stderr
+from StdMisc	import abort
+from StdTuple	import fst
+from StdList	import ++
+from StdBool	import && 
+from StdString	import %
+
+import	Wrap, ShowWrapped
+
+print :: ![{#Char}] .b -> .b
+print debugStrings value
+	| fst (ferror (stderr <<< debugStrings))
+		=	abort "Debug, print: couldn't write to stderr"
+	// otherwise
+		=	value
+
+debugBefore :: !.a !(DebugShowFunction .a) .b -> .b
+debugBefore debugValue show value
+	=	print (show debugValue) value
+
+debugAfter :: !.a !(DebugShowFunction .a) !.b -> .b
+debugAfter debugValue show value
+	=	print (show debugValue) value
+
+debugValue :: !(DebugShowFunction .a) !.a -> .a
+debugValue show value
+	=	print (show copy1) copy2
+	where
+		(copy1, copy2)
+			=	copyUniqueValue value
+
+		copyUniqueValue :: !.a -> (!.a, !.a)
+		copyUniqueValue value
+			=	code {
+				.o 1 0
+					push_a	0				
+				.d 2 0
+				}
+
+:: DebugShowFunction a :== !a -> [{#Char}]
+
+debugShow :: DebugShowFunction .a
+debugShow
+	=	\debugValue -> ShowWrapped (Wrap debugValue) ++ ["\n"]
+
+
+:: DebugOptionRecord
+	=	{maxDepth :: !Int, maxBreadth :: !Int, maxChars :: !Int, terminator :: !{#Char}}
+DebugDefaultOptions
+	:== {maxDepth = MaxInt, maxBreadth = MaxInt, maxChars = MaxInt, terminator = "\n"}
+
+MaxInt
+	:== (1<<31)-1
+
+:: DebugShowOption 
+	=	DebugMaxDepth !Int			// default MaxInt
+	|	DebugMaxBreadth !Int		// default MaxInt
+	|	DebugMaxChars !Int			// default MaxInt
+	|	DebugTerminator !{#Char}	// default "\n"
+
+debugShowWithOptions :: [DebugShowOption] -> DebugShowFunction .a
+debugShowWithOptions debugOptions 
+	=	\debug -> chop maxChars (ShowWrapped (pruneWrappedNode maxDepth maxBreadth (Wrap debug))) ++ [terminator]
+	where
+		{maxDepth, maxBreadth, maxChars, terminator}
+			=	set debugOptions DebugDefaultOptions
+			where
+				set [] options
+					=	options
+				set [DebugMaxDepth maxDepth:t] options
+					=	set t {options & maxDepth=maxDepth}
+				set [DebugMaxBreadth maxBreadth:t] options
+					=	set t {options & maxBreadth=maxBreadth}
+				set [DebugMaxChars maxChars:t] options
+					=	set t {options & maxChars=maxChars}
+				set [DebugTerminator terminator:t] options
+					=	set t {options & terminator=terminator}
+
+:: Indicators
+	=	...
+	|	.+.
+
+MaxCharsString
+	:== ".."
+MaxBreadthString
+	:== "..."
+MaxBreadthIndicator
+	:==	Wrap ...
+MaxDepthIndicator
+	:==	Wrap .+.
+
+pruneWrappedNode :: !Int !Int !WrappedNode -> !WrappedNode
+pruneWrappedNode maxDepth maxBreadth value
+	=	prune 0 value
+	where
+		prune :: !Int WrappedNode -> WrappedNode
+		prune depth value
+			| depth == maxDepth
+				=	MaxDepthIndicator
+		prune depth (WrappedIntArray a)
+			=	pruneBasicArray depth a
+		prune depth (WrappedBoolArray a)
+			=	pruneBasicArray depth a
+		prune depth (WrappedRealArray a)
+			=	pruneBasicArray depth a
+		prune depth (WrappedFileArray a)
+			=	pruneBasicArray depth a
+		prune depth (WrappedString a)
+			| size a > maxBreadth
+				=	WrappedString ((a % (0, maxBreadth-1)) +++ MaxBreadthString)
+		prune depth (WrappedArray a)
+			=	WrappedArray (pruneArray depth a)
+		prune depth (WrappedRecord descriptor args)
+			=	WrappedRecord descriptor (pruneArray depth args)
+		prune depth (WrappedOther WrappedDescriptorCons args)
+			| size args == 2
+				=	WrappedOther WrappedDescriptorCons
+						{prune (depth+1) args.[0], prune depth args.[1]}
+		prune depth (WrappedOther WrappedDescriptorTuple args)
+			=	WrappedOther WrappedDescriptorTuple (pruneArray depth args)
+		prune depth (WrappedOther descriptor args)
+			=	WrappedOther descriptor (pruneArray depth args)
+		prune _ a
+			=	a
+
+		pruneArray :: !Int !{WrappedNode} -> {WrappedNode}
+		pruneArray depth a
+			| size a > maxBreadth
+				=	{{prune (depth+1) e \\ e <-: a & i <- [0 .. maxBreadth]}
+						& [maxBreadth] = MaxBreadthIndicator}
+			// otherwise
+				=	{prune (depth+1) e \\ e <-: a}
+
+		pruneBasicArray :: !Int !(a b) -> WrappedNode | Array .a & ArrayElem b
+		pruneBasicArray depth a
+			| size a > maxBreadth
+				=	WrappedArray (pruneArray depth {Wrap e \\ e <-: a & i <- [0 .. maxBreadth]})
+			// otherwise
+				=	WrappedArray {Wrap e \\ e <-: a}
+
+chop :: !Int ![{#Char}] -> [{#Char}]
+chop _ []
+	=	[]
+chop maxSize list=:[string:strings]
+	| maxSize < stringSize + sizeMaxCharsString
+		| fits maxSize list
+			=	list
+		| stringSize > sizeMaxCharsString
+			=	[string % (0, maxSize-sizeMaxCharsString-1), MaxCharsString]
+		// otherwise
+			=	[MaxCharsString]
+	// otherwise
+		=	[string : chop (maxSize - stringSize) strings]
+	where
+		fits _ []
+			=	True
+		fits maxSize [h : t]
+			=	maxSize >= size h && fits (maxSize - size h) t
+
+		stringSize
+			=	size string
+		sizeMaxCharsString
+			=	size MaxCharsString
+
+instance <<< [a] | <<< a where
+	(<<<) :: *File [a] -> *File | <<< a
+	(<<<) file []
+		=	file
+	(<<<) file [h:t]
+		=	file <<< h <<< t