/* Copyright 2009-2021 * Kaz Kylheku * Vancouver, Canada * All rights reserved. * * 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. * * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" * AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE * IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE * ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE * LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR * CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF * SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS * INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN * CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) * ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE * POSSIBILITY OF SUCH DAMAGE. */ #include #include #include #include #include #include #include #include #include #include #include "config.h" #include "alloca.h" #ifdef __CYGWIN__ #include #endif #if HAVE_SYS_STAT #include #endif #include "lib.h" #include "signal.h" #include "unwind.h" #include "gc.h" #include "args.h" #include "utf8.h" #include "hash.h" #include "eval.h" #include "stream.h" #include "y.tab.h" #include "sysif.h" #include "cadr.h" #include "struct.h" #include "tree.h" #include "parser.h" #include "regex.h" #include "itypes.h" #include "arith.h" #include "buf.h" #include "vm.h" #include "ffi.h" #include "txr.h" #if HAVE_TERMIOS #include "linenoise/linenoise.h" #endif val parser_s, unique_s, circref_s; val listener_hist_len_s, listener_multi_line_p_s, listener_sel_inclusive_p_s; val listener_pprint_s, listener_greedy_eval_s; val rec_source_loc_s, read_unknown_structs_s, read_bad_json_s; val json_s; val intr_s; struct cobj_class *parser_cls; static lino_t *lino_ctx; static int repl_level = 0; static val stream_parser_hash, catch_all; static void yy_tok_mark(struct yy_token *tok) { gc_conservative_mark(tok->yy_lval.val); } static void parser_mark(val obj) { int i; parser_t *p = coerce(parser_t *, obj->co.handle); assert (p->parser == nil || p->parser == obj); gc_mark(p->stream); gc_mark(p->name); gc_mark(p->prepared_msg); gc_mark(p->circ_ref_hash); if (p->syntax_tree != nao) gc_mark(p->syntax_tree); yy_tok_mark(&p->recent_tok); for (i = 0; i < 4; i++) yy_tok_mark(&p->tok_pushback[i]); } static void parser_destroy(val obj) { parser_t *p = coerce(parser_t *, obj->co.handle); parser_cleanup(p); free(p); } static struct cobj_ops parser_ops = cobj_ops_init(eq, cobj_print_op, parser_destroy, parser_mark, cobj_eq_hash_op); void parser_common_init(parser_t *p) { int i; yyscan_t yyscan; val rec_source_loc_var = lookup_var(nil, rec_source_loc_s); val read_unknown_structs_var = lookup_var(nil, read_unknown_structs_s); val read_bad_json_var = lookup_var(nil, read_bad_json_s); p->parser = nil; p->lineno = 1; p->errors = 0; p->eof = 0; p->ignore = 0; p->stream = nil; p->name = nil; p->prepared_msg = nil; p->circ_ref_hash = nil; p->circ_count = 0; p->syntax_tree = nil; p->quasi_level = 0; yylex_init(&yyscan); p->scanner = convert(scanner_t *, yyscan); yyset_extra(p, p->scanner); p->recent_tok.yy_char = 0; p->recent_tok.yy_lex_state = 0; p->recent_tok.yy_lval.val = 0; for (i = 0; i < 4; i++) { p->tok_pushback[i].yy_char = 0; p->tok_pushback[i].yy_lex_state = 0; p->tok_pushback[i].yy_lval.val = 0; } p->tok_idx = 0; p->rec_source_loc = !nilp(cdr(rec_source_loc_var)); p->read_unknown_structs = !nilp(cdr(read_unknown_structs_var)); p->read_bad_json = !nilp(cdr(read_bad_json_var)); } void parser_cleanup(parser_t *p) { if (p->scanner != 0) yylex_destroy(p->scanner); p->scanner = 0; } void parser_reset(parser_t *p) { yyscan_t yyscan; parser_cleanup(p); yylex_init(&yyscan); p->scanner = convert(scanner_t *, yyscan); yyset_extra(p, p->scanner); } val parser(val stream, val name, val lineno) { val self = lit("parser"); parser_t *p = coerce(parser_t *, chk_malloc(sizeof *p)); val parser; parser_common_init(p); parser = cobj(coerce(mem_t *, p), parser_cls, &parser_ops); p->parser = parser; p->lineno = c_num(default_arg(lineno, one), self); p->name = name; p->stream = stream; return parser; } parser_t *parser_get_impl(val self, val parser) { return coerce(parser_t *, cobj_handle(self, parser, parser_cls)); } val ensure_parser(val stream, val name) { uses_or2; loc pcdr = gethash_l(lit("internal error"), stream_parser_hash, stream, nulloc); val pars = deref(pcdr); if (pars) return pars; return set(pcdr, parser(stream, or2(name, stream_get_prop(stream, name_k)), one)); } static void pushback_token(parser_t *p, struct yy_token *tok) { assert (p->tok_idx < 4); p->tok_pushback[p->tok_idx++] = *tok; } val parser_set_lineno(val self, val stream, val lineno) { val parser = ensure_parser(stream, nil); parser_t *pi = parser_get_impl(self, parser); pi->lineno = c_num(lineno, self); return stream; } void prime_parser(parser_t *p, val name, enum prime_parser prim) { struct yy_token sec_tok = all_zero_init; switch (prim) { case prime_lisp: sec_tok.yy_char = SECRET_ESCAPE_E; break; case prime_interactive: sec_tok.yy_char = SECRET_ESCAPE_I; break; case prime_regex: sec_tok.yy_char = SECRET_ESCAPE_R; break; case prime_json: sec_tok.yy_char = SECRET_ESCAPE_J; break; } if (p->recent_tok.yy_char && prim != prime_json) pushback_token(p, &p->recent_tok); pushback_token(p, &sec_tok); prime_scanner(p->scanner, prim); set(mkloc(p->name, p->parser), name); } void prime_parser_post(parser_t *p, enum prime_parser prim) { p->eof = (p->recent_tok.yy_char == 0); if (prim == prime_interactive) p->recent_tok.yy_char = 0; } int parser_callgraph_circ_check(struct circ_stack *rs, val obj) { for (; rs; rs = rs->up) { if (rs->obj == obj) return 0; } return 1; } static val patch_ref(parser_t *p, val obj) { if (consp(obj)) { val a = pop(&obj); if (a == circref_s) { val num = car(obj); val rep = gethash(p->circ_ref_hash, num); if (!rep) yyerrorf(p->scanner, lit("dangling #~s# ref"), num, nao); if (consp(rep) && car(rep) == circref_s) yyerrorf(p->scanner, lit("absurd #~s# ref"), num, nao); if (!p->circ_count--) yyerrorf(p->scanner, lit("unexpected surplus #~s# ref"), num, nao); return rep; } } return nil; } static void circ_backpatch(parser_t *p, struct circ_stack *up, val obj) { val self = lit("parser"); struct circ_stack cs = { up, obj }; if (!parser_callgraph_circ_check(up, obj)) return; tail: if (!p->circ_count) return; if (!is_ptr(obj)) return; switch (type(obj)) { case CONS: { us_cons_bind(a, d, obj); val ra = patch_ref(p, a); val rd = patch_ref(p, d); if (ra) us_rplaca(obj, ra); else circ_backpatch(p, &cs, a); if (rd) { us_rplacd(obj, rd); break; } obj = d; goto tail; } case VEC: { cnum i; cnum l = c_num(length_vec(obj), self); for (i = 0; i < l; i++) { val v = obj->v.vec[i]; val rv = patch_ref(p, v); if (rv) set(mkloc(obj->v.vec[i], obj), rv); else circ_backpatch(p, &cs, v); if (!p->circ_count) break; } break; } case RNG: { val s = from(obj); val e = to(obj); val rs = patch_ref(p, s); val re = patch_ref(p, e); if (rs) set_from(obj, rs); else circ_backpatch(p, &cs, s); if (re) { set_to(obj, re); break; } obj = e; goto tail; } case TNOD: { val k = obj->tn.key; val l = obj->tn.left; val r = obj->tn.right; val rk = patch_ref(p, k); val rl = patch_ref(p, l); val rr = patch_ref(p, r); if (rl) set(mkloc(obj->tn.left, obj), rl); else circ_backpatch(p, &cs, l); if (rr) set(mkloc(obj->tn.right, obj), rr); else circ_backpatch(p, &cs, r); if (rk) set(mkloc(obj->tn.key, obj), rk); obj = k; goto tail; } case COBJ: if (hashp(obj)) { val u = get_hash_userdata(obj); val ru = patch_ref(p, u); cnum old_circ_count = p->circ_count; if (ru) set_hash_userdata(obj, ru); else circ_backpatch(p, &cs, u); if (old_circ_count > 0) { val cell; val pairs = nil; struct hash_iter hi; us_hash_iter_init(&hi, obj); while ((cell = hash_iter_next(&hi))) { circ_backpatch(p, &cs, cell); push(cell, &pairs); } if (old_circ_count != p->circ_count) { clearhash(obj); while (pairs) { val cell = rcyc_pop(&pairs); sethash(obj, us_car(cell), us_cdr(cell)); } } else { while (pairs) rcyc_pop(&pairs); } } } else if (structp(obj)) { val stype = struct_type(obj); val iter; for (iter = slots(stype); iter; iter = cdr(iter)) { val sn = car(iter); val sv = slot(obj, sn); val rsv = patch_ref(p, sv); if (rsv) slotset(obj, sn, rsv); else circ_backpatch(p, &cs, sv); if (p->circ_count <= 0) break; } } else if (treep(obj)) { val iter = tree_begin(obj, colon_k, colon_k); val node; val nodes = nil; cnum old_circ_count = p->circ_count; while ((node = tree_next(iter))) { val k = node->tn.key; val rk = patch_ref(p, k); if (rk) set(mkloc(node->tn.key, node), rk); else circ_backpatch(p, &cs, k); push(node, &nodes); } if (nodes && old_circ_count != p->circ_count) { tree_clear(obj); while (nodes) { val node = rcyc_pop(&nodes); tree_insert_node(obj, node); } } else { while (nodes) rcyc_pop(&nodes); } } break; case FUN: if (obj->f.functype == FINTERP) { val fun = obj->f.f.interp_fun; circ_backpatch(p, &cs, car(fun)); obj = cadr(fun); goto tail; } default: break; } return; } void parser_resolve_circ(parser_t *p) { if (p->circ_count == 0) return; circ_backpatch(p, 0, p->syntax_tree); if (p->circ_count > 0) yyerrorf(p->scanner, lit("not all ## refs replaced in object ~s"), p->syntax_tree, nao); } void parser_circ_def(parser_t *p, val num, val expr) { if (!p->circ_ref_hash) { p->circ_ref_hash = make_eq_hash(hash_weak_none); setcheck(p->parser, p->circ_ref_hash); } { val new_p = nil; loc pcdr = gethash_l(lit("parser"), p->circ_ref_hash, num, mkcloc(new_p)); if (!new_p && deref(pcdr) != unique_s) yyerrorf(p->scanner, lit("duplicate #~s= def"), num, nao); set(pcdr, expr); } } val parser_circ_ref(parser_t *p, val num) { val obj = if2(p->circ_ref_hash, gethash(p->circ_ref_hash, num)); if (!obj) yyerrorf(p->scanner, lit("dangling #~s# ref"), num, nao); if (obj == unique_s && !p->ignore) { p->circ_count++; return cons(circref_s, cons(num, nil)); } return obj; } void open_txr_file(val spec_file, val *txr_lisp_p, val *name, val *stream, val self) { enum { none, tl, tlo, txr } suffix; if (match_str(spec_file, lit(".txr"), negone)) suffix = txr; else if (match_str(spec_file, lit(".tl"), negone)) suffix = tl; else if (match_str(spec_file, lit(".tlo"), negone)) suffix = tlo; else if (match_str(spec_file, lit(".txr_profile"), negone)) suffix = tl; else suffix = none; errno = 0; { val spec_file_try = nil; FILE *in = 0; if (suffix == none && !*txr_lisp_p) { spec_file_try = scat(lit("."), spec_file, lit("txr"), nao); if ((in = w_fopen(c_str(spec_file_try, nil), L"r")) != 0) goto found; #ifdef ENOENT if (in == 0 && errno != ENOENT) goto except; #endif } if (suffix == none) { { spec_file_try = scat(lit("."), spec_file, lit("tlo"), nao); errno = 0; if ((in = w_fopen(c_str(spec_file_try, nil), L"r")) != 0) { *txr_lisp_p = chr('o'); goto found; } #ifdef ENOENT if (in == 0 && errno != ENOENT) goto except; #endif } { spec_file_try = scat(lit("."), spec_file, lit("tl"), nao); errno = 0; if ((in = w_fopen(c_str(spec_file_try, nil), L"r")) != 0) { *txr_lisp_p = t; goto found; } #ifdef ENOENT if (in == 0 && errno != ENOENT) goto except; #endif } } { spec_file_try = spec_file; errno = 0; in = w_fopen(c_str(spec_file_try, self), L"r"); if (in != 0) { switch (suffix) { case tl: *txr_lisp_p = t; break; case tlo: *txr_lisp_p = chr('o'); break; case txr: *txr_lisp_p = nil; break; default: break; } } } if (in == 0) { #ifdef ENOENT except: #endif uw_throwf(errno_to_file_error(errno), lit("unable to open ~a"), spec_file_try, nao); } found: *stream = make_stdio_stream(in, spec_file_try); *name = spec_file_try; } } val regex_parse(val string, val error_stream) { val save_stream = std_error; val stream = make_string_byte_input_stream(string); parser_t parser; error_stream = default_arg_strict(error_stream, std_null); std_error = if3(error_stream == t, std_output, error_stream); parser_common_init(&parser); parser.stream = stream; { int gc = gc_state(0); parse(&parser, if3(std_error != std_null, lit("regex"), lit("")), prime_regex); gc_state(gc); } parser_cleanup(&parser); std_error = save_stream; if (parser.errors) uw_throw(syntax_error_s, lit("regex-parse: syntax errors in regex")); return parser.syntax_tree; } static val lisp_parse_impl(val self, enum prime_parser prime, val rlcp_p, val source_in, val error_stream, val error_return_val, val name_in, val lineno) { val source = default_arg_strict(source_in, std_input); val str = stringp(source); val input_stream = if3(str, make_string_byte_input_stream(source), source); val name = default_arg_strict(name_in, if3(str, lit("string"), stream_get_prop(input_stream, name_k))); val parser = ensure_parser(input_stream, name); val saved_dyn = dyn_env; parser_t *pi = parser_get_impl(self, parser); volatile val parsed = nil; if (rlcp_p) pi->rec_source_loc = 1; uw_simple_catch_begin; dyn_env = make_env(nil, nil, dyn_env); error_stream = default_arg_strict(error_stream, std_null); error_stream = if3(error_stream == t, std_output, error_stream); class_check (self, error_stream, stream_cls); if (lineno && !missingp(lineno)) pi->lineno = c_num(lineno, self); env_vbind(dyn_env, stderr_s, error_stream); for (;;) { int gc = gc_state(0); parse(pi, if3(std_error != std_null, name, lit("")), prime); mut(parser); gc_state(gc); if (pi->syntax_tree == nao && pi->errors == 0 && !pi->eof) continue; break; } if (str) { int junk = 0; if (prime == prime_json) { YYSTYPE yyl; junk = yylex(&yyl, pi->scanner); } else { junk = pi->recent_tok.yy_char; } if (junk) yyerrorf(pi->scanner, lit("trailing material after expression"), nao); } parsed = t; uw_unwind { dyn_env = saved_dyn; if (!parsed) { parser_reset(pi); } } uw_catch_end; if (pi->errors || pi->syntax_tree == nao) { if (missingp(error_return_val)) uw_throwf(syntax_error_s, lit("read: ~a: ~a"), name, if3(pi->syntax_tree == nao, lit("end of input reached without seeing object"), lit("errors encountered")), nao); return error_return_val; } return pi->syntax_tree; } val lisp_parse(val source_in, val error_stream, val error_return_val, val name_in, val lineno) { val self = lit("lisp-parse"); return lisp_parse_impl(self, prime_lisp, t, source_in, error_stream, error_return_val, name_in, lineno); } val nread(val source_in, val error_stream, val error_return_val, val name_in, val lineno) { val self = lit("nread"); return lisp_parse_impl(self, prime_lisp, nil, source_in, error_stream, error_return_val, name_in, lineno); } val iread(val source_in, val error_stream, val error_return_val, val name_in, val lineno) { val self = lit("iread"); return lisp_parse_impl(self, prime_interactive, nil, source_in, error_stream, error_return_val, name_in, lineno); } val get_json(val source_in, val error_stream, val error_return_val, val name_in, val lineno) { val self = lit("get-json"); return lisp_parse_impl(self, prime_json, nil, source_in, error_stream, error_return_val, name_in, lineno); } static val read_file_common(val self, val stream, val error_stream, val compiled) { val error_val = gensym(nil); val name = stream_get_prop(stream, name_k); val first = t; val big_endian = nil; val parser = ensure_parser(stream, name); val not_compiled = null(compiled); if (compiled) { parser_t *pi = parser_get_impl(self, parser); pi->rec_source_loc = 0; } for (;;) { val form = lisp_parse_impl(self, prime_lisp, not_compiled, stream, error_stream, error_val, name, colon_k); if (form == error_val) { if (parser_errors(parser) != zero) return nil; break; } if (compiled && first) { val major = car(form); if (neq(major, num_fast(6)) && neq(major, num_fast(7))) uw_throwf(error_s, lit("cannot load ~s: version number mismatch"), stream, nao); big_endian = caddr(form); first = nil; } else if (compiled) { for (; form; form = cdr(form)) { val item = car(form); val nlevels = pop(&item); val nregs = pop(&item); val bytecode = pop(&item); val datavec = pop(&item); val funvec = car(item); val desc = vm_make_desc(nlevels, nregs, bytecode, datavec, funvec); if ((big_endian && HAVE_LITTLE_ENDIAN) || (!big_endian && !HAVE_LITTLE_ENDIAN)) buf_swap32(bytecode); (void) vm_execute_toplevel(desc); gc_hint(desc); } } else { (void) eval_intrinsic(form, nil); } } return t; } val read_eval_stream(val self, val stream, val error_stream) { return read_file_common(self, stream, error_stream, nil); } val read_compiled_file(val self, val stream, val error_stream) { return read_file_common(self, stream, error_stream, t); } val txr_parse(val source_in, val error_stream, val error_return_val, val name_in) { val self = lit("txr-parse"); val source = default_arg_strict(source_in, std_input); val input_stream = if3(stringp(source), make_string_byte_input_stream(source), source); val name = default_arg_strict(name_in, if3(stringp(source), lit("string"), stream_get_prop(input_stream, name_k))); int gc = gc_state(0); val saved_dyn = dyn_env; val parser_obj = ensure_parser(input_stream, name); parser_t *pi = parser_get_impl(self, parser_obj); val loading = cdr(lookup_var(dyn_env, load_recursive_s)); uw_simple_catch_begin; dyn_env = make_env(nil, nil, dyn_env); error_stream = default_arg_strict(error_stream, std_null); error_stream = if3(error_stream == t, std_output, error_stream); class_check (self, error_stream, stream_cls); parse_once(self, input_stream, name); uw_unwind { dyn_env = saved_dyn; mut(parser_obj); gc_state(gc); if (!loading) uw_release_deferred_warnings(); } uw_catch_end; if (pi->errors || pi->syntax_tree == nao) { if (missingp(error_return_val)) uw_throwf(syntax_error_s, lit("~a: ~a: ~a"), self, name, if3(pi->syntax_tree == nao, lit("end of input reached without seeing object"), lit("errors encountered")), nao); return error_return_val; } return pi->syntax_tree; } #if HAVE_TERMIOS static void report_security_problem(val name) { val self = lit("listener"); static int umask_warned; format(std_output, lit("** possible security problem: ~a is writable to others\n"), name, nao); #if HAVE_SYS_STAT if (!umask_warned++) { val um = umask_wrap(colon_k); if ((c_num(um, self) & 022) != 022) { format(std_output, lit("** possible reason: your umask has an insecure value: ~,03o\n"), um, nao); } } #endif } static void load_rcfile(val name) { val self = lit("listener"); val resolved_name; val lisp_p = t; val stream = nil; val catch_syms = cons(error_s, nil); val path_private_to_me_p = intern(lit("path-private-to-me-p"), user_package); uw_catch_begin (catch_syms, sy, va); open_txr_file(name, &lisp_p, &resolved_name, &stream, self); if (stream) { if (!funcall1(path_private_to_me_p, stream)) { report_security_problem(name); } else { val saved_dyn_env = set_dyn_env(make_env(nil, nil, dyn_env)); env_vbind(dyn_env, load_path_s, resolved_name); read_eval_stream(self, stream, std_output); dyn_env = saved_dyn_env; } } uw_catch(sy, va) { (void) va; if (stream || sy != path_not_found_s) { format(std_output, lit("** type ~s exception while loading ~a\n"), sy, name, nao); format(std_output, lit("** details: ~a\n"), car(va), nao); } } uw_unwind { if (stream) close_stream(stream, nil); } uw_catch_end; } static val get_visible_syms(val package, int include_fallback) { val fblist; if (!include_fallback || nilp((fblist = package_fallback_list(package)))) { return package_symbols(package); } else { val symhash = copy_hash(package->pk.symhash); for (; fblist; fblist = cdr(fblist)) { val fb_pkg = car(fblist); val fcell; val new_p; struct hash_iter hi; us_hash_iter_init(&hi, fb_pkg->pk.symhash); while ((fcell = hash_iter_next(&hi))) { loc pcdr = gethash_l(lit("listener"), symhash, us_car(fcell), mkcloc(new_p)); if (new_p) set(pcdr, us_cdr(fcell)); } } return hash_values(symhash); } } static void find_matching_syms(lino_completions_t *cpl, val package, val prefix, val line_prefix, char kind, val force_qualify) { val is_cur = tnil(package == cur_package); val qualify = tnil(force_qualify || !is_cur); val pkg_name = if2(qualify, if3(package == keyword_package && !force_qualify, lit(""), package_name(package))); val syms = ((kind == 'S' || kind == 'M') ? hash_keys((get_slot_syms(package, is_cur, tnil(kind == 'M')))) : get_visible_syms(package, is_cur != nil && !qualify)); for ( ; syms; syms = cdr(syms)) { val sym = car(syms); val name = symbol_name(sym); val found = if3(cpl->substring, search_str(name, prefix, zero, nil), match_str(name, prefix, zero)); if (found) { val comple; switch (kind) { case '(': if (fboundp(sym) || mboundp(sym) || special_operator_p(sym)) break; continue; case 'M': case 'S': break; case 'Q': if (mboundp(sym) || special_operator_p(sym)) break; /* fallthrough */ default: if (find_struct_type(sym) || ffi_type_p(sym)) break; /* fallthrough */ case '[': if (fboundp(sym) || boundp(sym)) break; continue; } if (equal(name, prefix)) continue; if (qualify) comple = scat(nil, line_prefix, pkg_name, lit(":"), name, nao); else comple = scat2(line_prefix, name); lino_add_completion(cpl, c_str(comple, nil)); gc_hint(comple); } } } static void provide_completions(const wchar_t *data, lino_completions_t *cpl, void *ctx) { const wchar_t *gly = L"!$%&*+-<=>?\\_~/"; const wchar_t *ptr = data[0] ? data + wcslen(data) - 1 : 0; const wchar_t *sym = 0, *pkg = 0; const wchar_t *end; val keyword = nil; val package = nil; (void) ctx; uw_catch_begin (catch_all, exsym, exvals); if (!ptr) goto out; while ((iswalnum(convert(wint_t, *ptr)) || wcschr(gly, *ptr) || *ptr >= 0x80) && (sym = ptr) && ptr > data) ptr--; if (!sym) goto out; end = sym; if (*ptr == ':') { if (ptr == data) { keyword = t; } else { ptr--; while ((iswalnum(convert(wint_t, *ptr)) || wcschr(gly, *ptr) || *ptr >= 0x80) && (pkg = ptr) && ptr > data) ptr--; if (!pkg) keyword = t; } } if (keyword) { package = keyword_package; end = sym - 1; } else if (pkg) { size_t sz = sym - pkg; wchar_t *pkg_copy = convert(wchar_t *, alloca(sizeof *pkg_copy * sz)); wmemcpy(pkg_copy, pkg, sz); pkg_copy[sz - 1] = 0; { val package_name = string(pkg_copy); package = find_package(package_name); if (!package) return; } end = pkg; } { val sym_pfx = string(sym); size_t lsz = end - data + 1; wchar_t *line_pfxs = convert(wchar_t *, alloca(sizeof *line_pfxs * lsz)); wmemcpy(line_pfxs, data, lsz); line_pfxs[lsz - 1] = 0; { uses_or2; val line_pfx = string(line_pfxs); char prev = (end > data) ? end[-1] : 0; char pprev = (end > data + 1) ? end[-2] : 0; int quote = (prev == '^' || prev == '\''); int pquote = (pprev == '^' || pprev == '\'' || pprev == '#'); int ppar = (pprev == '('); int dwim = (prev == '['); int par = (prev == '('); int slot = (prev == '.'); int meth = (pprev == '.') && (dwim || par); char kind = if3(slot, 'S', if3(meth, 'M', if3(quote, 'Q', if3(!pprev || (!pquote && !ppar) || dwim, prev, 0)))); find_matching_syms(cpl, or2(package, cur_package), sym_pfx, line_pfx, kind, if2(package, null(keyword))); } } out: uw_catch (exsym, exvals) { (void) exsym; (void) exvals; } uw_unwind; uw_catch_end; } static wchar_t *provide_atom(lino_t *l, const wchar_t *str, int n, void *ctx) { val obj = nao; val form; val line = string(str); wchar_t *out = 0; (void) l; (void) ctx; uw_catch_begin (catch_all, exsym, exvals); form = lisp_parse(line, std_null, colon_k, lit("atomcb"), colon_k); if (atom(form)) { if (n == 1) obj = form; } else { val fform = flatcar(form); obj = ref(fform, num(-n)); } if (obj != nao) out = chk_strdup(c_str(tostring(obj), nil)); uw_catch (exsym, exvals) { (void) exsym; (void) exvals; } uw_unwind; uw_catch_end; return out; } static val repl_intr(val signo, val async_p) { (void) signo; (void) async_p; return uw_rthrow(intr_s, lit("intr")); } static val read_eval_ret_last(val env, val counter, val in_stream, val out_stream) { val lineno = one; val error_val = gensym(nil); val name = format(nil, lit("paste-~a"), counter, nao); val value = nil; val loading = cdr(lookup_var(dyn_env, load_recursive_s)); val saved_dyn_env = set_dyn_env(make_env(nil, nil, dyn_env)); env_vbind(dyn_env, load_recursive_s, t); (void) env; for (;; lineno = succ(lineno)) { val form = lisp_parse(in_stream, out_stream, error_val, name, lineno); if (form == error_val) break; value = eval_intrinsic(form, nil); } dyn_env = saved_dyn_env; if (!loading) uw_release_deferred_warnings(); prinl(value, out_stream); return t; } static val get_home_path(void) { #ifdef __CYGWIN__ struct utsname un; if (uname(&un) >= 0) { if (strncmp(un.sysname, "CYGNAL", 6) == 0) return getenv_wrap(lit("USERPROFILE")); } #endif return getenv_wrap(lit("HOME")); } static val repl_warning(val out_stream, val exc, struct args *rest) { val args = args_get_list(rest); (void) exc; if (cdr(args)) uw_defer_warning(args); else format(out_stream, lit("** ~!~a\n"), car(args), nao); return uw_rthrow(continue_s, nil); } static int is_balanced_line(const wchar_t *line, void *ctx) { enum state { ST_START, ST_CMNT, ST_PAR, ST_BKT, ST_BRC, ST_HASH, ST_LIT, ST_QLIT, ST_RGX, ST_RGXC, ST_RGXE, ST_CHR, ST_ESC, ST_AT, ST_HASH_B, ST_BUF }; int count[32], sp = 0; enum state state[32]; count[sp] = 0; state[sp] = ST_START; wchar_t ch; (void) ctx; while ((ch = *line++) != 0) { again: if (sp >= 30) return 1; count[sp+1] = 0; count[sp+2] = 0; switch (state[sp]) { case ST_START: case ST_PAR: case ST_BKT: case ST_BRC: switch (ch) { case ';': state[++sp] = ST_CMNT; break; case '#': state[++sp] = ST_HASH; break; case '"': state[++sp] = ST_LIT; break; case '`': state[++sp] = ST_QLIT; break; case '(': if (state[sp] == ST_PAR) count[sp]++; else state[++sp] = ST_PAR; break; case '[': if (state[sp] == ST_BKT) count[sp]++; else state[++sp] = ST_BKT; break; case '{': if (state[sp] == ST_BRC) count[sp]++; else state[++sp] = ST_BRC; break; case ')': case ']': case '}': { enum state match = ST_START; switch (ch) { case ')': match = ST_PAR; break; case ']': match = ST_BKT; break; case '}': match = ST_BRC; break; } while (sp > 0 && state[sp] != match) sp--; if (state[sp] != match) return 0; if (count[sp] == 0) sp--; else count[sp]--; break; } } break; case ST_CMNT: if (ch == '\r') sp--; break; case ST_HASH: switch (ch) { case '\\': state[sp] = ST_CHR; break; case '/': state[sp] = ST_RGX; break; case 'b': state[sp] = ST_HASH_B; break; case ';': --sp; break; default: --sp; goto again; } break; case ST_LIT: switch (ch) { case '"': sp--; break; case '\\': state[++sp] = ST_ESC; break; } break; case ST_QLIT: switch (ch) { case '`': sp--; break; case '\\': state[++sp] = ST_ESC; break; case '@': state[++sp] = ST_AT; break; } break; case ST_RGX: switch (ch) { case '/': sp--; break; case '[': state[++sp] = ST_RGXC; break; case '(': state[++sp] = ST_RGXE; break; case '\\': state[++sp] = ST_ESC; break; } break; case ST_RGXC: switch (ch) { case ']': sp--; break; case '\\': state[++sp] = ST_ESC; break; } break; case ST_RGXE: switch (ch) { case ')': sp--; break; case '[': state[++sp] = ST_RGXC; break; case '(': state[++sp] = ST_RGXE; break; case '\\': state[++sp] = ST_ESC; break; } break; case ST_CHR: --sp; break; case ST_ESC: --sp; break; case ST_AT: switch (ch) { case '(': state[sp] = ST_PAR; break; case '[': state[sp] = ST_BKT; break; case '{': state[sp] = ST_BRC; break; default: sp--; break; } break; case ST_HASH_B: switch (ch) { case '\'': state[sp] = ST_BUF; break; default: sp--; break; } break; case ST_BUF: switch (ch) { case '\'': sp--; break; } break; } } if (state[sp] == ST_CMNT) sp--; return sp == 0 && state[sp] == ST_START && count[sp] == 0; } static_forward(lino_os_t linenoise_txr_binding); static void hist_save(lino_t *ls, val in_stream, val out_stream, val histfile, const wchar_t *histfile_w, val hist_len_var) { val self = lit("listener"); if (histfile_w && lino_have_new_lines(ls)) { val histfile_tmp = scat2(histfile, lit(".tmp")); const wchar_t *histfile_tmp_w = c_str(histfile_tmp, self); lino_t *ltmp = lino_make(coerce(mem_t *, in_stream), coerce(mem_t *, out_stream)); lino_hist_set_max_len(ltmp, c_num(cdr(hist_len_var), self)); lino_hist_load(ltmp, histfile_w); lino_hist_save(ltmp, histfile_tmp_w, 0); if (lino_hist_save(ls, histfile_tmp_w, 1) == 0) rename_path(histfile_tmp, histfile); else put_line(lit("** unable to save history file"), out_stream); gc_hint(histfile_tmp); lino_free(ltmp); } } val repl(val bindings, val in_stream, val out_stream, val env) { val self = lit("listener"); lino_t *ls = if3(repl_level++, lino_ctx, lino_ctx = lino_make(coerce(mem_t *, in_stream), coerce(mem_t *, out_stream))); wchar_t *line_w = 0; val quit_k = intern(lit("quit"), keyword_package); val read_k = intern(lit("read"), keyword_package); val prompt_k = intern(lit("prompt"), keyword_package); val prompt_on_k = intern(lit("prompt-on"), keyword_package); val p_k = intern(lit("p"), keyword_package); val save_k = intern(lit("save"), keyword_package); val counter_sym = intern(lit("*n"), user_package); val var_counter_sym = intern(lit("*v"), user_package); val result_hash_sym = intern(lit("*r"), user_package); val path_private_to_me_p = intern(lit("path-private-to-me-p"), user_package); val result_hash = make_hash(hash_weak_none, nil); val done = nil; val counter = one; val home = if3(repl_level == 1, get_home_path(), nil); val histfile = if2(home, scat2(home, lit("/.txr_history"))); const wchar_t *histfile_w = if3(home, c_str(histfile, self), NULL); val rcfile = if2(home && !opt_noprofile, scat2(home, lit("/.txr_profile"))); val old_sig_handler = set_sig_handler(num(SIGINT), func_n2(repl_intr)); val hist_len_var = lookup_global_var(listener_hist_len_s); val multi_line_var = lookup_global_var(listener_multi_line_p_s); val sel_inclusive_var = lookup_global_var(listener_sel_inclusive_p_s); val pprint_var = lookup_global_var(listener_pprint_s); val greedy_eval = lookup_global_var(listener_greedy_eval_s); val rw_f = func_f1v(out_stream, repl_warning); val saved_dyn_env = set_dyn_env(make_env(nil, nil, dyn_env)); val brackets = mkstring(num_fast(repl_level), chr('>')); cnum i; env_vbind(dyn_env, stderr_s, out_stream); for (; bindings; bindings = cdr(bindings)) { val binding = car(bindings); reg_varl(car(binding), cdr(binding)); } for (i = 1; i <= 20; i++) { val name = format(nil, lit("*-~d"), num_fast(i), nao); val sym = intern(name, user_package); reg_symacro(sym, list(dwim_s, result_hash_sym, list(macro_time_s, list(mod_s, list(minus_s, var_counter_sym, num_fast(i), nao), num_fast(100), nao), nao), nao)); } reg_varl(result_hash_sym, result_hash); lino_set_completion_cb(ls, provide_completions, 0); lino_set_atom_cb(ls, provide_atom, 0); lino_set_enter_cb(ls, is_balanced_line, 0); lino_set_tempfile_suffix(ls, ".tl"); if (rcfile) load_rcfile(rcfile); lino_hist_set_max_len(ls, c_num(cdr(hist_len_var), self)); if (histfile_w) { if (lino_hist_load(ls, histfile_w) == 0 && !funcall1(path_private_to_me_p, histfile)) { report_security_problem(histfile); } } lino_set_noninteractive(ls, opt_noninteractive); while (!done) { val prompt = format(nil, lit("~d~a "), counter, brackets,nao); val prev_counter = counter; val var_counter = mod(counter, num_fast(100)); val var_name = format(nil, lit("*~d"), var_counter, nao); val var_sym = intern(var_name, user_package); uw_frame_t uw_handler; lino_hist_set_max_len(ls, c_num(cdr(hist_len_var), self)); lino_set_multiline(ls, cdr(multi_line_var) != nil); lino_set_selinclusive(ls, cdr(sel_inclusive_var) != nil); reg_varl(counter_sym, counter); reg_varl(var_counter_sym, var_counter); line_w = linenoise(ls, c_str(prompt, self)); rplacd(multi_line_var, tnil(lino_get_multiline(ls))); if (line_w == 0) { switch (lino_get_error(ls)) { case lino_intr: put_line(lit("** intr"), out_stream); continue; case lino_eof: break; default: put_line(lit("** error reading interactive input"), out_stream); break; } break; } { size_t wsp = wcsspn(line_w, L" \t\n\r"); if (line_w[wsp] == 0) { free(line_w); continue; } if (line_w[wsp] == ';') { lino_hist_add(ls, line_w); free(line_w); continue; } } counter = succ(counter); uw_catch_begin (catch_all, exsym, exvals); uw_push_handler(&uw_handler, cons(warning_s, nil), rw_f); { val name = format(nil, lit("expr-~d"), prev_counter, nao); val line = string(line_w); val form = lisp_parse(line, out_stream, colon_k, name, colon_k); if (form == quit_k) { done = t; } else if (form == prompt_k) { pprinl(prompt, out_stream); counter = prev_counter; } else if (form == prompt_on_k) { lino_enable_noninteractive_prompt(ls, 1); counter = prev_counter; } else if (form == p_k) { pprinl(prev_counter, out_stream); counter = prev_counter; } else if (form == save_k) { hist_save(ls, in_stream, out_stream, histfile, histfile_w, hist_len_var); counter = prev_counter; } else { val value = if3(form != read_k, eval_intrinsic(form, env), read_eval_ret_last(nil, prev_counter, in_stream, out_stream)); val pprin = cdr(pprint_var); val (*pfun)(val, val) = if3(pprin, pprinl, prinl); val (*tsfun)(val) = if3(pprin, tostringp, tostring); reg_varl(var_sym, value); sethash(result_hash, var_counter, value); pfun(value, out_stream); lino_set_result(ls, chk_strdup(c_str(tsfun(value), self))); lino_hist_add(ls, line_w); if (cdr(greedy_eval)) { val error_p = nil; while (bindable(value) || consp(value)) { value = eval_intrinsic_noerr(value, nil, &error_p); /* env deliberately not passed to eval here */ if (error_p) break; pfun(value, out_stream); } } } } uw_pop_frame(&uw_handler); uw_catch (exsym, exvals) { val exinfo = cons(exsym, exvals); reg_varl(var_sym, exinfo); sethash(result_hash, var_counter, exinfo); lino_hist_add(ls, line_w); if (uw_exception_subtype_p(exsym, syntax_error_s)) { format(out_stream, lit("** syntax error: ~a\n"), car(exvals), nao); } else if (uw_exception_subtype_p(exsym, error_s)) { error_trace(exsym, exvals, out_stream, lit("**")); } else { format(out_stream, lit("** ~!~s exception, args: ~!~s\n"), exsym, exvals, nao); } } uw_unwind { free(line_w); line_w = 0; } uw_catch_end; gc_hint(prompt); } set_sig_handler(num(SIGINT), old_sig_handler); dyn_env = saved_dyn_env; hist_save(ls, in_stream, out_stream, histfile, histfile_w, hist_len_var); free(line_w); if (--repl_level == 0) { lino_free(lino_ctx); lino_ctx = 0; } gc_hint(histfile); return nil; } #endif val parser_errors(val parser) { val self = lit("parser-errors"); parser_t *p = coerce(parser_t *, cobj_handle(self, parser, parser_cls)); return num(p->errors); } val parse_errors(val stream) { val self = lit("parse-errors"); val errors = nil; val parser = gethash(stream_parser_hash, stream); if (parser) { parser_t *p = coerce(parser_t *, cobj_handle(self, parser, parser_cls)); if (p->errors) errors = num(p->errors); } return errors; } static val circref(val n) { uw_throwf(error_s, lit("unresolved #~s# reference in object syntax"), n, nao); } static int lino_fileno(mem_t *stream_in) { val self = lit("listener"); val stream = coerce(val, stream_in); return c_num(stream_fd(stream), self); } static int lino_puts(mem_t *stream_in, const wchar_t *str_in) { val stream = coerce(val, stream_in); wchar_t ch; while ((ch = *str_in++)) if (ch != LINO_PAD_CHAR) if (put_char(chr(ch), stream) != t) return 0; flush_stream(stream); return 1; } static int lino_puts_file(mem_t *stream_in, const wchar_t *str_in) { val stream = coerce(val, stream_in); wchar_t ch; while ((ch = *str_in++)) if (put_char(chr(ch), stream) != t) return 0; return 1; } static wint_t lino_getch(mem_t *stream_in) { val self = lit("listener"); wint_t ret = WEOF; val stream, ch; uw_catch_begin (catch_all, sy, va); stream = coerce(val, stream_in); ch = get_char(stream); ret = if3(ch, (wint_t) c_num(ch, self), WEOF); uw_catch (sy, va) { (void) sy; (void) va; } uw_unwind { } uw_catch_end; return ret; } static wchar_t *lino_getl(mem_t *stream_in, wchar_t *buf, size_t nchar) { val self = lit("listener"); wchar_t *ptr = buf; val stream = coerce(val, stream_in); if (nchar == 0) return buf; while (nchar-- > 1) { val ch = get_char(stream); if (!ch) break; if ((*ptr++ = c_num(ch, self)) == '\n') break; } *ptr++ = 0; return (ptr == buf + 1) ? 0 : buf; } static wchar_t *lino_gets(mem_t *stream_in, wchar_t *buf, size_t nchar) { val self = lit("listener"); wchar_t *ptr = buf; val stream = coerce(val, stream_in); if (nchar == 0) return buf; while (nchar-- > 1) { val ch = get_char(stream); if (!ch) break; *ptr++ = c_num(ch, self); } *ptr++ = 0; return (ptr == buf + 1) ? 0 : buf; } static int lino_feof(mem_t *stream_in) { val stream = coerce(val, stream_in); return get_error(stream) == t; } static const wchli_t *lino_mode_str[] = { wli("r"), wli("w"), wli("a") }; static mem_t *lino_open(const wchar_t *name_in, lino_file_mode_t mode_in) { val self = lit("listener"); val name = string(name_in); val mode = static_str(lino_mode_str[mode_in]); val ret = 0; ignerr_begin; ret = open_file(name, mode); #if HAVE_CHMOD if (mode_in == lino_overwrite || mode_in == lino_append) (void) fchmod(c_num(stream_fd(ret), self), S_IRUSR | S_IWUSR); #endif ignerr_end; return coerce(mem_t *, ret); } static mem_t *lino_open8(const char *name_in, lino_file_mode_t mode_in) { val name = string_utf8(name_in); val mode = static_str(lino_mode_str[mode_in]); mem_t *ret = 0; ignerr_begin; ret = coerce(mem_t *, open_file(name, mode)); ignerr_end; return ret; } static mem_t *lino_fdopen(int fd, lino_file_mode_t mode_in) { val mode = static_str(lino_mode_str[mode_in]); return coerce(mem_t *, open_fileno(num(fd), mode)); } static void lino_close(mem_t *stream) { (void) close_stream(coerce(val, stream), nil); } static_def(lino_os_t linenoise_txr_binding = lino_os_init(chk_malloc, chk_realloc, chk_wmalloc, chk_wrealloc, chk_strdup, free, lino_fileno, lino_puts, lino_puts_file, lino_getch, lino_getl, lino_gets, lino_feof, lino_open, lino_open8, lino_fdopen, lino_close, wide_display_char_p)); static val me_json(val form, val menv) { (void) menv; return cdr(form); } void parse_init(void) { parser_s = intern(lit("parser"), user_package); circref_s = intern(lit("circref"), system_package); intr_s = intern(lit("intr"), user_package); listener_hist_len_s = intern(lit("*listener-hist-len*"), user_package); listener_multi_line_p_s = intern(lit("*listener-multi-line-p*"), user_package); listener_sel_inclusive_p_s = intern(lit("*listener-sel-inclusive-p*"), user_package); listener_pprint_s = intern(lit("*listener-pprint-p*"), user_package); listener_greedy_eval_s = intern(lit("*listener-greedy-eval-p*"), user_package); rec_source_loc_s = intern(lit("*rec-source-loc*"), user_package); read_unknown_structs_s = intern(lit("*read-unknown-structs*"), user_package); read_bad_json_s = intern(lit("*read-bad-json*"), user_package); json_s = intern(lit("json"), user_package); unique_s = gensym(nil); parser_cls = cobj_register(parser_s); protect(&stream_parser_hash, &unique_s, &catch_all, convert(val *, 0)); stream_parser_hash = make_hash(hash_weak_and, nil); catch_all = cons(t, nil); parser_l_init(); lino_init(&linenoise_txr_binding); reg_var(listener_hist_len_s, num_fast(500)); reg_var(listener_multi_line_p_s, t); reg_var(listener_sel_inclusive_p_s, nil); reg_var(listener_pprint_s, nil); reg_var(listener_greedy_eval_s, nil); reg_var(rec_source_loc_s, nil); reg_var(read_unknown_structs_s, nil); reg_var(read_bad_json_s, nil); reg_fun(circref_s, func_n1(circref)); reg_fun(intern(lit("parse-errors"), user_package), func_n1(parse_errors)); reg_fun(intern(lit("repl"), system_package), func_n4(repl)); reg_mac(json_s, func_n2(me_json)); }