Project

General

Profile

Download (5.52 KB) Statistics
| Branch: | Tag: | Revision:
1 a2d97a3e ploc
(********************************************************************)
2
(*                                                                  *)
3
(*  The LustreC compiler toolset   /  The LustreC Development Team  *)
4
(*  Copyright 2012 -    --   ONERA - CNRS - INPT                    *)
5
(*                                                                  *)
6
(*  LustreC is free software, distributed WITHOUT ANY WARRANTY      *)
7
(*  under the terms of the GNU Lesser General Public License        *)
8
(*  version 2.1.                                                    *)
9
(*                                                                  *)
10
(********************************************************************)
11 90e83deb Lélio Brun
open Utils.Format
12
module I = Parser_lustre_table.MenhirInterpreter
13 a2327c71 Lélio Brun
module Inc = Parser_lustre_table.Incremental
14 90e83deb Lélio Brun
module E = MenhirLib.ErrorReports
15
module L = MenhirLib.LexerUtil
16 04a63d25 xthirioux
17 90e83deb Lélio Brun
exception Error
18 04a63d25 xthirioux
19 ca7ff3f7 Lélio Brun
type start_symbol = Header | Program
20 90e83deb Lélio Brun
21 ca7ff3f7 Lélio Brun
(* [env checkpoint] extracts a parser environment out of a checkpoint, which
22
   must be of the form [HandlingError env]. *)
23 90e83deb Lélio Brun
let env checkpoint =
24 ca7ff3f7 Lélio Brun
  match checkpoint with I.HandlingError env -> env | _ -> assert false
25 90e83deb Lélio Brun
26
(* [state checkpoint] extracts the number of the current state out of a
27
   checkpoint. *)
28
let state checkpoint : int =
29
  match I.top (env checkpoint) with
30
  | Some (I.Element (s, _, _, _)) ->
31
    I.number s
32
  | None ->
33 ca7ff3f7 Lélio Brun
    (* Hmm... The parser is in its initial state. The incremental API currently
34
       lacks a way of finding out the number of the initial state. It is usually
35
       0, so we return 0. This is unsatisfactory and should be fixed in the
36
       future. *)
37
    0
38 90e83deb Lélio Brun
39 ca7ff3f7 Lélio Brun
(* [show text (pos1, pos2)] displays a range of the input text [text] delimited
40
   by the positions [pos1] and [pos2]. *)
41 90e83deb Lélio Brun
let show text positions =
42 ca7ff3f7 Lélio Brun
  E.extract text positions |> E.sanitize |> E.compress |> E.shorten 20
43
(* max width 43 *)
44 90e83deb Lélio Brun
45 91e96bd8 Lélio Brun
(* (\* [get text checkpoint i] extracts and shows the range of the input text that
46
 *    corresponds to the [i]-th stack cell. The top stack cell is numbered zero. *\)
47
 * let get text checkpoint i =
48
 *   match I.get i (env checkpoint) with
49
 *   | Some (I.Element (_, _, pos1, pos2)) ->
50
 *     show text (pos1, pos2)
51
 *   | None ->
52
 *     (\* The index is out of range. This should not happen if [$i]
53
 *        keywords are correctly inside the syntax error message
54
 *        database. The integer [i] should always be a valid offset
55
 *        into the known suffix of the stack. *\)
56
 *     "???" *)
57 90e83deb Lélio Brun
58 a2327c71 Lélio Brun
module type LEXER = sig
59 ca7ff3f7 Lélio Brun
  val token : Lexing.lexbuf -> Parser_lustre.token
60
61 a2327c71 Lélio Brun
  type error
62 ca7ff3f7 Lélio Brun
63 a2327c71 Lélio Brun
  exception Error of Location.t * error
64 ca7ff3f7 Lélio Brun
65
  val pp_error : formatter -> error -> unit
66 a2327c71 Lélio Brun
end
67
68
let reparse (module Lexer : LEXER) ?orig_loc filename start src =
69 90e83deb Lélio Brun
  (* Allocate and initialize a lexing buffer. *)
70 a2327c71 Lélio Brun
  let lexbuf = L.init filename (Lexing.from_string src) in
