Return to b2uni.c CVS log

Up to [CSRG BSD Unix] / 43BSD / contrib / B / src / bint

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

1.1     ! root        1: /* Copyright (c) Stichting Mathematisch Centrum, Amsterdam, 1985. */
        !             2: 
        !             3: /*
        !             4:   $Header: b2uni.c,v 1.4 85/08/22 16:57:24 timo Exp $
        !             5: */
        !             6: 
        !             7: #include "b.h"
        !             8: #include "b0fea.h"
        !             9: #include "b1obj.h"
        !            10: #include "b2par.h"
        !            11: #include "b2key.h"
        !            12: #include "b2syn.h"
        !            13: #include "b2nod.h"
        !            14: #include "b3env.h"
        !            15: #include "b3err.h"
        !            16: #include "b3sou.h" /* for permkey() */
        !            17: 
        !            18: /* ******************************************************************** */
        !            19: /*             unit                                                    */
        !            20: /* ******************************************************************** */
        !            21: 
        !            22: Visible bool unit_keyword() {
        !            23:        bool b; txptr tx0= tx;
        !            24:        b= how_to_keyword() || yield_keyword() || test_keyword();
        !            25:        tx= tx0;
        !            26:        return b;
        !            27: }
        !            28: 
        !            29: Hidden value formlist, sharelist;
        !            30: Hidden envtab reftab; 
        !            31: Visible literal idf_cntxt;
        !            32: 
        !            33: Forward bool is_howto_unit(), is_yield_unit(), is_test_unit();
        !            34: Forward parsetree unicmd_suite(), ref_suite();
        !            35: 
        !            36: Visible parsetree unit(heading) bool heading; {
        !            37:        parsetree v= NilTree;
        !            38:        if (!heading) {
        !            39:                lino= 1;
        !            40:                cntxt= In_unit;
        !            41:                release(uname); uname= Vnil;
        !            42:        }
        !            43:        if (!is_howto_unit(&v, heading) &&
        !            44:            !is_yield_unit(&v, heading) &&
        !            45:            !is_test_unit(&v, heading)
        !            46:           )
        !            47:                parerr(MESS(2800, "no unit keyword where expected"));
        !            48: #ifdef TYPE_CHECK
        !            49:        if (!heading) type_check(v);
        !            50: #endif
        !            51:        return v;
        !            52: }
        !            53: 
        !            54: /* ******************************************************************** */
        !            55: /*             howto_unit                                              */
        !            56: /* ******************************************************************** */
        !            57: 
        !            58: Forward value hu_formals();
        !            59: 
        !            60: Hidden bool is_howto_unit(v, heading) parsetree *v; bool heading; {
        !            61:        if (how_to_keyword()) {
        !            62:                value kw, w, f;
        !            63:                txptr ftx, ttx;
        !            64:                if (cur_ilev != 0) parerr(MESS(2801, "unit starts with indentation"));
        !            65:                formlist= mk_elt(); 
        !            66:                skipsp(&tx);
        !            67:                kw= keyword(); 
        !            68:                release(uname); uname= permkey(kw, How);
        !            69:                if (in(kw, kwlist)) pprerr2(kw, MESS(2802, " is a reserved keyword"));
        !            70:                req(":", ceol, &ftx, &ttx);
        !            71:                idf_cntxt= In_formal;
        !            72:                f= hu_formals(ftx, kw); tx= ttx;
        !            73:                if (!is_comment(&w)) w= Vnil;
        !            74:                *v= node8(HOW_TO, copy(kw), f, w, NilTree, NilTree, Vnil, Vnil);
        !            75:                if (!heading) {
        !            76:                        sharelist= mk_elt();
        !            77:                        *Branch(*v, HOW_SUITE)= unicmd_suite();
        !            78:                        reftab= mk_elt();
        !            79:                        *Branch(*v, HOW_REFINEMENT)= ref_suite();
        !            80:                        *Branch(*v, HOW_R_NAMES)= reftab;
        !            81:                        release(sharelist);
        !            82:                }
        !            83:                release(formlist); 
        !            84:                return Yes;
        !            85:        }
        !            86:        return No;
        !            87: }
        !            88: 
        !            89: Hidden value hu_formals(q, kw) txptr q; value kw; {
        !            90:        value t, v, w;
        !            91:        skipsp(&tx);
        !            92:        if (Text(q) && is_tag(&t)) treat_idf(t);
        !            93:        else t= Vnil;
        !            94:        skipsp(&tx);
        !            95:        v= Text(q) ? hu_formals(q, keyword()) : Vnil;
        !            96:        w= node4(FORMAL, kw, t, v);
        !            97:        return w;
        !            98: }
        !            99: 
        !           100: /* ******************************************************************** */
        !           101: /*             yield_unit                                              */
        !           102: /* ******************************************************************** */
        !           103: 
        !           104: Forward parsetree ytu_formals();
        !           105: 
        !           106: Hidden bool is_yield_unit(v, heading) parsetree *v; bool heading; {
        !           107:        if (yield_keyword()) {
        !           108:                parsetree f; value name, w, adicity;
        !           109:                txptr ftx, ttx;
        !           110:                if (cur_ilev != 0) parerr(MESS(2803, "unit starts with indentation"));
        !           111:                formlist= mk_elt(); 
        !           112:                skipsp(&tx);
        !           113:                req(":", ceol, &ftx, &ttx);
        !           114:                f= ytu_formals(ftx, 'y', &name, &adicity); tx= ttx;
        !           115:                if (!is_comment(&w)) w= Vnil;
        !           116:                *v= node9(YIELD, copy(name), adicity, f, w, NilTree,
        !           117:                          NilTree, Vnil, Vnil);
        !           118:                if (!heading) {
        !           119:                        sharelist= mk_elt();
        !           120:                        *Branch(*v, FPR_SUITE)= unicmd_suite();
        !           121:                        reftab= mk_elt();
        !           122:                        *Branch(*v, FPR_REFINEMENT)= ref_suite();
        !           123:                        *Branch(*v, FPR_R_NAMES)= reftab;
        !           124:                        release(sharelist);
        !           125:                }
        !           126:                release(formlist); 
        !           127:                return Yes;
        !           128:        }
        !           129:        return No;
        !           130: }
        !           131: 
        !           132: /* ******************************************************************** */
        !           133: /*             test_unit                                               */
        !           134: /* ******************************************************************** */
        !           135: 
        !           136: Hidden bool is_test_unit(v, heading) parsetree *v; bool heading; {
        !           137:        if (test_keyword()) {
        !           138:                parsetree f; value name, w, adicity;
        !           139:                txptr ftx, ttx;
        !           140:                if (cur_ilev != 0) parerr(MESS(2804, "unit starts with indentation"));
        !           141:                formlist= mk_elt();
        !           142:                skipsp(&tx);
        !           143:                req(":", ceol, &ftx, &ttx);
        !           144:                f= ytu_formals(ftx, 't', &name, &adicity); tx= ttx;
        !           145:                if (!is_comment(&w)) w= Vnil;
        !           146:                *v= node9(TEST, copy(name), adicity, f, w, NilTree,
        !           147:                          NilTree, Vnil, Vnil);
        !           148:                if (!heading) {
        !           149:                        sharelist= mk_elt();
        !           150:                        *Branch(*v, FPR_SUITE)= unicmd_suite();
        !           151:                        reftab= mk_elt();
        !           152:                        *Branch(*v, FPR_REFINEMENT)= ref_suite();
        !           153:                        *Branch(*v, FPR_R_NAMES)= reftab;
        !           154:                        release(sharelist);
        !           155:                }
        !           156:                release(formlist); 
        !           157:                return Yes;
        !           158:        }
        !           159:        return No;
        !           160: }
        !           161: 
        !           162: /* ******************************************************************** */
        !           163: 
        !           164: #define FML_IN_FML MESS(2805, " is already a formal parameter or operand")
        !           165: #define SH_IN_FML  MESS(2806, " is already a formal parameter")
        !           166: #define SH_IN_SH   MESS(2807, " is already a shared identifier")
        !           167: #define REF_IN_FML MESS(2808, " is already a formal parameter")
        !           168: #define REF_IN_SH  MESS(2809, " is already a shared identifier")
        !           169: #define REF_IN_REF MESS(2810, " is already a refinement name")
        !           170: 
        !           171: Hidden Procedure treat_idf(t) value t; {
        !           172:        switch (idf_cntxt) {
        !           173:                case In_formal: if (in(t, formlist)) pprerr2(t, FML_IN_FML);
        !           174:                                insert(t, &formlist);
        !           175:                                break;
        !           176:                case In_share:  if (in(t, formlist)) pprerr2(t, SH_IN_FML);
        !           177:                                if (in(t, sharelist)) pprerr2(t, SH_IN_SH);
        !           178:                                insert(t, &sharelist);
        !           179:                                break;
        !           180:                case In_ref:    if (in(t, formlist)) pprerr2(t, REF_IN_FML);
        !           181:                                if (in(t, sharelist)) pprerr2(t, REF_IN_SH);
        !           182:                                break;
        !           183:                case In_ranger: break;
        !           184:                default:        break;
        !           185:        }
        !           186: }
        !           187: 
        !           188: Forward parsetree fml_operand();
        !           189: 
        !           190: Hidden parsetree ytu_formals(q, yt, name, adic)
        !           191:        txptr q; char yt; value *name, *adic; {
        !           192: 
        !           193:        parsetree v1, v2, v3;
        !           194:        *name= Vnil;
        !           195:        idf_cntxt= In_formal;
        !           196:        v1= fml_operand(q);
        !           197:        skipsp(&tx);
        !           198:        if (!Text(q)) { /* zeroadic */
        !           199:                *adic= zero; 
        !           200:                if (nodetype(v1) == TAG) {
        !           201:                        *name= *Branch(v1, TAG_NAME);
        !           202:                        release(uname); uname= permkey(*name, Zer);
        !           203:                } else
        !           204:                        pprerr(MESS(2811, "user defined functions must be tags"));
        !           205:                return v1;
        !           206:        }
        !           207: 
        !           208:        v2= fml_operand(q);
        !           209:        skipsp(&tx);
        !           210:        if (!Text(q)) { /* monadic */
        !           211:                *adic= one; 
        !           212:                if (nodetype(v1) == TAG) {
        !           213:                        *name= *Branch(v1, TAG_NAME);
        !           214:                        release(uname); uname= permkey(*name, Mon);
        !           215:                } else
        !           216:                        pprerr(MESS(2812, "no monadic function name"));
        !           217:                if (nodetype(v2) == TAG) treat_idf(*Branch(v2, TAG_NAME));
        !           218:                return node4(yt == 'y' ? MONF : MONPRD, *name, v2, Vnil);
        !           219:        }
        !           220: 
        !           221:        v3= fml_operand(q);
        !           222:        /* dyadic */
        !           223:        *adic= mk_integer(2);
        !           224:        if (nodetype(v2) == TAG) {
        !           225:                *name= *Branch(v2, TAG_NAME);
        !           226:                release(uname); uname= permkey(*name, Dya);
        !           227:        } else
        !           228:                pprerr(MESS(2813, "no dyadic function name"));
        !           229:        upto(q, "dyadic formal formula");
        !           230:        if (nodetype(v1) == TAG) treat_idf(*Branch(v1, TAG_NAME));
        !           231:        if (nodetype(v3) == TAG) treat_idf(*Branch(v3, TAG_NAME));
        !           232:        return node5(yt == 'y' ? DYAF : DYAPRD, v1, *name, v3, Vnil);
        !           233: }
        !           234: 
        !           235: Hidden parsetree fml_operand(q) txptr q; {
        !           236:        value t;
        !           237:        skipsp(&tx);
        !           238:        if (nothing(q, "formal operand")) return NilTree;
        !           239:        else if (is_tag(&t)) return node2(TAG, t);
        !           240:        else if (open_sign()) return compound(q, idf);
        !           241:        else {
        !           242:                parerr(MESS(2814, "no formal operand where expected"));
        !           243:                tx= q;
        !           244:                return NilTree;
        !           245:        }
        !           246: }
        !           247: 
        !           248: /* ******************************************************************** */
        !           249: /*             unit_command_suite                                      */
        !           250: /* ******************************************************************** */
        !           251: 
        !           252: Forward parsetree ucmd_seq();
        !           253: 
        !           254: Forward bool share();
        !           255: 
        !           256: Hidden parsetree unicmd_suite() {
        !           257:        if (ateol()) 
        !           258:                return ucmd_seq(0, Yes);
        !           259:        else {
        !           260:                parsetree v; value c; intlet l= lino;
        !           261:                suite_command(&v, &c);
        !           262:                return node5(SUITE, mk_integer(l), v, c, NilTree);
        !           263:        }
        !           264: }
        !           265: 
        !           266: Hidden parsetree ucmd_seq(cil, first) intlet cil; bool first; {
        !           267:        value c; intlet level, l;
        !           268:        level= ilev(); l= lino;
        !           269:        if (is_comment(&c)) 
        !           270:                return node5(SUITE, mk_integer(l), NilTree, c,
        !           271:                                ucmd_seq(cil, first));
        !           272:        if ((level == cil && !first) || (level > cil && first)) {
        !           273:                parsetree v;
        !           274:                findceol();
        !           275:                if (share(ceol, &v, &c)) 
        !           276:                        return node5(SUITE, mk_integer(l), v, c,
        !           277:                                        ucmd_seq(level, No));
        !           278:                veli();
        !           279:                return cmd_suite(cil, first);
        !           280:        }
        !           281:        veli();
        !           282:        return NilTree;
        !           283: } 
        !           284: 
        !           285: Hidden bool share(q, v, c) txptr q; parsetree *v; value *c; {
        !           286:        if (share_keyword()) {
        !           287:                idf_cntxt= In_share;
        !           288:                *v= node2(SHARE, idf(q));
        !           289:                *c= tail_line();
        !           290:                return Yes;
        !           291:        }
        !           292:        return No;
        !           293: }
        !           294: 
        !           295: 
        !           296: /* ******************************************************************** */
        !           297: /*             refinement_suite                                        */
        !           298: /* ******************************************************************** */
        !           299: 
        !           300: Hidden parsetree ref_suite() {
        !           301:        value name; bool t;
        !           302:        if (ilev() > 0) {
        !           303:                parerr(MESS(2815, "indentation where not allowed"));
        !           304:                return NilTree;
        !           305:        }
        !           306:        if ((t= is_tag(&name)) || is_keyword(&name)) {
        !           307:                parsetree v, s; value w, *aa, r;
        !           308:                skipsp(&tx);
        !           309:                if (Char(tx) != ':') {
        !           310:                        release(name);
        !           311:                        tx= fcol();
        !           312:                        veli(); return NilTree;
        !           313:                }
        !           314:                /* lino= 1; cntxt= In_ref; */
        !           315:                tx++;
        !           316:                if (t) {
        !           317:                        idf_cntxt= In_ref;
        !           318:                        treat_idf(name);
        !           319:                }
        !           320:                if (in_env(reftab, name, &aa)) pprerr2(name, REF_IN_REF);
        !           321:                findceol();
        !           322:                if (!is_comment(&w)) w= Vnil;
        !           323:                s= cmd_suite(0, Yes);
        !           324:                v= node6(REFINEMENT, name, w, s, Vnil, Vnil);
        !           325:                e_replace(r= mk_ref(v), &reftab, name);
        !           326:                release(r);
        !           327:                *Branch(v, REF_NEXT)= ref_suite();
        !           328:                return v;
        !           329:        } 
        !           330:        veli();
        !           331:        return NilTree;
        !           332: }
        !           333: 
        !           334: /* ******************************************************************** */
        !           335: /*             collateral, compound                                    */
        !           336: /* ******************************************************************** */
        !           337: 
        !           338: Hidden parsetree n_collateral(q, n, base)
        !           339:        txptr q; intlet n; parsetree (*base)(); {
        !           340: 
        !           341:        parsetree v, w; txptr ftx, ttx;
        !           342:        if (find(",", q, &ftx, &ttx)) {
        !           343:                w= (*base)(ftx); tx= ttx;
        !           344:                v= n_collateral(q, n+1, base);
        !           345:        } else {
        !           346:                w= (*base)(q);
        !           347:                if (n == 1) return w;
        !           348:                v= mk_compound(n);
        !           349:        }
        !           350:        *Field(v, n-1)= w;
        !           351:        return n > 1 ? v : node2(COLLATERAL, v);
        !           352: }
        !           353: 
        !           354: Visible parsetree collateral(q, base) txptr q; parsetree (*base)(); {
        !           355:        return n_collateral(q, 1, base);
        !           356: }
        !           357: 
        !           358: Visible parsetree compound(q, base) txptr q; parsetree (*base)(); {
        !           359:        parsetree v; txptr ftx, ttx;
        !           360:        req(")", q, &ftx, &ttx);
        !           361:        v= (*base)(ftx); tx= ttx;
        !           362:        return node2(COMPOUND, v);
        !           363: }
        !           364: 
        !           365: /* ******************************************************************** */
        !           366: /*             idf, singidf                                            */
        !           367: /* ******************************************************************** */
        !           368: 
        !           369: Hidden parsetree singidf(q) txptr q; {
        !           370:        parsetree v;
        !           371:        skipsp(&tx);
        !           372:        if (nothing(q, "identifier"))
        !           373:                v= NilTree;
        !           374:        else if (open_sign())
        !           375:                v= compound(q, idf);
        !           376:        else if (is_tag(&v)) {
        !           377:                treat_idf(v);
        !           378:                v= node2(TAG, v);
        !           379:        } else {
        !           380:                parerr(MESS(2816, "no identifier where expected"));
        !           381:                v= NilTree;
        !           382:        }
        !           383:        upto(q, "identifier");
        !           384:        return v;
        !           385: }
        !           386: 
        !           387: Visible parsetree idf(q) txptr q; {
        !           388:        return collateral(q, singidf);
        !           389: }

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