Dijkstra's algorithm

This is a rosettacode.org task
The graph stored in a jagged array. A tuple in m2000 is an array of one dimension. We can put tuple in a tuple too, so this is a jagged array. When we store an array in an array, we store only the pointer to array (which is an object, so we can read the type if we wish).

So Edges is a pointer to the graph (which we didn't change values). The task want only to find the path from a to e, and the weight. But here we search all the paths from every vertex to every vertex (and if not possible the a "no path" label printed).

I use an inventory list only with keys, because we can delete any of them without cost (this list need unique keys). Because we have the statement Inventory in a loop, the second time the inventory must be empty (or an exception produced), but algorithm end when inventory is empty. (to clear an inventory S we have to use Clear S.

There are two lambda functions inside loop. Because we use closures, and for d and pa we get new pointer in each iteration we have to redefine the lambdas to get new closures (with new pointers). Closures in lambda are copies, and this include pointers.

Also I use some subs, which have same scope as the module where we call them. Functions and Modules are namespaces (this include the lambda functions). There is special call to place the same namespace the Call Local but here not used.

I use this pdf for information about algorithm.

Module Dijkstra`s_algorithm {
        const max_number=1.E+306
        GetArr=lambda (n, val)->{
                dim d(n)=val
                =d()
        }
        term=("",0)
        Edges=(("a", ("b",7),("c",9),("f",14)),("b",("c",10),("d",15)),("c",("d",11),("f",2)),("d",("e",6)),("e",("f", 9)),("f",term))
        Document Doc$="Graph:"+{
        }
        ShowGraph()
        Doc$="Paths"+{
        }
        Print "Paths"
        For from_here=0 to 5
                pa=GetArr(len(Edges), -1)
                d=GetArr(len(Edges), max_number)
                Inventory S=1,2,3,4,5,6
                return d, from_here:=0
                RemoveMin=Lambda S, d, max_number-> {
                        ss=each(S)
                        min=max_number
                        p=0
                        while ss
                                val=d#val(eval(S,ss^)-1)
                                if min>val then let min=val : p=ss^ 
                        end while
                        =s(p!)  ' use p as index not key
                        Delete S, eval(s,p)
                }
                Show_Distance_and_Path$=lambda$ d, pa, from_here, max_number (n) -> {
                        ret1$=chr$(from_here+asc("a"))+" to "+chr$(n+asc("a"))
                        if d#val(n) =max_number then =ret1$+ "No Path" :exit
                        let ret$="", mm=n, m=n
                        repeat
                                n=m
                                ret$+=chr$(asc("a")+n)
                                m=pa#val(n)
                        until  from_here=n 
                        =ret1$+format$("{0::-4} {1}",d#val(mm),strrev$(ret$))
                }
                while len(s)>0 
                        u=RemoveMin()
                        rem Print u, chr$(u-1+asc("a"))
                        Relaxed()
                end while
                For i=0 to len(d)-1
                        line$=Show_Distance_and_Path$(i)
                        Print line$
                        doc$=line$+{
                        }
                next
        next
        Clipboard Doc$
        End
        Sub Relaxed()
                local vertex=Edges#val(u-1), i
                local e=Len(vertex)-1, edge=(,), val
                for i=1 to e
                        edge=vertex#val(i)
                        if edge#val$(0)<>"" then
                                val=Asc(edge#val$(0))-Asc("a")
                                if d#val(val)>edge#val(1)+d#val(u-1) then  return d, val:=edge#val(1)+d#val(u-1) : Return Pa, val:=u-1
                        end if
                next 
        end sub
        Sub ShowGraph()
                Print "Graph"
                local i
                for i=1 to len(Edges)
                        show_edges(i)
                next
        end sub
        Sub show_edges(n)
                n--
                local vertex=Edges#val(n), line$
                local e=each(vertex 2 to end), v2=(,)
                While e 
                        v2=array(e)
                        line$=vertex#val$(0)+if$(v2#val$(0)<>""->"->"+v2#val$(0)+format$(" {0::-2}",v2#val(1)),"")
                        Print line$
                        Doc$=line$+{
                        }
                end while
        end sub
}
Dijkstra`s_algorithm

Graph:
a->b  7
a->c  9
a->f 14
b->c 10
b->d 15
c->d 11
c->f  2
d->e  6
e->f  9
f
Paths
a to a   0 a
a to b   7 ab
a to c   9 ac
a to d  20 acd
a to e  26 acde
a to f  11 acf
b to a     No Path
b to b   0 b
b to c  10 bc
b to d  15 bd
b to e  21 bde
b to f  12 bcf
c to a     No Path
c to b     No Path
c to c   0 c
c to d  11 cd
c to e  17 cde
c to f   2 cf
d to a     No Path
d to b     No Path
d to c     No Path
d to d   0 d
d to e   6 de
d to f  15 def
e to a     No Path
e to b     No Path
e to c     No Path
e to d     No Path
e to e   0 e
e to f   9 ef
f to a     No Path
f to b     No Path
f to c     No Path
f to d     No Path
f to e     No Path
f to f   0 f

Anonymous Functions

M2000 support anonymous functions with closures
If a closure is a reference type then saved as reference. So here s is a reference to a stack object. When we wish to use it, preserving items, we have to copy it, using stack() function ( stack(s,s) copy two times, in a new stack object)

Here f closure is a lambda function. A lambda function saved as closure as a value type, so each closure in a f is a new copy. So curry (a variable which hold the lambda function) get a function and all other arguments in a second closure, the stack object, and then return a lambda object. We make a new lambda named curried, which hold the anonymous function.

The disp variable hold another lambda, which we use it with a Call (without returning a result). By default if we use a numeric type lambda we get 0 if no return statement exist in function (we use = as statement to return value(s)).
We can store the lambda function (as a copy) to arrays and inventories (And stack objects, and lambda members of objects type of Group)

In M2000 a call to a function or module done without checking for proper arguments at the calling part. We can analyze the input before the use of arguments in code, but most times we use a Read statement, or the syntactic sugar the parameter list in parenthesis (which make a Read statement). Calling a function by Call we place current stack among the arguments, but using a function in an expression we use new stack with arguments only (can be expand, but at the exit from function the stack deleted).

Type checking are in two levels in M2000. First level, or basic level, is the two types, the numeric and the string type, for return type from expressions. So if we want a string type function we have to use $ in the name and for lambda functions we have to use lambda$ (and not lambda). A numeric type can return objects too. Also the string type may return objects too.

alfa$ =lambda$ ->{
        group k$ {
                k=1000
                value {
                        ="ok"
                }
        }
        =Group$(k)
}
Dim K$(10)
K$(3)=alfa$()
Print K$(3)
Link K$() to K()  ' so K() is a reference to K$()
Print K(3).k

Second level type checking is about the type of arguments. If we don;t provide type then type must be numeric/object or string/object depends of the name (like first level).
In sum function we have a loop while stack is not empty and we get  a number. If stack item isn't a number we get error.
change these lines to pass enum type arguments. We use the peek function, stackitem() which return numeric value even we have object, but we have to drop manual, using drop statement, to emulate a pop from stack.

sum=lambda -> {
        s=0   \\ number pop numbers from stack
        while not empty : s+=stackitem(): drop :end while
        =s
}
enum nums {five=5, seven=7, nine=9}
curried=curry(sum, five, seven, nine)

So in the example bellow we want numbers only (so we use Number which pop a number from stack)

\\ Anonymous Functions
curry=lambda (f)->{
        \\ get arguments as a stack object and store reference to s
        \\ f and s are closures to returned anonymous function
        =lambda f, s=[] -> {
                \\ pass arguments [] to f() if any
                \\ pass arguments using a copy of s
                \\ passing done using ! symbol before a stack object
                =f(![], !stack(s))
        }
}
sum=lambda -> {
        s=0   \\ number pop numbers from stack
        while not empty : s+=number:end while
        =s
}
curried=curry(sum, 5,7,9)
Print curried(1,2,3)=5+7+9+1+2+3  ' true
Print curried(10,20,30)=5+7+9+10+20+30 ' true
Print curried()=5+7+9  ' true
curried2=curry(sum)
Print curried2()=0
curried2=curry(sum, 10,20,30,40)
Print curried2(1,2,3,4)=110
\\ make a closure for a lambda function
disp=lambda title$="my title:" (that$) -> {
        Print title$;that$
}
Call disp("Anonymous Function")
Dim A(10)
A(3)=disp
ret=A(3)("Call from array")
Inventory Abc="100":=disp
ret=Abc("100")("Call from inventory")
ret=lambda title$="another tilte1:" (that$)->{Print title$;that$}("call anonymous function")
ret=lambda title$="another tilte2:" (that$)->{
        Print title$;that$
}("call anonymous function")

Compiler Task (added Transpiler to M2000 code)

This is a program for Rossetacode.org and first published here

Modules have a stack of values, and when we call a module we pass any argument in this stack, but stack is the current stack, from the caller. So from a module we can return results to same stack. So in console we have a current stack, and a Push 10, "ok"  make two items, one at position 1 of stack as "ok" and a second at position 2 as 10 (default type double). To observe the stack we can use the Stack statement with no arguments. Its good first to flush the stack (to make it empty) using the Flush statement:

Flush
Push 10, "ok"
Stack ' show "ok" 1
Read a$, x
Print a$, x, empty=true ' yes is true
Push 10 : Push "ok"
Data 20 ' this goes to end of stack
Stack ' show "ok" 10 20
Data 1,2,"end"
Stack ' show "ok" 10 20 1 2 "end"
Module Consume { Stack : Read x : Drop x}
Consume 3 ' show 3 "ok" 10 20 1 2 "end"
Stack  ' show 1 2 "end"
Print Match("NNS")=True
Drop Stack.Size ' same as Flush
Print Empty=True ' true

When we call a user function in an expression, interpreter give a fresh new stack of values, so any value on stack at the exit of function just removed as stack destroyed.

Stack pass values by value, and reference type by pointer (a reference is something else from a pointer). Reference type is an array, so if we push an array three time we push only three pointers. If we change the array after the push, then when we read the array we get the changed array. We can use Cons() function to make a copy of one or a copy of the merging of two or more arrays), and pass this new pointer as the array to stack, so only one pointer exist, and this only to stack.

So the following program use the stack, to shared by these modules:

lexical_analyzer, syntax_analyzer, CodeGenerator, Virtual_Machine_Interpreter 

Also we use Set Fast ! and Set Fast, one for changing the way which interpreter control screen refresh, the "Extreme" Fast !, and the "Normal" Fast (there is also the Set Slow). We use Set to send the line of code to command line interpreter (global name space). We can use Fast !, Fast and Slow in M2000 console without Set statement.

The example program (783 lines) get a string in stack of values using a Push statement, and a string in curly brackets (including line separator the two characters crlf) with a context of a program written in a simple language, (which draw a Mandelbrot ascii image), and pass it to lexical analyzer, then to syntax analyzer then to code generator and then to virtual machine. All in one program, with one module the CompilerExample. (M2000 identifiers are not case sensitive, ecxept for labels, for using with goto and gosub - the BASIC type statements).

About scope in M2000. Each module and user function has own scope. A local variable always shadow a global one with the same name. We can use closures to lambda functions, passing them as copies. We can alter the value of a closure inside the lambda function. M2000 can use OOP but here not needed for this task. A subroutine is a code private to a module or and a function. In a subroutine we have the same scope as module or function, so we have to use Local to shadow any module's variable with same name, or when we call again (recursion, or mutual recursion happen). Subs have a limit of 10000 calls for private in module return stack, but we can change that to million calls, using the Recursion.Limit statement (or using Recursion.limit 0 for no limit until we get out of memory, including virtual memory), Modules and Functions have three number to indicate the recursion level, which are the three type of calls, in M2000, the simple call of a module using only the name (6354 calls, but no recursion allowed, so we have to use mutual recursion for global modules), the call using the Call statement for functions and modules (also stack of values are the same for each call, so we get about 5422 calls) and functions calls in expressions (we have new stack of values for every call, about 3233 calls). Arguments passed to stack of values when we call something, not to the return stack. When interpreter loaded to execute, check the length of stack, so we can get these values for calls, using Monitor statement from console. So interpreter has one return stack (size defined in M2000.exe), and for each execution object (modules and functions have execution objects) there is also a subroutine stack. Modules also have a pointer to parent stack of values, and functions (if called in expressions) hold own stack of values. Except return stack, all other stacks are kept in heap.

Local Scope. In Virtual_Machine_Interpreter we use a Call Local to call a lambda function. The Call Local place the current scope to the function which we call. We can use this call for modules and normal functions. When we use arguments we have to use new before the first argument to make the Read new arg1, arg2 ... so we can shadow same name variables. In subroutines these happen automatic. So a call local is like a call to subroutine. Calling a lambda function is a kind of indirect call. A lambda function is a value type. So each time we use a copy (see b=func(eval(code_, pc)) where b get a copy from inventory func() when we pass an opcode from buffer code_ at offset pc)


Use of Tuple. M2000 use a kind of array as tuple. So a (,) is the empty tuple (also called auto array). A ((1,2),(3,4)) is a tuple with two tuples as items. A (1,) is a tuple with one item. A (1) is number 1.  A a=("a","b", (1,2), 100#) is a tuple with strings as the two first items amd a tuple as third and a currency type number as fourth item. Print a#val(2)#val(1)=2 because item 2 is the third item which is a tuple, and item 1 is number 2 (if we want the string value we have to use last val as val$). We make, in the compiler task an AST tree as Tuple in Tuple. The variable a is a pointer to tuple. We can push a tuple to stack and pop it or pick it (we can peek a value from stack using Stackitem() for top or item 1, or we can peek from another position, say 3 we use StackItem(3), and we can use Stacktype$(3) to check for type in a more dynamic perspective)

Print (1,2,3,"a","b")#max()=3 'true
Print (1,2,3,"a","b")#max$()="b" ' true

We use some ready made objects, like Invetories (a type of vector), enum types, Buffer (memory block). Also we use Form ! 120, 60  (for TV to use safe area we use this !, but we can use Form 120, 60 without it for a monitor), which give us a console with 120 characters per line, for 60 lines. We want big width for characters in a line to use it for drawing with ascii. M2000 console works for graphics. Using Move 6000,6000 : Circle 3000 we make a circle of 3000 twips, with a center at 6000twips from left side, and 6000twips from upper side. But for the task we use ascii drawing. We didn't use the Print ordinary statement, but a variant which is like to send unicode characters to a file, but we use #-2 to send it to console screen. The ordinary Print not process CR and LF from chars (the print as spaces), because we use @() to move the cursor to print. Also normal Print statement use columns, so Print #-2 bypass columns, and print to the next. Both Print and Print #-2  use the ; for not using a new line as the last action of statement.

2022 November

We can choose from a message box the virtual machine or the M2000 transpiler. The M2000 transpiler get the same input as the virtual machine from code generator, and make a module, then register to M2000 interpreter with name Run and execute it. For each mnemonic we have module inside Run module, except for fetch and store which we have subroutines. We use the stack of values of M2000 for the stack machine. Also we leave the numbers (address for the virtual machine), because M2000 handle these as numeric labels, and we can use Goto for jump, The Jump on zero (jz mnemonic) we use the If number Else XXX where XXX is the numeric label. The read only variable Number just pop a value from stack (if isn't numeric we get an error but here we now it is numeric).

So this code (Courier font) is actual a M2000 program; The module RUN. See the Inline statement which we place the module as local module of Transpiler_to_M2000 module, which is local to CompilerExample which is local to whatever module name you give to module where you copy the code.

Module Run {Global z

Module Halt {Error "stop"}

Module neg {push -number}

Module not {push number=0}

Module and {push sint(binary.and(uint(number), uint(number)))}

Module or {push sint(binary.or(uint(number), uint(number)))}

Module gt {push number<number}

Module lt {push number>number}

Module ge {push number<=number}

Module le {push number>=number}

Module ne {push number<>number}

Module eq {push number=number}

Module mul {push number*number}

Module div {shift 2 : push number div number}

Module mod {shift 2 : push number mod number}

Module sub {shift 2 : push number - number}

Module add {push number + number}

Module prtc {Print #-2, chrcode$(number);:Refresh}

Module prts {Print #-2, var$(number);:Refresh}

Module prti {Print #-2, str$(number, 0);:Refresh}

Dim Base 0, var(15)

Try {

     0 push 420

     5 neg

     6 store(0)

    11 push 300

    16 store(1)

    21 push 300

    26 store(2)

    31 push 300

    36 neg

    37 store(3)

    42 push 7

    47 store(4)

    52 push 15

    57 store(5)

    62 push 200

    67 store(6)

    72 fetch(2)

    77 store(7)

    82 fetch(7)

    87 fetch(3)

    92 gt

    93 if number else  423

    98 fetch(0)

   103 store(8)

   108 fetch(8)

   113 fetch(1)

   118 lt

   119 if number else  396

   124 push 0

   129 store(9)

   134 push 0

   139 store(10)

   144 push 32

   149 store(11)

   154 push 0

   159 store(12)

   164 fetch(12)

   169 fetch(6)

   174 lt

   175 if number else  369

   180 fetch(10)

   185 fetch(10)

   190 mul

   191 push 200

   196 div

   197 store(13)

   202 fetch(9)

   207 fetch(9)

   212 mul

   213 push 200

   218 div

   219 store(14)

   224 fetch(13)

   229 fetch(14)

   234 add

   235 push 800

   240 gt

   241 if number else  298

   246 push 48

   251 fetch(12)

   256 add

   257 store(11)

   262 fetch(12)

   267 push 9

   272 gt

   273 if number else  288

   278 push 64

   283 store(11)

   288 fetch(6)

   293 store(12)

   298 fetch(10)

   303 fetch(9)

   308 mul

   309 push 100

   314 div

   315 fetch(7)

   320 add

   321 store(9)

   326 fetch(13)

   331 fetch(14)

   336 sub

   337 fetch(8)

   342 add

   343 store(10)

   348 fetch(12)

   353 push 1

   358 add

   359 store(12)

   364 goto 164

   369 fetch(11)

   374 prtc

   375 fetch(8)

   380 fetch(4)

   385 add

   386 store(8)

   391 goto 108

   396 push 10

   401 prtc

   402 fetch(7)

   407 fetch(5)

   412 sub

   413 store(7)

   418 goto 82

   423 halt

}

End

Sub store(x)

Read var(x)

End Sub

Sub fetch(x)

Push  var(x)

End Sub

}

And this is the program (we have to copy this in a module), 981 lines of code from both languages..

Module CompilerExample {
	Set Fast !
	Module lexical_analyzer (a$){
		lim=Len(a$)
		LineNo=1
		ColumnNo=1
		Document Output$
		Buffer Scanner as Integer*lim
		Return Scanner, 0:=a$
		offset=0
		buffer1$=""
		flag_rem=true
		Ahead=lambda Scanner (a$, offset)->{
			=false
			Try {
				// second parameter is the offset in buffer units
				// third parameter is length in bytes
				=Eval$(Scanner, offset,2*len(a$))=a$
			}
		}
		Ahead2=lambda Scanner (a$, offset)->{
			=false
			Try {
				=Eval$(Scanner, offset,2) ~ a$
			}
		}
		const nl$=chr$(13)+chr$(10), quo$="""", er$="@", Ansi=3
		Try {
			Do
			If Ahead("/*", offset) Then {
				offset+=2 : ColumnNo+=2
				While not Ahead("*/", offset)
					If Ahead(nl$, offset) Then
						lineNo++: ColumnNo=1 : offset+=2
					Else
						offset++ : ColumnNo++
					End If
					if offset>lim then
						Error "End-of-file in comment. Closing comment characters not found"+er$
					End if
				End While
				offset+=2 : ColumnNo+=2
			} Else.if Ahead(nl$, offset) Then{
				LineNo++: ColumnNo=1
				offset+=2
			} Else.if Ahead(quo$, offset) Then {
				Output$=format$("{0::-10}{1::-10} ", LineNo, ColumnNo)
				offset++ : ColumnNo++
				strin=offset
				While not Ahead(quo$, offset)
					If Ahead("/", offset) Then
						offset+=2 : ColumnNo+=2
					else
						offset++ : ColumnNo++
					End if
					checkerror()
				End While
				Output$="String "+quote$(Eval$(Scanner, strin, (offset-strin)*2))+nl$
				offset++ : ColumnNo++
			} Else.if Ahead("'", offset) Then {
				Output$=format$("{0::-10}{1::-10} ", LineNo, ColumnNo)
				offset++ : ColumnNo++
				strin=offset
				While not Ahead("'", offset)
					If Ahead("/", offset) Then
						offset+=2 : ColumnNo+=2
					else
						offset++ : ColumnNo++
					End if
					checkerror()
				End While
				lit$=format$(Eval$(Scanner, strin, (offset-strin)*2))
				select case len(lit$)
				case 1
					Output$="Integer "+str$(asc(lit$),0)+nl$
				case >1
					{Error "Multi-character constant."+er$}
				case 0
					{Error "Empty character constant."+er$}
				end select
				offset++ : ColumnNo++
			} Else.if Ahead2("[a-z]", offset) Then {
				strin=offset
				Output$=format$("{0::-10}{1::-10} ", LineNo, ColumnNo)
				offset++ : ColumnNo++
				While Ahead2("[a-zA-Z0-9_]", offset)
					offset++ : ColumnNo++
				End While
				Keywords(Eval$(Scanner, strin, (offset-strin)*2))
			} Else.if Ahead2("[0-9]", offset) Then {
				strin=offset
				Output$=format$("{0::-10}{1::-10} Integer ", LineNo, ColumnNo)
				offset++ : ColumnNo++
				While Ahead2("[0-9]", offset)
					offset++ : ColumnNo++
				End While
				if Ahead2("[a-zA-Z_]", offset) then  
					{Error " Invalid number. Starts like a number, but ends in non-numeric characters."+er$}
				else
					Output$=Eval$(Scanner, strin, (offset-strin)*2)+nl$
				end if
			} Else {
				Symbols(Eval$(Scanner, Offset, 2))	      
				offset++ : ColumnNo++
			}
			Until offset>=lim
		}
		er1$=leftpart$(error$,er$)
		if er1$<>"" then
			Print
			Report "Error:"+er1$
			Output$="(Error)"+nl$+"Error:"+er1$
		else
			Output$=format$("{0::-10}{1::-10}", LineNo, ColumnNo)+" End_of_Input"+nl$
		end if
		Push Output$
		Exit
		Clipboard Output$
		Save.Doc Output$, "lex.t", Ansi
		document lex$
		Load.Doc lex$,"lex.t", Ansi
		Report lex$
 
		Sub Keywords(a$)
			select case a$
			case "if"
				a$="Keyword_if"
			case "else"
				a$="Keyword_else"
			case "while"
				a$="Keyword_while"
			case "print"
				a$="Keyword_print"
			case "putc"
				a$="Keyword_putc"
			else case
				a$="Identifier "+a$
			end select
			Output$=a$+nl$
		End sub
		Sub Symbols(a$)
			select case a$
			case " ", chr$(9)
				a$=""
			case "("
				a$="LeftParen"
			case ")"
				a$="RightParen"
			case "{"
				a$="LeftBrace"
			case "}"
				a$="RightBrace"
			case ";"
				a$="Semicolon"
			case ","
				a$="Comma"
			case "*"
				a$="Op_multiply"
			case "/"
				a$="Op_divide"
			case "+"
				a$="Op_add"
			case "-"
				a$="Op_subtract"
			case "%"
				a$="Op_mod"
			case "<"
			{	if Ahead("=", offset+1) Then
					offset++
					a$="Op_lessequal"
					ColumnNo++
				else
					a$="Op_less"
				end if
			}
			case ">"
			{	if Ahead("=", offset+1) Then
					offset++
					ColumnNo++
					a$="Op_greaterequal"
				else
					a$="Op_greater"
				end if
			}
			case "="
			{	if Ahead("=", offset+1) Then
					offset++
					ColumnNo++
					a$="Op_equal"
				else
					a$="Op_assign"
				end if
			}
			case "!"
			{	if Ahead("=", offset+1) Then
					offset++
					ColumnNo++
					a$="Op_notequal"
				else
					a$="Op_not"
				end if
			}
			case "&"
			{	if Ahead("&", offset+1) Then
					offset++
					ColumnNo++
					a$="Op_and"
				else
					a$=""
				end if
			}
			case "|"
			{	if Ahead("|", offset+1) Then
					offset++
					ColumnNo++
					a$="Op_or"
				else
					a$=""
				end if
			}
			else case
				{Error "Unrecognized character."+er$}
			end select
			if a$<>"" then
			Output$=format$("{0::-10}{1::-10} ", LineNo, ColumnNo)+a$+nl$
			end if
		End Sub
		Sub checkerror()
			if offset>lim then {
				Error "End-of-line while scanning string literal. Closing string character not found before end-of-line."+er$
			} else.if  Ahead(nl$,offset) then {
				Error "End-of-file while scanning string literal. Closing string character not found."+er$
			}
		End Sub
	}
	Module syntax_analyzer (b$){
		enum tokens {
			Op_add, Op_subtract, Op_not=5, Op_multiply=10, Op_divide, Op_mod, 
			Op_negate,  Op_less, Op_lessequal, Op_greater, Op_greaterequal,
			Op_equal, Op_notequal, Op_and, Op_or, Op_assign=100, Keyword_if=110,
			Keyword_else, Keyword_while, Keyword_print, Keyword_putc, LeftParen, RightParen,
			LeftBrace, RightBrace, Semicolon, Comma, Identifier, Integer, String, End_of_input
		}
 
		Inventory precedence=Op_multiply:=13, Op_divide:=13, Op_mod:=13, Op_add:=12, Op_subtract:=12
		Append  precedence, Op_negate:=14, Op_not:=14, Op_less:=10, Op_lessequal:=10, Op_greater:=10 
		Append  precedence, Op_greaterequal:=10, Op_equal:=9, Op_notequal:=9, Op_assign:=-1, Op_and:=5
		Append  precedence, Op_or:=4
 
		Inventory symbols=Op_multiply:="Multiply", Op_divide:="Divide", Op_mod:="Mod", Op_add:="Add"
		Append  symbols, Op_negate:="Negate", Op_not:="Not", Op_less:="Less", Op_subtract:="Subtract"
		Append  symbols, Op_lessequal:="LessEqual", Op_greater:="Greater", Op_greaterequal:="GreaterEqual"
		Append  symbols, Op_equal:="Equal", Op_notequal:="NotEqual",  Op_and:="And", Op_or:="Or" 
 
		def lineNo, ColumnNo, m, line$, a, lim, cur=-1
		const nl$=chr$(13)+chr$(10), Ansi=3
		Dim lex$()
		lex$()=piece$(b$,chr$(13)+chr$(10)) 
		lim=dimension(lex$(),1)-1
		op=End_of_input
		flush
		k=0
		Try {
			push (,)   ' Null
			getone(&op)
			repeat
			stmt(&op)
			shift 2  ' swap two top items
			push ("Sequence", array, array)
			k++
			until op=End_of_Input
		}
		er$=error$
		if er$<>"" then print er$ : flush: break
		Print "Ast"
		Document Output$
		prt_ast()
		Push Output$
		exit
		clipboard Output$
		Save.Doc Output$, "parse.t", Ansi
		document parse$
		Load.Doc parse$,"parse.t", Ansi
		Report parse$
 
		sub prt_ast(t)
			if len(t)<1 then
				Output$=";"+nl$
			else.if len(t)=3 then
				Output$=t#val$(0) +nl$
				prt_ast(t#val(1)) : prt_ast(t#val(2))
			else
				Output$=t#val$(0) +nl$
			end if
		end sub
		sub expr(p)   ' only a number
			local x=(,), prev=op
			if  op>=Identifier then
				x=(line$,)
				getone(&op)
			else.if op=LeftParen then
				paren_exp()
				x=array
			else.if op<10 then
				getone(&op)
				expr(precedence(int(Op_negate)))
				read local y
				if prev=Op_add then
					x=y
				else
					if prev=Op_subtract then prev=Op_negate
					x=(symbols(prev), y,(,))
				End if
			else
				 {error "??? "+eval$(op)}
			end if
			local prec
			while exist(precedence, int(op))
				prev=op : prec=eval(precedence)
				if prec<14 and prec>=p else exit
				getone(&op)
				expr(prec+1)  ' all operators are left associative (use prec for right a.)
				x=(symbols(int(prev)), x, array)
			End While
			Push x
		end sub
		sub paren_exp()
			expected(LeftParen)
			getone(&op)
			expr(0)
			expected(RightParen)
			getone(&op)
		end sub
		sub stmt(&op)
			local t=(,)
			if op=Identifier then
				t=(line$)
				getone(&op)
				expected(Op_assign)
				getone(&op) 
				expr(0)
				read local rightnode
				Push ("Assign",t,rightnode)
				expected(Semicolon)
				getone(&op)
			else.if op=Semicolon then
				getone(&op)
				Push (";",)
			else.if op=Keyword_print then
				getone(&op)
				expected(LeftParen)
				repeat
					getone(&op)
					if op=String then
						Push ("Prts",(line$,),(,))
						getone(&op)
					else
						expr(0)
						Push ("Prti", array,(,))
					end if
					t=("Sequence", t, array)
				until op<>Comma
				expected(RightParen)
				getone(&op)
				expected(Semicolon)
				getone(&op)
				push t
			else.if op=Keyword_while then
				getone(&op)
				paren_exp()
				stmt(&op)
				shift 2
				Push ("While",array, array)
			else.if op=Keyword_if then
				getone(&op)
				paren_exp()
				stmt(&op)
				local s2=(,)
				if op=Keyword_else then
					getone(&op)
					stmt(&op)
					read s2
				end if
				shift 2
				Push ("If",array ,("If",array,s2))
			else.if op=Keyword_putc then
				getone(&op)
				paren_exp()
				Push ("Prtc",array,t)
				expected(Semicolon)
				getone(&op)
			else.if op=LeftBrace then
				Brace()
			else
				error "Unkown Op"
			end if
		end sub
		Sub Brace()
				getone(&op)
				while op<>RightBrace and op<>End_of_input
					stmt(&op)
					t=("Sequence", t, array)
				end while
				expected(RightBrace)
				getone(&op)
				push t
		End Sub
		Sub expected(what)
			if not op=what then {Error "Expected "+eval$(what)+str$(LineNo)+","+Str$(ColumnNo)}
		End Sub
		sub getone(&op)
			op=End_of_input
			while cur<lim
			cur++
			line$=trim$(lex$(cur))
			if line$<>"" then exit
			end while
			if cur=lim then exit sub
			LineNo=Val(line$,"int",m)
			line$=mid$(line$, m)
			ColumnNo=Val(line$,"int",m)
			line$=trim$(mid$(line$, m))
			Rem : Print LineNo, ColumnNo
			m=instr(line$," ")
			if m>0 then op=Eval("."+leftpart$(line$, " ")) else op=Eval("."+line$)
		end sub
	}
	Module CodeGenerator (s$){
		Function code$(op$) {
			=format$("{0::-6} {1}", pc, op$)
			pc++
		}
		Function code2$(op$, n$) {
			=format$("{0::-6} {1} {2}", pc, op$, n$)
			pc+=5
		}
		Function code3$(op$,pc, st, ed) {
			=format$("{0::-6} {1} ({2}) {3}", pc, op$, ed-st-1, ed)
		}
 
		Enum tok {
			gneg, gnot, gmul, gdiv, gmod, gadd, gle, gsub, glt
			gle, ggt, gge, geq, gne, gand, gor, gprtc, gprti, gprts,
			gif, gwhile, gAssign, gSeq, gstring, gidentifier, gint, gnone
		}
 
		// Inventories are lists with keys, or keys/data (key must be unique)
		// there is one type more the Invetory Queue which get same keys.
		// But here not used.
		Inventory symb="Multiply":=gmul, "Divide":=gdiv, "Mod":=gmod, "Add":=gadd
		Append  symb, "Negate":=gneg, "Not":=gnot,"Less":=glt,"Subtract":=gsub
		Append  symb, "LessEqual":=gle, "Greater":=ggt, "GreaterEqual":=gge, "Sequence":=gSeq
		Append  symb, "Equal":=geq, "NotEqual":=gne,  "And":=gand, "Or":=gor, "While":=gwhile
		Append  symb, "Prtc":=gprtc,"Prti":=gprti,"Prts":=gprts, "Assign":=gAssign, "If":=gif
		Append  symb, "String":=gstring, "Identifier":=gidentifier, "Integer":=gint, ";", gnone
 
		Inventory DataSet
		// We set string as key. key maybe an empty string, a string or a number.
		// so we want eash string to saved one time only.
		Inventory Strings
 
		Const nl$=chr$(13)+chr$(10), Ansi=3
		Def z$, lim, line$, newvar_ok, i=0
		Document message$=nl$
		Global pc     // functions have own scope, so we make it global, for this module, and childs.
 
		Dim lines$()
		s$=filter$(s$,chr$(9))   // exclude tabs
		Lines$()=piece$(s$,nl$) // break to lines
		lim=len(Lines$())
		Flush ' empty stack (there is a current stack of values which we use here)
 
		Load_Ast()
		If not stack.size=1 Then Flush : Error "Ast not loaded"
		AST=array   // pop the array from stack
		Document Assembly$, Header$
 
		// all lines of assembly goes to stack. Maybe not in right order.
		// Push statement push to top, Data statement push to bottom of stack
 
		CodeGenerator(Ast)
		Data  code$("halt") ' append to end of stack
		// So now we get all data (letters) from stack
		While not empty
			Assembly$=letter$+nl$
		end while
		// So now we have to place them in order
		Sort Assembly$
 
		// Let's make the header
		Header$=format$("Datasize: {0} Strings: {1}", Len(Dataset),Len(strings))
		// we use an iterator object, str^ is the counter, readonly, but Eval$() use it from object.
		str=each(strings)    
		While str
			Header$=nl$+Eval$(str)
		End while
		Assembly$=nl$
		// insert to line 1 the Header
		Insert 1 Assembly$=Header$
		// Also we check for warnings
		If len(message$)>2 then Assembly$="Warnings: "+nl$+message$
		// So now we get a report
		// (at each 3/4 of window's lines, the printing stop and wait for user response, any key)
		Push Assembly$
		Exit
		Report Assembly$
		Clipboard Assembly$
		Save.Doc Assembly$, "code.t", Ansi
		End
		// subs have 10000 limit for recursion but can be extended to 1000000 or more.
		Sub CodeGenerator(t)
 
			If len(t)=3 then
				select case  t#val(0)
				Case gSeq
					CodeGenerator(t#val(1)) : CodeGenerator(t#val(2))
				Case gwhile
				{
					local spc=pc
					CodeGenerator(t#val(1)) 
					local pc1=pc
					pc+=5 ' room for jz
					CodeGenerator(t#val(2))
					data code3$("jz",pc1, pc1, pc+5)
					data code3$("jmp",pc,  pc, spc)
					pc+=5  ' room for jmp
				}
				Case gif
				{
					CodeGenerator(t#val(1)) 
					local pc1=pc, pc2
					pc+=5
					CodeGenerator(t#val(2)#val(1)) 
					If len(t#val(2)#val(2))>0 then
						pc2=pc
						pc+=5
						data code3$("jz",pc1, pc1, pc)
						CodeGenerator(t#val(2)#val(2))
						data code3$("jmp",pc2, pc2, pc)
					else
						data code3$("jz",pc1, pc1, pc)
					end If	  
				}
				Case gAssign
				{
					CodeGenerator(t#val(2))
					local newvar_ok=true
					CodeGenerator(t#val(1))
				}
				case gneg to gnot, gprtc to gprts
					CodeGenerator(t#val(1)) : data code$(mid$(eval$(t#val(0)),2))
				case gmul to gor
				{
					CodeGenerator(t#val(1))
					CodeGenerator(t#val(2))
					data code$(mid$(eval$(t#val(0)),2))
				}
				End select
			Else.if len(t)=2 then
				select case  t#val(0)
				Case gString
				{
					local spos
					If exist(strings,t#val$(1)) then
						spos=eval(strings!)
					else
						append strings, t#val$(1)	       
						spos=len(strings)-1
					end If
					Push code2$("push",str$(spos,0))
				}
				Case gInt
					Push code2$("push",t#val$(1), pc)
				Case gIdentifier
				{
					local ipos
					If exist(dataset,t#val$(1)) then
						ipos=Eval(dataset!)  ' return position
					else.if newvar_ok then
						Append dataset, t#val$(1)
						ipos=len(dataset)-1
					else
						message$="Variable "+t#val$(1)+" not initialized"+nl$
 
					end If
					If newvar_ok then
						Push code2$("store","["+str$(ipos, 0)+"]")
					else
						Push code2$("fetch","["+str$(ipos, 0)+"]")
					end If
				}
				end select
			End If
		End Sub
		Sub Load_Ast()
				If i>=lim then Push (,) : exit sub
				do
				line$=Trim$(lines$(i))
				I++
				tok$=piece$(line$," ")(0)
				until line$<>"" or i>=lim
				If tok$="Identifier" then
					Push (gidentifier,trim$(Mid$(line$,11)))
				else.if tok$="Integer" then
					long n=Val(Mid$(line$,8))  ' check overflow
					Push (gint, Trim$(Mid$(line$,8)))
				else.if tok$="String" then
					Push (gstring,Trim$(Mid$(line$,7)))
				else.if tok$=";" then
					Push (,)
				Else
					local otok=symb(tok$)
					Load_Ast() 
					Load_Ast()
					Shift 2
					Push (otok,array, array)
				End If
		End Sub
	}
	Module Virtual_Machine_Interpreter (a$){
		// function to extract string, replacing escape codes.
		Function GetString$(a$) {
			s=instr(a$, chr$(34))
			m=rinstr(a$,chr$(34))-s
			if m>1 then
				// process escape codes
				=format$(mid$(a$, s+1, m-1))
			else
				=""
			end if
		}
 		const nl$=chr$(13)+chr$(10)
		// we can set starting value to any number  n where 0<=n<=232
		enum op {	halt_=232, add_, sub_, mul_, div_, mod_, not_, neg_, and_, or_, lt_,
			    	gt_, le_, ge_, ne_, eq_, prts_, prti_, prtc_, store_, fetch_, push_,
				jmp_, jz_
	    	}
	     	exit_now=false
		Inventory  func=halt_:=lambda->{exit_now=true}
		Append  func, push_:=lambda->{sp--:return stack_, sp:=eval(code_, pc as long):pc+=4}
		Append  func, jz_:=lambda->{
			sp++: if eval(stack_, sp-1)=0 then pc=eval(code_, pc as long) else pc+=4
		}
		Append  func, jmp_:=lambda->{pc=eval(code_, pc as long)}
		Append  func, fetch_:=lambda->{sp--:Return stack_, sp:=eval(stack_, eval(code_, pc as long)):pc+=4}
		Append  func, store_:=lambda->{Return stack_, eval(code_, pc as long):=eval(stack_, sp):sp++:pc+=4}
		Append  func, add_:=lambda->{Return stack_, sp+1:=uint(sint(eval(stack_, sp+1))+sint(eval(stack_, sp))):sp++}
		Append  func, sub_:=lambda->{Return stack_, sp+1:=uint(sint(eval(stack_, sp+1))-sint(eval(stack_, sp))):sp++}
		Append  func, mul_:=lambda->{Return stack_, sp+1:=uint(sint(eval(stack_, sp+1))*sint(eval(stack_, sp))):sp++}
		Append  func, div_:=lambda->{Return stack_, sp+1:=uint(sint(eval(stack_, sp+1)) div sint(eval(stack_, sp))):sp++}
		Append  func, mod_:=lambda->{Return stack_, sp+1:=uint(sint(eval(stack_, sp+1)) mod sint(eval(stack_, sp))) :sp++}
		Append  func, not_:=lambda->{Return stack_, sp:=if(eval(stack_, sp)=0->uint(-1),0)}
		Append  func, neg_:=lambda->{Return stack_, sp:=uint(-sint(eval(stack_, sp)))}
		Append  func, and_:=lambda->{Return stack_, sp+1:=binary.and(eval(stack_, sp+1),eval(stack_, sp)):sp++	}
		Append  func, or_:=lambda->{Return stack_, sp+1:=binary.or(eval(stack_, sp+1),eval(stack_, sp)):sp++	}
		Append  func, lt_:=lambda->{Return stack_, sp+1:=uint(if(sint(eval(stack_, sp+1))<sint(eval(stack_, sp))->-1, 0)):sp++}
		Append  func, gt_:=lambda->{Return stack_, sp+1:=uint(if(sint(eval(stack_, sp+1))>sint(eval(stack_, sp))->-1, 0)):sp++}
		Append  func, le_:=lambda->{Return stack_, sp+1:=uint(if(sint(eval(stack_, sp+1))<=sint(eval(stack_, sp))->-1, 0)):sp++}
		Append  func, ge_:=lambda->{Return stack_, sp+1:=uint(if(sint(eval(stack_, sp+1))>=sint(eval(stack_, sp))->-1, 0)):sp++}
		Append  func, ne_:=lambda->{Return stack_, sp+1:=uint(if(eval(stack_, sp+1)<>eval(stack_, sp)->-1, 0)):sp++}
		Append  func, eq_:=lambda->{Return stack_, sp+1:=uint(if(eval(stack_, sp+1)=eval(stack_, sp)->-1, 0)):sp++}
		Append  func, prts_:=lambda->{Print #-2, strings$(eval(stack_,sp));: Refresh:sp++}
		Append  func, prti_:=lambda->{Print #-2, str$(sint(eval(stack_,sp)),0);: Refresh:sp++}
		Append  func, prtc_:=lambda->{Print #-2, chrcode$(eval(stack_,sp));: Refresh:sp++}
		Rem : Form 120, 60 ' change console width X height to run Ascii Mandlebrot example
		// change Report with Print #-2,   (report stop when scrolling 3/4 of height of console, waiting key or mouse key to continue)
		Print #-2,  "Virtual Assembly Code:"+{
		}+a$
		Print "Prepare Byte Code"
 
		// get datasize
		a$=rightpart$(a$, "Datasize:")
		m=0
		data_size=val(a$, "int", m)
		a$=mid$(a$, m)
		// make stack
		if data_size>0 then Buffer Clear stack_ as long*data_size
		// dim or redim buffer append 1000 long as is.
		Buffer stack_ as long*(1000+data_size)
		// get strings
		a$=rightpart$(a$, "Strings:")
		m=0
		strings=val(a$, "int", m)
		a$=rightpart$(a$, nl$)
 
		if strings>0 then
			Dim strings$(strings)
			for i=0 to strings-1
				strings$(i)=GetString$(leftpart$(a$, nl$))
				a$=rightpart$(a$, nl$)
			Next i
		End if
		buffer clear code_ as byte*1000
		do
			m=0
			offset=val(a$,"int", m)
			if m<0 then exit
			a$=mid$(a$,m)
			line$=trim$(leftpart$(a$,nl$))
			if line$="" then line$=trim$(a$) else a$=trim$(rightpart$(a$, nl$))
			op$=if$(instr(line$," ")>0->leftpart$(line$," "), line$)
			if not valid(eval(op$+"_")) then exit
			opc=eval(op$+"_")
			Return code_, offset:=opc
			if opc>=store_ then
				line$=rightpart$(line$," ")
				select case opc
				case store_, fetch_
					Return code_, offset+1:=val(rightpart$(leftpart$(line$,"]"),"[")) as long : offset+=4
				case push_
					Return code_, offset+1:=uint(val(line$)) as long : offset+=4
				case jz_, jmp_
					Return code_, offset+1:=val(rightpart$(line$,")")) as long : offset+=4
				end select 
			end if
		Always
		Print "Press any key" : Push key$ : Drop
		// Prepare VM
		profiler
		let pc=0, sp=len(stack_) div 4
		do
			b=func(eval(code_, pc))
			pc++
			call local b()
		until exit_now
		Print
		Print "", round(Timecount/1000,2),"s"
	}
	Module Transpiler_to_M2000 (code$){
		Print #-2,  "Virtual Assembly Code:"+{
		}+code$
		Print "Prepare M2000 Code"
		Flush
		prolog$={Global z
			Module Halt {Error "stop"}
			Module neg {push -number}
			Module not {push number=0}
			Module and {push sint(binary.and(uint(number), uint(number)))}
			Module or {push sint(binary.or(uint(number), uint(number)))}
			Module gt {push number<number}
			Module lt {push number>number}
			Module ge {push number<=number}
			Module le {push number>=number}
			Module ne {push number<>number}
			Module eq {push number=number}
			Module mul {push number*number}
			Module div {shift 2 : push number div number}
			Module mod {shift 2 : push number mod number}
			Module sub {shift 2 : push number - number}
			Module add {push number + number}
			Module prtc {Print #-2, chrcode$(number);:Refresh}
			Module prts {Print #-2, format$(var$(number));:Refresh}
			Module prti {Print #-2, str$(number, 0);:Refresh}
			}
		Variable$=lambda$ (many, Name$, glob as boolean=false)->{
			if many else exit
			if glob then
				="Global "+name$+"(0 to "+str$(many,0)+")"+{
				}
			else
				="Dim Base 0, "+name$+"("+str$(many,0)+")"+{
				}
			end if
		}
		firstline$=leftpart$(code$,13)
		code$=rightpart$(code$, 10)
		firstline$=rightpart$(firstline$, ": ")
		Vars=val(firstline$)
		firstline$=rightpart$(firstline$, ": ")
		Strings=val(firstline$)
		document feedstrings$
		if Strings Then
		for i=0 to Strings-1
			firstline$=Trim$(leftpart$(code$,13))
			code$=rightpart$(code$, 10)
			feedstrings$="var$("+str$(i,0)+") = "+firstline$+{
			}
		next
		end if
		stack new {
			{
				g$=leftpart$(code$, " (")
				if g$="" or code$="" then
					data code$ : code$="": exit
				end if
				data g$
				code$=rightpart$(code$, 41)
				loop
			}
			while not empty{
				read g$
				code$+=g$
			}
		}
		code$=replace$("]", ")", code$)
		code$=replace$("fetch [", "fetch(", code$)
		code$=replace$("store [", "store(", code$)
		code$=replace$("jmp ", "goto ", code$)
		code$=replace$("jz", "if number else ", code$)
		Subs$={
			End
			Sub store(x)
				Read var(x)
			End Sub
			Sub fetch(x)
				Push  var(x)
			End Sub
		}
		document M2000Code$="Module Run {" +prolog$ + Variable$(Vars,"var")
		M2000Code$=Variable$(Strings,"var$", true) +feedstrings$ + "Try {" + {
		} + code$+"}"+Subs$+"}"
		//clipboard M2000code$
		//exit
		Inline M2000Code$
		Print "Press any key" : Push key$ : Drop
		profiler
		Run
		Print
		Print round(Timecount/1000,2),"s"
	}
	print "choose example",
	menu "Mandelbrot", "primes","test case 4", "99 Bottles of Beer", "FizzBuzz", "fibonacci of 44 is 701408733", "12 factorial is 479001600"
	if menu then print menu$(menu) else exit
	select case menu
	case 1
		{
			Push {
			{
				/*
				This is an integer ascii Mandelbrot generator
				*/
				left_edge= -420;
				right_edge=300;
				top_edge=300;
				bottom_edge = -300;
				x_step=7;
				y_step=15;
				
				max_iter=200;
				
				y0 = top_edge;
				while (y0 > bottom_edge) {
					x0 = left_edge;
					while (x0 < right_edge) {
						y = 0;
						x = 0;
						the_char = ' ';
						i = 0;
						while (i < max_iter) {
							x_x = (x * x) / 200;
							y_y = (y * y) / 200;
							if (x_x + y_y > 800 ) {
								the_char = '0' + i;
								if (i > 9) {
									the_char = '@';
								}
								i = max_iter;
							}
							y = x * y / 100 + y0;
							x = x_x - y_y + x0;
							i = i + 1;
						}
						putc(the_char);
						x0 = x0 + x_step;
					}
					putc('\n');
					y0 = y0 - y_step;
				}
			}
			} 
		}
	case 2
		{
			push {
			/*
			Simple prime number generator
			*/
			count = 1;
			n = 1;
			limit = 100;
			while (n < limit) {
				k=3;
				p=1;
				n=n+2;
				while ((k*k<=n) && (p)) {
					p=n/k*k!=n;
					k=k+2;
				}
				if (p) {
					print(n, " is prime\n");
					count = count + 1;
				}
			}
			print("Total primes found: ", count, "\n");
			} 
		}
	case 3
	{
		push {
		/*** test printing, embedded \n and comments with lots of '*' ***/ print(42); print("\nHello World\nGood Bye\nok\n"); print("Print a slash n - \\n.\n");
		}
	}
	case 4
	{
		push {
		 /* 99 bottles */ bottles = 99; while (bottles > 0) {
			print(bottles, " bottles of beer on the wall\n");
			print(bottles, " bottles of beer\n");
			print("Take one down, pass it around\n");
			bottles = bottles - 1;
			print(bottles, " bottles of beer on the wall\n\n");
			}
		}
	}
	case 5
	{
		push {
		/* FizzBuzz */ i = 1; while (i <= 100) {

			if (!(i % 15))
				print("FizzBuzz");
			else if (!(i % 3))
				print("Fizz");
			else if (!(i % 5))
				print("Buzz");
			else
				print(i);
				print("\n");
				i = i + 1;
			} 
		}
	}
	case 6
	{
		push {
			/* fibonacci of 44 is 701408733 */
			
			n = 44; i = 1; a = 0; b = 1; while (i < n) {
			
				w = a + b;
				a = b;
				b = w;
				i = i + 1;
			} print(w, "\n"); 
		}
	}
	case 7
	{
		push {
			/* 12 factorial is 479001600 */
			
			n = 12; result = 1; i = 1; while (i <= n) {
			
			result = result * i;
			i = i + 1;
			} print(result); 
		}
	}
	end select
	Form! 104, 60
	Refresh
	Print "Lexical Analyzer" : Refresh
	lexical_analyzer
	if not islet then exitr
	Print "Syntax Analyzer" : Refresh
	syntax_analyzer
	if not islet then exit
	Print "Code Generator" : Refresh
	CodeGenerator
	if not islet then exit
	if ask("Choose execution style", "Info", "Virtual Machine", "*M2000 Transpiler")=1 then
		Virtual_Machine_Interpreter
	else
		Transpiler_to_M2000
	end if
	Print "done"
	Set Fast 'restore speed setting
}
CompilerExample