units.mac, revision of 2005/05/01.

infix ("`", 118, 118);

matchdeclare (aa, true,
    cc, constantp,
    ccn0, constantp_not0,
    ccn1, constantp_not1,
    mm, mult_expr_nontrivialconstfactorsp,
    ndn1, nondimensional_not1,
    [uu, vv, ww], unitp,
    xx, nonconstantp);

simp: false$
tellsimpafter (uu^ccn1, (first(uu)^ccn1) ` (second(uu)^ccn1));
tellsimpafter (ndn1*uu, (ndn1*first(uu))`second(uu));

tellsimpafter (uu * vv, multiply_with_units (uu, vv));
tellsimpafter (uu * vv * ww, multiply_with_units (multiply_with_units (uu, vv), ww));
tellsimpafter (uu * vv * ndn1, block ([uv: multiply_with_units (uu, vv)], (ndn1*first(uv))`second(uv)));
tellsimpafter (uu + vv, add_with_units (uu, vv));

tellsimpafter (aa ` (xx + ccn0), (aa - ccn0)`xx);
tellsimpafter (aa ` mm, (constant_factors(mm) * aa) ` everything_else(mm));
tellsimpafter (aa ` cc, aa*cc);
simp: true$

unitp (e) := not atom(e) and nounify (op(e)) = nounify ("`");
constantp_not1 (x) := constantp(x) and x # 1;
constantp_not0 (x) := constantp(x) and x # 0;
nonconstantp (x) := not constantp (x);
mult_exprp (e) := not atom(e) and (nounify (op(e)) = nounify ("*") or nounify (op(e)) = nounify ("//"));
mult_expr_nontrivialconstfactorsp (e) := mult_exprp (e) and constant_factors (e) # 1;
nondimensional (e) := atom(e) or (op(e) # "`" and apply ("and", map (nondimensional, args(e))));
nondimensional_not1 (e) := e # 1 and nondimensional (e);

add_with_units (u, v) :=
  if not second(u) = second(v) then buildq ([u:u, v:v], u + v)
  else (first(u) + first(v)) ` second(u);

multiply_with_units(u,v) :=
  (first(u) * first(v)) ` simplify_units (second(u) * second(v));

constant_factors (e) := block ([L, eqns], L: listofvars(e), eqns: map ("=", L, L*0+1), subst (eqns, e));

everything_else(e) := e/constant_factors(e);

simplify_units (e) := e;