2 * Copyright (C) 2012 Red Hat Inc.
4 * This program is free software; you can redistribute it and/or modify
5 * it under the terms of the GNU General Public License as published by
6 * the Free Software Foundation; either version 2 of the License, or
7 * (at your option) any later version.
9 * This program is distributed in the hope that it will be useful,
10 * but WITHOUT ANY WARRANTY; without even the implied warranty of
11 * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
12 * GNU General Public License for more details.
14 * You should have received a copy of the GNU General Public License along
15 * with this program; if not, write to the Free Software Foundation, Inc.,
16 * 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
19 (* For general information about camlp4, see:
20 * http://brion.inria.fr/gallium/index.php/Camlp4
22 * For information about quotations, see:
23 * http://brion.inria.fr/gallium/index.php/Quotation
32 let unique = let i = ref 0 in fun () -> incr i; !i
34 let unique_job_name () = sprintf "job$%d" (unique ())
37 let len = String.length s in
38 let sublen = String.length sub in
40 if i <= len-sublen then (
43 if s.[i+j] = sub.[j] then loop2 (j+1)
49 if r = -1 then loop (i+1) else r
55 let rec replace_str s s1 s2 =
56 let len = String.length s in
57 let sublen = String.length s1 in
61 let s' = String.sub s 0 i in
62 let s'' = String.sub s (i+sublen) (len-i-sublen) in
63 s' ^ s2 ^ replace_str s'' s1 s2
66 (* Convert a _loc to an AST. *)
67 let expr_of_loc _loc loc =
69 start_line, start_bol, start_off,
70 stop_line, stop_bol, stop_off,
71 ghost = Loc.to_tuple loc in
72 <:expr< Camlp4.PreCast.Loc.of_tuple
74 $`int:start_line$, $`int:start_bol$, $`int:start_off$,
75 $`int:stop_line$, $`int:stop_bol$, $`int:stop_off$,
78 (* Convert 'expr option' to an expression that contains the option inside. *)
79 let expr_of_option _loc = function
80 | None -> <:expr< None >>
81 | Some e -> <:expr< Some $e$ >>
83 (* "Lift" an expression, turning it from an expression into an OCaml
84 * abstract syntax tree in the output. This is pretty obscure.
85 * http://caml.inria.fr/pub/ml-archives/caml-list/2008/09/591f7c4a8df9295d675a5adcb6802748.en.html
87 module M = Ast.Meta.Make (Ast.Meta.MetaGhostLoc)
88 let lift_expr = M.Expr.meta_expr
90 (* Handle a top level statement. *)
91 let rec call_stmt ?name ?pre ?post (_loc, stmt, sh) =
94 | None -> let name = unique_job_name () in <:expr< $str:name$ >>
95 | Some name -> name in
96 let pre = expr_of_option _loc pre in
97 let post = expr_of_option _loc post in
99 | `When e -> when_stmt _loc name pre post e sh
100 | `Every p -> every_stmt _loc name pre post p sh
102 (* Handle a top level "when" statement.
103 * e -> when expression
104 * sh -> the shell script to run
105 * Returns a top level statement (str_item) which when executed just
106 * adds the statement to a global list.
108 and when_stmt _loc name pre post e sh =
109 let loc = expr_of_loc _loc _loc in
110 let e = lift_expr _loc e in
113 Whenfile.add_when_job $loc$ $name$ $pre$ $post$ $e$ $sh$
116 (* Handle a top level "every" statement. *)
117 and every_stmt _loc name pre post period sh =
118 let loc = expr_of_loc _loc _loc in
121 Whenfile.add_every_job $loc$ $name$ $pre$ $post$ $period$ $sh$
125 (* Quotation expander for shell script. *)
126 let sh_quotation_expander _loc _ sh =
127 let loc = expr_of_loc _loc _loc in
129 (* Convert ">\>" to ">>" in code. *)
130 let sh = replace_str sh ">\\>" ">>" in
132 <:expr< { Whenexpr.sh_loc = $loc$;
133 sh_script = $str:sh$ } >>
135 Quotation.add "sh" Quotation.DynAst.expr_tag sh_quotation_expander;
137 (* Default quotation expander (<< .. >>) should be shell script ("sh"). *)
138 Quotation.default := "sh"
140 (* For period expressions "<NN> (secs|mins|hours|...)" we cannot use
141 * the ordinary camlp4 parser since it only looks ahead by 1 symbol, so
142 * it gets "stuck" on the integer. Write a custom parser instead.
144 * Note the EXTEND macro implicitly reserves KEYWORDs.
147 Gram.Entry.of_parser "period"
149 match Stream.peek stream with
150 | Some (INT (_, i), info) ->
151 let i = int_of_string i in
152 let _loc = Gram.token_location info in
154 (match Stream.next stream with
155 | KEYWORD ("sec"|"secs"|"second"|"seconds"), _ ->
156 <:expr< Whenexpr.Every_seconds $`int:i$ >>
157 | KEYWORD ("min"|"mins"|"minute"|"minutes"), _ ->
159 <:expr< Whenexpr.Every_seconds $`int:i$ >>
160 | KEYWORD ("hour"|"hours"), _ ->
162 <:expr< Whenexpr.Every_seconds $`int:i$ >>
163 | KEYWORD ("day"|"days"), _ ->
164 <:expr< Whenexpr.Every_days $`int:i$ >>
165 | KEYWORD ("week"|"weeks"), _ ->
167 <:expr< Whenexpr.Every_days $`int:i$ >>
168 | KEYWORD ("month"|"months"), _ ->
169 <:expr< Whenexpr.Every_months $`int:i$ >>
170 | KEYWORD ("year"|"years"), _ ->
171 <:expr< Whenexpr.Every_years $`int:i$ >>
172 | KEYWORD ("decade"|"decades"), _ ->
174 <:expr< Whenexpr.Every_years $`int:i$ >>
175 | KEYWORD ("century"|"centuries"|"centurys"), _ ->
177 <:expr< Whenexpr.Every_years $`int:i$ >>
178 | KEYWORD ("millenium"|"millenia"|"milleniums"), _ ->
180 <:expr< Whenexpr.Every_years $`int:i$ >>
181 | (KEYWORD s | LIDENT s), _ ->
182 eprintf "period: failed to parse %d %s\n%!" i s;
187 | _ -> raise Stream.Failure
194 (* A period expression (used in "every"). *)
196 [ ["sec"|"secs"|"second"|"seconds"] ->
197 <:expr< Whenexpr.Every_seconds 1 >> ]
198 | [ ["min"|"mins"|"minute"|"minutes"] ->
199 <:expr< Whenexpr.Every_seconds 60 >> ]
200 | [ ["hour"|"hours"] -> <:expr< Whenexpr.Every_seconds 3600 >> ]
201 | [ ["day"|"days"] -> <:expr< Whenexpr.Every_days 1 >> ]
202 | [ ["week"|"weeks"] -> <:expr< Whenexpr.Every_days 7 >> ]
203 | [ ["month"|"months"] -> <:expr< Whenexpr.Every_months 1 >> ]
204 | [ ["year"|"years"] -> <:expr< Whenexpr.Every_years 1 >> ]
205 | [ ["decade"|"decades"] -> <:expr< Whenexpr.Every_years 10 >> ]
206 | [ ["century"|"centuries"|"centurys"] ->
207 <:expr< Whenexpr.Every_years 100 >> ]
208 | [ ["millenium"|"millenia"|"milleniums"] ->
209 <:expr< Whenexpr.Every_years 1000 >> ]
210 | [ e = period_parser -> e ]
213 (* Pre and post functions. *)
214 pre: [[ "pre"; f = expr -> f ]];
215 post: [[ "post"; f = expr -> f ]];
217 (* Top level statements. *)
219 [ "when"; e = expr; ":"; sh = expr ->
220 (_loc, `When e, sh) ]
221 | [ "every"; p = periodexpr; ":"; sh = expr ->
222 (_loc, `Every p, sh) ]
225 (* "str_item" is a top level statement in an OCaml program. *)
226 str_item: LEVEL "top" [
227 [ s = statement -> call_stmt s ]
228 | [ "job"; name = expr;
232 call_stmt ~name ?pre ?post s ]