1%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 2% Copyright (C) 1990 Regents of the University of California. 3% All rights reserved. This program may be freely used and modified for 4% non-commercial purposes provided this copyright notice is kept unchanged. 5% Written by Peter Van Roy as a part of the Aquarius project. 6%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 7 8% Benchmark based on part of Aquarius Prolog compiler 9% Compiling unification into abstract machine code. 10 11top :- main(X). 12%, write(X), nl. 13 14main(Size) :- u(X, [1,Y], [X], Code), size(Code, 0, Size). 15 16% Unify variable X with term T and write the result: 17u(X, T, In, Code) :- unify(X, T, In, _, Code, []). 18 19% Unify the variable X with the term T, given that 20% In = set of variables initialized before the unification. 21% Returns the intermediate code for the unification and 22% Out = set of variables initialized after the unification. 23unify(X, T, In, Out) --> {\+myin(X, In)}, !, uninit(X, T, In, Out). 24unify(X, T, In, Out) --> {myin(X, In)}, !, init(X, T, In, Out, nonlast, _). 25 26%**** Uninit assumes X has not yet been initialized: 27uninit(X, T, In, Out) --> {my_compound(T)}, !, [move(Tag^h, X)], 28 {termtag(T, Tag)}, unify_block(nonlast, T, _, In, Mid, _), {incl(X, Mid, Out)}. 29uninit(X, T, In, Out) --> {atomic(T)}, !, [move(tatm^T, X)], {incl(X, In, Out)}. 30uninit(X, T, In, Out) --> {var(T)}, !, unify_var(X, T, In, Out). 31 32%**** Init assumes X has already been initialized: 33init(X, T, In, Out, Last, LLbls) --> {nonvar(T)}, !, 34 {termtag(T,Tag)}, [deref(X), switch(Tag,X,[trail(X) | Write],Read,fail)], 35 {unify_writemode(X, T, In, Last, LLbls, Write, [])}, 36 {unify_readmode(X, T, In, Out, LLbls, Read, [])}. 37init(X, T, In, Out, _, _) --> {var(T)}, !, unify_var(X, T, In, Out). 38 39%**** Unifying two variables together: 40unify_var(X, Y, In, In) --> { myin(X, In), myin(Y, In)}, !, [unify(X,Y,fail)]. 41unify_var(X, Y, In, Out) --> { myin(X, In), \+myin(Y, In)}, !, [move(X,Y)], {incl(Y, In, Out)}. 42unify_var(X, Y, In, Out) --> {\+myin(X, In), myin(Y, In)}, !, [move(Y,X)], {incl(X, In, Out)}. 43unify_var(X, Y, In, Out) --> {\+myin(X, In), \+myin(Y, In)}, !, 44 [move(tvar^h,X), move(tvar^h,Y), add(1,h), move(Y,[h-1])], 45 {incl(X, In, Mid), incl(Y, Mid, Out)}. 46 47%**** Unify_readmode assumes X is a dereferenced nonvariable 48% at run-time and T is a nonvariable at compile-time. 49unify_readmode(X, T, In, Out, LLbls) --> {structure(T)}, !, [equal([X],tatm^(F/N),fail)], 50 {functor(T, F, N)}, unify_args(1, N, T, In, Out, 0, X, LLbls). 51unify_readmode(X, T, In, Out, LLbls) --> {cons(T)}, !, 52 unify_args(1, 2, T, In, Out, -1, X, LLbls). 53unify_readmode(X, T, In, In, _) --> {atomic(T)}, !, [equal(X,tatm^T,fail)]. 54 55unify_args(I, N, _, In, In, _, _, _) --> {I>N}, !. 56unify_args(I, N, T, In, Out, D, X, [ _ | LLbls]) --> {I=N}, !, 57 unify_arg(I, T, In, Out, D, X, last, LLbls). 58unify_args(I, N, T, In, Out, D, X, LLbls) --> {I<N}, !, 59 unify_arg(I, T, In, Mid, D, X, nonlast, _), 60 {I1 is I+1}, unify_args(I1, N, T, Mid, Out, D, X, LLbls). 61 62unify_arg(I, T, In, Out, D, X, Last, LLbls) --> [move([X+ID],Y)], 63 {ID is I+D, incl(Y, In, Mid), arg(I, T, A)}, 64 init(Y, A, Mid, Out, Last, LLbls). 65 66 67 68%**** Unify_writemode assumes X is a dereferenced unbound 69% variable at run-time and T is a nonvariable at compile-time. 70unify_writemode(X, T, In, Last, LLbls) --> {my_compound(T)}, !, [move(Tag^h,[X])], 71 {termtag(T, Tag)}, unify_block(Last, T, _, In, _, LLbls). 72unify_writemode(X, T, _, _, _) --> {atomic(T)}, !, [move(tatm^T,[X])]. 73 74 75%**** Generate a minimal sequence of moves to create T on the heap: 76unify_block( last, T, Size, In, In, [Lbl | _ ]) --> !, [add(Size,h), jump(Lbl)], 77 {size(T, 0, Size)}. 78unify_block(nonlast, T, Size, In, Out, [ _ | LLbls]) --> !, [add(Size,h)], 79 {size(T, 0, Size), Offset is -Size}, block(T, Offset, 0, In, Out, LLbls). 80 81block(T, Inf, Outf, In, Out, LLbls) --> {structure(T)}, !, [move(tatm^(F/N), [h+Inf])], 82 {functor(T, F, N), Midf is Inf+N+1, S is Inf+1}, 83 make_slots(1, N, T, S, Offsets, In, Mid), 84 block_args(1, N, T, Midf, Outf, Offsets, Mid, Out, LLbls). 85block(T, Inf, Outf, In, Out, LLbls) --> {cons(T)}, !, 86 {Midf is Inf+2}, 87 make_slots(1, 2, T, Inf, Offsets, In, Mid), 88 block_args(1, 2, T, Midf, Outf, Offsets, Mid, Out, LLbls). 89block(T, Inf, Inf, In, In, []) --> {atomic(T)}, !. 90block(T, Inf, Inf, In, In, []) --> {var(T)}, !. 91 92block_args(I, N, _, Inf, Inf, [], In, In, []) --> {I>N}, !. 93block_args(I, N, T, Inf, Outf, [Inf], In, Out, [Lbl | LLbls]) --> {I=N}, !, [label(Lbl)], 94 {arg(I, T, A)}, block(A, Inf, Outf, In, Out, LLbls). 95block_args(I, N, T, Inf, Outf, [Inf | Offsets], In,Out,LLbls) --> {I<N}, !, 96 {arg(I, T, A)}, block(A, Inf, Midf, In, Mid, _), {I1 is I+1}, 97 block_args(I1, N, T, Midf, Outf, Offsets, Mid, Out, LLbls). 98 99make_slots(I, N, _, _, [], In, In) --> {I>N}, !. 100make_slots(I, N, T, S, [Off | Offsets], In, Out) --> {I=<N}, !, 101 {arg(I, T, A)}, init_var(A, S, In), 102 {incl(A, In, Mid), make_word(A, Off, Word)}, [move(Word,[h+S])], 103 {S1 is S+1, I1 is I+1}, 104 make_slots(I1, N, T, S1, Offsets, Mid, Out). 105 106 107% Initialize first-time variables in write mode: 108init_var(V, I, In) --> {var(V), \+myin(V, In)}, !, [move(tvar^(h+I),V)]. 109init_var(V, _, In) --> {var(V), myin(V, In)}, !. 110init_var(V, _, _) --> {nonvar(V)}, !. 111 112make_word(C, Off, Tag^(h+Off)) :- my_compound(C), !, termtag(C, Tag). 113make_word(V, _, V) :- var(V), !. 114make_word(A, _, tatm^A) :- atomic(A), !. 115 116% Calculate the size of T on the heap: 117size(T) --> {structure(T)}, !, {functor(T, _, N)}, add(1), add(N), size_args(1, N, T). 118size(T) --> {cons(T)}, !, add(2), size_args(1, 2, T). 119size(T) --> {atomic(T)}, !. 120size(T) --> {var(T)}, !. 121 122size_args(I, N, _) --> {I>N}, !. 123size_args(I, N, T) --> {I=<N}, !, {arg(I, T, A)}, size(A), {I1 is I+1}, size_args(I1, N, T). 124 125%**** Utility routines: 126 127add(I, X, Y) :- Y is X+I. 128 129myin(A, [B|S]) :- 130 compare(Order, A, B), 131 in_2(Order, A, S). 132 133in_2(=, _, _). 134in_2(>, A, S) :- myin(A, S). 135 136incl(A, S1, S) :- incl_2(S1, A, S). 137 138incl_2([], A, [A]). 139incl_2([B|S1], A, S) :- 140 compare(Order, A, B), 141 incl_3(Order, A, B, S1, S). 142 143incl_3(<, A, B, S1, [A,B|S1]). 144incl_3(=, _, B, S1, [B|S1]). 145incl_3(>, A, B, S1, [B|S]) :- incl_2(S1, A, S). 146 147my_compound(X) :- nonvar(X), \+atomic(X). 148cons(X) :- nonvar(X), X=[_|_]. 149structure(X) :- my_compound(X), \+X=[_|_]. 150 151termtag(T, tstr) :- structure(T). 152termtag(T, tlst) :- cons(T). 153termtag(T, tatm) :- atomic(T). 154termtag(T, tvar) :- var(T). 155 156 157 158 159