summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--defun-1.lisp6
-rw-r--r--destructuring-bind.lisp10
-rw-r--r--list-functions.lisp39
-rw-r--r--util.lisp13
4 files changed, 38 insertions, 30 deletions
diff --git a/defun-1.lisp b/defun-1.lisp
index a0c2416..6038e88 100644
--- a/defun-1.lisp
+++ b/defun-1.lisp
@@ -1,3 +1,6 @@
+(export '(defmacro defun))
+
+
(%defmacro* defun (name lambda-list . body)
(let ((lambda-sym (gensym)))
`(%defun ,name ,lambda-sym
@@ -15,6 +18,3 @@
(,env-sym (second ,arg-sym)))
(d-b ,lambda-list ,env-sym ,whole-sym ,lambda-sym
,@body)))))
-
-
-(export '(defmacro defun))
diff --git a/destructuring-bind.lisp b/destructuring-bind.lisp
index 1207649..8767630 100644
--- a/destructuring-bind.lisp
+++ b/destructuring-bind.lisp
@@ -1,3 +1,8 @@
+(export '(destructuring-bind lambda-list-keywords
+ &allow-other-keys &aux &body &environment &key &optional &rest
+ &whole))
+
+
;; D-B may not expand to (but _may_ itself use!) plain list function
;; calls because these are defined in list-functions.lisp by way of
;; DEFUN, which is in turn based on D-B. Because of this, we define our
@@ -120,8 +125,3 @@
(%defmacro* destructuring-bind (tree expression . body)
`(d-b ,tree nil nil ,expression ,@body))
-
-
-(export '(destructuring-bind lambda-list-keywords
- &allow-other-keys &aux &body &environment &key &optional &rest
- &whole))
diff --git a/list-functions.lisp b/list-functions.lisp
index 91fd5ad..2622fac 100644
--- a/list-functions.lisp
+++ b/list-functions.lisp
@@ -1,9 +1,13 @@
+(export '(cons list* first second third fourth fifth sixth seventh
+ eigthth ninth tenth atom consp listp null rplaca rplacd caaaar
+ caaadr caaar caadar caaddr caadr caar cadaar cadadr cadar
+ caddar cadddr caddr cadr car cdaaar cdaadr cdaar cdadar cdaddr
+ cdadr cdar cddaar cddadr cddar cdddar cddddr cdddr cddr cdr))
+
+
(%defmacro* pushq args
(list* 'setq (car (cdr args)) (car args)))
-(defun first (list)
- (car list))
-
;;;;-----------------------------------------------------------------
;;;; THE CxR FUNCTIONS
@@ -50,8 +54,7 @@
(defun cadr (list)
(car (cdr list)))
-(shadow 'car)
-(unexport 'sys::car (find-package :sys))
+(%shadowing-export car)
(defun car (list)
(sys::car list))
@@ -97,15 +100,17 @@
(defun cddr (list)
(cdr (cdr list)))
-(shadow 'cdr)
-(unexport 'sys::cdr (find-package :sys))
+(%shadowing-export cdr)
(defun cdr (list)
(sys::cdr list))
;;;;-----------------------------------------------------------------
-;;;; SECOND ... TENTH
+;;;; FIRST ... TENTH
;;;;-----------------------------------------------------------------
+(defun first (list)
+ (car list))
+
(defun second (list)
(cadr list))
@@ -137,8 +142,7 @@
;;;;-----------------------------------------------------------------
;;;; CONS
;;;;-----------------------------------------------------------------
-(shadow 'cons)
-(unexport 'sys::cons (find-package :sys))
+(%shadowing-export cons)
(defun cons (x y)
(sys::cons x y))
@@ -146,8 +150,10 @@
;;;;-----------------------------------------------------------------
;;;; TYPE PREDICATES
;;;;-----------------------------------------------------------------
-(shadow '(consp listp null atom))
-(unexport '(sys::consp sys::listp sys::null sys::atom) (find-package :sys))
+(%shadowing-export consp)
+(%shadowing-export listp)
+(%shadowing-export null)
+(%shadowing-export atom)
(defun consp (x)
(sys::consp x))
@@ -179,8 +185,8 @@
;;;;-----------------------------------------------------------------
;;;; ACCESSORS
;;;;-----------------------------------------------------------------
-(shadow '(rplaca rplacd))
-(unexport '(sys::rplaca sys::rplacd) (find-package :sys))
+(%shadowing-export rplaca)
+(%shadowing-export rplacd)
(defun rplaca (cons new-value)
(sys::rplaca cons new-value))
@@ -190,8 +196,3 @@
;;;;-----------------------------------------------------------------
-(export '(cons list* first second third fourth fifth sixth seventh
- eigthth ninth tenth atom consp listp null rplaca rplacd caaaar
- caaadr caaar caadar caaddr caadr caar cadaar cadadr cadar
- caddar cadddr caddr cadr car cdaaar cdaadr cdaar cdadar cdaddr
- cdadr cdar cddaar cddadr cddar cdddar cddddr cdddr cddr cdr))
diff --git a/util.lisp b/util.lisp
index 63777ea..f6fbe20 100644
--- a/util.lisp
+++ b/util.lisp
@@ -1,3 +1,7 @@
+(export '(and or not let* list* case cond append reverse macroexpand
+ otherwise unless when))
+
+
(%defmacro %defun args
(list '%fset
(list 'quote (car (cdr (car args))))
@@ -193,6 +197,9 @@
(%defmacro* when (test . body)
`(if ,test (progn ,@body) nil))
-
-(export '(and or not let* list* case cond append reverse macroexpand
- otherwise unless when))
+(%defmacro* %shadowing-export (symbol)
+ `(progn
+ (shadow ',symbol)
+ (unexport ',symbol (find-package :sys))
+ (unexport ',symbol (find-package :cl))
+ (export (intern (symbol-name ',symbol) (find-package :cl)))))