Δευτέρα 10 Δεκεμβρίου 2018

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$()
            }
      }




Δεν υπάρχουν σχόλια:

Δημοσίευση σχολίου

You can feel free to write any suggestion, or idea on the subject.