Promotion.mag

// This file is part of ExactpAdics
// Copyright (C) 2018 Christopher Doris
//
// ExactpAdics is free software: you can redistribute it and/or modify
// it under the terms of the GNU General Public License as published by
// the Free Software Foundation, either version 3 of the License, or
// (at your option) any later version.
//
// ExactpAdics is distributed in the hope that it will be useful,
// but WITHOUT ANY WARRANTY; without even the implied warranty of
// MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
// GNU General Public License for more details.
//
// You should have received a copy of the GNU General Public License
// along with ExactpAdics.  If not, see <http://www.gnu.org/licenses/>.


///# Miscellany
///## Promotion
/// A basic scheme for promoting values in different structures to a common strucure.

intrinsic IsPromotable(x, y) -> BoolElt, ., .
  {True if x and y are promotable to the same parent.}
  R := Parent(x);
  S := Parent(y);
  if R cmpeq S then
    return true, x, y;
  end if;
  ok, T := ExistsCoveringStructure(R, S);
  if ok then
    return true, T!x, T!y;
  end if;
  ok, x2 := IsCoercible(S, x);
  if ok then
    return true, x2, y;
  end if;
  ok, y2 := IsCoercible(R, y);
  if ok then
    return true, x, y2;
  end if;
  return false, _, _;
end intrinsic;

intrinsic Promote(x, y) -> ., .
  {Promotes x and y to a common type.}
  ok, x, y := IsPromotable(x, y);
  if ok then
    return x, y;
  else
    error Sprintf("not promotable: %o", x);
  end if;
end intrinsic;

// tries to do 'op'(x, y)
// it is assumed there is no intrinsic for this directly
// we try to promote x and y to a common value
function do_binop(op, x, y)
  S := Parent(x);
  T := Parent(y);
  if S cmpne T then
    ok, x2, y2 := IsPromotable(x, y);
    if ok then
      return op(x2, y2);
    end if;
    ok, y2, x2 := IsPromotable(y, x);
    if ok then
      return op(x2, y2);
    end if;
  elif Type(S) eq ExtRe then
    return op(Retrieve(x), Retrieve(y));
  end if;
  error Sprintf("operation %m not defined for these", op);
end function;