Simple AST->WASM (text format) compiler.

wasm.pi

%% Primitive AST->WASM (text format) compiler.

%% Type =
%% | bool
%% | int
%% | float
%% | void

show_type(bool) = "i32".
show_type(int) = "i32".
show_type(float) = "f32".

expression_result(void) = "".
expression_result(Type) = Res =>
  T = show_type(Type),
  Res = "(result " ++ T ++")".


%% Expression =
%% | ltrue | lfalse
%% | ilit(i32)
%% | flit(f32)
%% | read(i32)
%% | add(Expr, Expr)
%% | sub(Expr, Expr)
%% | mul(Expr, Expr)
%% | div(Expr, Expr)
%% | eq(Expr, Expr)
%% | ne(Expr, Expr)
%% | le(Expr, Expr)
%% | ge(Expr, Expr)
%% | lt(Expr, Expr)
%% | gt(Expr, Expr)

ex1 = $add(
  ilit(42),
  sub(
    ilit(8),
    ilit(10))).

ex2 = $div(
  ilit(42),
  sub(
    ilit(8),
    ilit(10))).

ex3 = $div(
  flit(42),
  sub(
    flit(8),
    flit(10))).

ex4 = $add(
  ilit(42),
  sub(
    ilit(8),
    read(0))).

ex5 = $le(
  flit(23.46),
  add(
    flit(0.43),
    flit(17.02))).


%% Statement =
%% | assign(i32, Expr)
%% | expr(Expr)
%% | if(Expr, Statement, Statement)
%% | while(Expr, Statement)
%% | block([Statement])

st1 = $block([
  assign(0, mul(ilit(2), ilit(37))),
  expr(sub(read(0), ilit(28)))
  ]).

st2 = $block([
  assign(0, mul(ilit(2), ilit(37))),
  if(eq(read(0), ilit(123)),
    assign(0, ilit(42)),
    assign(0, add(read(0), ilit(10)))),
  expr(sub(read(0), ilit(28)))
  ]).

st3 = $block([
  assign(0, ilit(10)),
  while(
    ne(read(0), ilit(0)),
    assign(0, sub(read(0), ilit(5)))
  ),
  expr(read(0))]).

fact(N) = $block([
  assign(0, ilit(N)),
  assign(1, ilit(1)),
  while(
    ge(read(0), ilit(2)),
    block([
      assign(1, mul(read(1), read(0))),
      assign(0, sub(read(0), ilit(1)))])
  ),
  expr(read(1))]).


%% Ctx = [{N, Type}]

get_var_type(N, [{N, Type} | _]) = Type.
get_var_type(N, [_ | T]) = get_var_type(N, T).

typed_expr(Ctx, ltrue, T) => T = bool.
typed_expr(Ctx, lfalse, T) => T = bool.
typed_expr(Ctx, ilit(_), T) => T = int.
typed_expr(Ctx, flit(_), T) => T = float.
typed_expr(Ctx, read(N), T) => T = get_var_type(N, Ctx).
typed_expr(Ctx, add(L, R), T) => typed_expr(Ctx, L, T), typed_expr(Ctx, R, T1), T = T1.
typed_expr(Ctx, sub(L, R), T) => typed_expr(Ctx, L, T), typed_expr(Ctx, R, T1), T = T1.
typed_expr(Ctx, mul(L, R), T) => typed_expr(Ctx, L, T), typed_expr(Ctx, R, T1), T = T1.
typed_expr(Ctx, div(L, R), T) => typed_expr(Ctx, L, T), typed_expr(Ctx, R, T1), T = T1.
typed_expr(Ctx, eq(L, R), T) => typed_expr(Ctx, L, T2), typed_expr(Ctx, R, T1), T2 = T1, T = bool.
typed_expr(Ctx, ne(L, R), T) => typed_expr(Ctx, L, T2), typed_expr(Ctx, R, T1), T2 = T1, T = bool.
typed_expr(Ctx, le(L, R), T) => typed_expr(Ctx, L, T2), typed_expr(Ctx, R, T1), T2 = T1, T = bool.
typed_expr(Ctx, ge(L, R), T) => typed_expr(Ctx, L, T2), typed_expr(Ctx, R, T1), T2 = T1, T = bool.
typed_expr(Ctx, lt(L, R), T) => typed_expr(Ctx, L, T2), typed_expr(Ctx, R, T1), T2 = T1, T = bool.
typed_expr(Ctx, gt(L, R), T) => typed_expr(Ctx, L, T2), typed_expr(Ctx, R, T1), T2 = T1, T = bool.

