Mon May 11 14:30:33 CEST 2009 Tobias Rautenkranz <tobias@rautenkranz.ch>

* cleanup: use package alexandria.

--- old-smoke/src/cxx-method.lisp 2014-09-30 10:26:01.000000000 +0200

+++ new-smoke/src/cxx-method.lisp 2014-09-30 10:26:01.000000000 +0200

@@ -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

--- old-smoke/src/method.lisp 2014-09-30 10:26:01.000000000 +0200

+++ new-smoke/src/method.lisp 2014-09-30 10:26:01.000000000 +0200

@@ -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)))

--- old-smoke/src/overload-resolution.lisp 2014-09-30 10:26:01.000000000 +0200

+++ new-smoke/src/overload-resolution.lisp 2014-09-30 10:26:01.000000000 +0200

@@ -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)

-)

--- old-smoke/src/package.lisp 2014-09-30 10:26:01.000000000 +0200

+++ new-smoke/src/package.lisp 2014-09-30 10:26:01.000000000 +0200

@@ -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

--- old-smoke/src/using-type.lisp 2014-09-30 10:26:01.000000000 +0200

+++ new-smoke/src/using-type.lisp 2014-09-30 10:26:01.000000000 +0200

@@ -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))))