Annotation of 43BSDTahoe/new/B/src/bint/b2fix.c, revision 1.1.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.