15.4.1145  src/lib/std/src/number-string.pkg

## number-string.pkg

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



###                  "One of the symptoms of an approaching nervous breakdown
###                   is the belief that one's work is terribly important."
###
###                                           -- Bertrand Russell



stipulate
    package it  =  inline_t;                                    # inline_t              is from   src/lib/core/init/built-in.pkg
    package pb  =  proto_basis;                                 # proto_basis           is from   src/lib/std/src/proto-basis.pkg
    package ps  =  protostring;                                 # protostring           is from   src/lib/std/src/protostring.pkg
herein

    package   number_string
    : (weak)  Number_String                                     # Number_String         is from   src/lib/std/src/number-string.api
    {
        Radix = BINARY | OCTAL | DECIMAL | HEX;

        Float_Format
          = EXACT
          | SCI  Null_Or( Int )
          | FIX  Null_Or( Int )
          | GEN  Null_Or( Int )
          ;

        Reader( X, Y ) =   Y -> Null_Or( (X, Y) ); 

        (+) = it::default_int::(+);
        (-) = it::default_int::(-);
        (<) = it::default_int::(<);
        (>) = it::default_int::(>);

        stipulate

            fun fill_string (c, s, i, n)
                =
                {
                    stop = i+n;

                    fun fill j
                        =
                        if   (j < stop)

                             it::vector_of_chars::set_char_as_byte (s, j, c);
                             fill (j+1);
                        fi;

                    fill i;
                };

            fun copy_string (src, src_len, dst, start)
                =
                {
                    fun cpy (i, j)
                        =
                        if (i < src_len)
                            #
                            it::vector_of_chars::set_char_as_byte (dst, j, it::vector_of_chars::get_byte_as_char (src, i));
                            cpy (i+1, j+1);
                        fi;

                    cpy (0, start);
                };

        herein

            fun pad_left pad_chr wid s
                =
                {
                    len = it::vector_of_chars::length s;
                    pad = wid - len;

                    if (pad > 0)
                        #                   
                        s' = ps::create wid;
                        #                   
                        fill_string (pad_chr, s', 0, pad);
                        copy_string (s, len, s', pad);
                        s';
                    else
                        s;
                    fi;
                };

            fun pad_right pad_chr wid s
                =
                {   len = it::vector_of_chars::length  s;

                    pad = wid - len;

                    if (pad > 0)
                        # 
                        s' = ps::create wid;
                        # 
                        fill_string (pad_chr, s', len, pad);
                        copy_string (s, len, s', 0);
                        s';
                    else
                        s;
                    fi;
                };
        end; #  local 

        fun rev_implode (0,     _) =>  "";
            rev_implode (n, chars) =>  ps::rev_implode (n, chars);
        end;

        fun split_off_prefix  predicate  getc  rep
            =
            lp (0, [], rep)
            where

                fun lp (n, chars, rep)
                    =
                    case (getc rep)
                        #
                        NULL
                            =>
                            (rev_implode (n, chars), rep);
                        #
                        THE (c, rep')
                            =>
                            if (predicate c)   lp (n+1, c ! chars, rep');
                            else               (rev_implode (n, chars), rep);
                            fi;
                    esac;
            end;

        fun get_prefix  predicate  getc  rep
            =
            lp (0, [], rep)
            where
                fun lp (n, chars, rep)
                    =
                    case (getc rep)
                        #                 
                        NULL =>   rev_implode (n, chars);
                        #                 
                        THE (c, rep')
                            =>
                            if   (predicate c)

                                 lp (n+1, c ! chars, rep');
                            else
                                 rev_implode (n, chars);
                            fi;
                    esac;
            end;

        fun drop_prefix  predicate  getc
            =
            lp
            where 
                fun lp rep
                    =
                    case (getc rep)
                        #                 
                        NULL          =>   rep;
                        THE (c, rep') =>   if   (predicate c)   lp rep';   else   rep;   fi;
                    esac;
            end;

        skip_ws =  pb::skip_ws;


        # The Char_Stream type is the type used by scan_string
        # to represent a stream of characters; we use the current
        # index in the string being scanned.
        #
        Char_Stream = Int;

        scan_string =  pb::scan_string;

    };
end;