OBJECTS = \
config.cmx \
utils.cmx \
+ cmdline.cmx \
ast.cmx \
+ eval.cmx \
parser.cmx \
lexer.cmx \
parse.cmx \
- eval.cmx \
main.cmx
all: goals
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
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
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 *)
--- /dev/null
+(* 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
--- /dev/null
+(* 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. *)
| "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) }
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=<expr>" to assign a value to a variable, or
- * "<expr>" 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 =
let () =
try main ()
with
- Failure msg -> prerr_endline msg; exit 1
+ Failure msg | Sys_error msg ->
+ prerr_endline ("error: " ^ msg); exit 1
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;
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 =
* 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
*)
%{
+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. *)
%token EOF
%token GOAL
%token <string> ID
+%token INCLUDE
%token LEFT_ARRAY
%token LEFT_PAREN
%token LET
%token TACTIC_KEYWORD
(* Start nonterminals. *)
-%start <Ast.env> file
+%start <Ast.expr Ast.Env.t> file
%start <Ast.expr> expr
%%
;
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 =
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
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. *)
--- /dev/null
+# 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
+}
--- /dev/null
+# 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
+}
# Test.
+include "url.gl"
+
+let foo = "bar"
+
goal all = : "file1.o", *file("file2.o")
goal compile (name) =
echo %< "->" %@
touch %@
}
-
-tactic *file (filename) = {
- test -f %filename || exit 99
- # XXX older than %<
-}
\ No newline at end of file