Παρασκευή, 10 Ιουλίου 2020

Abstract Factory (OOP)

M2000 has no abstract classes. But we can emulate them, because all modules and functions in a group (the object which the class function return) can be changed unless we state Final. So for abstract modules and functions we place an Error statement. This means we have to replace it to use it.

Classes are global functions as long as the module where defined running. The object's never need the classes to execute. Classes are for creating objects only.
Here we have a Creator abstract class because the factoryMethod is abstract (using the error statement, to emulate it).
The ConcreteCreator is a Creator which replace the factoryMethod with a final one.We can make another class as ConcreteCreator2 which is also a Creator but with different factoryMethod. Each one of them produce a specific Product at the Creator's anOperation. So anOperation make product, from some kinds of objects but all objects are type Product (and each one has some additional logic).



Class Product {
Class:
      Module Product {
            Report "A new Product"
      }
}
class Creator {
      module anOperation       {
            Report "An Operation of Creator - Use a specific to object factoryMethod"
            product = .factoryMethod()
      }
      function factoryMethod {
            Error "Not implemented yet "+module.name$
      }
Class:
      Module Creator {
            Report "A new Creator"
      }
}
class ConcreteProduct as Product {
class:
      module ConcreteProduct {
      \\ call Product module which is part of Product.
            .Product
            Report "A new ConcreteProduct is a Product"
      }


}
class ConcreteProduct2 as Product {
class:
      module ConcreteProduct2 {
      \\ call Product module which is part of Product.
            .Product
            Report "A new ConcreteProduct2 is a Product"
      }
}


class ConcreteCreator as Creator {
      function final factoryMethod {
            Print "factoryMethod 001"
            =ConcreteProduct()
      }
class:
      module ConcreteCreator {
            .Creator
            Report "A new ConcreteCreator is a Creator"
      }
}
class ConcreteCreator2 as Creator {
      function final factoryMethod {
            Print "factoryMethod 002"
            =ConcreteProduct2()
      }
class:
      module ConcreteCreator2 {
            .Creator
            Report "A new ConcreteCreator2 is a Creator"
      }
}
Module Client {
      Report 2, "ConcreteCreator attach a new factoryMethod to a creator class"
      creator = ConcreteCreator()
      creator.anOperation
      creator2= ConcreteCreator2()
      creator2.anOperation
}
Client

Factory Pattern (OOP)

The factory pattern use a function to create a specific object from an id.


\\ Factory Pattern I
      \\ creates objects without exposing the instantiation logic to the client.
      \\ refers to the newly created object through a common interface
class Product {
      
}
class OneProduct as Product {
      
}
class AnotherProduct as Product {
      
}
Group ProductFactory {
      Enum KnownProducts {ID1=101, ID2=102}
      Function createProduct(id as .KnownProducts) {
            if id=ID1 then
                  =OneProduct()
            Else.if id=ID2 Then
                  =AnotherProduct()
            Else
                  =Pointer() ' Null object
            End if
      }
}
P1=ProductFactory.createProduct(101)
Print P1 is type Product
Print P1 is type OneProduct
P2=ProductFactory.createProduct(ProductFactory.ID2)
Print P2 is type Product
Print P2 is type AnotherProduct


Another way is by registering to Factory any number of classes. One way is by using function references, which are code (anonymous functions) from a function.

The list m_RegisteredProducts save strings, but each string is a function. How this can happen. A string contained this "{=number**2}" has an Anonymous function. Print Function("{=number**2}", 2)  show 4, because 2 send to function's stack, number get 2, and 2**2 return 4. So when we place a function reference, we place an anonymous function. For this reason if we want recursion for anonymous function we use Lambda() or Lambda$() for string return type function.

A Class is a function, So if we do this Report &Product() we render as text the code of function to console. We use Report because this handle text (using word wrapping) and also has a page mode which display 3/4 of consols rows, and stop for reading then we press space or mouse button to get the next page.

\\ Factory Pattern II

