Universal Turing Machine

 Read https://en.wikipedia.org/wiki/Universal_Turing_machine

We use stack of values as TAPE. We can writ e from both sides, we can read from anywhere, but we can pop only from top. So if we have to change value to 15th element (where no 1 is the first element)  we have first do this shift 15  so the 15th became 1st, then do Drop to drop it from stack, then we push the new value and do shiftback 15 to send it to  position 15. A stack of value is a collection of values, which we can easy move elements, insert or delete. So we have variable HEAD to get the scanned symbol.

These 4 statements change the current symbol (as HEAD point to) with one on inst(0) array item.

shift .head : drop :push inst(0): shiftback .head

Rules have 5 parts, and we have a List where we place them. The key for each element is a combination of state and scanning symbol. The other 3 combined in a tuple and that is the value of the element for the key. So When we run the machine, we have an initial state, we read the symbol at Head, (if no symbols are on tape, we feed the stack with the blank symbol). Then we combine these two to form a key and we read the tuple. We get three values, the new symbol to replace the scanning one (this happen in every step), the action to perform on Head, (right, left, stay) and the new state. When we place stay we have the new state as the Terminating state, so the machine stop. 

When we place Head beyond the bounds of stack we simply add another item, as Blank Symbol, so the Head always points to a Symbol.

Modules in M2000 read/modify parent stack of values. Interpreter call modules placing any parameter on top of stack so if stack has values "A" 112 "B" and we call ModuleOne 1,2 then the stack will be 1,2,"A", 112, "B" (we have a merging situation). The stack of values isn't used as return stack. Functions and lambda functions,  except simple functions (like subrutines, Funstion/End Function) have own stack, if they called in expressions, but same stack through Call statement.

The [] identifier return a stack object replacing the current stack with an empty one. So using this we clear the current stack, but all elements held by the variable which hold the pointer to stack.

so p=[] give the pointer to current stack to p and place a new pointer to an empty stack as the current stack (M2000 never expose the pointer of current stack), The function array() do many things, but with a stack object (a pointer to a stack object) we get an array from the stack, and then stack object  would be empty.

m=stack:=1,2,"abc"
Print len(m)=3
k=array(m)
Print len(m)=0
Print len(k)

So array([]) get the stack and convert to array. In the following example we call a function (with a new stack of values), we get all parameters, make an array and use the special # functions for arrays, we get the sum. The #sum() works for numeric values, so if we pass some strings, there will be no problem for the sum. See the use of ! before a stack object and an array. When we use it, we place all items as parameters. The difference is about the objects, the state after the use. The array not changed, the stack object has no items. To prevent the loss of items we can give a copy of stack object using Stack()

Function Sum() {
	=array([])#sum()
}

Print sum(1,2,3,4,5)=15
Print sum(!(1,2,3),!(4,5))=15
Z=stack:=1,2,3,4,5
Print sum(!Z)=15
Print Len(Z)=0

On the tape (stack of values) we can use any value, but here for the Machine we place numbers, the position of the symbol in Symbols array (from 0 as the lower index). So we place symbols as strings, and the Tape module convert these to positions..

Arrays in M2000 are two kinds, the Array and the Buffer. The array has 16bytes per item, and internal the item is type Variant, (string, boolean,  integer, long, single, double, currency, decimal, object). Buffers used for arrays of simple items like double (8 byte per item), byte (1 byte), etc and as arrays of Structures. The Array has two interfaces. One defined with DIM, eg DIM a(-10 to 10)=1 and the other by using any array (or tuple, but no Buffers). So p=a() make a p a pointer to a(). So check these lines of code, and see that the pointer interface always see the array as one dimension from 0. A statement a+=100 add 100 to all numeric elements. But a(-10)+=100 add 100 to that item only.

dim a(-10 to 10)=1
p=a()
a(-10)=2
Print p#val(0)=2

When we have an array with strings and numbers we can use a second name to get the other type, so the line:  dim inst$() : link inst$() to inst()  make an array inst$() (empty) and a link to inst() so these two identifiers are the same array. So when this happen:

inst$()=.Rules(theRule$)

The this.Rules(theRule$) take the key theRule$ and return a tuple. The array with  name with parenthesis use one pointer and never change the pointer. See the example bellow

dim a()
k=(1,2,3,4)
a()=k
a(0)+=10
Print a(0)=11, k#val(0)=1

The a(0) has value 11, so the internal pointer of a() is different from k. We can make a name with parenthesis as a reference of a pointer to a. A reference means that is ONE thing with another name. So when we do this m()=(1,2,3,4,5,6,7) is like we do k=(1,2,3,4,5,6,7). The difference are for the use of operators (for k ++, += and other apply to all elements, for m() only for the item by the index).

k=(1,2,3,4)
Link k to m()
k+=100
Print m(0)=101
k=(500,200,100)
Print m(0)=500

m()=(1,2,3,4,5,6,7)
Print len(k)=7

Enjoy this program:

