handle constructor with strict arguments (for Clean 1.3.3)

git-svn-id: https://svn.cs.ru.nl/repos/clean-compiler/trunk@66 1f8540f1-abd5-4d5b-9d24-4c5ce8603e2d

4 files changed, 67 insertions, 55 deletions

diff --git a/frontend/Debug.icl b/frontend/Debug.icl
index 75092ad..1b1ae0a 100644
--- a/frontend/Debug.icl
+++ b/frontend/Debug.icl
@@ -44,7 +44,7 @@ debugValue show value
 
 debugShow :: DebugShowFunction .a
 debugShow
-	=	\debugValue -> ShowWrapped (Wrap debugValue) ++ ["\n"]
+	=	\debugValue -> showWrapped (wrapNode debugValue) ++ ["\n"]
 
 
 :: DebugOptionRecord
@@ -63,7 +63,7 @@ MaxInt
 
 debugShowWithOptions :: [DebugShowOption] -> DebugShowFunction .a
 debugShowWithOptions debugOptions 
-	=	\debug -> chop maxChars (ShowWrapped (pruneWrappedNode maxDepth maxBreadth (Wrap debug))) ++ [terminator]
+	=	\debug -> chop maxChars (showWrapped (pruneWrappedNode maxDepth maxBreadth (wrapNode debug))) ++ [terminator]
 	where
 		{maxDepth, maxBreadth, maxChars, terminator}
 			=	set debugOptions DebugDefaultOptions
@@ -88,9 +88,9 @@ MaxCharsString
 MaxBreadthString
 	:== "..."
 MaxBreadthIndicator
-	:==	Wrap ...
+	:==	wrapNode ...
 MaxDepthIndicator
-	:==	Wrap .+.
+	:==	wrapNode .+.
 
 pruneWrappedNode :: !Int !Int !WrappedNode -> !WrappedNode
 pruneWrappedNode maxDepth maxBreadth value
@@ -137,9 +137,9 @@ pruneWrappedNode maxDepth maxBreadth value
 		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]})
+				=	WrappedArray (pruneArray depth {wrapNode e \\ e <-: a & i <- [0 .. maxBreadth]})
 			// otherwise
