PreviousUpNext

15.4.1164  src/lib/std/src/rw-vector-slice-of-chars.pkg

## rw-vector-slice-of-chars.pkg

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



###            "Any fool can know.  The
###             point is to understand."
###
###                     -- Albert Einstein



package rw_vector_slice_of_chars : Typelocked_Rw_Vector_Slice           # Typelocked_Rw_Vector_Slice    is from   src/lib/std/src/typelocked-rw-vector-slice.api
                                where  Element == Char
                                where  Rw_Vector == rw_vector_of_chars::Rw_Vector
                                where     Vector == vector_of_chars::Vector
                                where  Vector_Slice == vector_slice_of_chars::Slice
= package {

                                                                        # inline_t                      is from   src/lib/core/init/built-in.pkg
    Element = Char;

    Rw_Vector    = rw_vector_of_chars::Rw_Vector;
    Vector       =    vector_of_chars::Vector;
    Vector_Slice = vector_slice_of_chars::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_chars::get;
    unsafe_set = inline_t::rw_vector_of_chars::set;

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

    rw_length = inline_t::rw_vector_of_chars::length;
    ro_length = inline_t::vector_of_chars::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 SUBSCRIPT;
            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 SUBSCRIPT;
            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  =>  rw_length arr
          };


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

            SLICE { base => arr,

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

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


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

            stop' = case olen   
                        #
                        NULL => stop;
                        #
                        THE len =>
                            {   stop' = start' +++ len;
                                #
                                if (stop' < start' or stop < stop')  raise exception SUBSCRIPT;
                                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 => "";
            #          
            len =>  {   s =  runtime::asm::make_string  len;

                        fun fill (i, j)
                            =
                            if (i < len)
                                #
                                ro_unsafe_set (s, i, unsafe_get (base, j));
                                #
                                fill (i +++ 1, j +++ 1);
                            fi;

                        fill (0, start); s;
                    };
        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 > rw_length into) raise exception SUBSCRIPT;
            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_chars::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 > rw_length into)
                #
                raise exception SUBSCRIPT;
            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