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
8ec770c0
Commit
8ec770c0
authored
Nov 18, 2019
by
Job Cuppen
Browse files
Options
Browse Files
Download
Email Patches
Plain Diff
ex 8.1.1
parent
03bb02c3
Changes
2
Hide whitespace changes
Inline
Sidebyside
Showing
2 changed files
with
268 additions
and
1 deletion
+268
1
week08/ex1.icl
week08/ex1.icl
+267
0
week08/ex2.icl
week08/ex2.icl
+1
1
No files found.
week08/ex1.icl
0 → 100644
View file @
8ec770c0
module
ex1
/*
Definitions for assignment 8 in AFP 2019
Kind indexed gennerics
Pieter Koopman, pieter@cs.ru.nl
September 2019
Use StdEnv or iTask environment.
Use Basic Values Only as conclose option for a nicer output.
*/
import
StdEnv
,
StdMaybe
class
unitDecidable
a
where
isUnit
::
a
>
Bool
instance
unitDecidable
UNIT
where
isUnit
_
=
True
instance
unitDecidable
a
where
isUnit
_
=
False
// use this as serialize0 for kind *
class
serialize0
a

unitDecidable
a
where
write0
::
a
[
String
]
>
[
String
]
read0
::
[
String
]
>
Maybe
(
a
,[
String
])
class
serialize1
a
where
write1
::
(
x
[
String
]
>
[
String
])
(
a
x
)
[
String
]
>
[
String
]

unitDecidable
x
read1
::
([
String
]
>
Maybe
(
x
,
[
String
]))
[
String
]
>
Maybe
((
a
x
),[
String
])
class
serialize2
a
where
write2
::
(
x
[
String
]
>
[
String
])
(
y
[
String
]
>
[
String
])
(
a
x
y
)
[
String
]
>
[
String
]
read2
::
([
String
]
>
Maybe
(
x
,
[
String
]))
([
String
]
>
Maybe
(
y
,
[
String
]))
[
String
]
>
Maybe
((
a
x
y
),[
String
])
// 
instance
serialize0
Bool
where
write0
b
c
=
[
toString
b
:
c
]
read0
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
serialize0
Int
where
write0
i
c
=
[
toString
i
:
c
]
read0
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
instance
serialize0
UNIT
where
write0
_
c
=
c
read0
l
=
Just
(
UNIT
,
l
)
instance
serialize0
(
EITHER
a
b
)

serialize0
a
&
serialize0
b
where
write0
(
LEFT
a
)
c
=
write0
a
c
write0
(
RIGHT
b
)
c
=
write0
b
c
read0
r
=
case
read0
r
of
Just
(
a
,
restA
)
>
Just
(
LEFT
a
,
restA
)
_
>
case
read0
r
of
Just
(
b
,
restB
)
>
Just
(
RIGHT
b
,
restB
)
_
>
Nothing
instance
serialize2
EITHER
where
write2
f
g
(
LEFT
a
)
c
=
f
a
c
write2
f
g
(
RIGHT
b
)
c
=
g
b
c
read2
f
g
r
=
case
f
r
of
Just
(
a
,
restA
)
>
Just
(
LEFT
a
,
restA
)
_
>
case
g
r
of
Just
(
b
,
restB
)
>
Just
(
RIGHT
b
,
restB
)
_
>
Nothing
instance
serialize0
(
PAIR
a
b
)

serialize0
a
&
serialize0
b
where
write0
(
PAIR
a
b
)
c
=
write0
a
(
write0
b
c
)
read0
xs
=
case
read0
xs
of
Just
(
a
,
restA
)
>
case
read0
restA
of
Just
(
b
,
restB
)
>
Just
(
PAIR
a
b
,
restB
)
_
>
Nothing
_
>
Nothing
instance
serialize2
PAIR
where
write2
f
g
(
PAIR
a
b
)
c
=
f
a
(
g
b
c
)
read2
f
g
xs
=
case
f
xs
of
Just
(
a
,
restA
)
>
case
g
restA
of
Just
(
b
,
restB
)
>
Just
(
PAIR
a
b
,
restB
)
_
>
Nothing
_
>
Nothing
instance
serialize0
(
CONS
a
)

serialize0
a
where
write0
(
CONS
str
a
)
c

(
isUnit
a
)
=
[
str
:
write0
a
c
]

otherwise
=
[
"["
:
str
:(
write0
a
[
"]"
:
c
])]
read0
[
"["
:
str
:
r
]
=
case
read0
r
of
Just
(
a
,
[
"]"
:
r
])
>
Just
(
CONS
str
a
,
r
)
Just
(
a
,
r
)
>
Nothing
Nothing
>
Nothing
read0
[
str
:
r
]
=
case
read0
r
of
Just
(
a
,
r
)
>
Just
(
CONS
str
a
,
r
)
Nothing
>
Nothing
read0
_
=
Nothing
instance
serialize1
CONS
where
write1
f
(
CONS
str
a
)
c

