fork download
  1. ; fsm generator
  2.  
  3. (defmacro mealy (input actions)
  4. (let ((c (gensym)) ;; Avoid variable capture
  5. (state (gensym))
  6. (out (gensym))) ;; Put output here
  7. `(loop for ,c in (coerce ,input 'list) ;; Convert input into a list
  8. with ,state = 0
  9. while (>= ,state 0)
  10. append
  11. (cond
  12. ,@(mapcar
  13. #'(lambda (statespec)
  14. (let ((thisstate (car statespec)))
  15. `((= ,state ,thisstate)
  16. (cond
  17. ,@(mapcar
  18. #'(lambda (actionspec)
  19. (let ((match (car actionspec))
  20. (newstate (cadr actionspec))
  21. (output (cddr actionspec)))
  22. `(,(if (eq match nil) t `(eq ,c ,match))
  23. ;; Reset the state if necessary
  24. ,@(if (not (= thisstate newstate)) `((setq ,state ,newstate)))
  25. (list
  26. ,@(mapcar
  27. ;; If output char is nil, just echo the input.
  28. #'(lambda(outchar) (if (eq outchar nil) c outchar))
  29. (cddr actionspec))))))
  30. (cdr statespec))))))
  31. actions)) into ,out
  32. finally (return (coerce ,out 'string)))))
  33.  
  34. (defun singleton1 (s)
  35. (mealy s
  36. ((0
  37. (#\X 1)
  38. (nil 0 nil))
  39. (1
  40. (#\X 1 #\X #\X)
  41. (nil 0 nil)))))
  42.  
  43. (print (singleton1 "XbbXXbX"))
  44.  
  45. (defun singleton2 (s c)
  46. (mealy s
  47. ((0
  48. (c 1)
  49. (nil 0 nil))
  50. (1
  51. (c 1 c c)
  52. (nil 0 nil)))))
  53.  
  54. (print (singleton2 "XbbXXbX" #\X))
  55.  
  56. (print (mealy "abcacb" ((0 (#\a 0 nil) (nil 0 nil nil)))))
Success #stdin #stdout 0.02s 10584KB
stdin
Standard input is empty
stdout
"bbXXb" 
"bbXXb" 
"abbccaccbb"