turing machine simulator using TS types

turing-types.ts

// Natural Numbers
interface Zero {
  isZero: true;
}
interface Successor<N extends Nat> {
  prev: N;
  isZero: false;
}
type Nat = Zero | Successor<Nat>;

// Helpers
type Shift<T extends any[]> = ((...tuple: T) => void) extends (
  head: any,
  ...tail: infer U
) => void
  ? U
  : never;
type Unshift<U extends any[], T extends any> = ((
  a: T,
  ...t: U
) => void) extends (...t: infer R) => void
  ? R
  : never;

type NatToDecimal<
  N extends Nat,
  __acc extends { state: NatToTupleResult<Nat, any[]>; done: boolean } = {
    state: NatToTupleResult<N, []>;
    done: false;
  }
> = {
  0: NatToDecimal<N, NatToUnaryTuple_<__acc["state"], 1, []>>;
  1: __acc["state"]["tuple"]["length"];
}[__acc["done"] extends true ? 1 : 0];

// Trampoline
type NatToUnaryTuple_<
  T extends NatToTupleResult<Nat, any[]>,
  Fill extends any = 1,
  NumberOfBounces extends any[] = []
> = {
  2: { state: NatToTupleResult<T["nat"], T["tuple"]>; done: false };
  0: { state: NatToTupleResult<T["nat"], T["tuple"]>; done: true };
  1: T["nat"] extends Successor<infer U>
    ? NatToUnaryTuple_<
        NatToTupleResult<U, Unshift<T["tuple"], Fill>>,
        Fill,
        Unshift<NumberOfBounces, any>
      >
    : never;
}[T["nat"] extends Successor<Nat>
  ? NumberOfBounces["length"] extends 5
    ? 2
    : 1
  : 0];
interface NatToTupleResult<L, T> {
  nat: L;
  tuple: T;
}

// TM directions
enum Dir {
  Left,
  Right,
}
type IInstruction =
  | Instruction<string, Dir, number>
  | HaltInstruction<string, Dir>;
interface Instruction<Sym extends string, M extends Dir, N extends number> {
  write: Sym;
  move: M;
  next: N;
}
interface HaltInstruction<Sym extends string, M extends Dir> {
  write: Sym;
  move: M;
  halt: true;
}

type IFSM = {
  [K in number]: {
    [K in string]: IInstruction;
  };
};

type ICell = Nil | Cell<string, ICell>;
interface Nil {
  isNil: true;
}
interface Cell<Sym extends string, Prev extends ICell> {
  symbol: Sym;
  prev: Prev;
  isNil: false;
}

interface ITape {
  left: ICell;
  right: ICell;
  symbol: string;
}
interface NewTape<
  D extends string,
  Left extends ICell = Nil,
  Right extends ICell = Nil
> {
  symbol: D;
  left: Left;
  right: Right;
}

type WriteTape<
  Tape extends ITape,
  V extends string,
  Left extends ICell = Tape["left"],
  Right extends ICell = Tape["right"]
> = {
  symbol: V;
  left: Left;
  right: Right;
};

type MoveTape<
  M extends Dir,
  Tape extends ITape,
  EdgeSymbol extends string,
  Sym extends string = Tape["symbol"],
  Left extends ICell = Tape["left"],
  Right extends ICell = Tape["right"]
> = M extends Dir.Left
  ? Left extends Cell<infer U, infer V>
    ? NewTape<U, V, Cell<Sym, Right>>
    : Left extends Nil
    ? NewTape<EdgeSymbol, Nil, Cell<Sym, Right>>
    : never
  : M extends Dir.Right
  ? Right extends Cell<infer U, infer V>
    ? NewTape<U, Cell<Sym, Left>, V>
    : Right extends Nil
    ? NewTape<EdgeSymbol, Cell<Sym, Left>, Nil>
    : never
  : never;

type Run<
  Config extends ITMConfig,
  __acc extends { state: IProgram; done: boolean } = {
    state: Program<Config["states"], Config["input"], Config["initialState"]>;
    done: false;
  },
  EdgeSymbol extends string = Config["edgeSymbol"]
> = {
  0: Run<Config, Trampoline<__acc["state"], EdgeSymbol, []>>;
  1: __acc["state"];
}[__acc["done"] extends true ? 1 : 0];

