X-Git-Url: http://git.annexia.org/?a=blobdiff_plain;f=src%2Feval.ml;h=24b04d435d0beecca0494cea483842406b0fa280;hb=98b795ddf06271fa8018edcd0bd15960871828fd;hp=4589a40725b35541c3d0171f425e13d2297d608a;hpb=881b2e9b7bad0da8f44418e9e6558710db5ce690;p=goals.git diff --git a/src/eval.ml b/src/eval.ml index 4589a40..24b04d4 100644 --- a/src/eval.ml +++ b/src/eval.ml @@ -55,8 +55,8 @@ let rec to_constant env = function Ast.string_loc loc name ) - | ETacticCtor (loc, name, _) -> - failwithf "%a: cannot use tactic ‘%s’ in constant expression" + | EPredCtor (loc, name, _) -> + failwithf "%a: cannot use predicate ‘%s’ in constant expression" Ast.string_loc loc name | EGoalDefn (loc, _) -> @@ -67,8 +67,8 @@ let rec to_constant env = function failwithf "%a: cannot use function in constant expression" Ast.string_loc loc - | ETacticDefn (loc, _) -> - failwithf "%a: cannot use tactic in constant expression" + | EPredDefn (loc, _) -> + failwithf "%a: cannot use predicate in constant expression" Ast.string_loc loc and substitute env loc substs = @@ -128,9 +128,9 @@ and expr_to_shell_string env = function Ast.string_loc loc name ) - (* Tactics expand to the first parameter. *) - | ETacticCtor (loc, _, []) -> Filename.quote "" - | ETacticCtor (loc, _, (arg :: _)) -> expr_to_shell_string env arg + (* Predicates expand to the first parameter. *) + | EPredCtor (loc, _, []) -> Filename.quote "" + | EPredCtor (loc, _, (arg :: _)) -> expr_to_shell_string env arg | EGoalDefn (loc, _) -> failwithf "%a: cannot use goal in shell expansion" @@ -140,8 +140,8 @@ and expr_to_shell_string env = function failwithf "%a: cannot use function in shell expansion" Ast.string_loc loc - | ETacticDefn (loc, _) -> - failwithf "%a: cannot use tactic in shell expansion" + | EPredDefn (loc, _) -> + failwithf "%a: cannot use predicate in shell expansion" Ast.string_loc loc and run_code env loc code = @@ -186,11 +186,11 @@ and run_code_to_string_list env loc code = i, lines and prepare_code env loc (code, quiet) = - let quiet = if Cmdline.debug_flag then false else quiet in + let quiet = if Cmdline.debug_flag () then false else quiet in let code = to_shell_script env loc code in "source " ^ Filename.quote Cmdline.prelude_sh_file ^ "\n" ^ "set -e\n" ^ - (if not quiet then "set -x\n" else "") ^ + (if not (Cmdline.silent ()) && not quiet then "set -x\n" else "") ^ "\n" ^ code @@ -206,8 +206,8 @@ and evaluate_goal_arg env = function | EList (loc, exprs) -> Ast.EList (loc, List.map (evaluate_goal_arg env) exprs) - | ETacticCtor (loc, name, exprs) -> - Ast.ETacticCtor (loc, name, List.map (evaluate_goal_arg env) exprs) + | EPredCtor (loc, name, exprs) -> + Ast.EPredCtor (loc, name, List.map (evaluate_goal_arg env) exprs) | ECall (loc, name, args) -> let expr = Ast.getvar env loc name in @@ -230,7 +230,7 @@ and evaluate_goal_arg env = function | EConstant _ | EGoalDefn _ | EFuncDefn _ - | ETacticDefn _ as e -> e + | EPredDefn _ as e -> e (* Functions are only called from goal args or when substituting * into a shell script or constant expression (this may change if we @@ -270,18 +270,18 @@ and call_function_really env loc name returning code = match returning with | RetExpr -> let r, b = run_code_to_string env loc code in - if r <> 0 then ( - eprintf "*** function ‘%s’ failed with exit code %d\n" name r; - exit 1 - ); + if r <> 0 then + failwithf "function ‘%s’ failed with exit code %d" name r; Parse.parse_expr (sprintf "function:%s" name) b | RetString -> let r, b = run_code_to_string env loc code in - if r <> 0 then ( - eprintf "*** function ‘%s’ failed with exit code %d\n" name r; - exit 1 - ); + if r <> 0 then + failwithf "function ‘%s’ failed with exit code %d" name r; + (* Remove a single trailing \n if present. *) + let b = + let len = String.length b in + if len > 0 && b.[len-1] = '\n' then String.sub b 0 (len-1) else b in Ast.EConstant (loc, Ast.CString b) | RetStrings ->