Update of /project/closure/cvsroot/closure/src/glisp In directory clnet:/tmp/cvs-serv30859/src/glisp
Modified Files: dep-acl.lisp dep-acl5.lisp dep-clisp.lisp dep-cmucl-dtc.lisp dep-cmucl.lisp dep-openmcl.lisp dep-sbcl.lisp util.lisp Log Message: No need to have two identical versions of defsubst. Use the one in CXML.
--- /project/closure/cvsroot/closure/src/glisp/dep-acl.lisp 2005/03/13 18:01:15 1.2 +++ /project/closure/cvsroot/closure/src/glisp/dep-acl.lisp 2006/12/31 12:14:36 1.3 @@ -110,23 +110,5 @@ (defun glisp::mp/process-wait (whostate predicate) (mp:process-wait whostate predicate))
-;; ACL is incapable to define compiler macros on (setf foo) -;; Unfortunately it is also incapable to declaim such functions inline. -;; So we revoke the DEFUN hack from dep-gcl here. - -(defmacro glisp::defsubst (fun args &body body) - (if (and (consp fun) (eq (car fun) 'setf)) - (let ((fnam (intern (concatenate 'string "(SETF " (symbol-name (cadr fun)) ")") - (symbol-package (cadr fun))))) - `(progn - (defsetf ,(cadr fun) (&rest ap) (new-value) (list* ',fnam new-value ap)) - (glisp::defsubst ,fnam ,args .,body))) - `(progn - (defun ,fun ,args .,body) - (define-compiler-macro ,fun (&rest .args.) - (cons '(lambda ,args .,body) - .args.))))) - - (defun glisp::getenv (string) (sys:getenv string)) --- /project/closure/cvsroot/closure/src/glisp/dep-acl5.lisp 2005/03/13 18:01:15 1.2 +++ /project/closure/cvsroot/closure/src/glisp/dep-acl5.lisp 2006/12/31 12:14:36 1.3 @@ -140,28 +140,5 @@ (defun glisp::mp/process-kill (proc) (mp:process-kill proc))
-;; ACL is incapable to define compiler macros on (setf foo) -;; Unfortunately it is also incapable to declaim such functions inline. -;; So we revoke the DEFUN hack from dep-gcl here. - -(defmacro glisp::defsubst (fun args &body body) - (if (and (consp fun) (eq (car fun) 'setf)) - (let ((fnam (intern (concatenate 'string "(SETF " (symbol-name (cadr fun)) ")") - (symbol-package (cadr fun))))) - `(progn - (defsetf ,(cadr fun) (&rest ap) (new-value) (list* ',fnam new-value ap)) - (glisp::defsubst ,fnam ,args .,body))) - (labels ((declp (x) - (and (consp x) (eq (car x) 'declare)))) - `(progn - (defun ,fun ,args .,body) - (define-compiler-macro ,fun (&rest .args.) - (cons '(lambda ,args - ,@(remove-if-not #'declp body) - (block ,fun - ,@(remove-if #'declp body))) - .args.)))))) - - (defun glisp::getenv (string) - (sys:getenv string)) \ No newline at end of file + (sys:getenv string)) --- /project/closure/cvsroot/closure/src/glisp/dep-clisp.lisp 2005/03/13 18:01:15 1.2 +++ /project/closure/cvsroot/closure/src/glisp/dep-clisp.lisp 2006/12/31 12:14:36 1.3 @@ -120,11 +120,6 @@ (apply #'xlib:draw-glyphs drawable gcontext x y (vector elt) more)) ||#
-(defmacro glisp::defsubst (name args &body body) - `(progn - (declaim (inline ,name)) - (defun ,name ,args .,body))) - (export 'glisp::getenv :glisp) (defun glisp::getenv (var) (sys::getenv var)) --- /project/closure/cvsroot/closure/src/glisp/dep-cmucl-dtc.lisp 2005/03/13 18:01:15 1.2 +++ /project/closure/cvsroot/closure/src/glisp/dep-cmucl-dtc.lisp 2006/12/31 12:14:36 1.3 @@ -161,7 +161,7 @@ On Wednesday, 7/1/98 12:48:51 pm [-1] it was compiled from: target:code/run-program.lisp Created: Saturday, 6/20/98 07:13:08 pm [-1] - Comment: $Header: /project/closure/cvsroot/closure/src/glisp/dep-cmucl-dtc.lisp,v 1.2 2005/03/13 18:01:15 gbaumann Exp $ + Comment: $Header: /project/closure/cvsroot/closure/src/glisp/dep-cmucl-dtc.lisp,v 1.3 2006/12/31 12:14:36 dlichteblau Exp $ ||#
;; (process-exit-code (run-program "/bin/sh" (list "-c" "ls") :wait t :input nil :output nil)) @@ -169,11 +169,6 @@ (defun glisp:run-unix-shell-command (command) (ext:process-exit-code (ext:run-program "/bin/sh" (list "-c" command) :wait t :input nil :output nil)))
-(defmacro glisp::defsubst (name args &body body) - `(progn - (declaim (inline ,name)) - (defun ,name ,args .,body))) -
;;; MP
--- /project/closure/cvsroot/closure/src/glisp/dep-cmucl.lisp 2005/03/13 18:01:15 1.2 +++ /project/closure/cvsroot/closure/src/glisp/dep-cmucl.lisp 2006/12/31 12:14:36 1.3 @@ -192,7 +192,7 @@ On Wednesday, 7/1/98 12:48:51 pm [-1] it was compiled from: target:code/run-program.lisp Created: Saturday, 6/20/98 07:13:08 pm [-1] - Comment: $Header: /project/closure/cvsroot/closure/src/glisp/dep-cmucl.lisp,v 1.2 2005/03/13 18:01:15 gbaumann Exp $ + Comment: $Header: /project/closure/cvsroot/closure/src/glisp/dep-cmucl.lisp,v 1.3 2006/12/31 12:14:36 dlichteblau Exp $ ||#
;; (process-exit-code (run-program "/bin/sh" (list "-c" "ls") :wait t :input nil :output nil)) @@ -200,12 +200,6 @@ (defun glisp:run-unix-shell-command (command) (ext:process-exit-code (ext:run-program "/bin/sh" (list "-c" command) :wait t :input nil :output nil)))
-(defmacro glisp::defsubst (name args &body body) - `(progn - (declaim (inline ,name)) - (defun ,name ,args .,body))) - - ;;; MP
(export 'glisp::mp/process-yield :glisp) --- /project/closure/cvsroot/closure/src/glisp/dep-openmcl.lisp 2005/08/25 15:14:12 1.1 +++ /project/closure/cvsroot/closure/src/glisp/dep-openmcl.lisp 2006/12/31 12:14:36 1.2 @@ -145,12 +145,6 @@ (ccl:run-program "/bin/sh" (list "-c" command) :wait t :input nil :output nil))))
-(defmacro glisp::defsubst (name args &body body) - `(progn - (declaim (inline ,name)) - (defun ,name ,args .,body))) - - ;;; MP
(export 'glisp::mp/process-yield :glisp) --- /project/closure/cvsroot/closure/src/glisp/dep-sbcl.lisp 2006/12/30 15:00:28 1.3 +++ /project/closure/cvsroot/closure/src/glisp/dep-sbcl.lisp 2006/12/31 12:14:36 1.4 @@ -100,12 +100,6 @@ (sb-ext:run-program "/bin/sh" (list "-c" command) :wait t :input nil :output nil)))
-(defmacro glisp::defsubst (name args &body body) - `(progn - (declaim (inline ,name)) - (defun ,name ,args .,body))) - - ;;; MP
(export 'glisp::mp/process-yield :glisp) --- /project/closure/cvsroot/closure/src/glisp/util.lisp 2006/12/29 21:29:25 1.5 +++ /project/closure/cvsroot/closure/src/glisp/util.lisp 2006/12/31 12:14:36 1.6 @@ -41,6 +41,9 @@ (define-compiler-macro neq (x y) `(not (eq ,x ,y)))
+(defmacro defsubst (name args &body body) + `(runes:definline ,name ,args ,@body)) + ;;; -------------------------------------------------------------------------------- ;;; Meta functions