susisu · March 9, 2020 20:08 · Mar 9, 2020
diff --git a/brainfuck.ts b/brainfuck.ts
@@ -0,0 +1,121 @@
+// Type-level Brainfuck interpreter in TypeScript
+// Copyright (c) 2020 Susisu (susisu2413@yahoo.co.jp)
+
+type State<P, M, I, O, R, K> = {
+  program: P,
+  memory: M,
+  input: I,
+  output: O,
+  return: R,
+  skip: K,
+};
+
+type Token = "+" | "-" | ">" | "<" | "," | "." | "[" | "]";
+
+type Byte =
+  | 0x0 | 0x1 | 0x2 | 0x3
+  | 0x4 | 0x5 | 0x6 | 0x7
+  | 0x8 | 0x9 | 0xA | 0xB
+  | 0xC | 0xD | 0xE | 0xF;
+
+type Succ<B> =
+    B extends 0x0 ? 0x1 : B extends 0x1 ? 0x2 : B extends 0x2 ? 0x3 : B extends 0x3 ? 0x4
+  : B extends 0x4 ? 0x5 : B extends 0x5 ? 0x6 : B extends 0x6 ? 0x7 : B extends 0x7 ? 0x8
+  : B extends 0x8 ? 0x9 : B extends 0x9 ? 0xA : B extends 0xA ? 0xB : B extends 0xB ? 0xC
+  : B extends 0xC ? 0xD : B extends 0xD ? 0xE : B extends 0xE ? 0xF : B extends 0xF ? 0x0
+  : never;
+type Pred<B> =
+    B extends 0x0 ? 0xF : B extends 0x1 ? 0x0 : B extends 0x2 ? 0x1 : B extends 0x3 ? 0x2
+  : B extends 0x4 ? 0x3 : B extends 0x5 ? 0x4 : B extends 0x6 ? 0x5 : B extends 0x7 ? 0x6
+  : B extends 0x8 ? 0x7 : B extends 0x9 ? 0x8 : B extends 0xA ? 0x9 : B extends 0xB ? 0xA
+  : B extends 0xC ? 0xB : B extends 0xD ? 0xC : B extends 0xE ? 0xD : B extends 0xF ? 0xE
+  : never;
+
+type Nil = null;
+type Cons<X, XS> = [X, XS];
+
+type Car<XS> = XS extends Cons<infer Y, infer _YS> ? Y : never;
+type Cdr<XS> = XS extends Cons<infer _Y, infer YS> ? YS : never;
+
+type Memory<L, H, R,> = {
+  left: L,
+  head: H,
+  right: R,
+};
+
+type Read<M> = M extends Memory<infer _L, infer H, infer _R> ? (
+  H
+) : never;
+type Write<M, B> = M extends Memory<infer L, infer _H, infer R> ? (
+  Memory<L, B, R>
+) : never;
+type MoveLeft<M> = M extends Memory<infer L, infer H, infer R> ? (
+  L extends Nil
+    ? Memory<Nil, 0x0, Cons<H, R>>
+    : Memory<Cdr<L>, Car<L>, Cons<H, R>>
+) : never;
+type MoveRight<M> = M extends Memory<infer L, infer H, infer R> ? (
+  R extends Nil
+    ? Memory<Cons<H, L>, 0x0, Nil>
+    : Memory<Cons<H, L>, Car<R>, Cdr<R>>
+) : never;
+
+type Init<P = Nil, I = Nil> = State<P, Memory<Nil, 0x0, Nil>, I, Nil, Nil, Nil>;
+
+type Next<S> = S extends State<infer P, infer M, infer I, infer O, infer R, infer K> ? (
+  K extends Nil
+    ? NextProc<P, M, I, O, R>
+    : NextSkip<P, M, I, O, R, K>
+) : never;
+type NextProc<P, M, I, O, R> = P extends Cons<infer T, infer Q> ? (
+    T extends "+" ? State<Q, Write<M, Succ<Read<M>>>, I, O, R, Nil>
+  : T extends "-" ? State<Q, Write<M, Pred<Read<M>>>, I, O, R, Nil>
+  : T extends ">" ? State<Q, MoveRight<M>, I, O, R, Nil>
+  : T extends "<" ? State<Q, MoveLeft<M>, I, O, R, Nil>
+  : T extends "," ? I extends Nil
+    ? never
+    : State<Q, Write<M, Car<I>>, Cdr<I>, O, R, Nil>
+  : T extends "." ? State<Q, M, I, Cons<Read<M>, O>, R, Nil>
+  : T extends "[" ? Read<M> extends 0x0
+    ? State<Q, M, I, O, R, Cons<Nil, Nil>>
+    : State<Q, M, I, O, Cons<P, R>, Nil>
+  : T extends "]" ? R extends Nil
+    ? never
+    : State<Car<R>, M, I, O, Cdr<R>, Nil>
+  : State<Q, M, I, O, R, Nil>
+) : never;
+type NextSkip<P, M, I, O, R, K> = P extends Cons<infer T, infer Q> ? (
+    T extends "[" ? State<Q, M, I, O, R, Cons<Nil, K>>
+  : T extends "]" ? State<Q, M, I, O, R, Cdr<K>>
+  : State<Q, M, I, O, R, K>
+) : never;
+
+type Run<S> = Flatten<RunSub<S>>;
+type RunSub<S> = S extends State<infer P, infer _M, infer _I, infer O, infer R, infer K> ? (
+  P extends Nil
+    ? (R extends Nil ? K extends Nil ? O : never : never)
+    : { next: RunSub<Next<S>> }
+) : never;
+
+type Flatten<T, H extends "__hack" = "__hack"> =
+  T extends { next: unknown }
+    ? { [H0 in H]: Flatten<FlattenSub<T>> }[H]
+    : T;
+type FlattenSub<T> =
+    T extends { next: { next: infer U } } ? { next: FlattenSub<U> }
+  : T extends { next: infer U } ? U
+  : T;
+
+export type Brainfuck<P extends Token[] = [], I extends Byte[] = []> =
+  FromRevConsList<Run<Init<ToConsList<P>, ToConsList<I>>>>;
+
+type ToConsList<XS extends unknown[]> =
+    XS extends [] ? Nil
+  : ((...xs: XS) => unknown) extends (y: infer Y, ...ys: infer YS) => unknown ? [Y, ToConsList<YS>]
+  : never;
+type FromRevConsList<XS, YS extends unknown[] = [], H extends "__hack" = "__hack"> =
+  XS extends Nil
+    ? YS
+    : { [H0 in H]: FromRevConsList<Cdr<XS>, Unshift<Car<XS>, YS>> }[H];
+type Unshift<X, XS extends unknown[]> =
+  ((x: X, ...xs: XS) => unknown) extends (...ys: infer YS) => unknown ? YS : never;