FORTH - 2swap
prof_braino
Posts: 4,313
If you don't care about FORTH, no need to keep reading or responding.
A question came up about a less commonly used FORTH word - 2swap
SWAP - swtches the top two values on the stack
: swap \ ( n1 n2 - n2 n1 )
2swap - switches the top PAIR of values on the stack
: 2swap \ ( n1 n2 n3 n4 - n3 n4 n1 n2 )
This is not included in the default propforth dictionary. A user found a reference to this word in a thrid party example.
To my knowledge, this is the first time somebody noticed its absence when writing code in propforth.
Should this word be added to the kernel, since it is defined in the ANS forth standard DPANS94?
Should this word be left to the user to add as an extension, since it is seldom used and would consume limited dictionary space?
What do you think? Other reasons for or against?
A question came up about a less commonly used FORTH word - 2swap
SWAP - swtches the top two values on the stack
: swap \ ( n1 n2 - n2 n1 )
2swap - switches the top PAIR of values on the stack
: 2swap \ ( n1 n2 n3 n4 - n3 n4 n1 n2 )
This is not included in the default propforth dictionary. A user found a reference to this word in a thrid party example.
To my knowledge, this is the first time somebody noticed its absence when writing code in propforth.
Should this word be added to the kernel, since it is defined in the ANS forth standard DPANS94?
Should this word be left to the user to add as an extension, since it is seldom used and would consume limited dictionary space?
What do you think? Other reasons for or against?
Comments
BUT as non-implemented ANSI words are recognized, I think there needs to be an addendum document that gives you a PropForth ready example to implement the word if you want it. Some folks may run across the use of an ANSI word and not know how to best implement it to get over their current roadblock. If there was a file of ready to go words to add in, it would make stumbling a little less painful.
I like eForth for a quick reference of anything that needs to be quickly added. The ANSI Forth spec does NOT provide the info to make words from other words and factoring for yourself is really a bit mental for a language that has this maturity.
I believe that Dave factored his ANS Forth core words independently for the init.fth before discovering eForth was available.
Noted...
This is a really good idea. After the "build the bot" sessions at the start of class next fall, I will attempt to create a "programming" class. I think I will have the kids impleiment non-kernel ANS words in propforth, using init.fth and eforth examples. Then the kids can get used to adding to the extensions and documentation.
Muhuhahah! My evil plan is working!
It may be a good time to get started. I think we have finished with the debate of standard versus non-standard. The Propeller really requires BOTH for users to really be able to do their own thing in Forth.
Of course, some of the legacy and PC supported words will never take hold.... it is an all new world for Forth on the Propeller.
This might become the plan to finally address the ANS support for standard intro materials.
\ prints a single roman digit from array : roman_digit_print \ ( n -- ) case 1 of ." i" endof 4 of ." iv" endof 5 of ." v" endof 9 of ." ix" endof 10 of ." x" endof 40 of ." xl" endof 50 of ." l" endof 90 of ." xc" endof 100 of ." c" endof 400 of ." cd" endof 500 of ." d" endof 900 of ." cm" endof 1000 of ." m" endof endcase ; \ iterates on a single digit until all are printed : do_single_digit \ (number digit -- remainder) begin 2dup >= while dup roman_digit_print 2dup \ number digit number digit - \ number digit remainder swap \ number remainder digit rot \ remainder digit number drop \ remainder digit repeat drop ; \ prints an integer on the stack as roman numeral : roman_numeral_print ( number -- ) 1000 do_single_digit 900 do_single_digit 500 do_single_digit 400 do_single_digit 100 do_single_digit 90 do_single_digit 50 do_single_digit 40 do_single_digit 10 do_single_digit 9 do_single_digit 5 do_single_digit 4 do_single_digit 1 do_single_digit drop ;In Forth, programs seem to evolve very quickly. I love the rapid deployment.
It is an excellent example of how to use CASE but PropForth has stolen ( and ) for other purposes... that comment must be removed before Prof Brano will accept this.
There a non DPANS word THENS that might be useful. It resolves all pending IF statements, and makes the code more readable.
Hey! That's cool!
Can I post this? Does it work in propforth? I want to use this in the programming portion of the LittleRobot workshop.
[FONT=courier new]DECIMAL \ prints a single roman digit from array : roman_digit_print \ ( n -- ) SWITCH 1 CASE ." i" BREAK 4 CASE ." iv" BREAK 5 CASE ." v" BREAK 9 CASE ." ix" BREAK 10 CASE ." x" BREAK 40 CASE ." xl" BREAK 50 CASE ." l" BREAK 90 CASE ." xc" BREAK 100 CASE ." c" BREAK 400 CASE ." cd" BREAK 500 CASE ." d" BREAK 900 CASE ." cm" BREAK 1000 CASE ." m" BREAK ; \ iterates on a single digit until all are printed : do_single_digit \ (number digit -- remainder) BEGIN 2DUP => WHILE DUP roman_digit_print 2DUP \ number digit number digit - \ number digit remainder SWAP \ number remainder digit ROT \ remainder digit number DROP \ remainder digit REPEAT DROP ; \ prints an integer on the stack as roman numeral : .ROMAN ( number -- ) SPACE 1000 do_single_digit 900 do_single_digit 500 do_single_digit 400 do_single_digit 100 do_single_digit 90 do_single_digit 50 do_single_digit 40 do_single_digit 10 do_single_digit 9 do_single_digit 5 do_single_digit 4 do_single_digit 1 do_single_digit DROP ; [/FONT] 1043 .ROMAN mxliii ok 2012 .ROMAN mmxii ok 1996 .ROMAN mcmxcvi ok[FONT=courier new] [/FONT]Be my guest. I've only tried in in gforth, but I'm willing to try it in propforth over the weekend. It's pretty basic as I avoided most of the areas where I know propforth differs from gforth.
BTW Here's a line for line translation of the program from FORTH into C++ using MS Visual Studio IDE.
// RomanNumerals.cpp : Line for line copy of FORTH into C++ // #include "stdafx.h" #include <stdlib.h> // forward declaration of function. void roman_numeral_print(int number); int _tmain(int argc, _TCHAR* argv[]) // don't get me started on TCHAR's. { if (argc >= 2) roman_numeral_print( _ttoi(argv[1]) ); return 0; } // prints a single roman digit from array void roman_digit_print (int n) { switch(n) { case 1: printf("i"); break; case 4: printf("iv"); break; case 5: printf("v"); break; case 9: printf("ix"); break; case 10: printf("x"); break; case 40: printf("xl"); break; case 50: printf("l"); break; case 90: printf("xc"); break; case 100: printf("c"); break; case 400: printf("cd"); break; case 500: printf("d"); break; case 900: printf("cm"); break; case 1000: printf("m"); break; } } // iterates on a single digit until all are printed void do_single_digit (int * number, int digit) { while(*number >= digit) { roman_digit_print (digit); *number -= digit; } } // prints an integer on the stack as roman numeral void roman_numeral_print(int number) { do_single_digit(&number, 1000); do_single_digit(&number, 900); do_single_digit(&number, 500); do_single_digit(&number, 400); do_single_digit(&number, 100); do_single_digit(&number, 90); do_single_digit(&number, 50); do_single_digit(&number, 40); do_single_digit(&number, 10); do_single_digit(&number, 9); do_single_digit(&number, 5); do_single_digit(&number, 4); do_single_digit(&number, 1); printf("\n"); }But that's not how I would write the program in C++. I would use arrays and iteration as follows:
// RomanNumerals.cpp : This is the way I would write this in C++ and the // resulting program is more space efficient that brute force iteration too. #include "stdafx.h" #include <stdlib.h> // forward declaration of function. void roman_numeral_print(int number); int _tmain(int argc, _TCHAR* argv[]) // don't get me started on TCHAR's. { if (argc >= 2) roman_numeral_print( _ttoi(argv[1]) ); return 0; } // These coordinated arrays are used to map back and forth from the numeric to text values. int digits[] = {1000, 900, 500, 400, 100, 90, 50, 40, 10, 9, 5, 4, 1}; char* values[] = { "m", "cm", "d", "cd", "c", "xc", "l", "xl", "x", "ix", "v", "iv", "i"}; int digitCount = sizeof digits/ sizeof(int); // prints a single roman digit from array void roman_digit_print (int idx) { printf(values[idx]); } // iterates on a single digit until all are printed void do_single_digit (int * number, int idx) { while(*number >= digits[idx]) { roman_digit_print (idx); *number -= digits[idx]; } } // prints an integer on the stack as roman numeral void roman_numeral_print(int number) { for (int idx = 0; idx < digitCount; idx++) do_single_digit(&number, idx); printf("\n"); }I checked the resultant code size and this indeed results in a more compact program. The result might be less clear to a novice programmer. What I may do it translate the second program into FORTH to get a better handle on strings arrays. This will likely bring this post back on topic as I suspect I'll need 2swap at some point.
I don't know, but I don't think so. As I recall, THENS just closes out any outstanding IF's. If I rermember correctly, there can even be some nested if's that were explicitley resolved by specific then. But I'll have to dig through the code and find the example. Only used it once. Sal uses it often, so he can leave out the case words.
\ Used to allocate an array of cells of the desired size passed on stack : array ( n -- addr ) create cells \ converts count into size in bytes here over erase \ clear the buffer and allot \ allocate space Does> swap cells + ; \ run time gives address of cell at index \ Create and load an array of values 13 array roman_digits 1000 0 roman_digits ! 900 1 roman_digits ! 500 2 roman_digits ! 400 3 roman_digits ! 100 4 roman_digits ! 90 5 roman_digits ! 50 6 roman_digits ! 40 7 roman_digits ! 10 8 roman_digits ! 9 9 roman_digits ! 5 10 roman_digits ! 4 11 roman_digits ! 1 12 roman_digits ! \ Create and load an arrays of values and lengths 13 array roman_values 13 array roman_values_len \ helper function to store both the address and length : roman_values_store \ (c-addr u idx -- ) dup -rot \ c-addr idx u idx roman_values_len ! \ c-addr idx roman_values ! ; s" m" 0 roman_values_store s" cm" 1 roman_values_store s" d" 2 roman_values_store s" cd" 3 roman_values_store s" c" 4 roman_values_store s" xc" 5 roman_values_store s" l" 6 roman_values_store s" xl" 7 roman_values_store s" x" 8 roman_values_store s" ix" 9 roman_values_store s" v" 10 roman_values_store s" iv" 11 roman_values_store s" i" 12 roman_values_store \ prints a single roman digit : roman_digit_print \ ( n -- ) dup roman_values @ swap roman_values_len @ type ; \ iterates on a single digit until all are printed : do_single_digit \ (number index -- remainder) begin 2dup roman_digits @ >= while dup roman_digit_print 2dup \ number index number index roman_digits @ \ number index number digit - \ number index remainder swap \ number remainder index rot \ remainder index number drop \ remainder index repeat drop ; \ prints an integer on the stack as roman numeral : .roman ( number -- ) 13 0 do \ from 0 to 13 i do_single_digit loop drop ;There might be a more concise way to construct the arrays and statically initialize them. But reading this program you can see how much detail the C compiler is hiding from you in two lines of code.
\ Used to allocate an array of cells of the desired size passed on stack : array ( n -- addr ) create cells \ converts count into size in bytes here over erase \ clear the buffer and allot \ allocate space Does> swap cells + ; \ run time gives address of cell at index \ Create and load an array of digits 13 array roman_digits 1000 0 roman_digits ! 900 1 roman_digits ! 500 2 roman_digits ! 400 3 roman_digits ! 100 4 roman_digits ! 90 5 roman_digits ! 50 6 roman_digits ! 40 7 roman_digits ! 10 8 roman_digits ! 9 9 roman_digits ! 5 10 roman_digits ! 4 11 roman_digits ! 1 12 roman_digits ! \ Create a set of functions to print the text values. : .m ." m" ; : .cm ." cm" ; : .d ." d" ; : .cd ." cd" ; : .c ." c" ; : .xc ." xc"; : .l ." l"; : .xl ." xl"; : .x ." x"; : .ix ." ix"; : .v ." v"; : .iv ." iv"; : .i ." i"; \ Create and load an array of execution tokens 13 array roman_values : roman_values_load ['] .m 0 roman_values ! ['] .cm 1 roman_values ! ['] .d 2 roman_values ! ['] .cd 3 roman_values ! ['] .c 4 roman_values ! ['] .xc 5 roman_values ! ['] .l 6 roman_values ! ['] .xl 7 roman_values ! ['] .x 8 roman_values ! ['] .ix 9 roman_values ! ['] .v 10 roman_values ! ['] .iv 11 roman_values ! ['] .i 12 roman_values ! ; roman_values_load \ prints a single roman digit : .roman_digit \ ( n -- ) roman_values @ execute ; \ iterates on a single digit until all are printed : do_single_digit \ (number index -- remainder) begin 2dup roman_digits @ >= while dup .roman_digit 2dup \ number index number index roman_digits @ \ number index number digit - \ number index remainder swap \ number remainder index rot \ remainder index number drop \ remainder index repeat drop ; \ prints an integer on the stack as roman numeral : .roman ( number -- ) 13 0 do \ from 0 to 13 i do_single_digit loop drop ;http://en.wikipedia.org/wiki/Smile
or perhaps "Whitespace":
http://en.wikipedia.org/wiki/Whitespace_(programming_language)
Wouldn't it be easier to write programs in raw hex or binary like we had to in the old days before we got hold of assemblers?
Here's my version of the roman numeral program. I haven't tried it yet, so I don't know if it has any errors in it.
\ create an array of roman digits create roman_digits 1000 , 900 , 500 , 400 , 100 , 90 , 50 , 40 , 10 , 9 , 5 , 4 , 1 , \ get a roman value based on the index : roman_value ( index -- value ) 3 * s" m cm d cd c xc l xl x ix v iv i " drop + ; \ get a roman digit based on the index : roman_digit ( index -- digit ) 4 * roman_digits + @ ; \ print a single digit : print_digit ( value -- ) dup c@ emit 1 + c@ dup bl = if drop else emit then ; \ iterates on a single digit until all are printed : do_single_digit (number index -- remainder) swap begin over roman_digit - dup 0 >= while over roman_value print_digit repeat swap roman_digit + ; \ prints an integer on the stack as a roman numeral : .roman ( number -- ) 13 0 do i do_single_digit loop drop ;But that's was nothing compared to trying to get Forth to even do simple arithmetic in a readable manner, that is epilepsy time and total nervous collapse.
After therapy and counceling I'm OK, as long as keep taking the meds. My shrink warns me not to go near Forth again. I start shaking just reading this thread.
Basically I have been reduced to a JavaScript monkey....
@Dave, I like your approach. But you use the s" operator to allocate a string in a function. Does that allocate it each execution, or at compile time? I'm asking because I've wondered about memory leaks of unreferenced allocations.
I found an error in my code where I used >=0. I replaced this with "0 >=" and it works correctly.
!@heater: (don't want him to have a relapse)
Off topic, but there's these two examples to show how its done the easy way. At least it looks easy to me, but I don't really understand it yet. Apparently the Hartley transform derivative of the fourrier is the way to go on the prop.
http://propforth.googlecode.com/files/FHT11.rtf
http://propforth.googlecode.com/files/FHT_Examples.f
Basically FORTH feels a bit like an assembly language that prevents access to the JMP instruction, so labels can only be used for subroutine names and variable storage. But makes up for it with one heck of a macro facility (its flow of control structures), so you don't mind.