Commit cc7fc51e authored by POTTIER Francois's avatar POTTIER Francois

Remove trailing whitespace.

parent 4172c02f
...@@ -69,7 +69,7 @@ module Make (T : TABLE) = struct ...@@ -69,7 +69,7 @@ module Make (T : TABLE) = struct
let rec run env please_discard : semantic_value checkpoint = let rec run env please_discard : semantic_value checkpoint =
(* Log the fact that we just entered this state. *) (* Log the fact that we just entered this state. *)
if log then if log then
Log.state env.current; Log.state env.current;
...@@ -346,7 +346,7 @@ module Make (T : TABLE) = struct ...@@ -346,7 +346,7 @@ module Make (T : TABLE) = struct
(* [start s] begins the parsing process. *) (* [start s] begins the parsing process. *)
let start (s : state) (initial : Lexing.position) : semantic_value checkpoint = let start (s : state) (initial : Lexing.position) : semantic_value checkpoint =
(* Build an empty stack. This is a dummy cell, which is its own successor. (* 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 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 is propagated all the way until the stack is empty. Its [endp] field WILL
......
...@@ -296,7 +296,7 @@ module Workset : sig ...@@ -296,7 +296,7 @@ module Workset : sig
(* [insert node] inserts [node] into the workset. [node] must have no (* [insert node] inserts [node] into the workset. [node] must have no
successors. *) successors. *)
val insert: node -> unit val insert: node -> unit
(* [repeat f] repeatedly applies [f] to a node extracted out of the (* [repeat f] repeatedly applies [f] to a node extracted out of the
workset, until the workset becomes empty. [f] is allowed to use workset, until the workset becomes empty. [f] is allowed to use
...@@ -304,7 +304,7 @@ module Workset : sig ...@@ -304,7 +304,7 @@ module Workset : sig
val repeat: (node -> unit) -> unit val repeat: (node -> unit) -> unit
(* That's it! *) (* That's it! *)
end end
= struct = struct
(* Initialize the workset. *) (* Initialize the workset. *)
......
...@@ -95,4 +95,3 @@ module Make ...@@ -95,4 +95,3 @@ module Make
computation takes place, on demand, when [get] is applied. *) computation takes place, on demand, when [get] is applied. *)
val lfp: equations -> valuation val lfp: equations -> valuation
end end
\ No newline at end of file
...@@ -54,7 +54,7 @@ and typedef = { ...@@ -54,7 +54,7 @@ and typedef = {
(* Constraint. *) (* Constraint. *)
typeconstraint: (typ * typ) option typeconstraint: (typ * typ) option
} }
and typedefrhs = and typedefrhs =
| TDefRecord of fielddef list | TDefRecord of fielddef list
...@@ -72,7 +72,7 @@ and fielddef = { ...@@ -72,7 +72,7 @@ and fielddef = {
(* Type of the field. *) (* Type of the field. *)
fieldtype: typescheme fieldtype: typescheme
} }
and datadef = { and datadef = {
...@@ -86,10 +86,10 @@ and datadef = { ...@@ -86,10 +86,10 @@ and datadef = {
[None] if this is an ordinary ADT. *) [None] if this is an ordinary ADT. *)
datatypeparams: typ list option; datatypeparams: typ list option;
} }
and typ = and typ =
(* Textual OCaml type. *) (* Textual OCaml type. *)
| TypTextual of Stretch.ocamltype | TypTextual of Stretch.ocamltype
...@@ -113,7 +113,7 @@ and typescheme = { ...@@ -113,7 +113,7 @@ and typescheme = {
(* Body. *) (* Body. *)
body: typ; body: typ;
} }
and valdef = { and valdef = {
...@@ -129,7 +129,7 @@ and valdef = { ...@@ -129,7 +129,7 @@ and valdef = {
(* Value to which it is bound. *) (* Value to which it is bound. *)
valval: expr valval: expr
} }
and expr = and expr =
...@@ -197,7 +197,7 @@ and branch = { ...@@ -197,7 +197,7 @@ and branch = {
(* Branch body. *) (* Branch body. *)
branchbody: expr; branchbody: expr;
} }
and pattern = and pattern =
......
...@@ -229,7 +229,7 @@ module type SYMBOLS = sig ...@@ -229,7 +229,7 @@ module type SYMBOLS = sig
['a symbol]. This type is useful in situations where the index ['a] ['a symbol]. This type is useful in situations where the index ['a]
is not statically known. *) is not statically known. *)
type xsymbol = type xsymbol =
| X : 'a symbol -> xsymbol | X : 'a symbol -> xsymbol
end end
......
...@@ -5,7 +5,7 @@ type 'a t = { ...@@ -5,7 +5,7 @@ type 'a t = {
default: 'a; default: 'a;
mutable table: 'a array; mutable table: 'a array;
mutable extent: int; (* the index of the greatest [set] ever, plus one *) mutable extent: int; (* the index of the greatest [set] ever, plus one *)
} }
let default_size = let default_size =
16384 (* must be non-zero *) 16384 (* must be non-zero *)
...@@ -14,7 +14,7 @@ let make x = { ...@@ -14,7 +14,7 @@ let make x = {
default = x; default = x;
table = Array.make default_size x; table = Array.make default_size x;
extent = 0; extent = 0;
} }
let rec new_length length i = let rec new_length length i =
if i < length then if i < length then
......
...@@ -18,7 +18,7 @@ end) = struct ...@@ -18,7 +18,7 @@ end) = struct
| T : 'a terminal -> 'a symbol | T : 'a terminal -> 'a symbol
| N : 'a nonterminal -> 'a symbol | N : 'a nonterminal -> 'a symbol
type xsymbol = type xsymbol =
| X : 'a symbol -> xsymbol | X : 'a symbol -> xsymbol
end end
......
...@@ -484,7 +484,7 @@ type fact = { ...@@ -484,7 +484,7 @@ type fact = {
(* To save memory (and therefore time), we encode a fact in a single OCaml (* 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 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 This admittedly horrible hack allows us to save roughly a factor of 2
in space, and to gain 10% in time. *) in space, and to gain 10% in time. *)
...@@ -682,7 +682,7 @@ let () = ...@@ -682,7 +682,7 @@ let () =
(whose word has minimal length). Indeed, we are not interested in keeping (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 track of several words that produce the same effect. Only the shortest such
word is of interest. word is of interest.
Thus, the total number of facts accumulated by the algorithm is at most 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, [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. and [n] is the number of terminal symbols. (This number can be quite large.
...@@ -797,7 +797,7 @@ end ...@@ -797,7 +797,7 @@ end
(* The module [E] is in charge of recording the non-terminal edges that we have (* The module [E] is in charge of recording the non-terminal edges that we have
discovered, or more precisely, the conditions under which these edges can be discovered, or more precisely, the conditions under which these edges can be
taken. taken.
It maintains a set of quadruples [s, nt, w, z], where such a quadruple means 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 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]. consuming the word [w], under the assumption that the next symbol is [z].
...@@ -972,7 +972,7 @@ let new_fact fact = ...@@ -972,7 +972,7 @@ let new_fact fact =
(* Throughout this rather long function, there is just one [fact]. Let's (* Throughout this rather long function, there is just one [fact]. Let's
name its components right now, so as to avoid accessing them several name its components right now, so as to avoid accessing them several
times. (That could be costly, as it requires decoding the fact.) *) times. (That could be costly, as it requires decoding the fact.) *)
let position = position fact let position = position fact
and lookahead = lookahead fact and lookahead = lookahead fact
and word = word fact in and word = word fact in
let source = Trie.source position let source = Trie.source position
...@@ -981,7 +981,7 @@ let new_fact fact = ...@@ -981,7 +981,7 @@ let new_fact fact =
(* 1. View [fact] as a vertex. Examine the transitions out of [current]. (* 1. View [fact] as a vertex. Examine the transitions out of [current].
For every transition labeled by a symbol [sym] and into a state For every transition labeled by a symbol [sym] and into a state
[target], ... *) [target], ... *)
Lr1.transitions current |> SymbolMap.iter (fun sym target -> Lr1.transitions current |> SymbolMap.iter (fun sym target ->
(* ... try to follow this transition in the trie [position], (* ... try to follow this transition in the trie [position],
down to a child which we call [child]. *) down to a child which we call [child]. *)
...@@ -994,7 +994,7 @@ let new_fact fact = ...@@ -994,7 +994,7 @@ let new_fact fact =
() ()
| child, Symbol.T t -> | child, Symbol.T t ->
(* 1a. The transition exists in the trie, and [sym] is in fact a (* 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, terminal symbol [t]. We note that [t] cannot be the [error] token,
because the trie does not have any edges labeled [error]. *) because the trie does not have any edges labeled [error]. *)
...@@ -1005,7 +1005,7 @@ let new_fact fact = ...@@ -1005,7 +1005,7 @@ let new_fact fact =
(* If the lookahead assumption [lookahead] is compatible with (* If the lookahead assumption [lookahead] is compatible with
[t], then we derive a new fact, where one more edge has been taken, [t], then we derive a new fact, where one more edge has been taken,
and enqueue this new fact for later examination. *) and enqueue this new fact for later examination. *)
(* The state [target] is solid, i.e., its incoming symbol is terminal. (* The state [target] is solid, i.e., its incoming symbol is terminal.
This state is always entered without consideration for the next This state is always entered without consideration for the next
lookahead symbol. Thus, we can use [any] as the lookahead assumption lookahead symbol. Thus, we can use [any] as the lookahead assumption
...@@ -1033,7 +1033,7 @@ let new_fact fact = ...@@ -1033,7 +1033,7 @@ let new_fact fact =
(* It could be the case that, due to a default reduction, the answer (* 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. 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. *) advantage of this to increase performance, seems difficult. *)
let foreach = foreach_terminal_not_causing_an_error target in let foreach = foreach_terminal_not_causing_an_error target in
......
...@@ -38,16 +38,16 @@ module PersistentMapsToImperativeMaps ...@@ -38,16 +38,16 @@ module PersistentMapsToImperativeMaps
type key = type key =
M.key M.key
type 'data t = type 'data t =
'data M.t ref 'data M.t ref
let create () = let create () =
ref M.empty ref M.empty
let clear t = let clear t =
t := M.empty t := M.empty
let add k d t = let add k d t =
t := M.add k d !t t := M.add k d !t
......
...@@ -41,7 +41,7 @@ let magnitude (v : int) = ...@@ -41,7 +41,7 @@ let magnitude (v : int) =
let pack (a : int array) : t = let pack (a : int array) : t =
let m = Array.length a in let m = Array.length a in
(* Compute the maximum magnitude of the array elements. This tells (* Compute the maximum magnitude of the array elements. This tells
us how many bits per element we are going to use. *) us how many bits per element we are going to use. *)
......
...@@ -61,7 +61,7 @@ let compress ...@@ -61,7 +61,7 @@ let compress
(insignificant : 'a -> bool) (insignificant : 'a -> bool)
(dummy : 'a) (dummy : 'a)
(m : int) (n : int) (m : int) (n : int)
(t : 'a array array) (t : 'a array array)
: 'a table = : 'a table =
(* Be defensive. *) (* Be defensive. *)
...@@ -187,7 +187,7 @@ let compress ...@@ -187,7 +187,7 @@ let compress
else else
fit (k + 1) row fit (k + 1) row
in in
let fit row = let fit row =
match row with match row with
| [] -> | [] ->
......
...@@ -4,7 +4,7 @@ ...@@ -4,7 +4,7 @@
module type TABLES = sig module type TABLES = sig
(* This is the parser's type of tokens. *) (* This is the parser's type of tokens. *)
type token type token
(* This maps a token to its internal (generation-time) integer code. *) (* This maps a token to its internal (generation-time) integer code. *)
...@@ -105,7 +105,7 @@ module type TABLES = sig ...@@ -105,7 +105,7 @@ module type TABLES = sig
actions. The calling convention for semantic actions is described in actions. The calling convention for semantic actions is described in
[EngineTypes]. This table contains ONLY NON-START PRODUCTIONS, so the [EngineTypes]. This table contains ONLY NON-START PRODUCTIONS, so the
indexing is off by [start]. Be careful. *) indexing is off by [start]. Be careful. *)
val semantic_action: ((int, Obj.t, token) EngineTypes.env -> val semantic_action: ((int, Obj.t, token) EngineTypes.env ->
(int, Obj.t) EngineTypes.stack) array (int, Obj.t) EngineTypes.stack) array
......
...@@ -15,22 +15,22 @@ module Make (T : TableFormat.TABLES) ...@@ -15,22 +15,22 @@ module Make (T : TableFormat.TABLES)
type semantic_value = type semantic_value =
Obj.t Obj.t
let token2terminal = let token2terminal =
T.token2terminal T.token2terminal
let token2value = let token2value =
T.token2value T.token2value
let error_terminal = let error_terminal =
T.error_terminal T.error_terminal
let error_value = let error_value =
Obj.repr () Obj.repr ()
type production = type production =
int int
let default_reduction state defred nodefred env = let default_reduction state defred nodefred env =
let code = PackedIntArray.get T.default_reduction state in let code = PackedIntArray.get T.default_reduction state in
if code = 0 then if code = 0 then
...@@ -40,7 +40,7 @@ module Make (T : TableFormat.TABLES) ...@@ -40,7 +40,7 @@ module Make (T : TableFormat.TABLES)
let is_start prod = let is_start prod =
prod < T.start prod < T.start
(* This auxiliary function helps access a compressed, two-dimensional (* This auxiliary function helps access a compressed, two-dimensional
matrix, like the action and goto tables. *) matrix, like the action and goto tables. *)
...@@ -72,7 +72,7 @@ module Make (T : TableFormat.TABLES) ...@@ -72,7 +72,7 @@ module Make (T : TableFormat.TABLES)
| c -> | c ->
assert (c = 0); assert (c = 0);
fail env fail env
let goto state prod = let goto state prod =
let code = unmarshal2 T.goto state (PackedIntArray.get T.lhs prod) in let code = unmarshal2 T.goto state (PackedIntArray.get T.lhs prod) in
(* code = 1 + state *) (* code = 1 + state *)
...@@ -84,42 +84,42 @@ module Make (T : TableFormat.TABLES) ...@@ -84,42 +84,42 @@ module Make (T : TableFormat.TABLES)
type semantic_action = type semantic_action =
(state, semantic_value, token) EngineTypes.env -> (state, semantic_value, token) EngineTypes.env ->
(state, semantic_value) EngineTypes.stack (state, semantic_value) EngineTypes.stack
let semantic_action prod = let semantic_action prod =
(* Indexing into the array [T.semantic_action] is off by [T.start], (* Indexing into the array [T.semantic_action] is off by [T.start],
because the start productions do not have entries in this array. *) because the start productions do not have entries in this array. *)
T.semantic_action.(prod - T.start) T.semantic_action.(prod - T.start)
(* If [T.trace] is [None], then the logging functions do nothing. *) (* If [T.trace] is [None], then the logging functions do nothing. *)
let log = let log =
match T.trace with Some _ -> true | None -> false match T.trace with Some _ -> true | None -> false
module Log = struct module Log = struct
open Printf open Printf
let state state = let state state =
match T.trace with match T.trace with
| Some _ -> | Some _ ->
fprintf stderr "State %d:\n%!" state fprintf stderr "State %d:\n%!" state
| None -> | None ->
() ()
let shift terminal state = let shift terminal state =
match T.trace with match T.trace with
| Some (terminals, _) -> | Some (terminals, _) ->
fprintf stderr "Shifting (%s) to state %d\n%!" terminals.(terminal) state fprintf stderr "Shifting (%s) to state %d\n%!" terminals.(terminal) state
| None -> | None ->
() ()
let reduce_or_accept prod = let reduce_or_accept prod =
match T.trace with match T.trace with
| Some (_, productions) -> | Some (_, productions) ->
fprintf stderr "%s\n%!" productions.(prod) fprintf stderr "%s\n%!" productions.(prod)
| None -> | None ->
() ()
let lookahead_token token startp endp = let lookahead_token token startp endp =
match T.trace with match T.trace with
| Some (terminals, _) -> | Some (terminals, _) ->
...@@ -129,29 +129,29 @@ module Make (T : TableFormat.TABLES) ...@@ -129,29 +129,29 @@ module Make (T : TableFormat.TABLES)
endp.Lexing.pos_cnum endp.Lexing.pos_cnum
| None -> | None ->
() ()
let initiating_error_handling () = let initiating_error_handling () =
match T.trace with match T.trace with
| Some _ -> | Some _ ->
fprintf stderr "Initiating error handling\n%!" fprintf stderr "Initiating error handling\n%!"
| None -> | None ->
() ()
let resuming_error_handling () = let resuming_error_handling () =
match T.trace with match T.trace with
| Some _ -> | Some _ ->
fprintf stderr "Resuming error handling\n%!" fprintf stderr "Resuming error handling\n%!"
| None -> | None ->
() ()
let handling_error state = let handling_error state =
match T.trace with match T.trace with
| Some _ -> | Some _ ->
fprintf stderr "Handling error in state %d\n%!" state fprintf stderr "Handling error in state %d\n%!" state
| None -> | None ->
() ()
end end
end) end)
...@@ -19,7 +19,7 @@ type t = { ...@@ -19,7 +19,7 @@ type t = {
(* Creation. *) (* Creation. *)
let from_stretch s = { let from_stretch s = {
expr = IL.ETextual s; expr = IL.ETextual s;
filenames = [ s.Stretch.stretch_filename ]; filenames = [ s.Stretch.stretch_filename ];
keywords = KeywordSet.of_list s.Stretch.stretch_keywords keywords = KeywordSet.of_list s.Stretch.stretch_keywords
...@@ -36,7 +36,7 @@ let define keyword keywords f action = ...@@ -36,7 +36,7 @@ let define keyword keywords f action =
(* Composition, used during inlining. *) (* 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, (* 2015/07/20: there used to be a call to [parenthesize_stretch] here,
which would insert parentheses around every stretch in [a1]. This is which would insert parentheses around every stretch in [a1]. This is
not necessary, as far as I can see, since every stretch that represents not n