guile18/test-suite/standalone/test-asmobs-lib.c

   1 /* Copyright (C) 1999,2000,2001,2003, 2006, 2008 Free Software Foundation, Inc.
   2  *
   3  * This library is free software; you can redistribute it and/or
   4  * modify it under the terms of the GNU Lesser General Public
   5  * License as published by the Free Software Foundation; either
   6  * version 2.1 of the License, or (at your option) any later version.
   7  *
   8  * This library 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 GNU
  11  * Lesser General Public License for more details.
  12  *
  13  * You should have received a copy of the GNU Lesser General Public
  14  * License along with this library; if not, write to the Free Software
  15  * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
  16  */
  17
  18 #ifndef HAVE_CONFIG_H
  19 # include <config.h>
  20 #endif
  21
  22 #include <libguile.h>
  23
  24 long asmob000;
  25 long asmob100;
  26 long asmob010;
  27 long asmob001;
  28 long asmob200;
  29 long asmob110;
  30 long asmob020;
  31 long asmob101;
  32 long asmob011;
  33 long asmob300;
  34 long asmob210;
  35 long asmob120;
  36 long asmob030;
  37 long asmob201;
  38 long asmob021;
  39 long asmob111;
  40
  41 /* since we don't have SCM_DEFINE_STATIC or similar */
  42 SCM scm_make_asmob000 (void);
  43 SCM scm_make_asmob001 (void);
  44 SCM scm_make_asmob010 (void);
  45 SCM scm_make_asmob011 (void);
  46 SCM scm_make_asmob100 (void);
  47 SCM scm_make_asmob101 (void);
  48 SCM scm_make_asmob110 (void);
  49 SCM scm_make_asmob111 (void);
  50 SCM scm_make_asmob120 (void);
  51 SCM scm_make_asmob020 (void);
  52 SCM scm_make_asmob021 (void);
  53 SCM scm_make_asmob200 (void);
  54 SCM scm_make_asmob201 (void);
  55 SCM scm_make_asmob210 (void);
  56 SCM scm_make_asmob030 (void);
  57 SCM scm_make_asmob300 (void);
  58
  59
  60 SCM_DEFINE (scm_make_asmob000, "make-asmob000", 0, 0, 0, (), "")
  61 {
  62   SCM_RETURN_NEWSMOB (asmob000, 0);
  63 }
  64
  65 SCM_DEFINE (scm_make_asmob100, "make-asmob100", 0, 0, 0, (), "")
  66 {
  67   SCM_RETURN_NEWSMOB (asmob100, 0);
  68 }
  69
  70 SCM_DEFINE (scm_make_asmob010, "make-asmob010", 0, 0, 0, (), "")
  71 {
  72   SCM_RETURN_NEWSMOB (asmob010, 0);
  73 }
  74
  75 SCM_DEFINE (scm_make_asmob001, "make-asmob001", 0, 0, 0, (), "")
  76 {
  77   SCM_RETURN_NEWSMOB (asmob001, 0);
  78 }
  79
  80 SCM_DEFINE (scm_make_asmob200, "make-asmob200", 0, 0, 0, (), "")
  81 {
  82   SCM_RETURN_NEWSMOB (asmob200, 0);
  83 }
  84
  85 SCM_DEFINE (scm_make_asmob110, "make-asmob110", 0, 0, 0, (), "")
  86 {
  87   SCM_RETURN_NEWSMOB (asmob110, 0);
  88 }
  89
  90 SCM_DEFINE (scm_make_asmob020, "make-asmob020", 0, 0, 0, (), "")
  91 {
  92   SCM_RETURN_NEWSMOB (asmob020, 0);
  93 }
  94
  95 SCM_DEFINE (scm_make_asmob101, "make-asmob101", 0, 0, 0, (), "")
  96 {
  97   SCM_RETURN_NEWSMOB (asmob101, 0);
  98 }
  99
 100 SCM_DEFINE (scm_make_asmob011, "make-asmob011", 0, 0, 0, (), "")
 101 {
 102   SCM_RETURN_NEWSMOB (asmob011, 0);
 103 }
 104
 105 SCM_DEFINE (scm_make_asmob300, "make-asmob300", 0, 0, 0, (), "")
 106 {
 107   SCM_RETURN_NEWSMOB (asmob300, 0);
 108 }
 109
 110 SCM_DEFINE (scm_make_asmob210, "make-asmob210", 0, 0, 0, (), "")
 111 {
 112   SCM_RETURN_NEWSMOB (asmob210, 0);
 113 }
 114
 115 SCM_DEFINE (scm_make_asmob120, "make-asmob120", 0, 0, 0, (), "")
 116 {
 117   SCM_RETURN_NEWSMOB (asmob120, 0);
 118 }
 119
 120 SCM_DEFINE (scm_make_asmob030, "make-asmob030", 0, 0, 0, (), "")
 121 {
 122   SCM_RETURN_NEWSMOB (asmob030, 0);
 123 }
 124
 125 SCM_DEFINE (scm_make_asmob201, "make-asmob201", 0, 0, 0, (), "")
 126 {
 127   SCM_RETURN_NEWSMOB (asmob201, 0);
 128 }
 129
 130 SCM_DEFINE (scm_make_asmob021, "make-asmob021", 0, 0, 0, (), "")
 131 {
 132   SCM_RETURN_NEWSMOB (asmob021, 0);
 133 }
 134
 135 SCM_DEFINE (scm_make_asmob111, "make-asmob111", 0, 0, 0, (), "")
 136 {
 137   SCM_RETURN_NEWSMOB (asmob111, 0);
 138 }
 139
 140 static SCM
 141 apply0 (SCM smob)
 142 {
 143   return SCM_EOL;
 144 }
 145
 146 static SCM
 147 apply1 (SCM smob, SCM a1)
 148 {
 149   if (SCM_UNBNDP (a1)) a1 = SCM_BOOL_F;
 150   return scm_list_1 (a1);
 151 }
 152
 153 static SCM
 154 apply2 (SCM smob, SCM a1, SCM a2)
 155 {
 156   if (SCM_UNBNDP (a1)) a1 = SCM_BOOL_F;
 157   if (SCM_UNBNDP (a2)) a2 = SCM_BOOL_F;
 158   return scm_list_2 (a1, a2);
 159 }
 160
 161 static SCM
 162 apply3 (SCM smob, SCM a1, SCM a2, SCM rest)
 163 {
 164   if (SCM_UNBNDP (a1)) a1 = SCM_BOOL_F;
 165   if (SCM_UNBNDP (a2)) a2 = SCM_BOOL_F;
 166   if (SCM_UNBNDP (rest)) rest = SCM_BOOL_F;
 167   return scm_list_3 (a1, a2, rest);
 168 }
 169
 170 void libtest_asmobs_init (void);
 171
 172 void
 173 libtest_asmobs_init ()
 174 {
 175   asmob000 = scm_make_smob_type ("asmob000", 0);
 176   scm_set_smob_apply (asmob000, apply0, 0, 0, 0);
 177   asmob100 = scm_make_smob_type ("asmob100", 0);
 178   scm_set_smob_apply (asmob100, apply1, 1, 0, 0);
 179   asmob010 = scm_make_smob_type ("asmob010", 0);
 180   scm_set_smob_apply (asmob010, apply1, 0, 1, 0);
 181   asmob001 = scm_make_smob_type ("asmob001", 0);
 182   scm_set_smob_apply (asmob001, apply1, 0, 0, 1);
 183   asmob200 = scm_make_smob_type ("asmob200", 0);
 184   scm_set_smob_apply (asmob200, apply2, 2, 0, 0);
 185   asmob110 = scm_make_smob_type ("asmob110", 0);
 186   scm_set_smob_apply (asmob110, apply2, 1, 1, 0);
 187   asmob020 = scm_make_smob_type ("asmob020", 0);
 188   scm_set_smob_apply (asmob020, apply2, 0, 2, 0);
 189   asmob101 = scm_make_smob_type ("asmob101", 0);
 190   scm_set_smob_apply (asmob101, apply2, 1, 0, 1);
 191   asmob011 = scm_make_smob_type ("asmob011", 0);
 192   scm_set_smob_apply (asmob011, apply2, 0, 1, 1);
 193   asmob300 = scm_make_smob_type ("asmob300", 0);
 194   scm_set_smob_apply (asmob300, apply3, 3, 0, 0);
 195   asmob210 = scm_make_smob_type ("asmob210", 0);
 196   scm_set_smob_apply (asmob210, apply3, 2, 1, 0);
 197   asmob120 = scm_make_smob_type ("asmob120", 0);
 198   scm_set_smob_apply (asmob120, apply3, 1, 2, 0);
 199   asmob030 = scm_make_smob_type ("asmob030", 0);
 200   scm_set_smob_apply (asmob030, apply3, 0, 3, 0);
 201   asmob201 = scm_make_smob_type ("asmob201", 0);
 202   scm_set_smob_apply (asmob201, apply3, 2, 0, 1);
 203   asmob021 = scm_make_smob_type ("asmob021", 0);
 204   scm_set_smob_apply (asmob021, apply3, 0, 2, 1);
 205   asmob111 = scm_make_smob_type ("asmob111", 0);
 206   scm_set_smob_apply (asmob111, apply3, 1, 1, 1);
 207 # include "test-asmobs-lib.x"
 208 }