Skip to content

Commit

Permalink
[goal] Add labels, break, and continue to loops (#3426)
Browse files Browse the repository at this point in the history
Uses (block) and (return-from) to support (break) and (continue) with
labeling

Supports `(while) (until) (dotimes) (countdown) (loop) (doarray)`

Test cases:
``` lisp
(dotimes (i 5)
    (when (= i 2)
        (break)
    )
    (format #t "i: ~D~%" i)
)
;; Output:
;; i: 0
;; i: 1

(dotimes (i 5)
    (when (= i 2)
        (continue)
    )
    (format #t "i: ~D~%" i)
)
;; Output:
;; i: 0
;; i: 1
;; i: 3
;; i: 4

(dotimes (i 3)
    (when (= i 2)
        (continue)
    )
    (format #t "outer: ~D~%" i)
    (dotimes (i 3)
        (when (= i 0)
            (continue)
        )
        (format #t "inner: ~D~%" i)
    )
)
;; Output:
;; outer: 0
;; inner: 1
;; inner: 2
;; outer: 1
;; inner: 1
;; inner: 2

(dotimes (i 5) :label outer
    (when (= i 2)
        (continue :from outer)
    )
    (format #t "outer: ~D~%" i)
    (dotimes (i 3)
        (when (= i 1)
            (continue :from outer)
        )
        (format #t "inner: ~D~%" i)
    )
)
;; Output:
;; outer: 0
;; inner: 0
;; outer: 1
;; inner: 0
;; outer: 3
;; inner: 0
;; outer: 4
;; inner: 0

(dotimes (i 5) :label outer
    (when (= i 2)
        (continue :from outer)
    )
    (format #t "outer: ~D~%" i)
    (dotimes (i 3)
        (when (= i 0)
            (break :from outer)
        )
        (format #t "inner: ~D~%" i)
    )
)
;; Output:
;; outer: 0

(dotimes (i 5) :label outer
    (when (= i 2)
        (continue :from outer)
    )
    (format #t "outer2: ~D~%" i)
    (dotimes (i 3)
        (when (= i 1)
            (break)
        )
        (format #t "inner2: ~D~%" i)
    )
)
;; Output:
;; outer2: 0
;; inner2: 0
;; outer2: 1
;; inner2: 0
;; outer2: 3
;; inner2: 0
;; outer2: 4
;; inner2: 0

(countdown (i 5)
    (when (= i 2)
        (continue)
    )
    (format #t "i: ~D~%" i)
)
;; Output: 
;; i: 4
;; i: 3
;; i: 1
;; i: 0

(let ((i 0))
    (while (< i 5)
        (when (= i 1)
            (break)
        )
        (format #t "i: ~D~%" i)
        (1+! i)
    )
)
;; Output: 
;; i: 0

(let ((i 0))
    (until (> i 5) :label outer
        (loop
            (break :from outer)
        )
        (format #t "i: ~D~%" i)
        (1+! i)
    )
)
;; Output:
;; nothing

(define *array* (new 'global 'boxed-array uint32 3))
(doarray (i *array*)
   (break)
   (format #t "doarray")
)
;; Output:
;; nothing

(doarray (i *array*) :label arrayloop
    (dotimes (i 5)
        (when (= i 2)
            (continue :from arrayloop)
        )
        (format #t "i: ~D~%" i)
    )
    (format #t "doarray~%")
)
;; Output:
;; i: 0
;; i: 1
;; i: 0
;; i: 1
;; i: 0
;; i: 1
```
  • Loading branch information
Brent-Hickey authored Mar 16, 2024
1 parent 82fb2cc commit df2f3da
Showing 1 changed file with 58 additions and 31 deletions.
89 changes: 58 additions & 31 deletions goal_src/goal-lib.gc
Original file line number Diff line number Diff line change
Expand Up @@ -327,71 +327,98 @@
)
)