\\ need to be global
Global Group ProductFactory {
Private:
        m_RegisteredProducts=List
Public:
      \\  we get a reference of a class but we make it a string
      \\ because a reference of a function is the code of function
      Module Register (id$, func$) {
            id$=lcase$(id$)
            if exist(.m_RegisteredProducts, id$) then Error "Id used"
            Append .m_RegisteredProducts, id$:=func$
      }
      Function createProduct(id$) {
            id$=lcase$(id$)
            if exist(.m_RegisteredProducts, id$) then
                  Push eval$(.m_RegisteredProducts)
                  Read &Class()
                  =Class()
            Else
                  =Pointer() ' Null object
            End if
      }
}
Module SetUp {
      class Product {
            
      }
      class OneProduct as Product {
            
      }
      class AnotherProduct as Product {
            
      }
      ProductFactory.Register "101", &OneProduct()
      ProductFactory.Register "102", &AnotherProduct()
}
\\ call setup to register classes to ProductFactory
\\ original classes definitions erased
Setup
Class Product {
Class:
      Module Product(id$) {
            This<=ProductFactory.createProduct(id$)
      }
}
P1=Product("101")
Print P1 is type Product
Print P1 is type OneProduct
P2=Product("102")
Print P2 is type Product
Print P2 is type AnotherProduct


Using Lambda functions to the list m_RegisterProducts. Classes are global, as long as the module or function where created is running these classes exist. After the end of run these classes erased. So the function part of a lambda has to run when the classes exist. 

A lambda is a variable and a function. We can pass the function or the variable by reference or the variable by value. Here we pass the variable by value.

\\ Factory Pattern III - Using Lambda Functions


class Product {
      
}
class OneProduct as Product {
      
}
class AnotherProduct as Product {
      
}
\\ if the OneProduct() and AnotherProduct() erased
\\ then these lambda can't call them
OneProduct=lambda ->OneProduct()
AnotherProduct=lambda ->AnotherProduct()
Group ProductFactory {
Private:
        m_RegisteredProducts=List
Public:
      \\  we get a reference of a class but we make it a string
      \\ because a reference of a function is the code of function
      Module Register (id$, b as lambda) {
            id$=lcase$(id$)
            if exist(.m_RegisteredProducts, id$) then Error "Id used"
            Append .m_RegisteredProducts, id$:=b
      }
      Function createProduct(id$) {
            id$=lcase$(id$)
            if exist(.m_RegisteredProducts, id$) then
                  \\ =.m_RegisteredProducts(id$)() is the same as these two lines:
                  Class=eval(.m_RegisteredProducts)
                  =Class()
            Else
                  =Pointer() ' Null object
            End if
      }
}
ProductFactory.Register "101", OneProduct
ProductFactory.Register "102", AnotherProduct
P1=ProductFactory.createProduct("101")
Print P1 is type Product
Print P1 is type OneProduct
P2=ProductFactory.createProduct("102")
Print P2 is type Product
Print P2 is type AnotherProduct


Πέμπτη, 9 Ιουλίου 2020

Factory Method Pattern (OOP)

We mimic the abstract class by using members which produce error at execution. So we have to replace them.

Look the line where we make the MyApplication as a combine from class Application and the ConcreteCreate group. The ConcreteCreate is typeless, so we didn't add type, and replace two functions with two other as final change. So now MyApplication can handle specific types. The Application knows nothing about the types. but knows the Document type of class. (Document is a specific object in M2000, but here we use the name for a class, and all classes have their name as type, plus other names from classes which inherit .


\\ Factory Method Pattern

\\ Document used as abstract group
\\ identifier Document used to define Documents, but here we redefine the name

