Prolog "brainfog"
/**
* Warranty & Liability
* To the extent permitted by applicable law and unless explicitly
* otherwise agreed upon, XLOG Technologies AG makes no warranties
* regarding the provided information. XLOG Technologies AG assumes
* no liability that any problems might be solved with the information
* provided by XLOG Technologies AG.
*
* Rights & License
* All industrial property rights regarding the information - copyright
* and patent rights in particular - are the sole property of XLOG
* Technologies AG. If the company was not the originator of some
* excerpts, XLOG Technologies AG has at least obtained the right to
* reproduce, change and translate the information.
*
* Reproduction is restricted to the whole unaltered document. Reproduction
* of the information is only allowed for non-commercial uses. Selling,
* giving away or letting of the execution of the library is prohibited.
* The library can be distributed as part of your applications and libraries
* for execution provided this comment remains unchanged.
*
* Restrictions
* Only to be distributed with programs that add significant and primary
* functionality to the library. Not to be distributed with additional
* software intended to replace any components of the library.
*
* Trademarks
* Jekejeke is a registered trademark of XLOG Technologies AG.
*/
/**
* See also:
* The Elements of Computing Systems
* Nisan, N. and Schocken, S. - June 15, 2021, MIT Press
* https://mitpress.mit.edu/9780262539807/the-elements-of-computing-systems/
*/
:- ensure_loaded(library(lists)).
:- ensure_loaded(library(hiord)).
/**
* emulate(G):
* emulate(G, N):
* The predicate succeeds. As a side effect it emulates G
* on an abstract π-WAM. The only side effects consumed or
* produced by the π-WAM is their input and output. The binary
* predicate allows specifying hack options.
*/
% emulate(+Goal)
emulate(GOAL) :-
emulate(GOAL, []).
% emulate(+Goal, +List)
emulate(GOAL, OPTS) :-
sys_hack_opts(OPTS, v(1,0rNone,0rNone), v(NUM,_,_)),
sys_comp_goal(GOAL, _, BUFFER, [], CODE, []),
sys_close_list(BUFFER),
term_variables(BUFFER-CODE, LIST),
(sys_number_list(LIST, 0, 1),
length(LIST, LEN),
LEN3 is 3+LEN,
LEN2 is LEN3*NUM,
length(STATE, LEN2),
sys_number_list(STATE, 0, 0),
length(OFFSETS, NUM),
sys_number_list(OFFSETS, 3, LEN3),
sys_hack_init(OFFSETS, 0, STATE, STATE2),
sys_hack_run(OFFSETS, CODE, STATE2);
true).
/**
* execute(G):
* execute(G, N):
* The predicate succeeds. As a side effect it runs G on a
* CPU backend for π-WAM. The only side effects consumed or
* produced by the π-WAM is their input and output. The binary
* predicate allows specifying hack options.
*/
% execute(+Goal)
execute(GOAL) :-
execute(GOAL, []).
% execute(+Goal, +List)
execute(GOAL, OPTS) :-
sys_hack_opts(OPTS, v(1,0rNone,0rNone), v(NUM,_,_)),
sys_comp_goal(GOAL, _, BUFFER, [], CODE, []),
sys_close_list(BUFFER),
term_variables(BUFFER-CODE, LIST),
(sys_number_list(LIST, 0, 1),
length(LIST, LEN),
LEN3 is 3+LEN,
LEN2 is LEN3*NUM,
length(STATE, LEN2),
sys_number_list(STATE, 0, 0),
maplist(sys_pack_instr, CODE, CODE2),
% write('CODE2='), write(CODE2), write(', LEN='), write(LEN), nl,
cpu_data_new(CODE2, BUF),
cpu_data_new(STATE, BUF2),
length(OFFSETS, NUM),
sys_number_list(OFFSETS, 3, LEN3),
cpu_data_new(OFFSETS, BUF3),
sys_execute(BUF, BUF2, BUF3, NUM);
true).
% sys_execute(+Buffer, +Buffer, +Buffer, +Integer)
sys_execute(BUF, BUF2, BUF3, NUM) :-
cpu_comp_new(BUF, BUF3, BUF2, PIWAM),
cpu_comp_work(PIWAM, WORK),
NUM2 is (NUM + WORK - 1) // WORK,
length(IDXS, NUM2),
sys_number_list(IDXS, 0, 1),
maplist(sys_execute_submit(PIWAM), IDXS, WARPS),
maplist(sys_execute_done, WARPS), fail.
% sys_execute_submit(+Object, +Integer, -Warp)
sys_execute_submit(PIWAM, IDX, WARP) :-
cpu_group_new(PIWAM, WARP),
cpu_group_start(WARP, IDX).
% sys_execute_done(+Warp)
sys_execute_done(WARP) :-
cpu_group_join(WARP, PROM),
'$YIELD'(PROM),
cpu_group_free(WARP).
/***************************************************************/
/* Helpers */
/***************************************************************/
% sys_close_list(+List)
sys_close_list([]) :- !.
sys_close_list([_|L]) :-
sys_close_list(L).
% sys_number_list(+List, +Integer, +Integer)
sys_number_list([], _, _).
sys_number_list([X|L], X, D) :-
Y is X+D,
sys_number_list(L, Y, D).
/***************************************************************/
/* Emulator */
/***************************************************************/
% sys_hack_init(+List, +Integer, +List, -List)
sys_hack_init([], _, STATE, STATE).
sys_hack_init([OFFSET|MORE], ID, STATE, STATE3) :-
IDX is OFFSET-3,
nth0(IDX, STATE, _, TEMP),
nth0(IDX, STATE2, ID, TEMP),
ID2 is ID+1,
sys_hack_init(MORE, ID2, STATE2, STATE3).
% sys_hack_run(+List, +List, +List)
sys_hack_run([], _, _) :- !, fail.
sys_hack_run(OFFSETS, CODE, STATE) :-
sys_hack_robin(OFFSETS, CODE, STATE, OFFSETS2, STATE2),
sys_hack_run(OFFSETS2, CODE, STATE2).
% sys_hack_robin(+List, +List, +List, -List)
sys_hack_robin([OFFSET|MORE], CODE, STATE, [OFFSET|REST], STATE3) :-
sys_hack_step(CODE, OFFSET, STATE, STATE2), !,
sys_hack_robin(MORE, CODE, STATE2, REST, STATE3).
sys_hack_robin([_|MORE], CODE, STATE, REST, STATE2) :-
sys_hack_robin(MORE, CODE, STATE, REST, STATE2).
sys_hack_robin([], _, STATE, [], STATE).
% sys_hack_step(+List, +Integer, +List, -List)
sys_hack_step(CODE, OFFSET, STATE, STATE5) :-
IDX is OFFSET-2,
nth0(IDX, STATE, PC),
IDX2 is OFFSET-1,
nth0(IDX2, STATE, ACCU),
nth0(PC, CODE, INSTR),
INSTR = (ACT, OBJ, REL),
ACT = (FUN, MODE, COND),
sys_hack_get(MODE, OBJ, OFFSET, CODE, PC, STATE, VALUE, STATE2),
sys_hack_fun(FUN, ACCU, VALUE, ACCU2),
sys_hack_set(MODE, OBJ, OFFSET, STATE2, ACCU2, STATE3),
sys_hack_jump(COND, ACCU2, REL, REL2),
PC2 is PC+1+REL2,
nth0(IDX, STATE3, _, TEMP),
nth0(IDX, STATE4, PC2, TEMP),
nth0(IDX2, STATE4, _, TEMP2),
nth0(IDX2, STATE5, ACCU2, TEMP2).
/***************************************************************/
/* Instructions */
/***************************************************************/
% sys_hack_get(+Atom, +Integer, +Integer, +List, +Integer, +List, -Integer, +List)
sys_hack_get(get, OBJ, OFFSET, _, _, STATE, VALUE, STATE) :-
IDX is OFFSET+OBJ,
nth0(IDX, STATE, VALUE).
sys_hack_get(cst, OBJ, _, _, _, STATE, OBJ, STATE).
sys_hack_get(set, _, _, _, _, STATE, 0, STATE).
sys_hack_get(out, _, _, _, _, STATE, 0, STATE).
sys_hack_get(in, OBJ, OFFSET, _, _, STATE, 0, STATE2) :-
write(': '), flush_output, sys_read_ints(RESULT),
sys_store_ints(RESULT, 0, OBJ, OFFSET, STATE, STATE2).
sys_hack_get(tbl, OBJ, _, CODE, PC, STATE, VALUE, STATE) :-
IDX is PC+1+OBJ,
nth0(IDX, CODE, VALUE).
% sys_hack_fun(+Atom, +Integer, +Integer, -Integer)
sys_hack_fun(val, _, VALUE, VALUE).
sys_hack_fun(acc, ACCU, _, ACCU).
sys_hack_fun(add, ACCU, VALUE, ACCU2) :-
TEMP is VALUE+ACCU,
sys_int32(TEMP, ACCU2).
sys_hack_fun(sub, ACCU, VALUE, ACCU2) :-
TEMP is VALUE-ACCU,
sys_int32(TEMP, ACCU2).
sys_hack_fun(mul, ACCU, VALUE, ACCU2) :-
TEMP is VALUE*ACCU,
sys_int32(TEMP, ACCU2).
sys_hack_fun(zdiv, ACCU, VALUE, ACCU2) :-
TEMP is VALUE//ACCU,
sys_int32(TEMP, ACCU2).
sys_hack_fun(rem, ACCU, VALUE, ACCU2) :-
TEMP is VALUE rem ACCU,
sys_int32(TEMP, ACCU2).
% sys_hack_set(+Atom, +Integer, +Integer, +List, +Integer, -List)
sys_hack_set(get, _, _, STATE, _, STATE).
sys_hack_set(cst, _, _, STATE, _, STATE).
sys_hack_set(set, OBJ, OFFSET, STATE, ACCU2, STATE2) :-
IDX is OFFSET+OBJ,
nth0(IDX, STATE, _, TEMP),
nth0(IDX, STATE2, ACCU2, TEMP).
sys_hack_set(out, OBJ, OFFSET, STATE, _, STATE) :-
OBJ2 is OBJ-1,
(between(0, OBJ2, AT), IDX is AT+OFFSET,
nth0(IDX, STATE, TERM),
write(TERM), write(' '), fail; nl).
sys_hack_set(in, _, _, STATE, _, STATE).
sys_hack_set(tbl, _, _, STATE, _, STATE).
% sys_hack_jump(+Atom, +Integer, +Integer, -Integer)
sys_hack_jump(eq, ACCU, REL, REL2) :- (ACCU =:= 0 -> REL2 = REL; REL2 = 0).
sys_hack_jump(nq, ACCU, REL, REL2) :- (ACCU =\= 0 -> REL2 = REL; REL2 = 0).
sys_hack_jump(ls, ACCU, REL, REL2) :- (ACCU < 0 -> REL2 = REL; REL2 = 0).
sys_hack_jump(gr, ACCU, REL, REL2) :- (ACCU > 0 -> REL2 = REL; REL2 = 0).
sys_hack_jump(lq, ACCU, REL, REL2) :- (ACCU =< 0 -> REL2 = REL; REL2 = 0).
sys_hack_jump(gq, ACCU, REL, REL2) :- (ACCU >= 0 -> REL2 = REL; REL2 = 0).
sys_hack_jump(true, _, REL, REL).
/***************************************************************/
/* Utilities */
/***************************************************************/
% sys_int32(+Integer, -Integer)
sys_int32(ALPHA, RESULT) :-
MASKED is ALPHA /\ 0xFFFFFFFF,
(MASKED >= 0x80000000 ->
RESULT is MASKED - 0x100000000;
RESULT = MASKED).
% sys_read_ints(-List)
sys_read_ints(RESULT) :-
get_atom(ATOM, []),
sub_atom(ATOM, 0, _, 1, CROPED),
sys_atom_split(CROPED, LIST),
foldl(sys_atom_int32, LIST, RESULT, []).
% sys_atom_split(+Atom, -List)
sys_atom_split(ATOM, [SPLIT|LIST]) :-
sub_atom(ATOM, POS, _, POS2, ' '), !,
sub_atom(ATOM, 0, POS, _, SPLIT),
sub_atom(ATOM, _, POS2, 0, REST),
sys_atom_split(REST, LIST).
sys_atom_split(ATOM, [ATOM]).
% sys_atom_int32(+Atom)
sys_atom_int32('') --> !.
sys_atom_int32(ATOM) -->
{atom_integer(ATOM, 10, TEMP), sys_int32(TEMP, VALUE)},
[VALUE].
% sys_store_ints(-List, +Integer, +Integer, +Integer, +List, -List)
sys_store_ints([], AT, MAX, OFFSET, STATE, STATE2) :- AT < MAX, !,
IDX is AT+OFFSET,
nth0(IDX, STATE, _, TEMP),
nth0(IDX, STATE3, 0, TEMP),
AT2 is AT+1,
sys_store_ints([], AT2, MAX, OFFSET, STATE3, STATE2).
sys_store_ints([VALUE|LIST], AT, MAX, OFFSET, STATE, STATE2) :- AT < MAX, !,
IDX is AT+OFFSET,
nth0(IDX, STATE, _, TEMP),
nth0(IDX, STATE3, VALUE, TEMP),
AT2 is AT+1,
sys_store_ints(LIST, AT2, MAX, OFFSET, STATE3, STATE2).
sys_store_ints(_, _, _, _, STATE, STATE).
/***************************************************************/
/* Compiler */
/***************************************************************/
% sys_comp_goal(+Goal, +List, +List, +List, -List, +List)
sys_comp_goal(VAR, _, _, _) --> {var(VAR),
throw(error(instantiation_error,_))}.
sys_comp_goal(gid(TERM), _, _, CODE) --> !,
[((val,get,true),-3,0)], sys_comp_is(TERM, CODE).
sys_comp_goal(TERM is EXPR, STACK, _, CODE) --> !,
sys_comp_arith(EXPR, STACK),
sys_comp_is(TERM, CODE).
sys_comp_goal(GOAL, _, BUFFER, CODE) --> {functor(GOAL, out, LEN)}, !,
{GOAL =.. [_|LIST]}, sys_comp_out(LIST, BUFFER),
[((acc,out,true),LEN,0)], phrase(CODE).
sys_comp_goal(GOAL, _, BUFFER, CODE) --> {functor(GOAL, in, LEN)}, !,
[((acc,in,true),LEN,0)],
{GOAL =.. [_|LIST]}, sys_comp_in(LIST, BUFFER, CODE).
sys_comp_goal(EXPR=:=EXPR2, STACK, _, CODE) --> !, {length(CODE, REL)},
sys_comp_arith(EXPR, STACK),
[((acc,set,true),TEMP,0)],
sys_comp_arith(EXPR2, STACK),
[((sub,get,nq),TEMP,REL)], phrase(CODE).
sys_comp_goal(EXPR=\=EXPR2, STACK, _, CODE) --> !, {length(CODE, REL)},
sys_comp_arith(EXPR, STACK),
[((acc,set,true),TEMP,0)],
sys_comp_arith(EXPR2, STACK),
[((sub,get,eq),TEMP,REL)], phrase(CODE).
sys_comp_goal(EXPR<EXPR2, STACK, _, CODE) --> !, {length(CODE, REL)},
sys_comp_arith(EXPR, STACK),
[((acc,set,true),TEMP,0)],
sys_comp_arith(EXPR2, STACK),
[((sub,get,gq),TEMP,REL)], phrase(CODE).
sys_comp_goal(EXPR>EXPR2, STACK, _, CODE) --> !, {length(CODE, REL)},
sys_comp_arith(EXPR, STACK),
[((acc,set,true),TEMP,0)],
sys_comp_arith(EXPR2, STACK),
[((sub,get,lq),TEMP,REL)], phrase(CODE).
sys_comp_goal(EXPR=<EXPR2, STACK, _, CODE) --> !, {length(CODE, REL)},
sys_comp_arith(EXPR, STACK),
[((acc,set,true),TEMP,0)],
sys_comp_arith(EXPR2, STACK),
[((sub,get,gr),TEMP,REL)], phrase(CODE).
sys_comp_goal(EXPR>=EXPR2, STACK, _, CODE) --> !, {length(CODE, REL)},
sys_comp_arith(EXPR, STACK),
[((acc,set,true),TEMP,0)],
sys_comp_arith(EXPR2, STACK),
[((sub,get,ls),TEMP,REL)], phrase(CODE).
sys_comp_goal(between(TERM,TERM2,VAR), _, _, CODE) --> !, {length(CODE, REL)},
sys_comp_build(TERM), [((acc,set,true),VAR,0)],
{REL2 is REL+3},
sys_comp_build(TERM2), [((sub,get,gr),VAR,REL2)],
{REL3 is -REL2-2}, phrase(CODE),
[((val,get,true),VAR,0), ((add,cst,true),1,0), ((acc,set,true),VAR,REL3)].
sys_comp_goal((GOAL, GOAL2), STACK, BUFFER, CODE) --> !,
{sys_comp_goal(GOAL2, STACK, BUFFER, CODE, CODE2, [])},
sys_comp_goal(GOAL, STACK, BUFFER, CODE2).
sys_comp_goal(GOAL, _, _, _) -->
{throw(error(type_error(callable,GOAL),_))}.
% sys_comp_arith(+Expr, +List, -List, +List)
sys_comp_arith(CONST, _) --> {integer(CONST),
-512 =< CONST, CONST =< 511}, !,
[((val,cst,true),CONST,0)].
sys_comp_arith(CONST, _) --> {integer(CONST)}, !,
[((val,tbl,true),0,1), CONST].
sys_comp_arith(VAR, _) --> {var(VAR)}, !,
[((val,get,true),VAR,0)].
sys_comp_arith(EXPR+EXPR2, [TEMP|STACK]) --> !,
sys_comp_arith(EXPR, STACK), [((acc,set,true),TEMP,0)],
sys_comp_arith(EXPR2, STACK), [((add,get,true),TEMP,0)].
sys_comp_arith(EXPR-EXPR2, [TEMP|STACK]) --> !,
sys_comp_arith(EXPR, STACK), [((acc,set,true),TEMP,0)],
sys_comp_arith(EXPR2, STACK), [((sub,get,true),TEMP,0)].
sys_comp_arith(EXPR*EXPR2, [TEMP|STACK]) --> !,
sys_comp_arith(EXPR, STACK), [((acc,set,true),TEMP,0)],
sys_comp_arith(EXPR2, STACK), [((mul,get,true),TEMP,0)].
sys_comp_arith(EXPR//EXPR2, [TEMP|STACK]) --> !,
sys_comp_arith(EXPR, STACK), [((acc,set,true),TEMP,0)],
sys_comp_arith(EXPR2, STACK), [((zdiv,get,true),TEMP,0)].
sys_comp_arith(EXPR rem EXPR2, [TEMP|STACK]) --> !,
sys_comp_arith(EXPR, STACK), [((acc,set,true),TEMP,0)],
sys_comp_arith(EXPR2, STACK), [((rem,get,true),TEMP,0)].
sys_comp_arith(EXPR, _) -->
{throw(error(type_error(evaluable,EXPR),_))}.
/***************************************************************/
/* Matcher */
/***************************************************************/
% sys_comp_build(+Term, -List, +List)
sys_comp_build(CONST) --> {integer(CONST),
-512 =< CONST, CONST =< 511}, !,
[((val,cst,true),CONST,0)].
sys_comp_build(CONST) --> {integer(CONST)}, !,
[((val,tbl,true),0,1), CONST].
sys_comp_build(VAR) --> {var(VAR)}, !,
[((val,get,true),VAR,0)].
sys_comp_build(TERM) -->
{throw(error(type_error(integer,TERM),_))}.
% sys_comp_out(+List, +List, -List, +List)
sys_comp_out([], _) --> [].
sys_comp_out([TERM|LIST], [TEMP|BUFFER]) -->
sys_comp_build(TERM),
[((acc,set,true),TEMP,0)],
sys_comp_out(LIST, BUFFER).
% sys_comp_is(+Term, +List)
sys_comp_is(CONST, CODE) --> {integer(CONST),
-512 =< CONST, CONST =< 511}, !,
{length(CODE, REL)},
[((sub,cst,nq),CONST,REL)], phrase(CODE).
sys_comp_is(CONST, CODE) --> {integer(CONST)}, !,
{length(CODE, REL)},
[((sub,tbl,true),0,1), CONST, ((acc,cst,nq),0,REL)], phrase(CODE).
sys_comp_is(VAR, CODE) --> {var(VAR)}, !,
[((acc,set,true),VAR,0)], phrase(CODE).
sys_comp_is(TERM, _) -->
{throw(error(type_error(integer,TERM),_))}.
% sys_comp_in(+List, +List, +List, -List, -List)
sys_comp_in([], _, CODE) --> phrase(CODE).
sys_comp_in([TERM|LIST], [TEMP|BUFFER], CODE) -->
{sys_comp_in(LIST, BUFFER, CODE, CODE2, [])},
[((val,get,true),TEMP,0)],
sys_comp_is(TERM, CODE2).
/***************************************************************/
/* Encoder */
/***************************************************************/
% sys_pack_fun(+Atom, -Integer)
sys_pack_fun(val, 0).
sys_pack_fun(acc, 1).
sys_pack_fun(add, 2).
sys_pack_fun(sub, 3).
sys_pack_fun(mul, 4).
sys_pack_fun(zdiv, 5).
sys_pack_fun(rem, 6).
% sys_pack_mode(+Atom, -Integer)
sys_pack_mode(get, 0).
sys_pack_mode(cst, 1).
sys_pack_mode(tbl, 2).
sys_pack_mode(set, 3).
sys_pack_mode(out, 4).
sys_pack_mode(in, 5).
% sys_pack_jump(+Atom, -Integer)
sys_pack_jump(true, 0).
sys_pack_jump(eq, 1).
sys_pack_jump(nq, 2).
sys_pack_jump(ls, 3).
sys_pack_jump(gr, 4).
sys_pack_jump(lq, 5).
sys_pack_jump(gq, 6).
% sys_pack_act(+Triple, -Integer)
sys_pack_act((FUN, MODE, COND), ACT) :-
sys_pack_fun(FUN, VAL),
sys_pack_mode(MODE, VAL2),
sys_pack_jump(COND, VAL3),
ACT is (VAL<<8) \/ (VAL2<<4) \/ VAL3.
% sys_pack_instr(+Term, -Integer)
sys_pack_instr(CONST, INSTR) :- integer(CONST), !,
INSTR = CONST.
sys_pack_instr((ACT, OBJ, REL), INSTR) :-
sys_pack_act(ACT, VAL),
INSTR is (VAL<<20) \/ ((OBJ + 512)<<10) \/ (REL + 512).
/***************************************************************/
/* Decode Hack Options */
/***************************************************************/
% sys_hack_opts(+List, +Triple, -Triple)
sys_hack_opts(V, _, _) :- var(V),
throw(error(instantiation_error,_)).
sys_hack_opts([X|L], I, O) :- !,
sys_hack_opt(X, I, H),
sys_hack_opts(L, H, O).
sys_hack_opts([], H, H) :- !.
sys_hack_opts(L, _, _) :-
throw(error(type_error(list,L),_)).
% sys_hack_opt(+Option, +Triple, -Triple)
sys_hack_opt(V, _, _) :- var(V),
throw(error(instantiation_error,_)).
sys_hack_opt(size(S), v(_,Y,Z), v(S,Y,Z)) :- !.
sys_hack_opt(O, _, _) :-
throw(error(domain_error(read_option,O),_)).
/****************************************************************/
/* Error Texts */
/****************************************************************/
% strings(+Atom, +Atom, -Atom)
:- multifile(strings/3).
strings('resource_error.shared_missing', de, 'Gemeinsamer Speicher fehlt').
strings('resource_error.shared_missing', '', 'Shared memory missing').
/*******************************************************************/
/* Foreign Predicates */
/*******************************************************************/
% cpu_data_new(A, B):
% defined in foreign(misc/hacklib)
% cpu_comp_new(C, S, O, M):
% defined in foreign(misc/hacklib)
% cpu_comp_work(M, W):
% defined in foreign(misc/hacklib)
% cpu_group_new(M, G):
% defined in foreign(misc/hacklib)
% cpu_group_start(G, I):
% defined in foreign(misc/hacklib)
% cpu_group_join(G, P):
% defined in foreign(misc/hacklib)
% cpu_group_free(G):
% defined in foreign(misc/hacklib)
:- ensure_loaded(foreign(misc/hacklib)).