Starting Forth Example

Oforth examples. Feel free to post your own code.

Starting Forth Example

Postby Doug » 24 Jul 2018 15:57

Code: Select all

\ Last Revision: 23 Jul 2018  08:03:12  dbh
\ Douglas B. Hoffman

\ This program was written to illustrate one way the Leo Brodie
\ Starting Forth program "No Weighting" can be written in Oforth.
\ For comparison to the original SF program see the listing that
\ comes after. Also, a link to the pertinent SF section is:

\ http://home.iae.nl/users/mhx/sf12/sf12.html  "3. No Weighting"

\ *** BEGIN PROGRAM
import: math  \ to get PI and round

tvar: material-in-use

Object Class new: material ( i.d. density tan  )
 m: initialize \ str density tan
    := tan := density := i.d. ;

\       ht^3*pi*D
\ W =  -----------
\       3*tan^2

 m: weight \ ( ht -- ) input height in feet
    3 ^  PI * @density *
    @tan 2 ^  3 * /
    dup round . "pounds of" . @i.d. . "or" .
    2000 /
    <<wjp(System.Out, 7, JUSTIFY_RIGHT, 6)
    " tons" . ;

 m: use self to material-in-use ;
 
: feet \ ( ht -- ) height in feet
  material-in-use weight ;

\ i.d.        density   tan
"cement"        131    .7    material new const: cement
"loose gravel"   93    .649  material new const: loose-gravel
"packed gravel" 100    .7    material new const: packed-gravel
"dry sand"       90    .754  material new const: dry-sand
"wet sand"      118    .9    material new const: wet-sand
"clay"          120    .727  material new const: clay
\ *** END PROGRAM

cement use
10 feet
\ => 279965 pounds of cement or 139.983 tons ok

10.25 feet
\ => 301492 pounds of cement or 150.746 tons ok

dry-sand use
10 feet
\ => 165779 pounds of dry sand or  82.8893 tons ok


