Revision 6 Version 9.6

Many new things, plus some minor bug removed
1. Print is faster now.
2. While and For Next loop are faster now
3. New While End While, and Do Until (or Repeat Until) and Do Always (or Repeat Always), without { }
4. We can exit from these non block structures, restoring the return stack correctly. Also Continue and Exit works in new If End If
5. Color Syntax changed to show Case >Alfa, <Beta in Select Case.



 here is the library for json, with the new statements without blocks: (If End If, Do Until, While End While). Previous edition: http://georgekarras.blogspot.com/2017/06/11-88.html

New version for revision 19, version 9.6
In a module Lib1 we copy this

Class ParserClass {
      Private:
            Class bStream {
                  Private:
                  cnt, Buffer A
                  Public:
                  Value (&c) {Try { c=eval(.A, .cnt) : .cnt++:=true}}
                  Class:
                  Module final bStream (a$){
                        Buffer .A as Integer*Len(a$)
                        Return .A, 0:=a$
                  }
            }
            Func=Lambda->false
            char=0
            ' using obj as pointer to  Stack
            obj=Stack
            Function final IsId {
                  If .char=34 Then =.IsString(false)
            }
            Function final IsTrue {
                  ' U+0074 U+0072 U+0075 U+0065
                  If .char=0x74 Then If .func() Then If .char=0x72 Then If .func() Then If .char=0x75 Then If .func() Then If .char=0x65 Then PushIt() : =True
                  Sub PushIt()
                        Stack .obj {
                              Push .Boolean(True)
                        }
                  End Sub
            }
            Function final IsFalse {
                  ' U+0066 U+0061 U+006c U+0073 U+0065
                  If .char=0x66 Then If .func() Then If .char=0x61 Then If .func() Then If .char=0x6c Then If .func() Then If .char=0x73 Then If .func() Then If .char=0x65 Then PushIt() : =True
                  Sub PushIt()
                        Stack .obj {
                              Push .Boolean(False)
                        }
                  End Sub
            }
            Function final IsNull {
                  ' U+006E U+0075 U+006C U+006C
                  If .char=0x6e Then If .func() Then If .char=0x75 Then If .func() Then If .char=0x6c Then If .func() Then If .char=0x6c Then PushIt() : =True
                  Sub PushIt()
                        Stack .obj {
                              Push .Null()
                        }
                  End Sub
            }
            Function final IsSemiCol {
                    If .char=0x3a Then =true
            }
            Function final IsComma {
                    If .char=0x2c Then =true
            }
            Function final IsObject {
                  If .char=123 Else exit
                  inventory objinv
                 ' we push object with a pointer to objinv
                 Stack .obj { Push .Object(objinv)}
                 .Trim
                 While .IsId()
                       .Trim
                       If .IsSemiCol() Then
                             .Trim
                             If .IsValue() Then
                                   Stack .obj {
                                          Shift 2 ' move top as second
                                          ' letter$ is ok If top is string, and throw it
                                          Append objinv, Letter$:=Group
                                    }
                              End If
                       Else
                             Exit
                       End If
                       .Trim
                        If not .IsComma() Then exit
                       .Trim
                  End While
                  If .char=125 Then =true Else .obj<=Stack : .func<=lambda->0
            }
            Function final IsValue {
                  If .IsString(True) Then
                         =True
                  Else.if .IsNumber() Then
                        =True
                  Else.if .IsTrue() Then
                        =True
                  Else.if .IsFalse() Then
                        =True
                  Else.if .IsNull() Then
                        =True
                  Else.if .IsArray() Then
                        =True
                  Else.if .IsObject() Then
                        =True
                  Else
                        ? "what", .char
                        Stack .obj { Stack}
                        .func<=lambda->0
                  End If
            }
            Function final Digits (private_stack){
                  While .func()
                        Select Case .char
                        Case 48 to 57
                        {
                              =true
                             Stack private_stack { Data .char}
                        }
                        Else Case
                             break
                        End Select
                  End While
            }
            Function final IsNumber {
                  a=Stack
                  Select Case .char
                  Case 45 ' -
                  {
                              oldfunc=.func
                              Stack a { Data .char}
                              If .Func() Then
                                    Select Case .char
                                    Case 48
                                    {
                                            Stack a { Data .char}
                                            If .func() Then
                                                If .char=46 Then
                                                      Fraction()
                                                      Exponent()
                                                End If
                                          End If
                                    }
                                    Case 49 to 57
                                    {
                                          Stack a { Data .char}
                                          If .Digits(a) Then {}
                                          Fraction()
                                          Exponent()
                                    }
                                    Else Case
                                          a=stack
                                    End Select
                              End If
                  }
                  Case 48 ' 0
                  {
                        oldfunc=.func
                        Stack a { Data .char}
                        If .func() Then
                            If .char=46 Then
                                  Fraction()
                                  Exponent()
                            End If
                      End If
                  }
                  Case 49 to 57
                  {
                              oldfunc=.func
                              Stack a { Data .char}
                              If .Digits(a) Then {}
                              Fraction()
                              Exponent()
                  }
                  End Select
                 
                  If len(a)>0 Then {
                        b=each(a)
                        Document D$
                        While b
                              D$=chrcode$(StackItem(b))
                        End While
                        .func<=oldfunc
                        If len(D$)>1 Then For i=2 to len(D$) { .Trim}
                        Stack .obj { Push .Numeric(D$) }
                        =True
                  }
                  '  here is an auto exit from function. Sub as command is an exit
                  Sub Fraction()
                        If .char=46 Then Stack a { Data .char}
                        If .Digits(a) Then { }
                  End Sub
                  Sub Exponent()
                        If .char=101 or .char=61 Then
                              Stack a { Data .char}
                              If .func() Then
                                    If .char=43 or .char=45 Then
                                          Stack a { Data .char }
                                          If .Digits(a) Else
                                                a=Stack ' cleat by point to new Stack
                                          End if
                                    Else.if .char>47 and .char<58 Then
                                          Stack a { Data .char}
                                          If .Digits(a) Then {}
                                    Else
                                           a=Stack
                                    End If
                              End If
                        End If
                  End Sub
            }
            Function final IsString (as_object){
            If .char=34 Else exit
                  Document D$
                  While .func()
                        If .char=34 Then 2000
                        If .char=92 Then
                              ' special care
                              If .func() Then
                                    Select Case .Char
                                    Case 117 'u
                                    GetHex()
                                    Case 114 ' r
                                    .char<=0x0d
                                    Case 110 ' n
                                    .char<=0x0a
                                    Case 116 ' t
                                    .char<=0x09
                                    Case 98 ' b
                                    .char<=0x08
                                    Case 102 ' f
                                    .char<=0x0c
                                    Case 0x22, 0x2f , 0x5c
                                    Else
                                    Exit ' not normal
                                    End Select
                              End If
                        End If
                        D$=chrcode$(.char)
                  End While
                  Exit
      2000 Stack .obj {
                        If as_object Then Push .JString$(D$) Else Push D$
                  } : =True
                  Sub GetHex()
                        Local D$
                        Document D$="0x"
                        For i=1 to 4
                              If .func() Then End If
                                    If Chrcode(.char) ~ "[0123456789ABCDEFabcdef]"  Then
                                          D$=Chrcode(.char)
                                    Else
                                          Goto 3000
                                   End If
                              End If
                        Next I
                        If i<>5 Then 3000
                        .Char=Eval(D$)
      3000 End Sub
            }
            Function final IsArray {
               
                  If .char=91 Else exit
                  Dim Gr()
                  ' We place a pointer ro Array
                  .Trim
                  If .char=93 Then =true : Stack .obj { Push .Arr(Gr())} : exit
                        While .IsValue()
                              Stack .obj {
                                    Dim Gr(Len(Gr())+1)
                                    Gr(len(Gr())-1)=Group
                              }
                              .Trim
                              If not .IsComma() Then exit
                              .Trim
                        End While
                  ' Push later pointer to array (maybe altered in redimension)
                  If .char=93 Then =true : Stack .obj { Push .Arr(Gr())} Else .Func<=lambda->false
            }
            Module final Trim {
                  While .func()
                         If .char<33 or .char=160 Else exit
                  End While
            }
            Function final IsContainer {
                 .Trim
                 Select Case chrcode$(.char)
                 Case "{"
                        =.IsObject()
                 Case "["
                        =.IsArray()
                 end select
            }
      ' merge a foreign group here
            Module final ReadArrayItem (temp, object){
                   Select Case temp.type$
                        Case "String","Boolean","Number", "Null"
                        {
                              If object Then Error "No object "+quote$(temp.type$)
                              Push temp.str$
                        }
                        Case "Object"
                        {
                              If not Empty Then
                                 Call .ReadObject temp, object, letter$
                              Else
                                    If object Then Push Temp : exit
                                    Push .ser$(group(temp),0)
                              End If
                        }
                        Case "Array"
                        {
                              If not Empty Then
                                    ' recursion only with Call statement for modules
                                    Call .ReadArrayItem, Array(temp, number), object
                              Else
                                    If object Then Push Temp : exit
                                    Push .ser$(group(temp),0)
                              End If
                        }
                        End Select
            }
            Module final ReadObject (json, object){
                  If type$(json)="Inventory" Then
                        If exist(json, Letter$) Then
                              temp=eval(json)
                        Else
                             push "none"
                             Break ' exit Module final  (Break do something Else in Select End Select)
                        End If
                  Else
                        temp=json
                  End If
                        Select Case temp.type$
                        Case "String","Boolean","Number", "Null"
                        {
                              If object Then Error "No object "+quote$(temp.type$)
                              Push temp.str$
                        }
                        Case "Object"
                        {
                              If not Empty Then
                                    Call .ReadObject temp, object ', letter$
                              Else
                                    If object Then Push Temp : exit
                                    Push .ser$(group(temp),0)
                              End If
                        }
                        Case "Array"
                        {
                              If not Empty Then
                                    Call .ReadArrayItem array(temp, number), object
                              Else
                                    If object Then Push Temp : exit
                                    Push .ser$(group(temp),0)
                              End If
                        }
                        End Select
            }
            Module final Worker (object){
                         If match("IN") Or match("IS") Then ' inventory & number or inventory and string
                         '    maybe we have more items in Stack
                               Push object : ShiftBack 2
                              .ReadObject
                         Else
                              read Temp ' get  a group which returns Iventoty or an mArray
                              If Type$(Temp)="mArray" Then
                                    If not Empty Then
                                          Call .ReadArrayItem, Array(Temp, number), object
                                    Else
                                          If object Then Push Temp : exit
                                          Push .ser$(Temp,0)
                                    End If
                              Else
                                    If not Empty Then
                                                Call .ReadObject Temp, object
                                    Else
                                          If not Empty Then
                                                Call .ReadObject Temp, object
                                          Else
                                                If object Then Push Temp : exit
                                                If Type$(Temp)="Inventory" Then
                                                      Push .ser$(.Object(Temp),0)
                                                Else
                                                      Push .ser$(group(Temp),0)
                                                End If
                                          End if
                                   End If
                              End If
                        End If
            }
      Public:
      \\ This is the Public part
      \\ First we set Public some class for later use
      \\ Using Pointer to Array in Class Arr
            Class Arr {
            Private:
                  MyValue
            Public:
                  Property Type$ {Value} ="Array"
                  Value {
                        =.MyValue
                  }
            Class:
                  Module final Arr (.MyValue) {}
            }
            Class Null {
                 Property Type$ {Value} ="Null"
                 Property Str$ {Value}="null"
                 Value { =0}
            }
            Class JString$ {
            Private:
                  MyValue$=""
            Public:
                  Property Type$ {Value} ="String"
                  Property Str$ {
                        Value{
                              Link parent MyValue$ to MyValue$
                              value$=quote$(string$(MyValue$ as json))
                        }
                  }
                  Value {
                        =.MyValue$
                  }
            Class:
                  Module final JString (.MyValue$) {}
            }
            Class Numeric {
            Private:
                  MyValue$=""
            Public:
                  Property Type$ {Value} ="Number"
                  Property Str$ {
                        Value{
                              Link parent MyValue$ to MyValue$
                              value$=MyValue$
                        }
                  }
                  Value {
                        =Val(.MyValue$)
                  }
            Class:
                  Module final Numeric {
                  If match("S") Then
                        Read .MyValue$
                  Else
                        value$=trim$(str$(Number))
                        ' M2000 return -.3 for -0.35
                        ' using ? str$(MyValue, "0.#############")
                        ' we get locale decimal char - maybe is comma
                        ' so using str$(MyValue) we get integer or float with char "." for decimal always
                        ' so we have to add 0
                        If left$(value$, 1)="." Then
                              value$="0"+value$
                        Else
                               If value$ ~ "-.*" Then value$=replace$("-.","-0.", value$)
                         End If
                        .Myvalue$<=value$
                  End If
                  }
            }
            Class Boolean {
            Private:
                  MyValue=false
            Public:
                  Property Type$ {Value} ="Boolean"
                  Property Str$ {
                        Value{
                              Link parent MyValue to MyValue
                              If MyValue Then {
                                    value$="true"
                              } Else value$="false"
                        }
                  }
                  Value {
                        =.MyValue
                  }
            Class:
                  Module final Boolean (.MyValue) {}
            }
            Class Object {
            Private:
                  Inventory MyValue
            Public:
                  Property Type$ {Value} ="Object"
                  Value {
                        =.MyValue
                  }
            Class:
                  Module final Object (.MyValue) {}
            }
      \\ Empty group, with $, so we get two vars, Ser and Ser$ ( Ser$ we want to return a value type String)
            Group Ser$
            Module final SetSpace (.ser.space) { ' set space for values - 6 by default
            }
            Function final UseDecimalPoint$ {
                  ' use this to change standard decimal point to local decimal point character
                  =str$(val(letter$),"")
            }
            Function final ReadNumber$ {
                        .Worker false 'modules get caller Stack
                        =.UseDecimalPoint$( Letter$)
            }           
            Function final ReadAnyString$ {
                        \\ read an inventory
                        .Worker false
                        =Letter$
            }
            Function final ReadAny {
                        \\ read an inventory
                        .Worker true
                        Read A
                        =A
            }
            Function final Eval {
                  ' Letter$  pop a string ftom Stack Else give error
                   .func<=Lambda z=.bStream(Letter$) -> {
                         link .char to c
                         ' we can't pass reference in a private member
                         =z(&c)
                   }
                  ' In this Parser we use a dedicated Stack
                  ' for use from recuirsive memberts
                  ' .obj is a pointer to Stack
                  ' we can delete it simply setting a new Stack
                  ' .obj<=Stack
                  ' or we can flush all elements Using a command Flush
                  ' .obj,  char and .func() are visible from group members
                  ' test
                  Stack .obj { Flush}
                  .char<=0
                  If .IsContainer() Then
                        ' we get the pointer
                        =StackItem(.obj)
                        .obj<=Stack
                  Else
                        ' return an Empty object
                        inventory emptinv
                        =.Object(emptinv)
                  End If
            }
            Group StringValue$ {
                  Add=false
                  Del=false
                  ' from revision 12 we can place temp in parameter block
                  Set (temp) {
                        ' always first read is for the assigned value to Group
                        Read temp1
                        If type$(temp)<>"Group" Then error "Need a group"
                        If not valid(temp.type$="") Then error "not a proper group"
                        If not valid(temp1.type$="") Then error "not a proper group for value"
                        ' because Null() is out of this scope we have to link
                        Link parent Null() to MyNull()
                        Null=MyNull()
                        ' or we can hard code the Null object
'                        Group Null {
'                                  Property Type$ {Value} ="Null"
'                                  Property Str$ {Value}="null"
'                                  Value { =0}
'                       }
                        Dim Base 1, A(1)
                        \\ now we get the second interface for arrays
                        \\ bb() has a reference to b (one reference allowed)
                        \\ but b is pointer to array and can change to point to other arrrays
                        \\ we need ths to perform some tasks which belong to standard arrray interface
                        b=(,) : Link b to bb()
                        A(1)=Group(temp)
                        Do
                              again=false
                              Select Case A(1).type$
                              Case "Array"
                              {
                                    If match("N") Then
                                          Read where
                                          If len(A(1))<=where and Empty Then
                                          ' only the last array we can redimension
                                                If .add and not .del Then
                                                      cursize=Len(A(1))
                                                      b=A(1) ' A(1) has a pointer so now b has the same pointer
                                                      ' dim preserve values
                                                      Dim bb(where+1) ' need one more because all "automatic arrays" have base 0
                                                      Stock bb(cursize) sweep Len(b)-cursize, Group(Null)
                                                Else
                                                      Error "Index out of limits"+str$(where)
                                                End If
                                          Else
                                                If where<0 Then Error "Index out of limits "+str$(where)
                                          End If
                                          If Empty Then
                                                If .del Then
                                                      cursize=Len(A(1))
                                                      b=A(1) ' A(1) has a pointer so now b has the same pointer
                                                      If where<cursize-1 Then
                                                            Stock bb(where+1) Keep cursize-where, bb(where)
                                                      End If
                                                      Dim bb(cursize-1) ' bb(0) is an empty array
                                                Else
                                                      Return A(1), where:=Group(temp1)
                                                End If
                                          Else
                                                A(1)=Array(A(1),where)
                                                again=True
                                          End If
                                    Else
                                          Error "No Index Found"
                                    End If
                              }
                              Case "Object"
                              {
                                    If match("S") Then
                                          Read k$
                                          If Exist(A(1), k$) Then
                                                If Empty Then
                                                      If .del Then
                                                           Delete A(1) , k$
                                                      Else
                                                            Return A(1), k$:=Group(temp1)
                                                      End If
                                                Else
                                                      A(1)=Eval(A(1)) ' Eval(inventory_pointer) return  object pointer
                                                      again=True
                                                End If
                                        Else.if .add and not .del Then
                                                 If Empty Then
                                                            Append A(1), k$:=Group(temp1)
                                                Else
                                                      Error "No such Tag "+k$
                                                End If
                                         Else
                                               Error "No such Tag "+k$
                                         End If
                                    Else
                                          Error "No Tag Found"
                                    End If
                              }
                              End Select
                         until not again
                  }
                  Value (temp) {
                        If type$(temp)<>"Group" Then error "Need a group"
                        If not valid(temp.type$="") Then error "not a proper group"
                        Dim Base 1, A(1)
                        A(1)=Group(temp)
                        Do
                              again=false
                              Select Case A(1).type$
                              Case "String", "Number", "Null", "Boolean"
                                    Exit
                              Case "Array"
                              {
                                    If match("N") Then
                                          A(1)=Array(A(1), Number)
                                    Else
                                          Error "No Index Found"
                                    End If
                                    again=True
                              }
                              Case "Object"
                              {
                                    If match("S") Then
                                          If Exist(A(1), Letter$) Then
                                                A(1)=Eval(A(1)) ' Eval(inventory_pointer) return  object pointer
                                          Else
                                                Error "No such Tag"
                                          End If
                                    Else
                                          Error "No Tag Found"
                                     End If
                                    again=True
                              }
                              End Select
                        until not again
                         =A(1).str$
                  }
            }
      Class:
      \ one time definitions
            Class CreatSerialize$ {
            Private:
                  usen=0
                  n=0
                  nl1$={
                  }
                  Function final Jarray$ (json1, n){
                        \\ json1 is group type Array
                                 A=json1
                              \\ A is mArray (pointer to Array)
                              nl$=.nl1$
                              If .usen>0 Then
                                    nl$=nl$+string$(" ", n+.space)
                              End If
                              document a$
                              a$="["
                              If Len(A)>0 Then
                                    If .usen>0 Then a$=nl$
                                     k=each(A)
                                     M=len(A)-1
                                     while k
                                          For This {
                                                \\ temporary group
                                                Temp=array(k)
                                                select Case temp.type$
                                                Case "Number", "Null","Boolean", "String"
                                                a$=temp.str$
                                                Case "Array"
                                                {
                                                      nn=0
                                                      If .usen>0 Then
                                                            nn=n +.space
                                                      End If
                                                      a$=.Jarray$(Temp, nn, "")
                                                }
                                                Case "Object"
                                                {
                                                     nn=0
                                                      If .usen>0 Then
                                                            nn=n +.space
                                                      End If
                                                      a$=.Jobject$(Temp, nn,"")
                                                }
                                                Else Case
                                                      a$=" "+temp.type$
                                                end select
                                                 If k^<M Then
                                                     a$=", "
                                                      If .usen>0 Then a$=nl$
                                                Else
                                                      If .usen>0 Then a$=.nl1$
                                                End If
                                          }
                                    End While
                               Else
                                     If .usen>0 Then a$=.nl1$
                               End If
                               If .usen>0 Then a$=string$(" ", n)
                        a$="]"
                           =a$+letter$
                  }
                  Function final Jobject$ (json1, n){
                                    json=json1
                                    \\ json has to be an object inventory
                                    nl$=.nl1$
                                    If .usen>0 Then
                                          nl$=nl$+string$(" ", n+.space)
                                    End If
                                    document a$
                                    a$="{"
                                    If .usen>0 Then a$=nl$
                                     k=each(json)
                                     M=len(json)-1
                                     while k
                                          a$=quote$(eval$(json, k^)) +" : "
                                          select Case json(k^!).type$
                                          Case "Array"
                                          {
                                                nn=0
                                                If .usen>0 Then
                                                      nn=n +.space
                                                End If
                                                a$=.Jarray$(eval(k), nn, "")
                                          }
                                          Case "Boolean", "Null", "Number", "String"
                                                a$=json(k^!).str$
                                          Case "Object"
                                          {
                                                nn=0
                                                If .usen>0 Then
                                                      nn=n +.space
                                                End If
                                                a$=.Jobject$(eval(k), nn, "")
                                          }
                                          Else Case
                                                a$=" "+json( k^!).type$
                                          end select
                                          If k^<M Then
                                               a$=", "
                                                If .usen>0 Then a$=nl$
                                          Else
                                                If .usen>0 Then a$=.nl1$
                                          End If
                                    End While
                               If .usen>0 Then a$=string$(" ", n)
                              a$="}"
                              =a$+letter$
                  }
                  Class Object {
                  Private:
                        Inventory MyValue
                  Public:
                        Property Type$ {Value} ="Object"
                        Value {
                              =.MyValue
                        }
                  Class:
                        Module final Object (.MyValue) {}
                  }
            Public:
                  space=10
                  Value (json, n) {
                              a$=.nl1$
                              b$=""
                              .usen<=n
                              n--
                              If n<=0 Then a$="" : n=0 Else b$=string$(" ", n)
                              If type$(json)<>"Group" Then
                                    If type$(json)="Inventory" Then
                                          =b$+.Jobject$(.Object(json),n, a$)
                                    Else.if type$(json)="mArray" Then
                                          =b$+.Jarray$(json, n, a$)
                                    End If
                              Else
                                    If json.type$="Object" Then
                                          =b$+.Jobject$(json, n,a$)
                                    Else.if json.type$="Array" Then
                                          =b$+.Jarray$(json, n, a$)
                                    End If
                              End If
                  }
            }
            Module final ParserClass {
                  \ constructor
                  \ Let work as Push .CreatSerialize$() : Read .Ser
                  \ So now Group Ser loaded from CreatSerialize$()
                  \ Class CreatSerialize$ is a Function final, and because it is after Class:
                  \ Deleted before ParserClass return Group
                  Let .Ser=.CreatSerialize$()
            }
      }

