You can not select more than 25 topics
Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.
82 lines
2.8 KiB
82 lines
2.8 KiB
import { L, _, fromNative as __, cnst, id, pipe } 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, singleton, 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 done: L<(s: State) => Bool>
|
|
= uncurry(_(p => cnst(uncurry(_(is => _(cs => ge(head(is))(len(cs)))))(p))));
|
|
|
|
const command: L<(c: String) => L<(s: State) => Bool>>
|
|
= _(c => uncurry(_(p => cnst(eq(c)(uncurry(pipe(get)(head))(p))))));
|
|
|
|
const advance: L<(s: State) => State>
|
|
= first(first(update(succ)(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>
|
|
= pipe(pipe(uncurry(get))(fst))(snd);
|
|
|
|
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 => pipe(Pair(t))(second(_(os => snoc(os)(uncurry(get)(t))))))));
|
|
|
|
const next: L<(t: State) => State>
|
|
= second(first(first(succ)));
|
|
|
|
const prev: L<(t: State) => State>
|
|
= second(first(first(pred)));
|
|
|
|
const jump: L<(d: Num) => L<(s: State) => State>>
|
|
= _(d => _(s =>
|
|
iif(command(_c('['))(s))(jump(succ(d)))
|
|
(iif(command(_c(']'))(s))(ifz(pred(d))(cnst(s))(jump(pred(d))))
|
|
(jump(d)))(advance(s))));
|
|
|
|
const whlnz: L<(t: State) => State>
|
|
= _(s => ifn(read(s))(jump(Zero))(save)(s));
|
|
|
|
const endwhl: L<(t: State) => State>
|
|
= _(s => ifn(read(s))(reset)(pipe(save)(restore))(s));
|
|
|
|
const exec: L<(s: State) => State>
|
|
= _(s => iif<State>(done(s))(s)(exec(advance
|
|
(iif(command(_c('>'))(s))(next)
|
|
(iif(command(_c('<'))(s))(prev)
|
|
(iif(command(_c('+'))(s))(inc)
|
|
(iif(command(_c('-'))(s))(dec)
|
|
(iif(command(_c('.'))(s))(output)
|
|
(iif(command(_c(','))(s))(input)
|
|
(iif(command(_c('['))(s))(whlnz)
|
|
(iif(command(_c(']'))(s))(endwhl)
|
|
(id))))))))(s)))));
|
|
|
|
export const run: L<(p: String) => L<(i: String) => String>>
|
|
= _(p => _(i => snd(snd(snd(exec(Pair(Pair(singleton(Zero))(p))(Pair(Pair(Zero)(repeat(x00)))(Pair(i)(Empty)))))))));
|
|
|