/**
 * a.c
 *   A simple Racket extension designed by 195.01A 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 *
square (int argc, Scheme_Object *argv[])
{
  if (SCHEME_INTP (argv[0]))
    {
      int ival;
      int iresult;
      // Extract the information from the list
      ival = SCHEME_INT_VAL (argv[0]);
      // Do the computation
      iresult = ival * ival;
      // Convert it back
      return scheme_make_integer (iresult);
    }
  else
    {
      scheme_signal_error ("I am unable to square non-integers");
    } 
} // square

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

Scheme_Object *
scheme_initialize (Scheme_Env *env)
{
  fprintf (stderr, "scheme_initialize\n");
  return scheme_reload (env);
} // scheme_initialize

Scheme_Object *
scheme_module_name (void)
{
  fprintf (stderr, "scheme_module_name\n");
  return scheme_intern_symbol ("'ello");
} // scheme_module_name

Scheme_Object *
scheme_reload (Scheme_Env *env)
{
  fprintf (stderr, "scheme_reload\n");
  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 (square, "square", 1, 1);
  scheme_add_global ("square", proc, env);

  return scheme_void;
} // scheme_reload