Annotation of 43BSD/contrib/B/src/bint/b1tlt.c, revision 1.1

1.1     ! root        1: /* Copyright (c) Stichting Mathematisch Centrum, Amsterdam, 1985. */
        !             2: 
        !             3: /*
        !             4:   $Header: b1tlt.c,v 1.4 85/08/22 16:53:20 timo Exp $
        !             5: */
        !             6: 
        !             7: /* generic routines for B texts, lists and tables */
        !             8: 
        !             9: #include "b.h"
        !            10: #include "b0fea.h"
        !            11: #include "b1obj.h"
        !            12: #ifndef INTEGRATION
        !            13: #include "b0con.h"
        !            14: #include "b1btr.h"
        !            15: #include "b1val.h"
        !            16: #endif
        !            17: #include "b1tlt.h"
        !            18: #include "b3err.h"
        !            19: 
        !            20: #ifndef INTEGRATION
        !            21: 
        !            22: /* From b1lta.c */
        !            23: int l2size();
        !            24: value l2min(), l2max();
        !            25: 
        !            26: Visible value mk_elt() { /* {}, internal only */
        !            27:        value e = grab_tlt(ELT, Lt);
        !            28:        Root(e) = Bnil;
        !            29:        return e;
        !            30: }
        !            31: 
        !            32: Visible bool empty(v) value v; { /* #v=0, internal only */
        !            33:        switch (Type(v)) {
        !            34:        case ELT:
        !            35:        case Lis:
        !            36:        case Tex:
        !            37:        case Tab:
        !            38:                return Root(v) EQ Bnil;
        !            39:        default:
        !            40:                return No;
        !            41:                /* Some routines must test empty(t) end return an error
        !            42:                   message if it fails, before testing Type(t).
        !            43:                   In this way, they won't give the wrong error message. */
        !            44:        }
        !            45: }
        !            46: 
        !            47: /* return size of (number of items in) dependent tree */
        !            48: 
        !            49: Hidden value treesize(pnode) btreeptr pnode; {
        !            50:     int psize;
        !            51:     value vsize, childsize, u;
        !            52:     intlet l;
        !            53:     psize = Size(pnode);
        !            54:     if (psize EQ Bigsize) {
        !            55:        switch (Flag(pnode)) {        
        !            56:        case Inner:
        !            57:            vsize = mk_integer((int) Lim(pnode));
        !            58:            for (l = 0; l <= Lim(pnode); l++) {
        !            59:                childsize = treesize(Ptr(pnode, l));
        !            60:                u = vsize;
        !            61:                vsize = sum(vsize, childsize);
        !            62:                release(u);
        !            63:                release(childsize);
        !            64:            }
        !            65:            break;
        !            66:        case Irange: 
        !            67:            u = diff(Upbval(pnode), Lwbval(pnode));
        !            68:            vsize = sum(u, one);
        !            69:            release(u);
        !            70:            break;
        !            71:        case Bottom: 
        !            72:        case Crange: 
        !            73:            syserr(MESS(1700, "Bigsize in Bottom or Crange"));
        !            74:        }
        !            75:        return(vsize);
        !            76:     }
        !            77:     return mk_integer(psize);
        !            78: }
        !            79: 
        !            80: Visible value size(t) value t; { /* #t */
        !            81:        int tsize;
        !            82:        switch (Type(t)) {
        !            83:        case ELT:
        !            84:        case Lis:
        !            85:        case Tex:
        !            86:        case Tab:
        !            87:                tsize = Tltsize(t);
        !            88:                if (tsize EQ Bigsize) return treesize(Root(t));
        !            89:                return mk_integer(tsize);
        !            90:        default:
        !            91:                reqerr(MESS(1701, "in #t, t is not a text, list or table"));
        !            92:                return zero;
        !            93:        }
        !            94: }
        !            95: 
        !            96: Visible value th_of(num, v) value num, v; { /* num th'of v */
        !            97:        value m= Vnil;
        !            98:        if (!Is_tlt(v))
        !            99:                error(MESS(1702, "in n th'of t, t is not a text, list or table"));
        !           100:        else if (!Is_number(num))
        !           101:                error(MESS(1703, "in n th'of t, n is not a number"));
        !           102:        else if (empty(v))
        !           103:                error(MESS(1704, "in n th'of t, t is empty"));
        !           104:        else if (numcomp(num, one) < 0)
        !           105:                error(MESS(1705, "in n th'of t, n is < 1"));
        !           106:        else {
        !           107:                /*RANGES?*/
        !           108:                m= thof(intval(num), v);
        !           109:                if (m == Vnil && still_ok)
        !           110:                        error(MESS(1706, "in n th'of t, n exceeds #t"));
        !           111:        }
        !           112:        return m;
        !           113: }
        !           114: 
        !           115: /*
        !           116:  * 'Walktree' handles functions on texts and associates of tables.
        !           117:  * The actual function performed is determined by the 'visit' function.
        !           118:  * The tree is walked (possibly recursively) and all items are visited.
        !           119:  * The return value of walktree() and visit() is used to determine whether
        !           120:  * the walk should continue (Yes == continue, No == stop now).
        !           121:  * Global variables are used to communicate the result, and the parameters
        !           122:  * of the function. The naming convention is according to "e func t".
        !           123:  */
        !           124: 
        !           125: Hidden intlet tt;              /* type of walked value t */
        !           126: Hidden intlet wt;              /* width of items in walked value t */
        !           127: Hidden value ve;               /* value of e, if func is dyadic */
        !           128: Hidden char ce;                /* C char in e, if t is a text */
        !           129: 
        !           130: Hidden int count;              /* result of size2 */
        !           131: Hidden bool found;             /* result for in */
        !           132: Hidden intlet m_char;          /* result for min/max on texts */
        !           133: Hidden value m_val;            /* result for min/max on tables */
        !           134: 
        !           135: #define Lowchar (-Maxintlet)   /* -infinity for characters */
        !           136: #define Highchar (Maxintlet)   /* +infinity */
        !           137: 
        !           138: Hidden bool walktree(p, visit) btreeptr p; bool (*visit)(); {
        !           139:        intlet l;
        !           140:        
        !           141:        if (p EQ Bnil) return Yes; /* i.e., not found (used by in() !) */
        !           142:        for (l=0; l < Lim(p); l++) {
        !           143:                switch (Flag(p)) {
        !           144:                case Inner:
        !           145:                        if (!walktree(Ptr(p, l), visit) || !still_ok)
        !           146:                                return No;
        !           147:                        if (!(*visit)(Piitm(p, l, wt)) || !still_ok)
        !           148:                                return No;
        !           149:                        break;
        !           150:                case Bottom:
        !           151:                        if (!(*visit)(Pbitm(p, l, wt)) || !still_ok)
        !           152:                                return No;
        !           153:                }
        !           154:        }
        !           155:        return Flag(p) EQ Bottom || walktree(Ptr(p, l), visit);
        !           156: }
        !           157: 
        !           158: /* Common code for min/max-1/2, size2, in. */
        !           159: 
        !           160: Hidden Procedure tlt_func(e, t, where, li_func, te_visit, ta_visit)
        !           161:        value e, t;                     /* [e] func t */
        !           162:        string where;                   /* "in [e] func_name t" */
        !           163:        value (*li_func)();             /* func for lists */
        !           164:        bool (*te_visit)(), (*ta_visit)(); /* 'visit' for walktree */
        !           165: {
        !           166:        m_val = Vnil;
        !           167:        if (empty(t)) {
        !           168:                error3(MESSMAKE(where), Vnil, MESS(1707, ", t is empty"));
        !           169:                return;
        !           170:        }
        !           171:        wt = Itemwidth(Itemtype(t));
        !           172:        tt = Type(t);
        !           173:        switch (tt) {
        !           174:        case Lis:
        !           175:                m_val = (*li_func)(e, t);
        !           176:                break;
        !           177:        case Tex:
        !           178:                if (e NE Vnil) {
        !           179:                        if (!Character(e)) {
        !           180:                                error3(MESSMAKE(where), Vnil,
        !           181:                        MESS(1708, ", t is a text, but e is not a character"));
        !           182:                                return;
        !           183:                        }
        !           184:                        ce = Bchar(Root(e), 0);
        !           185:                }
        !           186:                found = !walktree(Root(t), te_visit);
        !           187:                if (m_char NE Lowchar && m_char NE Highchar)
        !           188:                        m_val = mkchar(m_char);
        !           189:                break;
        !           190:        case Tab:
        !           191:                ve = e;
        !           192:                found = !walktree(Root(t), ta_visit);
        !           193:                break;
        !           194:        default:
        !           195:                error3(MESSMAKE(where), Vnil,
        !           196:                        MESS(1709, ", t is not a text list or table"));
        !           197:        }
        !           198: }
        !           199: 
        !           200: Hidden value li2size(e, t) value e, t; {
        !           201:        count = l2size(e, t);
        !           202:        return Vnil;
        !           203: }
        !           204: 
        !           205: Hidden bool te2size(pitm) itemptr pitm; {
        !           206:        if (ce EQ Charval(pitm))
        !           207:                count++;
        !           208:        return Yes;
        !           209: }
        !           210: 
        !           211: Hidden bool ta2size(pitm) itemptr pitm; {
        !           212:        if (compare(ve, Ascval(pitm)) EQ 0)
        !           213:                count++;
        !           214:        return Yes;
        !           215: }
        !           216: 
        !           217: Visible value size2(e, t) value e, t; { /* e#t */
        !           218:        if (empty(t)) /* Must check here because tlt_func would complain */
        !           219:                return copy(zero);
        !           220:        m_char = Lowchar;
        !           221:        count = 0;
        !           222:        tlt_func(e, t, "in e#t", li2size, te2size, ta2size);
        !           223:        return mk_integer(count);
        !           224: }
        !           225: 
        !           226: Hidden value li_in(e, t) value e, t; {
        !           227:        found = in_keys(e, t);
        !           228:        return Vnil;
        !           229: }
        !           230:        
        !           231: Hidden bool te_in(pitm) itemptr pitm; {
        !           232:        return Charval(pitm) NE ce;
        !           233: }
        !           234: 
        !           235: Hidden bool ta_in(pitm) itemptr pitm; {
        !           236:        return compare(ve, Ascval(pitm)) NE 0;
        !           237: }
        !           238: 
        !           239: Visible bool in(e, t) value e, t; {
        !           240:        if (empty(t)) /* Must check here because tlt_func would complain */
        !           241:                return No;
        !           242:        m_char = Lowchar;
        !           243:        found = No;
        !           244:        tlt_func(e, t, "in the test e in t", li_in, te_in, ta_in);
        !           245:        return found;
        !           246: }
        !           247: 
        !           248: Hidden value li_min(e, t) value e, t; {
        !           249:        return th_of(one, t);
        !           250: }
        !           251: 
        !           252: Hidden bool te_min(pitm) itemptr pitm; {
        !           253:        if (m_char > Charval(pitm))
        !           254:                m_char = Charval(pitm);
        !           255:        return Yes;
        !           256: }
        !           257: 
        !           258: Hidden bool ta_min(pitm) itemptr pitm; {
        !           259:        if (m_val EQ Vnil || compare(m_val, Ascval(pitm)) > 0) {
        !           260:                release(m_val);
        !           261:                m_val = copy(Ascval(pitm));
        !           262:        }
        !           263:        return Yes;
        !           264: }
        !           265: 
        !           266: Visible value min1(t) value t; {
        !           267:        m_char = Highchar;
        !           268:        tlt_func(Vnil, t, "in min t", li_min, te_min, ta_min);
        !           269:        return m_val;
        !           270: }
        !           271: 
        !           272: Hidden value li_max(e, t) value e, t; {
        !           273:        value v= size(t);
        !           274:        m_val = th_of(v, t);
        !           275:        release(v);
        !           276:        return m_val;
        !           277: }
        !           278: 
        !           279: Hidden bool te_max(pitm) itemptr pitm; {
        !           280:        if (m_char < Charval(pitm))
        !           281:                m_char = Charval(pitm);
        !           282:        return Yes;
        !           283: }
        !           284: 
        !           285: Hidden bool ta_max(pitm) itemptr pitm; {
        !           286:        if (m_val EQ Vnil || compare(Ascval(pitm), m_val) > 0) {
        !           287:                release(m_val);
        !           288:                m_val = copy(Ascval(pitm));
        !           289:        }
        !           290:        return Yes;
        !           291: }
        !           292: 
        !           293: Visible value max1(t) value t; {
        !           294:        m_char = Lowchar;
        !           295:        tlt_func(Vnil, t, "in max t", li_max, te_max, ta_max);
        !           296:        return m_val;
        !           297: }
        !           298: 
        !           299: Hidden bool te2min(pitm) itemptr pitm; {
        !           300:        if (m_char > Charval(pitm) && Charval(pitm) > ce) {
        !           301:                m_char = Charval(pitm);
        !           302:        }
        !           303:        return Yes;
        !           304: }
        !           305: 
        !           306: Hidden bool ta2min(pitm) itemptr pitm; {
        !           307:        if (compare(Ascval(pitm), ve) > 0
        !           308:            &&
        !           309:            (m_val EQ Vnil || compare(m_val, Ascval(pitm)) > 0)) {
        !           310:                release(m_val);
        !           311:                m_val = copy(Ascval(pitm));
        !           312:        }
        !           313:        return Yes;
        !           314: }
        !           315: 
        !           316: Visible value min2(e, t) value e, t; {
        !           317:        m_char = Highchar;
        !           318:        tlt_func(e, t, "in e min t", l2min, te2min, ta2min);
        !           319:        if (m_val EQ Vnil && still_ok)
        !           320:                reqerr(MESS(1710, "in e min t, no element of t exceeds e"));
        !           321:        return m_val;
        !           322: }
        !           323: 
        !           324: /*+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++*/
        !           325: 
        !           326: Hidden bool te2max(pitm) itemptr pitm; {
        !           327:        if (ce > Charval(pitm) && Charval(pitm) > m_char) {
        !           328:                m_char = Charval(pitm);
        !           329:        }
        !           330:        return Yes;
        !           331: }
        !           332: 
        !           333: Hidden bool ta2max(pitm) itemptr pitm; {
        !           334:        if (compare(ve, Ascval(pitm)) > 0
        !           335:            &&
        !           336:            (m_val EQ Vnil || compare(Ascval(pitm), m_val) > 0)) {
        !           337:                release(m_val);
        !           338:                m_val = copy(Ascval(pitm));
        !           339:        }
        !           340:        return Yes;
        !           341: }
        !           342: 
        !           343: Visible value max2(e, t) value e, t; {
        !           344:        m_char = Lowchar;
        !           345:        tlt_func(e, t, "in e max t", l2max, te2max, ta2max);
        !           346:        if (m_val EQ Vnil && still_ok)
        !           347:                reqerr(MESS(1711, "in e max t, no element of t is less than e"));
        !           348:        return m_val;
        !           349: }
        !           350: 
        !           351: #else INTEGRATION
        !           352: 
        !           353: Visible value mk_elt() { return grab_elt(); }
        !           354: 
        !           355: Visible value size(x) value x; { /* monadic # operator */
        !           356:        if (!Is_tlt(x))
        !           357:                error(MESS(1712, "in #t, t is not a text, list or table"));
        !           358:        return mk_integer((int) Length(x));
        !           359: }
        !           360: 
        !           361: #define Lisent(tp,k) (*(tp+(k)))
        !           362: 
        !           363: Visible value size2(v, t) value v, t; { /* Dyadic # operator */
        !           364:        intlet len= Length(t), n= 0, k; value *tp= Ats(t);
        !           365:        if (!Is_tlt(t)) {
        !           366:                error(MESS(1713, "in e#t, t is not a text, list or table"));
        !           367:                return mk_integer((int) n);
        !           368:        }
        !           369:        switch (Type(t)) {
        !           370:        case Tex:
        !           371:                {string cp= (string)tp; char c;
        !           372:                        if (Type(v) != Tex)
        !           373:                                error(MESS(1714, "in e#t, t is a text but e is not"));
        !           374:                        if (Length(v) != 1)
        !           375:                                error(MESS(1715, "in e#t, e is a text but not a character"));
        !           376:                        c= *Str(v);
        !           377:                        Overall if (*cp++ == c) n++;
        !           378:                } break;
        !           379:        case ELT:
        !           380:                break;
        !           381:        case Lis:
        !           382:                {intlet lo= -1, mi, xx, mm, hi= len; relation c;
        !           383:                bins:   if (hi-lo < 2) break;
        !           384:                        mi= (lo+hi)/2;
        !           385:                        if ((c= compare(v, Lisent(tp,mi))) == 0) goto some;
        !           386:                        if (c < 0) hi= mi; else lo= mi;
        !           387:                        goto bins;
        !           388:                some:   xx= mi;
        !           389:                        while (xx-lo > 1) {
        !           390:                                mm= (lo+xx)/2;
        !           391:                                if (compare(v, Lisent(tp,mm)) == 0) xx= mm;
        !           392:                                else lo= mm;
        !           393:                        }
        !           394:                        xx= mi;
        !           395:                        while (hi-xx > 1) {
        !           396:                                mm= (xx+hi)/2;
        !           397:                                if (compare(v, Lisent(tp,mm)) == 0) xx= mm;
        !           398:                                else hi= mm;
        !           399:                        }
        !           400:                        n= hi-lo-1;
        !           401:                } break;
        !           402:        case Tab:
        !           403:                Overall if (compare(v, Dts(*tp++)) == 0) n++;
        !           404:                break;
        !           405:        default:
        !           406:                syserr(MESS(1716, "e#t with non text, list or table"));
        !           407:                break;
        !           408:        }
        !           409:        return mk_integer((int) n);
        !           410: }
        !           411: 
        !           412: Hidden bool less(r) relation r;    { return r<0; }
        !           413: Hidden bool greater(r) relation r; { return r>0; }
        !           414: 
        !           415: Hidden value mm1(t, rel) value t; bool (*rel)(); {
        !           416:        intlet len= Length(t), k; value m, *tp= Ats(t);
        !           417:        switch (Type(t)) {
        !           418:        case Tex:
        !           419:                {string cp= (string) tp; char mc= '\0', mm[2];
        !           420:                        Overall {
        !           421:                                if (mc == '\0' || ((*rel)(*cp < mc ? -1 : (*cp > mc ? 1 : 0))))
        !           422:                                        mc= *cp;
        !           423:                                cp++;
        !           424:                        }
        !           425:                        mm[0]= mc; mm[1]= '\0';
        !           426:                        m= mk_text(mm);
        !           427:                } break;
        !           428:        case Lis:
        !           429:                if ((*rel)(-1)) /*min*/ m= copy(*Ats(t));
        !           430:                else m= copy(*(Ats(t)+len-1));
        !           431:                break;
        !           432:        case Tab:
        !           433:                {value dm= Vnil;
        !           434:                        Overall {
        !           435:                                if (dm == Vnil || (*rel)(compare(Dts(*tp), dm)))
        !           436:                                        dm= Dts(*tp);
        !           437:                                tp++;
        !           438:                        }
        !           439:                        m= copy(dm);
        !           440:                } break;
        !           441:        default:
        !           442:                syserr(MESS(1717, "min or max t, with non text, list or table"));
        !           443:        }
        !           444:        return m;
        !           445: }
        !           446: 
        !           447: #ifdef NO_ABS
        !           448: 
        !           449: Hidden int abs(i) int i; {
        !           450:        return i >= 0 ? i : -i;
        !           451: }
        !           452: 
        !           453: #endif
        !           454: 
        !           455: Hidden value mm2(v, t, rel) value v, t; bool (*rel)(); {
        !           456:        intlet len= Length(t), k; value m= Vnil, *tp= Ats(t);
        !           457:        switch (Type(t)) {
        !           458:        case Tex:
        !           459:                {string cp= (string) tp; char c, mc= '\0', mm[2];
        !           460:                        c= *Str(v);
        !           461:                        Overall {
        !           462:                                if ((*rel)(c < *cp ? -1 : c > *cp ? 1 : 0)) {
        !           463:                                        if (mc == '\0' || (*rel)(*cp < mc ? -1 : *cp>mc ? 1 : 0))
        !           464:                                                mc= *cp;
        !           465:                                }
        !           466:                                cp++;
        !           467:                        }
        !           468:                        if (mc != '\0') {
        !           469:                                mm[0]= mc; mm[1]= '\0';
        !           470:                                m= mk_text(mm);
        !           471:                        }
        !           472:                } break;
        !           473:        case Lis:
        !           474:                {intlet lim1, mid, lim2;
        !           475:                        if ((*rel)(-1)) { /*min*/
        !           476:                                lim1= 1; lim2= len-1;
        !           477:                        } else {
        !           478:                                lim2= 1; lim1= len-1;
        !           479:                        }
        !           480:                        if (!(*rel)(compare(v, Lisent(tp,lim2)))) break;
        !           481:                        if (len == 1 || (*rel)(compare(v, Lisent(tp,lim1)))) {
        !           482:                                m= copy(Lisent(tp,lim1));
        !           483:                                break;
        !           484:                        }
        !           485:                        /* v rel tp[lim2] && !(v rel tp[lim1]) */
        !           486:                        while (abs(lim2-lim1) > 1) {
        !           487:                                mid= (lim1+lim2)/2;
        !           488:                                if ((*rel)(compare(v, Lisent(tp,mid)))) lim2= mid;
        !           489:                                else lim1= mid;
        !           490:                        }
        !           491:                        m= copy(Lisent(tp,lim2));
        !           492:                } break;
        !           493:        case Tab:
        !           494:                {value dm= Vnil;
        !           495:                        Overall {
        !           496:                                if ((*rel)(compare(v, Dts(*tp)))) {
        !           497:                                        if (dm == Vnil ||
        !           498:                                                (*rel)(compare(Dts(*tp), dm)))
        !           499:                                                dm= Dts(*tp);
        !           500:                                }
        !           501:                                tp++;
        !           502:                        }
        !           503:                        if (dm != Vnil) m= copy(dm);
        !           504:                } break;
        !           505:        default:
        !           506:                syserr(MESS(1718, "min2 or max2 with non text, list or table"));
        !           507:                break;
        !           508:        }
        !           509:        return m;
        !           510: }
        !           511: 
        !           512: Visible value min1(t) value t; { /* Monadic min */
        !           513:        value m= Vnil;
        !           514:        if (!Is_tlt(t))
        !           515:                error(MESS(1719, "in min t, t is not a text, list or table"));
        !           516:        else if (Length(t) == 0)
        !           517:                error(MESS(1720, "in min t, t is empty"));
        !           518:        else m= mm1(t, less);
        !           519:        return m;
        !           520: }
        !           521: 
        !           522: Visible value min2(v, t) value v, t; {
        !           523:        value m= Vnil;
        !           524:        if (!Is_tlt(t))
        !           525:                error(MESS(1721, "in e min t, t is not a text, list or table"));
        !           526:        else if (Length(t) == 0)
        !           527:                error(MESS(1722, "in e min t, t is empty"));
        !           528:        else if (Is_text(t)) {
        !           529:                if (!Is_text(v))
        !           530:                        error(MESS(1723, "in e min t, t is a text but e is not"));
        !           531:                else if (Length(v) != 1)
        !           532:                        error(MESS(1724, "in e min t, e is a text but not a character"));
        !           533:        }
        !           534:        if (still_ok) {
        !           535:                m= mm2(v, t, less);
        !           536:                if (m == Vnil)
        !           537:                        error(MESS(1725, "in e min t, no element of t exceeds e"));
        !           538:        }
        !           539:        return m;
        !           540: }
        !           541: 
        !           542: Visible value max1(t) value t; {
        !           543:        value m= Vnil;
        !           544:        if (!Is_tlt(t))
        !           545:                error(MESS(1726, "in max t, t is not a text, list or table"));
        !           546:        else if (Length(t) == 0)
        !           547:                error(MESS(1727, "in max t, t is empty"));
        !           548:        else m= mm1(t, greater);
        !           549:        return m;
        !           550: }
        !           551: 
        !           552: Visible value max2(v, t) value v, t; {
        !           553:        value m= Vnil;
        !           554:        if (!Is_tlt(t))
        !           555:                error(MESS(1728, "in e max t, t is not a text, list or table"));
        !           556:        else if (Length(t) == 0)
        !           557:                error(MESS(1729, "in e max t, t is empty"));
        !           558:        else if (Is_text(t)) {
        !           559:                if (!Is_text(v))
        !           560:                        error(MESS(1730, "in e max t, t is a text but e is not"));
        !           561:                else if (Length(v) != 1)
        !           562:                        error(MESS(1731, "in e max t, e is a text but not a character"));
        !           563:        }
        !           564:        if (still_ok) {
        !           565:                m= mm2(v, t, greater);
        !           566:                if (m == Vnil)
        !           567:                        error(MESS(1732, "in e max t, no element of t is less than e"));
        !           568:        }
        !           569:        return m;
        !           570: }
        !           571: 
        !           572: Visible value th_of(n, t) value n, t; {
        !           573:        return thof(intval(n), t);
        !           574: }
        !           575: 
        !           576: Visible value thof(n, t) int n; value t; {
        !           577:        intlet len= Length(t); value w= Vnil;
        !           578:        if (!Is_tlt(t))
        !           579:                error(MESS(1733, "in n th'of t, t is not a text, list or table"));
        !           580:        else if (n <= 0 || n > len)
        !           581:                error(MESS(1734, "in n th'of t, n is out of bounds"));
        !           582:        else {
        !           583:                switch (Type(t)) {
        !           584:                case Tex:
        !           585:                        {char ww[2];
        !           586:                                ww[0]= *(Str(t)+n-1); ww[1]= '\0';
        !           587:                                w= mk_text(ww);
        !           588:                        } break;
        !           589:                case Lis:
        !           590:                        w= copy(*(Ats(t)+n-1));
        !           591:                        break;
        !           592:                case Tab:
        !           593:                        w= copy(Dts(*(Ats(t)+n-1)));
        !           594:                        break;
        !           595:                default:
        !           596:                        syserr(MESS(1735, "th'of with non text, list or table"));
        !           597:                }
        !           598:        }
        !           599:        return w;
        !           600: }
        !           601: 
        !           602: Visible bool found(elem, v, probe, where)
        !           603:        value (*elem)(), v, probe; intlet *where;
        !           604:        /* think of elem(v,lo-1) as -Infinity and elem(v,hi+1) as +Infinity.
        !           605:           found and where at the end satisfy:
        !           606:           SELECT:
        !           607:               SOME k IN {lo..hi} HAS probe = elem(v,k):
        !           608:                   found = Yes AND where = k
        !           609:               ELSE: found = No AND elem(v,where-1) < probe < elem(v,where).
        !           610:        */
        !           611: {relation c; intlet lo=0, hi= Length(v)-1;
        !           612:        if (lo > hi) { *where= lo; return No; }
        !           613:        if ((c= compare(probe, (*elem)(v, lo))) == 0) {*where= lo; return Yes; }
        !           614:        if (c < 0) { *where=lo; return No; }
        !           615:        if (lo == hi) { *where=hi+1; return No; }
        !           616:        if ((c= compare(probe, (*elem)(v, hi))) == 0) { *where=hi; return Yes; }
        !           617:        if (c > 0) { *where=hi+1; return No; }
        !           618:        /* elem(lo) < probe < elem(hi) */
        !           619:        while (hi-lo > 1) {
        !           620:                if ((c= compare(probe, (*elem)(v, (lo+hi)/2))) == 0) {
        !           621:                        *where= (lo+hi)/2; return Yes;
        !           622:                }
        !           623:                if (c < 0) hi= (lo+hi)/2; else lo= (lo+hi)/2;
        !           624:        }
        !           625:        *where= hi; return No;
        !           626: }
        !           627: 
        !           628: Visible bool in(v, t) value v, t; {
        !           629:        intlet where, k, len= Length(t); value *tp= Ats(t);
        !           630:        if (!Is_tlt(t)) {
        !           631:                error(MESS(1736, "in the test e in t, t is not a text, list or table"));
        !           632:                return No;
        !           633:        }
        !           634:        switch (Type(t)) {
        !           635:        case Tex:
        !           636:                if (Type(v) != Tex)
        !           637:                        error(MESS(1737, "in the test e in t, t is a text but e is not"));
        !           638:                else if (Length(v) != 1)
        !           639:                        error(MESS(1738, "in the test e in t, e is a text but not a character"));
        !           640:                else return index((string) tp, *Str(v)) != 0;
        !           641:                return No;
        !           642:        case ELT:
        !           643:                return No;
        !           644:        case Lis:
        !           645:                return found(list_elem, t, v, &where);
        !           646:        case Tab:
        !           647:                Overall if (compare(v, Dts(*tp++)) == 0) return Yes;
        !           648:                return No;
        !           649:        default:
        !           650:                syserr(MESS(1739, "e in t with non text, list or table"));
        !           651:                return No;
        !           652:        }
        !           653: }
        !           654: 
        !           655: Visible bool empty(v) value v; {
        !           656:        switch (Type(v)) {
        !           657:        case Tex:
        !           658:        case Lis:
        !           659:        case Tab:
        !           660:        case ELT:
        !           661:                return (Length(v) == 0);
        !           662:        default:
        !           663:                syserr(MESS(1740, "empty() on non tlt value"));
        !           664:                return (No);
        !           665:        }
        !           666: }
        !           667: 
        !           668: #endif INTEGRATION

unix.superglobalmegacorp.com

This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.