#!/usr/bin/onyx
#
# Read one or more files and count the number of lines, words, and characters.
# Unlike most wc implementations, this program pays enough attention to get the
# line count correct, even if there is no newline at the end of the file.
#

################################################################################
#
# Parse the command line.
#

# Load the clopt module.
$modclopt mclass:singleton:load

# Subclass clopt and add option handlers.
$optclass clopt <
    #
    # Class data.
    #
><
    #
    # Methods.
    #

    # Constructor.  This could be omitted, since no work is done, except to
    # recursively call the superclass's constructor, which would happen anyway,
    # were this method definition missing.  However, the convention is to always
    # define this method.
    #
    #class#
    #- new #instance
    $new {
	;rnew
	#instance
    } bind

    # Print usage to #file.
    #
    #file usage_print -
    $usage_print {
	# Substitute progname into usage string.
	`\
progname usage:
    progname [<option>]* [<file>]*

    Option | Description
    -------+----------------------
	-c | Print byte counts.
        -w | Print word counts.
        -l | Print line counts.
        -h | Print usage and exit.
'
	`progname' ;progname_get <$g true> subst pop

	# Print usage string.
	write pop
    } bind

    # Print an error.
    #
    #instance#
    #errstr error_print -
    $error_print {
	# Call the superclass's print method.
	this:isa:super:methods $error_print get eval

	# Print usage.
	stderr ;usage_print

	# Exit with an error.
	1 die
    } bind

    # Parse argv, store the remainder, and post-process option values.
    #
    #instance#
    #- parse -
    $parse {
	# Set defaults.
	<
	    $opt_c false
	    $opt_w false
	    $opt_l false
	> ;data copy pop

	# Call superclass's parse method, then store remainder.
	this:isa:super:methods $parse get eval {
	    $rem [] ;def
	}{
	    $rem exch ;def
	} ifelse

	# Post-process option values.
	,opt_c ,opt_w or ,opt_l or {
	    # No flags were specified.  Set all three flags to true.
	    <
		$opt_c true
		$opt_w true
		$opt_l true
	    > ;data copy pop
	} unless
    } bind

    # Return option values.
    #
    #instance#
    #- opt_* #boolean
    $opt_c {
	,opt_c
    } bind

    $opt_w {
	,opt_w
    } bind

    $opt_l {
	,opt_l
    } bind

    # Return the remainder of the command line that was not parsed.
    #
    #- rem #rem
    $rem {
	,rem
    } bind

    #
    # Option handlers.
    #

    `-h' {
	stdout ;usage_print
	flush
	0 die
    } bind
    
    `-c' {
	$opt_c true ;def
    } bind

    `-w' {
	$opt_w true ;def
    } bind

    `-l' {
	$opt_l true ;def
    } bind
> cdef

# Instantiate optclass and parse the command line arguments.
$opts optclass:new def
argv opts:parse

#
################################################################################
#
# Initialize globals.  This should be done before defining procedures that use
# the globals, so that the bind operator is able to replace references to the
# globals in the procedure bodies.
#

#
# Create lookup table of word separators (`\t\v\f\n\r ').
#
$ws 256 array def
# Non-whitespace is code -1.
0 1 255 {
	ws exch -1 put
} for
# Most whitespace is code 1.
[16@09 16@0b 16@0c 16@0d 16@20] {
    ws exch 1 put
} bind foreach
# `\n' is code 2.
ws 16@0a 2 put

#
# Define a string buffer that can be used repeatedly when reading file data.
#
$str 4096 string def

#
################################################################################
#
# Define various procedures.
#

