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

@@ -1,27 +1,28 b''
 
 # loops
 jump 'КонеЦ'
 p 'Это сообщение не будет выведено'
 :конец
 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

@@ -1,93 +1,93 b''
 
 (in-package cl-user)
 
 (defpackage :sugar-qsp.js)
 
 (defpackage :sugar-qsp.main
   (:use :cl :ps :sugar-qsp.js)
   (:export #:api-call #:by-id
            #:root #:in
            #:vars #:objs #:current-location
            #:started-at #:timer-interval #:timer-obj
            #:state-stash #:playing #:locals
            #:acts #:locs))
 
 ;;; API functions
 (defpackage :sugar-qsp.api
   (:use :cl :ps :sugar-qsp.main :sugar-qsp.js)
   (:export #:with-frame #:with-call-args
            #:stash-state
 
            #:report-error #:sleep #:init-dom #:call-serv-loc
            #:newline #:clear-id #:prepare-contents #:get-id #:set-id #:append-id
            #:init-args #:get-result #:call-loc #:call-act
            #:get-frame #:add-text #:get-text #:clear-text #:enable-frame
            #:add-act #:del-act #:clear-act #:update-acts
            #:qspfor
            #:*var #:new-value #:index-num #:get #:set #:kill
            #:var-real-name #:ensure-var #:var-ref #:get-var #:set-var
            #:get-array #:set-array #:kill-var #:array-size
            #:push-local-frame #:pop-local-frame #:current-local-frame #:new-local
            #:update-objs
            #:menu
            #:clean-audio
            #:show-image
            #:opengame #:savegame
            ))
 
 ;;; QSP library functions and macros
 (defpackage :sugar-qsp.lib
   (: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
            #:qspver #:curloc
            #:rnd #:qspmax #:qspmin
            #:arrsize #:len
            #:mid #:ucase #:lcase #:trim #:replace #:val #:qspstr
            #:exit #:desc
            #:showstat #:msg
            #:showacts #:delact #:cla
            #:showobjs #:countobj #:getobj
            #:isplay
            #:view
            #:showinput
            #:wait #:settimer
            #:local
            #:opengame #:savegame
 
            #:goto #:xgoto
            #:rand
            #:copyarr #:arrpos #:arrcomp
            #:instr #:isnum #:strcomp #:strfind #:strpos
            #:iif
            #:gosub #:func
            #:dynamic #:dyneval
            #:main-p #:main-pl #:main-nl #:maintxt #:desc #:main-clear
            #:stat-p #:stat-pl #:stat-nl #:stattxt #:stat-clear #:cls
            #:curacts
            #:addobj #:delobj #:killobj
            #:menu
            #:play #:close #:closeall
            #:refint
            #:usertxt #:cmdclear #:input
            #:msecscount
            #:rgb
            #:openqst #:addqst #:killqst
            ))
 
 ;;; The compiler
 (defpackage :sugar-qsp
   (:use :cl)
   (:local-nicknames (#:p #:esrap)
                     (#:lib :sugar-qsp.lib)
                     (#:api :sugar-qsp.api)
                     (#:main :sugar-qsp.main))
   (:export #:parse-file #:entry-point))
 
 (setf (ps:ps-package-prefix "SUGAR-QSP.MAIN") "qsp_")
 (setf (ps:ps-package-prefix "SUGAR-QSP.API") "qsp_api_")
 (setf (ps:ps-package-prefix "SUGAR-QSP.LIB") "qsp_lib_")

src/ps-macros.lisp

@@ -1,162 +1,163 b''
 
 (in-package sugar-qsp.lib)
 
 ;;;; Parenscript macros which make the parser's intermediate
 ;;;; representation directly compilable by Parenscript
 ;;;; Some utility macros for other .ps sources too.
 
 ;;; Utils
 
 ;;; Common
 
 (defpsmacro label-block (() &body body)
   (let ((has-labels (some #'keywordp body)))
     `(block nil
        ,@(when has-labels
-           '((defvar __labels)))
+           '((defvar _labels)))
        (tagbody
           ,@body
           (void)))))
 
 (defpsmacro str (&rest forms)
   (cond ((zerop (length forms))
          "")
         ((and (= 1 (length forms))
               (stringp (first forms)))
          (first forms))
         (t
          `(& ,@forms))))
 
 ;;; 1loc
 
 (defpsmacro location ((name) &body body)
   `(setf (root locs ,name)
          (async-lambda (args)
                        (label-block ()
                          ,@body))))
 
 (defpsmacro goto% (target &rest args)
   `(progn
      (goto ,target ,args)
      (exit)))
 
 (defpsmacro xgoto% (target &rest args)
   `(progn
      (xgoto ,target ,args)
      (exit)))
 
 ;;; 2var
 
 (defpsmacro qspvar (name index slot)
   `(api-call get-var ,(string name) ,index ,slot))
 
 (defpsmacro set ((var vname vindex vslot) value)
   (assert (eq var 'qspvar))
   `(api-call set-var ,(string vname) ,vindex ,vslot ,value))
 
 ;;; 3expr
 
 (defpsmacro <> (op1 op2)
   `(not (equal ,op1 ,op2)))
 
 (defpsmacro ! (op1 op2)
   `(not (equal ,op1 ,op2)))
 
 ;;; 4code
 
 (defpsmacro exec (&body body)
   (format nil "javascript: ~{~A~^~%~}" (mapcar #'ps* body)))
 
 ;;; 5arrays
 
 ;;; 6str
 
 (defpsmacro & (&rest args)
   `(chain "" (concat ,@args)))
 
 ;;; 7if
 
 (defpsmacro qspcond (&rest clauses)
   `(cond ,@(loop :for clause :in clauses
               :collect (list (first clause)
                              `(tagbody
                                  ,@(rest clause))))))
 
 ;;; 8sub
 
 ;;; 9loops
 ;;; 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)))))
     (setf (first funcs) (reverse (first funcs)))
     (setf funcs (reverse funcs))
     (if (= 2 (length funcs))
         `(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
 
 (defpsmacro qspblock (&body body)
   `(async-lambda (args)
      (label-block ()
        ,@body)))
 
 ;;; 11main
 
 (defpsmacro act (name img &body body)
   `(api-call add-act ,name ,img
              (async-lambda ()
                (label-block ()
                  ,@body))))
 
 ;;; 12aux
 
 ;;; 13diag
 
 ;;; 14act
 
 ;;; 15objs
 
 ;;; 16menu
 
 ;;; 17sound
 
 ;;; 18img
 
 ;;; 19input
 
 ;;; 20time
 
 ;;; 21local
 
 ;;; 22for
 
 (defpsmacro qspfor (var from to step &body body)
   `((intern "QSPFOR" "API")
     ,(string (second var)) ,(third var) ;; name and index
     ,from ,to ,step
     (lambda ()
       (block nil
         ,@body
         t))))