PreviousUpNext

15.4.1147  src/lib/std/src/one-word-int-guts.pkg

## one-word-int-guts.pkg
#
# One-word int -- 32-bit int on 32-bit architectures, 64-bit int on 64-bit architectures.

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

stipulate
    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 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
herein

    package one_word_int_guts: (weak)  Int {                                    # Int                   is from   src/lib/std/src/int.api
        #                                                                       # inline_t              is from   src/lib/core/init/built-in.pkg
        package i32 = inline_t::i1;

        Int = one_word_int::Int;

        precision = THE 32;                                                     # 64-bit issue -- this will be 64 on 64-bit architectures.

        min_int_val =   -2147483648 :   Int;                                    # 64-bit issue -- this is probably -2**31   or such, on 64-bit architectures will need to be -2**63 or such.

        min_int   =  THE min_int_val:  Null_Or(  Int );
        max_int   =  THE 2147483647 :  Null_Or(  Int );                 # 64-bit issue -- this is probably  2**31-1 or such, on 64-bit architectures will need to be  2**63-1 or such.

        (-_)      =  i32::neg       : Int -> Int;
        neg       =  i32::neg       : Int -> Int;
        abs       =  i32::abs       : Int -> Int;

        (+)       =  i32::(+)       : (Int, Int) -> Int;
        (-)       =  i32::(-)       : (Int, Int) -> Int;
        (*)       =  i32::(*)       : (Int, Int) -> Int;

        (/)       =  i32::div       : (Int, Int) -> Int;
        (%)       =  i32::mod       : (Int, Int) -> Int;

        quot      =  i32::quot      : (Int, Int) -> Int;
        rem       =  i32::rem       : (Int, Int) -> Int;

        (<)       =  i32::(<)       : (Int, Int) -> Bool;
        (<=)      =  i32::(<=)      : (Int, Int) -> Bool;
        (>)       =  i32::(>)       : (Int, Int) -> Bool;
        (>=)      =  i32::(>=)      : (Int, Int) -> Bool;

        min       =  i32::min       : (Int, Int) -> Int;
        max       =  i32::max       : (Int, Int) -> Int;

        fun sign  0 =>  0;
            sign  i =>  if (i32::(<) (i, 0) ) -1;
                        else                   1;
                        fi;
        end;

        fun 0! =>  1;
            n! =>  n * (n - 1)! ;
        end;

        fun same_sign (i, j)
            =
            i32::bitwise_and (i32::bitwise_xor (i, j), min_int_val) == 0;

        fun compare ( i: Int,
                      j: Int
                    )
            =
            if    (i32::(<) (i, j))   exceptions_guts::LESS;
            elif  (i32::(>) (i, j))   exceptions_guts::GREATER;
            else                      exceptions_guts::EQUAL;
            fi;

        fun is_prime p                  # A very simple and naive primality tester.  2009-09-02 CrT.
            =
            {   p = abs(p);                     # Try to do something reasonable with negative numbers.
                #
                if   (p < 4)       TRUE;        # Call zero prime.
                elif (p % 2 == 0)  FALSE;       # Special-case even numbers to halve our loop time.
                else
                    # Test all odd numbers less than sqrt(p):

                    loop 3
                    where
                        fun loop i
                            =
                            if   (p % i == 0)   FALSE;
                            elif (i*i >= p)     TRUE;
                            else                loop (i + 2);
                            fi;
                    end;
                fi;
            };

        fun factors n
            =
            factors' (n, 2, [])
            where
                fun factors' (n, p, results)
                    =
                    if (p*p > n)
                        #
                        reverse (n ! results);

                    elif (n % p == 0)

                       factors' (n/p, p,   p ! results);

                    else

                       factors' (n,   p+1,     results);
                    fi;
            end;

        fun sum ints
            =
            sum' (ints, 0)
            where
                fun sum' (      [], result) =>  result;
                    sum' (i ! rest, result) =>  sum' (rest, i + result);
                end;
            end;

        fun product ints
            =
            product' (ints, 1)
            where
                fun product' (      [], result) =>  result;
                    product' (i ! rest, result) =>  product' (rest, i * result);
                end;
            end;

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

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

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

        fun sort_and_drop_duplicates ints
            =
            lms::sort_list_and_drop_duplicates  compare  ints;


        scan   =  ns::scan_int;
        format =  nf::format_int;

        to_string   =  format nst::DECIMAL;
        from_string =  pb::scan_string (scan nst::DECIMAL); 

        my to_int:    Int -> int::Int   = i32::to_int;
        my from_int:  int::Int -> Int   = i32::from_int;

        my to_multiword_int:    Int -> mwi::Int   = i32::to_large;
        my from_multiword_int:  mwi::Int -> Int   = i32::from_large;


        fun mean []     =>      0;                                                      # Would throwing an exception be better?  In graphics, at least, often it is better to just gloss over the occasional special case...
            mean ints   =>      sum ints   /   from_int (length ints);
        end;

        fun median []
                =>
                0;                                                                      # As above, arbitrary, possibly should throw exception.

            median ints
                =>
                {   len  = from_int (length ints);
                    ints = lms::sort_list (>) ints;
                    #
                    i1 = len / 2;
                    i2 = i1 - 1;

                    if (is_odd(len))
                        #       
                        # Return middle element:
                        #       
                        list::nth (ints, to_int i1);
                    else
                        # Return average of the two middle elements:
                        #
                        n1 = list::nth (ints, to_int i1); 
                        n2 = list::nth (ints, to_int i2); 

                        (n1 + n2) / 2;
                    fi;
                }
                where
                    fun is_odd(i) =  (i & 1 == 1);
                end;
        end;
    };
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