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
7119cd3f
Commit
7119cd3f
authored
Dec 31, 2019
by
Job Cuppen
Browse files
Options
Browse Files
Download
Email Patches
Plain Diff
all but eval for var works
parent
b13befee
Changes
1
Show whitespace changes
Inline
Side-by-side
Showing
1 changed file
with
288 additions
and
0 deletions
+288
-0
week13_job/ex13.icl
week13_job/ex13.icl
+288
-0
No files found.
week13_job/ex13.icl
0 → 100644
View file @
7119cd3f
module
ex13
import
StdEnv
,
StdMaybe
import
Data
.
Functor
,
Control
.
Applicative
,
Control
.
Monad
class
type
a
|
toString
,
TC
a
where
type
::
a
->
String
instance
type
Int
where
type
a
=
"int"
instance
type
Bool
where
type
a
=
"bool"
::
Expr
=
Expr
class
expr
v
where
containersBelow
::
(
v
Expr
Int
)
lit
::
a
->
v
Expr
a
|
type
a
(<.)
infix
4
::
(
v
Expr
t
)
(
v
Expr
t
)
->
v
Expr
Bool
|
<,
type
t
(>.)
x
y
:==
y
<.
x
(+.)
infix
4
::
(
v
Expr
t
)
(
v
Expr
t
)
->
v
Expr
t
|
+,
type
t
::
Step
init
target
=
Step
init
target
::
High
=
High
::
Low
=
Low
::
Act
=
Act
class
action
v
where
(:.)
infixl
1
::
(
v
Act
(
Step
a
b
))
(
v
Act
(
Step
b
c
))
->
v
Act
(
Step
a
c
)
moveToShip
::
v
Act
(
Step
High
High
)
moveToQuay
::
v
Act
(
Step
High
High
)
moveUp
::
v
Act
(
Step
Low
High
)
moveDown
::
v
Act
(
Step
High
Low
)
lock
::
v
Act
(
Step
Low
Low
)
unlock
::
v
Act
(
Step
Low
Low
)
wait
::
v
Act
(
Step
x
x
)
While
::
(
v
Expr
Bool
)
(
v
Act
t
)
->
v
Act
()
class
var
v
where
(=.)
infixr
2
::
(
v
Var
t
)
(
v
Expr
t
)
->
v
Act
(
Step
x
y
)
|
type
t
int
::
(
v
Expr
t
)
((
v
Var
t
)
->
(
v
Act
u
))
->
v
Act
u
|
type
t
var
::
(
v
Var
t
)
->
(
v
Expr
t
)
|
type
t
loadShip
=
While
(
containersBelow
>.
lit
0
)
(
moveDown
:.
lock
:.
moveUp
:.
moveToShip
:.
wait
:.
moveDown
:.
wait
:.
unlock
:.
moveUp
:.
moveToQuay
)
loadShip2
=
int
containersBelow
\
n
.
While
(
var
n
>.
lit
0
)
(
moveDown
:.
lock
:.
moveUp
:.
moveToShip
:.
wait
:.
moveDown
:.
wait
:.
unlock
:.
moveUp
:.
moveToQuay
:.
n
=.
var
n
+.
lit
-1
)
::
Show
p
t
=
Show
(
SHOW
->(
t
,
SHOW
))
::
SHOW
=
{
fresh
::
Int
,
indent
::
Int
,
print
::
[
String
]
}
s0
::
SHOW
s0
=
{
fresh
=
0
,
indent
=
0
,
print
=
[
"
\n
"
]
}
c
::
t
->
Show
p
u
|
toString
t
c
a
=
Show
\
c
.(
undef
,
{
c
&
print
=
[
toString
a
:
c
.
print
]})
unShow
::
(
Show
p
t
)
->
(
SHOW
->(
t
,
SHOW
))
unShow
(
Show
t
)
=
t
instance
Functor
(
Show
p
)
where
fmap
f
(
Show
e
)
=
Show
\
s
.
let
(
a
,
t
)
=
e
s
in
(
f
a
,
t
)
instance
pure
(
Show
p
)
where
pure
a
=
Show
\
s
.(
a
,
s
)
instance
<*>
(
Show
p
)
where
<*>
f
a
=
f
>>=
\
g
.
a
>>=
\
b
.
pure
(
g
b
)
instance
Monad
(
Show
p
)
where
bind
(
Show
e
)
f
=
Show
\
s
.
let
(
a
,
t
)
=
e
s
in
unShow
(
f
a
)
t
class
tie
v
where
(>>-)
infixl
1
::
(
v
p
t
)
(
t
->
v
q
u
)
->
v
r
u
(>>!)
infixl
1
::
(
v
p
t
)
(
v
q
u
)
->
v
q
u
(>>!)
x
y
=
x
>>-
\_.
y
(<*.>)
infixl
4
::
(
v
p
(
t
->
u
))
(
v
q
t
)
->
v
r
u
|
tie
v
&
Monad
(
v
q
)
(<*.>)
f
a
=
f
>>-
\
g
.
a
>>=
\
b
.
pure
(
g
b
)
instance
tie
Show
where
>>-
(
Show
e
)
f
=
Show
\
s
.
let
(
a
,
t
)
=
e
s
in
unShow
(
f
a
)
t
brac
::
(
Show
p
t
)
->
Show
q
s
brac
e
=
c
"("
>>!
e
>>!
c
")"
fresh
::
Show
p
Int
fresh
=
Show
\
c
.(
c
.
fresh
,
{
c
&
fresh
=
inc
c
.
fresh
})
freshVar
::
Show
p
String
freshVar
=
fmap
(\
n
.
"v"
+++
toString
n
)
fresh
freshShow
::
Show
p
(
Show
q
t
)
freshShow
=
fmap
c
freshVar
indent
::
Show
p
Int
indent
=
Show
\
c
.
let
n
=
inc
c
.
indent
in
(
n
,
{
c
&
indent
=
n
})
unindent
::
Show
p
Int
unindent
=
Show
\
c
.
let
n
=
max
(
dec
c
.
indent
)
0
in
(
n
,
{
c
&
indent
=
n
})
nl
::
Show
p
t
nl
=
Show
\
c
.(
undef
,{
c
&
print
=
[
toString
[
'
\n
'
:repeatn (2 * c.indent)
'
'
]:
c
.
print
]})
instance
expr
Show
where
containersBelow
=
c
"containersBelow"
lit
a
=
c
"lit "
>>!
c
a
(<.)
x
y
=
brac
(
x
>>!
c
" <. "
>>!
y
)
(+.)
x
y
=
brac
(
x
>>!
c
" +. "
>>!
y
)
instance
action
Show
where
(:.)
s
t
=
s
>>!
c
":."
>>!
nl
<*.>
t
moveToShip
=
c
"moveToShip"
moveToQuay
=
c
"moveToQuay"
moveUp
=
c
"moveUp"
moveDown
=
c
"moveDown"
lock
=
c
"lock"
unlock
=
c
"unlock"
wait
=
c
"wait"
While
b
s
=
c
"While "
>>!
b
>>!
c
" ("
>>!
indent
>>!
nl
>>!
s
>>!
unindent
>>!
nl
>>!
c
")"
>>!
nl
instance
var
Show
where
(=.)
v
e
=
v
>>!
c
" = "
<*.>
e
int
a
f
=
c
"int "
>>!
freshShow
>>=
\
v
.
v
>>!
c
" = "
>>!
a
>>!
c
";"
>>!
nl
>>!
f
v
var
n
=
c
"var "
<*.>
n
::
State
=
{
onShip
::
[
Container
]
,
onQuay
::
[
Container
]
,
craneOnQuay
::
Bool
,
craneUp
::
Bool
,
locked
::
Maybe
Container
}
::
Container
:==
String
initialState
=
{
onShip
=
[]
,
onQuay
=
[
"apples"
,
"beer"
,
"camera"
]
,
craneOnQuay
=
True
,
craneUp
=
True
,
locked
=
Nothing
}
::
Result
t
=
Res
t
|
Err
String
::
Eval
p
t
=
Eval
(
State
->
(
Result
t
,
State
))
instance
Functor
Result
where
fmap
f
(
Res
t
)
=
Res
(
f
t
)
fmap
f
(
Err
str
)
=
Err
str
instance
Functor
(
Eval
p
)
where
fmap
f
(
Eval
e
)
=
Eval
\
s
.
let
(
a
,
st
)
=
e
s
in
(
fmap
f
a
,
st
)
instance
pure
Result
where
pure
a
=
Res
a
instance
pure
(
Eval
p
)
where
pure
a
=
Eval
\
s
.(
pure
a
,
s
)
instance
<*>
(
Eval
p
)
where
<*>
f
a
=
f
>>=
\
g
.
a
>>=
\
b
.
pure
(
g
b
)
unEval
::
(
Eval
p
t
)
->
(
State
->
(
Result
t
,
State
))
unEval
(
Eval
t
)
=
t
instance
Monad
(
Eval
p
)
where
bind
(
Eval
e
)
f
=
Eval
\
s
.
case
e
s
of
(
Res
a
,
t
)
=
unEval
(
f
a
)
t
(
Err
e
,
t
)
=
(
Err
e
,
t
)
instance
tie
Eval
where
(>>-)
(
Eval
e
)
f
=
Eval
\
s
.
case
e
s
of
(
Res
a
,
t
)
=
unEval
(
f
a
)
t
(
Err
e
,
t
)
=
(
Err
e
,
t
)
concat
::
[
String
]
->
String
concat
s
=
foldr
(+++)
""
s
instance
expr
Eval
where
containersBelow
=
Eval
\
s
->(
pure
(
value
s
),
s
)
where
l
list
=
length
list
value
s
=
if
s
.
craneOnQuay
(
l
s
.
onQuay
)
(
l
s
.
onShip
)
lit
a
=
pure
a
(<.)
x
y
=
pure
(<)
<*.>
x
<*.>
y
(+.)
x
y
=
pure
(+)
<*.>
x
<*.>
y
instance
action
Eval
where
(:.)
(
Eval
x
)
(
Eval
y
)
=
Eval
\
s
.
case
x
s
of
(
Res
(
Step
a
b
),
ss
)
->
case
y
ss
of
(
Res
(
Step
b
c
),
sss
)
->
(
Res
(
Step
a
c
),
sss
)
(
Err
e
,
g
)
->
(
Err
e
,
g
)
(
Err
e
,
g
)
->
(
Err
e
,
g
)
moveToShip
=
Eval
\
s
->
if
s
.
craneOnQuay
(
Res
(
Step
High
High
),
{
s
&
craneOnQuay
=
False
})
(
Err
"ERROR5"
,
s
)
moveToQuay
=
Eval
\
s
->
if
s
.
craneOnQuay
(
Err
"ERROR4"
,
s
)
(
Res
(
Step
High
High
),
{
s
&
craneOnQuay
=
True
})
moveUp
=
Eval
\
s
->
(
Res
(
Step
Low
High
),
{
s
&
craneUp
=
True
})
moveDown
=
Eval
\
s
->
(
Res
(
Step
High
Low
),
{
s
&
craneUp
=
False
})
lock
=
Eval
\
s
->
if
s
.
craneUp
(
Err
"ERROR3"
,
s
)
if
(
isJust
s
.
locked
)
(
Err
"ERROR2"
,
s
)
if
s
.
craneOnQuay
(
lockResultQuay
s
)
(
lockResultShip
s
)
where
lockResultShip
s
=
case
s
.
onShip
of
[
x
:
xs
]
->
(
Res
(
Step
Low
Low
),
{
s
&
locked
=
Just
x
,
onShip
=
xs
})
[]
->
(
Err
"No crates left on ship"
,
s
)
lockResultQuay
s
=
case
s
.
onQuay
of
[
x
:
xs
]
->
(
Res
(
Step
Low
Low
),
{
s
&
locked
=
Just
x
,
onQuay
=
xs
})
[]
->
(
Err
"No crates left on quay"
,
s
)
unlock
=
Eval
\
s
->
if
s
.
craneUp
(
Err
"ERROR1"
,
s
)
case
s
.
locked
of
(
Just
a
)
->
if
s
.
craneOnQuay
(
unlockResultQuay
a
s
)
(
unlockResultShip
a
s
)
(
Nothing
)
->
(
Err
"Crane is empty!"
,
s
)
where
unlockResultShip
a
s
=
(
Res
(
Step
Low
Low
),
{
s
&
locked
=
Nothing
,
onShip
=
[
a
:
s
.
onShip
]
})
unlockResultQuay
a
s
=
(
Res
(
Step
Low
Low
),
{
s
&
locked
=
Nothing
,
onQuay
=
[
a
:
s
.
onQuay
]
})
wait
=
Eval
\
s
->
(
Res
(
Step
undef
undef
),
s
)
While
c
a
=
Eval
\
s
.
case
(
unEval
c
)
s
of
(
Res
True
,
ss
)
->
case
(
unEval
a
)
ss
of
(
Res
_,
s
)
->
let
(
Eval
z
)
=
While
c
a
in
z
s
(
Err
e
,
g
)
->
(
Err
e
,
g
)
(
Res
False
,
s
)
->
(
Res
(),
s
)
(
Err
e
,
g
)
->
(
Err
e
,
g
)
instance
var
Eval
where
(=.)
a
b
=
Eval
\
s
->
(
Err
"ERROR()"
,
s
)
int
a
f
=
Eval
\
s
->
(
Err
"ERROR()"
,
s
)
var
n
=
Eval
\
s
->
(
Err
"ERROR()"
,
s
)
::
Var
=
Var
Id
::
Id
:==
Int
test
=
(
lit
33
)
test2
=
containersBelow
test4
=
moveToQuay
:.
moveToQuay
test5
=
int
(
lit
3
)
\
x
.
While
(
var
x
>.
lit
2
)
(
x
=.
(
lit
2
))
//Start = let (Show f) = loadShip in (concat o reverse) (snd (f s0)).print
Start
=
let
(
Show
f
)
=
loadShip2
in
(
concat
o
reverse
)
(
snd
(
f
s0
)).
print
//Start = let (Eval f) = test4 in (f initialState)
//Start = let (Eval f) = loadShip in (f initialState)
//Start = let (Eval f) = loadShip2 in (f initialState)
\ 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