FORTH version implemented in UCalc FMP

Yesterday, I released a new beta for UCalc FMP, which is designed for  
constructing programming languages.  Last month, someone suggested that I  look at 
the FORTH language.  It turned out to be an easy language to  learn.  And as I 
was going through such tutorials as Phil Burk's and  others, I found myself 
implementing core words even as I was learning  them.  Working on FORTH allowed 
me to view what I was doing with UCalc from  another angle, and improve it in 
ways that will be useful for constructing other  types of languages as well 
(so far I have a version of BASIC, and FORTH, and  hope to work on a variety of 
others like C, LISP, Pascal, etc...).
 
Anyway, creating a version of FORTH for UCalc was so straightforward and  
short that I am posting the language definition right here.  By simply  loading 
the following code from a text file into the UCalc interpreter, you can  then 
start programming in FORTH.  This is by no means complete, but it has  many 
core words.  I suggest you skip down to the lines that start with  FDEF, before 
coming back to the first few lines to understand how this language  definition 
code works (and see the help files that come with UCalc FMP and the  
interpreter.  Download them from _www.ucalc.com_ (http://www.ucalc.com) ):
 
-------  FORTH language definition starts below:
 
ucQuote           =  96          ~c ASCII 96 is the `  (backquote) character
ucQuoteAlt        =  96
ucVersion         = ucVersion +  `Generic FORTH.  Version x.x October 2005 
(beta)  ~cr`
ucMainPrompt      = `ucalc:FORTH>  `
ucMultiLinePrompt = `ucalc:FORTH>>`
ucRelationalTrue  =  -1
 
Var x, vIndex, Vars(50)
 
syntax quote((Literal:~q[^)]*~q)) ::= ~qLiteral~q
syntax (statementsA) ~  (statementsB) ::= (statementsA ~cr statementsB)  ~
::: Precedence = PrecedenceMin-10 :  Property = ucIsDelaySyntax
syntax FDEF (a) := (b) ::=  uc_SendToInputQueue(syntax FORTH a [:` ` 
(other=)] ::= b ~ FORTH other)  ~
::: Precedence=PrecedenceMin-20 :  Property = ucIsDelaySyntax
 
syntax FORTH ( (comment:` [^)]*`) ) [(other=)] ::= FORTH other :::  
Precedence = PrecedenceMin-20
syntax FORTH \ [(comment:`.*`=)] ::= :::  Precedence = PrecedenceMin-20
syntax FORTH : (word) (def) ;  ::=  uc_SendToInputQueue(syntax word ::= def)
syntax FORTH : (word) [(def=)] ::=  uc_SendToInputQueue(: word def  ~)
\ syntax FORTH VARIABLE (var) ::=  uc_SendToInputQueue((vIndex=vIndex+1), 
(FDEF var :=  push(ucVarPtr(Vars(vIndex)))))
\ syntax FORTH VARIABLE (var) ::=  uc_SendToInputQueue(syntax FORTH var ::= 
push(ucVarPtr(Vars(vIndex)))  ~058~058~058 Sequence = 1)
\ FDEF variable (var) :=  (push(ucVarPtr(Vars(vIndex))))
\ syntax variable (var) ::= ucalc  (uc_SendToInputQueue(syntax var ::= ucalc 
push(ucVarPtr(Vars(vIndex)))))
 
FDEF VARIABLE (var) := uc_SendToInputQueue( ucalc (vIndex=vIndex+1), ucalc  
(FDEF var := push(ucVarPtr(Vars(vIndex)))) )
 
FDEF !       := uc_SetValByAddr(pop, pop,  ucType_Extended)
FDEF @       :=  push(uc_GetValByAddr(pop, ucType_Extended))
FDEF /MOD    :=  push(StackPeek(StackIndex-1) mod StackPeek(StackIndex)) ~ 
push(pop(3) \  pop(2))
FDEF -ROT    := push(pop(3)) ~ push(pop(3))
FDEF  ?DUP    := iif(StackPeek(StackIndex)<>0,  push(StackPeek(StackIndex)), 
0)
FDEF 0SP     := uc_For(x,  1, StackIndex, 1, pop)
FDEF 2DROP   := pop ~ pop
FDEF  2DUP    := push(StackPeek(StackIndex-1)) ~  
push(StackPeek(StackIndex-1))
FDEF 2OVER   :=  push(StackPeek(StackIndex-3)) ~ push(StackPeek(StackIndex-3))
FDEF  2SWAP   := push(pop(4)) ~ push(pop(4))
FDEF  ABS     := push(Abs(pop))
FDEF BEGIN (code) UNTIL :=  uc_Loop(1, (FORTH code), pop==0)
FDEF BL      :=  push(32)
FDEF BYE    := uc_Quit(1)
FDEF CHAR (c):=  push(ucAsc(ucTrim(quote(c)), 1))
FDEF CR      :=  Print ~cr
FDEF DEPTH   := push(StackIndex)
FDEF DO (code) LOOP  := uc_For(x, pop, pop-1, 1, (FORTH code))
FDEF DROP    :=  pop
FDEF DUP     := push(StackPeek(StackIndex))
FDEF  EMIT    := Print ucChr(pop);
FDEF FALSE   :=  push(0)
\ FDEF FORGET (Word) := ucReleaseItem(~qWord~q) +++ find other way  since 
word is FORTH
FDEF I       :=  push(x)
FDEF IF (x) THEN := iif(pop, (FORTH x), _Nothing)
FDEF IF (x) ELSE  (y) THEN := iif(pop, (FORTH x), (FORTH y))
FDEF KEY      := push(ucAsc(Waitkey_, 1))
FDEF LSHIFT  := push(pop(2) * 2 ^  pop)
FDEF MAX     := push(Max(pop, pop))
FDEF  MIN     := push(Min(pop, pop))
FDEF NEGATE  :=  push(-pop)
FDEF NIP     := pop(2)
FDEF  OVER    := push(StackPeek(StackIndex-1))
FDEF  PICK    := push(StackPeek(StackIndex-pop))
FDEF  ROT     := push(pop(3))
FDEF RSHIFT  := push(pop(2)  \ 2 ^ pop)
FDEF SPACE   := Print ` `;
FDEF SPACES  :=  uc_For(x, 1, pop, 1, (Print ` `;))
FDEF SWAP    :=  push(pop(2))
FDEF TRUE    := push(-1)
FDEF  TUCK    := push(pop(2)) ~  push(StackPeek(StackIndex-1))
FDEF UCALC (code) := code
FDEF  UC_QUIT() := ExprPrefix = `` ~ ucMainPrompt=`ucalc> ` ~  
ucMultiLinePrompt=`ucalc>>`
FDEF (num:`[ ]+-[0-9]+`)     := push(num)
FDEF (num:`[ ]+[0-9]+`)     :=  push(num)
FDEF ." :` ` (c:`[^"]*`) "  := Print_S_(quote(c))
FDEF  .S      := uc_For(x, 1, StackIndex, 1, (Print  StackPeekStr(x)+` `;))
FDEF .       := Print  popstr+` `;
FDEF (op)    := push(int(pop(2) op pop))
 
syntax FORTH ::=
 
ExprPrefix = `FORTH `
 
( End of File )
 
 
Daniel Corbier
UCalc Fast Math Parser
_http://www.ucalc.com_ (http://www.ucalc.com)