From c720098b5f0eb58eef01fef4acbeccde00af2c75 Mon Sep 17 00:00:00 2001 From: Kaz Kylheku Date: Tue, 18 Feb 2014 23:46:51 -0800 Subject: * eval.c (env_hash): new function. (eval_init): Register env and env_hash functions. Register prog_args and prog_args_full as *args* and *full-args*. * lib.c (timegm_hack): Invalidate env_list, after mucking with the environment via setenv and unsetenv. * txr.c (prog_args_full, prog_args): New global variables. (txr_main): Command-line processing converted to use TXR's library. Populates prog_args_full and prog_args. * txr.h (prog_args_full, prog_args): Declared. * txr.1: Documented *args*, *full-args*, env and env-hash. --- txr.c | 185 ++++++++++++++++++++++++++++-------------------------------------- 1 file changed, 78 insertions(+), 107 deletions(-) (limited to 'txr.c') diff --git a/txr.c b/txr.c index 8b746f00..d2ca6f23 100644 --- a/txr.c +++ b/txr.c @@ -49,7 +49,7 @@ const wchli_t *version = wli("80"); const wchar_t *progname = L"txr"; -val self_path; +val self_path, prog_args_full, prog_args; /* * Can implement an emergency allocator here from a fixed storage @@ -179,9 +179,10 @@ int txr_main(int argc, char **argv) val bindings = nil; val evaled = nil; int match_loglevel = opt_loglevel; + val arg; + list_collect_decl(arg_list, arg_tail); - prot1(&spec_file_str); - prot1(&self_path); + protect(&spec_file_str, &self_path, &prog_args, &prog_args_full, (val *) 0); setvbuf(stderr, 0, _IOLBF, 0); @@ -192,160 +193,138 @@ int txr_main(int argc, char **argv) return EXIT_FAILURE; } - argc--, argv++; + while (*argv) + arg_tail = list_collect(arg_tail, string_utf8(*argv++)); - while (argc > 0 && (*argv)[0] == '-') { - if (!strcmp(*argv, "--")) { - argv++, argc--; - break; - } - - if (!strcmp(*argv, "-")) - break; - - if (!strncmp(*argv, "-D", 2)) { - char *var = *argv + 2; - char *equals = strchr(var, '='); - char *has_comma = (equals != 0) ? strchr(equals, ',') : 0; - - if (has_comma) { - char *pval = equals + 1; - val list = nil; - - *equals = 0; + prog_args_full = arg_list; - for (;;) { - size_t piece = strcspn(pval, ","); - char comma_p = pval[piece]; + arg_list = cdr(arg_list); - pval[piece] = 0; - - list = cons(string_utf8(pval), list); + for (arg = pop(&arg_list); arg && car(arg) == chr('-'); arg = pop(&arg_list)) + { + if (equal(arg, lit("--"))) + break; - if (!comma_p) - break; + if (equal(arg, lit("-"))) { + push(arg, &arg_list); + break; + } - pval += piece + 1; - } + if (equal(sub(arg, zero, two), lit("-D"))) { + val dopt_arg = sub(arg, two, t); + cons_bind(var, def, split_str(dopt_arg, lit("="))); + val deflist = if2(def, split_str(car(def), lit(","))); - list = nreverse(list); - bindings = cons(cons(intern(string_utf8(var), nil), list), bindings); - } else if (equals) { - char *pval = equals + 1; - *equals = 0; - bindings = cons(cons(intern(string_utf8(var), nil), - string_utf8(pval)), bindings); - } else { - bindings = cons(cons(intern(string_utf8(var), nil), - null_string), bindings); - } + if (rest(deflist)) + bindings = cons(cons(intern(var, nil), deflist), bindings); + else if (deflist) + bindings = cons(cons(intern(var, nil), car(deflist)), bindings); + else + bindings = cons(cons(intern(var, nil), t), bindings); - argc--, argv++; continue; } - if (!strcmp(*argv, "--version")) { + if (equal(arg, lit("--version"))) { format(std_output, lit("~a: version ~a\n"), prog_string, auto_str(version), nao); return 0; } - if (!strcmp(*argv, "--help")) { + if (equal(arg, lit("--help"))) { help(); return 0; } - if (!strcmp(*argv, "-a") || !strcmp(*argv, "-c") || !strcmp(*argv, "-f") || - !strcmp(*argv, "-e") || !strcmp(*argv, "-p")) + if (memqual(arg, list(lit("-a"), lit("-c"), lit("-f"), + lit("-e"), lit("-p"), nao))) { - long optval; - char *errp; - char opt = (*argv)[1]; + val opt = chr_str(arg, one); - if (argc == 1) { + if (!arg_list) { format(std_error, lit("~a: option -~a needs argument\n"), - prog_string, chr(opt), nao); + prog_string, opt, nao); return EXIT_FAILURE; } - argv++, argc--; + arg = pop(&arg_list); - switch (opt) { + switch (c_chr(opt)) { case 'a': - optval = strtol(*argv, &errp, 10); - if (*errp != 0) { - format(std_error, lit("~a: option -~a needs numeric argument, " - "not ~a\n"), prog_string, chr(opt), - string_utf8(*argv), nao); - return EXIT_FAILURE; - } + { + val optval = int_str(arg, nil); + + if (!optval || !fixnump(optval)) { + format(std_error, lit("~a: option -~a needs a small integer " + "argument, not ~a\n"), prog_string, opt, + arg, nao); + return EXIT_FAILURE; + } - opt_arraydims = optval; + opt_arraydims = c_num(optval); + } break; case 'c': - specstring = string_utf8(*argv); + specstring = arg; break; case 'f': - spec_file = string_utf8(*argv); + spec_file = arg; break; case 'e': - eval_intrinsic(lisp_parse(string_utf8(*argv), std_error), nil); + eval_intrinsic(lisp_parse(arg, std_error), nil); evaled = t; break; case 'p': - obj_print(eval_intrinsic(lisp_parse(string_utf8(*argv), std_error), + obj_print(eval_intrinsic(lisp_parse(arg, std_error), nil), std_output); put_char(chr('\n'), std_output); evaled = t; break; } - argv++, argc--; continue; } - if (!strcmp(*argv, "--gc-debug")) { + if (equal(arg, lit("--gc-debug"))) { opt_gc_debug = 1; - argv++, argc--; continue; - } else if (!strcmp(*argv, "--vg-debug")) { + } else if (equal(arg, lit("--vg-debug"))) { #if HAVE_VALGRIND opt_vg_debug = 1; - argv++, argc--; continue; #else format(std_error, lit("~a: option ~a requires Valgrind support compiled in\n"), - prog_string, string_utf8(*argv), nao); + prog_string, arg, nao); return EXIT_FAILURE; #endif - } else if (!strcmp(*argv, "--dv-regex")) { + } else if (equal(arg, lit("--dv-regex"))) { opt_derivative_regex = 1; - argv++, argc--; continue; - } else if (!strcmp(*argv, "--lisp-bindings")) { + } else if (equal(arg, lit("--lisp-bindings"))) { opt_lisp_bindings = 1; - argv++, argc--; continue; - } else if (!strcmp(*argv, "--debugger")) { + } else if (equal(arg, lit("--debugger"))) { #if CONFIG_DEBUG_SUPPORT opt_debugger = 1; + continue; #else format(std_error, lit("~a: option ~a requires debug support compiled in\n"), - prog_string, string_utf8(*argv), nao); + prog_string, arg, nao); return EXIT_FAILURE; #endif - argv++, argc--; - continue; } { - char *popt; - for (popt = (*argv)+1; *popt != 0; popt++) { - switch (*popt) { + val optchars = cdr(arg); + + for (; optchars != nil; optchars = cdr(optchars)) { + val opch = car(optchars); + + switch (c_chr(opch)) { case 'v': match_loglevel = 2; break; @@ -367,7 +346,7 @@ int txr_main(int argc, char **argv) #else format(std_error, lit("~a: option ~a requires debug support compiled in\n"), - prog_string, chr(*popt), nao); + prog_string, opch, nao); return EXIT_FAILURE; #endif break; @@ -377,20 +356,18 @@ int txr_main(int argc, char **argv) case 'p': case 'D': format(std_error, lit("~a: option -~a does not clump\n"), - prog_string, chr(*popt), nao); + prog_string, opch, nao); return EXIT_FAILURE; case '-': format(std_error, lit("~a: unrecognized long option: --~a\n"), - prog_string, string_utf8(popt + 1), nao); + prog_string, cdr(optchars), nao); return EXIT_FAILURE; default: format(std_error, lit("~a: unrecognized option: -~a\n"), - prog_string, chr(*popt), nao); + prog_string, opch, nao); return EXIT_FAILURE; } } - - argc--, argv++; } } @@ -406,6 +383,7 @@ int txr_main(int argc, char **argv) chr_str(specstring, minus(length_str(specstring), one)) != chr('\n')) specstring = cat_str(list(specstring, string(L"\n"), nao), nil); yyin_stream = make_string_byte_input_stream(specstring); + push(arg, &arg_list); } else if (spec_file) { if (wcscmp(c_str(spec_file), L"-") != 0) { FILE *in = w_fopen(c_str(spec_file), L"r"); @@ -416,27 +394,27 @@ int txr_main(int argc, char **argv) } else { spec_file_str = lit("stdin"); } + push(arg, &arg_list); } else { - if (argc < 1) { + if (!arg) { if (evaled) return EXIT_SUCCESS; hint(); return EXIT_FAILURE; } - if (strcmp(*argv, "-") != 0) { - FILE *in = fopen(*argv, "r"); - val name = string_utf8(*argv); + if (!equal(arg, lit("-"))) { + FILE *in = w_fopen(c_str(arg), L"r"); if (in == 0) - uw_throwf(file_error_s, lit("unable to open ~a"), name, nao); - yyin_stream = make_stdio_stream(in, name); - spec_file_str = string_utf8(*argv); + uw_throwf(file_error_s, lit("unable to open ~a"), arg, nao); + yyin_stream = make_stdio_stream(in, arg); + spec_file_str = arg; } else { spec_file_str = lit("stdin"); } - argc--, argv++; } + prog_args = arg_list; { int gc = gc_state(0); @@ -459,14 +437,7 @@ int txr_main(int argc, char **argv) self_path = spec_file_str; { - int retval; - list_collect_decl(filenames, iter); - - while (*argv) - iter = list_collect(iter, string_utf8(*argv++)); - - retval = extract(spec, filenames, bindings); - + int retval = extract(spec, arg_list, bindings); return errors ? EXIT_FAILURE : retval; } } -- cgit v1.2.3