Skip to content
GitLab
Projects
Groups
Snippets
/
Help
Help
Support
Community forum
Keyboard shortcuts
?
Submit feedback
Contribute to GitLab
Sign in
Toggle navigation
Menu
Open sidebar
clean-and-itasks
clean-libraries
Commits
d5ba91c0
Commit
d5ba91c0
authored
Feb 22, 2000
by
Ronny Wichers Schreur
🏢
Browse files
Initial import
parent
84d706db
Changes
11
Hide whitespace changes
Inline
Side-by-side
libraries/WrapDebug/Examples.icl
0 → 100644
View file @
d5ba91c0
module
Examples
import
StdEnv
/*
these examples use Ronny's syntax (->>, <<- and <<->>)
and options (see RWSDebug.icl)
*/
import
RWSDebug
// choose your example here
Start
=
example1
/*
a <<- b (debugBefore)
print b, then evaluate a
*/
example1
=
abort
"example1 value
\n
"
<<-
"example1 debug"
/*
a ->> b (debugAfter)
evaluate a, then print b
*/
example2
=
abort
"example2 value
\n
"
->>
"example2 debug"
/*
<<->> a (debugValue)
print and evaluate a, value can be unique
*/
example3
=
<<->>
"example3"
/*
debugging also works with infinity values (provided you
limit the debug output with the DebugMax... options)
*/
example4
=
"example4"
<<-
[
1
..]
/*
debugging with algebraic values
*/
::
List
a
=
Nil
|
Cons
a
(
List
a
)
example5
=
"example5"
<<-
Cons
1
(
Cons
2
Nil
)
/*
debugging with a record value, note that the field names
don't appear in the debug output (this information isn't
available at run-time)
*/
::
R
=
{
f1
::
Int
,
f2
::
Int
}
example6
=
"example6"
<<-
{
f1
=
1
,
f2
=
2
}
/*
debugging with arrays
*/
example7
=
"example7"
<<-
{
1
,
2
,
3
,
4
,
5
}
/*
debugging with closures
*/
example8
=
"example8"
<<-
(
take
,
take
5
,
take
5
[
'Brubek'
])
/*
debugging may evaluate values that wouldn't otherwise
be evaluated
*/
example9
=
hd
(<<->>
[
"example9"
:
undef
])
/*
debugging may effect strictness, in this example f is not
strict in its first argument because of the debug function
*/
example10
=
f
"example"
"10"
where
f
a
b
=
(
a
<<-
"f"
)
+++
b
/*
debugging depends on the evalution order, you'll have to
understand the evalution order to understand in which order
the debug values will be printed
*/
example11
=
fst
(
concatFirstTwo
[
"exam"
,
"ple11"
])
where
concatFirstTwo
=
(
get
->>
"get first"
)
`
bind`
\
first
->
(
get
->>
"get second"
)
`
bind`
\
second
->
return
(
first
+++
second
)
->>
"return"
get
[
h
:
t
]
=
(
h
,
t
)
libraries/WrapDebug/README.txt
0 → 100644
View file @
d5ba91c0
WrapDebug
Version 1.0
Ronny Wichers Schreur
ronny@cs.kun.nl
The WrapDebug package lets you print arbitrary expressions for debugging
purposes. The main functions are in ShowDebug.
FILES
README
This file
ShowDebug.dcl, ShowDebug.icl
Debug functions (uses Wrap and ShowWrapped)
Wrap.dcl, Wrap.icl
Wrap Clean nodes
ShowWrapped.dcl, ShowWrapped.icl
Convert a wrapped node to a list of strings
RWSDebug.dcl, RWSDebug.icl
Syntax and options I use for debugging (uses ShowDebug)
Examples.icl
Some examples with explanations
libraries/WrapDebug/RWSDebug.dcl
0 → 100644
View file @
d5ba91c0
definition
module
RWSDebug
(->>)
::
!.
a
!.
b
->
.
a
(<<-)
::
.
a
!.
b
->
.
a
<<->>
::
!.
a
->
.
a
\ No newline at end of file
libraries/WrapDebug/RWSDebug.icl
0 → 100644
View file @
d5ba91c0
implementation
module
RWSDebug
import
Debug
show
x
=
debugShowWithOptions
[
DebugMaxChars
80
,
DebugMaxDepth
5
]
(->>)
::
!.
a
!.
b
->
.
a
(->>)
value
debugValue
=
debugAfter
debugValue
show
value
(<<-)
::
.
a
!.
b
->
.
a
(<<-)
value
debugValue
=
debugBefore
debugValue
show
value
<<->>
::
!.
a
->
.
a
<<->>
value
=
debugValue
show
value
libraries/WrapDebug/RWSDebug2.icl
0 → 100644
View file @
d5ba91c0
implementation
module
RWSDebug
import
ShowDebug
show
::
DebugShowFunction
.
a
show
=
debugShow
[
DebugMaxChars
79
,
DebugMaxDepth
5
,
DebugMaxBreadth
20
]
class
(<<-)
infix
0
a
::
.
a
!
b
->
.
a
class
(->>)
infix
0
a
::
!.
a
!
b
->
.
a
class
<<->>
a
::
!.
a
->
.
a
instance
<<-
a
where
(<<-)
value
debugValue
=
debugBefore
debugValue
show
value
instance
->>
a
where
(->>)
value
debugValue
=
debugAfter
debugValue
show
value
instance
<<->>
a
where
<<->>
value
=
debugValue
show
value
instance
<<-
(
a
->
b
)
|
<<-
b
where
(<<-)
f
debugValue
=
\
a
->
(
f
a
<<-
debugValue
)
instance
->>
(
a
->
b
)
|
->>
b
where
(->>)
f
debugValue
=
\
a
->
(
f
a
->>
debugValue
)
instance
<<->>
(
a
->
b
)
|
<<->>
b
where
<<->>
f
=
\
a
->
<<->>
(
f
a
)
libraries/WrapDebug/ShowDebug.dcl
0 → 100644
View file @
d5ba91c0
/*
Debug functions.
Version 1.0
Ronny Wichers Schreur
ronny@cs.kun.nl
*/
definition
module
ShowDebug
::
DebugShowFunction
a
:==
a
->
[{#
Char
}]
// print (show a), then evaluate b
debugBefore
::
!.
a
!(
DebugShowFunction
.
a
)
.
b
->
.
b
// evaluate b, then print (show a)
debugAfter
::
.
a
!(
DebugShowFunction
.
a
)
!.
b
->
.
b
// evaluate and print (show a)
debugValue
::
!(
DebugShowFunction
.
a
)
!.
a
->
.
a
// generic show function
debugShow
::
[
DebugShowOption
]
.
a
->
[{#
Char
}]
::
DebugShowOption
=
DebugMaxDepth
!
Int
// default no limit
|
DebugMaxBreadth
!
Int
// default no limit
|
DebugMaxChars
!
Int
// default no limit
|
DebugTerminator
!{#
Char
}
// default "\n"
libraries/WrapDebug/ShowDebug.icl
0 → 100644
View file @
d5ba91c0
/*
Debug functions.
Version 1.0
Ronny Wichers Schreur
ronny@cs.kun.nl
*/
implementation
module
ShowDebug
import
StdEnv
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
// copying a unique reference is OK here, because after the show
// reference1 is no longer in use and show shouldn't change anything
=
print
(
show
reference1
)
reference2
where
(
reference1
,
reference2
)
=
copyUniqueReference
value
copyUniqueReference
::
!.
a
->
(!.
a
,
!.
a
)
copyUniqueReference
value
=
code {
.o
1
0
push_a
0
.d
2
0
}
::
DebugShowFunction
a
:==
a
->
[{#
Char
}]
::
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"
(:-)
infixl
(:-)
a
f
:==
f
a
debugShow
::
[
DebugShowOption
]
.
a
->
[{#
Char
}]
debugShow
debugOptions
debugValue
=
debugValue
:-
wrapNode
:-
pruneWrappedNode
maxDepth
maxBreadth
:-
showWrapped
:-
chop
maxChars
:-
flip
(++)
[
terminator
]
where
{
maxDepth
,
maxBreadth
,
maxChars
,
terminator
}
=
foldl
set
DebugDefaultOptions
debugOptions
where
set
options
(
DebugMaxDepth
maxDepth
)
=
{
options
&
maxDepth
=
maxDepth
}
set
options
(
DebugMaxBreadth
maxBreadth
)
=
{
options
&
maxBreadth
=
maxBreadth
}
set
options
(
DebugMaxChars
maxChars
)
=
{
options
&
maxChars
=
maxChars
}
set
options
(
DebugTerminator
terminator
)
=
{
options
&
terminator
=
terminator
}
::
Indicators
=
...
|
.+.
MaxCharsString
:==
".."
MaxBreadthString
:==
"..."
MaxBreadthIndicator
:==
wrapNode
...
MaxDepthIndicator
:==
wrapNode
.+.
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
{
wrapNode
e
\\
e
<-:
a
&
i
<-
[
0
..
maxBreadth
]})
// otherwise
=
WrappedArray
{
wrapNode
e
\\
e
<-:
a
}
/* +++ handle newlines in strings correctly */
chop
::
!
Int
[{#
Char
}]
->
[{#
Char
}]
chop
_
[]
=
[]
chop
maxChars
list
=:[
string
:
strings
]
|
maxChars
<
stringSize
+
sizeMaxCharsString
|
fits
maxChars
list
=
list
|
stringSize
>
sizeMaxCharsString
=
[
string
%
(
0
,
maxChars
-
sizeMaxCharsString
-1
),
MaxCharsString
]
// otherwise
=
[
MaxCharsString
]
// otherwise
=
[
string
:
chop
(
maxChars
-
stringSize
)
strings
]
where
stringSize
=
size
string
sizeMaxCharsString
=
size
MaxCharsString
fits
::
!
Int
[{#
Char
}]
->
Bool
fits
_
[]
=
True
fits
maxChars
[
h
:
t
]
=
maxChars
>=
size
h
&&
fits
(
maxChars
-
size
h
)
t
instance
<<<
[
a
]
|
<<<
a
where
(<<<)
::
*
File
[
a
]
->
*
File
|
<<<
a
(<<<)
file
[]
=
file
(<<<)
file
[
h
:
t
]
=
file
<<<
h
<<<
t
libraries/WrapDebug/ShowWrapped.dcl
0 → 100644
View file @
d5ba91c0
definition
module
ShowWrapped
from
Wrap
import
WrappedNode
showWrapped
::
WrappedNode
->
[{#
Char
}]
\ No newline at end of file
libraries/WrapDebug/ShowWrapped.icl
0 → 100644
View file @
d5ba91c0
implementation
module
ShowWrapped
import
StdEnv
import
Wrap
ShowParentheses
:==
True
Don`tShowParentheses
:==
False
showWrapped
::
WrappedNode
->
[{#
Char
}]
showWrapped
node
=
show
Don`tShowParentheses
node
show
::
Bool
WrappedNode
->
[{#
Char
}]
show
_
(
WrappedInt
i
)
=
[
toString
i
]
show
_
(
WrappedChar
c
)
=
[
"
\'
"
+++
toString
c
+++
"
\'
"
]
show
_
(
WrappedBool
b
)
=
[
toString
b
]
show
_
(
WrappedReal
r
)
=
[
toString
r
]
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
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
Don`tShowParentheses
args
.[
0
]
:
showTail
args
.[
1
]]]
++
[
"]"
]
where
showTail
::
WrappedNode
->
[[{#
Char
}]]
showTail
(
WrappedOther
WrappedDescriptorCons
args
)
|
size
args
==
2
=
[[
", "
],
show
Don`tShowParentheses
args
.[
0
]
:
showTail
args
.[
1
]]
showTail
(
WrappedOther
WrappedDescriptorNil
args
)
|
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
ShowParentheses
arg
\\
arg
<-:
args
]])
showDescriptor
::
WrappedDescriptor
->
{#
Char
}
showDescriptor
(
WrappedDescriptorOther
id
)
=
toString
id
showDescriptor
WrappedDescriptorNil
=
"[]"
showDescriptor
WrappedDescriptorCons
=
"[:]"
showDescriptor
WrappedDescriptorTuple
=
"(..)"
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
=
l
instance
toString
File
where
toString
::
File
->
{#
Char
}
toString
_
=
"File"
libraries/WrapDebug/Wrap.dcl
0 → 100644
View file @
d5ba91c0
/*
Wrap Clean nodes (for debugging purposes).
Version 1.0.2
Ronny Wichers Schreur
ronny@cs.kun.nl
*/
definition
module
Wrap
from
StdOverloaded
import
toString
::
WrappedDescriptorId
instance
toString
WrappedDescriptorId
::
WrappedDescriptor
=
WrappedDescriptorCons
|
WrappedDescriptorNil
|
WrappedDescriptorTuple
|
WrappedDescriptorOther
!
WrappedDescriptorId
::
WrappedNode
// basic types
=
WrappedInt
!
Int
|
WrappedChar
!
Char
|
WrappedBool
!
Bool
|
WrappedReal
!
Real
|
WrappedFile
!
File
// unboxed arrays of basic types
|
WrappedString
!{#
Char
}
|
WrappedIntArray
!{#
Int
}
|
WrappedBoolArray
!{#
Bool
}
|
WrappedRealArray
!{#
Real
}
|
WrappedFileArray
!{#
File
}
// other arrays
|
WrappedArray
!{
WrappedNode
}
// records
|
WrappedRecord
!
WrappedDescriptor
!{
WrappedNode
}
// other nodes
|
WrappedOther
!
WrappedDescriptor
!{
WrappedNode
}
wrapNode
::
!.
a
->
WrappedNode
\ No newline at end of file
libraries/WrapDebug/Wrap.icl
0 → 100644
View file @
d5ba91c0
/*
Wrap Clean nodes (for debugging purposes).
Version 1.0.2
Ronny Wichers Schreur
ronny@cs.kun.nl
*/
implementation
module
Wrap
import
StdOverloaded
::
WrappedDescriptorId
=
{
descriptorId
::
!
Int
}
::
WrappedDescriptor
=
WrappedDescriptorCons
|
WrappedDescriptorNil
|
WrappedDescriptorTuple
|
WrappedDescriptorOther
!
WrappedDescriptorId
::
WrappedNode
=
WrappedInt
!
Int
|
WrappedChar
!
Char
|
WrappedBool
!
Bool
|
WrappedReal
!
Real
|
WrappedFile
!
File
|
WrappedString
!{#
Char
}
|
WrappedIntArray
!{#
Int
}
|
WrappedBoolArray
!{#
Bool
}
|
WrappedRealArray
!{#
Real
}
|
WrappedFileArray
!{#
File
}
|
WrappedArray
!{
WrappedNode
}
|
WrappedRecord
!
WrappedDescriptor
!{
WrappedNode
}
|
WrappedOther
!
WrappedDescriptor
!{
WrappedNode
}
instance
toString
WrappedDescriptorId
where
toString
::
WrappedDescriptorId
->
{#
Char
}
toString
{
descriptorId
}
=
descriptorIDtoString
descriptorId
where
descriptorIDtoString
::
!
Int
->
{#