PreviousUpNext

15.4.485  src/lib/compiler/back/top/improve-nextcode/replace-unlimited-precision-int-ops-in-nextcode.pkg

## replace-unlimited-precision-int-ops-in-nextcode.pkg

# Compiled by:
#     src/lib/compiler/core.sublib



# Expand out any remaining occurrences
# of test_inf, trunc_inf, extend_inf,
# and copy_inf.
#
# These primops carry a second argument
# which is a function that performs the
# operation for 32 bit precision.




###                                "John von Neumann was the only
###                                 student I was ever afraid of."
###
###                                              -- George Pólya,


stipulate
    package ncf =  nextcode_form;                       # nextcode_form         is from   src/lib/compiler/back/top/nextcode/nextcode-form.pkg
    package tmp =  highcode_codetemp;                   # highcode_codetemp     is from   src/lib/compiler/back/top/highcode/highcode-codetemp.pkg
herein

    package replace_unlimited_precision_int_ops_in_nextcode
    : (weak)
    api {

        replace_unlimited_precision_int_ops_in_nextcode
            :
            { function:   ncf::Function,
              mk_kvar:    Void -> tmp::Codetemp,                # Make new fate var. 
              mk_i32var:  Void -> tmp::Codetemp                 # Make new one_word_int var. 
            }
            ->
            ncf::Function;

    }

    {

        fun replace_unlimited_precision_int_ops_in_nextcode
              {
                function,
                mk_kvar,
                mk_i32var
              }
            =
            do_function function
            where
                fun do_function (fk, f, vl, tl, e)
                    =
                    (fk, f, vl, tl, cexp e)

                also
                fun cexp (ncf::DEFINE_RECORD { kind, fields, to_temp,  next              })
                      =>  ncf::DEFINE_RECORD { kind, fields, to_temp,  next => cexp next };
                    #
                    cexp (ncf::GET_FIELD_I   { i, record, to_temp, type, next              })
                      =>  ncf::GET_FIELD_I   { i, record, to_temp, type, next => cexp next };
                    #
                    cexp (ncf::GET_ADDRESS_OF_FIELD_I { i, record, to_temp,       next              })
                      =>  ncf::GET_ADDRESS_OF_FIELD_I { i, record, to_temp,       next => cexp next };

                    cexp (ncf::TAIL_CALL funargs)               =>   ncf::TAIL_CALL  funargs;
                    cexp (ncf::DEFINE_FUNS { funs, next })      =>   ncf::DEFINE_FUNS {  funs => map do_function funs,  next => cexp next  };

                    cexp (ncf::JUMPTABLE { i, xvar, nexts })    =>   ncf::JUMPTABLE { i, xvar, nexts => map cexp nexts };
                    #
                    cexp (ncf::IF_THEN_ELSE { op, args, xvar, then_next, else_next })
                        =>
                        ncf::IF_THEN_ELSE   { op, args, xvar, then_next => cexp then_next,
                                                              else_next => cexp else_next
                                            };

                    cexp (ncf::STORE_TO_RAM   { op, args,                next }) =>   ncf::STORE_TO_RAM   { op, args,                next => cexp next };
                    cexp (ncf::FETCH_FROM_RAM { op, args, to_temp, type, next }) =>   ncf::FETCH_FROM_RAM { op, args, to_temp, type, next => cexp next };

                    cexp (ncf::PURE { op   =>  ncf::p::COPY_TO_INTEGER 32,
                                      args =>  [x, fn],
                                      to_temp,
                                      type,
                                      next
                                    }
                         )
                        =>
                        {   k = mk_kvar ();
                            #
                            next = cexp next;

                            ncf::DEFINE_FUNS  { funs =>  [(ncf::FATE_FN, k, [to_temp], [type], next)],
                                                #
                                                next =>  ncf::TAIL_CALL {  fn,
                                                                       args =>  [ncf::CODETEMP k, x, ncf::INT 0]
                                                                    }
                                              };
                        };

                    cexp (ncf::PURE { op   =>  ncf::p::STRETCH_TO_INTEGER 32,
                                      args =>  [x, fn],
                                      to_temp,
                                      type,
                                      next
                                    }
                         )
                        =>
                        {   k = mk_kvar ();

                            next = cexp next;

                            ncf::DEFINE_FUNS  { funs =>  [(ncf::FATE_FN, k, [to_temp], [type], next)],
                                                #
                                                next =>  ncf::TAIL_CALL {  fn,  args => [ncf::CODETEMP k, x, ncf::INT 1] }
                                              };
                        };

                    cexp (   ncf::ARITH { op => ncf::p::SHRINK_INTEGER 32, args => [x, fn], to_temp, type, next }
                         |   ncf::PURE { op => ncf::p::CHOP_INTEGER   32, args => [x, fn], to_temp, type, next }
                         )
                        =>
                        {   k = mk_kvar ();

                            next = cexp next;

                            ncf::DEFINE_FUNS  { funs =>  [(ncf::FATE_FN, k, [to_temp], [type], next)],
                                                next =>  ncf::TAIL_CALL { fn, args => [ncf::CODETEMP k, x] }
                                              };
                        };

                    cexp (ncf::ARITH { op   =>  ncf::p::SHRINK_INTEGER i,
                                      args =>  [x, fn],
                                      to_temp,
                                      type,
                                      next
                                    }
                         )
                        =>
                        {   k  =  mk_kvar ();
                            v' =  mk_i32var ();

                            next =  cexp next;

                            ncf::DEFINE_FUNS
                              {
                                funs =>
                                    [ ( ncf::FATE_FN,
                                        k,
                                        [v'],
                                        [ncf::typ::INT1],
                                        ncf::ARITH
                                          { op => ncf::p::SHRINK_INT (32, i),
                                            args => [ncf::CODETEMP v'],
                                            to_temp,
                                            type,
                                            next
                                          }
                                      )
                                    ],

                                next =>  ncf::TAIL_CALL { fn, args => [ncf::CODETEMP k, x] }
                              };
                        };

                    cexp (ncf::ARITH { op, args, to_temp, type, next              })
                      =>  ncf::ARITH { op, args, to_temp, type, next => cexp next };


                    cexp (ncf::PURE { op   =>  ncf::p::CHOP_INTEGER i,
                                      args =>  [x, fn],
                                      to_temp,
                                      type,
                                      next
                                    }
                         )
                        =>
                        {   k    =  mk_kvar ();
                            v'   =  mk_i32var ();
                            next =  cexp next;

                            ncf::DEFINE_FUNS
                              {
                                funs =>
                                    [ ( ncf::FATE_FN,
                                        k,
                                        [v'],
                                        [ncf::typ::INT1],
                                        ncf::PURE
                                          { op   =>  ncf::p::CHOP (32, i),
                                            args => [ncf::CODETEMP v'],
                                            to_temp,
                                            type,
                                            next
                                           }
                                      )
                                    ],
                                #
                                next =>  ncf::TAIL_CALL {   fn,   args => [ncf::CODETEMP k, x]   }
                              };
                        };

                    cexp (ncf::PURE { op   =>  ncf::p::COPY_TO_INTEGER i,
                                      args =>  [x, fn],
                                      to_temp,
                                      type,
                                      next
                                    }
                         )
                        =>
                        {   k    =  mk_kvar ();
                            v'   =  mk_i32var ();
                            next =  cexp next;

                            ncf::DEFINE_FUNS
                              {
                                funs =>  [ (ncf::FATE_FN, k, [to_temp], [type], next) ],
                                #
                                next =>
                                    ncf::PURE
                                      { op => ncf::p::COPY (i, 32),
                                        args => [x],
                                        to_temp => v',
                                        type => ncf::typ::INT1,
                                        next => ncf::TAIL_CALL {   fn,   args => [ncf::CODETEMP k, ncf::CODETEMP v', ncf::INT 0]  }
                                      }
                              };
                        };

                    cexp (ncf::PURE { op   =>  ncf::p::STRETCH_TO_INTEGER i,
                                      args =>  [x, fn],
                                      to_temp,
                                      type,
                                      next
                                    }
                         )
                        =>
                        {   k    =  mk_kvar ();
                            v'   =  mk_i32var ();
                            next =  cexp next;

                            ncf::DEFINE_FUNS
                              {
                                funs =>  [(ncf::FATE_FN, k, [to_temp], [type], next)],
                                #
                                next => ncf::PURE
                                          { op => ncf::p::STRETCH (i, 32),
                                            args => [x],
                                            to_temp => v',
                                            type => ncf::typ::INT1,
                                            next => ncf::TAIL_CALL { fn,
                                                                 args => [ncf::CODETEMP k, ncf::CODETEMP v', ncf::INT 1]
                                                               }
                                          }
                              };
                        };

                    cexp (ncf::PURE { op, args, to_temp, type, next              })
                      =>  ncf::PURE { op, args, to_temp, type, next => cexp next };

                    cexp (ncf::RAW_C_CALL { kind, cfun_name, cfun_type, args, to_ttemps,  next               })
                      =>  ncf::RAW_C_CALL { kind, cfun_name, cfun_type, args, to_ttemps,  next => cexp next  };
                end;
            end;
    };
end;


Comments and suggestions to: bugs@mythryl.org

PreviousUpNext