root/src/keyword.c

/* [<][>][^][v][top][bottom][index][help] */

DEFINITIONS

This source file includes following definitions.
  1. keyword_print
  2. Scm_MakeKeyword
  3. Scm_GetKeyword
  4. Scm_DeleteKeyword
  5. Scm_DeleteKeywordX
  6. 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 }

/* [<][>][^][v][top][bottom][index][help] */