Αναθεώρηση 5 Έκδοση 9.6

Οι προηγούμενες τρεις αναθεωρήσεις (2,3,4) είχαν θέματα, τα οποία λύθηκαν στην 5. Επιπλέον έγινε έλεγχος συμβατότητας και η τελευταία αναθεώρηση πέρασε επιτυχώς.

Προστέθηκε μια συνάρτηση η Δείκτης() ή Pointer() που επιστρέφει δείκτη σε ομάδα. Παλαιότερα μπορούσε μόνο να γίνει με ανάθεση με τον χειριστή -> και τώρα με την συνάρτηση μπορεί να γίνει απευθείας σε κλήση χωρίς μεσολάβηση μεταβλητής τύπου δείκτη. Ενημερώθηκε και η βοήθεια.



Δείκτες για ομάδες (αντικείμενα της Μ2000)
δ=δείκτης(όνομα_ομάδας)   ' δείκτης σε επώνυμη ομάδα (η ομάδα ζει όσο το τμήμα ή η συνάρτηση που τη δημιούργησε)
δ=δείκτης((όνομα_ομάδας))  ' αντίγραφο της ομάδας ως ανώνυμη ομάδα
δ=δείκτης(πίνακαςΑ(1,2)) ' δείκτης σε ομάδα σε πίνακα (ανώνυμη ομάδα)

