extra/turing/turing.factor

   1 USING: arrays assocs io kernel math namespaces
   2 prettyprint sequences strings vectors words accessors ;
   3 IN: turing
   4
   5 ! A turing machine simulator.
   6
   7 TUPLE: state sym dir next ;
   8
   9 ! Mapping from symbol/state pairs into new-state tuples
  10 SYMBOL: states
  11
  12 ! Halting state
  13 SYMBOL: halt
  14
  15 ! This is a simple program that outputs 5 1's
  16 H{
  17     { { 1 0 } T{ state f 1  1 2    } }
  18     { { 2 0 } T{ state f 1  1 3    } }
  19     { { 3 0 } T{ state f 1 -1 1    } }
  20     { { 1 1 } T{ state f 1 -1 2    } }
  21     { { 2 1 } T{ state f 1 -1 3    } }
  22     { { 3 1 } T{ state f 1 -1 halt } }
  23 } states set
  24
  25 ! Current state
  26 SYMBOL: state
  27
  28 ! Initial state
  29 1 state set
  30
  31 ! Position of head on tape
  32 SYMBOL: position
  33
  34 ! Initial tape position
  35 5 position set
  36
  37 ! The tape, a mutable sequence of some kind
  38 SYMBOL: tape
  39
  40 ! Initial tape
  41 20 0 <array> >vector tape set
  42
  43 : sym ( -- sym )
  44     ! Symbol at head position.
  45     position get tape get nth ;
  46
  47 : set-sym ( sym -- )
  48     ! Set symbol at head position.
  49     position get tape get set-nth ;
  50
  51 : next-state ( -- state )
  52     ! Look up the next state/symbol/direction triplet.
  53     state get sym 2array states get at ;
  54
  55 : turing-step ( -- )
  56     ! Do one step of the turing machine.
  57     next-state
  58     dup sym>> set-sym
  59     dup dir>> position [ + ] change
  60     next>> state set ;
  61
  62 : c ( -- )
  63     ! Print current turing machine state.
  64     state get .
  65     tape get .
  66     2 position get 2 * + CHAR: \s <string> write "^" print ;
  67
  68 : n ( -- )
  69     ! Do one step and print new state.
  70     turing-step c ;