
bool or (>FALSE,>FALSE,FALSE>): ->;
bool or (>v,>w,TRUE>):.

bool and (>TRUE,>TRUE,TRUE>): ->;
bool and (>v,>w,FALSE>):.

%TEX     
\subsubsection{Do operations on strings VBuiltin}
%
x equal (>a 1 * a 2 * _  ,>repair node):
    where (> a 1, x * y * val 1>),
    where (> a 2, x * y * val 2>),
    more x equal (>val 1,> val 2,>repair node).

more x equal (>val,>val,>repair node):->,
    repair (>repair node,>ParBool , >BOOL * TRUE);
more x equal (>v,>w,>repair node):
    repair (>repair node,>ParBool , >BOOL * FALSE).


%TEX
\subsection{Applications.}
%
symbol application(>node,>org,>STRING  * name,>apply list):
    lookup (>name,>"Mac",def csd>),->,
    macro application (>node, >org,>name,>def csd,>apply list);
symbol application(>node,>org,>STRING * name,>apply list):
    lookup (>name,>"Def",def csd>),->,
    def application (>org,>name,>def csd,>apply list);
symbol application(>node,>org,>name ce,>apply list):
    where (>name ce,STRING * name>),
    lookup (>name,>"Atom",def csd>),->,
    atom application (>org,>name ce,>apply list);
symbol application(>node,>org,>name,>apply list):.

macro application (>node,>org,>name, >def*d org*name ce*body cs,>actual args):
    where (>body cs, vtype*typecs * macalts cs>),
    where (>macalts cs,VMacAlts*LIST * mac alts >),
    select right number of args (>node,>mac alts,>actual args), ->;
macro application (>node,>TUPLE*file el*line el,>name, >_,>_):
    where (>file el, STRING * file>),
    where (>line el, I NUM *line>),
    type out (>"me: Malformed macro application of `"+name+"'\n"+
    "   at "+file+" "+line+".\n").

select right number of args (>node,>f list,>a cs):
    where (>f list, first cs *r>),
    get f arg count (>first cs, >empty, f nr>),
    get a arg count (>a cs, a nr>, val pars>),
    compare (>a nr, >f nr, r a>, r f>),
    more select actuals (>node,>f nr,>f list,> val pars,> r f, > r a).

%TEX
get number of actual parameters
%
get a arg count (>VApply*r*_, i>,r>): ->,
    more get a arg count (>r,>empty, i>);
get a arg count (>vval apply , i>,vval apply>):
    more get a arg count (>vval apply,>empty, i>).

more get a arg count (>VValApply*r*_,>i, ii>): ->,
    more get a arg count (>r,>i+"i", ii>);
more get a arg count (>_,>i, i>):.

%TEX
get number of actual parameters
%
get f arg count (>VMacLambda*a*r,>i, ii>): ->,
    get f arg count (>r,>i+"i", ii>);
get f arg count (>_,>i, i>):.

more select actuals (>node,>empty, >body*_,> a cs,>_, >_): ->,
    some name (replace list>),
    copy meta ds (>replace list,>body, matched body>),
    trans val (>matched body, >matched body,>empty),
    where (>matched body, m name*m rest>),
    repair(>node,>m name,>m rest);
more select actuals (>_,>_,>f list,> a cs,>empty, >empty): ->,
    fill in (>f list, >a cs, matched body>),
#    trans val  (>matched body, >matched body,>empty),
    where (>matched body, m name*m rest>),
    repair(>a cs,>m name,>m rest);
more select actuals (>_,>_,>f list, > a cs,>empty, >to much args): ->,
    strip actuals (>a cs,>to much args, stripped a cs>),
    fill in (>f list, >stripped a cs, matched body>),
    where (>matched body,m name*m rest>),
    repair(>stripped a cs,>m name,>m rest),
    trans val (>a cs, >a cs,>empty);
more select actuals (>_,>_,>f list, > a cs,>to few, >empty): .

%TEX
If there are more formal then actual parameters we need
to strip some of them.
%
strip actuals (>a cs,>empty, a cs>): ->;
strip actuals (>_*r*_,>"i"+i, stripped a cs>):
    strip actuals (>r,>i, stripped a cs>).

def application (>org,>name, >def*d org*name ce*body cs,>actual args):
    where (>body cs, vtype*typecs * vmaclambda cs>),
    where (>vmaclambda cs,VMacLambda*_>),
    where (>vmaclambda cs*empty, def alts>),
    select right number of args (>empty,>def alts,>actual args), ->;
def application (>TUPLE*file el*line el,>name, >_,>_):
    where (>file el, STRING *file>),
    where (>line el, I NUM *line>),
    type out (>"me: mallformed def application of `"+name+"'\n"+
    "   at "+file+" "+line+".\n").  
