Starting Forth Example

Oforth examples. Feel free to post your own code.

Starting Forth Example

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 PROGRAMimport: math  \ to get PI and roundtvar: material-in-useObject 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 PROGRAMcement use10 feet\ => 279965 pounds of cement or 139.983 tons ok10.25 feet\ => 301492 pounds of cement or 150.746 tons okdry-sand use10 feet\ => 165779 pounds of dry sand or  82.8893 tons okfalse 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 fashionVARIABLE 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  cement10.0 feet\ = 279939 pounds of cement or 139.969 tons okcr10.3 feet\ = 305658 pounds of cement or 152.829 tons okcrdry-sand10.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

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

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

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 Bensusanimport: 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: noFillerGroups78 const: rmargin \ right margintvar: 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
This is page 2 of the SF program
page2 (1).jpg (81.5 KiB) Viewed 169 times
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

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: buzzArraybuzzArray size const: noBuzLns`

Regards,
Franck
Franck

Posts: 155
Joined: 29 Oct 2014 19:01

Re: Starting Forth Example

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

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

#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

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 indexOfAllimport: 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: surname2 const: given3 const: job4 const: phonetvar: a  \ a place to store the array of arraystvar: record# \ remember index into array a\ remember last kind and whattvar: kind  \ an integer 1-4tvar: 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 okall\ Dan Rather \ Jessica Savitch \ Frank Reynolds \ okanother\ No other okprintcrFIND job news, \ Dan Ratherprintcrget job, \ newscaster okprintcrFIND given jess, \ Jessica Savitch okprintcrpair job newscaster,phone 555-9876,\ Dan Rather okprintcrfullname rath,dan, \ Dan Rather okenter Hoffman,Sparky,dog,nophone,printcrFIND given spark, \ Sparky Hoffman okprintcrget surname,\ Hoffman okchange job canine,printcrFIND given ark,\ Sparky Hoffman okget job,\ canine okprintcrFIND given Sparkie,\ Not in file okprintcrcall frank,\ Frank Reynolds 555-8765 ok`
Attachments
myfile.txt
Input data file for Oforth File Away!
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

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.

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

Who is online

Users browsing this forum: No registered users and 1 guest