/* classes: src_files */

/*	Copyright (C) 1995 Free Software Foundation, Inc.
 * 
 * This program 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 2, or (at your option)
 * any later version.
 * 
 * This program 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 this software; see the file COPYING.  If not, write to
 * the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
 */


#include "scm.h"

static sizet
free_kw (obj)
     SCM obj;
{
  return 0;
}

static int
prin_kw (exp, port, writing)
     SCM exp;
     SCM port;
     int writing;
{
  scm_lputs(":", port);
  scm_lputs(1 + CHARS (CDR (exp)), port);
  return 1;
}

int scm_tc16_kw;

static scm_smobfuns variable_smob = {scm_markcdr, free_kw, prin_kw, 0};
static char s_make_kw[] = "make-kw";

SCM
scm_make_kw (symbol)
     SCM symbol;
{
  SCM vcell;

  ASSERT (NIMP (symbol) && SYMBOLP(symbol) && ('-' == CHARS(symbol)[0]),
	  symbol, ARG1, s_make_kw);


  vcell = scm_sym2ovcell_soft (symbol, kw_obarray);
  if (vcell == BOOL_F)
    {
      SCM kw;
      NEWCELL(kw);
      DEFER_INTS;
      CAR(kw) = (SCM)scm_tc16_kw;
      CDR(kw) = symbol;
      ALLOW_INTS;
      scm_intern_symbol (kw_obarray, symbol);
      vcell = scm_sym2ovcell_soft (symbol, kw_obarray);
      CDR (vcell) = kw;
    }
  return CDR (vcell);
}

static char s_kwp[] = "keyword?";
SCM
scm_kwp (obj)
     SCM obj;
{
  return ( (NIMP(obj) && KEYWORDP (obj))
	  ? BOOL_T
	  : BOOL_F);
}

static char s_kwsym[] = "keyword->symbol";

SCM
scm_kwsym (kw)
     SCM kw;
{
  ASSERT (NIMP (kw) && KEYWORDP (kw), kw, ARG1, s_kwsym);
  return CDR (kw);
}


void
scm_init_kw ()
{
  scm_tc16_kw = scm_newsmob (&variable_smob);
  scm_make_subr (s_kwp, tc7_subr_1, scm_kwp);
  scm_make_subr (s_make_kw, tc7_subr_1, scm_make_kw);
  scm_make_subr (s_kwsym, tc7_subr_1, scm_kwsym);
  kw_obarray = scm_make_vector (MAKINUM (256), EOL);
}
