A few parser fixes

README.md

@@ -35,10 +35,10 b' 1. **\xd0\x9f\xd1\x80\xd0\xbe\xd1\x81\xd1\x82\xd0\xbe \xd1\x81\xd0\xbe\xd0\xb1\xd0\xb5\xd1\x80\xd0\xb8 \xd0\xbc\xd0\xbd\xd0\xb5 \xd0\xb8\xd0\xb3\xd1\x80\xd1\x83**:<br/>'
 
 2. **Я знаю что делаю**:<br/>
 `sugar-qsp game.txt -o game.html --body body.html --js jquery.js my-js-library.js --css styles/*.css`<br/>
-Если вы знаете что делаете, то для вас смысл опций очевиден. `body.html`
-по-умолчанию лежит в каталоге `extras`.
+Если вы знаете что делаете, то для вас смысл опций очевиден. `body.html` и `default.css`
+лежат в каталоге `extras`.
 
 3. **Я - фронтендер!**<br/>
 `sugar-qsp game.txt -c -o game.js`<br/>
 Просто соберёт игру в Javascript файл который вы можете разместить на своём
-сайте как вам угодно. Для запуска игры вызовите `SugarQSP.start()`.
+сайте как вам угодно.

src/intrinsic-macros.lisp

@@ -37,10 +37,14 b''
   `(funcall (root lib rand) 1 1000))
 
 (ps:defpsmacro qspmax (&rest args)
-  `(max ,@args))
+  (if (= 1 (length args))
+      `(*math.max.apply nil ,@args)
+      `(*math.max ,@args)))
 
 (ps:defpsmacro qspmin (&rest args)
-  `(min ,@args))
+  (if (= 1 (length args))
+      `(*math.min.apply nil ,@args)
+      `(*math.min ,@args)))
 
 ;;; 5arrays
 

src/parser.lisp

@@ -103,13 +103,18 b''
 ;;; Identifiers
 
 ;; From the official docs
-(defparameter *keywords* '(act addlib addobj addqst and arrcomp arrpos arrsize cla clear *clear close clr *clr cls cmdclear cmdclr copyarr $counter countobj $curacts curloc debug delact dellib delobj desc disablescroll disablesubex dynamic dyneval else elseif end exit fcolor $fname freelib fsize func getobj gosub goto gs gt if iif inclib input instr isnum isplay jump killall killobj killqst killvar lcase lcolor len let loc $maintxt max menu mid min mod msecscount msg nl *nl no nosave obj $onactsel $ongload $ongsave $onnewloc $onobjadd $onobjdel $onobjsel opengame openqst or p *p pl *pl play qspver rand refint replace rgb rnd savegame selact selobj set settimer showacts showinput showobjs showstat $stattxt str strcomp strfind strpos trim ucase unsel unselect $usercom user_text usrtxt val view wait xgoto xgt))
+(defparameter *keywords* '(act addlib addobj addqst and arrcomp arrpos arrsize cla clear *clear close clr *clr cls cmdclear cmdclr copyarr counter countobj curacts curloc debug delact dellib delobj desc disablescroll disablesubex dynamic dyneval else elseif end exit fcolor fname freelib fsize func getobj gosub goto gs gt if iif inclib input instr isnum isplay jump killall killobj killqst killvar lcase lcolor len let loc maintxt max menu mid min mod msecscount msg nl *nl no nosave obj onactsel ongload ongsave onnewloc onobjadd onobjdel onobjsel opengame openqst or p *p pl *pl play qspver rand refint replace rgb rnd savegame selact selobj set settimer showacts showinput showobjs showstat stattxt str strcomp strfind strpos trim ucase unsel unselect usercom user_text usrtxt val view wait xgoto xgt))
+
+(defun trim-$ (str)
+  (if (char= #\$ (elt str 0))
+      (subseq str 1)
+      str))
 
 (defun qsp-keyword-p (id)
-  (member (intern (string-upcase id)) *keywords*))
+  (member (intern (trim-$ (string-upcase id))) *keywords*))
 
 (defun not-qsp-keyword-p (id)
-  (not (member (intern (string-upcase id)) *keywords*)))
+  (not (member (intern (trim-$ (string-upcase id))) *keywords*)))
 
 (p:defrule qsp-keyword (qsp-keyword-p identifier-raw))
 
@@ -118,10 +123,7 b''
                        (digit-char-p character)))
 (p:defrule identifier-raw (and id-first (* id-next))
   (:lambda (list)
-    (let ((id (p:text list)))
-      (when (member id *keywords*)
-        (error "~A is a keyword" id))
-      (intern (string-upcase id)))))
+    (intern (string-upcase (p:text list)))))
 
 (p:defrule identifier (not-qsp-keyword-p identifier-raw))
 
@@ -250,7 +252,10 b''
   (:lambda (list)
     (intern (string (second list)) :keyword)))
 
-(p:defrule comment (and #\! (* (or text-spaces qsp-string brace-string not-newline)))
+(p:defrule comment (and #\! (* (or qsp-string brace-comment text-spaces not-newline)))
+  (:constant nil))
+
+(p:defrule brace-comment (and #\{ (* (not-brace character)) #\})
   (:constant nil))
 
 ;;; Blocks
@@ -346,11 +351,15 b''
   (:function third))
 (p:defrule plain-arguments (and spaces base-arguments)
   (:function second))
-(p:defrule no-arguments (or spaces (p:& #\newline) (p:& #\&))
+(p:defrule no-arguments (or (and spaces? (p:& #\newline))
+                            (and spaces? (p:& #\&))
+                            spaces?)
   (:constant nil))
-(p:defrule base-arguments (and first-argument (* next-argument))
-  (:destructure (first rest)
-    (list* first rest)))
+(p:defrule base-arguments (or (and first-argument (* next-argument)) spaces?)
+  (:lambda (list)
+    (if (null list)
+        nil
+        (list* (first list) (second list)))))
 
 ;;; Intrinsics
 
@@ -437,17 +446,17 b''
   (dynamic  nil 1 10)
   (dyneval  t   1 10)
   ;; Main window
-  (main-p   nil 1 1 "*p")
   (main-pl  nil 1 1 "*pl")
   (main-nl  nil 0 1 "*nl")
+  (main-p   nil 1 1 "*p")
   (maintxt  t   0 0)
   (desc     t   1 1)
   (main-clear   nil 0 0 "*clear" "*clr")
   ;; Aux window
   (showstat nil 1 1)
-  (stat-p    nil 1 1 "p")
   (stat-pl   nil 1 1 "pl")
   (stat-nl   nil 0 1 "nl")
+  (stat-p    nil 1 1 "p")
   (stattxt  t   0 0)
   (stat-clear    nil 0 0 "clear" "clr")
   (cls      nil 0 0)
@@ -503,17 +512,11 b''
 (p:defrule and-expr (and eq-expr (* (and spaces? and-op spaces? eq-expr)))
   (:function do-binop))
 
-(p:defrule eq-expr (and cat-expr (* (and spaces? (or "<>" "<=" ">=" "=<" "=>"
-                                                          #\= #\< #\> #\!)
+(p:defrule eq-expr (and sum-expr (* (and spaces? (or "<=" ">=" "=<" "=>" "<>"
+                                                     "=" "<" ">" "!")
                                          spaces? cat-expr)))
   (:function do-binop))
 
-(p:defrule cat-expr (and sum-expr (* (and spaces? #\& spaces? (p:! expr-stopper) sum-expr)))
-  (:lambda (list)
-    (do-binop (list (first list) (mapcar (lambda (l)
-                                           (remove-nth l 3))
-                                         (second list))))))
-
 (p:defrule sum-expr (and mod-expr (* (and spaces? (or #\+ #\-) spaces? mod-expr)))
   (:function do-binop))
 
@@ -552,15 +555,21 b''
   (:lambda (list)
     (or (third list) :end)))
 
-(p:defrule assignment (or kw-assignment plain-assignment)
+(p:defrule assignment (or kw-assignment plain-assignment op-assignment)
   (:destructure (var eq expr)
     (declare (ignore eq))
     (list 'set var expr)))
 
+(p:defrule kw-assignment (and (or (p:~ "let") (p:~ "set")) spaces? (or op-assignment plain-assignment))
+  (:function third))
+
+(p:defrule op-assignment (and variable spaces? (or "+" "-" "*" "/") #\= spaces? expression)
+  (:destructure (var ws1 op eq ws2 expr)
+                (declare (ignore ws1 ws2))
+                (list var eq (intern-first (list op var expr)))))
+
 (p:defrule plain-assignment (and variable spaces? #\= spaces? expression)
   (:function remove-nil))
-(p:defrule kw-assignment (and (or (p:~ "let") (p:~ "set")) spaces? plain-assignment)
-  (:function third))
 
 ;;; Non-string literals