examples/box-module/box.c

   1 /* examples/box-module/box.c
   2  *
   3  *      Copyright (C) 1998,2001, 2006 Free Software Foundation, Inc.
   4  *
   5  * This program is free software; you can redistribute it and/or
   6  * modify it under the terms of the GNU Lesser General Public License
   7  * as published by the Free Software Foundation; either version 3, or
   8  * (at your option) any later version.
   9  *
  10  * This program is distributed in the hope that it will be useful, but
  11  * WITHOUT ANY WARRANTY; without even the implied warranty of
  12  * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  13  * Lesser General Public License for more details.
  14  *
  15  * You should have received a copy of the GNU Lesser General Public
  16  * License along with this software; see the file COPYING.LESSER.  If
  17  * not, write to the Free Software Foundation, Inc., 51 Franklin
  18  * Street, Fifth Floor, Boston, MA 02110-1301 USA
  19  */
  20
  21 /* Include all needed declarations.  */
  22 #include <libguile.h>
  23
  24
  25 /* The type code for the newly created smob type will be stored into
  26    this variable.  It has the prefix `scm_tc16_' to make it usable
  27    with the SCM_VALIDATE_SMOB macro below.  */
  28 static scm_t_bits scm_tc16_box;
  29
  30
  31 /* This function is responsible for marking all SCM objects included
  32    in the smob.  */
  33 static SCM
  34 mark_box (SCM b)
  35 {
  36   /* Since we have only one SCM object to protect, we simply return it
  37      and the caller will mark it.  */
  38   return SCM_CELL_OBJECT_1 (b);
  39 }
  40
  41
  42 /* Print a textual represenation of the smob to a given port.  */
  43 static int
  44 print_box (SCM b, SCM port, scm_print_state *pstate)
  45 {
  46   SCM value = SCM_CELL_OBJECT_1 (b);
  47
  48   scm_puts ("#<box ", port);
  49   scm_write (value, port);
  50   scm_puts (">", port);
  51
  52   /* Non-zero means success.  */
  53   return 1;
  54 }
  55
  56
  57 /* This defines the primitve `make-box', which returns a new smob of
  58    type `box', initialized to `#f'.  */
  59 static SCM
  60 #define FUNC_NAME "make-box"
  61 make_box (void)
  62 {
  63   /* This macro creates the new objects, stores the value `#f' into it
  64      and returns it to the caller.  */
  65   SCM_RETURN_NEWSMOB (scm_tc16_box, SCM_BOOL_F);
  66 }
  67 #undef FUNC_NAME
  68
  69
  70 /* This is the primitive `box-ref' which returns the object stored in
  71    the box.  */
  72 static SCM
  73 box_ref (SCM b)
  74 #define FUNC_NAME "box-ref"
  75 {
  76   /* First, we have to ensure that the user really gave us a box
  77      objects.  The macro SCM_VALIDATE_SMOB will do all what is needed.
  78      The parameters are interpreted as follows:
  79
  80      1: The position of the checked variable in the parameter list.
  81      b: The passed parameter.
  82      box: Concatenated with the fixed prefix scm_tc16_, names the type
  83           code for the expected smob type.  */
  84   SCM_VALIDATE_SMOB (1, b, box);
  85
  86   /* Fetch the object from the box and return it.  */
  87   return SCM_CELL_OBJECT_1 (b);
  88 }
  89 #undef FUNC_NAME
  90
  91
  92 /* Primitive which stores an arbitrary value into a box.  */
  93 static SCM
  94 box_set_x (SCM b, SCM value)
  95 #define FUNC_NAME "box-set!"
  96 {
  97   SCM_VALIDATE_SMOB (1, b, box);
  98
  99   /* Set the cell number 1 of the smob to the given value.  */
 100   SCM_SET_CELL_OBJECT_1 (b, value);
 101
 102   /* When this constant is returned, the REPL will not print the
 103      returned value.  All procedures in Guile which are documented as
 104      returning `and unspecified value' actually return this value.  */
 105   return SCM_UNSPECIFIED;
 106 }
 107 #undef FUNC_NAME
 108
 109
 110 /* Create and initialize the new smob type, and register the
 111    primitives withe the interpreter library.
 112
 113    This function must be declared a bit different from the example in
 114    the ../box directory, because it will be called by
 115    `scm_c_define_module', called from below.  */
 116 static void
 117 init_box_type (void * unused)
 118 {
 119   scm_tc16_box = scm_make_smob_type ("box", 0);
 120   scm_set_smob_mark (scm_tc16_box, mark_box);
 121   scm_set_smob_print (scm_tc16_box, print_box);
 122
 123   scm_c_define_gsubr ("make-box", 0, 0, 0, make_box);
 124   scm_c_define_gsubr ("box-set!", 2, 0, 0, box_set_x);
 125   scm_c_define_gsubr ("box-ref", 1, 0, 0, box_ref);
 126
 127   /* This is new too: Since the procedures are now in a module, we
 128      have to explicitly export them before they can be used.  */
 129   scm_c_export ("make-box", "box-set!", "box-ref", NULL);
 130 }
 131
 132
 133 /* This is the function which gets called by scm_boot_guile after the
 134    Guile library is completely initialized.  */
 135 static void
 136 inner_main (void *closure, int argc, char **argv)
 137 {
 138   /* Unlike the example in ../box, init_box_type is not called
 139      directly, but by scm_c_define_module, which will create a module
 140      named (box-module) and make this module current while called
 141      init_box_type, thus placing the definitions into that module.  */
 142   scm_c_define_module ("box-module", init_box_type, NULL);
 143
 144   /* ... then we start a shell, in which the box data type can be
 145      used (after using the module (box-module)).  */
 146   scm_shell (argc, argv);
 147 }
 148
 149
 150 /* Main program.  */
 151 int
 152 main (int argc, char **argv)
 153 {
 154   /* Initialize Guile, then call `inner_main' with the arguments 0,
 155      argc and argv.  */
 156   scm_boot_guile (argc, argv, inner_main, 0);
 157   return 0; /* Never reached.  */
 158 }
 159
 160 /* End of file.  */