api.lisp

   1 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
   2 ;;;                                                                  ;;;
   3 ;;; Confidential and proprietary information of ITA Software, Inc.   ;;;
   4 ;;;                                                                  ;;;
   5 ;;; Copyright (c) 2012 ITA Software, Inc.  All rights reserved.      ;;;
   6 ;;;                                                                  ;;;
   7 ;;; Original author: Scott McKay                                     ;;;
   8 ;;;                                                                  ;;;
   9 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  10
  11 (in-package "PROTO-IMPL")
  12
  13
  14 ;;; A Protobufs2-compatible API, whose names are taken from the Python API
  15
  16 (defgeneric clear (object)
  17   (:documentation
  18    "Initialize all of the fields of 'object' to their default values.")
  19   (:method ((object standard-object))
  20     (let* ((class   (class-of object))
  21            (message (find-message-for-class class)))
  22       (assert message ()
  23               "There is no Protobufs message for the class ~S" class)
  24       ;;--- Do this: set everything either to the default value or "unbound"
  25       message)))
  26
  27 (defgeneric is-initialized (object)
  28   (:documentation
  29    "Returns true iff all of the fields of 'object' are initialized.")
  30   (:method ((object standard-object))
  31     (let* ((class   (class-of object))
  32            (message (find-message-for-class class)))
  33       (assert message ()
  34               "There is no Protobufs message for the class ~S" class)
  35       ;;--- Do this: check that there are no "unbound" slots
  36       message)))
  37
  38 ;; This is simpler than 'object-size', but doesn't fully support aliasing
  39 (defgeneric octet-size (object)
  40   (:documentation
  41    "Returns the number of octets required to encode 'object' using the wire format.
  42     'object' is an object whose Lisp class corresponds to a Protobufs message.")
  43   (:method ((object standard-object))
  44     (let* ((class   (class-of object))
  45            (message (find-message-for-class class))
  46            (type    (and message (proto-class message))))
  47       (assert message ()
  48               "There is no Protobufs message for the class ~S" class)
  49       (let ((visited (make-hash-table)))
  50         (object-size object type visited)))))
  51
  52 ;; This is simpler than 'serialize-object', but doesn't fully support aliasing
  53 (defgeneric serialize (object &optional buffer start end)
  54   (:documentation
  55    "Serialize 'object' into 'buffer' using the wire format, starting at the index
  56    'start' and going no farther than 'end'. 'object' is an object whose Lisp class
  57    corresponds to a Protobufs message.")
  58   (:method ((object standard-object) &optional buffer (start 0) end)
  59     (declare (ignore end))
  60     (let* ((class   (class-of object))
  61            (message (find-message-for-class class))
  62            (type    (and message (proto-class message))))
  63       (assert message ()
  64               "There is no Protobufs message for the class ~S" class)
  65       (let* ((visited (make-hash-table))
  66              (size    (object-size object type visited))
  67              (start   (or start 0))
  68              (buffer  (or buffer (make-array size :element-type '(unsigned-byte 8)))))
  69         (assert (>= (length buffer) size) ()
  70                 "The buffer ~S is not large enough to hold ~S" buffer object)
  71         (serialize-object object type buffer start visited)
  72         buffer))))
  73
  74 ;; This is simpler than 'deserialize-object', but doesn't fully support aliasing
  75 (defgeneric merge-from-array (object buffer &optional start end)
  76   (:documentation
  77    "Deserialize the object encoded in 'buffer' into 'object', starting at the index
  78     'start' and ending at 'end'. 'object' is an object whose Lisp class corresponds
  79     to a Protobufs message.")
  80   (:method ((object standard-object) buffer &optional (start 0) (end (length buffer)))
  81     (let* ((class   (class-of object))
  82            (message (find-message-for-class class))
  83            (type    (and message (proto-class message))))
  84       (assert message ()
  85               "There is no Protobufs message for the class ~S" class)
  86       (let* ((start  (or start 0))
  87              (end    (or end (length buffer))))
  88         (deserialize-object type buffer start end)))))
  89
  90 (defgeneric merge-from-message (object source-object)
  91   (:documentation
  92    "")
  93   (:method ((object standard-object) (source-object standard-object))
  94     (let* ((class   (class-of object))
  95            (message (find-message-for-class class))
  96            (type    (and message (proto-class message))))
  97       (assert (eq class (class-of source-object)) ()
  98               "The objects ~S and ~S are of not of the same class" object source-object)
  99       (assert message ()
 100               "There is no Protobufs message for the class ~S" class)
 101       ;;--- Do this
 102       type)))