X-Git-Url: http://git.hcoop.net/bpt/guile.git/blobdiff_plain/da4a1dbab4e802a4d516ed6ec456864d22fe5432..a6b844c224b65f99300aa0f516fadbef50e7c8aa:/libguile/keywords.c

diff --git a/libguile/keywords.c b/libguile/keywords.c
index 7508e7425..5b10100de 100644
--- a/libguile/keywords.c
+++ b/libguile/keywords.c
@@ -1,4 +1,4 @@
-/* Copyright (C) 1995,1996,1997,1998, 1999 Free Software Foundation, Inc.
+/* Copyright (C) 1995,1996,1997,1998,1999,2000,2001 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
@@ -39,91 +39,92 @@
  * whether to permit this exception to apply to your modifications.
  * If you do not wish that, delete this exception notice.  */
 
-/* Software engineering face-lift by Greg J. Badros, 11-Dec-1999,
-   gjb@cs.washington.edu, http://www.cs.washington.edu/homes/gjb */
 
 
 
-#include <stdio.h>
-#include "_scm.h"
-#include "genio.h"
-#include "smob.h"
+#include <string.h>
 
-#include "scm_validate.h"
-#include "keywords.h"
+#include "libguile/_scm.h"
+#include "libguile/ports.h"
+#include "libguile/root.h"
+#include "libguile/smob.h"
+#include "libguile/hashtab.h"
+
+#include "libguile/validate.h"
+#include "libguile/keywords.h"
 
 
+scm_t_bits scm_tc16_keyword;
+
 static int
-prin_keyword (SCM exp,SCM port,scm_print_state *pstate)
+keyword_print (SCM exp, SCM port, scm_print_state *pstate SCM_UNUSED)
 {
+  SCM symbol = SCM_KEYWORDSYM (exp);
+
   scm_puts ("#:", port);
-  scm_puts(1 + SCM_CHARS (SCM_CDR (exp)), port);
+  scm_print_symbol_name (SCM_SYMBOL_CHARS (symbol) + 1,
+			 SCM_SYMBOL_LENGTH (symbol) - 1,
+			 port);
+  scm_remember_upto_here_1 (symbol);
   return 1;
 }
 
-int scm_tc16_keyword;
-
-/* This global is only kept for backward compatibility.
-   Will be removed in next release.  */
-int scm_tc16_kw;
-
-
 SCM_DEFINE (scm_make_keyword_from_dash_symbol, "make-keyword-from-dash-symbol", 1, 0, 0, 
             (SCM symbol),
-            "Return a keyword object from SYMBOL that starts with `-' (a dash).")
+            "Make a keyword object from a @var{symbol} that starts with a dash.")
 #define FUNC_NAME s_scm_make_keyword_from_dash_symbol
 {
-  SCM vcell;
+  SCM keyword;
 
   SCM_ASSERT (SCM_SYMBOLP (symbol)
-	      && ('-' == SCM_CHARS(symbol)[0]),
+	      && ('-' == SCM_SYMBOL_CHARS(symbol)[0]),
 	      symbol, SCM_ARG1, FUNC_NAME);
 
   SCM_DEFER_INTS;
-  vcell = scm_sym2ovcell_soft (symbol, scm_keyword_obarray);
-  if (vcell == SCM_BOOL_F)
+  keyword = scm_hashq_ref (scm_keyword_obarray, symbol, SCM_BOOL_F);
+  if (SCM_FALSEP (keyword))
     {
-      SCM keyword;
-      SCM_NEWSMOB (keyword, scm_tc16_keyword, symbol);
-      scm_intern_symbol (scm_keyword_obarray, symbol);
-      vcell = scm_sym2ovcell_soft (symbol, scm_keyword_obarray);
-      SCM_SETCDR (vcell, keyword);
+      SCM_NEWSMOB (keyword, scm_tc16_keyword, SCM_UNPACK (symbol));
+      scm_hashq_set_x (scm_keyword_obarray, symbol, keyword);
     }
   SCM_ALLOW_INTS;
-  return SCM_CDR (vcell);
+  return keyword;
 }
 #undef FUNC_NAME
 
 SCM
 scm_c_make_keyword (char *s)
 {
-  SCM vcell;
-  char *buf = scm_must_malloc (strlen (s) + 2, "keyword");
+  char *buf = scm_malloc (strlen (s) + 2);
+  SCM symbol;
+
   buf[0] = '-';
   strcpy (buf + 1, s);
-  vcell = scm_sysintern0 (buf);
-  scm_must_free (buf);
-  return scm_make_keyword_from_dash_symbol (SCM_CAR (vcell));
+  symbol = scm_str2symbol (buf);
+  free (buf);
+
+  return scm_make_keyword_from_dash_symbol (symbol);
 }
 
 SCM_DEFINE (scm_keyword_p, "keyword?", 1, 0, 0, 
             (SCM obj),
-	    "Returns #t if the argument OBJ is a keyword, else #f.")
+	    "Return @code{#t} if the argument @var{obj} is a keyword, else\n"
+	    "@code{#f}.")
 #define FUNC_NAME s_scm_keyword_p
 {
-  return SCM_BOOL(SCM_KEYWORDP (obj));
+  return SCM_BOOL (SCM_KEYWORDP (obj));
 }
 #undef FUNC_NAME
 
 
 SCM_DEFINE (scm_keyword_dash_symbol, "keyword-dash-symbol", 1, 0, 0, 
             (SCM keyword),
-	    "Return KEYWORD as a dash symbol.\n"
-            "This is the inverse of `make-keyword-from-dash-symbol'.\n")
+	    "Return the dash symbol for @var{keyword}.\n"
+	    "This is the inverse of @code{make-keyword-from-dash-symbol}.")
 #define FUNC_NAME s_scm_keyword_dash_symbol
 {
-  SCM_VALIDATE_KEYWORD (1,keyword);
-  return SCM_CDR (keyword);
+  SCM_VALIDATE_KEYWORD (1, keyword);
+  return SCM_KEYWORDSYM (keyword);
 }
 #undef FUNC_NAME
 
@@ -132,10 +133,17 @@ SCM_DEFINE (scm_keyword_dash_symbol, "keyword-dash-symbol", 1, 0, 0,
 void
 scm_init_keywords ()
 {
-  scm_tc16_keyword = scm_make_smob_type_mfpe ("keyword", 0,
-                                             scm_markcdr, NULL, prin_keyword, NULL);
-  scm_tc16_kw = scm_tc16_keyword;
-  scm_keyword_obarray = scm_make_vector (SCM_MAKINUM (256), SCM_EOL);
-#include "keywords.x"
+  scm_tc16_keyword = scm_make_smob_type ("keyword", 0);
+  scm_set_smob_mark (scm_tc16_keyword, scm_markcdr);
+  scm_set_smob_print (scm_tc16_keyword, keyword_print);
+
+  scm_keyword_obarray = scm_c_make_hash_table (256);
+#include "libguile/keywords.x"
 }
 
+
+/*
+  Local Variables:
+  c-file-style: "gnu"
+  End:
+*/