Commit 81dcc7dd by POTTIER Francois

### Merge remote-tracking branch 'origin/fix'

```This modifies the analyses in [Grammar] to use [Fix] as the fixed point
computation algorithm.```
parents 0f324090 7e608c59
src/Boolean.ml 0 → 100644
 (* The Boolean lattice. *) type property = bool let bottom = false let equal (b1 : bool) (b2 : bool) = b1 = b2 let is_maximal b = b
src/Boolean.mli 0 → 100644
 include Fix.PROPERTY with type property = bool
 (* The natural numbers, completed with [Infinity], and ordered towards zero (i.e. [Infinity] is [bottom], [Finite 0] is [top]). *) type t = | Finite of int | Infinity type property = t let equal p1 p2 = match p1, p2 with | Finite i1, Finite i2 -> i1 = i2 | Infinity, Infinity -> true | _, _ -> false let bottom = Infinity let is_maximal p = match p with | Finite 0 -> true | _ -> false let min p1 p2 = match p1, p2 with | Finite i1, Finite i2 -> if i1 <= i2 then p1 else p2 | p, Infinity | Infinity, p -> p let min_lazy p1 p2 = match p1 with | Finite 0 -> p1 | _ -> min p1 (Lazy.force p2) let add p1 p2 = match p1, p2 with | Finite i1, Finite i2 -> Finite (i1 + i2) | _, _ -> Infinity let add_lazy p1 p2 = match p1 with | Infinity -> Infinity | _ -> add p1 (Lazy.force p2) let print p = match p with | Finite i -> string_of_int i | Infinity -> "infinity"
 (* The natural numbers, completed with [Infinity], and ordered towards zero (i.e. [Infinity] is [bottom], [Finite 0] is [top]). *) type t = | Finite of int | Infinity include Fix.PROPERTY with type property = t val min: t -> t -> t val add: t -> t -> t val min_lazy: t -> t Lazy.t -> t val add_lazy: t -> t Lazy.t -> t val print: t -> string
 (* This is an enriched version of [CompletedNat], where we compute not just numbers, but also lists of matching length. During the fixed point computation, instead of manipulating actual lists, we manipulate only recipes for constructing lists. These recipes can be evaluated by the user after the fixed point has been reached. *) (* A property is either [Finite (n, xs)], where [n] is a natural number and [xs] is a (recipe for constructing a) list of length [n]; or [Infinity]. *) type 'a t = | Finite of int * 'a list Lazy.t | Infinity let equal p1 p2 = match p1, p2 with | Finite (i1, _), Finite (i2, _) -> i1 = i2 | Infinity, Infinity -> true | _, _ -> false let bottom = Infinity let is_maximal p = match p with | Finite (0, _) -> true | _ -> false let min p1 p2 = match p1, p2 with | Finite (i1, _), Finite (i2, _) -> if i1 <= i2 then p1 else p2 | p, Infinity | Infinity, p -> p let min_lazy p1 p2 = match p1 with | Finite (0, _) -> p1 | _ -> min p1 (Lazy.force p2) let add p1 p2 = match p1, p2 with | Finite (i1, xs1), Finite (i2, xs2) -> Finite ( i1 + i2, (* The only list operation in the code! *) lazy (Lazy.force xs1 @ Lazy.force xs2) ) | _, _ -> Infinity let add_lazy p1 p2 = match p1 with | Infinity -> Infinity | _ -> add p1 (Lazy.force p2) let print conv p = match p with | Finite (i, xs) -> string_of_int i ^ " " ^ String.concat " " (List.map conv (Lazy.force xs)) | Infinity -> "infinity"
 (* This is an enriched version of [CompletedNat], where we compute not just numbers, but also lists of matching length. During the fixed point computation, instead of manipulating actual lists, we manipulate only recipes for constructing lists. These recipes can be evaluated by the user after the fixed point has been reached. *) (* A property is either [Finite (n, xs)], where [n] is a natural number and [xs] is a (recipe for constructing a) list of length [n]; or [Infinity]. *) type 'a t = | Finite of int * 'a list Lazy.t | Infinity val bottom: 'a t val equal: 'a t -> 'b t -> bool val is_maximal: 'a t -> bool val min: 'a t -> 'a t -> 'a t val add: 'a t -> 'a t -> 'a t val min_lazy: 'a t -> 'a t Lazy.t -> 'a t val add_lazy: 'a t -> 'a t Lazy.t -> 'a t val print: ('a -> string) -> 'a t -> string
src/Maps.ml 0 → 100644
 (* BEGIN PERSISTENT_MAPS *) module type PERSISTENT_MAPS = sig type key type 'data t val empty: 'data t val add: key -> 'data -> 'data t -> 'data t val find: key -> 'data t -> 'data val iter: (key -> 'data -> unit) -> 'data t -> unit end (* END PERSISTENT_MAPS *) (* BEGIN IMPERATIVE_MAPS *) module type IMPERATIVE_MAPS = sig type key type 'data t val create: unit -> 'data t val clear: 'data t -> unit val add: key -> 'data -> 'data t -> unit val find: key -> 'data t -> 'data val iter: (key -> 'data -> unit) -> 'data t -> unit end (* END IMPERATIVE_MAPS *) (* BEGIN IMPERATIVE_MAP *) module type IMPERATIVE_MAP = sig type key type data val set: key -> data -> unit val get: key -> data option end (* END IMPERATIVE_MAP *) module PersistentMapsToImperativeMaps (M : PERSISTENT_MAPS) : IMPERATIVE_MAPS with type key = M.key and type 'data t = 'data M.t ref = struct 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 let find k t = M.find k !t let iter f t = M.iter f !t end module ImperativeMapsToImperativeMap (M : IMPERATIVE_MAPS) (D : sig type data end) : IMPERATIVE_MAP with type key = M.key and type data = D.data = struct type key = M.key type data = D.data let m = M.create() let set k d = M.add k d m let get k = try Some (M.find k m) with Not_found -> None end module ConsecutiveIntegerKeysToImperativeMaps (K : sig val n: int end) : IMPERATIVE_MAPS with type key = int and type 'data t = 'data option array = struct open K type key = int type 'data t = 'data option array let create () = Array.make n None let clear m = Array.fill m 0 n None let add key data m = m.(key) <- Some data let find key m = match m.(key) with | None -> raise Not_found | Some data -> data let iter f m = Array.iteri (fun key data -> match data with | None -> () | Some data -> f key data ) m end module HashTableAsImperativeMaps (H : Hashtbl.HashedType) : IMPERATIVE_MAPS with type key = H.t = struct include Hashtbl.Make(H) let create () = create 1023 let add key data table = add table key data let find table key = find key table end module TrivialHashedType (T : sig type t end) : Hashtbl.HashedType with type t = T.t = struct include T let equal = (=) let hash = Hashtbl.hash end
src/Maps.mli 0 → 100644
 (* This module defines three signatures for association maps, together with a number of conversion functors. *) (* Following the convention of the ocaml standard library, the [find] functions raise [Not_found] when the key is not a member of the domain of the map. By contrast, [get] returns an option. *) (* BEGIN PERSISTENT_MAPS *) module type PERSISTENT_MAPS = sig type key type 'data t val empty: 'data t val add: key -> 'data -> 'data t -> 'data t val find: key -> 'data t -> 'data val iter: (key -> 'data -> unit) -> 'data t -> unit end (* END PERSISTENT_MAPS *) (* BEGIN IMPERATIVE_MAPS *) module type IMPERATIVE_MAPS = sig type key type 'data t val create: unit -> 'data t val clear: 'data t -> unit val add: key -> 'data -> 'data t -> unit val find: key -> 'data t -> 'data val iter: (key -> 'data -> unit) -> 'data t -> unit end (* END IMPERATIVE_MAPS *) (* BEGIN IMPERATIVE_MAP *) module type IMPERATIVE_MAP = sig type key type data val set: key -> data -> unit val get: key -> data option end (* END IMPERATIVE_MAP *) (* An implementation of persistent maps can be made to satisfy the interface of imperative maps. An imperative map is represented as a persistent map, wrapped within a reference cell. *) module PersistentMapsToImperativeMaps (M : PERSISTENT_MAPS) : IMPERATIVE_MAPS with type key = M.key and type 'data t = 'data M.t ref (* An implementation of imperative maps can be made to satisfy the interface of a single imperative map. This map is obtained via a single call to [create]. *) module ImperativeMapsToImperativeMap (M : IMPERATIVE_MAPS) (D : sig type data end) : IMPERATIVE_MAP with type key = M.key and type data = D.data (* An implementation of imperative maps as arrays is possible if keys are consecutive integers. *) module ConsecutiveIntegerKeysToImperativeMaps (K : sig val n: int end) : IMPERATIVE_MAPS with type key = int and type 'data t = 'data option array (* An implementation of imperative maps as a hash table. *) module HashTableAsImperativeMaps (H : Hashtbl.HashedType) : IMPERATIVE_MAPS with type key = H.t (* A trivial implementation of equality and hashing. *) module TrivialHashedType (T : sig type t end) : Hashtbl.HashedType with type t = T.t
 ... ... @@ -187,14 +187,14 @@ let rec follow1 tok derivation offset' = function at the moment, so let's skip it. *) derivation | (item, _, offset) :: configs -> let _, _, rhs, pos, length = Item.def item in let prod, _, rhs, pos, length = Item.def item in if offset = offset' then (* This is an epsilon transition. Attack a new line and add a comment that explains why the lookahead symbol is produced or inherited. *) let nullable, first = Analysis.nullable_first_rhs rhs (pos + 1) in let nullable, first = Analysis.nullable_first_prod prod (pos + 1) in if TerminalSet.mem tok first then ... ... @@ -304,7 +304,7 @@ let explain_reduce_item if pos < length then match rhs.(pos) with | Symbol.N nt -> let nullable, first = Analysis.nullable_first_rhs rhs (pos + 1) in let nullable, first = Analysis.nullable_first_prod prod (pos + 1) in let first : bool = TerminalSet.mem tok first in let lookahead' = if nullable then first || lookahead else first ... ...
 ... ... @@ -277,6 +277,18 @@ module TerminalSet = struct ) ) (* The following definitions are used in the computation of FIRST sets below. They are not exported outside of this file. *) type property = t let bottom = empty let is_maximal _ = false end (* Maps over terminals. *) ... ... @@ -492,6 +504,18 @@ module Production = struct in loop accu k (* This funny variant is lazy. If at some point [f] does not demand its second argument, then iteration stops. *) let foldnt_lazy (nt : Nonterminal.t) (f : index -> 'a Lazy.t -> 'a) (seed : 'a) : 'a = let k, k' = ntprods.(nt) in let rec loop prod seed = if prod < k' then f prod (lazy (loop (prod + 1) seed)) else seed in loop k seed (* Accessors. *) let def prod = ... ... @@ -666,37 +690,32 @@ module ProductionMap = struct end (* ------------------------------------------------------------------------ *) (* Build the grammar's forward and backward reference graphs. (* If requested, build and print the forward reference graph of the grammar. There is an edge of a nonterminal symbol [nt1] to every nonterminal symbol [nt2] that occurs in the definition of [nt1]. *) In the backward reference graph, edges relate each nonterminal [nt] to each of the nonterminals whose definition mentions [nt]. The reverse reference graph is used in the computation of the nullable, nonempty, and FIRST sets. let () = if Settings.graph then begin The forward reference graph is unused but can be printed on demand. *) (* Allocate. *) let forward : NonterminalSet.t array = Array.make Nonterminal.n NonterminalSet.empty let forward : NonterminalSet.t array = Array.make Nonterminal.n NonterminalSet.empty in let backward : NonterminalSet.t array = Array.make Nonterminal.n NonterminalSet.empty (* Populate. *) let () = Array.iter (fun (nt1, rhs) -> Array.iter (function | Symbol.T _ -> () | Symbol.N nt2 -> forward.(nt1) <- NonterminalSet.add nt2 forward.(nt1); backward.(nt2) <- NonterminalSet.add nt1 backward.(nt2) ) rhs ) Production.table Array.iter (fun (nt1, rhs) -> Array.iter (function | Symbol.T _ -> () | Symbol.N nt2 -> forward.(nt1) <- NonterminalSet.add nt2 forward.(nt1) ) rhs ) Production.table; (* ------------------------------------------------------------------------ *) (* If requested, dump the forward reference graph. *) (* Print. *) let () = if Settings.graph then let module P = Dot.Print (struct type vertex = Nonterminal.t let name nt = ... ... @@ -714,37 +733,179 @@ let () = P.print f; close_out f end (* ------------------------------------------------------------------------ *) (* Generic support for fixpoint computations. A fixpoint computation associates a property with every nonterminal. A monotone function tells how properties are computed. [compute nt] updates the property associated with nonterminal [nt] and returns a flag that tells whether the property actually needed an update. The state of the computation is maintained entirely inside [compute] and is invisible here. Whenever a property of [nt] is updated, the properties of the terminals whose definitions depend on [nt] are updated. The dependency graph must be explicitly supplied. *) let fixpoint (dependencies : NonterminalSet.t array) (compute : Nonterminal.t -> bool) : unit = let queue : Nonterminal.t Queue.t = Queue.create () in let onqueue : bool array = Array.make Nonterminal.n true in for i = 0 to Nonterminal.n - 1 do Queue.add i queue done; Misc.qiter (fun nt -> onqueue.(nt) <- false; let changed = compute nt in if changed then NonterminalSet.iter (fun nt -> if not onqueue.(nt) then begin Queue.add nt queue; onqueue.(nt) <- true end ) dependencies.(nt) ) queue (* Support for analyses of the grammar, expressed as fixed point computations. We exploit the generic fixed point algorithm in [Fix]. *) (* We perform memoization only at nonterminal symbols. We assume that the analysis of a symbol is the analysis of its definition (as opposed to, say, a computation that depends on the occurrences of this symbol in the grammar). *) module GenericAnalysis (P : Fix.PROPERTY) (S : sig open P (* An analysis is specified by the following functions. *) (* [terminal] maps a terminal symbol to a property. *) val terminal: Terminal.t -> property (* [disjunction] abstracts a binary alternative. That is, when we analyze an alternative between several productions, we compute a property for each of them independently, then we combine these properties using [disjunction]. *) val disjunction: property -> property Lazy.t -> property (* [P.bottom] should be a neutral element for [disjunction]. We use it in the analysis of an alternative with zero branches. *) (* [conjunction] abstracts a binary sequence. That is, when we analyze a sequence, we compute a property for each member independently, then we combine these properties using [conjunction]. In general, conjunction needs access to the first member of the sequence (a symbol), not just to its analysis (a property). *) val conjunction: Symbol.t -> property -> property Lazy.t -> property (* [epsilon] abstracts the empty sequence. It should be a neutral element for [conjunction]. *) val epsilon: property end) : sig open P (* The results of the analysis take the following form. *) (* To every nonterminal symbol, we associate a property. *) val nonterminal: Nonterminal.t -> property (* To every symbol, we associate a property. *) val symbol: Symbol.t -> property (* To every suffix of every production, we associate a property. The offset [i], which determines the beginning of the suffix,