Δευτέρα, 25 Ιουνίου 2018

Accumulator Factory Solution in M2000

From http://www.rosettacode.org/wiki/Accumulator_factory
This a a solution for Accumulator Factory.
From a Foo() we make a x() function, who holds an accumulator.
If we feed integer value we get as return value integer value. Because M2000 can use Double, Single (~ at the end, eg 12.23~), Decimal (12.12@), Currency (12.12#), Long (12&) and Integer (12%),  we can use any of it, and we take return value same as the input value (Functions in M2000 have master types, eg Numbers or Strings depends from $ in names to distinguish for string type, here in this example we have a string function as ExpType$()).





\\ M2000 Interpreter
\\ accumulator factory
foo=lambda (n as double) -> {
      =lambda n (x) -> {
            \\ x has no type here, can be any numeric type (also can be an object too)       
            \\ accumulator is double, and is a closure (a copy of n in foo)
            n+=x
            \\ any variable in M2000 hold  first type
            \\ if x is an object then we get error, except if object use this operator
            x=n
            \\ so we return x type
            =x
      }
}
x=foo(1)
call void x(5)
call void foo(3)
print x(2.3) \ 8.3

\\ We can add this code to check x() function for result type.

\\ Check Types of return value
\\ ExpType$() return string - is not a lambda function
x1=-x
Def ExpType$(x)=Type$(x)
\\ We can write this as lambda function: ExpType$=Lambda$ (x) -> Type$(x)
Print ExpType$(x(5&))="Long"
Print x(1)=14.3 ' True
Print ExpType$(x(2@))="Decimal"
Print x(1)=17.3 ' True
Print x1(0)=8.3 ' true
Print x1(0&)=8 ' true  ' because we set x as Long

\\ Second part. We make a Class function which is a function (a global one) which return a group (this group is not a pointer to group, is a group).
\\ x() and x1() return numeric value. Class Beta return what Value function define, and we want at x() the n+=x to add a numeric value to n.
\\ A class: label in group/class definition make any member to exist in first "named" group, and not in any copy of it. So module Beta, the constructor, exist only in Beta() class function, and not in Z group.


Class Beta {
private:
      m
public:
      Operator "+=" {
            .m+=number
      }
      Set (z) {
            .m<=z
      }
      Value {
            =.m
      }
Class:
      Module Beta (x) {
      \\ swapping variables we swap types too.
      swap x, .m
      }
}
z=Beta(5.2)
\\ so now z is an object, and we place an object instead of a numeric value
\\ group() return a copy of z. Normal a group return a copy, but we define a value function, so return a number
\\ but group() first check if z is a group, if not an error occur else return a nameless group with a copy of z
Print x(group(z))
z1=Beta(2.23#) ' so now z1 has a Currency type
x2=x ' we get a copy of lambda x, with a copy of n closure.
m=x(group(z1)) ' so x return a Currency too
Print Type$(m)="Currency", m =24.73# ' True
m1=x1(group(z))
Print Type$(m1)="Double", m1=13.5



Change lines with these lines to use event "Display", so each copy call the event from original named group, if exist.

Class Beta {
Event "display"
private:
      m
public:
      Operator "+=" {
            .m+=number
      }
      Set (z) {
             call event "display", .m, z
            .m<=z
      }
      Value {
            =.m
      }
Class:
      Module Beta (x) {
      \\ swapping variables we swap types too.
      swap x, .m
      }
}
Group WithEvents z=Beta(5.2)
Function z_display (new m, z) {
      Print format$("old value={0}, new value={1}", m, z)
}

Until here all groups are used as "values". We can define a pointer to z too, as pZ,
\\ check pointers too
pZ->Z
Z=500
Print x1(Group(pZ)) ' Also event fired here
Print EVal(pz)=Z
For pZ {This=1000} ' Also event fired here
Print Z=1000 ' true