and tactic = param_decl list * code
and param_decl = id
and id = string
-and code = substs
+and code = substs * bool
and returning = RetExpr | RetStrings | RetString
and substs = subst list
and subst =
(String.concat ", " (List.map (string_param_decl ()) param_decls))
(String.concat ", " (List.map (string_pattern ()) patterns))
(String.concat ", " (List.map (string_expr ()) exprs))
- (match code with None -> "" | Some code -> " = { ... }")
+ (match code with None -> ""
+ | Some (code, false) -> " = { ... }"
+ | Some (code, true) -> " = @{ ... }")
-and string_func () (name, (param_decls, returning, code)) =
- sprintf "function%s returning %s (%s) = { ... }"
+and string_func () (name, (param_decls, returning, (code, quiet))) =
+ sprintf "function%s returning %s (%s) = %s{ ... }"
(match name with None -> "" | Some name -> " " ^ name)
(match returning with RetExpr -> "expression"
| RetString -> "string"
| RetStrings -> "strings")
(String.concat ", " (List.map (string_param_decl ()) param_decls))
+ (if quiet then "@" else "")
-and string_tactic () (name, (param_decls, code)) =
- sprintf "tactic%s (%s) = { ... }"
+and string_tactic () (name, (param_decls, (code, quiet))) =
+ sprintf "tactic%s (%s) = %s{ ... }"
(match name with None -> "" | Some name -> " " ^ name)
(String.concat ", " (List.map (string_param_decl ()) param_decls))
+ (if quiet then "@" else "")
and string_param_decl () name = name
and tactic = param_decl list * code
and param_decl = id (** goal/func/tactic parameter. *)
and id = string
-and code = substs
+and code = substs * bool (** code + quiet flag *)
and returning = RetExpr | RetStrings | RetString
and substs = subst list
and subst =
failwithf "%a: cannot use tactic in shell expansion"
Ast.string_loc loc
-and run_code ?(quiet = false) env loc code =
+and run_code env loc (code, quiet) =
let code = to_shell_script env loc code in
let code =
"source " ^ Filename.quote Cmdline.prelude_sh_file ^ "\n" ^
(** Run a code section. Returns the exit code and the output printed
by the script. Raises [Failure _] on error. *)
-val run_code : ?quiet:bool -> Ast.env -> Ast.loc -> Ast.substs -> int * string
+val run_code : Ast.env -> Ast.loc -> Ast.code -> int * string
(** Evaluate a goal argument. This substitutes any variables found,
and recursively calls functions. *)
| "[" { LEFT_ARRAY }
| "]" { RIGHT_ARRAY }
| '"' { read_string (Ast.Substs.create ()) lexbuf }
- | "{" { read_code (Ast.Substs.create ()) (ref 1) lexbuf }
+ | "{" { read_code false (Ast.Substs.create ()) (ref 1) lexbuf }
+ | "@{" { read_code true (Ast.Substs.create ()) (ref 1) lexbuf }
| "goal" { GOAL }
| "tactic"
{ TACTIC_KEYWORD }
* Note the range of %-substitutions possible is larger than
* for strings.
*)
-and read_code buf level =
+and read_code quiet buf level =
parse
| '{' { Ast.Substs.add_char buf '{';
- incr level; read_code buf level lexbuf }
+ incr level; read_code quiet buf level lexbuf }
| '}' { decr level;
- if !level = 0 then CODE (Ast.Substs.get buf)
+ if !level = 0 then CODE (Ast.Substs.get buf, quiet)
else (
Ast.Substs.add_char buf '}';
- read_code buf level lexbuf
+ read_code quiet buf level lexbuf
) }
| newline { Ast.Substs.add_char buf '\n';
- new_line lexbuf; read_code buf level lexbuf }
- | '%' '%' { Ast.Substs.add_char buf '%'; read_code buf level lexbuf }
- | '%' '@' { Ast.Substs.add_var buf "@"; read_code buf level lexbuf }
- | '%' '<' { Ast.Substs.add_var buf "<"; read_code buf level lexbuf }
- | '%' '^' { Ast.Substs.add_var buf "^"; read_code buf level lexbuf }
+ new_line lexbuf; read_code quiet buf level lexbuf }
+ | '%' '%' { Ast.Substs.add_char buf '%'; read_code quiet buf level lexbuf }
+ | '%' '@' { Ast.Substs.add_var buf "@"; read_code quiet buf level lexbuf }
+ | '%' '<' { Ast.Substs.add_var buf "<"; read_code quiet buf level lexbuf }
+ | '%' '^' { Ast.Substs.add_var buf "^"; read_code quiet buf level lexbuf }
| '%' id { let id = Lexing.lexeme lexbuf in
let len = String.length id in
Ast.Substs.add_var buf (String.sub id 1 (len-1));
- read_code buf level lexbuf }
+ read_code quiet buf level lexbuf }
| '%' _ { raise (SyntaxError ("illegal character in %-substitution: " ^
Lexing.lexeme lexbuf)) }
| [^ '{' '}' '\r' '\n' '%' ]+
{ Ast.Substs.add_string buf (Lexing.lexeme lexbuf);
- read_code buf level lexbuf }
+ read_code quiet buf level lexbuf }
| _ { raise (SyntaxError ("illegal character in code section: " ^
Lexing.lexeme lexbuf)) }
| eof { raise (SyntaxError ("unterminated code section")) }
%}
(* Tokens. *)
-%token <Ast.substs> CODE
+%token <Ast.code> CODE
%token COLON
%token COMMA
%token EQUALS
match deps with
| [] -> env
| d :: _ -> Ast.Env.add "^" d env in
- let r, _ = Eval.run_code ~quiet:true env loc code in
+ let r, _ = Eval.run_code env loc code in
if r = 99 (* means "needs rebuild" *) then true
else if r = 0 (* means "doesn't need rebuild" *) then false
else (
# tactics.
# The only tactic that ‘make’ has.
-tactic *file (filename) = {
+tactic *file (filename) = @{
# Rebuild if the target file doesn't exist at all.
test -f %filename || exit 99
# This is a simpler tactic than the above since it will
# rebuild if the file is missing, but not if it is older.
-tactic *exists (filename) = {
+tactic *exists (filename) = @{
test -f %filename || exit 99
}
# Text functions.
# Sort + uniq a list.
-function sort (xs) returning strings = {
+function sort (xs) returning strings = @{
for f in %xs; do echo "$f"; done | sort -u
}
# File functions.
# Expand a wildcard into a list of filenames.
-function wildcard (wc) returning strings = {
+function wildcard (wc) returning strings = @{
shopt -s nullglob
# Note that the substitution is quoted by goals, so to expand
# it we must assign it to a variable and then use it unquoted.