Brainfuck interpreter

src/bf.ts

@@ -0,0 +1,85 @@
+import { L, _, fromNative as __ } from './core';
+import { Bool, iif } from './bool';
+import { Num, Zero, ge, ifz, pred, succ } from './num';
+import { x00 } from './byte';
+import { Char, fromChar as _c, dec as cdec, inc as cinc, eq, ifn } from './char';
+import { Pair, first, fst, second, snd, uncurry } from './pair';
+import { List, Nil, cons, head, repeat, set, tail, update } from './list';
+import { Empty, String, get, len, snoc } from './string';
+
+type Program = Pair<List<Num>, String>;
+
+type Tape = Pair<Num, List<Char>>;
+
+type IO = Pair<String, String>;
+
+type State = Pair<Program, Pair<Tape, IO>>;
+
+const pcommand: L<(p: Program) => Char>
+  = uncurry._(_(is => get._(head._(is))));
+
+const padvance: L<(p: Program) => Program>
+  = first._(update._(succ)._(Zero));
+
+const pjump: L<(d: Num) => L<(p: Program) => Program>>
+  = _(d => _(p =>
+    iif._<Program>(eq._(_c('['))._(pcommand._(p)))._(pjump._(succ._(d))._(padvance._(p)))
+      ._(iif._<Program>(eq._(_c(']'))._(pcommand._(p)))._(ifz._<Program>(pred._(d))._(p)._(pjump._(pred._(d))._(padvance._(p))))
+        ._(pjump._(d)._(padvance._(p))))));
+
+const done: L<(s: State) => Bool>
+  = _(s => uncurry._(_(is => _(cs => ge._(head._(is))._(len._(cs)))))._(fst._(s)));
+
+const command: L<(s: State) => Char>
+  = _(s => pcommand._(fst._(s)));
+
+const advance: L<(s: State) => State>
+  = first._(padvance);
+
+const jump: L<(s: State) => State>
+  = first._(pjump._(Zero));
+
+const save: L<(s: State) => State>
+  = first._(first._(_(is => cons._(head._(is))._(is))));
+
+const restore: L<(s: State) => State>
+  = first._(first._(tail));
+
+const reset: L<(s: State) => State>
+  = first._(first._(_(is => cons._(head._(is))._(tail._(tail._(is))))));
+
+const inc: L<(t: State) => State>
+  = second._(first._(_(t => second._(update._(cinc)._(fst._(t)))._(t))));
+
+const dec: L<(t: State) => State>
+  = second._(first._(_(t => second._(update._(cdec)._(fst._(t)))._(t))));
+
+const read: L<(s: State) => Char>
+  = _(s => uncurry._(get)._(fst._(snd._(s))));
+
+const input: L<(s: State) => State>
+  = second._(uncurry._(_(t => _(io => Pair._(second._(set._(head._(fst._(io)))._(fst._(t)))._(t))._(first._(tail)._(io))))));
+
+const output: L<(s: State) => State>
+  = second._(uncurry._(_(t => _(io => Pair._(t)._(second._(_(os => snoc._(os)._(uncurry._(get)._(t))))._(io))))));
+
+const next: L<(t: State) => State>
+  = second._(first._(first._(succ)));
+
+const prev: L<(t: State) => State>
+  = second._(first._(first._(pred)));
+
+const exec: L<(s: State) => State>
+  = _(s => iif._<State>(done._(s))._(s)._(exec._(advance
+    ._(iif._<State>(eq._(_c('>'))._(command._(s)))._(next._(s))
+      ._(iif._<State>(eq._(_c('<'))._(command._(s)))._(prev._(s))
+        ._(iif._<State>(eq._(_c('+'))._(command._(s)))._(inc._(s))
+          ._(iif._<State>(eq._(_c('-'))._(command._(s)))._(dec._(s))
+            ._(iif._<State>(eq._(_c('.'))._(command._(s)))._(output._(s))
+              ._(iif._<State>(eq._(_c(','))._(command._(s)))._(input._(s))
+                ._(iif._<State>(eq._(_c('['))._(command._(s)))._(ifn._<State>(read._(s))._(jump._(s))._(save._(s)))
+                  ._(iif._<State>(eq._(_c(']'))._(command._(s)))._(ifn._<State>(read._(s))._(reset._(s))._(save._(restore._(s))))
+                    ._(s))))))))))));
+
+export const run: L<(p: String) => L<(i: String) => String>>
+  = _(p => _(i => snd._(snd._(snd._(exec._(Pair._(Pair._(cons._(Zero)._(Nil))._(p))._(Pair._(Pair._(Zero)._(repeat._(x00)))._(Pair._(i)._(Empty)))))))));

src/byte.ts

@@ -0,0 +1,34 @@
+import { L, _, id } from './core';
+import { iif } from './bool';
+import { Num, Succ, Zero, fromNumber as _n, eq } from './num';
+
+export type Byte = Num;
+
+export const x00: Byte
+  = Zero;
+
+export const xFF: Num
+  = _n(255);
+
+export const Inc: L<(p: Byte) => Byte>
+  = _(p => iif._(eq._(xFF)._(p))._(x00)._(Succ._(p)));
+
+export { ifz, cmp, lt, le, eq, ge, gt, even, odd, div, mod, show, toNumber } from './num';
+
+export const inc: L<(n: Byte) => Byte>
+  = Inc;
+
+export const dec: L<(n: Byte) => Byte>
+  = _(n => n._(xFF)._(id));
+
+export const sum: L<(l: Byte) => L<(r: Byte) => Byte>>
+  = _(l => _(r => r._(l)._(_(pr => sum._(inc._(l))._(pr)))));
+
+export const sub: L<(l: Byte) => L<(r: Byte) => Byte>>
+  = _(l => _(r => r._(l)._(_(pr => sub._(dec._(l))._(pr)))));
+
+export const mul: L<(l: Byte) => L<(r: Byte) => Byte>>
+  = _(l => _(r => l._(x00)._(_(pl => sum._(r)._(mul._(pl)._(r))))));
+
+export const fromNumber: (n: number) => Byte
+  = n => _n(n % 256);

src/index.ts

@@ -1,6 +1,8 @@
 export * from './core';
 export * from './bool';
 export * from './num';
-export * from './list';
+export * from './byte';
 export * from './char';
+export * from './list';
 export * from './pair';
+export * from './bf';

src/list.ts

@@ -31,6 +31,9 @@ export const append: L<<T extends P>(l: List<T>) => L<(r: List<T>) => List<T>>>
 export const concat: L<<T extends P>(ls: List<List<T>>) => List<T>>
   = _(ls => ls._(Nil)._(_(x => _(xs => append._(x)._(concat._(xs))))));
 
+export const repeat: L<<T extends P>(v: T) => List<T>>
+  = _(v => cons._(v)._(repeat._(v)));
+
 export const head: L<<T extends P>(xs: List<T>) => T>
   = _(xs => xs._(undef)._(_(x => _(_xs => x))));