typed(Ctx1, assign(N, Expr), Ctx2, T) =>
  T = void,
  typed_expr(Ctx1, Expr, T1),
  Ctx2 = [{N, T1} | Ctx1].
typed(Ctx1, expr(Expr), Ctx2, T) =>
  typed_expr(Ctx1, Expr, T),
  Ctx1 = Ctx2.
typed(Ctx1, if(Expr, Stmt1, Stmt2), Ctx2, T) =>
  typed_expr(Ctx1, Expr, bool),
  typed(Ctx1, Stmt1, _, T),
  typed(Ctx1, Stmt2, _, T),
  Ctx1 = Ctx2.
typed(Ctx1, while(Expr, Stmt), Ctx2, T) =>
  typed_expr(Ctx1, Expr, bool),
  typed(Ctx1, Stmt, _, void),
  T = void,
  Ctx1 = Ctx2.
typed(Ctx1, block([Stmt]), Ctx2, T) =>
  typed(Ctx1, Stmt, Ctx2, T).
typed(Ctx1, block([Stmt | Tl]), Ctx2, T) =>
  typed(Ctx1, Stmt, Ctx3, _),
  typed(Ctx3, $block(Tl), Ctx2, T).


test_typed_expr_read0 =>
  Ctx = [ {0, int} ],
  E = $sub(read(0),ilit(28)),
  typed_expr(Ctx, E, int).

test_typed_expr =>
  test_typed_expr_read0.

test_typed0 =>
  Ctx1 = [ {0, int} ],
  typed(Ctx1, $expr(sub(read(0),ilit(28))), Ctx2, int),
  Ctx1 = Ctx2.

test_typed1 =>
  S = st1(),
  typed([], S, Ctx2, int),
  Ctx2 = [ {0, int} ].

test_typed =>
  test_typed_expr,
  test_typed0,
  test_typed1.


%%%
%%% Evaluator
%%%

get_var(0, [V|_]) = V.
get_var(N, [_|T]) = get_var(N-1, T).

eval(ilit(V), Env) = V.
eval(flit(V), Env) = V.
eval(read(N), Env) = get_var(N, Env).
eval(add(L, R), Env) = eval(L, Env) + eval(R, Env).
eval(sub(L, R), Env) = eval(L, Env) - eval(R, Env).
eval(mul(L, R), Env) = eval(L, Env) * eval(R, Env).
eval(div(L, R), Env) = eval(L, Env) / eval(R, Env).
%eval(_) = throw(unknown_expression).

eval(E) = eval(E, []).

eval_ex1 =>
  E = ex1(),
  V = eval(E),
  println(V).

eval_ex2 =>
  E = ex2(),
  V = eval(E),
  println(V).

eval_ex3 =>
  E = ex3(),
  V = eval(E),
  println(V).

eval_ex4 =>
  E = ex4(),
  V = eval(E, [10]),
  println(V).

eval_ex5 =>
  E = ex4(),
  V = eval(E, [20]),
  println(V).


%%%
%%% Compiler
%%%

wat_header(Type) = Res =>
  T = expression_result(Type),
  Res = "(module\n  (func $test " ++ T ++"\n".
wat_footer = ")\n  (export \"test\" (func $test)))".

wat_emit(Body, Type) =>
  println(wat_header(Type) ++ Body ++ wat_footer()).


div_inst(int) = ".div_s".
div_inst(float) = ".div".

eq_inst(int) = "i32.eq".
eq_inst(bool) = "i32.eq".
eq_inst(float) = "f32.eq".

ne_inst(int) = "i32.ne".
ne_inst(bool) = "i32.ne".
ne_inst(float) = "f32.ne".