false IFTRUE: [

\ for comparison, a standard Forth version based on the program from Starting Forth
\ to be fair, most Forths can use a floating point extension and word-set these days
\ so this could be written in an easier-to-read fashion

VARIABLE density   VARIABLE theta   VARIABLE i.d.

: STRING ( c) WORD DUP C@ 1+ ALLOT ;
: ,"   [CHAR] " STRING ; ( -- c-addr )
: DU.3 ( du --)   <# # # # [CHAR] . HOLD #S #> TYPE SPACE ;

: MATERIAL ( 'string density theta -- )
   CREATE  , , ,
   DOES>   DUP       @  theta !
      CELL+ DUP @ density !
      CELL+     @ i.d. ! ;

: .SUBSTANCE   i.d. @ COUNT TYPE SPACE ;

: CUBE   2DUP OVER 10 M*/  DROP  10 M*/ ; ( d1 -- d2 )
: /TAN   1000 theta @ M*/ ; ( d1 -- d2 ) 

: FEET  ( d -- )
   CUBE  355 339 M*/  density @ 1 M*/
   /TAN /TAN 5 M+  1 10 M*/
   2DUP ." = " D. ." pounds of "  .SUBSTANCE
   1 2 M*/ ."  or " DU.3 ." tons " ;

\ table of materials
\   string-address     density     theta 
   ," cement"           131       700  MATERIAL cement
   ," loose gravel"      93       649  MATERIAL loose-gravel
   ," packed gravel"    100       700  MATERIAL packed-gravel
   ," dry sand"          90       754  MATERIAL dry-sand
   ," wet sand"         118       900  MATERIAL wet-sand
   ," clay"             120       727  MATERIAL clay
 
 
cement

10.0 feet
\ = 279939 pounds of cement or 139.969 tons ok

cr
10.3 feet
\ = 305658 pounds of cement or 152.829 tons ok

cr
dry-sand
10.3 feet
\ = 165763 pounds of dry sand or 82.881 tons ok

]
Last edited by Doug on 20 Aug 2018 16:00, edited 1 time in total.
Doug
 
Posts: 15
Joined: 20 Jul 2018 14:26

Re: Starting Forth Example

Postby Franck » 25 Jul 2018 07:41

Hello Doug,

Interesting, thank you.

btw, your example is related to a new feature that will be added to Oforth in V1.2.
While reworking the outer interpreter, it will be possible to create new kind of words (inherited from the Word class) that will be handled by the interpreter.

If you don't mind, I will post informations based on your example after the V1.2 is released.

Franck
Franck
 
Posts: 155
Joined: 29 Oct 2014 19:01

Re: Starting Forth Example

Postby Doug » 25 Jul 2018 14:02

Hi Franck,

The new feature sounds useful. Although I found this little program very easy to write in Oforth.

-Doug
Last edited by Doug on 31 Aug 2018 12:40, edited 1 time in total.
Doug
 
Posts: 15
Joined: 20 Jul 2018 14:26

Re: Starting Forth Example

Postby Doug » 20 Aug 2018 01:15

The following is another Starting Forth program written in Oforth. "A Better Buzz (Phrase Generator)"
If one wants to see the original SF program it is attached below.
I was impressed with how easy and concise this example could be written in Oforth.
Thanks again to Franck for putting together such a marvelous dialect of Forth.
I am thinking Oforth represents the 'Forth of the Future' or something close to it.

-Doug Hoffman

p.s., I originally wrote the Oforth program to read the data from text files. It was very easy to do. But I liked being able to use the built-in array syntax of Oforth and it avoids messing with other files.

Code: Select all
\ Last Revision: 20 Aug 2018  04:33:39  dbh
\ with several code usage improvements as
\ suggested by Franck Bensusan


import: mapping  \ to get split

\ add extra intro data lines as you wish,
\ retain the format shown
[
"In this paper we will demonstrate that",
"On the one hand, studies have shown that",
"On the other hand, however, practical experience indicates that",
"In summary, then, we propose that"
]
const: introArray

\ add extra buzz word data lines as you wish,
\ retain the format shown
[
[ "integrated", "management", "criteria"],
["total", "organization", "flexibility"],
["systematized", "monitored", "capability"],
["parallel", "reciprocol", "mobility"],
["functional", "digital", "programming"],
["responsive", "logistical", "concepts"],
["optimal", "transitional", "time phasing"],
["synchronized", "incremental", "projections"],
["compatible", "third generation", "hardware"],
["qualified", "policy", "through-put"],
["partial", "decision", "engineering"],
["stand-alone", "undocumented", "outflow"],
["random", "context-sensitive", "superstructures"],
["representative", "fail-safe", "interaction"],
["optional", "omnirange", "congruence"],
["transient", "unilateral", "utilities"],
["turbo", "mega", "philosophies" ]
]
dup const: buzzArray  size const: noBuzLns


\ add extra fill data lines as you wish,
\ be sure they are in multiples of 3
\ and formatted as shown
[
"by using",
"by applying available resources towards",
"with structured deployment of",
"",
"coordinated with",
"to offset",
"balanced by",
"",
"it is possible for even the most",
"it becomes not unfeasible for all but the least",
"it is necessary for all",
"",
"to function as",
"to generate a high level of",
"to avoid"
]
dup const: fillerArray   size 1+ 4 / const: noFillerGroups

78 const: rmargin \ right margin
tvar: col \ current column position

: +col col + to col ; \ n --
: fits? col + rmargin < ; \ n -- flag
: space' col if 1 +col then ;
: cr' printcr  0 to col ;
: .word dup size dup fits? if space' else cr' then +col . ; \ s
: display ( s -- [] ) \ s will be a word or many bl delimited words
   s null? if return then #.word ' ' s split apply ;
: buzzword ( r c -- s ) r buzzArray at c swap at ;
: part noBuzLns rand swap buzzword display ; \ col --
: 1stAdjective 1 part ;
: 2ndAdjective 2 part ;
: noun 3 part ;
: filler 1- 4 * 3 rand + fillerArray at display ; \ group# --
: sentence \ each will pass the indices 1 thru 4 to #filler
   #[ filler 1stAdjective 2ndAdjective noun ] noFillerGroups each
   "\b." . cr' ;
: paper #[ cr' display sentence ] introArray apply ;

\ execute 'paper' to run the program
\ each run should give different results
Attachments
page2 (1).jpg
This is page 2 of the SF program
page2 (1).jpg (81.5 KiB) Viewed 169 times
page1 (1).jpg
This is the original SF program
page1 (1).jpg (114.47 KiB) Viewed 169 times
Last edited by Doug on 20 Aug 2018 09:42, edited 1 time in total.
Doug
 
Posts: 15
Joined: 20 Jul 2018 14:26

Re: Starting Forth Example

Postby Franck » 20 Aug 2018 04:39

Thank you very much Doug for your comments on Oforth.

Just some suggestions :

1) If a block contains only one word, you can use the word alone.

So you can write :

Code: Select all
: display ( s -- [] ) \ s will be a word or many bl delimited words
   s null? if return then #.word ' ' s split apply ;


