1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
|
#!/usr/bin/env stack
-- stack --nix --resolver lts-11.7 script
{-# LANGUAGE TypeSynonymInstances #-}
{-# LANGUAGE FlexibleInstances #-}
import Data.List
import Control.Monad
import Control.Exception (assert)
type Coords a = (a, a) -- ^ (line, column)
-- Extend ordinal operations to both numbers
instance {-# OVERLAPPING #-} Ord (Coords Int) where
a < b = (fst a) < (fst b) && (snd a) < (snd b)
a <= b = (fst a) <= (fst b) && (snd a) <= (snd b)
a > b = (fst a) > (fst b) && (snd a) > (snd b)
a >= b = (fst a) >= (fst b) && (snd a) >= (snd b)
-- | A single stack trace element
data St = St
{ start :: Coords Int
, end :: Coords Int
} deriving (Eq, Show)
-- | We have two types of operations on the stacktrace
data OpType
= Jumppoint -- ^ It's a jump point if it moves outside the previous scope
| Descending -- ^ We are descending if the scope in th 'St' is narrowing
deriving (Show, Eq)
-- | To detect the 'OpType', we need the current and next thing in the
-- stacktrace.
detect' :: St -> St -> (St, OpType)
detect' a b
| (end a) == (end b) = (a, Descending)
| (start a) < (start b) && (end a) >= (end b) = (a, Descending) -- If a wraps around b, we are still descending
| otherwise = (a, Jumppoint)
detect :: [St] -> [(St, OpType)]
detect [] = error "empty list"
detect [a] = error "not enough elements"
detect [a, b] = [detect' a b]
detect (a:b:rest) = detect' a b : (detect $ b:rest)
prune :: [(St, OpType)] -> [(St, OpType)]
prune ls = filter (\(_, opType) -> opType == Jumppoint) ls
main = do
putStrLn $ assert ([(head ex2, Jumppoint)] == detect ex2) "Jumppoint test passes"
putStrLn $ assert ([(head ex3, Descending)] == detect ex3) "Descending test passes"
putStrLn "Pruning:"
print $ map show $ prune $ detect ex1
-- Examples
{- Example
1 |
2 |
3 |main = do
4 | x <- someFunc 10
5 | y <- someOtherfunc 53
6 | putStrLn (show x <> show y)
8 |
9 |someFunc x = x
10|
11|someOtherfunc y = y
12|
13|
-}
ex1 :: [St]
ex1 =
[ St { start = (3, 1), end = (6, 29) } -- Descending : main
, St { start = (3, 7), end = (6, 29) } -- Descending : do
, St { start = (4, 2), end = (4, 18) } -- Jumppoint : x <- someFunc 10
, St { start = (9, 0), end = (9, 14) } -- Jumppoint : someFunc 10
, St { start = (5, 2), end = (5, 18) } -- Jumppoint : y <- someOtherfunc 53
, St { start = (11, 0), end = (11, 19) } -- Jumppoint : someOtherfunc 53
, St { start = (6, 2), end = (6, 29) } -- Descending : putStrLn
, St { start = (6, 11), end = (6, 29) } -- Descending : (show x <> show y)
, St { start = (6, 12), end = (6, 18) } -- Jumppoint : show x
, St { start = (6, 22), end = (6, 28) } -- Jumppoint : show y
]
{- Jumppoint example
1 |(func1 arg)
2 |
3 |func1 a = undefined
-}
ex2 :: [St]
ex2 =
[ St { start = (1, 0), end = (1, 10) }
, St { start = (3, 0), end = (3, 20) }
]
{- Descending example
1|(func1
2| (func2 arg))
3|
-}
ex3 :: [St]
ex3 =
[ St { start = (1, 1), end = (2, 14) }
, St { start = (2, 3), end = (2, 14) }
]
|
