3rdparties/software/flexi-streams-20200427-git/mapping.lisp (3180 bytes)
1 ;;; -*- Mode: LISP; Syntax: COMMON-LISP; Package: FLEXI-STREAMS; Base: 10 -*- 2 ;;; $Header: /usr/local/cvsrep/flexi-streams/mapping.lisp,v 1.3 2008/05/25 19:07:53 edi Exp $ 3 4 ;;; Copyright (c) 2005-2008, Dr. Edmund Weitz. All rights reserved. 5 6 ;;; Redistribution and use in source and binary forms, with or without 7 ;;; modification, are permitted provided that the following conditions 8 ;;; are met: 9 10 ;;; * Redistributions of source code must retain the above copyright 11 ;;; notice, this list of conditions and the following disclaimer. 12 13 ;;; * Redistributions in binary form must reproduce the above 14 ;;; copyright notice, this list of conditions and the following 15 ;;; disclaimer in the documentation and/or other materials 16 ;;; provided with the distribution. 17 18 ;;; THIS SOFTWARE IS PROVIDED BY THE AUTHOR 'AS IS' AND ANY EXPRESSED 19 ;;; OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED 20 ;;; WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE 21 ;;; ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR ANY 22 ;;; DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL 23 ;;; DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE 24 ;;; GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS 25 ;;; INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, 26 ;;; WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING 27 ;;; NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS 28 ;;; SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. 29 30 (in-package :flexi-streams) 31 32 (deftype octet () 33 "A shortcut for \(UNSIGNED-BYTE 8)." 34 '(unsigned-byte 8)) 35 36 (deftype char* () 37 "Convenience shortcut to paper over the difference between LispWorks 38 and the other Lisps." 39 #+:lispworks 'lw:simple-char 40 #-:lispworks 'character) 41 42 (deftype string* () 43 "Convenience shortcut to paper over the difference between LispWorks 44 and the other Lisps." 45 #+:lispworks 'lw:text-string 46 #-:lispworks 'string) 47 48 (deftype char-code-integer () 49 "The subtype of integers which can be returned by the function CHAR-CODE." 50 #-:cmu '(integer 0 #.(1- char-code-limit)) 51 #+:cmu '(integer 0 65533)) 52 53 (deftype code-point () 54 "The subtype of integers that's just big enough to hold all Unicode 55 codepoints. 56 57 See for example <http://unicode.org/glossary/#C>." 58 '(mod #x110000)) 59 60 (defmacro defconstant (name value &optional doc) 61 "Make sure VALUE is evaluated only once \(to appease SBCL)." 62 `(cl:defconstant ,name (if (boundp ',name) (symbol-value ',name) ,value) 63 ,@(when doc (list doc)))) 64 65 (defun invert-table (table) 66 "`Inverts' an array which maps octets to character codes to a hash 67 table which maps character codes to octets." 68 (let ((hash (make-hash-table))) 69 (loop for octet from 0 70 for char-code across table 71 unless (= char-code 65533) 72 do (setf (gethash char-code hash) octet)) 73 hash)) 74 75 (defun make-decoding-table (list) 76 "Creates and returns an array which contains the elements in the 77 list LIST and has an element type that's suitable for character 78 codes." 79 (make-array (length list) 80 :element-type 'char-code-integer 81 :initial-contents list))