M2000 Interpreter Json Class
M2000 InterpreterEdit
<lang M2000 Interpreter>
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$()
}
}
} </lang>