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 sys_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 sys_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):
* The predicate fails always. 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.
*/
% emulate(+Goal)
emulate(GOAL) :-
sys_comp_goal(GOAL, _, [], CODE, []),
term_variables(CODE, LIST),
copy_term(LIST, STATE),
sys_number_list(LIST, 0, 1),
sys_number_list(STATE, 0, 0),
sys_run(0, CODE, 0, STATE).
% 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).
/**
* execute(G):
* The predicate fails always. 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.
*/
% execute(+Goal)
execute(GOAL) :-
sys_comp_goal(GOAL, _, [], CODE, []),
term_variables(CODE, LIST),
copy_term(LIST, STATE),
sys_number_list(LIST, 0, 1),
maplist(sys_pack_instr, CODE, CODE2),
sys_number_list(STATE, 0, 0),
ir_piwam_new(CODE2, STATE, PIWAM),
ir_piwam_run(PIWAM).
/***************************************************************/
/* Evaluator */
/***************************************************************/
% sys_run(+Integer, +List, +Integer, +List)
sys_run(PC, CODE, ACCU, STATE) :-
nth0(PC, CODE, INSTR),
INSTR = (ACT, OBJ, REL),
ACT = (FUN, MODE, COND),
sys_run_get(MODE, OBJ, STATE, VALUE),
sys_run_fun(FUN, ACCU, VALUE, ACCU2),
sys_run_set(MODE, OBJ, STATE, ACCU2, STATE2),
sys_run_jump(COND, ACCU2, REL, REL2),
PC2 is PC+1+REL2,
sys_run(PC2, CODE, ACCU2, STATE2).
% sys_run_get(+Atom, +Integer, +Compound, -Integer)
sys_run_get(get, OBJ, STATE, VALUE) :- nth0(OBJ, STATE, VALUE).
sys_run_get(cst, OBJ, _, OBJ).
sys_run_get(set, _, _, 0).
sys_run_get(out, _, _, 0).
sys_run_get(in, _, _, VALUE) :-
write(': '),
flush_output,
sys_readbig(TEMP),
sys_int32(TEMP, VALUE).
% sys_run_fun(+Atom, +Integer, +Integer, -Integer)
sys_run_fun(val, _, VALUE, VALUE).
sys_run_fun(acc, ACCU, _, ACCU).
sys_run_fun(add, ACCU, VALUE, ACCU2) :-
TEMP is VALUE+ACCU,
sys_int32(TEMP, ACCU2).
sys_run_fun(sub, ACCU, VALUE, ACCU2) :-
TEMP is VALUE-ACCU,
sys_int32(TEMP, ACCU2).
sys_run_fun(mul, ACCU, VALUE, ACCU2) :-
TEMP is VALUE*ACCU,
sys_int32(TEMP, ACCU2).
sys_run_fun(nil, _, _, ACCU2) :-
ACCU2 = [].
sys_run_fun(cons, ACCU, VALUE, ACCU2) :-
ACCU2 = [VALUE|ACCU].
sys_run_fun(car, ACCU, _, ACCU2) :-
ACCU = [ACCU2|_].
sys_run_fun(cdr, ACCU, _, ACCU2) :-
ACCU = [_|ACCU2].
% sys_run_set(+Atom, +Integer, +Compound, +Integer, -Compound)
sys_run_set(get, _, STATE, _, STATE).
sys_run_set(cst, _, STATE, _, STATE).
sys_run_set(set, OBJ, STATE, ACCU2, STATE2) :-
nth0(OBJ, STATE, _, TEMP),
nth0(OBJ, STATE2, ACCU2, TEMP).
sys_run_set(out, _, STATE, ACCU2, STATE) :- write(ACCU2), nl.
sys_run_set(in, _, STATE, _, STATE).
% sys_run_jump(+Atom, +Integer, +Integer, -Integer)
sys_run_jump(eq, ACCU, REL, REL2) :- (ACCU =:= 0 -> REL2 = REL; REL2 = 0).
sys_run_jump(nq, ACCU, REL, REL2) :- (ACCU =\= 0 -> REL2 = REL; REL2 = 0).
sys_run_jump(ls, ACCU, REL, REL2) :- (ACCU < 0 -> REL2 = REL; REL2 = 0).
sys_run_jump(gr, ACCU, REL, REL2) :- (ACCU > 0 -> REL2 = REL; REL2 = 0).
sys_run_jump(lq, ACCU, REL, REL2) :- (ACCU =< 0 -> REL2 = REL; REL2 = 0).
sys_run_jump(gq, ACCU, REL, REL2) :- (ACCU >= 0 -> REL2 = REL; REL2 = 0).
sys_run_jump(unit, ACCU, REL, REL2) :- (ACCU \= [] -> REL2 = REL; REL2 = 0).
sys_run_jump(pair, ACCU, REL, REL2) :- (ACCU \= [_|_] -> REL2 = REL; REL2 = 0).
sys_run_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_readbig(-Integer)
sys_readbig(RESULT) :-
get_atom(ATOM, []),
sub_atom(ATOM, 0, _, 1, CROPED),
atom_integer(CROPED, 10, RESULT).
/***************************************************************/
/* Compiler */
/***************************************************************/
% sys_comp_goal(+Goal, +List, +List, -List, +List)
sys_comp_goal(TERM is EXPR, STACK, CODE) --> !,
sys_comp_arith(EXPR, STACK), sys_comp_is(TERM, STACK, CODE).
sys_comp_goal(out(LIST), STACK, CODE) --> !,
sys_comp_build(LIST, STACK), [((acc,out,true),0,0)], phrase(CODE).
sys_comp_goal(in(LIST), STACK, CODE) --> !,
[((val,in,true),0,0)], sys_comp_is(LIST, STACK, 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), STACK, CODE) --> !, {length(CODE, REL)},
sys_comp_build(TERM, STACK), [((acc,set,true),VAR,0)],
{REL2 is REL+3}, sys_comp_build(TERM2, STACK), [((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, CODE) --> !,
{sys_comp_goal(GOAL2, STACK, CODE, CODE2, [])},
sys_comp_goal(GOAL, STACK, CODE2).
% sys_comp_arith(+Expr, +List, -List, +List)
sys_comp_arith(CONST, _) --> {integer(CONST)}, !,
[((val,cst,true),CONST,0)].
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_build(+Term, +List, -List, +List)
sys_comp_build(CONST, _) --> {integer(CONST)}, !,
[((val,cst,true),CONST,0)].
sys_comp_build(VAR, _) --> {var(VAR)}, !,
[((val,get,true),VAR,0)].
sys_comp_build([], _) --> !,
[((nil,cst,true),0,0)].
sys_comp_build([TERM|REST], [TEMP|STACK]) --> !,
sys_comp_build(TERM, STACK), [((acc,set,true),TEMP,0)],
sys_comp_build(REST, STACK), [((cons,get,true),TEMP,0)].
% sys_comp_is(+Term, +List, +List, -List, +List)
sys_comp_is(CONST, _, CODE) --> {integer(CONST)}, !, {length(CODE, REL)},
[((sub,cst,nq),CONST,REL)], phrase(CODE).
sys_comp_is(VAR, _, CODE) --> {var(VAR)}, !,
[((acc,set,true),VAR,0)], phrase(CODE).
sys_comp_is([], _, CODE) --> !, {length(CODE, REL)},
[((acc,cst,unit),0,REL)], phrase(CODE).
sys_comp_is([TERM|REST], STACK, CODE) --> !, {sys_comp_cdr(REST, STACK, CODE, CODE2, []),
sys_comp_car(TERM, STACK, CODE2, CODE3, []), length(CODE3, REL)},
[((acc,cst,pair),0,REL)], phrase(CODE3).
% sys_comp_car(+Term, +List, +List, -List, +List)
sys_comp_car(TERM, [TEMP|STACK], CODE) -->
[((acc,set,true),TEMP,0), ((car,cst,true),0,0)], sys_comp_is(TERM, STACK, CODE).
% sys_comp_cdr(+Term, +List, +List, -List, +List)
sys_comp_cdr(REST, [TEMP|STACK], CODE) -->
[((val,get,true),TEMP,0), ((cdr,cst,true),0,0)], sys_comp_is(REST, STACK, CODE).
/***************************************************************/
/* 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(nil, 8).
sys_pack_fun(cons, 9).
sys_pack_fun(car, 10).
sys_pack_fun(cdr, 11).
% sys_pack_mode(+Atom, -Integer)
sys_pack_mode(get, 0).
sys_pack_mode(cst, 1).
sys_pack_mode(set, 2).
sys_pack_mode(out, 4).
sys_pack_mode(in, 5).
% sys_pack_jump(+Atom, -Integer)
sys_pack_jump(eq, 0).
sys_pack_jump(nq, 1).
sys_pack_jump(ls, 2).
sys_pack_jump(gr, 3).
sys_pack_jump(lq, 4).
sys_pack_jump(gq, 5).
sys_pack_jump(unit, 8).
sys_pack_jump(pair, 9).
sys_pack_jump(true, 15).
% 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(+Tripple, -Integer)
sys_pack_instr((ACT, OBJ, REL), INSTR) :-
sys_pack_act(ACT, VAL),
INSTR is (VAL<<20) \/ ((OBJ + 512)<<10) \/ (REL + 512).
/*******************************************************************/
/* Foreign Predicates */
/*******************************************************************/
:- ensure_loaded(foreign(edge/piwamlib)).