From 2ac1b84cb49ad04e27b4543436b0227153fbfb15 Mon Sep 17 00:00:00 2001 From: "Richard W.M. Jones" Date: Sun, 5 Jan 2020 13:10:43 +0000 Subject: [PATCH] Functions return expressions instead of only lists of strings. --- Goalfile.in | 10 +++++----- Makefile.in | 15 +++++---------- src/eval.ml | 20 +++++++++----------- src/main.ml | 9 +++++++-- src/parse.ml | 13 ++++++------- src/parse.mli | 2 +- src/parser.mly | 24 +++++++++++++++++------- stdlib/prelude.gl | 12 ++++++++++-- 8 files changed, 60 insertions(+), 45 deletions(-) diff --git a/Goalfile.in b/Goalfile.in index 88e0684..393b4e9 100644 --- a/Goalfile.in +++ b/Goalfile.in @@ -33,11 +33,11 @@ let objects = [ "src/utils.cmx", "src/cmdline.cmx", "src/ast.cmx", - "src/eval.cmx", - "src/run.cmx", "src/parser.cmx", "src/lexer.cmx", "src/parse.cmx", + "src/eval.cmx", + "src/run.cmx", "src/main.cmx" ] @@ -64,9 +64,9 @@ goal maintainer-clean = : clean { "src/parser.mli", "src/parser.ml" : "src/parser.mly" { %MENHIR --explain %< - # Hack required to get includes working. - echo 'val lexer_read : (Lexing.lexbuf -> token) option ref' \ - >> src/parser.mli + # Hack required to break circular dependencies. + echo 'val lexer_read : (Lexing.lexbuf -> token) option ref' >> src/parser.mli + echo 'val eval_substitute : (Ast.env -> Ast.loc -> Ast.substs -> string) option ref' >> src/parser.mli } "src/lexer.ml" : "src/lexer.mll" { diff --git a/Makefile.in b/Makefile.in index f518c26..74fc7de 100644 --- a/Makefile.in +++ b/Makefile.in @@ -27,6 +27,7 @@ all clean depend install: src/goals # goals itself (see Goalfile.in). MENHIR = @MENHIR@ +OCAMLDEP = @OCAMLDEP@ OCAMLFIND = @OCAMLFIND@ OCAMLLEX = @OCAMLLEX@ OCAMLFLAGS = @OCAMLFLAGS@ @@ -34,18 +35,12 @@ OCAMLPACKAGES = @OCAMLPACKAGES@ src/goals: $(MENHIR) --explain src/parser.mly -# Hack required to get includes working. - echo 'val lexer_read : (Lexing.lexbuf -> token) option ref' \ - >> src/parser.mli +# Hack required to break circular dependencies. + echo 'val lexer_read : (Lexing.lexbuf -> token) option ref' >> src/parser.mli + echo 'val eval_substitute : (Ast.env -> Ast.loc -> Ast.substs -> string) option ref' >> src/parser.mli $(OCAMLLEX) src/lexer.mll $(OCAMLFIND) opt $(OCAMLFLAGS) $(OCAMLPACKAGES) -I src \ - src/config.mli src/utils.mli src/cmdline.mli src/ast.mli \ - src/eval.mli src/run.mli src/parser.mli src/lexer.mli \ - src/parse.mli \ - src/config.ml src/utils.ml src/cmdline.ml src/ast.ml \ - src/eval.ml src/run.ml src/parser.ml src/lexer.ml \ - src/parse.ml \ - src/main.ml \ + $$($(OCAMLDEP) -sort src/*.mli src/*.ml) \ -linkpkg -o $@ # These rules are required by autoconf. diff --git a/src/eval.ml b/src/eval.ml index a0ed834..c2d6551 100644 --- a/src/eval.ml +++ b/src/eval.ml @@ -183,10 +183,8 @@ and evaluate_goal_arg env = function (* Functions are only called from goal args or when substituting * 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 substituting - * the output into an EList. - * - * XXX In future allow functions to be annotated with a return type. + * function by running the associated shell script and parsing + * the output as an expression. *) and call_function env loc name args (params, code) = (* This is used to print the function in debug and error messages only. *) @@ -215,10 +213,13 @@ and call_function env loc name args (params, code) = let code = "set -e\n" (*^ "set -x\n"*) ^ "\n" ^ code in let chan = Unix.open_process_in code in - let lines = ref [] in - (try while true do lines := input_line chan :: !lines done + let b = Buffer.create 1024 in + (try + while true do + Buffer.add_string b (input_line chan); + Buffer.add_char b '\n' + done with End_of_file -> ()); - let lines = List.rev !lines in let st = Unix.close_process_in chan in (match st with | Unix.WEXITED 0 -> () @@ -230,7 +231,4 @@ and call_function env loc name args (params, code) = eprintf "*** function ‘%s’ stopped by signal %d\n" name i ); - Ast.EList (Ast.noloc, - (List.map (fun line -> - Ast.EConstant (Ast.noloc, Ast.CString line)) - lines)) + Parse.parse_expr (sprintf "function:%s" name) (Buffer.contents b) diff --git a/src/main.ml b/src/main.ml index 2e7ac44..6421aa8 100644 --- a/src/main.ml +++ b/src/main.ml @@ -19,6 +19,11 @@ open Printf +(* See comment in parser.mly. *) +let () = + Parser.lexer_read := Some Lexer.read; + Parser.eval_substitute := Some Eval.substitute + let main () = (* Change directory (-C option). *) Sys.chdir Cmdline.directory; @@ -37,12 +42,12 @@ let main () = let env = List.fold_left ( fun env (name, expr) -> - let expr = Parse.parse_cli_expr expr in + let expr = Parse.parse_expr "commandline" expr in Ast.Env.add name expr env ) env Cmdline.anon_vars in (* Parse the target expressions. *) - let targets = List.map Parse.parse_cli_expr Cmdline.targets in + let targets = List.map (Parse.parse_expr "commandline") Cmdline.targets in (* If no target was set on the command line, use "all ()". *) let targets = diff --git a/src/parse.ml b/src/parse.ml index d9210ff..6e1ff95 100644 --- a/src/parse.ml +++ b/src/parse.ml @@ -22,9 +22,6 @@ open Lexing open Printf -let () = - Parser.lexer_read := Some Lexer.read - let print_position fp lexbuf = let pos = lexbuf.lex_curr_p in fprintf fp "%s:%d:%d" @@ -62,9 +59,11 @@ let parse_goalfile env filename = close_in fp; env' -(* This is used to parse dependency expressions on the command line. *) -let parse_cli_expr str = - Cmdline.debug "parsing from command line: %S" str; +(* This is used to parse expressions on the command line and + * the output from functions. + *) +let parse_expr source str = + Cmdline.debug "parse expression: %S" str; let lexbuf = Lexing.from_string str in - lexbuf.lex_curr_p <- { lexbuf.lex_curr_p with pos_fname = "" }; + lexbuf.lex_curr_p <- { lexbuf.lex_curr_p with pos_fname = source }; parse_expr lexbuf diff --git a/src/parse.mli b/src/parse.mli index e4bddcf..e755a59 100644 --- a/src/parse.mli +++ b/src/parse.mli @@ -18,4 +18,4 @@ *) val parse_goalfile : Ast.env -> string -> Ast.env -val parse_cli_expr : string -> Ast.expr +val parse_expr : string -> string -> Ast.expr diff --git a/src/parser.mly b/src/parser.mly index c3148ca..aca014e 100644 --- a/src/parser.mly +++ b/src/parser.mly @@ -21,11 +21,13 @@ open Utils open Printf -(* This is initialized with Lexer.read once the program - * starts. Doing this avoids a circular dependency caused - * by include files. +(* There are several circular dependencies between the lexer + * (caused by includes) and eval. These references break + * the circular dependencies. They are initialized when + * the program starts, hence are never really None. *) let lexer_read = ref None +let eval_substitute = ref None let find_on_include_path filename = if not (Filename.is_implicit filename) then filename @@ -40,16 +42,18 @@ let find_on_include_path filename = ) let do_include env loc filename optflag file = - let filename = Eval.substitute env loc filename in + let eval_substitute = + match !eval_substitute with None -> assert false | Some f -> f in + let filename = eval_substitute env loc filename in let filename = find_on_include_path filename in if optflag && not (Sys.file_exists filename) then env else ( let fp = open_in filename in let lexbuf = Lexing.from_channel fp in lexbuf.lex_curr_p <- { lexbuf.lex_curr_p with pos_fname = filename }; - let reader = + let lexer_read = match !lexer_read with None -> assert false | Some r -> r in - let env' = file reader lexbuf in + let env' = file lexer_read lexbuf in close_in fp; Ast.Env.merge env env' ) @@ -152,8 +156,14 @@ expr: | LEFT_ARRAY barelist RIGHT_ARRAY { Ast.EList ($loc, $2) } ; barelist: - | separated_list(COMMA, expr) { $1 } + | right_flexible_list(COMMA, expr) { $1 } ; params: | LEFT_PAREN separated_list(COMMA, expr) RIGHT_PAREN { $2 } ; + +(* http://gallium.inria.fr/blog/lr-lists/ *) +right_flexible_list(delim, X): + | (* nothing *) { [] } + | x = X { [x] } + | x = X delim xs = right_flexible_list(delim, X) { x :: xs } diff --git a/stdlib/prelude.gl b/stdlib/prelude.gl index 7e6cbd5..f9fa642 100644 --- a/stdlib/prelude.gl +++ b/stdlib/prelude.gl @@ -42,7 +42,12 @@ tactic *exists (filename) = { # Sort + uniq a list. function sort (xs) = { - for f in %xs; do echo "$f"; done | sort -u + # XXX Quoting + echo '[' + for f in %xs; do echo "$f"; done | + sort -u | + sed 's/.*/"&",/' + echo ']' } #---------------------------------------------------------------------- @@ -50,11 +55,14 @@ function sort (xs) = { # Expand a wildcard into a list of filenames. function wildcard (wc) = { + # XXX Quoting 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 - echo "$f" + echo "\"$f\"," done + echo ']' } -- 1.8.3.1