fork(2) download
copy 
  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
comments (?)
stdin
copy 
Standard input is empty
stdout
copy 
"bbXXb" 
"bbXXb" 
"abbccaccbb"
https://ideone.com/Ta3PPM
language:
Common Lisp (clisp 2.49.92)
created:
9 years ago
visibility:
public

Share or Embed source code

Discover > Sphere Engine API

The brand new service which powers Ideone!

Discover > IDE Widget

Widget for compiling and running the source code in a web browser!