├── COPYING ├── README ├── README.md ├── base-test.lisp ├── com.google.base.asd ├── error.lisp ├── octet.lisp ├── optimize.lisp ├── package.lisp ├── sequence.lisp ├── syntax.lisp └── type.lisp /COPYING: -------------------------------------------------------------------------------- 1 | Copyright 2011 Google Inc. All Rights Reserved 2 | 3 | Redistribution and use in source and binary forms, with or without 4 | modification, are permitted provided that the following conditions are 5 | met: 6 | 7 | * Redistributions of source code must retain the above copyright 8 | notice, this list of conditions and the following disclaimer. 9 | * Redistributions in binary form must reproduce the above 10 | copyright notice, this list of conditions and the following disclaimer 11 | in the documentation and/or other materials provided with the 12 | distribution. 13 | * Neither the name of Google Inc. nor the names of its 14 | contributors may be used to endorse or promote products derived from 15 | this software without specific prior written permission. 16 | 17 | THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS 18 | "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT 19 | LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR 20 | A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT 21 | OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, 22 | SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT 23 | LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, 24 | DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY 25 | THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT 26 | (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE 27 | OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. 28 | -------------------------------------------------------------------------------- /README: -------------------------------------------------------------------------------- 1 | 2 | Universally useful Lisp code that lives in package com.google.base. 3 | 4 | The intent is that the base package only contains code that's highly likely to 5 | be useful in every Lisp application. Currently it contains: 6 | 7 | a nicer version of DEFCONSTANT 8 | a macro for generating simple PRINT-OBJECT methods 9 | a MISSING-ARGUMENT function for use in DEFCLASS forms 10 | functions for manipulating utf-8 strings stored as vectors of 8-bit octets 11 | common compiler optimization settings 12 | functions for extracting the prefix or suffix of a sequence 13 | Lisp type definitions for common C integer types 14 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | # com.google.base 2 | 3 | Universally useful Common Lisp code. 4 | 5 | The base package contains code that's highly likely to be useful in every Lisp 6 | application. The package contains: 7 | 8 | ## ASDF fast-unsafe-source-file component 9 | 10 | The ASDF component type FAST-UNSAFE-SOURCE-FILE allows you to specify maximum 11 | optimization for one Lisp source file. It is used just like the FILE 12 | component. In the system definition below, foo is compiled with default 13 | optimization settings, while bar is compiled for maximum run-time speed: 14 | 15 | ``` 16 | (defsystem example 17 | :defsystem-depends-on (com.google.base) 18 | :components 19 | ((:file "foo") 20 | (:fast-unsafe-source-file "bar"))) 21 | ``` 22 | 23 | ## A nicer version of DEFCONSTANT 24 | 25 | #### defconst name value &optional documentation 26 | 27 | ``` 28 | Identical to CL:DEFCONSTANT except that the global constant variable NAME is 29 | bound to VALUE at compile time so it can be used in #. reader forms. 30 | Additionally, if the DEFCONST form is evaluated a second time, the constant is 31 | not rebound if the new value is EQUALP to the old. CL:DEFCONSTANT requires 32 | the two values be EQL to avoid undefined behavior. 33 | ``` 34 | 35 | ## A missing-argument function 36 | 37 | #### missing-argument 38 | 39 | ``` 40 | Calls ERROR with an argument that indicates a required &KEY or &OPTIONAL 41 | function argument was not supplied. For example, the following function will 42 | signal an error condition for a missing :AGE or :ADDRESS argument. 43 | 44 | (defun foo (name &key (age (missing-argument)) (address (missing-argument))) 45 | ... 46 | ) 47 | 48 | A (MISSING-ARGUMENT) form also useful as the value of a slot :INITFORM when the 49 | slot is required. For instance, the following class definition ensures that a 50 | value is supplied for SLOT when an instance is created: 51 | 52 | (defclass foo () 53 | ((slot 54 | :accessor :slot 55 | :initform (missing-argument)))) 56 | ``` 57 | 58 | ## Types and functions for manipulating UTF-8 strings 59 | 60 | #### octet 61 | 62 | ``` 63 | The type (UNSIGNED-BYTE 8). 64 | ``` 65 | #### octet-vector &optional length 66 | 67 | ``` 68 | The type `(SIMPLE-ARRAY OCTET (,LENGTH). 69 | ``` 70 | 71 | #### make-octet-vector octet-count &key initial-contents 72 | 73 | ``` 74 | Creates an OCTET-VECTOR containing OCTET-COUNT octets. If INITIAL-CONTENTS is 75 | not supplied, each element of the vector is initialized to zero. Otherwise, 76 | the vector is initialized to the contents of list INITIAL-CONTENTS. 77 | ``` 78 | #### string-to-utf8-octets string &key (start 0) (end (length string)) 79 | 80 | ``` 81 | Converts STRING into an OCTET-VECTOR by UTF-8 encoding each character. 82 | ``` 83 | #### utf8-octets-to-string octets &key (start 0) (end (length octets)) 84 | 85 | ``` 86 | Converts OCTETS, a vector of UTF-8 encoded octets, into a string. 87 | ``` 88 | 89 | ## Sequence functions 90 | 91 | #### prefixp prefix sequence &key (test #'eql) 92 | 93 | ``` 94 | Does PREFIX match a prefix of SEQUENCE? 95 | ``` 96 | 97 | #### suffixp suffix sequence &key (test #'eql) 98 | 99 | ``` 100 | Does SUFFIX match a suffix of SEQUENCE? 101 | ``` 102 | 103 | ## Lisp type definitions for common C integer types 104 | 105 | The following types are defined: 106 | 107 | ``` 108 | int8 109 | int16 110 | int32 111 | int64 112 | uint8 113 | uint16 114 | uint32 115 | uint64 116 | ``` 117 | -------------------------------------------------------------------------------- /base-test.lisp: -------------------------------------------------------------------------------- 1 | ;;;; Copyright 2011 Google Inc. All Rights Reserved 2 | 3 | ;;;; Redistribution and use in source and binary forms, with or without 4 | ;;;; modification, are permitted provided that the following conditions are 5 | ;;;; met: 6 | 7 | ;;;; * Redistributions of source code must retain the above copyright 8 | ;;;; notice, this list of conditions and the following disclaimer. 9 | ;;;; * Redistributions in binary form must reproduce the above 10 | ;;;; copyright notice, this list of conditions and the following disclaimer 11 | ;;;; in the documentation and/or other materials provided with the 12 | ;;;; distribution. 13 | ;;;; * Neither the name of Google Inc. nor the names of its 14 | ;;;; contributors may be used to endorse or promote products derived from 15 | ;;;; this software without specific prior written permission. 16 | 17 | ;;;; THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS 18 | ;;;; "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT 19 | ;;;; LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR 20 | ;;;; A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT 21 | ;;;; OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, 22 | ;;;; SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT 23 | ;;;; LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, 24 | ;;;; DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY 25 | ;;;; THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT 26 | ;;;; (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE 27 | ;;;; OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. 28 | 29 | ;;;; Author: Robert Brown 30 | 31 | ;;;; Test base code. 32 | 33 | (in-package #:common-lisp-user) 34 | 35 | (defpackage #:com.google.base-test 36 | (:documentation "Test code in the COM.GOOGLE.BASE package.") 37 | (:use #:common-lisp 38 | #:com.google.base 39 | #:hu.dwim.stefil) 40 | (:export #:test-base)) 41 | 42 | (in-package #:com.google.base-test) 43 | 44 | (defsuite (test-base :in root-suite) () 45 | (run-child-tests)) 46 | 47 | (in-suite test-base) 48 | 49 | ;;; syntax tests 50 | 51 | (defclass foo () 52 | ((x :reader x :initarg :x :type integer) 53 | (y :reader y :initarg y :type symbol) 54 | (hidden :reader hidden :initarg :hidden :type integer))) 55 | 56 | (define-print-object foo ((x :x "x is ~D") (y 'y "y is ~S") (hidden :hidden))) 57 | 58 | (defun foo-equal (foo1 foo2) 59 | (and (= (x foo1) (x foo2)) 60 | (eq (y foo1) (y foo2)) 61 | (= (hidden foo1) (hidden foo2)))) 62 | 63 | (deftest define-print-object-print-read-consistency () 64 | (let* ((foo1 (make-instance 'foo :x 100 'y 'hello :hidden 300)) 65 | (foo2 (with-standard-io-syntax (read-from-string (write-to-string foo1))))) 66 | (is (foo-equal foo1 foo2)))) 67 | 68 | (deftest define-print-object-unreadable-printing () 69 | (let* ((foo (make-instance 'foo :x 11 'y 'world :hidden 123456789)) 70 | (output (with-standard-io-syntax 71 | (let ((*package* (find-package :com.google.base-test))) 72 | (write-to-string foo :readably nil))))) 73 | (is (search "x is 11" output)) 74 | (is (search "y is WORLD" output)) 75 | (is (null (search "123456789" output))))) 76 | 77 | (defun tree-search (x tree) 78 | (cond ((equal x tree) t) 79 | ((consp tree) (or (tree-search x (car tree)) (tree-search x (cdr tree)))) 80 | (t nil))) 81 | 82 | (deftest define-print-object-no-format-strings () 83 | ;; Test that the code uses (call-next-method) when no format strings are supplied. 84 | (is (tree-search '(call-next-method) (macroexpand-1 '(define-print-object foo ((z :z))))))) 85 | 86 | (deftest define-print-object-syntax-errors () 87 | (flet ((signals-error (form) 88 | (signals error (macroexpand-1 form)))) 89 | (signals-error '(define-print-object ((z :z "~D zebras")))) 90 | (signals-error '(define-print-object foobar ((z "~D zebras")))) 91 | (signals-error '(define-print-object foobar ((z :z zebras)))) 92 | (signals-error '(define-print-object foobar ((z initarg zebras)))) 93 | (signals-error '(define-print-object foobar ((z)))) 94 | (signals-error '(define-print-object foobar ((z :z "~D zebras" junk)))))) 95 | 96 | ;;; octet tests 97 | 98 | (deftest octet-types () 99 | (let ((octets (make-octet-vector 10))) 100 | (is (typep octets 'octet-vector)) 101 | (is (typep octets '(octet-vector 10))) 102 | (is (typep (aref octets 5) 'octet)))) 103 | -------------------------------------------------------------------------------- /com.google.base.asd: -------------------------------------------------------------------------------- 1 | ;;;; Copyright 2014 Google Inc. All Rights Reserved 2 | 3 | ;;;; Redistribution and use in source and binary forms, with or without 4 | ;;;; modification, are permitted provided that the following conditions are 5 | ;;;; met: 6 | 7 | ;;;; * Redistributions of source code must retain the above copyright 8 | ;;;; notice, this list of conditions and the following disclaimer. 9 | ;;;; * Redistributions in binary form must reproduce the above 10 | ;;;; copyright notice, this list of conditions and the following disclaimer 11 | ;;;; in the documentation and/or other materials provided with the 12 | ;;;; distribution. 13 | ;;;; * Neither the name of Google Inc. nor the names of its 14 | ;;;; contributors may be used to endorse or promote products derived from 15 | ;;;; this software without specific prior written permission. 16 | 17 | ;;;; THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS 18 | ;;;; "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT 19 | ;;;; LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR 20 | ;;;; A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT 21 | ;;;; OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, 22 | ;;;; SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT 23 | ;;;; LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, 24 | ;;;; DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY 25 | ;;;; THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT 26 | ;;;; (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE 27 | ;;;; OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. 28 | 29 | ;;;; Author: Robert Brown 30 | 31 | (defclass fast-unsafe-source-file (cl-source-file) 32 | () 33 | (:documentation 34 | "A Common Lisp source file that is compiled with high optimization settings.")) 35 | 36 | (defun call-with-compiler-policy (thunk policy) 37 | #+abcl 38 | (let ((system::*debug* system::*debug*) 39 | (system::*safety* system::*safety*) 40 | (system::*space* system::*space*) 41 | (system::*speed* system::*speed*)) 42 | (proclaim policy) 43 | (funcall thunk)) 44 | #+clisp 45 | (let ((previous-policy 46 | (loop for key being the hash-keys of system::*optimize* using (hash-value value) 47 | collect (cons key value)))) 48 | (unwind-protect 49 | (progn (proclaim policy) 50 | (funcall thunk)) 51 | (clrhash system::*optimize*) 52 | (loop for (key . value) in previous-policy 53 | do (setf (gethash key system::*optimize*) value)))) 54 | #+clozure 55 | (let ((ccl::*nx-cspeed* ccl::*nx-cspeed*) 56 | (ccl::*nx-debug* ccl::*nx-debug*) 57 | (ccl::*nx-safety* ccl::*nx-safety*) 58 | (ccl::*nx-space* ccl::*nx-space*) 59 | (ccl::*nx-speed* ccl::*nx-speed*)) 60 | (proclaim policy) 61 | (funcall thunk)) 62 | #+(or cmucl scl) 63 | (let ((c::*default-cookie* c::*default-cookie*)) 64 | (proclaim policy) 65 | (funcall thunk)) 66 | #+ecl 67 | (let ((c::*debug* c::*debug*) 68 | (c::*safety* c::*safety*) 69 | (c::*space* c::*space*) 70 | (c::*speed* c::*speed*)) 71 | (proclaim policy) 72 | (funcall thunk)) 73 | #+sbcl 74 | (let ((sb-c::*policy* sb-c::*policy*)) 75 | (proclaim policy) 76 | (funcall thunk)) 77 | #-(or abcl clisp clozure cmucl ecl sbcl scl) 78 | (progn 79 | (warn "unable to safely change compiler optimization policy") 80 | (funcall thunk))) 81 | 82 | (defmethod perform :around ((operation compile-op) (component fast-unsafe-source-file)) 83 | (let ((policy (symbol-value (read-from-string "com.google.base:*optimize-fast-unsafe*")))) 84 | (call-with-compiler-policy #'call-next-method policy))) 85 | 86 | (defmethod perform :around ((operation load-op) (component fast-unsafe-source-file)) 87 | (let ((policy (symbol-value (read-from-string "com.google.base:*optimize-fast-unsafe*")))) 88 | (call-with-compiler-policy #'call-next-method policy))) 89 | 90 | (defsystem com.google.base 91 | :name "Lisp base" 92 | :description "Universally useful Lisp code." 93 | :long-description "Code that should be useful for any Lisp application." 94 | :version "1.4" 95 | :author "Robert Brown " 96 | :license "New BSD license. See the copyright messages in individual files." 97 | :depends-on (#-(or allegro ccl clisp sbcl) trivial-utf-8) 98 | :in-order-to ((test-op (test-op com.google.base/test))) 99 | :components 100 | ((:file "package") 101 | (:file "optimize" :depends-on ("package")) 102 | (:file "syntax" :depends-on ("package" "optimize")) 103 | (:file "error" :depends-on ("package" "optimize")) 104 | (:file "type" :depends-on ("package" "optimize" "syntax")) 105 | (:fast-unsafe-source-file "octet" :depends-on ("package" "optimize" "type")) 106 | (:file "sequence" :depends-on ("package" "optimize")))) 107 | 108 | (defsystem com.google.base/test 109 | :name "Lisp base test" 110 | :description "Test code for package COM.GOOGLE.BASE." 111 | :version "1.4" 112 | :author "Robert Brown " 113 | :license "New BSD license. See the copyright messages in individual files." 114 | :depends-on (com.google.base hu.dwim.stefil) 115 | :components 116 | ((:file "base-test"))) 117 | 118 | (defmethod perform ((operation test-op) (component (eql (find-system 'com.google.base/test)))) 119 | (symbol-call 'com.google.base-test 'test-base)) 120 | -------------------------------------------------------------------------------- /error.lisp: -------------------------------------------------------------------------------- 1 | ;;;; Copyright 2011 Google Inc. All Rights Reserved 2 | 3 | ;;;; Redistribution and use in source and binary forms, with or without 4 | ;;;; modification, are permitted provided that the following conditions are 5 | ;;;; met: 6 | 7 | ;;;; * Redistributions of source code must retain the above copyright 8 | ;;;; notice, this list of conditions and the following disclaimer. 9 | ;;;; * Redistributions in binary form must reproduce the above 10 | ;;;; copyright notice, this list of conditions and the following disclaimer 11 | ;;;; in the documentation and/or other materials provided with the 12 | ;;;; distribution. 13 | ;;;; * Neither the name of Google Inc. nor the names of its 14 | ;;;; contributors may be used to endorse or promote products derived from 15 | ;;;; this software without specific prior written permission. 16 | 17 | ;;;; THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS 18 | ;;;; "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT 19 | ;;;; LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR 20 | ;;;; A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT 21 | ;;;; OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, 22 | ;;;; SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT 23 | ;;;; LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, 24 | ;;;; DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY 25 | ;;;; THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT 26 | ;;;; (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE 27 | ;;;; OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. 28 | 29 | ;;;; Author: Robert Brown 30 | 31 | ;;;; Error generation for missing arguments. 32 | 33 | (in-package #:com.google.base) 34 | 35 | ;; Tell the compiler that MISSING-ARGUMENT never returns in order to avoid compile-time type 36 | ;; warnings for object slots with declared types. 37 | (declaim (ftype (function () nil) missing-argument)) 38 | 39 | (defun missing-argument () 40 | "Signal an error indicating that an &OPTIONAL or &KEY argument is missing. 41 | Use (MISSING-ARGUMENT) as the default value of required &KEY function arguments 42 | and as the initform in DEFCLASS and DEFSTRUCT slot definition forms when the 43 | slot's initform must always be supplied to MAKE-INSTANCE." 44 | (error "A required &KEY or &OPTIONAL argument was not supplied.")) 45 | -------------------------------------------------------------------------------- /octet.lisp: -------------------------------------------------------------------------------- 1 | ;;;; Copyright 2011 Google Inc. All Rights Reserved 2 | 3 | ;;;; Redistribution and use in source and binary forms, with or without 4 | ;;;; modification, are permitted provided that the following conditions are 5 | ;;;; met: 6 | 7 | ;;;; * Redistributions of source code must retain the above copyright 8 | ;;;; notice, this list of conditions and the following disclaimer. 9 | ;;;; * Redistributions in binary form must reproduce the above 10 | ;;;; copyright notice, this list of conditions and the following disclaimer 11 | ;;;; in the documentation and/or other materials provided with the 12 | ;;;; distribution. 13 | ;;;; * Neither the name of Google Inc. nor the names of its 14 | ;;;; contributors may be used to endorse or promote products derived from 15 | ;;;; this software without specific prior written permission. 16 | 17 | ;;;; THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS 18 | ;;;; "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT 19 | ;;;; LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR 20 | ;;;; A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT 21 | ;;;; OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, 22 | ;;;; SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT 23 | ;;;; LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, 24 | ;;;; DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY 25 | ;;;; THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT 26 | ;;;; (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE 27 | ;;;; OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. 28 | 29 | ;;;; Author: Robert Brown 30 | 31 | ;;;; Vectors of octets, 8-bit bytes, used to store UTF-8 encoded strings. 32 | 33 | (in-package #:com.google.base) 34 | 35 | (deftype octet () '(unsigned-byte 8)) 36 | (deftype octet-vector (&optional length) `(simple-array octet (,length))) 37 | 38 | (defun octet-vector (&rest octets) 39 | (coerce octets 'octet-vector)) 40 | 41 | (declaim (ftype (function (fixnum &key (:initial-contents list)) (values octet-vector &optional)) 42 | make-octet-vector)) 43 | 44 | (defun make-octet-vector (octet-count &key initial-contents) 45 | "Create an OCTET-VECTOR containing OCTET-COUNT octets. If INITIAL-CONTENTS 46 | is not supplied, each element of the vector is initialized to zero. Otherwise, 47 | the vector is initialized to the contents of list INITIAL-CONTENTS." 48 | (declare (type vector-index octet-count) 49 | (type list initial-contents)) 50 | (if initial-contents 51 | (make-array octet-count :element-type 'octet :initial-contents initial-contents) 52 | (make-array octet-count :element-type 'octet :initial-element 0))) 53 | 54 | (declaim (ftype (function (string &key (:start vector-index) (:end vector-index)) 55 | (values octet-vector &optional)) 56 | string-to-utf8-octets)) 57 | 58 | (defun string-to-utf8-octets (string &key (start 0) (end (length string))) 59 | "Convert STRING into an OCTET-VECTOR by UTF-8 encoding each character." 60 | (declare (type string string) 61 | (type vector-index start end)) 62 | #+allegro 63 | (excl:string-to-octets string :start start :end end :null-terminate nil :external-format :utf8) 64 | #+ccl 65 | (ccl:encode-string-to-octets string :start start :end end :external-format :utf-8) 66 | #+clisp 67 | (ext:convert-string-to-bytes string charset:utf-8 :start start :end end) 68 | #+sbcl 69 | (sb-ext:string-to-octets string :start start :end end :external-format :utf-8) 70 | #-(or allegro ccl clisp sbcl) 71 | (trivial-utf-8:string-to-utf-8-bytes (subseq string start end))) 72 | 73 | (declaim (ftype (function (octet-vector &key (:start vector-index) (:end vector-index)) 74 | (values string &optional)) 75 | utf8-octets-to-string)) 76 | 77 | (defun utf8-octets-to-string (octets &key (start 0) (end (length octets))) 78 | "Convert OCTETS, a vector of UTF-8 encoded octets, into a string." 79 | (declare (type octet-vector octets) 80 | (type vector-index start end)) 81 | #+allegro 82 | (excl:octets-to-string octets :start start :end end :external-format :utf8) 83 | #+ccl 84 | (ccl:decode-string-from-octets octets :start start :end end :external-format :utf-8) 85 | #+clisp 86 | (ext:convert-string-from-bytes octets charset:utf-8 :start start :end end) 87 | #+sbcl 88 | (sb-ext:octets-to-string octets :start start :end end :external-format :utf8) 89 | #-(or allegro ccl clisp sbcl) 90 | (trivial-utf-8:utf-8-bytes-to-string (subseq octets start end))) 91 | -------------------------------------------------------------------------------- /optimize.lisp: -------------------------------------------------------------------------------- 1 | ;;;; Copyright 2011 Google Inc. All Rights Reserved 2 | 3 | ;;;; Redistribution and use in source and binary forms, with or without 4 | ;;;; modification, are permitted provided that the following conditions are 5 | ;;;; met: 6 | 7 | ;;;; * Redistributions of source code must retain the above copyright 8 | ;;;; notice, this list of conditions and the following disclaimer. 9 | ;;;; * Redistributions in binary form must reproduce the above 10 | ;;;; copyright notice, this list of conditions and the following disclaimer 11 | ;;;; in the documentation and/or other materials provided with the 12 | ;;;; distribution. 13 | ;;;; * Neither the name of Google Inc. nor the names of its 14 | ;;;; contributors may be used to endorse or promote products derived from 15 | ;;;; this software without specific prior written permission. 16 | 17 | ;;;; THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS 18 | ;;;; "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT 19 | ;;;; LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR 20 | ;;;; A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT 21 | ;;;; OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, 22 | ;;;; SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT 23 | ;;;; LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, 24 | ;;;; DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY 25 | ;;;; THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT 26 | ;;;; (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE 27 | ;;;; OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. 28 | 29 | ;;;; Author: Robert Brown 30 | 31 | ;;;; Compiler optimization settings. 32 | 33 | (in-package #:com.google.base) 34 | 35 | ;;; To recompile code with different compiler optimization settings, rebind 36 | ;;; these special variables. 37 | 38 | (defparameter *optimize-default* 39 | '(optimize (compilation-speed 0) (debug 3) (safety 3) (space 1) (speed 1)) 40 | "Compiler optimization settings that emphasize debugging over speed. Most 41 | code should use these settings.") 42 | 43 | (defparameter *optimize-fast-unsafe* 44 | ;; Use the default debugging level. 45 | '(optimize (compilation-speed 0) (debug 2) (safety 0) (space 1) (speed 3)) 46 | "Compiler optimization settings that emphasize speed at the expense of 47 | debugging and run-time safety. Only low-level performance sensitive code that 48 | has been extensively tested should use these settings.") 49 | -------------------------------------------------------------------------------- /package.lisp: -------------------------------------------------------------------------------- 1 | ;;;; Copyright 2011 Google Inc. All Rights Reserved 2 | 3 | ;;;; Redistribution and use in source and binary forms, with or without 4 | ;;;; modification, are permitted provided that the following conditions are 5 | ;;;; met: 6 | 7 | ;;;; * Redistributions of source code must retain the above copyright 8 | ;;;; notice, this list of conditions and the following disclaimer. 9 | ;;;; * Redistributions in binary form must reproduce the above 10 | ;;;; copyright notice, this list of conditions and the following disclaimer 11 | ;;;; in the documentation and/or other materials provided with the 12 | ;;;; distribution. 13 | ;;;; * Neither the name of Google Inc. nor the names of its 14 | ;;;; contributors may be used to endorse or promote products derived from 15 | ;;;; this software without specific prior written permission. 16 | 17 | ;;;; THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS 18 | ;;;; "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT 19 | ;;;; LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR 20 | ;;;; A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT 21 | ;;;; OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, 22 | ;;;; SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT 23 | ;;;; LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, 24 | ;;;; DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY 25 | ;;;; THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT 26 | ;;;; (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE 27 | ;;;; OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. 28 | 29 | ;;;; Author: Robert Brown 30 | 31 | (in-package #:common-lisp-user) 32 | 33 | (defpackage #:com.google.base 34 | (:documentation 35 | "Basic code used by all applications. The code in BASE should be universally 36 | useful, since most packages will import BASE symbols by including 37 | (:USE #:COM.GOOGLE.BASE) in their DEFPACKAGE form.") 38 | (:use #:common-lisp) 39 | ;; error.lisp 40 | (:export #:missing-argument) 41 | ;; octet.lisp 42 | (:export #:octet 43 | #:octet-vector 44 | #:make-octet-vector 45 | #:string-to-utf8-octets 46 | #:utf8-octets-to-string) 47 | ;; optimize.lisp 48 | (:export #:*optimize-default* 49 | #:*optimize-fast-unsafe*) 50 | ;; sequence.lisp 51 | (:export #:prefixp 52 | #:suffixp) 53 | ;; syntax.lisp 54 | (:export #:defconst 55 | #:define-print-object) 56 | ;; type.lisp 57 | (:export #:int8 58 | #:int16 59 | #:int32 60 | #:int64 61 | #:uint8 62 | #:uint16 63 | #:uint32 64 | #:uint64 65 | #:+maximum-vector-index+ 66 | #:vector-index)) 67 | -------------------------------------------------------------------------------- /sequence.lisp: -------------------------------------------------------------------------------- 1 | ;;;; Copyright 2011 Google Inc. All Rights Reserved 2 | 3 | ;;;; Redistribution and use in source and binary forms, with or without 4 | ;;;; modification, are permitted provided that the following conditions are 5 | ;;;; met: 6 | 7 | ;;;; * Redistributions of source code must retain the above copyright 8 | ;;;; notice, this list of conditions and the following disclaimer. 9 | ;;;; * Redistributions in binary form must reproduce the above 10 | ;;;; copyright notice, this list of conditions and the following disclaimer 11 | ;;;; in the documentation and/or other materials provided with the 12 | ;;;; distribution. 13 | ;;;; * Neither the name of Google Inc. nor the names of its 14 | ;;;; contributors may be used to endorse or promote products derived from 15 | ;;;; this software without specific prior written permission. 16 | 17 | ;;;; THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS 18 | ;;;; "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT 19 | ;;;; LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR 20 | ;;;; A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT 21 | ;;;; OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, 22 | ;;;; SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT 23 | ;;;; LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, 24 | ;;;; DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY 25 | ;;;; THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT 26 | ;;;; (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE 27 | ;;;; OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. 28 | 29 | ;;;; Author: madscience@google.com (Moshe Looks) 30 | 31 | ;;;; Functions on sequences. 32 | 33 | (in-package #:com.google.base) 34 | 35 | (defun prefixp (prefix sequence &key (test #'eql)) 36 | "Does PREFIX match a prefix of SEQUENCE?" 37 | (let ((mismatch (mismatch prefix sequence :test test))) 38 | (or (null mismatch) (= mismatch (length prefix))))) 39 | 40 | (defun suffixp (suffix sequence &key (test #'eql)) 41 | "Does SUFFIX match a suffix of SEQUENCE?" 42 | (let ((mismatch (mismatch suffix sequence :test test :from-end t))) 43 | (or (null mismatch) (zerop mismatch)))) 44 | -------------------------------------------------------------------------------- /syntax.lisp: -------------------------------------------------------------------------------- 1 | ;;;; Copyright 2011 Google Inc. All Rights Reserved 2 | 3 | ;;;; Redistribution and use in source and binary forms, with or without 4 | ;;;; modification, are permitted provided that the following conditions are 5 | ;;;; met: 6 | 7 | ;;;; * Redistributions of source code must retain the above copyright 8 | ;;;; notice, this list of conditions and the following disclaimer. 9 | ;;;; * Redistributions in binary form must reproduce the above 10 | ;;;; copyright notice, this list of conditions and the following disclaimer 11 | ;;;; in the documentation and/or other materials provided with the 12 | ;;;; distribution. 13 | ;;;; * Neither the name of Google Inc. nor the names of its 14 | ;;;; contributors may be used to endorse or promote products derived from 15 | ;;;; this software without specific prior written permission. 16 | 17 | ;;;; THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS 18 | ;;;; "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT 19 | ;;;; LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR 20 | ;;;; A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT 21 | ;;;; OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, 22 | ;;;; SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT 23 | ;;;; LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, 24 | ;;;; DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY 25 | ;;;; THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT 26 | ;;;; (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE 27 | ;;;; OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. 28 | 29 | ;;;; Author: Robert Brown 30 | 31 | ;;;; Commonly used macros. 32 | 33 | (in-package #:com.google.base) 34 | 35 | (defmacro defconst (name value &optional (documentation nil documentation-present-p)) 36 | "Identical to CL:DEFCONSTANT except that the global constant variable NAME is 37 | bound to VALUE at compile time so it can be used in #. reader forms. 38 | Additionally, if the DEFCONST form is evaluated a second time, the constant is 39 | not rebound if the new value is EQUALP to the old. CL:DEFCONSTANT requires 40 | that the two values be EQL to avoid undefined behavior." 41 | (assert (symbolp name) 42 | (name) "constant name ~S is not a symbol" name) 43 | (assert (or (not documentation-present-p) (stringp documentation)) 44 | (documentation) "documentation for constant ~S is not a string" name) 45 | (let ((temp (gensym)) 46 | (documentation (when documentation-present-p (list documentation)))) 47 | `(eval-when (:compile-toplevel :load-toplevel :execute) 48 | (let ((,temp ,value)) 49 | (if (and (boundp ',name) (equalp (symbol-value ',name) ,temp)) 50 | ;; Return the same result as CL:DEFCONSTANT. 51 | ',name 52 | (defconstant ,name ,temp ,@documentation)))))) 53 | 54 | (defmacro define-print-object (class-name accessor-info) 55 | "Generates a CL:PRINT-OBJECT generic function for class CLASS-NAME using 56 | ACCESSOR-INFO, a list containing elements of the form 57 | (accessor initarg [format-string]). 58 | 59 | If a format-string is not provided for a slot, then the generated PRINT-OBJECT 60 | function outputs nothing for that slot when *PRINT-READABLY* is false. 61 | 62 | Given a POINT class with slots X, Y, and HIDDEN. The following 63 | DEFINE-PRINT-OBJECT form: 64 | 65 | (define-print-object point 66 | ((x :x \"x is ~D\") 67 | (y :y \"y is ~D\") 68 | (hidden :hidden))) 69 | 70 | expands to a PRINT-OBJECT function similar to: 71 | 72 | (defmethod print-object ((point point) stream) 73 | (if *print-readably* 74 | (progn (write-string \"#.\" stream) 75 | (write `(make-instance 'point 76 | :x ,(x point) 77 | :y ,(y point) 78 | :hidden ,(hidden point)) 79 | :stream stream)) 80 | (print-unreadable-object (point stream :type t :identity t) 81 | (format stream \"x is ~D y is ~D\" (x point) (y point)))))" 82 | (dolist (info accessor-info) 83 | (destructuring-bind (accessor initarg &optional format &rest rest) 84 | info 85 | (assert (null rest) () "too many arguments") 86 | (assert (and accessor (symbolp accessor)) 87 | (accessor) "~S is not an accessor" accessor) 88 | ;; Allow keywords and quoted symbols as initargs. 89 | (assert (or (keywordp initarg) 90 | (and (listp initarg) 91 | (= (length initarg) 2) 92 | (eq (first initarg) 'quote) 93 | (and (symbolp (second initarg))))) 94 | (initarg) "initarg ~S is not a keyword or quoted symbol" initarg) 95 | (assert (or (not format) (stringp format)) 96 | (format) "~S is not a format string" format))) 97 | (let* ((object (gensym)) 98 | (stream (gensym)) 99 | (initargs 100 | (loop for (accessor initarg) in accessor-info 101 | collect `',initarg 102 | collect ``',(,accessor ,object))) 103 | (format-accessors 104 | (loop for (accessor nil format) in accessor-info 105 | when format collect `(,accessor ,object))) 106 | (format-string 107 | (with-output-to-string (s) 108 | (loop for (nil nil format) in accessor-info do 109 | (when format (format s "~A " format)))))) 110 | `(defmethod print-object ((,object ,class-name) ,stream) 111 | (if *print-readably* 112 | (progn (write-string "#." ,stream) 113 | (write `(make-instance ',',class-name ,,@initargs) :stream ,stream)) 114 | ,(if (string= format-string "") 115 | '(call-next-method) 116 | `(print-unreadable-object (,object ,stream :type t :identity t) 117 | (format ,stream ,format-string ,@format-accessors))))))) 118 | -------------------------------------------------------------------------------- /type.lisp: -------------------------------------------------------------------------------- 1 | ;;;; Copyright 2011 Google Inc. All Rights Reserved 2 | 3 | ;;;; Redistribution and use in source and binary forms, with or without 4 | ;;;; modification, are permitted provided that the following conditions are 5 | ;;;; met: 6 | 7 | ;;;; * Redistributions of source code must retain the above copyright 8 | ;;;; notice, this list of conditions and the following disclaimer. 9 | ;;;; * Redistributions in binary form must reproduce the above 10 | ;;;; copyright notice, this list of conditions and the following disclaimer 11 | ;;;; in the documentation and/or other materials provided with the 12 | ;;;; distribution. 13 | ;;;; * Neither the name of Google Inc. nor the names of its 14 | ;;;; contributors may be used to endorse or promote products derived from 15 | ;;;; this software without specific prior written permission. 16 | 17 | ;;;; THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS 18 | ;;;; "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT 19 | ;;;; LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR 20 | ;;;; A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT 21 | ;;;; OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, 22 | ;;;; SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT 23 | ;;;; LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, 24 | ;;;; DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY 25 | ;;;; THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT 26 | ;;;; (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE 27 | ;;;; OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. 28 | 29 | ;;;; Author: Robert Brown 30 | 31 | ;;;; Constants and types that are very commonly used. 32 | 33 | (in-package #:com.google.base) 34 | 35 | ;;; Lisp integer types with the same numeric range as C++ ints. 36 | 37 | (deftype int8 () "A signed 8-bit integer." '(signed-byte 8)) 38 | (deftype int16 () "A signed 16-bit integer." '(signed-byte 16)) 39 | (deftype int32 () "A signed 32-bit integer." '(signed-byte 32)) 40 | (deftype int64 () "A signed 64-bit integer." '(signed-byte 64)) 41 | 42 | (deftype uint8 () "An unsigned 8-bit integer." '(unsigned-byte 8)) 43 | (deftype uint16 () "An unsigned 16-bit integer." '(unsigned-byte 16)) 44 | (deftype uint32 () "An unsigned 32-bit integer." '(unsigned-byte 32)) 45 | (deftype uint64 () "An unsigned 64-bit integer." '(unsigned-byte 64)) 46 | 47 | ;;; Vector index types. 48 | 49 | (defconst +maximum-vector-index+ (1- array-dimension-limit) "Largest valid vector index.") 50 | 51 | (deftype vector-index () 52 | "Integer that can be used as a subscript for accessing an array or vector element." 53 | '(integer 0 #.+maximum-vector-index+)) 54 | --------------------------------------------------------------------------------