micros/walker: for clause

contrib/walker/example.lisp

@@ -134,3 +134,23 @@
 
 (loop :with ((x y) . z) := (f)
       :with a := (+ x y z))
+
+(loop :for x :in '(1 2 3) :do (print x))
+(loop :with foo
+      :for x :in '(1 2 3) :do (print x))
+(loop :with foo := nil
+      :for x :in '(1 2 3) :do (print x))
+(loop :with fn := #'cddr :and a
+      :for x :in (list a) :by fn :do (print x))
+
+(loop :for x :on '(1 2 3) :do (print x))
+(loop :with foo
+      :for x :on '(1 2 3) :do (print x))
+(loop :with foo := nil
+      :for x :on '(1 2 3) :do (print x))
+(loop :with fn := #'cddr :and a
+      :for x :on (list a) :by fn :do (print x))
+(loop :for x := 1
+      :do (f x))
+(loop :for x := 1 :then (f x)
+      :do (f x))

contrib/walker/loop-form.lisp

@@ -18,6 +18,8 @@
    (fianl-clauses :initarg :final-clauses
                   :type (proper-list final-clause)
                   :reader loop-form-final-clauses)
+   (for-as-clauses :initarg :for-as-clauses
+                   :reader loop-form-for-as-clauses)
    (doing-forms :initarg :doing-forms
                 :type (proper-list ast)
                 :reader loop-form-doing-forms)
@@ -49,6 +51,31 @@
 (defclass it-form (ast)
   ())
 
+(defclass <for-as-in-on-list-clause> (ast <with-binding-form>)
+  ((binding :initarg :binding
+            :reader ast-binding)
+   (in-on :initarg :in-on
+          :reader ast-in-on)
+   (by :initarg :by
+       :reader ast-by)))
+
+(defclass for-as-in-list-clause (<for-as-in-on-list-clause>) ())
+(defclass for-as-on-list-clause (<for-as-in-on-list-clause>) ())
+
+(defclass for-as-equals-then-clause (ast <with-binding-form>)
+  ((binding :initarg :binding
+            :reader ast-binding)
+   (equals :initarg :equals
+           :reader ast-equals)
+   (then :initarg :then
+         :reader ast-then)))
+
+(defclass for-across-clause (ast <with-binding-form>)
+  ((binding :initarg :binding
+            :reader ast-binding)
+   (across :initarg :across
+           :reader ast-across)))
+
 (defun walk-d-var-spec (walker d-var-spec env path)
   (cond ((null d-var-spec)
          '())
@@ -80,6 +107,7 @@
         (with-clauses '())
         (initial-clauses '())
         (final-clauses '())
+        (for-as-clauses '())
         (doing-forms '())
         (return-forms '()))
     (labels ((lookahead ()
@@ -180,20 +208,59 @@
                (let ((var (exact-var)))
                  (type-spec)
                  (let ((binding (make-instance 'lexical-variable-binding :name var)))
-                   (declare (ignore binding))
                    (cond ((accept :in)
-                          )
+                          (for-as-in-list binding))
                          ((accept :on)
-                          )
+                          (for-as-on-list binding))
                          ((accept :=)
-                          )
+                          (for-as-equals-then binding))
                          ((accept :across)
-                          )
+                          (for-as-across binding))
                          ((accept :being)
+                          ;; TODO
                           )
                          (t
                           ;; TODO: error
+                          ;; TODO: from, to, downfrom, downto, above, by
                           )))))
+
+             (for-as-in-on-list (ast-class binding)
+               (let* ((for-pos (- pos 2))
+                      (in (walk walker (next) env (cons (+ for-pos 3) path)))
+                      (by (when (accept :by)
+                            (walk walker (next) env (cons (+ for-pos 5) path)))))
+                 (push (make-instance ast-class
+                                      :path (cons (+ for-pos 1) path)
+                                      :binding binding
+                                      :in-on in
+                                      :by by)
+                       for-as-clauses)
+                 (setf env (extend-env env binding))))
+             (for-as-in-list (binding)
+               (for-as-in-on-list 'for-as-in-list-clause binding))
+             (for-as-on-list (binding)
+               (for-as-in-on-list 'for-as-on-list-clause binding))
+             (for-as-equals-then (binding)
+               (setf env (extend-env env binding))
+               (let* ((for-pos (- pos 2))
+                      (in (walk walker (next) env (cons (+ for-pos 3) path)))
+                      (by (when (accept :then)
+                            (walk walker (next) env (cons (+ for-pos 5) path)))))
+                 (push (make-instance 'for-as-equals-then-clause
+                                      :path (cons (+ for-pos 1) path)
+                                      :binding binding
+                                      :equals in
+                                      :then by)
+                       for-as-clauses)))
+             (for-as-across (binding)
+               (let* ((for-pos (- pos 2))
+                      (across (walk walker (next) env (cons (+ for-pos 3) path))))
+                 (push (make-instance 'for-across-clause
+                                      :path (cons (+ for-pos 1) path)
+                                      :binding binding
+                                      :across across)
+                       for-as-clauses))
+               (setf env (extend-env env binding)))
              (type-spec ()
                (cond ((member (lookahead) '(t nil fixnum float))
                       (next)
@@ -219,6 +286,7 @@
                      :with-clauses (nreverse with-clauses)
                      :initial-clauses (nreverse initial-clauses)
                      :final-clauses (nreverse final-clauses)
+                     :for-as-clauses (nreverse for-as-clauses)
                      :doing-forms (nreverse doing-forms)
                      :return-forms (nreverse return-forms)))))
 
@@ -238,12 +306,14 @@
   (visit-foreach visitor (loop-form-with-clauses ast))
   (visit-foreach visitor (loop-form-initial-clauses ast))
   (visit-foreach visitor (loop-form-final-clauses ast))
+  (visit-foreach visitor (loop-form-for-as-clauses ast))
   (visit-foreach visitor (loop-form-doing-forms ast))
   (visit-foreach visitor (loop-form-return-forms ast)))
 
 (defmethod visit (visitor (ast with-clause))
   (visit-foreach visitor (ast-d-vars ast))
-  (visit visitor (ast-value ast)))
+  (when (ast-value ast)
+    (visit visitor (ast-value ast))))
 
 (defmethod visit (visitor (ast initial-clause))
   (visit-foreach visitor (ast-forms ast)))
@@ -254,5 +324,16 @@
 (defmethod visit (visitor (ast it-form))
   nil)
 
+(defmethod visit (visitor (ast <for-as-in-on-list-clause>))
+  (visit visitor (ast-in-on ast))
+  (when (ast-by ast) (visit visitor (ast-by ast))))
+
+(defmethod visit (visitor (ast for-as-equals-then-clause))
+  (visit visitor (ast-equals ast))
+  (when (ast-then ast) (visit visitor (ast-then ast))))
+
+(defmethod visit (visitor (ast for-across-clause))
+  (visit visitor (ast-across ast)))
+
 (defmethod visit (visitor (ast simple-loop-form))
   (visit visitor (ast-body ast)))