New Accumulator Example

By default literal 1 and 1.388 are type double for M2000 Interpreter.

Numeric Types: Byte (8bit, unsigned), Integer (16bit), Long, Long Long (64bit), signle, double, currency, decimal, date

examples:1ub, 1%, 1&, 1&&, 1~, 1, 1#, 1@, 1ud

Date type is a double which displayed as a string of date/time format. We can do this: Date dt="2025-12-31" or Date dt=46022. To display the numeric value we use Val(), so ? Val(dt) display 46022.

These are the rules fot an Accumulator Factory:

1. Takes a number n and returns a function (lets call it g), that takes a number i, and returns n incremented by the accumulation of i from every call of function g(i).
   Although these exact function and parameter names need not be used
2. Works for any numeric type-- i.e. can take both ints and floats and returns functions that can take both ints and floats. (It is not enough simply to convert all input to floats. An accumulator that has only seen integers must return integers.) (i.e., if the language doesn't allow for numeric polymorphism, you have to use overloading or something like that)
3. Generates functions that return the sum of every number ever passed to them, not just the most recent. (This requires a piece of state to hold the accumulated value, which in turn means that pure functional languages can't be used for this task.)
4. Returns a real function, meaning something that you can use wherever you could use a function you had defined in the ordinary way in the text of your program. (Follow your language's conventions here.)
5. Doesn't store the accumulated value or the returned functions in a way that could cause them to be inadvertently modified by other code. (No global variables or other such things.)

Module CheckIt { 
    Def VarType(n)=Type$(n)
    foo=lambda  (acc) -> {
          =lambda acc -> {
                if empty then =acc : exit
                read x
                acc+=x
                =acc
          }
    }
    Double a=1
    x = foo(a)
    call void x(5)  ' 	Without Void a non zero value count as Error.
    call  foo(3)
    print VarType(x())="Double", x(2.3)=8.3 ' Double literal
    Single m=1
    z=foo(m)
    long L=5
    ? VarType(z(L))="Single", z(2.3)=8.3~ ' Signle literal
    Currency c=1
    zc=foo(c)
    ? VarType(zc(5))="Currency", zc(2.3)=8.3#  ' Currency literal
    Decimal d=1
    zd=foo(d)
    ? VarType(zd(5))="Decimal", zd(2.3)=8.3@  ' Decimal literal
    Date dt=1
    zdt=foo(dt)
    ? VarType(zdt(5))="Date", zdt(2.3)=8.3ud ' Date literal
    Long Long LL=1
    zdt=foo(LL)
    ? VarType(zdt(5))="Long Long", zdt(2.3)=8&& ' Long Long literal
}
CheckIt

Revision 41 Version 12

Three issues: Two bugs fixed and one addition:

1) The #fold() now can take object for initial value.

map=lambda (k, m as array)-> {
	append m, (k^2,): push m
}
? (1,2,3,4,5,6)#fold(map, (,))
? (1,2,3,4,5,6)#fold(map, (,))#fold(map, (,))
? (4,5,6)#fold(map, (1,2,3)#fold(map, (,)))#fold(map, (,))
map2stack=lambda -> {
	read k, m as stack   // we can put the read statement too
	stack m {data k^2}: push m
}
? (1,2,3,4,5,6)#fold(map2stack, stack)   // no #function for stack
map2list=lambda (k, m as list) ->{
	//using (k, m as list) is the same as Read k, m as list
	append m, k^2: push m
}
? (1,2,3,4,5,6)#fold(map2list, list)  // no #function for list
map2queue=lambda -> {
	read k, m as queue // here we place the read statement
	append m, k^2: push m
}
? (1,1,3,4,5,6)#fold(map2queue, queue)  // no #function for queue

2) The bug here was the Point() as class. The Point() is an internal function (which was buggy, see 3rd issue). If we change the Class Point as Class Point1, and also change module point to module point1, and everywhere we call Point() to return an object, then the bug stayed hidden (from 40 and older revisions). Now is ok.  Also see that we can use the internal Point() as @Point() 

// point is an internal function.
// We can make a function with same name as an internal one
// We can call the function using @ if exist as internal and non internal
testpoint()
module abc {
	class point {
		X as integer
	class:
		module point (a as integer) {
			.X<=a
		}
	}
	
	dim a(10)<<point(random(1, 1000))
	m=each(a())
	while m
		for a(m^) {
			? m^, .X
		}
	end while
	testObject()
	testpoint()
}
abc
module abc1 {
	class point {
		X as integer
	class:
		module point (a as integer) {
			.X<=a
		}
	}
	function beta() {
		=point(random(1, 1000))
	}
	dim a(10)<<beta()
	m=each(a())
	while m
		for a(m^) {
			? m^, .X
		}
	end while
	// we can call a subroutine like was here
	testObject()
	// so we have to place @point() for run as internal function
	testpoint()
}
abc1
testpoint()
Report @SimpleFunction()
testObject()
end
// this is a simple function
// a simple function can't change code at run time
//An we can pass a simple function by reference
function SimpleFunction()
	="We can't use an internal name like Point() for simple function"
end function
sub testObject()
	if module(point()) then
		local a=point(100): print a.x=100
	else
		Report "Point() not defined"
	end if
end sub
sub testpoint()
	local a$
	move 0,0
	copy 1000, 1000 to a$
	print @point(a$, 0,0)
end sub

3) The point() function was not used so there was some bugs and I found them when I solved the previous issue.

