PreviousUpNext

15.4.1105  src/lib/std/src/num-format.pkg

## num-format.pkg

# Compiled by:
#     src/lib/std/src/standard-core.sublib

# The word to string conversion for the largest word and int types.
# All of the other fmt functions can be implemented in terms of them.

###                   "War does not determine who is right - only who is left."
###
###                                                 -- Bertrand Russell



stipulate                               # inline_t      is from   src/lib/core/init/built-in.pkg
    package u32 = inline_t::u1;         # "u1" == one-word unsigned int (32-bits on 32-bit architectures; 64-bits on 64-bit architectures.)
    package ti  = inline_t::ti;         # "ti" == "tagged_int".         (31-bits on 32-bit architectures; 63-bits on 64-bit architectures.)
    package i32 = inline_t::i1;         # "i1" == one-word   signed int (32-bits on 32-bit architectures; 64-bits on 64-bit architectures.)
herein
    package num_format: (weak)  api {
        #
        format_unt:  number_string::Radix -> one_word_unt::Unt -> String;
        format_int:  number_string::Radix -> one_word_int::Int -> String;
    }
    {

        my (<)   = u32::(<);
        my (-)   = u32::(-);
        my (*)   = u32::(*);
        my (div) = u32::div;

        fun mk_digit (w:  one_word_unt::Unt)
            =
            inline_t::vector_of_chars::get ("0123456789ABCDEF", u32::to_int w);

        fun word_to_bin w
            =
            f (w, 0, [])
            where
                fun make_bit w
                    =
                    u32::bitwise_and (w, 0u1) == 0u0
                      ?? '0'
                      :: '1';

                fun f (0u0, n, l) =>   (ti::(+) (n, 1), '0' ! l);
                    f (0u1, n, l) =>   (ti::(+) (n, 1), '1' ! l);
                    f (w,   n, l) =>   f (u32::rshiftl (w, 0u1), ti::(+) (n, 1), (make_bit w) ! l);
                end;
            end;

        fun word_to_oct w
            =
            f (w, 0, [])
            where
                fun f (w, n, l)
                    =
                    if   (w < 0u8)

                         (ti::(+) (n, 1), (mk_digit w) ! l);
                    else
                         f (u32::rshiftl (w, 0u3), ti::(+) (n, 1), mk_digit (u32::bitwise_and (w, 0ux7)) ! l);
                    fi;
            end;

        fun word_to_dec w
            =
            f (w, 0, [])
            where
                fun f (w, n, l)
                    =
                    if   (w < 0u10)

                         (ti::(+) (n, 1), (mk_digit w) ! l);
                    else
                         j = w div 0u10;

                         f (j,  ti::(+) (n, 1), mk_digit (w - 0u10*j) ! l);
                    fi;
            end;

        fun word_to_hex w
            =
            f (w, 0, [])
            where
                fun f (w, n, l)
                    =
                    if   (w < 0u16)

                         (ti::(+) (n, 1), (mk_digit w) ! l);
                    else
                         f (u32::rshiftl (w, 0u4), ti::(+) (n, 1), mk_digit (u32::bitwise_and (w, 0uxf)) ! l);
                    fi;
            end;

        fun format_w number_string::BINARY  => word_to_bin;
            format_w number_string::OCTAL   => word_to_oct;
            format_w number_string::DECIMAL => word_to_dec;
            format_w number_string::HEX     => word_to_hex;
        end;

        fun format_unt radix
            =
            prestring::implode o (format_w radix);

        i2w =  u32::from_large_int o i32::to_large;

        fun format_int radix i
            = 
            if (i2w i == 0ux80000000)
                #
                "-2147483648";
            else
                w32 =  i2w (if (i32::(<) (i, 0) ) i32::neg(i); else i;fi);

                my (n, digits)
                    =
                    format_w radix w32;

                if (i32::(<) (i, 0))
                     #
                     prestring::implode (ti::(+) (n, 1), '-' ! digits);
                else prestring::implode (n, digits);
                fi;
            fi;
    };

end;


Comments and suggestions to: bugs@mythryl.org

PreviousUpNext