rcl/vectors.lisp

   1 ;; Copyright (c) 2006-2007 Carlos Ungil
   2
   3 ;; Permission is hereby granted, free of charge, to any person obtaining
   4 ;; a copy of this software and associated documentation files (the
   5 ;; "Software"), to deal in the Software without restriction, including
   6 ;; without limitation the rights to use, copy, modify, merge, publish,
   7 ;; distribute, sublicense, and/or sell copies of the Software, and to
   8 ;; permit persons to whom the Software is furnished to do so, subject to
   9 ;; the following conditions:
  10
  11 ;; The above copyright notice and this permission notice shall be
  12 ;; included in all copies or substantial portions of the Software.
  13
  14 ;; THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
  15 ;; EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
  16 ;; MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND
  17 ;; NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE
  18 ;; LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION
  19 ;; OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION
  20 ;; WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.
  21
  22 (in-package :rcl)
  23
  24 (defun get-data-integers (sexp)
  25   (let ((start-data (cffi:inc-pointer sexp 24))
  26         (length (vecsxp-length (sexp-vecsxp sexp))))
  27     (loop for i from 0 below length
  28        collect (cffi:mem-aref start-data :int i))))
  29
  30 (defun set-data-integers (sexp integers)
  31   (let ((start-data (cffi:inc-pointer sexp 24)))
  32     (dotimes (i (length integers))
  33       (setf (cffi:mem-aref start-data :int i) (coerce (elt integers i) 'integer)))))
  34
  35 (defun get-data-reals (sexp)
  36   (let ((start-data (cffi:inc-pointer sexp 24))
  37         (length (vecsxp-length (sexp-vecsxp sexp))))
  38     (loop for i from 0 below length
  39        collect (cffi:mem-aref start-data :double i))))
  40
  41 (defun set-data-reals (sexp reals)
  42   (let ((start-data (cffi:inc-pointer sexp 24)))
  43     (dotimes (i (length reals))
  44       (setf (cffi:mem-aref start-data :double i) (coerce (elt reals i) 'double-float)))))
  45
  46 (defun get-data-sexps (sexp)
  47   (let ((start-data (cffi:inc-pointer sexp 24))
  48         (length (vecsxp-length (sexp-vecsxp sexp))))
  49     (loop for i from 0 below length
  50        collect (cffi:mem-aref start-data :pointer i))))
  51
  52 (defun set-data-sexps (sexp pointers)
  53   (let ((start-data (cffi:inc-pointer sexp 24)))
  54     (dotimes (i (length pointers))
  55       (setf (cffi:mem-aref start-data :pointer i) (elt pointers i)))))
  56
  57 (defun get-data-strings (sexp)
  58   (let ((start-data (cffi:inc-pointer sexp 24))
  59         (length (vecsxp-length (sexp-vecsxp sexp))))
  60     (loop for i from 0 below length
  61        collect (r-obj-decode (cffi:mem-aref start-data :pointer i)))))
  62
  63 (defun set-data-strings (sexp strings)
  64   (let ((start-data (cffi:inc-pointer sexp 24)))
  65     (dotimes (i (length strings))
  66       (setf (cffi:mem-aref start-data :pointer i)
  67             (new-internal-char (elt strings i))))))
  68