From: peter klausler <pklausler@nvidia.com>
Date: Wed, 22 Aug 2018 20:36:45 +0000 (-0700)
Subject: [flang] Replace FOR_EACH_... macro cruft with safer template metaprogramming.
X-Git-Tag: llvmorg-12-init~9537^2~2186
X-Git-Url: http://review.tizen.org/git/?a=commitdiff_plain;h=e90480785db2b721ef2ca8f4c2235b82a3c3e73b;p=platform%2Fupstream%2Fllvm.git

[flang] Replace FOR_EACH_... macro cruft with safer template metaprogramming.

Original-commit: flang-compiler/f18@bc3c4279b053bf9d779bb9b341cde8bd6222260a
Reviewed-on: https://github.com/flang-compiler/f18/pull/183
Tree-same-pre-rewrite: false
---

diff --git a/flang/lib/common/idioms.h b/flang/lib/common/idioms.h
index 1e58172..8a97c1e 100644
--- a/flang/lib/common/idioms.h
+++ b/flang/lib/common/idioms.h
@@ -129,17 +129,21 @@ template<typename A> struct ListItemCount {
         static_cast<int>(e), #__VA_ARGS__); \
   }
 
+template<typename A> std::optional<A> GetIfNonNull(const A *p) {
+  if (p) {
+    return {*p};
+  }
+  return std::nullopt;
+}
+
 // If a variant holds a value of a particular type, return a copy in a
 // std::optional<>.
 template<typename A, typename VARIANT>
 std::optional<A> GetIf(const VARIANT &u) {
-  if (const A * x{std::get_if<A>(&u)}) {
-    return {*x};
-  }
-  return std::nullopt;
+  return GetIfNonNull(std::get_if<A>(&u));
 }
 
-// Collapses a nested std::optional<std::optional<A>>
+// Collapses a nested std::optional<std::optional<A>> to std::optional<A>
 template<typename A>
 std::optional<A> JoinOptionals(std::optional<std::optional<A>> &&x) {
   if (x.has_value()) {
@@ -168,5 +172,6 @@ std::optional<A> MapOptional(std::function<A(B &&, C &&)> &f,
   }
   return std::nullopt;
 }
+
 }  // namespace Fortran::common
 #endif  // FORTRAN_COMMON_IDIOMS_H_
