1: /*
    2:  * vector.c - vector implementation
    3:  *
    4:  *   Copyright (c) 2000-2007  Shiro Kawai  <shiro@acm.org>
    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:  *   1. Redistributions of source code must retain the above copyright
   11:  *      notice, this list of conditions and the following disclaimer.
   12:  *
   13:  *   2. Redistributions in binary form must reproduce the above copyright
   14:  *      notice, this list of conditions and the following disclaimer in the
   15:  *      documentation and/or other materials provided with the distribution.
   16:  *
   17:  *   3. Neither the name of the authors nor the names of its contributors
   18:  *      may be used to endorse or promote products derived from this
   19:  *      software without specific prior written permission.
   20:  *
   21:  *   THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
   22:  *   "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
   23:  *   LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR
   24:  *   A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT
   25:  *   OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
   26:  *   SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED
   27:  *   TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR
   28:  *   PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF
   29:  *   LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
   30:  *   NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
   31:  *   SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
   32:  *
   33:  *  $Id: vector.c,v 1.27 2007/03/27 09:18:30 shirok Exp $
   34:  */
   35: 
   36: #define LIBGAUCHE_BODY
   37: #include "gauche.h"
   38: 
   39: /*
   40:  * Constructor
   41:  */
   42: 
   43: static void vector_print(ScmObj obj, ScmPort *port, ScmWriteContext *ctx)
   44: {
   45:     int i;
   46:     SCM_PUTZ("#(", -1, port);
   47:     for (i=0; i<SCM_VECTOR_SIZE(obj); i++) {
   48:         if (i != 0) SCM_PUTC(' ', port);
   49:         Scm_Write(SCM_VECTOR_ELEMENT(obj, i), SCM_OBJ(port), ctx->mode);
   50:     }
   51:     SCM_PUTZ(")", -1, port);
   52: }
   53: 
   54: SCM_DEFINE_BUILTIN_CLASS(Scm_VectorClass, vector_print, NULL, NULL, NULL,
   55:                          SCM_CLASS_SEQUENCE_CPL);
   56: 
   57: static ScmVector *make_vector(int size)
   58: {
   59:     ScmVector *v = SCM_NEW2(ScmVector *,
   60:                             sizeof(ScmVector) + sizeof(ScmObj)*(size-1));
   61:     SCM_SET_CLASS(v, SCM_CLASS_VECTOR);
   62:     v->size = size;
   63:     return v;
   64: }
   65: 
   66: ScmObj Scm_MakeVector(int size, ScmObj fill)
   67: {
   68:     int i;
   69:     ScmVector *v;
   70:     if (size < 0) {
   71:         Scm_Error("vector size must be a positive integer, but got %d", size);
   72:     }
   73:     v = make_vector(size);
   74:     if (SCM_UNBOUNDP(fill)) fill = SCM_UNDEFINED;
   75:     for (i=0; i<size; i++) v->elements[i] = fill;
   76:     return SCM_OBJ(v);
   77: }
   78: 
   79: ScmObj Scm_ListToVector(ScmObj l, int start, int end)
   80: {
   81:     ScmVector *v;
   82:     ScmObj e;
   83:     int i;
   84: 
   85:     if (end < 0) {
   86:         int size = Scm_Length(l);
   87:         if (size < 0) Scm_Error("bad list: %S", l);
   88:         SCM_CHECK_START_END(start, end, size);
   89:         v = make_vector(size - start);
   90:     } else {
   91:         SCM_CHECK_START_END(start, end, end);
   92:         v = make_vector(end - start);
   93:     }
   94:     e = Scm_ListTail(l, start, SCM_UNBOUND);
   95:     for (i=0; i<end-start; i++, e=SCM_CDR(e)) {
   96:         if (!SCM_PAIRP(e)) {
   97:             Scm_Error("list too short: %S", l);
   98:         }
   99:         v->elements[i] = SCM_CAR(e);
  100:     }
  101:     return SCM_OBJ(v);
  102: }
  103: 
  104: ScmObj Scm_VectorToList(ScmVector *v, int start, int end)
  105: {
  106:     int len = SCM_VECTOR_SIZE(v);
  107:     SCM_CHECK_START_END(start, end, len);
  108:     return Scm_ArrayToList(SCM_VECTOR_ELEMENTS(v)+start,
  109:                            end-start);
  110: }
  111: 
  112: /*
  113:  * Accessors
  114:  */
  115: 
  116: /* NB: we're permissive about the out-of-range index here; the strict
  117:    check (for Scheme routines) should be done in the stub file, since
  118:    Scheme version may receive bignum, which can't be passed to C API. */
  119: 
  120: ScmObj Scm_VectorRef(ScmVector *vec, int i, ScmObj fallback)
  121: {
  122:     if (i < 0 || i >= vec->size) return fallback;
  123:     return vec->elements[i];
  124: }
  125: 
  126: ScmObj Scm_VectorSet(ScmVector *vec, int i, ScmObj obj)
  127: {
  128:     if (i >= 0 && i < vec->size) vec->elements[i] = obj;
  129:     return obj;
  130: }
  131: 
  132: ScmObj Scm_VectorFill(ScmVector *vec, ScmObj fill, int start, int end)
  133: {
  134:     int i, len = SCM_VECTOR_SIZE(vec);
  135:     SCM_CHECK_START_END(start, end, len);
  136:     for (i=start; i < end; i++) {
  137:         SCM_VECTOR_ELEMENT(vec, i) = fill;
  138:     }
  139:     return SCM_OBJ(vec);
  140: }
  141: 
  142: ScmObj Scm_VectorCopy(ScmVector *vec, int start, int end, ScmObj fill)
  143: {
  144:     int i, len = SCM_VECTOR_SIZE(vec);
  145:     ScmVector *v = NULL;
  146:     if (end < 0) end = len;
  147:     if (end < start) {
  148:         Scm_Error("vector-copy: start (%d) is greater than end (%d)",
  149:                   start, end);
  150:     } else if (end == start) {
  151:         v = make_vector(0);
  152:     } else {
  153:         if (SCM_UNBOUNDP(fill)) fill = SCM_UNDEFINED;
  154:         v = make_vector(end - start);
  155:         for (i=0; i<end-start; i++) {
  156:             if (i+start < 0 || i+start >= len) {
  157:                 SCM_VECTOR_ELEMENT(v, i) = fill;
  158:             } else {
  159:                 SCM_VECTOR_ELEMENT(v, i) = SCM_VECTOR_ELEMENT(vec, i+start);
  160:             }
  161:         }
  162:     }
  163:     return SCM_OBJ(v);
  164: }
  165: