Commit 5899434c authored by Ronny Wichers Schreur's avatar Ronny Wichers Schreur

remove RWSDebug dependency

parent 63a843fb
/*
Debug functions.
Version 1.0
Ronny Wichers Schreur
ronny@cs.kun.nl
*/
definition module Debug
:: 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
debugShowWithOptions :: [DebugShowOption] .a -> [{#Char}]
:: DebugShowOption
= DebugMaxDepth !Int // default no limit
| DebugMaxBreadth !Int // default no limit
| DebugMaxChars !Int // default no limit
| DebugTerminator !{#Char} // default "\n"
/*
Debug functions.
Version 1.0
Ronny Wichers Schreur
ronny@cs.kun.nl
*/
implementation module Debug
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
debugShowWithOptions :: [DebugShowOption] .a -> [{#Char}]
debugShowWithOptions 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
// MW 2.0 was: = ...
= @...
| .+.
MaxCharsString
:== ".."
MaxBreadthString
:== "..."
MaxBreadthIndicator
// MW 2.0 was: :== wrapNode ...
:== 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}
// MW:
//1.3
pruneBasicArray :: !Int !(a b) -> WrappedNode | Array .a & ArrayElem b
//3.1
/*2.0
pruneBasicArray :: !Int !(a b) -> WrappedNode | Array a b
0.2*/
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
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)
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
definition module RWSDebug
(->>) :: !.a !.b -> .a
(<<-) :: .a !.b -> .a
<<->> :: !.a -> .a
\ No newline at end of file
implementation module RWSDebug
import Debug
show
= 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
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)
definition module ShowWrapped
/*2.0
from Wrap import ::WrappedNode
0.2*/
//1.3
from Wrap import WrappedNode
//3.1
showWrapped :: WrappedNode -> [{#Char}]
\ No newline at end of file
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
= "(..)"
// MW
//1.3
showBasicArray :: {#a} -> [{#Char}] | toString, ArrayElem a
//3.1
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"
/*
Wrap Clean nodes (for debugging purposes).
Version 1.0.2
Ronny Wichers Schreur
ronny@cs.kun.nl
*/
definition module Wrap
/*2.0
from StdOverloaded import class toString
0.2*/
//1.3
from StdOverloaded import toString
//3.1
:: 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
This diff is collapsed.
Markdown is supported
0%
or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment