PreviousUpNext

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

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

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



###                   "No sane man can be happy, for to him life is real,
###                    and he sees what a fearful thing it is.
###
###                   "Only the mad can be happy, and not many of those."
###
###                                         -- Mark Twain,
###                                            The Mysterious Stranger



package rw_vector_slice_of_one_byte_unts : Typelocked_Rw_Vector_Slice           # Typelocked_Rw_Vector_Slice    is from   src/lib/std/src/typelocked-rw-vector-slice.api
                                           where  Element == one_byte_unt::Unt
                                           where  Rw_Vector == rw_vector_of_one_byte_unts::Rw_Vector
                                           where     Vector ==    vector_of_one_byte_unts::Vector
                                           where  Vector_Slice == vector_slice_of_one_byte_unts::Slice
= package {

     Element = one_byte_unt::Unt;

     Rw_Vector = rw_vector_of_one_byte_unts::Rw_Vector;
        Vector =    vector_of_one_byte_unts::Vector;

     Vector_Slice = vector_slice_of_one_byte_unts::Slice;

     Slice = SLICE  { base:  Rw_Vector,
                   start: Int,
                   stop:  Int
                 };

    # Fast add/subtract avoiding
    # the overflow test:
    #
    infix my --- +++;
    #
    fun x --- y = inline_t::tu::copyt_tagged_int (inline_t::tu::copyf_tagged_int x - inline_t::tu::copyf_tagged_int y);
    fun x +++ y = inline_t::tu::copyt_tagged_int (inline_t::tu::copyf_tagged_int x + inline_t::tu::copyf_tagged_int y);

    unsafe_get    =  inline_t::rw_vector_of_one_byte_unts::get;
    unsafe_set    =  inline_t::rw_vector_of_one_byte_unts::set;

    ro_unsafe_get =  inline_t::vector_of_one_byte_unts::get;
    ro_unsafe_set =  inline_t::vector_of_one_byte_unts::set;

    alength       =  inline_t::rw_vector_of_one_byte_unts::length;
    vlength       =  inline_t::vector_of_one_byte_unts::length;

    fun length (SLICE { start, stop, ... } )
        =
        stop --- start;


    fun get (SLICE { base, start, stop }, i)
        =
        {   i' = start + i;

            if (i' < start or i' >= stop)  raise exception INDEX_OUT_OF_BOUNDS;
            else                           unsafe_get (base, i');
            fi;
        };


    fun set (SLICE { base, start, stop }, i, x)
        =
        {   i' = start + i;

            if  (i' < start
            or   i' >= stop
            )    raise exception INDEX_OUT_OF_BOUNDS;
            else unsafe_set (base, i', x);
            fi;
        };

    (_[])   =  get;                                                     # Enables   'vec[index]'           notation;
    (_[]:=) =  set;                                                     # Enables   'vec[index] := value'  notation;

    fun make_full_slice  arr
        =
        SLICE { base => arr, start => 0, stop => alength arr };


    fun make_slice (arr, start, olen)
        =
        {   al = alength arr;

            SLICE { base => arr,

                 start => if (start < 0 or al < start)  raise exception INDEX_OUT_OF_BOUNDS;
                          else                          start;
                          fi,

                 stop => case olen
                             #
                             NULL => al;
                             #
                             THE len =>
                                 {   stop = start +++ len;
                                     #
                                     if (stop < start or al < stop)   raise exception INDEX_OUT_OF_BOUNDS;
                                     else                             stop;
                                     fi;
                                 };
                         esac
               };
        };


    fun make_subslice (SLICE { base, start, stop }, i, olen)
        =
        {   start' = if (i < 0 or stop < i)  raise exception INDEX_OUT_OF_BOUNDS;
                     else                    start +++ i;
                     fi;

            stop'  = case olen
                         #
                         NULL => stop;
                         #
                         THE len =>
                             {   stop' = start' +++ len;
                                 #
                                 if (stop' < start' or stop < stop')   raise exception INDEX_OUT_OF_BOUNDS;
                                 else                                  stop';
                                 fi;
                             };
                     esac;

            SLICE { base, start => start', stop => stop' };
        };


    fun burst_slice (SLICE { base, start, stop } )
        =
        (base, start, stop --- start);


    fun to_vector (SLICE { base, start, stop } )
        =
        case (stop --- start)
            #          
            0 => inline_t::cast "";
            #          
            len =>
                {   v =   inline_t::cast  (runtime::asm::make_string  len);
                    #
                    fun fill (i, j)
                        =
                        if (i < len)
                            #
                            ro_unsafe_set (v, i, unsafe_get (base, j));
                            fill (i +++ 1, j +++ 1);
                        fi;

                    fill (0, start);

                    v;
                };
        esac;


    fun copy { from => SLICE { base, start, stop },  into,  at }
        =
        {   sl = stop --- start;
            de = at + sl;

            fun copy_dn (s, d)
                =
                if (s >= start)
                    #
                    unsafe_set (into, d, unsafe_get (base, s));
                    copy_dn (s --- 1, d --- 1);
                fi;

            fun copy_up (s, d)
                =
                if (s < stop)
                    #
                    unsafe_set (into, d, unsafe_get (base, s));
                    copy_up (s +++ 1, d +++ 1);
                fi;

            if   (at < 0 or de > alength into) raise exception INDEX_OUT_OF_BOUNDS;
            elif (at >= start )                copy_dn (stop --- 1, de --- 1);
            else                               copy_up (start, at);
            fi;
        };

    fun copy_vector { from => vsl, into, at }
        =
        {   (vector_slice_of_one_byte_unts::burst_slice  vsl)
                ->
                (base, start, vlen);

            de = at + vlen;

            fun copy_up (s, d)
                =
                if (d < de)
                    #
                    unsafe_set (into, d, ro_unsafe_get (base, s));
                    copy_up (s +++ 1, d +++ 1);
                fi;

            if (at < 0 or de > alength into)   raise exception INDEX_OUT_OF_BOUNDS;
            else                               copy_up (start, at);         #  Assume vector and rw_vector are disjoint 
            fi;
        };

    fun is_empty (SLICE { start, stop, ... } )
        =
        start == stop;

    fun get_item (SLICE { base, start, stop } )
        =
        if (start >= stop)   NULL;
        else                 THE (unsafe_get (base, start),   SLICE { base, start => start +++ 1, stop } );
        fi;

    fun keyed_apply f (SLICE { base, start, stop } )
        =
        apply start
        where
            fun apply i
                =
                if (i < stop)
                    #
                    f (i --- start, unsafe_get (base, i));
                    apply (i +++ 1);
                fi;
        end;

    fun apply f (SLICE { base, start, stop } )
        =
        apply start
        where
            fun apply i
                =
                if (i < stop)
                    #
                    f (unsafe_get (base, i));
                    apply (i +++ 1);
                fi;
        end;

    fun keyed_map_in_place f (SLICE { base, start, stop } )
        =
        mdf start
        where
            fun mdf i
                =
                if (i < stop)
                    #
                    unsafe_set (base, i, f (i --- start, unsafe_get (base, i)));
                    mdf (i +++ 1);
                fi;
        end;

    fun map_in_place f (SLICE { base, start, stop } )
        =
        mdf start
        where
            fun mdf i
                =
                if (i < stop)
                    #
                    unsafe_set (base, i, f (unsafe_get (base, i)));
                    mdf (i +++ 1);
                fi;
        end;

    fun keyed_fold_forward f init (SLICE { base, start, stop } )
        =
        fold (start, init)
        where
            fun fold (i, a)
                =
                if (i >= stop)   a;
                else             fold (i +++ 1, f (i --- start, unsafe_get (base, i), a));
                fi;
        end;

    fun fold_forward f init (SLICE { base, start, stop } )
        =
        fold (start, init)
        where
            fun fold (i, a)
                =
                if (i >= stop)   a;
                else             fold (i +++ 1, f (unsafe_get (base, i), a));
                fi;
        end;

    fun keyed_fold_backward f init (SLICE { base, start, stop } )
        =
        fold (stop --- 1, init)
        where
            fun fold (i, a)
                =
                if (i < start)   a;
                else             fold (i --- 1, f (i --- start, unsafe_get (base, i), a));
                fi;
        end;

    fun fold_backward f init (SLICE { base, start, stop } )
        =
        fold (stop --- 1, init)
        where
            fun fold (i, a)
                =
                if (i < start)   a;
                else             fold (i --- 1, f (unsafe_get (base, i), a));
                fi;
        end;

    fun keyed_find p (SLICE { base, start, stop } )
        =
        fnd start
        where
            fun fnd i
                =
                if (i >= stop)
                    #  
                    NULL;
                else 
                    x = unsafe_get (base, i);
                    #
                    if (p (i, x))   THE (i --- start, x);
                    else            fnd (i +++ 1);
                    fi;
                fi;
        end;

    fun find p (SLICE { base, start, stop } )
        =
        fnd start
        where
            fun fnd i
                =
                if (i >= stop )
                    #
                    NULL;
                else
                    x = unsafe_get (base, i);
                    #
                    if (p x)   THE x;
                    else       fnd (i +++ 1);
                    fi;
                fi;
        end;

    fun exists p (SLICE { base, start, stop } )
        =
        ex start
        where
            fun ex i
                =
                i < stop
                and
                (   p (unsafe_get (base, i))
                    or
                    ex (i +++ 1)
                );
        end;

    fun all p (SLICE { base, start, stop } )
        =
        al start
        where
            fun al i
                =
                i >= stop
                or
                (   p (unsafe_get (base, i))
                    and
                    al (i +++ 1)
                );
        end;

    fun compare_sequences c (SLICE { base => b1, start => s1, stop => e1 },
                             SLICE { base => b2, start => s2, stop => e2 } )
        =
        col (s1, s2)
        where
            fun col (i1, i2)
                =
                if (i1 >= e1)
                    #                    
                    if (i2 >= e2 ) EQUAL;
                    else           LESS;
                    fi;
                elif (i2 >= e2 ) GREATER;
                else
                    case (c (unsafe_get (b1, i1), unsafe_get (b2, i2)))
                        #
                        EQUAL   =>  col (i1 +++ 1, i2 +++ 2);
                        unequal =>  unequal;
                    esac;
                fi;
        end;
};




Comments and suggestions to: bugs@mythryl.org

PreviousUpNext