00001
00002
00003
00004
00005
00006 static char *rcsid="@(#)$Id: charstring.old.c,v 1.1.1.1 2003/11/20 07:46:26 eus Exp $";
00007 #include <ctype.h>
00008 #include "eus.h"
00009
00010 extern byte *get_string();
00011
00012 pointer CHAR(ctx,n,argv)
00013 register context *ctx;
00014 register int n;
00015 register pointer argv[];
00016 { register pointer a=argv[0];
00017 ckarg(2);
00018 n=ckintval(argv[1]);
00019 if (!isstring(a)) error(E_NOSTRING);
00020 if (n<0 || vecsize(a)<=n) error(E_ARRAYINDEX);
00021
00022
00023
00024
00025
00026 return(makeint(a->c.str.chars[n]));}
00027
00028 pointer SETCHAR(ctx,n,argv)
00029 register context *ctx;
00030 register int n;
00031 register pointer argv[];
00032 { register pointer a=argv[0];
00033 register int newval=ckintval(argv[2]);
00034 ckarg(3);
00035 n=ckintval(argv[1]);
00036 if (!isstring(a)) error(E_NOSTRING);
00037 if (n<0 || vecsize(a)<=n) error(E_ARRAYINDEX);
00038
00039
00040
00041 a->c.str.chars[n]=newval;
00042 return(argv[2]);}
00043
00044 pointer UPCASEP(ctx,n,argv)
00045 register context *ctx;
00046 register int n;
00047 register pointer argv[];
00048 { ckarg(1); n=ckintval(argv[0]);
00049 return((isupper(n))?T:NIL);}
00050
00051 pointer LOWCASEP(ctx,n,argv)
00052 register context *ctx;
00053 register int n;
00054 register pointer argv[];
00055 { ckarg(1); n=ckintval(argv[0]);
00056 return((islower(n))?T:NIL);}
00057
00058 pointer ALPHAP(ctx,n,argv)
00059 register context *ctx;
00060 register int n;
00061 pointer argv[];
00062 { ckarg(1); n=ckintval(argv[0]);
00063 return((isalpha(n))?T:NIL);}
00064
00065 pointer DIGITP(ctx,n,argv)
00066 register context *ctx;
00067 register int n;
00068 pointer argv[];
00069 { ckarg(1); n=ckintval(argv[0]);
00070 return((isdigit(n))?T:NIL);}
00071
00072 pointer ALNUMP(ctx,n,argv)
00073 register context *ctx;
00074 register int n;
00075 register pointer argv[];
00076 { ckarg(1); n=ckintval(argv[0]);
00077 return((isalnum(n))?T:NIL);}
00078
00079 pointer CHUPCASE(ctx,n,argv)
00080 register context *ctx;
00081 register int n;
00082 pointer argv[];
00083 { ckarg(1); n=ckintval(argv[0]);
00084 return((islower(n))?(makeint(toupper(n))):argv[0]);}
00085
00086 pointer CHDOWNCASE(ctx,n,argv)
00087 register context *ctx;
00088 register int n;
00089 pointer argv[];
00090 { ckarg(1); n=ckintval(argv[0]);
00091 return((isupper(n))?(makeint(tolower(n))):argv[0]);}
00092
00093 pointer STRINGEQ(ctx,n,argv)
00094 register context *ctx;
00095 int n;
00096 register pointer argv[];
00097 { register byte *str1, *str2;
00098 int start1,end1,start2,end2;
00099 register int len;
00100 pointer s1=Getstring(argv[0]), s2=Getstring(argv[1]);
00101 ckarg(6);
00102 start1=ckintval(argv[2]); end1=ckintval(argv[3]);
00103 end1=min(end1,vecsize(s1));
00104 start2=ckintval(argv[4]); end2=ckintval(argv[5]);
00105 end2=min(end2,vecsize(s2));
00106 len=end1-start1;
00107 if (len!=end2-start2) return(NIL);
00108 str1= &s1->c.str.chars[start1]; str2= &s2->c.str.chars[start2];
00109 while (len-->0) if (*str1++ != *str2++) return(NIL);
00110 return(T);}
00111
00112 pointer STRINGEQUAL(ctx,n,argv)
00113 register context *ctx;
00114 int n;
00115 register pointer argv[];
00116 { register byte *str1, *str2;
00117 int start1,end1,start2,end2,ch1,ch2;
00118 pointer s1=Getstring(argv[0]),s2=Getstring(argv[1]);
00119 register int len;
00120 ckarg(6);
00121 start1=ckintval(argv[2]); end1=ckintval(argv[3]); end1=min(end1,vecsize(s1));
00122 start2=ckintval(argv[4]); end2=ckintval(argv[5]); end2=min(end2,vecsize(s2));
00123 len=end1-start1;
00124 if (len!=end2-start2) return(NIL);
00125 str1= &s1->c.str.chars[start1]; str2= &s2->c.str.chars[start2];
00126 while (len-->0) {
00127 ch1= *str1++; ch2= *str2++;
00128 if (islower(ch1)) ch1=toupper(ch1);
00129 if (islower(ch2)) ch2=toupper(ch2);
00130 if (ch1!=ch2) return(NIL);}
00131 return(T);}
00132
00133
00134
00135
00136
00137 pointer STR_LT(ctx,n,argv)
00138 register context *ctx;
00139 int n;
00140 register pointer argv[];
00141 { ckarg(2);
00142 if (strcmp(get_string(argv[0]),get_string(argv[1]))<0) return(T);
00143 else return(NIL);}
00144
00145 pointer STR_LE(ctx,n,argv)
00146 register context *ctx;
00147 int n;
00148 register pointer argv[];
00149 { ckarg(2);
00150 if (strcmp(get_string(argv[0]),get_string(argv[1]))<=0) return(T);
00151 else return(NIL);}
00152
00153 pointer STR_EQ(ctx,n,argv)
00154 register context *ctx;
00155 int n;
00156 register pointer argv[];
00157 { ckarg(2);
00158 if (strcmp(get_string(argv[0]),get_string(argv[1]))==0) return(T);
00159 else return(NIL);}
00160
00161 pointer STR_GT(ctx,n,argv)
00162 register context *ctx;
00163 int n;
00164 register pointer argv[];
00165 { ckarg(2);
00166 if (strcmp(get_string(argv[0]),get_string(argv[1]))>0) return(T);
00167 else return(NIL);}
00168
00169 pointer STR_GE(ctx,n,argv)
00170 register context *ctx;
00171 int n;
00172 register pointer argv[];
00173 { ckarg(2);
00174 if (strcmp(get_string(argv[0]),get_string(argv[1]))>=0) return(T);
00175 else return(NIL);}
00176
00177
00178
00179 charstring(ctx,mod)
00180 register context *ctx;
00181 register pointer mod;
00182 {
00183 defun(ctx,"CHAR",mod,CHAR);
00184 defun(ctx,"SCHAR",mod,CHAR);
00185 defun(ctx,"SETCHAR",mod,SETCHAR);
00186 defun(ctx,"ALPHA-CHAR-P",mod,ALPHAP);
00187 defun(ctx,"UPPER-CASE-P",mod,UPCASEP);
00188 defun(ctx,"LOWER-CASE-P",mod,LOWCASEP);
00189 defun(ctx,"DIGIT-CHAR-P",mod,DIGITP);
00190 defun(ctx,"ALPHANUMERICP",mod,ALNUMP);
00191 defun(ctx,"CHAR-UPCASE",mod,CHUPCASE);
00192 defun(ctx,"CHAR-DOWNCASE",mod,CHDOWNCASE);
00193 defun(ctx,"STRINGEQ",mod,STRINGEQ);
00194 defun(ctx,"STRINGEQUAL",mod,STRINGEQUAL);
00195 defun(ctx,"STRING<",mod,STR_LT);
00196 defun(ctx,"STRING<=",mod,STR_LE);
00197 defun(ctx,"STRING=",mod,STR_EQ);
00198 defun(ctx,"STRING>",mod,STR_GT);
00199 defun(ctx,"STRING>=",mod,STR_GE);
00200
00201 }
00202