Σημείωση: Υπάρχει η βιβλιοθήκη και το παράδειγμα στο αρχείο info.gsb το οποίο παρέχεται στην εγκατάσταση της Μ2000. Όταν ανοίξουμε την Μ2000 γράφουμε:
κατάλογος εφαρμογή.κατ$
φόρτωσε info
ή στα αγγλικά: dir appdir$ : load info
τώρα φορτώνει το info.gsb και τρέχει αυτόματα το τμήμα info, το οποίο θέτει τον κατάλογο πάλι στο κατάλογο χρήστη. Τώρα με F1 ή Saveme σώνουμε το info στο κατάλογο χρήστη.
Στο info υπάρχει το τμήμα json (γράψτε edit json ή σ json για να ανοίξει ο διορθωτής). Η ParserClass είναι στο τμήμα LIB3.
Στην έκδοση 11 υπάρχει το JsonObject και δεν χρειάζεται η βιβλιοθήκη σε Μ2000, παρόλα αυτά είναι χρήσιμη για να διαβάσει κανείς τον κώδικα.
κατάλογος εφαρμογή.κατ$
φόρτωσε info
ή στα αγγλικά: dir appdir$ : load info
τώρα φορτώνει το info.gsb και τρέχει αυτόματα το τμήμα info, το οποίο θέτει τον κατάλογο πάλι στο κατάλογο χρήστη. Τώρα με F1 ή Saveme σώνουμε το info στο κατάλογο χρήστη.
Στο info υπάρχει το τμήμα json (γράψτε edit json ή σ json για να ανοίξει ο διορθωτής). Η ParserClass είναι στο τμήμα LIB3.
Στην έκδοση 11 υπάρχει το JsonObject και δεν χρειάζεται η βιβλιοθήκη σε Μ2000, παρόλα αυτά είναι χρήσιμη για να διαβάσει κανείς τον κώδικα.
Το παράδειγμα παρακάτω υπάρχει σαν Json1 στο info.
Json Library for M2000
All code is in one class. We can change, append and delete values.
From M2000 console:
Edit "jsonex.gsb"
Now open a file as jsonex.gsb and we can place the code by drag and drop, or copy.
Load jsonex
Now we load these modules and we start the example
A
function KeyList (json) {
flush
with json, "index" as json.index, "count" as json.count ,"KeyToStringPos" as keyName$()
if json.count=0 then =(,): exit
for i=0 to json.count-1:data keyname$(i):next
=array([])
}
declare Json JsonObject
json$={
{
"description":"A person",
"type":"object",
"properties":
{
"name":
{
"type":"string"
},
"age":
{
"type":"integer",
"maximum":125
}
}
}
}
method json, "parser", json$ as json
with json, "json" as json.format$(), "item" as json(), "item" as json$()
with json, "itempath" as json.path(), "itempath" as json.path$()
Report json.format$(4)
Print json$("description")
Print json$("type")
Print json.path$("properties.name.type")
Print json.path$("properties|age|type", "|") ' define different seperator
Print json.path("properties.age.maximum")
method json, "assignpath", "properties.age.maximum", 80
Report json.format$(4)
Print json.format$(0)
list1=Keylist(json.path("properties"))
Print format$("Found {0} properties:", len(list1))
nl$={
}+" - "
Print #-2, " - "+list1#sort()#str$(nl$)
// New in revision 2 version 11 deletekey
Report json.format$(0)
//Method json, "deletekey", "type"
Method json, "deletekey", "properties"
Report json.format$(0)
Json Library for M2000
All code is in one class. We can change, append and delete values.
From M2000 console:
Edit "jsonex.gsb"
Now open a file as jsonex.gsb and we can place the code by drag and drop, or copy.
Load jsonex
Now we load these modules and we start the example
A
MODULE
A {
\\ Process data in json format
\\ We can load from external file with Inline "libName"
\\ or multiple files Inline "file1" && "file2"
\\ but here we have the library in a module
Inline Code Lib1
\\ So now we make a Parser object (a group type in M2000)
Parser=ParserClass()
\\ We can display any function, module that is public and known list
Modules ?
\\ And this are all known variables (or and objects)
List !
Document json$
\\ We can load from file
\\ Load.Doc json$, "alfa.json"
json$={{
"alfa":-0.11221e+12,
"array" : [
-0.67,
"alfa1",
[
10,
20
],
"beta1",
1.21e12,
21.12145,
"ok"
],
"delta": false, "epsilon" : true, "Null Value" : null
}}
Save.Doc json$, "json2.json" \\ by default in Utf-8 with BOM
\\ just show multiline text
\\ Report display lines and stop after 3/4 of console height lines
\\ just press a key or click mouse button
Report json$
\\ so now we get text to a new object
alfa=Parser.Eval(json$)
\\ check t
Print Type$(alfa) ' it is a group
Print "alfa.type$=";alfa.type$ \\ this is a read only property
Report "as one line"
Report Parser.Ser$(alfa, 0)
Report "as multiline"
Report Parser.Ser$(alfa, 1)
Print "Using Print"
Print Parser.ReadAnyString$(alfa)
Print "Value for alfa, id alfa"
Print Parser.ReadAnyString$(alfa,"alfa")
Report "as multiline"
Report Parser.Ser$(Parser.Eval(Parser.ReadAnyString$(alfa,"array", 2)), 1)
\\ We get a copy of an array as a Group (a group which return an array)
Alfa3=Parser.Eval(Parser.ReadAnyString$(alfa,"array", 2))
\\ First value is for actual object, second value is a reafonly property of this object
Print type$(Alfa3), Alfa3.type$
Dim B()
\\ Now Alfa3 run Value part and pass a pointer of array
\\ B() is an array and here take a pointer to Alfa3 array (as value of Alfa3)
B()=Alfa3
\\ each() make an iterator for B()
N=each(B())
While N {
\\ Using B() we get values always. but if we have "object" or "array" then Print prints items **
Print B(N^)
}
\\ Print show here nothing because if value is object then "print" just leave a column and continue to next one
Print B()
\\ we have to use Group() to get group not value of group (if any).
\\ Group() works for "named" group, not for stored in an array or an inventory or a stack
Print Parser.StringValue$(Group(Alfa3), 0)
Print Parser.StringValue$(Group(Alfa3), 1)
\\ Now we want to pass a new value
\\ Interpreter want to match type of expression from left side to right side
\\ Because Parser.StringValue$ is actuall a Group (As property),
\\ we have a second linked name: Parser.StringValue
\\ we have to use Parser.StringValue()
\\ and all values must be groups, as those provided by Parser
Parser.StringValue(Group(Alfa3), 1)=Parser.Numeric(1234)
Print Parser.StringValue$(Group(Alfa3), 1)
Print Parser.StringValue$(Group(Alfa), "array", 2, 0)
\\ we have to use Parser.StringValue$()
Parser.StringValue$(Group(Alfa), "array", 2, 0)=Parser.JString$("Changed to String")
Print Parser.StringValue$(Group(Alfa), "array", 2,0)
Try ok {
Print Parser.StringValue$(Group(Alfa), "array", 2)
}
If Error or not ok Then Print Error$
Parser.StringValue.Add = True
Parser.StringValue$(Group(Alfa), "array", 2, 10)=Parser.JString$("Changed to String 2")
Parser.StringValue(Group(Alfa), "Last value")=Parser.Boolean(true)
Report "as multiline"
Report Parser.Ser$(alfa3, 1)
Report Parser.Ser$(alfa, 1)
Parser.StringValue.Add = False
Parser.StringValue.Del = True
Parser.StringValue(Group(Alfa), "array", 0)=Parser.Null()
Parser.StringValue(Group(Alfa), "delta")=Parser.Null()
Parser.StringValue.Del = False
For Parser {
.StringValue(Group(Alfa), "array", 1,5)=.Arr((.Numeric(10), .Jstring$("ok 20"), .Boolean(true)))
}
Report Parser.Ser$(alfa, 1)
}
MODULE LIB1 {
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
obj=Stack
Function Final IsId {
If .char=34 Then =.IsString(false)
}
Function Final IsTrue {
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 {
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 {
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
Stack .obj { Push .Object(objinv)}
.Trim
While .IsId() {
.Trim
If .IsSemiCol() Then {
.Trim
If .IsValue() Then {
Stack .obj {
Shift 2: Append objinv, Letter$:=Group
}
}
} Else Exit
.Trim
If not .IsComma() Then exit
.Trim
}
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 {
Print "what", .char
Stack .obj { Stack}
.func<=lambda->0
}
}
Function Final Digits (private_stack){
While .func() {
Select Case .char
Case 48 to 57
{
=true
Stack private_stack { Data .char}
}
Else
break
End Select
}
}
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()
}
}
}
Case 49 to 57
{
Stack a { Data .char}
If .Digits(a) Then {}
Fraction()
Exponent()
}
Else
a=stack
End Select
}
}
Case 48
{
oldfunc=.func
Stack a { Data .char}
If .func() Then {
If .char=46 Then {
Fraction()
Exponent()
}
}
}
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))
}
.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
}
} Else.If .char>47 and .char<58 Then {
Stack a { Data .char}
If .Digits(a) Then {}
} Else { a=Stack }
}
}
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
rem ' need a line always - revision 4
Else
Exit ' not normal
End Select
}
}
D$=chrcode$(.char)
}
Exit
2000 Stack .obj {
Print D$
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 {
If Chrcode$(.char) ~ "[0123456789ABCDEFabcdef]" Then {
D$=Chrcode$(.char)
} Else 3000
}
}
If i<>5 Then 3000
.Char<=Eval(D$)
3000 End Sub
}
Function Final IsArray {
If .char=91 Else exit
Dim Gr()
.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
}
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
}
}
Function Final IsContainer {
.Trim
Select Case chrcode$(.char)
Case "{"
=.IsObject()
Case "["
=.IsArray()
end select
}
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)
}
}
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 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)
}
} Else temp=json
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
} Else {
If object Then Push Temp : exit
Push .ser$(group(temp),0)
}
}
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 Select
}
Module Final Worker (object){
If match("IN") Or match("IS") Then {
Push object : ShiftBack 2
.ReadObject
} Else {
read Temp
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)
}
} 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)
}
}
}
}
}
}
Public:
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 {
.Myvalue$<=trim$(str$(Number, 1033))
}
}
}
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) {}
}
Group Ser$
Module Final SetSpace (.ser.space) {
}
Function Final UseDecimalPoint$ {
=str$(val(letter$),"")
}
Function Final ReadNumber$ {
.Worker false
=.UseDecimalPoint$( Letter$)
}
Function Final ReadAnyString$ {
.Worker false
=Letter$
}
Function Final ReadAny {
.Worker true
Read A
=A
}
Function Final Eval {
.func<=Lambda z=.bStream(Letter$) -> {
link .char to c
=z(&c)
}
Stack .obj { Flush}
.char<=0
If .IsContainer() Then {
=StackItem(.obj)
.obj<=Stack
} Else {
inventory emptinv
=.Object(emptinv)
}
}
Group StringValue$ {
Add=false
Del=false
Set (temp) {
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"
Link parent Null() to MyNull()
Null=MyNull()
Dim Base 1, A(1)
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 {
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 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)
} Else If where<0 Then Error "Index out of limits "+str$(where)
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)
}
Dim bb(cursize-1) ' bb(0) is an empty array
} Else Return A(1), where:=Group(temp1)
} Else {
A(1)=Array(A(1),where)
again=True
}
} Else Error "No Index Found"
}
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)
}
} Else {
A(1)=Eval(A(1))
again=True
}
} else.if .add and not .del Then {
If Empty Then {
Append A(1), k$:=Group(temp1)
} Else Error "No such Tag "+k$
} Else Error "No such Tag "+k$
} Else Error "No Tag Found"
}
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"
again=True
}
Case "Object"
{
If match("S") Then {
If Exist(A(1), Letter$) Then {
A(1)=Eval(A(1))
} Else Error "No such Tag"
} Else Error "No Tag Found"
again=True
}
End Select
} until not again
=A(1).str$
}
}
Class:
Class CreatSerialize$ {
Private:
usen=0
n=0
nl1$={
}
Function Final Jarray$ (json1, n){
A=json1
nl$=.nl1$
If .usen>0 Then {
nl$=nl$+string$(" ", n+.space)
}
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 {
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
}
a$=.Jarray$(Temp, nn, "")
}
Case "Object"
{
nn=0
If .usen>0 Then {
nn=n +.space
}
a$=.Jobject$(Temp, nn,"")
}
Else
a$=" "+temp.type$
end select
If k^<M Then {
a$=", "
If .usen>0 Then a$=nl$
} Else {
If .usen>0 Then a$=.nl1$
}
}
}
} else If .usen>0 Then a$=.nl1$
If .usen>0 Then a$=string$(" ", n)
a$="]"
=a$+letter$
}
Function Final Jobject$ (json1, n){
json=json1
nl$=.nl1$
If .usen>0 Then {
nl$=nl$+string$(" ", n+.space)
}
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
}
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
}
a$=.Jobject$(eval(k), nn, "")
}
Else
a$=" "+json( k^!).type$
end select
If k^<M Then {
a$=", "
If .usen>0 Then a$=nl$
} Else {
If .usen>0 Then a$=.nl1$
}
}
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$)
}
} Else {
If json.type$="Object" Then {
=b$+.Jobject$(json, n,a$)
} else.if json.type$="Array" Then {
=b$+.Jarray$(json, n, a$)
}
}
}
}
Module Final ParserClass {
Let .Ser=.CreatSerialize$()
}
}
}
\\ Process data in json format
\\ We can load from external file with Inline "libName"
\\ or multiple files Inline "file1" && "file2"
\\ but here we have the library in a module
Inline Code Lib1
\\ So now we make a Parser object (a group type in M2000)
Parser=ParserClass()
\\ We can display any function, module that is public and known list
Modules ?
\\ And this are all known variables (or and objects)
List !
Document json$
\\ We can load from file
\\ Load.Doc json$, "alfa.json"
json$={{
"alfa":-0.11221e+12,
"array" : [
-0.67,
"alfa1",
[
10,
20
],
"beta1",
1.21e12,
21.12145,
"ok"
],
"delta": false, "epsilon" : true, "Null Value" : null
}}
Save.Doc json$, "json2.json" \\ by default in Utf-8 with BOM
\\ just show multiline text
\\ Report display lines and stop after 3/4 of console height lines
\\ just press a key or click mouse button
Report json$
\\ so now we get text to a new object
alfa=Parser.Eval(json$)
\\ check t
Print Type$(alfa) ' it is a group
Print "alfa.type$=";alfa.type$ \\ this is a read only property
Report "as one line"
Report Parser.Ser$(alfa, 0)
Report "as multiline"
Report Parser.Ser$(alfa, 1)
Print "Using Print"
Print Parser.ReadAnyString$(alfa)
Print "Value for alfa, id alfa"
Print Parser.ReadAnyString$(alfa,"alfa")
Report "as multiline"
Report Parser.Ser$(Parser.Eval(Parser.ReadAnyString$(alfa,"array", 2)), 1)
\\ We get a copy of an array as a Group (a group which return an array)
Alfa3=Parser.Eval(Parser.ReadAnyString$(alfa,"array", 2))
\\ First value is for actual object, second value is a reafonly property of this object
Print type$(Alfa3), Alfa3.type$
Dim B()
\\ Now Alfa3 run Value part and pass a pointer of array
\\ B() is an array and here take a pointer to Alfa3 array (as value of Alfa3)
B()=Alfa3
\\ each() make an iterator for B()
N=each(B())
While N {
\\ Using B() we get values always. but if we have "object" or "array" then Print prints items **
Print B(N^)
}
\\ Print show here nothing because if value is object then "print" just leave a column and continue to next one
Print B()
\\ we have to use Group() to get group not value of group (if any).
\\ Group() works for "named" group, not for stored in an array or an inventory or a stack
Print Parser.StringValue$(Group(Alfa3), 0)
Print Parser.StringValue$(Group(Alfa3), 1)
\\ Now we want to pass a new value
\\ Interpreter want to match type of expression from left side to right side
\\ Because Parser.StringValue$ is actuall a Group (As property),
\\ we have a second linked name: Parser.StringValue
\\ we have to use Parser.StringValue()
\\ and all values must be groups, as those provided by Parser
Parser.StringValue(Group(Alfa3), 1)=Parser.Numeric(1234)
Print Parser.StringValue$(Group(Alfa3), 1)
Print Parser.StringValue$(Group(Alfa), "array", 2, 0)
\\ we have to use Parser.StringValue$()
Parser.StringValue$(Group(Alfa), "array", 2, 0)=Parser.JString$("Changed to String")
Print Parser.StringValue$(Group(Alfa), "array", 2,0)
Try ok {
Print Parser.StringValue$(Group(Alfa), "array", 2)
}
If Error or not ok Then Print Error$
Parser.StringValue.Add = True
Parser.StringValue$(Group(Alfa), "array", 2, 10)=Parser.JString$("Changed to String 2")
Parser.StringValue(Group(Alfa), "Last value")=Parser.Boolean(true)
Report "as multiline"
Report Parser.Ser$(alfa3, 1)
Report Parser.Ser$(alfa, 1)
Parser.StringValue.Add = False
Parser.StringValue.Del = True
Parser.StringValue(Group(Alfa), "array", 0)=Parser.Null()
Parser.StringValue(Group(Alfa), "delta")=Parser.Null()
Parser.StringValue.Del = False
For Parser {
.StringValue(Group(Alfa), "array", 1,5)=.Arr((.Numeric(10), .Jstring$("ok 20"), .Boolean(true)))
}
Report Parser.Ser$(alfa, 1)
}
MODULE LIB1 {
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
obj=Stack
Function Final IsId {
If .char=34 Then =.IsString(false)
}
Function Final IsTrue {
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 {
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 {
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
Stack .obj { Push .Object(objinv)}
.Trim
While .IsId() {
.Trim
If .IsSemiCol() Then {
.Trim
If .IsValue() Then {
Stack .obj {
Shift 2: Append objinv, Letter$:=Group
}
}
} Else Exit
.Trim
If not .IsComma() Then exit
.Trim
}
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 {
Print "what", .char
Stack .obj { Stack}
.func<=lambda->0
}
}
Function Final Digits (private_stack){
While .func() {
Select Case .char
Case 48 to 57
{
=true
Stack private_stack { Data .char}
}
Else
break
End Select
}
}
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()
}
}
}
Case 49 to 57
{
Stack a { Data .char}
If .Digits(a) Then {}
Fraction()
Exponent()
}
Else
a=stack
End Select
}
}
Case 48
{
oldfunc=.func
Stack a { Data .char}
If .func() Then {
If .char=46 Then {
Fraction()
Exponent()
}
}
}
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))
}
.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
}
} Else.If .char>47 and .char<58 Then {
Stack a { Data .char}
If .Digits(a) Then {}
} Else { a=Stack }
}
}
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
rem ' need a line always - revision 4
Else
Exit ' not normal
End Select
}
}
D$=chrcode$(.char)
}
Exit
2000 Stack .obj {
Print D$
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 {
If Chrcode$(.char) ~ "[0123456789ABCDEFabcdef]" Then {
D$=Chrcode$(.char)
} Else 3000
}
}
If i<>5 Then 3000
.Char<=Eval(D$)
3000 End Sub
}
Function Final IsArray {
If .char=91 Else exit
Dim Gr()
.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
}
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
}
}
Function Final IsContainer {
.Trim
Select Case chrcode$(.char)
Case "{"
=.IsObject()
Case "["
=.IsArray()
end select
}
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)
}
}
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 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)
}
} Else temp=json
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
} Else {
If object Then Push Temp : exit
Push .ser$(group(temp),0)
}
}
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 Select
}
Module Final Worker (object){
If match("IN") Or match("IS") Then {
Push object : ShiftBack 2
.ReadObject
} Else {
read Temp
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)
}
} 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)
}
}
}
}
}
}
Public:
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 {
.Myvalue$<=trim$(str$(Number, 1033))
}
}
}
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) {}
}
Group Ser$
Module Final SetSpace (.ser.space) {
}
Function Final UseDecimalPoint$ {
=str$(val(letter$),"")
}
Function Final ReadNumber$ {
.Worker false
=.UseDecimalPoint$( Letter$)
}
Function Final ReadAnyString$ {
.Worker false
=Letter$
}
Function Final ReadAny {
.Worker true
Read A
=A
}
Function Final Eval {
.func<=Lambda z=.bStream(Letter$) -> {
link .char to c
=z(&c)
}
Stack .obj { Flush}
.char<=0
If .IsContainer() Then {
=StackItem(.obj)
.obj<=Stack
} Else {
inventory emptinv
=.Object(emptinv)
}
}
Group StringValue$ {
Add=false
Del=false
Set (temp) {
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"
Link parent Null() to MyNull()
Null=MyNull()
Dim Base 1, A(1)
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 {
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 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)
} Else If where<0 Then Error "Index out of limits "+str$(where)
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)
}
Dim bb(cursize-1) ' bb(0) is an empty array
} Else Return A(1), where:=Group(temp1)
} Else {
A(1)=Array(A(1),where)
again=True
}
} Else Error "No Index Found"
}
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)
}
} Else {
A(1)=Eval(A(1))
again=True
}
} else.if .add and not .del Then {
If Empty Then {
Append A(1), k$:=Group(temp1)
} Else Error "No such Tag "+k$
} Else Error "No such Tag "+k$
} Else Error "No Tag Found"
}
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"
again=True
}
Case "Object"
{
If match("S") Then {
If Exist(A(1), Letter$) Then {
A(1)=Eval(A(1))
} Else Error "No such Tag"
} Else Error "No Tag Found"
again=True
}
End Select
} until not again
=A(1).str$
}
}
Class:
Class CreatSerialize$ {
Private:
usen=0
n=0
nl1$={
}
Function Final Jarray$ (json1, n){
A=json1
nl$=.nl1$
If .usen>0 Then {
nl$=nl$+string$(" ", n+.space)
}
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 {
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
}
a$=.Jarray$(Temp, nn, "")
}
Case "Object"
{
nn=0
If .usen>0 Then {
nn=n +.space
}
a$=.Jobject$(Temp, nn,"")
}
Else
a$=" "+temp.type$
end select
If k^<M Then {
a$=", "
If .usen>0 Then a$=nl$
} Else {
If .usen>0 Then a$=.nl1$
}
}
}
} else If .usen>0 Then a$=.nl1$
If .usen>0 Then a$=string$(" ", n)
a$="]"
=a$+letter$
}
Function Final Jobject$ (json1, n){
json=json1
nl$=.nl1$
If .usen>0 Then {
nl$=nl$+string$(" ", n+.space)
}
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
}
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
}
a$=.Jobject$(eval(k), nn, "")
}
Else
a$=" "+json( k^!).type$
end select
If k^<M Then {
a$=", "
If .usen>0 Then a$=nl$
} Else {
If .usen>0 Then a$=.nl1$
}
}
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$)
}
} Else {
If json.type$="Object" Then {
=b$+.Jobject$(json, n,a$)
} else.if json.type$="Array" Then {
=b$+.Jarray$(json, n, a$)
}
}
}
}
Module Final ParserClass {
Let .Ser=.CreatSerialize$()
}
}
}
Δεν υπάρχουν σχόλια:
Δημοσίευση σχολίου
You can feel free to write any suggestion, or idea on the subject.