From c72ef132927400350dc5d29b206ee529f7d19072 Mon Sep 17 00:00:00 2001 From: cxxxr Date: Sun, 19 Nov 2023 23:20:19 +0900 Subject: [PATCH] micros/walker: it-binding --- contrib/walker/example.lisp | 4 +++ contrib/walker/loop-form.lisp | 52 +++++++++++++++++++++------- contrib/walker/tests/test-cases.lisp | 38 ++++++++++++++++++-- 3 files changed, 79 insertions(+), 15 deletions(-) diff --git a/contrib/walker/example.lisp b/contrib/walker/example.lisp index 4136e1e..7ad108e 100644 --- a/contrib/walker/example.lisp +++ b/contrib/walker/example.lisp @@ -225,6 +225,10 @@ :when (f x) :count :it) +(loop :for x :across "abc123" + :when (digit-char-p x) + :collect :it :and :collect :it) + (let ((x 1)) (loop :for x :from x :to 10 :collect x)) diff --git a/contrib/walker/loop-form.lisp b/contrib/walker/loop-form.lisp index 112b152..1e4d283 100644 --- a/contrib/walker/loop-form.lisp +++ b/contrib/walker/loop-form.lisp @@ -1,7 +1,11 @@ (in-package :micros/walker) +(defvar *it-binding* nil) + (define-condition loop-conflicting-stepping-directions (simple-condition) ()) +(defclass it-binding (binding) ()) + (defclass simple-loop-form (ast) ((body :initarg :body :type implict-progn-form @@ -52,8 +56,10 @@ :reader ast-forms :writer set-ast-forms))) -(defclass it-form (ast) - ()) +(defclass it-form (ast ) + ((binding :initarg :binding + :type it-binding + :reader ast-binding))) (defclass (ast) ((d-vars :initarg :d-vars @@ -121,6 +127,12 @@ (into :initarg :into :reader ast-into))) +(defclass conditional-test-clause (ast ) + ((binding :initarg :binding + :reader ast-binding) + (form :initarg :form + :reader ast-form))) + (defclass conditional-clause (ast) ((keyword :initarg :keyword :reader ast-keyword @@ -206,7 +218,8 @@ (final-clauses '()) (for-as-clauses '()) (main-clauses '()) - (simple-vars '())) + (simple-vars '()) + (*it-binding* nil)) (labels ((lookahead () (first exps)) (current () @@ -311,7 +324,9 @@ 'return-clause :form (let ((return-pos (current))) (if (accept :it) - (make-instance 'it-form :path (cons return-pos path)) + (make-instance 'it-form + :path (cons return-pos path) + :binding *it-binding*) (let ((form (next))) (walk walker form env (cons return-pos path))))))))) (accumulation () @@ -326,7 +341,9 @@ (when (or list-accumulation-p numeric-accumulation-p) (let ((form (let ((pos (current))) (if (accept :it) - (make-instance 'it-form :path (cons pos path)) + (make-instance 'it-form + :path (cons pos path) + :binding *it-binding*) (walk-and-next)))) (into (when (accept :into) (simple-var)))) @@ -339,10 +356,18 @@ (conditional () (let ((keyword (lookahead))) (when (accept :if :when :unless) - (let ((test-form (walk-and-next)) - (then-forms (selectable-clauses)) - (else-form (when (accept :else) - (selectable-clauses)))) + (let* ((it-binding (make-instance 'it-binding)) + (test-form + (make-instance 'conditional-test-clause + :path (cons (current) path) + :binding it-binding + :form (walk-and-next))) + (then-forms (cons (let ((*it-binding* it-binding)) + (selectable-clause)) + (loop :while (accept :and) + :collect (selectable-clause)))) + (else-form (when (accept :else) + (selectable-clauses)))) (accept :end) (make-instance 'conditional-clause :keyword keyword @@ -584,6 +609,9 @@ (defmethod visit (visitor (ast d-var)) nil) +(defmethod visit (visitor (ast simple-loop-form)) + (visit visitor (ast-body ast))) + (defmethod visit (visitor (ast loop-form)) (visit-foreach visitor (loop-form-simple-vars ast)) (visit-foreach visitor (loop-form-with-clauses ast)) @@ -638,6 +666,9 @@ (defmethod visit (visitor (ast accumulation-clause)) (visit visitor (ast-form ast))) +(defmethod visit (visitor (ast conditional-test-clause)) + (visit visitor (ast-form ast))) + (defmethod visit (visitor (ast conditional-clause)) (visit visitor (ast-test-form ast)) (visit-foreach visitor (ast-then-forms ast)) @@ -652,6 +683,3 @@ (defmethod visit (visitor (ast termination-test-clause)) (visit visitor (ast-form ast))) - -(defmethod visit (visitor (ast simple-loop-form)) - (visit visitor (ast-body ast))) diff --git a/contrib/walker/tests/test-cases.lisp b/contrib/walker/tests/test-cases.lisp index da3d410..0e00ca3 100644 --- a/contrib/walker/tests/test-cases.lisp +++ b/contrib/walker/tests/test-cases.lisp @@ -1788,11 +1788,11 @@ :DO (F X)) (2)) ((1 6) (2))) -((MICROS/WALKER:COLLECT-HIGHLIGHT-PATHS (LOOP :WITH X := 0 :RETURN :IT :RETURN (F X)) (6)) +((MICROS/WALKER:COLLECT-HIGHLIGHT-PATHS (LOOP :WITH X := 0 :RETURN 1 :RETURN (F X)) (6)) NIL) -((MICROS/WALKER:COLLECT-HIGHLIGHT-PATHS (LOOP :WITH X := 0 :RETURN :IT :RETURN (F X)) (1 8)) +((MICROS/WALKER:COLLECT-HIGHLIGHT-PATHS (LOOP :WITH X := 0 :RETURN 1 :RETURN (F X)) (1 8)) ((1 8) (2))) -((MICROS/WALKER:COLLECT-HIGHLIGHT-PATHS (LOOP :WITH X := 0 :RETURN :IT :RETURN (F X)) (2)) +((MICROS/WALKER:COLLECT-HIGHLIGHT-PATHS (LOOP :WITH X := 0 :RETURN 1 :RETURN (F X)) (2)) ((1 8) (2))) ((MICROS/WALKER:COLLECT-HIGHLIGHT-PATHS (LOOP :WITH ((X Y) . Z) := (F) @@ -3708,3 +3708,35 @@ :COLLECT (F X)) (2)) ((1 8) (2))) +((MICROS/WALKER:COLLECT-HIGHLIGHT-PATHS + (LOOP :FOR MICROS/WALKER::X :ACROSS "abc123" + :WHEN (DIGIT-CHAR-P MICROS/WALKER::X) + :COLLECT :IT + :AND + :COLLECT :IT) + (11)) + ((11))) +((MICROS/WALKER:COLLECT-HIGHLIGHT-PATHS + (LOOP :FOR MICROS/WALKER::X :ACROSS "abc123" + :WHEN (DIGIT-CHAR-P MICROS/WALKER::X) + :COLLECT :IT + :AND + :COLLECT :IT) + (8)) + ((8) (6))) +((MICROS/WALKER:COLLECT-HIGHLIGHT-PATHS + (LOOP :FOR MICROS/WALKER::X :ACROSS "abc123" + :WHEN (DIGIT-CHAR-P MICROS/WALKER::X) + :COLLECT :IT + :AND + :COLLECT :IT) + (6)) + ((8) (6))) +((MICROS/WALKER:COLLECT-HIGHLIGHT-PATHS + (LOOP :FOR MICROS/WALKER::X :ACROSS "abc123" + :WHEN (DIGIT-CHAR-P MICROS/WALKER::X) + :COLLECT :IT + :AND + :COLLECT :IT) + (1 6)) + ((1 6) (2)))