From: Richard W.M. Jones Date: Mon, 16 Sep 2013 17:38:14 +0000 (+0100) Subject: Command line parsing, the concept of publishing goals. X-Git-Tag: 0.2~38 X-Git-Url: http://git.annexia.org/?a=commitdiff_plain;ds=sidebyside;h=a0bf80d39e5dbb7daac3c28ab546a2c3ae1312a6;p=goaljobs.git Command line parsing, the concept of publishing goals. --- diff --git a/.depend b/.depend index 1c95889..2440c82 100644 --- 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 diff --git a/.gitignore b/.gitignore index c32e226..78fe55c 100644 --- a/.gitignore +++ b/.gitignore @@ -17,6 +17,7 @@ Makefile /config.h /config.h.in /config.log +/config.ml /config.status /config.sub /configure diff --git a/Makefile.am b/Makefile.am index 1aa4248..53f50d3 100644 --- a/Makefile.am +++ b/Makefile.am @@ -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 --- 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 index 0000000..38f8146 --- /dev/null +++ b/config.ml.in @@ -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@" diff --git a/configure.ac b/configure.ac index 613186d..3466970 100644 --- a/configure.ac +++ b/configure.ac @@ -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 diff --git a/goaljobs b/goaljobs index 93dd844..cc8d003 100755 --- 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 diff --git a/goaljobs.ml b/goaljobs.ml index 282c29e..c68bc31 100644 --- a/goaljobs.ml +++ b/goaljobs.ml @@ -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 [] + +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" diff --git a/goaljobs.mli b/goaljobs.mli index 752e9b7..8b31abe 100644 --- a/goaljobs.mli +++ b/goaljobs.mli @@ -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 diff --git a/pa_goal.ml b/pa_goal.ml index 06b2ec8..723df1b 100644 --- a/pa_goal.ml +++ b/pa_goal.ml @@ -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.