Mini Lisp (Μ2000 code, 2 versions)

Παράδειγμα γραμμένο σε Μ2000. Ένας μίνι μεταφραστής της Lisp . Αυτόν έφτιαχνα πριν μερικές βδομάδες και μου ήρθε ιδέα να προχωρήσω τη γλώσσα, και πράγματι βρήκα πολλά και νέα πράγματα και μικροπροβλήματα που έλυσα.
Ανοίγουμε τον διερμηνευτή, γράφουμε Σ Α ώστε να ανοίξει η Συγγραφή (ο διορθωτής), με το τμήμα Α που θα βάλουμε το κώδικα παρακάτω και μας εμφανίζει αυτό (έχω αλλάξει σε 60 χαρακτήρες τη κονσόλα, ενώ στο πρόγραμμα γράφει 80)

Ο χρόνος εκτέλεσης δεν μας πειράζει εδώ. Χρησιμοποιώ Windows 7 σε VirtualBox σε Linux.

Εκτελούμε το παρακάτω δοκιμαστικό πρόγραμμα σε Mini Lisp, αν μια λέξη στην αρχή μιας λίστας ( ) δεν την γνωρίζει ο διερμηνευτής τότε την γυρνάει σαν αποτέλεσμα! Οι εντολές έχουν σημειωθεί με bold (με το χέρι...)