Class Document {
    module open {
        Error "Not implemented yet "+module.name$
    }
    module save (filename$) {
        Error "Not implemented yet "+module.name$
    }
    module close {
        Error "Not implemented yet "+module.name$
    }
}
\\ also Application is a pointer to M2000 interpreter to access inner funcitons
\\ but here we redefine the identifier
Class Application {
Private:
    docnum=0, docs=list, lastdocnum=0
    Function GetType$(filename$) {
        Error "Not implemented yet "+module.name$
    }
Public:
    Value (num=0){
        \\ by default return 0
        if num=0 then
            =.docnum
        Else.if exist(.docs, num) Then
            =num
        End If
    }
    Function ExportPointer(Num) {
        if exist(.docs, Num) then
            =eval(.docs)
        else
            =pointer() ' Null Group
        end if
    }
    Module DropDocument (Num) {
        if exist(.docs, Num) then delete .docs, Num
    }
    Function CreateDocument(type$){
        Error "Not implemented yet "+module.name$
    }
    Module NewDocument(type$){
        doc->(.CreateDocument(type$))
        .docnum++
        Append .docs, .docnum:=doc
        doc=>Open
    }
    Module OpenDocument(filename$) {
        Doc=Pointer(.CreateDocument(.GetType$(filename$)))
        If Doc is type Document then
            .docnum++
            Append .docs, .docnum:=doc
            doc=>Open
        Else
            Error "Wrong File Type"
        End If
    }
    
}
Group ConcreteCreator {
Private:
    Function Final GetType$(filename$) {
        \\ supposed we read the magic number from file
        \\ but here we check the filename only
        filename$=lcase$(filename$)
        if filename$ ~ "*.html" Then
            ="html"
        Else.if filename$ ~ "*.odt" Then
            ="proprietary"
        Else.if filename$ ~ "*.pdt" Then
            ="pdf"
        End if    
    }
Public:
    Function Final CreateDocument(type$){
        if type$="html" Then
            =HtmlDocument()
        Else.if type$="proprietary" Then
            return new MyDocument()
        Else.if type$="pdf" Then
            =PdfDocument()
        Else
            Error "Not such type "+type$
        End if
    }    
}
Class SimpleText {
    Property dirty {value}=false
    Property text$ {Value}=""
    module placetext (aText$) {
        .[dirty] <= .[text]$<>aText$ or .[dirty]
        Swap .[text]$, aText$
    }
}
Class HtmlDocument as SimpleText as Document{
    module open {
    }
    module save (filename$) {
    }
    module close {
    }    
}
Class MyDocument as SimpleText as Document {
    module open {
    }
    module save (filename$) {
    }
    module close {
    }    
}
Class PdfDocument as SimpleText as Document {
    module open {
    }
    module save (filename$) {
    }
    module close {
    }    
}
MyApplication = Application() with ConcreteCreator
MyApplication.NewDocument "html"
DocId1=MyApplication()
MyApplication.NewDocument "pdf"
DocId2=MyApplication()
MyDocument1=if( DocId1<>0-> MyApplication.ExportPointer(DocId1), SimpleText())
MyDocument1=>placetext "html text"
Disp(MyDocument1)
MyDocument2=if( DocId2<>0-> MyApplication.ExportPointer(DocId2), SimpleText())
MyDocument2=>placetext "pdf text"
Disp(MyDocument2)

End
Sub Disp(Doc as *Simpletext)
    Print "Dirty: ";Doc=>dirty=True
    Print "Text : ";Doc=>Text$
End Sub

Τετάρτη, 8 Ιουλίου 2020

Singleton Pattern (OOP)

We can define a Singleton object and if we pass it as pointer to object or as a copy we get the same object (in logic). Copies of groups can be done using Group(aPointerOfGroup) or defined a new group using Group namedgroup=aPointerOfGroup.

1. We make a lambda function starting with a closure to the Null Group. First time we place the pointer of the Singleton group to M. So each time we get the same.
2. The group singleton convert to a closed group (nameless) and hold by the pointer M. Because state is a tuple, each time we copy the group we get the same copy of state (as pointer to tuple).
3. We can read the value of state evaluate the export value from Value member. If k is a pointer we need Eval(k) to execute the value member. If k is named group then k return the value (not the group). Using Group(k) always we get a copy of group (but we get a copy of state so we have the same state to every group).
4. The method module add, do one thing add x to every item in tuple this.state and here we have only one item. Every other group which have the same pointer to this.state (or .state) get the new value.
5. When the module CheckSingleton ends push a value to stack, the lambda variable (a lambda is both  a variable and a function) as a copy, and also here we get a copy of a pointer, the closuer M. At the return from call  we read lambda from stack as something, so we get also a function something(). 
6. We make a named group as M and a pointer to group z and demonstrate the use.

