Implement stdlib directory, -I, --no-prelude, etc.
authorRichard W.M. Jones <rjones@redhat.com>
Sat, 28 Dec 2019 18:43:25 +0000 (18:43 +0000)
committerRichard W.M. Jones <rjones@redhat.com>
Mon, 30 Dec 2019 13:42:45 +0000 (13:42 +0000)
15 files changed:
src/Makefile.in
src/ast.ml
src/ast.mli
src/cmdline.ml [new file with mode: 0644]
src/cmdline.mli [new file with mode: 0644]
src/lexer.mll
src/main.ml
src/parse.ml
src/parse.mli
src/parser.mly
src/utils.ml
src/utils.mli
stdlib/prelude.gl [new file with mode: 0644]
stdlib/url.gl [new file with mode: 0644]
tests/test1.gl

index 29e5382..4d6640e 100644 (file)
 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
index 9f3326a..587c888 100644 (file)
@@ -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
index 56bfa7b..831878d 100644 (file)
@@ -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 (file)
index 0000000..53ab0f9
--- /dev/null
@@ -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 (file)
index 0000000..e9ab8f1
--- /dev/null
@@ -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. *)
index 273b09d..617c10f 100644 (file)
@@ -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) }
index c23b70a..127c24c 100644 (file)
 
 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 =
@@ -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
index 07647c2..1a4c206 100644 (file)
@@ -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 =
index 39893a1..e4bddcf 100644 (file)
@@ -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
index 3a17124..c6f961d 100644 (file)
  *)
 
 %{
+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 <string> ID
+%token INCLUDE
 %token LEFT_ARRAY
 %token LEFT_PAREN
 %token LET
@@ -39,7 +47,7 @@ open Printf
 %token TACTIC_KEYWORD
 
 (* Start nonterminals. *)
-%start <Ast.env> file
+%start <Ast.expr Ast.Env.t> file
 %start <Ast.expr> 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 =
index c495675..d1b0efa 100644 (file)
@@ -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
index e3981cd..5fabcfb 100644 (file)
@@ -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 (file)
index 0000000..70c664c
--- /dev/null
@@ -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 (file)
index 0000000..2f59faa
--- /dev/null
@@ -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
+}
index d944b94..85335ce 100644 (file)
@@ -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