File: config_parse.mly

package info (click to toggle)
headache 1.03-27
  • links: PTS, VCS
  • area: main
  • in suites: buster
  • size: 556 kB
  • ctags: 190
  • sloc: ml: 621; xml: 218; makefile: 70
file content (174 lines) | stat: -rw-r--r-- 6,731 bytes parent folder | download | duplicates (5)
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
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
/**************************************************************************/
/*                                                                        */
/*                               Headache                                 */
/*                                                                        */
/*          Vincent Simonet, Projet Cristal, INRIA Rocquencourt           */
/*                                                                        */
/*  Copyright 2002                                                        */
/*  Institut National de Recherche en Informatique et en Automatique.     */
/*  All rights reserved.  This file is distributed under the terms of     */
/*  the GNU Library General Public License.                               */
/*                                                                        */
/*  Vincent.Simonet@inria.fr           http://cristal.inria.fr/~simonet/  */
/*                                                                        */
/**************************************************************************/

/**************************************************************************/
/*                                                                        */
/*                                 Header                                 */
/*                 Automatic generation of files headers                  */
/*                                                                        */
/*          Vincent Simonet, Projet Cristal, INRIA Rocquencourt           */
/*                                                                        */
/*  Copyright 2002                                                        */
/*  Institut National de Recherche en Informatique et en Automatique.     */
/*  All rights reserved.  This file is distributed under the terms of     */
/*  the GNU Library General Public License.                               */
/*                                                                        */
/*  Vincent.Simonet@inria.fr           http://cristal.inria.fr/~simonet/  */
/*                                                                        */
/**************************************************************************/

/**************************************************************************/
/*                                                                        */
/*                                 Header                                 */
/*                 Automatic generation of files headers                  */
/*                                                                        */
/*          Vincent Simonet, Projet Cristal, INRIA Rocquencourt           */
/*                                                                        */
/*  Copyright 2002                                                        */
/*  Institut National de Recherche en Informatique et en Automatique.     */
/*  All rights reserved.  This file is distributed under the terms of     */
/*  the GNU Library General Public License.                               */
/*                                                                        */
/*  Vincent.Simonet@inria.fr           http://cristal.inria.fr/~simonet/  */
/*                                                                        */
/**************************************************************************/

/* $Id: config_parse.mly,v 1.2 2003/11/13 16:08:44 simonet Exp $ */

%{
open Printf

type entry = 
  | EntryModel of Model.generator 
  | EntrySkip of Skip.regexp_skip list
;;

(* Dispatch entry considering if it is a skip or a model.
 * List returned are reversed considering their initial order.
 *)
let rec dispatch_entry acc_model acc_skip lst =
  match lst with
  | (rg_filename, EntryModel mdl) :: tl ->
      dispatch_entry ((rg_filename, mdl) :: acc_model) acc_skip tl
  | (rg_filename, EntrySkip rg_skip_lst) :: tl ->
      let nacc_skip =
        List.fold_left 
        (fun nacc_skip rg_skip -> (rg_filename, rg_skip) :: nacc_skip) 
        acc_skip
        rg_skip_lst
      in
      dispatch_entry acc_model nacc_skip tl
  | [] ->
      acc_model, acc_skip
%}

%token ARROW
%token COLON
%token EOF
%token PIPE
%token <string> STRING

%start configfile
%type <((Str.regexp * Model.generator) list) * ((Str.regexp * Skip.regexp_skip) list)> configfile
%start boot
%type <(string * string * (string * string) list) list> boot

%%

configfile:
  opt_pipe item_list EOF                            { dispatch_entry [] [] $2 }
;

opt_pipe:
  /*empty*/                                         { () }
| PIPE                                              { () }
;

item_list:
  item                                              { $1 :: [] }
| item_list PIPE item                               { $3 :: $1 }
;

item:
  STRING ARROW STRING parameters                    
  { 
    let regexp =
      try 
	Str.regexp ("^" ^ $1 ^ "$")
      with
	Failure msg ->
	  raise (Config.Error (sprintf "Illegal regexp: %s" msg,
			       Parsing.rhs_start 1, Parsing.rhs_end 1))
    in
    if $3 = "skip" then
      let fun_parameters (id, str) =
        if id = "match" then
          try 
            Str.regexp ("^" ^ str ^ "$")
          with
            Failure msg ->
              raise (Config.Error (sprintf "Illegal regexp: %s" msg,
                                   Parsing.rhs_start 1, Parsing.rhs_end 1))
        else
          raise (Config.Error (sprintf "Unkown option '%s' for skip" id,
                                 Parsing.rhs_start 3, Parsing.rhs_end 3))
      in
      let skip_lst =
        List.map fun_parameters (List.rev $4)
      in
      regexp, (EntrySkip skip_lst)
    else
      let model =
        try
          Model.find $3
        with
          Not_found ->
            raise (Config.Error (sprintf "Unknown model: %s" $3,
                                 Parsing.rhs_start 3, Parsing.rhs_end 3))
      in
      let generator =
        try
          model (List.rev $4)
        with
          Model.Error msg ->
            raise (Config.Error (msg,
                                 Parsing.rhs_start 3, Parsing.rhs_end 4))
      in
      regexp, (EntryModel generator)
  }
;

parameters:
  /*empty*/                                         { [] }
| parameters STRING COLON STRING                    { ($2, $4) :: $1 }
;



/***************************************************************************/

boot:
  opt_pipe boot_item_list EOF                       { List.rev $2 }
;


boot_item_list:
  boot_item                                         { $1 :: [] }
| boot_item_list PIPE boot_item                     { $3 :: $1 }
;

boot_item:
  STRING ARROW STRING parameters                    { $1, $3, $4 }
;