PreviousUpNext

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

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

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

###                 "Probably there is an imperceptible touch of
###                  something permanent that one feels instinctively
###                  to adhere to true humour, whereas wit may be
###                  the mere conversational shooting up of "smartness" --
###                  a bright feather, to be blown into space the
###                  second after it is launched...
###
###                 "Wit seems to be counted a very poor relation to Humour...
###
###                 "Humour is never artificial."
###
###                                         -- Mark Twain
###                                           quoted in Sydney Morning Herald,
###                                           September 17, 1895,, pp. 5-6.



stipulate
    package it  =  inline_t;                                                    # inline_t                      is from   src/lib/core/init/built-in.pkg
herein

    package vector_slice_of_one_byte_unts : Typelocked_Vector_Slice             # Typelocked_Vector_Slice       is from   src/lib/std/src/typelocked-vector-slice.api
                                     where  Element == one_byte_unt::Unt
                                     where  Vector == vector_of_one_byte_unts::Vector
    =
    package {


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

        Element =  one_byte_unt::Unt;
        Vector  =  vector_of_one_byte_unts::Vector;

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

        unsafe_get =  it::vector_of_one_byte_unts::get;
        vlength    =  it::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 make_full_slice  vec
            =
            SLICE { base => vec, start => 0, stop => vlength vec };

        fun make_slice (vec, start, olen)
            =
            {   vl = vlength vec;
                #
                SLICE { base => vec,
                        #
                        start => if (start < 0 or vl < start)  raise exception INDEX_OUT_OF_BOUNDS;
                                 else                          start;
                                 fi,

                        stop =>  case olen   
                                     #
                                     NULL    => vl;
                                     #
                                     THE len => {   stop = start +++ len;

                                                    if (stop < start or vl < 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 } )
            =
            vector_of_one_byte_unts::from_fn (stop --- start, \\ i = unsafe_get (base, start +++ i) );


        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_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 cat sll
            =
            vector_of_one_byte_unts::from_list (
                reverse (
                    list::fold_forward
                        (\\ (sl, l) =  fold_forward (!) l sl)
                        []
                        sll
                )
            );

        fun keyed_map f sl
            =
            vector_of_one_byte_unts::from_list (
                reverse (
                    keyed_fold_forward
                        (\\ (i, x, a) =  f (i, x) ! a)
                        []
                        sl
                )
            );

        fun map f sl
            =
            vector_of_one_byte_unts::from_list (
                reverse (
                    fold_forward
                        (\\ (x, a) =  f x ! a)
                        []
                        sl
                )
            );

        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;
                    else
                        if (i2 >= e2)   GREATER;
                        else
                            case (c (unsafe_get (b1, i1), unsafe_get (b2, i2)))
                                #
                                EQUAL   =>  col (i1 +++ 1, i2 +++ 1);
                                unequal =>  unequal;
                            esac;
                        fi;
                   fi;
            end;
    };
end;



Comments and suggestions to: bugs@mythryl.org

PreviousUpNext