summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorKaz Kylheku <kaz@kylheku.com>2014-10-21 06:56:53 -0700
committerKaz Kylheku <kaz@kylheku.com>2014-10-21 06:56:53 -0700
commitf9d4303ea0875da3feba4b5eb0dd372b676b8652 (patch)
tree2b180a51b214f57562ab4b82a38538b174137842
parent81f7dcca6528252c1f0a57d3b5581c628efa4bf1 (diff)
downloadtxr-f9d4303ea0875da3feba4b5eb0dd372b676b8652.tar.gz
txr-f9d4303ea0875da3feba4b5eb0dd372b676b8652.tar.bz2
txr-f9d4303ea0875da3feba4b5eb0dd372b676b8652.zip
* eval.c (eval_init): Register notf intrinsic function.
* lib.c (do_not): New static function. (notf): New function. * lib.h (notf): Declared. * txr.1: Documented notf. * share/txr/stdlib/txr-case.txr (bindable): Eliminated. (txr-if): Use functional expression, taking advantage of notf. * txr.vim: Regenerated.
-rw-r--r--ChangeLog16
-rw-r--r--eval.c1
-rw-r--r--lib.c10
-rw-r--r--lib.h1
-rw-r--r--share/txr/stdlib/txr-case.txr10
-rw-r--r--txr.117
-rw-r--r--txr.vim140
7 files changed, 117 insertions, 78 deletions
diff --git a/ChangeLog b/ChangeLog
index 98873158..3784aa27 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,5 +1,21 @@
2014-10-21 Kaz Kylheku <kaz@kylheku.com>
+ * eval.c (eval_init): Register notf intrinsic function.
+
+ * lib.c (do_not): New static function.
+ (notf): New function.
+
+ * lib.h (notf): Declared.
+
+ * txr.1: Documented notf.
+
+ * share/txr/stdlib/txr-case.txr (bindable): Eliminated.
+ (txr-if): Use functional expression, taking advantage of notf.
+
+ * txr.vim: Regenerated.
+
+2014-10-21 Kaz Kylheku <kaz@kylheku.com>
+
* share/txr/stdlib/txr-case.txr: New file.
* txr.1: Document txr-if, txr-when and txr-case.
diff --git a/eval.c b/eval.c
index c4b5cb78..94736bdb 100644
--- a/eval.c
+++ b/eval.c
@@ -3711,6 +3711,7 @@ void eval_init(void)
reg_fun(intern(lit("juxt"), user_package), func_n0v(juxtv));
reg_fun(intern(lit("andf"), user_package), func_n0v(andv));
reg_fun(intern(lit("orf"), user_package), func_n0v(orv));
+ reg_fun(intern(lit("notf"), user_package), func_n1(notf));
reg_fun(intern(lit("iff"), user_package), func_n3o(iff, 2));
reg_fun(intern(lit("iffi"), user_package), func_n3o(iffi, 2));
reg_fun(intern(lit("if"), user_package), func_n3o(if_fun, 2));
diff --git a/lib.c b/lib.c
index acac10dd..920b53cf 100644
--- a/lib.c
+++ b/lib.c
@@ -4572,6 +4572,16 @@ val orv(val funlist)
return func_f0v(nullify(funlist), do_or);
}
+static val do_not(val fun, val args)
+{
+ return null(apply(fun, args, nil));
+}
+
+val notf(val fun)
+{
+ return func_f0v(fun, do_not);
+}
+
static val do_iff(val env, val args)
{
cons_bind (condfun, choices, env);
diff --git a/lib.h b/lib.h
index 0ed408a0..36e2db02 100644
--- a/lib.h
+++ b/lib.h
@@ -725,6 +725,7 @@ val andf(val first_fun, ...);
val andv(val funlist);
val orf(val first_fun, ...);
val orv(val funlist);
+val notf(val fun);
val iff(val condfun, val thenfun, val elsefun);
val iffi(val condfun, val thenfun, val elsefun);
val swap_12_21(val fun);
diff --git a/share/txr/stdlib/txr-case.txr b/share/txr/stdlib/txr-case.txr
index 4d0081b3..12321a31 100644
--- a/share/txr/stdlib/txr-case.txr
+++ b/share/txr/stdlib/txr-case.txr
@@ -1,13 +1,7 @@
@(do
- (macro-time
- (defun bindable (obj)
- (and obj
- (symbolp obj)
- (not (keywordp obj))
- (not (eq t obj)))))
-
(defmacro txr-if (name args input : then else)
- (let ((syms [keep-if bindable args])
+ (let ((syms (keep-if [andf true symbolp [notf keywordp] [notf (op eq t)]]
+ args))
(arg-exprs [mapcar [iffi symbolp (ret ^',@1)] args])
(result (gensym "res-"))
(bindings (gensym "bindings-"))
diff --git a/txr.1 b/txr.1
index d6853dfe..512f2b82 100644
--- a/txr.1
+++ b/txr.1
@@ -20576,6 +20576,23 @@ is returned. The expression
returns a function which accepts any arguments and returns
.codn nil .
+.coNP Function @ notf
+.synb
+.mets (notf << function )
+.syne
+.desc
+The
+.code notf
+function returns a function which is the boolean negation
+of
+.metn function .
+
+The returned function takes a variable number of arguments. When
+invoked, it passes all of these arguments to
+.meta function
+and then inverts the result as if by application of the
+.codn not .
+
.coNP Functions @ iff and @ iffi
.synb
.mets (iff < cond-func < then-func <> [ else-func ])
diff --git a/txr.vim b/txr.vim
index b4ccba96..38cf49b9 100644
--- a/txr.vim
+++ b/txr.vim
@@ -123,76 +123,76 @@ syn keyword txl_keyword contained member-if memq memql memqual
syn keyword txl_keyword contained merge min minor mkdir
syn keyword txl_keyword contained mknod mkstring mod multi
syn keyword txl_keyword contained multi-sort n-choose-k n-perm-k nconc
-syn keyword txl_keyword contained nilf none not nreverse
-syn keyword txl_keyword contained null nullify num-chr num-str
-syn keyword txl_keyword contained numberp oddp op open-command
-syn keyword txl_keyword contained open-directory open-file open-files open-files*
-syn keyword txl_keyword contained open-pipe open-process open-tail openlog
-syn keyword txl_keyword contained or orf packagep partition
-syn keyword txl_keyword contained partition* partition-by perm pop
-syn keyword txl_keyword contained pos pos-if pos-max pos-min
-syn keyword txl_keyword contained posq posql posqual pprinl
-syn keyword txl_keyword contained pprint pprof prinl print
-syn keyword txl_keyword contained prof prog1 progn prop
-syn keyword txl_keyword contained proper-listp push pushhash put-byte
-syn keyword txl_keyword contained put-char put-line put-lines put-string
-syn keyword txl_keyword contained put-strings pwd qquote quasi
-syn keyword txl_keyword contained quasilist quote rand random
-syn keyword txl_keyword contained random-fixnum random-state-p range range*
-syn keyword txl_keyword contained range-regex 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 ret
-syn keyword txl_keyword contained retf return return-from reverse
-syn keyword txl_keyword contained rlcp rperm rplaca rplacd
-syn keyword txl_keyword contained run s-ifblk s-ifchr s-ifdir
-syn keyword txl_keyword contained s-ififo s-iflnk s-ifmt s-ifreg
-syn keyword txl_keyword contained s-ifsock s-irgrp s-iroth s-irusr
-syn keyword txl_keyword contained s-irwxg s-irwxo s-irwxu s-isgid
-syn keyword txl_keyword contained s-isuid s-isvtx s-iwgrp s-iwoth
-syn keyword txl_keyword contained s-iwusr s-ixgrp s-ixoth s-ixusr
-syn keyword txl_keyword contained search search-regex search-str search-str-tree
-syn keyword txl_keyword contained second seek-stream select seqp
-syn keyword txl_keyword contained set set-diff set-hash-userdata set-sig-handler
-syn keyword txl_keyword contained sethash setitimer setlogmask sh
-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 stdlib str< str<= str=
-syn keyword txl_keyword contained str> str>= stream-get-prop stream-set-prop
-syn keyword txl_keyword contained streamp 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 tf third throw throwf
-syn keyword txl_keyword contained time time-fields-local time-fields-utc time-string-local
-syn keyword txl_keyword contained time-string-utc time-usec tofloat toint
-syn keyword txl_keyword contained tok-str tok-where tostring tostringp
-syn keyword txl_keyword contained transpose tree-bind tree-case tree-find
-syn keyword txl_keyword contained trie-add trie-compress trie-lookup-begin trie-lookup-feed-char
-syn keyword txl_keyword contained trie-value-at trim-str true trunc
-syn keyword txl_keyword contained tuples txr-case txr-if txr-when
-syn keyword txl_keyword contained typeof unget-byte unget-char uniq
-syn keyword txl_keyword contained unless unquote until upcase-str
-syn keyword txl_keyword contained update url-decode url-encode usleep
-syn keyword txl_keyword contained uw-protect vec vec-push vec-set-length
-syn keyword txl_keyword contained vecref vector vector-list vectorp
-syn keyword txl_keyword contained when where while with-saved-vars
-syn keyword txl_keyword contained zerop zip
+syn keyword txl_keyword contained nilf none not notf
+syn keyword txl_keyword contained nreverse null nullify num-chr
+syn keyword txl_keyword contained num-str numberp oddp op
+syn keyword txl_keyword contained open-command open-directory open-file open-files
+syn keyword txl_keyword contained open-files* open-pipe open-process open-tail
+syn keyword txl_keyword contained openlog or orf packagep
+syn keyword txl_keyword contained partition partition* partition-by perm
+syn keyword txl_keyword contained pop pos pos-if pos-max
+syn keyword txl_keyword contained pos-min posq posql posqual
+syn keyword txl_keyword contained pprinl pprint pprof prinl
+syn keyword txl_keyword contained print prof prog1 progn
+syn keyword txl_keyword contained prop proper-listp push pushhash
+syn keyword txl_keyword contained put-byte put-char put-line put-lines
+syn keyword txl_keyword contained put-string put-strings pwd qquote
+syn keyword txl_keyword contained quasi quasilist quote rand
+syn keyword txl_keyword contained random random-fixnum random-state-p range
+syn keyword txl_keyword contained range* range-regex 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 ret retf return return-from
+syn keyword txl_keyword contained reverse rlcp rperm rplaca
+syn keyword txl_keyword contained rplacd run 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 search-regex search-str
+syn keyword txl_keyword contained search-str-tree second seek-stream select
+syn keyword txl_keyword contained seqp set set-diff set-hash-userdata
+syn keyword txl_keyword contained set-sig-handler sethash setitimer setlogmask
+syn keyword txl_keyword contained sh 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 stdlib str< str<=
+syn keyword txl_keyword contained str= str> str>= stream-get-prop
+syn keyword txl_keyword contained stream-set-prop streamp string-extend string-lt
+syn keyword txl_keyword contained stringp sub sub-list sub-str
+syn keyword txl_keyword contained sub-vec symacrolet symbol-function symbol-name
+syn keyword txl_keyword contained symbol-package symbol-value symbolp symlink
+syn keyword txl_keyword contained sys-qquote sys-splice sys-unquote syslog
+syn keyword txl_keyword contained tan tf third throw
+syn keyword txl_keyword contained throwf time time-fields-local time-fields-utc
+syn keyword txl_keyword contained time-string-local time-string-utc time-usec tofloat
+syn keyword txl_keyword contained toint tok-str tok-where tostring
+syn keyword txl_keyword contained tostringp transpose tree-bind tree-case
+syn keyword txl_keyword contained tree-find trie-add trie-compress trie-lookup-begin
+syn keyword txl_keyword contained trie-lookup-feed-char trie-value-at trim-str true
+syn keyword txl_keyword contained trunc tuples txr-case txr-if
+syn keyword txl_keyword contained txr-when typeof unget-byte unget-char
+syn keyword txl_keyword contained uniq unless unquote until
+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 when where while
+syn keyword txl_keyword contained with-saved-vars zerop zip
syn match txr_error "@[\t ]*[*]\?[\t ]*."
syn match txr_nested_error "[^\t `]\+" contained