// Use the "trampoline" technique to avoid being caught by TS deep recursion checks
// It'll recurse a limited number of times before returning. The parent function can
// then call the trampoline again to continue with a fresh stack
type MAX_JUMPS = 14;

type GetInstruction<
  P extends IProgram
> = P["states"][P["counter"]][P["tape"]["symbol"]];

type Trampoline<
  P extends IProgram,
  EdgeSymbol extends string,
  NumberOfBounces extends any[],
  Inst extends IInstruction = GetInstruction<P>
> = {
  0: Inst extends HaltInstruction<infer S, infer M>
    ? {
        state: Program<
          P["states"],
          MoveTape<M, WriteTape<P["tape"], S>, EdgeSymbol>,
          P["counter"],
          Successor<P["steps"]>
        >;
        done: true;
      }
    : never;
  1: Inst extends Instruction<infer S, infer M, infer N>
    ? Trampoline<
        Program<
          P["states"],
          MoveTape<M, WriteTape<P["tape"], S>, EdgeSymbol>,
          N,
          Successor<P["steps"]>
        >,
        EdgeSymbol,
        Unshift<NumberOfBounces, any>
      >
    : never;
  2: { state: P; done: false };
}[Inst extends HaltInstruction<string, Dir>
  ? 0
  : NumberOfBounces["length"] extends MAX_JUMPS
  ? 2
  : 1];

interface Program<
  States extends IFSM,
  TTape extends ITape,
  CurrentState extends keyof IFSM,
  Steps extends Nat = Zero
> {
  states: States;
  counter: CurrentState;
  tape: TTape;
  steps: Steps;
}
interface IProgram {
  states: IFSM;
  tape: ITape;
  counter: number;
  steps: Nat;
}

interface ITMConfig {
  states: IFSM;
  initialState: number;
  edgeSymbol: string;
  input: ITape;
}
type TMConfigTuple<
  EdgeSymbol extends TupleTape[number],
  InitState extends keyof States,
  States extends IFSM,
  TupleTape extends string[] = [EdgeSymbol],
  Head extends Nat = Zero
> = {
  states: States;
  initialState: InitState;
  edgeSymbol: EdgeSymbol;
  input: TupleToTape<TupleTape, Head> extends { tape: infer U } ? U : never;
};
// Use this if you want output of one TM as input to another
type TMConfigTape<
  EdgeSymbol extends string,
  InitState extends keyof States,
  States extends IFSM,
  Tape extends ITape
> = {
  states: States;
  initialState: InitState;
  edgeSymbol: EdgeSymbol;
  input: Tape;
};

// Conversion tools
// Convert tuple format into internal tape format
type TupleToTape<Tuple extends string[], Head extends Nat> = TupleToTape_<
  TupleToTapeResult<Tuple, Zero, Head, NewTape<"#">, false>
>;

type TupleToTape_<
  T extends {
    tuple: string[];
    idx: Nat;
    head: Nat;
    tape: ITape;
    isPastHead: boolean;
  }
> = {
  0: T;
  1: T extends TupleToTapeResult<
    infer Tup,
    infer Idx,
    infer Head,
    infer Tape,
    infer IsPastHead,
    infer TupCopy
  >
    ? Idx extends Head
      ? TupleToTape_<
          TupleToTapeResult<
            Shift<Tup>,
            Successor<Idx>,
            Head,
            WriteTape<Tape, Tup[0]>,
            true,
            Shift<Tup>
          >
        >
      : IsPastHead extends true
      ? TupleToTape_<
          TupleToTapeResult<
            Shift<Tup>,
            Successor<Idx>,
            Head,
            PushRightStack<Tape, TupCopy[Shift<Tup>["length"]]>,
            true,
            TupCopy
          >
        >
      : TupleToTape_<
          TupleToTapeResult<
            Shift<Tup>,
            Successor<Idx>,
            Head,
            PushLeftStack<Tape, Tup[0]>,
            false
          >
        >
    : never;
}[T["tuple"] extends [] ? 0 : 1];

interface TupleToTapeResult<
  Tuple extends string[],
  Idx extends Nat,
  Head extends Nat,
  Tape extends ITape,
  IsPastHead extends boolean = false,
  TupleCopy extends string[] = Tuple
> {
  tuple: Tuple;
  tupleCopy: TupleCopy;
  idx: Idx;
  head: Head;
  tape: Tape;
  isPastHead: IsPastHead;
}

