Skip to content
GitLab
Projects
Groups
Snippets
Help
Loading...
Help
What's new
10
Help
Support
Community forum
Keyboard shortcuts
?
Submit feedback
Contribute to GitLab
Sign in
Toggle navigation
Open sidebar
Software
CoPaR
Commits
87b8ef1d
Commit
87b8ef1d
authored
Mar 13, 2019
by
Hans-Peter Deifel
🐢
Browse files
Options
Browse Files
Download
Email Patches
Plain Diff
Implement bitvectors and bitwise 'or' as monoid-valued functor
parent
7a6be645
Changes
3
Hide whitespace changes
Inline
Side-by-side
Showing
3 changed files
with
105 additions
and
0 deletions
+105
-0
src/Copar/Functors.hs
src/Copar/Functors.hs
+2
-0
src/Copar/Functors/MonoidValued.hs
src/Copar/Functors/MonoidValued.hs
+42
-0
tests/Copar/Functors/MonoidValuedSpec.hs
tests/Copar/Functors/MonoidValuedSpec.hs
+61
-0
No files found.
src/Copar/Functors.hs
View file @
87b8ef1d
...
...
@@ -19,6 +19,7 @@ import Copar.Functors.MonoidValued ( maxIntValued
,
maxRealValued
,
minRealValued
,
andWordValued
,
orWordValued
)
import
Copar.Functors.SomeFunctor
...
...
@@ -29,6 +30,7 @@ registeredFunctors =
,
someFunctor
maxRealValued
,
someFunctor
minRealValued
,
someFunctor
andWordValued
,
someFunctor
orWordValued
]
,
[
someFunctor
intValued
,
someFunctor
realValued
...
...
src/Copar/Functors/MonoidValued.hs
View file @
87b8ef1d
...
...
@@ -16,6 +16,7 @@ module Copar.Functors.MonoidValued
,
maxRealValued
,
minRealValued
,
andWordValued
,
orWordValued
)
where
...
...
@@ -237,6 +238,42 @@ andWordHelp =
<+>
Doc
.
reflow
"'{' X ':' 0xCAFE, ... '}'"
-- | The @(ℕ, or)^X@ functor
orWordValued
::
FunctorDescription
(
SlowMonoidValued
(
BitOr
Word
))
orWordValued
=
FunctorDescription
{
name
=
"BitOr-valued"
,
syntaxExample
=
"(N, or)^X"
,
description
=
Just
orWordHelp
,
functorExprParser
=
prefix
-- We need this try here, so that parenthesis can still be parsed as
-- normal if they don't contain exactly (N, or)
(
try
(
L
.
parens
((
L
.
symbol
"N"
<|>
L
.
symbol
"ℕ"
)
>>
L
.
comma
>>
L
.
symbol
"or"
)
)
>>
L
.
symbol
"^"
>>
pure
SlowMonoidValued
)
}
orWordHelp
::
Doc
.
Doc
Doc
.
AnsiStyle
orWordHelp
=
Doc
.
reflow
(
"Weighted systems with bitvectors or bitwise 'or' as monoid weight."
)
<>
Doc
.
line
<>
Doc
.
line
<>
Doc
.
reflow
"This is similar to all the group valued functors (int, real,
\
\
etc) but isn't actually a group as it lacks an inverse. Thus
\
\
the refinement interface implementation for this functor is
\
\
asymptotically slower than for the others."
<>
Doc
.
line
<>
Doc
.
line
<>
Doc
.
annotate
Doc
.
bold
"Functor syntax:"
<+>
Doc
.
reflow
"(N, or)^X"
<>
Doc
.
line
<>
Doc
.
line
<>
Doc
.
annotate
Doc
.
bold
"Coalgebra syntax:"
<+>
Doc
.
reflow
"'{' X ':' 0xCAFE, ... '}'"
type
instance
Label
(
SlowMonoidValued
m
)
=
m
type
instance
Weight
(
SlowMonoidValued
m
)
=
(
m
,
SumBag
m
)
type
instance
F1
(
SlowMonoidValued
m
)
=
m
...
...
@@ -297,6 +334,11 @@ instance ParseMorphism (SlowMonoidValued (BitAnd Word)) where
parseMorphismPointHelper
inner
L
.
hex
=<<
(
not
<$>
noSanityChecks
)
instance
ParseMorphism
(
SlowMonoidValued
(
BitOr
Word
))
where
parseMorphismPoint
(
SlowMonoidValued
inner
)
=
parseMorphismPointHelper
inner
L
.
hex
=<<
(
not
<$>
noSanityChecks
)
parseMorphismPointHelper
::
(
MonadParser
m
,
Ord
x
,
Monoid
w
)
=>
m
x
->
m
w
->
Bool
->
m
(
w
,
V
.
Vector
(
x
,
w
))
parseMorphismPointHelper
inner
weightParser
sanity
=
do
!
successors
<-
case
sanity
of
...
...
tests/Copar/Functors/MonoidValuedSpec.hs
View file @
87b8ef1d
...
...
@@ -38,6 +38,8 @@ spec = do
minRealRefineSpec
andWordParseSpec
andWordRefineSpec
orWordParseSpec
orWordRefineSpec
maxIntParseSpec
::
Spec
...
...
@@ -336,3 +338,62 @@ andWordRefineSpec = describe "andWord refine" $ do
let
Right
enc
=
p
"x: {x: 0xA0, y: 0x0A}
\n
y: {x: 0x0B, y: 0xB0}"
part
<-
stToIO
(
refine
proxy
enc
True
)
(
Part
.
toBlocks
part
)
`
shouldMatchList
`
[[
0
,
1
]]
orWordParseSpec
::
Spec
orWordParseSpec
=
describe
"bit-or parsing"
$
do
it
"can parse (N, or)^X as functor expression"
$
parseFunctorExpression
[[
functorExprParser
orWordValued
]]
""
"(N, or)^X"
`
shouldParse
`
(
Functor
1
(
SlowMonoidValued
Variable
))
it
"can parse (ℕ, or)^X as functor expression"
$
parseFunctorExpression
[[
functorExprParser
orWordValued
]]
""
"(ℕ, or)^X"
`
shouldParse
`
(
Functor
1
(
SlowMonoidValued
Variable
))
it
"nests correctly in functor expressions"
$
parseFunctorExpression
[[
functorExprParser
orWordValued
]]
""
"(N, or)^((N, or)^X)"
`
shouldParse
`
(
Functor
1
(
SlowMonoidValued
(
Functor
1
(
SlowMonoidValued
Variable
)))
)
it
"still parses parenthesis in functor expressions correctly"
$
do
parseFunctorExpression
[[
functorExprParser
orWordValued
]]
""
"((N, or)^X)"
`
shouldParse
`
(
Functor
1
(
SlowMonoidValued
Variable
))
parseFunctorExpression
[[
functorExprParser
orWordValued
]]
""
"(N, or)^(X)"
`
shouldParse
`
(
Functor
1
(
SlowMonoidValued
Variable
))
let
p
=
fmap
snd
.
parseMorphisms
(
Functor
1
(
SlowMonoidValued
@
(
BitOr
Word
)
Variable
))
EnableSanityChecks
""
it
"parses an empty successor list"
$
p
"x: {}"
`
shouldParse
`
encoding
[
Sorted
1
mempty
]
[]
it
"parses a simple example"
$
p
"x: {x: 0xA0, y: 0x0A}
\n
y: {}"
`
shouldParse
`
encoding
[
Sorted
1
0xAA
,
Sorted
1
mempty
]
[(
0
,
(
Sorted
1
0xA0
),
0
),
(
0
,
(
Sorted
1
0x0A
),
1
)]
it
"fails on duplicate edges"
$
p
`
shouldFailOn
`
"x: {x: 0xA, x: 0xA}"
orWordRefineSpec
::
Spec
orWordRefineSpec
=
describe
"orWord refine"
$
do
let
p
=
fmap
snd
.
parseMorphisms
(
Functor
1
(
SlowMonoidValued
@
(
BitOr
Word
)
Variable
))
EnableSanityChecks
""
proxy
=
Proxy
@
(
Desorted
(
SlowMonoidValued
(
BitOr
Word
)))
it
"it distinguishes different joins with equal sums"
$
do
let
Right
enc
=
p
"x: {x: 0xAA, y: 0xCC}
\n
y: {x: 0xBB, y: 0xBB}"
part
<-
stToIO
(
refine
proxy
enc
True
)
(
Part
.
toBlocks
part
)
`
shouldMatchList
`
[[
0
],
[
1
]]
it
"identifies equal joins with different sums"
$
do
let
Right
enc
=
p
"x: {x: 0xA0, y: 0x0A}
\n
y: {x: 0xAA, y: 0x00}"
part
<-
stToIO
(
refine
proxy
enc
True
)
(
Part
.
toBlocks
part
)
`
shouldMatchList
`
[[
0
,
1
]]
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