PreviousUpNext

15.4.443  src/lib/compiler/back/low/treecode/treecode-fold-g.pkg

## treecode-fold-g.pkg
#
#    "basic functionality for implementing various forms of
#     aggregation function over the [treecode] sumtypes."
#
#                        -- http://www.cs.nyu.edu/leunga/MLRISC/Doc/html/mltree-util.html

# Compiled by:
#     src/lib/compiler/back/low/lib/treecode.lib



###               "I find television very educating.
###                Every time somebody turns on the set,
###                I go into the other room and read a book."
###
###                                  -- Groucho Marx



generic package   treecode_fold_g   (
    #             ===============
    #
    package tcf: Treecode_Form;                                                 # Treecode_Form         is from   src/lib/compiler/back/low/treecode/treecode-form.api

    # Extension mechanism:
    #
    sext:   tcf::Fold_Fns(Y) -> (                    tcf::Sext,  Y) -> Y;
    rext:   tcf::Fold_Fns(Y) -> (tcf::Int_Bitsize,   tcf::Rext,  Y) -> Y;
    fext:   tcf::Fold_Fns(Y) -> (tcf::Float_Bitsize, tcf::Fext,  Y) -> Y;
    ccext:  tcf::Fold_Fns(Y) -> (tcf::Int_Bitsize,   tcf::Ccext, Y) -> Y;
)
: (weak) Treecode_Fold                                                          # Treecode_Fold         is from   src/lib/compiler/back/low/treecode/treecode-fold.api
{
    # Export to client packages:
    #
    package tcf =  tcf;                                                         # "tcf" == "treecode_form".

    fun fold
        { int_expression        =>  do_int_expression,
          float_expression      =>  do_float_expression,
          flag_expression       =>  do_flag_expression,
          void_expression       =>  do_void_expression
        }
        = 
        {   fun void_expression (s, x)
                =
                do_void_expression (s, x)
                where 
                    x = case s
                            #
                            tcf::LOAD_INT_REGISTER (type, dst, e) => int_expression (e, x);
                            tcf::LOAD_INT_REGISTER_FROM_FLAGS_REGISTER (dst, e) => flag_expression (e, x);
                            tcf::LOAD_FLOAT_REGISTER (fty, dst, e) => float_expression (e, x);
                            tcf::MOVE_INT_REGISTERS _  => x;
                            tcf::MOVE_FLOAT_REGISTERS _ => x;
                            tcf::GOTO (e, cf) => int_expression (e, x);
                            tcf::IF_GOTO (cc, l) => flag_expression (cc, x);
                            tcf::CALL { funct, defs, uses, ... } => lowhalfs (uses, lowhalfs (defs, int_expression (funct, x)));
                            tcf::RET _ => x;
                            tcf::FLOW_TO (s, _) => void_expression (s, x);
                            tcf::IF (cc, yes, no) => void_expression (no, void_expression (yes, flag_expression (cc, x)));
                            tcf::STORE_INT (type, ea, d, r) => int_expression (d, int_expression (ea, x));
                            tcf::STORE_FLOAT (fty, ea, d, r) => float_expression (d, int_expression (ea, x));
                            tcf::REGION (s, ctrl) => void_expression (s, x);
                            tcf::SEQ s => void_expressions (s, x);
                            tcf::DEFINE _ => x;
                            tcf::NOTE (s, an) => void_expression (s, x);
                            tcf::EXT s => sext { void_expression, int_expression, float_expression, flag_expression } (s, x);
                            tcf::PHI _ => x; 
                            tcf::ASSIGN(_, a, b) => int_expression (b, int_expression (a, x));
                            tcf::SOURCE => x; 
                            tcf::SINK => x; 
                            tcf::RTL _ => x;
                            tcf::LIVE ls => lowhalfs (ls, x);
                            tcf::DEAD ks => lowhalfs (ks, x);
                        esac;
                end

            also
            fun void_expressions (ss, x)
                 =
                 fold_backward void_expression x ss

            also
            fun int_expression (e, x)
                 = 
                 do_int_expression (e, x)
                 where
                     x = case e
                             #                      
                             tcf::CODETEMP_INFO _ => x;
                             tcf::LITERAL _ => x;
                             tcf::LABEL _ => x; 
                             tcf::LABEL_EXPRESSION _ => x; 
                             tcf::LATE_CONSTANT _ => x;
                             tcf::NEG (type, a) => int_expression (a, x);
                             tcf::ADD (type, a, b) => rexp2 (a, b, x);
                             tcf::SUB (type, a, b) => rexp2 (a, b, x);
                             tcf::MULS (type, a, b) => rexp2 (a, b, x);
                             tcf::DIVS (m, type, a, b) => rexp2 (a, b, x);
                             tcf::REMS (m, type, a, b) => rexp2 (a, b, x);
                             tcf::MULU (type, a, b) => rexp2 (a, b, x);
                             tcf::DIVU (type, a, b) => rexp2 (a, b, x);
                             tcf::REMU (type, a, b) => rexp2 (a, b, x);
                             tcf::NEG_OR_TRAP (type, a) => int_expression (a, x);
                             tcf::ADD_OR_TRAP (type, a, b) => rexp2 (a, b, x);
                             tcf::SUB_OR_TRAP (type, a, b) => rexp2 (a, b, x);
                             tcf::MULS_OR_TRAP (type, a, b) => rexp2 (a, b, x);
                             tcf::DIVS_OR_TRAP (m, type, a, b) => rexp2 (a, b, x);
                             tcf::BITWISE_AND (type, a, b) => rexp2 (a, b, x);
                             tcf::BITWISE_OR (type, a, b) => rexp2 (a, b, x);
                             tcf::BITWISE_XOR (type, a, b) => rexp2 (a, b, x);
                             tcf::BITWISE_EQV (type, a, b) => rexp2 (a, b, x);
                             tcf::BITWISE_NOT (type, a) => int_expression (a, x);
                             tcf::RIGHT_SHIFT (type, a, b) => rexp2 (a, b, x);
                             tcf::RIGHT_SHIFT_U (type, a, b) => rexp2 (a, b, x);
                             tcf::LEFT_SHIFT (type, a, b) => rexp2 (a, b, x);
                             tcf::SIGN_EXTEND (t, t', e) => int_expression (e, x);
                             tcf::ZERO_EXTEND (t, t', e) => int_expression (e, x);
                             tcf::FLOAT_TO_INT (type, mode, fty, e) => float_expression (e, x);
                             tcf::CONDITIONAL_LOAD (type, cc, yes, no) => int_expression (no, int_expression (yes, flag_expression (cc, x)));
                             tcf::LOAD (type, ea, r) => int_expression (ea, x);
                             tcf::PRED (e, ctrl) => int_expression (e, x);
                             tcf::LET (s, e) => int_expression (e, void_expression (s, x));
                             tcf::REXT (t, e) => rext { void_expression, int_expression, float_expression, flag_expression } (t, e, x);
                             tcf::RNOTE (e, an) => int_expression (e, x);
                             tcf::OP (type, op, es) => rexps (es, x);
                             tcf::ARG _ => x;
                             tcf::PARAM _ => x;
                             tcf::BITSLICE(_, _, e) => int_expression (e, x);
                             tcf::ATATAT(type, k, e) => int_expression (e, x);
                             tcf::QQQ => x;
                         esac;
                 end

            also
            fun rexp2 (a, b, x)
                 =
                 int_expression (b, int_expression (a, x))

            also
            fun rexps (es, x)
                 =
                 fold_backward int_expression x es

            also
            fun float_expression (e, x)
                =
                do_float_expression (e, x)
                where
                    x = case e
                            #
                            tcf::CODETEMP_INFO_FLOAT _ => x;
                            tcf::FLOAD (fty, e, r) => int_expression (e, x);
                            #
                            tcf::FADD (fty, a, b) =>  fexp2 (a, b, x);
                            tcf::FSUB (fty, a, b) =>  fexp2 (a, b, x);
                            tcf::FMUL (fty, a, b) =>  fexp2 (a, b, x);
                            tcf::FDIV (fty, a, b) =>  fexp2 (a, b, x);
                            #
                            tcf::FABS  (fty, e) =>  float_expression (e, x);
                            tcf::FNEG  (fty, e) =>  float_expression (e, x);
                            tcf::FSQRT (fty, e) =>  float_expression (e, x);
                            #
                            tcf::COPY_FLOAT_SIGN (fty, a, b) => fexp2 (a, b, x);
                            tcf::FCONDITIONAL_LOAD (fty, c, a, b) => fexp2 (a, b, flag_expression (c, x));
                            #
                            tcf::INT_TO_FLOAT   (fty, type, e) => int_expression (e, x);
                            tcf::FLOAT_TO_FLOAT (fty, fty', e) => float_expression (e, x);
                            #
                            tcf::FPRED (e, ctrl) => float_expression (e, x);
                            tcf::FEXT (t, e) => fext { void_expression, int_expression, float_expression, flag_expression } (t, e, x);
                            tcf::FNOTE (e, an) => float_expression (e, x);
                        esac;
                 end

            also
            fun fexp2 (a, b, x)
                 =
                 float_expression (b, float_expression (a, x))

            also
            fun fexps (es, x)
                 =
                 fold_backward float_expression x es

            also
            fun flag_expression (e, x)
                =
                do_flag_expression (e, x)
                where
                    x = case e
                            #
                            tcf::CC _  => x;
                            tcf::FCC _ => x; 
                            tcf::TRUE  => x;
                            tcf::FALSE => x;
                            #
                            tcf::NOT e => flag_expression (e, x);
                            #
                            tcf::AND (a, b) => flag_expression2 (a, b, x);
                            tcf::OR  (a, b) => flag_expression2 (a, b, x);
                            tcf::XOR (a, b) => flag_expression2 (a, b, x);
                            tcf::EQV (a, b) => flag_expression2 (a, b, x);
                            #
                            tcf::CMP  (type,  cond, a, b) => rexp2 (a, b, x);
                            tcf::FCMP (type, fcond, a, b) => fexp2 (a, b, x);
                            #
                            tcf::CCNOTE (e, an) => flag_expression (e, x);
                            tcf::CCEXT (t, e) => ccext { void_expression, int_expression, float_expression, flag_expression } (t, e, x);
                        esac;
                end

            also
            fun flag_expression2 (a, b, x)
                 =
                 flag_expression (b, flag_expression (a, x))

            also
            fun lowhalfs (m, x)
                 =
                 fold_backward lowhalf x m

            also
            fun lowhalf (m, x)
                 =
                 case m
                     #     
                     tcf::FLAG_EXPRESSION  e =>  flag_expression (e, x);
                     tcf::INT_EXPRESSION   e =>   int_expression (e, x);
                     tcf::FLOAT_EXPRESSION e => float_expression (e, x);
                 esac;


            { int_expression,
              float_expression,
              flag_expression,
              void_expression
            };
        };
};                                                                                      # treecode_fold_g 


Comments and suggestions to: bugs@mythryl.org

PreviousUpNext