diff --git a/contrib/walker/example.lisp b/contrib/walker/example.lisp index 145e69a..39fb62e 100644 --- a/contrib/walker/example.lisp +++ b/contrib/walker/example.lisp @@ -134,3 +134,9 @@ (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)) diff --git a/contrib/walker/loop-form.lisp b/contrib/walker/loop-form.lisp index c6d30c5..44b85cd 100644 --- a/contrib/walker/loop-form.lisp +++ b/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,14 @@ (defclass it-form (ast) ()) +(defclass for-as-in-list-clause (ast ) + ((binding :initarg :binding + :reader ast-binding) + (in :initarg :in + :reader ast-in) + (by :initarg :by + :reader ast-by))) + (defun walk-d-var-spec (walker d-var-spec env path) (cond ((null d-var-spec) '()) @@ -80,6 +90,7 @@ (with-clauses '()) (initial-clauses '()) (final-clauses '()) + (for-as-clauses '()) (doing-forms '()) (return-forms '())) (labels ((lookahead () @@ -180,20 +191,42 @@ (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)) ((accept :=) - ) + (for-as-equals-then)) ((accept :across) - ) + (for-as-across)) ((accept :being) + ;; TODO ) (t ;; TODO: error + ;; TODO: from, to, downfrom, downto, above, by ))))) + (for-as-in-list (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 'for-as-in-list-clause + :path (cons (+ for-pos 1) path) + :binding binding + :in in + :by by) + for-as-clauses) + (setf env (extend-env env binding)))) + (for-as-on-list () + ;; TODO + ) + (for-as-equals-then () + ;; TODO + ) + (for-as-across () + ;; TODO + ) (type-spec () (cond ((member (lookahead) '(t nil fixnum float)) (next) @@ -219,6 +252,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 +272,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 +290,9 @@ (defmethod visit (visitor (ast it-form)) nil) +(defmethod visit (visitor (ast for-as-in-list-clause)) + (visit visitor (ast-in ast)) + (when (ast-by ast) (visit visitor (ast-by ast)))) + (defmethod visit (visitor (ast simple-loop-form)) (visit visitor (ast-body ast))) diff --git a/contrib/walker/tests/tests.lisp b/contrib/walker/tests/tests.lisp index e1d6647..6cbaae4 100644 --- a/contrib/walker/tests/tests.lisp +++ b/contrib/walker/tests/tests.lisp @@ -1852,7 +1852,95 @@ :WITH A := X :WITH B := Y) (0 2)) - ((0 2) (8))))) + ((0 2) (8))) + ((MICROS/WALKER:COLLECT-HIGHLIGHT-PATHS + (LOOP :WITH FOO := NIL + :FOR X :IN '(1 2 3) + :DO (PRINT X)) + (1 10)) + ((1 10) (6))) + ((MICROS/WALKER:COLLECT-HIGHLIGHT-PATHS + (LOOP :WITH FOO := NIL + :FOR X :IN '(1 2 3) + :DO (PRINT X)) + (6)) + ((1 10) (6))) + ((MICROS/WALKER:COLLECT-HIGHLIGHT-PATHS + (LOOP :WITH FOO := NIL + :FOR X :IN '(1 2 3) + :DO (PRINT X)) + (2)) + ((2))) + ((MICROS/WALKER:COLLECT-HIGHLIGHT-PATHS + (LOOP :WITH FOO + :FOR X :IN '(1 2 3) + :DO (PRINT X)) + (1 8)) + ((1 8) (4))) + ((MICROS/WALKER:COLLECT-HIGHLIGHT-PATHS + (LOOP :WITH FOO + :FOR X :IN '(1 2 3) + :DO (PRINT X)) + (4)) + ((1 8) (4))) + ((MICROS/WALKER:COLLECT-HIGHLIGHT-PATHS + (LOOP :WITH FOO + :FOR X :IN '(1 2 3) + :DO (PRINT X)) + (2)) + ((2))) + ((MICROS/WALKER:COLLECT-HIGHLIGHT-PATHS + (LOOP :FOR X :IN '(1 2 3) + :DO (PRINT X)) + (1 6)) + ((1 6) (2))) + ((MICROS/WALKER:COLLECT-HIGHLIGHT-PATHS + (LOOP :FOR X :IN '(1 2 3) + :DO (PRINT X)) + (2)) + ((1 6) (2))) + ((MICROS/WALKER:COLLECT-HIGHLIGHT-PATHS + (LOOP :WITH FN := #'CDDR + :AND A + :FOR X :IN (LIST A) :BY FN + :DO (PRINT X)) + (1 14)) + ((1 14) (8))) + ((MICROS/WALKER:COLLECT-HIGHLIGHT-PATHS + (LOOP :WITH FN := #'CDDR + :AND A + :FOR X :IN (LIST A) :BY FN + :DO (PRINT X)) + (12)) + ((12) (2))) + ((MICROS/WALKER:COLLECT-HIGHLIGHT-PATHS + (LOOP :WITH FN := #'CDDR + :AND A + :FOR X :IN (LIST A) :BY FN + :DO (PRINT X)) + (1 10)) + ((1 10) (6))) + ((MICROS/WALKER:COLLECT-HIGHLIGHT-PATHS + (LOOP :WITH FN := #'CDDR + :AND A + :FOR X :IN (LIST A) :BY FN + :DO (PRINT X)) + (8)) + ((1 14) (8))) + ((MICROS/WALKER:COLLECT-HIGHLIGHT-PATHS + (LOOP :WITH FN := #'CDDR + :AND A + :FOR X :IN (LIST A) :BY FN + :DO (PRINT X)) + (6)) + ((1 10) (6))) + ((MICROS/WALKER:COLLECT-HIGHLIGHT-PATHS + (LOOP :WITH FN := #'CDDR + :AND A + :FOR X :IN (LIST A) :BY FN + :DO (PRINT X)) + (2)) + ((12) (2))))) (deftest random (loop :for (act-form expected) :in *test-cases*