(      Title:  Measured strings multiline input
        File:  mstrings-linput.fs
      Author:  David N. Williams
     License:  LGPL
     Version:  0.8.4
   Test file:  mstrings-test.fs
  Change log:  mstrings.log
     Revised:  August 26, 2008

Copyright [C] 2002, 2007, 2008 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 is a library in the mstrings collection.  It is mostly ANS
Forth compatible up to case dependence, [UNDEFINED], and
REQUIRED.

The code is intended to be character clean.

Please see the file mstrings.txt for terminology and more
word specifications.
)
decimal

s" mstrings-comma.fs" required

\ works with pfe and gforth
s" FORTH-NAME" environment?
[IF] s" pfe" compare 0= [ELSE] false [THEN]
( pfe?) constant PFE-HOST

[UNDEFINED] PARSING-EXT [IF]
false value PARSING-EXT
[THEN]

PARSING-EXT PFE-HOST and to PARSING-EXT

PARSING-EXT [IF]  \ pfe parsing module
loadm parsing
[ELSE]            \ ANS Forth library
s" parsing.fs" required
[THEN]


\ *** MULTILINE INPUT
(*
   eol-s
   upto-m!  upto-m+  m!"  m!`  m+"  m+`
   upto-m,s  m,s"  m,s`  m"<lines><char>"  m"  m`
   s-upto-m+,  s-upto-m,s  |s|-upto-m,s

     NOT IMPLEMENTED
     {}upto-m!  {}upto-m+  s-upto-m!  s-upto-m+
     upto-m+,  m+,"  m+,`
     {}upto-m,s  {}upto-m+,  s-upto-m+,  |s|-upto-m+,
*)


\ *** UTILITY WORDS

\ DEBUGGING
\ : .#  ( n -- )  cr ." #" . cr ;

[UNDEFINED] c-allot [IF]
: c-allot  ( n -- )  chars allot ;  [THEN]


\ *** DEFINITIONS
(
The constant EOL-S leaves the fstring consisting of the host
eol.  It is stored in memory as an mstring.  Run the file
mstrings-test.fs to test whether the value below is correct.
)

  1 , here 10 c, 1        \ unix
\ 1 , here 13 c, 1        \ mac
\ 2 , here 13 c, 10 c, 2  \ dos
  2constant eol-s  \ fstring for host eol

: upto-m+  ( "<lines><char>" mbuf /mbuf char  -- room? found? )
(
Append the input stream across lines, up to the first occurrence
of char, to the mstring in the mbuffer, including the host eol
for line ends.

The "room" flag is true when the mbuffer is sufficient, and the
"found" flag is true when the delimiting character is found in
the input stream before a REFILL failure.

When both flags are true, the input stream is left with the
delimiting character parsed away.

When one or both of the flags is false, the input stream is
positioned just after the last character stored, if that was
within a line, or at the beginning of the next line, if that was
the last character of the host eol sequence.  Only full
fragments within a line are stored, up to the delimiting
character or the end of the line, whichever comes first.
)
  LOCALS| delim /mbuf mbuf |
  BEGIN
    parse-area@ delim separate
  0= WHILE  \ delim not found
    mbuf /mbuf m+
    0= IF false false EXIT THEN
    eol-s mbuf /mbuf m+
    0= IF empty-parse-area false false EXIT THEN
    ?emit-cr refill
    0= IF true false EXIT THEN
  REPEAT
  mbuf /mbuf m+
  IF   parse-area! true true
  ELSE 2drop false true THEN ;

: upto-m!  ( "<lines><char>" mbuf /mbuf char  -- room? found? )
  0 3 pick ! upto-m+ ;

( "<lines><char>" mbuf /mbuf -- flag )
: m!"  [char] " upto-m! and ;
: m!`  [char] ` upto-m! and ;
: m+"  [char] " upto-m+ and ;
: m+`  [char] ` upto-m+ and ;

