Fix labels

TODO

@@ -1,12 +1,14 b''
 
+* Duplicate label error (in the parser)
+* Reporting error lines in the parser
 * MENU with async/await
 * Special locations
 * Special variables
 * CLI build for Linux
 * CLI build for Windows
+* Storing error lines in the parser to report it in runtime errors
 
 * Build Istreblenie
 * Windows GUI (for the compiler)
 * Save-load game in slots
 * Resizable frames
-** modifying it to suit compiler specifics

examples/9loops.txt

@@ -6,22 +6,23 b" p '\xd0\xad\xd1\x82\xd0\xbe \xd1\x81\xd0\xbe\xd0\xbe\xd0\xb1\xd1\x89\xd0\xb5\xd0\xbd\xd0\xb8\xd0\xb5 \xd0\xbd\xd0\xb5 \xd0\xb1\xd1\x83\xd0\xb4\xd0\xb5\xd1\x82 \xd0\xb2\xd1\x8b\xd0\xb2\xd0\xb5\xd0\xb4\xd0\xb5\xd0\xbd\xd0\xbe'"
 p 'А это сообщение пользователь увидит'
 
 s=0
-:loop
+:loop1
 if s<9:
   s=s+1
   pl s
-  jump 'loop'
+  jump 'loop1'
 end
 p 'Всё!'
 
-:loop
+:loop2
 if y<y0:
   if x<x0:
     x=x+1
-    jump 'loop'
+    jump 'loop2'
   end
   y=y+1
   x=0
-  jump 'loop'
+  jump 'loop2'
+  if y > y0: exit
 end
 -

src/package.lisp

@@ -40,7 +40,7 b''
   (:use :cl :ps :sugar-qsp.main :sugar-qsp.js)
   (:local-nicknames (#:api :sugar-qsp.api))
   (:export #:str #:exec #:qspblock #:qspfor #:location
-           #:qspcond #:qspvar #:set #:local
+           #:qspcond #:qspvar #:set #:local #:jump
 
            #:killvar #:killall
            #:obj #:loc #:no

src/ps-macros.lisp

@@ -13,7 +13,7 b''
   (let ((has-labels (some #'keywordp body)))
     `(block nil
        ,@(when has-labels
-           '((defvar __labels)))
+           '((defvar _labels)))
        (tagbody
           ,@body
           (void)))))
@@ -88,15 +88,15 b''
 ;;; Yep, that's a huge kludge since Javascript doesn't support arbitrary labels
 
 (defpsmacro jump (target)
-  `(return-from ,(intern (string-upcase (second target)))
-     (funcall (getprop __labels ,target))))
+  `(return-from label-body
+     (funcall (getprop _labels ,(string-upcase (second target))))))
 
 (defpsmacro tagbody (&body body)
-  (let ((funcs (list nil :__nil)))
+  (let ((funcs (list nil "_nil")))
     (dolist (form body)
       (cond ((keywordp form)
              (setf (first funcs) (reverse (first funcs)))
-             (push form funcs)
+             (push (string-upcase form) funcs)
              (push nil funcs))
             (t
              (push form (first funcs)))))
@@ -106,14 +106,15 b''
         `(progn
            ,@body)
         `(progn
-           (setf ,@(loop :for f :on funcs :by #'cddr
-                      :append `((@ __labels ,(first f))
-                                (block ,(intern (string-upcase (string (first f))))
-                                  ,@(second f)
-                                  ,@(when (third f)
-                                      `((funcall
-                                         (getprop __labels ,(third f)))))))))
-           (jump (str "__nil"))))))
+           (setf ,@(loop :for (label code . rest-labels) :on funcs :by #'cddr
+                      :append `((@ _labels ,label)
+                                (block label-body
+                                  (block ,(intern label)
+                                    ,@code
+                                    ,@(when rest-labels
+                                        `((funcall
+                                           (getprop _labels ,(first rest-labels))))))))))
+           (funcall (getprop _labels "_nil"))))))
 
 ;;; 10dynamic