sets_c.tcl

Go to the documentation of this file.
00001 /* ----------------------------------------------------------------------*/
00002 /* */
00003 /*  sets_tcl.tcl --*/
00004 /* */
00005 /*        Definitions for the processing of sets. C implementation.*/
00006 /* */
00007 /*  Copyright (c) 2007 by Andreas Kupries.*/
00008 /* */
00009 /*  See the file "license.terms" for information on usage and redistribution*/
00010 /*  of this file, and for a DISCLAIMER OF ALL WARRANTIES.*/
00011 /* */
00012 /*  RCS: @(#) $Id: sets_c.tcl,v 1.1 2007/01/21 22:15:59 andreas_kupries Exp $*/
00013 /* */
00014 /* ----------------------------------------------------------------------*/
00015 
00016 package require critcl
00017 package provide struct_c =  2.1.1
00018 package require Tcl 8.4
00019 
00020 namespace ::struct {
00021     /*  Supporting code for the main command.*/
00022 
00023     catch {
00024         critcl::cheaders -g
00025         critcl::debug memory symbols
00026     }
00027 
00028     critcl::cheaders s = /*.h
00029     critcl::csources s = /*.c
00030 
00031     critcl::ccode {
00032         /* -*- c -*- */
00033 
00034         /* include <m.h>*/
00035     }
00036 
00037     /*  Main command, set creation.*/
00038 
00039     critcl::ccommand _critcl =  {dummy interp objc objv} {
00040     /* Syntax - dispatcher to the sub commands.
00041      */
00042 
00043         static CONST char* ret s [] = (
00044             "type add",      ", type contains",     ", type difference",   ", type empty",
00045             ", type equal",", type exclude",  ", type include",      ", type intersect",
00046             ", type intersect3",       ", type size", ", type subsetof",     ", type subtract",
00047             ", type symdiff",  ", type union",
00048             , type NULL
00049         );
00050         enum methods {
00051             S_add,      S_contains,     S_difference,   S_empty,
00052             S_equal,S_exclude,  S_include,      S_intersect,
00053             S_intersect3,       S_size, S_subsetof,     S_subtract,
00054             S_symdiff,  S_union
00055         };
00056 
00057     int m;
00058 
00059         if (objc < 2) {
00060             Tcl_WrongNumArgs (interp, objc, objv, "cmd ?arg ...?");
00061             return TCL_ERROR;
00062         } else if (Tcl_GetIndexFromObj (interp, objv [1], ret s, "option",
00063             0, &m) != TCL_OK) (
00064             type return , type TCL_, type ERROR;
00065         )
00066 
00067         /* Dispatch to methods. They check the #args in detail before performing
00068          * the requested functionality
00069          */
00070 
00071         switch (m) {
00072             case S_add:        return sm_ADD        (NULL, interp, objc, objv);
00073             case S_contains:   return sm_CONTAINS   (NULL, interp, objc, objv);
00074             case S_difference: return sm_DIFFERENCE (NULL, interp, objc, objv);
00075             case S_empty:      return sm_EMPTY      (NULL, interp, objc, objv);
00076             case S_equal:      return sm_EQUAL      (NULL, interp, objc, objv);
00077             case S_exclude:    return sm_EXCLUDE    (NULL, interp, objc, objv);
00078             case S_include:    return sm_INCLUDE    (NULL, interp, objc, objv);
00079             case S_intersect:  return sm_INTERSECT  (NULL, interp, objc, objv);
00080             case S_intersect3: return sm_INTERSECT3 (NULL, interp, objc, objv);
00081             case S_size:       return sm_SIZE       (NULL, interp, objc, objv);
00082             case S_subsetof:   return sm_SUBSETOF   (NULL, interp, objc, objv);
00083             case S_subtract:   return sm_SUBTRACT   (NULL, interp, objc, objv);
00084             case S_symdiff:    return sm_SYMDIFF    (NULL, interp, objc, objv);
00085             case S_union:      return sm_UNION      (NULL, interp, objc, objv);
00086         }
00087         /* Not coming to this place */
00088     }
00089 }
00090 
00091 /*  ### ### ### ######### ######### #########*/
00092 /*  Ready*/
00093