diff --git a/flang/lib/common/kind-variant.h b/flang/lib/common/kind-variant.h
new file mode 100644
index 0000000..95058df
--- /dev/null
+++ b/flang/lib/common/kind-variant.h
@@ -0,0 +1,121 @@
+// Copyright (c) 2018, NVIDIA CORPORATION.  All rights reserved.
+//
+// Licensed under the Apache License, Version 2.0 (the "License");
+// you may not use this file except in compliance with the License.
+// You may obtain a copy of the License at
+//
+//     http://www.apache.org/licenses/LICENSE-2.0
+//
+// Unless required by applicable law or agreed to in writing, software
+// distributed under the License is distributed on an "AS IS" BASIS,
+// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
+// See the License for the specific language governing permissions and
+// limitations under the License.
+
+#ifndef FORTRAN_COMMON_KIND_VARIANT_H_
+#define FORTRAN_COMMON_KIND_VARIANT_H_
+
+#include "template.h"
+#include <utility>
+#include <variant>
+
+namespace Fortran::common {
+
+// A KindVariant instantiates a std::variant over a collection of types
+// derived by applying a given template to each of a list of "kind" arguments,
+// wraps that variant as the sole data member ("u"), and supplies some helpful
+// member functions and member function templates to perform reverse
+// mappings of both alternative indices and alternative types back to their
+// kinds, invoke kind-dependent templates based on dynamic kind values, &c.
+template<typename KIND, template<KIND> class TYPE, KIND... KINDS>
+struct KindVariant {
+  using Kind = KIND;
+
+  static constexpr auto kinds{sizeof...(KINDS)};
+  static constexpr Kind kindValue[kinds]{KINDS...};
+  template<Kind K> using KindType = TYPE<K>;
+
+  using Variant = std::variant<KindType<KINDS>...>;
+
+  CLASS_BOILERPLATE(KindVariant)
+  template<typename A> KindVariant(const A &x) : u{x} {}
+  template<typename A>
+  KindVariant(std::enable_if_t<!std::is_reference_v<A>, A> &&x)
+    : u{std::move(x)} {}
+
+  template<typename A> KindVariant &operator=(const A &x) {
+    u = x;
+    return *this;
+  }
+  template<typename A> KindVariant &operator=(A &&x) {
+    u = std::move(x);
+    return *this;
+  }
+
+  static constexpr Kind IndexToKind(int index) { return kindValue[index]; }
+
+  template<typename A>
+  static constexpr Kind TypeToKind{
+      IndexToKind(TypeIndex<A, KindType<KINDS>...>)};
+
+  Kind kind() const { return IndexToKind(u.index()); }
+
+  // Accessors for alternatives as identified by kind or type.
+  template<Kind K> KindType<K> *GetIfKind() {
+    if (auto *p{std::get_if<KindType<K>>(u)}) {
+      return p;
+    }
+    return nullptr;
+  }
+  template<Kind K> const KindType<K> *GetIfKind() const {
+    if (const auto *p{std::get_if<KindType<K>>(u)}) {
+      return p;
+    }
+    return nullptr;
+  }
+  template<Kind K> std::optional<KindType<K>> GetIf() const {
+    return common::GetIf<KindType<K>>(u);
+  }
+
+  // Given an instance of some class A with a member template function
+  // "template<Kind K> void action();", AtKind<A>(A &a, Kind k) will
+  // invoke a.action<k> with a *dynamic* kind value.
+private:
+  template<typename A, int J> static void Helper(A &a, Kind k) {
+    static constexpr Kind K{IndexToKind(J)};
+    if (k == K) {
+      a.template action<K>();
+    } else if constexpr (J + 1 < kinds) {
+      Helper<A, J + 1>(a, k);
+    }
+  }
+
+public:
+  template<typename A> static void AtKind(A &a, Kind k) { Helper<A, 0>(a, k); }
+
+  // When each of the alternatives of a KindVariant has a constructor that
+  // accepts an rvalue reference to some (same) type A, this template can be
+  // used to create a KindVariant instance of a forced kind.
+private:
+  template<typename A> struct SetResult {
+    explicit SetResult(A &&x) : value{std::move(x)} {}
+    template<Kind K> void action() {
+      CHECK(!result.has_value());
+      result = KindVariant{KindType<K>{std::move(value)}};
+    }
+    std::optional<KindVariant> result;
+    A value;
+  };
+
+public:
+  template<typename A>
+  static std::optional<KindVariant> ForceKind(Kind k, A &&x) {
+    SetResult<A> setter{std::move(x)};
+    AtKind(setter, k);
+    return std::move(setter.result);
+  }
+
+  Variant u;
+};
+}  // namespace Fortran::common
+#endif  // FORTRAN_COMMON_KIND_VARIANT_H_
diff --git a/flang/lib/common/template.h b/flang/lib/common/template.h
new file mode 100644
index 0000000..cd26419
--- /dev/null
+++ b/flang/lib/common/template.h
@@ -0,0 +1,77 @@
+// Copyright (c) 2018, NVIDIA CORPORATION.  All rights reserved.
+//
+// Licensed under the Apache License, Version 2.0 (the "License");
+// you may not use this file except in compliance with the License.
+// You may obtain a copy of the License at
+//
+//     http://www.apache.org/licenses/LICENSE-2.0
+//
+// Unless required by applicable law or agreed to in writing, software
+// distributed under the License is distributed on an "AS IS" BASIS,
+// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
+// See the License for the specific language governing permissions and
+// limitations under the License.
+
+#ifndef FORTRAN_COMMON_TEMPLATE_H_
+#define FORTRAN_COMMON_TEMPLATE_H_
+
+// Template metaprogramming utilities
+
+namespace Fortran::common {
+
+// SearchTypeList<PREDICATE, TYPES...> scans a list of types.  The zero-based
+// index of the first type T in the list for which PREDICATE<T>::value() is
+// true is returned, or -1 if the predicate is false for every type in the list.
+template<int N, template<typename> class PREDICATE, typename A,
+    typename... REST>
+struct SearchTypeListTemplate {
+  static constexpr int value() {
+    if constexpr (PREDICATE<A>::value()) {
+      return N;
+    } else if constexpr (sizeof...(REST) == 0) {
+      return -1;
+    } else {
+      return SearchTypeListTemplate<N + 1, PREDICATE, REST...>::value();
+    }
+  }
+};
+
+template<template<typename> class PREDICATE, typename... TYPES>
+constexpr int SearchTypeList{
+    SearchTypeListTemplate<0, PREDICATE, TYPES...>::value()};
+
+// TypeIndex<A, TYPES...> scans a list of types for simple type equality.
+// The zero-based index of A in the list is returned, or -1 if A is not present.
+template<typename A> struct MatchType {
+  template<typename B> struct Match {
+    static constexpr bool value() {
+      return std::is_same_v<std::decay_t<A>, std::decay_t<B>>;
+    }
+  };
+};
+
+template<typename A, typename... TYPES>
+constexpr int TypeIndex{SearchTypeList<MatchType<A>::template Match, TYPES...>};
+
+// SearchVariantType<PREDICATE> scans the types that constitute the alternatives
+// of a std::variant instantiation.  The zero-based index of the first type T
+// among the alternatives for which PREDICATE<T>::value() is true is returned,
+// or -1 if the predicate is false for every alternative of the union.
+
+// N.B. It *is* possible to extract the types of the alternatives of a
+// std::variant discriminated union instantiation and reuse them as a
+// template parameter pack in another template instantiation.  The trick is
+// to match the std::variant type with a partial specialization.
+template<template<typename> class PREDICATE, typename V>
+struct SearchVariantTypeTemplate;
+template<template<typename> class PREDICATE, typename... Ts>
+struct SearchVariantTypeTemplate<PREDICATE, std::variant<Ts...>> {
+  static constexpr int index{SearchTypeList<PREDICATE, Ts...>};
+};
+
+template<template<typename> class PREDICATE, typename VARIANT>
+constexpr int SearchVariantType{
+    SearchVariantTypeTemplate<PREDICATE, VARIANT>::index};
+
+}  // namespace Fortran::common
+#endif  // FORTRAN_COMMON_TEMPLATE_H_
diff --git a/flang/lib/evaluate/expression.cc b/flang/lib/evaluate/expression.cc
index 2e493ec..a4e3261 100644
--- a/flang/lib/evaluate/expression.cc
+++ b/flang/lib/evaluate/expression.cc
@@ -179,7 +179,7 @@ auto Expr<SomeKind<CAT>>::Fold(FoldingContext &context)
         }
         return std::nullopt;
       },