A singleton must be global, but here we can make copies, and work perfect
A singleton has one instance (although we have different instances when copy it as group, each one has same state, not only as value but using same pointer to tuple, so we can say that it is one instance by logic)

Module CheckSingleton {
    \\ singleton
    \\ pointers and static groups are the same object because
    \\ each one has a pointer to same state (a tuple)
    \\ but from outside we do the miracle to have a static group to act as a pointer
    \\ We need a lambda function to hold the pointe to Singleton as closure
    Global One=lambda M=pointer() (aValue=0)-> {
        If M is type null then
            \\ one time happen
            Group Singleton {
            Type:One
            Private:
                state=(aValue,)
            Public:            
                module Add (x) {
                    .state+=x
                }
                Set {Drop}
                Value {
                    =.state#val(0)
                }
            }
            M->group(Singleton)
        end if
        \\ return M which is a pointer
        =M
    }
    K=One(100)
    Print Eval(K)=100
    M=One()
    Print Eval(M)=100
    Print K is M = true
    Print K is type One = true
    K=>add 500
    Print eval(K)=600
    \\ copy K to Z (no pointer to Z, Z is named group)
    Z=Group(K)
    Print eval(z)=600, z=600
    Z.add 1000
    Print Z=1600, Eval(M)=1600, Eval(K)=1600
    \\ push a copy of Z, but state is pointer so we get a copy of a pointer
    Push Group(Z)
    Read beta
    Beta.add 1000
    Print Z=2600, Eval(M)=2600, Eval(K)=2600
    \\ convert pointer to group (a copy of group)
    group delta=One()
    delta.add 1000
    Print Z=3600, beta=3600, delta=3600, Eval(M)=3600, Eval(K)=3600
    \\ M and K are pointers to groups
    M=>add 400
    Print Z=4000, beta=4000, delta=4000, Eval(M)=4000, Eval(K)=4000
    class alfa {
        X=100
    }
    \\ we can't change named group Z becaues Z has a set member and drop the value;
    Z=alfa()
    Print valid(z.x)=false
    \\ but pointers can change to what group they point
    K->alfa()
    Print K is type alfa
    Print K=>X=100
    Push one
}
CheckSingleton
\\ peek the top from stack
global something=Stackitem()
\\ drop it
drop
\\ so now we have a global something and a global something()
group m=something()
Print m=4000
m.add 1000
Print m=5000
z=something()
z=>add 1000
Print Eval(z)=6000, m=6000


Αναθεώρηση 43, Έκδοση 9..9

Σε αυτήν την αναθεώρηση μπήκε στη NULL ομάδα και το όνομα τύπου Μηδενικός. Επίσης προστέθηκε λογική για το καθάρισμα επώνυμων ομάδων. Τώρα μετά το καθάρισμα μπορούμε να συγχωνεύουμε σωστά μια άλλη ομάδα.



Παράδειγμα με το Μηδενικός που σημαίνει Null. Η συνάρτηση Δείκτης() γυρίζει δείκτη Μηδενικό τύπου Μηδενικός (Null).

Μ->0&
Τύπωσε Μ είναι τύπος Μηδενικός=Αληθής
Τύπωσε Μ είναι τύπος Null=Αληθής

Ο Μ είναι δείκτης το Ομάδα(Μ) γυρίζει κενή ομάδα (όχι δείκτη) και δεν διατηρεί τον τύπο Null.

Στο παρακάτω παράδειγμα το Κ είναι δείκτης σε ομάδα, το Αλφα και το Βήτα είναι επώνυμες ομάδες (στατικές κατά μια έννοια, χωρίς δείκτη).

Κ=Δείκτης()
Ομάδα Αλφα {
      Τύπος: Κάτι
      Χ=10
}
Τύπωσε Κ είναι τύπος Μηδενικός=Αληθής
Τύπωσε Αλφα είναι τύπος Κάτι=Αληθής
Βήτα = Ομάδα(Κ)
Βήτα = Αλφα
Τύπωσε Βήτα είναι τύπος Κάτι=Αληθής
Τύπωσε Βήτα είναι τύπος Μηδενικός=Ψευδής

