summaryrefslogtreecommitdiffstats
path: root/share
diff options
context:
space:
mode:
authorKaz Kylheku <kaz@kylheku.com>2015-06-18 06:35:09 -0700
committerKaz Kylheku <kaz@kylheku.com>2015-06-18 06:35:09 -0700
commite0bede31f0094f6e2b4893a9db726fa67ca84ad4 (patch)
treec423a5230e8012bf2e4574903b5b2d4b27b8e29f /share
parentb41b2cc220d9ba53024045fd3f84cd7be495d6a4 (diff)
downloadtxr-e0bede31f0094f6e2b4893a9db726fa67ca84ad4.tar.gz
txr-e0bede31f0094f6e2b4893a9db726fa67ca84ad4.tar.bz2
txr-e0bede31f0094f6e2b4893a9db726fa67ca84ad4.zip
Library .txr files become .tl and are autoloaded.
* lisplib.c (ver_set_entries, ver_instantiate, txr_case_set_entries, txr_case_instantiate): New static functions. (lisplib_init): Register new functions. * share/txr/stdlib/txr-case.txr: Reduced to a load for the corresponding .tl file, retained for backward compatibility. * share/txr/stdlib/ver.txr: Likewise. * share/txr/stdlib/txr-case.tl: New file, based on previous contents of corresponding .txr file. * share/txr/stdlib/ver.tl: Likewise.
Diffstat (limited to 'share')
-rw-r--r--share/txr/stdlib/txr-case.tl41
-rw-r--r--share/txr/stdlib/txr-case.txr43
-rw-r--r--share/txr/stdlib/ver.tl1
-rw-r--r--share/txr/stdlib/ver.txr2
4 files changed, 44 insertions, 43 deletions
diff --git a/share/txr/stdlib/txr-case.tl b/share/txr/stdlib/txr-case.tl
new file mode 100644
index 00000000..2e0c5979
--- /dev/null
+++ b/share/txr/stdlib/txr-case.tl
@@ -0,0 +1,41 @@
+(defmacro txr-if (name args input : then else)
+ (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-"))
+ (insym (gensym "input-")))
+ ^(let* ((,insym ,input)
+ (,result (match-fun ',name (list ,*arg-exprs)
+ (if (stringp ,insym) (list ,insym) ,insym)
+ nil)))
+ (if ,result
+ (let ((,bindings (car ,result)))
+ (let (,*[mapcar (ret ^(,@1 (cdr (assoc ',@1 ,bindings))))
+ syms])
+ ,then))
+ ,else))))
+
+(defmacro txr-when (name args input . body)
+ ^(txr-if ,name ,args ,input (progn ,*body)))
+
+(defmacro txr-case-impl (sym . clauses)
+ (tree-case clauses
+ (((name args . body) . other-clauses)
+ (if (eq name t) :
+ ^(txr-if ,name ,args ,sym
+ (progn ,*body)
+ (txr-case-impl ,sym ,*other-clauses))))
+ (((sym . rest) . other-clauses)
+ (if (eq sym t)
+ (if other-clauses
+ (error "txr-case: clauses after (t ...) clause ignored")
+ ^(progn ,*rest))
+ (error "txr-case: bad syntax: ~s" (car clauses))))
+ (atom
+ (error "txr-case: unexpected atom in syntax: ~s" atom))))
+
+(defmacro txr-case (input-expr . clauses)
+ (let ((input (gensym "input-")))
+ ^(let ((,input ,input-expr))
+ (txr-case-impl ,input ,*clauses))))
diff --git a/share/txr/stdlib/txr-case.txr b/share/txr/stdlib/txr-case.txr
index 12321a31..9b65d1bc 100644
--- a/share/txr/stdlib/txr-case.txr
+++ b/share/txr/stdlib/txr-case.txr
@@ -1,42 +1 @@
-@(do
- (defmacro txr-if (name args input : then else)
- (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-"))
- (insym (gensym "input-")))
- ^(let* ((,insym ,input)
- (,result (match-fun ',name (list ,*arg-exprs)
- (if (stringp ,insym) (list ,insym) ,insym)
- nil)))
- (if ,result
- (let ((,bindings (car ,result)))
- (let (,*[mapcar (ret ^(,@1 (cdr (assoc ',@1 ,bindings))))
- syms])
- ,then))
- ,else))))
-
- (defmacro txr-when (name args input . body)
- ^(txr-if ,name ,args ,input (progn ,*body)))
-
- (defmacro txr-case-impl (sym . clauses)
- (tree-case clauses
- (((name args . body) . other-clauses)
- (if (eq name t) :
- ^(txr-if ,name ,args ,sym
- (progn ,*body)
- (txr-case-impl ,sym ,*other-clauses))))
- (((sym . rest) . other-clauses)
- (if (eq sym t)
- (if other-clauses
- (error "txr-case: clauses after (t ...) clause ignored")
- ^(progn ,*rest))
- (error "txr-case: bad syntax: ~s" (car clauses))))
- (atom
- (error "txr-case: unexpected atom in syntax: ~s" atom))))
-
- (defmacro txr-case (input-expr . clauses)
- (let ((input (gensym "input-")))
- ^(let ((,input ,input-expr))
- (txr-case-impl ,input ,*clauses)))))
+@(load "txr-case.tl")
diff --git a/share/txr/stdlib/ver.tl b/share/txr/stdlib/ver.tl
new file mode 100644
index 00000000..85221ca0
--- /dev/null
+++ b/share/txr/stdlib/ver.tl
@@ -0,0 +1 @@
+(defvar *lib-version* 108)
diff --git a/share/txr/stdlib/ver.txr b/share/txr/stdlib/ver.txr
index 18a987e7..2339bda7 100644
--- a/share/txr/stdlib/ver.txr
+++ b/share/txr/stdlib/ver.txr
@@ -1 +1 @@
-@(do (defvar *lib-version* 108))
+@(load "ver.tl")