libguile/pairs.c

   1 /*      Copyright (C) 1995,1996 Free Software Foundation, Inc.
   2  *
   3  * This program is free software; you can redistribute it and/or modify
   4  * it under the terms of the GNU General Public License as published by
   5  * the Free Software Foundation; either version 2, or (at your option)
   6  * any later version.
   7  *
   8  * This program is distributed in the hope that it will be useful,
   9  * but WITHOUT ANY WARRANTY; without even the implied warranty of
  10  * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  11  * GNU General Public License for more details.
  12  *
  13  * You should have received a copy of the GNU General Public License
  14  * along with this software; see the file COPYING.  If not, write to
  15  * the Free Software Foundation, Inc., 59 Temple Place, Suite 330,
  16  * Boston, MA 02111-1307 USA
  17  *
  18  * As a special exception, the Free Software Foundation gives permission
  19  * for additional uses of the text contained in its release of GUILE.
  20  *
  21  * The exception is that, if you link the GUILE library with other files
  22  * to produce an executable, this does not by itself cause the
  23  * resulting executable to be covered by the GNU General Public License.
  24  * Your use of that executable is in no way restricted on account of
  25  * linking the GUILE library code into it.
  26  *
  27  * This exception does not however invalidate any other reasons why
  28  * the executable file might be covered by the GNU General Public License.
  29  *
  30  * This exception applies only to the code released by the
  31  * Free Software Foundation under the name GUILE.  If you copy
  32  * code from other Free Software Foundation releases into a copy of
  33  * GUILE, as the General Public License permits, the exception does
  34  * not apply to the code that you add in this way.  To avoid misleading
  35  * anyone as to the status of such modified files, you must delete
  36  * this exception notice from them.
  37  *
  38  * If you write modifications of your own for GUILE, it is your choice
  39  * whether to permit this exception to apply to your modifications.
  40  * If you do not wish that, delete this exception notice.  */
  41
  42 /* Software engineering face-lift by Greg J. Badros, 11-Dec-1999,
  43    gjb@cs.washington.edu, http://www.cs.washington.edu/homes/gjb */
  44
  45 \f
  46 #include <stdio.h>
  47 #include "libguile/_scm.h"
  48
  49
  50 #include "libguile/validate.h"
  51
  52 \f
  53
  54 /* {Pairs}
  55  */
  56
  57 SCM_DEFINE (scm_cons, "cons", 2, 0, 0,
  58            (SCM x, SCM y),
  59             "Returns a newly allocated pair whose car is @var{x} and whose cdr is\n"
  60             "@var{y}.  The pair is guaranteed to be different (in the sense of\n"
  61             "@code{eqv?}) from every previously existing object.")
  62 #define FUNC_NAME s_scm_cons
  63 {
  64   register SCM z;
  65   SCM_NEWCELL (z);
  66   SCM_SETCAR (z, x);
  67   SCM_SETCDR (z, y);
  68   return z;
  69 }
  70 #undef FUNC_NAME
  71
  72
  73 SCM
  74 scm_cons2 (SCM w, SCM x, SCM y)
  75 {
  76   register SCM z;
  77   SCM_NEWCELL (z);
  78   SCM_SETCAR (z, x);
  79   SCM_SETCDR (z, y);
  80   x = z;
  81   SCM_NEWCELL (z);
  82   SCM_SETCAR (z, w);
  83   SCM_SETCDR (z, x);
  84   return z;
  85 }
  86
  87
  88 SCM_DEFINE (scm_pair_p, "pair?", 1, 0, 0,
  89             (SCM x),
  90             "Returns @code{#t} if @var{x} is a pair; otherwise returns @code{#f}.")
  91 #define FUNC_NAME s_scm_pair_p
  92 {
  93   if (SCM_IMP (x))
  94     return SCM_BOOL_F;
  95   return SCM_BOOL(SCM_CONSP (x));
  96 }
  97 #undef FUNC_NAME
  98
  99 SCM_DEFINE (scm_set_car_x, "set-car!", 2, 0, 0,
 100             (SCM pair, SCM value),
 101             "Stores @var{value} in the car field of @var{pair}.  The value returned\n"
 102             "by @code{set-car!} is unspecified.")
 103 #define FUNC_NAME s_scm_set_car_x
 104 {
 105   SCM_VALIDATE_CONS (1,pair);
 106   SCM_SETCAR (pair, value);
 107   return SCM_UNSPECIFIED;
 108 }
 109 #undef FUNC_NAME
 110
 111 SCM_DEFINE (scm_set_cdr_x, "set-cdr!", 2, 0, 0,
 112             (SCM pair, SCM value),
 113             "Stores @var{value} in the cdr field of @var{pair}.  The value returned\n"
 114             "by @code{set-cdr!} is unspecified.")
 115 #define FUNC_NAME s_scm_set_cdr_x
 116 {
 117   SCM_VALIDATE_CONS (1,pair);
 118   SCM_SETCDR (pair, value);
 119   return SCM_UNSPECIFIED;
 120 }
 121 #undef FUNC_NAME
 122
 123
 124 \f
 125
 126 static const scm_iproc cxrs[] =
 127 {
 128   {"car", 0},
 129   {"cdr", 0},
 130   {"caar", 0},
 131   {"cadr", 0},
 132   {"cdar", 0},
 133   {"cddr", 0},
 134   {"caaar", 0},
 135   {"caadr", 0},
 136   {"cadar", 0},
 137   {"caddr", 0},
 138   {"cdaar", 0},
 139   {"cdadr", 0},
 140   {"cddar", 0},
 141   {"cdddr", 0},
 142   {"caaaar", 0},
 143   {"caaadr", 0},
 144   {"caadar", 0},
 145   {"caaddr", 0},
 146   {"cadaar", 0},
 147   {"cadadr", 0},
 148   {"caddar", 0},
 149   {"cadddr", 0},
 150   {"cdaaar", 0},
 151   {"cdaadr", 0},
 152   {"cdadar", 0},
 153   {"cdaddr", 0},
 154   {"cddaar", 0},
 155   {"cddadr", 0},
 156   {"cdddar", 0},
 157   {"cddddr", 0},
 158   {0, 0}
 159 };
 160
 161 \f
 162
 163 void
 164 scm_init_pairs ()
 165 {
 166   scm_init_iprocs (cxrs, scm_tc7_cxr);
 167 #include "libguile/pairs.x"
 168 }
 169
 170
 171 /*
 172   Local Variables:
 173   c-file-style: "gnu"
 174   End:
 175 */