Or even :
Code: Select all
: display ( s -- [] ) \ s will be a word or many bl delimited words
   s ifNotNull: [ #.word ' ' s split apply ] ;



2) There is a HOF, #each, that will execute something on each integer from 1 to a limit

each \ ( r n -- ... )

So you can write :

Code: Select all
: sentence
   #[ filler 1stAdjective 2ndAdjective noun ] noFillerGroups each
   "\b." . cr' ;



3) It seems that many objects are constants and not variables, so you can create constants instead.

For instance :

Code: Select all
[
[ "integrated", "management", "criteria"],
["total", "organization", "flexibility"],
["systematized", "monitored", "capability"],
["parallel", "reciprocol", "mobility"],
["functional", "digital", "programming"],
["responsive", "logistical", "concepts"],
["optimal", "transitional", "time phasing"],
["synchronized", "incremental", "projections"],
["compatible", "third generation", "hardware"],
["qualified", "policy", "through-put"],
["partial", "decision", "engineering"],
["stand-alone", "undocumented", "outflow"],
["random", "context-sensitive", "superstructures"],
["representative", "fail-safe", "interaction"],
["optional", "omnirange", "congruence"],
["transient", "unilateral", "utilities"],
["turbo", "mega", "philosophies" ]
]
const: buzzArray
buzzArray size const: noBuzLns


Regards,
Franck
Franck
 
Posts: 155
Joined: 29 Oct 2014 19:01

Re: Starting Forth Example

Postby Doug » 20 Aug 2018 05:41

Hi Franck,

Once again all very useful comments on my code. Thank you!

I appear to be having difficulty breaking the variable habit. I know better.

Regarding not using loop: in my sentence definition. I thought about a HOF but I need the i in the loop to pass to filler, I think. Maybe I'm missing something there.

Anyway, I am really enjoying Oforth. It just feels right. Perhaps it helps having a "one man's vision" instead of a "design by committee" approach.

Now when I see something new or unexpected in Oforth, I just adjust my thinking instead of trying to force my classic Forth habits. It is working out very well, I believe.

Regards,

-Doug
Doug
 
Posts: 15
Joined: 20 Jul 2018 14:26

Re: Starting Forth Example

Postby Franck » 20 Aug 2018 08:48

each will push the current integer for you on the stack before calling ils parameter.

Franck
Franck
 
Posts: 155
Joined: 29 Oct 2014 19:01

Re: Starting Forth Example

Postby Doug » 20 Aug 2018 09:16

#each, Got it. It is there in the docs and I missed it. Thank you!

Regards,
-Doug
Doug
 
Posts: 15
Joined: 20 Jul 2018 14:26

Re: Starting Forth Example

Postby Doug » 22 Aug 2018 13:59

Yet another Starting Forth example program written in Oforth.

Code: Select all

\ Last Revision: 30 Aug 2018  08:29:39  dbh
\ written by Douglas B. Hoffman
\ with assistance from Franck Bensusan

\ the data input file "myfile.txt" is attached as an upload

\ This program was written to illustrate one way the Leo Brodie
\ Starting Forth program "File Away!" can be written in Oforth.
\ It is functionally identical. Actually it has added functionality.
\ It was an excellent Oforth learning exercise for me. I decided that
\ others may find it instructive.

\ The following are functional differences from the original Leo Brodie
\ program:
\ 1) Text files instead of blocks files are used.
\ 2) There is no practical limit to the number of records.
\ 3) Instead of fixed length fields, comma-separated fields are used.
\ 4) Text searches are case insensitive and will hit on substring matches.
\    For example FIND surname rath<enter> will hit on a field with
\    surname "Rather".
\ 5) If the provided file name does not exist then it will be created
\    as an empty file to which records may be added using "enter".
\ 6) The parsed keyboard input text must always end with ','. Franck
\    says the next release will have a fixed #parse-upto so the comma
\    will not be necessary.

import: mapping  \ to get split and indexOfAll
import: chars    \ to get the >upper method for Strings

\ both #mapm and #map could be placed in file "mapping.of"
Object method: mapm( r -- aArray ) \ mutable array
| o m l f n |
    self size Array newSize -> l
    r array? -> f dup ifTrue: [ r size -> n ]
    self forEach: o [
        f ifTrue: [ r forEach: m [ o m perform ] n arrayWith ]
          else:   [ o r perform ]
        l add
        ]
    l
;

\ Collection method: map \ ( r -- aArray ) \ immutable array
\  self mapm dup freeze ;

: parse-upto ( c -- str )
    String new
    begin
       parse-char dup ifNull: [ break ]
       dup c if=: [ break ]
       <<c
    again
    drop dup freeze ;

