From c07380a3a4dca44a29df4cb09265d10442c1d06f Mon Sep 17 00:00:00 2001 From: "Richard W.M. Jones" Date: Mon, 6 Jan 2020 09:51:15 +0000 Subject: [PATCH] Allow functions "returning strings" (etc), redefine sort function. --- TODO | 7 +++++++ src/ast.ml | 10 +++++++--- src/ast.mli | 3 ++- src/eval.ml | 28 +++++++++++++++++++++++----- src/lexer.mll | 8 ++++++++ src/parser.mly | 13 +++++++++++-- src/utils.ml | 24 ++++++++++++++++++++++++ src/utils.mli | 9 +++++++++ stdlib/prelude.gl | 14 ++++++-------- 9 files changed, 97 insertions(+), 19 deletions(-) diff --git a/TODO b/TODO index 1c9ab88..45b1880 100644 --- a/TODO +++ b/TODO @@ -36,6 +36,13 @@ https://www.gnu.org/software/make/manual/html_node/Remaking-Makefiles.html Code should be an expression, eg this ought to work: let foo = { echo "hello" } +and/or anonymous functions: +let foo = function (arg) { ... } + +Functions returning plain strings and lists of strings. +function (foo, bar) returning string = { echo hello } +function (foo, bar) returning strings = { echo hello; echo goodbye } +Then re-add the sort function. Should the environment be populated by the actual environment, eg: let homedir = "%HOME" diff --git a/src/ast.ml b/src/ast.ml index 922827c..a8a5248 100644 --- a/src/ast.ml +++ b/src/ast.ml @@ -54,11 +54,12 @@ and expr = and constant = | CString of string and goal = param_decl list * pattern list * expr list * code option -and func = param_decl list * code +and func = param_decl list * returning * code and tactic = param_decl list * code and param_decl = id and id = string and code = substs +and returning = RetExpr | RetStrings | RetString and substs = subst list and subst = | SString of string @@ -163,9 +164,12 @@ and string_goal () (name, (param_decls, patterns, exprs, code)) = (String.concat ", " (List.map (string_expr ()) exprs)) (match code with None -> "" | Some code -> " = { ... }") -and string_func () (name, (param_decls, code)) = - sprintf "function%s (%s) = { ... }" +and string_func () (name, (param_decls, returning, code)) = + sprintf "function%s returning %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)) and string_tactic () (name, (param_decls, code)) = diff --git a/src/ast.mli b/src/ast.mli index 9ee55b0..df6c60f 100644 --- a/src/ast.mli +++ b/src/ast.mli @@ -65,11 +65,12 @@ and expr = and constant = | CString of string and goal = param_decl list * pattern list * expr list * code option -and func = param_decl list * code +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 returning = RetExpr | RetStrings | RetString and substs = subst list and subst = | SString of string diff --git a/src/eval.ml b/src/eval.ml index 4496319..53c4dd0 100644 --- a/src/eval.ml +++ b/src/eval.ml @@ -211,13 +211,16 @@ and evaluate_goal_arg env = function * into a shell script or constant expression (this may change if we * implement ‘:=’ assignment for variables). This evaluates a * function by running the associated shell script and parsing - * the output as an expression. + * the output as an expression, string or list of strings. *) -and call_function env loc name args (params, code) = +and call_function env loc name args (params, returning, code) = (* This is used to print the function in debug and error messages only. *) let debug_func = - sprintf "%s (%s)" name - (String.concat ", " (List.map (Ast.string_expr ()) args)) in + sprintf "%s (%s) returning %s" name + (String.concat ", " (List.map (Ast.string_expr ()) args)) + (match returning with RetExpr -> "expression" + | RetString -> "string" + | RetStrings -> "strings") in Cmdline.debug "%a: running function %s" Ast.string_loc loc debug_func; (* Evaluate function args. Must be done before updating the environment. *) @@ -240,4 +243,19 @@ and call_function env loc name args (params, code) = eprintf "*** function ‘%s’ failed with exit code %d\n" name r; exit 1 ); - Parse.parse_expr (sprintf "function:%s" name) b + + match returning with + | RetExpr -> Parse.parse_expr (sprintf "function:%s" name) b + | RetString -> Ast.EConstant (loc, Ast.CString b) + | RetStrings -> + (* run_code always adds \n after the final line, so when we + * read it back we will get a final empty string which we + * have to drop. XXX Probably better to preserve the lines + * read from the external command. + *) + let strs = nsplit "\n" b in + let strs = List.rev strs in + let strs = match strs with "" :: xs -> xs | xs -> xs in + let strs = List.rev strs in + let strs = List.map (fun s -> Ast.EConstant (loc, Ast.CString s)) strs in + EList (loc, strs) diff --git a/src/lexer.mll b/src/lexer.mll index 66c6b9f..ae4a030 100644 --- a/src/lexer.mll +++ b/src/lexer.mll @@ -61,6 +61,14 @@ rule read = { INCLUDE } | "-include" { OPTINCLUDE } + | "returning" + { RETURNING } + | "expression" + { EXPRESSION } + | "string" + { STRING_KEYWORD } + | "strings" + { STRINGS } | "*" id { (* NB: The initial '*' is part of the name. *) TACTIC (Lexing.lexeme lexbuf) } | id { ID (Lexing.lexeme lexbuf) } diff --git a/src/parser.mly b/src/parser.mly index aca014e..faccb6b 100644 --- a/src/parser.mly +++ b/src/parser.mly @@ -65,6 +65,7 @@ let do_include env loc filename optflag file = %token COMMA %token EQUALS %token EOF +%token EXPRESSION %token FUNCTION %token GOAL %token ID @@ -73,10 +74,13 @@ let do_include env loc filename optflag file = %token LEFT_PAREN %token LET %token OPTINCLUDE +%token RETURNING %token RIGHT_ARRAY %token RIGHT_PAREN %token SEMICOLON %token STRING +%token STRING_KEYWORD +%token STRINGS %token TACTIC %token TACTIC_KEYWORD @@ -113,9 +117,9 @@ stmt: let name, params = $1 in name, Ast.EGoalDefn ($loc, (params, [], [], Some $2)) } - | FUNCTION ID params_decl EQUALS CODE + | FUNCTION ID params_decl return_decl EQUALS CODE { - $2, Ast.EFuncDefn ($loc, ($3, $5)) + $2, Ast.EFuncDefn ($loc, ($3, $4, $6)) } | TACTIC_KEYWORD TACTIC params_decl EQUALS CODE { @@ -133,6 +137,11 @@ params_decl: ; param_decl: | ID { $1 } +return_decl: + | { RetExpr } + | RETURNING EXPRESSION { RetExpr } + | RETURNING STRINGS { RetStrings } + | RETURNING STRING_KEYWORD { RetString } patterns: | separated_list(COMMA, pattern) { $1 } diff --git a/src/utils.ml b/src/utils.ml index d1b0efa..50adfb4 100644 --- a/src/utils.ml +++ b/src/utils.ml @@ -58,6 +58,30 @@ let rec string_find s sub = in loop 0 +let rec split sep str = + let len = String.length sep in + let seplen = String.length str in + let i = string_find str sep in + if i = -1 then str, "" + else ( + String.sub str 0 i, String.sub str (i + len) (seplen - i - len) + ) + +and nsplit ?(max = 0) sep str = + if max < 0 then + invalid_arg "String.nsplit: max parameter should not be negative"; + + (* If we reached the limit, OR if the pattern does not match the string + * at all, return the rest of the string as a single element list. + *) + if max = 1 || string_find str sep = -1 then + [str] + else ( + let s1, s2 = split sep str in + let max = if max = 0 then 0 else max - 1 in + s1 :: nsplit ~max sep s2 + ) + let isspace c = c = ' ' (* || c = '\f' *) || c = '\n' || c = '\r' || c = '\t' (* || c = '\v' *) diff --git a/src/utils.mli b/src/utils.mli index 5fabcfb..bbb8670 100644 --- a/src/utils.mli +++ b/src/utils.mli @@ -35,6 +35,15 @@ val string_find : string -> string -> int (** [string_find str sub] finds the index of [sub] in [str]. If not found, returns -1. *) +val nsplit : ?max:int -> string -> string -> string list +(** [nsplit ?max sep str] splits [str] into multiple strings at each + separator [sep]. + + As with the Perl split function, you can give an optional + [?max] parameter to limit the number of strings returned. The + final element of the list will contain the remainder of the + input string. *) + val isspace : char -> bool val triml : ?test:(char -> bool) -> string -> string val trimr : ?test:(char -> bool) -> string -> string diff --git a/stdlib/prelude.gl b/stdlib/prelude.gl index fdb23e9..bfeb0ba 100644 --- a/stdlib/prelude.gl +++ b/stdlib/prelude.gl @@ -40,21 +40,19 @@ tactic *exists (filename) = { #---------------------------------------------------------------------- # Text functions. - +# Sort + uniq a list. +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) = { +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. wc=%wc - echo '[' - for f in $wc; do - quoted_string "$f" - echo ',' - done - echo ']' + for f in $wc; do echo "$f"; done } -- 1.8.3.1