:- use_module(library(clpfd)). :- [thun]. /* Copyright © 2018, 2019, 2020 Simon Forman This file is part of Thun Thun is free software: you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation, either version 3 of the License, or (at your option) any later version. Thun is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. You should have received a copy of the GNU General Public License along with Thun. If not see . The enviroment or context is a predicate reggy/4: reggy(FreePool, References, Values, Code) The FreePool is a list of atoms that each denote a free register; References is a list of register atoms that keeps track of how many times a register is used (it is in lieu of reference counting); Values is an assoc list mapping register atoms to their current values; and lastly Code is a list of machine code predicates emitted by the compiler. */ % just to hush the linter, which won't respect consult/1. % def(Name, _). % func(Name, _, _). % combo(Name, _, _, _, _). % joy_parse(_, _, _). encode_list(List, addr(list(List))) --> []. % Retrieve the next free register. get_reggy([], _, _) :- writeln('Out of Registers'), fail. get_reggy([Reg|FreePool], Reg, FreePool). % free one reference and de-allocate if it was the last. free_reg(Reg, Value, reggy(FreePool0, References0, V0, Code), reggy(FreePool, References, V, Code)) :- select(Reg, References0, References), get_assoc(Reg, V0, Value), ( member(Reg, References) % If reg is still in use -> FreePool= FreePool0, V0=V % we can't free it yet ; FreePool=[Reg|FreePool0], % otherwise we put it back in the pool. del_assoc(Reg, V0, _, V) ). add_ref(Reg, reggy(FreePool, References, V, Code), reggy(FreePool, [Reg|References], V, Code)). assoc_reg(Reg, Value, reggy(FreePool0, References, V0, Code), reggy(FreePool, [Reg|References], V, Code)) :- get_reggy(FreePool0, Reg, FreePool), put_assoc(Reg, V0, Value, V). fresh_env(reggy( % Create a fresh new env/context with... [r0, r1, r2, r3, % Available registers r4, r5, r6, r7, r8, r9, rA, rB, rC, rD, rE, rF], [], % References. V, % Register to value assoc list. [] % List of (pseudo-)machine code. )) :- empty_assoc(V). emit([]) --> []. emit([A|Rest]) --> emit(A), emit(Rest). emit(A) --> { A \= [], A \= [_|_] }, emit_code(A). emit_code(C, reggy(FreePool, References, V, [C|Code]), reggy(FreePool, References, V, Code )). /* Compiling THread through the env/context as DCG dif-lists */ thun_compile(E, Si, So, Env) :- fresh_env(Env0), thun_compile(E, Si, So, Env0, Env). thun_compile([], S, S) --> []. thun_compile([Term|Rest], Si, So) --> thun_compile(Term, Rest, Si, So). thun_compile(int(I), E, Si, So) --> emit(mov_imm(R, int(I))), assoc_reg(R, int(I)), thun_compile(E, [R|Si], So). thun_compile(bool(B), E, Si, So) --> assoc_reg(R, bool(B)), thun_compile(E, [R|Si], So). thun_compile(list(L), E, Si, So) --> encode_list(L, Addr), assoc_reg(R, Addr), emit(load_imm(R, Addr)), thun_compile(E, [R|Si], So). thun_compile(symbol(Name), E, Si, So) --> { def(Name, _) } -> def_compile(Name, E, Si, So) ; { func(Name, _, _) } -> func_compile(Name, E, Si, So) ; { combo(Name, _, _, _, _) } -> combo_compile(Name, E, Si, So). % I'm going to assume that any defs that can be compiled to funcs already % have been. Defs that can't be pre-compiled shove their body expression % onto the pending expression (continuation) to be compiled "inline". def_compile(Def, E, Si, So) --> { def(Def, Body), append(Body, E, Eo) }, thun_compile(Eo, Si, So). % swap (et. al.) doesn't change register refs nor introspect values % so we can delegate its effect to the semantic relation. non_alloc(swap). non_alloc(rollup). non_alloc(rolldown). % Functions delegate to a per-function compilation relation. func_compile(+, E, [A, B|S], So) --> !, free_reg(A, int(N)), free_reg(B, int(M)), assoc_reg(R, int(K)), emit(add(R, A, B)), { K #= N + M }, % Update value in the context? thun_compile(E, [R|S], So). func_compile(dup, E, [A|S], So) --> !, add_ref(A), thun_compile(E, [A, A|S], So). func_compile(pop, E, [A|S], So) --> !, free_reg(A, _), thun_compile(E, S, So). func_compile(cons, E, [List, Item|S], So) --> !, % Assume list is already stored in RAM % and item ... % allocate a cons cell emit(alloc_cons(list(Item, List))), % https://mitpress.mit.edu/sites/default/files/sicp/full-text/book/book-Z-H-33.html#%_sec_5.3 thun_compile(E, S, So). func_compile(Func, E, Si, So) --> { non_alloc(Func), !, func(Func, Si, S) }, thun_compile(E, S, So). func_compile(_Func, E, Si, So) --> % look up function, compile it... {Si = S}, thun_compile(E, S, So). combo_compile(_Combo, E, Si, So) --> % look up combinator, compile it... {Si = S, E = Eo}, thun_compile(Eo, S, So). compiler(InputString, StackIn, StackOut, FreePool0, References0, Values0, MachineCode0, FreePool, References, Values, MachineCode) :- phrase(joy_parse(Expression), InputString), !, thun_compile(Expression, StackIn, StackOut, reggy(FreePool0, References0, Values0, MachineCode0), reggy(FreePool, References, Values, MachineCode ) ). % phrase(thun_compile(Expression, StackIn, StackOut, _), MachineCode, []). compiler(InputString, StackIn, StackOut, FreePool, References, Values, MachineCode) :- [r0, r1, r2, r3, % Available registers r4, r5, r6, r7, r8, r9, rA, rB, rC, rD, rE, rF]=FreePool0, empty_assoc(Values0), compiler(InputString, StackIn, StackOut, FreePool0, [], Values0, MachineCode, FreePool, References, Values, []). % compiler(`3 +`, [r0|StackIn], StackOut, [r1, r2, r3, r4, ], [r0], Values0, MachineCode0, FreePool, References, Values, MachineCode). /* compiler(`2`, StackIn, Stack1, FreePool0, References0, Values0, MachineCode0), compiler(`3 +`, Stack1, StackOut, FreePool0, References0, Values0, MachineCode1, FreePool, References, Values, []). ?- compiler(`2`, StackIn, Stack1, FreePool0, References0, Values0, MachineCode0), compiler(`3 +`, Stack1, StackOut, FreePool0, References0, Values0, MachineCode1, FreePool, References, Values, []).| compiler(`3 +`, Stack1, StackOut, FreePool0, References0, Values0, MachineCode1, FreePool, References, Values, []). Stack1 = StackOut, StackOut = [r0|StackIn], FreePool0 = FreePool, FreePool = [r1, r2, r3, r4, r5, r6, r7, r8, r9|...], References0 = References, References = [r0], Values0 = t(r0, int(2), -, t, t), MachineCode0 = [mov_imm(r0, int(2))], MachineCode1 = [mov_imm(r1, int(3)), add(r0, r1, r0)], Values = t(r0, int(_19548), -, t, t) . */ % show_compiler(InputString, StackIn, StackOut) :- % phrase(joy_parse(Expression), InputString), !, % phrase(thun_compile(Expression, StackIn, StackOut, reggy(_, _, V)), MachineCode, []), % maplist(portray_clause, MachineCode), % assoc_to_list(V, VP), % portray_clause(VP). /* So what happens when you compile just an integer literal? ?- thun_compile([int(23)], Si, So, reggy(FreePool, References, Values, Code)). So = [r0|Si], FreePool = [r1, r2, r3, r4, r5, r6, r7, r8, r9|...], References = [r0], Values = t(r0, int(23), -, t, t), Code = [mov_imm(r0, int(23))]. The int is put onto the next available register, which is returned on the stack. ?- compiler(`2 3 +`, MachineCode, StackIn, StackOut). MachineCode = [mov_imm(r0, int(2)), mov_imm(r1, int(3)), add(r0, r1, r0)], StackOut = [r0|StackIn] ; false. ?- phrase(grow, [symbol('&&')], Out), writeln(Out). [ list([ list([symbol(stack)]), symbol(dip), symbol(swap), symbol(cons), symbol(swaack), list([symbol(i)]), symbol(dip), symbol(swaack), symbol(first) ]), msymbol(cons), list([ list([symbol(stack)]), symbol(dip), symbol(swap), symbol(cons), symbol(swaack), list([symbol(i)]), symbol(dip), symbol(swaack), symbol(first), list([bool(false)]) ]), symbol(dip), symbol(branch) ] */