Skip to content
GitLab
Menu
Projects
Groups
Snippets
Loading...
Help
Help
Support
Community forum
Keyboard shortcuts
?
Submit feedback
Contribute to GitLab
Sign in
Toggle navigation
Menu
Open sidebar
POTTIER Francois
menhir
Commits
cc7fc51e
Commit
cc7fc51e
authored
Apr 29, 2016
by
POTTIER Francois
Browse files
Remove trailing whitespace.
parent
4172c02f
Changes
84
Hide whitespace changes
Inline
Sidebyside
src/Engine.ml
View file @
cc7fc51e
...
...
@@ 69,7 +69,7 @@ module Make (T : TABLE) = struct
let
rec
run
env
please_discard
:
semantic_value
checkpoint
=
(* Log the fact that we just entered this state. *)
if
log
then
Log
.
state
env
.
current
;
...
...
@@ 346,7 +346,7 @@ module Make (T : TABLE) = struct
(* [start s] begins the parsing process. *)
let
start
(
s
:
state
)
(
initial
:
Lexing
.
position
)
:
semantic_value
checkpoint
=
(* Build an empty stack. This is a dummy cell, which is its own successor.
Its [next] field WILL be accessed by [error_fail] if an error occurs and
is propagated all the way until the stack is empty. Its [endp] field WILL
...
...
src/Fix.ml
View file @
cc7fc51e
...
...
@@ 296,7 +296,7 @@ module Workset : sig
(* [insert node] inserts [node] into the workset. [node] must have no
successors. *)
val
insert
:
node
>
unit
val
insert
:
node
>
unit
(* [repeat f] repeatedly applies [f] to a node extracted out of the
workset, until the workset becomes empty. [f] is allowed to use
...
...
@@ 304,7 +304,7 @@ module Workset : sig
val
repeat
:
(
node
>
unit
)
>
unit
(* That's it! *)
end
end
=
struct
(* Initialize the workset. *)
...
...
src/Fix.mli
View file @
cc7fc51e
...
...
@@ 95,4 +95,3 @@ module Make
computation takes place, on demand, when [get] is applied. *)
val
lfp
:
equations
>
valuation
end
\ No newline at end of file
src/IL.mli
View file @
cc7fc51e
...
...
@@ 54,7 +54,7 @@ and typedef = {
(* Constraint. *)
typeconstraint
:
(
typ
*
typ
)
option
}
}
and
typedefrhs
=

TDefRecord
of
fielddef
list
...
...
@@ 72,7 +72,7 @@ and fielddef = {
(* Type of the field. *)
fieldtype
:
typescheme
}
}
and
datadef
=
{
...
...
@@ 86,10 +86,10 @@ and datadef = {
[None] if this is an ordinary ADT. *)
datatypeparams
:
typ
list
option
;
}
}
and
typ
=
(* Textual OCaml type. *)

TypTextual
of
Stretch
.
ocamltype
...
...
@@ 113,7 +113,7 @@ and typescheme = {
(* Body. *)
body
:
typ
;
}
}
and
valdef
=
{
...
...
@@ 129,7 +129,7 @@ and valdef = {
(* Value to which it is bound. *)
valval
:
expr
}
}
and
expr
=
...
...
@@ 197,7 +197,7 @@ and branch = {
(* Branch body. *)
branchbody
:
expr
;
}
}
and
pattern
=
...
...
src/IncrementalEngine.ml
View file @
cc7fc51e
...
...
@@ 229,7 +229,7 @@ module type SYMBOLS = sig
['a symbol]. This type is useful in situations where the index ['a]
is not statically known. *)
type
xsymbol
=
type
xsymbol
=

X
:
'
a
symbol
>
xsymbol
end
...
...
src/InfiniteArray.ml
View file @
cc7fc51e
...
...
@@ 5,7 +5,7 @@ type 'a t = {
default
:
'
a
;
mutable
table
:
'
a
array
;
mutable
extent
:
int
;
(* the index of the greatest [set] ever, plus one *)
}
}
let
default_size
=
16384
(* must be nonzero *)
...
...
@@ 14,7 +14,7 @@ let make x = {
default
=
x
;
table
=
Array
.
make
default_size
x
;
extent
=
0
;
}
}
let
rec
new_length
length
i
=
if
i
<
length
then
...
...
src/InspectionTableInterpreter.ml
View file @
cc7fc51e
...
...
@@ 18,7 +18,7 @@ end) = struct

