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
b13befee
Commit
b13befee
authored
Dec 28, 2019
by
Job Cuppen
Browse files
Options
Browse Files
Download
Email Patches
Plain Diff
all
parent
50c4f265
Changes
3
Hide whitespace changes
Inline
Side-by-side
Showing
3 changed files
with
249 additions
and
58 deletions
+249
-58
week12_job/12.icl
week12_job/12.icl
+160
-0
week12_job/ex12
week12_job/ex12
+0
-0
week12_job/ex12.icl
week12_job/ex12.icl
+89
-58
No files found.
week12_job/12.icl
0 → 100644
View file @
b13befee
module
ex12
import
StdEnv
,
StdMaybe
,
StdDebug
import
Data
.
Functor
,
Control
.
Applicative
,
Control
.
Monad
::
BM
a
b
=
{
t
::
a
->
b
,
f
::
b
->
a
}
bm
::
BM
a
a
bm
=
{
f
=
id
,
t
=
id
}
::
Action
a
b
i
j
x
y
=
MoveToShip
(
BM
a
High
)
(
BM
b
High
)
(
BM
i
j
)
(
BM
x
Quay
)
(
BM
y
Ship
)
// move the crane to the ship
|
MoveToQuay
(
BM
a
High
)
(
BM
b
High
)
(
BM
i
j
)
(
BM
x
Ship
)
(
BM
y
Quay
)
// move the crane to the quay
|
MoveUp
(
BM
a
Low
)
(
BM
b
High
)
(
BM
i
j
)
(
BM
x
y
)
// moves the crane up
|
MoveDown
(
BM
a
High
)
(
BM
b
Low
)
(
BM
i
j
)
(
BM
x
y
)
// moves the crane down
|
Lock
(
BM
a
Low
)
(
BM
b
Low
)
(
BM
i
Empty
)
(
BM
j
Full
)
(
BM
x
y
)
// locks the top container of the stack under the crane
|
Unlock
(
BM
a
Low
)
(
BM
b
Low
)
(
BM
i
Full
)
(
BM
j
Empty
)
(
BM
x
y
)
// unlocks the container the crane is carrying, put it on the stack
|
Wait
(
BM
a
b
)
(
BM
i
j
)
(
BM
x
y
)
// do nothing
|
E
.
c
k
z
:(:.)
infixl
1
(
Action
a
c
i
k
x
z
)
(
Action
c
b
k
j
z
y
)
// sequence of two actions
|
WhileContainerBelow
(
Action
High
High
Empty
Empty
Quay
Quay
)
// repeat action while there is a container at current position
::
High
=
High
::
Low
=
Low
::
Quay
=
Quay
::
Ship
=
Ship
::
Full
=
Full
::
Empty
=
Empty
::
Result
r
=
Res
r
|
Err
String
::
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
}
moveDown
::
Action
High
Low
i
i
x
x
moveDown
=
MoveDown
bm
bm
bm
bm
moveUp
::
Action
Low
High
i
i
x
x
moveUp
=
MoveUp
bm
bm
bm
bm
moveToShip
::
Action
High
High
i
i
Quay
Ship
moveToShip
=
MoveToShip
bm
bm
bm
bm
bm
moveToQuay
::
Action
High
High
i
i
Ship
Quay
moveToQuay
=
MoveToQuay
bm
bm
bm
bm
bm
lock
::
Action
Low
Low
Empty
Full
x
x
lock
=
Lock
bm
bm
bm
bm
bm
test
::
Action
High
High
Empty
Full
Quay
Quay
test
=
moveUp
:.
lock
wait
::
Action
a
a
i
i
x
x
wait
=
Wait
bm
bm
bm
unlock
::
Action
Low
Low
Full
Empty
x
x
unlock
=
Unlock
bm
bm
bm
bm
bm
whileContainerBelow
::
(
Action
High
High
Empty
Empty
Quay
Quay
)
->
Action
High
High
Empty
Empty
Quay
Quay
whileContainerBelow
a
=
WhileContainerBelow
a
loadShip
::
Action
High
High
Empty
Empty
Quay
Quay
loadShip
=
whileContainerBelow
(
moveDown
:.
lock
:.
moveUp
:.
moveToShip
:.
wait
:.
moveDown
:.
wait
:.
unlock
:.
moveUp
:.
moveToQuay
)
highError
::
String
->
Result
State
highError
str
=
Err
(
"Can not do '"
+++
str
+++
"', crane is high!"
)
eval
::
(
Action
a
b
i
j
x
y
)
State
->
Result
State
eval
(
MoveUp
_
_
_
_)
st
=
Res
{
st
&
craneUp
=
True
}
eval
(
MoveDown
_
_
_
_)
st
=
Res
{
st
&
craneUp
=
False
}
eval
(
Unlock
_
_
_
_
_)
st
=
if
st
.
craneUp
(
highError
"Unlock"
)
case
st
.
locked
of
(
Just
a
)
->
if
st
.
craneOnQuay
(
unlockResultQuay
a
)
(
unlockResultShip
a
)
(
Nothing
)
->
(
Err
"Crane is empty!"
)
where
unlockResultShip
a
=
Res
{
st
&
locked
=
Nothing
,
onShip
=
[
a
:
st
.
onShip
]
}
unlockResultQuay
a
=
Res
{
st
&
locked
=
Nothing
,
onQuay
=
[
a
:
st
.
onQuay
]
}
eval
(
Lock
_
_
_
_
_)
st
=
if
st
.
craneUp
(
highError
"Lock"
)
if
(
isJust
st
.
locked
)
(
Err
"Crane is full!"
)
if
st
.
craneOnQuay
lockResultQuay
lockResultShip
where
lockResultShip
=
case
st
.
onShip
of
[
x
:
xs
]
->
(
Res
{
st
&
locked
=
Just
x
,
onShip
=
xs
})
[]
->
(
Err
"No crates left on ship"
)
lockResultQuay
=
case
st
.
onQuay
of
[
x
:
xs
]
->
(
Res
{
st
&
locked
=
Just
x
,
onQuay
=
xs
})
[]
->
(
Err
"No crates left on quay"
)
eval
(
MoveToShip
_
_
_
_
_)
st
=
if
(
not
st
.
craneOnQuay
)
(
Err
"Can not move to Ship already on Ship"
)
(
Res
{
st
&
craneOnQuay
=
False
})
eval
(
MoveToQuay
_
_
_
_
_)
st
=
if
st
.
craneOnQuay
(
Err
"Can not move to Quay already on Quay"
)
(
Res
{
st
&
craneOnQuay
=
True
})
eval
(
Wait
_
_
_)
st
=
Res
st
eval
(:.
a
b
)
st
=
case
eval
a
st
of
Res
st1
->
eval
b
st1
Err
str
->
Err
str
eval
(
WhileContainerBelow
a
)
st
=
if
(
containerBelow
st
)
iteration
(
Res
st
)
where
iteration
=
case
eval
a
st
of
(
Res
st1
)
->
eval
(
WhileContainerBelow
a
)
st1
(
Err
str
)
->
Err
str
isNotEmpty
=
(
not
o
isEmpty
)
containerBelow
::
State
->
Bool
containerBelow
s
=
if
s
.
craneOnQuay
(
isNotEmpty
s
.
onQuay
)
(
isNotEmpty
s
.
onShip
)
print
::
(
Action
a
b
i
j
x
y
)
->
[
String
]
print
(
MoveToShip
_
_
_
_
_)
=
[
"moveToShip"
]
print
(
MoveToQuay
_
_
_
_
_)
=
[
"moveToQuay"
]
print
(
MoveUp
_
_
_
_)
=
[
"moveUp"
]
print
(
MoveDown
_
_
_
_)
=
[
"moveDown"
]
print
(
Lock
_
_
_
_
_)
=
[
"lock"
]
print
(
Unlock
_
_
_
_
_)
=
[
"unlock"
]
print
(
Wait
_
_
_)
=
[
"wait"
]
print
(:.
a
b
)
=
print
a
++
[
":."
:
"
\n
"
:
print
b
]
print
(
WhileContainerBelow
a
)
=
[
"whileContainerBelow"
:
"("
:
"
\n
"
:
(
print
a
++
[
")"
])]
//Start = optimize (wait:.moveUp)
Start
=
eval
loadShip
initialState
//Start = print loadShip
week12_job/ex12
0 → 100755
View file @
b13befee
File added
week12_job/ex12.icl
View file @
b13befee
...
...
@@ -4,26 +4,26 @@ import StdEnv, StdMaybe, StdDebug
import
Data
.
Functor
,
Control
.
Applicative
,
Control
.
Monad
::
BM
a
b
=
{
t
::
a
->
b
,
f
::
b
->
a
{
t
::
a
->
b
,
f
::
b
->
a
}
bm
::
BM
a
a
bm
=
{
f
=
id
,
t
=
id
{
f
=
id
,
t
=
id
}
::
Action
a
b
x
y
=
MoveToShip
(
BM
a
High
)
(
BM
b
High
)
(
BM
x
Quay
)
(
BM
y
Ship
)
// move the crane to the ship
|
MoveToQuay
(
BM
a
High
)
(
BM
b
High
)
(
BM
x
Ship
)
(
BM
y
Quay
)
// move the crane to the quay
|
MoveUp
(
BM
a
Low
)
(
BM
b
High
)
(
BM
x
y
)
(
BM
x
y
)
// moves the crane up
|
MoveDown
(
BM
a
High
)
(
BM
b
Low
)
(
BM
x
y
)
(
BM
x
y
)
// moves the crane down
|
Lock
(
BM
a
Low
)
(
BM
b
Low
)
(
BM
x
y
)
(
BM
x
y
)
// locks the top container of the stack under the crane
|
Unlock
(
BM
a
Low
)
(
BM
b
Low
)
(
BM
x
y
)
(
BM
x
y
)
// unlocks the container the crane is carrying, put it on the stack
|
Wait
(
BM
a
b
)
(
BM
a
b
)
(
BM
x
y
)
(
BM
x
y
)
// do nothing
|
E
.
c
.
z
:(:.)
infixl
1
(
Action
a
c
x
z
)
(
Action
c
b
z
y
)
// sequence of two actions
|
WhileContainerBelow
(
Action
High
High
Quay
Quay
)
// repeat action while there is a container at current position
::
Action
a
b
i
j
x
y
=
MoveToShip
(
BM
a
High
)
(
BM
b
High
)
(
BM
i
j
)
(
BM
x
Quay
)
(
BM
y
Ship
)
// move the crane to the ship
|
MoveToQuay
(
BM
a
High
)
(
BM
b
High
)
(
BM
i
j
)
(
BM
x
Ship
)
(
BM
y
Quay
)
// move the crane to the quay
|
MoveUp
(
BM
a
Low
)
(
BM
b
High
)
(
BM
i
j
)
(
BM
x
y
)
// moves the crane up
|
MoveDown
(
BM
a
High
)
(
BM
b
Low
)
(
BM
i
j
)
(
BM
x
y
)
// moves the crane down
|
Lock
(
BM
a
Low
)
(
BM
b
Low
)
(
BM
i
Empty
)
(
BM
j
Full
)
(
BM
x
y
)
// locks the top container of the stack under the crane
|
Unlock
(
BM
a
Low
)
(
BM
b
Low
)
(
BM
i
Full
)
(
BM
j
Empty
)
(
BM
x
y
)
// unlocks the container the crane is carrying, put it on the stack
|
Wait
(
BM
a
b
)
(
BM
i
j
)
(
BM
x
y
)
// do nothing
|
E
.
c
k
z
:(:.)
infixl
1
(
Action
a
c
i
k
x
z
)
(
Action
c
b
k
j
z
y
)
// sequence of two actions
|
WhileContainerBelow
(
Action
High
High
Empty
Empty
Quay
Quay
)
// repeat action while there is a container at current position
::
High
=
High
::
Low
=
Low
...
...
@@ -31,12 +31,16 @@ bm =
::
Quay
=
Quay
::
Ship
=
Ship
::
Full
=
Full
::
Empty
=
Empty
::
Result
r
=
Res
r
|
Err
String
::
State
=
{
onShip
::
[
Container
]
,
onQuay
::
[
Container
]
,
craneOnQuay
::
Bool
,
craneUp
::
Bool
,
locked
::
Maybe
Container
}
...
...
@@ -46,34 +50,35 @@ initialState =
{
onShip
=
[]
,
onQuay
=
[
"apples"
,
"beer"
,
"camera"
]
,
craneOnQuay
=
True
,
craneUp
=
True
,
locked
=
Nothing
}
moveDown
::
Action
High
Low
x
x
moveDown
=
MoveDown
bm
bm
bm
bm
moveDown
::
Action
High
Low
i
i
x
x
moveDown
=
MoveDown
bm
bm
bm
bm
moveUp
::
Action
Low
High
x
x
moveUp
::
Action
Low
High
i
i
x
x
moveUp
=
MoveUp
bm
bm
bm
bm
moveToShip
::
Action
High
High
Quay
Ship
moveToShip
=
MoveToShip
bm
bm
bm
bm
moveToShip
::
Action
High
High
i
i
Quay
Ship
moveToShip
=
MoveToShip
bm
bm
bm
bm
bm
moveToQuay
::
Action
High
High
Ship
Quay
moveToQuay
=
MoveToQuay
bm
bm
bm
bm
moveToQuay
::
Action
High
High
i
i
Ship
Quay
moveToQuay
=
MoveToQuay
bm
bm
bm
bm
bm
lock
::
Action
Low
Low
x
x
lock
=
Lock
bm
bm
bm
bm
lock
::
Action
Low
Low
Empty
Full
x
x
lock
=
Lock
bm
bm
bm
bm
bm
wait
::
Action
a
a
x
x
wait
=
Wait
bm
bm
bm
bm
wait
::
Action
a
a
i
i
x
x
wait
=
Wait
bm
bm
bm
unlock
::
Action
Low
Low
x
x
unlock
=
Unlock
bm
bm
bm
bm
unlock
::
Action
Low
Low
Full
Empty
x
x
unlock
=
Unlock
bm
bm
bm
bm
bm
whileContainerBelow
::
(
Action
High
High
Quay
Quay
)
->
Action
High
High
Quay
Quay
whileContainerBelow
::
(
Action
High
High
Empty
Empty
Quay
Quay
)
->
Action
High
High
Empty
Empty
Quay
Quay
whileContainerBelow
a
=
WhileContainerBelow
a
loadShip
::
Action
High
High
Quay
Quay
loadShip
::
Action
High
High
Empty
Empty
Quay
Quay
loadShip
=
whileContainerBelow
(
moveDown
:.
lock
:.
...
...
@@ -87,40 +92,66 @@ loadShip = whileContainerBelow (
moveToQuay
)
eval
::
(
Action
a
b
x
y
)
State
->
Result
State
eval
(
MoveUp
_
_
_
_)
st
=
Res
st
eval
(
MoveDown
_
_
_
_)
st
=
Res
st
eval
(
Unlock
_
_
_
_)
st
|
st
.
craneOnQuay
=
Res
{
st
&
locked
=
Nothing
,
onQuay
=
[
fromJust
st
.
locked
:
st
.
onQuay
]
}
|
otherwise
=
Res
{
st
&
locked
=
Nothing
,
onShip
=
[
fromJust
st
.
locked
:
st
.
onShip
]
}
eval
(
Lock
_
_
_
_)
st
|
st
.
craneOnQuay
=
Res
{
st
&
locked
=
Just
(
hd
st
.
onQuay
),
onQuay
=
tl
st
.
onQuay
}
|
otherwise
=
Res
{
st
&
locked
=
Just
(
hd
st
.
onShip
),
onShip
=
tl
st
.
onShip
}
eval
(
MoveToShip
_
_
_
_)
st
=
Res
{
st
&
craneOnQuay
=
False
}
eval
(
MoveToQuay
_
_
_
_)
st
=
Res
{
st
&
craneOnQuay
=
True
}
eval
(
Wait
_
_
_
_)
st
=
Res
st
eval
(:.
a
b
)
st
=
case
eval
a
st
of
Res
st1
->
eval
b
st1
Err
str
->
Err
str
eval
(
WhileContainerBelow
a
)
st
=
if
quayNotEmpty
iteration
(
Res
st
)
highError
::
String
->
Result
State
highError
str
=
Err
(
"Can not do '"
+++
str
+++
"', crane is high!"
)
eval
::
(
Action
a
b
i
j
x
y
)
State
->
Result
State
eval
(
MoveUp
_
_
_
_)
st
=
Res
{
st
&
craneUp
=
True
}
eval
(
MoveDown
_
_
_
_)
st
=
Res
{
st
&
craneUp
=
False
}
eval
(
Unlock
_
_
_
_
_)
st
=
if
st
.
craneUp
(
highError
"Unlock"
)
case
st
.
locked
of
(
Just
a
)
->
if
st
.
craneOnQuay
(
unlockResultQuay
a
)
(
unlockResultShip
a
)
(
Nothing
)
->
(
Err
"Crane is empty!"
)
where
unlockResultShip
a
=
Res
{
st
&
locked
=
Nothing
,
onShip
=
[
a
:
st
.
onShip
]
}
unlockResultQuay
a
=
Res
{
st
&
locked
=
Nothing
,
onQuay
=
[
a
:
st
.
onQuay
]
}
eval
(
Lock
_
_
_
_
_)
st
=
if
st
.
craneUp
(
highError
"Lock"
)
if
(
isJust
st
.
locked
)
(
Err
"Crane is full!"
)
if
st
.
craneOnQuay
lockResultQuay
lockResultShip
where
lockResultShip
=
case
st
.
onShip
of
[
x
:
xs
]
->
(
Res
{
st
&
locked
=
Just
x
,
onShip
=
xs
})
[]
->
(
Err
"No crates left on ship"
)
lockResultQuay
=
case
st
.
onQuay
of
[
x
:
xs
]
->
(
Res
{
st
&
locked
=
Just
x
,
onQuay
=
xs
})
[]
->
(
Err
"No crates left on quay"
)
eval
(
MoveToShip
_
_
_
_
_)
st
=
if
(
not
st
.
craneOnQuay
)
(
Err
"Can not move to Ship already on Ship"
)
(
Res
{
st
&
craneOnQuay
=
False
})
eval
(
MoveToQuay
_
_
_
_
_)
st
=
if
st
.
craneOnQuay
(
Err
"Can not move to Quay already on Quay"
)
(
Res
{
st
&
craneOnQuay
=
True
})
eval
(
Wait
_
_
_)
st
=
Res
st
eval
(:.
a
b
)
st
=
case
eval
a
st
of
Res
st1
->
eval
b
st1
Err
str
->
Err
str
eval
(
WhileContainerBelow
a
)
st
=
if
(
containerBelow
st
)
iteration
(
Res
st
)
where
quayNotEmpty
=
length
st
.
onQuay
>
0
iteration
=
case
eval
a
st
of
iteration
=
case
eval
a
st
of
(
Res
st1
)
->
eval
(
WhileContainerBelow
a
)
st1
(
Err
str
)
->
Err
str
print
::
(
Action
a
b
x
y
)
->
[
String
]
print
(
MoveToShip
_
_
_
_)
=
[
"moveToShip"
]
print
(
MoveToQuay
_
_
_
_)
=
[
"moveToQuay"
]
print
(
MoveUp
_
_
_
_)
=
[
"moveUp"
]
print
(
MoveDown
_
_
_
_)
=
[
"moveDown"
]
print
(
Lock
_
_
_
_)
=
[
"lock"
]
print
(
Unlock
_
_
_
_)
=
[
"unlock"
]
print
(
Wait
_
_
_
_)
=
[
"wait"
]
isNotEmpty
=
(
not
o
isEmpty
)
containerBelow
::
State
->
Bool
containerBelow
s
=
if
s
.
craneOnQuay
(
isNotEmpty
s
.
onQuay
)
(
isNotEmpty
s
.
onShip
)
print
::
(
Action
a
b
i
j
x
y
)
->
[
String
]
print
(
MoveToShip
_
_
_
_
_)
=
[
"moveToShip"
]
print
(
MoveToQuay
_
_
_
_
_)
=
[
"moveToQuay"
]
print
(
MoveUp
_
_
_
_)
=
[
"moveUp"
]
print
(
MoveDown
_
_
_
_)
=
[
"moveDown"
]
print
(
Lock
_
_
_
_
_)
=
[
"lock"
]
print
(
Unlock
_
_
_
_
_)
=
[
"unlock"
]
print
(
Wait
_
_
_)
=
[
"wait"
]
print
(:.
a
b
)
=
print
a
++
[
":."
:
"
\n
"
:
print
b
]
print
(
WhileContainerBelow
a
)
=
[
"whileContainerBelow"
:
"("
:
"
\n
"
:
(
print
a
++
[
")"
])]
//Start =
loadShip
Start
=
eval
lo
adShip
initialState
//Start =
optimize (wait:.moveUp)
Start
=
eval
lo
ck
initialState
//Start = print loadShip
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