FOR loop

examples/22for.txt

@@ -0,0 +1,18 b''
+
+# for
+FOR k1=0 TO 5:
+    *PL k1
+    IF k1=3: EXIT
+END
+
+FOR номер_нпц = 1 TO количество_нпц: GS 'инициализировать нпц', номер_нпц
+
+стоимость['меч'] = 10
+стоимость['доспех'] = 250
+стоимость['щит'] = 15
+стоимость_снаряжения = 0
+FOR номер_предмета = 0 TO ARRSIZE('стоимость')-1: стоимость_снаряжения += стоимость[номер_предмета]
+
+FOR i = 1 TO 10 STEP 2: *PL i
+
+-

TODO

@@ -1,6 +1,10 b''
 
+* Finish lib
+* CLI build for Linux
+* CLI build for Windows
+
+* Build Istreblenie
 * Windows GUI (for the compiler)
 * Save-load game in slots
 * Resizable frames
-* Build Istreblenie
 ** modifying it to suit compiler specifics
  No newline at end of file

src/parser.lisp

@@ -78,6 +78,9 b''
 (p:defrule colon #\:
   (:constant nil))
 
+(p:defrule equal #\=
+  (:constant nil))
+
 (p:defrule alphanumeric (alphanumericp character))
 
 (p:defrule not-newline (not-newline character))
@@ -102,8 +105,7 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 local 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 for 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 local 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 step str strcomp strfind strpos to trim ucase unsel unselect usercom user_text usrtxt val view wait xgoto xgt))
 
 (defun trim-$ (str)
   (if (char= #\$ (elt str 0))
@@ -266,7 +268,7 b''
 
 ;;; Blocks
 
-(p:defrule block (or block-act block-if))
+(p:defrule block (or block-act block-if block-for))
 
 (p:defrule block-if (and block-if-head block-if-body)
   (:destructure (head body)
@@ -325,12 +327,6 b''
   (:lambda (list)
     (apply #'append list)))
 
-(p:defrule block-act-sl line-body)
-
-(p:defrule block-act-ml (and newline-block-body block-act-end)
-  (:lambda (list)
-    (apply #'list* (butlast list))))
-
 (p:defrule block-act-head (and (p:~ "act") spaces qsp-string spaces?
                                (p:? block-act-head-img)
                                colon spaces?)
@@ -343,7 +339,36 b''
   (:lambda (list)
     (or (third list) "")))
 
-(p:defrule block-act-end (and (p:~ "end"))
+(p:defrule block-for (and block-for-head (or block-ml block-sl))
+  (:lambda (list)
+    (apply #'append list)))
+
+(p:defrule block-for-head (and (p:~ "for") spaces variable spaces? equal spaces? expression 
+                               (p:~ "to") spaces expression
+                               block-for-head-step
+                               colon spaces?)
+  (:lambda (list)
+    (unless (eq (fourth (third list)) :num)
+      (error "For counter variable must be numeric."))
+    (list 'qspfor
+          (elt list 2)
+          (elt list 6)
+          (elt list 9)
+          (elt list 10))))
+
+(p:defrule block-for-head-step (p:? (and (p:~ "step") spaces expression spaces?))
+  (:lambda (list)
+    (if list
+        (third list)
+        1)))
+
+(p:defrule block-sl line-body)
+
+(p:defrule block-ml (and newline-block-body block-end)
+  (:lambda (list)
+    (apply #'list* (butlast list))))
+
+(p:defrule block-end (and (p:~ "end"))
   (:constant nil))
 
 ;;; Calls

src/ps-macros.lisp

@@ -191,3 +191,13 b''
 ;;; 20time
 
 ;;; 21local
+
+;;; 22for
+
+(ps:defpsmacro qspfor (var from to step &body body)
+  `(block nil
+     (set ,var ,from)
+     (ps:for ()
+             ((< ,var ,to))
+             ((set ,var (+ ,var ,step)))
+             ,@body)))