/* [<][>][^][v][top][bottom][index][help] */
DEFINITIONS
This source file includes following definitions.
- keyword_print
- Scm_MakeKeyword
- Scm_GetKeyword
- Scm_DeleteKeyword
- Scm_DeleteKeywordX
- Scm__InitKeyword
1 /*
2 * keyword.c - keyword implementation
3 *
4 * Copyright (c) 2000-2004 Shiro Kawai, All rights reserved.
5 *
6 * Redistribution and use in source and binary forms, with or without
7 * modification, are permitted provided that the following conditions
8 * are met:
9 *
10 * 1. Redistributions of source code must retain the above copyright
11 * notice, this list of conditions and the following disclaimer.
12 *
13 * 2. Redistributions in binary form must reproduce the above copyright
14 * notice, this list of conditions and the following disclaimer in the
15 * documentation and/or other materials provided with the distribution.
16 *
17 * 3. Neither the name of the authors nor the names of its contributors
18 * may be used to endorse or promote products derived from this
19 * software without specific prior written permission.
20 *
21 * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
22 * "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
23 * LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR
24 * A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT
25 * OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
26 * SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED
27 * TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR
28 * PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF
29 * LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
30 * NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
31 * SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
32 *
33 * $Id: keyword.c,v 1.16 2005/07/30 23:39:50 shirok Exp $
34 */
35
36 #define LIBGAUCHE_BODY
37 #include "gauche.h"
38
39 /*
40 * Keywords
41 */
42
43 static void keyword_print(ScmObj obj, ScmPort *port, ScmWriteContext *ctx)
44 {
45 if (SCM_WRITE_MODE(ctx) != SCM_WRITE_DISPLAY) {
46 SCM_PUTC(':', port);
47 }
48 SCM_PUTS(SCM_KEYWORD(obj)->name, port);
49 return;
50 }
51
52 SCM_DEFINE_BUILTIN_CLASS_SIMPLE(Scm_KeywordClass, keyword_print);
53
54 /* Global keyword table. */
55 static struct {
56 ScmHashTable *table;
57 ScmInternalMutex mutex;
58 } keywords = { NULL };
59
60 /* Returns a keyword whose name is NAME. Note that preceding ':' is not
61 * a part of the keyword name.
62 */
63 ScmObj Scm_MakeKeyword(ScmString *name)
64 {
65 ScmHashEntry *e;
66 ScmObj r;
67
68 (void)SCM_INTERNAL_MUTEX_LOCK(keywords.mutex);
69 e = Scm_HashTableGet(keywords.table, SCM_OBJ(name));
70 if (e) r = e->value;
71 else {
72 ScmKeyword *k = SCM_NEW(ScmKeyword);
73 SCM_SET_CLASS(k, SCM_CLASS_KEYWORD);
74 k->name = SCM_STRING(Scm_CopyString(name));
75 Scm_HashTablePut(keywords.table, SCM_OBJ(name), SCM_OBJ(k));
76 r = SCM_OBJ(k);
77 }
78 (void)SCM_INTERNAL_MUTEX_UNLOCK(keywords.mutex);
79 return r;
80 }
81
82 ScmObj Scm_GetKeyword(ScmObj key, ScmObj list, ScmObj fallback)
83 {
84 ScmObj cp;
85 SCM_FOR_EACH(cp, list) {
86 if (!SCM_PAIRP(SCM_CDR(cp))) {
87 Scm_Error("incomplete key list: %S", list);
88 }
89 if (key == SCM_CAR(cp)) return SCM_CADR(cp);
90 cp = SCM_CDR(cp);
91 }
92 if (SCM_UNBOUNDP(fallback)) {
93 Scm_Error("value for key %S is not provided: %S", key, list);
94 }
95 return fallback;
96 }
97
98 ScmObj Scm_DeleteKeyword(ScmObj key, ScmObj list)
99 {
100 ScmObj cp;
101 SCM_FOR_EACH(cp, list) {
102 if (!SCM_PAIRP(SCM_CDR(cp))) {
103 Scm_Error("incomplete key list: %S", list);
104 }
105 if (key == SCM_CAR(cp)) {
106 /* found */
107 ScmObj h = SCM_NIL, t = SCM_NIL;
108 ScmObj tail = Scm_DeleteKeyword(key, SCM_CDR(SCM_CDR(cp)));
109 ScmObj cp2;
110 SCM_FOR_EACH(cp2, list) {
111 if (cp2 == cp) {
112 SCM_APPEND(h, t, tail);
113 return h;
114 } else {
115 SCM_APPEND1(h, t, SCM_CAR(cp2));
116 }
117 }
118 }
119 cp = SCM_CDR(cp);
120 }
121 return list;
122 }
123
124 ScmObj Scm_DeleteKeywordX(ScmObj key, ScmObj list)
125 {
126 ScmObj cp, prev = SCM_FALSE;
127 SCM_FOR_EACH(cp, list) {
128 if (!SCM_PAIRP(SCM_CDR(cp))) {
129 Scm_Error("incomplete key list: %S", list);
130 }
131 if (key == SCM_CAR(cp)) {
132 /* found */
133 if (SCM_FALSEP(prev)) {
134 /* we're at the head of list */
135 return Scm_DeleteKeywordX(key, SCM_CDR(SCM_CDR(cp)));
136 } else {
137 ScmObj tail = Scm_DeleteKeywordX(key, SCM_CDR(SCM_CDR(cp)));
138 SCM_SET_CDR(prev, tail);
139 return list;
140 }
141 }
142 cp = SCM_CDR(cp);
143 prev = cp;
144 }
145 return list;
146 }
147
148 void Scm__InitKeyword(void)
149 {
150 (void)SCM_INTERNAL_MUTEX_INIT(keywords.mutex);
151 keywords.table = SCM_HASH_TABLE(Scm_MakeHashTableSimple(SCM_HASH_STRING, 256));
152 }