Tue May 19 13:09:12 CEST 2009 Tobias Rautenkranz <tobias@rautenkranz.ch>
* Fix loading with Clozure CL
diff -rN -u old-smoke/src/clos.lisp new-smoke/src/clos.lisp
--- old-smoke/src/clos.lisp 2014-09-30 10:27:37.000000000 +0200
+++ new-smoke/src/clos.lisp 2014-09-30 10:27:38.000000000 +0200
@@ -11,6 +11,7 @@
(values (intern (cxx-to-lisp name)))
(values (intern (cxx-to-lisp name) package))))
+
(defmacro define-string-transform (name documentation &body states)
"Defines a function to transform a string."
(let ((output (gensym))
@@ -310,6 +311,12 @@
(unless (void-p type)
(set-returnvalue stack value type)))
+(defun get-gf-for-method (smoke-method)
+ (declare (smoke-method smoke-method)
+ (optimize (speed 3)))
+ (symbol-function (lispify (name smoke-method) "CXX")))
+;(memoize:memoize-function 'get-gf-for-method)
+
(defcallback dispatch-method :boolean
((binding :pointer)
(method smoke-index)
@@ -320,7 +327,7 @@
(let ((method (make-instance 'smoke-method
:id method
:smoke (smoke-get-smoke binding))))
- (let ((gf (symbol-function (lispify (name method) "CXX"))))
+ (let ((gf (get-gf-for-method method)))
(if (null (gf-methods gf))
(progn
(when abstract
diff -rN -u old-smoke/src/cxx-method.lisp new-smoke/src/cxx-method.lisp
--- old-smoke/src/cxx-method.lisp 2014-09-30 10:27:37.000000000 +0200
+++ new-smoke/src/cxx-method.lisp 2014-09-30 10:27:37.000000000 +0200
@@ -1,13 +1,5 @@
(in-package :smoke)
-(defclass cxx-method-generic-function (standard-generic-function)
- ((generic-function :accessor cxx-generic-function
- :initarg :cxx-generic-function
- :type cxx-generic-function
- :documentation "Contains the generic function."))
- (:metaclass closer-mop:funcallable-standard-class)
- (:documentation "Generic function of a specify argument count."))
-
(defclass cxx-generic-function (standard-generic-function)
((gf-methods :initform nil
:accessor gf-methods
@@ -17,6 +9,16 @@
(:documentation
"A generic function that can be overloaded by argument count."))
+(defclass cxx-method-generic-function (standard-generic-function)
+ ((generic-function :accessor cxx-generic-function
+ :initarg :cxx-generic-function
+ :type cxx-generic-function
+ :documentation "Contains the generic function."))
+ (:metaclass closer-mop:funcallable-standard-class)
+ (:documentation "Generic function of a specify argument count."))
+
+
+
(defun make-lambda (argument-count)
"Returns a lambda expression for ARGUMENT-COUNT arguments."
(declare ((integer 0) argument-count))
diff -rN -u old-smoke/src/method.lisp new-smoke/src/method.lisp
--- old-smoke/src/method.lisp 2014-09-30 10:27:37.000000000 +0200
+++ new-smoke/src/method.lisp 2014-09-30 10:27:37.000000000 +0200
@@ -52,13 +52,17 @@
`(list ,@(make-lambda argument-count)))))
name)))
-(defun generic-method-definition (name cxx-name)
- (values
- `(ensure-generic-function (quote ,name)
- :cxx-name ,cxx-name
+(defun ensure-generic-methods (symbols-names)
+ "Ensures the generic functions for SYMBOLS-NAMES."
+ (declare (list symbols-names)
+ (optimize (speed 3)))
+ (dolist (symbol-name symbols-names)
+ (ensure-generic-function (first symbol-name)
+ :cxx-name (rest symbol-name)
:generic-function-class 'smoke-gf
:lambda-list '(object &rest args))
- name))
+ (export (first symbol-name) :cxx)))
+
(defun setf-method-definition (method)
`(defun (setf ,(lispify (subseq (name method) 3) :cxx)) (new-value object)
@@ -89,10 +93,8 @@
(let ((generics (make-hash-table))
(constants)
(functions)
- (ensure-generics)
(function-symbols (make-hash-table))
(setf-function-symbols (make-hash-table))
- (cxx-exports)
(exports))
(map-methods
#'(lambda (method)
@@ -138,20 +140,13 @@
-1))
(push definition functions)
(push export exports))))
- (loop for name being the hash-key of generics
- for cxx-name being the hash-value of generics do
- (multiple-value-bind (definition export)
- (generic-method-definition name cxx-name)
- (push definition ensure-generics)
- (push export cxx-exports)))
`(progn (check-recompile ,smoke)
,@functions
(eval-startup (:execute)
(register-smoke-module-var (quote ,smoke))
- (make-smoke-classes ,smoke))
- (eval-when (:load-toplevel :execute)
- ,@ensure-generics)
- (export (quote ,cxx-exports) :cxx)
+ (make-smoke-classes ,smoke)
+ (ensure-generic-methods ',(hash-table-alist generics)))
,@constants
- (export (quote ,exports)))))
+ (eval-when (:load-toplevel :execute)
+ (export (quote ,exports))))))
diff -rN -u old-smoke/src/overload-resolution.lisp new-smoke/src/overload-resolution.lisp
--- old-smoke/src/overload-resolution.lisp 2014-09-30 10:27:37.000000000 +0200
+++ new-smoke/src/overload-resolution.lisp 2014-09-30 10:27:38.000000000 +0200
@@ -109,9 +109,10 @@
methods)))))))))
methods))
+(eval-when (:compile-toplevel :load-toplevel :execute)
(defconstant +exact-match+ 0)
(defconstant +promotion+ 1)
-(defconstant +conversion+ 2)
+(defconstant +conversion+ 2))
(defclass std-conversion ()
((function-name :accessor conversion-function-name
diff -rN -u old-smoke/src/package.lisp new-smoke/src/package.lisp
--- old-smoke/src/package.lisp 2014-09-30 10:27:37.000000000 +0200
+++ new-smoke/src/package.lisp 2014-09-30 10:27:37.000000000 +0200
@@ -27,8 +27,6 @@
#:id
#:smoke-type=
- #:define-methods
-
#:cxx-bool
#:define-from-lisp-translation