######################################################################
#
# *** IMPORTANT *** : Please do not submit or publish any additions
#                     or improvements to this or other files just yet.
#                     These files will likely be open source.
#                     However, details have not been worked out yet.
#                     Please do not submit bug reports yet either.
#                     This beta is a snap shot with many missing or
#                     evolving pieces, so it is already expected that
#                     certain things won't work as anticipated.
#
# Forth.uc: This sample version of Forth is inspired by Phil Burk's
#           tutorial found at www.softsynth.com/pforth/pf_tut.php
#
# For use with uCalc Language Builder v ???
#
# Code in this file originally written by: Daniel Corbier
# Contact: support at ucalc.com
# Date: ???
#
# Revision: ??? Date: ???  By: ??? contact: ???
# Modifications: ???, ???, ???
# 
######################################################################
Include: uCalc.uc

Var: x
Var: DataStack As Stack
Var: FunctionCount
Var: FunctionTable As Table
Var: Space = ' '
Var: StackOutputPrefix = 'Stack: '

SyntaxArg:  {forth} = Chr(25) ~~ # Chr(25) is an arbitrary non-text char
SyntaxArgL: {word}  = "{word:'[^ \r\n\t]+'}"
SyntaxArgL: {op}    = "{op:'[\+\-\*\/\>\<\=]'}"
SyntaxArgL: {s}     = "{'[ \r\n\t]+'}" ~~ # whitespace
SyntaxArgR: {s}     = " "

Pattern: [ \r\n\t]+ ~~ Properties: ucWhiteSpace
Pattern: "          ~~ # turns double quote into ordinary character

DataType: Long     ~~ ConvertsTo: String
DataType: Extended ~~ ConvertsTo: String

Syntax: {Prog_Start}                         ::= {forth}
Syntax: {Prog_Start} >   {Debug:'.*'}        ::= ucExpand({q}{forth} {Debug}{q})
Syntax: {Prog_Start} >>  {Debug:'.*'}        ::= ucSteps({q}{forth} {Debug}{q})
Syntax: {Prog_Start} >>> {Debug:'.*'}        ::= {Debug}

Syntax: Count         ::= uc_Count(DataStack)
Syntax: Read          ::= uc_ReadNum(DataStack, Count)
Syntax: Read({index}) ::= uc_ReadNum(DataStack, {index})
Syntax: Push({item})  ::= uc_Push(DataStack, Int({item}))
Syntax: Pop           ::= uc_PopNum(DataStack)
Syntax: Pop({index})  ::= uc_PopNum(DataStack, {index})

Syntax: {forth}                              ::=
Syntax: {forth}{s}{word}                     ::= ~Eval(IIf(Handle(FunctionTable, {q}{word}{q}), _
                                                 {q1}~Eval(FunctionTable({q}{word}{q})){q1},   _
                                                 {q1}WriteLn({q}{word}  ? - unrecognized word{q}){q1})); {forth}
Syntax: {forth}{Keyword: IF|DO|:|BEGIN }[{'.*'}] ::= ~Eval(uc_IsIncomplete(~t, True))
Syntax: {forth}{s}{Number:'-?[0-9]+\b'}[{op}]::= Push({Number}); {forth}{s}{op}{s}
Syntax: {forth}{s} : {s}{word} {code%} ;     ::= ~Define(Def: {word} {forth} {code} ;;) {forth}
Syntax: {forth}{s} \ {comment:'.*'}          ::= {forth}
Syntax: {forth}{s} {comment:'\( [^)]*\)'}    ::= {forth}
Syntax: {forth} ."{' '}[{literal:'[^\"]+'}]" ::= Write({q}{literal}{q}); {forth}
Syntax: {forth} BEGIN {x} UNTIL              ::= uc_Loop(1, ({forth} {x}), Pop == 0); {forth}
Syntax: {forth} CHAR {' '} {char:'.'}        ::= Push(Asc({q}{char}{q})); {forth}
Syntax: {forth} DO {x} LOOP                  ::= uc_For(x, Pop, Pop-1, 1, ({forth} {x})); {forth}
Syntax: {forth} IF {x} THEN                  ::= iif(Pop, ({forth} {x}), 0); {forth}
Syntax: {forth} IF {x} ELSE {y} THEN         ::= iif(Pop, ({forth} {x}), ({forth} {y})); {forth}
Syntax: {forth} INCLUDE{s}{word}             ::= ~Eval({Prog_Start} ~FileInclude_1({word}))
Syntax: {forth} VARIABLE{s}{word}            ::= {forth} : {word} ~Eval(uCalc(uc_DataAlloc, NullStr, Long)) ;

