44 lines
1.8 KiB
Forth
44 lines
1.8 KiB
Forth
include lib/stmstack.4th \ include string stack library
|
|
|
|
: check-word ( a n -- a n f)
|
|
2dup bl >r \ start off with a space
|
|
begin
|
|
dup \ when not end of word
|
|
while
|
|
over c@ r@ >= \ check character
|
|
while
|
|
r> drop over c@ >r chop \ chop character off
|
|
repeat r> drop nip 0= \ cleanup and set flag
|
|
;
|
|
|
|
: open-file ( -- h)
|
|
1 dup argn = abort" Usage: ordered infile"
|
|
args input open error? abort" Cannot open file"
|
|
dup use \ return and use the handle
|
|
;
|
|
|
|
: read-file ( --)
|
|
0 >r \ begin with zero length
|
|
begin
|
|
refill \ EOF detected?
|
|
while
|
|
0 parse dup r@ >= \ equal or longer string length?
|
|
if \ check the word and adjust length
|
|
check-word if r> drop dup >r >s else 2drop then
|
|
else \ if it checks out, put on the stack
|
|
2drop \ otherwise drop the word
|
|
then
|
|
repeat r> drop \ clean it up
|
|
;
|
|
|
|
: read-back ( --)
|
|
s> dup >r type cr \ longest string is on top of stack
|
|
begin s> dup r@ >= while type cr repeat
|
|
2drop r> drop \ keep printing until shorter word
|
|
; \ has been found
|
|
|
|
: ordered ( --)
|
|
open-file s.clear read-file read-back close
|
|
; \ open file, clear the stack, read file
|
|
\ read it back and close the file
|
|
ordered
|