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
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
|
module program1
import StdBool
import StdEnum
from StdFunc import flip, o
import StdList
import StdString
import StdTuple
import Control.Applicative
import Control.Monad
import Control.Monad.State
import Data.Functor
import Data.List
import Data.Maybe
:: Bin a = Leaf | Bin (Bin a) a (Bin a)
:: Rose a = Rose a [Rose a]
instance == (Bin a) | == a
where
== Leaf Leaf = True
== (Bin la xa ra) (Bin lb xb rb) = xa == xb && la == lb && ra == rb
== _ _ = False
instance == (Rose a) | == a
where
== (Rose x xs) (Rose y ys) = x == y && xs == ys
class serialize a
where
write :: a [String] -> [String]
read :: [String] -> Maybe (a, [String])
sread :== StateT read
instance serialize Bool
where
write b c = [toString b:c]
read ["True": r] = Just (True, r)
read ["False":r] = Just (False, r)
read _ = Nothing
instance serialize String
where
write s c = [s:c]
read [s:r] = Just (s,r)
read _ = Nothing
instance serialize Int
where
write i c = write (toString i) c
read ["0":r] = Just (0, r)
read [i:r] = case toInt i of
0 -> Nothing
i -> Just (i, r)
read _ = Nothing
instance serialize [a] | serialize a
where
// We don't actually need to start with [, but this gives some type safety.
// The ] is necessary to recognise the end of the list.
write xs c = write "[" (foldl (flip write) (write "]" c) xs)
read ["[":r] = readElements [] r
where
readElements :: [a] [String] -> Maybe ([a], [String]) | serialize a
readElements xs ["]":r] = Just (xs, r)
readElements xs s = read s >>= \(x,r) -> readElements [x:xs] r
read _ = Nothing
instance serialize (Bin a) | serialize a
where
// Here, it is necessary to start with "Bin", to be able to parse
// ["Leaf":_] unambiguously.
write Leaf c = write "Leaf" c
write (Bin l x r) c = write "Bin" (write l (write x (write r c)))
read ["Leaf":r] = Just (Leaf, r)
read ["Bin":r] = runStateT (liftM3 Bin sread sread sread) r
read _ = Nothing
instance serialize (Rose a) | serialize a
where
// Other than for [], we don't include the constructor here (it is not
// necessary because there is only one constructor).
write (Rose x xs) c = write xs (write x c)
read s = runStateT (liftM2 (flip Rose) sread sread) s
test :: a -> (Bool, [String]) | serialize, == a
test a = (isJust r && fst jr == a && isEmpty (tl (snd jr)), s)
where
s = write a [""]
r = read s
jr = fromJust r
Start :: [([Rose (Bin Bool)], Bool)] // Change the first type of the tuple to test other expressions.
Start = filter (not o snd) testn // Should be [].
testn :: [(a, Bool)] | serialize, ==, someExprs a
testn = [(x, fst (test x)) \\ x <- someExprs]
class someExprs a :: [a]
instance someExprs Bool where someExprs = [True,False]
instance someExprs Int where someExprs = [-3..3]
instance someExprs [a] | someExprs a where someExprs = tails someExprs
instance someExprs (Bin a) | someExprs a
where
someExprs =
[ Leaf
, Bin Leaf (es!!0) Leaf
, Bin (Bin (Bin (Bin Leaf (es!!1) Leaf) (es!!2) Leaf) (es!!3) Leaf) (es!!4) Leaf
, Bin (Bin Leaf (es!!7) Leaf) (es!!6) (Bin Leaf (es!!5) Leaf)
, Bin Leaf (es!!8) (Bin (Bin (Bin Leaf (es!!9) Leaf) (es!!10) Leaf) (es!!11) Leaf)
] // Looking forward to using Gast.
where
es = cycle someExprs
instance someExprs (Rose a) | someExprs a
where
someExprs = level1 ++ level2 ++ level3
where
level1 = [Rose x [] \\ x <- someExprs]
level2 = [Rose x rs \\ x <- someExprs, rs <- tails level1]
level3 = [Rose x rs \\ x <- someExprs, rs <- tails (level1 ++ level2)]
// Would be better to use (a) permutations / subsequences or (b) do
// something more intelligent, but (a) takes too much memory and (b)
// requires thinking.
|
