summaryrefslogtreecommitdiff
path: root/libguile/keywords.c
blob: e4a79ac4dd8f8e025e1b70bf4243308b5af9a3a8 (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
/* Copyright (C) 1995,1996,1997,1998,1999,2000,2001, 2003, 2004, 2006, 2008, 2009, 2011 Free Software Foundation, Inc.
 * 
 * This library is free software; you can redistribute it and/or
 * modify it under the terms of the GNU Lesser General Public License
 * as published by the Free Software Foundation; either version 3 of
 * the License, or (at your option) any later version.
 *
 * This library 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
 * Lesser General Public License for more details.
 *
 * You should have received a copy of the GNU Lesser General Public
 * License along with this library; if not, write to the Free Software
 * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
 * 02110-1301 USA
 */



#ifdef HAVE_CONFIG_H
# include <config.h>
#endif

#include <string.h>

#include "libguile/_scm.h"
#include "libguile/async.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"
#include "libguile/strings.h"



static SCM keyword_obarray;

scm_t_bits scm_tc16_keyword;

#define KEYWORDP(X)	(SCM_SMOB_PREDICATE (scm_tc16_keyword, (X)))
#define KEYWORDSYM(X)	(SCM_SMOB_OBJECT (X))

static int
keyword_print (SCM exp, SCM port, scm_print_state *pstate SCM_UNUSED)
{
  scm_puts_unlocked ("#:", port);
  scm_display (KEYWORDSYM (exp), port);
  return 1;
}

SCM_DEFINE (scm_keyword_p, "keyword?", 1, 0, 0, 
            (SCM obj),
	    "Return @code{#t} if the argument @var{obj} is a keyword, else\n"
	    "@code{#f}.")
#define FUNC_NAME s_scm_keyword_p
{
  return scm_from_bool (KEYWORDP (obj));
}
#undef FUNC_NAME

SCM_DEFINE (scm_symbol_to_keyword, "symbol->keyword", 1, 0, 0,
	    (SCM symbol),
	    "Return the keyword with the same name as @var{symbol}.")
#define FUNC_NAME s_scm_symbol_to_keyword
{
  SCM keyword;

  SCM_ASSERT_TYPE (scm_is_symbol (symbol), symbol, 0, NULL, "symbol");

  SCM_CRITICAL_SECTION_START;
  /* njrev: NEWSMOB and hashq_set_x can raise errors */
  keyword = scm_hashq_ref (keyword_obarray, symbol, SCM_BOOL_F);
  if (scm_is_false (keyword))
    {
      SCM_NEWSMOB (keyword, scm_tc16_keyword, SCM_UNPACK (symbol));
      scm_hashq_set_x (keyword_obarray, symbol, keyword);
    }
  SCM_CRITICAL_SECTION_END;
  return keyword;
}
#undef FUNC_NAME

SCM_DEFINE (scm_keyword_to_symbol, "keyword->symbol", 1, 0, 0,
	    (SCM keyword),
	    "Return the symbol with the same name as @var{keyword}.")
#define FUNC_NAME s_scm_keyword_to_symbol
{
  scm_assert_smob_type (scm_tc16_keyword, keyword);
  return KEYWORDSYM (keyword);
}
#undef FUNC_NAME

int
scm_is_keyword (SCM val)
{
  return KEYWORDP (val);
}

SCM
scm_from_locale_keyword (const char *name)
{
  return scm_symbol_to_keyword (scm_from_locale_symbol (name));
}

SCM
scm_from_locale_keywordn (const char *name, size_t len)
{
  return scm_symbol_to_keyword (scm_from_locale_symboln (name, len));
}

SCM
scm_from_latin1_keyword (const char *name)
{
  return scm_symbol_to_keyword (scm_from_latin1_symbol (name));
}

SCM
scm_from_utf8_keyword (const char *name)
{
  return scm_symbol_to_keyword (scm_from_utf8_symbol (name));
}

/* njrev: critical sections reviewed so far up to here */
void
scm_init_keywords ()
{
  scm_tc16_keyword = scm_make_smob_type ("keyword", 0);
  scm_set_smob_print (scm_tc16_keyword, keyword_print);

  keyword_obarray = scm_c_make_hash_table (0);
#include "libguile/keywords.x"
}


/*
  Local Variables:
  c-file-style: "gnu"
  End:
*/