T
:
'
a
terminal
>
'
a
symbol

N
:
'
a
nonterminal
>
'
a
symbol
type
xsymbol
=
type
xsymbol
=

X
:
'
a
symbol
>
xsymbol
end
...
...
src/LRijkstra.ml
View file @
cc7fc51e
...
...
@@ 484,7 +484,7 @@ type fact = {
(* To save memory (and therefore time), we encode a fact in a single OCaml
integer value. This is made possible by the fact that tries, words, and
terminal symbols are represented as (or can be encoded as) integers.
terminal symbols are represented as (or can be encoded as) integers.
This admittedly horrible hack allows us to save roughly a factor of 2
in space, and to gain 10% in time. *)
...
...
@@ 682,7 +682,7 @@ let () =
(whose word has minimal length). Indeed, we are not interested in keeping
track of several words that produce the same effect. Only the shortest such
word is of interest.
Thus, the total number of facts accumulated by the algorithm is at most
[T.n^2], where [T] is the total size of the tries that we have constructed,
and [n] is the number of terminal symbols. (This number can be quite large.
...
...
@@ 797,7 +797,7 @@ end
(* The module [E] is in charge of recording the nonterminal edges that we have
discovered, or more precisely, the conditions under which these edges can be
taken.
It maintains a set of quadruples [s, nt, w, z], where such a quadruple means
that in the state [s], the outgoing edge labeled [nt] can be taken by
consuming the word [w], under the assumption that the next symbol is [z].
...
...
@@ 972,7 +972,7 @@ let new_fact fact =
(* Throughout this rather long function, there is just one [fact]. Let's
name its components right now, so as to avoid accessing them several
times. (That could be costly, as it requires decoding the fact.) *)
let
position
=
position
fact
let
position
=
position
fact
and
lookahead
=
lookahead
fact
and
word
=
word
fact
in
let
source
=
Trie
.
source
position
...
...
@@ 981,7 +981,7 @@ let new_fact fact =
(* 1. View [fact] as a vertex. Examine the transitions out of [current].
For every transition labeled by a symbol [sym] and into a state
[target], ... *)
Lr1
.
transitions
current
>
SymbolMap
.
iter
(
fun
sym
target
>
(* ... try to follow this transition in the trie [position],
down to a child which we call [child]. *)
...
...
@@ 994,7 +994,7 @@ let new_fact fact =
()

child
,
Symbol
.
T
t
>
(* 1a. The transition exists in the trie, and [sym] is in fact a
terminal symbol [t]. We note that [t] cannot be the [error] token,
because the trie does not have any edges labeled [error]. *)
...
...
@@ 1005,7 +1005,7 @@ let new_fact fact =
(* If the lookahead assumption [lookahead] is compatible with
[t], then we derive a new fact, where one more edge has been taken,
and enqueue this new fact for later examination. *)
(* The state [target] is solid, i.e., its incoming symbol is terminal.
This state is always entered without consideration for the next
lookahead symbol. Thus, we can use [any] as the lookahead assumption
...
...
@@ 1033,7 +1033,7 @@ let new_fact fact =
(* It could be the case that, due to a default reduction, the answer
to our query does not depend on [z], and we are wasting work.
However, allowing [z] to be [any] in [E.query], and taking
However, allowing [z] to be [any] in [E.query], and taking
advantage of this to increase performance, seems difficult. *)
let
foreach
=
foreach_terminal_not_causing_an_error
target
in
...
...
src/Maps.ml
View file @
cc7fc51e
...
...
@@ 38,16 +38,16 @@ module PersistentMapsToImperativeMaps
type
key
=
M
.
key
type
'
data
t
=
'
data
M
.
t
ref
let
create
()
=
ref
M
.
empty
let
clear
t
=
t
:=
M
.
empty
let
add
k
d
t
=
t
:=
M
.
add
k
d
!
t
...
...
src/PackedIntArray.ml
View file @
cc7fc51e
...
...
@@ 41,7 +41,7 @@ let magnitude (v : int) =
let
pack
(
a
:
int
array
)
:
t
=
let
m
=
Array
.
length
a
in
(* Compute the maximum magnitude of the array elements. This tells
us how many bits per element we are going to use. *)
...
...
src/RowDisplacement.ml
View file @
cc7fc51e
...
...
@@ 61,7 +61,7 @@ let compress
(
insignificant
:
'
a
>
bool
)
(
dummy
:
'
a
)
(
m
:
int
)
(
n
:
int
)
(
t
:
'
a
array
array
)
(
t
:
'
a
array
array
)
:
'
a
table
=
(* Be defensive. *)
...
...
@@ 187,7 +187,7 @@ let compress
else
fit
(
k
+
1
)
row
in
let
fit
row
=
match
row
with

[]
>
...
...
src/TableFormat.ml
View file @
cc7fc51e
...
...
@@ 4,7 +4,7 @@
module
type
TABLES
=
sig
(* This is the parser's type of tokens. *)
type
token
(* This maps a token to its internal (generationtime) integer code. *)
...
...
@@ 105,7 +105,7 @@ module type TABLES = sig
actions. The calling convention for semantic actions is described in
[EngineTypes]. This table contains ONLY NONSTART PRODUCTIONS, so the
indexing is off by [start]. Be careful. *)
val
semantic_action
:
((
int
,
Obj
.
t
,
token
)
EngineTypes
.
env
>
(
int
,
Obj
.
t
)
EngineTypes
.
stack
)
array
...
...
src/TableInterpreter.ml
View file @
cc7fc51e
...
...
@@ 15,22 +15,22 @@ module Make (T : TableFormat.TABLES)
type
semantic_value
=
Obj
.
t
let
token2terminal
=
T
.
token2terminal
let
token2value
=
T
.
token2value
let
error_terminal
=
T
.
error_terminal
let
error_value
=
Obj
.
repr
()
type
production
=
int
let
default_reduction
state
defred
nodefred
env
=
let
code
=
PackedIntArray
.
get
T
.
default_reduction
state
in
if
code
=
0
then
...
...
@@ 40,7 +40,7 @@ module Make (T : TableFormat.TABLES)
let
is_start
prod
=
prod
<
T
.
start
(* This auxiliary function helps access a compressed, twodimensional
matrix, like the action and goto tables. *)
...
...
@@ 72,7 +72,7 @@ module Make (T : TableFormat.TABLES)

c
>
assert
(
c
=
0
);
fail
env
let
goto
state
prod
=
let
code
=
unmarshal2
T
.
goto
state
(
PackedIntArray
.
get
T
.
lhs
prod
)
in
(* code = 1 + state *)
...
...
@@ 84,42 +84,42 @@ module Make (T : TableFormat.TABLES)
type
semantic_action
=
(
state
,
semantic_value
,
token
)
EngineTypes
.
env
>
(
state
,
semantic_value
)
EngineTypes
.
stack
let
semantic_action
prod
=
(* Indexing into the array [T.semantic_action] is off by [T.start],
because the start productions do not have entries in this array. *)
T
.
semantic_action
.
(
prod

T
.
start
)
(* If [T.trace] is [None], then the logging functions do nothing. *)
let
log
=
match
T
.
trace
with
Some
_
>
true

None
>
false
module
Log
=
struct
open
Printf
let
state
state
=
match
T
.
trace
with

Some
_
>
fprintf
stderr
"State %d:
\n
%!"
state

None
>
()
let
shift
terminal
state
=
match
T
.
trace
with

Some
(
terminals
,
_
)
>
fprintf
stderr
"Shifting (%s) to state %d
\n
%!"
terminals
.
(
terminal
)
state

None
>
()
let
reduce_or_accept
prod
=
match
T
.
trace
with

Some
(
_
,
productions
)
>
fprintf
stderr
"%s
\n
%!"
productions
.
(
prod
)

None
>
()
let
lookahead_token
token
startp
endp
=
match
T
.
trace
with

Some
(
terminals
,
_
)
>
...
...
@@ 129,29 +129,29 @@ module Make (T : TableFormat.TABLES)
endp
.
Lexing
.
pos_cnum

None
>
()
let
initiating_error_handling
()
=
match
T
.
trace
with

Some
_
>
fprintf
stderr
"Initiating error handling
\n
%!"

None
>
()
let
resuming_error_handling
()
=
match
T
.
trace
with

Some
_
>
fprintf
stderr
"Resuming error handling
\n
%!"

None
>
()
let
handling_error
state
=
match
T
.
trace
with

Some
_
>
fprintf
stderr
"Handling error in state %d
\n
%!"
state

None
>
()
end
end
)
src/action.ml
View file @
cc7fc51e
...
...
@@ 19,7 +19,7 @@ type t = {
(* Creation. *)
let
from_stretch
s
=
{
let
from_stretch
s
=
{
expr
=
IL
.
ETextual
s
;
filenames
=
[
s
.
Stretch
.
stretch_filename
];
keywords
=
KeywordSet
.
of_list
s
.
Stretch
.
stretch_keywords
...
...
@@ 36,7 +36,7 @@ let define keyword keywords f action =
(* Composition, used during inlining. *)
let
compose
x
a1
a2
=
let
compose
x
a1
a2
=
(* 2015/07/20: there used to be a call to [parenthesize_stretch] here,
which would insert parentheses around every stretch in [a1]. This is
not necessary, as far as I can see, since every stretch that represents
...
...
@@ 54,10 +54,10 @@ type subst =
(
string
*
string
)
list
let
apply
(
phi
:
subst
)
(
s
:
string
)
:
string
=
try
try
List
.
assoc
s
phi
with
Not_found
>
s
s
let
apply_subject
(
phi
:
subst
)
(
subject
:
subject
)
:
subject
=
match
subject
with
...
...
@@ 88,7 +88,7 @@ let rename_keyword (f : sw > sw option) (phi : subst ref) keyword : keyword =

SyntaxError
>
SyntaxError

Position
(
subject
,
where
,
flavor
)
>
let
subject'
,
where'
=
let
subject'
,
where'
=
match
f
(
subject
,
where
)
with

Some
(
subject'
,
where'
)
>
subject'
,
where'
...
...
@@ 107,7 +107,7 @@ let rename_keyword (f : sw > sw option) (phi : subst ref) keyword : keyword =
returning [Some _], or to not transform it, by returning [None]. (In the
latter case, [phi] still applies to the keyword.) *)
let
rename
f
phi
a
=
let
rename
f
phi
a
=
(* Rename all keywords, growing [phi] as we go. *)
let
keywords
=
a
.
keywords
in
...
...
@@ 120,25 +120,25 @@ let rename f phi a =
let
phi
=
List
.
map
(
fun
(
x
,
y
)
>
IL
.
PVar
x
,
IL
.
EVar
y
)
phi
in
let
expr
=
IL
.
ELet
(
phi
,
a
.
expr
)
in
{
{
expr
=
expr
;
filenames
=
a
.
filenames
;
keywords
=
keywords
;
}
let
to_il_expr
action
=
let
to_il_expr
action
=
action
.
expr
let
filenames
action
=
let
filenames
action
=
action
.
filenames
let
keywords
action
=
let
keywords
action
=
action
.
keywords
let
print
f
action
=
let
module
P
=
Printer
.
Make
(
struct
let
f
=
f
let
locate_stretches
=
None
end
)
let
print
f
action
=
let
module
P
=
Printer
.
Make
(
struct
let
f
=
f
let
locate_stretches
=
None
end
)
in
P
.
expr
action
.
expr
...
...
src/astar.ml
View file @
cc7fc51e
...
...
@@ 112,7 +112,7 @@ end) = struct
let
add
node
inode
=
H
.
add
t
node
inode
let
get
node
=
H
.
find
t
node
...
...
src/attic/automatonGraph.ml
View file @
cc7fc51e
...
...
@@ 18,7 +18,7 @@ module G = struct
Lr1
.
transitions
s
>
SymbolMap
.
iter
(
fun
symbol
s'
>
action
~
label
:
(
Symbol
.
print
symbol
)
s'
)
let
iter
(
action
:
?
shape
:
Dot
.
shape
>
?
style
:
Dot
.
style
>
label
:
string
>
vertex
>
unit
)
:
unit
=
Lr1
.
iter
(
fun
s
>
let
has_reduction
=
...
...
src/attic/heap.ml
View file @
cc7fc51e
...
...
@@ 29,16 +29,16 @@ exception EmptyHeap
module
Imperative
(
X
:
Ordered
)
=
struct
(* The heap is encoded in the array [data], where elements are stored
from [0] to [size  1]. From an element stored at [i], the left
from [0] to [size  1]. From an element stored at [i], the left
(resp. right) subtree, if any, is rooted at [2*i+1] (resp. [2*i+2]). *)
type
t
=
{
mutable
size
:
int
;
mutable
data
:
X
.
t
array
}
(* When [create n] is called, we cannot allocate the array, since there is
no known value of type [X.t]; we'll wait for the first addition to
no known value of type [X.t]; we'll wait for the first addition to
do it, and we remember this situation with a negative size. *)
let
create
n
=
let
create
n
=
if
n
<=
0
then
invalid_arg
"create"
;
{
size
=

n
;
data
=
[

]
}
...
...
@@ 90,13 +90,13 @@ module Imperative(X : Ordered) = struct
let
rec
movedown
i
=
let
j
=
2
*
i
+
1
in
if
j
<
n
then
let
j
=
let
j'
=
j
+
1
in
if
j'
<
n
&&
X
.
compare
d
.
(
j'
)
d
.
(
j
)
>
0
then
j'
else
j
let
j
=
let
j'
=
j
+
1
in
if
j'
<
n
&&
X
.
compare
d
.
(
j'
)
d
.
(
j
)
>
0
then
j'
else
j
in
if
X
.
compare
d
.
(
j
)
x
>
0
then
begin
d
.
(
i
)
<
d
.
(
j
);
movedown
j
if
X
.
compare
d
.
(
j
)
x
>
0
then
begin
d
.
(
i
)
<
d
.
(
j
);
movedown
j
end
else
d
.
(
i
)
<
x
else
...
...
@@ 106,7 +106,7 @@ module Imperative(X : Ordered) = struct
let
pop_maximum
h
=
let
m
=
maximum
h
in
remove
h
;
m
let
iter
f
h
=
let
iter
f
h
=
let
d
=
h
.
data
in
for
i
=
0
to
h
.
size

1
do
f
d
.
(
i
)
done
...
...
src/attic/heap.mli
View file @
cc7fc51e
...
...
@@ 30,7 +30,7 @@ module Imperative(X: Ordered) : sig
(* Type of imperative heaps.
(In the following [n] refers to the number of elements in the heap) *)
type
t
type
t
(* [create c] creates a new heap, with initial capacity of [c] *)
val
create
:
int
>
t
...
...
src/attic/nonpositiveCycles.ml
View file @
cc7fc51e
...
...
@@ 65,7 +65,7 @@ end) = struct
is initialized to infinity. Then, we iterate over all edges, and copy them
into the distance matrix. *)
(* Note that, by default, [d.(i).(i)] is not initialized to zero: it is
(* Note that, by default, [d.(i).(i)] is not initialized to zero: it is
initialized to infinity. This is because we are looking for paths of
nonzero length. In other words, we are computing a transitive closure,
not a reflexive, transitive closure. *)
...
...
src/attic/reductionGraphs.ml
View file @
cc7fc51e
...
...
@@ 10,7 +10,7 @@
can take us from [s1] to [s2]. Every edge is labeled with its effect on the
size of the stack. *)
(* This graph is built with respect to a fixed lookahead token [tok]. We
(* This graph is built with respect to a fixed lookahead token [tok]. We
consider only the reductions that are permitted with [tok] is the next
token on the stream. *)
...
...
@@ 140,7 +140,7 @@ let make_reduction_graph tok =
let
edges
=
List
.
filter
acceptable
edges
in
(* Augment the table. *)
adjacency
:=
Lr1
.
NodeMap
.
add
source
edges
!
adjacency
)
)
let
successors
(
action
:
int
>
node
>
unit
)
source
:
unit
=
let
edges
=
...
...
Prev
1
2
3
4
5
Next
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