/** * 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 !, {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= !, {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)).