图灵机运作原理及示例
((lambda (l m)
`(,l
',l
',((lambda (M)
(letrec ((TAPE (cadar M))
(HEAD (cadadr M))
(POS (cadar HEAD))
(cur-alpha (list-ref TAPE POS))
(STATUS (cadadr HEAD))
(ROLES (cadr (caddr HEAD)))
(findfirst
(lambda (q a l)
(if (null? l)
'()
(if (and (eq? q (caar l)) (eq? a (cadar l)))
(cddar l)
(findfirst q a (cdr l))))))
(should!
(lambda ()
(let* ((v (findfirst STATUS cur-alpha ROLES))
(v3 (car v))
(v4 (cadr v))
(v5 (car (cddr v))))
(set! TAPE (list-set TAPE POS v3))
(cond
((eq? 'L v4)
(if (<= POS 0)
(set! TAPE (cons '() TAPE))
(set! POS (- POS 1))))
((eq? 'R v4)
(if (>= POS (- (length TAPE) 1))
(begin
(set! TAPE (append TAPE '(())))
(set! POS (+ POS 1)))
(set! POS (+ POS 1)))))
(set! STATUS v5)))))
(should!)
`((TAPE ,TAPE)
(HEAD ((POS ,POS) (STATUS ,STATUS) (ROLES ,ROLES))))))
m)))
'(lambda (l m)
`(,l
',l
',((lambda (M)
(letrec ((TAPE (cadar M))
(HEAD (cadadr M))
(POS (cadar HEAD))
(cur-alpha (list-ref TAPE POS))
(STATUS (cadadr HEAD))
(ROLES (cadr (caddr HEAD)))
(findfirst
(lambda (q a l)
(if (null? l)
'()
(if (and (eq? q (caar l)) (eq? a (cadar l)))
(cddar l)
(findfirst q a (cdr l))))))
(should!
(lambda ()
(let* ((v (findfirst STATUS cur-alpha ROLES))
(v3 (car v))
(v4 (cadr v))
(v5 (car (cddr v))))
(set! TAPE (list-set TAPE POS v3))
(cond
((eq? 'L v4)
(if (<= POS 0)
(set! TAPE (cons '() TAPE))
(set! POS (- POS 1))))
((eq? 'R v4)
(if (>= POS (- (length TAPE) 1))
(begin
(set! TAPE (append TAPE '(())))
(set! POS (+ POS 1)))
(set! POS (+ POS 1)))))
(set! STATUS v5)))))
(should!)
`((TAPE ,TAPE)
(HEAD ((POS ,POS) (STATUS ,STATUS) (ROLES ,ROLES))))))
m)))
'((TAPE (1 1 1 1 b 1 1 1 b b))
(HEAD
((POS 0)
(STATUS q1)
(ROLES
((q1 1 1 R q1)
(q1 b 1 R q2)
(q2 1 1 R q2)
(q2 b b L q3)
(q3 1 b H q3)
(q3 b b H q3)))))))
