PreviousUpNext

15.4.1148  src/lib/std/src/one-word-unt-guts.pkg

## one-word-unt-guts.pkg
#
# One-word unt ("unsigned int") -- 32-bit unt on 32-bit architectures, 64-bit unt on 64-bit architectures.

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

###             "Words, words. They're all we have to go on."
###
###                -- Tom Stoppard, "Rosencrantz and Guildenstern Are Dead"



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 nf  =  number_format;                                               # number_format         is from   src/lib/std/src/number-format.pkg
    package ns  =  number_scan;                                                 # number_scan           is from   src/lib/std/src/number-scan.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 u1w =  one_word_unt;                                                # one_word_unt          is from   src/lib/std/types-only/basis-structs.pkg
    #
    package w32 =  it::u1;                                                      # "u1" == "one-word unsigned int" -- 32 bits on 32-bit architectures, 64 bits on 64-bit architectures.
herein

    package one_word_unt_guts: (weak)  Unt {                                    # Unt                   is from   src/lib/std/src/unt.api
        #
        Unt = u1w::Unt;

        unt_size = 32;                                                                          # 64-bit issue.

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

        to_multiword_int    =   w32::to_large_int;
        to_multiword_int_x  =   w32::to_large_int_x;
        from_multiword_int  =   w32::from_large_int;

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

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

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

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

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

        (<<)   =   w32::check_lshift;
        (>>)   =   w32::check_rshiftl;
        (>>>)  =   w32::check_rshift; 

        (-_)   = (-_): Unt -> Unt;
        min    = w32::min:  (Unt, Unt) -> Unt;
        max    = w32::max:  (Unt, Unt) -> Unt;

        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;

        format    =  nf::format_unt;
        to_string =  format  nst::HEX;

        scan =  ns::scan_word;

        from_string =  pb::scan_string  (scan  nst::HEX);
    };                                                                  #  package one_word_unt_guts 
end;




## COPYRIGHT (c) 1995 AT&T Bell Laboratories.
## Subsequent changes by Jeff Prothero Copyright (c) 2010-2015,
## released per terms of SMLNJ-COPYRIGHT.


Comments and suggestions to: bugs@mythryl.org

PreviousUpNext