\\ οι επώνυμε ομάδες έχουν ένα όνομα μεταβλητής και υπάρχουν μέσα στο μέρος που δημιουργήθηκαν, στο τμήμα ή τη συνάρτηση για όσο ο "δημιουργός" είναι ακόμη σε εκτέλεση. Αν πάρουμε δείκτη από επώνυμη ομάδα, και τον επιστρέψουμε από το τμήμα που τερμάτισε και διέγραψε την ομάδα, θα βγει λάθος αν προσπαθήσουμε να το χρησιμοποιήσουμε.
\\ οι ανώνυμες ομάδες ζουν ή με δείκτες ή σε αποθηκευτικά μέσα όπως σωροί, καταστάσεις και πίνακες. Οι ομάδες αυτές είναι μεταφερόμενος, ή μέσω δείκτη ή μέσω των αντικείμένων (αποθηκευτικών μέσω). Τα μέσα αυτά έχουν πάντα δείκτη. Δηλαδή το όνομα μεταβλητής τους είναι δείκτης.
Οι δείκτες ξεχωρίζουν από τις αναφορές επειδή μπορούν να αλλάξουν αυτό που δείχνουν. Αν περάσουμε ένα δείκτη με αναφορά τότε μπορούμε να τον αλλάξουμε και θα αλλάξει και πιο πίσω (από εκεί που τον περάσαμε), ενώ αν τον περάσουμε με τιμή, θα έχουμε έναν δεύτερο δείκτη με ίδια λειτουργία, αλλά αν αλλάξουμε αντικείμενο δεν θα αλλαχθεί πιο πίσω.


