PreviousUpNext

15.4.1195  src/lib/std/src/rw-vector-of-one-byte-unts.pkg

## rw-vector-of-one-byte-unts.pkg

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

###                    "The motto stated a lie. If this nation has ever trusted in God,
###                     that time has gone by; for nearly half a century almost its
###                     entire trust has been in the Republican party and the dollar --
###                     mainly the dollar.
###
###                    "I recognize that I am only making an assertion and furnishing no proof;
###                     I am sorry, but this is a habit of mine; sorry also that I am not alone in it;
###                     everybody seems to have this disease."
###
###                                                    -- Mark Twain in Eruption



stipulate
    package inl =  inline_t;                                    # inline_t                      is from   src/lib/core/init/built-in.pkg
    package rt  =  runtime;                                     # runtime                       is from   src/lib/core/init/built-in.pkg.
    package u1b =  one_byte_unt;                                # one_byte_unt                  is from   src/lib/std/types-only/basis-structs.pkg
    package v1b =  vector_of_one_byte_unts;                     # vector_of_one_byte_unts       is from   src/lib/std/src/vector-of-one-byte-unts.pkg
    #
    package rwv =  inl::rw_vector_of_one_byte_unts;             # 
    package rov =  inl::vector_of_one_byte_unts;
herein

    package rw_vector_of_one_byte_unts
    : (weak)  Typelocked_Rw_Vector                              # Typelocked_Rw_Vector          is from   src/lib/std/src/typelocked-rw-vector.api
    {
        # Fast add/subtract avoiding
        # the overflow test:
        #
        infix my  --- +++ ;
        #
        fun x --- y =  inl::tu::copyt_tagged_int (inl::tu::copyf_tagged_int x - inl::tu::copyf_tagged_int y);
        fun x +++ y =  inl::tu::copyt_tagged_int (inl::tu::copyf_tagged_int x + inl::tu::copyf_tagged_int y);


        # Unchecked access operations 
        #
        unsafe_set =  rwv::set;
        unsafe_get =  rwv::get;
        #
        ro_unsafe_set =  rov::set;
        ro_unsafe_get =  rov::get;
        ro_length     =  rov::length;

        Rw_Vector =  rwv::Rw_Vector;
        Element   =  u1b::Unt;
        Vector    =  v1b::Vector;

        empty_v   =  inl::cast "":  Vector;

        maximum_vector_length =  core::maximum_vector_length;

        fun make_rw_vector (0, _)
                =>
                rwv::make_zero_length_vector();

            make_rw_vector (len, initial_value)
                =>
                if (inl::default_int::ltu (maximum_vector_length, len))
                    #
                    raise exception exceptions_guts::SIZE;              # exceptions_guts       is from   src/lib/std/src/exceptions-guts.pkg
                else
                    v = rt::asm::make_unt8_rw_vector len;

                    init 0
                    where
                        fun init i
                            =
                            if (i < len)
                                #
                                unsafe_set (v, i, initial_value);
                                init (i+1);
                            fi;
                    end;

                    v;
                fi;
        end;


        fun from_fn (0, _) =>   rwv::make_zero_length_vector ();
            #
            from_fn (len, f)
                =>
                v
                where
                    if (inl::default_int::ltu (maximum_vector_length, len))   raise exception exceptions_guts::SIZE;   fi;

                    v = rt::asm::make_unt8_rw_vector len;

                    fun init i
                        =
                        if (i < len)
                            #
                            unsafe_set (v, i, f i);
                            init (i+1);
                        fi;

                    init 0;
                end;
        end;


        fun from_list [] =>   rwv::make_zero_length_vector();
            #
            from_list l
                =>
                v
                where
                    fun length ([], n) => n;
                        length (_ ! r, n) => length (r, n+1);
                    end;

                    len =  length (l, 0);

                    if (len > maximum_vector_length)    raise exception exceptions_guts::SIZE;   fi;

                    v =  rt::asm::make_unt8_rw_vector len;

                    fun init ([], _)    =>  ();
                        init (c ! r, i) =>  {  unsafe_set (v, i, c);   init (r, i+1);  };
                    end;

                    init (l, 0);
                end;
        end;

        # Note:  The (_[])   enables   'vec[index]'           notation;
        #        The (_[]:=) enables   'vec[index] := value'  notation;

        length =  rwv::length;

        get     =  rwv::get_with_boundscheck;
        (_[])   =  rwv::get_with_boundscheck;

        set     =  rwv::set_with_boundscheck;
        (_[]:=) =  rwv::set_with_boundscheck;

        fun to_vector a
            =
            case (length a)
                #          
                0   =>  empty_v;
                #
                len =>  v
                        where
                            (inl::cast  (rt::asm::make_string  len))
                                ->
                                v:  v1b::Vector;

                            fun fill i
                                =
                                if (i < len)
                                    #
                                    ro_unsafe_set (v, i, unsafe_get (a, i));
                                    fill (i +++ 1);
                                fi;

                            fill 0;
                        end;
            esac;

        fun copy { from, into, at }
            =
            {   if (at < 0   or   de > length into)     raise exception INDEX_OUT_OF_BOUNDS;    fi;
                #
                copy_dn (sl --- 1, de --- 1);
            }
            where
                sl =  length  from;
                de =  at + sl ;

                fun copy_dn (s, d)
                    =
                    if (s >= 0)
                        #
                        unsafe_set (into, d, unsafe_get (from, s));
                        copy_dn (s --- 1, d --- 1);
                    fi;
            end;

        fun copy_vector { from, into, at }
            =
            {   sl =  ro_length  from;
                de =  at + sl;

                fun copy_dn (s, d)
                    =
                    if (s >= 0)
                        #
                        unsafe_set (into, d, ro_unsafe_get (from, s));
                        copy_dn (s --- 1, d --- 1);
                    fi;

                if (at < 0  or  de > length into)
                    # 
                    raise exception INDEX_OUT_OF_BOUNDS;
                else
                    copy_dn (sl --- 1, de --- 1);
                fi;
            };

        fun keyed_apply f v
            =
            apply 0
            where
                len =  length v;

                fun apply i
                    =
                    if (i < len)
                        #
                        f (i, unsafe_get (v, i));
                        apply (i +++ 1);
                    fi;
            end;

        fun apply f v
            =
            apply 0
            where
                len = length v;

                fun apply i
                    =
                    if (i < len)
                        #
                        f (unsafe_get (v, i));
                        apply (i +++ 1);
                    fi;
            end;

        fun keyed_map_in_place f v
            =
            mdf 0
            where
                len = length v;

                fun mdf i
                    =
                    if (i < len)
                        #
                        unsafe_set (v, i, f (i, unsafe_get (v, i)));
                        mdf (i +++ 1);
                    fi;
            end;

        fun map_in_place f v
            =
            mdf 0
            where
                len = length v;

                fun mdf i
                    =
                    if (i < len)
                        #
                        unsafe_set (v, i, f (unsafe_get (v, i)));
                        mdf (i +++ 1);
                    fi;

            end;

        fun keyed_fold_forward f init v
            =
            fold (0, init)
            where

                len = length v;

                fun fold (i, a)
                    =
                    if (i >= len)   a;
                    else            fold (i +++ 1, f (i, unsafe_get (v, i), a));
                    fi;
            end;

        fun fold_forward f init v
            =
            fold (0, init)
            where
                len = length v;

                fun fold (i, a)
                    =
                    if (i >= len)
                        #
                        a;
                    else
                        fold (i +++ 1, f (unsafe_get (v, i), a));
                    fi;

            end;

        fun keyed_fold_backward f init v
            =
            fold (length v --- 1, init)
            where
                fun fold (i, a)
                    =
                    if (i < 0)
                        #
                        a;
                    else
                        fold (i --- 1, f (i, unsafe_get (v, i), a));
                    fi;
            end;

        fun fold_backward f init v
            =
            fold (length v --- 1, init)
            where
                fun fold (i, a)
                    =
                    if (i < 0)
                        #
                        a;
                    else
                        fold (i --- 1, f (unsafe_get (v, i), a));
                    fi;
            end;

        fun keyed_find p v
            =
            fnd 0
            where
                len = length v;

                fun fnd i
                    =
                    if (i >= len)
                        #
                        NULL;
                    else
                        x = unsafe_get (v, i);
                        #
                        if (p (i, x))   THE (i, x);
                        else        fnd (i +++ 1);
                        fi;
                    fi;
            end;

        fun find p v
            =
            fnd 0
            where
                len = length v;

                fun fnd i
                    =
                    if (i >= len)
                        #
                        NULL;
                    else
                        x = unsafe_get (v, i);
                        #
                        if (p x)   THE x;
                        else       fnd (i +++ 1);
                        fi;
                    fi;
            end;

        fun exists p v
            =
            ex 0
            where
                len = length v;

                fun ex i
                    =
                    i < len
                    and
                    (   p (unsafe_get (v, i))
                        or
                        ex (i +++ 1)
                    );
            end;

        fun all p v
            =
            al 0
            where
                len =  length v;

                fun al i
                    =
                    i >= len
                    or
                    (   p (unsafe_get (v, i))
                        and
                        al (i +++ 1)
                    );
            end;

        fun compare_sequences c (a1, a2)
            =
            coll 0
            where
                l1 = length a1;
                l2 = length a2;
                l12 = inl::ti::min (l1, l2);

                fun coll i
                    =
                    if (i >= l12)
                        #
                        int_guts::compare (l1, l2);
                    else
                        case (c (unsafe_get (a1, i), unsafe_get (a2, i)))
                            #
                            EQUAL   =>  coll (i +++ 1);
                            unequal =>  unequal;
                        esac;
                    fi;
            end;
    };                                          #  package rw_vector_of_one_byte_unts 
end;


Comments and suggestions to: bugs@mythryl.org

PreviousUpNext