(
isUnit
a
)
=
[
str
:
f
a
c
]

otherwise
=
[
"["
:
str
:(
f
a
[
"]"
:
c
])]
read1
f
[
"["
:
str
:
r
]
=
case
f
r
of
Just
(
a
,
[
"]"
:
r
])
>
Just
(
CONS
str
a
,
r
)
Just
(
a
,
r
)
>
Nothing
Nothing
>
Nothing
read1
f
[
str
:
r
]
=
case
f
r
of
Just
(
a
,
r
)
>
Just
(
CONS
str
a
,
r
)
Nothing
>
Nothing
read1
_
_
=
Nothing
::
ListG
a
:==
EITHER
(
CONS
UNIT
)
(
CONS
(
PAIR
a
[
a
]))
fromList
::
[
a
]
>
ListG
a
fromList
[]
=
LEFT
(
CONS
NilString
UNIT
)
fromList
[
a
:
l
]
=
RIGHT
(
CONS
ConsString
(
PAIR
a
l
))
toList
::
(
ListG
a
)
>
[
a
]
toList
(
LEFT
(
CONS
_
UNIT
))
=
[]
toList
(
RIGHT
(
CONS
_
(
PAIR
a
l
)))
=
[
a
:
l
]
instance
serialize0
[
a
]

serialize0
a
where
write0
l
c
=
write0
(
fromList
l
)
c
read0
r
=
case
read0
r
of
Just
(
s
,
r
)
>
Just
(
toList
s
,
r
)
Nothing
>
Nothing
NilString
:==
"Nil"
ConsString
:==
"Cons"
instance
serialize1
[]
where
write1
f
l
c
=
write2
(
write1
write0
)
(
write1
(
write2
f
(
write1
f
)))
(
fromList
l
)
c
read1
f
r
=
case
read2
(
read1
read0
)
(
read1
(
read2
f
(
read1
f
)))
r
of
Just
(
s
,
r
)
>
Just
(
toList
s
,
r
)
Nothing
>
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
serialize0
(
Bin
a
)

serialize0
a
where
write0
a
c
=
write0
(
fromBin
a
)
c
read0
l
=
case
read0
l
of
Just
(
s
,
r
)
>
Just
(
toBin
s
,
r
)
Nothing
>
Nothing
instance
==
(
Bin
a
)

==
a
where
(==)
Leaf
Leaf
=
True
(==)
(
Bin
l
a
r
)
(
Bin
k
b
s
)
=
l
==
k
&&
a
==
b
&&
r
==
s
(==)
_
_
=
False
instance
serialize1
Bin
where
write1
f
a
c
=
write2
(
write1
write0
)
(
write1
(
write2
(
write1
f
)
(
write2
f
(
write1
f
))))
(
fromBin
a
)
c
read1
f
l
=
case
read2
(
read1
read0
)
(
read1
(
read2
(
read1
f
)
(
read2
f
(
read1
f
))))
l
of
Just
(
s
,
r
)
>
Just
(
toBin
s
,
r
)
Nothing
>
Nothing
// 
::
Coin
=
Head

Tail
::
CoinG
:==
EITHER
(
CONS
UNIT
)
(
CONS
UNIT
)
fromCoin
::
Coin
>
CoinG
fromCoin
Head
=
LEFT
(
CONS
"Head"
UNIT
)
fromCoin
Tail
=
RIGHT
(
CONS
"Tail"
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
serialize0
Coin
where
write0
c
cont
=
write0
(
fromCoin
c
)
cont
read0
r
=
case
read0
r
of
Just
(
c
,
rest
)
>
Just
(
toCoin
c
,
rest
)
_
>
Nothing
/*
Define a special purpose version for this type that writes and reads
the value (7,True) as ["(","7",",","True",")"]
*/
instance
serialize0
(
a
,
b
)

serialize0
a
&
serialize0
b
where
write0
(
a
,
b
)
c
=
[
"("
:
write0
a
[
","
:
write0
b
[
")"
:
c
]]]
read0
[
"("
:
r
]
=
case
read0
r
of
Nothing
>
Nothing
Just
(
a
,[
","
:
r
])
>
case
read0
r
of
Nothing
>
Nothing
Just
(
b
,[
")"
:
r
])
>
Just
((
a
,
b
),
r
)
_
>
Nothing
_
>
Nothing
read0
_
=
Nothing
// 
// output looks nice if compiled with "Basic Values Only" for console in project options
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
]

serialize0
,
==
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: "
:
write0
(
fst
jr
)
[]])
[
"read result is Nothing"
]
)
++
[
", write produces: "
:
s
]
where
s
=
write0
a
[
"
\n
"
]
r
=
read0
s
jr
=
fromJust
r
week08/
serialize8Start
.icl
→
week08/
ex2
.icl
View file @
8ec770c0
module
serialize8Start
module
ex2
/*
Definitions for assignment 8 in AFP 2019
...
...
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