\ -*- mode: forth -*-
\ $Id: regexmatch.gforth,v 1.1 2001/05/26 15:59:44 doug Exp $
\ http://www.bagley.org/~doug/shootout/

\ from Anton Ertl:
\ this uses the Gray parser generator, which is probably too big a
\ cannon for this problem (it also needs a lot of setup code).
\ Writing a recursive descent parser by hand is probably both smaller
\ and faster in this case.


0. argc @ 1- arg >number 2drop drop constant NUM

warnings off \ Gray is a little wordy

require gray.fs

: slurp-fid { fid -- addr u }
    0 0 begin 
    dup 1024 + dup >r extend-mem 
    rot r@ fid read-file throw 
    r> 2dup =
    while 
    2drop
    repeat
    - + dup >r resize throw r> ;

: bit-equiv 
    \ w3=~w1^w2
    invert xor ;

: set-complement 
    empty ['] bit-equiv binary-set-operation ;

variable input \ pointer to next character to be scanned
variable end-input \ pointer to end of input
-1 constant eof-char

: start 
    input @ ;

: end 
    input @ over - ;

: get-input 
    start end-input @ = if
    eof-char
    else
    start c@
    endif ;

256 max-member
s" scan failed" exception constant scanfail

: ?nextchar 
    0= scanfail and throw
    1 chars input +! ;
    
: testchar? 
    get-input member? ;
' testchar? test-vector !

: .. 
 
 empty copy-set
 swap 1+ rot do
  i over add-member
 loop ;

: ` 
    \ creates anonymous terminal for the character c )
    char singleton ['] ?nextchar make-terminal ;

char 0 char 9 .. dup  ' ?nextchar  terminal digit
set-complement        ' ?nextchar  terminal nondigit
bl singleton          ' ?nextchar  terminal lspace

2variable areacode
2variable exchange
2variable last4

)
<- area-code

 || area-code ))
   lspace {{ start }} digit digit digit {{ end exchange 2! }}
   )
   {{ start }} digit digit digit digit {{ end last4 2! }}
   nondigit
)) <- telnum 

telnum parser scan-telnum 

: scan-for-nondigit 
    begin
    count  >r
    r@ '0 < r@ '9 > or  r> '( <>  and
    over end-input @ u>= or
    until ;

variable count  0 count !

: scanfile 
    over + end-input !
    begin 
    dup input !
    ['] scan-telnum catch
    dup dup scanfail <> and throw
    if 
        scan-for-nondigit
    else
        1 count +! count @ 1 u.r ." : "
        ."  " exchange 2@ type ." -" last4 2@ type
        cr
        end-input @ over - #lf scan drop \ skip rest of line
    endif
    dup end-input @ u>=
    until
    drop ;

: mainloop 
    ['] 2drop [is] type
    NUM 1 +do
    2dup scanfile
    loop
    [']  [is] type
    scanfile ;
    
stdin slurp-fid mainloop bye