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