-      u);
+      u.u);
 }
 
 auto Expr<SomeType>::Fold(FoldingContext &context)
@@ -218,7 +218,7 @@ auto Convert<TO, FROM>::FoldScalar(FoldingContext &context,
           using Ty = std::decay_t<decltype(x)>;
           return Convert<Result, Ty>::FoldScalar(context, x);
         },
-        c.u);
+        c.u.u);
   } else if constexpr (std::is_same_v<Result, SomeKind<Result::category>>) {
     if constexpr (Result::category == Operand::category) {
       return {Scalar<Result>{c}};
@@ -226,10 +226,10 @@ auto Convert<TO, FROM>::FoldScalar(FoldingContext &context,
   } else if constexpr (std::is_same_v<Operand, SomeKind<Operand::category>>) {
     return std::visit(
         [&](const auto &x) -> std::optional<Scalar<Result>> {
-          using Ty = ScalarValueType<std::decay_t<decltype(x)>>;
+          using Ty = TypeOf<std::decay_t<decltype(x)>>;
           return Convert<Result, Ty>::FoldScalar(context, x);
         },
-        c.u);
+        c.u.u);
   } else if constexpr (Result::category == TypeCategory::Integer) {
     if constexpr (Operand::category == TypeCategory::Integer) {
       auto converted{Scalar<Result>::ConvertSigned(c)};
@@ -398,7 +398,7 @@ auto RealToIntPower<A, B>::FoldScalar(FoldingContext &context,
         RealFlagWarnings(context, power.flags, "raising to INTEGER power");
         return {std::move(power.value)};
       },
-      y.u);
+      y.u.u);
 }
 
 template<typename A>
