Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
Browse files

lispworks conditionalization

  • Loading branch information...
commit 5ecfb67ea17cb4911d2c6b31d7663aa2c4c1bd86 1 parent fea0ec5
@lisp authored
View
30 classes.lisp
@@ -224,15 +224,18 @@
(:method ((identifier string))
identifier))
-
-(defmethod c2mop:direct-slot-definition-class ((class thrift-class) &key identifier (identifier-name identifier))
+;;; 20110402 : lw does not allow for standard argument keys, thus the &allow-other-keys here
+(defmethod c2mop:direct-slot-definition-class ((class thrift-class) &key
+ identifier (identifier-name identifier)
+ &allow-other-keys)
"If an id is present in the definition, the slot is included to pr included when de/serializing"
(cond (identifier-name
(find-class 'direct-field-definition))
(t
(call-next-method))))
-(defmethod c2mop:effective-slot-definition-class ((class thrift-class) &key name)
+(defmethod c2mop:effective-slot-definition-class ((class thrift-class) &key name
+ &allow-other-keys)
"If some direct lost definition indicates thrift support, them carry that over to the effective definition"
(if (some #'(lambda (class)
(typep (find name (c2mop:class-direct-slots class) :key #'field-definition-name)
@@ -313,7 +316,26 @@
;; for use in macros
(getf (cddr fd) :type))
(:method ((sd c2mop:slot-definition))
- (c2mop:slot-definition-type sd)))
+ (let ((literal-type (c2mop:slot-definition-type sd)))
+ ;; clozure rewrites the types specified in a slot definition
+ (etypecase literal-type
+ (symbol (case literal-type
+ (boolean 'bool)
+ (double-float 'thrift:double)
+ (single-float 'thrift:float)
+ (base-string 'string)
+ (t literal-type)))
+ (cons (case (first literal-type)
+ (member (if (or (equal '(member nil t) literal-type) (equal '(member t nil) literal-type))
+ 'bool
+ literal-type))
+ (signed-byte (ecase (second literal-type)
+ (8 'i08)
+ (16 'i16)
+ (32 'i32)
+ (64 'i64)))
+ ((array vector) 'binary)
+ (t literal-type)))))))
(defgeneric class-field-definitions (class)
View
21 package.lisp
@@ -41,7 +41,9 @@
#+sbcl
(:import-from :sb-gray
:stream-write-string)
-
+ #+lispworks
+ (:import-from :stream
+ :stream-write-string)
(:export
:*binary-transport-element-type*
:application-error
@@ -195,28 +197,33 @@
stream operators.")
(:shadowing-import-from :common-lisp :byte :set :list :map :type-of :float)
-
+
+ (:import-from :de.setf.utility
+ :stream-reader
+ :stream-writer
+ )
#+ccl
(:import-from :ccl
:stream-write-byte :stream-read-byte
- :stream-close :stream-direction
+ :stream-direction
:stream-position
- :stream-read-sequence :stream-write-sequence
:stream-force-output :stream-finish-output)
-
+ #+mcl
+ (:import-from :ccl
+ :stream-close
+ :stream-read-sequence :stream-write-sequence
+ :stream-tyi :stream-tyo :stream-untyi)
#+clozure
(:import-from :ccl
:double-float-positive-infinity
:double-float-negative-infinity
#+ccl-1.4 :double-float-nan)
-
#+sbcl
(:import-from :sb-ext
:double-float-positive-infinity
:double-float-negative-infinity
:single-float-positive-infinity
:single-float-negative-infinity)
-
#+sbcl
(:import-from :sb-gray
:stream-write-byte :stream-read-byte
View
11 parameters.lisp
@@ -185,3 +185,14 @@
(eval '(+ single-float-positive-infinity single-float-negative-infinity)))
(defconstant double-float-nan
(eval '(+ double-float-positive-infinity double-float-negative-infinity)))))
+
+#+lispworks
+(progn
+ (defconstant double-float-positive-infinity system::*plus-infinity-double*)
+ (defconstant double-float-negative-infinity system::*minus-infinity-double*)
+ (defconstant single-float-positive-infinity (coerce system::*plus-infinity-double* 'single-float))
+ (defconstant single-float-negative-infinity (coerce system::*minus-infinity-double* 'single-float))
+
+ (defconstant single-float-nan (+ single-float-positive-infinity single-float-negative-infinity))
+ (defconstant double-float-nan (+ double-float-positive-infinity double-float-negative-infinity))
+ )
View
4 types.lisp
@@ -63,7 +63,9 @@
'list)
-(deftype base-type () '(member bool thrift:byte i08 i16 i32 i64 double thrift:float string binary))
+(deftype base-type ()
+ "Indicates the union of thrift base (atomic) types."
+ '(member bool thrift:byte i08 i16 i32 i64 double thrift:float string binary))
(defun base-type-p (type)
(typep type 'base-type))
View
4 vector-protocol.lisp
@@ -154,7 +154,7 @@
(incf position)
byte))))
-#+ccl
+#+mcl
(defmethod ccl:stream-tyi ((stream vector-input-stream))
(stream-read-byte stream))
@@ -198,7 +198,7 @@
(setf position next)))
-#+ccl
+#+mcl
(defmethod ccl:stream-tyo ((stream vector-output-stream) byte)
(stream-write-byte stream byte))
Please sign in to comment.
Something went wrong with that request. Please try again.