s c h e m a t i c s : c o o k b o o k

;
; FSMP - Finite State Machine Parser in Scheme
; a Scheme interpreter for a finite state machine.
;
; A very simple language for developing finite state machines in Scheme.
; This is meant to be an example, pretty ugly, but it shows how to model these concepts
; in Scheme.
;

; test program
(define prog '( FSM foo 2
                    (0 (1 (lambda()(display "FOO"))))
                    (1 (0 (lambda()(display "BAR"))))
                    ;; -1 is for end of list for now
                    (-1)))

;; name of program we are parsing.
(define prog-name "")
;; fsm-vector is a vector of all states[num] = list(next,lambda);
(define fsm-vector '())
;; number of state in vector
(define num-states 0)
;; current state we are on now
(define state 0)
  
;; add state (number next function)
(define (add-state num next func)
  (vector-set! fsm-vector num (list next func)))

;; expand a vector with one more element at the end. copies old into it, return new vector.
(define (expand-vector old)  
  ( let* ((n (+ num-states 1))( v (make-vector n)))
     (let loop (( i 0 ))
       (if (= i (- num-states 1))
           ( begin
              (set! num-states n)
              v)
           ( begin
              (vector-set! v i (vector-ref old i))
              (loop (+ i 1)))))))
     
;; execute state  n
(define (exec-state n)
  (set! state (car n))
  (eval (car(cdr n))))

;; send message to the FSM
;; if message is recognized, it advances to the new state and evaluates it's action.
(define (fsm-message n)
  ( let (( c (vector-ref fsm-vector state)))
     (if(= n (car c))
        ( (exec-state c)))))

;; parse the list and setup the vector
(define (parser p)
  (if (= (caar p) -1)
      #t     
      ( let ((c (car p)))
         (add-state ( car c )( car (cadr c))( cadr (cadr c)))
       (parser (cdr p)))))
  
;; parse-fsm driver
(define (fsm-parse program )
  (let ((c (car program)))
    (if(null? c)
       (display "error"))
    (if(eqv? c 'FSM)
       ( begin
          (set! prog-name  (cadr program))
          (set! num-states (caddr program ))
          (set! fsm-vector (make-vector num-states))
          (parser (cdddr program)))
    (display "Bad program"))))

;; test
(fsm-parse prog)

(fsm-message 1)
(fsm-message 0)
(fsm-message 1)
(fsm-message 0)

; PFSMP - Probabilistic Finite State Machine Parser
;
; Similar to FSMP, except it makes a random path from choices given to it.
; This is simulated by rolling a virtual percentile die.

; STATE RANGE(min,max) ACTION(...)

(define program '( PFSM pfsm 4
                     ( 0 0  25   (lambda()(display "1")(newline)))
                     ( 1 26 75   (lambda()(display "2")(newline)))
                     ( 2 76 90   (lambda()(display "3")(newline)))
                     ( 3 91 100  (lambda()(display "4")(newline)))))


;; roll a percentile dice
(define (roll-dice)
  (random 100))

;; name of program we are parsing.
(define prog-name "")
;; fsm-vector is a vector of all states[num] = list(next,lambda);
(define pfsm-vector '())
;; number of state in vector
(define num-states 0)
;; current state we are on now
(define state 0)
  
;; add state (number next function)
(define (add-state num min max func)
  (vector-set! pfsm-vector num (list min max func)))

(define (pfsm-message)
  ( let (( d (roll-dice))(min 0)(max 0)(v (vector-ref pfsm-vector 0)))
     ( let loop ((i 0))
        (if(= i (- num-states 1)) 
           #t
           (begin
             (set! min (car v))
             (set! max (cadr v))
             (if( and (>= d min)(<= d max))
                ((eval(caddr v)))
                (begin
                  (set! v (vector-ref pfsm-vector (+ i 1)))
                  (loop (+ i 1)))))))))

;; parse the list and setup the vector
(define (parser p)
  (if(null? p) 
     #t     
     (begin
       (let ((c (car p)))
         ;            num     min     max     action
         (add-state (car c)(cadr c)(caddr c)(cadddr c))
         (parser (cdr p))))))
         

(define (pfsm-parse program )
  (let ((c (car program)))
    (if(null? c)
       (display "error"))
    (if(eqv? c 'PFSM)
       ( begin
          (set! prog-name  (cadr program))
          (set! num-states (caddr program ))
          (set! pfsm-vector (make-vector num-states))
          (parser (cdddr program)))
    (display "Bad program"))))

;; test
(pfsm-parse program)
(let loop ((i 0))
  (if (= i 10)
      #t
      (begin        
        (pfsm-message)
        (loop (+ i 1)))))