@@ -540,12 +540,12 @@ std::ostream &DumpExpr(std::ostream &o, const std::variant<A...> &u) {
 
 template<TypeCategory CAT>
 std::ostream &Expr<SomeKind<CAT>>::Dump(std::ostream &o) const {
-  return DumpExpr(o, u);
+  return DumpExpr(o, u.u);
 }
 
 template<TypeCategory CAT>
 std::ostream &Relational<SomeKind<CAT>>::Dump(std::ostream &o) const {
-  return DumpExpr(o, u);
+  return DumpExpr(o, u.u);
 }
 
 std::ostream &Expr<SomeType>::Dump(std::ostream &o) const {
@@ -658,7 +658,7 @@ auto Expr<SomeKind<CAT>>::ScalarValue() const -> std::optional<Scalar<Result>> {
         }
         return std::nullopt;
       },
-      u);
+      u.u);
 }
 
 auto Expr<SomeType>::ScalarValue() const -> std::optional<Scalar<Result>> {
@@ -679,7 +679,7 @@ auto Expr<SomeType>::ScalarValue() const -> std::optional<Scalar<Result>> {
 // Rank
 
 template<TypeCategory CAT> int Expr<SomeKind<CAT>>::Rank() const {
-  return std::visit([](const auto &x) { return x.Rank(); }, u);
+  return std::visit([](const auto &x) { return x.Rank(); }, u.u);
 }
 
 int Expr<SomeType>::Rank() const {
diff --git a/flang/lib/evaluate/expression.h b/flang/lib/evaluate/expression.h
index e00f5ff..aa66ce2 100644
--- a/flang/lib/evaluate/expression.h
+++ b/flang/lib/evaluate/expression.h
@@ -37,13 +37,16 @@ namespace Fortran::evaluate {
 using common::RelationalOperator;
 
 // Expr<A> represents an expression whose result is the Fortran type A,
-// which can be specific, SomeKind<C> for a type category C, or
+// which can be a specific Type<C,K>, or SomeKind<C> for a type category C, or
 // Expr<SomeType> for a wholly generic expression.  Instances of Expr<>
 // wrap discriminated unions.
 template<typename A> class Expr;
 
 template<typename A> using ResultType = typename std::decay_t<A>::Result;
 
+// Abstract Operation<> base class.  The first type parameter is a "CRTP"
+// reference to the specific operation class; e.g., Add is defined with
+// struct Add : public Operation<Add, ...>.
 template<typename DERIVED, typename RESULT, typename... OPERAND>
 class Operation {
 public:
@@ -495,18 +498,21 @@ struct Relational : public Operation<Relational<A>, LogicalResult, A, A> {
 // A generic relation between two operands of the same kind in some intrinsic
 // type category (except LOGICAL).
 template<TypeCategory CAT> struct Relational<SomeKind<CAT>> {
+  static constexpr TypeCategory category{CAT};
   using Result = LogicalResult;
   using Operand = SomeKind<CAT>;
-  template<int KIND> using KindRelational = Relational<Type<CAT, KIND>>;
+  template<TypeCategory C, int K> using KindRelational = Relational<Type<C, K>>;
 
   CLASS_BOILERPLATE(Relational)
-  template<int KIND> Relational(const KindRelational<KIND> &x) : u{x} {}
-  template<int KIND> Relational(KindRelational<KIND> &&x) : u{std::move(x)} {}
+  template<int KIND>
+  Relational(const KindRelational<category, KIND> &x) : u{x} {}
+  template<int KIND>
+  Relational(KindRelational<category, KIND> &&x) : u{std::move(x)} {}
 
   std::optional<Scalar<Result>> Fold(FoldingContext &);
   std::ostream &Dump(std::ostream &) const;
 
-  KindsVariant<CAT, KindRelational> u;
+  CategoryUnion<CAT, KindRelational> u;
 };
 
 template<int KIND> class Expr<Type<TypeCategory::Logical, KIND>> {
@@ -552,17 +558,31 @@ template<TypeCategory CAT> class Expr<SomeKind<CAT>> {
 public:
   using Result = SomeKind<CAT>;
   using FoldableTrait = std::true_type;
+  static constexpr TypeCategory category{CAT};
   CLASS_BOILERPLATE(Expr)
 
-  template<int KIND> using KindExpr = Expr<Type<CAT, KIND>>;
-  template<int KIND> Expr(const KindExpr<KIND> &x) : u{x} {}
-  template<int KIND> Expr(KindExpr<KIND> &&x) : u{std::move(x)} {}
+  template<TypeCategory C, int K> using KindExpr = Expr<Type<C, K>>;
+  using Variant = CategoryUnion<category, KindExpr>;
+  Expr(Variant &&x) : u{std::move(x)} {}
+  template<int KIND> Expr(const KindExpr<category, KIND> &x) : u{x} {}
+  template<int KIND> Expr(KindExpr<category, KIND> &&x) : u{std::move(x)} {}
   std::optional<Scalar<Result>> ScalarValue() const;
   std::ostream &Dump(std::ostream &) const;
   std::optional<Scalar<Result>> Fold(FoldingContext &);
   int Rank() const;
 
-  KindsVariant<CAT, KindExpr> u;
+  template<typename A> static std::optional<Expr> ForceKind(int kind, A &&x) {
+    if (std::optional<Variant> result{
+            Variant::template ForceKind<A>(kind, std::move(x))}) {
+      return {Expr{std::move(*result)}};
+    }
+    return std::nullopt;
+  }
+  template<typename A> static void AtKind(A &x, int kind) {
+    Variant::template AtKind<A>(x, kind);
+  }
+
+  Variant u;
 };
 
 // BOZ literal constants need to be wide enough to hold an integer or real
diff --git a/flang/lib/evaluate/tools.h b/flang/lib/evaluate/tools.h
index f1bc983..36aba3c 100644
--- a/flang/lib/evaluate/tools.h
+++ b/flang/lib/evaluate/tools.h
@@ -51,7 +51,7 @@ Expr<Type<C, K>> operator/(Expr<Type<C, K>> &&x, Expr<Type<C, K>> &&y) {
 
 template<TypeCategory C> Expr<SomeKind<C>> operator-(Expr<SomeKind<C>> &&x) {
   return std::visit(
-      [](auto &xk) { return Expr<SomeKind<C>>{-std::move(xk)}; }, x.u);
+      [](auto &xk) { return Expr<SomeKind<C>>{-std::move(xk)}; }, x.u.u);
 }
 
 template<TypeCategory C>
@@ -60,7 +60,7 @@ Expr<SomeKind<C>> operator+(Expr<SomeKind<C>> &&x, Expr<SomeKind<C>> &&y) {
       [](auto &xk, auto &yk) {
         return Expr<SomeKind<C>>{std::move(xk) + std::move(yk)};
       },
-      x.u, y.u);
+      x.u.u, y.u.u);
 }
 
 template<TypeCategory C>
@@ -69,7 +69,7 @@ Expr<SomeKind<C>> operator-(Expr<SomeKind<C>> &&x, Expr<SomeKind<C>> &&y) {
       [](auto &xk, auto &yk) {
         return Expr<SomeKind<C>>{std::move(xk) - std::move(yk)};
       },
-      x.u, y.u);
+      x.u.u, y.u.u);
 }
 
 template<TypeCategory C>
@@ -78,7 +78,7 @@ Expr<SomeKind<C>> operator*(Expr<SomeKind<C>> &&x, Expr<SomeKind<C>> &&y) {
       [](auto &xk, auto &yk) {
         return Expr<SomeKind<C>>{std::move(xk) * std::move(yk)};
       },
-      x.u, y.u);
+      x.u.u, y.u.u);
 }
 
 template<TypeCategory C>
@@ -87,7 +87,7 @@ Expr<SomeKind<C>> operator/(Expr<SomeKind<C>> &&x, Expr<SomeKind<C>> &&y) {
       [](auto &xk, auto &yk) {
         return Expr<SomeKind<C>>{std::move(xk) / std::move(yk)};
       },
-      x.u, y.u);
+      x.u.u, y.u.u);
 }
 
 // Convert the second argument expression to an expression of the same type