Κυριακή, 5 Ιουλίου 2020

An example of Scope Checking in M2000

This code is in a module A
We do this: Start M2000 Environment, Write Edit A and press Ente then rpaste the code press Esc write A press Enter. Just so simple. Write Save example1 so now you can do next time Load example1. Use New if you have another, or better write Start press enter to make a soft reset. Also you can clear variables only (and static variables) using Clear. You can empty the Stack of values using Flush.

Function Master {
    Module Alfa {
        Gosub 100
        Global M=1000
        \\ delta print 1000
        delta
        End
    100    Print Module(Beta)=False
        Print Module(Delta)=True
        Return
    }
    Group Object1 {
        Function Master {
            =M
        }
        Module Final Beta {
            \\ delta print 500
            delta
            alfa()
            Sub alfa()
                Local N=@Kappa(3)
                Global M=N
                \\ delta print 1500
                Delta
                Print This.Master()=1500
                N=@Kappa(6)
                \\ change value of M, not shadow M like Global M
                M<=N
                \\ delta print 9000
                Delta
                Print .Master()=9000
            End Sub
            Function Kappa(K)
                =M*K
            End Function
        }
    }
    Module Global Delta {
        Goto name1
        \\ a remark here
    
    name1:
        Print Module(Alfa)=False
        Print Module(Beta)=False
        Print Module(Delta)=True
        Print M
    }
    
    \\ This is the program
    K=100
    Global M=500
    Alfa
    Object1.Beta
    Print Object1.Master()=500
    Print K=100, M=500
}


Call Master()
\\ No variables exist after the return from Master()
Print Valid(M)=False

Revision 38, Version 9.9

The final revision

A bug removed from static variables code. This revision supposed the final one.
George Karras

Κυριακή, 28 Ιουνίου 2020

Revision 33, Version 9.9 Types for Groups

From this revision Groups may have types. A type can be used to restrict the parameter list to specific objects. Also in a method of object not only has in scope own privates members but also form those objects with the same type(s) (all types must be the same) which passed to method, private variables act as public.


