Skip to content
GitLab
Projects
Groups
Snippets
/
Help
Help
Support
Community forum
Keyboard shortcuts
?
Submit feedback
Contribute to GitLab
Sign in
Toggle navigation
Menu
Open sidebar
Informatik 8
CoPaR
Commits
b77cf5f4
Commit
b77cf5f4
authored
Jul 06, 2018
by
Hans-Peter Deifel
Browse files
Remove even more unused code
parent
33e9f5c7
Changes
4
Pipelines
2
Hide whitespace changes
Inline
Side-by-side
src/Algorithm.hs
View file @
b77cf5f4
...
...
@@ -43,6 +43,7 @@ import qualified Data.RefinablePartition as Partition
import
Data.RefinementInterface
(
RefinementInterface
)
import
qualified
Data.RefinementInterface
as
RI
import
Data.Sort
import
Data.Functors.SomeFunctor
data
AlgoState
s
h
=
AlgoState
{
toSub
::
MVector
s
[
EdgeRef
]
...
...
@@ -204,15 +205,17 @@ processQueue queue states = whileM $ Queue.dequeue queue >>= \case
data
SomeAlgoState
s
where
SomeAlgoState
::
RefinementInterface
h
=>
AlgoState
s
h
->
SomeAlgoState
s
type
Morphism
=
Encoding
(
RI
.
Label
SomeFunctor
)
(
RI
.
H1
SomeFunctor
)
initializeAll
::
Vector
Morphism
->
ST
s
(
BlockQueue
s
,
SortTable
(
SomeAlgoState
s
))
initializeAll
encodings
=
do
let
sizes
=
fmap
(
\
(
Morphism
_
x
)
->
size
x
)
encodings
let
sizes
=
fmap
size
encodings
queue
<-
Queue
.
empty
sizes
sorts
<-
iforM
(
V
.
zip
encodings
(
rotateVectorLeft
sizes
))
$
\
sort
(
Morphism
(
_
::
h
()
)
encoding
,
nextSize
)
->
do
(
blocks
,
state
)
<-
initialize
@
h
sort
encoding
nextSize
\
sort
(
encoding
,
nextSize
)
->
do
(
blocks
,
state
)
<-
initialize
@
SomeFunctor
sort
encoding
nextSize
mapM_
(
Queue
.
enqueue
queue
.
(
sort
,))
blocks
return
(
SomeAlgoState
state
)
...
...
src/Data/MorphismEncoding.hs
View file @
b77cf5f4
...
...
@@ -3,7 +3,6 @@
{-# LANGUAGE RecordWildCards #-}
module
Data.MorphismEncoding
(
Encoding
(
..
)
,
SomeEncoding
(
..
)
,
EdgeRef
(
..
)
,
Edge
(
..
)
,
new
...
...
@@ -32,12 +31,6 @@ data Encoding a h1 = Encoding
}
deriving
(
Show
)
data
SomeEncoding
where
SomeEncoding
::
(
Show
a
,
Show
h1
)
=>
Encoding
a
h1
->
SomeEncoding
deriving
instance
Show
SomeEncoding
new
::
Vector
h1
->
Vector
(
Edge
a
)
->
Encoding
a
h1
new
structure
edges
=
Encoding
{
..
}
...
...
src/Data/Sort.hs
View file @
b77cf5f4
...
...
@@ -3,16 +3,11 @@
{-# LANGUAGE KindSignatures #-}
{-# LANGUAGE DataKinds #-}
module
Data.Sort
(
Morphism
(
..
)
,
Sort
(
Sort
,
Sorted
,
SortTable
)
where
import
Data.Kind
import
Data.RefinementInterface
import
Data.MorphismEncoding
import
Data.Vector
(
Vector
)
...
...
@@ -22,9 +17,3 @@ type Sorted a = (Sort, a)
-- | This type maps sorts to 'a'
type
SortTable
a
=
Vector
a
-- TODO This should really be somewhere else
data
Morphism
::
Type
where
Morphism
::
RefinementInterface
h
=>
h
()
->
Encoding
(
Label
h
)
(
H1
h
)
->
Morphism
deriving
instance
Show
Morphism
src/Parser.hs
View file @
b77cf5f4
...
...
@@ -16,9 +16,9 @@ import qualified Text.Megaparsec as Megaparsec
import
Data.RefinementInterface
import
Data.Functors
(
registeredFunctors
)
import
Data.
S
or
t
import
qualified
MA.FunctorExpression.Parser
as
New
import
qualified
MA.FunctorExpression.Sorts
as
New
import
Data.
M
or
phismEncoding
import
MA.FunctorExpression.Parser
import
MA.FunctorExpression.Sorts
import
Data.Functors.SomeFunctor
...
...
@@ -28,20 +28,18 @@ instance Yaml.FromJSON RFIList where
parseJSON
=
Yaml
.
withText
"functor expression"
$
\
expr
->
do
let
res
=
New
.
parseFunctorExpression
registeredFunctors
"functor expression"
expr
parseFunctorExpression
registeredFunctors
"functor expression"
expr
case
res
of
Left
err
->
fail
$
"Invalid functor expression: "
++
Megaparsec
.
parseErrorPretty
err
Right
functorExpression
->
let
sorts
=
New
.
sortTable
(
New
.
annotateSorts
functorExpression
)
let
sorts
=
sortTable
(
annotateSorts
functorExpression
)
in
return
(
RFIList
sorts
)
newtype
CoalgebraSpecification
=
CoalgebraSpecification
{
fromCoalg
::
Vector
Morphism
}
deriving
(
Show
)
newtype
CoalgebraSpecification
=
CoalgebraSpecification
{
fromCoalg
::
Vector
(
Encoding
(
Label
SomeFunctor
)
(
H1
SomeFunctor
))
}
deriving
(
Show
)
instance
Yaml
.
FromJSON
CoalgebraSpecification
where
parseJSON
=
Yaml
.
withObject
"coalgebra"
$
\
obj
->
do
...
...
@@ -50,10 +48,11 @@ instance Yaml.FromJSON CoalgebraSpecification where
-- TODO Ensure functors and morphisms are of equal length
encodings
<-
forM
(
V
.
zip
functors
morphisms
)
$
\
(
functor
,
yamlValue
)
->
Morphism
functor
<$>
parse
functor
yamlValue
\
(
functor
,
yamlValue
)
->
parse
functor
yamlValue
return
(
CoalgebraSpecification
encodings
)
decodeCoalgebra
::
ByteString
->
Either
String
(
Vector
Morphism
)
decodeCoalgebra
::
ByteString
->
Either
String
(
Vector
(
Encoding
(
Label
SomeFunctor
)
(
H1
SomeFunctor
)))
decodeCoalgebra
=
fmap
fromCoalg
.
Yaml
.
decodeEither
Write
Preview
Supports
Markdown
0%
Try again
or
attach a new 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