closure-cvs

closure-cvs@common-lisp.net

208 discussions

[closure-cvs] CVS closure
by dlichteblau 31 Dec '06

31 Dec '06

Update of /project/closure/cvsroot/closure In directory clnet:/tmp/cvs-serv15409 Modified Files: closure.asd Log Message: Based on the assumption that (and cmucl pthread) is actually code for Scieneer CL, rename dep-cmucl-dtc to dep-scl. --- /project/closure/cvsroot/closure/closure.asd 2006/12/31 13:00:03 1.10 +++ /project/closure/cvsroot/closure/closure.asd 2006/12/31 13:11:44 1.11 @@ -68,9 +68,9 @@ ((:file dependent :pathname #+CLISP "dep-clisp" - #+(AND :CMU (NOT :PTHREAD)) "dep-cmucl" + #+(AND :CMU (NOT SCL)) "dep-cmucl" #+sbcl "dep-sbcl" - #+(AND :CMU :PTHREAD) "dep-cmucl-dtc" + #+SCL "dep-scl" #+ALLEGRO "dep-acl" #+GCL "dep-gcl" #+OPENMCL "dep-openmcl"

1 0

[closure-cvs] CVS closure/src/glisp
by dlichteblau 31 Dec '06

31 Dec '06

Update of /project/closure/cvsroot/closure/src/glisp In directory clnet:/tmp/cvs-serv15409/src/glisp Added Files: dep-scl.lisp Removed Files: dep-cmucl-dtc.lisp Log Message: Based on the assumption that (and cmucl pthread) is actually code for Scieneer CL, rename dep-cmucl-dtc to dep-scl. --- /project/closure/cvsroot/closure/src/glisp/dep-scl.lisp 2006/12/31 13:11:44 NONE +++ /project/closure/cvsroot/closure/src/glisp/dep-scl.lisp 2006/12/31 13:11:44 1.1 ;;; -*- Mode: Lisp; Syntax: Common-Lisp; Package: CL-USER; -*- ;;; --------------------------------------------------------------------------- ;;; Title: [Originally CMUCL dependent stuff + fixups], probably for SCL ;;; Created: 1999-05-25 22:32 ;;; Author: Gilbert Baumann <gilbert(a)base-engineering.com> ;;; License: MIT style (see below) ;;; --------------------------------------------------------------------------- ;;; (c) copyright 1999 by Gilbert Baumann ;;; Permission is hereby granted, free of charge, to any person obtaining ;;; a copy of this software and associated documentation files (the ;;; "Software"), to deal in the Software without restriction, including ;;; without limitation the rights to use, copy, modify, merge, publish, ;;; distribute, sublicense, and/or sell copies of the Software, and to ;;; permit persons to whom the Software is furnished to do so, subject to ;;; the following conditions: ;;; ;;; The above copyright notice and this permission notice shall be ;;; included in all copies or substantial portions of the Software. ;;; ;;; THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, ;;; EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF ;;; MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. ;;; IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY ;;; CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, ;;; TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE ;;; SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. (export 'glisp::read-byte-sequence :glisp) (export 'glisp::read-char-sequence :glisp) (export 'glisp::run-unix-shell-command :glisp) (export 'glisp::getenv :glisp) (defun glisp::read-byte-sequence (&rest ap) (apply #'read-sequence ap)) (defun glisp::read-char-sequence (&rest ap) (apply #'read-sequence ap)) (defun glisp::read-byte-sequence (sequence input &key (start 0) (end (length sequence))) (let (c (i start)) (loop (cond ((= i end) (return i))) (setq c (read-byte input nil :eof)) (cond ((eql c :eof) (return i))) (setf (aref sequence i) c) (incf i) ))) (defun glisp::read-byte-sequence (sequence input &key (start 0) (end (length sequence))) (let ((r (read-sequence sequence input :start start :end end))) (cond ((and (= r start) (> end start)) (let ((byte (read-byte input nil :eof))) (cond ((eq byte :eof) r) (t (setf (aref sequence start) byte) (incf start) (if (> end start) (glisp::read-byte-sequence sequence input :start start :end end) start))))) (t r)))) #|| (defun glisp::read-char-sequence (sequence input &key (start 0) (end (length sequence))) (let (c (i start)) (loop (cond ((= i end) (return i))) (setq c (read-byte input nil :eof)) (cond ((eql c :eof) (return i))) (setf (aref sequence i) c) (incf i) ))) ||# (defmacro glisp::with-timeout ((&rest ignore) &body body) (declare (ignore ignore)) `(progn ,@body)) (defun glisp::open-inet-socket (hostname port) (let ((fd (extensions:connect-to-inet-socket hostname port))) (values (sys:make-fd-stream fd :input t :output t :element-type '(unsigned-byte 8) :name (format nil "Network connection to ~A:~D" hostname port)) :byte))) (defun glisp::g/make-string (length &rest options) (apply #'make-array length :element-type 'base-char options)) #|| RUN-PROGRAM is an external symbol in the EXTENSIONS package. Function: #<Function RUN-PROGRAM {12E7B79}> Function arguments: (program args &key (env *environment-list*) (wait t) pty input if-input-does-not-exist output (if-output-exists :error) (error :output) (if-error-exists :error) status-hook) Function documentation: Run-program creates a new process and runs the unix progam in the file specified by the simple-string program. Args are the standard arguments that can be passed to a Unix program, for no arguments use NIL (which means just the name of the program is passed as arg 0). Run program will either return NIL or a PROCESS structure. See the CMU Common Lisp Users Manual for details about the PROCESS structure. The keyword arguments have the following meanings: :env - An A-LIST mapping keyword environment variables to simple-string values. :wait - If non-NIL (default), wait until the created process finishes. If NIL, continue running Lisp until the program finishes. :pty - Either T, NIL, or a stream. Unless NIL, the subprocess is established under a PTY. If :pty is a stream, all output to this pty is sent to this stream, otherwise the PROCESS-PTY slot is filled in with a stream connected to pty that can read output and write input. :input - Either T, NIL, a pathname, a stream, or :STREAM. If T, the standard input for the current process is inherited. If NIL, /dev/null is used. If a pathname, the file so specified is used. If a stream, all the input is read from that stream and send to the subprocess. If :STREAM, the PROCESS-INPUT slot is filled in with a stream that sends its output to the process. Defaults to NIL. :if-input-does-not-exist (when :input is the name of a file) - can be one of: :error - generate an error. :create - create an empty file. nil (default) - return nil from run-program. :output - Either T, NIL, a pathname, a stream, or :STREAM. If T, the standard output for the current process is inherited. If NIL, /dev/null is used. If a pathname, the file so specified is used. If a stream, all the output from the process is written to this stream. If :STREAM, the PROCESS-OUTPUT slot is filled in with a stream that can be read to get the output. Defaults to NIL. :if-output-exists (when :input is the name of a file) - can be one of: :error (default) - generates an error if the file already exists. :supersede - output from the program supersedes the file. :append - output from the program is appended to the file. nil - run-program returns nil without doing anything. :error and :if-error-exists - Same as :output and :if-output-exists, except that :error can also be specified as :output in which case all error output is routed to the same place as normal output. :status-hook - This is a function the system calls whenever the status of the process changes. The function takes the process as an argument. Its defined argument types are: (T T &KEY (:ENV T) (:WAIT T) (:PTY T) (:INPUT T) (:IF-INPUT-DOES-NOT-EXIST T) (:OUTPUT T) (:IF-OUTPUT-EXISTS T) (:ERROR T) (:IF-ERROR-EXISTS T) (:STATUS-HOOK T)) Its result type is: (OR EXTENSIONS::PROCESS NULL) 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-scl.lisp,v 1.1 2006/12/31 13:11:44 dlichteblau Exp $ ||# ;; (process-exit-code (run-program "/bin/sh" (list "-c" "ls") :wait t :input nil :output nil)) (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))) ;;; MP (export 'glisp::mp/process-yield :glisp) (export 'glisp::mp/process-wait :glisp) (export 'glisp::mp/process-run-function :glisp) (export 'glisp::mp/make-lock :glisp) (export 'glisp::mp/current-process :glisp) (export 'glisp::mp/process-kill :glisp) (defun glisp::mp/make-lock (&key name) (pthread::make-lock name)) (defmacro glisp::mp/with-lock ((lock) &body body) `(pthread::with-lock-held (,lock) ,@body)) (defun glisp::mp/process-yield (&optional process-to-run) (declare (ignore process-to-run)) (PTHREAD:SCHED-YIELD)) (defun glisp::mp/process-wait (whostate predicate) (do () ((funcall predicate)) (sleep .1))) (defun glisp::mp/process-run-function (name fun &rest args) (pthread::thread-create (lambda () (apply fun args)) :name name)) (defun glisp::mp/current-process () 'blah) (defun glisp::mp/process-kill (process) (warn "*** Define GLISP:MP/PROCESS-KILL for CMUCL.")) (defun glisp::getenv (string) (cdr (assoc string ext:*environment-list* :test #'string-equal)))

1 0

[closure-cvs] CVS closure/src/glisp
by dlichteblau 31 Dec '06

31 Dec '06

Update of /project/closure/cvsroot/closure/src/glisp In directory clnet:/tmp/cvs-serv6441/src/glisp Removed Files: dep-acl5.lisp Log Message: As part of the great glisp cleanup, remove dep-acl5.lisp. Hopefully this doesn't break anything, but according to both closure.asd and closure.system, this file hasn't been in use ever since Allegro 6.0 came out, and it's now at version 8.0. Obviously, this file was -meant- for ACL >= 5.0, not ACL == 5.0, but that's not what the reader conditionals say. The differences to dep-acl.lisp seem negligible anyway. If this breaks anything, please complain so that it can be fixed.

1 0

[closure-cvs] CVS closure
by dlichteblau 31 Dec '06

31 Dec '06

Update of /project/closure/cvsroot/closure In directory clnet:/tmp/cvs-serv6441 Modified Files: closure.asd Log Message: As part of the great glisp cleanup, remove dep-acl5.lisp. Hopefully this doesn't break anything, but according to both closure.asd and closure.system, this file hasn't been in use ever since Allegro 6.0 came out, and it's now at version 8.0. Obviously, this file was -meant- for ACL >= 5.0, not ACL == 5.0, but that's not what the reader conditionals say. The differences to dep-acl.lisp seem negligible anyway. If this breaks anything, please complain so that it can be fixed. --- /project/closure/cvsroot/closure/closure.asd 2006/12/31 12:35:18 1.9 +++ /project/closure/cvsroot/closure/closure.asd 2006/12/31 13:00:03 1.10 @@ -71,8 +71,7 @@ #+(AND :CMU (NOT :PTHREAD)) "dep-cmucl" #+sbcl "dep-sbcl" #+(AND :CMU :PTHREAD) "dep-cmucl-dtc" - #+(AND ALLEGRO ALLEGRO-V5.0) "dep-acl5" - #+(AND ALLEGRO (NOT ALLEGRO-V5.0)) "dep-acl" + #+ALLEGRO "dep-acl" #+GCL "dep-gcl" #+OPENMCL "dep-openmcl" #-(OR sbcl CLISP CMU ALLEGRO GCL OPENMCL) #.(error "Configure!"))

1 0

[closure-cvs] CVS closure
by dlichteblau 31 Dec '06

31 Dec '06

Update of /project/closure/cvsroot/closure In directory clnet:/tmp/cvs-serv2129 Modified Files: closure.asd Log Message: Don't export gray stream symbols from glisp. Use a normal defpackage for glisp. (I was planning to switch closure to the trivial-gray-streams package instead, but couldn't find any actual gray streams usage.) --- /project/closure/cvsroot/closure/closure.asd 2006/12/29 21:29:22 1.8 +++ /project/closure/cvsroot/closure/closure.asd 2006/12/31 12:35:18 1.9 @@ -60,7 +60,10 @@ (make-pathname :name nil :type nil :defaults *load-truename*)) :default-component-class closure-source-file - :depends-on (:cxml :mcclim #+sbcl :sb-bsd-sockets) + :depends-on (:cxml :mcclim + ;; uncomment this if we actually need gray streams: + ;; :trivial-gray-streams + #+sbcl :sb-bsd-sockets) :components ((:file dependent :pathname

1 0

[closure-cvs] CVS closure/src/glisp
by dlichteblau 31 Dec '06

31 Dec '06

Update of /project/closure/cvsroot/closure/src/glisp In directory clnet:/tmp/cvs-serv2129/src/glisp Modified Files: package.lisp Log Message: Don't export gray stream symbols from glisp. Use a normal defpackage for glisp. (I was planning to switch closure to the trivial-gray-streams package instead, but couldn't find any actual gray streams usage.) --- /project/closure/cvsroot/closure/src/glisp/package.lisp 2006/12/31 11:48:18 1.6 +++ /project/closure/cvsroot/closure/src/glisp/package.lisp 2006/12/31 12:35:18 1.7 @@ -26,198 +26,102 @@ ;;; TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE ;;; SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. -(defpackage :glisp-temp (:use #:cl)) -(in-package :glisp-temp) +(in-package :cl-user) -(defpackage :glisp (:use)) - -(eval-when (compile) - (defvar *export-from-glisp* - '( - "DEFSUBST" - "G/MAKE-STRING" - "MP/MAKE-LOCK" - "MP/WITH-LOCK" - "WITH-TIMEOUT" - "OPEN-INET-SOCKET" - ;; util.lisp : - "ALWAYS" - "CL-BYTE-STREAM" - "CL-CHAR-STREAM" - "CL-STREAM" - "COMPOSE" - "CURRY" - "FALSE" - "FORCE" - "G/CLOSE" - "G/FINISH-OUTPUT" - "G/PEEK-CHAR" - "G/READ-BYTE" - "G/READ-BYTE-SEQUENCE" - "G/READ-CHAR" - "G/READ-CHAR-SEQUENCE" - "G/READ-LINE" - "G/READ-LINE*" - "G/UNREAD-BYTE" - "G/UNREAD-CHAR" - "G/WRITE-BYTE" - "G/WRITE-BYTE-SEQUENCE" - "G/WRITE-CHAR" - "G/WRITE-STRING" - "GSTREAM" - "MAP-ARRAY" - "MAPFCAR" - "MAX*" - "MAXF" - "MIN*" - "MINF" - "MULTIPLE-VALUE-OR" - "MULTIPLE-VALUE-SOME" - "NCONCF" - "NEQ" - "PROMISE" - "RCURRY" - "SANIFY-STRING" - "SHOW" - "SPLIT-BY" - "SPLIT-BY-IF" - "SPLIT-BY-MEMBER" - "SPLIT-STRING" - "STRING-BEGIN-EQUAL" - "TRUE" - "UNTIL" - "USE-BYTE-FOR-CHAR-STREAM-FLAVOUR" - "USE-CHAR-FOR-BYTE-STREAM-FLAVOUR" - "WHILE" - "WHITE-SPACE-P" - - "CL-BYTE-STREAM->GSTREAM" - "CL-CHAR-STREAM->GSTREAM" - "G/OPEN-INET-SOCKET" - "ACCEPT-CONNECTION" - - "FIND-TEMPORARY-FILE" - "DELETE-TEMPORARY-FILE" - "WITH-TEMPORARY-FILE" +(defpackage "GLISP" + (:use :cl) + (:export "DEFSUBST" + "G/MAKE-STRING" + "MP/MAKE-LOCK" + "MP/WITH-LOCK" + "WITH-TIMEOUT" + "OPEN-INET-SOCKET" + ;; util.lisp : + "ALWAYS" + "CL-BYTE-STREAM" + "CL-CHAR-STREAM" + "CL-STREAM" + "COMPOSE" + "CURRY" + "FALSE" + "FORCE" + "G/CLOSE" + "G/FINISH-OUTPUT" + "G/PEEK-CHAR" + "G/READ-BYTE" + "G/READ-BYTE-SEQUENCE" + "G/READ-CHAR" + "G/READ-CHAR-SEQUENCE" + "G/READ-LINE" + "G/READ-LINE*" + "G/UNREAD-BYTE" + "G/UNREAD-CHAR" + "G/WRITE-BYTE" + "G/WRITE-BYTE-SEQUENCE" + "G/WRITE-CHAR" + "G/WRITE-STRING" + "GSTREAM" + "MAP-ARRAY" + "MAPFCAR" + "MAX*" + "MAXF" + "MIN*" + "MINF" + "MULTIPLE-VALUE-OR" + "MULTIPLE-VALUE-SOME" + "NCONCF" + "NEQ" + "PROMISE" + "RCURRY" + "SANIFY-STRING" + "SHOW" + "SPLIT-BY" + "SPLIT-BY-IF" + "SPLIT-BY-MEMBER" + "SPLIT-STRING" + "STRING-BEGIN-EQUAL" + "TRUE" + "UNTIL" + "USE-BYTE-FOR-CHAR-STREAM-FLAVOUR" + "USE-CHAR-FOR-BYTE-STREAM-FLAVOUR" + "WHILE" + "WHITE-SPACE-P" + + "CL-BYTE-STREAM->GSTREAM" + "CL-CHAR-STREAM->GSTREAM" + "G/OPEN-INET-SOCKET" + "ACCEPT-CONNECTION" + + "FIND-TEMPORARY-FILE" + "DELETE-TEMPORARY-FILE" + "WITH-TEMPORARY-FILE" - "SET-EQUAL" - "MAYBE-PARSE-INTEGER" - "NOP" - "WITH-STRUCTURE-SLOTS" - - "COMPILE-FUNCALL" - "FUNCALL*" - "MAPC*" - "VREDUCE*" - "LREDUCE*" - "WITH-UNIQUE-NAMES" + "SET-EQUAL" + "MAYBE-PARSE-INTEGER" + "NOP" + "WITH-STRUCTURE-SLOTS" + + "COMPILE-FUNCALL" + "FUNCALL*" + "MAPC*" + "VREDUCE*" + "LREDUCE*" + "WITH-UNIQUE-NAMES" - "G/MAKE-HASH-TABLE" - "G/HASHGET" - "G/CLRHASH" - "STIR-HASH-CODES" - "HASH-SEQUENCE" - "HASH/STRING-EQUAL" - "MAKE-STRING-EQUAL-HASH-TABLE" + "G/MAKE-HASH-TABLE" + "G/HASHGET" + "G/CLRHASH" + "STIR-HASH-CODES" + "HASH-SEQUENCE" + "HASH/STRING-EQUAL" + "MAKE-STRING-EQUAL-HASH-TABLE" - "PRIMEP" + "PRIMEP" - ;; match.lisp - "DEFINE-MATCH-MACRO" - "IF-MATCH" - "GSTREAM-AS-STRING" - )) - - (defparameter *packages* - #-GCL '(:common-lisp) - #+GCL '(:lisp :pcl) ) - - (defparameter *gray-symbols* - '("FUNDAMENTAL-STREAM" - "FUNDAMENTAL-INPUT-STREAM" - "FUNDAMENTAL-OUTPUT-STREAM" - "FUNDAMENTAL-CHARACTER-STREAM" - "FUNDAMENTAL-BINARY-STREAM" - "FUNDAMENTAL-CHARACTER-INPUT-STREAM" - "FUNDAMENTAL-CHARACTER-OUTPUT-STREAM" - "FUNDAMENTAL-BINARY-INPUT-STREAM" - - "STREAM-READ-CHAR" - "STREAM-UNREAD-CHAR" - "STREAM-READ-CHAR-NO-HANG" - "STREAM-PEEK-CHAR" - "STREAM-LISTEN" - "STREAM-READ-LINE" - "STREAM-CLEAR-INPUT" - - "STREAM-WRITE-CHAR" - "STREAM-LINE-COLUMN" - "STREAM-START-LINE-P" - "STREAM-WRITE-STRING" - "STREAM-TERPRI" - "STREAM-FRESH-LINE" - "STREAM-FINISH-OUTPUT" - "STREAM-FORCE-OUTPUT" - "STREAM-ADVANCE-TO-COLUMN" - - "STREAM-READ-BYTE" - "STREAM-WRITE-BYTE" )) - - (defparameter *gray-packages* - `( - #+:CLISP ,@'(:lisp) - #+:CMU ,@'(:ext) - #+:sbcl ,@'(:sb-gray) - #+:ALLEGRO ,@'(:common-lisp :excl :stream) - #+:HARLEQUIN-COMMON-LISP ,@'(:stream) - #+:OPENMCL ,@'(:ccl) - )) - - (defun seek-symbol (name packages) - ;; Seek the a symbol named 'name' in `packages' - (or (some #'(lambda (p) - (multiple-value-bind (sym res) (find-symbol name p) - (if (eql res :external) - (list sym) - nil))) - packages) - (progn (format T "~&There is no ~A in ~A." name packages) - (finish-output) - nil))) - - (defun dump-defpackage (&aux imports export-gray) - (labels ((grok (symbols packages) - (let ((res nil)) - (dolist (nam symbols) - (let ((sym (seek-symbol nam packages))) - (when sym - (push (car sym) res) - (cond ((multiple-value-bind (sym2 res) (find-symbol nam :glisp) - (and sym2 (eq res :external))) - ;; - (format T "~&;; ~S is pacthed." sym) ) - (t - (setf sym (car sym)) - ;; CLISP has no (:import ..) ARG! - (push `(:import-from - ,(package-name (symbol-package sym)) - ,(symbol-name sym)) - imports)))))) - res))) - (setf export-gray (grok *gray-symbols* *gray-packages*)) - `(progn - (defpackage "GLISP" - (:use :cl) - ,@imports - (:export - ,@(mapcar #'symbol-name export-gray) - ,@*export-from-glisp*)) - (defpackage "GLUSER" - (:use "CL" "GLISP")) ))) - - (defmacro define-glisp-package () - (dump-defpackage)) - ) - -(define-glisp-package) + ;; match.lisp + "DEFINE-MATCH-MACRO" + "IF-MATCH" + "GSTREAM-AS-STRING")) +(defpackage "GLUSER" + (:use "CL" "GLISP"))

1 0

[closure-cvs] CVS closure/src/glisp
by dlichteblau 31 Dec '06

31 Dec '06

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

1 0

[closure-cvs] CVS closure/src/parse
by dlichteblau 31 Dec '06

31 Dec '06

Update of /project/closure/cvsroot/closure/src/parse In directory clnet:/tmp/cvs-serv29975/src/parse Modified Files: sgml-parse.lisp Log Message: More rune fixes. --- /project/closure/cvsroot/closure/src/parse/sgml-parse.lisp 2006/12/29 21:29:30 1.5 +++ /project/closure/cvsroot/closure/src/parse/sgml-parse.lisp 2006/12/31 12:05:33 1.6 @@ -392,7 +392,7 @@ (t (parse-warn input 3 "Saw character '~A' after '&' -- bad entity reference?!" - (or (code-char ch) + (or (rune-char ch) (format nil "&#x~4,'0X" ch))) (a-unread-byte ch input) ;it might be something interesting (push-on-scratch input sp #/&)) ))) @@ -438,7 +438,7 @@ (do ((ch (a-read-byte input) (a-read-byte input))) ((or (null ch) (not (digit-rune-p ch radix))) ;; Ok. [s1..sp) now is the digit sequence - (let ((num (parse-integer (map 'string #'code-char + (let ((num (parse-integer (map 'string #'rune-char (subseq (a-stream-scratch input) s1 sp)) :radix radix))) (cond ((<= 0 num #xFFFF) @@ -446,7 +446,7 @@ (when (and (not (null ch)) (not (rune= ch #/\;))) (a-unread-byte ch input)) ;; Rewind scratch pad to `s0' and push character `num' - (setf sp (push-on-scratch input s0 num))) + (setf sp (push-on-scratch input s0 (code-rune num)))) (t ;; num too large; emit warning and leave scratch pad alone (when (not (null ch)) @@ -537,7 +537,7 @@ (read-start-tag input dtd)) (t (parse-warn input 3 "Bad character after '<': '~A' -- ignored." - (code-char ch)) + (rune-char ch)) (let ((res (string-rod "<"))) (values :pcdata res))) ))) ) @@ -669,7 +669,7 @@ (t (read-tag-error input "Expected sloopy name, got ~A" - (or (code-char ch) (format nil "U+~4,'0X" ch)) )) ))) + (or (rune-char ch) (format nil "U+~4,'0X" ch)) )) ))) (defun read-sloopy-value (input) (let ((ch (a-peek-byte input)) @@ -683,7 +683,7 @@ (setf sp (push-on-scratch input sp ch)))) (t (read-tag-error input "Expected sloopy value, got ~A" - (or (code-char ch) (format nil "U+~4,'0X" ch)) )) ))) + (or (rune-char ch) (format nil "U+~4,'0X" ch)) )) ))) (defun read-define-tag (input dtd) (let ((ch (a-peek-byte input)))

1 0

[closure-cvs] CVS closure/src/css
by dlichteblau 31 Dec '06

31 Dec '06

Update of /project/closure/cvsroot/closure/src/css In directory clnet:/tmp/cvs-serv29975/src/css Modified Files: css-parse.lisp css-support.lisp Log Message: More rune fixes. --- /project/closure/cvsroot/closure/src/css/css-parse.lisp 2006/12/29 21:29:23 1.6 +++ /project/closure/cvsroot/closure/src/css/css-parse.lisp 2006/12/31 12:05:33 1.7 @@ -1153,6 +1153,10 @@ (eql a b)) (defun hieroglyph-equal (a b) (equal a b)) +(defun hieroglyph-char (x) + (code-char x)) +(defun papyrus-string (v) + (map 'string (lambda (x) (or (hieroglyph-char x) #\?)) v)) (defun find-value-parser (slot) (unless (typep slot 'rod) --- /project/closure/cvsroot/closure/src/css/css-support.lisp 2006/12/29 21:29:24 1.4 +++ /project/closure/cvsroot/closure/src/css/css-support.lisp 2006/12/31 12:05:33 1.5 @@ -37,9 +37,12 @@ ;;; hmmm -(defun intern-attribute-name (string) +(defun intern-attribute-name (papyrus) ;; XXX hack - (intern (string-upcase (map 'string (lambda (x) (or (rune-char x) #\?)) string)) :keyword)) + (intern (string-upcase (if (stringp papyrus) + papyrus + (papyrus-string papyrus))) + :keyword)) (defun intern-gi (string) (intern-attribute-name string))

1 0

[closure-cvs] CVS closure/src/html
by dlichteblau 31 Dec '06

31 Dec '06

Update of /project/closure/cvsroot/closure/src/html In directory clnet:/tmp/cvs-serv29975/src/html Modified Files: html-style.lisp Log Message: More rune fixes. --- /project/closure/cvsroot/closure/src/html/html-style.lisp 2006/12/29 21:29:28 1.8 +++ /project/closure/cvsroot/closure/src/html/html-style.lisp 2006/12/31 12:05:33 1.9 @@ -191,9 +191,6 @@ (t (format nil "[invalid html-length: ~S]" value)))) -(defun rod->string (x) - (map 'simple-string (lambda (x) (or (code-char x) #\?)) x)) - (defun pt-attr/with-parser (pt slot default parser pretty-type-name) (let ((s (pt-attr* pt slot))) (if (not s) @@ -203,7 +200,7 @@ value (progn (pt-attr-warn pt "The value of the ~A attribute, ~S, is not ~A." - slot (rod->string s) pretty-type-name) + slot (rod-string s) pretty-type-name) default)))))) (defun pt-attr/integer (pt slot &optional default) @@ -238,7 +235,7 @@ (progn (pt-attr-warn pt "The value of the ~A attribute, ~ should be ~{\"~A\"~#[~; or ~:;, ~]~}, but not ~S." - slot keys (rod->string s)) + slot keys (rod-string s)) default))))))) (defun pt-attr/table.frame (pt slot &optional default) @@ -298,28 +295,28 @@ (defun html/parse-integer (s) (if-match (s :type rod :test #'rune=) (& (w*) (= $res (integer)) (w*)) - (parse-integer (rod->string (subseq s $res-start $res-end))))) + (parse-integer (rod-string (subseq s $res-start $res-end))))) (defun html/parse-length (s) (or (if-match (s :type rod :test #'rune=) (& (w*) (= $res (integer)) (w*)) - (cons :px (parse-integer (rod->string (subseq s $res-start $res-end))))) + (cons :px (parse-integer (rod-string (subseq s $res-start $res-end))))) (if-match (s :type rod :test #'rune=) (& (w*) (= $res (integer)) #.(char-code #\%) (w*)) - (cons :% (parse-integer (rod->string (subseq s $res-start $res-end))))))) + (cons :% (parse-integer (rod-string (subseq s $res-start $res-end))))))) (defun html/parse-multi-length (s) (or (html/parse-length s) (if-match (s :type rod :test #'rune=) (& (w*) (= $res (integer)) #.(char-code #\*) (w*)) - (cons '* (parse-integer (rod->string (subseq s $res-start $res-end))))) + (cons '* (parse-integer (rod-string (subseq s $res-start $res-end))))) ;; This below is illegal syntax '*i' is not allowed #+(OR) (if-match (s :type rod :test #'rune=) (& (w*) #.(char-code #\*) (= $res (integer)) (w*)) - (cons '* (parse-integer (rod->string (subseq s $res-start $res-end))))) + (cons '* (parse-integer (rod-string (subseq s $res-start $res-end))))) ;; "*" is abbrev for "1*" (if-match (s :type rod :test #'rune=) (& (w*) #.(char-code #\*) (w*))

1 0

← Newer
1
...
6
7
8
9
10
11
12
...
21
Older →

Jump to page:

2024

2023

2022

2021

2020

2019

2018

2017

2016

2015

2014

2013

2012

2011

2010

2009

2008

2007

2006

2005

closure-cvs