Command-line parser for CLI applications (FORTH)

\ Command-line parser for CLI applications (FORTH)
\ Public Domain. Use at your own risk.
\ Revised: 2024-02-02

\ Usage:
\  Create colon or :NONAME definitions for DEFERed words: SETOPT PARSEFN
\  Feed your command string to PARSECMD

\ *** Related words you may need ***

\ CMDTAIL ( -- a u )  \ Return OS command-tail; tabs converted to blanks
\ >BLANKS ( a u -- )  Convert ctrl chars to blanks in place
\ -PATH ( a u -- a' u' )  Discard path spec from filename
\ -EXT ( a u -- a' u' )  Discard filename extension and/or trailing '.'
\ +EXT ( a1 u1 a2 u2 -- a3 u3 )  Conditionally append filename
\   extension a2 u2 to filename string a1 u1 if no extension or
\   trailing '.' was present and place in temporary buffer a3.

\ *** Needed words already present in the DX-Forth kernel ***

\ SKIP SCAN as commonly defined

: END  postpone exit  postpone then ; immediate

: BETWEEN  1+ swap within 0= ;  \ better than 1+ WITHIN
: 2NIP  2swap 2drop ;
: NOOP ;

: /CHAR ( a u -- a2 u2 c )  1 /string over 1- c@ ;

: /SIGN ( a u -- a' u' flag )  \ code def'n is simpler!
  dup if  over c@  case  [char] - of 1 /string -1 endof
  [char] + of 1 /string 0 endof  0 swap endcase  exit then  0 ;

: /NUMBER ( a u -- a2 u2 d|ud )  \ N.B. empty string returns d=0
  /sign >r 0 0 2swap >number 2swap r> if dnegate then ;

\ *** Misc library words ***

\ Split string at character leaving first on top
: SPLIT ( a u c -- a2 u2 a3 u3 )  >r 2dup r> scan 2swap 2 pick - ;

: .ABORT ( -- )  ."  ... aborting"  abort ;

\ *** Command-line parser ***

\ Error handling
: .BAD ( -- )  cr ." Invalid item"  .abort ;
: ?BAD ( f -- )  0= if .bad then ;  \ empty or failed
: ?END ( u -- 0 )  dup if .bad then ;  \ expected end

\ Convert double number to single
: ?D>S ( d|ud -- n|u )  -1 0 between ?bad ;

\ Range check single number
: ?RNG ( n|u lo hi -- n|u )  2>r dup 2r> between ?bad ;

\ Number parsers
: /DNUM ( a u -- a' 0 d|ud )
  dup ?bad  /number  2swap ?end 2swap ;

: /NUM ( a u -- a' 0 n|u )  /dnum ?d>s ;

: /HEX ( a u -- a' 0 n|u )  base @ >r  hex /num  r> base ! ;

create ARGC ( -- a )  3 cells allot

\ Reset command parser
: /ARG ( -- )  argc off ;

\ Assign string for parsing
: !ARG ( a u -- )  argc cell+ 2!  /arg ;  here 0 !arg

\ Get next blank delimited arg
: ARGV ( -- a u -1 | 0 )
  1 argc +!  argc cell+ 2@  0 0
  argc @ 0 ?do  2drop  bl skip  bl split  loop 2nip
  dup if  -1  end  and ;

\ Set switch
defer SETOPT ( a u char -- a' u' )  ' drop is setopt

\ Parse filenames
defer PARSEFN ( -- )  ' noop is parsefn

\ Parse switches
: PARSEOPT ( -- )
  begin  argv while ( not end )
    /char  $FD and  [char] -  ( '-' or '/')
    - if  2drop  -1 argc +! ( backup) end
    begin  dup while  /char setopt  repeat 2drop
  repeat ;

\ Parse the command string
: PARSECMD ( a u -- )
  !arg  parseopt  parsefn  argv ?end drop ;

\ *** Additional words for comma-separated numbers ***

\ N.B. empty field returns n=0
: /INT ( a u -- a' u' n|u )  /number ?d>s ;

defer (NUM)  ' /int is (num)

\ Skip next char if not empty; abort if no match
: ?SKIP ( a u char -- a' u' )
  over if  >r /char r> = ?bad  end  drop ;

\ Parse first number; abort if string empty
: FIRSTNUM ( a u -- a' u' num true )
  dup ?bad (num) -1 ;

\ Parse comma separated number; false if string empty
: NEXTNUM ( a u -- a' u' num true | a 0 false )
  dup if  [char] , ?skip  firstnum  end  0 ;


1 [if]  \ test

: sete ( a u -- a' u' )
  firstnum if .
  nextnum  if .
  nextnum  if .
  then then then  ?end ;

\ Set switch
:noname ( a u char -- a' u' )
  case
    [char] a of ." a " endof
    [char] b of ." b " endof
    [char] c of ." c " endof
    [char] d of ." d " /num . endof
    [char] e of ." e " sete endof
    .bad
  endcase ; is setopt

\ Parse filenames
:noname ( -- )
  cr begin argv while type space repeat ; is parsefn

s" -a -b -c -abc -d1 -e2 -e2,3,4 -e,5 filename1 filename2" cr parsecmd

\ a b c a b c d 1 e 2 e 2 3 4 e 0 5
\ filename1 filename2  ok

[then]