122 lines
2.8 KiB
Racket
122 lines
2.8 KiB
Racket
#lang racket
|
|
|
|
; utils - wont change
|
|
|
|
(define def-symbol '())
|
|
(define start-state '())
|
|
(define input '())
|
|
|
|
(define (set-def! x)
|
|
(set! def-symbol x))
|
|
|
|
(define (set-start! x)
|
|
(set! start-state x))
|
|
|
|
(define (set-input! x)
|
|
(set! start-state x))
|
|
|
|
(define (pre t)
|
|
(car t))
|
|
|
|
(define (cur t)
|
|
(cadr t))
|
|
|
|
(define (aft t)
|
|
(caddr t))
|
|
|
|
(define (shiftr t)
|
|
(let* [(c (cur t))
|
|
(p (pre t))
|
|
(a (aft t))
|
|
(a (if (null? a)
|
|
(list def-symbol)
|
|
a))]
|
|
`(,(append p (list c))
|
|
,(car a)
|
|
,(cdr a))))
|
|
|
|
(define (shiftl t)
|
|
(let* [(c (cur t))
|
|
(p (pre t))
|
|
(a (aft t))
|
|
(p (if (null? p)
|
|
(list def-symbol)
|
|
p))]
|
|
`(,(reverse (cdr (reverse p)))
|
|
,(car (reverse p))
|
|
,(cons c a))))
|
|
|
|
(define (write-sym s t)
|
|
(let [(p (pre t))
|
|
(a (aft t))]
|
|
`(,p ,s ,a)))
|
|
|
|
(define (list->tape l)
|
|
`(() ,(car l) ,(cdr l)))
|
|
|
|
(define trans-map (make-hash))
|
|
|
|
(define (transition current-state tape)
|
|
(let [(f (hash-ref trans-map `(,current-state ,(cur tape)) #f))]
|
|
(if (eq? f #f)
|
|
`(,current-state ,tape)
|
|
(let* [(new-sym (first f))
|
|
(dir (second f))
|
|
(new-state (third f))
|
|
(dir-op (if (eq? 'L dir)
|
|
shiftl
|
|
shiftr))
|
|
(new-tape (dir-op (write-sym new-sym tape)))]
|
|
(transition new-state new-tape)))))
|
|
|
|
(define (tape->list t)
|
|
(let [(flat-tape (append (pre t) (list (cur t)) (aft t)))
|
|
(f (lambda (x) (eq? x def-symbol)))]
|
|
(reverse (drop-while f (reverse (drop-while f flat-tape))))))
|
|
|
|
(define (drop-while f l)
|
|
(if (null? l)
|
|
l
|
|
(if (f (car l))
|
|
(drop-while f (cdr l))
|
|
l)))
|
|
|
|
(define (display-result input)
|
|
(let* [(res (transition start-state (list->tape input)))
|
|
(fin-state (car res))
|
|
(fin-tape (tape->list (cadr res)))]
|
|
(void
|
|
(printf "Initial State: ~a~nInitial Tape:~n~a~nFinal State: ~a~nFinal Tape:~n~a~n" start-state input fin-state fin-tape))))
|
|
|
|
(provide trans-map)
|
|
(provide display-result)
|
|
(provide set-def!)
|
|
(provide set-start!)
|
|
|
|
;; per machine - will change
|
|
;
|
|
;(define def-symbol 'e)
|
|
;(define start-state '1)
|
|
;
|
|
;(hash-set! trans-map '(1 a) '(b R 2))
|
|
;(hash-set! trans-map '(1 c) '(c R 4))
|
|
;
|
|
;(hash-set! trans-map '(2 a) '(a R 2))
|
|
;(hash-set! trans-map '(2 c) '(c R 2))
|
|
;(hash-set! trans-map '(2 e) '(c L 3))
|
|
;
|
|
;(hash-set! trans-map '(3 a) '(a L 3))
|
|
;(hash-set! trans-map '(3 c) '(c L 3))
|
|
;(hash-set! trans-map '(3 b) '(b R 1))
|
|
;
|
|
;(hash-set! trans-map '(4 c) '(c R 4))
|
|
;(hash-set! trans-map '(4 e) '(e L 5))
|
|
;
|
|
;(hash-set! trans-map '(5 c) '(a L 5))
|
|
;(hash-set! trans-map '(5 b) '(a L 5))
|
|
;(hash-set! trans-map '(5 e) '(e R F))
|
|
;
|
|
;; fin
|
|
;
|
|
;(display-result '(a a a a a))
|