Starting Forth Example

Oforth examples. Feel free to post your own code.

Starting Forth Example

Postby Doug » 24 Jul 2018 15:57

\ Last Revision: 27 Sep 2018 11:01:33 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.

Code: Select all
\ *** BEGIN PROGRAM

\ Oforth v1.2 is required
\   Makes use of the Words class (see chapter 11 in the Manual)
\   thus allowing for one less attribute(i.d.), simplified material
\   declaration, and elimination of the #use method(see #execute).

import: math  \ to get PI and round

tvar: material-in-use

Word Class new: Material ( mutable density, mutable tan )
m: initialize  \ ( density tan -- )
   := tan := density ;

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

 m: weight \ ( ht -- )
    3 ^  PI * @density *
    @tan 2 ^  3 * /
    dup round . "pounds of" . self name . "or" .
    2000 /
    <<wjp(System.Out, 7, JUSTIFY_RIGHT, 6)
    " tons" . drop ; \ drop (File stdout)

 m: execute  self to material-in-use ;

\ parse-token ( "name" -- str )
: material: parse-token Material new drop ; \ ( "name" -- )

 : feet \ ( ht -- ) height in feet, integer or float
   material-in-use weight ;


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

\ *** EXAMPLE USE:
cement
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
10 feet
\ => 165779 pounds of dry sand or  82.8893 tons ok
Last edited by Doug on 28 Sep 2018 22:28, edited 2 times in total.
Doug
 
Posts: 20
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: 159
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: 20
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 278 times
page1 (1).jpg
This is the original SF program
page1 (1).jpg (114.47 KiB) Viewed 278 times
Last edited by Doug on 20 Aug 2018 09:42, edited 1 time in total.
Doug
 
Posts: 20
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: 159
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: 20
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: 159
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: 20
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: 25 Sep 2018  09:37:33  dbh
\ written by Douglas B. Hoffman
\ with assistance from Franck Bensusan
\ Oforth v1.2 is required
\   makes use of #parse-until

\ 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".

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

\ substring search, case insensitive
: 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 -- []imut
   File new dup exist?
   if   #[ ',' swap split ] swap mapm
   else drop Array new
   then ;

: make-array-mutable \ []imut -- []mut
  | b | Array new -> b
  #[ >array b add ] swap apply
  b ;

filename read-file make-array-mutable 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-until ; \ "text," -- str  \ comma-keyboard
: bkb ' ' parse-until 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

\ all

\ another

\ FIND job news

\ get job

\ FIND given jess

\ pair job newscaster,phone 555-9653

\ fullname rath,dan

\ enter Hoffman,Sparky,dog,nophone

\ FIND given spark

\ get surname

\ change job canine

\ FIND given ark

\ get job

\ FIND given Sparkie

\ call frank
















Attachments
myfile.txt
Input data file for Oforth File Away!
(1.14 KiB) Downloaded 8 times
Last edited by Doug on 28 Sep 2018 22:32, edited 3 times in total.
Doug
 
Posts: 20
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: 159
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