"hello there this is a string"  ; this is going to result
(write 1223345.788)(defvar Hello "M2000")(write Hello)
(write 121 "Hello again...")
(eq 7 7)(write (list 1 2 4 5))(defvar A (+ 7 9 13 1 5 7) ) (write A  (- A 10) (* A 3) (/ 5 2))
(defvar (a b c d) 100)(write a b c d)(setq a (+ a 1))(write '(a =) a)(write (car '(a b c))(cdr '(a b c))) ; remark
(write (cons 'a '(b c)))(write George 'Karras)(write (eq a 101))
(this is written as result)(write '(This written before results) (+ a 1))
(quote (Hello 1 There a b))  '(Hello 2 There a b)(eq 5 5)
(loop (write a) (eq a 107) (setq a (+ a 1))) (write (list 1 A (+ A 1) 3 4 5))
(write 1 A (+ A 1) 3 4 5)
(write (If t 5 6))  (write ok)
(write (If nil (list 1 2 3) (list 4 5 6)))
(write (If nil 5 6))
(write (If t (list 1 2 3) (list 4 5 6)))

Profiler
EntryLevel =0
Module forall {  
      Local MyAcc$
      Document MyAcc$
      Clear Buffer$  \\ through old object and get a new one /  = is For append
      Call Local Parser(level,  &MyAcc$)
}
Module Comm {
      Read proc$
      Call ! Local forall
      Local dummy$=paragraph$(MyAcc$,-1,-1)
      Local a, d, acc
      Long a, d=forward(MyAcc$, a)  \\ there is a  backward() function too
      If d<>0 Then {
      Select Case proc$
      Case "+"
      { While a<>0 { acc+=Val(paragraph$(MyAcc$, (a))) }}
      Case "-"
            {         If a<>0 Then   acc=Val(paragraph$(MyAcc$, (a))) 
                       While a<>0 { acc-=Val(paragraph$(MyAcc$, (a)))  }}
      Case "*"
            { acc=1: While a<>0 { acc*=Val(paragraph$(MyAcc$, (a))) }}
      Else  '  Case "/"
            { acc=1
                  If a<>0 Then  acc=Val(paragraph$(MyAcc$, (a))) 
                  While a<>0 { acc/=Val(paragraph$(MyAcc$, (a))) }}
      End Select    
       Accum$=Format$("{0}", acc)+nl$
      } 
}
Module CommWrite {
      Call ! Local forall
      Print "Lisp:";
      Local i, f=Doc.Par(MyAcc$)
      If f>1 Then {
      f--  : If f>1 Then Print "(";
      For i=1 to f
            Print paragraph$(MyAcc$, i); : If i<f Then  Print " ";
      Next i
      }
      If f>1 Then { Print ")" } Else Print
}
Module LoopLisp {
      Local dummy$ : Clear Buffer$
      cnt++ : Local backhere=cnt
      Local mylevel=level
      {
            Call Local Parser(myLevel, &Accum$)
            dummy$=paragraph$(Accum$,-1,-1)     \\ throw  last nl$
            dummy$= paragraph$(Accum$,-1,-1)
            Accum$=nl$  \\ insert  last nl$
            If dummy$="t" Then Exit
            cnt=backhere
            level=mylevel
            loop   
      }          
}
Module MyList {
      Local MyAcc$
      Document MyAcc$ : Clear Buffer$
      Call Local Parser(level, &MyAcc$)
      Accum$="("+Trim$(Replace$(nl$," ", MyAcc$))+")"+nl$       
}
Module Myif {
      Call ! Local forall
      If paragraph$(MyAcc$, 1)="t" Then {
            Accum$=paragraph$(MyAcc$, 2)+nl$
      } else {
            Accum$=paragraph$(MyAcc$, 3)+nl$
      }
}
Module DefVar {
      Local MyAcc$, Iddoc$
      Document MyAcc$, Iddoc$ : Clear Buffer$
      cnt++
      Call Local Parser(level,  &Iddoc$, True)
      Call Local Parser(level,  &MyAcc$)
      Local id$=paragraph$(Iddoc$, 1,-1)  \\ third parameter If is -1 Then delete the paragraph 
      If id$="" Then Error "No name For variable"
      While Doc.Par(iddoc$)>0 {
            Call Local PrintNewLine "Var :"+id$
            If not exist(Mem,id$) Then {
                  Append Mem, id$:=MyAcc$
            } Else Error "Variable "+id$+" already defined"
           id$=paragraph$(Iddoc$, 1,-1)
      }
}
Module SetVar {
      Local MyAcc$, Iddoc$
      Document MyAcc$, Iddoc$ : Clear Buffer$
      cnt++
      Call Local Parser(level, &Iddoc$, True)
      cnt--
      Call Local Parser(level, &MyAcc$)
      Local id$=paragraph$(Iddoc$, 1,-1)  \\ third parameter If is -1 Then delete the paragraph 
      If id$="" Then Error "No name For variable"
      While Doc.Par(iddoc$)>0 {
            Call Local PrintNewLine "Var :"+id$
            If exist(Mem,id$) Then {
                  Return Mem, id$:=MyAcc$
            } Else Error "No such variable"
           id$=paragraph$(Iddoc$, 1,-1)
      }
}
Module Cons {
      Call ! Local forall
      Accum$=MyAcc$
}
Module Remark {
     while cnt<=tmproof {
           cnt++
           If mid$(a$, cnt,2)=nl$ Then cnt++ : exit
     }
}
Module String {
     Local check=cnt
     Clear Buffer$ : numeric=false
     while cnt<=tmproof {
           cnt++
           If mid$(a$, cnt,1)=qu$ Then exit
     }
     if cnt-check>1 Then { Buffer$=Mid$(a$,check, cnt-check+1)} Else Buffer$={""}
}
Module  PrintBuffer {
      If Doc.Len(Buffer$)>0 Then {
                  If exist(Mem, Buffer$) and not GetQuote Then {
                       Accum$=Mem$(Buffer$)
                  } else   Accum$=Buffer$+nl$
            Call Local PrintNewLine Buffer$
            Clear Buffer$ : prints++
      }
}
Module PrintNewLine {
      Read New What$
     If mess Then Print what$
}
Module StopChar {
      Read New val    
      com = val=1
      level+=val
      If GetQuote And level<=EntryLevel Then Call Local PrintBuffer : GetQuote=false: tmproof=cnt : Exit
      If val<>0 Then Local oldprints=prints : prints=0
      Call Local PrintBuffer
      If profil=1 And val=-1 Then If prints=0 Then If oldprints=prints Then Buffer$="()" : Call Local PrintBuffer
      profil=val
}
Module StopCharZero {
      If GetQuote And level=EntryLevel Then Call Local PrintBuffer:GetQuote=false: tmproof=cnt : Exit
      If com Then Call Local CheckCommand
      If not com Then Call Local PrintBuffer : Exit
}
Module StorePeriod {
      If Doc.Len(Buffer$)=0 Then Call Local StoreNumeric : Exit
      If numeric Else Call Local StoreLabel : Exit  \\ see Else, same as If not numeric Then
      If Instr(Buffer$,".")>0 Then Call Local PrintBuffer
      Call Local StoreNumeric
}
Module StoreSign {
      If Doc.Len(Buffer$)>0 And numeric Then Call Local PrintBuffer : Call Local  StoreNumeric : Exit
      Call Local StoreNumeric  \\ maybe numeric=False so this is like storelabel...
}
Module StoreNumeric {
      If Doc.Len(Buffer$)=0 Then  numeric=True 
      buffer$=one$
}
Module StoreLabel {
      numeric=False
      buffer$=one$
}
Module CheckCommand {
      com=false
      If GetQuote Then Exit
      If numeric Then {
            If Doc.Len(Buffer$)=1 Then If Instr("*/+-",Buffer$)>0 Then Exit
            Exit
      }
      If Exist(commands, Buffer$) Then Inline "Call Local "+Eval$(commands)
}
Module Sym {
      Read new w$
      Call ! Local forall
      If Evall(quote$(paragraph$(MyAcc$, 1) )+ w$+ Quote$(paragraph$(MyAcc$, 2) )) Then {
       Accum$=t$  } Else  Accum$=nil$
}
Module Quote {
      Clear Buffer$
      cnt++
      Call Local Parser(level, &Accum$, True)
      cnt--
}
Module Car {
      Call ! Local forall     
      Accum$=paragraph$(MyAcc$, 1)+nl$
}
Module Cdr {
      Call ! Local forall     
      Local drop$=paragraph$(MyAcc$, 1,-1)
      Accum$=MyAcc$
}
Module Eq {
      Call ! Local forall
      If paragraph$(MyAcc$, 1)=paragraph$(MyAcc$, 2) Then {
            Accum$=t$
      } Else  Accum$=nil$
}
Function Parser {
      Read New EntryLevel,  &Back$
      Local GetQuote  
      Read ? GetQuote  \\ this is an optional argument For Parser
      Local tmproof=roof, Accum$
      Document Accum$
{
      If level<EntryLevel Then cnt-- : Back$=Accum$ : Exit
      one$=mid$(a$,cnt,1)
      \\ warning in each Case one command in one line or use { } For multiple commands/lines
      \\ no empty lines allowed. 
      Select Case one$
      Case  qu$
            Call Local String
      Case ";"  \\ remark
            Call Local Remark
      Case "'"  \\ quote
            Call Local Quote
      Case "("
            Call Local StopChar, 1 ''StopChar(1)
      Case ")"
            Call Local StopChar, -1 ''StopChar(-1)
      Case " ", Ch10$, Ch13$  ' white space too
            Call Local StopCharZero
      Case "0" to "9"
            Call Local StoreNumeric
      Case "."
            Call Local StorePeriod
      Case "-", "+"
            Call Local StoreNumeric
      Else
            Call Local StoreLabel
      End Select
      cnt++
      If cnt<=tmproof Then Restart
      Back$=Accum$
      }
}
\\ Mini lisp ver 0.01
Clear \\ clear variables
Flush \\ empty stack
Form 80,48
Print "MiniLisp Ver 0.01"
Scroll Split  Row  \\ make this row start of scrolling screen
\\ A simple lisp interpreter written in M2000 by George Karras
\\For Documents "=" is For append text. Clear a$, give a new object Document.
Document a$={
                        "hello there this is a string"  ; this is going to result
                        (write 1223345.788)(defvar Hello "M2000")(write Hello)
                        (write 121 "Hello again...")
                        (eq 7 7)(write (list 1 2 4 5))(defvar A (+ 7 9 13 1 5 7) ) (write A  (- A 10) (* A 3) (/ 5 2))
                        (defvar (a b c d) 100)(write a b c d)(setq a (+ a 1))(write '(a =) a)(write (car '(a b c))(cdr '(a b c))) ; remark
                        (write (cons 'a '(b c)))(write George 'Karras)(write (eq a 101))
                        (this is written as result)(write '(This written before results) (+ a 1))
                        (quote (Hello 1 There a b))  '(Hello 2 There a b)(eq 5 5)
                        (loop (write a) (eq a 107) (setq a (+ a 1))) (write (list 1 A (+ A 1) 3 4 5))
                        (write 1 A (+ A 1) 3 4 5)
                        (write (If t 5 6))  (write ok)
                        (write (If nil (list 1 2 3) (list 4 5 6)))
                        (write (If nil 5 6))
                        (write (If t (list 1 2 3) (list 4 5 6)))

                        }                       
Print "Parse:";
Report a$
Print
nl$={
} \\ nl$ is new line
Let level=0, one$="", numeric=False, prints=0, com=False, profil=1, ch10$=chr$(10),ch13$=chr$(13), qu$=chr$(34)
Let mess=false '\\true   \\ For messages
Let cnt=1, roof=len(a$), comlevel=-1 
' no command
Document Buffer$, Result$
\\ Inventory is a hash table.
Inventory commands="+":="Comm {+}",  "-":="Comm {-}" , "*":="Comm {*}", "/":="Comm {/}", "write":="CommWrite", "car":="Car", "cdr":="Cdr", "cons":="Cons",  "defvar":="DefVar", "eq":="Eq", "setq":="SetVar", "quote":="Quote", "loop":="loopLisp",">":="Sym {>}" ,"<":="Sym {<}", ">=":="Sym{>=}","<=":="Sym{<=}", "<>":="Sym{<>}", "list":="MyList","If":="Myif"
Clear t$, nil$
\\ we want a paragraph only - with new line
Inventory mem  \\ For variables
t$="t"+nl$
nil$="nil"+nl$
Append Mem, "t":=t$,"nil":=nil$
Try ok {  Call Local Parser(level,  &Result$)}
If Error or Not Ok Then Print Error$
If level>0 Then Error "more ("
If Not Mess Then {
      Report 2, "Results" 
      Report Replace$(nl$," ", Result$)
}
Print Timecount

Το παραπάνω πρόγραμμα με Ρουτίνες αντί για τμήματα. Ο σκοπός εδώ είναι να μειωθεί η χρήση του stack του exe, και οι ρουτίνες στη Μ2000 χρησιμοποιούν δικό τους σωρό επιστροφής, και για το λόγο αυτό έχουν μεγάλο αριθμό για κλήσεις με αναδρομή (μπορεί κανείς να θέσει όριο 100000, και το βάζουμε μόνο για να πετύχουμε τα τυχόν λάθη στο κώδικα). Πρέπει όμως να μην κάνουμε κλήση ρουτίνας μέσα από μπλόκ { } γιατί τα μπλόκ καλούν συνάρτηση εσωτερικά άρα χρησιμοποιούν τον στάνταρ σωρό του exe. Όπου καλούμε την Parser() προσέχουμε να μην είναι μέσα σε μπλοκ. (αφήνουμε τα μπλοκ για άμεσες επαναλήψεις).
Επιπλέον στο πρόγραμμα μπήκε μια βελτιστοποίηση στον Parser με πρόσθετη Κατάσταση που σημαίνει ότι η αναζήτηση στη κατάσταση γίνεται άμεσα. Βέβαια δεν έχει μεγάλη διαφορά, γιατί ακόμα και ο χρόνος χρήσης του κλειδιού στην Κατάσταση σε σχέση με το κλειδί στην Select Case, μπορεί να μην είναι τόσο καλύτερος, ειδικά αν το Select Case είναι μικρό. Πάντως εδώ κερδίζουμε.
Τα goto, και τα Gosub (όλες οι ρουτίνες καλούνται με Gosub, απλά είναι προαιρετικό να το γράψουμε, εκτός και αν υπάρχει πίνακας με ίδιο όνομα, και έτσι φαίνονται οι ρουτίνες από τις παρενθέσεις, σαν συναρτήσεις χωρίς να επιστρέφουν τιμή). Οι ρουτίνες βλέπουν ότι βλέπουμε και στο τμήμα που τρέχουν, δηλαδή και τις άλλες ρουτίνες και τον εαυτό τους, και τις μεταβλητές του τμήματος.

X=10
Gosub Alfa()
Alfa()   \\ same as Gosub Alfa()
List \\ here we see only one X=10, M not exist


Sub Alfa()
Local X=20, Μ=10

List  \\ here we see X=10 and X=20 and M=10
End Sub

Υπάρχει και άλλος τύπος ρουτινών με ετικέτα με γράμματα ή αριθμό αλλά αυτές δεν καθορίζουν προσωρινό χώρο για μεταβλητές. Σε κάθε περίπτωση η έκδοση 8.4 καταγράφει τις θέσεις μετά την πρώτη αναζήτηση και στην δεύτερη τις βρίσκει από πίνακα κατακερματισμού (Hash Table), όπως βρίσκει και τα Τμήματα/Συναρτήσεις (παλαιότερα δεν γίνονταν αυτό).

Profiler
EntryLevel =0
\\ Mini lisp ver 0.02
Clear \\ clear variables
Flush \\ empty stack
Form 60,48
Print "MiniLisp Ver 0.02"
Scroll Split  Row  \\ make this row start of scrolling screen
\\ A simple lisp interpreter written in M2000 by George Karras
\\For Documents "=" is For append text. Clear a$, give a new object Document.
Document a$={
                        "hello there this is a string"  ; this is going to result
                        (write 1223345.788)(defvar Hello "M2000")(write Hello)
                        (write 121 "Hello again...")
                        (eq 7 7)(write (list 1 2 4 5))(defvar A (+ 7 9 13 1 5 7) ) (write A  (- A 10) (* A 3) (/ 5 2))
                        (defvar (a b c d) 100)(write a b c d)(setq a (+ a 1))(write '(a =) a)(write (car '(a b c))(cdr '(a b c))) ; remark
                        (write (cons 'a '(b c)))(write George 'Karras)(write (eq a 101))
                        (this is written as result)(write '(This written before results) (+ a 1))
                        (quote (Hello 1 There a b))  '(Hello 2 There a b)(eq 5 5)
                        (loop (write a) (eq a 107) (setq a (+ a 1))) (write (list 1 A (+ A 1) 3 4 5))
                        (write 1 A (+ A 1) 3 4 5)
                        (write (If t 5 6))  (write ok)
                        (write (If nil (list 1 2 3) (list 4 5 6)))
                        (write (If nil 5 6))
                        (write (If t (list 1 2 3) (list 4 5 6)))


                        }                         
Print "Parse:";
Report a$
Print
nl$={
} \\ nl$ is new line
Let level=0, one$="", numeric=False, prints=0, com=False, profil=1, ch10$=chr$(10),ch13$=chr$(13), qu$=chr$(34)
Let mess=false '\\true   \\ For messages
Let cnt=1, roof=len(a$), comlevel=-1 
Global Inventory TopGun = chr$(34):="String()", ";":="Remark()", "'":="Quote()", "(":="StopChar(1)", ")":="StopChar(-1)", " ":="StopCharZero()",  Chr$(10):="StopCharZero()", Ch13$ :="StopCharZero()", ".":="StorePeriod()", "-":="StoreNumeric()", "+":="StoreNumeric()"
For i=0 to 9: Append TopGun, str$(i,"0"):="StoreNumeric()" : Next i
Document Buffer$, Result$
\\ Inventory is a hash table.
Inventory commands="+":="Comm({+})",  "-":="Comm({-})" , "*":="Comm({*})", "/":="Comm({/})", "write":="CommWrite()", "car":="Car()", "cdr":="Cdr()", "cons":="Cons()",  "defvar":="DefVar()", "eq":="Eq()", "setq":="SetVar()", "quote":="Quote()", "loop":="loopLisp()",">":="Sym({>})" ,"<":="Sym({<})", ">=":="Sym({>=})","<=":="Sym({<=})", "<>":="Sym({<>})", "list":="MyList()","If":="Myif()"
Clear t$, nil$
\\ we want a paragraph only - with new line
Inventory mem  \\ For variables
t$="t"+nl$
nil$="nil"+nl$
Append Mem, "t":=t$,"nil":=nil$
Try ok {  Parser(level,  &Result$)}
If Error or Not Ok Then Print Error$
If level>0 Then Error "more ("
If Not Mess Then {
      Report 2, "Results" 
      Report Replace$(nl$," ", Result$)
}
Print Timecount
Sub StoreNumeric()
      If Doc.Len(Buffer$)=0 Then  numeric=True 
      buffer$=one$
End Sub
Sub StoreLabel()
      numeric=False
      buffer$=one$
End Sub
Sub Comm()
      Read proc$
      Local MyAcc$
      Document MyAcc$:Clear Buffer$:Parser(level,  &MyAcc$)
      Local dummy$=paragraph$(MyAcc$,-1,-1)
      Local a, d, acc
      Long a, d=forward(MyAcc$, a)  \\ there is a  backward() function too
      If d<>0 Then {
      Select Case proc$
      Case "+"
      { While a<>0 { acc+=Val(paragraph$(MyAcc$, (a))) }}
      Case "-"
            {         If a<>0 Then   acc=Val(paragraph$(MyAcc$, (a))) 
                       While a<>0 { acc-=Val(paragraph$(MyAcc$, (a)))  }}
      Case "*"
            { acc=1: While a<>0 { acc*=Val(paragraph$(MyAcc$, (a))) }}
      Else  '  Case "/"
            { acc=1
                  If a<>0 Then  acc=Val(paragraph$(MyAcc$, (a))) 
                  While a<>0 { acc/=Val(paragraph$(MyAcc$, (a))) }}
      End Select    
       Accum$=Format$("{0}", acc)+nl$
      } 
End Sub
Sub CommWrite()
      Local MyAcc$
      Document MyAcc$ : Clear Buffer$: Parser(level,  &MyAcc$)
      Print "Lisp:";
      Local i, f=Doc.Par(MyAcc$)
      If f>1 Then { 
            f--  : If f>1 Then Print "(";
            For i=1 to f {
                  Print paragraph$(MyAcc$, i); 
                  If i<f Then  Print " ";
            }
      }
      If f>1 Then { Print ")" } Else Print
End Sub
Sub LoopLisp()
      Local dummy$ : Clear Buffer$
      cnt++ : Local backhere=cnt
      Local mylevel=level
loop1:
      Parser(myLevel, &Accum$)
      dummy$=paragraph$(Accum$,-1,-1)     \\ throw  last nl$
      dummy$= paragraph$(Accum$,-1,-1)
      Accum$=nl$  \\ insert  last nl$
      If dummy$="t" Then Exit Sub
      cnt=backhere
      level=mylevel
      goto loop1
End Sub
Sub  MyList()
      Local MyAcc$
      Document MyAcc$ : Clear Buffer$
      Parser(level, &MyAcc$)
      Accum$="("+Trim$(Replace$(nl$," ", MyAcc$))+")"+nl$       
End Sub
Sub Myif()
      Local MyAcc$
      Document MyAcc$:Clear Buffer$:Parser(level,  &MyAcc$)
      If paragraph$(MyAcc$, 1)="t" Then {
            Accum$=paragraph$(MyAcc$, 2)+nl$
      } else {
            Accum$=paragraph$(MyAcc$, 3)+nl$
      }
End Sub
Sub DefVar()
      Local MyAcc$, Iddoc$
      Document MyAcc$, Iddoc$ : Clear Buffer$
      cnt++ : Parser(level,  &Iddoc$, True) :      Parser(level,  &MyAcc$)
      Local id$=paragraph$(Iddoc$, 1,-1)  \\ third parameter If is -1 Then delete the paragraph 
      If id$="" Then Error "No name For variable"
      While Doc.Par(iddoc$)>0 {
            PrintNewLine("Var :"+id$)
            If not exist(Mem,id$) Then {
                  Append Mem, id$:=MyAcc$
            } Else Error "Variable "+id$+" already defined"
           id$=paragraph$(Iddoc$, 1,-1)
      }
End Sub
Sub SetVar()
      Local MyAcc$, Iddoc$
      Document MyAcc$, Iddoc$ : Clear Buffer$
      cnt++:Parser(level, &Iddoc$, True):cnt--:Parser(level, &MyAcc$)
      Local id$=paragraph$(Iddoc$, 1,-1)  \\ third parameter If is -1 Then delete the paragraph 
      If id$="" Then Error "No name For variable"
      While Doc.Par(iddoc$)>0 {
            PrintNewLine("Var :"+id$)
            If exist(Mem,id$) Then {
                  Return Mem, id$:=MyAcc$
            } Else Error "No such variable"
           id$=paragraph$(Iddoc$, 1,-1)
      }
End Sub
Sub Cons()
      Local MyAcc$
      Document MyAcc$: Clear Buffer$: Parser(level,  &MyAcc$)
      Accum$=MyAcc$
End Sub
Sub Remark()
     while cnt<=tmproof {cnt++:If mid$(a$, cnt,2)=nl$ Then cnt++ : Exit
}
End Sub
Sub String()
     Local check=cnt :Clear Buffer$ : numeric=false
     while cnt<=tmproof {cnt++:If mid$(a$, cnt,1)=qu$ Then exit
     }
     if cnt-check>1 Then { Buffer$=Mid$(a$,check, cnt-check+1)} Else Buffer$={""}
End Sub
Sub PrintBuffer()
      If Doc.Len(Buffer$)=0 Then Exit Sub
      If exist(Mem, Buffer$) and not GetQuote Then {
           Accum$=Mem$(Buffer$)
      } else Accum$=Buffer$+nl$
      PrintNewLine(Buffer$)
      Clear Buffer$ : prints++
End Sub
Sub PrintNewLine(What$)
     If mess Then Print what$
End Sub
Sub StopChar(val)
      com = val=1
      level+=val
      If GetQuote And level<=EntryLevel Then PrintBuffer() : GetQuote=false: tmproof=cnt : Exit Sub
      If val<>0 Then Local oldprints=prints : prints=0
      PrintBuffer()
      If profil=1 And val=-1 Then If prints=0 Then If oldprints=prints Then Buffer$="()" : PrintBuffer()
      profil=val
End Sub
Sub StopCharZero()
      If GetQuote And level=EntryLevel Then PrintBuffer():GetQuote=false: tmproof=cnt : Exit Sub
      If com Then CheckCommand()
      If not com Then PrintBuffer()
End Sub
Sub StorePeriod()
      If Doc.Len(Buffer$)=0 Then StoreNumeric() : Exit Sub
      If numeric Else StoreLabel() : Exit Sub  \\ see Else, same as If not numeric Then
      If Instr(Buffer$,".")>0 Then PrintBuffer()
      StoreNumeric()
End Sub
Sub StoreSign()
      If Doc.Len(Buffer$)>0 And numeric Then PrintBuffer() : StoreNumeric() : Exit Sub
      StoreNumeric()  \\ maybe numeric=False so this is like storelabel...
End Sub
Sub CheckCommand()
      com=false
      If Not GetQuote Then If Exist(commands, Buffer$) Then { Inline Eval$(commands)}
End Sub
Sub Sym(w$)
      Local MyAcc$
      Document MyAcc$:Clear Buffer$:Parser(level,  &MyAcc$)
      If Evall(quote$(paragraph$(MyAcc$, 1) )+ w$+ Quote$(paragraph$(MyAcc$, 2) )) Then {
       Accum$=t$  } Else  Accum$=nil$
End Sub
Sub Quote()
      Clear Buffer$:  cnt++: Parser(level, &Accum$, True): cnt--
End Sub
Sub Car()
      Local MyAcc$
      Document MyAcc$:Clear Buffer$:Parser(level,  &MyAcc$)
      Accum$=paragraph$(MyAcc$, 1)+nl$
End Sub
Sub Cdr()
      Local MyAcc$
      Document MyAcc$:Clear Buffer$:Parser(level,  &MyAcc$)
      Local drop$=paragraph$(MyAcc$, 1,-1)
      Accum$=MyAcc$
End Sub
Sub Eq()
      Local MyAcc$
      Document MyAcc$:Clear Buffer$:Parser(level,  &MyAcc$)
      If paragraph$(MyAcc$, 1)=paragraph$(MyAcc$, 2) Then {
            Accum$=t$
      } Else  Accum$=nil$
End SUb
Sub Parser(EntryLevel,  &Back$)
      Local GetQuote  
      Read ? GetQuote  \\ this is an optional argument For Parser
      Local tmproof=roof, Accum$
      Document Accum$
100 If level<EntryLevel Then cnt-- : Back$=Accum$ : Exit Sub
      one$=mid$(a$,cnt,1)
      If exist(TopGun, one$) then 200
      StoreLabel()
      cnt++ :If cnt<=tmproof then 100
      Back$=Accum$
      Exit Sub  
200 inline Eval$(TopGun)
      cnt++ :If cnt<=tmproof then 100
      Back$=Accum$
End Sub

H Sub Parser μπορούσε να δοθεί έτσι, χωρίς τη χρήση της κατάστασης TopGun (λίστα με Hash table) η οποία όμως είναι κατι τις πιο αργή. Το βάζω εδώ για να κάνετε δοκιμή!
Προσοχή: Στις εξόδους από Sub χρειάζεται το Exit Sub, ενώ σε block τo απλό Exit. Στα μπλοκ ο κώδικας ανήκει σε μια συνάρτηση που όταν πάρει το Exit απλά επιστρέφει, ενώ το Exit Sub τραβάει την επιστροφή από τον ειδικό σωρό. Αν το ξεχάσουμε τότε στο επόμενο End Sub θα γυρίσουμε "αλλού για αλλού".

Sub Parser(EntryLevel, &Back$)
      Local GetQuote
      Read ? GetQuote \\ this is an optional argument For Parser
      Local tmproof=roof, Accum$
      Document Accum$
100 If level<EntryLevel Then cnt-- : Back$=Accum$ : Exit Sub
      one$=mid$(a$,cnt,1)
      \\ warning in each Case one command in one line or use { } For multiple commands/lines
      \\ no empty lines allowed.
      Select Case one$
      Case qu$
            String()
      Case ";"  \\ remark
            Remark()
      Case "'"  \\ quote
            Quote()
      Case "("
            StopChar(1)
      Case ")"
            StopChar(-1)
      Case " ", Ch10$, Ch13$ ' white space too
            StopCharZero()
      Case "0" to "9"
            StoreNumeric()
      Case "."
            StorePeriod()
      Case "-", "+"
            StoreNumeric()
      Else
            StoreLabel()
      End Select
      cnt++
      if cnt<=tmproof then 100
      Back$=Accum$

End Sub

Αναθεώρηση 5 (Έκδοση 8.4)

Μερικές πινελιές ακόμα...και είναι έτοιμη η Μ2000. Σήμερα κοίταξα το αντικείμενο Γεγονός. Μπήκαν μερικές πρόσθετες δυνατότητες, όπως το να καλούμε το γεγονός από πίνακα.
Ένα αντικείμενο γεγονός είναι μια συλλογή συναρτήσεων με ίδιο σετ παραμέτρων, που μπορεί να κληθεί απ' όπουδήποτε έχουμε πρόσβαση σε αυτό. Αν είναι γενικό τότε έχουμε από παντού. Όμως έχουμε και δυο περιπτώσεις. Να είναι σε ομάδα, ανοικτού τύπου (επώνυμη) ή να είναι σε κλειστού τύπου σε πίνακα ή κατάσταση. Όταν είναι σε πίνακα και θα θέλαμε να ελέγχεται το γεγονός για όλα τα στοιχεία, ώστε να το αλλάζουμε για όλα άμεσα,  τότε βάζουμε το αντικείμενο σε πίνακα στην ομάδα, και καθώς αντιγράφεται σε όλα τα στοιχεία του πίνακα, αντιγράφεται μόνο η αναφορά στο στοιχείο, άρα κάθε ομάδα μπορεί να χρησιμοποιήσει το ίδιο γεγονός. Θα μπορούσαμε να έχουμε το γεγονός έτσι ώστε κάθε ομάδα να έχει το δικό της αντικείμενο, αρκεί να το γράψουμε στην ομάδα και όχι έμμεσα σε πίνακα στην ομάδα!
Παρατήρηση 1: τα [ ] δεν είναι ειδικά σύμβολα για τα ονόματα, ο διερμηνευτής τα βλέπει ως χαρακτήρες. Η εντολή Ιδιότητα είναι εσωτερικά μακροεντολή, δηλαδή ετοιμάζει κώδικα της Μ2000 και τον αφήνει στη θέση της εντολής. Στην μακροεντολή αυτή έχει επιλεγεί να εμφανίζεται το όνομα της μεταβλητής πίσω από την ιδιότητα με [ ] . Οι ιδιότητες με αλφαριθμητικό έχουν βασική ομάδα χωρίς το $, και μια αναφορά σε αυτή με $. Στο όνομα της μεταβλητής από πίσω έχουμε το δολάριο $ ακριβώς μετά το ], πχ η αα$ θα είναι [αα]$
Παρατήρηση 2. Ιδιότητα φτιάχνουμε και με δυο αναγνωριστικά το Ιδιότητα και το όνομα της ιδιότητας. Απλά θα διαβάζεται και θα γράφεται. Αλλά δεν θα έχει τελεστές ++ -- και άλλους που έχουν οι απλές μεταβλητές σε ομάδα. Οι ιδιότητες είναι πάντα δημόσιες. Οι μεταβλητές πίσω από αυτές είναι ιδιωτικές.
Παρατήρηση 3. Σε μια ιδιότητα αν έχει οριστεί Αξία χωρίς να δώσουμε μπλοκ { } με οδηγίες, και δεν έχει οριστεί το τμήμα Θέσε, για να πάρει τιμή, θα είναι μόνο για ανάγνωση. Μπορούμε όμως να κάνουμε και το αντίθετο, να μην ορίσουμε Αξία και να ορίσουμε το τμήμα Θέσε (χωρίς το αναγνωριστικό Τμήμα).


Οθόνη 5, 0 \\ καθαρίζουμε την οθόνη με χρώμα Ματζέντα
                    \\ από την πρώτη γραμμή (0) που θα γίνεται και ολίσθηση!
Κλάση Κάτι {
       \\ Ιδιότητα μόνο για ανάγνωση
       Ιδιότητα Άθροισμα {Αξια}=0
  
       \\ Αυτό το τμήμα έχει ίδιο όνομα με την Κλάση
       \\ Αφού φτιαχτεί η ομάδα, θα κλήθεί το τμήμα αυτό
       \\ το οποίο καλείται με τρόπο ώστε οι προσθήκες να μένουν.
       \\ Εδώ δεν έχουμε προσθήκη αλλά διαβάζουμε προαιρετικά την Άλφα
       Τμήμα Κάτι {
               \\ Το τμήμα αυτό βλέπει την ιδιότητα .Άλφα
               \\ γιατί ανήκει στην ίδια ομάδα
               .Άλφα<=350
               Διάβασε ? .Άλφα
          
       }
       Κατάσταση Υποδοχή
       Ιδιότητα Άλφα {
             Αξία {
                        \\ Τα αναγνωριστικά Υποδοχή & ['Αθροισμα] ανήκουν στη γονική ομάδα.
                        \\ Η Ιδιότητα Άλφα είναι ομάδα που περιέχεται στην γονική
                        \\ Στη Μ2000 η προς τα άνω θέαση μεταβλητών δεν γίνεται!
                        \\ Παρόλα αυτά οι ομάδες μπορούν να βλέπουν μέχρι τη γονική ομάδα.
                        Ένωσε γονικό Υποδοχή στο Υποδοχή
                        Ένωσε γονικό [Άθροισμα] στο Αθ
                        Αν Άλφα>300 τότε {
                             \\ κάθε φορά αυξάνουμε την ιδιότητα Άθροισμα
                             \\ που είναι μόνο για ανάγνωση - αλλά εδώ έχουμε..
                             \\ ...πρόσβαση στην μεταβλητή πίσω από την ιδιότητα
                             \\ για την ακρίβεια έχουμε βγάλει μια αναφορά σε αυτή!
                              Αθ++
                              Κάλεσε Γεγονός Υποδοχή(1), "Υψηλή Τιμή"
                        }
            }
            Θέσε {
                  Αν Αξία>400 τότε Αξία=400
            }
      } = 10
      \\ προσθέτουμε στην Ιδιότητα Άθροισμα μια μέθοδο (Τμήμα)
      Ομάδα Άθροισμα {
            Τμήμα Μηδένισε {
                  Ένωσε γονικό [Άθροισμα] στο Αθ
                  Αθ=0
            }
      }
}
Κάτι=Κάτι()
\\ δώσαμε την υπογραφή των παραμέτρων
\\ αλλά όχι συναρτήσεις
Για Αυτό {
      \\ η ΓΓ θα φτιαχτεί για αυτό το μπλοκ μόνο
      \\ αλλά θα φυλαχτεί το αντικείμενο στην Κατάσταση
      \\ Κάτι.Υποδοχή
      Γεγονός ΓΓ { Διάβασε Τι$ }
      \\ Θα δώσουμε την παρακάτω
      \\ Το όνομα δεν έχει σημασία, θα εκτελεστεί ως έχει
      Προσθήκη Κάτι.Υποδοχή, 1:=ΓΓ
}
Κάτι.Άλφα=500
Τύπωσε Κάτι.Άλφα, Κάτι.Άθροισμα

Συνάρτηση Τυπ {
      Διάβασε Τι$ \\ Τύπωσε Γράμμα$  \\ χωρίς μεταβλητή!
      Τύπωσε Τι$
}

Γεγονός Κάτι.Υποδοχή(1) Νέο Τυπ()

\\ διαβάζουμε τιμή που είναι πάνω από 300 και θα βγάλει γεγονός!
Μ=Κάτι.Άλφα
Τύπωσε Μ, Κάτι.Άθροισμα

\\ Γεμίζουμε το πίνακα με Κάτι!
\\ Οι καταστάσεις είναι με αναφορά, οπότε έχουμε αρχικά την ίδια κατάσταση
\\ σε όλες τις ομάδες
Κάτι.Άθροισμα.Μηδένισε
Πίνακας Α(10)=Κάτι

Μ=Α(1).Άλφα \\ προκαλεί κάλεσμα γεγονότος
Τύπωσε Μ, Α(1).Άθροισμα
ΠάταΠλήκτρο()
Τύπωσε "Αφαιρούμε την τυπ() από το γεγονός"
Για Α(1) {
      Γεγονός .Υποδοχή(1) Πέτα Τυπ()
}
Για Ι=0 έως Μήκος(Α())-1
Μ=Α(Ι).Άλφα \\ προκαλεί κάλεσμα γεγονότος
Τύπωσε Μ, Α(Ι).Άθροισμα
Επόμενο Ι
ΠάταΠλήκτρο()
Τύπωσε "Προσθέτουμε δυο φορές την τυπ() στο γεγονός"
Για Α(1) {
      Γεγονός .Υποδοχή(1) Νέο Τυπ(), Τυπ()
}
Για Ι=0 έως Μήκος(Α())-1
Μ=Α(Ι).Άλφα \\ προκαλεί κάλεσμα γεγονότος
Τύπωσε Μ, Α(Ι).Άθροισμα
Επόμενο Ι
\\ Εδώ καλούμε ένα τμήμα (διαδικασία ή μέθοδο)
\\ που ανήκει στην ιδιότητα Άθροισμα!
\\ Μηδενίζει την μεταβλητή που είναι στη γονική ομάδα!
\\ Οι ιδιότητες είναι ομάδες και αυτές και μπορούν να έχουν μεταβλητές, τμήματα, συναρτήσεις και άλλες ιδιότητες
Α(0).Άθροισμα.Μηδένισε
Τύπωσε Α(0).Άθροισμα
Τέλος \\ προαιρετικό να γράψουμε τέλος. Θα γίνει όταν ο Διερμηνευτής βρει τη λέξη Ρουτίνα.
Ρουτίνα ΠάταΠλήκτρο()
      Τοπική Α$=Κομ$
Τέλος Ρουτίνας

Αναθεώρηση 4 (έκδοση 8.4)

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

Το παράδειγμα είναι στα αγγλικά. Το αντικείμενο Ζ θα πάρει την Χ και μια συνάρτηση από την ομάδα t. Την συνάρτηση μόνο για όσο είναι στο τμήμα Alfa. Επειδή όμως υπάρχει η Χ πριν μπει η b ως Ζ στο τμήμα Alfa της t, θα παραμείνει με την αλλαγή τιμής σε 500.
Στην ιδιότητα m πρόσθεσα μια ιδιότητα, Locked, μια συνάρτηση που διαβάζει την κανονική τιμή της ιδιότητας και έναν τελεστή "++"
Έχει γίνει αλλαγή στο κώδικα βάσει της 8.5 έκδοσης. Προστέθηκε η μεταβλητή Αξία (Value) στο τμήμα Value {} η οποία παίρνει αρχική τιμή την τιμή της ιδιότητας και μπορούμε να την αλλάξουμε πριν δοθεί ως επιστροφή. Παραμένει η αναφορά στην τιμή της ιδιότητας, και μπορούμε να την αλλάξουμε!

group b {
      x=100
      property m {
         value {
               if value>200 then value=200
            }
         set {
               if .Locked then exit
               if value>1000 then Error "High Value"
         }
      }=100 \\ set value
      \\ Property {} =... is a  macro
      \\ we can expand this property
      \\ using group {}
      group m {
            Property Locked =False
            function OriginalValue {
                  link parent [m] to m
                  =m
            }
            operator "++" {
                  link parent [m] to m
                  m++
            }
      }
}
    
group t {
      X=500
      function Alfa {=.X**2}
      module alfa {
            read &Z
            Z.m<=600 \\ use <= not =
            Z.m++
            print Z.m, Z.m.OriginalValue()
            z=This
            .X<=100
            print .X, .Alfa()
            print Z.X, Z.Alfa(), Z.m
      }
}      
t.alfa &b
Print b.X