15.4.163  src/lib/c-glue-lib/internals/zstring.pkg

#
# Functions for translating between
# 0-terminated C strings and
# native Mythryl strings.
#
#  (C) 2001, Lucent Technologies, Bell Laboratories
#
# author: Matthias Blume (blume@research.bell-labs.com)

# Compiled by:
#     src/lib/c-glue-lib/internals/c-internals.lib

package zstring: (weak)  Zstring {              # Zstring       is from   src/lib/c-glue-lib/zstring.api

    stipulate

        include package   c;

        fun get'  p     =  get::uchar' (ptr::deref' p);
        fun set' (p, w) =  set::uchar' (ptr::deref' p, w);
        fun nxt'  p     =  ptr::plus' s::uchar (p, 1);
    herein
         Zstring ( C ) = Ptr(  Chunk (Uchar, C) );
         Zstring'( C ) = Ptr'( Chunk (Uchar, C) );

        fun length' p
            =
            loop (0, p)
            where
                fun loop (n, p)
                    =
                    if (get' p == 0u0)   n;
                    else                 loop (n + 1, nxt' p);
                    fi;
            end;

        fun length p
            =
            length' (light::ptr p);

        fun to_ml' p
            =
            loop ([], p)
            where
                fun loop (l, p)
                    =
                    case (get' p)
                      
                        0u0 => string::implode (reverse l);
                        c   => loop (char::from_int (one_word_unt::to_int c) ! l, nxt' p);
                    esac;
            end;

        fun to_ml p
            =
            to_ml' (light::ptr p);

        fun cp_ml' { from, to }
            =
            loop (0, to)
            where
                n = string::length_in_bytes from;

                fun loop (i, p)
                    =
                    if (i >= n)
                        set' (p, 0u0);
                    else
                        set' (p, one_word_unt::from_int (string::get_byte (from, i)));
                        loop (i+1, nxt' p);
                    fi;
            end;

        fun cp_ml { from, to }
            =
            cp_ml' { from, to => light::ptr to };

        fun dup_ml' s
            =
            {
                z = c::allot' c::s::uchar (unt::from_int (size s + 1));

                cp_ml' { from => s, to => z };
                ptr::rw' z;
            };

        fun dup_ml s
            =
            {
                z = c::allot c::t::uchar (unt::from_int (size s + 1));

                cp_ml { from => s, to => z };
                ptr::rw z;
            };
    end;
};