#lang play


;;;;;;;;     GUARDED LOOPS       ;;;;;;;;
(defmac (my-while cond body)
  (letrec ([iter (λ ()
                   (if cond
                       (begin body (iter))
                       (void)))])
    (iter)))


(let ([x 0])
  (my-while
     (<= x 5)
     (begin (set! x (+ 1 x)) (printf "~a\n" x))))



;;;;;;;;     FINITE-STATE AUTOMATA       ;;;;;;;;
(defmac (automaton init-state
                   final-state
                   (state : (action → target) ...) ...)
  #:keywords : →
  (letrec ([state
            (if (eq? (quote state) (quote final-state))
                ; if final state
                (λ (stream)
                  (or (empty? stream)   ; stream empty                      
                      (case (first stream)
                        [(action) (target (rest stream))]
                        ...
                        [else false])))
                ; if not final state
                (λ (stream)
                  (and (cons? stream)   ; stream not empty
                      (case (first stream)
                        [(action) (target (rest stream))]
                        ...
                        [else false]))))]
                        
                        ...)
    init-state))

(define m (automaton init
                     end
                     [init : (c → more)]
                     [more : (a → more)
                             (d → more)
                             (r → end)]
                     [end : ]))

;; expanded version of m
;;
;(define m
;  (letrec ([init
;            (λ (stream)
;              (and (cons? stream)
;                   (case (first stream)
;                     [(c) (more (rest stream))]
;                     [else false])))]
;           [more
;            (λ (stream)
;              (and (cons? stream)
;                   (case (first stream)
;                    [(a) (more (rest stream))]
;                    [(d) (more (rest stream))]
;                    [(r) (end (rest stream))]
;                    [else false])))]
;           [end
;            (λ (stream)
;              (or (empty? stream)
;                  (case (first stream)
;                    [else false])))])
;    init))

(m '(c a a d r))

(m '(c a d a r))

(m '(c a r a d r))

(m '(c d d a))