(defmacro while (test &rest body)
(defmacro continue (&key (from #f))
"Skips the remainder of the current loop iteration. Optionally continue from a labeled loop."
`(return-from ,(string->symbol (if from (string-append (symbol->string from) "-continue") "continue")) #f)
)

(defmacro break (&key (from #f))
"Exits the current loop immediately. Optionally break from a labeled loop."
`(return-from ,(string->symbol (if from (string-append (symbol->string from) "-break") "break")) #f)
)

(defmacro while (test &key (label #f) &rest body)
"While loop. The test is evaluated before body."
(with-gensyms (reloop test-exit)
`(begin
(goto ,test-exit)
(label ,reloop)
,@body
(label ,test-exit)
(when-goto ,test ,reloop)
#f
)
(let ((break-label (string->symbol (if label (string-append (symbol->string label) "-break") "break")))
(continue-label (string->symbol (if label (string-append (symbol->string label) "-continue") "continue"))))
`(block ,break-label
(goto ,test-exit)
(label ,reloop)
(block ,continue-label
,@(if (null? body) (list `(return-from ,continue-label #f)) body)
)
(label ,test-exit)
(when-goto ,test ,reloop)
#f
)
)
)
)

(defmacro until (test &rest body)
(defmacro until (test &key (label #f) &rest body)
"Until loop. The body is evaluated before the test."
(with-gensyms (reloop)
`(begin
(label ,reloop)
,@body
(when-goto (not ,test) ,reloop)
)
(let ((break-label (string->symbol (if label (string-append (symbol->string label) "-break") "break")))
(continue-label (string->symbol (if label (string-append (symbol->string label) "-continue") "continue"))))
`(block ,break-label
(label ,reloop)
(block ,continue-label
,@(if (null? body) (list `(return-from ,continue-label #f)) body)
)
(when-goto (not ,test) ,reloop)
)
)
)
)

(defmacro dotimes (var &rest body)
(defmacro dotimes (var &key (label #f) &rest body)
"Loop like for (int i = 0; i < end; i++)
var is a list made up of a variable to bind the amount to (second item), and the remaining forms are evaluated after the loop is finished."
`(let (( ,(first var) 0))
(while (< ,(first var) ,(second var))
,@body
(1+! ,(first var))
)
,@(cddr var)
)
(let ((continue-label (string->symbol (if label (string-append (symbol->string label) "-continue") "continue"))))
`(let (( ,(first var) 0))
(while (< ,(first var) ,(second var)) :label ,label
(block ,continue-label
,@(if (null? body) (list `(return-from ,continue-label #f)) body)
)
(1+! ,(first var))
)
,@(cddr var)
)
)
)

(defmacro countdown (var &rest body)
(defmacro countdown (var &key (label #f) &rest body)
"Loop like for (int i = end; i-- > 0)"
`(let ((,(first var) ,(second var)))
(while (!= ,(first var) 0)
(while (!= ,(first var) 0) :label ,label
(set! ,(first var) (- ,(first var) 1))
,@body
)
)
)

(defmacro loop (&rest body)
(defmacro loop (&key (label #f) &rest body)
"Loop this code forever."
`(while #t
`(while #t :label ,label
,@body)
)

(defmacro doarray (bindings &rest body)
(defmacro doarray (bindings &key (label #f) &rest body)
"iterate over an array. usage: (doarray (<array entry name> <array>) <code>)"

(with-gensyms (len i)
(let ((val (first bindings))
(arr (second bindings)))
(arr (second bindings))
(continue-label (string->symbol (if label (string-append (symbol->string label) "-continue") "continue"))))

`(let* ((,len (-> ,arr length))
(,i 0)
(,val (-> ,arr ,i)))
(while (< ,i ,len)
,@body
(while (< ,i ,len) :label ,label
(block ,continue-label
,@(if (null? body) (list `(return-from ,continue-label #f)) body)
)
(1+! ,i)
(set! ,val (-> ,arr ,i))
)
Expand Down

0 comments on commit df2f3da

Please sign in to comment.