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
Open sidebar
POTTIER Francois
menhir
Commits
eee0d9d3
Commit
eee0d9d3
authored
Jan 30, 2020
by
POTTIER Francois
Browse files
Remove [Misc.tabulateo] and export [Misc.tabulatef] instead.
parent
f9d3b859
Changes
3
Hide whitespace changes
Inline
Sidebyside
Showing
3 changed files
with
20 additions
and
35 deletions
+20
35
src/default.ml
src/default.ml
+7
5
src/misc.ml
src/misc.ml
+0
22
src/misc.mli
src/misc.mli
+13
8
No files found.
src/default.ml
View file @
eee0d9d3
...
...
@@ 57,13 +57,11 @@ module C = Conflict (* artificial dependency; ensures that [Conflict] runs first
terminate properly. From 2015/09/25 on, we again always allow default
reductions, as they seem to be beneficial when explaining syntax errors. *)
let
has_default_reduction
,
count
=
Misc
.
tabulateo
Lr1
.
number
Lr1
.
fold
Lr1
.
n
(
fun
s
>
let
has_default_reduction
:
Lr1
.
node
>
(
Production
.
index
*
TerminalSet
.
t
)
option
=
Misc
.
tabulatef
Lr1
.
number
Lr1
.
fold
Lr1
.
n
None
(
fun
s
>
if
Lr1
.
forbid_default_reduction
s
then
None
else
let
reduction
=
ProductionMap
.
is_singleton
(
Lr0
.
invert
(
Lr1
.
reductions
s
))
in
match
reduction
with

Some
_
>
...
...
@@ 72,10 +70,14 @@ let has_default_reduction, count =
else
None

None
>
reduction
)
let
()
=
let
count
=
Lr1
.
fold
(
fun
accu
s
>
if
has_default_reduction
s
=
None
then
accu
else
accu
+
1
)
0
in
Error
.
logC
1
(
fun
f
>
Printf
.
fprintf
f
"%d out of %d states have a default reduction.
\n
"
...
...
src/misc.ml
View file @
eee0d9d3
...
...
@@ 46,12 +46,6 @@ let sum n (f : int > int) : int =
done
;
!
sum
(* [tabulatef number fold n dummy f] returns a function that is extensionally
equal to [f], but relies on an internal array. Arguments to [f] are of type
['a] and are mapped by [number] into the range [0..n). [fold] allows
folding over the domain of [f]. [dummy] is used to initialize the internal
array. Its value has no impact if [fold] is surjective. *)
let
tabulatef
number
fold
n
dummy
f
=
let
a
=
Array
.
make
n
dummy
in
let
()
=
fold
(
fun
()
element
>
...
...
@@ 62,22 +56,6 @@ let tabulatef number fold n dummy f =
in
get
let
tabulateo
number
fold
n
f
=
let
c
=
ref
0
in
let
get
=
tabulatef
number
fold
n
None
(
fun
element
>
let
image
=
f
element
in
begin
match
image
with

Some
_
>
incr
c

None
>
()
end
;
image
)
in
get
,
!
c
type
'
a
iter
=
(
'
a
>
unit
)
>
unit
let
separated_iter_to_string
printer
separator
iter
=
...
...
src/misc.mli
View file @
eee0d9d3
...
...
@@ 40,14 +40,19 @@ val tabulate: int > (int > 'a) > (int > 'a)
val
sum
:
int
>
(
int
>
int
)
>
int
(* [tabulateo number fold n f] returns a function that is
extensionally equal to [f], but relies on an internal
array. Arguments to [f] are of type ['a] and are mapped by [number]
into the range [0..n). [fold] allows folding over the domain of
[f]. The result type of [f] is an option type, and [tabulateo] also
returns the number of points where [f] is [Some _]. *)
val
tabulateo
:
(
'
a
>
int
)
>
((
unit
>
'
a
>
unit
)
>
unit
>
unit
)
>
int
>
(
'
a
>
'
b
option
)
>
(
'
a
>
'
b
option
)
*
int
(* [tabulatef number fold n dummy f] returns a function that is extensionally
equal to [f], but relies on an internal array. Arguments to [f] are of type
['a] and are mapped by [number] into the range [0..n). [fold] allows
folding over the domain of [f]. [dummy] is used to initialize the internal
array. Its value has no impact if [fold] is surjective. *)
val
tabulatef
:
(
'
a
>
int
)
>
((
unit
>
'
a
>
unit
)
>
unit
>
unit
)
>
int
>
'
b
>
(
'
a
>
'
b
)
>
(
'
a
>
'
b
)
(* [separated_list_to_string printer sep l] converts [l] into a string
representation built by using [printer] on each element and [sep] as
...
...
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