-				=	WrappedArray {Wrap e \\ e <-: a}
+				=	WrappedArray {wrapNode e \\ e <-: a}
 
 chop :: !Int ![{#Char}] -> [{#Char}]
 chop _ []
diff --git a/frontend/RWSDebug.icl b/frontend/RWSDebug.icl
index 9d7639d..98c5ed9 100644
--- a/frontend/RWSDebug.icl
+++ b/frontend/RWSDebug.icl
@@ -2,8 +2,8 @@ implementation module RWSDebug
 
 import Debug
 
-show
-	=	debugShowWithOptions [] // [DebugMaxChars 80, DebugMaxDepth 5]
+show x
+	=	debugShowWithOptions [DebugMaxChars 80, DebugMaxDepth 5] x
 
 (->>) :: !.a !.b -> .a
 (->>) value debugValue
diff --git a/frontend/ShowWrapped.dcl b/frontend/ShowWrapped.dcl
index 3bcc251..1801f91 100644
--- a/frontend/ShowWrapped.dcl
+++ b/frontend/ShowWrapped.dcl
@@ -2,4 +2,4 @@ definition module ShowWrapped
 
 from Wrap import WrappedNode
 
-ShowWrapped :: WrappedNode -> [{#Char}]
\ No newline at end of file
+showWrapped :: WrappedNode -> [{#Char}]
\ No newline at end of file
diff --git a/frontend/ShowWrapped.icl b/frontend/ShowWrapped.icl
index 82b72a1..7254b40 100644
--- a/frontend/ShowWrapped.icl
+++ b/frontend/ShowWrapped.icl
@@ -3,78 +3,90 @@ implementation module ShowWrapped
 import StdEnv
 import Wrap
 
-ShowWrapped :: WrappedNode -> [{#Char}]
-ShowWrapped node
-	=	Show False node
+ShowParentheses
+	:==	True
+Don`tShowParentheses
+	:==	False
 
-Show _ (WrappedInt i)
+showWrapped :: WrappedNode -> [{#Char}]
+showWrapped node
+	=	show Don`tShowParentheses node
+
+show :: Bool WrappedNode -> [{#Char}]
+show _ (WrappedInt i)
 	=	[toString i]
-Show _ (WrappedChar c)
+show _ (WrappedChar c)
 	=	["\'" +++ toString c +++ "\'"]
-Show _ (WrappedBool b)
+show _ (WrappedBool b)
 	=	[toString b]
-Show _ (WrappedReal r)
+show _ (WrappedReal r)
 	=	[toString r]
-Show _ (WrappedFile f)
-	=	[toString f]
-Show _ (WrappedString s)
+show _ (WrappedFile _)
+	=	["File"]
+show _ (WrappedString s)
 	=	["\"" +++ s +++ "\""]
-Show _ (WrappedIntArray a)
-	=	ShowBasicArray a
-Show _ (WrappedBoolArray a)
-	=	ShowBasicArray a
-Show _ (WrappedRealArray a)
-	=	ShowBasicArray a
-Show _ (WrappedFileArray a)
-	=	ShowBasicArray a
-Show _ (WrappedArray a)
-	=	["{" : flatten (Separate [", "] [Show False el \\ el <-: a])] ++ ["}"]
-Show _ (WrappedRecord descriptor args)
-	=	["{" : flatten (Separate [" "] [[ShowDescriptor descriptor] : [Show True arg \\ arg <-: args]])] ++ ["}"]
-Show _ (WrappedOther WrappedDescriptorCons args)
+show _ (WrappedIntArray a)
+	=	showBasicArray a
+show _ (WrappedBoolArray a)
+	=	showBasicArray a
+show _ (WrappedRealArray a)
+	=	showBasicArray a
+show _ (WrappedFileArray a)
+	=	showBasicArray a
+show _ (WrappedArray a)
+	=	["{" : flatten (separate [", "] [show Don`tShowParentheses el \\ el <-: a])] ++ ["}"]
+show _ (WrappedRecord descriptor args)
+	=	["{" : flatten (separate [" "] [[showDescriptor descriptor] : [show ShowParentheses arg \\ arg <-: args]])] ++ ["}"]
+show _ (WrappedOther WrappedDescriptorCons args)
 	| size args == 2
-	=	["[" : flatten [Show False args.[0] : ShowTail args.[1]]] ++ ["]"]
+		=	["[" : flatten [show Don`tShowParentheses args.[0] : showTail args.[1]]] ++ ["]"]
 	where
-		ShowTail (WrappedOther WrappedDescriptorCons args)
+		showTail :: WrappedNode -> [[{#Char}]]
+		showTail (WrappedOther WrappedDescriptorCons args)
 			| size args == 2
-				=	[[", "], Show False args.[0] : ShowTail args.[1]]
-		ShowTail (WrappedOther WrappedDescriptorNil args)
+				=	[[", "], show Don`tShowParentheses args.[0] : showTail args.[1]]
+		showTail (WrappedOther WrappedDescriptorNil args)
 			| size args == 0
 				=	[]
-		ShowTail graph // abnormal list
-			=	[[" : " : Show False graph]]
-Show _ (WrappedOther WrappedDescriptorTuple args)
-	=	["(" : flatten (Separate [", "] [Show False arg \\ arg <-: args])] ++ [")"]
-Show pars (WrappedOther descriptor args)
-	| pars && size args > 0
+		showTail node // abnormal list
+			=	[[" : " : show Don`tShowParentheses node]]
+show _ (WrappedOther WrappedDescriptorTuple args)
+	=	["(" : flatten (separate [", "] [show Don`tShowParentheses arg \\ arg <-: args])] ++ [")"]
+show parentheses (WrappedOther descriptor args)
+	| parentheses && size args > 0
 		=	["(" : application] ++ [")"]
 	// otherwise
 		=	application
 	where
 		application
-			=	flatten (Separate [" "] [[ShowDescriptor descriptor] : [Show True arg \\ arg <-: args]])
+			=	flatten (separate [" "] [[showDescriptor descriptor] : [show ShowParentheses arg \\ arg <-: args]])
 
-ShowDescriptor (WrappedDescriptorOther id)
+showDescriptor :: WrappedDescriptor -> {#Char}
+showDescriptor (WrappedDescriptorOther id)
 	=	toString id
-ShowDescriptor WrappedDescriptorNil
+showDescriptor WrappedDescriptorNil
 	=	"[]"
-ShowDescriptor WrappedDescriptorCons
+showDescriptor WrappedDescriptorCons
 	=	"[:]"
-ShowDescriptor WrappedDescriptorTuple
+showDescriptor WrappedDescriptorTuple
 	=	"(..)"
 
-ShowBasicArray a
-	=	["{" : Separate ", " [toString el \\ el <-: a]] ++ ["}"]
-ShowWrappedArray a
-	=	["{" : flatten (Separate [", "] [Show False el \\ el <-: a])] ++ ["}"]
+showBasicArray :: {#a} -> [{#Char}] | toString, ArrayElem a
+showBasicArray a
+	=	["{" : separate ", " [toString el \\ el <-: a]] ++ ["}"]
+
+showWrappedArray :: {WrappedNode} -> [{#Char}]
+showWrappedArray a
+	=	["{" : flatten (separate [", "] [show Don`tShowParentheses el \\ el <-: a])] ++ ["}"]
 
-Separate :: a [a] -> [a]
-Separate separator [a : t=:[b : _]]
-	=	[a, separator : Separate separator t]
-Separate _ l
+separate :: a [a] -> [a]
+separate separator [a : t=:[b : _]]
+	=	[a, separator : separate separator t]
+separate _ l
 	=	l
 
 instance toString File
 where
+	toString :: File -> {#Char}
 	toString _
 		=	"File"