lexer: Use @{...} for quiet code sections.
authorRichard W.M. Jones <rjones@redhat.com>
Mon, 6 Jan 2020 21:38:07 +0000 (21:38 +0000)
committerRichard W.M. Jones <rjones@redhat.com>
Mon, 6 Jan 2020 21:39:24 +0000 (21:39 +0000)
src/ast.ml
src/ast.mli
src/eval.ml
src/eval.mli
src/lexer.mll
src/parser.mly
src/run.ml
stdlib/prelude.gl

index a8a5248..76b0ff3 100644 (file)
@@ -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
 
index df6c60f..371c209 100644 (file)
@@ -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 =
index 53c4dd0..0d945af 100644 (file)
@@ -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" ^
index 2a86601..82bab71 100644 (file)
@@ -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. *)
index 8f56d5b..6afa40c 100644 (file)
@@ -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")) }
index c59a555..7f606ef 100644 (file)
@@ -60,7 +60,7 @@ let do_include env loc filename optflag file =
 %}
 
 (* Tokens. *)
-%token <Ast.substs> CODE
+%token <Ast.code> CODE
 %token COLON
 %token COMMA
 %token EQUALS
index 6d14f9d..9eb3df6 100644 (file)
@@ -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 (
index bfeb0ba..240d40d 100644 (file)
@@ -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.