swh:1:snp:e3b0b9991945262e7cc28768373af4560caf7afa
Tip revision: ad0c16675d221938530269610308cd5a2c142687 authored by Software Heritage on 17 October 2018, 13:20:37 UTC
hal: Deposit 205 in collection hal
hal: Deposit 205 in collection hal
Tip revision: ad0c166
ExtMenhirLib.ml
(**************************************************************************)
(* -*- tuareg -*- *)
(* *)
(* Copyright (C) 2017,2018 Yann RĂ©gis-Gianas, Nicolas Jeannerod, *)
(* Ralf Treinen. *)
(* *)
(* This is free software: you can redistribute it and/or modify it *)
(* under the terms of the GNU General Public License, version 3. *)
(* *)
(* Additional terms apply, due to the reproduction of portions of *)
(* the POSIX standard. Please refer to the file COPYING for details. *)
(**************************************************************************)
open Parser
open Parser.Incremental
open Parser.MenhirInterpreter
open MenhirLib.General
let current_items parsing_state =
match Lazy.force (stack parsing_state) with
| Nil ->
[]
| Cons (Element (s, _, _, _), _) ->
items s
type 'a status =
| AcceptedNow of 'a
| Fine
| Wrong
let rec close checkpoint =
match checkpoint with
| AboutToReduce (_, _) | Shifting _ -> close (resume checkpoint)
| Rejected | HandlingError _ -> Wrong
| Accepted x -> AcceptedNow x
| InputNeeded _ -> Fine
let accepted_token checkpoint token =
match checkpoint with
| InputNeeded _ -> close (offer checkpoint token)
| _ -> Wrong
let is_accepted_token checkpoint token =
accepted_token checkpoint token <> Wrong
let accepted_raw_token checkpoint raw_token =
accepted_token checkpoint (raw_token, Lexing.dummy_pos, Lexing.dummy_pos)
(** [finished checkpoint] is [true] if the current [checkpoint] can
move the LR(1) automaton to an accepting state with no extra
input.
*)
let rec finished = function
| Accepted _ -> true
| (AboutToReduce (_, _) | Shifting (_, _, _)) as checkpoint ->
finished (resume checkpoint)
| _ -> false