: searchCI \ s1 sub -- true | false    search for sub$ in $ s1
  >upper swap >upper indexOfAll null? not ;

"myfile.txt" const: filename

\ four field#s for each record (kinds)
1 const: surname
2 const: given
3 const: job
4 const: phone

tvar: a  \ a place to store the array of arrays
tvar: record# \ remember index into array a

\ remember last kind and what
tvar: kind  \ an integer 1-4
tvar: what  \ a string

\ Collection>>unwordsWith ( c [ ] -- s ) : return a new string with
\ the concatenation of all elements, separated by c
: save
   filename File new dup File.WRITE swap open
   #[ ',' swap unwordsWith << dup cr ] a apply
   dup flush close ;

: read-file \ filename -- []
   File new dup exist?
   if   #[ ',' swap split ] swap mapm
   else drop Array new
   then ;   

filename read-file to a
: top 1 to record# ;
: down 1 record# + to record# ;
: missing "Not in file" . ;
: aat a at at ; \ idx idx -- str
: .field record# aat . ; \ ( field# -- )
: .name given .field surname .field ;
: keep to what to kind ; \ n str --
: ckb ',' parse-upto ; \ "text," -- str  \ comma-keyboard
: bkb ' ' parse-upto evaluate ; \ "text " -- n  \ blank-keyboard
: kbd bkb ckb ;  \ "text text," -- n str   \ keyboard
: -find \ ( -- flag )  return true if not found, false if found
  | i | true
  record# a size for: i [
     kind i aat what searchCI if down not break then
     i to record# ] ;
: PAIR ( kind2 what2 )
  | i |
  a size loop: i [
     i to record# -find
     if missing return
     else kind2 record# aat what2 searchCI if .name return then
     then ] ;
: Find \ n str --
  keep top -find if missing else .name then ;

\ Begin User Words
: FIND \ "kind what," --
  kbd Find ;
: enter \ "surname,given,job,phone," --
  Array new
  4 #[ ckb over add ] times \ perform the runnable 4 times
  \ array
  a add save ;
: remove record# a removeAt drop save ;
: change kbd record# a at put save ; \ "kind what,"
: get ckb evaluate .field ; \ "kind,"
: another down -find if "No other" . else .name then ;
: all top
  begin printcr -find not if .name down else return then again ;
: pair kbd keep kbd PAIR ; \ "kind what,kind2 what2," --
: fullname surname ckb keep given ckb PAIR ; \ "surname,given," --
: call \ "given,"     from Problem 12-2 in Starting Forth
  given ckb Find phone .field ;
\ end of program


\ tests and some example useage:

FIND job newscaster,
\ Dan Rather ok

all
\ Dan Rather
\ Jessica Savitch
\ Frank Reynolds
\ ok

another
\ No other ok

printcr
FIND job news,
\ Dan Rather

printcr
get job,
\ newscaster ok

printcr
FIND given jess,
\ Jessica Savitch ok

printcr
pair job newscaster,phone 555-9876,
\ Dan Rather ok

printcr
fullname rath,dan,
\ Dan Rather ok

enter Hoffman,Sparky,dog,nophone,

printcr
FIND given spark,
\ Sparky Hoffman ok

printcr
get surname,
\ Hoffman ok

change job canine,

printcr
FIND given ark,
\ Sparky Hoffman ok

get job,
\ canine ok

printcr
FIND given Sparkie,
\ Not in file ok

printcr
call frank,
\ Frank Reynolds 555-8765 ok

Attachments
myfile.txt
Input data file for Oforth File Away!
(1.14 KiB) Downloaded 5 times
Last edited by Doug on 30 Aug 2018 13:42, edited 2 times in total.
Doug
 
Posts: 15
Joined: 20 Jul 2018 14:26

Re: Starting Forth Example

Postby Franck » 27 Aug 2018 16:03

Hello Doug

Sorry for the late answer, I was not able to connect a lot during the 2 last weeks.

Thank you for sharing this example.

Two little comments.
1) The word #exists? do what you do to check if a file exist (see File.of source file).

2) Into the mapping package, there is the #map word (hence the package name).
This word, like #apply, applies a word to all items into a collection but, unlike #apply, it creates an array with the results.
For instance :

Code: Select all
#1+ [ 1, 2, 3, 4 ] map


You could use it into your read-file word. But you would have to change some code, as the array returned by #map is immutable.

Regards,
Franck
Franck
 
Posts: 155
Joined: 29 Oct 2014 19:01

Next

Return to Oforth examples

Who is online

Users browsing this forum: No registered users and 1 guest

cron