Underload Interpreter in Tamsin

underload.tamsin

# An Underload interpreter written in Tamsin.
# Only supports programs containing only `a^:!S~*()`.

# Concatenate two lists.
concat(nil, R) = return R.
concat(cons(A, AS), R) = concat(AS, R) -> R2 & return cons(A, R2).

# Parse a term into an AST.
term = "a" & return wrap
     | "^" & return exec
     | ":" & return dup
     | "!" & return drop
     | "S" & return out
     | "~" & return swap
     | "*" & return cat
     | "(" & terms -> V & ")" & return push(V).

# Parse multiple terms into a list of ASTs.
terms = term/nil/cons -> T & $:reverse(T, nil, cons).

# Emit a term without a newline.
print_term(wrap) = $:emit('a').
print_term(exec) = $:emit('^').
print_term(dup)  = $:emit(':').
print_term(drop) = $:emit('!').
print_term(out)  = $:emit('S').
print_term(swap) = $:emit('~').
print_term(cat)  = $:emit('*').
print_term(push(V)) = $:emit('(')
                    & print_terms(V)
                    & $:emit(')').

# Emit a list of terms without a newline.
print_terms(V) = { return V -> cons(I, V) & print_term(I) }.

# Evaluate a term on a stack. Return ok(S') where S' is the new stack.
# If there is a stack underflow error, return err.
eval(wrap, cons(V, VS)) =
  return ok(cons(cons(push(V), nil), VS)).
eval(exec, cons(V, VS)) = eval_list(V, VS).
eval(dup,  cons(V, VS)) =
  return ok(cons(V, cons(V, VS))).
eval(drop, cons(V, VS)) =
  return ok(VS).
eval(out,  cons(V, VS)) = print_terms(V) &
  return ok(VS).
eval(swap, cons(VA, cons(VB, VS))) =
  return ok(cons(VB, cons(VA, VS))).
eval(cat,  cons(VA, cons(VB, VS))) = concat(VB, VA) -> V &
  return ok(cons(V, VS)).
eval(push(V), S) =
  return ok(cons(V, S)).
eval(P,       S) =
  return err.

# Evaluate a list of terms on the stack.
eval_list(nil,        S) = return ok(S).
eval_list(cons(I, P), S) = eval(I, S) -> R & eval_list_helper(R, P).
eval_list_helper(err,   P) = return err.
eval_list_helper(ok(S), P) = eval_list(P, S).

main = terms -> T & eval_list(T, nil) & ''.