4 people like it.

Turing machine interpreter

A Turing machine emulator. An infinite tape is simulated by a zipper, instructions are stored in the binary tree for faster lookup.

 ``` 1: 2: 3: 4: 5: 6: 7: 8: 9: 10: 11: 12: 13: 14: 15: 16: 17: 18: 19: 20: 21: 22: 23: 24: 25: 26: 27: 28: 29: 30: 31: 32: 33: 34: 35: 36: 37: 38: 39: 40: 41: 42: 43: 44: 45: 46: 47: 48: 49: 50: 51: 52: 53: 54: 55: 56: 57: 58: 59: 60: 61: 62: 63: 64: 65: 66: 67: 68: 69: 70: 71: 72: 73: 74: 75: 76: 77: 78: 79: 80: 81: 82: 83: 84: 85: 86: 87: 88: 89: 90: 91: 92: 93: 94: 95: 96: 97: 98: 99: 100: 101: 102: 103: 104: 105: 106: 107: 108: 109: 110: ``` ``````(* we store our instructions in the binary tree for faster search *) type 'a Tree when 'a : comparison = | Nil | Node of 'a * ('a Tree) * ('a Tree) let Leaf x = Node(x, Nil, Nil) type State = int type Base = char (* tape is represented by a zipper *) type Ribbon = (Base list)*(Base list) type OP = L | R | U | H type Instr = State * Base * Base * State * OP type Prog = Instr Tree type TM = Prog * State * Ribbon let insert x T = let rec insert' x T cont = match T with | Nil -> cont (Leaf x) | Node(a, l, r) -> if (x > a) then insert' x r (fun e -> cont <| Node(a, l, e)) else insert' x l (fun e -> cont <| Node(a, e, r)) insert' x T id let flip f x y = f y x let curry f x y = f (x, y) let uncurry f (x, y) = f x y (* creating a tape structure from a string *) let mkrib (s : string) = ([' '], s.ToCharArray() |> List.ofArray) (* equivalent to List.append << List.rev *) let rec rev_append l1 l2 = match l1 with | [] -> l2 | h::t -> rev_append t (h::l2) (* move the head according to the operation *) let proc rib op = match op,rib with | U,_ -> rib | L,([],r) -> ([], ' '::r) | L,(h::t, r) -> (t, h::r) | R,(l,h::[]) -> (h::l, [' ']) | R,(l, h::t) -> (h::l, t) | H,(l, r) -> ([],rev_append l r) (* Find an instruction in the instructions tree *) let rec find fSt fSym = function | Nil -> failwith "Not found" | Node((st,sym,nsym,nst,op), l, r) -> if (fSt,fSym) = (st,sym) then (st,sym,nsym,nst,op) elif (fSt,fSym) <= (st,sym) then find fSt fSym l else find fSt fSym r let findInstr st sym (P : Prog) = find st sym P (* simulate a step of the machine *) let step ((P, st, (ribL, sym::ribR)) : TM) = let (_,_,nsym,nst,op) = findInstr st sym P let newrib = proc (ribL, nsym::ribR) op (P, nst, newrib) (* Print the tape *) let print (P, st, (ribL,ribR)) = for c in (List.rev ribL) do printf "%c " c printf "[%c] " <| List.head ribR for c in (List.tail ribR) do printf "%c " c printf "\n" let rec run ((P, st, rib) : TM) = match rib with (* if the left part of the ribbon is nil, then halt *) | ([],_) -> (P, st, rib) | (l, r) -> print (P, st, rib) let n = step (P,st,rib) run n (* example machine: binary addition *) let mtadd = ( [(0,'0','0',0,R); (0,'1','1',0,R); (0,' ',' ',1,R); (1,'0','0',1,R); (1,'1','1',1,R); (1,' ',' ',2,L); (2,'1','0',3,L); (2,'0','1',2,L); (2,' ',' ',5,R); (3,'1','1',3,L); (3,'0','0',3,L); (3,' ',' ',4,L); (4,'1','0',4,L); (4,'0','1',0,R); (4,' ',' ',0,R); (5,'1',' ',5,R); (5,' ',' ',5,H)] |> List.fold (flip insert) Nil, 0, mkrib "001110 101") run mtadd ``````
union case Tree.Nil: 'a Tree
union case Tree.Node: 'a * 'a Tree * 'a Tree -> 'a Tree
type Tree<'a (requires comparison)> =
| Nil
| Node of 'a * 'a Tree * 'a Tree

Full name: Script.Tree<_>
val Leaf : x:'a -> 'a Tree (requires comparison)

Full name: Script.Leaf
val x : 'a (requires comparison)
type State = int

Full name: Script.State
Multiple items
val int : value:'T -> int (requires member op_Explicit)

Full name: Microsoft.FSharp.Core.Operators.int

--------------------
type int = int32

Full name: Microsoft.FSharp.Core.int

--------------------
type int<'Measure> = int

Full name: Microsoft.FSharp.Core.int<_>
type Base = char

Full name: Script.Base
Multiple items
val char : value:'T -> char (requires member op_Explicit)

Full name: Microsoft.FSharp.Core.Operators.char

--------------------
type char = System.Char

Full name: Microsoft.FSharp.Core.char
type Ribbon = Base list * Base list

Full name: Script.Ribbon
type 'T list = List<'T>

Full name: Microsoft.FSharp.Collections.list<_>
type OP =
| L
| R
| U
| H

Full name: Script.OP
union case OP.L: OP
union case OP.R: OP
union case OP.U: OP
union case OP.H: OP
type Instr = State * Base * Base * State * OP

Full name: Script.Instr
type Prog = Instr Tree

Full name: Script.Prog
type TM = Prog * State * Ribbon

Full name: Script.TM
val insert : x:'a -> T:'a Tree -> 'a Tree (requires comparison)

Full name: Script.insert
val T : 'a Tree (requires comparison)
val insert' : ('b -> 'b Tree -> ('b Tree -> 'c) -> 'c) (requires comparison)
val x : 'b (requires comparison)
val T : 'b Tree (requires comparison)
val cont : ('b Tree -> 'c) (requires comparison)
val a : 'b (requires comparison)
val l : 'b Tree (requires comparison)
val r : 'b Tree (requires comparison)
val e : 'b Tree (requires comparison)
val id : x:'T -> 'T