Module CheckIt {
	print "Universal Turing Machine"
	print "------------------------"
	class Machine {
	private:
		Head=1, Symbols=(,), States=(,)
		Initial_State$, Terminating_state$, Blank_Symbol$
		BS=0, Rules=list, caption$
		tp$="{0:4} {1} {2} {3:5} {4:4}"
	public:
		Module States {
			.States<=array([])
		}
		Module Symbols {
			.Symbols<=array([])
		}
		Module Reset (.Initial_State$, .Terminating_state$, .Blank_Symbol$) {
			if len(.States)=0 then error "No States defined"
			if len(.Symbols)=0 then error "No Symbols defined"
			if .States#nothave(.Initial_State$) then error "Initial State Not Exist"
			if .States#nothave(.Terminating_state$) then error "Terminating State Not Exist"
			it=.Symbols#pos(.Blank_Symbol$) : if it=-1 then error "Blank symbol not exist"
			.BS<=it
			.Rules<=List
		}
		Module Init (.caption$) {
			flush  // empty stack
			print .caption$
		}
		Module AddRule (state$, read_symbol$, write_symbol$, action$, end_state$) {
			
			if .States#nothave(state$) then Error "State not exist"
			if .symbols#nothave(read_symbol$) then Error "Read Symbol not exist"
			if .symbols#nothave(write_symbol$) then Error "Read Symbol not exist"
			if ("right","left","stay")#nothave(action$) then Error "Action not exist"
			if .States#nothave(end_state$) then Error "End state not exist"
			try ok {
				tuple=(.symbols#pos(write_symbol$), action$, end_state$)
				Append .rules, state$+"_"+read_symbol$:=tuple
			}
			if not ok then error "rule "+ state$+"_"+read_symbol$+" already exist "
			Pen 11 {
				Print format$(.tp$, state$, read_symbol$, write_symbol$, action$, end_state$)
			}
			if stack.size>=5 then loop
		}
		Module Tape {
			s=[]
			m=each(s)
			while m
				it= .Symbols#pos(stackitem$(m))
				if it=-1 then error "Tape symbol not exist at position ";m^
				data it
			end while
		}
		Module Run (steps as long, display as boolean) {
			if len(.rules)=0 then error "No rules found"
			if .Initial_State$="" or .Terminating_state$="" or .Blank_Symbol$="" then
				error "Reset the machine please"
			end if
			if empty then push .BS
			curState$=.Initial_State$
			cont=true
			.head<=1
			dim inst$() : link inst$() to inst()
			while curState$<>.Terminating_state$
				if display then pen 15 {showstack()}		
				steps--
				theRule$=curState$+"_"+.symbols#val$(stackitem(.head))
				if not exist(.Rules, theRule$) then error "Undefined "+theRule$
				inst$()=.Rules(theRule$)
				shift .head : drop :push inst(0): shiftback .head
				select case inst$(1)
				case "right"
					.head++ : if .head>stack.size then data .BS
				case "left"
					if .head<=1 then push .BS else .head--
				else case
					cont=false
				end select
				// change state
				curState$=inst$(2)
				// Show Stack
				if steps=0  or not cont then exit
			end while
			if steps=0 then print over
			Pen 12 {showstack()}
			print "tape length: ";stack.size : flush
			Refresh
			sub showstack()
				local d$=format$("{0:-5} {1::-5} ", curState$, .head) 
				local i: for i=1 to min.data(stack.size, 60): d$+=.symbols#val$(stackitem(i)):Next
				print d$
			end sub
		}
	}
	Turing1=Machine()
	For Turing1 {
		.init "Simple incrementer"
		.States "q0", "qf"
		.Symbols "B", "1"
		.Reset "q0", "qf", "B"    // initial state, terminating state, blank symbol
		.AddRule "q0", "1", "1", "right", "q0"
		.AddRule "q0", "B", "1", "stay", "qf"
		.tape  "1", "1", "1"
		.Run 100, true
	}
	Turing2=Machine()
	For Turing2 {
		.init "Three-state busy beaver"
		.States "a", "b", "c", "halt"
		.Symbols "0", "1"
		.Reset "a", "halt", "0"
		.AddRule "a", "0", "1", "right", "b",	"a", "1", "1", "left", "c"
		.AddRule "b", "0", "1", "left", "a",	"b", "1", "1", "right", "b"
		.AddRule "c", "0", "1", "left", "b", 	"c", "1", "1", "stay", "halt"
		.Run 1000, true
	}
	
	For Turing1 {
		.init "Sorter"
		.States "A","B","C","D","E","X"
		.Symbols "a","b","B","*"
		.Reset "A", "X", "*"
		.AddRule "A", "a", "a", "right", "A", 	"A", "b", "B", "right", "B"
		.AddRule "A", "*", "*", "left", "E",  	"B", "a", "a", "right", "B"
		.AddRule "B", "b", "b", "right", "B", 	"B", "*", "*", "left", "C"
		.AddRule "C", "a", "b", "left", "D",  	"C", "b", "b", "left", "C"
		.AddRule "C", "B", "b", "left", "E",  	"D", "a", "a", "left", "D"
		.AddRule "D", "b", "b", "left", "D", 	"D", "B", "a", "right", "A"
		.AddRule "E", "a", "a", "left", "E", 	 "E", "*", "*", "right", "X"
		.tape "b", "a", "b","b","b","a","a"
		.Run 100, false
	}
	Turing1.tape "b","b","b","a","b","a","b","a","a","a","b","b","a"
	Turing1.Run 1000, false
	
	Turing3=Machine()
	for Turing3 {
		.init "5-state, 2-symbol probable Busy Beaver machine from Wikipedia"
		.States "A","B","C","D", "E", "H"
		.Symbols "0", "1"
		.Reset "A", "H", "0"
		.AddRule "A", "0", "1", "right", "B", 	"A", "1", "1", "left", "C"
		.AddRule "B", "0", "1", "right", "C", 	"B", "1", "1", "right", "B"
		.AddRule "C", "0", "1", "right", "D", 	"C", "1", "1", "left", "E"
		.AddRule "D", "0", "1", "left", "A",	"D", "1", "1", "left", "D"
		.AddRule "E", "0", "1", "stay", "H", 	"E", "1", "0", "left", "A"
		profiler
		.Run 470, false //000000, false
		Print round(timecount/1000,2);"s"    // estimated 12.5 hours for 47000000 steps
	}
}
CheckIt