Programming performance/kc5tja Forth

• Language: Forth
• Skill: Advanced. I've been programming Forth for more than 10 years.
• Time: 3.7 hours total, including re-inventing the necessary iterators and string processing routines. Precise breakdown follows.
• Notes:
  • This demonstrates that, while Forth coding took way longer than Haskell or Python, it's still not that bad, considering I had to write the software in terms of raw primitives (bytes, fetches, stores, etc), and ended up with abstractions that closely matched the problem being solved. Still, in commercial software development, this kind of time sink is acceptable only for deep embedded environments; 3.7 hours versus 1.5 for the TimN Haskell version is a factor of 2.5; in terms of resource expenditures (including electricity, employee pay, etc.), the Python version is overwhelmingly cheaper to produce. Magnus Haskell is substantially faster still, leading one to believe that coding in Haskell is more cost-effective than even Python.
  • The code is pragmatic; I use variables where it makes the coder easier to develop. However, you'll find that the overwhelming majority of the code is written to use values on the stack, thus employing Forth in a more functional manner. Indeed, though Forth isn't a functional language, Forth strongly encourages referential transparency. This is one possible reason why Forth has a reputation for being a highly productive programming environment.
  • Note that most of the time spent was in parsing the file. The "Forth Way" obviously would not use this approach to store the data in the first place, thus eliminating all that code, and the 1.5 hours it took to write it. :)
  • The last three sub-components of the program took 1.5 hours to write primarily because of me getting too tired. It's after midnight as I post this.

Time Breakdown

5 minutes coding mapLines

90 minutes coding line parser engine (using iterative development)

5 minutes coding database

30 seconds coding routine to load database from file. :)

1 minute coding the bank

5 minutes coding the purchasing of shares

25 minutes coding the selling of shares, due to HIGHLY ambiguous (actual coding took 3 minutes) requirements. :(

90 minutes coding the portfolio manager, broker, and liquidator, combined.

Sum total time: 3.7 hours coding time.

Remember that, due to Forth's lack of standard string processing functions, I had to write my own. :) On the other hand, they're perfectly taylored to the job at hand. All times include debugging effort as well.

Code

\
\ Maps a function to each line in the gspc.txt file.
\

create lineBuffer 100 chars allot
variable GSPC
: open S" gspc.txt" r/o open-file throw GSPC ! ;
  open

: mapLines ( ... xt -- ... ) \ xt ( ... caddr u -- ... )
  >r begin lineBuffer 100 chars GSPC @ read-line throw
  while lineBuffer swap r@ execute repeat
  0 s>d GSPC @ reposition-file throw  rdrop drop ;



\
\ Determine number of records in the database
\

variable records 0 records !

: isn'tAComment?                over c@ '# = 0= ;
: tallyRecord  ( caddr u -- )   isn'tAComment? IF 1 records +! THEN  2drop ;
' tallyRecord mapLines

." Database records: " records @ . cr
records @ constant #records

variable record#
records @ record# !



\
\ Database of dates and closing prices
\

create years        #records cells allot
create months       #records cells allot
create days         #records cells allot
create closings     #records cells allot \ fixed-point representation!

: currentRecord     record# @ ;
: previousRecord    currentRecord 1- ;
: prevRecord        -1 record# +! ;
: closingPriceA     cells closings + ;

: *year*            currentRecord cells years + ;
: *month*           currentRecord cells months + ;
: *day*             currentRecord cells days + ;
: *closing*         currentRecord closingPriceA ;

: currentPrice      *closing* @ ;
: previousPrice     previousRecord closingPriceA @ ;



\
\ Line parser
\

variable input

: currentCharacterAddress   input @ ;
: currentCharacter          currentCharacterAddress c@ ;
: nextCharacter             1 input +! ;

: fixedFieldAsInteger ( addr n -- )
  currentCharacterAddress over evaluate  swap input +!  swap ! ;

: year                      *year* 4 fixedFieldAsInteger ;
: month                     *month* 2 fixedFieldAsInteger ;
: day                       *day* 2 fixedFieldAsInteger ;

: isn'tDash                 '- = 0= ;
: isn'tDot                  '. = 0= ;
: isn'tSpace                32 = 0= ;
: isInteger                 dup '0 >= swap '9 <= and ;

: '-' currentCharacter isn'tDash abort" E1: Malformed input" nextCharacter ;
: '.' currentCharacter isn'tDot abort" E3: Malformed input" nextCharacter ;
: spc currentCharacter isn'tSpace abort" E2: Malformed input" nextCharacter ;

: skipNonWhitespace
  begin currentCharacter isn'tSpace while nextCharacter repeat ;

: asInteger     '0 - ;
: accumulate    asInteger *closing* @ 10 * + *closing* !  nextCharacter ;
: integer       begin currentCharacter dup isInteger while accumulate repeat drop ;

: unused        skipNonWhitespace spc ;

: closing       0 *closing* !  integer '.' integer spc ;
: date          year '-' month '-' day spc ;

: lineFormat    date unused unused unused closing ( rest ignored ) ;



\
\ Load database from file
\

: readLine  isn'tAComment? if drop input !  lineFormat  prevRecord exit then
            2drop ;
' readLine mapLines



\
\ Bank
\

\ fixed point integer; same scale as database records
variable account 1000000 account !       

: balance       account @ ;
: credit        account +! ;
: debit         negate credit ;



\
\ Stock Broker
\

create prices       #records cells allot
create shares       #records cells allot
variable buys       0 buys !
variable sells      0 sells !

: *price*           buys @ cells prices + ;
: *shares*          buys @ cells shares + ;
: bought            1 buys +! ;

: %price%           sells @ cells prices + ;
: %shares%          sells @ cells shares + ;
: sold              1 sells +! ;

: buyShares     dup *shares* !  currentPrice dup *price* ! * debit bought ;
: buy           balance 10 / currentPrice / buyShares ;

: sellShares    * credit sold ;
: sell          %price% @ %shares% @ sellShares ;



\
\ Portfolio Manager
\

: %change   over - swap 100 swap */ ;
: action    %change dup -2 < if drop buy exit then
                         6 >= if sell then ;
: history   dup record# !  previousPrice currentPrice ;
: manage    2 begin dup #records < while history action 1+ repeat drop ;

manage



\
\ Final liquidator
\

: liquidate     %price% @ begin sells @ buys @ < while dup %shares% @
                sellShares repeat drop ;

liquidate



\
\ Report Results.
\

." Ending balance: " balance s>d <# # # '. hold #s '$ hold #> type cr 
bye