type PushRightStack<Tape extends ITape, D extends string> = NewTape<
  Tape["symbol"],
  Tape["left"],
  Cell<D, Tape["right"]>
>;
type PushLeftStack<Tape extends ITape, D extends string> = NewTape<
  Tape["symbol"],
  Cell<D, Tape["left"]>,
  Tape["right"]
>;

// Pretty print the internal tape format
type TapeToDisplay<T extends ITape, Tup extends string[] = []> = [
  StackToTuple<T["left"], Tup>,
  [T["symbol"]],
  StackToTupleReverse<T["right"], Tup>
];

type StackToTuple<
  Stack extends ICell,
  Tuple extends string[] = []
> = Stack extends Cell<infer U, infer T>
  ? T extends Nil
    ? Tuple["length"] extends 0
      ? [U]
      : Unshift<Tuple, U>
    : StackToTuple<T, Tuple["length"] extends 0 ? [U] : Unshift<Tuple, U>>
  : Tuple;

type StackToTupleReverse<
  Stack extends ICell,
  Tuple extends string[] = [],
  StackR extends ICell = Nil
> = Stack extends Cell<infer U, infer T>
  ? T extends Nil
    ? StackToTuple<StackR, [U]>
    : StackToTupleReverse<T, Tuple, Cell<U, StackR>>
  : Tuple;

// Busy Beaver machines

// 1-state 2-symbol machine
type BB1FSM = {
  0: {
    "0": HaltInstruction<"1", Dir.Right>;
  };
};
type BB1Config = TMConfigTuple<"0", 0, BB1FSM>;
type BB1Run = Run<BB1Config>;
type BB1StepCount = NatToDecimal<BB1Run["steps"]>;
type BB1Output = TapeToDisplay<BB1Run["tape"]>;

// 2-state 2-symbol machine
type BB2FSM = {
  0: {
    "0": Instruction<"1", Dir.Right, 1>;
    "1": Instruction<"1", Dir.Left, 1>;
  };
  1: {
    "0": Instruction<"1", Dir.Left, 0>;
    "1": HaltInstruction<"1", Dir.Right>;
  };
};
type BB2Config = TMConfigTuple<"0", 0, BB2FSM>;
type BB2Run = Run<BB2Config>;
type BB2StepCount = NatToDecimal<BB2Run["steps"]>;
type BB2Output = TapeToDisplay<BB2Run["tape"]>;

// Binary Adder
// Adds two binary numbers separated by a blank
type BinaryAdderFSM = {
  // move right to end of first block
  0: {
    "0": Instruction<"0", Dir.Right, 0>;
    "1": Instruction<"1", Dir.Right, 0>;
    _: Instruction<"_", Dir.Right, 1>;
  };
  // move right to end of second block
  1: {
    "0": Instruction<"0", Dir.Right, 1>;
    "1": Instruction<"1", Dir.Right, 1>;
    _: Instruction<"_", Dir.Left, 2>;
  };
  // subtract one in binary
  2: {
    "0": Instruction<"1", Dir.Left, 2>;
    "1": Instruction<"0", Dir.Left, 3>;
    _: Instruction<"_", Dir.Right, 5>;
  };
  // move left to end of first block
  3: {
    "0": Instruction<"0", Dir.Left, 3>;
    "1": Instruction<"1", Dir.Left, 3>;
    _: Instruction<"_", Dir.Left, 4>;
  };
  // add one in binary
  4: {
    "0": Instruction<"1", Dir.Right, 0>;
    "1": Instruction<"0", Dir.Left, 4>;
    _: Instruction<"1", Dir.Right, 0>;
  };
  // clean up and stop
  5: {
    "0": Instruction<"_", Dir.Right, 5>;
    "1": Instruction<"_", Dir.Right, 5>;
    _: HaltInstruction<"_", Dir.Right>;
  };
};
type TMTape = ["1","1","1", "_", "1", "1", "_"];
type BinaryAdderConfig = TMConfigTuple<"_", 0, BinaryAdderFSM, TMTape>;
type Result = Run<BinaryAdderConfig>;

type steps = NatToDecimal<Result["steps"]>;
type output = TapeToDisplay<Result["tape"]>;

This is too much beauty and elegance! What a masterpiece.