Adding anaphoric ifa macro.

* Makefile (install): Install .tl files present in stdlib directory.
(INSTALL): Handle argument 2 being a list.

* eval.c (load): New function.

* eval.h (load): Declared.

* lisplib.c (ifa_set_entries, ifa_instantiate): New functions
to lazily load ifa.tl.
(lisplib_init): Register new functions.

* txr.c (stdlib_path): New variable.
(sysroot_init): Store the stdlib path in stdlib_path.

* txr.h (stdlib_path): Declared.

* share/txr/stdlib/ifa.tl: New file.

1 files changed, 44 insertions, 0 deletions

diff --git a/share/txr/stdlib/ifa.tl b/share/txr/stdlib/ifa.tl
new file mode 100644
index 00000000..f7c4fcb0
--- /dev/null
+++ b/share/txr/stdlib/ifa.tl
@@ -0,0 +1,44 @@
+;; Copyright 2015
+;; Kaz Kylheku <kaz@kylheku.com>
+;; Vancouver, Canada
+;; All rights reserved.
+;;
+;; Redistribution of this software in source and binary forms, with or without
+;; modification, is permitted provided that the following two conditions are met.
+;;
+;; Use of this software in any manner constitutes agreement with the disclaimer
+;; which follows the two conditions.
+;;
+;; 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 ``AS IS'' AND WITHOUT ANY EXPRESS OR IMPLIED
+;; WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED WARRANTIES OF
+;; MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE.  IN NO EVENT SHALL THE
+;; COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE FOR ANY DAMAGES, HOWEVER CAUSED,
+;; AND UNDER ANY THEORY OF LIABILITY, ARISING IN ANY WAY OUT OF THE USE OF THIS
+;; SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+
+(defmacro ifa (:env e test then : else)
+  (flet ((candidate-p (expr)
+           (not (or (constantp expr e) (symbolp expr)))))
+    (cond
+      ((or (atom test) (null (cdr test))) ^(let ((it ,test))
+                                             (if it ,then ,else)))
+      ((member (first test) '(not null)) ^(ifa ,(second test) ,else ,then))
+      (t (let* ((sym (first test))
+                (args (rest test))
+                (n-candidate-args [count-if candidate-p args])
+                (pos-candidate (or [pos-if candidate-p args] 0)))
+           (unless (fboundp sym)
+             (error "ifa: only works with global functions."))
+           (when (> n-candidate-args 1)
+             (error "ifa: ambiguous situation: not clear what can be \"it\"."))
+           (let* ((temps (mapcar (ret (gensym)) args))
+                  (it-temp [temps pos-candidate]))
+             ^(let* (,*(zip temps args) (it ,it-temp))
+                (if (,sym ,*temps) ,then ,else))))))))