calculator.tao

# General utility

type Str = [Char]
type Io A = Universe -> (A, Universe)

fn nothing |uni of Universe| ((), uni)
fn print |s, uni| ((), @print(s, uni))
fn input |uni| @input(uni)

data Maybe A =
	| Just A
	| Nil

fn contains |cs of [Char], c| match cs {
	| [c1, cs: ...] => c1 = c or contains(cs, c)
	| [] => false
}

fn eq |xs of [Char], ys| match (xs, ys) {
	| ([], []) => true
	| ([x, xs: ...], [y, ys: ...]) => x = y and xs:eq(ys)
	| _ => false
}

fn len A |xs of [A]| match xs {
	| [_, xs: ...] => 1 + xs:len
	| [] => 0
}

fn nth A |n, xs of [A]| match (n, xs) {
	| (0, [head, tail: ...]) => Just head
	| (n, [_, tail: ...]) => nth(n - 1, tail)
	| _ => Nil
}

fn show_num_inner |x| if x < 1
	then ""
	else match nth(x % 10, "0123456789") {
		| Just c => show_num_inner((x - x % 10) / 10) ++ [c]
		| _ => ""
	}

fn show_num |x| if x < 1
	then "0"
	else show_num_inner(x)

fn fold_l A B |init, f of B -> A -> ?, xs| match xs {
	| [x, xs: ...] => fold_l(f(init, x), f, xs)
	| [] => init
}

fn reduce_l A B |f, (init, xs) of (A, [B])| fold_l(init, f, xs)

fn fold_r A B |init, f of A -> B -> ?, xs| match xs {
	| [x, xs: ...] => f(x, fold_r(init, f, xs))
	| [] => init
}

fn reduce_r A B |f, (xs, init) of ([B], A)| fold_r(init, f, xs)

def sum = fold_l(0, |a, x| a + x)

fn find_char_inner |x, cs, c of Char| match cs {
	| [c1, cs: ...] => if c1 = c
		then Just x
		else find_char_inner(x + 1, cs, c)
	| [] => Nil
}

def find_char = find_char_inner(0)

# Parser Things

data Out I O = {
	rest: [I],
	out: Maybe O,
}

fn success I O |rest of [I], out of O| Out { rest, out: Just out }
fn failure I O of [I] -> Out ? O |rest| Out { rest, out: Nil }

type Parser I O = [I] -> Out I O

fn matcher I O |f of I -> Maybe O, input| match input {
	| [i, rest: ...] => match i:f {
		| Just o => success(rest, o)
		| Nil => failure(input)
	}
	| [] => failure([])
}

fn recurse I O |f of [I] -> Out I O, input| match input:f {
	| Out { rest, out: Just o } => success(rest, o)
	| _ => failure(input)
}

fn end I of Parser I () |input| match input {
	| [] => success([], ())
	| _ => failure([])
}

fn map I O U |f of O -> U, p of Parser I O, input|
	let r = input:p in
	match r.out {
		| Just o => success(r.rest, f(o))
		| _ => failure(r.rest)
	}

fn repeated I O |p of Parser I O, input| match input:p {
	| Out { rest, out: Just o } =>
		let r = rest:repeated(p) in
		match r.out {
			| Just out => success(r.rest, [o] ++ out)
			| Nil => failure(r.rest)
		}
	| Out { rest, out } => success(rest, [])
}

fn repeated_at_least I O |n, p of Parser I O, input|
	let r = input:repeated(p) in
	match r.out {
		| Just xs => if xs:len >= n
			then r
			else failure(r.rest)
		| Nil => failure(r.rest)
	}

fn and_then I O U |p1 of Parser I U, p0 of Parser I O, input|
	let r = input:p0 in
	match r.out {
		| Just o => r.rest:map(|u| (o, u), p1)
		| Nil => failure(r.rest)
	}

fn or_else I O |p1 of Parser I O, p0 of Parser I O, input|
	let r = input:p0 in
	match r.out {
		| Just o => success(r.rest, o)
		| Nil => let r = input:p1 in
			match r.out {
				| Just o => success(r.rest, o)
				| Nil => failure(r.rest)
			}
	}

fn is_success I O |p of Parser I O, input| match input:p {
	| Out { rest, out: Just _ } => true
	| _ => false
}

def char_to_num = find_char("0123456789")

fn padded_by I O U |p1 of Parser I O, p0 of Parser I U| p0
	:and_then(p1)
	:map(|(a, _)| a)

fn padding_for I O U |p1 of Parser I O, p0 of Parser I U| p0
	:and_then(p1)
	:map(|(_, b)| b)

# AST

data UnaryOp =
	| Neg

data BinaryOp =
	| Add | Sub
	| Mul | Div | Rem

data Expr =
	| Number Num
	| Unary (UnaryOp, Expr)
	| Binary (BinaryOp, Expr, Expr)

# Parser

def whitespace = matcher(find_char(" \t\n"))

fn padded O |p of Parser Char O| p
	:padded_by(whitespace:repeated)

fn char |c of Char| matcher(|i| if c = i
	then Just i
	else Nil)

fn op |c| char(c):padded

def digit = matcher(|c| char_to_num(c))

def number = digit
	:repeated_at_least(1)
	:map(|xs| xs:fold_l(0, |a, x| a * 10 + x))
	:padded

def atom = number
	:map(|x| Number x)
	:or_else(char('(')
		:padding_for(recurse(|input| input:expr))
		:padded_by(char(')')))

def unary = op('-'):map(|_| Neg)
	:repeated
	:and_then(atom)
	:map(reduce_r(|op, a| Unary (op, a)))

def product = unary
	:and_then(op('*'):map(|_| Mul)
		:or_else(op('/'):map(|_| Div))
		:or_else(op('%'):map(|_| Rem))
		:and_then(unary)
		:repeated)
	:map(reduce_l(|a, (op, b)| Binary (op, a, b)))

def sum = product
	:and_then(op('+'):map(|_| Add)
		:or_else(op('-'):map(|_| Sub))
		:and_then(product)
		:repeated)
	:map(reduce_l(|a, (op, b)| Binary (op, a, b)))

def expr = sum

def full_expr = expr:padded_by(end)

# Interpreter

def eval = |ast| match ast {
	| Number x => x
	| Unary (op, a) => match op {
		| Neg => -a:eval
	}
	| Binary (op, a, b) => match op {
		| Add => a:eval + b:eval
		| Sub => a:eval - b:eval
		| Mul => a:eval * b:eval
		| Div => a:eval / b:eval
		| Rem => a:eval % b:eval
	}
}

def main = match full_expr("4 + (5 - 3)").out {
	| Just ast => ast:eval
	| Nil => 0
}

fn make A |x of A, uni of Universe| (x, uni)

fn bind A B |b of ? -> Io B, a of Io A, uni|
	let (x, uni) = a(uni) in b(x, uni)

fn next A B |b of Io B, a of Io A, uni|
	let (_, uni) = a(uni) in b(uni)

def loop = do
	str <- input;
	if str:eq("q\n")
	then nothing
	else do
		match full_expr(str).out {
			| Just ast => print(ast:eval:show_num ++ "\n")
			| _ => print("Invalid input: " ++ str)
		};
		loop

def main = loop