: upto-m,s  ( "<lines><char>" char -- s )
(
Store the string across lines, up to the first occurrence of
char, as an mstring in data space, including the host eol for
line ends.  Leave its fstring representation.  Leave the input
stream positioned just after the trailing char.  Throw an error
if char is not found.
)
  align here ( m) >r 0 ( len) ,
  BEGIN
    ( char) dup parse ( len) dup c-allot
    r@ (m+) parse-area-empty?
  WHILE  \ char not found
    eol-s ( len) dup c-allot   ( eol.s) r@ (m+)
    ?emit-cr refill 0= ABORT" ***terminating character not found"
  REPEAT
  ( char) drop r> mcount ;

: m,s"  ( "<lines><">" -- s )  [char] " upto-m,s ;
: m,s`  ( "<lines><`>" -- s )  [char] ` upto-m,s ;

: m"<lines><char>"  \ compile:  ( "<lines><char>" char -- )
                    \ run:      ( -- s )
(
Throw an error if not compiling.  The interpretive version of
this word is not implemented.

When compiling, store the input stream across lines into data
space as an mstring according to the specification for UPTO-M,S,
and append code to the definition which leaves its fstring
representation on the data stack.  Throw an error if the
delimiting character is not found in the input stream.

The code below is based on the idea in the gforth code for
SLITERAL.
)
  state @ 0= IF -14 throw THEN
  >r postpone AHEAD r> upto-m,s 2>r align postpone THEN
  2r> postpone 2literal ;

: m"   \ compile:  ( "<lines><">" -- )
       \ run:      ( -- s )
  [char] " m"<lines><char>" ; immediate

: m`   \ compile:  ( "<lines><`>" -- )
       \ run:      ( -- s )
  [char] ` m"<lines><char>" ; immediate

: s-upto-m+,  ( "<lines><pat.body>" pat.s m -- )
(
Assume that pat.s is not empty.  Concatenate the input stream
across lines, up to the first occurrence of the characters in
pat.body, onto to the data space mstring m, including line ends
consisting of the host eol.  Leave the input stream positioned
just after the trailing character of the copy of pat.body found
in the input stream.  Abort if the next available data space is
not contiguous with m, or if the pattern is not found
)
  LOCALS| m #pat &pat | 
  m ?mcontig-data
  BEGIN
    parse-area@ &pat #pat s-separate
    ( pa.s false | after.s before.s true)
  0= WHILE  \ s not found
    ( pa.s) m (m+,)   eol-s m (m+,)
    ?emit-cr refill 0= ABORT" ***terminating string not found"
  REPEAT
  ( before.s) m (m+,)
  ( after.s) parse-area! ;  

: s-upto-m,s  ( "<lines><pat.body>" pat.s -- lines.s )
(
Assume that pat.s is not empty.  Store the input stream across
lines, up to the first occurrence of the pattern body, as an
mstring in data space, including line ends consisting of the
host eol.  The fstring representation of the mstring is lines.s.
Leave the input stream positioned just after the trailing
character of the copy of pat.body found in the input stream. 
Abort if the pattern is not found.
)
  align here 0 ( mlen) , dup >r s-upto-m+, r> mcount ;

: |s|-upto-m,s  ( "<lines><ws><pat.body><ws>" pat.s -- lines.s )
(
Assume that pat.s is nonempty.  Store the input stream across
lines as an mstring in data space, up to the first occurrence of
the pattern body, delimited by whitespace in the sense of
WHITE-DELIMITED?, minus the last of any ws characters
immediately preceding it.  Line ends consisting of the host eol
are included in the stored mstring.  The fstring representation
of the mstring is lines.s.  Leave the input stream positioned
just after the pattern and the first of any immediately trailing
ws characters.  Abort if the whitespace delimited pattern is not
found.
)
  align here 0 ( mlen) ,
  LOCALS| m #pat &pat |
    BEGIN
      &pat #pat m s-upto-m+,
      parse-area@ drop #pat chars - #pat  
      ( pat.s') source white-delimited?
    0= WHILE
      &pat 1 m (m+,)         \ 1st pat char
      >in @ #pat - 1+ >in !  \ restore pat minus 1st char
    REPEAT
    >in @ #pat <>   m @ 0<> and
    IF -1 c-allot   -1 m +! THEN
    >in++ m mcount ;