diff options
| -rw-r--r-- | defun-1.lisp | 6 | ||||
| -rw-r--r-- | destructuring-bind.lisp | 10 | ||||
| -rw-r--r-- | list-functions.lisp | 39 | ||||
| -rw-r--r-- | util.lisp | 13 |
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)) @@ -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))))) |