(   Title:  Stack-comment ordered locals across lines
     File:  aelocals-xl.fs
   Author:  David N. Williams
  License:  Public Domain
  Version:  0.5.0
  Started:  August 28, 2008
  Revised:  August 28, 2008
)

s" parsing.fs"  required  
s" dstrings.fs" required

(*
This code modifies Anton Ertl's anslocal.fs to work across lines. 
*)

true [IF]  \ version with "--" and trailing text optional
(*
Notation:
  <ws>         whitespace characters or line ends
  <ws0>        optional <ws>
  <_--_text0>  optional whitespace delimited "--" and text across lines
  _}_          whitespace delimited "}"
*)


: get-locals  ( "<ws0><name_1><ws>...<name_n><_--_text0>_}_" -- )

  next-instream-name 2dup s" --" compare 0=
  IF
    2drop s" }" |s|-seek-instream
    0= ABORT" ***locals } terminator not found" EXIT
  ELSE
    2dup s" }" compare 0=
    IF 2drop EXIT THEN
  THEN
  >$s-copy RECURSE $s> (LOCAL)
;


: {  ( "<ws0><name_1><ws>...<name_n><_--_text0>_}_" -- )  \ compile
     ( p_1 ... p_n -- )		                          \ run

  get-locals 0 0 (LOCAL)
; immediate


0 [IF]
\ broken-line version of Anton Ertl's test word
: test1-swap  { 
  a 
b 
--  b   a
}
." xxx" b a ;

cr 1 2 test1-swap . . .s cr

\ version without "--"
: test2-swap  { a
b }
." xxx" b a ;

1 2 test2-swap . . .s cr
[THEN]

[ELSE]  \ simplified version requiring "--"

(*
Notation:
  <ws>     whitespace characters or line ends
  <ws0>    optional <ws>
  _--_     whitespace delimited "--"
  <text0>  optional text across lines
  _}_      whitespace delimited "}"
*)

: get-locals  ( "<ws0><name_1><ws>...<name_n>_--_" -- )

  next-instream-name 2dup s" --" compare 0=
  IF 2drop ELSE >$s-copy RECURSE $s> (LOCAL) THEN
;


: {  ( "<ws0><name_1><ws>...<name_n>_--_<text0>>_}_" -- )  \ compile
     ( p_1 ... p_n -- )		                           \ run

  get-locals 0 0 (LOCAL) s" }" |s|-seek-instream
  0= ABORT" ***locals } terminator not found"
; immediate


0 [IF]
\ broken-line version of Anton Ertl's test word
: test1-swap  { 
  a 
b 
--  b   a
}
." xxx" b a ;

cr 1 2 test1-swap . . .s cr
[THEN]

[THEN]