base/enum.c

   1 /*
   2  *
   3  */
   4
   5 #include <string.h>
   6
   7 #include "chiark-tcl.h"
   8 #include "tables.h"
   9
  10 static void enum_nt_dup(Tcl_Obj *src, Tcl_Obj *dup) {
  11   dup->internalRep= src->internalRep;
  12   dup->typePtr= src->typePtr;
  13 }
  14
  15 static void enum_nt_ustr(Tcl_Obj *o) {
  16   abort();
  17 }
  18
  19 static int enum_nt_sfa(Tcl_Interp *ip, Tcl_Obj *o) {
  20   abort();
  21 }
  22
  23 Tcl_ObjType cht_enum_nearlytype = {
  24   "enum-nearly",
  25   0, enum_nt_dup, enum_nt_ustr, enum_nt_sfa
  26 };
  27
  28 Tcl_ObjType cht_enum1_nearlytype = {
  29   "enum1-nearly",
  30   0, enum_nt_dup, enum_nt_ustr, enum_nt_sfa
  31 };
  32
  33 static void report_bad(Tcl_Interp *ip, const char *what, const char *supplied,
  34                        const void *first, size_t each,
  35                        int (*isvalid)(const void *entry),
  36                        void (*appres)(Tcl_Interp *ip, const void *entry)) {
  37   int count, i;
  38   const Byte *entry;
  39
  40   for (entry=first; isvalid(entry); entry+=each);
  41   count= (entry - (const Byte*)first) / each;
  42
  43   Tcl_ResetResult(ip);
  44   Tcl_AppendResult(ip, "bad ",what," \"",supplied,"\": must be",(char*)0);
  45
  46   for (i=0, entry=first; i<count; i++, entry+=each) {
  47     Tcl_AppendResult(ip,
  48                      (char*)(i==0 ? " " :
  49                              i+1==count ? ", or " :
  50                              ", "),
  51                      (char*)0);
  52     appres(ip,entry);
  53   }
  54 }
  55
  56 static const char *enum_str(const void *p) { return *(const char*const*)p; }
  57 static int isvalid_enum(const void *p) { return !!enum_str(p); }
  58 static void appres_enum(Tcl_Interp *ip, const void *p) {
  59   Tcl_AppendResult(ip, enum_str(p), (char*)0);
  60 }
  61
  62 const void *cht_enum_lookup_cached_func(Tcl_Interp *ip, Tcl_Obj *o,
  63                                     const void *firstentry, size_t entrysize,
  64                                     const char *what) {
  65   const char *supplied, *found;
  66   const char *ep;
  67
  68   if (o->typePtr == &cht_enum_nearlytype &&
  69       o->internalRep.twoPtrValue.ptr1 == firstentry)
  70     return o->internalRep.twoPtrValue.ptr2;
  71
  72   supplied= Tcl_GetStringFromObj(o,0);  assert(supplied);
  73   for (ep= firstentry;
  74        (found= *(const char*const*)ep) && strcmp(supplied,found);
  75        ep += entrysize);
  76
  77   if (found) {
  78     cht_objfreeir(o);
  79     o->typePtr= &cht_enum_nearlytype;
  80     o->internalRep.twoPtrValue.ptr1= (void*)firstentry;
  81     o->internalRep.twoPtrValue.ptr2= (void*)ep;
  82     return ep;
  83   }
  84
  85   report_bad(ip,what,supplied, firstentry,entrysize, isvalid_enum,appres_enum);
  86   return 0;
  87 }
  88
  89 static int isvalid_enum1(const void *p) { return !!*(const char*)p; }
  90 static void appres_enum1(Tcl_Interp *ip, const void *p) {
  91   char buf[2];
  92   buf[0]= *(const char*)p;
  93   buf[1]= 0;
  94   Tcl_AppendResult(ip, buf, (char*)0);
  95 }
  96
  97 int cht_enum1_lookup_cached_func(Tcl_Interp *ip, Tcl_Obj *o,
  98                              const char *opts, const char *what) {
  99   const char *supplied, *fp;
 100
 101   if (o->typePtr != &cht_enum1_nearlytype ||
 102       o->internalRep.twoPtrValue.ptr1 != opts) {
 103
 104     supplied= Tcl_GetStringFromObj(o,0);  assert(supplied);
 105
 106     if (!(strlen(supplied) == 1 &&
 107           (fp= strchr(opts, supplied[0])))) {
 108       report_bad(ip,what,supplied, opts,1, isvalid_enum1,appres_enum1);
 109       return -1;
 110     }
 111
 112     cht_objfreeir(o);
 113     o->typePtr= &cht_enum1_nearlytype;
 114     o->internalRep.twoPtrValue.ptr1= (void*)opts;
 115     o->internalRep.twoPtrValue.ptr2= (void*)fp;
 116   }
 117   return (const char*)o->internalRep.twoPtrValue.ptr2 - opts;
 118 }