\\ Παράδειγμα
Κλάση Άλφα {
      χ=10
}
\\ το δ είναι δείκτης σε ομάδα (αντικείμενο)
\\ τώρα δείχνει ένα ανώνυμο αντικείμενο.
\\ Τα ανώνυμα αντικείμενα "πεθαίνουν" όταν ο τελευταίος δείκτης χαθεί
\\ now point to a unnamed group. The unnamed group lives untii no pointers point to it.
δ=Δείκτης(Άλφα())
\\ Αυτό είναι το ίδιο με αυτό  δ->Άλφα()
Τύπωσε δ=>χ

ζ=Άλφα()
\\ now point to a named group (we can't use the pointer if ζ erased, επειδή has a reference only)
\\ τώρα ο δείκτης δείχνει σε ένα επώνυμο αντικείμενο τύπου ομάδα. Το άλλο που έδειχνε έσβησε
\\ Τα επώνυμα αντικείμενα "πεθαίνουν" όταν τερματίσει το τμήμα ή η συνάρτηση που τα δημιούργησε.
\\ ο δείκτης θα έχει ισχύ όσο το επώνυμο αντικείμενο υπάρχει, ή εφόσον του δώσουμε άλλο αντικείμενο
δ=Δείκτης(ζ)
\\ Αυτό είναι το ίδιο με αυτό  δ->ζ
Τύπωσε δ=>χ
δ=>χ+=10
Τύπωσε ζ.χ=δ=>χ ' επειδή ζ.χ  είναι το ίδιο με το δ=>χ
δ=Δείκτης((ζ)) ' look the ( ), we get a copy of ζ as unnamed group.
\\ Αυτό είναι το ίδιο με αυτό   δ->(ζ)
Τύπωσε δ=>χ
δ=>χ+=10
Τύπωσε ζ.χ<>δ=>χ ' επειδή ζ.χ δεν είναι το ίδιο με το δ=>χ
Λίστα  ' Δείχνει όλες τις μεταβλητές (εκτός από τις ιδιωτικές των ομάδων, και απ΄ ότι περιέχουν οι δείκτες)

Με αγγλικές εντολές:

\\Example
class alfa {
      x=10
}
\\ p is a pointer to group
\\ now point to a unnamed group. The unnamed group lives untii no pointers point to it.
p=pointer(alfa())
\\ this is the same as p->alfa()
Print p=>x

z=alfa()
\\ now point to a named group (we can't use the pointer if z erased, because has a reference only)
p=pointer(z)
\\ this is the same as p->z
Print p=>x
p=>x+=10
Print z.x=p=>x ' because z.x is the same as p=>x
p=pointer((z)) ' look the ( ), we get a copy of z as unnamed group.
\\ this is the same as  p->(z)
Print p=>x
p=>x+=10
Print z.x<>p=>x ' because z.x is not the same as p=>x
list  ' show all variables





 

revision 3 Version 9.6

Some bugs fixed. This is a release for M2000 Interpreter. Later this week I hope to finish the new manual for Interpreter.

Αναθεώρηση 1 Έκδοση 9.6

1. Διορθώθηκε ένα λάθος που έγινε στην 9.6 στο αντικείμενο Γεγονός. Τώρα δουλεύει κανονικά.
2. Εμπλουτίστηκαν τα αντικείμενα τύπου Ομάδα, για τα γενικά (global) αντικείμενα. Επιπλέον αν κάπου τοπικά συγχωνεύσουμε μια άλλη ομάδα στην γενική, αυτή η συγχώνευση θα μείνει τοπικά, η γενική ομάδα δεν θα πάρει περισσότερα μέλη, αλλά θα αλλάξει μόνο όσα μέλη βρέθηκαν κοινά με την ομάδα που συγχωνεύτηκε.
3. Φτιάχτηκε το Δες { } ή Try {} ώστε αν το λάθος γίνει μέσα σε δομή που χρησιμοποιεί μια στοίβα επιστροφής όπως οι ρουτίνες με παρενθέσεις Ρουτίνα Τέλος Ρουτίνας (Sub End Sub), οι απλές ρουτίνες με όνομα  Διαμέσου Επιστροφή (Gosub Return), Για  Επόμενο (For Next), καθώς και η νέα Αν Τέλος Αν (χωρίς μπλοκ κώδικα {}).  Στην ουσία πριν εκτελεστεί το μπλοκ της Δες έχει περάσει στη στοίβα μια δική του σειρά με ένα αναγνωριστικό αριθμό, και αν στην εκτέλεση εντός βγει λάθος τότε ο διερμηνευτής την χρησιμοποιεί αδειάζοντάς την μέχρι να βρει τη δική του σειρά και έτσι κάνει αποκατάσταση. Τα τμήματα/Συναρτήσεις επειδή καλούνται με εσωτερικές συναρτήσεις, χρησιμοποιείται η στοίβα επιστροφής του διερμηνευτή, και εδώ αν γίνει λάθος έχουμε άμεση επιστροφή από την εσωτερική συνάρτηση με αναφορά σφάλματος, δηλαδή ο αρχικός σχεδιασμός ήταν πιο απλός και εύκολος. Απλά οι νέες δομές επειδή δεν καλούν την περιορισμένη στοίβα του διερμηνευτή, και επειδή κάνουν χρήση μεταβλητών που υπάρχουν ήδη σε αυτές τις εσωτερικές συναρτήσεις για τμήματα και συναρτήσεις της Μ2000, καταναλώνουν λιγότερη μνήμη. Επειδή η στοίβα για αυτές έχει την δυνατότητα να χρησιμοποιεί όλη την μνήμη, έχουμε επιπλέον το κέρδος για μεγάλο βάθος αναδρομής στις ρουτίνες. Η εντολή Όριο.Αναδρομής αρχικά είναι ρυθμισμένη στο 10000, αλλά μπορούμε άνετα να το βάλουμε στο ένα εκατομμύριο. Σημαίνει ότι θα κάνει μέχρι το ένα εκατομμύριο διαδοχικές κλήσεις είτε με μια ρουτίνα ή με ομάδες ρουτινών (η μία καλεί την άλλη και η τελευταία την πρώτη, και όλες έχουν ένα τρόπο να μην καλέσουν και να επιστρέψουν)

Στο παράδειγμα έχουμε μια γενική ομάδα, την άλφα με ένα μέλος το χ. Μετά έχουμε μια δομή Αν Τέλος Αν. Δεν μας ενδιαφέρει η συνθήκη απλά θέλουμε να εκτελεστεί κώδικας, οπότε το Αληθές είναι αρκετό. Μετά έχουμε την Δες {} χωρίς παράμετρο, οπότε θα συνεχίσει οπωσδήποτε ακόμα και αν βρεθεί λάθος. στο πρώτο καλούμε την ρουτίνα m(). Όλες οι ρουτίνες καθαρίζουν ότι νέο κάνουν πριν την επιστροφή, εκτός από αυτά που εκχωρούν σε υπάρχουσες μεταβλητές ή σε αυτά που βάζουν στο κοινό σωρό τιμών (και τα οποία δίνουν την δυνατότητα στις ρουτίνες να εξάγουν αποτελέσματα). Μπορούμε να χρησιμοποιούμε παραμέτρους με αναφορά με χρήση του & πριν το όνομα). Η m() καλεί την k() (θα μπορούσε να την καλέσει με Gosub k(), απλά είναι προαιρετικό, αλλά επιβάλλεται αν υπάρχει ήδη πίνακας με το ίδιο όνομα - ο διερμηνευτής δίνει προτεραιότητα στους πίνακες). Εκεί στην k() φτιάχνουμε μια ομάδα και την συγχωνεύουμε  με την γενικά άλφα με χρήση του τελεστή <= (αν είχαμε χρησιμοποιήσει το = απλά θα φτιάχναμε μια τοπική για την ρουτίνα). Οι τοπικές των ρουτινών είναι θεατές και από τις άλλες ρουτίνες όταν τις καλούμε, οπότε επειδή και εκεί φτιάχνουμε τοπικές, τελικά οι προηγούμενες σκιάζονται πρόσκαιρα, μέχρι να τερματίσουν οι ρουτίνες που τις σκίασαν (πάντα σε επίπεδο τμήματος). Με τα άλλα τμήματα δεν υπάρχει ίδιος σκοπός ή θέαση μεταβλητών. Έχουμε βάλει μια Για Επόμενο (For Next) και  εκεί έχουμε βάλει την Λάθος ή Error για να παράγει  λάθος. Ο διερμηνευτής άμεσα θα γυρίσει στην Δες αλλά η στοίβα επιστροφής θα έχει αφεθεί στην μοίρα της. Θα έχει την επιστροφή του Για, την επιστροφή της δεύτερης στη κλήση ρουτίνας και της πρώτης καθώς και το κομμάτι του Δες. Αυτό συμβαίνει γιατί όταν βγαίνει λάθος τερματίζει η εσωτερική συνάρτηση, και είναι αυτή που τρέχει το μπλοκ της Δες. Αν δεν υπήρχε αυτό θα έβγαινε λάθος επειδή τα Τέλος Αν τα μετράει το τμήμα (για να δείξει ότι λείπει ή ότι έχει μπει επιπλέον), και φυσικά αν το Δες βρίσκονταν σε ρουτίνα θα υπήρχε επίσης πρόβλημα από τη γεμάτη στοίβα επιστροφής.

Το δεύτερο Δες χρησιμοποιεί τις απλές ρουτίνες τύπου BASIC. Αυτές εκτελούν απλά κώδικα και επιστρέφουν χωρίς να σβήσουν κάτι. Εκεί έχω αλλάξει την Για Επόμενο με μια ακόμα Αν Τέλος Αν. Το λάθος βγαίνει μέσα σε αυτή τη δομή και επιστρέφουμε στο τερματισμό του μπλοκ της Δες και επίσης καθαρίζεται η στοίβα επιστροφή.


global group alfa {
      x=10
}
If true then
      try {
       gosub m()
      }
      Try {
            gosub alfa1
      }
      end if
m=alfa
list
End
sub m()
      k()
end sub
sub k()
      group z {
            y=20
      }
      alfa<=z
      for i=1 to 3
              error "10"
      next i
end sub

alfa1:
      group z {
            y=20
      }
      alfa<=z
      Print alfa.y
      if true then
      error "10"
      end if
Return

Έκδοση 9.6

Συνέχισα την εργασία πάνω στην δομή Αν.
Μπήκε η δομή με την Τέλος Αν χωρίς μπλοκ. Με το παλιό σύστημα (και πιο γρήγορο) μπορεί κανείς να κάνει άλματα με την ΠΡΟΣ (GOTO), αλλά μέσα από τα μπλοκ {} δεν μπορεί να δώσει εντολές όπως Συνέχισε ή Έξοδος. Βέβαια υπήρχαν εκδοχές της Αν χωρίς μπλοκ, με εντολές σε μια γραμμή. Απλά τώρα μπήκε κάτι πιο νέο (θυμίζει περισσότερο την BASIC). Όλες οι δομές λειτουργούν μαζί. (ουσιαστικά ο διερμηνευτής αποφασίζει πιο Αν είναι άμεσα, γιατί ο ίδιος κώδικας εκτελεί όλες τις παραλλαγές). Όταν χρησιμοποιούμε την Αν συνθήκη Τότε ή Αν συνθήκη Αλλιώς χωρίς να έχουμε κάτι μετά (εκτός από σημειώσεις) τότε ο διερμηνευτής ξέρει ότι είναι ένα Αν με Τέλος Αν και το σημειώνει σε ένα σωρό τιμών (ο ίδιος που χρησιμοποιείται για τις ρουτίνες). Αν μετά το Τότε ή το Αλλιώς ακολουθεί μπλοκ ή εντολές τότε ξέρει ότι είναι το παλιό, το οποίο δεν χρησιμοποιεί σωρό αλλά μια σημαία και μια μεταβλητή.Η σημαία προκύπτει από την συνθήκη και η μεταβλητή έχει έναν αριθμό 0 ή 1 ή 2 ανάλογα, για να δηλώσει με το 1 ότι είμαστε στο Αν και με το 2 ότι είμαστε μετά από ένα Αλλιώς.Αν το οποίο απορρίπτεται οπωσδήποτε (γιατί κάτι προηγουμένως έχει εκτελέσει, έχει βγάλει θετική τη συνθήκη). Όταν έχουμε φωλιασμένα Αν με μπλοκ, τότε το κάθε μπλοκ έχει τις δικές δυο μεταβλητές και έτσι δεν χρειάζεται σωρός. Δεν συμβαίνει αυτό με την Αν Τέλος Αν. Εδώ δεν έχουμε κλήση μπλοκ, όλα γίνονται σε ένα ακόμα και αν καλέσουμε ρουτίνα (οι ρουτίνες είναι εσωτερικά στοιχεία των Τμημάτων και Συναρτήσεων και για το λόγω αυτό έχουν θέαση των μεταβλητών αυτών, αν και φτιάχνουν και τοπικές μεταβλητές). Μπλοκ ανοίγουμε με { }. Τα μπλοκ έχουν μια ιδιαίτερη λειτουργία για να "πηδάνε" σε άλλο σημείο κώδικα εκτός μπλοκ. Ουσιαστικά είτε καλέσουμε ρουτίνα είτε κάνουμε άλμα προς κάποια ετικέτα, το μπλοκ θα διακοπεί, και θα γίνει έλεγχος αν στο τρέχον μπλοκ υπάρχει η ετικέτα/ρουτίνα, εφόσον δεν έχει ζητηθεί ξανά, διαφορετικά θα την πάρει από μια λίστα (όπου καταχωρούνται στη πρώτη ζήτηση). Μετά θα φορτωθεί ο κώδικας από το σημείο που δηλώνει η ρουτίνα ή η ετικέτα. Αν δεν βρεθεί στο τρέχον μπλοκ τότε  ο διερμηνευτής πάει στο αμέσως προηγούμενο μέχρι το Τμήμα η Συνάρτηση που τρέχει ο κώδικας. Ειδικά για τις ρουτίνες μπορεί να πάει και πιο πάνω, στο κείμενο που πρώτη φορά βρήκε το τμήμα ή συνάρτηση και να τρέξει τη ρουτίνα σαν να ήταν μέρος του τμήματος ή συνάρτησης, και στην επιστροφή γυρνάει ακριβώς στο κώδικα που έτρεχε πριν. Ένα τμήμα από μόνο του είναι ένα μπλοκ, οπότε επειδή ξεκινάμε με τμήματα πάντα υπάρχει το "κορυφαίο" μπλοκ.



\\ Παράδειγμα της νέας δομής Αν
Ι=10
Κ=20
Δ=5
Αν Ι>Κ Τότε Τύπωσε Ι Αλλιώς.Αν Ι>Δ Τότε Τύπωσε Δ Αλλιώς Τύπωσε Κ 'δίνει το 5

Ι=10
Κ=20
Δ=50
Αν Ι>Κ Τότε Τύπωσε Ι Αλλιώς.Αν Ι>Δ Τότε Τύπωσε Δ Αλλιώς Τύπωσε Κ ' δίνει το 20

Ι=100
Κ=20
Δ=50
Αν Ι>Κ Τότε Τύπωσε Ι Αλλιώς.Αν Ι>Δ Τότε Τύπωσε Δ Αλλιώς Τύπωσε Κ ' δίνει το 100

\\ άλλες μορφές ανάπτυξης

Αν Ι>Κ Τότε Τύπωσε Ι Αλλιώς.Αν Ι>Δ Τότε Τύπωσε Δ Αλλιώς Τύπωσε Κ ' δίνει το 100

\\ Συνεχόμενη χωρίς Αν βάζουμε εντολές ανάμεσα
Αν Ι>Κ Τότε Τύπωσε Ι
Αλλιώς.Αν Ι>Δ Τότε Τύπωσε Δ
Αλλιώς Τύπωσε Κ ' δίνει το 100

\\ Σπαστή με το Τέλος Αν στο τέλος.
\\ Μπορούμε να βάλουμε και άλλα Αν ανάμεσα με ή χωρίς μπλοκ
\\ Μπορούμε να χρησιμοποιήσουμε το έξοδος ή το συνέχισε (Αν βρίσκεται σε μπλοκ)
\\ Μπορούμε να χρησιμοποιήσουμε ΠΡΟΣ (GOTO) μόνο εντός ορίων (να μην βγούμε πέρα από το τέλος Αν)
Αν Ι>Κ Τότε
      Τύπωσε Ι
Αλλιώς.Αν Ι>Δ Τότε
      Τύπωσε Δ
Αλλιώς
      Τύπωσε Κ ' δίνει το 100
Τέλος Αν

\\ αυτή είναι η γενική και πιο γρήγορη μορφή.
\\ Αν χρησιμοποιήσουμε το έξοδος ή το συνέχισε τότε θα πιάσουν για τα τρέχοντα μπλοκ
\\ μπορούμε να χρησιμοποιούμε την ΠΡΟΣ (GOTO) και εκτός ορίων.
Αν Ι>Κ Τότε {
      Τύπωσε Ι
} Αλλιώς.Αν Ι>Δ Τότε {
      Τύπωσε Δ
} Αλλιώς{
      Τύπωσε Κ ' δίνει το 100
}

\\ Χρήση πολλαπλών Αν σε μια γραμμή

Αν Ι>Κ Τότε Αν Ι>Δ Τότε Τύπωσε "Ι>Κ και Ι>Δ" Αλλιώς Τύπωσε "από το τελευταίο Αν"
Ι-! ' αλλαγή προσήμου
\\ δεν θα τυπώσει κάτι γιατί στο πρώτο Αν δεν υπάρχει η αλλιώς.
Αν Ι>Κ Τότε Αν Ι>Δ Τότε Τύπωσε "Ι>Κ και Ι>Δ" Αλλιώς Τύπωσε "από το τελευταίο Αν"  ' δεν τυπώνει τίποτα

\\ τώρα με τη χρήση μπλοκ  δώσαμε και στο εξωτερικό Αν την Αλλιώς
Αν Ι>Κ Τότε {Αν Ι>Δ Τότε Τύπωσε "Ι>Κ και Ι>Δ" Αλλιώς Τύπωσε "από το τελευταίο Αν" } Αλλιώς Τύπωσε "Κάτι τύπωσα"

\\ θα μπορούσε να γραφτεί και έτσι
Αν Ι>Κ Τότε {
      Αν Ι>Δ Τότε Τύπωσε "Ι>Κ και Ι>Δ" Αλλιώς Τύπωσε "από το τελευταίο Αν"
} Αλλιώς Τύπωσε "Κάτι τύπωσα"

\\ ή έτσι 
\\ η Αν χωρίς εντολές μετά την Τότε θέλει την Τέλος Αν στο τέλος και οπωσδήποτε να περάσει η ροή από εκεί
\\ γιατί καταγράφεται, για να μπορεί ο διερμηνευτής να δείξει την απουσία ή το επιπλέον αν έχει μπει κάπου
\\ ο διερμηνευτής προς το παρόν δεν βγάζει κάποιο ενδιάμεσο κώδικα, απλά εκτελεί άμεσα το κείμενο.

Αν Ι>Κ Τότε
      Αν Ι>Δ Τότε Τύπωσε "Ι>Κ και Ι>Δ" Αλλιώς Τύπωσε "από το τελευταίο Αν"
Αλλιώς
      Τύπωσε "Κάτι τύπωσα"
Τέλος Αν

\\ ή έτσι
Αν Ι>Κ Τότε
      Αν Ι>Δ Τότε
            Τύπωσε "Ι>Κ και Ι>Δ"
      Αλλιώς
            Τύπωσε "από το τελευταίο Αν"
      Τέλος Αν
Αλλιώς
      Τύπωσε "Κάτι τύπωσα"
Τέλος Αν

\\ ή έτσι
Αν Ι>Κ Τότε
      Αν Ι>Δ Τότε Τύπωσε "Ι>Κ και Ι>Δ"
      Αλλιώς Τύπωσε "από το τελευταίο Αν"    ' χωρίς την Τέλος Αν
Αλλιώς
      Τύπωσε "Κάτι τύπωσα"
Τέλος Αν

Ι=Κ+1
Δ=Ι+1
Αν Ι>Κ Τότε : Αν Ι>Δ Τότε Τύπωσε "Ι>Κ και Ι>Δ"  Αλλιώς Τύπωσε "από το τελευταίο Αν"  ' τυπώνει μετά την αλλιώς



Επιπλέον από την έκδοση 9.6 οι αριθμοί τύπου Double (Διπλός) δεν στρογγυλεύονται στο 13ο δεκαδικό, (τώρα ο διερμηνευτής αφήνει και το δέκατο τέταρτο). Αυτό φαίνεται στην Έλεγχος όπου ο διακόπτης RDB (round double) είναι με -. Μπορούμε να επαναφέρουμε τη στρογγυλοποίηση με το Διακόπτες "+RDB" αλλά μόνο για το τρέχον διερμηνευτή (μπορούμε να έχουμε ανοίξει πολλά προγράμματα και το καθένα να τρέχει με τη δική του ρύθμιση). Επειδή ο διερμηνευτής, η εφαρμογή, έχει γίνει χωρίς στρογγύλευμα στον επεξεργαστή κινητής υποδιαστολής θεώρησα να έχω αυτή την επιλογή για στρογγύλεμα μόνιμα σε παλαιότερες εκδόσεις. Υπάρχει ο τελεστής == που κάνει πάντα σύγκριση όταν έχει διπλούς (double) με στρογγύλεμα στο 13ο δεκαδικό, ενώ ο τελεστής = δεν κάνει στρογγύλεμα. Στις διαιρέσεις πάντα γίνεται στρογγύλεμα στο έλεγχο αν η τιμή του διαιρέτη είναι μηδενική ή κοντά στο μηδέν, και αν όχι τότε γίνεται η διαίρεση (χωρίς στρογγύλεμα).

Μπορούμε να χρησιμοποιούμε τους Decimal  (Αριθμός) ή τους Currency (Λογιστικός) όπου ο μεν πρώτος έχει 28 ψηφία με την υποδιαστολή να πηγαίνει οπουδήποτε και ο δεύτερος έχει 15 ακέραια και 4 δεκαδικά. (ουσιαστικά εσωτερικά είναι ένας ακέραιος, όπου το 1 γράφεται ως 10000).
Ο 100@ είναι Decimal ενώ ο 100# είναι Currency
Η Μ2000 χρησιμοποιεί ακέραιους 16 και 32 bit, 100% είναι 16bit ενώ το 100& είναι σε 32bit. Επίσης έχει τους λογικούς και τους απλούς. Οι απλοί είναι από -3.4028235E+38 έως -1.401298E-45, μικρής ακρίβειας αλλά πιο γρήγοροι.
Η ύψωση σε δύναμη δίνει πάντα διπλό. Εδώ ορίζουμε την k ως Single, και την x ό,τι πάρει από την παράσταση δεξιά από το ίσον (εδώ της καταχώρησης). Όταν βάζουμε τιμή στην k τότε θα γίνει μετατροπή στο τύπο της. Προσοχή στους απλούς/διπλούς δεν έχουμε υπερχείλιση, μπορούμε να πάρουμε ό,τι να είναι αν δώσουμε κάτι εκτός. Στους Decimal, Currency, Long, Integer έχουμε έλεγχο υπερχείλισης (θα πάρουμε λάθος).

def single k=100
x=k^2
print type$(x)="Double"
k=k^2
print type$(k)="Single"

https://docs.microsoft.com/en-us/dotnet/visual-basic/language-reference/data-types/decimal-data-type
https://docs.microsoft.com/en-us/office/vba/language/reference/user-interface-help/currency-data-type

https://docs.microsoft.com/en-us/dotnet/visual-basic/language-reference/data-types/single-data-type