├── project └── build.properties ├── LICENSE ├── README.md └── src ├── test └── scala │ └── bidir │ └── BidirTest.scala └── main └── scala └── bidir └── Bidir.scala /project/build.properties: -------------------------------------------------------------------------------- 1 | sbt.version=1.2.5 2 | -------------------------------------------------------------------------------- /LICENSE: -------------------------------------------------------------------------------- 1 | Copyright 2018 Michael Bayne 2 | 3 | Permission is hereby granted, free of charge, to any person obtaining a copy of this software and 4 | associated documentation files (the "Software"), to deal in the Software without restriction, 5 | including without limitation the rights to use, copy, modify, merge, publish, distribute, 6 | sublicense, and/or sell copies of the Software, and to permit persons to whom the Software is 7 | furnished to do so, subject to the following conditions: 8 | 9 | The above copyright notice and this permission notice shall be included in all copies or substantial 10 | portions of the Software. 11 | 12 | THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR IMPLIED, INCLUDING BUT 13 | NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND 14 | NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES 15 | OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN 16 | CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. 17 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | # Bidirectional Type Checker 2 | 3 | A simple Scala implementation of "Complete and Easy Bidirectional Type Checking for Higher-Rank 4 | Polymorphism" ([Dunfield and Krishnaswami 2013]). 5 | 6 | This implementation is designed to follow the paper as closely as possible and serve as an aid to 7 | anyone seeking to implement the type checking and inference algorithm described in the paper in 8 | their own programming language. 9 | 10 | An attempt has been made to keep the terminology and variable names in the code close to those used 11 | in the paper, and comments indicate which parts of the typing rules correspond to specific parts of 12 | the code. 13 | 14 | ## Building 15 | 16 | The code can be built with [SBT] and contains some simple tests to run the checker on ASTs. 17 | 18 | ``` 19 | sbt compile 20 | sbt test 21 | ``` 22 | 23 | Set the `Trace` variable to `true` to see a trace of the checker as it proceeds through the various 24 | inference and checking rules. 25 | 26 | ## Acknowledgements 27 | 28 | Thanks to Dunfield and Krishnaswami for their clearly and carefully written paper, and to Alexis 29 | King for her [Haskell implementation](https://github.com/lexi-lambda/higher-rank) which served as 30 | an inspiration for the structure of this code, and as a reminder of the value of making a simple 31 | direct translation of a type checking algorithm into code before trying to adapt it for use in a 32 | full-fledged language. 33 | 34 | [SBT]: https://www.scala-sbt.org/ 35 | [Dunfield and Krishnaswami 2013]: http://research.cs.queensu.ca/~joshuad/papers/bidir/ 36 | -------------------------------------------------------------------------------- /src/test/scala/bidir/BidirTest.scala: -------------------------------------------------------------------------------- 1 | package bidir 2 | 3 | import org.junit.Assert._ 4 | import org.junit._ 5 | 6 | class BidirTest { 7 | import Bidir._ 8 | 9 | @Test def testUnit () :Unit = { 10 | assertEquals(Right(TUnit), inferExpr(XUnit)) 11 | } 12 | 13 | val xV = XVar("x") 14 | val yV = XVar("y") 15 | val fV = XVar("f") 16 | 17 | // id :: (forall a. a -> a) 18 | // id x = x 19 | val idExpr = XLambda(xV, xV) 20 | 21 | @Test def testSplit () :Unit = { 22 | val aUV = TUVar("a") 23 | val bEV = TEVar("b") 24 | val xVAssump = NAssump(xV, TUnit) 25 | val ctx = aUV :: bEV :: xVAssump :: Nil 26 | val Some((post, pre)) = split(ctx, bEV) 27 | assertEquals(aUV :: Nil, post) 28 | assertEquals(xVAssump :: Nil, pre) 29 | } 30 | 31 | @Test def testIdent () :Unit = { 32 | assertEquals(Right(TArrow(TEVar("a1"), TEVar("a1"))), inferExpr(idExpr)) 33 | assertEquals(Right(TUnit), inferExpr(XApply(idExpr, XUnit))) 34 | } 35 | 36 | // hof :: (forall a. () -> a) -> a 37 | // hof f = f () 38 | val hofExpr = XLambda(fV, XApply(fV, XUnit)) 39 | 40 | @Test def testHOF () :Unit = { 41 | assertEquals(Right(TUnit), inferExpr(XApply(hofExpr, idExpr))) 42 | } 43 | 44 | @Test def testError () :Unit = { 45 | assertEquals(Left("Type mismatch: expected '(() -> ^a₂4)', given: '()'"), 46 | inferExpr(XApply(hofExpr, XUnit))) 47 | } 48 | 49 | val aTV = TUVar("a") 50 | // hrf :: (forall a. (a -> a)) -> () 51 | val hrfType = TArrow(TAll(aTV, TArrow(aTV, aTV)), TUnit) 52 | // hrf f = (f id) (f ()) 53 | val hrfExpr = XLambda(fV, XApply(XApply(fV, idExpr), XApply(fV, XUnit))) 54 | 55 | @Test def testHigherRank () :Unit = { 56 | assertEquals(Left("Type mismatch: expected '(^a₂8 -> ^a₂8)', given: '()'"), 57 | inferExpr(hrfExpr)) // fail: cannot infer higher-rank types 58 | assertEquals(Right(hrfType), 59 | inferExpr(XAnnot(hrfExpr, hrfType))) // (hrf : hrfType) 60 | assertEquals(Right(TUnit), 61 | inferExpr(XApply(XAnnot(hrfExpr, hrfType), idExpr))) // ((hrf : hrfType) id) 62 | } 63 | } 64 | -------------------------------------------------------------------------------- /src/main/scala/bidir/Bidir.scala: -------------------------------------------------------------------------------- 1 | // 2 | // Scala implementation of bidirectional type checking & inference as described in: 3 | // "Complete and Easy Bidirectional Type Checking for Higher-Rank Polymorphism" 4 | // http://research.cs.queensu.ca/~joshuad/papers/bidir/ 5 | 6 | package bidir 7 | 8 | object Bidir { 9 | 10 | // NOTE: there's no UTF8 character for α hat (nor β hat), so we use â and ĉ for existential vars 11 | 12 | // types (A,B,C): 1 | α | â | ∀α.A | A→B 13 | sealed abstract class Type { 14 | /** Whether this type is a monotype. */ 15 | def isMono :Boolean = true 16 | /** Returns whether `eV` is in the free variables of this type. */ 17 | def containsFree (eV :TEVar) :Boolean 18 | /** Checks that this type is well-formed with respect to `ctx`, throws exception if not. */ 19 | def checkWellFormed (implicit ctx :Context) :Unit = checkMalformed match { 20 | case Some(error) => fail(error) 21 | case None => // yay! 22 | } 23 | /** Returns whether this type is well-formed with respect to `ctx`. */ 24 | def isWellFormed (implicit ctx :Context) :Boolean = !checkMalformed.isDefined 25 | /** Checks that this type is malformed with respect to `ctx`. 26 | * @return `Some(error)` if it is malformed, `None` if it is well-formed. */ 27 | def checkMalformed (implicit ctx :Context) :Option[String] 28 | } 29 | case object TUnit extends Type { 30 | def containsFree (eV :TEVar) :Boolean = false 31 | def checkMalformed (implicit ctx :Context) = None 32 | override def toString = "()" 33 | } 34 | case class TUVar (name :String) extends Type with Note { 35 | def containsFree (eV :TEVar) :Boolean = false 36 | def checkMalformed (implicit ctx :Context) = 37 | if (!ctx.contains(this)) Some(s"Unbound type variable '$name'") else None 38 | override def toString = name 39 | } 40 | case class TEVar (name :String) extends Type with Note { 41 | def containsFree (eV :TEVar) :Boolean = eV == this 42 | def checkMalformed (implicit ctx :Context) = 43 | if (!ctx.contains(this) && 44 | !solution(this).isDefined) Some(s"Unbound existential variable '$name'") else None 45 | override def toString = s"^$name" 46 | } 47 | case class TAll (uv :TUVar, tpe :Type) extends Type { 48 | override def isMono :Boolean = false 49 | def containsFree (eV :TEVar) :Boolean = tpe.containsFree(eV) 50 | def checkMalformed (implicit ctx :Context) = tpe.checkMalformed(uv :: ctx) 51 | override def toString = s"∀$uv. $tpe" 52 | } 53 | case class TArrow (arg :Type, res :Type) extends Type { 54 | override def isMono :Boolean = arg.isMono && res.isMono 55 | def containsFree (eV :TEVar) :Boolean = arg.containsFree(eV) || res.containsFree(eV) 56 | def checkMalformed (implicit ctx :Context) = arg.checkMalformed orElse res.checkMalformed 57 | override def toString = s"($arg -> $res)" 58 | } 59 | 60 | // terms (x): () | x | λx.e | e e | e:A 61 | sealed abstract trait Term 62 | case object XUnit extends Term { 63 | override def toString = "()" 64 | } 65 | case class XVar (name :String) extends Term { 66 | override def toString = name 67 | } 68 | case class XLambda (arg :XVar, exp :Term) extends Term { 69 | override def toString = s"(λ$arg.$exp)" 70 | } 71 | case class XApply (fun :Term, arg :Term) extends Term { 72 | override def toString = s"($fun $arg)" 73 | } 74 | case class XAnnot (exp :Term, tpe :Type) extends Term { 75 | override def toString = s"($exp : $tpe)" 76 | } 77 | 78 | // contexts (Γ,∆,Θ): · | Γ,α | Γ,x:A | Γ,â | Γ,â = τ | Γ,▶â 79 | sealed abstract trait Note 80 | // case class NUVar == TUVar 81 | case class NAssump (v :XVar, tpe :Type) extends Note { 82 | override def toString = s"$v : $tpe" 83 | } 84 | // case class NEVar == TEVar 85 | case class NSol (eV :TEVar, tpe :Type) extends Note { 86 | override def toString = s"$eV = $tpe" 87 | } 88 | case class NMark (eV :TEVar) extends Note { 89 | override def toString = s"▶$eV" 90 | } 91 | 92 | // a context is an ordered list of notes (note: the head of the list is the most recently added 93 | // note, which is opposite the lexical representation in the paper) 94 | type Context = List[Note] 95 | 96 | /** Looks up the assumption for `v` in `ctx`. */ 97 | def assump (v :XVar)(implicit ctx :Context) :Option[Type] = { 98 | val assumps = ctx collect { case na @ NAssump(av, _) if (v == av) => na } 99 | assumps match { 100 | case Seq() => None 101 | case Seq(na) => Some(na.tpe) 102 | case nas => fail(s"Multiple types for '$v': $nas") 103 | } 104 | } 105 | 106 | /** Looks up the solution for `ev` in `ctx`. */ 107 | def solution (eV :TEVar)(implicit ctx :Context) :Option[Type] = { 108 | val sols = ctx collect { case ns @ NSol(seV, _) if (eV == seV) => ns } 109 | sols match { 110 | case Seq() => None 111 | case Seq(ns) => Some(ns.tpe) 112 | case nss => fail(s"Multiple solutions for '$eV': $nss") 113 | } 114 | } 115 | 116 | /** Peels off the end of a context up to and including `note`. */ 117 | def peel (ctx :Context, note :Note) :Context = (ctx dropWhile(_ != note)) match { 118 | case Nil => Nil 119 | case h :: t => t 120 | } 121 | 122 | /** Splits `ctx` into the part after `note` and the part before. `note` itself is not included. 123 | * Recall that contexts list notes in reverse order, hence the `(post, pre)` return order. 124 | * If `note` is not in `ctx` then `None` is returned. */ 125 | def split (ctx :Context, note :Note) :Option[(Context, Context)] = ctx.span(_ != note) match { 126 | case (post, Nil) => None 127 | case (post, pre) => Some((post, pre.tail)) 128 | } 129 | 130 | var nextEVar = 1 131 | def freshEVar (name :String) :TEVar = try TEVar(s"$name$nextEVar") finally nextEVar += 1 132 | 133 | // NOTE: to conserve monads, type errors are reported via exceptions 134 | def fail (msg :String) = throw new Exception(msg) 135 | 136 | /** Applies `ctx` to `tpe` (substituting existential vars for their solutions). */ 137 | def apply (tpe :Type)(implicit ctx :Context) :Type = tpe match { 138 | case ev :TEVar => solution(ev) map apply getOrElse ev 139 | case TArrow(a, b) => TArrow(apply(a), apply(b)) 140 | case TAll(uv, tpe) => TAll(uv, apply(tpe)) 141 | case _ => tpe 142 | } 143 | 144 | /** Returns `inT` with `thatT` replaced by `thisT`. */ 145 | def subst (thisT :TEVar, thatT :TUVar, inT :Type) :Type = inT match { 146 | case uv :TUVar => if (thatT == uv) thisT else uv 147 | case TArrow(a, b) => TArrow(subst(thisT, thatT, a), subst(thisT, thatT, b)) 148 | case TAll(uv, tpe) => TAll(uv, subst(thisT, thatT, tpe)) 149 | case _ /*TUnit, TEvar*/ => inT 150 | } 151 | 152 | /** Derives a subtyping relationship `tpeA <: tpeB` with input context `ctx`. See Figure 9. 153 | * @return the output context. */ 154 | def subtype (tpeA :Type, tpeB :Type)(implicit ctx :Context) :Context = (tpeA, tpeB) match { 155 | // <:Unit :: Γ ⊢ 1 <: 1 ⊣ Γ 156 | case (TUnit, TUnit) => ctx // Γ 157 | 158 | // <:Var :: Γ[α] ⊢ α <: α ⊣ Γ[α] 159 | case (uva :TUVar, uvb :TUVar) if (uva == uvb) => ctx // Γ 160 | 161 | // <:Exvar :: Γ[â] ⊢ â <: â ⊣ Γ[â] 162 | case (eA :TEVar, eB :TEVar) if (eA == eB) => 163 | if (ctx contains eA) ctx else fail(s"Unbound existential '$eA'") // Γ 164 | 165 | // <:→ :: Γ ⊢ A1→A2 <: B1→B2 ⊣ ∆ 166 | case (TArrow(a1, a2), TArrow(b1, b2)) => 167 | val theta = subtype(b1, a1) // Γ ⊢ B1 <: A1 ⊣ Θ 168 | subtype(apply(a2)(theta), apply(b2)(theta))(theta) // Θ ⊢ [Θ]A2 <: [Θ]B2 ⊣ ∆ 169 | 170 | // <:∀L :: Γ ⊢ ∀α.A <: B ⊣ ∆ 171 | case (TAll(uA, a), b) => 172 | val eA = freshEVar("a") 173 | val eAMark = NMark(eA) 174 | val subCtx = eA :: eAMark :: ctx // Γ,▶â,â 175 | val deltaEtc = subtype(subst(eA, uA, a), b)(subCtx) // [â/α]A <: B ⊣ ∆,▶â,Θ 176 | peel(deltaEtc, eAMark) // ∆ 177 | 178 | // <:∀R :: Γ ⊢ A <: ∀α.B ⊣ ∆ 179 | case (a, TAll(uA, b)) => 180 | val deltaEtc = subtype(a, b)(uA :: ctx) // Γ,α ⊢ A <: B ⊣ ∆,α,Θ 181 | peel(deltaEtc, uA) // ∆ 182 | 183 | // <:InstantiateL :: Γ[â] ⊢ â <: A ⊣ ∆ 184 | case (eA :TEVar, a) if (ctx.contains(eA) && !a.containsFree(eA)) => 185 | trace(s"- <:InstL $eA :=< $a") 186 | instantiateL(eA, a) // Γ[â] ⊢ â :=< A ⊣ ∆ 187 | 188 | // <:InstantiateR :: Γ[â] ⊢ A <: â ⊣ ∆ 189 | case (a, eA :TEVar) if (ctx.contains(eA) && !a.containsFree(eA)) => 190 | trace(s"- <:InstR $a :=< $eA") 191 | instantiateR(a, eA) // Γ[â] ⊢ A <: â ⊣ ∆ 192 | 193 | case _ => fail(s"Type mismatch: expected '$tpeB', given: '$tpeA'") 194 | } 195 | 196 | /** Instantiates `eA` such that `eA <: a` in `ctx`. See Figure 10. 197 | * @return the output context. */ 198 | def instantiateL (eA :TEVar, a :Type)(implicit ctx :Context) :Context = a match { 199 | // InstLSolve :: Γ,â,Γ′ ⊢ â :=< τ ⊣ Γ,â=τ,Γ′ 200 | case a if (a.isMono && a.isWellFormed(peel(ctx, eA))) /* Γ ⊢ τ */ => 201 | val Some((postCtx, preCtx)) = split(ctx, eA) 202 | trace(s"- InstLSolve $eA :=< $a") 203 | postCtx ++ (NSol(eA, a) :: preCtx) // Γ,â=τ,Γ′ 204 | 205 | // InstLReach :: Γ[â][ĉ] ⊢ â :=< ĉ ⊣ Γ[â][ĉ=â] 206 | case eC :TEVar if (peel(ctx, eC) contains eA) => 207 | val Some((postCtx, preCtx)) = split(ctx, eC) 208 | trace(s"- InstLReach $eA :=< $eC") 209 | postCtx ++ (NSol(eC, eA) :: preCtx) // Γ[â][ĉ=â] 210 | 211 | // InstLArr :: Γ[â] ⊢ â :=< A1 → A2 ⊣ ∆ 212 | case TArrow(a1, a2) if (ctx contains eA) => 213 | val Some((postCtx, preCtx)) = split(ctx, eA) 214 | val eA1 = freshEVar("a₁") 215 | val eA2 = freshEVar("a₂") 216 | val a1ctx = postCtx ++ (NSol(eA, TArrow(eA1, eA2)) :: eA1 :: eA2 :: preCtx) 217 | trace(s"- InstLArr(1) $a1 :=< $eA1 in $a1ctx") 218 | val theta = instantiateR(a1, eA1)(a1ctx) // Γ[â₂,â₁,â=â₁→â2] ⊢ A1 :=< â₁ ⊣ Θ 219 | trace(s"- InstRArr(2) $eA2 :=< ${apply(a2)(theta)} in $theta") 220 | instantiateL(eA2, apply(a2)(theta))(theta) // Θ ⊢ â₂ :=< [Θ]A2 ⊣ ∆ 221 | 222 | // InstLAllR :: Γ[â] ⊢ â :=< ∀β.B ⊣ ∆ 223 | case TAll(uB, b) if (ctx contains eA) => 224 | trace(s"- InstLAllR $eA :=< $b in ${uB :: ctx}") 225 | val deltaEtc = instantiateL(eA, b)(uB :: ctx) // Γ[â],β ⊢ â :=< B ⊣ ∆,β,∆′ 226 | peel(deltaEtc, uB) // ∆ 227 | 228 | case _ => fail(s"Failed to instantiate '$eA' to '$a'") 229 | } 230 | 231 | /** Instantiates `eA` such that `a <: eA` in `ctx`. See Figure 10. 232 | * @return the output context. */ 233 | def instantiateR (a :Type, eA :TEVar)(implicit ctx :Context) :Context = a match { 234 | // InstRSolve :: Γ,â,Γ′ ⊢ τ :=< â ⊣ Γ,â=τ,Γ′ 235 | case a if (a.isMono && a.isWellFormed(peel(ctx, eA))) /* Γ ⊢ τ */ => 236 | val Some((postCtx, preCtx)) = split(ctx, eA) 237 | trace(s"- InstRSolve $a :=< $eA") 238 | postCtx ++ (NSol(eA, a) :: preCtx) // Γ,â=τ,Γ′ 239 | 240 | // InstRReach :: Γ[â][ĉ] ⊢ ĉ :=< â ⊣ Γ[â][ĉ=â] 241 | case eC :TEVar if (peel(ctx, eC) contains eA) => 242 | val Some((postCtx, preCtx)) = split(ctx, eC) 243 | trace(s"- InstRReach $eC :=< $eA") 244 | postCtx ++ (NSol(eC, eA) :: preCtx) // Γ[â][ĉ = â] 245 | 246 | // InstRArr :: Γ[â] ⊢ A1 → A2 :=< â ⊣ ∆ 247 | case TArrow(a1, a2) if (ctx contains eA) => 248 | val Some((postCtx, preCtx)) = split(ctx, eA) 249 | val eA1 = freshEVar("a₁") 250 | val eA2 = freshEVar("a₂") 251 | val a1ctx = postCtx ++ (NSol(eA, TArrow(eA1, eA2)) :: eA1 :: eA2 :: preCtx) 252 | trace(s"- InstRArr(1) $eA1 :=< $a1 in $a1ctx") 253 | val theta = instantiateL(eA1, a1)(a1ctx) // Γ[â₂,â₁,â=â₁→â₂] ⊢ â₁ :=< A1 ⊣ Θ 254 | trace(s"- InstRArr(2) ${apply(a2)(theta)} :=< $eA2 in $theta") 255 | instantiateR(apply(a2)(theta), eA2)(theta) // Θ ⊢ [Θ]A2 :=< â₂ ⊣ ∆ 256 | 257 | // InstRAllL :: Γ[â],▶ĉ,ĉ ⊢ [ĉ/β]B :=< â ⊣ ∆,▶ĉ,∆′ 258 | case TAll(uB, b) if (ctx contains eA) => 259 | val eC = freshEVar("c") 260 | val instCtx = eC :: NMark(eC) :: ctx // Γ[â],▶ĉ,ĉ 261 | trace(s"- InstRAllL [$eC/$uB]$b :=< $eA in $instCtx") 262 | val deltaEtc = instantiateR(subst(eC, uB, b), eA)(instCtx) // Γic ⊢ [ĉ/β]B :=< â ⊣ ∆,▶ĉ,∆′ 263 | peel(deltaEtc, NMark(eC)) // ∆ 264 | 265 | case _ => fail(s"Failed to instantiate '$a' to '$eA'\n (context: $ctx)") 266 | } 267 | 268 | /** Checks that `exp` has type `tpe` with input context `ctx`. See Figure 11. 269 | * @return the output context. */ 270 | def check (exp :Term, tpe :Type)(implicit ctx :Context) :Context = (exp, tpe) match { 271 | // 1I :: ((), 1) 272 | case (XUnit, TUnit) => ctx // Γ 273 | 274 | // ->I :: (λx.e, A→B) 275 | case (XLambda(arg, exp), TArrow(argT, expT)) => 276 | val argAssump = NAssump(arg, argT) // x:A 277 | trace(s"- ->I ($exp <= $expT) in ${argAssump :: ctx}") 278 | val deltaEtc = check(exp, expT)(argAssump :: ctx) // Γ,x:A ⊢ e ⇐ B ⊣ ∆,x:A,Θ 279 | peel(deltaEtc, argAssump) // ∆ 280 | 281 | // ∀I :: (e, ∀α.A) 282 | case (exp, TAll(uA, tpe)) => 283 | trace(s"- ∀I ($exp <= $tpe) in ${uA :: ctx}") 284 | val deltaEtc = check(exp, tpe)(uA :: ctx) // Γ,α ⊢ e ⇐ A ⊣ ∆,α,Θ 285 | peel(deltaEtc, uA) // ∆ 286 | 287 | // Sub :: (e, B) 288 | case (exp, tpe) => 289 | val (expType, theta) = infer(exp) // Γ ⊢ e ⇒ A ⊣ Θ 290 | trace(s"- Sub ($exp => $expType) ; [Θ]$expType <: [Θ]$tpe in $theta") 291 | subtype(apply(expType)(theta), apply(tpe)(theta))(theta) // Θ ⊢ [Θ]A <: [Θ]B ⊣ ∆ 292 | } 293 | 294 | /** Infers a type for `exp` with input context `ctx`. See Figure 11. 295 | * @return the inferred type and the output context. */ 296 | def infer (exp :Term)(implicit ctx :Context) :(Type, Context) = exp match { 297 | // 1I=> :: () 298 | case XUnit => (TUnit, ctx) // 1 ⊣ Γ 299 | 300 | // Var :: x 301 | case v @ XVar(name) => assump(v) match { 302 | case Some(tpe) => (tpe, ctx) // A ⊣ Γ 303 | case None => fail(s"No binding for variable '$name'") 304 | } 305 | 306 | // ->I=> :: λx.e 307 | case XLambda(arg, body) => 308 | val eA = freshEVar("a") // â 309 | val eC = freshEVar("c") // ĉ 310 | val assump = NAssump(arg, eA) // x:â 311 | val checkCtx = assump :: eC :: eA :: ctx // Γ,â,ĉ,x:â 312 | trace(s"- ->I=> ($body <= $eC) in $checkCtx") 313 | val checkedCtx = check(body, eC)(checkCtx) // e ⇐ ĉ ⊣ ∆,x:â,Θ 314 | (TArrow(eA, eC), peel(checkedCtx, assump)) // â→ĉ ⊣ ∆ 315 | 316 | // ->E :: (e1 e2) 317 | case XApply(fun, arg) => 318 | val (funType, theta) = infer(fun) // e1 ⇒ A ⊣ Θ 319 | val reducedFun = apply(funType)(theta) // [Θ]A 320 | trace(s"- ->E $fun => $funType ; $reducedFun ● $arg in $theta") 321 | inferApp(reducedFun, arg)(theta) // C ⊣ ∆ 322 | 323 | // Anno: x:A 324 | case XAnnot(x, tpe) => 325 | tpe.checkWellFormed 326 | (tpe, check(x, tpe)) // A ⊣ ∆ 327 | } 328 | 329 | /** Infers the type of an application of a function of type `fun` to `exp`. See Figure 11. 330 | * @return the inferred type and the output context. */ 331 | def inferApp (fun :Type, exp :Term)(implicit ctx :Context) :(Type, Context) = fun match { 332 | // ∀App 333 | case TAll(uv, tpe) => 334 | val eA = freshEVar("a") // â 335 | val reduced = subst(eA, uv, tpe) // [â/α]A 336 | val appCtx = eA :: ctx // Γ,â 337 | trace(s"- ∀App $reduced ● $exp in $appCtx") 338 | inferApp(reduced, exp)(appCtx) // C ⊣ ∆ 339 | // âApp 340 | case eA :TEVar => 341 | val a1 = freshEVar("a₁") // â₁ 342 | val a2 = freshEVar("a₂") // â₂ 343 | val aArrow = TArrow(a1, a2) // â₁→â₂ 344 | val Some((postCtx, preCtx)) = split(ctx, eA) // Γpre[â]post 345 | val checkCtx = postCtx ++ ( 346 | NSol(eA, aArrow) :: a1 :: a2 :: preCtx) // Γpre[â₂,â₁,â=â₁→â₂]post 347 | trace(s"- âApp $exp <= $a1 in $checkCtx") 348 | (a2, check(exp, a1)(checkCtx)) // â₂ ⊣ ∆ 349 | // ->App 350 | case TArrow(argT, resT) => // A→C 351 | (resT, check(exp, argT)) // C ⊣ ∆ 352 | case fun => fail(s"Cannot apply expr of type '$fun' to '$exp'") 353 | } 354 | 355 | /** Runs inference on `expr` and returns either its type or an error. */ 356 | def inferExpr (expr :Term) :Either[String, Type] = try { 357 | nextEVar = 1 // makes error messages less arbitrary 358 | trace(s"inferExpr $expr") 359 | val (tpe, delta) = infer(expr)(Nil) 360 | trace(s"∆ = $delta") 361 | Right(apply(tpe)(delta)) 362 | } catch { 363 | case e :Exception => Left(e.getMessage) 364 | } 365 | 366 | val Trace = false 367 | private def trace (msg :String) = if (Trace) println(msg) 368 | } 369 | --------------------------------------------------------------------------------