/**
 * b.c
 *   A simple Racket extension designed by CSC 195b 2013S
 *
 *   Copyright (c) 2013 Samuel A. Rebelsky.  All rights reserved.
 *
 *   This file is part of The Glimmer Guide to Writing Racket Extensions
 *   (GGWRE).
 *
 *   GGWRE is free software: you can redistribute it and/or modify
 *   it under the terms of the GNU General Public License as published by
 *   the Free Software Foundation, either version 3 of the License, or
 *   (at your option) any later version.
 *
 *   GGWRE is distributed in the hope that it will be useful,
 *   but WITHOUT ANY WARRANTY; without even the implied warranty of
 *   MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
 *   GNU General Public License for more details.
 *
 *   You should have received a copy of the GNU General Public License
 *   along with GGWRE.  If not, see <http://www.gnu.org/licenses/>.
 */


// +---------+---------------------------------------------------------
// | Headers |
// +---------+

#include <escheme.h>
#include <scheme.h>


// +------------+------------------------------------------------------
// | Extensions |
// +------------+

Scheme_Object *
hi (int argc, Scheme_Object *argv[])
{
  return scheme_make_locale_string ("Hello");
} // hi  

Scheme_Object *
cube (int argc, Scheme_Object *argv[])
{
  if (SCHEME_INTP (argv[0]))
    {
      int input;
      int output;
      // Extract the parameters
      input = SCHEME_INT_VAL (argv[0]);
      // Do the computation
      output = input * input * input;
      // Convert back
      return scheme_make_integer (output);
    }
  else if (SCHEME_FLOATP (argv[0]))
    {
      float dinput;
      float doutput;
      // Extract the parameters
      dinput = SCHEME_FLOAT_VAL (argv[0]);
      // Do the computation
      doutput = dinput * dinput * dinput;
      // Convert back
      return scheme_make_float (doutput);
   }
 else
   {
     scheme_signal_error ("Negative one!");
   }
} // cube


// +---------------------+---------------------------------------------
// | Standard Procedures |
// +---------------------+

Scheme_Object *
scheme_initialize (Scheme_Env *env)
{
  return scheme_reload (env);
} // scheme_initialize

Scheme_Object *
scheme_module_name (void)
{
  return scheme_intern_symbol ("ello");
} // scheme_module_name

Scheme_Object *
scheme_reload (Scheme_Env *env)
{
  Scheme_Object *proc;

  proc = scheme_make_prim_w_arity (hi, "hello", 0, 0);
  scheme_add_global ("hello", proc, env);

  proc = scheme_make_prim_w_arity (cube, "cube", 1, 1);
  scheme_add_global ("cube", proc, env);

  return scheme_void;
} // scheme_reload