test-asmobs-lib.c 5.4 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211
  1. /* Copyright 1999-2001,2003,2006,2008,2018
  2. Free Software Foundation, Inc.
  3. This file is part of Guile.
  4. Guile is free software: you can redistribute it and/or modify it
  5. under the terms of the GNU Lesser General Public License as published
  6. by the Free Software Foundation, either version 3 of the License, or
  7. (at your option) any later version.
  8. Guile is distributed in the hope that it will be useful, but WITHOUT
  9. ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
  10. FITNESS FOR A PARTICULAR PURPOSE. See the GNU Lesser General Public
  11. License for more details.
  12. You should have received a copy of the GNU Lesser General Public
  13. License along with Guile. If not, see
  14. <https://www.gnu.org/licenses/>. */
  15. #ifdef HAVE_CONFIG_H
  16. # include <config.h>
  17. #endif
  18. #include <libguile.h>
  19. long asmob000;
  20. long asmob100;
  21. long asmob010;
  22. long asmob001;
  23. long asmob200;
  24. long asmob110;
  25. long asmob020;
  26. long asmob101;
  27. long asmob011;
  28. long asmob300;
  29. long asmob210;
  30. long asmob120;
  31. long asmob030;
  32. long asmob201;
  33. long asmob021;
  34. long asmob111;
  35. /* since we don't have SCM_DEFINE_STATIC or similar */
  36. SCM scm_make_asmob000 (void);
  37. SCM scm_make_asmob001 (void);
  38. SCM scm_make_asmob010 (void);
  39. SCM scm_make_asmob011 (void);
  40. SCM scm_make_asmob100 (void);
  41. SCM scm_make_asmob101 (void);
  42. SCM scm_make_asmob110 (void);
  43. SCM scm_make_asmob111 (void);
  44. SCM scm_make_asmob120 (void);
  45. SCM scm_make_asmob020 (void);
  46. SCM scm_make_asmob021 (void);
  47. SCM scm_make_asmob200 (void);
  48. SCM scm_make_asmob201 (void);
  49. SCM scm_make_asmob210 (void);
  50. SCM scm_make_asmob030 (void);
  51. SCM scm_make_asmob300 (void);
  52. SCM_DEFINE (scm_make_asmob000, "make-asmob000", 0, 0, 0, (), "")
  53. {
  54. SCM_RETURN_NEWSMOB (asmob000, 0);
  55. }
  56. SCM_DEFINE (scm_make_asmob100, "make-asmob100", 0, 0, 0, (), "")
  57. {
  58. SCM_RETURN_NEWSMOB (asmob100, 0);
  59. }
  60. SCM_DEFINE (scm_make_asmob010, "make-asmob010", 0, 0, 0, (), "")
  61. {
  62. SCM_RETURN_NEWSMOB (asmob010, 0);
  63. }
  64. SCM_DEFINE (scm_make_asmob001, "make-asmob001", 0, 0, 0, (), "")
  65. {
  66. SCM_RETURN_NEWSMOB (asmob001, 0);
  67. }
  68. SCM_DEFINE (scm_make_asmob200, "make-asmob200", 0, 0, 0, (), "")
  69. {
  70. SCM_RETURN_NEWSMOB (asmob200, 0);
  71. }
  72. SCM_DEFINE (scm_make_asmob110, "make-asmob110", 0, 0, 0, (), "")
  73. {
  74. SCM_RETURN_NEWSMOB (asmob110, 0);
  75. }
  76. SCM_DEFINE (scm_make_asmob020, "make-asmob020", 0, 0, 0, (), "")
  77. {
  78. SCM_RETURN_NEWSMOB (asmob020, 0);
  79. }
  80. SCM_DEFINE (scm_make_asmob101, "make-asmob101", 0, 0, 0, (), "")
  81. {
  82. SCM_RETURN_NEWSMOB (asmob101, 0);
  83. }
  84. SCM_DEFINE (scm_make_asmob011, "make-asmob011", 0, 0, 0, (), "")
  85. {
  86. SCM_RETURN_NEWSMOB (asmob011, 0);
  87. }
  88. SCM_DEFINE (scm_make_asmob300, "make-asmob300", 0, 0, 0, (), "")
  89. {
  90. SCM_RETURN_NEWSMOB (asmob300, 0);
  91. }
  92. SCM_DEFINE (scm_make_asmob210, "make-asmob210", 0, 0, 0, (), "")
  93. {
  94. SCM_RETURN_NEWSMOB (asmob210, 0);
  95. }
  96. SCM_DEFINE (scm_make_asmob120, "make-asmob120", 0, 0, 0, (), "")
  97. {
  98. SCM_RETURN_NEWSMOB (asmob120, 0);
  99. }
  100. SCM_DEFINE (scm_make_asmob030, "make-asmob030", 0, 0, 0, (), "")
  101. {
  102. SCM_RETURN_NEWSMOB (asmob030, 0);
  103. }
  104. SCM_DEFINE (scm_make_asmob201, "make-asmob201", 0, 0, 0, (), "")
  105. {
  106. SCM_RETURN_NEWSMOB (asmob201, 0);
  107. }
  108. SCM_DEFINE (scm_make_asmob021, "make-asmob021", 0, 0, 0, (), "")
  109. {
  110. SCM_RETURN_NEWSMOB (asmob021, 0);
  111. }
  112. SCM_DEFINE (scm_make_asmob111, "make-asmob111", 0, 0, 0, (), "")
  113. {
  114. SCM_RETURN_NEWSMOB (asmob111, 0);
  115. }
  116. static SCM
  117. apply0 (SCM smob)
  118. {
  119. return SCM_EOL;
  120. }
  121. static SCM
  122. apply1 (SCM smob, SCM a1)
  123. {
  124. if (SCM_UNBNDP (a1)) a1 = SCM_BOOL_F;
  125. return scm_list_1 (a1);
  126. }
  127. static SCM
  128. apply2 (SCM smob, SCM a1, SCM a2)
  129. {
  130. if (SCM_UNBNDP (a1)) a1 = SCM_BOOL_F;
  131. if (SCM_UNBNDP (a2)) a2 = SCM_BOOL_F;
  132. return scm_list_2 (a1, a2);
  133. }
  134. static SCM
  135. apply3 (SCM smob, SCM a1, SCM a2, SCM rest)
  136. {
  137. if (SCM_UNBNDP (a1)) a1 = SCM_BOOL_F;
  138. if (SCM_UNBNDP (a2)) a2 = SCM_BOOL_F;
  139. if (SCM_UNBNDP (rest)) rest = SCM_BOOL_F;
  140. return scm_list_3 (a1, a2, rest);
  141. }
  142. void libtest_asmobs_init (void);
  143. void
  144. libtest_asmobs_init ()
  145. {
  146. asmob000 = scm_make_smob_type ("asmob000", 0);
  147. scm_set_smob_apply (asmob000, apply0, 0, 0, 0);
  148. asmob100 = scm_make_smob_type ("asmob100", 0);
  149. scm_set_smob_apply (asmob100, apply1, 1, 0, 0);
  150. asmob010 = scm_make_smob_type ("asmob010", 0);
  151. scm_set_smob_apply (asmob010, apply1, 0, 1, 0);
  152. asmob001 = scm_make_smob_type ("asmob001", 0);
  153. scm_set_smob_apply (asmob001, apply1, 0, 0, 1);
  154. asmob200 = scm_make_smob_type ("asmob200", 0);
  155. scm_set_smob_apply (asmob200, apply2, 2, 0, 0);
  156. asmob110 = scm_make_smob_type ("asmob110", 0);
  157. scm_set_smob_apply (asmob110, apply2, 1, 1, 0);
  158. asmob020 = scm_make_smob_type ("asmob020", 0);
  159. scm_set_smob_apply (asmob020, apply2, 0, 2, 0);
  160. asmob101 = scm_make_smob_type ("asmob101", 0);
  161. scm_set_smob_apply (asmob101, apply2, 1, 0, 1);
  162. asmob011 = scm_make_smob_type ("asmob011", 0);
  163. scm_set_smob_apply (asmob011, apply2, 0, 1, 1);
  164. asmob300 = scm_make_smob_type ("asmob300", 0);
  165. scm_set_smob_apply (asmob300, apply3, 3, 0, 0);
  166. asmob210 = scm_make_smob_type ("asmob210", 0);
  167. scm_set_smob_apply (asmob210, apply3, 2, 1, 0);
  168. asmob120 = scm_make_smob_type ("asmob120", 0);
  169. scm_set_smob_apply (asmob120, apply3, 1, 2, 0);
  170. asmob030 = scm_make_smob_type ("asmob030", 0);
  171. scm_set_smob_apply (asmob030, apply3, 0, 3, 0);
  172. asmob201 = scm_make_smob_type ("asmob201", 0);
  173. scm_set_smob_apply (asmob201, apply3, 2, 0, 1);
  174. asmob021 = scm_make_smob_type ("asmob021", 0);
  175. scm_set_smob_apply (asmob021, apply3, 0, 2, 1);
  176. asmob111 = scm_make_smob_type ("asmob111", 0);
  177. scm_set_smob_apply (asmob111, apply3, 1, 1, 1);
  178. # include "test-asmobs-lib.x"
  179. }