X-Git-Url: http://git.annexia.org/?a=blobdiff_plain;f=src%2Fmain.ml;h=ba4a1958d4743ce34b97a58157897fd044707167;hb=54c8ad92025a9c77c2b10644499b3944e1299187;hp=33d91b6e6c7a048c823fd1dae38921314ef2b0f7;hpb=c46c3a5c7793753f2f15c1655517f3f9b8fee644;p=goals.git diff --git a/src/main.ml b/src/main.ml index 33d91b6..ba4a195 100644 --- a/src/main.ml +++ b/src/main.ml @@ -21,83 +21,75 @@ 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.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_expr "commandline") targets in (* If no target was set on the command line, use "all ()". *) let targets = if targets <> [] then targets else [Ast.ECall (Ast.noloc, "all", [])] in - Ast.print_env stderr env; + 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 - (* Evaluate the target expressions in turn. *) - Eval.evaluate_targets env targets + (* 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 string_of_job job = Deps.string_of_job job in + Jobs.run next_job retire_job string_of_job let () = try main () with - Failure msg -> prerr_endline msg; exit 1 + | Failure msg | Sys_error msg -> + prerr_endline ("*** error: " ^ msg); + exit 1