@@ -100,7 +100,7 @@ Expr<SomeKind<TC>> ConvertToTypeAndKindOf(
         using SpecificExpr = std::decay_t<decltype(tk)>;
         return {SpecificExpr{std::move(from)}};
       },
-      to.u);
+      to.u.u);
 }
 
 // Ensure that both operands of an intrinsic REAL operation or CMPLX()
@@ -122,23 +122,25 @@ void ConvertToSameKind(Expr<SomeKind<CAT>> &x, Expr<SomeKind<CAT>> &y) {
           y.u = Expr<xt>{yk};
         }
       },
-      x.u, y.u);
+      x.u.u, y.u.u);
 }
 
-template<typename A> Expr<ScalarValueType<A>> ScalarConstantToExpr(const A &x) {
+template<typename A> Expr<TypeOf<A>> ScalarConstantToExpr(const A &x) {
+  static_assert(std::is_same_v<Scalar<TypeOf<A>>, std::decay_t<A>> ||
+      !"TypeOf<> is broken");
   return {x};
 }
 
 template<TypeCategory CAT, int KIND>
 Expr<SomeKind<CAT>> ToSomeKindExpr(const Expr<Type<CAT, KIND>> &x) {
-  return Expr<SomeKind<CAT>>{x};
+  return {x};
 }
 
 template<TypeCategory CAT>
 Expr<SomeKind<CAT>> SomeKindScalarToExpr(const SomeKindScalar<CAT> &x) {
   return std::visit(
       [](const auto &c) { return ToSomeKindExpr(ScalarConstantToExpr(c)); },
-      x.u);
+      x.u.u);
 }
 
 Expr<SomeType> GenericScalarToExpr(const Scalar<SomeType> &);
diff --git a/flang/lib/evaluate/type.h b/flang/lib/evaluate/type.h
index ec01f51..eba3f55 100644
--- a/flang/lib/evaluate/type.h
+++ b/flang/lib/evaluate/type.h
@@ -26,6 +26,8 @@
 #include "real.h"
 #include "../common/fortran.h"
 #include "../common/idioms.h"
+#include "../common/kind-variant.h"
+#include "../common/template.h"
 #include <cinttypes>
 #include <optional>
 #include <string>
@@ -37,6 +39,8 @@ using common::TypeCategory;
 
 // Specific intrinsic types
 
+template<TypeCategory C, int KIND> struct Type;
+
 template<TypeCategory C, int KIND> struct TypeBase {
   static constexpr TypeCategory category{C};
   static constexpr int kind{KIND};
@@ -46,8 +50,6 @@ template<TypeCategory C, int KIND> struct TypeBase {
   }
 };
 
-template<TypeCategory C, int KIND> struct Type;
-
 template<int KIND>
 struct Type<TypeCategory::Integer, KIND>
   : public TypeBase<TypeCategory::Integer, KIND> {
@@ -107,6 +109,7 @@ struct Type<TypeCategory::Logical, KIND>
 };
 
 // Type functions
+
 template<typename T> using Scalar = typename std::decay_t<T>::Scalar;
 
 template<TypeCategory C, typename T>
@@ -131,66 +134,89 @@ using DefaultCharacter = Type<TypeCategory::Character, 1>;
 using SubscriptInteger = Type<TypeCategory::Integer, 8>;
 using LogicalResult = Type<TypeCategory::Logical, 1>;
 
