Command line parsing, the concept of publishing goals.
authorRichard W.M. Jones <rjones@redhat.com>
Mon, 16 Sep 2013 17:38:14 +0000 (18:38 +0100)
committerRichard W.M. Jones <rjones@redhat.com>
Mon, 16 Sep 2013 17:38:14 +0000 (18:38 +0100)
.depend
.gitignore
Makefile.am
NOTES
config.ml.in [new file with mode: 0644]
configure.ac
goaljobs
goaljobs.ml
goaljobs.mli
pa_goal.ml

diff --git a/.depend b/.depend
index 1c95889..2440c82 100644 (file)
--- a/.depend
+++ b/.depend
@@ -1,3 +1,5 @@
+config.cmo :
+config.cmx :
 goaljobs.cmi :
-goaljobs.cmo : goaljobs.cmi
-goaljobs.cmx : goaljobs.cmi
+goaljobs.cmo : config.cmo goaljobs.cmi
+goaljobs.cmx : config.cmx goaljobs.cmi
index c32e226..78fe55c 100644 (file)
@@ -17,6 +17,7 @@ Makefile
 /config.h
 /config.h.in
 /config.log
+/config.ml
 /config.status
 /config.sub
 /configure
index 1aa4248..53f50d3 100644 (file)
@@ -20,6 +20,7 @@ include common-rules.mk
 ACLOCAL_AMFLAGS = -I m4
 
 EXTRA_DIST = \
+       config.ml.in \
        COPYING \
        goaljobs \
        goaljobs.spec \
@@ -33,6 +34,7 @@ EXTRA_DIST = \
 SUBDIRS = . examples tests
 
 sources = \
+       config.ml \
        goaljobs.ml \
        goaljobs.mli
 
@@ -44,11 +46,11 @@ bin_SCRIPTS = goaljobs
 noinst_SCRIPTS = goaljobs.cma goaljobs.cmxa pa_goal.cmo
 
 # Library.
-goaljobs.cma: goaljobs.cmo
-       $(OCAMLFIND) ocamlc -a -o $@ $(OCAMLCFLAGS) $(OCAMLCPACKAGES) $<
+goaljobs.cma: config.cmo goaljobs.cmo
+       $(OCAMLFIND) ocamlc -a -o $@ $(OCAMLCFLAGS) $(OCAMLCPACKAGES) $^
 
-goaljobs.cmxa: goaljobs.cmx
-       $(OCAMLFIND) ocamlopt -a -o $@ $(OCAMLOPTFLAGS) $(OCAMLOPTPACKAGES) $<
+goaljobs.cmxa: config.cmx goaljobs.cmx
+       $(OCAMLFIND) ocamlopt -a -o $@ $(OCAMLOPTFLAGS) $(OCAMLOPTPACKAGES) $^
 
 # Preprocessor for goaljobs scripts.
 pa_goal.cmo: pa_goal.ml
diff --git a/NOTES b/NOTES
index 385e6b0..28ca33d 100644 (file)
--- a/NOTES
+++ b/NOTES
@@ -75,3 +75,17 @@ Example program:
       git describe --tags --abbrev=0 --match='v*'
     " package in
     require (website_updated version)
+
+This compiles down to a command line program that can be used like this:
+
+  ./compile [-flags] [goals]
+
+The goals are not enabled automatically.  You have to do something
+(simple) to publish a goal and specify how command line arguments get
+mapped to goal arguments, since the mapping is not likely to be 1-1
+strings.  In the end you can do stuff like:
+
+  ./compile all
+  ./compile clean
+  ./compile build program  # program is a parameter
+  ./compile -my-flag       # custom flags can be defined
diff --git a/config.ml.in b/config.ml.in
new file mode 100644 (file)
index 0000000..38f8146
--- /dev/null
@@ -0,0 +1,21 @@
+(* goaljobs
+ * Copyright (C) 2013 Red Hat Inc.
+ * @configure_input@
+ *
+ * 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.
+ *)
+
+let package_name = "@PACKAGE_NAME@"
+let package_version = "@PACKAGE_VERSION@"
index 613186d..3466970 100644 (file)
@@ -89,7 +89,8 @@ if test "x$PERLDOC" = "x"; then
 fi
 
 AC_CONFIG_HEADERS([config.h])
