package shapeless
import scala.language.experimental.macros
import scala.reflect.macros.Context
trait Nat {
type N <: Nat
}
case class Succ[P <: Nat]() extends Nat {
type N = Succ[P]
}
class _0 extends Nat {
type N = _0
}
object Nat extends Nats {
import ops.nat._
def apply(i: Int) = macro NatMacros.materializeWidened
val _0: _0 = new _0
def toInt[N <: Nat](implicit toIntN : ToInt[N]) = toIntN()
def toInt(n : Nat)(implicit toIntN : ToInt[n.N]) = toIntN()
implicit val witness0: Witness.Aux[_0] =
new Witness {
type T = _0
val value = _0
}
implicit def witnessN[P <: Nat]: Witness.Aux[Succ[P]] =
new Witness {
type T = Succ[P]
val value = new Succ[P]()
}
implicit def materialize(i: Int) = macro NatMacros.materializeSingleton
}
object NatMacros {
def mkNatTpt(c: Context)(i: c.Expr[Int]): c.Tree = {
import c.universe._
val n = i.tree match {
case Literal(Constant(n: Int)) => n
case _ =>
c.abort(c.enclosingPosition, s"Expression ${i.tree} does not evaluate to an Int constant")
}
if (n < 0)
c.abort(c.enclosingPosition, s"A Nat cannot represent $n")
val succSym = typeOf[Succ[_]].typeConstructor.typeSymbol
val _0Sym = typeOf[_0].typeSymbol
def mkNatTpt(n: Int): Tree = {
if(n == 0) Ident(_0Sym)
else AppliedTypeTree(Ident(succSym), List(mkNatTpt(n-1)))
}
mkNatTpt(n)
}
def materializeSingleton(c: Context)(i: c.Expr[Int]): c.Expr[Nat] = {
import c.universe._
val natTpt = mkNatTpt(c)(i)
val pendingSuperCall = Apply(Select(Super(This(tpnme.EMPTY), tpnme.EMPTY), nme.CONSTRUCTOR), List())
val moduleName = newTermName(c.fresh("nat_"))
val moduleDef =
ModuleDef(Modifiers(), moduleName,
Template(
List(natTpt),
emptyValDef,
List(
DefDef(
Modifiers(), nme.CONSTRUCTOR, List(),
List(List()),
TypeTree(),
Block(List(pendingSuperCall), Literal(Constant(()))))
)
)
)
c.Expr[Nat] {
Block(
List(moduleDef),
Ident(moduleName)
)
}
}
def materializeWidened(c: Context)(i: c.Expr[Int]): c.Expr[Nat] = {
import c.universe._
val natTpt = mkNatTpt(c)(i)
val valName = newTermName(c.fresh("nat_"))
val valDef =
ValDef(Modifiers(), valName,
natTpt,
Apply(Select(New(natTpt), nme.CONSTRUCTOR), List())
)
c.Expr[Nat] {
Block(
List(valDef),
Ident(valName)
)
}
}
}