Skip to content
GitLab
Projects
Groups
Snippets
Help
Loading...
Help
Help
Support
Community forum
Keyboard shortcuts
?
Submit feedback
Contribute to GitLab
Sign in
Toggle navigation
A
Advanced Programming
Project overview
Project overview
Details
Activity
Releases
Repository
Repository
Files
Commits
Branches
Tags
Contributors
Graph
Compare
Issues
0
Issues
0
List
Boards
Labels
Service Desk
Milestones
Merge Requests
1
Merge Requests
1
CI / CD
CI / CD
Pipelines
Jobs
Schedules
Operations
Operations
Incidents
Environments
Analytics
Analytics
CI / CD
Repository
Value Stream
Wiki
Wiki
Snippets
Snippets
Members
Members
Collapse sidebar
Close sidebar
Activity
Graph
Create a new issue
Jobs
Commits
Issue Boards
Open sidebar
Job Cuppen
Advanced Programming
Commits
5c8c1de5
Commit
5c8c1de5
authored
Nov 14, 2019
by
Job Cuppen
Browse files
Options
Browse Files
Download
Email Patches
Plain Diff
generic somewhat working save for isunit
parent
16971ef9
Changes
2
Hide whitespace changes
Inline
Side-by-side
Showing
2 changed files
with
85 additions
and
29 deletions
+85
-29
week08/serialize8Start
week08/serialize8Start
+0
-0
week08/serialize8Start.icl
week08/serialize8Start.icl
+85
-29
No files found.
week08/serialize8Start
View file @
5c8c1de5
No preview for this file type
week08/serialize8Start.icl
View file @
5c8c1de5
...
...
@@ -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
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