Commit 5c8c1de5 authored by Job Cuppen's avatar Job Cuppen

generic somewhat working save for isunit

parent 16971ef9
No preview for this file type
......@@ -10,9 +10,16 @@ module serialize8Start
Use Basic Values Only as conclose option for a nicer output.
*/
import StdEnv, StdMaybe
import StdEnv, StdMaybe, StdDebug
import StdGeneric
generic isUnit a :: a -> Bool
isUnit{|UNIT|} a = True
isUnit{|c|} a = False
//derive isUnit [], Coin, (,), Bin
// use this as serialize0 for kind *
//class serialize a | isUnit a where
// write :: a [String] -> [String]
......@@ -21,30 +28,76 @@ import StdGeneric
generic write a :: a [String] -> [String]
generic read a :: [String] -> Maybe (a,[String])
class serialize a | read{|*|}, write{|*|} a
class serialize a | read{|*|}, write{|*|}, isUnit{|*|} a
//write :: a [String] -> [String]
//write a c = write{|*|} a
//instance serialize Bool where
derive read Bool
derive write Bool
write{|Bool|} b c = [toString b:c]
write{|UNIT|} b c = []
write{|PAIR|} f g b c = []
write{|EITHER|} f g b c = []
write{|CONS|} f b c = []
write{|FIELD|} f b c = []
write{|OBJECT|} f b c = []
read{|Bool|} r = Nothing
read{|UNIT|} r = Nothing
read{|PAIR|} f g r = Nothing
read{|EITHER|} f g r = Nothing
read{|CONS|} f r = Nothing
read{|FIELD|} f r = Nothing
read{|OBJECT|} f r = Nothing
write{|Int|} b c = [toString b:c]
write{|UNIT|} b c = c
write{|PAIR|} f g (PAIR a b) c = f a (g b c)
write{|EITHER|} f g (LEFT a) c = f a c
write{|EITHER|} f g (RIGHT b) c = g b c
write{|CONS of x|} f (CONS a) c = ["(":(trace x.gcd_type_def.gtd_name x.gcd_name):(f a [")":c])]
//write{|FIELD|} f b c = []
write{|OBJECT|} f (OBJECT o) c = f o c
write{|(,)|} f g (a,b) c = ["(":(f a [ ",":(g b [")":c])])]
// Don't flip left and right though, that makes reading using the 'unit without parentheses' not work
read{|Int|} r = foldl (match r) Nothing [True, False]
where
match [string: rest] r bool
# int = toInt string
| string == toString int
= Just (int, rest)
= r
match _ r bool = r
read{|Bool|} r = foldl (match r) Nothing [True, False]
where
match [string: rest] r bool | toString bool == string
= Just (bool, rest)
= r
match _ r bool = r
read{|UNIT|} r = Just (UNIT,r)
read{|PAIR|} f g r = case f r of
Nothing -> Nothing
Just (a,r) -> case g r of
Nothing -> Nothing
Just (b,r) -> Just (PAIR a b, r)
read{|EITHER|} f g r = case f r of // try to parse the left side...
Just (a,r) -> Just (LEFT a ,r)
Nothing -> case g r of // if that fails, try to parse the right side
Just (a,r) -> Just (RIGHT a ,r)
Nothing -> Nothing
read{|CONS|} f ["(":s:r] = case f r of
Just (a,[")":r]) -> Just(CONS a, r)
_ -> Nothing
read{|CONS|} f [s:r] = case f r of
Just (a,r) -> Just(CONS a, r)
_ -> Nothing
read{|CONS|} f _ = Nothing
//read{|FIELD|} f r = Nothing
read{|OBJECT|} f r = case f r of
Just(a,r) -> Just(OBJECT a, r)
_ -> Nothing
read{|(,)|} f g ["(":r] = case f r of
Just (a,[",":r]) -> case g r of
Just(b,[")":r]) -> Just ((a,b),r)
_ -> Nothing
_ -> Nothing
derive write [], Bin, Coin
derive read [], Bin, Coin
//write{|*|} b c = []
......@@ -57,9 +110,10 @@ read{|OBJECT|} f r = Nothing
// ---
//derive serialize Bool
instance serialize Bool where
write b c = []
/*instance serialize Bool where
write b c = write{|*|} b c
read r = read{|*|} r
*/
/*instance serialize Bool where
write b c = [toString b:c]
read list = foldl (match list) Nothing [True, False]
......@@ -238,12 +292,14 @@ instance serialize (a,b) | serialize a & serialize b where
*/
// ---
Start = write True
/*
Start =
[test True
]
*/
// output looks nice if compiled with "Basic Values Only" for console in project options
/*Start =
Start =
[test True
,test False
,test 0
......@@ -264,6 +320,7 @@ Start = write True
,["End of the tests.\n"]
]
test :: a -> [String] | serialize, == a
test a =
(if (isJust r)
......@@ -271,11 +328,10 @@ test a =
(if (isEmpty (tl (snd jr)))
["Oke"]
["Not all input is consumed! ":snd jr])
["Wrong result: ":write (fst jr) []])
["Wrong result: ":write{|*|} (fst jr) []])
["read result is Nothing"]
) ++ [", write produces: ": s]
where
s = write a ["\n"]
r = read s
s = write{|*|} a ["\n"]
r = read{|*|} s
jr = fromJust r
*/
\ No newline at end of file
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