[closure-cvs] CVS closure/src/glisp
dlichteblau
dlichteblau at common-lisp.net
Sun Dec 31 12:14:37 UTC 2006
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 , at body))
+
;;; --------------------------------------------------------------------------------
;;; Meta functions
More information about the Closure-cvs
mailing list