Permalink
Browse files

Initial commit of Common Lisp protocol buffer project.

  • Loading branch information...
0 parents commit 5d1a42687dc1fd58fda780c3f33d3a9013cf4612 Robert Brown committed Sep 30, 2008
Showing with 9,296 additions and 0 deletions.
  1. +28 −0 COPYING
  2. +47 −0 README
  3. +10 −0 TODO
  4. +159 −0 base.lisp
  5. BIN golden
  6. +48 −0 optimize.lisp
  7. +175 −0 package.lisp
  8. +182 −0 portable-float.lisp
  9. +309 −0 proto-lisp-test.lisp
  10. +2,907 −0 proto-test.lisp
  11. +504 −0 proto.lisp
  12. +88 −0 protobuf.asd
  13. +87 −0 protocol-buffer.lisp
  14. +3,777 −0 testprotocol.lisp
  15. +219 −0 varint-test.lisp
  16. +756 −0 varint.lisp
@@ -0,0 +1,28 @@
+Copyright 2008, Google Inc.
+All rights reserved.
+
+Redistribution and use in source and binary forms, with or without
+modification, are permitted provided that the following conditions are
+met:
+
+ * Redistributions of source code must retain the above copyright
+notice, this list of conditions and the following disclaimer.
+ * Redistributions in binary form must reproduce the above
+copyright notice, this list of conditions and the following disclaimer
+in the documentation and/or other materials provided with the
+distribution.
+ * Neither the name of Google Inc. nor the names of its
+contributors may be used to endorse or promote products derived from
+this software without specific prior written permission.
+
+THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR
+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT
+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT
+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
@@ -0,0 +1,47 @@
+
+A Common Lisp implementation of Google's protocol buffers.
+
+The code here is a preliminary release. It contains low-level routines for
+encoding and decoding protocol buffer types, such as integers and strings,
+but the translator from protocol buffer descriptions to Lisp code is
+currently unimplemented.
+
+The distribution does include two files that show what translated protocol
+buffer code might look like: testprotocol.lisp and proto-test.lisp.
+
+The release has been tested with clisp and sbcl.
+
+
+INSTALLATION
+============
+
+0. Download and install the packages that this code depends on:
+
+ asdf
+ iterate
+ trivial-utf-8 not needed for Allegro, CLisp, and SBCL
+
+Note that some Common Lisp implementations, such as SBCL, contain a copy of
+the asdf library.
+
+
+1. Make protobuf.asd available to asdf. Either create a symbolic link to
+protobuf.asd in your asdf:*central-registry* directory or load the file into
+your running Lisp with (load "protobuf.asd").
+
+
+2. Load the protobuf code:
+
+ (asdf:operate 'asdf:load-op 'protobuf)
+
+
+3. Run the tests:
+
+ (varint::test)
+ (proto-lisp-test::test)
+
+
+BUGS
+====
+
+Please report bugs and send suggestions to: robert.brown at host gmail.com
@@ -0,0 +1,10 @@
+
+Remove dependency in iterate. It is only used in a couple of places.
+
+Port the tests to a unit test framework.
+
+Implement a protocol buffer compiler in Common Lisp or create a Lisp backend
+for Google's released compiler.
+
+Add more testing code to proto-lisp-test.lisp.
+
@@ -0,0 +1,159 @@
+
+;;;; base.lisp
+
+
+;; Copyright 2008, Google Inc.
+;; All rights reserved.
+
+;; Redistribution and use in source and binary forms, with or without
+;; modification, are permitted provided that the following conditions are
+;; met:
+
+;; * Redistributions of source code must retain the above copyright
+;; notice, this list of conditions and the following disclaimer.
+;; * Redistributions in binary form must reproduce the above
+;; copyright notice, this list of conditions and the following disclaimer
+;; in the documentation and/or other materials provided with the
+;; distribution.
+;; * Neither the name of Google Inc. nor the names of its
+;; contributors may be used to endorse or promote products derived from
+;; this software without specific prior written permission.
+
+;; THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
+;; "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
+;; LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR
+;; A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT
+;; OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
+;; SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT
+;; LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
+;; DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
+;; THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
+;; (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
+;; OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+
+
+(in-package #:base)
+
+(declaim #.optimize:+default+)
+
+
+;;; DEFCONST is equivalent to DEFCONSTANT, but never defines a constant more
+;;; than once. We use DEFCONST because SBCL warns when a constant is
+;;; redefined to a value not EQ to its original value.
+
+(defmacro defconst (name form &optional (doc-string nil))
+ "Define global constant NAME as holding the result of evaluating FORM. When
+DOC-STRING is supplied, make it the constant's documentation."
+ `(eval-when (:compile-toplevel :load-toplevel :execute)
+ (unless (boundp ',name)
+ ,(if doc-string
+ `(defconstant ,name ,form ,doc-string)
+ `(defconstant ,name ,form)))))
+
+
+;;; Lisp integer types with the same numeric range as C++ ints.
+
+(deftype int32 () '(signed-byte 32))
+(deftype int64 () '(signed-byte 64))
+(deftype uint32 () '(unsigned-byte 32))
+(deftype uint64 () '(unsigned-byte 64))
+
+
+;;; Signed to unsigned integer conversions. These are used when
+;;; interoperating with C++ code.
+
+
+(declaim (ftype (function (int32) uint64) int32-to-uint64)
+ #+opt (inline int32-to-uint64))
+
+(defun int32-to-uint64 (value)
+ "Convert the int32 VALUE into a uint64. The conversion is identical to
+that done by the C++ expression static_cast<int64>(X)."
+ (declare (type int32 value)
+ (optimize (debug 0) (safety 0) (speed 3)))
+ (if (minusp value)
+ (+ value (ash 1 64))
+ value))
+
+(declaim (ftype (function (int64) uint64) int64-to-uint64)
+ #+opt (inline int64-to-uint64))
+
+(defun int64-to-uint64 (value)
+ "Convert the int64 value X into a uint64. The conversion is identical to
+that done by the C++ expression static_cast<int64>(X)."
+ (declare (type int64 value)
+ (optimize (debug 0) (safety 0) (speed 3)
+ #+sbcl (sb-ext:inhibit-warnings 3)))
+ (if (minusp value)
+ (+ value (ash 1 64))
+ value))
+
+
+;;; Octet vectors
+
+
+(deftype vector-index () '(integer 0 #.(1- array-dimension-limit)))
+
+(deftype octet () '(unsigned-byte 8))
+(deftype octet-vector () '(simple-array octet (*)))
+(deftype octet-vector-index () '(integer 0 #.(1- array-dimension-limit)))
+
+(defconst +octet-vector-index-bits+
+ (integer-length (1- array-dimension-limit)))
+(defconst +illegal-octet-vector-index+ (1- array-dimension-limit))
+
+
+(declaim (ftype (function (fixnum &key (:initial-contents list)) octet-vector)
+ make-octet-vector))
+
+(defun make-octet-vector (octet-count &key initial-contents)
+ "Create an octet vector containing OCTET-COUNT octets. If INITIAL-CONTENTS
+is not supplied, each element of the vector is initialized to zero. Otherwise,
+the vector is initialized to the contents of list INITIAL-CONTENTS."
+ (declare (type octet-vector-index octet-count)
+ (type list initial-contents))
+ (if initial-contents
+ (make-array octet-count
+ :element-type 'octet
+ :initial-contents initial-contents)
+ (make-array octet-count :element-type 'octet :initial-element 0)))
+
+(declaim (ftype (function (string
+ &key (:start vector-index) (:end vector-index))
+ octet-vector)
+ string-to-utf8-octets))
+
+(defun string-to-utf8-octets (string &key (start 0) (end (length string)))
+ "Convert STRING into an octet-vector by uft-8 encoding each character."
+ (declare (type string string)
+ (type vector-index start end)
+ (optimize (speed 3) (safety 0)))
+ #+allegro
+ (excl:string-to-octets string
+ :start start :end end
+ :null-terminate nil :external-format :utf8)
+ #+clisp
+ (ext:convert-string-to-bytes string charset:utf-8 :start start :end end)
+ #+sbcl
+ (sb-ext:string-to-octets string :start start :end end)
+ #-(or allegro clisp sbcl)
+ (trivial-utf-8:string-to-utf-8-bytes (subseq string start end)))
+
+(declaim (ftype (function (octet-vector
+ &key (:start vector-index) (:end vector-index))
+ string)
+ utf8-octets-to-string))
+
+(defun utf8-octets-to-string (octets &key (start 0) (end (length octets)))
+ "Convert utf-8 encoded OCTETS into a string."
+ (declare (type octet-vector octets)
+ (type vector-index start end)
+ (optimize (speed 3) (safety 0)))
+ #+allegro
+ (excl:octets-to-string octets :start start :end end :external-format :utf8)
+ #+clisp
+ (ext:convert-string-from-bytes octets charset:utf-8 :start start :end end)
+ #+sbcl
+ (sb-ext:octets-to-string octets :start start :end end :external-format :utf8)
+ #-(or allegro clisp sbcl)
+ (trivial-utf-8:utf-8-bytes-to-string (subseq octets start end)))
Binary file not shown.
@@ -0,0 +1,48 @@
+
+;;;; optimize.lisp
+
+
+;; Copyright 2008, Google Inc.
+;; All rights reserved.
+
+;; Redistribution and use in source and binary forms, with or without
+;; modification, are permitted provided that the following conditions are
+;; met:
+
+;; * Redistributions of source code must retain the above copyright
+;; notice, this list of conditions and the following disclaimer.
+;; * Redistributions in binary form must reproduce the above
+;; copyright notice, this list of conditions and the following disclaimer
+;; in the documentation and/or other materials provided with the
+;; distribution.
+;; * Neither the name of Google Inc. nor the names of its
+;; contributors may be used to endorse or promote products derived from
+;; this software without specific prior written permission.
+
+;; THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
+;; "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
+;; LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR
+;; A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT
+;; OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
+;; SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT
+;; LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
+;; DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
+;; THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
+;; (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
+;; OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+
+
+(in-package #:optimize)
+
+
+;;; Compiler optimization settings. For debugging, push :DEBUG-PROTOBUF
+;;; onto *FEATURES*, then recompile and reload a file.
+
+(defparameter +default+
+ '(optimize (compilation-speed 0) (debug 3) (safety 3) (speed 1)))
+
+(defparameter +fast-unsafe+
+ '(optimize (compilation-speed 0)
+ #+:debug-protobuf (debug 3)
+ (safety #.(or #+:debug-protobuf 3 0))
+ (speed 3)))
Oops, something went wrong. Retry.

0 comments on commit 5d1a426

Please sign in to comment.