Skip to content
GitLab
Projects
Groups
Snippets
Help
Loading...
Help
What's new
7
Help
Support
Community forum
Keyboard shortcuts
?
Submit feedback
Contribute to GitLab
Sign in
Toggle navigation
Open sidebar
Job Cuppen
Advanced Programming
Commits
03bb02c3
Commit
03bb02c3
authored
Nov 18, 2019
by
Job Cuppen
Browse files
Options
Browse Files
Download
Email Patches
Plain Diff
ex 8.2.2
parent
5c8c1de5
Changes
2
Hide whitespace changes
Inline
Sidebyside
Showing
2 changed files
with
35 additions
and
239 deletions
+35
239
week08/serialize8Start
week08/serialize8Start
+0
0
week08/serialize8Start.icl
week08/serialize8Start.icl
+35
239
No files found.
week08/serialize8Start
deleted
100755 → 0
View file @
5c8c1de5
File deleted
week08/serialize8Start.icl
View file @
03bb02c3
...
...
@@ 10,45 +10,25 @@ module serialize8Start
Use Basic Values Only as conclose option for a nicer output.
*/
import
StdEnv
,
StdMaybe
,
StdDebug
import
StdEnv
,
StdMaybe
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]
// read :: [String] > Maybe (a,[String])
generic
write
a
::
a
[
String
]
>
[
String
]
generic
read
a
::
[
String
]
>
Maybe
(
a
,[
String
])
class
serialize
a

read
{*},
write
{*},
isUnit
{*}
a
//write :: a [String] > [String]
//write a c = write{*} a
//instance serialize Bool where
write
{
Bool
}
b
c
=
[
toString
b
:
c
]
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
class
serialize
a

read
{*},
write
{*}
a
write
{
Bool
}
b
c
=
[
toString
b
:
c
]
write
{
Int
}
b
c
=
[
toString
b
:
c
]
write
{
UNIT
}
_
c
=
c
write
{
PAIR
}
f
g
(
PAIR
a
b
)
c
=
f
a
(
g
b
c
)
write
{
EITHER
}
f
_
(
LEFT
a
)
c
=
f
a
c
write
{
EITHER
}
_
g
(
RIGHT
b
)
c
=
g
b
c
write
{
CONS
of
x
}
f
(
CONS
a
)
c

(
x
.
gcd_arity
==
0
)
=
[
x
.
gcd_name
:(
f
a
c
)]
=
[
"("
:
x
.
gcd_name
:(
f
a
[
")"
:
c
])]
write
{
OBJECT
}
f
(
OBJECT
o
)
c
=
f
o
c
write
{(,)}
f
g
(
a
,
b
)
c
=
[
"("
:(
f
a
[
","
:(
g
b
[
")"
:
c
])])]
read
{
Int
}
r
=
foldl
(
match
r
)
Nothing
[
True
,
False
]
...
...
@@ 67,236 +47,53 @@ read{Bool} r = foldl (match r) Nothing [True, False]
=
r
match
_
r
bool
=
r
read
{
UNIT
}
r
=
Just
(
UNIT
,
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
)
Just
(
a
,
r
)
>
case
g
r
of
Just
(
b
,
r
)
>
Just
(
PAIR
a
b
,
r
)
Nothing
>
Nothing
Nothing
>
Nothing
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
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
of
{
gcd_name
}}
f
[
s
:
r
]

s
==
gcd_name
=
case
f
r
of
Just
(
a
,
r
)
>
Just
(
CONS
a
,
r
)
Nothing
>
Nothing

otherwise
=
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
Just
(
a
,
r
)
>
Just
(
OBJECT
a
,
r
)
Nothing
>
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
Just
(
a
,[
","
:
r
])
>
case
g
r
of
Just
(
b
,[
")"
:
r
])
>
Just
((
a
,
b
),
r
)
Nothing
>
Nothing
Nothing
>
Nothing
derive
write
[],
Bin
,
Coin
derive
read
[],
Bin
,
Coin
//write{*} b c = []
//read{*} r = Nothing
//instance where
// write{*} a [String] > [String]
// read{*} [String] > Maybe (a,[String])
// 
//derive serialize Bool
/*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]
where
match [string: rest] r bool  toString bool == string
= Just (bool, rest)
= r
match _ r bool = r
instance serialize Int where
write i c = [toString i:c]
read list = foldl (match list) Nothing [True, False]
where
match [string: rest] r bool
# int = toInt string
 string == toString int
= Just (int, rest)
= r
match _ r bool = r
*/
// 
//:: UNIT = UNIT
//:: EITHER a b = LEFT a  RIGHT b
//:: PAIR a b = PAIR a b
//:: CONS a = CONS String a
// 
/*
class isUnit a where
isUnit :: a > Bool
instance isUnit UNIT where
isUnit a = True
instance isUnit a where
isUnit a = False
instance serialize UNIT where
write u c = c
read r = Just (UNIT,r)
instance serialize (PAIR a b)  serialize a & serialize b where
write (PAIR a b) c = (write a (write b c))
read r = case read r of
Nothing > Nothing
Just (a,r) > case read r of
Nothing > Nothing
Just (b,r) > Just (PAIR a b, r)
instance serialize (EITHER a b)  serialize a & serialize b where
write (LEFT a) c = write a c
write (RIGHT b) c = write b c
read r = case read r of // try to parse the left side...
Just (a,r) > Just (LEFT a ,r)
Nothing > case read r of // if that fails, try to parse the right side
Just (a,r) > Just (RIGHT a ,r)
Nothing > Nothing
// Don't flip left and right though, that makes reading using the 'unit without parentheses' not work
instance serialize (CONS a)  serialize a where
// Cheekily using the fact that a written unit is an empty list
//write (CONS s a) c = let written = write a [] in
// if (length (written) == 0)
// [s: written++c] // unit without parentheses
// ["(":s: (written ++ [")":c])] // else with parentheses
write (CONS a) c = if (isUnit a)
(write a c) // unit without parentheses
["(": (write a [")":c])] // else with parentheses
read ["(":s:r] = case read r of
Just (a,[")":r]) > Just(CONS a, r)
_ > Nothing
read [s:r] = case read r of
Just (a,r) > Just (CONS a, r)
Nothing > Nothing
read _ = Nothing
*/
// 
::
ListG
a
:==
EITHER
(
CONS
UNIT
)
(
CONS
(
PAIR
a
[
a
]))
fromList
::
[
a
]
>
ListG
a
fromList
[]
=
LEFT
(
CONS
/*NilString*/
UNIT
)
fromList
[
a
:
x
]
=
RIGHT
(
CONS
/*ConsString*/
(
PAIR
a
x
))
toList
::
(
ListG
a
)
>
[
a
]
toList
(
LEFT
(
CONS
/*NilString*/
UNIT
))
=
[]
toList
(
RIGHT
(
CONS
/*ConsString*/
(
PAIR
a
x
)))
=
[
a
:
x
]
NilString
:==
"Nil"
ConsString
:==
"Cons"
/*
instance serialize [a]  serialize a where // to be improved
write a s = s
read s = Nothing
*/
// 
::
Bin
a
=
Leaf