le_inst(int) = "i32.le_s".
le_inst(bool) = "i32.le_u".
le_inst(float) = "f32.le".

ge_inst(int) = "i32.ge_s".
ge_inst(bool) = "i32.ge_u".
ge_inst(float) = "f32.ge".

lt_inst(int) = "i32.lt_s".
lt_inst(bool) = "i32.lt_u".
lt_inst(float) = "f32.lt".

gt_inst(int) = "i32.gt_s".
gt_inst(bool) = "i32.gt_u".
gt_inst(float) = "f32.gt".

compile_expr(Ctx, ltrue, Out) => Out = "i32.const 1\n".
compile_expr(Ctx, lfalse, Out) => Out = "i32.const 0\n".
compile_expr(Ctx, ilit(V), Out) => Out = "i32.const " ++ to_string(V) ++ "\n".
compile_expr(Ctx, flit(V), Out) => Out = "f32.const " ++ to_string(V) ++ "\n".
compile_expr(Ctx, read(N), Out) => Out = "get_local " ++ to_string(N) ++ "\n".
compile_expr(Ctx, E@add(L, R), Out) =>
  typed_expr(Ctx, E, T),
  S = show_type(T),
  compile_expr(Ctx, L, LOut),
  compile_expr(Ctx, R, ROut),
  Out = LOut ++ ROut ++ S ++ ".add\n".
compile_expr(Ctx, E@sub(L, R), Out) =>
  typed_expr(Ctx, E, T),
  S = show_type(T),
  compile_expr(Ctx, L, LOut),
  compile_expr(Ctx, R, ROut),
  Out = LOut ++ ROut ++ S ++ ".sub\n".
compile_expr(Ctx, E@mul(L, R), Out) =>
  typed_expr(Ctx, E, T),
  S = show_type(T),
  compile_expr(Ctx, L, LOut),
  compile_expr(Ctx, R, ROut),
  Out = LOut ++ ROut ++ S ++ ".mul\n".
compile_expr(Ctx, E@div(L, R), Out) =>
  typed_expr(Ctx, E, T),
  S = show_type(T),
  I = div_inst(T),
  compile_expr(Ctx, L, LOut),
  compile_expr(Ctx, R, ROut),
  Out = LOut ++ ROut ++ S ++ I ++ "\n".
compile_expr(Ctx, E@eq(L, R), Out) =>
  typed_expr(Ctx, E, bool),
  typed_expr(Ctx, L, T),
  compile_expr(Ctx, L, LOut),
  compile_expr(Ctx, R, ROut),
  I = eq_inst(T),
  Out = LOut ++ ROut ++ I ++ "\n".
compile_expr(Ctx, E@ne(L, R), Out) =>
  typed_expr(Ctx, E, bool),
  typed_expr(Ctx, L, T),
  compile_expr(Ctx, L, LOut),
  compile_expr(Ctx, R, ROut),
  I = ne_inst(T),
  Out = LOut ++ ROut ++ I ++ "\n".
compile_expr(Ctx, E@le(L, R), Out) =>
  typed_expr(Ctx, E, bool),
  typed_expr(Ctx, L, T),
  compile_expr(Ctx, L, LOut),
  compile_expr(Ctx, R, ROut),
  I = le_inst(T),
  Out = LOut ++ ROut ++ I ++ "\n".
compile_expr(Ctx, E@ge(L, R), Out) =>
  typed_expr(Ctx, E, bool),
  typed_expr(Ctx, L, T),
  compile_expr(Ctx, L, LOut),
  compile_expr(Ctx, R, ROut),
  I = ge_inst(T),
  Out = LOut ++ ROut ++ I ++ "\n".
compile_expr(Ctx, E@lt(L, R), Out) =>
  typed_expr(Ctx, E, bool),
  typed_expr(Ctx, L, T),
  compile_expr(Ctx, L, LOut),
  compile_expr(Ctx, R, ROut),
  I = lt_inst(T),
  Out = LOut ++ ROut ++ I ++ "\n".