71 ca7ff3f7 Lélio Brun
  (* Wrap the lexer and lexbuf together into a supplier, that is, a function of
72
     type [unit -> token * position * position]. *)
73 a2327c71 Lélio Brun
  let supplier = I.lexer_lexbuf_to_supplier Lexer.token lexbuf in
74 ca7ff3f7 Lélio Brun
  (* Equip the supplier with a two-place buffer that records the positions of
75
     the last two tokens. This is useful when a syntax error occurs, as these
76
     are the token just before and just after the error. *)
77 90e83deb Lélio Brun
  let buffer, supplier = E.wrap_supplier supplier in
78
  (* Fetch the parser's initial checkpoint. *)
79 a2327c71 Lélio Brun
  let checkpoint = start lexbuf.lex_curr_p in
80 90e83deb Lélio Brun
  (* [succeed v] is invoked when the parser has succeeded and produced a
81
     semantic value [v]. In our setting, this cannot happen, since the
82 ca7ff3f7 Lélio Brun
     table-based parser is invoked only when we know that there is a syntax
83
     error in the input file. *)
84 90e83deb Lélio Brun
  let succeed _v = assert false in
85
  (* [fail checkpoint] is invoked when parser has encountered a syntax error. *)
86
  let fail (checkpoint : _ I.checkpoint) =
87
    (* Indicate where in the input file the error occurred. *)
88 a2327c71 Lélio Brun
    let loc = E.last buffer in
89 ca7ff3f7 Lélio Brun
    let loc =
90
      match orig_loc with Some loc' -> Location.shift loc' loc | _ -> loc
91
    in
92 90e83deb Lélio Brun
    (* Show the tokens just before and just after the error. *)
93 a2327c71 Lélio Brun
    let indication = E.show (show src) buffer in
94 90e83deb Lélio Brun
    (* Fetch an error message from the database. *)
95
    let message = Parser_lustre_messages.message (state checkpoint) in
96
    (* Expand away the $i keywords that might appear in the message. *)
97 91e96bd8 Lélio Brun
    (* let message = E.expand (get src checkpoint) message in *)
98 90e83deb Lélio Brun
    (* Show these three components. *)
99 ca7ff3f7 Lélio Brun
    eprintf "@[<v>%aSyntax error %s.@,%s@]@." Location.pp_loc loc indication
100
      message;
101 90e83deb Lélio Brun
    raise Error
102
  in
103
  (* Run the parser. *)
104 ca7ff3f7 Lélio Brun
  (* We do not handle [Lexer.Error] because we know that we will not encounter a
105
     lexical error during this second parsing run. *)
106 90e83deb Lélio Brun
  I.loop_handle succeed fail supplier checkpoint
107
108 ca7ff3f7 Lélio Brun
let parse (module Lexer : LEXER) ?orig_loc filename src lexbuf start_mono
109
    start_incr =
110 a2327c71 Lélio Brun
  let lexbuf = L.init filename lexbuf in
111 ca7ff3f7 Lélio Brun
  try start_mono Lexer.token lexbuf with
112 a2327c71 Lélio Brun
  | Lexer.Error (loc, err) ->
113 ca7ff3f7 Lélio Brun
    let loc =
114
      match orig_loc with Some loc' -> Location.shift loc' loc | _ -> loc
115
    in
116
    eprintf "@[<v>%aSyntax error.@,%a@]@." Location.pp_loc loc Lexer.pp_error
117
      err;
118 a2327c71 Lélio Brun
    raise Error
119
  | Parser_lustre.Error ->
120
    reparse (module Lexer) ?orig_loc filename start_incr src
121 22fe1c93 ploc
122 a2327c71 Lélio Brun
let parse_filename (module Lexer : LEXER) filename start =
123 ca7ff3f7 Lélio Brun
  let start_mono, start_incr =
124
    match start with
125
    | Header ->
126
      Parser_lustre.header, Inc.header
127
    | Program ->
128
      Parser_lustre.prog, Inc.prog
129 a2327c71 Lélio Brun
  in
130
  let src, lexbuf = L.read filename in
131
  Location.set_input filename;
132
  parse (module Lexer) filename src lexbuf start_mono start_incr
133 22fe1c93 ploc
134
(* Local Variables: *)
135
(* compile-command:"make -C .." *)
136
(* End: *)