(   Title:  Enhanced error reporting for %x%tester.fs
     File:  %x%tester-errors.fs
   Author:  David N. Williams
  License:  Public Domain
  Version:  1.4.3, January 18, 2021
Generated:  %DATE% from tester-errors.tmpl
)

\ *** HOW TO GENERATE A NEW ENHANCED ERROR DISPLAYER
(
This file is a template for generating an enhanced error reporting
utility for the corresponding xtester-style tester for separated stacks
with cell-sized elements or record pointers, especially for forth-gmpfr
stacks, currently not for the data or order stacks.  It is to be
translated by substituting replacements for text elements including a
leading and trailing % as in %NAME%, for example, by using the search
and replace function of a text editor, or a script based on the Forth
2012 words SUBSTITUTE and REPLACES.

There only two essential substitutions, one for %X% and one for %x%,
which are to be replaced by the upper and lower case versions,
respectively, of a text token not containing white space.  The date of
generation can also be substituted for %DATE%, which appears only in
the header above.

The code assumes that fetch and data item print words are defined for
the separated stack, with names resulting from the substitutions in %x%@
and %x%..

This section should be removed from the generated file.  In any case, if
its text undergoes substitution, it will become incoherent.
)

(
This code assumes that %x%tester.fs and tester-display.fs are loaded.
)

VARIABLE %X%T-#ERRORS    0 %X%T-#ERRORS !
: %X%T-ERROR1  ( c-addr u -- )
(
Display an error message followed by the line that had the error.
)
  red-text 1 %X%T-#ERRORS +! %X%T-ERROR-DEFAULT normal-text ;
\ ' %X%T-ERROR1 %X%T-ERROR-XT !

\ display results and goals
: %x%t-a.  ( 'buffer c-addr u -- )
  blue-text type
  ( 'buffer) dup >r @ dup
  IF   1- r> cell+ swap cells over +  \ display deepest first
       DO i %x%@ %x%. space -1 cells +LOOP
  ELSE r> 2drop ." none" THEN cr normal-text ;

: %X%T-ERROR2  ( c-addr u -- )
  %X%T-ERROR1
  %X%T-RESULTS s" %x%results: " %x%t-a.
  %X%T-GOALS   s"   %x%goals: " %x%t-a. ;
\ ' %X%T-ERROR2 %X%T-ERROR-XT !

\ fancy results and goals display
: %x%t-fancy-a.  ( 'buffer c-addr u -- )
  blue-text type
  ( 'buffer) dup @ swap cell+ swap ?dup
  IF   ( n) 1- 0 swap  \ display deepest first
       DO ( 'elem) i cells over + %x%@
         i 1+ %X%T-ERROR-INDEX @ =
         IF red-text %x%. blue-text ELSE %x%. THEN space
       -1 +LOOP
  ELSE ." none" THEN drop cr normal-text ;

: %X%T-ERROR3  ( c-addr u -- )
  %X%T-ERROR1
  %X%T-RESULTS s" %x%results: " %x%t-fancy-a.
  %X%T-GOALS   s"   %x%goals: " %x%t-fancy-a. ;
' %X%T-ERROR3 %X%T-ERROR-XT !

: .%x%t-errors   ( -- )
  blue-text ." %X%T-ERRORS: " normal-text %X%T-#ERRORS @ . ;
: ?.%x%t-errors  ( -- )  VERBOSE @ IF .%x%t-errors THEN ;