Mon May 11 14:30:33 CEST 2009 Tobias Rautenkranz * cleanup: use package alexandria. diff -rN -u old-smoke/src/cxx-method.lisp new-smoke/src/cxx-method.lisp --- old-smoke/src/cxx-method.lisp 2014-11-28 13:26:14.000000000 +0100 +++ new-smoke/src/cxx-method.lisp 2014-11-28 13:26:15.000000000 +0100 @@ -40,8 +40,8 @@ (defun cxx-method-generic-function-name (cxx-generic-function argument-count) (let ((*package* (find-package :cxx))) - (alexandria:symbolicate (closer-mop:generic-function-name cxx-generic-function) - #\/ (write-to-string argument-count)))) + (symbolicate (closer-mop:generic-function-name cxx-generic-function) + #\/ (write-to-string argument-count)))) (defun ensure-gf-by-argument-count (cxx-generic-function argument-count) "Returns the generic-function of CXX-GENERIC-FUNCTION that takes diff -rN -u old-smoke/src/method.lisp new-smoke/src/method.lisp --- old-smoke/src/method.lisp 2014-11-28 13:26:14.000000000 +0100 +++ new-smoke/src/method.lisp 2014-11-28 13:26:15.000000000 +0100 @@ -13,9 +13,7 @@ ".+" (name method) "+"))))) (values - ; `(defconstant ,symbol - ; ,(enum-call method)) - `(alexandria:define-constant ,symbol + `(define-constant ,symbol (make-instance 'enum :value ,(enum-call method) :type (make-instance 'smoke-type @@ -36,7 +34,7 @@ ".")) (name method))))) -(defun static-method-definition (method smoke) +(defun static-method-definition (method) "Returns an expression to define a function for the static METHOD. The second return value is the expression to export the function." (let* ((class (get-class method)) @@ -115,14 +113,14 @@ (let ((function-symbol (static-method-symbol method))) (unless (nth-value 1 (gethash function-symbol function-symbols)) (setf (gethash function-symbol function-symbols) t) - (multiple-value-bind (def export) (static-method-definition method smoke) + (multiple-value-bind (def export) (static-method-definition method) (push def functions) (push export exports))))))) (eval smoke)) `(progn (check-recompile ,smoke) ,@functions (eval-when (:load-toplevel :execute) - (ensure-generic-methods ',(alexandria:hash-table-alist generics)) + (ensure-generic-methods ',(hash-table-alist generics)) (make-smoke-classes ,smoke)) ,@constants ,@exports))) diff -rN -u old-smoke/src/overload-resolution.lisp new-smoke/src/overload-resolution.lisp --- old-smoke/src/overload-resolution.lisp 2014-11-28 13:26:14.000000000 +0100 +++ new-smoke/src/overload-resolution.lisp 2014-11-28 13:26:15.000000000 +0100 @@ -29,7 +29,7 @@ index (if (and (< diff (length name)) (or (>= diff (length method-name)) - (char< (char method-name diff) (char name diff)))) + (char< (char method-name diff) (char name diff)))) (binary-search-method-names name smoke (1+ index) end) (binary-search-method-names name smoke start (1- index)))) index)))) @@ -214,7 +214,7 @@ (defun+using-type get-conversion-sequence object (object type &optional user) "Retruns a conversion sequence to convert a instance of type CLASS to an instance of type TYPE. When USER is true user conversions are considered." - (alexandria:if-let + (if-let (match (call-using-type exact-match object type)) (if (eql t match) (make-match 'exact-match) @@ -280,7 +280,7 @@ (defmacro smoke-type-case ((keyform class) &body clauses) `(string-case ((name ,keyform)) - ,@(mapcar (alexandria:curry #'apply + ,@(mapcar (curry #'apply #'(lambda (type-name lisp-type) `(,type-name (typep-using-type ,class (quote ,lisp-type))))) clauses))) @@ -290,7 +290,7 @@ (defmacro define-from-lisp-translation (type-names lisp-type &optional (conversion-function-name 'identity)) - `(progn ,@(loop for type-name in (alexandria:ensure-list type-names) + `(progn ,@(loop for type-name in (ensure-list type-names) collect `(setf (gethash ,type-name *from-lisp-translations*) #'(lambda (type) (and (subtypep type ',lisp-type) @@ -302,14 +302,11 @@ ;; FIXME grovel this? (deftype c-integer (ctype) (let ((bits (* 8 (foreign-type-size ctype)))) - (if (alexandria:starts-with-subseq + (if (starts-with-subseq (symbol-name :unsigned) (symbol-name ctype)) - ;`(integer 0 ,(1- (expt 2 bits))) `(unsigned-byte ,bits) `(signed-byte ,bits)))) - ;`(integer ,(- (expt 2 (1- bits))) - ; ,(1- (expt 2 (1- bits))))))) ;(defun exact-match-using-type (object-type type) @@ -318,7 +315,7 @@ ;(declare (values boolean)) (case (type-id type) (0 - (alexandria:when-let (test (gethash (name type) *from-lisp-translations*)) + (when-let (test (gethash (name type) *from-lisp-translations*)) (funcall test (object.type-of)))) (1 (object.typep 'boolean)) (2 (object.typep 'standard-char)) @@ -466,13 +463,3 @@ (apply #'call-sequence method (null-pointer) sequence arguments) (apply #'call-sequence method (cast object-or-class (get-class method)) sequence arguments))))) - - -(defun cxx-coerce-p-using-type (type result-type) - "Returns true when an object of type TYPE can be convertet to an object -of smoke type RESULT-TYPE." -) - - -(defun cxx-coerce (object result-type) -) diff -rN -u old-smoke/src/package.lisp new-smoke/src/package.lisp --- old-smoke/src/package.lisp 2014-11-28 13:26:14.000000000 +0100 +++ new-smoke/src/package.lisp 2014-11-28 13:26:15.000000000 +0100 @@ -10,7 +10,8 @@ #:enum-ecase)) (defpackage #:smoke - (:use #:cl #:cffi #:trivial-garbage #:bordeaux-threads #:cxx-support) + (:use #:cl #:cffi #:trivial-garbage #:bordeaux-threads #:cxx-support + #:alexandria) (:export #:init #:make-smoke-classes diff -rN -u old-smoke/src/using-type.lisp new-smoke/src/using-type.lisp --- old-smoke/src/using-type.lisp 2014-11-28 13:26:14.000000000 +0100 +++ new-smoke/src/using-type.lisp 2014-11-28 13:26:15.000000000 +0100 @@ -1,10 +1,10 @@ (in-package :smoke) (defmacro with-object-as-object (object &body body) - `(macrolet ((,(alexandria:symbolicate object '.typep) + `(macrolet ((,(symbolicate object '.typep) (type) `(typep ,',object ,type)) - (,(alexandria:symbolicate object '.type-of) () + (,(symbolicate object '.type-of) () `(class-of ,',object)) (using-typep () nil) (call-using-types (function-name &rest args) @@ -33,17 +33,17 @@ (throw 'unspecific-type (values object-type)))))) (defmacro with-object-as-type (object-type &body body) - `(macrolet ((,(alexandria:symbolicate object-type '.typep) + `(macrolet ((,(symbolicate object-type '.typep) (type) `(typep-using-type ,',object-type ,type)) - (,(alexandria:symbolicate object-type '.type-of) () + (,(symbolicate object-type '.type-of) () (quote ,object-type)) (using-typep () t) (call-using-types (function-name &rest args) - `(,(alexandria:symbolicate function-name '-using-types) + `(,(symbolicate function-name '-using-types) ,@args)) (call-using-type (function-name &rest args) - `(,(alexandria:symbolicate function-name '-using-type) + `(,(symbolicate function-name '-using-type) ,@args))) ,@body)) @@ -56,7 +56,7 @@ (defun ,name ,lambda-list ,@body)) (with-object-as-type ,object - (defun ,(alexandria:symbolicate name '-using-type) ,lambda-list + (defun ,(symbolicate name '-using-type) ,lambda-list ,@body)))) (defmacro defun+using-types (name lambda-list &body body) @@ -70,13 +70,13 @@ (defun ,name ,lambda-list ,@body)) (macrolet ((call-using-types (function-name &rest args) - `(,(alexandria:symbolicate function-name '-using-types) + `(,(symbolicate function-name '-using-types) ,@args)) (call-using-type (function-name &rest args) - `(,(alexandria:symbolicate function-name '-using-type) + `(,(symbolicate function-name '-using-type) ,@args)) (using-typep () t) (function-using-types (name) - `(function ,(alexandria:symbolicate name '-using-types)))) - (defun ,(alexandria:symbolicate name '-using-types) ,lambda-list + `(function ,(symbolicate name '-using-types)))) + (defun ,(symbolicate name '-using-types) ,lambda-list ,@body))))