In the following example there are two modules which have same output. One module use  named groups (a kind of static and passing by reference (see: &a as alfa ), and the other use pointers to groups and passing by pointer, (see: a as *alfa).

All classes make types automatic. Groups can be use types, or not. Merging a not typed group add functionality without changing the type.

module UsingNamedObjects {
    \\ private members used as public inside a method
    \\ for any object.
    class alfa {
    private:
        dim a()
    public:
        module changethis (&p as alfa) {
            \\ m is a pointer to array (mArray object)
            \\ p.a() not work outside an alfa type method
            m=p.a()
            \\ pointer to arrays have some operators
            m+=10
            Print type$(m)
        }
        module PrintMe {
            \\ we can use .a() or this.a()
            print this.a()
        }
        Remove {
            Print "alfa type object deleted"
        }
    class:
        module alfa (n) {
            \\ redim array
            dim .a(10)=n
        }
    }
    
    b=alfa(3)
    c=alfa(6)
    b.PrintMe
    c.PrintMe
    \\ So now we pass pointer c to b.changethis
    b.changethis &b
    b.changethis &c
    b.PrintMe
    c.PrintMe
    \\ only manual we can call the remove function for named objects
    Clear b, c
}
UsingNamedObjects

module UsingPointersToObjects {
    \\ private members used as public inside a method
    \\ for any object.
    class alfa {
    private:
        dim a()
    public:
        module changethis (p as *alfa) {
            \\ m is a pointer to array (mArray object)
            \\ p=>a() not work outside an alfa type method
            m=p=>a()
            \\ pointer to arrays have some operators
            m+=10
            Print type$(m)
        }
        module PrintMe {
            \\ we can use .a() or this.a()
            print this.a()
        }
        Remove {
            Print "alfa type object deleted"
        }
    class:
        module alfa (n) {
            \\ redim array
            dim .a(10)=n
        }
    }
    
    b->alfa(3)
    c->alfa(6)
    b=>PrintMe
    c=>PrintMe
    \\ So now we pass pointer c to b.changethis
    b=>changethis b
    b=>changethis c
    b=>PrintMe
    c=>PrintMe
    \\ now b and c erased
    \\ and because no other pointers hold the objects, destroyed.
    \\ so the remove function call automatic
}
UsingPointersToObjects

Bellow is another example with 3 different implementations for same output.


Report {
          Tree traversal
                   1
                  / \
                 /   \
                /     \
               2       3
              / \     /
             4   5   6
            /       / \
           7       8   9

}
Pen 15 {Report "Using types in class Node"}
Print
Module OOP {
      Class Node {
      private:
            \\ Pointer() of Pointer(0) is the Null type pointer
            x, LeftNode=Pointer(), RightNode=Pointer()
      Public:
            Module preorder (visitor){
                  T->This
                  printtree(T)
                  sub printtree(T)
                        If T is type Null Then Exit sub
                        call visitor(T=>x)
                        printtree(T=>LeftNode)
                        printtree(T=>RightNode)
                  end sub
            }
            Module inorder (visitor){
                  T->This
                  printtree(T)
                  sub printtree(T)
                        If T is type Null Then Exit sub
                        printtree(T=>LeftNode)
                        call visitor(T=>x)
                        printtree(T=>RightNode)
                  end sub
            }
            Module postorder (visitor) {
                  T->This
                  printtree(T)
                  sub printtree(T)
                        If T is type Null Then Exit sub
                        printtree(T=>LeftNode)
                        printtree(T=>RightNode)
                        call visitor(T=>x)
                  end sub
            }
            Module level_order (visitor){
                  M=stack:= Pointer(This)
                  \\ using M as FIFO
                  Stack M {
                        if empty then exit
                        Read T
                        if T is type Node Then
                              call visitor(T=>x)
                              Data T=>LeftNode, T=>RightNode
                        end if
                        Loop
                  }
            }
            remove {
                   print format$("node {0} destroyed", .x)
            }
      Class:
            Module Node {
                  Read .x, .LeftNode, .RightNode
            }
      }
      \\ Function NodeTree return a pointer to a new Node
      Function NodeTree {
            \\ ![] pass currrent stack to Node()
            ->Node(![])
      }
      \\ Tree is type Node

      Tree=NodeTree(1, NodeTree(2,NodeTree(4, NodeTree(7)), NodeTree(5)), NodeTree(3, NodeTree(6, NodeTree(8), NodeTree(9))))

      printnum=lambda (title$) -> {
            Print
            Print title$;
            =lambda (x)-> {
                  Print x;" ";
            }
      }
      Tree=>preorder printnum("preorder:    ")
      Tree=>inorder printnum("inorder:     ")
      Tree=>postorder printnum("postorder:   ")
      Tree=>level_order printnum("level-order: ")
      Print
      Print
}
OOP

Pen 15 {Report "Using types and  inheritance: a class Tree as a class Node, which returns a pointer to Tree object"}
Print

Module OOP {
      Class Node {
      private:
            \\ Pointer() of Pointer(0) is the Null type pointer
            x, LeftNode=Pointer(), RightNode=Pointer()
      Public:
            Module preorder (visitor){
                  T->This
                  printtree(T)
                  sub printtree(T)
                        If T is type Null Then Exit sub
                        call visitor(T=>x)
                        printtree(T=>LeftNode)
                        printtree(T=>RightNode)
                  end sub
            }
            Module inorder (visitor){
                  T->This
                  printtree(T)
                  sub printtree(T)
                        If T is type Null Then Exit sub
                        printtree(T=>LeftNode)
                        call visitor(T=>x)
                        printtree(T=>RightNode)
                  end sub
            }
            Module postorder (visitor) {
                  T->This
                  printtree(T)
                  sub printtree(T)
                        If T is type Null Then Exit sub
                        printtree(T=>LeftNode)
                        printtree(T=>RightNode)
                        call visitor(T=>x)
                  end sub
            }
            Module level_order (visitor){
                  M=stack:= Pointer(This)
                  \\ using M as FIFO
                  Stack M {
                        if empty then exit
                        Read T
                        if T is type Null Else
                              call visitor(T=>x)
                              Data T=>LeftNode, T=>RightNode
                        end if
                        Loop
                  }
            }
            remove {
                   print format$("node {0} destroyed", .x)
            }
      }
     Class Tree as Node {
            value (xval) {
                  .LeftNode<=Pointer()
                  .RightNode<=Pointer()
                  Read ? .LeftNode, .RightNode
                  .x<=xval
                  ->(This)
            }
    
      }
      \\ now NodeTree is a static group with value which generate other trees.
      \\ Tree is type Tree
      NodeTree=Tree()
      Tree=NodeTree(1, NodeTree(2,NodeTree(4, NodeTree(7)), NodeTree(5)), NodeTree(3, NodeTree(6, NodeTree(8), NodeTree(9))))

      printnum=lambda (title$) -> {
            Print
            Print title$;
            =lambda (x)-> {
                  Print x;" ";
            }
      }
      Tree=>preorder printnum("preorder:    ")
      Tree=>inorder printnum("inorder:     ")
      Tree=>postorder printnum("postorder:   ")
      Tree=>level_order printnum("level-order: ")
      Print
      Print
}
OOP

Pen 15 {Report "Using types and inner class Node in a class Tree which returns a pointer to Node object"}
Print


Module OOP {
      Class Tree {
      Private:
            Class Node {
            private:
                  \\ Pointer() of Pointer(0) is the Null type pointer
                  x, LeftNode=Pointer(), RightNode=Pointer()
            Public:
                  Module preorder (visitor){
                        T->This
                        printtree(T)
                        sub printtree(T)
                              If T is type Null Then Exit sub
                              call visitor(T=>x)
                              printtree(T=>LeftNode)
                              printtree(T=>RightNode)
                        end sub
                  }
                  Module inorder (visitor){
                        T->This
                        printtree(T)
                        sub printtree(T)
                              If T is type Null Then Exit sub
                              printtree(T=>LeftNode)
                              call visitor(T=>x)
                              printtree(T=>RightNode)
                        end sub
                  }
                  Module postorder (visitor) {
                        T->This
                        printtree(T)
                        sub printtree(T)
                              If T is type Null Then Exit sub
                              printtree(T=>LeftNode)
                              printtree(T=>RightNode)
                              call visitor(T=>x)
                        end sub
                  }
                  Module level_order (visitor){
                        M=stack:= Pointer(This)
                        \\ using M as FIFO
                        Stack M {
                              if empty then exit
                              Read T
                              if T is type Node Then
                                    call visitor(T=>x)
                                    Data T=>LeftNode, T=>RightNode
                              end if
                              Loop
                        }
                  }
            remove {
                   print format$("node {0} destroyed", .x)
            }
            Class:
                  Module Node {
                        Read .x, .LeftNode, .RightNode
                  }
            }
      public:
            value (xval as double) {
                  Rem {
                        LeftNode=Pointer()
                        RightNode=Pointer()
                        Read ? LeftNode, RightNode
                        ->.Node(xval,LeftNode, RightNode)
                  }
                  ->.Node(xval,![])
            }
    
      }
      \\ now NodeTree is a static group with a private Node class
      \\ return a pointer to a Node object
      \\ Tree is type Node
      NodeTree=Tree()
      Tree=NodeTree(1, NodeTree(2,NodeTree(4, NodeTree(7)), NodeTree(5)), NodeTree(3, NodeTree(6, NodeTree(8), NodeTree(9))))

      printnum=lambda (title$) -> {
            Print
            Print title$;
            =lambda (x)-> {
                  Print x;" ";
            }
      }
      Tree=>preorder printnum("preorder:    ")
      Tree=>inorder printnum("inorder:     ")
      Tree=>postorder printnum("postorder:   ")
      Tree=>level_order printnum("level-order: ")
      Print
      Print
}
OOP