From 6afdc65fcdb592dccb751849f65b1f482ef97cd6 Mon Sep 17 00:00:00 2001 From: "Richard W.M. Jones" Date: Sat, 28 Dec 2019 18:43:25 +0000 Subject: [PATCH] Implement stdlib directory, -I, --no-prelude, etc. --- src/Makefile.in | 5 ++- src/ast.ml | 7 +++- src/ast.mli | 3 ++ src/cmdline.ml | 105 ++++++++++++++++++++++++++++++++++++++++++++++++++++++ src/cmdline.mli | 44 +++++++++++++++++++++++ src/lexer.mll | 1 + src/main.ml | 99 +++++++++++--------------------------------------- src/parse.ml | 15 +++++--- src/parse.mli | 2 +- src/parser.mly | 41 ++++++++++++++++++--- src/utils.ml | 3 ++ src/utils.mli | 3 ++ stdlib/prelude.gl | 38 ++++++++++++++++++++ stdlib/url.gl | 27 ++++++++++++++ tests/test1.gl | 9 +++-- 15 files changed, 305 insertions(+), 97 deletions(-) create mode 100644 src/cmdline.ml create mode 100644 src/cmdline.mli create mode 100644 stdlib/prelude.gl create mode 100644 stdlib/url.gl diff --git a/src/Makefile.in b/src/Makefile.in index 29e5382..4d6640e 100644 --- a/src/Makefile.in +++ b/src/Makefile.in @@ -19,11 +19,12 @@ OBJECTS = \ config.cmx \ utils.cmx \ + cmdline.cmx \ ast.cmx \ + eval.cmx \ parser.cmx \ lexer.cmx \ parse.cmx \ - eval.cmx \ main.cmx all: goals @@ -50,6 +51,8 @@ goals: $(OBJECTS) parser.ml parser.mli: stamp-parser stamp-parser: parser.mly @MENHIR@ --explain $< +# Hack required to get includes working. + echo 'val lexer_read : (Lexing.lexbuf -> token) option ref' >> parser.mli touch $@ lexer.ml: lexer.mll lexer.cmi parser.ml diff --git a/src/ast.ml b/src/ast.ml index 9f3326a..587c888 100644 --- a/src/ast.ml +++ b/src/ast.ml @@ -22,7 +22,12 @@ open Printf open Utils -module Env = Map.Make (String) +module Env = struct + include Map.Make (String) + + let merge env env' = + List.fold_left (fun env (k, v) -> add k v env) env (bindings env') +end type loc = position * position let noloc = dummy_pos, dummy_pos diff --git a/src/ast.mli b/src/ast.mli index 56bfa7b..831878d 100644 --- a/src/ast.mli +++ b/src/ast.mli @@ -26,6 +26,9 @@ module Env : sig val fold: (key -> 'a -> 'b -> 'b) -> 'a t -> 'b -> 'b val filter: (key -> 'a -> bool) -> 'a t -> 'a t val bindings: 'a t -> (key * 'a) list + + (* This is not the normal Map.merge function. *) + val merge : 'a t -> 'a t -> 'a t end (** Location where we parsed from $loc = $startpos, $endpos *) diff --git a/src/cmdline.ml b/src/cmdline.ml new file mode 100644 index 0000000..53ab0f9 --- /dev/null +++ b/src/cmdline.ml @@ -0,0 +1,105 @@ +(* Goalfile command line + * Copyright (C) 2019 Richard W.M. Jones + * Copyright (C) 2019 Red Hat Inc. + * + * This program is free software; you can redistribute it and/or modify + * it under the terms of the GNU General Public License as published by + * the Free Software Foundation; either version 2 of the License, or + * (at your option) any later version. + * + * This program is distributed in the hope that it will be useful, + * but WITHOUT ANY WARRANTY; without even the implied warranty of + * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + * GNU General Public License for more details. + * + * You should have received a copy of the GNU General Public License along + * with this program; if not, write to the Free Software Foundation, Inc., + * 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. + *) + +open Printf + +open Utils + +(* See also "let id" in [lexer.mll]. *) +let var_regexp = + Str.regexp "\\([a-zA-Z_][a-zA-Z0-9_]*\\)[ \t]*=[ \t]*\\(.*\\)" + +let usage = + "\ +goals: Build software. + + goals [-f Goalfile] ['var=value' ...] ['target' ...] + +For detailed help see goals(1). + +Options:" + +let print_version () = + printf "%s %s\n" Config.package_name Config.package_version; + exit 0 + +(* Get stdlib directory. *) +let datadir = + try Sys.getenv "GOALS_DATADIR" with Not_found -> Config.datadir +let stdlibdir = datadir // "stdlib" +let prelude_file = stdlibdir // "prelude.gl" +let () = + if not (is_directory stdlibdir) || not (Sys.file_exists prelude_file) then + failwithf "%s: cannot find the standard library directory, expected %s. If the standard library directory is in a non-standard location then set GOALS_DATADIR. If you can trying to run goals from the build directory then use ‘./run goals ...’" + Sys.executable_name stdlibdir + +let input_file, directory, includes, use_prelude, anon_vars, targets = + let args = ref [] in + let directory = ref "." in + let input_file = ref "Goalfile" in + let includes = ref [stdlibdir] in + let add_include dir = includes := dir :: !includes in + let use_prelude = ref true in + + let argspec = [ + "-C", Arg.Set_string directory, + "directory Change to directory before running"; + "--directory", Arg.Set_string directory, + "directory Change to directory before running"; + "-f", Arg.Set_string input_file, + "filename Set name of Goalfile"; + "--file", Arg.Set_string input_file, + "filename Set name of Goalfile"; + "-I", Arg.String add_include, + "dir Add include directory"; + "--include", Arg.String add_include, + "dir Add include directory"; + "--no-prelude",Arg.Clear use_prelude, + " Do not automatically use prelude.gl from stdlib"; + "-V", Arg.Unit print_version, + " Print version and exit"; + "--version", Arg.Unit print_version, + " Print version and exit"; + ] in + let argspec = Arg.align argspec in + let anon_fun s = args := s :: !args in + Arg.parse argspec anon_fun usage; + + let args = List.rev !args in + let directory = !directory in + let input_file = absolute_path !input_file in + (* Don't reverse includes - we want newer -I options to take precedence. *) + let includes = List.map absolute_path !includes in + let use_prelude = !use_prelude in + + (* Get the anon var assignments and targets. *) + let anon_vars, targets = + List.partition ( + fun arg -> Str.string_match var_regexp arg 0 + ) args in + let anon_vars = + List.map ( + fun arg -> + ignore (Str.string_match var_regexp arg 0); + let name = Str.matched_group 1 arg in + let expr = Str.matched_group 2 arg in + (name, expr) + ) anon_vars in + + input_file, directory, includes, use_prelude, anon_vars, targets diff --git a/src/cmdline.mli b/src/cmdline.mli new file mode 100644 index 0000000..e9ab8f1 --- /dev/null +++ b/src/cmdline.mli @@ -0,0 +1,44 @@ +(* Goals command line + * Copyright (C) 2019 Richard W.M. Jones + * Copyright (C) 2019 Red Hat Inc. + * + * This program is free software; you can redistribute it and/or modify + * it under the terms of the GNU General Public License as published by + * the Free Software Foundation; either version 2 of the License, or + * (at your option) any later version. + * + * This program is distributed in the hope that it will be useful, + * but WITHOUT ANY WARRANTY; without even the implied warranty of + * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + * GNU General Public License for more details. + * + * You should have received a copy of the GNU General Public License along + * with this program; if not, write to the Free Software Foundation, Inc., + * 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. + *) + +val stdlibdir : string +(** Get the stdlib directory. *) + +val prelude_file : string +(** Get the absolute path of the prelude.gl file. *) + +val input_file : string +(** Get the name of the input Goalfile. + This is an absolute path. *) + +val directory : string +(** Get the name of working directory (-C option). *) + +val includes : string list +(** Get list of include directories (-I option). + These are all absolute paths. *) + +val use_prelude : bool +(** True if we should load the prelude, or false if --no-prelude. *) + +val anon_vars : (string * string) list +(** List of anonymous variable assignments on the command line. *) + +val targets : string list +(** List of target expressions on the command line. *) diff --git a/src/lexer.mll b/src/lexer.mll index 273b09d..617c10f 100644 --- a/src/lexer.mll +++ b/src/lexer.mll @@ -53,6 +53,7 @@ rule read = | "goal" { GOAL } | "tactic" { TACTIC_KEYWORD } | "let" { LET } + | "include" { INCLUDE } | "*" id { (* NB: The initial '*' is part of the name. *) TACTIC (Lexing.lexeme lexbuf) } | id { ID (Lexing.lexeme lexbuf) } diff --git a/src/main.ml b/src/main.ml index c23b70a..127c24c 100644 --- a/src/main.ml +++ b/src/main.ml @@ -19,90 +19,30 @@ open Printf -open Utils - -(* See also "let id" in [lexer.mll]. *) -let var_regexp = - Str.regexp "\\([a-zA-Z_][a-zA-Z0-9_]*\\)[ \t]*=[ \t]*\\(.*\\)" - -let usage = - "\ -goals: Build software. - - goals [-f Goalfile] ['var=value' ...] ['target' ...] - -For detailed help see goals(1). - -Options:" - -let print_version () = - printf "%s %s\n" Config.package_name Config.package_version; - exit 0 - let main () = - (* Get stdlib directory. *) - let datadir = - try Sys.getenv "GOALS_DATADIR" with Not_found -> Config.datadir in - let stdlibdir = datadir // "stdlib" in - let prelude_gl = stdlibdir // "prelude.gl" in - if not (is_directory stdlibdir) || not (Sys.file_exists prelude_gl) then - failwithf "%s: cannot find the standard library directory, expected %s. If the standard library directory is in a non-standard location then set GOALS_DATADIR. If you can trying to run goals from the build directory then use ‘./run goals ...’" - Sys.executable_name stdlibdir; - - (* Command line arguments. *) - let args = ref [] in - let directory = ref "." in - let filename = ref "Goalfile" in - - let argspec = [ - "-C", Arg.Set_string directory, - "directory Change to directory before running"; - "--directory", Arg.Set_string directory, - "directory Change to directory before running"; - "-f", Arg.Set_string filename, - "filename Set name of Goalfile"; - "--file", Arg.Set_string filename, - "filename Set name of Goalfile"; - "-V", Arg.Unit print_version, - " Print version and exit"; - "--version", Arg.Unit print_version, - " Print version and exit"; - ] in - let argspec = Arg.align argspec in - let anon_fun s = args := s :: !args in - Arg.parse argspec anon_fun usage; + (* Change directory (-C option). *) + Sys.chdir Cmdline.directory; - let args = List.rev !args in - let directory = !directory in - let filename = !filename in + (* Parse the prelude. *) + let env = + if Cmdline.use_prelude then + Parse.parse_goalfile Ast.Env.empty Cmdline.prelude_file + else + Ast.Env.empty in (* Parse the input file. *) - let env = Parse.parse_goalfile filename in + let env = Parse.parse_goalfile env Cmdline.input_file in - (* Now we've read the input, change directory. *) - Sys.chdir directory; + (* Parse the command line assignments. *) + let env = + List.fold_left ( + fun env (name, expr) -> + let expr = Parse.parse_cli_expr expr in + Ast.Env.add name expr env + ) env Cmdline.anon_vars in - (* Parse the command line anon args. Each parameter has the - * form "name=" to assign a value to a variable, or - * "" to indicate a target to build. - *) - let targets = ref [] in - let env = ref env in - List.iter ( - fun arg -> - if Str.string_match var_regexp arg 0 then ( - (* assignment *) - let name = Str.matched_group 1 arg in - let expr = Parse.parse_cli_expr (Str.matched_group 2 arg) in - env := Ast.Env.add name expr !env - ) - else ( - (* target *) - let expr = Parse.parse_cli_expr arg in - targets := expr :: !targets - ) - ) args; - let targets = List.rev !targets and env = !env in + (* Parse the target expressions. *) + let targets = List.map Parse.parse_cli_expr Cmdline.targets in (* If no target was set on the command line, use "all ()". *) let targets = @@ -117,4 +57,5 @@ let main () = let () = try main () with - Failure msg -> prerr_endline msg; exit 1 + Failure msg | Sys_error msg -> + prerr_endline ("error: " ^ msg); exit 1 diff --git a/src/parse.ml b/src/parse.ml index 07647c2..1a4c206 100644 --- a/src/parse.ml +++ b/src/parse.ml @@ -22,13 +22,18 @@ 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" pos.pos_fname pos.pos_lnum (pos.pos_cnum - pos.pos_bol) -let parse_file lexbuf = - try Parser.file Lexer.read lexbuf +let parse_file env lexbuf = + try + let env' = Parser.file Lexer.read lexbuf in + Ast.Env.merge env env' with | SyntaxError msg -> eprintf "%a: %s\n" print_position lexbuf msg; @@ -48,13 +53,13 @@ let parse_expr lexbuf = exit 1 (* This is used to parse the Goalfile. *) -let parse_goalfile filename = +let parse_goalfile env filename = 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 env : Ast.env = parse_file lexbuf in + let env' = parse_file env lexbuf in close_in fp; - env + env' (* This is used to parse dependency expressions on the command line. *) let parse_cli_expr str = diff --git a/src/parse.mli b/src/parse.mli index 39893a1..e4bddcf 100644 --- a/src/parse.mli +++ b/src/parse.mli @@ -17,5 +17,5 @@ * 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. *) -val parse_goalfile : string -> Ast.env +val parse_goalfile : Ast.env -> string -> Ast.env val parse_cli_expr : string -> Ast.expr diff --git a/src/parser.mly b/src/parser.mly index 3a17124..c6f961d 100644 --- a/src/parser.mly +++ b/src/parser.mly @@ -18,7 +18,14 @@ *) %{ +open Utils open Printf + +(* This is initialized with Lexer.read once the program + * starts. Doing this avoids a circular dependency caused + * by include files. + *) +let lexer_read = ref None %} (* Tokens. *) @@ -29,6 +36,7 @@ open Printf %token EOF %token GOAL %token ID +%token INCLUDE %token LEFT_ARRAY %token LEFT_PAREN %token LET @@ -39,7 +47,7 @@ open Printf %token TACTIC_KEYWORD (* Start nonterminals. *) -%start file +%start file %start expr %% @@ -48,12 +56,35 @@ file: ; stmts: - | list(stmt) - { List.fold_left ( - fun env (name, expr) -> Ast.Env.add name expr env - ) Ast.Env.empty $1 + | (* none *) { Ast.Env.empty } + | stmts INCLUDE STRING + { + let env = $1 in + let filename = Ast.substitute env $loc $3 in + let rec find_on_include_path = + function + | [] -> filename + | inc :: incs -> + let path = inc // filename in + if Sys.file_exists path then path + else find_on_include_path incs + in + let filename = + if Filename.is_implicit filename then + find_on_include_path Cmdline.includes + else filename in + 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 = + match !lexer_read with None -> assert false | Some r -> r in + let env' = file reader lexbuf in + close_in fp; + Ast.Env.merge env env' } + | stmts stmt { let name, expr = $2 in Ast.Env.add name expr $1 } ; + stmt: | option(goal_stmt) patterns COLON barelist option(CODE) { let name, params = diff --git a/src/utils.ml b/src/utils.ml index c495675..d1b0efa 100644 --- a/src/utils.ml +++ b/src/utils.ml @@ -82,3 +82,6 @@ let trimr ?(test = isspace) str = let trim ?(test = isspace) str = trimr ~test (triml ~test str) + +let absolute_path path = + if not (Filename.is_relative path) then path else Sys.getcwd () // path diff --git a/src/utils.mli b/src/utils.mli index e3981cd..5fabcfb 100644 --- a/src/utils.mli +++ b/src/utils.mli @@ -40,3 +40,6 @@ val triml : ?test:(char -> bool) -> string -> string val trimr : ?test:(char -> bool) -> string -> string val trim : ?test:(char -> bool) -> string -> string (** Trim strings at left, right or both. *) + +val absolute_path : string -> string +(** Convert any path into an absolute path. *) diff --git a/stdlib/prelude.gl b/stdlib/prelude.gl new file mode 100644 index 0000000..70c664c --- /dev/null +++ b/stdlib/prelude.gl @@ -0,0 +1,38 @@ +# Goals stdlib prelude. +# Copyright (C) 2019 Richard W.M. Jones +# Copyright (C) 2019 Red Hat Inc. +# +# This program is free software; you can redistribute it and/or modify +# it under the terms of the GNU General Public License as published by +# the Free Software Foundation; either version 2 of the License, or +# (at your option) any later version. +# +# This program is distributed in the hope that it will be useful, +# but WITHOUT ANY WARRANTY; without even the implied warranty of +# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +# GNU General Public License for more details. +# +# You should have received a copy of the GNU General Public License along +# with this program; if not, write to the Free Software Foundation, Inc., +# 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. + +# This file is included first and automatically in all Goalfiles +# (unless you use --no-prelude). It contains standard goals and +# tactics. + +# The only tactic that ‘make’ has. +tactic *file (filename) = { + # Rebuild if the target file doesn't exist at all. + test -f %filename || exit 99 + + # Otherwise rebuild if it is older than any dependency. + for f in %<; do + test %filename -ot "$f" && exit 99 || exit 0 + done +} + +# 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) = { + test -f %filename || exit 99 +} diff --git a/stdlib/url.gl b/stdlib/url.gl new file mode 100644 index 0000000..2f59faa --- /dev/null +++ b/stdlib/url.gl @@ -0,0 +1,27 @@ +# Goals stdlib url module. +# Copyright (C) 2019 Richard W.M. Jones +# Copyright (C) 2019 Red Hat Inc. +# +# This program is free software; you can redistribute it and/or modify +# it under the terms of the GNU General Public License as published by +# the Free Software Foundation; either version 2 of the License, or +# (at your option) any later version. +# +# This program is distributed in the hope that it will be useful, +# but WITHOUT ANY WARRANTY; without even the implied warranty of +# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +# GNU General Public License for more details. +# +# You should have received a copy of the GNU General Public License along +# with this program; if not, write to the Free Software Foundation, Inc., +# 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. + +# Tactics for dealing with URLs. These require the curl command +# line tool. + +# XXX tactic *url + +# Check only if a URL exists without considering its age. +tactic *url_exists (url) = { + curl --output /dev/null --silent --head --fail %url || exit 99 +} diff --git a/tests/test1.gl b/tests/test1.gl index d944b94..85335ce 100644 --- a/tests/test1.gl +++ b/tests/test1.gl @@ -1,5 +1,9 @@ # Test. +include "url.gl" + +let foo = "bar" + goal all = : "file1.o", *file("file2.o") goal compile (name) = @@ -7,8 +11,3 @@ goal compile (name) = echo %< "->" %@ touch %@ } - -tactic *file (filename) = { - test -f %filename || exit 99 - # XXX older than %< -} \ No newline at end of file -- 1.8.3.1