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
|
(***********************************************************************)
(* *)
(* HEVEA *)
(* *)
(* Luc Maranget, projet Moscova, INRIA Rocquencourt *)
(* *)
(* Copyright 2001 Institut National de Recherche en Informatique et *)
(* Automatique. Distributed only by permission. *)
(* *)
(* $Id: subst.mll,v 1.19 2007/06/06 18:24:19 maranget Exp $ *)
(***********************************************************************)
{
open Misc
open Lexstate
open Lexing
let subst_buff = Out.create_buff ()
;;
}
let command_name =
'\\' ((['@''A'-'Z' 'a'-'z']+ '*'?) | [^ 'A'-'Z' 'a'-'z'] | "\\*")
rule subst = parse
| '#' ['1'-'9'] as lxm
{if is_plain '#' then begin
let i = Char.code (lxm.[1]) - Char.code '1' in
scan_arg
(fun arg -> scan_this_arg subst arg) i
end else
Out.put subst_buff lxm ;
subst lexbuf}
| '#' '#'
{if is_plain '#' then
Out.put_char subst_buff '#'
else
Out.put subst_buff "##" ;
subst lexbuf}
| "\\#" | '\\' | [^'\\' '#']+
{Out.blit subst_buff lexbuf ; subst lexbuf}
| "\\@print" as lxm
{Save.start_echo () ;
let _ = Save.arg lexbuf in
let real_arg = Save.get_echo () in
Out.put subst_buff lxm ;
Out.put subst_buff real_arg ;
subst lexbuf}
| command_name
{Out.blit subst_buff lexbuf ;
subst lexbuf}
| eof {()}
| "" {raise (Error "Empty lexeme in subst")}
and do_translate = parse
| "\\@print" as lxm
{fun f ->
Save.start_echo () ;
let _ = Save.arg lexbuf in
let real_arg = Save.get_echo () in
Out.put subst_buff lxm ;
Out.put subst_buff real_arg ;
do_translate lexbuf f}
| command_name
{fun f ->
Out.blit subst_buff lexbuf ;
do_translate lexbuf f}
| _ as lxm
{fun f ->
Out.put_char subst_buff (f lxm) ;
do_translate lexbuf f}
| eof {fun _ -> Out.to_string subst_buff}
{
let do_subst_this ({arg=arg ; subst=env} as x) =
if not (is_top env) then begin
try
let _ = String.index arg '#' in
if !verbose > 1 then begin
Printf.fprintf stderr "subst_this : [%s]\n" arg ;
prerr_args ()
end ;
let _ = scan_this_arg subst x in
let r = Out.to_string subst_buff in
if !verbose > 1 then
prerr_endline ("subst_this ["^arg^"] = "^r);
r
with Not_found -> arg
end else
arg
;;
let subst_list {arg=args ; subst=env} =
List.map
(fun arg -> do_subst_this {arg=arg; subst=env})
args
let subst_this s = do_subst_this (mkarg s (get_subst ()))
let subst_arg lexbuf = do_subst_this (save_arg lexbuf)
and subst_opt def lexbuf = do_subst_this (save_opt def lexbuf)
let subst_body = subst_arg
let translate f s =
let lexbuf = Lexing.from_string s in
do_translate lexbuf f
let lowercase s = translate Char.lowercase s
and uppercase s = translate Char.uppercase s
}
|