Full name: Microsoft.FSharp.Core.Operators.id
val flip : f:('a -> 'b -> 'c) -> x:'b -> y:'a -> 'c

Full name: Script.flip
val f : ('a -> 'b -> 'c)
val x : 'b
val y : 'a
val curry : f:('a * 'b -> 'c) -> x:'a -> y:'b -> 'c

Full name: Script.curry
val f : ('a * 'b -> 'c)
val x : 'a
val y : 'b
val uncurry : f:('a -> 'b -> 'c) -> x:'a * y:'b -> 'c

Full name: Script.uncurry
val mkrib : s:string -> char list * char list

Full name: Script.mkrib
val s : string
Multiple items
val string : value:'T -> string

Full name: Microsoft.FSharp.Core.Operators.string

--------------------
type string = System.String

Full name: Microsoft.FSharp.Core.string
System.String.ToCharArray() : char []
System.String.ToCharArray(startIndex: int, length: int) : char []
Multiple items
module List

from Microsoft.FSharp.Collections

--------------------
type List<'T> =
| ( [] )
| ( :: ) of Head: 'T * Tail: 'T list
interface IEnumerable
interface IEnumerable<'T>
member IsEmpty : bool
member Item : index:int -> 'T with get
member Length : int
member Tail : 'T list
static member Cons : head:'T * tail:'T list -> 'T list
static member Empty : 'T list

Full name: Microsoft.FSharp.Collections.List<_>
val ofArray : array:'T [] -> 'T list

Full name: Microsoft.FSharp.Collections.List.ofArray
val rev_append : l1:'a list -> l2:'a list -> 'a list

Full name: Script.rev_append
val l1 : 'a list
val l2 : 'a list
val h : 'a
val t : 'a list
val proc : char list * char list -> op:OP -> char list * char list

Full name: Script.proc
val rib : char list * char list
val op : OP
val r : char list
val h : char
val t : char list
val l : char list
val find : fSt:'a -> fSym:'b -> _arg1:('a * 'b * 'c * 'd * 'e) Tree -> 'a * 'b * 'c * 'd * 'e (requires comparison and comparison and comparison and comparison and comparison)

Full name: Script.find
val fSt : 'a (requires comparison)
val fSym : 'b (requires comparison)
val failwith : message:string -> 'T

Full name: Microsoft.FSharp.Core.Operators.failwith
val st : 'a (requires comparison)
val sym : 'b (requires comparison)
val nsym : 'c (requires comparison)
val nst : 'd (requires comparison)
val op : 'e (requires comparison)
val l : ('a * 'b * 'c * 'd * 'e) Tree (requires comparison and comparison and comparison and comparison and comparison)
val r : ('a * 'b * 'c * 'd * 'e) Tree (requires comparison and comparison and comparison and comparison and comparison)
val findInstr : st:State -> sym:Base -> P:Prog -> State * Base * Base * State * OP

Full name: Script.findInstr
val st : State
val sym : Base
val P : Prog
val step : Prog * State * Ribbon -> Prog * State * (char list * char list)

Full name: Script.step
val ribL : Base list
val ribR : Base list
val nsym : Base
val nst : State
val newrib : char list * char list
val print : P:'a * st:'b * (char list * char list) -> unit

Full name: Script.print
val P : 'a
val st : 'b
val ribL : char list
val ribR : char list
val c : char
val rev : list:'T list -> 'T list

Full name: Microsoft.FSharp.Collections.List.rev
val printf : format:Printf.TextWriterFormat<'T> -> 'T

Full name: Microsoft.FSharp.Core.ExtraTopLevelOperators.printf
val head : list:'T list -> 'T

val tail : list:'T list -> 'T list

Full name: Microsoft.FSharp.Collections.List.tail
val run : Prog * State * Ribbon -> Prog * State * Ribbon

Full name: Script.run
val rib : Ribbon
val l : Base list
val r : Base list
val n : Prog * State * (char list * char list)
val mtadd : (int * char * char * int * OP) Tree * int * (char list * char list)

val fold : folder:('State -> 'T -> 'State) -> state:'State -> list:'T list -> 'State

Full name: Microsoft.FSharp.Collections.List.fold