-AC_CONFIG_FILES([goaljobs.spec
+AC_CONFIG_FILES([config.ml
+                 goaljobs.spec
                  Makefile
                  META
                  examples/Makefile
index 93dd844..cc8d003 100755 (executable)
--- a/goaljobs
+++ b/goaljobs
@@ -104,6 +104,15 @@ if [ "$output" = "" ]; then
     output=`basename "$final" .ml`
 fi
 
+# Create a temporary 'main' file to handle command line args.
+main=$(mktemp --suffix=.ml /tmp/goaljobsmainXXXXXX)
+echo "let modules = [" > $main
+for module in "${modules[@]}"; do
+    echo "    \"$module\";" >> $main
+done
+echo "] ;;" >> $main
+echo "Goaljobs.init ()" >> $main
+
 # Either use installed package or if user selected --pkgdir then
 # use goaljobs from that directory.
 declare -a pkg
@@ -122,5 +131,7 @@ fi
 
 # Compile the input file(s).
 echo \
-ocamlfind $best "${passthru[@]}" "${pkg[@]}" "$@" -o "$output"
-ocamlfind $best "${passthru[@]}" "${pkg[@]}" "$@" -o "$output"
+ocamlfind $best "${passthru[@]}" "${pkg[@]}" "$@" $main -o "$output"
+ocamlfind $best "${passthru[@]}" "${pkg[@]}" "$@" $main -o "$output"
+
+rm -f $main
index 282c29e..c68bc31 100644 (file)
@@ -128,6 +128,11 @@ let memory_set = Hashtbl.replace memory
 let memory_get k = try Some (Hashtbl.find memory k) with Not_found -> None
 let memory_delete = Hashtbl.remove memory
 
+let published_goals = ref []
+let publish name fn = published_goals := (name, fn) :: !published_goals
+let get_goal name =
+  try Some (List.assoc name !published_goals) with Not_found -> None
+
 let goal_file_exists filename =
   if not (file_exists filename) then (
     let msg = sprintf "file '%s' required but not found" filename in
@@ -154,3 +159,64 @@ let goal_memory_exists k =
     let msg = sprintf "memory_exists: key '%s' required but does not exist" k in
     goal_failed msg
   )
+
+(* Run the program. *)
+let init () =
+  let prog = Sys.executable_name in
+  let prog = Filename.basename prog in
+
+  let args = ref [] in
+
+  let display_version () =
+    printf "%s %s\n" Config.package_name Config.package_version;
+    exit 0
+  in
+
+  let list_goals () =
+    let names = !published_goals in
+    let names = List.map fst names in
+    let names = List.sort compare names in
+    List.iter print_endline names
+  in
+
+  let argspec = Arg.align [
+    "--goals", Arg.Unit list_goals, " List all goals";
+    "-l", Arg.Unit list_goals, " List all goals";
+    "-V", Arg.Unit display_version, " Display version number and exit";
+    "--version", Arg.Unit display_version, " Display version number and exit";
+  ] in
+  let anon_fun str = args := str :: !args in
+  let usage_msg = sprintf "\
+%s: a script generated by goaljobs
+
+List all goals:                %s -l
+Run a single goal like this:   %s <name-of-goal> [<goal-args ...>]
+
+For more information see the goaljobs(1) man page.
+
+Options:
+" prog prog prog in
+
+  Arg.parse argspec anon_fun usage_msg;
+
+  let args = List.rev !args in
+
+  (* Was a goal named on the command line? *)
+  match args with
+  | name :: args ->
+    (match get_goal name with
+    | Some fn -> fn args
+    | None ->
+      eprintf "error: no goal called '%s' was found.\n" name;
+      eprintf "Use %s -l to list all published goals in this script.\n" name;
+      exit 1
+    )
+  | [] ->
+    (* Does a published 'all' goal exist? *)
+    match get_goal "all" with
+    | Some fn -> fn []
+    | None ->
+      (* No published 'all' goal.  This is only a warning, because
+       * other top-level code may exist in the script.
+       *)
+      eprintf "warning: no 'all' goal found.\n"
index 752e9b7..8b31abe 100644 (file)
@@ -292,6 +292,59 @@ val memory_get : string -> string option
 val memory_delete : string -> unit
   (** Delete the [key].  If the key doesn't exist, has no effect. *)
 
+(** {2 Publishing goals}
+
+    To "publish" a goal means it's available on the command line
+    for users to use directly.
+
+    Goals that have zero arguments are {b automatically published}.
+    So for example:
+
+    {v
+    let goal clean () = sh "rm *~"
+    }
+
+    can be used on the command line:
+
+    {v ./script clean }
+
+    The special goal called [all] (if it exists) is run implicitly
+    unless the user specifies another goal.  Unlike [make], there is
+    nothing special about the first rule in the file.
+
+    You can also publish goals, especially ones which take a non-zero
+    number of parameters, by calling {!publish}.
+*)
+
+val publish : string -> (string list -> unit) -> unit
+  (** Publish the named goal.
+
+      Use this function as in this example:
+
+      {v
+      let goal compiled program sources =
+        ... stuff for building the program from sources ...
+
+      let () = publish "compiled" (
+        fun args ->
+          let program = List.hd args in
+          let sources = List.tl args in
+          require (compiled program sources)
+      )
+      }
+
+      This could be used as follows:
+
+      {v ./script compiled program main.c utils.c }
+
+      You will notice you have to write a bit of OCaml code to
+      map the string arguments from the command line on to the
+      goal arguments.  In the example it means taking the first
+      string argument as the program name, and the rest of the
+      string arguments as the source filenames.  This is also
+      the place to perform string to int conversion, checks, and
+      so on (remember that OCaml is strongly typed). *)
+
 (**/**)
 
 (* Goal versions of some common functions.  You are using these
@@ -306,6 +359,11 @@ val goal_more_recent : string list -> string list -> unit
 val goal_url_exists : string -> unit
 val goal_memory_exists : string -> unit
 
+(* A single call to this function is added by the 'goaljobs' script.
+ * It is responsible for parsing the command line and so on.
+ *)
+val init : unit -> unit
+
 (* Export this so the macros can catch these exceptions. *)
 type goal_result_t = Goal_OK | Goal_failed of string
 exception Goal_result of goal_result_t
index 06b2ec8..723df1b 100644 (file)
@@ -51,6 +51,8 @@ let rec function_parameters = function
  * of let statements.
  *)
 let generate_let_goal _loc (r : rec_flag) (lets : binding) =
+  let autopublish = ref [] in
+
   (* lets might be a single binding, or multiple bindings using BiAnd
    * ('let .. and').  Rewrite each individual goal in the list.
    *)
@@ -72,6 +74,15 @@ let generate_let_goal _loc (r : rec_flag) (lets : binding) =
       if params = [] then
         locfail _loc "goal must have some parameters; you probably want to put '()' here";
 
+      (* Is it a "zero-parameters" automatically published goal?  What
+       * this really means is it has exactly one unit parameter.
+       *)
+      (match params with
+      | [ _, PaId (_, IdUid (_, "()")) ] ->
+        autopublish := name :: !autopublish
+      | _ -> ()
+      );
+
       (* Put a try-clause around the body. *)
       let body = <:expr< try $body$ with Goal_result Goal_OK -> () >> in
 
@@ -89,7 +100,25 @@ let generate_let_goal _loc (r : rec_flag) (lets : binding) =
   let lets = rewrite lets in
 
   (* let [rec] ... and ... in () *)
-  Ast.StVal (_loc, r, lets)
+  let stmts = Ast.StVal (_loc, r, lets) in
+
+  (* Auto-published goals. *)
+  List.fold_left (
+    fun stmt name ->
+      let publish_name =
+        let gname = "goal_" ^ name in
+        <:str_item<
+          let () = publish $str:name$ (
+            function
+            | [] ->
+              Goaljobs.require ($lid:gname$ ())
+            | _ ->
+              failwith (Printf.sprintf "goal '%s' does not take any arguments"
+                          $str:name$);
+          )
+        >> in
+      StSem (_loc, stmt, publish_name)
+  ) stmts !autopublish
 
 (* Rewrite 'require (name args...)' as 'require (goal_name args)'.
  * 'expr' is a function call.