Permalink
Browse files

add single float type; modify vector protocol for use as rdf value en…

…coder
  • Loading branch information...
1 parent d4e5de6 commit bb99cc30db83a88d4ba1971c09cd9fa2b6838863 @lisp committed Jul 31, 2010
Showing with 44 additions and 61 deletions.
  1. +5 −3 binary-protocol.lisp
  2. +8 −3 package.lisp
  3. +1 −0 parameters.lisp
  4. +1 −1 test/package.lisp
  5. +1 −1 test/thrift-test.asd
  6. +11 −8 types.lisp
  7. +17 −45 vector-protocol.lisp
@@ -122,7 +122,9 @@
(unpack-buffer)
(ieee-754-64-integer-to-float value))))
-(defmethod stream-read-single ((protocol binary-protocol))
+(defmethod stream-read-float ((protocol binary-protocol))
+ "As a special for for use with rdf - not part of the thrift. used just for specifically
+ coded struct declarations."
;; this is not part of the thrift spec, but is useful elsewhere
(let ((value 0)
(buffer (make-array 4 :element-type '(unsigned-byte 8))))
@@ -233,8 +235,8 @@
(stream-write-sequence (protocol-output-transport protocol) buffer)
8))
-(defmethod stream-write-single ((protocol binary-protocol) val)
- ;; this is not part of the spec, but is usefule elsewhere
+(defmethod stream-write-float ((protocol binary-protocol) val)
+ " Not part of the spec, but is useful elsewhere"
;; distinct from i34, as it's unsigned
(let ((buffer (make-array 4 :element-type '(unsigned-byte 8)))
(int-value (ieee-754-32-float-to-integer val)))
View
@@ -79,6 +79,7 @@
:field-definition-type
:field-size-error
:field-type-error
+ :float
:method-definition
:i08
:i16
@@ -115,6 +116,7 @@
:stream-read-field
:stream-read-field-begin
:stream-read-field-end
+ :stream-read-float
:stream-read-i08
:stream-read-i16
:stream-read-i32
@@ -132,7 +134,6 @@
:stream-read-set
:stream-read-set-begin
:stream-read-set-end
- :stream-read-single
:stream-read-string
:stream-read-struct
:stream-read-struct-begin
@@ -143,6 +144,7 @@
:stream-write-bool
:stream-write-double
:stream-write-field
+ :stream-write-float
:stream-write-i08
:stream-write-i16
:stream-write-i32
@@ -152,7 +154,6 @@
:stream-write-message
:stream-write-message-type
:stream-write-set
- :stream-write-single
:stream-write-string
:stream-write-struct
:stream-write-type
@@ -174,6 +175,10 @@
:unknown-field-error
:unknown-method
:unknown-method-error
+ :vector-input-stream
+ :vector-output-stream
+ :vector-stream-transport
+ :vector-stream-vector
:void
))
@@ -189,7 +194,7 @@
It also imports names as required per run-time for access to standard floating point constants and gray
stream operators.")
- (:shadowing-import-from :common-lisp :byte :set :list :map :type-of)
+ (:shadowing-import-from :common-lisp :byte :set :list :map :type-of :float)
#+ccl
(:import-from :ccl
View
@@ -31,6 +31,7 @@
(thrift:byte . 3)
(i08 . 3)
(double . 4)
+ (thrift:float . 5) ; this is not standard
(i16 . 6)
(enum . 6)
(i32 . 8)
View
@@ -4,7 +4,7 @@
(defpackage :thrift-test
- (:shadowing-import-from :thrift :byte :set :list :map :type-of)
+ (:shadowing-import-from :thrift :byte :set :list :map :type-of :float)
(:use :common-lisp :thrift)
#+ccl
(:import-from :ccl :stream-tyo :stream-tyi :stream-reader :stream-writer
@@ -8,7 +8,7 @@
:description "tests for com.apache.thrift"
:serial t
:components ((:file "package")
- (:file "vector-stream")
+ (:file "vector-protocol")
(:file "test")
(:file "conditions")
(:file "definition-operators")
View
@@ -35,7 +35,9 @@
(deftype i16 () '(signed-byte 16))
(deftype i32 () '(signed-byte 32))
(deftype i64 () '(signed-byte 64))
-;; double is standard
+(deftype thrift:float ()
+ "distinguish float from double for explicit struct codecs"
+ 'single-float)
;; string is standard
(deftype double () 'double-float)
;;; this is not what the spec says (it claims i08), but that makes no sense
@@ -61,7 +63,7 @@
'list)
-(deftype base-type () '(member bool thrift:byte i08 i16 i32 i64 double string binary))
+(deftype base-type () '(member bool thrift:byte i08 i16 i32 i64 double thrift:float string binary))
(defun base-type-p (type)
(typep type 'base-type))
@@ -124,19 +126,20 @@
(:documentation "Implements an equivalent to cl:type-of, but return the most specific thrift
type instead of the cl type. This is used to determine the encoding for dynamically generated
messages.")
-
+
(:method ((value null))
'bool)
(:method ((value (eql t)))
'bool)
(:method ((value integer))
(etypecase value
- (i08 'thrift:byte)
- (i16 'i16)
- (i32 'i32)
- (i64 'i64)))
+ (i08 'thrift:byte)
+ (i16 'i16)
+ (i32 'i32)
+ (i64 'i64)))
(:method ((value float))
- 'double)
+ "return double for all floats as the single form is non-standard"
+ 'double)
(:method ((value string))
'string)
(:method ((value vector))
View
@@ -1,6 +1,6 @@
-;;; -*- Mode: lisp; Syntax: ansi-common-lisp; Base: 10; Package: thrift-test; -*-
+;;; -*- Mode: lisp; Syntax: ansi-common-lisp; Base: 10; Package: org.apache.thrift.implementation; -*-
-(in-package :thrift-test)
+(in-package :org.apache.thrift.implementation)
;;; define a binary stream to wrap a vector for use in tests.
;;; adapted from the cl-xml version to restrict i/o to unsigned byte operations.
@@ -16,7 +16,7 @@
:initform 0
:reader get-stream-position :writer setf-stream-position)
(vector
- :reader get-vector-stream-vector :writer setf-vector-stream-vector
+ :accessor vector-stream-vector
:type vector)
(force-output-hook
:initform nil :initarg :force-output-hook
@@ -60,23 +60,24 @@
(make-array length :element-type type :initial-element 0))
(defmethod shared-initialize
- ((instance vector-stream) (slots t) &key (vector nil vector-s))
+ ((instance vector-stream) (slots t) &key (vector nil vector-s) (length 128))
(with-slots (position) instance
(setf position 0)
(when vector-s
- (setf-vector-stream-vector
- (etypecase vector
- (string (setf vector (map 'vector #'char-code vector)))
- (cl:list (setf vector (map 'vector #'(lambda (datum)
- (etypecase datum
- (fixnum datum)
- (character (char-code datum))))
- vector)))
- (vector vector))
- instance))
+ (setf (vector-stream-vector instance)
+ (etypecase vector
+ (string (map-into (make-vector-stream-buffer (length vector)) #'char-code vector))
+ (cl:cons (map-into (make-vector-stream-buffer (length vector))
+ #'(lambda (datum)
+ (etypecase datum
+ (fixnum datum)
+ (character (char-code datum))))
+ vector))
+ (vector vector)
+ (null (setf (vector-stream-vector instance) (make-vector-stream-buffer length))))))
(call-next-method)
(unless (slot-boundp instance 'vector)
- (setf-vector-stream-vector (make-vector-stream-buffer 128) instance))))
+ (setf (vector-stream-vector instance) (make-vector-stream-buffer length)))))
#+cmu
(let ((old-definition (fdefinition 'stream-element-type)))
@@ -108,7 +109,7 @@
((vs vector-stream) (stream t)
&aux (*print-array* t) (*print-length* 32) (*print-base* 16))
(print-unreadable-object (vs stream :type t)
- (princ (get-vector-stream-vector vs) stream)))
+ (princ (vector-stream-vector vs) stream)))
(defmethod stream-force-output ((stream vector-stream))
(let ((hook (stream-force-output-hook stream)))
@@ -179,32 +180,3 @@
:start2 start :end2 end)
(setf position new-position))
new-position)))
-
-
-;;;
-;;;
-
-#+(or)
-(progn
- (stream-write-byte (make-instance 'vector-stream-transport) 1)
- (stream-write-byte (make-instance 'vector-stream-transport) -1)
- (let* ((data #(0 1 2 3 4 5 6 7 8 9 246 247 248 249 250 251 252 253 254 255))
- (buffer (make-array 2 :element-type thrift::*binary-transport-element-type*))
- (outstream (make-instance 'vector-output-stream :vector buffer))
- (instream (make-instance 'vector-input-stream :vector nil)))
- (write-sequence data outstream)
- (map nil #'(lambda (c) (stream-write-byte outstream (char-code c))) "asdf")
-
- (and (every #'eql
- (concatenate 'vector data (map 'vector #'char-code "asdf"))
- (subseq (get-vector-stream-vector outstream) 0 (stream-position outstream)))
- (let ((data2 (make-array (length data)))
- (data3 (make-array 4)))
- (setf-vector-stream-vector (get-vector-stream-vector outstream) instream)
- (and (eql (stream-read-sequence instream data2) (length data2))
- (equalp data2 data))
- (eql (stream-read-sequence instream data3) 4)
- (equal (map 'string #'code-char data3) "asdf"))))
- )
-
-

0 comments on commit bb99cc3

Please sign in to comment.