Syntax: Def:{s}{word} {code+} ;; ::=                        _
            ~Exec(SetVar(FunctionCount, FunctionCount+1))   _
            ~Define(Func: F~Eval(FunctionCount)() As Void = {code}) _
            ~Exec(uc_Insert(FunctionTable, {q}{word}{q}, {qq}F~Eval(FunctionCount){qq}))

Def: +         Push(Pop(Count-1) + Pop) ;;
Def: -         Push(Pop(Count-1) - Pop) ;;
Def: *         Push(Pop(Count-1) * Pop) ;;
Def: /         Push(Pop(Count-1) / Pop) ;;
Def: <         Push(Pop(Count-1) < Pop) ;;
Def: >         Push(Pop(Count-1) > Pop) ;;
Def: =         Push(Pop(Count-1) == Pop) ;;
Def: .         Write(Pop + Space) ;;
Def: .S        Write(StackOutputPrefix); uc_For(x, 1, Count, 1, Write(Read(x) + Space)); WriteLn() ;;
Def: +!        SetVar(ValueAtAddr(Long, Read), ValueAtAddr(Long, Pop) + Pop) ;;
Def: !         SetVar(ValueAtAddr(Long, Pop), Pop) ;;
Def: @         Push(ValueAtAddr(Long, Pop)) ;;
Def: -ROT      Push(Pop(Count-2)); Push(Pop(Count-2)) ;;
Def: ?DUP      iif(Read <> 0, Push(Read), 0) ;;
Def: /MOD      Push(Read(Count-1) mod Read); Push(Pop(Count-2) \ Pop(Count-1)) ;;
Def: 0SP       uc_For(x, 1, Count, 1, Pop) ;;
Def: 2DROP     Pop; Pop ;;
Def: 2DUP      Push(Read(Count-1)); Push(Read(Count-1)) ;;
Def: 2SWAP     Push(Pop(Count-3));  Push(Pop(Count-3)) ;;
Def: 2OVER     Push(Read(Count-3)); Push(Read(Count-3)) ;;
Def: ABS       Push(Abs(Pop)) ;;
Def: AND       Push(Pop(Count-1) AND Pop) ;;
Def: C!        SetVar(ValueAtAddr(Byte, Pop), Pop) ;;
Def: C@        Push(ValueAtAddr(Byte, Pop)) ;;
Def: CR        Write(CrLf) ;;
Def: DROP      Pop ;;
Def: DUP       Push(Read) ;;
Def: EMIT      Write(Chr(Pop)) ;;
Def: FALSE     Push(0) ;;
Def: I         Push(x) ;;
Def: KEY       Push(Asc(InputKey)) ;;
Def: LSHIFT    Push(Pop(Count-1) * 2 ^ Pop) ;;
Def: MAX       Push(Max(Pop, Pop)) ;;
Def: MIN       Push(Min(Pop, Pop)) ;;
Def: MOD       Push(Pop(Count-1) Mod Pop) ;;
Def: NEGATE    Push(-Pop) ;;
Def: NIP       Pop(Count-1) ;;
Def: NOT       Push(-Abs(Read) == Abs(Pop)) ;;
Def: OR        Push(Pop(Count-1) OR  Pop) ;;
Def: OVER      Push(Read(Count-1)) ;;
Def: PICK      Push(Read(Count-Pop-1)) ;;
Def: ROT       Push(Pop(Count-2)) ;;
Def: RSHIFT    Push(Pop(Count-1) / 2 ^ Pop) ;;
Def: SPACE     Write(Space) ;;
Def: SPACES    uc_For(x, 1, Pop, 1, Write(Space)) ;;
Def: SWAP      Push(Pop(Count-1)) ;;
Def: TRUE      Push(-1) ;;
Def: TUCK      Push(Pop(Count-1)); Push(Read(Count-1)) ;;

Execute: SetVar(REPL_Result_Extra, Prog_Start + ' ."    ok" CR .S')
Execute: SetVar(Prompt_SingleLine, NullStr)
Execute: SetVar(Prompt_MultiLine, NullStr)
Execute: SetVar(REPL_Language, 'Forth')
Execute: SetVar(REPL_Startup, 'Startup.fth')
Pattern: ' ~~ # turns single quote into ordinary char (now that defs are over)

Mode: Execute

REPL_OR_FILE