-// These macros invoke other macros on each of the supported kinds of
-// a given category.
-// TODO larger CHARACTER kinds, incl. Kanji
-#define COMMA ,
-#define FOR_EACH_INTEGER_KIND(M, SEP) M(1) SEP M(2) SEP M(4) SEP M(8) SEP M(16)
-#define FOR_EACH_REAL_KIND(M, SEP) M(2) SEP M(4) SEP M(8) SEP M(10) SEP M(16)
-#define FOR_EACH_COMPLEX_KIND(M, SEP) M(2) SEP M(4) SEP M(8) SEP M(10) SEP M(16)
-#define FOR_EACH_CHARACTER_KIND(M, SEP) M(1)
-#define FOR_EACH_LOGICAL_KIND(M, SEP) M(1) SEP M(2) SEP M(4) SEP M(8)
-
-#define FOR_EACH_CATEGORY(M) \
-  M(Integer, INTEGER) \
-  M(Real, REAL) M(Complex, COMPLEX) M(Character, CHARACTER) M(Logical, LOGICAL)
-
-// These macros and template create instances of std::variant<> that can contain
-// applications of some class template to all of the supported kinds of
-// a category of intrinsic type.
-template<TypeCategory CAT, template<int> class T> struct VariantOverKinds;
-#define TKIND(K) T<K>
-#define MAKE(Cat, CAT) \
-  template<template<int> class T> \
-  struct VariantOverKinds<TypeCategory::Cat, T> { \
-    using type = std::variant<FOR_EACH_##CAT##_KIND(TKIND, COMMA)>; \
+template<TypeCategory CAT, template<TypeCategory, int> class TYPE>
+struct CategoryUnionTemplate;
+
+template<template<TypeCategory, int> class TYPE>
+struct CategoryUnionTemplate<TypeCategory::Integer, TYPE> {
+  static constexpr auto category{TypeCategory::Integer};
+  template<int K> using PerKind = TYPE<category, K>;
+  using type = common::KindVariant<int, PerKind, 1, 2, 4, 8, 16>;
+};
+
+template<template<TypeCategory, int> class TYPE>
+struct CategoryUnionTemplate<TypeCategory::Real, TYPE> {
+  static constexpr auto category{TypeCategory::Real};
+  template<int K> using PerKind = TYPE<category, K>;
+  using type = common::KindVariant<int, PerKind, 2, 4, 8, 10, 16>;
+};
+
+template<template<TypeCategory, int> class TYPE>
+struct CategoryUnionTemplate<TypeCategory::Complex, TYPE> {
+  static constexpr auto category{TypeCategory::Complex};
+  template<int K> using PerKind = TYPE<category, K>;
+  using type = common::KindVariant<int, PerKind, 2, 4, 8, 10, 16>;
+};
+
+template<template<TypeCategory, int> class TYPE>
+struct CategoryUnionTemplate<TypeCategory::Character, TYPE> {
+  static constexpr auto category{TypeCategory::Character};
+  template<int K> using PerKind = TYPE<category, K>;
+  using type = common::KindVariant<int, PerKind, 1>;  // TODO: add kinds 2 & 4;
+};
+
+template<template<TypeCategory, int> class TYPE>
+struct CategoryUnionTemplate<TypeCategory::Logical, TYPE> {
+  static constexpr auto category{TypeCategory::Logical};
+  template<int K> using PerKind = TYPE<category, K>;
+  using type = common::KindVariant<int, PerKind, 1, 2, 4, 8>;
+};
+
+template<TypeCategory CAT, template<TypeCategory, int> class TYPE>
+using CategoryUnion = typename CategoryUnionTemplate<CAT, TYPE>::type;
+
+template<template<TypeCategory, int> class A>
+struct IntrinsicTypeUnionTemplate {
+  template<TypeCategory C> using PerCategory = CategoryUnion<C, A>;
+  using type = common::KindVariant<TypeCategory, PerCategory,
+      TypeCategory::Integer, TypeCategory::Real, TypeCategory::Complex,
+      TypeCategory::Character, TypeCategory::Logical>;
+};
+
+template<template<TypeCategory, int> class A>
+using IntrinsicTypeUnion = typename IntrinsicTypeUnionTemplate<A>::type;
+
+// When Scalar<T> is S, then TypeOf<S> is T.
+template<typename CONST> struct TypeOfTemplate {
+  template<typename A>
+  struct InnerPredicate {  // A is a specific Type<CAT,KIND>
+    static constexpr bool value() {
+      return std::is_same_v<std::decay_t<CONST>,
+          std::decay_t<typename A::Scalar>>;
+    }
   };
-FOR_EACH_CATEGORY(MAKE)
-#undef MAKE
-#undef TKIND
-
-template<TypeCategory CAT, template<int> class T>
-using KindsVariant = typename VariantOverKinds<CAT, T>::type;
-
-// Map scalar value types back to their Fortran types.
-// For every type T = Type<CAT, KIND>, TypeOfScalarValue<T>> == T.
-// E.g., TypeOfScalarValue<Integer<32>> is Type<TypeCategory::Integer, 4>.
-template<typename CONST> struct GetTypeOfScalarValue;
-#define TOSV(cat, kind) \
-  template<> \
-  struct GetTypeOfScalarValue<Scalar<Type<TypeCategory::cat, kind>>> { \
-    using type = Type<TypeCategory::cat, kind>; \
+  template<typename A>
+  struct OuterPredicate {  // A is a CategoryUnion<CAT, Type>
+    static constexpr bool value() {
+      return common::SearchVariantType<InnerPredicate, typename A::Variant> >=
+          0;
+    }
   };
-#define M(k) TOSV(Integer, k)
-FOR_EACH_INTEGER_KIND(M, )
-#undef M
-#define M(k) TOSV(Real, k)
-FOR_EACH_REAL_KIND(M, )
-#undef M
-#define M(k) TOSV(Complex, k)
-FOR_EACH_COMPLEX_KIND(M, )
-#undef M
-#define M(k) TOSV(Character, k)
-FOR_EACH_CHARACTER_KIND(M, )
-#undef M
-#define M(k) TOSV(Logical, k)
-FOR_EACH_LOGICAL_KIND(M, )
-#undef M
-#undef TOSV
-
-template<typename CONST>
-using ScalarValueType =
-    typename GetTypeOfScalarValue<std::decay_t<CONST>>::type;
+  using BareTypes = IntrinsicTypeUnion<Type>;
+  static constexpr int CatIndex{
+      common::SearchVariantType<OuterPredicate, typename BareTypes::Variant>};
+  static_assert(
+      CatIndex >= 0 || !"no category found for type of scalar constant");
+  static constexpr TypeCategory category{BareTypes::IndexToKind(CatIndex)};
+  using CatType = BareTypes::template KindType<category>;
+  static constexpr int KindIndex{
+      common::SearchVariantType<InnerPredicate, typename CatType::Variant>};
+  static_assert(KindIndex >= 0 || !"search over category failed when repeated");
+  static constexpr int kind{CatType::IndexToKind(KindIndex)};
+  using type = Type<category, kind>;
+};
+
+template<typename CONST> using TypeOf = typename TypeOfTemplate<CONST>::type;
 
 // Holds a scalar value of any kind within a particular intrinsic type
 // category.
@@ -206,17 +232,17 @@ template<TypeCategory CAT> struct SomeKindScalar {
   std::optional<std::int64_t> ToInt64() const {
     if constexpr (category == TypeCategory::Integer) {
       return std::visit(
-          [](const auto &x) { return std::make_optional(x.ToInt64()); }, u);
+          [](const auto &x) { return std::make_optional(x.ToInt64()); }, u.u);
     }
     return std::nullopt;
   }
 
   std::optional<std::string> ToString() const {
-    return common::GetIf<std::string>(u);
+    return common::GetIf<std::string>(u.u);
   }
 
-  template<int KIND> using KindScalar = Scalar<Type<CAT, KIND>>;
-  KindsVariant<CAT, KindScalar> u;
+  template<TypeCategory C, int K> using KindScalar = Scalar<Type<C, K>>;
+  CategoryUnion<CAT, KindScalar> u;
 };
 
 // Holds a scalar constant of any intrinsic category and size.
diff --git a/flang/lib/semantics/expression.cc b/flang/lib/semantics/expression.cc
index 722d488..1f97135 100644
--- a/flang/lib/semantics/expression.cc
+++ b/flang/lib/semantics/expression.cc
@@ -100,20 +100,14 @@ static std::optional<Expr<evaluate::SomeCharacter>> AnalyzeLiteral(
     ExpressionAnalyzer &ea, const parser::CharLiteralConstant &x) {
   auto kind{ea.Analyze(std::get<std::optional<parser::KindParam>>(x.t),
       ExpressionAnalyzer::KindParam{1})};
-  switch (kind) {
-#define CASE(k) \
-  case k: { \
-    using Ty = Type<TypeCategory::Character, k>; \
-    return { \
-        Expr<evaluate::SomeCharacter>{Expr<Ty>{std::get<std::string>(x.t)}}}; \
-  }
-    FOR_EACH_CHARACTER_KIND(CASE, )
-#undef CASE
-  default:
-    ea.context().messages.Say("unimplemented CHARACTER kind (%ju)"_err_en_US,
+  auto value{std::get<std::string>(x.t)};
+  using Ex = Expr<evaluate::SomeCharacter>;
+  std::optional<Ex> result{Ex::template ForceKind(kind, std::move(value))};
+  if (!result.has_value()) {
+    ea.context().messages.Say("unsupported CHARACTER(KIND=%ju)"_err_en_US,
         static_cast<std::uintmax_t>(kind));
-    return std::nullopt;
   }
+  return result;
 }
 
 template<typename A> MaybeExpr PackageGeneric(std::optional<A> &&x) {
@@ -162,20 +156,14 @@ std::optional<Expr<evaluate::SomeInteger>> IntLiteralConstant(
     ExpressionAnalyzer &ea, const PARSED &x) {
   auto kind{ea.Analyze(std::get<std::optional<parser::KindParam>>(x.t),
       ea.defaultIntegerKind())};
-  auto value{std::get<0>(x.t)};  // std::[u]int64_t
-  switch (kind) {
-#define CASE(k) \
-  case k: { \
-    using Ty = Type<TypeCategory::Integer, k>; \
-    return {evaluate::ToSomeKindExpr(Expr<Ty>{value})}; \
-  }
-    FOR_EACH_INTEGER_KIND(CASE, )
-#undef CASE
-  default:
-    ea.context().messages.Say("unimplemented INTEGER kind (%ju)"_err_en_US,
+  auto value{std::get<0>(x.t)};  // std::(u)int64_t
+  using Ex = Expr<evaluate::SomeInteger>;
+  std::optional<Ex> result{Ex::template ForceKind(kind, std::move(value))};
+  if (!result.has_value()) {
+    ea.context().messages.Say("unsupported INTEGER(KIND=%ju)"_err_en_US,
         static_cast<std::uintmax_t>(kind));
-    return std::nullopt;
   }
+  return result;
 }
 
 static std::optional<Expr<evaluate::SomeInteger>> AnalyzeLiteral(
@@ -229,11 +217,23 @@ std::optional<Expr<evaluate::SomeReal>> ReadRealLiteral(
   return {evaluate::ToSomeKindExpr(Expr<RealType>{value})};
 }
 
+struct RealHelper {
+  RealHelper(parser::CharBlock lit, evaluate::FoldingContext &ctx)
+    : literal{lit}, context{ctx} {}
+  template<int K> void action() {
+    CHECK(!result.has_value());
+    result = ReadRealLiteral<K>(literal, context);
+  }
+  parser::CharBlock literal;
+  evaluate::FoldingContext &context;
+  std::optional<Expr<evaluate::SomeReal>> result;
+};
+
 static std::optional<Expr<evaluate::SomeReal>> AnalyzeLiteral(
     ExpressionAnalyzer &ea, const parser::RealLiteralConstant &x) {
   // Use a local message context around the real literal.
   parser::ContextualMessages ctxMsgs{x.real.source, ea.context().messages};
-  evaluate::FoldingContext foldingContext{ctxMsgs, ea.context()};
+  evaluate::FoldingContext localFoldingContext{ctxMsgs, ea.context()};
   // If a kind parameter appears, it takes precedence.  In the absence of
   // an explicit kind parameter, the exponent letter (e.g., 'e'/'d')
   // determines the kind.
@@ -251,16 +251,13 @@ static std::optional<Expr<evaluate::SomeReal>> AnalyzeLiteral(
     }
   }
   auto kind{ea.Analyze(x.kind, defaultKind)};
-  switch (kind) {
-#define CASE(k) \
-  case k: return ReadRealLiteral<k>(x.real.source, foldingContext);
-    FOR_EACH_REAL_KIND(CASE, )
-#undef CASE
-  default:
-    ctxMsgs.Say("unimplemented REAL kind (%ju)"_err_en_US,
+  RealHelper helper{x.real.source, localFoldingContext};
+  Expr<evaluate::SomeReal>::template AtKind(helper, kind);
+  if (!helper.result.has_value()) {
+    ctxMsgs.Say("unsupported REAL(KIND=%ju)"_err_en_US,
         static_cast<std::uintmax_t>(kind));
-    return std::nullopt;
   }
+  return helper.result;
 }
 
 static std::optional<Expr<evaluate::SomeReal>> AnalyzeLiteral(
@@ -328,19 +325,13 @@ static std::optional<Expr<evaluate::SomeLogical>> AnalyzeLiteral(
   auto kind{ea.Analyze(std::get<std::optional<parser::KindParam>>(x.t),
       ea.defaultLogicalKind())};
   bool value{std::get<bool>(x.t)};
-  switch (kind) {
-#define CASE(k) \
-  case k: { \
-    using Ty = Type<TypeCategory::Logical, k>; \
-    return {Expr<evaluate::SomeLogical>{Expr<Ty>{value}}}; \
-  }
-    FOR_EACH_LOGICAL_KIND(CASE, )
-#undef CASE
-  default:
-    ea.context().messages.Say("unimplemented LOGICAL kind (%ju)"_err_en_US,
+  using Ex = Expr<evaluate::SomeLogical>;
+  std::optional<Ex> result{Ex::template ForceKind(kind, std::move(value))};
+  if (!result.has_value()) {
+    ea.context().messages.Say("unsupported LOGICAL(KIND=%ju)"_err_en_US,
         static_cast<std::uintmax_t>(kind));
-    return std::nullopt;
   }
+  return result;
 }
 
 template<>
@@ -594,7 +585,7 @@ std::optional<Expr<evaluate::SomeComplex>> ExpressionAnalyzer::ConstructComplex(
           return {Expr<zType>{evaluate::ComplexConstructor<kind>{
               std::move(rx), std::move(ix)}}};
         },
-        std::move(joined->first.u), std::move(joined->second.u))};
+        std::move(joined->first.u.u), std::move(joined->second.u.u))};
   }
   return std::nullopt;
 }