2 * Copyright (C) 2019 Richard W.M. Jones
3 * Copyright (C) 2019 Red Hat Inc.
5 * This program is free software; you can redistribute it and/or modify
6 * it under the terms of the GNU General Public License as published by
7 * the Free Software Foundation; either version 2 of the License, or
8 * (at your option) any later version.
10 * This program is distributed in the hope that it will be useful,
11 * but WITHOUT ANY WARRANTY; without even the implied warranty of
12 * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
13 * GNU General Public License for more details.
15 * You should have received a copy of the GNU General Public License along
16 * with this program; if not, write to the Free Software Foundation, Inc.,
17 * 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
26 exception SyntaxError of string
29 let pos = lexbuf.lex_curr_p in
31 { pos with pos_bol = pos.pos_cnum; pos_lnum = pos.pos_lnum + 1 }
34 let white = [' ' '\t']+
35 let newline = '\r' | '\n' | "\r\n"
36 let comment = '#' (_#'\n')*
37 let id = ['a'-'z' 'A'-'Z' '_'] ['a'-'z' 'A'-'Z' '0'-'9' '_' '-']*
42 | comment { read lexbuf }
43 | newline { new_line lexbuf; read lexbuf }
52 | '"' { read_string (Ast.Substs.create ()) lexbuf }
53 | "{" { read_code false (Ast.Substs.create ()) (ref 1) lexbuf }
54 | "@{" { read_code true (Ast.Substs.create ()) (ref 1) lexbuf }
73 | "*" id { (* NB: The initial '*' is part of the name. *)
74 TACTIC (Lexing.lexeme lexbuf) }
75 | id { ID (Lexing.lexeme lexbuf) }
76 | _ { raise (SyntaxError ("unexpected character: " ^
77 Lexing.lexeme lexbuf)) }
80 (* Parse "STRING" literal with %-substitutions. *)
84 { Ast.Substs.add_char buf '"'; read_string buf lexbuf }
86 { Ast.Substs.add_char buf '\007'; read_string buf lexbuf }
88 { Ast.Substs.add_char buf '\008'; read_string buf lexbuf }
90 { Ast.Substs.add_char buf '\009'; read_string buf lexbuf }
92 { Ast.Substs.add_char buf '\010'; read_string buf lexbuf }
94 { Ast.Substs.add_char buf '\011'; read_string buf lexbuf }
96 { Ast.Substs.add_char buf '\012'; read_string buf lexbuf }
98 { Ast.Substs.add_char buf '\013'; read_string buf lexbuf }
100 { Ast.Substs.add_char buf '\\'; read_string buf lexbuf }
101 | '"' { STRING (Ast.Substs.get buf) }
102 | newline { Ast.Substs.add_char buf '\n';
103 new_line lexbuf; read_string buf lexbuf }
104 | '%' '%' { Ast.Substs.add_char buf '%'; read_string buf lexbuf }
105 | '%' id { let id = Lexing.lexeme lexbuf in
106 let len = String.length id in
107 Ast.Substs.add_var buf (String.sub id 1 (len-1));
108 read_string buf lexbuf }
109 | '%' _ { raise (SyntaxError ("illegal character in %-substitution: " ^
110 Lexing.lexeme lexbuf)) }
111 | [^ '"' '\\' '\r' '\n' '%' ]+
112 { Ast.Substs.add_string buf (Lexing.lexeme lexbuf);
113 read_string buf lexbuf }
114 | _ { raise (SyntaxError ("illegal character in string: " ^
115 Lexing.lexeme lexbuf)) }
116 | eof { raise (SyntaxError ("unterminated string")) }
118 (* Parse { CODE } literal with %-substitutions.
120 * Note the range of %-substitutions possible is larger than
123 and read_code quiet buf level =
125 | '{' { Ast.Substs.add_char buf '{';
126 incr level; read_code quiet buf level lexbuf }
128 if !level = 0 then CODE (Ast.Substs.get buf, quiet)
130 Ast.Substs.add_char buf '}';
131 read_code quiet buf level lexbuf
133 | newline { Ast.Substs.add_char buf '\n';
134 new_line lexbuf; read_code quiet buf level lexbuf }
135 | '%' '%' { Ast.Substs.add_char buf '%'; read_code quiet buf level lexbuf }
136 | '%' '@' { Ast.Substs.add_var buf "@"; read_code quiet buf level lexbuf }
137 | '%' '<' { Ast.Substs.add_var buf "<"; read_code quiet buf level lexbuf }
138 | '%' '^' { Ast.Substs.add_var buf "^"; read_code quiet buf level lexbuf }
139 | '%' id { let id = Lexing.lexeme lexbuf in
140 let len = String.length id in
141 Ast.Substs.add_var buf (String.sub id 1 (len-1));
142 read_code quiet buf level lexbuf }
143 | '%' _ { raise (SyntaxError ("illegal character in %-substitution: " ^
144 Lexing.lexeme lexbuf)) }
145 | [^ '{' '}' '\r' '\n' '%' ]+
146 { Ast.Substs.add_string buf (Lexing.lexeme lexbuf);
147 read_code quiet buf level lexbuf }
148 | _ { raise (SyntaxError ("illegal character in code section: " ^
149 Lexing.lexeme lexbuf)) }
150 | eof { raise (SyntaxError ("unterminated code section")) }