\ Turing.fs  Turingmaschinen-Simulator in Forth    uho 2007-12-04

: 3dup ( a b c -- a b c a b c )  >r 2dup r@ -rot r> ;
: 3drop ( a b c -- )  2drop drop ;

Variable 'head          \ Kopfposition: Adresse der aktuellen Zelle
Variable 'state-table   \ Anfangsadresse der Zustandstabelle
Variable status         \ aktueller Zustand

\ Kopfpositionierung
: sym ( -- addr )  'head @ ;
: moveright  ( -- )  1 cells 'head +! ;
: moveleft  ( -- )  -1 cells 'head +! ;
: headmove ( m -- )  IF moveleft ELSE moveright THEN ; 

\ Zeile der Zustandsübergangstabelle:
\ { Zustand | Eingabesymbol | Ausgabesymbol | Kopfbewegung | Folgezustand }
: >state ( 'row -- 'state ) ;
: >insym ( 'row -- 'state )  1 cells + ;
: >outsym ( 'row -- 'outsym )  2 cells + ;
: >movement ( 'row -- 'movement )  3 cells + ;
: >newstate ( 'row -- 'newstate )  4 cells + ;
: +row ( 'row0 -- 'row1 )  5 cells + ;

\ Durchsuchen der Zustandsübergangstabelle:
: found? ( s c 'row -- f )  swap over  >insym @ = >r  >state @ = r> and ;
: another-row? ( 'row -- f )  >r -1 -1 r> found? 0= ;
: @answer ( 'row -- s m c )  dup >r >newstate @ r@ >movement @ r> >outsym @ ;

: ?state-table ( s0 c0 -- s1 m c1 | -1 -1 -1 )
    'state-table @
    BEGIN ( s0 c0 'row )
      dup another-row? 
    WHILE ( s0 c0 'row )
      3dup found? IF >r 2drop r> @answer EXIT THEN
      +row
    REPEAT
    drop 2drop
    -1 -1 -1 ;  

\ Ein Schritt
: valid-step? ( s m c -- f )  -1 <>   swap -1 <> and   swap -1 <> and ;
: next-action ( -- s m c )  status @  sym @  ?state-table ;
: do-step ( s m c -- )  sym !  headmove  status ! ;

\ Laufen bis kein Zustandsübergang definiert
: run ( -- )  0 status !  
   BEGIN 
     next-action  3dup valid-step?
   WHILE ( s m c )
     do-step
   REPEAT 
   3drop ;

\ Notation für das Band und die Zustandsübergangstabelle
: <*>  ( -- )  here 'head ! ;
0 Constant -> 
1 Constant <-
char _ Constant _
char | Constant | 
: end-table ( -- )  -1 , -1 , -1 , -1 , -1 , ;


\ Turing-Maschine, die Strichzahlen addiert
\ Die Zahl n>=0 wird durch n+1 Striche auf dem Band
\ kodiert. Die beiden Parameter sind durch eine Lücke _ 
\ voneinander getrennt, also für 2+3 steht
\ ... _ _ _ _ | | | _ | | | | _ _ _ ... auf dem Band und
\            <*>
\ der Kopf steht auf dem ersten Strich der Zahl 2.

Create tape 
  _ ,  _ ,  _ ,   <*> | ,  | ,  | , _  ,  | ,  | ,  | ,  | ,  _ ,  _ ,  _ ,
     
Create state-table   here 'state-table !
\ state input   output movement newstate
    0 ,   | ,     | ,     -> ,    0 ,  \ überspringe alle Striche
    0 ,   _ ,     | ,     -> ,    1 ,  \ schreibe einen Strich in die Lücke
    
    1 ,   | ,     | ,     -> ,    1 ,  \ überspringe alle Striche
    1 ,   _ ,     _ ,     <- ,    2 ,  \ auf den letzten Strich
    
    2 ,   | ,     _ ,     <- ,    3 ,  \ letzten Strich löschen, auf vorletzten
    3 ,   | ,     _ ,     <- ,    4 ,  \ vorletzten Strich löschen
    
    4 ,   | ,     | ,     <- ,    4 ,  \ überspringe alle Striche rückwärts
    4 ,   _ ,     _ ,     -> ,    5 ,  \ auf den ersten Strich positionieren
end-table