compile_expr(Ctx, E@gt(L, R), Out) =>
  typed_expr(Ctx, E, bool),
  typed_expr(Ctx, L, T),
  compile_expr(Ctx, L, LOut),
  compile_expr(Ctx, R, ROut),
  I = gt_inst(T),
  Out = LOut ++ ROut ++ I ++ "\n".
%compile_expr(Ctx, _, _) => throw(some_error).

compile_stmt(Ctx, assign(N, Expr), Out) =>
  compile_expr(Ctx, Expr, EOut),
  Out = EOut ++ "set_local " ++ to_string(N) ++ "\n".
compile_stmt(Ctx, expr(Expr), Out) =>
  compile_expr(Ctx, Expr, Out).
compile_stmt(Ctx, if(Expr, Stmt1, Stmt2), Out) =>
  compile_expr(Ctx, Expr, Out1),
  compile_stmt(Ctx, Stmt1, Out2),
  compile_stmt(Ctx, Stmt2, Out3),
  typed(Ctx, Stmt1, _, T),
  R = expression_result(T),
  Out = Out1 ++ "if " ++ R ++ "\n" ++ Out2 ++ "else\n" ++ Out3 ++ "end\n".
compile_stmt(Ctx, while(Expr, Stmt), Out) =>
  compile_expr(Ctx, Expr, Out1),
  compile_stmt(Ctx, Stmt, Out2),
  Out = "block\n" ++
    "loop\n" ++
      Out1 ++
      "i32.const 1\n" ++
      "i32.xor\n" ++
      "br_if 1\n" ++
      Out2 ++
      "br 0\n" ++
    "end\n" ++
  "end\n".
compile_stmt(Ctx, block([Stmt]), Out) =>
  compile_stmt(Ctx, Stmt, Out).
compile_stmt(Ctx, block([Stmt | Tl]), Out) =>
  compile_stmt(Ctx, Stmt, Out1),
  compile_stmt(Ctx, $block(Tl), Out2),
  Out = Out1 ++ Out2.

dump_locals([]) = "".
dump_locals([{_, Type} | Tl]) = "(local " ++ show_type(Type) ++ ")\n" ++ dump_locals(Tl).

compile_body(Stmt, T, Out) =>
  typed([], Stmt, Ctx, T),
  Locals = dump_locals(Ctx),
  compile_stmt(Ctx, Stmt, Out1),
  Out = Locals ++ Out1.


emit_ex1 =>
  E = ex1(),
  compile_expr([], E, B),
  typed_expr([], E, Type),
  wat_emit(B, Type).

emit_ex2 =>
  E = ex2(),
  compile_expr([], E, B),
  typed_expr([], E, Type),
  wat_emit(B, Type).

emit_ex3 =>
  E = ex3(),
  compile_expr([], E, B),
  typed_expr([], E, Type),
  wat_emit(B, Type).

emit_ex4 =>
  E = ex4(),
  compile_expr([], E, B),
  typed_expr([], E, Type),
  wat_emit(B, Type).

emit_ex5 =>
  E = ex5(),
  compile_expr([], E, B),
  typed_expr([], E, Type),
  wat_emit(B, Type).


emit_st1 =>
  S = st1(),
  compile_body(S, Type, B),
  wat_emit(B, Type).

emit_st2 =>
  S = st2(),
  compile_body(S, Type, B),
  wat_emit(B, Type).

emit_st3 =>
  S = st3(),
  compile_body(S, Type, B),
  wat_emit(B, Type).

emit_fact(N) =>
  S = fact(N),
  compile_body(S, Type, B),
  wat_emit(B, Type).


test_all =>
  test_typed.

main =>
  test_all,
  %eval_ex1,
  %eval_ex5,
  %emit_ex4,
  %emit_ex5,
  %emit_st1,
  %emit_st3,
  emit_fact(5),
  true.

Doesn't deserve a Git repository (yet). 😄

Revision 2 doesn't work, wait for revision 3.

A little bit of tests and debugging made things work as they always should have been. 😃

Revision 4: fails to compile factorial. Yet.

Revision 5: fixed! 😃
The problem was I forgot to update typing rules. Additionally I removed redundant clauses.