PreviousUpNext

15.4.1146  src/lib/std/src/one-byte-unt-guts.pkg

## one-byte-unt-guts.pkg

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



###                "Short words are best
###                 and the old words when
###                 short are best of all."
###
###                   -- Winston Churchill



stipulate
    package it  =  inline_t;                                    # inline_t              is from   src/lib/core/init/built-in.pkg
    package lms =  list_mergesort;                              # list_mergesort        is from   src/lib/src/list-mergesort.pkg
    package mwi =  multiword_int;                               # multiword_int         is from   src/lib/std/types-only/basis-structs.pkg
    package nf  =  number_format;                               # number_format         is from   src/lib/std/src/number-format.pkg
    package nst =  number_string;                               # number_string         is from   src/lib/std/src/number-string.pkg
    package pb  =  proto_basis;                                 # proto_basis           is from   src/lib/std/src/proto-basis.pkg
    package u1b =  one_byte_unt;                                # one_byte_unt          is from   src/lib/std/types-only/basis-structs.pkg
    package u1w =  one_word_unt_guts;                           # one_word_unt_guts     is from   src/lib/std/src/one-word-unt-guts.pkg

    package w8  =  inline_t::u8;                                # "u8" == "8-bit unsigned int".
    package w31 =  inline_t::tu;                                # "tu" == "tagged unsigned int": 31-bits on 32-bit architectures, 63-bit on 64-bit architectures.
herein

    package one_byte_unt_guts: (weak)  Unt {                    # Unt   is from   src/lib/std/src/unt.api
        #
        Unt = u1b::Unt;                                         #  31 bits 

        unt_size = 8;                                           # 64-bit issue ?
        unt_size_w = 0u8;                                       # 64-bit issue ?
        unt_shift = it::tu::(-) (0u31, unt_size_w);             # 64-bit issue -- this will be 63 on 64-bit architectures.

        fun adapt op args
            =
            w8::bitwise_and (op args, 0uxFF);

        to_int   =  w8::to_int   :  Unt -> Int;
        to_int_x =  w8::to_int_x :  Unt -> Int;
        from_int =  w8::from_int :  Int -> Unt;

        to_large_unt   =  w8::to_large_unt:  Unt -> large_unt::Unt;
        to_large_unt_x =  w8::to_large_unt_x;
        from_large_unt =  w8::from_large_unt;

        to_multiword_int   =  u1w::to_multiword_int o to_large_unt:    Unt -> mwi::Int;
        to_multiword_int_x =  w8::to_large_int_x:  Unt -> mwi::Int;
        from_multiword_int =  w8::from_large_int:  mwi::Int -> Unt;


        # These should be inline functions             XXX SUCKO FIXME

        fun (<<) (w:  Unt, k)
            =
            if (it::default_unt::(<=) (unt_size_w, k))
                #
                0u0;
            else
                adapt w8::lshift (w, k);
            fi;

        fun (>>) (w:  Unt, k)
            =
            if (it::default_unt::(<=) (unt_size_w, k))
                #
                0u0;
            else
                w8::rshiftl (w, k);
            fi;

        fun (>>>) (w:  Unt, k)
            =
            if (it::default_unt::(<=) (unt_size_w, k))
                #
                adapt w8::rshift (w8::lshift (w, unt_shift), 0u31);
            else
                adapt w8::rshift (w8::lshift (w, unt_shift), it::default_unt::(+) (unt_shift, k));
            fi;

        bitwise_or  =  w8::bitwise_or  :  (Unt, Unt) -> Unt;
        bitwise_xor =  w8::bitwise_xor :  (Unt, Unt) -> Unt;
        bitwise_and =  w8::bitwise_and :  (Unt, Unt) -> Unt;

        bitwise_not =  adapt w8::bitwise_not :   Unt -> Unt;

        (*) =  (*) :  (Unt, Unt) -> Unt;
        (+) =  (+) :  (Unt, Unt) -> Unt;
        (-) =  (-) :  (Unt, Unt) -> Unt;
        (/) =  (/) :  (Unt, Unt) -> Unt;
        (%) =  (%) :  (Unt, Unt) -> Unt;

        fun compare (w1, w2)
            =
            if   (w8::(<) (w1, w2))  LESS;
            elif (w8::(>) (w1, w2))  GREATER;
            else                     EQUAL;
            fi;

        (>)  =  (>)  : (Unt, Unt) -> Bool;
        (>=) =  (>=) : (Unt, Unt) -> Bool;
        (<)  =  (<)  : (Unt, Unt) -> Bool;
        (<=) =  (<=) : (Unt, Unt) -> Bool;

        (-_) = (-_)     : Unt -> Unt;

        min =   w8::min :   (Unt, Unt) -> Unt;
        max =   w8::max :   (Unt, Unt) -> Unt;

        fun format radix
            =
            (nf::format_unt radix) o to_large_unt; 

        to_string = format nst::HEX;

        fun scan radix
            =
            scan
            where
                scan_large = number_scan::scan_word radix;

                fun scan getc cs
                    =
                    case (scan_large getc cs)
                        #
                        THE (w, cs')
                            =>
                            if (it::u1::(>) (w, 0u255))   raise exception OVERFLOW;
                            else                          THE (from_large_unt w, cs');
                            fi;

                        NULL => NULL;
                    esac;
            end;

        from_string
            =
            pb::scan_string (scan nst::HEX);

        fun sum unts
            =
            sum' (unts, 0u0)
            where
                fun sum' (      [], result) =>  result;
                    sum' (u ! rest, result) =>  sum' (rest, u + result);
                end;
            end;

        fun product unts
            =
            product' (unts, 0u1)
            where
                fun product' (      [], result) =>  result;
                    product' (u ! rest, result) =>  product' (rest, u * result);
                end;
            end;

        fun list_min [] =>   raise exception DIE "Cannot do list_min on empty list";
            #
            list_min (u ! unts)
                =>
                min' (unts, u: Unt)
                where
                    fun min' (      [], result) =>  result;
                        min' (u ! rest, result) =>  min'  (rest,  u < result ?? u :: result);
                    end;
                end;
        end;

        fun list_max [] =>   raise exception DIE "Cannot do list_max on empty list";
            #
            list_max (u ! unts)
                =>
                min' (unts, u: Unt)
                where
                    fun min' (      [], result) =>  result;
                        min' (u ! rest, result) =>  min'  (rest,  u > result ?? u :: result);
                    end;
                end;
        end;

        fun sort unts
            =
            lms::sort_list (>) unts;

        fun sort_and_drop_duplicates unts
            =
            lms::sort_list_and_drop_duplicates  compare  unts;

    };                                          #  package one_byte_unt_guts 
end;




Comments and suggestions to: bugs@mythryl.org

PreviousUpNext