Bin
(
Bin
a
)
a
(
Bin
a
)
::
BinG
a
:==
EITHER
(
CONS
UNIT
)
(
CONS
(
PAIR
(
Bin
a
)
(
PAIR
a
(
Bin
a
))))
fromBin
::
(
Bin
a
)
>
BinG
a
fromBin
Leaf
=
LEFT
(
CONS
/*LeafString*/
UNIT
)
fromBin
(
Bin
l
a
r
)
=
RIGHT
(
CONS
/*BinString*/
(
PAIR
l
(
PAIR
a
r
)))
toBin
::
(
BinG
a
)
>
Bin
a
toBin
(
LEFT
(
CONS
UNIT
))
=
Leaf
toBin
(
RIGHT
(
CONS
(
PAIR
l
(
PAIR
a
r
))))
=
Bin
l
a
r
LeafString
:==
"Leaf"
BinString
:==
"Bin"
instance
==
(
Bin
a
)

==
a
where
(==)
Leaf
Leaf
=
True
(==)
(
Bin
l
a
r
)
(
Bin
k
b
s
)
=
l
==
k
&&
a
==
b
&&
r
==
s
(==)
_
_
=
False
/*
instance serialize (Bin a)  serialize a where // to be improved
write b s = s
read l = Nothing
*/
// 
::
Coin
=
Head

Tail
::
CoinG
:==
EITHER
(
CONS
UNIT
)
(
CONS
UNIT
)
fromCoin
::
Coin
>
CoinG
fromCoin
Head
=
LEFT
(
CONS
UNIT
)
fromCoin
Tail
=
RIGHT
(
CONS
UNIT
)
toCoin
::
CoinG
>
Coin
toCoin
(
LEFT
(
CONS
UNIT
))
=
Head
toCoin
(
RIGHT
(
CONS
UNIT
))
=
Tail
instance
==
Coin
where
(==)
Head
Head
=
True
(==)
Tail
Tail
=
True
(==)
_
_
=
False
/*
instance serialize Coin where
write c s = s
read l = Nothing
*/
/*
Define a special purpose version for this type that writes and reads
the value (7,True) as ["(","7",",","True",")"]
*/
::
TupleG
a
b
:==
CONS
(
PAIR
a
b
)
fromTup
::
(
a
,
b
)
>
(
TupleG
a
b
)
fromTup
(
a
,
b
)
=
CONS
(
PAIR
a
b
)
toTup
::
(
TupleG
a
b
)
>
(
a
,
b
)
toTup
(
CONS
(
PAIR
a
b
))
=
(
a
,
b
)
/*
instance serialize (a,b)  serialize a & serialize b where
write (a,b) c = ["(":(write a [ ",":(write b [")":c])])] //write (fromTup (a,b)) c
read ["(":r] = case read r of
Just (a,[",":r]) > case read r of
Just(b,[")":r]) > Just ((a,b),r)
_ > Nothing
_ > Nothing
//read _ = Nothing
*/
// 
/*
Start =
[test True
]
*/
// output looks nice if compiled with "Basic Values Only" for console in project options
Start
=
...
...
@@ 320,7 +117,6 @@ Start =
,[
"End of the tests.
\n
"
]
]
test
::
a
>
[
String
]

serialize
,
==
a
test
a
=
(
if
(
isJust
r
)
...
...
Write
Preview
Markdown
is supported
0%
Try again
or
attach a new file
.
Attach a file
Cancel
You are about to add
0
people
to the discussion. Proceed with caution.
Finish editing this message first!
Cancel
Please
register
or
sign in
to comment