Newer
Older
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
open Str
open List_utils
open Lexing
open Grammar_lexer
open Grammar_parser_yacc
open Grammar
let print_position outx lexbuf =
let pos = lexbuf.lex_curr_p in
Printf.fprintf outx "%s:%d:%d" pos.pos_fname
pos.pos_lnum (pos.pos_cnum - pos.pos_bol + 1)
let parse_with_error lexbuf =
try main token lexbuf with
| Error ->
Printf.fprintf stderr "%a: syntax error\n" print_position lexbuf;
exit (-1)
let parse_grammar file : grammar * nonterm =
let ic = open_in file in
let lexbuf = Lexing.from_channel ic in
lexbuf.Lexing.lex_curr_p <- {lexbuf.Lexing.lex_curr_p with pos_fname = file};
let gram : grammar = parse_with_error lexbuf in
let (undefined_strings, used_strings) : string list * string list =
List.fold_left (fun (undef, used) rule ->
List.fold_left
(fun (undef, used) prod ->
let undef =
if not (List.mem prod (List.map fst gram.tokens) || List.mem prod gram.nonterms || List.mem prod undef)
then prod::undef
else undef in
let used =
if List.mem prod used then used else prod::used in
(undef, used)
)
(undef, used) (rule.rule_prods)
) ([],[]) (gram.rules) in
(* Error if undefined tokens or non-terminals are encountered *)
if undefined_strings <> []
then (Printf.printf "Undefined tokens or non-terminals: %a\n" print_list undefined_strings;
failwith "Undefined tokens or non-terminals");
match gram.axiom with
| None -> failwith "No axiom was defined for the grammar.\n Aborting."
| Some axiom ->
(* Warn if some non terminals are never seen on the right hand side of a rule. *)
let unused_nts = List.filter (fun nt -> not (List.mem nt used_strings) && Some nt <> gram.axiom) gram.nonterms in
if unused_nts <> [] then Printf.printf "The following non-terminals are declared but never appear on the right hand-side of a rule:\n%a\n" print_list unused_nts;
(* Warn if some tokens are never seen on the right hand side of a rule. *)
let unused_toks = (List.filter_map (fun (t,_) -> if not (List.mem t used_strings) then Some t else None) gram.tokens) in
if unused_toks <> [] then Printf.printf "The following tokens are declared but never appear on the right hand-side of a rule:\n%a\n" print_list unused_toks;
let h : (nonterm , rule list) Hashtbl.t =
Hashtbl.create (List.length gram.nonterms) in
List.iter ( fun r ->
match Hashtbl.find_opt h r.rule_nt with
| None -> Hashtbl.add h r.rule_nt [r]
| Some lp -> Hashtbl.replace h r.rule_nt (lp@[r]) ) (gram.rules);
let rules = List.concat (List.map (fun n -> hashget_def h n []) gram.nonterms) in
{ gram with rules = rules }, axiom