/* Copyright 2012 * Kaz Kylheku * Vancouver, Canada * All rights reserved. * * BSD License: * * Redistribution and use in source and binary forms, with or without * modification, are permitted provided that the following conditions * are met: * * 1. Redistributions of source code must retain the above copyright * notice, this list of conditions and the following disclaimer. * 2. Redistributions in binary form must reproduce the above copyright * notice, this list of conditions and the following disclaimer in * the documentation and/or other materials provided with the * distribution. * 3. The name of the author may not be used to endorse or promote * products derived from this software without specific prior * written permission. * * THIS SOFTWARE IS PROVIDED ``AS IS'' AND WITHOUT ANY EXPRESS OR * IMPLIED WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED * WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE. */ #include #include #include #include #include #include #include #include #include "config.h" #include "lib.h" #include "stream.h" #include "gc.h" #include "unwind.h" #include "parser.h" #include "match.h" #include "utf8.h" #include "debug.h" #include "txr.h" const wchli_t *version = wli("65"); const wchar_t *progname = L"txr"; const wchar_t *spec_file = L"stdin"; val self_path; /* * Can implement an emergency allocator here from a fixed storage * pool, which sets an OOM flag. Program can check flag * and gracefully terminate instead of aborting like this. */ static mem_t *oom_realloc_handler(mem_t *old, size_t size) { format(std_error, lit("~a: out of memory\n"), prog_string, nao); put_line(lit("false"), std_error); abort(); } static void help(void) { val text = lit( "\n" "txr version ~a\n" "\n" "copyright 2012, Kaz Kylheku \n" "\n" "usage:\n" "\n" " ~a [ options ] query-file { data-file }*\n" "\n" "The query-file or data-file arguments may be specified as -, in which case\n" "standard input is used. All data-file arguments which begin with a !\n" "character are treated as command pipes. Those which begin with a $\n" "are interpreted as directories to read. Leading arguments which begin\n" "with a - followed by one or more characters, and which are not arguments to\n" "options are interpreted as options. The -- option indicates the end of the\n" "options.\n" "\n" "If no data-file arguments sare supplied, then the query itself must open a\n" "a data source prior to attempting to make any pattern match, or it will\n" "simply fail due to a match which has run out of data.\n" "\n" "options:\n" "\n" "-Dvar=value Pre-define variable var, with the given value.\n" " A list value can be specified using commas.\n" "-Dvar Predefine variable var, with empty string value.\n" "-q Quiet: don't report errors during query matching.\n" "-v Verbose: extra logging from matcher.\n" "-b Don't dump list of bindings, or 'false'\n" " on unsuccessful termination.\n" "-B Force list of bindings to be dumped, or false\n" " if termination is unsuccessful.\n" "-l If dumping bindings, use TXR Lisp format.\n" "-d Debugger mode.\n" "-a num Generate array variables up to num-dimensions.\n" " Default is 1. Additional dimensions are fudged\n" " by generating numeric suffixes\n" "-c query-text The query is read from the query-text argument\n" " itself. The query-file argument is omitted in\n" " this case; the first argument is a data file.\n" "-f query-file Specify the query-file as an option argument.\n" " option, instead of the query-file argument.\n" " This allows #! scripts to pass options through\n" " to the utility.\n" "--help You already know!\n" "--version Display program version\n" "--lisp-bindings Synonym for -l\n" "--debugger Synonym for -d\n" "\n" "Options that take no argument can be combined. The -q and -v options\n" "are mutually exclusive; the right-most one dominates.\n" "\n" ); format(std_output, text, auto_str(version), prog_string, nao); } static void hint(void) { format(std_error, lit("~a: incorrect arguments: try --help\n"), prog_string, nao); } static val remove_hash_bang_line(val spec) { if (!consp(spec)) return spec; { val shbang = string(L"#!"); val firstline = first(spec); val firstelem = first(firstline); val item; if (stringp(firstelem)) item = firstelem; else if (consp(firstelem) && first(firstelem) == text_s) item = second(firstelem); else return spec; if (stringp(item)) { val twochars = sub_str(item, zero, two); if (equal(twochars, shbang)) return rest(spec); } return spec; } } int txr_main(int argc, char **argv); int main(int argc, char **argv) { val stack_bottom = nil; progname = argv[0] ? utf8_dup_from(argv[0]) : progname; init(progname, oom_realloc_handler, &stack_bottom); match_init(); parse_init(); debug_init(); return txr_main(argc, argv); } int txr_main(int argc, char **argv) { val specstring = nil; val spec = nil; val bindings = nil; int match_loglevel = opt_loglevel; prot1(&spec_file_str); prot1(&self_path); yyin_stream = std_input; if (argc <= 1) { hint(); return EXIT_FAILURE; } argc--, 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; for (;;) { size_t piece = strcspn(pval, ","); char comma_p = pval[piece]; pval[piece] = 0; list = cons(string_utf8(pval), list); if (!comma_p) break; pval += piece + 1; } 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); } argc--, argv++; continue; } if (!strcmp(*argv, "--version")) { format(std_output, lit("~a: version ~a\n"), prog_string, auto_str(version), nao); return 0; } if (!strcmp(*argv, "--help")) { help(); return 0; } if (!strcmp(*argv, "-a") || !strcmp(*argv, "-c") || !strcmp(*argv, "-f")) { long optval; char *errp; char opt = (*argv)[1]; if (argc == 1) { format(std_error, lit("~a: option -~a needs argument\n"), prog_string, chr(opt), nao); return EXIT_FAILURE; } argv++, argc--; switch (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; } opt_arraydims = optval; break; case 'c': specstring = string_utf8(*argv); break; case 'f': spec_file_str = string_utf8(*argv); break; } argv++, argc--; continue; } if (!strcmp(*argv, "--gc-debug")) { opt_gc_debug = 1; argv++, argc--; continue; } else if (!strcmp(*argv, "--vg-debug")) { #ifdef 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); return EXIT_FAILURE; #endif } else if (!strcmp(*argv, "--dv-regex")) { opt_derivative_regex = 1; argv++, argc--; continue; } else if (!strcmp(*argv, "--lisp-bindings")) { opt_lisp_bindings = 1; argv++, argc--; continue; } else if (!strcmp(*argv, "--debugger")) { #if CONFIG_DEBUG_SUPPORT opt_debugger = 1; #else format(std_error, lit("~a: option ~a requires debug support compiled in\n"), prog_string, string_utf8(*argv), nao); return EXIT_FAILURE; #endif argv++, argc--; continue; } { char *popt; for (popt = (*argv)+1; *popt != 0; popt++) { switch (*popt) { case 'v': match_loglevel = 2; break; case 'q': match_loglevel = 0; break; case 'b': opt_nobindings = 1; break; case 'B': opt_nobindings = -1; break; case 'l': opt_lisp_bindings = 1; break; case 'd': #if CONFIG_DEBUG_SUPPORT opt_debugger = 1; #else format(std_error, lit("~a: option ~a requires debug support compiled in\n"), prog_string, chr(*popt), nao); return EXIT_FAILURE; #endif break; case 'a': case 'c': case 'D': format(std_error, lit("~a: option -~a does not clump\n"), prog_string, chr(*popt), nao); return EXIT_FAILURE; case '-': format(std_error, lit("~a: unrecognized long option: --~a\n"), prog_string, string_utf8(popt + 1), nao); return EXIT_FAILURE; default: format(std_error, lit("~a: unrecognized option: -~a\n"), prog_string, chr(*popt), nao); return EXIT_FAILURE; } } argc--, argv++; } } if (specstring && spec_file_str) { format(std_error, lit("~a: cannot specify both -f and -c\n"), prog_string, nao); return EXIT_FAILURE; } if (specstring) { spec_file = L"cmdline"; spec_file_str = string(spec_file); if (gt(length_str(specstring), zero) && 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); } else if (spec_file_str) { if (wcscmp(c_str(spec_file_str), L"-") != 0) { FILE *in = w_fopen(c_str(spec_file_str), L"r"); if (in == 0) uw_throwf(file_error_s, lit("unable to open ~a"), spec_file_str, nao); yyin_stream = make_stdio_stream(in, spec_file_str, t, nil); } else { spec_file = L"stdin"; } } else { if (argc < 1) { hint(); return EXIT_FAILURE; } if (strcmp(*argv, "-") != 0) { FILE *in = fopen(*argv, "r"); val name = string_utf8(*argv); if (in == 0) uw_throwf(file_error_s, lit("unable to open ~a"), name, nao); yyin_stream = make_stdio_stream(in, name, t, nil); spec_file = utf8_dup_from(*argv); } else { spec_file = L"stdin"; } argc--, argv++; spec_file_str = string(spec_file); } { int gc = gc_state(0); yyparse(); gc_state(gc); if (errors) return EXIT_FAILURE; spec = remove_hash_bang_line(get_spec()); opt_loglevel = match_loglevel; if (opt_loglevel >= 2) { format(std_error, lit("spec:\n~s\n"), spec, nao); format(std_error, lit("bindings:\n~s\n"), bindings, nao); } self_path = spec_file_str; { int retval; list_collect_decl(filenames, iter); while (*argv) list_collect(iter, string_utf8(*argv++)); retval = extract(spec, filenames, bindings); return errors ? EXIT_FAILURE : retval; } } }