;; A state is a (make-state symbol list[transition])
(define-struct state (name trans-out))

;; A transition is a (make-trans symbol symbol)
(define-struct trans (guard next-state))

;; A monitor is a (make-monitor symbol list[state])
(define-struct monitor (init-state states))

;;;; interpreter for struct-based monitors ;;;;;;

;; find-next-state : symbol symbol list[state] $\rightarrow$ symbol or false
;; finds name of next-state in transition from given state (first arg) on given input/guard (second arg)
(define (find-next-state fromstate onguard all-states)
  (let ([poss-trans (state-trans-out 
                     (first (filter (lambda (s) (eq? (state-name s) fromstate)) all-states)))])
    (let ([matchtrans (filter (lambda (t) (eq? onguard (trans-guard t))) poss-trans)])
      (if (empty? matchtrans) false
          (trans-next-state (first matchtrans))))))

;; run-monitor : symbol list[symbol] list[states] $\rightarrow$ symbol
;; run monitor on samples from current state, returning 'okay or 'error
(define (run-monitor curr-state samples all-states)
  (cond [(empty? samples) 'okay]
        [(cons? samples)
         (let ([next-state (find-next-state curr-state (first samples) all-states)])
           (cond [(boolean? next-state) 'error]
                 [else (run-monitor next-state (rest samples) all-states)]))]))

;; interp-monitor : monitor list[symbol] $\rightarrow$ symbol
;; run monitor on samples, returning 'okay or 'error
(define (interp-monitor a-monitor samples)
  (run-monitor (monitor-init-state a-monitor)
               samples
               (monitor-states a-monitor)))

;;;;;;; macro for struct-based monitors

(define-syntax monitor
  (syntax-rules (-> :)
    [(monitor initname
              (curr-state : (label -> next-state) ...)
               ...)
     (make-monitor
      'initname
      (list (make-state 'curr-state (list (make-trans 'label 'next-state)
                                          ...))
            ...))]))

(define TL-monitor
  (monitor is-red
           (is-red : (green -> is-green)
                     (red -> is-red))
           (is-green : (yellow -> is-yellow)
                       (green -> is-green))
           (is-yellow : (red -> is-red)
                        (yellow -> is-yellow))))