| Commit message (Collapse) | Author | Age | Files | Lines |
|
|
|
|
|
|
|
|
|
|
|
|
| |
* parser.c (listener_auto_compound_s): New symbol variable.
(repl): If *listener-auto-compound-p* is true, then evaluate
multiple forms directly as a compound expression, without
inserting progn at the head.
(parse_init): Initialize symbol variable and register
the *listener-auto-compound-p* special.
* txr.1: Documented.
* stdlib/doc-syms.tl: Updated.
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
| |
The new function use-sym-as can bring a foreign
symbol into a package under a different name,
which is not that symbol's name. This is also
featured in a new defpackage clause, :use-syms-as.
With this simple relaxation in the package system,
we don't require package local nicknames, which is
more complicated to implement and less ergonomic,
because it doesn't actually vanquish the use of
ugly package prefixes on clashing symbols.
* eval.c (eval_init): Register use-syms-as.
* lib.c (use_sym_as): New function, made out of
use_sym.
(use_sym): Now a wrapper for use_sym_as.
* lib.h (use_sym_as): Declared.
* stdlib/package.tl (defpackage): Implement :use-syms-as
clause.
* tests/012/use-as.tl: New file.
* txr.1: Documented,
* stdlib/doc-syms.tl: Updated.
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
| |
* stdlib/op.tl (opip-expand): Take arguments which specify
the op and do operators to be inserted. Pass these
through the recursive calls.
(opip, oand): Pass op and do for the new arguments.
(lopip, loand): New macros like opip and oand, but
passing lop and ldo to the expander.
(lflow): New macro.
* autoload.c (op_set_entries): Add autoload entries
for lopip, loand and lflow.
* tests/012/op.tl: A few new tests.
* txr.1: Documented.
* stdlib/doc-syms.tl: Regenerated.
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
| |
* evalc (macro_k): New keyword symbol variable.
(lexical_binding_kind, lexical_fun_binding_kind)
New functions.
(lexical_var_p): Bugfix: if the symbol is a special
variable, do not short-circuit to a nil answer.
Special variables can be shadowed by symbol macros.
The function is now defined in terms of lexical_binding_kind.
(lexical_symacro_p, lexical_macro_p): New
functions.
(lexical_fun_p): Now defined using lexical_fun_binding_kind.
(lexical_lisp1_binding): Bugfix: check for special
variables; do not report special variables as :var.
(eval_init): Initialize macro_k. Register new intrinsics:
lexical-binding-kind, lexical-fun-binding-kind,
lexical-symacro-p, lexical-macro-p.
* txr.1: Documented.
* stdlib/doc-syms.tl: Updated.
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
| |
* configure: Detect all the new functions, with separate
tests for the unary and binary ones.
* arith.c (cbrt_s, erf_s, erfc_s, exp10_s, exp2_s,
expm1_s, gamma_s, j0_s, j1_s, lgamma_s, log1p_s, logb_s,
nearbyint_s, rint_s, significand_s, tgamma_s, y0_s, y1_s,
copysign_s, drem_s, fdim_s, fmax_s, fmin_s, hypot_s,
jn_s, ldexp_s, nextafter_s, remainder_s, scalb_s, scalbln_s,
yn_s, r_copysign_s, r_drem_s, r_fdim_s, r_fmax_s, r_fmin_s,
hypot_s, r_jn_s, r_ldexp_s, r_nextafter_s, r_remainder_s,
r_scalb_s, scalbln_s, r_yn_s): New symbol variables.
(not_available): New static function.
(cbrt_wrap, erf_wrap, erfc_wrap, exp10_wrap, exp2_wrap,
expm1_wrap, gamma_wrap, j0_wrap, j1_wrap, lgamma_wrap,
log1p_wrap, logb_wrap, nearbyint_wrap, rint_wrap,
significand_wrap, tgamma_wrap, y0_wrap, y1_wrap,
copysign_wrap, drem_wrap, fdim_wrap, fmax_wrap,
fmin_wrap, hypot_wrap, jn_wrap, ldexp_wrap,
nextafter_wrap, remainder_wrap, scalb_wrap, scalbln_wrap,
yn_wrap): New static functions.
(arith_set_entries, arith_instantiate): New static functions.
(arith_init): Initialize symbols and instantiate functions
via autoload mechanism. In a program that doesn't use the
functions, we suffer only the overhead of interning the symbols.
* lib.h (UNUSED): New macro for GCC unused attribute.
* txr.1: Documented.
* stdlib/doc-syms.tl: Updated.
|
|
|
|
|
|
| |
* txr.1: SHA-1 functions documented.
* stdlib/doc-syms.tl: Updated.
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
| |
These functions are useful when sorting a sequence
using an expensive keyfun.
* autoload.c (csort_set_entries, csort_instantiate):
New static functions.
(autlod_init): Register autoloading of csort module
via new functions.
* stdlib/csort.tl: New file.
* tests/012/sort.tl: csort functions included in tests.
* txr.1: Documented.
* stdlib/doc-syms.tl: Updated.
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
| |
hash-map converts a function mapping over a sequence
into a hash table.
* hash.[ch] (hash_map): New function.
* tests/010/hash.tl: Test case.
* genman.txr: The hash-map identifier introduces
a hash collision. We have to deal with that somehow now.
(colli): We put the conflicting entries into a new hash called
colli which maps them to an increment value.
(hash-title): Increment the hash code h by the amount
indicated in colli, if the title is found there.
* txr.1: Documented.
* stdlib/doc-syms.tl: Updated.
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
| |
With this change we fix the bug that the debugger commands
yield their Lisp forms rather than evaluating them.
* eval.c (eval_intrinsic): Takes one more argument,
the macro environment. This is passed into env_to_menv
as the root macro environment.
(eval_init): Update registration of eval intrinsic
to have two optional arguments.
* eval.h (eval_intrinsic): Declaration updated.
* parser.c (read_file_common, read_eval_ret_last): Pass
nil argument to new parameter of eval_intrinsic.
(repl): Pass the env parameter as the new menv
parameter of eval_intrinsic, rather than the existing
env parameter. This fixes the command dispatch in
the debugger, since the command table is consists of
symbol macros, and not variables. For instance the
backtrace command bt is a binding of the bt symbol
to the form (sys:print-backtrace), which has to be
substituted for it and executed. When that envrionment
is used as the ordinary environment, bt looks like
a variable whose value is the list (sys:backtrace).
* parser.y (elem, check_parse_time_action): Fix
eval_intrinsic calls.
* txr.c (txr_main): Likewise.
* txr.1: Documented.
* y.tab.c.shipped: Updated.
* stdlib/doc-syms.tl: Updated.
|
|
|
|
|
|
|
|
|
|
|
|
|
| |
* stdlib/match.tl (match-cond): New macro.
* autoload.c (match_set_entries): match-cond triggers
autoload of match module.
* tests/011/patmatch.tl: Tests.
* txr.1: Documented.
* stdlib/doc.tl: Updated.
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
| |
@(push) is like @(output), but feeds back into input.
Use carefully.
* parser.y (PUSH): New token.
(output_push): New nonterminal symbol.
(output_clause): Handle OUTPUT or PUSH via output_push.
Some logic moved to output_helper.
(output_helper): New function. Transforms both @(output)
and @(push) directives. Checks both for valid keywords;
push has only :filter.
* parser.l (grammar): Recognize @(push similarly to other
directives.
* lib.[ch] (push_s): New symbol variable.
* match.c (v_output_keys): Internal linkage changes to external.
(v_push): New function.
(v_parallel): We must fix the max_line algorithm not to
use an initial value of zero, because lines can go negative
thanks to @(push). We end up rejecting the pushed data.
(v_collect): We can no longer assert that the data line
number doesn't retreat.
(dir_tables_init): Register push directive in table of
vertical directives.
* match.h (append_k, continue_k, finish_k): Existing symbol
variables declared.
(v_output_keys): Declared.
* y.tab.c.shipped,
* y.tab.h.shipped,
* lex.yy.c.shipped: Updated.
* txr.1: Documented.
* stdlib/doc-syms.tl: Updated.
|
|
|
|
|
|
|
|
|
|
|
| |
* lib.[ch] (keep_keys_if, separate_keys): New functions.
* eval.c (eval_init): keep-keys-if, separate-keys intrinsics
registered.
* txr.1: Documented.
* stdlib/doc-syms.tl: Updated.
|
|
|
|
|
|
|
|
|
|
|
|
| |
* autoload.c (load_args_set_entries, load_args_instantiate):
New static functions.
(autoload_init): Register new auto-loaded module "load-args".
* stdlib/load-args.tl: New file.
* txr.1: Documented.
* stdlib/doc-syms.tl: Updated.
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
| |
This function simplifies cleaning, by allowing a file to
be cleaned to be identified in much the same way as an input
file to load or compile-file.
* autoload.c (compiler_set_entries): The clean-file symbol
is interned and becomes an autoload trigger for the
compiler module.
* stdlib/compiler.tl (clean-file): New function.
* txr.1: Documented.
* stdlib/doc-syms.tl: Updated.
|
|
|
|
|
|
|
|
|
|
|
|
|
| |
* stdlib/expander-let.tl: New file.
* autoload.c (expander_let_set_entries, expander_let_instantiate);
New static functions.
(autoload_init): Register autoloading of above new file via
above new functions.
* txr.1: Documented.
* stdlib/doc-syms.tl: Updated.
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
| |
* eval.c (compiler_let_s): New symbol variable.
(op_let): Recognize compiler-let for sequential
binding.
(do_expand): Traverse and diagnose compiler-let
form.
(eval_init): Initialize compiler_let_s and register
the interpreted version of the operator.
* stdlib/compiler.tl (compiler compile): Handle
compiler-let form.
(compiler comp-compiler-let): New method.
(no-dvbind-eval): New function.
* autoload.c (compiler-set-entries): Intern the
compiler-let symbol in the user package.
* txr.1: Documented.
* stdlib/doc-syms.tl: Updated.
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
| |
Adding a progv operator, similar to the Common Lisp one.
* eval.c (progv_s): New symbol variable.
(op_progv): New static function.
(do_expand): Recognize and traverse the progv form.
(rt_progv): New static function: run-time support
for compiled progv.
(eval_init): Initialize progv_s, and register the the
op_progv operator interpreting function.
* stdlib/compilert (compiler compile): Handle progv
operator ...
(compiler comp-progv): ... via this new method.
* tests/019/progv.tl: New file.
* txr.1: Documented.
* stdlib/doc-syms.tl: Updated.
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
| |
For array-like objecgts, these objects use an
array-based merge sort, using an auxiliary array
equal in size to the original array.
To provide the auxiliary array, a new kind of very simple
vector-like object is introduced into the gc module: protected
array. This looks like a raw dynamic C array of val type,
returned as a val *. Under the hood, there is a heap object
there, which makes the array traversable by the garbage
collector.
The whole point of this exercise is to make the new mergesort
function safe even if the caller-supplied functions misbehave
in such a way that the auxiliary array holds the only
references to heap objects.
* gc.c (struct prot_array): New struct,
(prot_array_cls): New static variable.
(gc_late_init): Register COBJ class, retaining in
prot_array_cls.
(prot_array_mark, prot_array_free): New static functions.
(prot_array_ops): New static structure.
(prot_array_alloc, prot_array_free): New functions.
* gc.h (prot_array_alloc, prot_array_free): Declared.
* lib.c (mergesort, ssort_vec): New static function.
(snsort, ssort): New functions.
* lib.h (snsort, ssort): Declared.
* tests/010/sort.tl: Cover ssort.
* txr.1: Documented.
* stdlib/doc-syms.tl: Updated.
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
| |
We don't have a function in the hash table module which can
create a populated hash table in one step without requiring
the caller to create auxiliary lists. This new function fills
that gap, albeit with some limitations.
* hash.c (hash_props): New function.
(hash_init): Register hash-props intrinsic.
* tests/010/hash.tl: New tests.
* txr.1: Documented.
* stdlib/doc-syms.tl: Updated.
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
| |
* time.c (time_str_local, time_str_utc): New static functions.
(time_fields_local, time_fields_utc, time_struct_local,
time_struct_utc): Time argument
becomes optional, defaulted to current time.
(time_init): Use time_s symbol instead of interning
twice. Register new time-str-local and time-str-utc
intrinsics. Fix registration of functions that take
optional args.
* txr.1: New functions documented; optional arguments
documented; existing documentation revised.
* stdlib/doc-syms.tl: Updated.
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
| |
* stdlib/optimize.tl (basic-blocks peephole-block): Drop the
code argument, and operate on bl.insns, which is stored
back. Perform the renames in the rename list after the
peephole pass.
(basic-blocks rename): New method.
(basic-blocks do-peephole-block): Implementation of
peephole-block, under a new name. The local function called
rename is removed; calls to it go to the new rename method.
(basic-blocks peephole): Simplify code around calls to
peephole-block; we no longer have to pass bl.insns to it,
capture the return value and store it back into bl.insns.
* stdlib/compiler.tl (*opt-level*): Initial
value changes from 6 to 7.
(compiler optimize): At optimization level 6,
we now do another jump threading pass, and
peephole, like at levels 4 and 5. The peephole
optimizations at level 5 make it possible
to coalesce some basic blocks in some cases,
and that opens up the possibility for more
reductions. The previously level 6 optimizations
are moved to level 7.
* txr.1: Updated documentation of optimization levels,
and default value of *opt-level*.
* stdlib/doc-syms.tl: Updated.
|
|
|
|
|
|
|
| |
* txr.1: Fix compiler-opts, *compiler-opts* and
with-compiler-opts to the correct "compile".
* stdlib/doc-syms.tl: Updated.
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
| |
* lib.h (arithp): Declared.
(plus_s): Existing symbol declared.
* arith.c (arithp): New function.
* struct.h (special_slot): New enum member plus_m.
* struct.c (special_sym): Register plus_s together as
the [plus_m] entry of the array.
* tests/016/arith.tl
* tests/016/ud-arith.tl: Tests for arithp.
* txr.1: Documented.
* stdlib/doc-syms.tl: Updated.
|
|
|
|
|
|
|
|
|
|
| |
* stdlib/compiler.tl (sys:env shadow-fun): Also diagnose
if a global macro is shadowed.
* txr.1: Documented compiler-opts structure, *compiler-opts*
variable and with-compiler-opts macro.
* stdlib/doc-syms.tl: Updated.
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
| |
This will be an official mechanism for indicating
deliberately unused variables.
* eval.c (eval_init): Register ignore intrinsic,
binding to the same function object as nilf.
* stdlib/compiler.tl (%const-foldable-funs%): Mention
ignore function, next to its nilf synonym.
* txr.1: Documented.
* stdlib/doc-syms.tl: Updated.
|
|
|
|
|
|
|
|
|
|
|
|
| |
* txr.1: The functions -, + and * are documented together,
but the section heading only mentions + and -.
This was introduced when these functions were documented
for the first time in March 2012, in commit
6363875356bc050ef81d40553e573fc47aca2e28, and
then went unnoticed for almost eleven years in spite
of the heading undergoing relocation and reformatting.
* stdlib/doc-syms.tl: Updated.
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
| |
The res variable captures the specific value of the
condition expression, making it available to the action.
* autoload.c (awk_set_entries): Intern the res symbol
* stdlib/awk.tl (awk): Instead of generating the condition-action
into a simple when, we use whenlet to also bind the res variable.
* tests/015/awk-res.tl: New file.
* txr.1: Documented.
* stdlib/doc-syms.tl: Updated.
|
|
|
|
|
|
|
| |
* txr.1: *define-struct-prelude* should of course be
define-struct-prelude.
* stdlib/doc-syms.tl: Updated.
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
| |
A struct prelude definition associates one or more
future defstruct (by struct name) with clauses which
are implicitly inserted into the defstruct.
It is purely a macro-time construct, customizing the
expansion behavior of defstruct.
* stdlib/struct.tl (*struct-prelude, *struct-prelude-alists*):
New special variables holding hash tables.
(defstruct): Before processing slot-specs, augment it with
the contents of the prelude definitions associated with
this struct name.
(define-struct-prelude): New macro.
* autoload.c (struct_set_entries): define-struct-prelude
is interned and triggers autoload of struct module.
* tests/012/oop-prelude.tl: New file.
* tests/012/oop-prelude.expected: Likewise.
* txr.1: Documented.
* stdlib/doc-syms.tl: Updated.
|
|
|
|
|
|
|
|
|
|
|
| |
* stdlib/struct.tl (macroexpand-struct-clause): New function.
* autoload.c (struct_set_entries): Autoload struct module
on macroexpand-struct-clause.
* txr.1: Documented.
* stdlib/doc-syms.tl: Updated.
|
|
|
|
|
|
|
|
|
|
|
| |
* stdlib/match.tl (macroexpand-match): New function.
* autoload.c (match_set_entries): Autoload match
module on macroexpand-match.
* txr.1: Documented.
* stdlib/doc-syms.tl: Updated.
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
| |
* stdlib/place.tl (sys:pl-expand): Function renamed to
macroexpand-place; env parameter becomes optional.
(macroexpand-1-place): New function.
(place-form-p, call-update-expander, call-clobber-expander,
call-delete-expander): Follow rename.
* autoload.c (place_set_entries): Register symbols
macroexpand-place and macroexpand-1-place for autoload.
* txr.1: Documented.
* stdlib/doc-syms.tl: Updated.
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
| |
* stdlib/pmac.tl (macroexpand-params): New function,
implemented using newly exposed sys:expand-param-macro.
* autoload.c (pmac_set_entries): Trigger pmac.tl autload
on macroexpand-params symbol.
* eval.c (eval_init): Register existing expand_param_macro
function as sys:expand-param-macro.
* txr.1: Documented.
* stdlib/doc-syms.tl: Updated.
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
| |
* stream.c (standard_k, print_json_format_s):
New symbol variables.
(stream_init): New variables initialized.
* stream.h (enum json_fmt): New enum.
(standard_k, print_json_format_s): Declared.
* lib.c (out_json_rec): Take enum json_fmt param,
and pass it recursively. Printing for vector and
dictionaries reacts to argument value.
(out_json, put_json): Examine value of special
var *print-json-format* and calculate enum json_fmt
value from this. Pass to out_json_rec.
* txr.1: Documented.
* stdlib/doc-syms.tl: Updated.
|
|
|
|
|
|
|
|
|
|
|
| |
* stream.c (inc_indent_abs): New function.
(stream_init): inc-init-abs intrinsic registered.
* stream.h (inc_indent_abs): Declared.
* txr.1: Documented.
* stdlib/doc-syms.tl: Updated.
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
| |
* eval.c (pct_fun_s): New symbol variable, holding
the usr:%fun% symbol.
(fun_macro_env): New static function.
(do_expand): For defun and defmacro, use fun_macro_env
to establish an environment binding the %fun% symbol
macro, and expand everything in that environment.
(eval_init): Intern the %fun% symbol, initializing
pct_fun_s, and also register a global symbol macro in
that name so that we can freely use %fun% everywhere
without worrying that the code will blow up.
E.g. a logging macro can use it to get the function name,
but still be useful in a top-level form outside of
a named function.
* stdlib/struct.tl (sys:meth-lambda): New macro.
(defstruct, defmeth): Use sys:meth-lambda as a replacement
for lambda to set up the %fun% symbol macro. In the :init
case which doesn't use a lambda, an open-coded symacrolet
does the job.
* tests/019/pct-fun.tl: New file.
* tests/019/pct-fun.expected: Likewise.
* txr.1: Documented.
* stdlib/doc-syms.tl: Updated.
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
| |
* socket.c (sock_set_entries): Intern str-addr symbol.
There is no autoload on this because the struct types of
which this is a method don't exist if the socket
module has not been loaded.
* stdlib/socket.tl ((sockaddr-in str-addr), (sockaddr-in6
str-addr), (sockaddr-un str-addr)): New methods.
* tests/014/str-addr.tl: New file. This provides
coverage not just for the str-addr method, but the
hitherto untested address to text functions.
This is why the bug was found, that was addressed
in the previous commit. The test case which produces
"8000::1" was actually producing "800:1".
* txr.1: Documented.
* stdlib/doc-syms.tl: Updated.
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
| |
This function "intelligently" constructs an
address object of the right type from a string.
* socket.c (sock_set_entries): Autoload socket.tl
on sockaddr-str function being accessed.
* stdlib/socket.tl (sockaddr-str): New function.
* tests/014/sockaddr-str.tl: New file.
* txr.1: Documented.
* stdlib.doc-syms.tl: Updated.
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
| |
* lib.c (lazy_stream_s): New symbol variable.
(lazy_streams_binding): New static variable.
(lazy_stream_register): New static function
(lazy_stream_cons): If the stream is associated with
a lazy cons, register it with lazy_stream_register.
(obj_init): gc-protect lazy_streams_binding variable.
Intern the sys:*lazy-streams* symbol.
* lib.h (lazy_streams_s): Declared.
* eval.c (eval_init): Register sys:*lazy-streams*
special variable.
* stdlib/getput.tl (close-lazy-streams): New macro.
* autoload.c (getput_set_entries): Trigger autload on
close-lazy-streams symbol.
* txr.1: Documented.
* stdlib/doc-syms.tl: Updated.
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
| |
* eval.c (eval_init): search-all intrinsic registered.
* lib.c (search_common): New Boolean argument all,
indicating whether all positions are to be returned.
We must handle this in the two places where empty
key and sequence are handled, and also in the main loop.
A trick is used: the found variable is now bound by
list_collect_decl, but not used for collecting unless
all is true.
(search, rsearch, contains): Pass 0 for all argument
of search_common.
(search_all): New function.
* lib.h (search_all): Declared.
* tests/012/seq.tl: New tests.
* txr.1: Documented.
* stdlib/doc-syms.tl: Regenerated.
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
| |
* autoload.c (path_test_set_entries): Autoload on
path-components-safe symbol.
* stdlib/path-test.tl (if-windows, if-native-windows):
New system macros.
(path-safe-sticky-dir): New system function.
(path-components-safe): New function.
* tests/018/path-safe.tl: New file.'
* txr.1: Documented.
* stdlib/doc-syms.tl: Updated.
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
| |
The general count function, with keyfun and testfun,
is noticeably absent. Let's implement it.
* lib.[ch] (count): New function.
* eval.c (eval_init): Register count intrinsic.
* tests/012/seq.tl: Some tests for count.
* txr.1: Add count to count-if section. Revise documentation
based on pos/pos-if.
* stdlib/doc-syms.tl: Updated.
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
| |
* eval.c (me_for): Require at least one argument.
However, we let the init-forms continue to be optional
and document it.
* txr.1: Refer to for and for* as macros, since they have been
since 2016. The omission of the inc-form list is shown
as a second variant of the syntax. This is to avoid misleading
the reader into thinking that the the inc-form list can be
omitted while body forms are present. A spurious paragraph
reiterating that the macros establish an anonymous block is
removed. That extra text was present in the first draft written
in 2011, and maintained since.
* stdlib/doc-syms.tl: Updated.
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
| |
The str function is like mkstring but allows a fill pattern
to be specified.
* eval.c (eval_init): str intrinsic registered.
* lib.[ch[ (str): New function.
* tests/015/str.tl: New file.
* txr.1: Documented.
* stdlib/doc-syms.tl: Updated.
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
| |
Instead of trying to work the new count parameter into the spl and
tok functions, it's better to make new ones.
* eval.c (eval_init): spln and tokn intrinsics registered.
* lib.[ch] (spln, tokn): New functions.
* tests/015/split.tl: New test cases.
* txr.1: Documented.
* stdlib/doc-syms.tl: Updated.
|
|
|
|
|
|
|
|
|
| |
* buf.c (buf_compress, buf_decompress): New static functions.
(buf_init): buf-compress and buf-decompress intrinsics registered.
* txr.1: Documented.
* stdlib/doc-syms.tl: Updated.
|
|
|
|
|
|
|
|
|
|
|
|
|
| |
* stream.c (trim_path_seps): New function.
(stream_init): trim-path-seps intrinsic registered.
* stream.c (trim_path_seps): Declared.
* tests/018/path.tl: New tests.
* txr.1: Documented.
* stdlib/doc-syms.tl: Updated.
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
| |
* ffi.c (pack_s): New symbol variable.
(ffi_type_compile): Handle new pack type operator together with
align. Allow a one-argument form of align and pack in which
the value is defaulted. The behavior of align changes: align
can only increase alignment now, never decrease, so for
instance (align 1 ...) does nothing. pack must be used to
decrease alignment. Furthermore, for certain argument types,
pack performs transformations of the type syntax, rather than
compiling the argument type and producing a variant of it with
altered alignment.
* txr.1: Documented.
* stdlib/doc-syms.tl: Updated.
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
| |
* eval.c (load_search_dirs_s): New symbol variable.
(load): Initialize the name variable whose address is passed
as the third argument of open_txr_file, which is now
an in-out parameter. Pass t for the new search_dirs parameter,
so that load benefits from the searching.
(eval_init): Initialize load_search_dirs_s and register the
*load-search-dirs* special variable.
* eval.h (load_search_dirs_s): Declared.
(load_search_dirs): New macro.
* match.c (v_load): Initialize the variable passed as third argument
of open_txr_file.
* parser.c (open_txr_file): Take a new argument, search_dirs.
If this is t, it tells the function "if the path is not found,
then recurse on the *load-search-dirs* variable. Otherwise,
if the value is not t, it is a list of the remaining directories
to try. The existing parameter orig_in_resolved_out must now
point to a location which is initialized. It is assumed to hold
the original target that was passed to the load function.
The first_try_path is a the path to actually try, derived from
that one. Thus, the caller of open_txr_file gets to determine
the initial try path using its own algorithm. Then any recursive
calls that go through *load-search-dirs* will pass a first argument
which is made of the original name, combined with a search dir.
(load_rcfile): Pass pointer to initialized location as third
argument of open-txr_file, and pass a nil value for search_dirs:
no search takes place when looking for that file, which is at a
single, fixed location.
* parser.h (open_txr_file): Declaration updated.
* txr.c (sysroot_init): Initialize *load-search-dirs*.
(txr_main): Ensure third argument in all calls to open_txr_file
points to initialized variable, with the correct value,
and pass t for the search_dirs argument.
* txr.1: Documented.
* stdlib/doc-syms.tl: Updated.
New: load can search multiple directories.
* eval.c (load_search_dirs_s): New symbol variable.
(load): Initialize the name variable whose address is passed as
the third argument of open_txr_file, which is now an in-out
parameter. Pass t for the new search_dirs parameter, so that
load benefits from the searching.
(eval_init): Initialize load_search_dirs_s and register the
*load-search-dirs* special variable.
* eval.h (load_search_dirs_s): Declared.
(load_search_dirs): New macro.
* match.c (v_load): Initialize the variable passed as third
* argument
of open_txr_file.
* parser.c (open_txr_file): Take a new argument, search_dirs.
If this is t, it tells the function "if the path is not found,
then recurse on the *load-search-dirs* variable. Otherwise, if
the value is not t, it is a list of the remaining directories
to try. The existing parameter orig_in_resolved_out must now
point to a location which is initialized. It is assumed to hold
the original target that was passed to the load function. The
first_try_path is a the path to actually try, derived from that
one. Thus, the caller of open_txr_file gets to determine the
initial try path using its own algorithm. Then any recursive
calls that go through *load-search-dirs* will pass a first
argument which is made of the original name, combined with a
search dir.
(load_rcfile): Pass pointer to initialized location as third
argument of open-txr_file, and pass a nil value for
search_dirs: no search takes place when looking for that file,
which is at a single, fixed location.
* parser.h (open_txr_file): Declaration updated.
* txr.c (sysroot_init): Initialize *load-search-dirs*.
(txr_main): Ensure third argument in all calls to open_txr_file
points to initialized variable, with the correct value, and
pass t for the search_dirs argument.
* txr.1: Documented.
* stdlib/doc-syms.tl: Updated.
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
| |
* eval.c (eval_init): Register isecp intrinsic.
* lib.c (isecp): New function.
* lib.h (isecp): Declared.
* stdlib/compiler.tl (lambda-apply-transform,
dump-compiled-objects): Use isecp instead of isec, since the
actual intersection of symbols isn't needed, only whether it
exists.
* txr.1: Documented.
* stdlib/doc-syms.tl: Updated.
|