From deb7edaccefe379139818e8b241844b9a0571651 Mon Sep 17 00:00:00 2001 From: "Richard W.M. Jones" Date: Mon, 6 Jan 2020 21:38:07 +0000 Subject: [PATCH] lexer: Use @{...} for quiet code sections. --- src/ast.ml | 16 ++++++++++------ src/ast.mli | 2 +- src/eval.ml | 2 +- src/eval.mli | 2 +- src/lexer.mll | 25 +++++++++++++------------ src/parser.mly | 2 +- src/run.ml | 2 +- stdlib/prelude.gl | 8 ++++---- 8 files changed, 32 insertions(+), 27 deletions(-) diff --git a/src/ast.ml b/src/ast.ml index a8a5248..76b0ff3 100644 --- a/src/ast.ml +++ b/src/ast.ml @@ -58,7 +58,7 @@ and func = param_decl list * returning * code 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 = @@ -162,20 +162,24 @@ and string_goal () (name, (param_decls, patterns, exprs, code)) = (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 diff --git a/src/ast.mli b/src/ast.mli index df6c60f..371c209 100644 --- a/src/ast.mli +++ b/src/ast.mli @@ -69,7 +69,7 @@ and func = param_decl list * returning * code 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 = diff --git a/src/eval.ml b/src/eval.ml index 53c4dd0..0d945af 100644 --- a/src/eval.ml +++ b/src/eval.ml @@ -142,7 +142,7 @@ and expr_to_shell_string env = function 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" ^ diff --git a/src/eval.mli b/src/eval.mli index 2a86601..82bab71 100644 --- a/src/eval.mli +++ b/src/eval.mli @@ -29,7 +29,7 @@ val substitute : Ast.env -> Ast.loc -> Ast.substs -> string (** 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. *) diff --git a/src/lexer.mll b/src/lexer.mll index 8f56d5b..6afa40c 100644 --- a/src/lexer.mll +++ b/src/lexer.mll @@ -50,7 +50,8 @@ rule read = | "[" { 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 } @@ -119,31 +120,31 @@ and read_string buf = * 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")) } diff --git a/src/parser.mly b/src/parser.mly index c59a555..7f606ef 100644 --- a/src/parser.mly +++ b/src/parser.mly @@ -60,7 +60,7 @@ let do_include env loc filename optflag file = %} (* Tokens. *) -%token CODE +%token CODE %token COLON %token COMMA %token EQUALS diff --git a/src/run.ml b/src/run.ml index 6d14f9d..9eb3df6 100644 --- a/src/run.ml +++ b/src/run.ml @@ -191,7 +191,7 @@ and needs_rebuild env loc deps extra_deps pattern = 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 ( diff --git a/stdlib/prelude.gl b/stdlib/prelude.gl index bfeb0ba..240d40d 100644 --- a/stdlib/prelude.gl +++ b/stdlib/prelude.gl @@ -21,7 +21,7 @@ # 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 @@ -33,7 +33,7 @@ tactic *file (filename) = { # 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 } @@ -41,7 +41,7 @@ tactic *exists (filename) = { # 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 } @@ -49,7 +49,7 @@ function sort (xs) returning strings = { # 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. -- 1.8.3.1