summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
-rw-r--r--ChangeLog15
-rw-r--r--eval.c4
-rw-r--r--eval.h2
-rw-r--r--genvim.txr4
-rw-r--r--stream.c27
-rw-r--r--txr.143
-rw-r--r--txr.vim141
7 files changed, 161 insertions, 75 deletions
diff --git a/ChangeLog b/ChangeLog
index 647efb68..d7521c86 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,5 +1,20 @@
2014-03-06 Kaz Kylheku <kaz@kylheku.com>
+ * eval.c (apply_intrinsic, lazy_mapcar): Changed linkage to external.
+
+ * eval.h (apply_intrinsic, lazy_mapcar): Declarations added.
+
+ * stream.c (open_files, open_file_star): New functions.
+ (stream_init): Registered new functions as intrinsics.
+
+ * txr.1: Documented open-files and open-files*. Added to make-catenated-stream documentation.
+
+ * genvim.txr: Replace bunch of code with open-files.
+
+ * txr.vim: Regenerated.
+
+2014-03-06 Kaz Kylheku <kaz@kylheku.com>
+
* match.c (match_files): Fix it again. The data (nil)
can occur from an interactive/real-time stream.
diff --git a/eval.c b/eval.c
index 00b448ce..6e3ff5ac 100644
--- a/eval.c
+++ b/eval.c
@@ -651,7 +651,7 @@ static val apply_frob_args(val args)
}
}
-static val apply_intrinsic(val fun, val args)
+val apply_intrinsic(val fun, val args)
{
return apply(fun, apply_frob_args(args), cons(apply_s, nil));
}
@@ -2661,7 +2661,7 @@ static val lazy_mapcar_func(val env, val lcons)
return nil;
}
-static val lazy_mapcar(val fun, val list)
+val lazy_mapcar(val fun, val list)
{
if (!list)
return nil;
diff --git a/eval.h b/eval.h
index d51c5953..a46d2a9a 100644
--- a/eval.h
+++ b/eval.h
@@ -39,6 +39,7 @@ val interp_fun(val env, val fun, val args);
void reg_var(val sym, val val);
void reg_fun(val sym, val fun);
val apply(val fun, val arglist, val ctx_form);
+val apply_intrinsic(val fun, val args);
val eval_progn(val forms, val env, val ctx_form);
val eval(val form, val env, val ctx_form);
val eval_intrinsic(val form, val env);
@@ -46,6 +47,7 @@ val expand(val form, val menv);
val expand_forms(val forms, val menv);
val bindable(val obj);
val mapcarv(val fun, val list_of_lists);
+val lazy_mapcar(val fun, val list);
val generate(val while_pred, val gen_fun);
void eval_init(void);
diff --git a/genvim.txr b/genvim.txr
index 00d3506e..b9d6b816 100644
--- a/genvim.txr
+++ b/genvim.txr
@@ -7,9 +7,7 @@ static void dir_tables_init(void)
@(until)
}
@(end)
-@(next @[apply make-catenated-stream
- [mapcar open-file '("eval.c" "rand.c" "signal.c"
- "stream.c" "syslog.c" "txr.c")]])
+@(next @(open-files '("eval.c" "rand.c" "signal.c" "stream.c" "syslog.c" "txr.c")))
@(collect)
@ (block)
@ (cases)
diff --git a/stream.c b/stream.c
index 414e840e..912e6a80 100644
--- a/stream.c
+++ b/stream.c
@@ -2555,6 +2555,31 @@ val readlink_wrap(val path)
#endif
+static val open_files(val file_list, val substitute_stream)
+{
+ substitute_stream = default_bool_arg(substitute_stream);
+
+ if (nilp(file_list) && substitute_stream) {
+ return substitute_stream;
+ } else {
+ return apply_intrinsic(func_n0v(make_catenated_stream),
+ cons(mapcar(func_n2o(open_file, 1), file_list), nil));
+
+ }
+}
+
+static val open_files_star(val file_list, val substitute_stream)
+{
+ substitute_stream = default_bool_arg(substitute_stream);
+
+ if (nilp(file_list) && substitute_stream) {
+ return substitute_stream;
+ } else {
+ return apply_intrinsic(func_n0v(make_catenated_stream),
+ cons(lazy_mapcar(func_n2o(open_file, 1), file_list), nil));
+ }
+}
+
#endif
void stream_init(void)
@@ -2704,4 +2729,6 @@ void stream_init(void)
reg_fun(intern(lit("open-process"), user_package), func_n3o(open_process, 2));
reg_fun(intern(lit("remove-path"), user_package), func_n1(remove_path));
reg_fun(intern(lit("rename-path"), user_package), func_n2(rename_path));
+ reg_fun(intern(lit("open-files"), user_package), func_n2o(open_files, 1));
+ reg_fun(intern(lit("open-files*"), user_package), func_n2o(open_files_star, 1));
}
diff --git a/txr.1 b/txr.1
index 3163d31f..59969354 100644
--- a/txr.1
+++ b/txr.1
@@ -11799,6 +11799,49 @@ Note that the operations can fail due to being unsupported. It is
the caller's responsibility to make sure all of the streams in the list
are compatible with the intended operations.
+If the stream list is empty then an empty catenated stream is produced.
+Input operations on this stream yield nil, and the unget-char
+and unget-byte operations throw an exception.
+
+.SS Functions open-files and open-files*
+
+.TP
+Syntax:
+
+ (open-files <path-list> [<alternative-stream>])
+ (open-files* <path-list> [<alternative-stream>])
+
+.TP
+Description:
+
+The open-files and open-files* functions create a list of streams by invoking the open-file
+function on each element of <path-list>. These streamas are turned into a catenated
+stream as if applied as arguments to make-catenated-stream.
+
+The effect is that multiple files appear to be catenated together into a single
+input stream.
+
+If the optional <alternative-stream> argument is supplied, then if <path-list> is empty,
+that argument is returned instead of an empty catenated stream.
+
+The difference between open-files and open-files* is that open-files creates all of the
+streams up-front. So if any of the paths cannot be opened, the operation throws.
+The open-files* variant is lazy: it creates a lazy list of streams out of the
+path list. The streams are opened as needed: before the second stream is opened,
+the program has to read the first stream to the end, and so on.
+
+.TP
+Example:
+
+Collect lines from all files that are given as arguments on the command line. If
+there are no files, then read from standard input:
+
+ @(next @(open-files *args* *stdin*))
+ @(collect)
+ @line
+ @(end)
+
+
.SS Function read
.TP
diff --git a/txr.vim b/txr.vim
index 22f67e6b..bae35aa1 100644
--- a/txr.vim
+++ b/txr.vim
@@ -94,76 +94,77 @@ syn keyword txl_keyword contained log-authpriv log-cons log-crit log-daemon
syn keyword txl_keyword contained log-debug log-emerg log-err log-info
syn keyword txl_keyword contained log-ndelay log-notice log-nowait log-odelay
syn keyword txl_keyword contained log-perror log-pid log-user log-warning
-syn keyword txl_keyword contained logand logior lognot logtest
-syn keyword txl_keyword contained logtrunc logxor macro-form-p macro-time
-syn keyword txl_keyword contained macroexpand macroexpand-1 macrolet major
-syn keyword txl_keyword contained make-catenated-stream make-env make-hash make-lazy-cons
-syn keyword txl_keyword contained make-package make-random-state make-similar-hash make-string-byte-input-stream
-syn keyword txl_keyword contained make-string-input-stream make-string-output-stream make-strlist-output-stream make-sym
-syn keyword txl_keyword contained make-time make-time-utc makedev mapcar
-syn keyword txl_keyword contained mapcar* maphash mappend mappend*
-syn keyword txl_keyword contained mask match-fun match-regex match-regex-right
-syn keyword txl_keyword contained match-str match-str-tree max memq
-syn keyword txl_keyword contained memql memqual merge min
-syn keyword txl_keyword contained minor mkdir mknod mkstring
-syn keyword txl_keyword contained mod multi-sort n-choose-k n-perm-k
-syn keyword txl_keyword contained none not nreverse null
-syn keyword txl_keyword contained num-chr num-str numberp oddp
-syn keyword txl_keyword contained op open-command open-directory open-file
-syn keyword txl_keyword contained open-pipe open-process open-tail openlog
-syn keyword txl_keyword contained or orf packagep perm
-syn keyword txl_keyword contained pop pos pos-if posq
-syn keyword txl_keyword contained posql posqual pprinl pprint
-syn keyword txl_keyword contained prinl print prog1 progn
-syn keyword txl_keyword contained prop proper-listp push pushhash
-syn keyword txl_keyword contained put-byte put-char put-line put-string
-syn keyword txl_keyword contained pwd qquote quasi quote
-syn keyword txl_keyword contained rand random random-fixnum random-state-p
-syn keyword txl_keyword contained range range* rcomb read
-syn keyword txl_keyword contained readlink real-time-stream-p reduce-left reduce-right
-syn keyword txl_keyword contained ref refset regex-compile regex-parse
-syn keyword txl_keyword contained regexp regsub rehome-sym remhash
-syn keyword txl_keyword contained remove-if remove-if* remove-path remq
-syn keyword txl_keyword contained remq* remql remql* remqual
-syn keyword txl_keyword contained remqual* rename-path repeat replace
-syn keyword txl_keyword contained replace-list replace-str replace-vec rest
-syn keyword txl_keyword contained return return-from reverse rlcp
-syn keyword txl_keyword contained rperm rplaca rplacd s-ifblk
-syn keyword txl_keyword contained s-ifchr s-ifdir s-ififo s-iflnk
-syn keyword txl_keyword contained s-ifmt s-ifreg s-ifsock s-irgrp
-syn keyword txl_keyword contained s-iroth s-irusr s-irwxg s-irwxo
-syn keyword txl_keyword contained s-irwxu s-isgid s-isuid s-isvtx
-syn keyword txl_keyword contained s-iwgrp s-iwoth s-iwusr s-ixgrp
-syn keyword txl_keyword contained s-ixoth s-ixusr search-regex search-str
-syn keyword txl_keyword contained search-str-tree second seek-stream set
-syn keyword txl_keyword contained set-diff set-hash-userdata set-sig-handler sethash
-syn keyword txl_keyword contained setlogmask sig-abrt sig-alrm sig-bus
-syn keyword txl_keyword contained sig-check sig-chld sig-cont sig-fpe
-syn keyword txl_keyword contained sig-hup sig-ill sig-int sig-io
-syn keyword txl_keyword contained sig-iot sig-kill sig-lost sig-pipe
-syn keyword txl_keyword contained sig-poll sig-prof sig-pwr sig-quit
-syn keyword txl_keyword contained sig-segv sig-stkflt sig-stop sig-sys
-syn keyword txl_keyword contained sig-term sig-trap sig-tstp sig-ttin
-syn keyword txl_keyword contained sig-ttou sig-urg sig-usr1 sig-usr2
-syn keyword txl_keyword contained sig-vtalrm sig-winch sig-xcpu sig-xfsz
-syn keyword txl_keyword contained sin sixth size-vec some
-syn keyword txl_keyword contained sort source-loc source-loc-str span-str
-syn keyword txl_keyword contained splice split-str split-str-set sqrt
-syn keyword txl_keyword contained stat stream-get-prop stream-set-prop streamp
-syn keyword txl_keyword contained string-cmp string-extend string-lt stringp
-syn keyword txl_keyword contained sub sub-list sub-str sub-vec
-syn keyword txl_keyword contained symacrolet symbol-function symbol-name symbol-package
-syn keyword txl_keyword contained symbol-value symbolp symlink sys-qquote
-syn keyword txl_keyword contained sys-splice sys-unquote syslog tan
-syn keyword txl_keyword contained third throw throwf time
-syn keyword txl_keyword contained time-fields-local time-fields-utc time-string-local time-string-utc
-syn keyword txl_keyword contained time-usec tok-str tostring tostringp
-syn keyword txl_keyword contained tree-bind tree-case tree-find trim-str
-syn keyword txl_keyword contained trunc typeof unget-byte unget-char
-syn keyword txl_keyword contained unquote upcase-str update url-decode
-syn keyword txl_keyword contained url-encode usleep uw-protect vec
-syn keyword txl_keyword contained vec-push vec-set-length vecref vector
-syn keyword txl_keyword contained vector-list vectorp with-saved-vars zerop
+syn keyword txl_keyword contained log10 logand logior lognot
+syn keyword txl_keyword contained logtest logtrunc logxor macro-form-p
+syn keyword txl_keyword contained macro-time macroexpand macroexpand-1 macrolet
+syn keyword txl_keyword contained major make-catenated-stream make-env make-hash
+syn keyword txl_keyword contained make-lazy-cons make-package make-random-state make-similar-hash
+syn keyword txl_keyword contained make-string-byte-input-stream make-string-input-stream make-string-output-stream make-strlist-output-stream
+syn keyword txl_keyword contained make-sym make-time make-time-utc makedev
+syn keyword txl_keyword contained mapcar mapcar* maphash mappend
+syn keyword txl_keyword contained mappend* mask match-fun match-regex
+syn keyword txl_keyword contained match-regex-right match-str match-str-tree max
+syn keyword txl_keyword contained memq memql memqual merge
+syn keyword txl_keyword contained min minor mkdir mknod
+syn keyword txl_keyword contained mkstring mod multi-sort n-choose-k
+syn keyword txl_keyword contained n-perm-k none not nreverse
+syn keyword txl_keyword contained null num-chr num-str numberp
+syn keyword txl_keyword contained oddp op open-command open-directory
+syn keyword txl_keyword contained open-file open-files open-files* open-pipe
+syn keyword txl_keyword contained open-process open-tail openlog or
+syn keyword txl_keyword contained orf packagep perm pop
+syn keyword txl_keyword contained pos pos-if posq posql
+syn keyword txl_keyword contained posqual pprinl pprint prinl
+syn keyword txl_keyword contained print prog1 progn prop
+syn keyword txl_keyword contained proper-listp push pushhash put-byte
+syn keyword txl_keyword contained put-char put-line put-string pwd
+syn keyword txl_keyword contained qquote quasi quote rand
+syn keyword txl_keyword contained random random-fixnum random-state-p range
+syn keyword txl_keyword contained range* rcomb read readlink
+syn keyword txl_keyword contained real-time-stream-p reduce-left reduce-right ref
+syn keyword txl_keyword contained refset regex-compile regex-parse regexp
+syn keyword txl_keyword contained regsub rehome-sym remhash remove-if
+syn keyword txl_keyword contained remove-if* remove-path remq remq*
+syn keyword txl_keyword contained remql remql* remqual remqual*
+syn keyword txl_keyword contained rename-path repeat replace replace-list
+syn keyword txl_keyword contained replace-str replace-vec rest return
+syn keyword txl_keyword contained return-from reverse rlcp rperm
+syn keyword txl_keyword contained rplaca rplacd s-ifblk s-ifchr
+syn keyword txl_keyword contained s-ifdir s-ififo s-iflnk s-ifmt
+syn keyword txl_keyword contained s-ifreg s-ifsock s-irgrp s-iroth
+syn keyword txl_keyword contained s-irusr s-irwxg s-irwxo s-irwxu
+syn keyword txl_keyword contained s-isgid s-isuid s-isvtx s-iwgrp
+syn keyword txl_keyword contained s-iwoth s-iwusr s-ixgrp s-ixoth
+syn keyword txl_keyword contained s-ixusr search-regex search-str search-str-tree
+syn keyword txl_keyword contained second seek-stream set set-diff
+syn keyword txl_keyword contained set-hash-userdata set-sig-handler sethash setlogmask
+syn keyword txl_keyword contained sig-abrt sig-alrm sig-bus sig-check
+syn keyword txl_keyword contained sig-chld sig-cont sig-fpe sig-hup
+syn keyword txl_keyword contained sig-ill sig-int sig-io sig-iot
+syn keyword txl_keyword contained sig-kill sig-lost sig-pipe sig-poll
+syn keyword txl_keyword contained sig-prof sig-pwr sig-quit sig-segv
+syn keyword txl_keyword contained sig-stkflt sig-stop sig-sys sig-term
+syn keyword txl_keyword contained sig-trap sig-tstp sig-ttin sig-ttou
+syn keyword txl_keyword contained sig-urg sig-usr1 sig-usr2 sig-vtalrm
+syn keyword txl_keyword contained sig-winch sig-xcpu sig-xfsz sin
+syn keyword txl_keyword contained sixth size-vec some sort
+syn keyword txl_keyword contained source-loc source-loc-str span-str splice
+syn keyword txl_keyword contained split-str split-str-set sqrt stat
+syn keyword txl_keyword contained stream-get-prop stream-set-prop streamp string-cmp
+syn keyword txl_keyword contained string-extend string-lt stringp sub
+syn keyword txl_keyword contained sub-list sub-str sub-vec symacrolet
+syn keyword txl_keyword contained symbol-function symbol-name symbol-package symbol-value
+syn keyword txl_keyword contained symbolp symlink sys-qquote sys-splice
+syn keyword txl_keyword contained sys-unquote syslog tan third
+syn keyword txl_keyword contained throw throwf time time-fields-local
+syn keyword txl_keyword contained time-fields-utc time-string-local time-string-utc time-usec
+syn keyword txl_keyword contained tok-str tostring tostringp tree-bind
+syn keyword txl_keyword contained tree-case tree-find trim-str trunc
+syn keyword txl_keyword contained typeof unget-byte unget-char unquote
+syn keyword txl_keyword contained upcase-str update url-decode url-encode
+syn keyword txl_keyword contained usleep uw-protect vec vec-push
+syn keyword txl_keyword contained vec-set-length vecref vector vector-list
+syn keyword txl_keyword contained vectorp with-saved-vars zerop
syn match txr_error "@[\t ]*[*]\?[\t ]*."
syn match txr_nested_error "[^\t `]\+" contained