# Count lines, words, and characters in #file.
#
#file wc_file #lcnt #wcnt #ccnt
$wc_file {
    # Read 4 KB at a time and iterate through the data, transitioning state from
    # positive to negative state, each time incrementing the word count.  The
    # newline(2) state is used to keep track of whether the last character was a
    # `\n', so that if the last line isn't terminated by a `\n', it still gets
    # counted.
    #
    # This function uses quite a few stack objects, which is a bit confusing.
    # There are alternative ways of writing this that are easier to read, but
    # performance is important in this procedure, so this is written the hard
    # way.
    0 0 0 1
    #file #lcnt #wcnt #ccnt #state
    {4 idup str read not} bind {
	#file #lcnt #wcnt #ccnt #state #str
	{
	    #file #lcnt #wcnt #ccnt #state #char

	    # Get the lookup table value for this character.
	    ws exch get
	    #file #lcnt #wcnt #ccnt #state #val

	    # If this character is `\n', increment the line count.
	    dup 2 eq {
		5 ndn inc 5 nup
	    } if

	    # Change state if necessary.  By multiplying the current state and
	    # the code for the current character, we quickly determine whether
	    # the state changed (negative result).
	    2 ndup mul 0 lt {
		#file #lcnt #wcnt #ccnt #state #val
		nip
		#file #lcnt #wcnt #ccnt #state(new)
		dup -1 eq {
		    # Increment word count.
		    dn inc up
		} if
	    }{
		nip
	    } ifelse
	    #file #lcnt #wcnt #ccnt #state

	    # Increment the character count.
	    exch inc exch
	} foreach
    } bind while
    #file #lcnt #wcnt #ccnt #state #str
    pop
    #file #lcnt #wcnt #ccnt #state

    # If the last character wasn't a `\n', and the file wasn't zero-length,
    # increment the line count.
    2 ne over 0 gt and {
	4 ndn inc 4 nup
    } if
    #file #lcnt #wcnt #ccnt
    4 ndn close
    #lcnt #wcnt #ccnt
    exch dn
    #ccnt #wcnt #lcnt
} bind def

# Print the counts for a file.
#
#filename #ccnt #wcnt #lcnt
$print_result {
    opts:opt_l {
	<$w 7> output
    }{
	pop
    } ifelse
    
    opts:opt_w {
	<$w 8> output
    }{
	pop
    } ifelse
    
    opts:opt_c {
	<$w 8> output
    }{
	pop
    } ifelse

    ` ' print
    print
    `\n' print
    flush
} bind def

# Open a file, taking care to catch all errors.
#
#filename safe_open #file/null
$safe_open {
    # Create a temporary namespace, and define a custom errordict.
    <
	# < is actually just a mark object, so it is possible to manipulate
	# the stack while defining the contents of this dictionary.  The call to
	# "dn" rotates the topmost three objects down one position, thus
	# associating #filename with $filename.
	#
	$filename dn
	#< $filename #filename
	$errordict <
	    $invalidfileaccess {
		opts:progname_get `: ' filename `: Permission denied\n' 4 ncat
		stderr exch write pop
		stop
	    }
	    $ioerror {
		opts:progname_get `: ' filename `: I/O error\n' 4 ncat
		stderr exch write pop
		stop
	    }
	    $limitcheck {
		opts:progname_get `: ' filename `: Limit exceeded\n' 4 ncat
		stderr exch write pop
		stop
	    }
	    $handleerror errordict $handleerror get
	    $stop errordict $stop get
	>
    > begin

    # Open the file within a trapped/stopped wrapper, which catches errors and
    # cleans up the stacks.  It would be possible to avoid the overhead of doing
    # this, but this is a clean example of how to use a powerful programming
    # idiom.
    {
	{
	    filename `d' test {
		# Don't open a directory.
		opts:progname_get `: ' filename `: Is a directory\n' 4 ncat
		stderr exch write pop
		stop
	    } if

	    filename `r' open
	} stopped {
	    # An error occurred.  The trapped operator will restore the stacks
	    # to their prior state when it traps the escape.
	    null escape
	} if
    } trapped pop

    # Pop the temporary namespace.
    end
} bind def

#
################################################################################
#
# Main program.
#

# If files were specified on the command line, iterate over them.  Otherwise,
# read stdin.
opts:rem length 0 gt {
    # Filenames were specified on the command line.  Iterate over them.

    # Create a temporary namespace and define some variables.  This is less
    # efficient than using stack variables is, but it's easier to deal with.
    <
	$cum_l 0
	$cum_w 0
	$cum_c 0
    > begin

    opts:rem {
	dup `-' ne {
	    dup safe_open
	    dup null eq {
		pop
		continue
	    } if
	}{
	    # `-' is an alias for stdin.
	    stdin
	} ifelse
	#filename #file

	# Get counts for file.
	wc_file
	#filename #ccnt #wcnt #lcnt

	# Update cumulative counts.
	!cum_l over add
	$cum_l exch def
	
	!cum_w 2 idup add
	$cum_w exch def

	!cum_c 3 idup add
	$cum_c exch def

	# Print result for file.
	print_result
    } foreach

    # Print cumulative counts, if more than one file was specified.
    opts:rem length 1 gt {
	`total' !cum_c !cum_w !cum_l print_result
    } if

    # Discard temporary namespace.
    end
}{
    # No filename was specified on the command line.  Read from stdin.
    stdin wc_file

    # Print result for stdin.
    `' 4 nup print_result
} ifelse

#
################################################################################