This is the 1000 twips X 1000 twips, or 67x67 pixels (when 1 pixel need twipsX=15 and twipsY=15). For 1440  parts of 1 inch, for 96 dpi, we have 1440/96 = 15 twips per pixel.

M2000 return the current dpi using 1440/twipsX   (return 96)

The example use the conversion from twips to pixel using the Image.x.pixels() (Image.x() return twips). We know the size of bitmap. The statement Copy has 1000, 1000 the image width and height (but as we see we have 1005X1005 twips, divided by 15 we get 67)

At the end a clipboard a$ send the DIB (a type of bitmap) to clipboard. The a$ is a string which hold some data and the pixels of image. We can get an image using Clipboard.Image$ (or Clipboard.Image to a buffer, a memory buffer, an alternative way to store images)

Cls #005580, 0: move 0, 6000
Pen 14 // yellow
Cursor !  // get the pos, row for characters from graphic cursor
Scroll Split Row 
a$=" "	
Move 0,0: Copy 1000, 1000 to a$: Print Point(a$, 0, 0)=#005580
// Point return color from graphic cursor
Print Point(a$, 0, 0)=Point,  Point=#005580
for i=0 to Image.x.pixels(a$)-1: old=Point(a$, i, i, #FF5580):next
Print old=Point, old=#005580,  Point(a$, 0, 0)=#ff5580
Move 0,0 : image a$, 6000  // make the image X6
move 3000, 1000: image a$  // original size
clipboard a$ // send bitmap no text (read first bytes to decide)
wait 100
b$=clipboard.image$
Print image.x(b$)=1005, " type:"+type$(b$) // String
wait 200
k=clipboard.image
Print image.x(k)=1005, " type:"+type$(k)  // Buffer

Another SuperClass Example

This is a simple program looking the core, we get a number, then add 3 and then multiply by 0.86, and do that for each new result until the new result is equal to old result.

Because I would like to show a program which use the SuperClass, I expand the program to hold results in a document object, and works for 4 different types of number which hold decimal digits.

The SuperClass is a special object which give each time a different object which can use the unique properties/methods of superclass. So here the unique parts are: the document and the module to put something in it formated as we wish. All other parts are specific for each object we make from this SuperClass. So the function Result  get from SuperClass the common Document and return it (as string).

The decimal point is a dot here. We can change it using LOCALE 1032 or GREEK (this also change the language for Error messages, and labels on dialogue forms), to a comma (eg 1.334 turn to 1,334).

For code the decimal point is always the point. Also we can use .23 without the 0 before. 

The Ouput of the program (a(0) to a(3) are four objects, with own Count propertu, and common Result() function which return the Doc$ from SuperClass unique property.

The Print #=2 redirect output formated for file to screen. We need this to get the document processing the new line properly. A simple Print the characters bellow 32 are shown with letters, eg. the new line is ␍␊, changing character code from 0x0D 0x0A to 0x240D and 0x240A, and thats the reason to not process the new line. But Print #FileNumber send all bytes to output, without altering, so the -2 file number send all bytes to screen processing them. All print statements add a new line unless we use a collon  ; at the end.

	test on a(0) so far:2
	test on a(1) so far:2
	test on a(2) so far:2
	test on a(3) so far:2
	Results
	Single           4.00  87 18.42854
	Single        1.23E+8 194 18.4286
	Double           4.00 209 18.4285714285711
	Double   123456789.00 316 18.4285714285717
	Decimal          4.00 423 18.428571428571428571428571426
	Decimal  123456789.00 528 18.428571428571428571428571432
	Currency         4.00  72 18.4283
	Currency 123456789.00 176 18.4289

This is the program

superclass MainTest {
unique: 
	document Doc$
	module PutValue {
		.Doc$<=letter$+{
		}	
	}
public:
	property counter{value}=0
	function result {
		for superclass {
			=.Doc$
		}
	}	
	module Test1 (thisType, ThisValue) {
		select case thistype
		case 0
			single a
		case 1
			double a
		case 3
			currency a
		case else
			decimal a
		end select
		a=ThisValue
		aa=a
		.[counter]++
		long long i=1
		do
			o=a
			a+=3@  ' decimal literal value
			a*=.86@
			if o=a then exit
			i++
		always
		for superclass {
			.PutValue format$("{0:8} {1:2:-12} {2::-3} {3}",type$(aa), aa, i, a)
		}
	}
}
document result$
dim a(0 to 3)=MainTest
for i=0 to 3
	a(i).test1 i, 4
	a(i).test1 i, 123456789	
	result$ = "test on a("+i+") so far:"+a(i).counter+{
	}
next
result$ = "Results" + {
}+a(1).result()

clipboard result$
Print #-2, result$

Revision 40, Version 12

 Fix for string arrays of type "arrays with square brackets":

string a[3]="ok12345"
? a[0]
? left$(a[0], 3)
? ucase$(a[0])
? a[0]+a[1]
? strrev$(a[1])
? len(a)=4, len(a[3])=7

Old revisions return fault values for left$(), Rigt$() and all these functions for strings.

These type of arrays may have second dimension (as a collection of arrays, each one may have different length). Also a string a[3] make 4 item from 0 to 3

string a[3][2]="ok12345"
? a[0][0]
? left$(a[0][0], 3)
? ucase$(a[0][0])
? a[0][0]+a[1][0]
? len(a)=4

a[5][10]="expand"
? a[5][10]
? len(a)=4, len(a[5])=11, len(a[5][10])=6

These type of arrays exist in M2000 to used for passing pointers when we call external function:

module testArr {
	Declare PathAddBackslash Lib "Shlwapi.PathAddBackslashW" { long string_pointer}
	Declare global GetMem4 lib "msvbvm60.GetMem4" {Long addr, Long retValue}
	
	string a[2]="ok1234"
	a[1] = "C:"+String$(Chr$(0), 250)
	function ArrPtr(a, x) {
		long ret
		With a, "ArrPtr" as a.ArrPtr()
		x=GetMem4(a.ArrPtr(0)+4*x, varptr(ret))
		=ret
	}
	if len(a[1])=0 then exit
	m= PathAddBackslash(Arrptr(a, 1))
	Print LeftPart$(a[1],0)
}
testArr

module testArr {
	Declare PathAddBackslash Lib "Shlwapi.PathAddBackslashW" { long string_pointer}
	Declare global GetMem4 lib "msvbvm60.GetMem4" {Long addr, Long retValue}

	string a[2][4]="ok1234"
	a[2][4] = "C:"+String$(Chr$(0), 250)
	function ArrPtr(a, n, x) {
		long ret
		With a, "ArrPtr" as a.ArrPtr()
		x=GetMem4(a.ArrPtr(n)+4*x, varptr(ret))
		=ret
	}
	if len(a[2][4])=0 then exit
	m= PathAddBackslash(Arrptr(a, 2, 4))
	Print LeftPart$(a[2][4],0)
}
testArr

Although this external function handled using a by reference string (we can pass by reference item of a string or an array, but not item of an array with square brackets) (do not pass the thispath$ by reference to PathAddBackslach, isn't a string, is an object with a read only value):

module testArr2 {
	Declare PathAddBackslash Lib "Shlwapi.PathAddBackslashW" { &Path$ }
	const thispath$="C:"+String$(Chr$(0), 250)
	
	string a = thispath$
	m = PathAddBackslash(&a)
	Print LeftPart$(a, 0)
	
	a$ = thispath$
	m = PathAddBackslash(&a$)
	Print LeftPart$(a$, 0)
	
	dim a$(4)
	a$(3) = thispath$
	m = PathAddBackslash(&a$(3))
	Print LeftPart$(a$(3), 0)
	
	dim a(4)
	a(3) = thispath$
	m = PathAddBackslash(&a(3))
	Print LeftPart$(a(3), 0)
	
	dim s(4, 2, 3) as string
	s(3, 1, 2) = thispath$
	m = PathAddBackslash(&s(3,1,2))
	Print LeftPart$(s(3,1,2), 0)
}
testArr2

Revision 39, Version 12

 

1) Some fixes for slice to not raise error for some situations:

a=(1,2,3): ? LEN(a#slice(1,0))=0 ' NOT RAISE ERROR, RETURN EMPTY ARRAY
TRY OK {? LEN(a#slice(2,1))=0} : IF ERROR THEN ? "HERE:"+ERROR$
? LEN(a#slice(3,))=0 ' NOT RAISE ERROR, RETURN EMPTY ARRAY

2) #fold() may produce arrays now. See the definition of a slice as fold1, where second parameter is number of many to slice and nor the ending item to slice:

a=(1,2,"aaa","bbb",5,6,7)
fold1=lambda (skip, many) -> {
	=lambda t=(,), m=0, skip, many -> {
		if m=0 then shift 2: drop: m=1: data t
		read q, k as array
		if skip<=0 then
			if many>0 then append k, (q,)
			data k
			many--
		else
			data t
		end if
		skip--
	}
}
// #slice(start, end)
// #fold(fold1(start, many)) 

? a#fold(fold1(2, 5))#str$(", ")
// PRINT: aaa, bbb, 5, 6, 7
// same as:
? a#slice(2, 6)#str$(", ")

? a#fold(fold1(1, 3))#str$(", ")
// PRINT: 2, aaa, bbb
// same as:
? a#slice(1, 3)#str$(", ")

3) How we get another list for doing map and produce different size array (previous the map function was 1 to 1 for input to output), So now we can change the ratio of items of input list by number of items of output list. So for these example the final list have each item a concat of each item from list1, list2 and list3 so 11019 is the frist item and 21120 the second one. There are no more items because list2 is small. This works from either small list from these three. The map function exit if we don't pass return value (pushing it to stack of values, see push statement - we read from current stack using letter$ and number)

List1=(1,2,3,4,5,6,7,8,9)
List2=(10,11)' ,12,13,14,15,16,17,18)
List3=(19,20,21,22,23,24,227)
map1=lambda (list0 as array) ->{
	dim a()
	a()=list0  // we get a copy
	=lambda a(), n=-1 ->{
		if n<len(a())-1 then
			n++
			if islet then		
				push letter$+(a(n))
			else
				push number+""+(a(n))
			end if
		else
			flush  ' if not return value the map function exit ' addition from 39
		end if
	}
}
? "["+list1#map(map1(list2), map1(list3))#str$(", ")+"]"
map2=map1(list2)
map3=map1(list3)
list2=()
list3=()
// map2 and map3 has a copy of list2, list3 before we erase it
? "["+list1#map(map2, map3)#str$(", ")+"]"

4) For map an example where we produce a bigger list from input list:

dim a(3) as long
a(0):=1,2,3
map1=lambda ->{
	push random(10)+number, 100 ' two values for one
}
? a()#map(map1)#str$(", ")
// 100, 8, 100, 3, 100, 4

5) A big fix for enums. Fix Sum/Min/Max/Min$/Max$ for tuple using Enum values. Sort not work with enum values. This example use Sort after a map function, which map the enum values only to simple values (without the object). Also a Map function can get more than one lambda function to make more maps, one after the other.

About enums: they are objects, which know the name of value, the value (numeric as  number and sign or a string value, also know the order, so a variable of some enum type can advance to next using ++ operator or go back using -- operator, We can use variables which get enum values. For a variable which hold an enum object if we assign a simple value, interpreter search for this value to change an internal index value. If interpreter can't find a value from the enum set then raise error. Also we can use As NameOfEnum for an item in a parameter list to constrain the input.

enum m {a=50, b=200, c=30}
k=(a, b, c)
? k#max(),  k#min(), k#val(0), k#Sum()
z=each(k)
strip = lambda->{
		read t as long:data t
}
strip1 = lambda->{
		read t as long:data t+100
}
k=k#map(strip,strip1)#sort()
? k#str$(", ")

Cycle Detection

https://rosettacode.org/wiki/Cycle_detection#M2000_Interpreter

This is the output of the program:

 Brent's algorithm
 Cycle starts at position: 2 (starting position = 0)
 The length of the Cycle = 6

 Cycle: 101, 2, 5, 26, 167, 95

This is the FREEBASIC program:

' version 11-01-2017
' compile with: fbc -s console

' define the function f(x)=(x*x +1) mod 255
Function f(x As Integer) As Integer
    Return (x * x +1) Mod 255
End Function

Sub brent(x0 As Integer, ByRef lam As Integer, ByRef mu As Integer)

    Dim As Integer i, power = 1
    lam = 1

    ' main phase: search successive powers of two
    Dim As Integer tortoise = f(x0)   ' f(x0) is the element/node next to x0.
    Dim As Integer hare = f(f(x0))

    While tortoise <> hare
        If power = lam Then
            tortoise = hare
            power *= 2
            lam = 0
        End If
        hare = f(hare)
        lam += 1
    Wend

    ' Find the position of the first repetition of length ?
    mu = 0
    tortoise = x0
    hare = x0
    For i = 0 To lam -1
        ' range(lam) produces a list with the values 0, 1, ... , lam-1
        hare = f(hare)
    Next
    ' The distance between the hare and tortoise is now ?.

    ' Next, the hare and tortoise move at same speed until they agree
    While tortoise <> hare
        tortoise = f(tortoise)
        hare = f(hare)
        mu += 1
    Wend

End Sub

' ------=< MAIN >=------

Dim As Integer  i, j, lam, mu, x0 = 3

brent(x0, lam, mu)
Print " Brent's algorithm"
Print " Cycle starts at position: "; mu; " (starting position = 0)"
Print " The length of the Cycle = "; lam
Print

j = f(x0)
Print " Cycle: ";
For i = 1 To lam + mu -1
    If i >= mu Then
        Print j;
        If i <> (lam + mu -1) Then Print ", "; Else Print ""
    End If
    j = f(j)
Next
Print

' empty keyboard buffer
While Inkey <> "" : Wend
Print : Print "hit any key to end program"
Sleep
End

So I made some corrections to translate to M2000 code, as less work as possible. Finally I put the code on a module. A module ins't a SUB. A module has own name space, a sub use the module's name space, so the simple function f() which we call using @f(). See the Local statements to make integers as local variables to Sub.

// https://rosettacode.org/wiki/Cycle_detection#
module Brent`s_Algorithm {
	' Translated from FreeBasic
	' Integer is 16bit integer
	' Change to Long or Long Long for bigger numbers
	Integer  i, j, lam, mu, x0 = 3
	
	brent(x0, &lam, &mu)
	Print " Brent's algorithm"
	Print " Cycle starts at position: "; mu; " (starting position = 0)"
	Print " The length of the Cycle = "; lam
	Print
	
	j = @f(x0)
	Print " Cycle: ";
	For i = 1 To lam + mu -1
	    If i >= mu Then
	        Print j;
	        If i <> (lam + mu -1) Then Print ", "; Else Print ""
	    End If
	    j = @f(j)
	Next
	Print
	
	
	Function f(x As Integer)    
	    =(x * x +1) Mod 255
	End Function
	
	Sub brent(x0 As Integer, &lam As Integer,  &mu As Integer)
	
	    Local Integer i, power = 1
	    lam = 1

	
	    ' main phase: search successive powers of two
	    Local Integer tortoise = @f(x0)   ' f(x0) is the element/node next to x0.
	    Local Integer hare = @f(@f(x0))
	
	    While tortoise <> hare
	        If power = lam Then
	            tortoise = hare
	            power *= 2
	            lam = 0
	        End If
	        hare = @f(hare)
	        lam += 1
	    End While
	    ' Find the position of the first repetition of length ?
	    mu = 0
	    tortoise = x0
	    hare = x0
	    if lam>0 then
	        For i = 0 To lam -1
	            ' range(lam) produces a list with the values 0, 1, ... , lam-1
	            hare = @f(hare)
	        Next
	    end if
	    ' The distance between the hare and tortoise is now ?.
	
	    ' Next, the hare and tortoise move at same speed until they agree
	    While tortoise <> hare
	        tortoise = @f(tortoise)
	        hare = @f(hare)
	        mu += 1
	    End While
	End Sub
}
Brent`s_Algorithm