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

1.1     ! root        1: /* Copyright (c) Stichting Mathematisch Centrum, Amsterdam, 1985. */
        !             2: 
        !             3: /* $Header: b2fix.c,v 1.4 85/08/22 16:55:08 timo Exp $ */
        !             4: 
        !             5: /* Fix unparsed expr/test */
        !             6: 
        !             7: #include "b.h"
        !             8: #include "b1obj.h"
        !             9: #include "b2exp.h"
        !            10: #include "b2nod.h"
        !            11: #include "b2gen.h" /* Must be after b2nod.h */
        !            12: #include "b2par.h" /* For is_b_tag */
        !            13: #include "b3err.h"
        !            14: #include "b3env.h"
        !            15: #include "b3sem.h"
        !            16: 
        !            17: Forward parsetree fix_expr(), fix_test();
        !            18: 
        !            19: Visible Procedure f_eunparsed(pt) parsetree *pt; {
        !            20:        f_unparsed(pt, fix_expr);
        !            21: }
        !            22: 
        !            23: Visible Procedure f_cunparsed(pt) parsetree *pt; {
        !            24:        f_unparsed(pt, fix_test);
        !            25: }
        !            26: 
        !            27: Hidden Procedure f_unparsed(pt, fct) parsetree *pt, (*fct)(); {
        !            28:        parsetree t= *pt; unpadm adm;
        !            29:        struct state v;
        !            30:        /* Ignore visits done during resolving UNPARSED: */
        !            31:        hold(&v);
        !            32:        initunp(&adm, *Branch(t, UNP_SEQ));
        !            33:        t= (*fct)(&adm);
        !            34:        release(*pt);
        !            35:        *pt= t;
        !            36:        jumpto(NilTree);
        !            37:        let_go(&v);
        !            38: }
        !            39: 
        !            40: /* ********************************************************************        */
        !            41: 
        !            42: #define Fld            *Field(Node(adm), N_fld(adm))
        !            43: #define Is_fld         (N_fld(adm) < Nfields(Node(adm)))
        !            44: #define Get_fld(v)     v= copy(Fld); N_fld(adm)++
        !            45: 
        !            46: Hidden Procedure initunp(adm, root) unpadm *adm; value root; {
        !            47:        Prop(adm)= No;
        !            48:        Node(adm)= root;
        !            49:        N_fld(adm)= 0;
        !            50: }
        !            51: 
        !            52: /* ********************************************************************        */
        !            53: 
        !            54: Hidden bool f_dyafun(v, s, fct) value v, *fct; string s; {
        !            55:        value t= Vnil; 
        !            56:        bool is= Is_text(v) && compare(v, t= mk_text(s)) == 0 && is_dyafun(v, fct);
        !            57:        release(t);
        !            58:        return is;
        !            59: }
        !            60: 
        !            61: Hidden bool f_dyatag(v, fct) value v, *fct; {
        !            62:        return Is_text(v) && is_b_tag(v) && is_dyafun(v, fct);
        !            63: }
        !            64: 
        !            65: Visible bool is_b_tag(v) value v; {
        !            66:        value a, b, c; bool x;
        !            67:        /* REPORT v|1 in {'a' .. 'z'} */
        !            68:        a= mk_charrange(b= mk_text("a"), c= mk_text("z"));
        !            69:        release(b); release(c);
        !            70:        x= in(b= curtail(v, one), a);
        !            71:        release(a); release(b);
        !            72:        return x;
        !            73: }
        !            74: 
        !            75: /* ********************************************************************        */
        !            76: 
        !            77: Hidden Procedure fix_formula(adm, v, fct, lev, right)
        !            78:        unpadm *adm; parsetree *v, (*right)(); value fct; intlet lev; {
        !            79: 
        !            80:        parsetree w; value name;
        !            81:        if (Level(adm) < lev) fixerr(Prio);
        !            82:        Get_fld(name);
        !            83:        w= (*right)(adm);
        !            84:        if (Trim(adm)) *v= node3(b_behead(name) ? BEHEAD : CURTAIL, *v, w);
        !            85:        else *v= node5(DYAF, *v, name, w, copy(fct));
        !            86: }
        !            87: 
        !            88: /* ********************************************************************        */
        !            89: 
        !            90: Hidden bool b_expr_opr(v, fct) value v, *fct; {
        !            91:        return  f_dyafun(v, "^^", fct) || f_dyafun(v, "><", fct) ||
        !            92:                f_dyafun(v, "<<", fct) || f_dyafun(v, ">>", fct) ||
        !            93:                f_dyatag(v, fct);
        !            94: }
        !            95: 
        !            96: Forward parsetree fix_term(), fix_factor(), fix_primary(), fix_base();
        !            97: 
        !            98: Hidden parsetree fix_expr(adm) unpadm *adm; {
        !            99:        parsetree v; value fct;
        !           100:        if (!Is_fld) {
        !           101:                fixerr(MESS(4700, "no expression where expected"));
        !           102:                return NilTree;
        !           103:        }
        !           104:        v= fix_term(adm);
        !           105:        if (Is_fld && b_expr_opr(Fld, &fct)) {
        !           106:                if (nodetype(v) == DYAF) fixerr(Prio);
        !           107:                fix_formula(adm, &v, fct, L_expr, fix_base);
        !           108:        }
        !           109:        if (Is_fld && !Prop(adm)) {
        !           110:                value f;
        !           111:                if (Is_text(Fld) && is_dyafun(Fld, &f)) fixerr(Prio);
        !           112:                else fixerr(MESS(4701, "something unexpected following expression"));
        !           113:        }
        !           114:        return v;
        !           115: }
        !           116: 
        !           117: Hidden parsetree fix_test(adm) unpadm *adm; {
        !           118:        parsetree v; value w= Vnil, f= Vnil; value *aa;
        !           119:        if (!Is_fld) {
        !           120:                fixerr(MESS(4702, "no test where expected"));
        !           121:                return NilTree;
        !           122:        }
        !           123:        if (Is_text(Fld)) {
        !           124:                Get_fld(v);
        !           125:                if (is_zerprd(v, &f)) {
        !           126:                        if (Is_fld)
        !           127:                                fixerr(MESS(4703, "something unexpected following test"));
        !           128:                        return node3(TAGzerprd, v, copydef(f));
        !           129:                } else if (aa= envassoc(refinements, v)) {
        !           130:                        if (!Is_fld) return node3(TAGrefinement, v, copy(*aa));
        !           131:                } else if (is_monprd(v, &f)) 
        !           132:                        return node4(MONPRD, v, fix_expr(adm), copydef(f));
        !           133:                release(v);
        !           134:                N_fld(adm)--;
        !           135:        }
        !           136:        Prop(adm)= Yes;
        !           137:        v= fix_expr(adm);
        !           138:        Prop(adm)= No;
        !           139:        if (!(Is_fld && Is_text(Fld) && is_dyaprd(Fld, &f)))
        !           140:                fixerr(MESS(4704, "no test where expected"));
        !           141:        if (Is_fld) Get_fld(w);
        !           142:        return node5(DYAPRD, v, w, fix_expr(adm), copydef(f));
        !           143: }
        !           144: 
        !           145: /* ********************************************************************        */
        !           146: 
        !           147: Hidden bool b_term_opr(v, fct) value v, *fct; {
        !           148:        return  f_dyafun(v, "+", fct) || f_dyafun(v, "-", fct) ||
        !           149:                f_dyafun(v, "^", fct);
        !           150: }
        !           151: 
        !           152: Hidden parsetree fix_term(adm) unpadm *adm; {
        !           153:        parsetree v; value fct;
        !           154:        v= fix_factor(adm);
        !           155:        while (Is_fld && b_term_opr(Fld, &fct))
        !           156:                fix_formula(adm, &v, fct, L_term, fix_factor);
        !           157:        return v;
        !           158: }
        !           159: 
        !           160: /* ********************************************************************        */
        !           161: 
        !           162: Hidden parsetree fix_factor(adm) unpadm *adm; {
        !           163:        parsetree v; value fct;
        !           164:        v= fix_primary(adm);
        !           165:        while (Is_fld && f_dyafun(Fld, "*", &fct))
        !           166:                fix_formula(adm, &v, fct, L_factor, fix_primary);
        !           167:        if (Is_fld && f_dyafun(Fld, "/", &fct))
        !           168:                fix_formula(adm, &v, fct, L_factor, fix_primary);
        !           169:        return v;
        !           170: }
        !           171: 
        !           172: /* ********************************************************************        */
        !           173: 
        !           174: Hidden parsetree fix_primary(adm) unpadm *adm; {
        !           175:        parsetree v; value fct;
        !           176:        v= fix_base(adm);
        !           177:        if (Is_fld && f_dyafun(Fld, "#", &fct))
        !           178:                fix_formula(adm, &v, fct, L_number, fix_base);
        !           179:        if (Is_fld && f_dyafun(Fld, "**", &fct))
        !           180:                fix_formula(adm, &v, fct, L_power, fix_base);
        !           181:        return v;
        !           182: }
        !           183: 
        !           184: /* ********************************************************************        */
        !           185: 
        !           186: Forward parsetree fix_rbase();
        !           187: 
        !           188: Hidden parsetree fix_base(adm) unpadm *adm; {
        !           189:        Level(adm)= L_expr;
        !           190:        Trim(adm)= No;
        !           191:        return fix_rbase(adm);
        !           192: }
        !           193: 
        !           194: Forward parsetree fix_monadic();
        !           195: 
        !           196: Hidden parsetree fix_rbase(adm) unpadm *adm; {
        !           197:        parsetree v, w= NilTree; value f;
        !           198:        if (!Is_fld && !Prop(adm)) {
        !           199:                fixerr(MESS(4705, "no expression where expected"));
        !           200:                return NilTree;
        !           201:        }
        !           202:        if (Is_parsetree(Fld)) {
        !           203:                f_expr(Branch(Node(adm), N_fld(adm)));
        !           204:                Get_fld(v);
        !           205:                fix_trim(adm, &v);
        !           206:                return v;
        !           207:        }
        !           208:        Get_fld(v);
        !           209:        if (modify_tag(v, &w)) fix_trim(adm, &w);
        !           210:        else if (is_monfun(v, &f)) w= fix_monadic(adm, v, f);
        !           211:        else {
        !           212:                fixerr2(v, MESS(4706, " has not yet received a value"));
        !           213:                release(v);
        !           214:        }
        !           215:        return w;
        !           216: }
        !           217: 
        !           218: Hidden Procedure adjust_level(adm, lev)        unpadm *adm; intlet lev; {
        !           219:        if (lev < Level(adm)) Level(adm)= lev;
        !           220: }
        !           221: 
        !           222: Hidden parsetree fix_monadic(adm, v, fct) unpadm *adm; value v, fct; {
        !           223:        if (!Trim(adm)) {
        !           224:                if (b_minus(v)) adjust_level(adm, L_factor); 
        !           225:                else if (b_number(v)) adjust_level(adm, L_power); 
        !           226:                else if (!(b_plus(v) || b_about(v))) 
        !           227:                        adjust_level(adm, L_bottom);
        !           228:        }
        !           229:        if (!Trim(adm) && b_minus(v)) {
        !           230:                intlet lev= Level(adm);
        !           231:                parsetree t= node4(MONF, v, fix_primary(adm), copydef(fct));
        !           232:                adjust_level(adm, lev);
        !           233:                return t;
        !           234:        } else 
        !           235:                return node4(MONF, v, fix_rbase(adm), copydef(fct));
        !           236: }
        !           237: 
        !           238: Hidden Procedure fix_trim(adm, v) unpadm *adm; parsetree *v; {
        !           239:        if (!Trim(adm)) {
        !           240:                Trim(adm)= Yes;
        !           241:                while (Is_fld && (b_behead(Fld) || b_curtail(Fld)))
        !           242:                        fix_formula(adm, v, Vnil, L_bottom, fix_rbase);
        !           243:                Trim(adm)= No;
        !           244:        }
        !           245: }

unix.superglobalmegacorp.com

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