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
127
128
129
130
|
module serialize3Native
import StdEnv
import StdGeneric
import StdMaybe
:: Bin a = Leaf | Bin (Bin a) a (Bin a)
instance == (Bin a) | == a where
(==) Leaf Leaf = True
(==) (Bin l a r) (Bin k b s) = l == k && a == b && r == s
(==) _ _ = False
:: Coin = Head | Tail
instance == Coin where
(==) Head Head = True
(==) Tail Tail = True
(==) _ _ = False
generic read a :: [String] -> Maybe (a, [String])
read{|Bool|} ["True":s] = Just (True,s)
read{|Bool|} ["False":s] = Just (False,s)
read{|Bool|} _ = Nothing
read{|Int|} ["0":s] = Just (0,s)
read{|Int|} [i:s] = case toInt i of
0 -> Nothing
i -> Just (i,s)
read{|Int|} _ = Nothing
read{|UNIT|} s = Just (UNIT,s)
read{|PAIR|} f g s = case f s of
Just (x,[" ":s]) -> case g s of
Just (y,s) -> Just (PAIR x y,s)
_ -> Nothing
_ -> Nothing
read{|CONS of d|} f ["(":c:" ":s]
| c == d.gcd_name = case f s of
Just (x,[")":s]) -> Just (CONS x,s)
_ -> Nothing
| otherwise = Nothing
read{|CONS of d|} f [c:s]
| d.gcd_arity == 0 && d.gcd_name == c = case f s of
Just (x,_) -> Just (CONS x,s)
Nothing -> Nothing
| otherwise = Nothing
read{|EITHER|} f g s = case f s of
Just (x,s) -> Just (LEFT x,s)
Nothing -> case g s of
Just (x,s) -> Just (RIGHT x,s)
Nothing -> Nothing
read{|OBJECT|} f s = case f s of
Just (x,s) -> Just (OBJECT x,s)
_ -> Nothing
read{|(,)|} f g ["(":s] = case f s of
Just (x,[",":s]) -> case g s of
Just (y,[")":s]) -> Just ((x,y),s)
_ -> Nothing
_ -> Nothing
derive read [], Bin, Coin
generic write a :: a [String] -> [String]
write{|Bool|} b s = [toString b:s]
write{|Int|} x s = [toString x:s]
write{|UNIT|} UNIT s = s
write{|PAIR|} f g (PAIR x y) s = f x [" ":g y s]
write{|CONS of d|} f (CONS x) s
| d.gcd_arity == 0 = [d.gcd_name:s]
| otherwise = ["(":d.gcd_name:" ":f x [")":s]]
write{|EITHER|} f g (LEFT x) s = f x s
write{|EITHER|} f g (RIGHT x) s = g x s
write{|OBJECT|} f (OBJECT x) s = f x s
write{|(,)|} f g (x,y) s = ["(":f x [",":g y [")":s]]]
derive write [], Bin, Coin
class serialize a | read{|*|}, write{|*|} a
Start =
[test True
,test False
,test 0
,test 123
,test -36
,test [42]
,test [0..4]
,test [[True],[]]
,test [[[1]],[[2],[3,4]],[[]]]
,test (Bin Leaf True Leaf)
,test [Bin (Bin Leaf [1] Leaf) [2] (Bin Leaf [3] (Bin Leaf [4,5] Leaf))]
,test [Bin (Bin Leaf [1] Leaf) [2] (Bin Leaf [3] (Bin (Bin Leaf [4,5] Leaf) [6,7] (Bin Leaf [8,9] Leaf)))]
,test Head
,test Tail
,test (7,True)
,test (Head,(7,[Tail]))
,["End of the tests.\n"]
]
test :: a -> [String] | serialize, == a
test a =
(if (isJust r)
(if (fst jr == a)
(if (isEmpty (tl (snd jr)))
["Oke"]
["Not all input is consumed! ":snd jr])
["Wrong result: ":write{|*|} (fst jr) []])
["read result is Nothing"]
) ++ [", write produces: ": s]
where
s = write{|*|} a ["\n"]
r = read{|*|} s
jr = fromJust r
/*
Oke, write produces: True
Oke, write produces: False
Oke, write produces: 0
Oke, write produces: 123
Oke, write produces: -36
Oke, write produces: (_Cons 42 _Nil)
Oke, write produces: (_Cons 0 (_Cons 1 (_Cons 2 (_Cons 3 (_Cons 4 _Nil)))))
Oke, write produces: (_Cons (_Cons True _Nil) (_Cons _Nil _Nil))
Oke, write produces: (_Cons (_Cons (_Cons 1 _Nil) _Nil) (_Cons (_Cons (_Cons 2 _Nil) (_Cons (_Cons 3 (_Cons 4 _Nil)) _Nil)) (_Cons (_Cons _Nil _Nil) _Nil)))
Oke, write produces: (Bin Leaf True Leaf)
Oke, write produces: (_Cons (Bin (Bin Leaf (_Cons 1 _Nil) Leaf) (_Cons 2 _Nil) (Bin Leaf (_Cons 3 _Nil) (Bin Leaf (_Cons 4 (_Cons 5 _Nil)) Leaf))) _Nil)
Oke, write produces: (_Cons (Bin (Bin Leaf (_Cons 1 _Nil) Leaf) (_Cons 2 _Nil) (Bin Leaf (_Cons 3 _Nil) (Bin (Bin Leaf (_Cons 4 (_Cons 5 _Nil)) Leaf) (_Cons 6 (_Cons 7 _Nil)) (Bin Leaf (_Cons 8 (_Cons 9 _Nil)) Leaf)))) _Nil)
Oke, write produces: Head
Oke, write produces: Tail
Oke, write produces: (7,True)
Oke, write produces: (Head,(7,(_Cons Tail _Nil)))
End of the tests.
*/
|
