(     Title:  Dynamic String Utilities
     Author:  David N. Williams
       File:  dstring-utils.fs
  Test file:  dstring-utils-test.fs
   Log file:  dstring-utils.log
    License:  LGPL
    Version:  0.8.6
    Revised:  October 21, 2010
)
\ Copyright (C) 1994-2004, 2006-2010 by David N. Williams
(
This library is free software; you can redistribute it and/or
modify it under the terms of the GNU Lesser General Public
License as published by the Free Software Foundation; either
version 2.1 of the License, or at your option any later version.

This software is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
GNU Lesser General Public License for more details.

If you take advantage of the option in the LGPL to put a
particular version of this library under the GPL, the author[s]
would regard it as polite if you would put any direct
modifications under the LGPL as well, and include a copy of this
request near the beginning of the modified library source.  A
"direct modification" is one that enhances or extends the
library in line with its original concept, as opposed to
developing a distinct application or library which might use it.
)
(
This library works with version 0.7.6 or later of the
Dynamic-Strings word set, either the pfe implementation or the
ANS Forth implementation in dstrings.fs.

It evolves various words we have used, some from a long while
back.  The code is generally Forth 200x compatible, if
dstrings.fs is used, except for case dependence.

The word FNUM+ has been tested with a separate and with a
nonseparate floating point stack.

The constant MAX-FNUM-DIGS may be defined prior to loading this
library if its default value is not suitable.
)
  decimal

[UNDEFINED] USE-DSTRINGS-EXT
[IF] false CONSTANT USE-DSTRINGS-EXT [THEN]

USE-DSTRINGS-EXT [IF]
  LOADM dstrings
[ELSE]
  s" dstrings.fs" included
[THEN]

[UNDEFINED] USE-FPNOSTACK-EXT
[IF] false CONSTANT USE-FPNOSTACK-EXT [THEN]
[UNDEFINED] USE-FP [IF] false CONSTANT USE-FP [THEN]
USE-FP [IF]
  USE-FPNOSTACK-EXT [IF]
    LOADM fpnostack
  [ELSE]
    s" FLOATING-EXT" environment? [IF] ( flag) drop [ELSE]
    cr .( FLOATING POINT NOT AVAILABLE) cr ABORT [THEN]
  [THEN]
  [UNDEFINED] MAX-FNUM-DIGS [IF] 256 CONSTANT MAX-FNUM-DIGS [THEN]
[THEN]


\ *** WORDS
(
  NUMBER AND DATE CATS
  num+  unum0r+  unum+  unum>hex+
  -mon-  date&time+
  MAX-FNUM-DIGS  set-fnum-digs  fnum+

    PRIVATE
    fnum-digs
)


\ *** UTILITY WORDS

[UNDEFINED] num>s [IF]
: num>s  ( n -- n.s )  \ Comus aka (.)
(
Convert the number according to the current BASE to an ANS Forth
string in transient memory.  Traditional implementation.
)
  <# dup >r abs s>d #s r> sign #> ;
[THEN]

[UNDEFINED] unum>s [IF]
: unum>s  ( u -- u.s )
(
Convert the unsigned number according to the current BASE to an
ANS Forth string in transient memory.
)
  <# 0 #s #> ;
[THEN]


\ *** NUMBER AND DATE CATS
(
"Cat" refers to dstring concatenation.  Words whose action is
to cat have a "+" appended to their names.

The cats in the following are "cat clean", that is, they do not
include code with terminated subcats, so they may be used in
succession.

Earlier versions of this library included words that produced
strings on the string stack.  They have been removed, some
because they are easy to define in terms of cat words, others
because they could lead to unintended cat fights, and should be
defined in the context of a controlled, current cat state.
)

: num+  ( n -- )
(
Cat the number as a string in the current BASE.
)
  num>s s+ ;

: unum+  ( u -- )
(
Cat the unsigned number as a string in the current BASE.
)
  unum>s s+ ;

: unum>hex+  ( u --  )
(
Cat the unsigned number as a hexadecimal string, prefixed by
"0x".
)
  base @ >r   $+" 0x"   hex unum>s s+   r> base ! ;

: unum0r+  ( u r -- )
(
Cat the last r digits of the nonnegative number as a string in
the current BASE.  If the number has fewer than r digits, fill
with leading zeroes to make r digits.  If it has more, the
output is silently truncated.
)
  swap num>s  \ assume no "-"
  rot over - ( r-#digits) dup 0>
  IF          \ need leading "0"'s
    ( r-#digits) 0 DO $+" 0" LOOP
  ELSE        \ simply truncate
    negate ( #digits-r) /string
  THEN s+ ;

: -mon-  ( month -- month.s )
(
Leave the month string corresponding to month = 1,2,...
)
  1- 4 chars *
  [ s" -Jan-Feb-Mar-Apr-May-Jun-Jul-Aug-Sep-Oct-Nov-Dec-" ] sliteral
  drop + 5 chars ;

: date&time+  ( --  )
(
Cat the current date and time as a string with "0"-filled
fields, as in "04-Jul-2002 09:02:06".
)
  time&date LOCALS| yr mo day hr min sec |
  day 2 unum0r+   mo -mon- s+   yr num+
  $+"  "
  hr 2  unum0r+   $+" :"
  min 2 unum0r+   $+" :"
  sec 2 unum0r+ ;

USE-FP [IF]

create digs-pad MAX-FNUM-DIGS chars allot

\ PRIVATE
6 value fnum-digs  \ not the same effect as PRECISION

\ PUBLIC
: set-fnum-digs  ( u -- )
  dup MAX-FNUM-DIGS u> ABORT" ***SET-FNUM-DIGS overflow"
  to fnum-digs ;

[UNDEFINED] +INF [IF] 1e 0e f/ FCONSTANT +INF [THEN]
[UNDEFINED] FINITE? [IF]  \ assume basic IEEE-FP arithmetic for specials
: FINITE?  ( f: r  -- ) ( -- [normal|subnormal]? )  fabs +INF f< ;
[THEN]

: fnum+  ( f: num  -- )
(
Cat the number according to the elements in the ANS Forth
specification for REPRESENT.  The result has FNUM-DIGS to the
right of the decimal point, with the leading digit just to the
right, and no digits to the left.  The fstack may be separate or
unified.
)
  fdup finite? 0= IF #-43 THROW THEN
  base @ >r decimal
  ( f: num) digs-pad fnum-digs represent
  r> base !    
  ( exp minus? valid?) drop
  ( minus?) IF $+" -." ELSE $+" ." THEN
  ( exp) >r
  digs-pad fnum-digs s+
  $+" E"
  r> ( exp) num+ ;

[THEN]  \ USE-FP