X-Git-Url: http://git.annexia.org/?a=blobdiff_plain;f=src%2Fmain.ml;h=cee1dcfb0aa2baee85ec5ade8376e8e2406794bd;hb=8a0ede3292b4968b1e3261ad97b96d5ea0ad16fd;hp=bb2540275fbf0df0a1ece9a2ed0fa626e75fb598;hpb=edf3fa931cfaff399ed05a3d223eecb2286e1353;p=goals.git diff --git a/src/main.ml b/src/main.ml index bb25402..cee1dcf 100644 --- a/src/main.ml +++ b/src/main.ml @@ -21,80 +21,76 @@ 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:" +(* See comment in parser.mly. *) +let () = + Parser.lexer_read := Some Lexer.read; + Parser.eval_substitute := Some Eval.substitute let main () = - (* Command line arguments. *) - let args = ref [] in - let directory = ref "." in - let filename = ref "Goalfile" in + (* Handle the command line. *) + let anon_vars, targets = Cmdline.parse () 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"; - ] 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 + (* Create the initial environment, containing the system environment + * and a few other standard strings. + *) + let env = + Array.fold_left ( + fun env environ -> + let k, v = split "=" environ in + Ast.Env.add k (Ast.EConstant (Ast.noloc, Ast.CString v)) env + ) Ast.Env.empty (Unix.environment ()) in + let env = + Ast.Env.add "stdlib" + (Ast.EConstant (Ast.noloc, Ast.CString Cmdline.stdlibdir)) + env in + (*let env = + if Cmdline.debug_flag then Ast.Env.add "debug" (Ast.EConstant (noloc, Ast.CBool true)) env else env in *) + + (* Parse the prelude. *) + let env = + if Cmdline.use_prelude () then + Parse.parse_goalfile env Cmdline.prelude_gl_file + else env 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_expr "commandline" expr in + Ast.Env.add name expr env + ) env 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.StringMap.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_expr "commandline") targets in (* If no target was set on the command line, use "all ()". *) let targets = if targets <> [] then targets - else [Ast.ECall ("all", [])] in - - (*Ast.print_env stdout env;*) - - (* Evaluate the target expressions in turn. *) - Eval.evaluate env targets - -let () = main () + else [Ast.ECall (Ast.noloc, "all", [])] in + + if Cmdline.debug_flag () then + Ast.print_env stderr env; + + (* Construct the dependency DAG with the root(s) being the targets. *) + let dag = Deps.create env targets in + + (* Run the jobs. *) + let state = Deps.new_state dag Run.goal_runner Run.exists_runner in + let next_job () = Deps.next_job state in + let retire_job job = Deps.retire_job state job in + let fail_job job = Deps.fail_job state job in + let string_of_job job = Deps.string_of_job job in + Jobs.run next_job retire_job fail_job string_of_job + +let () = + try main () + with + | Failure msg | Sys_error msg -> + prerr_endline ("*** error: " ^ msg); + exit 1