\ group   10/18/97  gwj
\ nonstandard exception-handling
\ words
require core-ext
require pairs

2variable  <group>  0 0 <group> 2!
2variable  groupsp   0 0 groupsp 2!
pair#: group.pair

: (group)  ( addr -- )
   >r sp@ r> 2r> rot 2@ 2>r
   2swap 2>r <group> 2@ 2>r
   rp@  2swap 2>r <group> 2!
 ;

\ transfer control to the nearest
\ enclosing }group and return n
: regroup   ( n -- )
   <group> 2@ 2dup or 0=
    if   2drop drop true 
           abort" unGROUPed regroup"
    else rp! 2r> <group> 2! 
             2r> groupsp 2!
    then ;
: ?regroup   ( flag errcode -- ?? )
     swap if regroup else drop  then  ;
: 0regroup    0 regroup ;
: reregroup   dup  ?regroup ;

\ start a group
: group{   ( -- )
   postpone ahead here swap 0 , 0 , 
   postpone then dup postpone literal
   postpone (group) group.pair ;
immediate

\ end the group
: }group   ( -- n )
   group.pair ?match
    postpone 0regroup here >abs
    rot 2!  ; immediate

\ restore stack depth to where it was
\ at group{
: group!depth  ( ?' --  ? )
     groupsp 2@ sp! ;