diff --git a/hkmc2/shared/src/main/scala/hkmc2/codegen/Lowering.scala b/hkmc2/shared/src/main/scala/hkmc2/codegen/Lowering.scala index d1488799de..fa4fcecdf3 100644 --- a/hkmc2/shared/src/main/scala/hkmc2/codegen/Lowering.scala +++ b/hkmc2/shared/src/main/scala/hkmc2/codegen/Lowering.scala @@ -596,7 +596,7 @@ class Lowering()(using Config, TL, Raise, State, Ctx): case Quoted(body) => quote(body)(k) - // * BbML-specific cases: t.Cls#field and mutable operations + // * InvalML-specific cases: t.Cls#field and mutable operations case sp @ SelProj(prefix, _, proj) => setupSelection(prefix, proj, sp.sym)(k) case Region(reg, body) => diff --git a/hkmc2/shared/src/main/scala/hkmc2/bbml/ConstraintSolver.scala b/hkmc2/shared/src/main/scala/hkmc2/invalml/ConstraintSolver.scala similarity index 87% rename from hkmc2/shared/src/main/scala/hkmc2/bbml/ConstraintSolver.scala rename to hkmc2/shared/src/main/scala/hkmc2/invalml/ConstraintSolver.scala index f737a8e788..a430a5cc18 100644 --- a/hkmc2/shared/src/main/scala/hkmc2/bbml/ConstraintSolver.scala +++ b/hkmc2/shared/src/main/scala/hkmc2/invalml/ConstraintSolver.scala @@ -1,5 +1,5 @@ package hkmc2 -package bbml +package invalml import scala.collection.mutable @@ -9,12 +9,11 @@ import mlscript.utils.*, shorthands.* import utils.* import utils.Scope -// * TODO use mutabnle cache instead for correct asymptotic complexity -type Cache = Set[(Type, Type)] +type Cache = mutable.HashSet[(Type, Type)] type ExtrudeCache = mutable.HashMap[(Uid[InfVar], Bool), InfVar] case class CCtx(cache: Cache, parents: Ls[(Type, Type)], origin: Term, exp: Opt[GeneralType])(using Scope): - def err(using Raise) = + def err(using Raise, InvalCtx) = raise(ErrorReport( msg"Type error in ${origin.describe}${exp match case S(ty) => msg" with expected type ${ty.show}" @@ -25,23 +24,23 @@ case class CCtx(cache: Cache, parents: Ls[(Type, Type)], origin: Term, exp: Opt[ ) )) def nest(sub: (Type, Type)): CCtx = - copy(cache = cache + sub, parents = parents match + copy(cache = cache += sub, parents = parents match case `sub` :: _ => parents case _ => sub :: parents ) object CCtx: - inline def init(origin: Term, exp: Opt[GeneralType])(using Scope) = CCtx(Set.empty, Nil, origin, exp) + inline def init(origin: Term, exp: Opt[GeneralType])(using Scope) = CCtx(mutable.HashSet.empty, Nil, origin, exp) def cctx(using CCtx): CCtx = summon class ConstraintSolver(infVarState: InfVarUid.State, elState: Elaborator.State, tl: TraceLogger): import tl.{trace, log} - import hkmc2.bbml.NormalForm.* + import hkmc2.invalml.NormalForm.* private def freshXVar(lvl: Int, sym: Symbol, hint: Str): InfVar = InfVar(lvl, infVarState.nextUid, new VarState(), false)(InstSymbol(sym)(using elState), hint) - def extrude(ty: Type)(using lvl: Int, pol: Bool, cache: ExtrudeCache, bbctx: BbCtx, cctx: CCtx, tl: TL): Type = + def extrude(ty: Type)(using lvl: Int, pol: Bool, cache: ExtrudeCache, invalctx: InvalCtx, cctx: CCtx, tl: TL): Type = trace[Type](s"Extruding[${printPol(pol)}] ${ty.showDbg}", r => s"~> ${r.showDbg}"): if ty.lvl <= lvl then ty else ty.toBasic/*TODO improve extrude directly*/ match case ClassLikeType(sym, targs) => @@ -79,7 +78,7 @@ class ConstraintSolver(infVarState: InfVarUid.State, elState: Elaborator.State, case NegType(ty) => Type.mkNegType(extrude(ty)(using lvl, !pol)) case Top | Bot => ty - private def constrainConj(conj: Conj)(using BbCtx, CCtx, TL): Unit = trace(s"Constraining ${conj.showDbg}"): + private def constrainConj(conj: Conj)(using InvalCtx, CCtx, TL): Unit = trace(s"Constraining ${conj.showDbg}"): conj match case Conj(i, u, (v, pol) :: tail) => var rest = Conj(i, u, tail) @@ -89,13 +88,13 @@ class ConstraintSolver(infVarState: InfVarUid.State, elState: Elaborator.State, if pol then val nc = Type.mkNegType(bd).toDnf // always cache the normal form to avoid unexpected cache misses log(s"New bound: ${v.showDbg} <: ${nc.showDbg}") - cctx.nest(v -> nc) givenIn: + cctx.nest(v.toDnf -> nc) givenIn: v.state.upperBounds ::= nc v.state.lowerBounds.foreach(lb => constrainImpl(lb, nc)) else val c = bd.toDnf // always cache the normal form to avoid unexpected cache misses log(s"New bound: ${v.showDbg} :> ${c.showDbg}") - cctx.nest(c -> v) givenIn: + cctx.nest(c -> v.toDnf) givenIn: v.state.lowerBounds ::= c v.state.upperBounds.foreach(ub => constrainImpl(c, ub)) case Conj(i, u, Nil) => (conj.i, conj.u) match @@ -122,10 +121,10 @@ class ConstraintSolver(infVarState: InfVarUid.State, elState: Elaborator.State, // raise(ErrorReport(msg"Cannot solve ${conj.i.toString()} <: ${conj.u.toString()}" -> N :: Nil)) cctx.err - private def constrainDNF(disj: Disj)(using BbCtx, CCtx, TL): Unit = + private def constrainDNF(disj: Disj)(using InvalCtx, CCtx, TL): Unit = disj.conjs.foreach(constrainConj(_)) - private def constrainArgs(lhs: TypeArg, rhs: TypeArg)(using BbCtx, CCtx, TL): Unit = + private def constrainArgs(lhs: TypeArg, rhs: TypeArg)(using InvalCtx, CCtx, TL): Unit = constrainImpl(rhs.negPart, lhs.negPart) constrainImpl(lhs.posPart, rhs.posPart) @@ -137,13 +136,13 @@ class ConstraintSolver(infVarState: InfVarUid.State, elState: Elaborator.State, case NegType(ty) => NegType(inlineSkolemBounds(ty, !pol)) case _: ClassLikeType | _: FunType | _: InfVar | Top | Bot => ty - private def constrainImpl(lhs: Type, rhs: Type)(using BbCtx, CCtx, TL): Unit = + private def constrainImpl(lhs: Type, rhs: Type)(using InvalCtx, CCtx, TL): Unit = val p = lhs.toDnf -> rhs.toDnf if cctx.cache(p) then log(s"Cached!") else trace(s"CONSTRAINT ${lhs.showDbg} <: ${rhs.showDbg}"): cctx.nest(p) givenIn: val ty = dnf(inlineSkolemBounds(lhs & rhs.!, true)(using Set.empty)) constrainDNF(ty) - def constrain(lhs: Type, rhs: Type)(using BbCtx, CCtx, TL): Unit = + def constrain(lhs: Type, rhs: Type)(using InvalCtx, CCtx, TL): Unit = constrainImpl(lhs, rhs) diff --git a/hkmc2/shared/src/main/scala/hkmc2/bbml/bbML.scala b/hkmc2/shared/src/main/scala/hkmc2/invalml/InvalML.scala similarity index 58% rename from hkmc2/shared/src/main/scala/hkmc2/bbml/bbML.scala rename to hkmc2/shared/src/main/scala/hkmc2/invalml/InvalML.scala index 00fcacd7b6..37162e7000 100644 --- a/hkmc2/shared/src/main/scala/hkmc2/bbml/bbML.scala +++ b/hkmc2/shared/src/main/scala/hkmc2/invalml/InvalML.scala @@ -1,5 +1,5 @@ package hkmc2 -package bbml +package invalml import scala.collection.mutable.{HashSet, HashMap, ListBuffer} @@ -18,95 +18,112 @@ import utils.Scope object InfVarUid extends Uid.Handler[InfVar] -final case class BbCtx( +final case class InvalCtx( raise: Raise, ctx: Ctx, - parent: Option[BbCtx], + parent: Option[InvalCtx], lvl: Int, env: HashMap[Uid[Symbol], GeneralType], outRegAcc: Type, - outVar: Option[InfVar] + // outVar: Option[InfVar], + symbolCache: HashMap[Str, TypeSymbol], ): def +=(p: Symbol -> GeneralType): Unit = env += p._1.uid -> p._2 def get(sym: Symbol): Option[GeneralType] = env.get(sym.uid) orElse parent.dlof(_.get(sym))(None) - def getCls(name: Str): Option[TypeSymbol] = - for - elem <- ctx.get(name) - sym <- elem.symbol - cls <- sym.asTpe - yield cls + def getCls(name: Str): TypeSymbol = symbolCache.getOrElseUpdate(name, + ctx.get(name).get.symbol.get.asTpe.get) def &=(p: (Symbol, Type, InfVar)): Unit = - env += p._1.uid -> BbCtx.varTy(p._2, p._3)(using this) - def nest: BbCtx = copy(parent = Some(this), env = HashMap.empty) - def nextLevel: BbCtx = copy(parent = Some(this), lvl = lvl + 1, env = HashMap.empty) - def nestReg(reg: InfVar): BbCtx = + env += p._1.uid -> InvalCtx.varTy(p._2, p._3)(using this) + def nest: InvalCtx = copy(parent = Some(this), env = HashMap.empty) + def nextLevel: InvalCtx = copy(parent = Some(this), lvl = lvl + 1, env = HashMap.empty) + def nestReg(reg: InfVar): InvalCtx = copy(parent = Some(this), lvl = lvl + 1, env = HashMap.empty, outRegAcc = outRegAcc | reg) - def nestWithOuter(outer: InfVar): BbCtx = - copy(parent = Some(this), lvl = lvl + 1, env = HashMap.empty, outRegAcc = Bot, outVar = S(outer)) - def getRegEnv: Type = outVar match - case S(v) => v | outRegAcc - case N => outRegAcc - + def nestWithOuter(outer: InfVar): InvalCtx = + copy(parent = Some(this), lvl = lvl + 1, env = HashMap.empty, outRegAcc = outRegAcc | outer) + // def getRegEnv: Type = outVar match + // case S(v) => v | outRegAcc + // case N => outRegAcc + def getRegEnv: Type = outRegAcc + +// object InvalCtx: +def invalctx(using ctx: InvalCtx): InvalCtx = ctx + +given (using ctx: InvalCtx): Raise = ctx.raise -given (using ctx: BbCtx): Raise = ctx.raise - -object BbCtx: - def intTy(using ctx: BbCtx): Type = ClassLikeType(ctx.getCls("Int").get, Nil) - def numTy(using ctx: BbCtx): Type = ClassLikeType(ctx.getCls("Num").get, Nil) - def strTy(using ctx: BbCtx): Type = ClassLikeType(ctx.getCls("Str").get, Nil) - def boolTy(using ctx: BbCtx): Type = ClassLikeType(ctx.getCls("Bool").get, Nil) - def errTy(using ctx: BbCtx): Type = ClassLikeType(ctx.getCls("Error").get, Nil) - private def codeBaseTy(ct: TypeArg, cr: TypeArg, isVar: TypeArg)(using ctx: BbCtx): Type = - ClassLikeType(ctx.getCls("CodeBase").get, ct :: cr :: isVar :: Nil) - def codeTy(ct: Type, cr: Type)(using ctx: BbCtx): Type = +object InvalCtx: + def unitTy(using ctx: InvalCtx): Type = ClassLikeType(ctx.getCls("Unit"), Nil) + def intTy(using ctx: InvalCtx): Type = ClassLikeType(ctx.getCls("Int"), Nil) + def numTy(using ctx: InvalCtx): Type = ClassLikeType(ctx.getCls("Num"), Nil) + def strTy(using ctx: InvalCtx): Type = ClassLikeType(ctx.getCls("Str"), Nil) + def boolTy(using ctx: InvalCtx): Type = ClassLikeType(ctx.getCls("Bool"), Nil) + def errTy(using ctx: InvalCtx): Type = ClassLikeType(ctx.getCls("Error"), Nil) + private def codeBaseTy(ct: TypeArg, cr: TypeArg, isVar: TypeArg)(using ctx: InvalCtx): Type = + ClassLikeType(ctx.getCls("CodeBase"), ct :: cr :: isVar :: Nil) + def codeTy(ct: Type, cr: Type)(using ctx: InvalCtx): Type = codeBaseTy(Wildcard.out(ct), Wildcard.out(cr), Wildcard.out(Top)) - def varTy(ct: Type, cr: Type)(using ctx: BbCtx): Type = + def varTy(ct: Type, cr: Type)(using ctx: InvalCtx): Type = codeBaseTy(ct, Wildcard(cr, cr), Wildcard.out(Bot)) - def regionTy(sk: Type)(using ctx: BbCtx): Type = - ClassLikeType(ctx.getCls("Region").get, Wildcard(sk, sk) :: Nil) - def refTy(ct: Type, sk: Type)(using ctx: BbCtx): Type = - ClassLikeType(ctx.getCls("Ref").get, Wildcard(ct, ct) :: Wildcard.out(sk) :: Nil) - def init(raise: Raise)(using Elaborator.State, Elaborator.Ctx): BbCtx = - new BbCtx(raise, summon, None, 1, HashMap.empty, Bot, N) + def regionTy(sk: Type)(using ctx: InvalCtx): Type = + ClassLikeType(ctx.getCls("Region"), Wildcard.out(sk) :: Nil) + def refTy(ct: Type, sk: Type)(using ctx: InvalCtx): Type = + ClassLikeType(ctx.getCls("Ref"), Wildcard(ct, ct) :: Wildcard.out(sk) :: Nil) + def init(raise: Raise)(using Elaborator.State, Elaborator.Ctx): InvalCtx = + new InvalCtx(raise, summon, None, 1, HashMap.empty, Bot, HashMap.empty) val builtinOps = Elaborator.binaryOps ++ Elaborator.unaryOps ++ Elaborator.aliasOps.keySet -end BbCtx +end InvalCtx -class BBTyper(using elState: Elaborator.State, tl: TL): +class InvalTyper(using elState: Elaborator.State, tl: TL): import tl.{trace, log} private val infVarState = new InfVarUid.State() private val solver = new ConstraintSolver(infVarState, elState, tl) - private def freshSkolem(sym: Symbol, hint: Str = "")(using ctx: BbCtx): InfVar = + // A temporary solution for ADT matching exhausive checking + // `adtCtors` maps IDs of ADTs to their constructors' IDs + // `adtParent` maps constructors' IDs to the ADT class symbol they belong to + // `typeNames` maintains all type names + // since we need to reject all non-variable patterns in ADT match for now + private val adtCtors = HashMap.empty[Uid[Symbol], ListBuffer[Uid[Symbol]]] + private val adtParent = HashMap.empty[Uid[Symbol], Symbol] + private val typeNames = HashSet.empty[Str] + + private def freshSkolem(sym: Symbol, hint: Str = "")(using ctx: InvalCtx): InfVar = InfVar(ctx.lvl, infVarState.nextUid, new VarState(), true)(sym, hint) - private def freshVar(sym: Symbol, hint: Str = "")(using ctx: BbCtx): InfVar = + private def freshVar(sym: Symbol, hint: Str = "")(using ctx: InvalCtx): InfVar = InfVar(ctx.lvl, infVarState.nextUid, new VarState(), false)(sym, hint) - private def freshWildcard(sym: Symbol)(using ctx: BbCtx) = + private def freshWildcard(sym: Symbol)(using ctx: InvalCtx) = val in = freshVar(sym, "") val out = freshVar(sym, "") // in.state.upperBounds ::= out // * Not needed for soundness; complicates inferred types Wildcard(in, out) - private def freshReg(sym: Symbol)(using ctx: BbCtx) = + private def freshReg(sym: Symbol)(using ctx: InvalCtx) = val state = new VarState() state.upperBounds = ctx.getRegEnv.! :: Nil InfVar(ctx.lvl + 1, infVarState.nextUid, state, true)(sym, "") - private def freshOuter(sym: Symbol)(using ctx: BbCtx): InfVar = + private def freshOuter(sym: Symbol)(using ctx: InvalCtx): InfVar = InfVar(ctx.lvl + 1, infVarState.nextUid, new VarState(), true)(sym, "") - private def freshEnv(sym: Symbol)(using ctx: BbCtx): InfVar = + private def freshEnv(sym: Symbol)(using ctx: InvalCtx): InfVar = val state = new VarState() state.upperBounds = ctx.getRegEnv :: Nil state.lowerBounds = ctx.getRegEnv :: Nil InfVar(ctx.lvl, infVarState.nextUid, state, false)(sym, "") - private def error(msg: Ls[Message -> Opt[Loc]])(using BbCtx) = - raise(ErrorReport(msg)) + private def error(msg: Ls[Message -> Opt[Loc]], extraInfo: => Opt[Any] = N)(using InvalCtx) = + raise(ErrorReport(msg, extraInfo = extraInfo)) Bot // TODO: error type? + private def addADTCtor(pSym: Symbol, cSym: Symbol) = + if !adtCtors.keySet(pSym.uid) then + adtCtors += pSym.uid -> ListBuffer(cSym.uid) + else adtCtors(pSym.uid) += cSym.uid + adtParent += cSym.uid -> pSym + typeNames.add(pSym.nme) + typeNames.add(cSym.nme) private def typeAndSubstType - (ty: Term, pol: Bool)(using map: Map[Uid[Symbol], TypeArg])(using ctx: BbCtx, cctx: CCtx) + (ty: Term, pol: Bool)(using map: Map[Uid[Symbol], TypeArg])(using ctx: InvalCtx, cctx: CCtx) : GeneralType = trace[GeneralType](s"${ctx.lvl}. Typing type ${ty.showDbg}", r => s"~> ${r.showDbg}"): def mono(ty: Term, pol: Bool): Type = @@ -132,7 +149,7 @@ class BBTyper(using elState: Elaborator.State, tl: TL): val outVar = freshOuter(outer.getOrElse(new TempSymbol(S(f), "outer")))(using ctx) val nestCtx = ctx.nestWithOuter(outVar) outer.foreach(sym => nestCtx += sym -> outVar) - given BbCtx = nestCtx + given InvalCtx = nestCtx genPolyType(tvs, outVar, typeAndSubstType(body, pol)) case Term.TyApp(cls, targs) => // log(s"Type application: ${cls.nme} with ${targs}") @@ -147,7 +164,7 @@ class BBTyper(using elState: Elaborator.State, tl: TL): val ts = defn.tparams.lazyZip(targs).map: (tp, t) => t match case Term.WildcardTy(in, out) => Wildcard( - in.map(t => mono(t, pol)).getOrElse(Bot), + in.map(t => mono(t, !pol)).getOrElse(Bot), out.map(t => mono(t, pol)).getOrElse(Top) ) case _ => @@ -163,13 +180,14 @@ class BBTyper(using elState: Elaborator.State, tl: TL): mono(rhs, !pol).! case CompType(lhs, rhs, pol) => Type.mkComposedType(typeMonoType(lhs), typeMonoType(rhs), pol) + case UnitVal() => + InvalCtx.unitTy case _ => ty.symbol.flatMap(_.asTpe) match case S(cls: (ClassSymbol | TypeAliasSymbol)) => typeAndSubstType(Term.TyApp(ty, Nil)(N), pol) - case S(_) => error(msg"${ty.symbol.get.getClass.toString()} is not a valid type" -> ty.toLoc :: Nil) - case N => error(msg"Invalid type" -> ty.toLoc :: Nil) // TODO + case N => error(msg"Invalid type" -> ty.toLoc :: Nil, S(ty)) // TODO - private def genPolyType(tvs: Ls[QuantVar], outer: InfVar, body: => GeneralType)(using ctx: BbCtx, cctx: CCtx) = + private def genPolyType(tvs: Ls[QuantVar], outer: InfVar, body: => GeneralType)(using ctx: InvalCtx, cctx: CCtx) = val bds = tvs.map: case qv @ QuantVar(sym, ub, lb) => val tv = freshVar(sym) @@ -184,41 +202,41 @@ class BBTyper(using elState: Elaborator.State, tl: TL): constrain(lbty, ubty) PolyType(bds.map(_._1), S(outer), body) - private def typeMonoType(ty: Term)(using ctx: BbCtx, cctx: CCtx): Type = monoOrErr(typeType(ty), ty) + private def typeMonoType(ty: Term)(using ctx: InvalCtx, cctx: CCtx): Type = monoOrErr(typeType(ty), ty) - private def typeType(ty: Term)(using ctx: BbCtx, cctx: CCtx): GeneralType = + private def typeType(ty: Term)(using ctx: InvalCtx, cctx: CCtx): GeneralType = typeAndSubstType(ty, pol = true)(using Map.empty) - private def instantiate(ty: PolyType)(using ctx: BbCtx): GeneralType = + private def instantiate(ty: PolyType)(using ctx: InvalCtx): GeneralType = ty.instantiate(infVarState.nextUid, freshEnv(new TempSymbol(N, "env")), ctx.lvl)(tl) - private def extrude(ty: GeneralType)(using ctx: BbCtx, pol: Bool, cctx: CCtx): GeneralType = ty match + private def extrude(ty: GeneralType)(using ctx: InvalCtx, pol: Bool, cctx: CCtx): GeneralType = ty match case ty: Type => solver.extrude(ty)(using ctx.lvl, pol, HashMap.empty) case PolyType(tvs, outer, body) => PolyType(tvs, outer, extrude(body)) case pf @ PolyFunType(args, ret, eff) => PolyFunType(args.map(extrude(_)(using ctx, !pol)), extrude(ret), solver.extrude(eff)(using ctx.lvl, pol, HashMap.empty)) - private def constrain(lhs: Type, rhs: Type)(using ctx: BbCtx, cctx: CCtx): Unit = + private def constrain(lhs: Type, rhs: Type)(using ctx: InvalCtx, cctx: CCtx): Unit = solver.constrain(lhs, rhs) - private def typeCode(code: Term)(using ctx: BbCtx, scope: Scope): (Type, Type, Type) = + private def typeCode(code: Term)(using ctx: InvalCtx, scope: Scope): (Type, Type, Type) = given CCtx = CCtx.init(code, N) code match case UnitVal() => (Top, Bot, Bot) - case Lit(lit) => ((lit match - case _: IntLit => BbCtx.intTy - case _: DecLit => BbCtx.numTy - case _: StrLit => BbCtx.strTy - case _: UnitLit => Top - case _: BoolLit => BbCtx.boolTy), Bot, Bot) + case Lit(lit) => ((lit match // TODO dedup with other `case Lit(lit)` + case _: IntLit => InvalCtx.intTy + case _: DecLit => InvalCtx.numTy + case _: StrLit => InvalCtx.strTy + case _: UnitLit => InvalCtx.unitTy + case _: BoolLit => InvalCtx.boolTy), Bot, Bot) case Ref(sym: Symbol) if sym.nme === "error" => (Bot, Bot, Bot) - case Ref(sym: Symbol) if BbCtx.builtinOps(sym.nme) => ctx.get(sym) match + case Ref(sym: Symbol) if InvalCtx.builtinOps(sym.nme) => ctx.get(sym) match case S(ty) => (tryMkMono(ty, code), Bot, Bot) case N => (error(msg"Cannot quote operator ${sym.nme}" -> code.toLoc :: Nil), Bot, Bot) case f @ Lam(PlainParamList(params), body) => val nestCtx = ctx.nextLevel - given BbCtx = nestCtx + given InvalCtx = nestCtx val bds = params.map: case Param(sym = sym) => val tv = freshVar(sym) @@ -245,13 +263,13 @@ class BBTyper(using elState: Elaborator.State, tl: TL): val (ty, eff) = typeCheck(body) val tv = freshVar(new TempSymbol(S(unq), "cde")) val cr = freshVar(new TempSymbol(S(unq), "ctx")) - constrain(tryMkMono(ty, body), BbCtx.codeTy(tv, cr)) + constrain(tryMkMono(ty, body), InvalCtx.codeTy(tv, cr)) (tv, cr, eff) case blk @ Term.Blk(LetDecl(sym, _) :: DefineVar(sym2, rhs) :: Nil, body) if sym2 is sym => // TODO: more than one!! val (rhsTy, rhsCtx, rhsEff) = typeCode(rhs)(using ctx) val nestCtx = ctx.nextLevel - given BbCtx = nestCtx + given InvalCtx = nestCtx val sk = freshSkolem(sym) nestCtx &= (sym, rhsTy, sk) val (bodyTy, bodyCtx, bodyEff) = typeCode(body) @@ -262,12 +280,12 @@ class BBTyper(using elState: Elaborator.State, tl: TL): val (condTy, condCtx, condEff) = typeCode(cond) val (consTy, consCtx, consEff) = typeCode(cons) val (altsTy, altsCtx, altsEff) = typeCode(alts) - constrain(condTy, BbCtx.boolTy) + constrain(condTy, InvalCtx.boolTy) (consTy | altsTy, condCtx | consCtx | altsCtx, condEff | consEff | altsEff) case _ => (error(msg"Cannot quote ${code.toString}" -> code.toLoc :: Nil), Bot, Bot) - private def typeFunDef(sym: Symbol, lam: Term, sig: Opt[Term])(using ctx: BbCtx, cctx: CCtx, scope: Scope) = lam match + private def typeFunDef(sym: Symbol, lam: Term, sig: Opt[Term])(using ctx: InvalCtx, cctx: CCtx, scope: Scope) = lam match case Term.Lam(params, body) => sig match case S(sig) => val sigTy = typeType(sig)(using ctx) @@ -276,7 +294,7 @@ class BBTyper(using elState: Elaborator.State, tl: TL): () case N => val outer = freshOuter(new TempSymbol(S(lam), "outer"))(using ctx) - given BbCtx = ctx.nestWithOuter(outer) + given InvalCtx = ctx.nestWithOuter(outer) val funTyV = freshVar(sym) ctx += sym -> funTyV // for recursive functions val (res, _) = typeCheck(lam) @@ -286,8 +304,109 @@ class BBTyper(using elState: Elaborator.State, tl: TL): ctx += sym -> PolyType.generalize(funTy, S(outer), ctx.lvl + 1) case _ => error(msg"Function definition shape not yet supported for ${sym.nme}" -> lam.toLoc :: Nil) + // Check if a given matching expression is matching on an ADT. + // An `if` expression can only matching on one ADT and patterns can only carry variables so far. + // It is a temporary solution to ADTs. + private def isADTMatch(split: Split)(using InvalCtx) = + def rec(split: Split, acc: Either[Opt[Symbol], Unit]): Bool = + split match + case Split.Cons(Branch(_, pattern, _), alts) => + pattern match + case Pattern.ResolvedClassOrModule(sym, _) if adtParent.keySet(sym.uid) => + acc match + case L(N) => rec(alts, L(S(sym))) + case L(S(other)) if adtParent.get(other.uid).exists(p => p.uid == adtParent(sym.uid).uid) => + rec(alts, L(S(sym))) + case R(_) => + error(msg"Mixing ADT pattern matching and general matching is not supported yet." -> split.toLoc :: Nil) + false + case _ => acc match + case L(S(_)) => + error(msg"Mixing ADT pattern matching and general matching is not supported yet." -> split.toLoc :: Nil) + false + case _ => rec(alts, R(())) + case Split.Let(_, _, tail) => rec(tail, acc) + case _ => acc match + case L(S(sym)) => true + case _ => false + rec(split, L(N)) + + // Type check ADT matching, which also returns mentioned constructors for exhaustive checking. + // No GADT reasoning. + // It is a temporary solution to ADTs. + private def typeADTMatch + (split: Split, sign: Opt[GeneralType])(using ctx: InvalCtx)(using CCtx, Scope) + : (GeneralType, Type, Ls[Symbol], Bool) = split match + case Split.Cons(Branch(scrutinee, pattern, cons), alts) => + val (scrutineeTy, scrutineeEff) = typeCheck(scrutinee) + val map = HashMap[Uid[Symbol], TypeArg]() + pattern match + case Pattern.ResolvedClassOrModule(sym, paramsOpt) => + paramsOpt.foreach: params => + params.foreach: + case (_, p, _) => p match + case Under() => () + case Ident(nme) if !typeNames(nme) => () + case _ => + error(msg"Pattern ${p.toString} is not supported yet." -> split.toLoc :: Nil) + val clsTy = adtParent.get(sym.uid).flatMap(_.asCls.flatMap(_.defn)) match + case S(cls) => + ClassLikeType(cls.sym, cls.tparams.map(_ => freshWildcard(sym))) + case _ => + error(msg"Cannot match ${scrutinee.toString} as ${sym.toString}" -> split.toLoc :: Nil) + Bot + constrain(tryMkMono(scrutineeTy, scrutinee), clsTy) + val (paramList, tps, isGeneric, ext) = sym.asCls.flatMap(_.defn) match + case S(clsDef) => + val isGeneric = clsDef.annotations.exists { + case Annot.Modifier(syntax.Keyword.data) => true + case _ => false + } + val ext = clsDef.ext match + case S(Term.New(p: Term, _, _)) => p + case _ => Term.Error + (clsDef.paramsOpt.map(p => p.params).getOrElse(Nil), clsDef.tparams, isGeneric, ext) + case N => + error(msg"${sym.toString} is not a valid constructor." -> split.toLoc :: Nil) + (Nil, Nil, false, Term.Error) + val params = paramsOpt.getOrElse(Nil) + if params.length != paramList.length then + error(msg"${sym.toString} is not a valid constructor." -> split.toLoc :: Nil) + (Bot, Bot, sym :: Nil, false) + else + val nestCtx = if isGeneric then ctx.nextLevel else ctx.nest + tps.foreach { + case TyParam(_, _, targ) => + val ty = if isGeneric then freshVar(targ)(using nestCtx) else freshWildcard(targ)(using nestCtx) + map += targ.uid -> ty + } + if !isGeneric then // no GADT reasoning so far + constrain(clsTy, tryMkMono(typeAndSubstType(ext, true)(using map.toMap), scrutinee)) + params.iterator.zip(paramList).foreach: + case (p, Param(_, _, S(ty), _)) => + nestCtx += p.scrutinee -> typeAndSubstType(ty, true)(using map.toMap) + val (consTy, consEff) = typeAllSplits(cons, sign)(using nestCtx) + val (altsTy, altsEff, altCases, fallback) = typeADTMatch(alts, sign) + val allEff = scrutineeEff | (consEff | altsEff) + (sign.getOrElse(tryMkMono(consTy, cons) | tryMkMono(altsTy, alts)), allEff, sym :: altCases, fallback) + case Split.Let(name, term, tail) => + val nestCtx = ctx.nest + given InvalCtx = nestCtx + val (termTy, termEff) = typeCheck(term) + nestCtx += name -> termTy + val (tailTy, tailEff, cases, fallback) = typeADTMatch(tail, sign)(using nestCtx) + (tailTy, termEff | tailEff, cases, fallback) + case Split.Else(alts) => sign match + case S(sign) => + val (ty, res) = ascribe(alts, sign) + (ty, res, Nil, true) + case _ => + val (ty, res) = typeCheck(alts) + (ty, res, Nil, true) + case Split.End => (Bot, Bot, Nil, false) + private def typeSplit - (split: Split, sign: Opt[GeneralType])(using ctx: BbCtx)(using CCtx, Scope) + (split: Split, sign: Opt[GeneralType])(using ctx: InvalCtx)(using CCtx, Scope) : (GeneralType, Type) = split match case Split.Cons(Branch(scrutinee, pattern, cons), alts) => @@ -313,12 +432,12 @@ class BBTyper(using elState: Elaborator.State, tl: TL): case N => error(msg"Not a valid class: ${pat.constructor.describe}" -> pat.constructor.toLoc :: Nil) Bot - case Pattern.Lit(lit) => lit match - case _: Tree.BoolLit => BbCtx.boolTy - case _: Tree.IntLit => BbCtx.intTy - case _: Tree.DecLit => BbCtx.numTy - case _: Tree.StrLit => BbCtx.strTy - case _: Tree.UnitLit => Top + case Pattern.Lit(lit) => lit match // TODO dedup with `case Lit(lit)` + case _: Tree.BoolLit => InvalCtx.boolTy + case _: Tree.IntLit => InvalCtx.intTy + case _: Tree.DecLit => InvalCtx.numTy + case _: Tree.StrLit => InvalCtx.strTy + case _: Tree.UnitLit => InvalCtx.unitTy constrain(tryMkMono(scrutineeTy, scrutinee), patTy) val (consTy, consEff) = typeSplit(cons, sign)(using nestCtx1) val (altsTy, altsEff) = typeSplit(alts, sign)(using nestCtx2) @@ -326,9 +445,8 @@ class BBTyper(using elState: Elaborator.State, tl: TL): (sign.getOrElse(tryMkMono(consTy, cons) | tryMkMono(altsTy, alts)), allEff) case Split.Let(name, term, tail) => val nestCtx = ctx.nest - given BbCtx = nestCtx + given InvalCtx = nestCtx val (termTy, termEff) = typeCheck(term) - val sk = freshSkolem(name) nestCtx += name -> termTy val (tailTy, tailEff) = typeSplit(tail, sign)(using nestCtx) (tailTy, termEff | tailEff) @@ -337,21 +455,42 @@ class BBTyper(using elState: Elaborator.State, tl: TL): case _ => typeCheck(alts) case Split.End => (Bot, Bot) + private def typeAllSplits + (split: Split, sign: Opt[GeneralType])(using ctx: InvalCtx)(using CCtx, Scope) + : (GeneralType, Type) = + if isADTMatch(split) then + val (res, eff, cases, fallback) = typeADTMatch(split, sign) + if !fallback then + cases match // A primitive exhaustive check + case c :: rest => // previous check already guarantees that all cases belong to the same ADT. + adtParent.get(c.uid).flatMap(p => adtCtors.get(p.uid)) match + case S(ctors) => + val dist = cases.map(_.uid).distinct + if dist.length < cases.length then + error(msg"Duplicate match branches." -> split.toLoc :: Nil) + if dist.length != ctors.length then + error(msg"Expect ${ctors.length.toString()} cases, but ${dist.length.toString()} got." -> split.toLoc :: Nil) + case N => + error(msg"Unknown ADT constructor ${c.nme}" -> split.toLoc :: Nil) + case Nil => ??? // impossible + (res, eff) + else typeSplit(split, sign) + // * Note: currently, the returned type is not used or useful, but it could be in the future - private def ascribe(lhs: Term, rhs: GeneralType)(using ctx: BbCtx, scope: Scope): (GeneralType, Type) = + private def ascribe(lhs: Term, rhs: GeneralType)(using ctx: InvalCtx, scope: Scope): (GeneralType, Type) = trace[(GeneralType, Type)](s"${ctx.lvl}. Ascribing ${lhs.showDbg} : ${rhs.showDbg}", res => s"! ${res._2.showDbg}"): given CCtx = CCtx.init(lhs, S(rhs)) (lhs, rhs) match case (Term.Lam(PlainParamList(params), body), ft @ PolyFunType(args, ret, eff)) => // * annoted functions if params.length != args.length then - (error(msg"Cannot type function ${lhs.toString} as ${rhs.show}" -> lhs.toLoc :: Nil), Bot) + (error(msg"Cannot type this ${lhs.describe} as ${rhs.show}" -> lhs.toLoc :: Nil), Bot) else val nestCtx = ctx.nest val argsTy = params.zip(args).map: case (Param(sym = sym), ty) => nestCtx += sym -> ty ty - given BbCtx = nestCtx + given InvalCtx = nestCtx val (_, effTy) = ascribe(body, ret) constrain(effTy, eff) (ft, Bot) @@ -360,11 +499,11 @@ class BBTyper(using elState: Elaborator.State, tl: TL): val nextCtx = outer match case S(outer) => ctx.nestWithOuter(outer) case N => ctx.nextLevel - given BbCtx = nextCtx + given InvalCtx = nextCtx constrain(ascribe(term, skolemize(pt))._2, Bot) // * never generalize terms with effects (pt, Bot) case (Term.IfLike(Keyword.`if`, branches), ty) => // * propagate - typeSplit(branches, S(ty)) + typeAllSplits(branches, S(ty)) case (Term.Asc(term, ty), rhs) => ascribe(term, typeType(ty)) ascribe(term, rhs) @@ -379,7 +518,7 @@ class BBTyper(using elState: Elaborator.State, tl: TL): // TODO: t -> loc when toLoc is implemented private def app(lhs: (GeneralType, Type), rhs: Ls[Elem], t: Term) - (using ctx: BbCtx)(using CCtx, Scope) + (using ctx: InvalCtx)(using CCtx, Scope) : (GeneralType, Type) = lhs match case (PolyFunType(params, ret, eff), lhsEff) => @@ -406,20 +545,63 @@ class BBTyper(using elState: Elaborator.State, tl: TL): constrain(tryMkMono(funTy, t), FunType(argTy.map((tryMkMono(_, t))), retVar, effVar)) (retVar, argEff.foldLeft[Type](effVar | lhsEff)((res, e) => res | e)) - private def skolemize(ty: PolyType)(using ctx: BbCtx) = ty.skolemize(infVarState.nextUid, ctx.lvl)(tl) + private def skolemize(ty: PolyType)(using ctx: InvalCtx) = ty.skolemize(infVarState.nextUid, ctx.lvl)(tl) // TODO: implement toLoc - private def monoOrErr(ty: GeneralType, sc: Located)(using BbCtx) = + private def monoOrErr(ty: GeneralType, sc: Located)(using InvalCtx) = ty.monoOr(error(msg"General type is not allowed here." -> sc.toLoc :: Nil)) // * Try to instantiate the given type if it is forall quantified - private def tryMkMono(ty: GeneralType, sc: Located)(using BbCtx, Scope): Type = ty match + private def tryMkMono(ty: GeneralType, sc: Located)(using InvalCtx, Scope): Type = ty match case pt: PolyType => tryMkMono(instantiate(pt), sc) case ft: PolyFunType => ft.monoOr(error(msg"Expected a monomorphic type or an instantiable type here, but ${ty.show} found" -> sc.toLoc :: Nil)) case ty: Type => ty - private def typeCheck(t: Term)(using ctx: BbCtx, scope: Scope): (GeneralType, Type) = + private def createADTCtor(clsDef: ClassDef, resTy: Term)(using ctx: InvalCtx, scope: Scope, cctx: CCtx) = + val nestCtx = ctx.nextLevel + given InvalCtx = nestCtx + val map = HashMap[Uid[Symbol], TypeArg]() + val isGeneric = clsDef.annotations.exists { + case Annot.Modifier(syntax.Keyword.data) => true + case _ => false + } + val targs = clsDef.tparams.map { + case TyParam(_, vce, targ) => + val ty = vce match + case S(v) => + val tv = freshVar(targ) + if v then Wildcard.out(tv) else Wildcard.in(tv) + case _ => if isGeneric then freshVar(targ) else freshWildcard(targ) + map += targ.uid -> ty + ty + } + addADTCtor(clsDef.ext.flatMap(n => n.cls.symbol).getOrElse(???), clsDef.sym) + clsDef match + case clsDef: ClassDef.Plain => + ctx += clsDef.bsym -> typeAndSubstType(resTy, true)(using map.toMap) + case clsDef: ClassDef.Parameterized => + if clsDef.tparams.isEmpty then + ctx += clsDef.bsym -> PolyFunType(clsDef.params.params.map { + case Param(_, _, S(ty), _) => typeType(ty) + case p => + error(msg"Invalid ADT parameter." -> p.toLoc :: Nil) + Bot + }, typeAndSubstType(resTy, true)(using map.toMap), Bot) + else + ctx += clsDef.bsym -> PolyType(targs.flatMap { + case Wildcard(in: InfVar, out: InfVar) => in :: out :: Nil + case Wildcard(in: InfVar, _) => in :: Nil + case Wildcard(_, out: InfVar) => out :: Nil + case v: InfVar => v :: Nil + }, N, PolyFunType(clsDef.params.params.map { + case Param(_, _, S(ty), _) => typeAndSubstType(ty, true)(using map.toMap) + case p => + error(msg"Invalid ADT parameter." -> p.toLoc :: Nil) + Bot + }, typeAndSubstType(resTy, true)(using map.toMap), Bot)) + + private def typeCheck(t: Term)(using ctx: InvalCtx, scope: Scope): (GeneralType, Type) = trace[(GeneralType, Type)](s"${ctx.lvl}. Typing ${t.showDbg}", res => s": (${res._1.showDbg}, ${res._2.showDbg})"): given CCtx = CCtx.init(t, N) t match @@ -459,8 +641,13 @@ class BBTyper(using elState: Elaborator.State, tl: TL): ctx += td.sym -> typeType(sig) goStats(stats) case (clsDef: ClassDef) :: stats => + typeNames.add(clsDef.sym.nme) + clsDef.ext match + case S(Term.New(ty, _, N)) => createADTCtor(clsDef, ty) + case _ => () goStats(stats) case (modDef: ModuleDef) :: stats => + typeNames.add(modDef.sym.nme) goStats(stats) case Import(sym, pth) :: stats => goStats(stats) // TODO: @@ -469,16 +656,16 @@ class BBTyper(using elState: Elaborator.State, tl: TL): goStats(stats) val (ty, eff) = typeCheck(res) (ty, effBuff.foldLeft(eff)((res, e) => res | e)) - case UnitVal() => (Top, Bot) + case UnitVal() => (InvalCtx.unitTy, Bot) case Lit(lit) => ((lit match - case _: IntLit => BbCtx.intTy - case _: DecLit => BbCtx.numTy - case _: StrLit => BbCtx.strTy - case _: UnitLit => Top - case _: BoolLit => BbCtx.boolTy), Bot) + case _: IntLit => InvalCtx.intTy + case _: DecLit => InvalCtx.numTy + case _: StrLit => InvalCtx.strTy + case _: UnitLit => InvalCtx.unitTy + case _: BoolLit => InvalCtx.boolTy), Bot) case Lam(PlainParamList(params), body) => val nestCtx = ctx.nest - given BbCtx = nestCtx + given InvalCtx = nestCtx val tvs = params.map: case Param(_, sym, sign, _) => val ty = sign.map(s => typeType(s)(using nestCtx)).getOrElse(freshVar(sym)) @@ -546,12 +733,13 @@ class BBTyper(using elState: Elaborator.State, tl: TL): case Term.Asc(term, ty) => val res = typeType(ty)(using ctx) ascribe(term, res) - case Term.IfLike(Keyword.`if`, branches) => typeSplit(branches, N) + case Term.IfLike(Keyword.`if`, branches) => + typeAllSplits(branches, N) case reg @ Term.Region(sym, body) => val sk = freshReg(sym)(using ctx) val nestCtx = ctx.nestReg(sk) - given BbCtx = nestCtx - nestCtx += sym -> BbCtx.regionTy(sk) + given InvalCtx = nestCtx + nestCtx += sym -> InvalCtx.regionTy(sk) val (res, eff) = typeCheck(body) val tv = freshVar(new TempSymbol(S(reg), "eff"))(using ctx) constrain(eff, tv | sk) @@ -560,37 +748,37 @@ class BBTyper(using elState: Elaborator.State, tl: TL): val (regTy, regEff) = typeCheck(reg) val (valTy, valEff) = typeCheck(value) val sk = freshVar(new TempSymbol(S(reg), "reg")) - constrain(tryMkMono(regTy, reg), BbCtx.regionTy(sk)) - (BbCtx.refTy(tryMkMono(valTy, value), sk), sk | (regEff | valEff)) + constrain(tryMkMono(regTy, reg), InvalCtx.regionTy(sk)) + (InvalCtx.refTy(tryMkMono(valTy, value), sk), sk | (regEff | valEff)) case Term.SetRef(lhs, rhs) => val (lhsTy, lhsEff) = typeCheck(lhs) val (rhsTy, rhsEff) = typeCheck(rhs) val sk = freshVar(new TempSymbol(S(lhs), "reg")) - constrain(tryMkMono(lhsTy, lhs), BbCtx.refTy(tryMkMono(rhsTy, rhs), sk)) + constrain(tryMkMono(lhsTy, lhs), InvalCtx.refTy(tryMkMono(rhsTy, rhs), sk)) (tryMkMono(rhsTy, rhs), sk | (lhsEff | rhsEff)) case Term.Deref(ref) => val (refTy, refEff) = typeCheck(ref) val sk = freshVar(new TempSymbol(S(ref), "reg")) val ctnt = freshVar(new TempSymbol(S(ref), "ref")) - constrain(tryMkMono(refTy, ref), BbCtx.refTy(ctnt, sk)) + constrain(tryMkMono(refTy, ref), InvalCtx.refTy(ctnt, sk)) (ctnt, sk | refEff) case Term.Quoted(body) => val nestCtx = ctx.nest - given BbCtx = nestCtx + given InvalCtx = nestCtx val (ty, ctxTy, eff) = typeCode(body) - (BbCtx.codeTy(ty, ctxTy), eff) + (InvalCtx.codeTy(ty, ctxTy), eff) case _: Term.Unquoted => (error(msg"Unquote should nest in quasiquote" -> t.toLoc :: Nil), Bot) case Throw(e) => val (ty, eff) = typeCheck(e) - constrain(tryMkMono(ty, e), BbCtx.errTy) + constrain(tryMkMono(ty, e), InvalCtx.errTy) (Bot, eff) case Term.Error => (Bot, Bot) // TODO: error type? case _ => - (error(msg"Term shape not yet supported by BbML: ${t.toString}" -> t.toLoc :: Nil), Bot) + (error(msg"Term shape not yet supported by InvalML: ${t.toString}" -> t.toLoc :: Nil), Bot) - def typePurely(t: Term)(using BbCtx, Scope): GeneralType = + def typePurely(t: Term)(using InvalCtx, Scope): GeneralType = val (ty, eff) = typeCheck(t) given CCtx = CCtx.init(t, N) constrain(eff, Bot) diff --git a/hkmc2/shared/src/main/scala/hkmc2/bbml/NormalForm.scala b/hkmc2/shared/src/main/scala/hkmc2/invalml/NormalForm.scala similarity index 96% rename from hkmc2/shared/src/main/scala/hkmc2/bbml/NormalForm.scala rename to hkmc2/shared/src/main/scala/hkmc2/invalml/NormalForm.scala index 66399b8a96..26969223a6 100644 --- a/hkmc2/shared/src/main/scala/hkmc2/bbml/NormalForm.scala +++ b/hkmc2/shared/src/main/scala/hkmc2/invalml/NormalForm.scala @@ -1,5 +1,5 @@ package hkmc2 -package bbml +package invalml import scala.annotation.tailrec @@ -14,7 +14,7 @@ final case class Disj(conjs: Ls[Conj]) extends NormalForm with CachedBasicType: def mkBasic: BasicType = BasicType.union(conjs.map(_.toBasic)) def toDnf(using TL): Disj = this - override def show(using Scope): Str = + override def show(using Scope, InvalCtx): Str = if conjs.isEmpty then "⊥" else conjs.map(_.show).mkString(" ∨ ") @@ -53,7 +53,7 @@ extends NormalForm with CachedBasicType: case (tv, false) => NegType(tv) }) def toDnf(using TL): Disj = Disj(this :: Nil) - override def show(using Scope): Str = + override def show(using Scope, InvalCtx): Str = val s = ((i :: Nil).filterNot(_.isTop).map(_.show) ::: (u :: Nil).filterNot(_.isBot).map("¬{"+_.show+"}") ::: vars.map: @@ -100,7 +100,7 @@ final case class Inter(v: Opt[ClassLikeType | FunType]) extends NormalForm: case _ => N def toBasic: BasicType = v.getOrElse(Top) def toDnf(using TL): Disj = Disj(Conj(this, Union(N, Nil), Nil) :: Nil) - override def show(using Scope): Str = + override def show(using Scope, InvalCtx): Str = toBasic.show override def showDbg: Str = toBasic.showDbg @@ -130,7 +130,7 @@ extends NormalForm with CachedBasicType: def mkBasic: BasicType = BasicType.union(fun.toList ::: cls) def toDnf(using TL): Disj = NormalForm.neg(this) - override def show(using Scope): Str = + override def show(using Scope, InvalCtx): Str = toType.show override def showDbg: Str = toType.showDbg @@ -145,7 +145,7 @@ sealed abstract class NormalForm extends TypeExt: def subst(using map: Map[Uid[InfVar], InfVar]): ThisType = toBasic.subst - def show(using Scope): Str + def show(using Scope, InvalCtx): Str def showDbg: Str object NormalForm: diff --git a/hkmc2/shared/src/main/scala/hkmc2/bbml/PrettyPrinter.scala b/hkmc2/shared/src/main/scala/hkmc2/invalml/PrettyPrinter.scala similarity index 79% rename from hkmc2/shared/src/main/scala/hkmc2/bbml/PrettyPrinter.scala rename to hkmc2/shared/src/main/scala/hkmc2/invalml/PrettyPrinter.scala index 80d011d4ad..86162de335 100644 --- a/hkmc2/shared/src/main/scala/hkmc2/bbml/PrettyPrinter.scala +++ b/hkmc2/shared/src/main/scala/hkmc2/invalml/PrettyPrinter.scala @@ -1,11 +1,14 @@ package hkmc2 -package bbml +package invalml import scala.collection.mutable.{Set => MutSet, ListBuffer} import utils.Scope -class PrettyPrinter(output: String => Unit)(using Scope): +class PrettyPrinter(output: String => Unit)(using Scope, InvalCtx): def print(ty: GeneralType): Unit = - output(s"Type: ${ty.show}") + ty.show match + case "()" => + case tyStr => + output(s"Type: ${tyStr}") val bounds = PrettyPrinter.collectBounds(ty).distinct if !bounds.isEmpty then output("Where:") @@ -14,7 +17,7 @@ class PrettyPrinter(output: String => Unit)(using Scope): } object PrettyPrinter: - def apply(output: String => Unit)(using Scope): PrettyPrinter = new PrettyPrinter(output) + def apply(output: String => Unit)(using Scope, InvalCtx): PrettyPrinter = new PrettyPrinter(output) type Bound = (Type, Type) // * Type <: Type diff --git a/hkmc2/shared/src/main/scala/hkmc2/bbml/TypeSimplifier.scala b/hkmc2/shared/src/main/scala/hkmc2/invalml/TypeSimplifier.scala similarity index 99% rename from hkmc2/shared/src/main/scala/hkmc2/bbml/TypeSimplifier.scala rename to hkmc2/shared/src/main/scala/hkmc2/invalml/TypeSimplifier.scala index 229f914766..405a02e79e 100644 --- a/hkmc2/shared/src/main/scala/hkmc2/bbml/TypeSimplifier.scala +++ b/hkmc2/shared/src/main/scala/hkmc2/invalml/TypeSimplifier.scala @@ -1,4 +1,4 @@ -package hkmc2.bbml +package hkmc2.invalml import scala.collection.mutable.{Map => MutMap, Set => MutSet, LinkedHashMap, LinkedHashSet} import scala.collection.immutable.{SortedMap, SortedSet} diff --git a/hkmc2/shared/src/main/scala/hkmc2/bbml/TypeTraverser.scala b/hkmc2/shared/src/main/scala/hkmc2/invalml/TypeTraverser.scala similarity index 97% rename from hkmc2/shared/src/main/scala/hkmc2/bbml/TypeTraverser.scala rename to hkmc2/shared/src/main/scala/hkmc2/invalml/TypeTraverser.scala index 02f1b14b92..bf9d90f19c 100644 --- a/hkmc2/shared/src/main/scala/hkmc2/bbml/TypeTraverser.scala +++ b/hkmc2/shared/src/main/scala/hkmc2/invalml/TypeTraverser.scala @@ -1,4 +1,4 @@ -package hkmc2.bbml +package hkmc2.invalml import mlscript.utils.*, shorthands.* diff --git a/hkmc2/shared/src/main/scala/hkmc2/bbml/types.scala b/hkmc2/shared/src/main/scala/hkmc2/invalml/types.scala similarity index 95% rename from hkmc2/shared/src/main/scala/hkmc2/bbml/types.scala rename to hkmc2/shared/src/main/scala/hkmc2/invalml/types.scala index a43eb94189..658d03375f 100644 --- a/hkmc2/shared/src/main/scala/hkmc2/bbml/types.scala +++ b/hkmc2/shared/src/main/scala/hkmc2/invalml/types.scala @@ -1,12 +1,12 @@ package hkmc2 -package bbml +package invalml import mlscript.utils.*, shorthands.* import syntax.* import semantics.*, semantics.Term.* import utils.* import scala.collection.mutable.{Set => MutSet} -import utils.Scope +import utils.Scope, Scope.scope import Elaborator.State // * General types include mono types (i.e., Type), forall quantified type, and poly function types @@ -23,14 +23,14 @@ sealed abstract class GeneralType: protected type ThisType <: GeneralType def map(f: ThisType => ThisType): ThisType def subst(using map: Map[Uid[InfVar], InfVar]): ThisType - def show(using Scope): Str + def show(using Scope, InvalCtx): Str def showDbg: Str // * Types that can be used as class type arguments sealed trait TypeArg: def lvl: Int def mapArg(f: Type => Type): TypeArg - def show(using Scope): Str + def show(using Scope, InvalCtx): Str def showDbg: Str def & (that: TypeArg): TypeArg = (this, that) match case (Wildcard(in1, out1), Wildcard(in2, out2)) => Wildcard(in1 | in2, out1 & out2) @@ -52,7 +52,7 @@ sealed trait TypeArg: case class Wildcard(in: Type, out: Type) extends TypeArg { def mapArg(f: Type => Type): Wildcard = Wildcard(f(in), f(out)) - override def show(using Scope): Str = in match + override def show(using Scope, InvalCtx): Str = in match case `out` => in.show case Bot => out match @@ -130,11 +130,11 @@ sealed abstract class Type extends GeneralType with TypeArg: case ComposedType(l, r, false) => l.! | r.! case _ => NegType(this) - protected[bbml] def paren(using Scope): Str = toBasic match + protected[invalml] def paren(using Scope, InvalCtx): Str = toBasic match case _: InfVar | _: ClassLikeType | _: NegType | Top | Bot => show case _: ComposedType | _: FunType => s"($show)" - protected[bbml] def parenDbg: Str = toBasic match + protected[invalml] def parenDbg: Str = toBasic match case _: InfVar | _: ClassLikeType | _: NegType | Top | Bot => showDbg case _: ComposedType | _: FunType => s"($showDbg)" @@ -158,12 +158,13 @@ sealed abstract class BasicType extends Type: case NegType(ty) => Type.mkNegType(f(ty)) case Top | Bot | _: InfVar => this - override def show(using scope: Scope): Str = + override def show(using Scope, InvalCtx): Str = def printEff(eff: Type) = eff match case Bot => "" // case ty if ty == allocSkolem => "" case _ => s"{${eff.show}}" this match + case ClassLikeType(sym, Nil) if sym is invalctx.getCls("Unit") => "()" case ClassLikeType(name, targs) => if targs.isEmpty then s"${name.nme}" else s"${name.nme}[${targs.map(_.show).mkString(", ")}]" case v @ InfVar(lvl, uid, _, isSkolem) => @@ -286,7 +287,7 @@ case class PolyType(tvs: Ls[InfVar], outer: Opt[InfVar], body: GeneralType) exte override lazy val isPoly: Bool = true override lazy val lvl: Int = (body :: tvs).map(_.lvl).max - override def show(using scope: Scope): Str = + override def show(using Scope, InvalCtx): Str = given Scope = scope.nest val lst = (outer match { case S(outer) => @@ -364,7 +365,7 @@ case class PolyFunType(args: Ls[GeneralType], ret: GeneralType, eff: Type) exten lazy val isPoly: Bool = (ret :: args).exists(_.isPoly) lazy val lvl: Int = (ret :: eff :: args).map(_.lvl).max - override def show(using Scope): Str = s"(${args.map(_.show).mkString(", ")}) ->{${eff.show}} ${ret.show}" + override def show(using Scope, InvalCtx): Str = s"(${args.map(_.show).mkString(", ")}) ->{${eff.show}} ${ret.show}" override def showDbg: Str = s"(${args.map(_.showDbg).mkString(", ")}) ->{${eff.showDbg}} ${ret.showDbg}" private lazy val mono: Opt[FunType] = if isPoly then N else Some(FunType(args.map { diff --git a/hkmc2/shared/src/main/scala/hkmc2/semantics/BlockImpl.scala b/hkmc2/shared/src/main/scala/hkmc2/semantics/BlockImpl.scala index fa5b15018e..14fec99aa9 100644 --- a/hkmc2/shared/src/main/scala/hkmc2/semantics/BlockImpl.scala +++ b/hkmc2/shared/src/main/scala/hkmc2/semantics/BlockImpl.scala @@ -19,14 +19,56 @@ trait BlockImpl(using Elaborator.State): case Constructor(Block(ctors)) => ctors case _ => Nil case _ => Nil + // A temp solution for ADTs, which desugars ADTs to normal class definitions. + // This will be removed after we truly support ADTs correctly. + // TODO: No raise contextual variable. Only `Error` nodes are returned if there is an error. + lazy val (headId, headPs) = td.baseHead match + case id: Ident => (id, Nil) + case App(id: Ident, TyTup(ps)) => (id, ps) + // Temporarily use `data` annotation to distinguish the following ctors: + // - Ctor(...) + // - Ctor[...](...) extends ADT[...] + // since the former will be desugared to `class Ctor[...](...) extends ADT[...]`, + // where `Ctor[...]` and `ADT[...]` share the same type parameter list + def wrapGeneric(decl: Tree, res: Tree) = decl match + case InfixApp(_, syntax.Keyword.`extends`, _) => + Annotated(Keywrd(syntax.Keyword.data), res) + case _ => res + // Generate `extends` suffix if it is not provided by users + // Also check if the number of type parameters is correct + def genExt(decl: Tree) = decl match + case InfixApp(_, syntax.Keyword.`extends`, ext) => ext match + case _: Ident if headPs.isEmpty => ext + case App(id: Ident, TyTup(ps)) if id.name == headId.name && ps.length == headPs.length => ext + case _ => Error() + case _ => headPs match + case Nil => headId + case ps => + App(headId, TyTup(ps.map { + case m @ Modified(syntax.Keyword.`in` | syntax.Keyword.`out`, _, _) => m + case t => Tup(Tree.Modified(syntax.Keyword.`in`, N, t) :: Tree.Modified(syntax.Keyword.`out`, N, t) :: Nil) + })) + // Insert type parameters for constructors. + // e.g. `class Foo[T] with constructor Bar(x: T)` will be desugared to + // `class Bar[T](x: T) extends Foo[T]` + // Otherwise, the elaborator will complain `T` is not defined. + def genCtorHead(decl: Tree) = decl match + case InfixApp(decl, syntax.Keyword.`extends`, _) => decl // check will be applied in genExt + case App(_: Ident, tup: TyTup) => Error() + case App(id: Ident, ps: Tup) => App(App(id, TyTup(headPs)), ps) + case id: Ident => App(id, TyTup(headPs)) + case _ => Error() + // Only fields modified by `val` can be extracted by pattern matching. + // For ADTs, all fields can be extracted, but we don't want to add `val`s manumally. + def insertVal(decl: Tree): Tree = decl match + case id: Ident => id + case App(f, Tup(ps)) => App(f, Tup(ps.map(p => TermDef(syntax.ImmutVal, p, N)))) + case App(f, tup: TyTup) => App(insertVal(f), tup) + case _ => Error() PossiblyAnnotated(anns, td) :: ( - ctors.map(head => PossiblyAnnotated(anns, TypeDef(syntax.Cls, - td.name match - case L(_) => head - case R(name) => - InfixApp(head, syntax.Keyword.`extends`, name) - , N - ))) + td.name match + case L(_) => Nil + case R(_) => ctors.map(head => PossiblyAnnotated(anns, wrapGeneric(head, TypeDef(syntax.Cls, InfixApp(insertVal(genCtorHead(head)), syntax.Keyword.`extends`, genExt(head)), N)))) ) ::: desug(stmts) case stmt :: stmts => stmt.desugared match diff --git a/hkmc2/shared/src/main/scala/hkmc2/semantics/Elaborator.scala b/hkmc2/shared/src/main/scala/hkmc2/semantics/Elaborator.scala index 00c94f3149..df7f3e9f27 100644 --- a/hkmc2/shared/src/main/scala/hkmc2/semantics/Elaborator.scala +++ b/hkmc2/shared/src/main/scala/hkmc2/semantics/Elaborator.scala @@ -675,6 +675,8 @@ extends Importer: case TypeDef(k, head, rhs) => raise(ErrorReport(msg"Illegal type declaration in term position." -> tree.toLoc :: Nil)) Term.Error + case Modified(Keyword.`in` | Keyword.`out`, kwLoc, body) => + subterm(body) case Modified(kw, kwLoc, body) => raise(ErrorReport(msg"Illegal position for '${kw.name}' modifier." -> kwLoc :: Nil)) subterm(body) @@ -1288,6 +1290,9 @@ extends Importer: val sym = VarSymbol(id) sym.decl = S(TyParam(FldFlags.empty, N, sym)) Param(FldFlags.empty, sym, N, Modulefulness.none) + case t => + raise(ErrorReport(msg"Unsupported type parameter ${t.describe}" -> t.toLoc :: Nil)) + Param(FldFlags.empty, VarSymbol(Ident("error")), N, Modulefulness.none) // FIXME: VarSymbol(Ident("error"))? (vs, ctx ++ vs.map(p => p.sym.name -> p.sym)) def importFrom(sts: Tree.Block)(using c: Ctx): (Blk, Ctx) = diff --git a/hkmc2/shared/src/main/scala/hkmc2/semantics/Pattern.scala b/hkmc2/shared/src/main/scala/hkmc2/semantics/Pattern.scala index f63de8f857..fc9980a720 100644 --- a/hkmc2/shared/src/main/scala/hkmc2/semantics/Pattern.scala +++ b/hkmc2/shared/src/main/scala/hkmc2/semantics/Pattern.scala @@ -68,6 +68,11 @@ object Pattern: */ type Argument = (scrutinee: BlockLocalSymbol, pattern: Tree, split: Opt[DeBrujinSplit]) + /** A class-like pattern whose symbol is resolved to a class or a module. */ + object ResolvedClassOrModule: + def unapply(p: Pattern.ClassLike): Opt[(ClassSymbol | ModuleSymbol, Opt[Ls[Argument]])] = + p.constructor.symbol.flatMap(_.asClsOrMod).map(_ -> p.arguments) + /** A class-like pattern whose symbol is resolved to a class. */ object Class: def unapply(p: Pattern): Opt[ClassSymbol] = p match diff --git a/hkmc2/shared/src/test/mlscript/basics/ADTs.mls b/hkmc2/shared/src/test/mlscript/basics/ADTs.mls index 76d15f75ff..8cbc83bf54 100644 --- a/hkmc2/shared/src/test/mlscript/basics/ADTs.mls +++ b/hkmc2/shared/src/test/mlscript/basics/ADTs.mls @@ -15,12 +15,8 @@ class Expr[A] with constructor Lit(n: Int) { A = Int } Add(lhs: Expr[Int], rhs: Expr[Int]) { A = Int } -//│ ╔══[ERROR] Expected a valid class definition head; found block instead -//│ ║ l.16: Lit(n: Int) { A = Int } -//│ ╙── ^^^^^^^^^^^ -//│ ╔══[ERROR] Expected a valid class definition head; found block instead -//│ ║ l.17: Add(lhs: Expr[Int], rhs: Expr[Int]) { A = Int } -//│ ╙── ^^^^^^^^^^^ +//│ ═══[ERROR] Expected a valid class definition head; found ‹erroneous syntax› instead +//│ ═══[ERROR] Expected a valid class definition head; found ‹erroneous syntax› instead // * one can also go the TypeScript way @@ -37,7 +33,7 @@ enum Expr = | Lit(n: Int) | Add(lhs: Expr, rhs: Expr) //│ ╔══[ERROR] Unrecognized definitional assignment left-hand side: juxtaposition -//│ ║ l.36: enum Expr = +//│ ║ l.32: enum Expr = //│ ╙── ^^^^^^^^^ diff --git a/hkmc2/shared/src/test/mlscript/bbml/bbDisjoint.mls b/hkmc2/shared/src/test/mlscript/bbml/bbDisjoint.mls deleted file mode 100644 index aa061cb495..0000000000 --- a/hkmc2/shared/src/test/mlscript/bbml/bbDisjoint.mls +++ /dev/null @@ -1,313 +0,0 @@ -:bbml -//│ Type: ⊤ - -//│ Type: ⊤ - - -data class Pair[P, Q](fst: P, snd: Q) -//│ Type: ⊤ - -fun fork: [A, B extends ~A, T1, T2] -> (Any ->{A} T1, Any ->{B} T2) ->{A | B} Pair[out T1, out T2] -fork -//│ Type: ['A, 'B, 'T1, 'T2] -> ((⊤) ->{'A} 'T1, (⊤) ->{'B} 'T2) ->{'A ∨ 'B} Pair[out 'T1, out 'T2] -//│ Where: -//│ 'B <: ¬'A - - -fun foo: Any -> Int -fun bar: Any -> Str -//│ Type: ⊤ - - -fork(foo, bar) -//│ Type: Pair[out Int, out Str] - - -:e -region x in - fork((_ => x.ref 1), (_ => x.ref 2)) -//│ ╔══[ERROR] Type error in function literal with expected type (⊤) ->{'B} 'T2 -//│ ║ l.28: fork((_ => x.ref 1), (_ => x.ref 2)) -//│ ║ ^^^^^^^ -//│ ╟── because: cannot constrain 'reg <: 'B -//│ ╟── because: cannot constrain 'reg <: 'B -//│ ╟── because: cannot constrain x <: 'B -//│ ╟── because: cannot constrain x <: 'B -//│ ╟── because: cannot constrain x <: ¬'A -//│ ╟── because: cannot constrain 'A <: ¬x -//│ ╙── because: cannot constrain x <: ¬x -//│ Type: Pair[out Ref[Int, ?], out Ref[Int, ?]] - - - -region x in - region y in - fork((_ => x.ref 1), (_ => y.ref 2)) -//│ Type: Pair[out Ref[Int, ?], out Ref[Int, ?]] - - -let naive_helper = r1 => // cannot infer the outer variable! - region r2 in - fork((_ => r1.ref 1), (_ => r2.ref 2)) -naive_helper -//│ Type: (Region[in 'reg out 'reg1]) ->{'reg1} Pair[out Ref[Int, out 'reg1], out Ref[Int, ?]] -//│ Where: -//│ 'reg1 <: ⊥ -//│ 'reg1 <: 'reg - - -:e -region x in - naive_helper(x) -//│ ╔══[ERROR] Type error in reference with expected type 'r1 -//│ ║ l.61: naive_helper(x) -//│ ║ ^ -//│ ╟── because: cannot constrain Region[x] <: 'r1 -//│ ╟── because: cannot constrain Region[in 'x1 out 'x2] <: 'r1 -//│ ╟── because: cannot constrain Region[in 'x1 out 'x2] <: Region[in 'reg out 'reg1] -//│ ╟── because: cannot constrain 'x2 <: 'reg1 -//│ ╟── because: cannot constrain 'x2 <: 'reg1 -//│ ╟── because: cannot constrain ⊤ <: 'reg1 -//│ ╟── because: cannot constrain ⊤ <: 'reg1 -//│ ╙── because: cannot constrain ⊤ <: ⊥ -//│ ╔══[ERROR] Type error in reference with expected type 'r1 -//│ ║ l.61: naive_helper(x) -//│ ║ ^ -//│ ╟── because: cannot constrain Region[x] <: 'r1 -//│ ╟── because: cannot constrain Region[in 'x1 out 'x2] <: 'r1 -//│ ╟── because: cannot constrain Region[in 'x1 out 'x2] <: Region[in 'reg out 'reg1] -//│ ╟── because: cannot constrain 'x2 <: 'reg1 -//│ ╟── because: cannot constrain 'x2 <: 'reg1 -//│ ╟── because: cannot constrain ⊤ <: 'reg1 -//│ ╟── because: cannot constrain ⊤ <: 'reg1 -//│ ╟── because: cannot constrain ⊤ <: 'reg -//│ ╟── because: cannot constrain ⊤ <: 'reg -//│ ╙── because: cannot constrain ⊤ <: ⊥ -//│ ╔══[ERROR] Type error in block -//│ ║ l.61: naive_helper(x) -//│ ║ ^^^^^^^^^^^^^^^ -//│ ╟── because: cannot constrain 'eff <: ⊥ -//│ ╟── because: cannot constrain 'eff <: ⊥ -//│ ╟── because: cannot constrain ¬'x3 ∧ 'eff1 <: ⊥ -//│ ╟── because: cannot constrain 'eff1 <: 'x3 -//│ ╟── because: cannot constrain 'eff1 <: ⊥ -//│ ╟── because: cannot constrain 'eff1 <: ⊥ -//│ ╟── because: cannot constrain 'reg1 <: ⊥ -//│ ╟── because: cannot constrain 'reg1 <: ⊥ -//│ ╙── because: cannot constrain ⊤ <: ⊥ -//│ Type: Pair[out Ref[Int, ?], out Ref[Int, ?]] - - -fun helper(r1) = - region r2 in - fork((_ => r1.ref 1), (_ => r2.ref 2)) -helper -//│ Type: [outer, 'reg, 'reg1] -> Region[in 'reg out 'reg1] ->{'reg1} Pair[out Ref[Int, out 'reg1], out Ref[Int, out ¬outer]] -//│ Where: -//│ 'reg <: outer -//│ 'reg <: 'reg1 - - -region x in - helper(x) -//│ Type: Pair[out Ref[Int, ?], out Ref[Int, ?]] - - -region x in - (region y in let t = helper(y) in 42) as [A] -> Int -//│ Type: Int - - -region x in - region y in - let t = helper(x) in 42 -//│ Type: Int - - -:e -region x in - (region y in let t = helper(x) in 42) as [A] -> Int -//│ ╔══[ERROR] Type error in reference with expected type 'r1 -//│ ║ l.129: (region y in let t = helper(x) in 42) as [A] -> Int -//│ ║ ^ -//│ ╟── because: cannot constrain Region[x] <: 'r1 -//│ ╟── because: cannot constrain Region[x] <: 'r1 -//│ ╟── because: cannot constrain Region[x] <: Region[in 'reg out 'reg1] -//│ ╟── because: cannot constrain x <: 'reg1 -//│ ╟── because: cannot constrain x <: 'reg1 -//│ ╟── because: cannot constrain x <: 'env -//│ ╟── because: cannot constrain x <: 'env -//│ ╙── because: cannot constrain x <: outer ∨ y -//│ ╔══[ERROR] Type error in region expression with expected type [outer, 'A] -> Int -//│ ║ l.129: (region y in let t = helper(x) in 42) as [A] -> Int -//│ ║ ^^^^^^^^^^^^^^^ -//│ ╟── because: cannot constrain 'eff <: ⊥ -//│ ╟── because: cannot constrain 'eff <: ⊥ -//│ ╟── because: cannot constrain ¬'y1 ∧ x <: ⊥ -//│ ╟── because: cannot constrain x <: 'y1 -//│ ╙── because: cannot constrain x <: ⊥ -//│ Type: Int - - -fun anno: [outer A] -> Int ->{A} Int -//│ Type: ⊤ - - -fun anno2: [outer] -> Int ->{outer} Int -//│ Type: ⊤ - - -:e -fun badanno: outer -//│ ═══[ERROR] Illegal outer reference. -//│ ═══[ERROR] Invalid type -//│ Type: ⊤ - -:e -fun badanno2: [outer A, outer B] -> Int ->{A | B} Int -//│ ╔══[ERROR] Only one outer variable can be bound. -//│ ║ l.167: fun badanno2: [outer A, outer B] -> Int ->{A | B} Int -//│ ╙── ^^^^^^^^^^^^^^^^^^ -//│ ╔══[ERROR] Illegal forall annotation. -//│ ║ l.167: fun badanno2: [outer A, outer B] -> Int ->{A | B} Int -//│ ╙── ^^^^^^^^^^^^^^^^^^ -//│ ═══[ERROR] Invalid type -//│ Type: ⊤ - - -fun annohelper: [outer, T extends outer] -> Region[T] ->{T} Pair[out Ref[Int, out T], out Ref[Int, out ~outer]] -fun annohelper(r1) = - region r2 in - fork((_ => r1.ref 1), (_ => r2.ref 2)) -annohelper -//│ Type: [outer, 'T] -> (Region['T]) ->{'T} Pair[out Ref[Int, out 'T], out Ref[Int, out ¬outer]] -//│ Where: -//│ 'T <: outer - - -region x in - annohelper(x) -//│ Type: Pair[out Ref[Int, ?], out Ref[Int, ?]] - - -fun annohelper: [outer, T] -> Region[T & outer] ->{T & outer} Pair[out Ref[Int, out T & outer], out Ref[Int, out ~outer]] -fun annohelper(r1) = - region r2 in - fork((_ => r1.ref 1), (_ => r2.ref 2)) -annohelper -//│ Type: [outer, 'T] -> (Region['T ∧ outer]) ->{'T ∧ outer} Pair[out Ref[Int, out 'T ∧ outer], out Ref[Int, out ¬outer]] - - -region x in - annohelper(x) -//│ Type: Pair[out Ref[Int, out 'env], out Ref[Int, ?]] -//│ Where: -//│ ⊤ <: 'env - - -// Cannot type check since foo: 'foo <: Region[T] ->{'eff} 'app -// Annotation is required for recursive calls -:e -fun foo(r1) = - region r2 in - fork((_ => r1.ref 1), (_ => r2.ref 2)) - foo(r2) -//│ ╔══[ERROR] Type error in function literal -//│ ║ l.211: fun foo(r1) = -//│ ║ ^^^^^ -//│ ║ l.212: region r2 in -//│ ║ ^^^^^^^^^^^^^^ -//│ ║ l.213: fork((_ => r1.ref 1), (_ => r2.ref 2)) -//│ ║ ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ -//│ ║ l.214: foo(r2) -//│ ║ ^^^^^^^^^^^ -//│ ╟── because: cannot constrain ('r1) ->{'eff} ('app) <: 'foo -//│ ╟── because: cannot constrain ('r1) ->{'eff} ('app) <: 'foo -//│ ╟── because: cannot constrain ('r1) ->{'eff} ('app) <: (Region[in 'r2 out 'r21]) ->{'eff1} ('app1) -//│ ╟── because: cannot constrain Region[in 'r2 out 'r21] <: 'r1 -//│ ╟── because: cannot constrain Region[in 'r2 out 'r21] <: 'r1 -//│ ╟── because: cannot constrain Region[in 'r2 out 'r21] <: Region[in 'reg out 'reg1] -//│ ╟── because: cannot constrain 'r21 <: 'reg1 -//│ ╟── because: cannot constrain 'r21 <: 'reg1 -//│ ╟── because: cannot constrain ¬outer <: 'reg1 -//│ ╟── because: cannot constrain ¬outer <: 'reg1 -//│ ╟── because: cannot constrain ¬outer <: ¬'r22 ∨ outer -//│ ╟── because: cannot constrain 'r22 <: outer -//│ ╙── because: cannot constrain ¬outer <: outer -//│ ╔══[ERROR] Type error in function literal -//│ ║ l.211: fun foo(r1) = -//│ ║ ^^^^^ -//│ ║ l.212: region r2 in -//│ ║ ^^^^^^^^^^^^^^ -//│ ║ l.213: fork((_ => r1.ref 1), (_ => r2.ref 2)) -//│ ║ ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ -//│ ║ l.214: foo(r2) -//│ ║ ^^^^^^^^^^^ -//│ ╟── because: cannot constrain ('r1) ->{'eff} ('app) <: 'foo -//│ ╟── because: cannot constrain ('r1) ->{'eff} ('app) <: 'foo -//│ ╟── because: cannot constrain ('r1) ->{'eff} ('app) <: (Region[in 'r2 out 'r21]) ->{'eff1} ('app1) -//│ ╟── because: cannot constrain Region[in 'r2 out 'r21] <: 'r1 -//│ ╟── because: cannot constrain Region[in 'r2 out 'r21] <: 'r1 -//│ ╟── because: cannot constrain Region[in 'r2 out 'r21] <: Region[in 'reg out 'reg1] -//│ ╟── because: cannot constrain 'r21 <: 'reg1 -//│ ╟── because: cannot constrain 'r21 <: 'reg1 -//│ ╟── because: cannot constrain ¬outer <: 'reg1 -//│ ╟── because: cannot constrain ¬outer <: 'reg1 -//│ ╟── because: cannot constrain ¬outer <: 'reg -//│ ╟── because: cannot constrain ¬outer <: 'reg -//│ ╙── because: cannot constrain ¬outer <: ⊥ -//│ Type: ⊤ - - -fun foo: [outer S, T extends S] -> Region[T] ->{T} Nothing -fun foo(r1) = - region r2 in - foo(r2) -foo -//│ Type: [outer S, 'T] -> (Region['T]) ->{'T} ⊥ -//│ Where: -//│ 'T <: S - - -fun foo: [outer To, T extends To] -> Region[T] ->{T} ([outer So, S extends So] -> Region[S]->{S} Pair[out Ref[Int, out S], out Ref[Int, out Any]]) -fun foo(r1) = - r3 => - region r4 in - fork((_ => r3.ref 3), (_ => r4.ref 4)) -//│ Type: ⊤ - - -fun bar: [outer S, T extends S] -> Region[T] ->{T} Int -//│ Type: ⊤ - - -bar as [outer Q, P extends Q] -> Region[P] ->{P} Int -//│ Type: [outer Q, 'P] -> (Region['P]) ->{'P} Int -//│ Where: -//│ 'P <: Q - - -fun foo: [outer To, T extends To] -> Region[T] ->{T} ([outer So, S extends So] -> Region[S]->{S} Int) -fun foo(r1) = bar -foo -//│ Type: [outer To, 'T] -> (Region['T]) ->{'T} [outer So, 'S] -> (Region['S]) ->{'S} Int -//│ Where: -//│ 'T <: To -//│ 'S <: So - - -fun borrow: [S, T, E extends ~S] -> Region[S] -> (Region[S] ->{E} T) ->{E} T -//│ Type: ⊤ - - -fun foo(f) = - region r in - let x = r.ref 0 - f(n => x := n) - borrow(r) of it => - foo(f) -foo -//│ Type: [outer, 'n, 'eff] -> (('n ->{¬outer} ('n ∨ Int)) ->{'eff} ⊤) ->{'eff} ⊥ -//│ Where: -//│ 'n <: Int -//│ 'eff <: outer diff --git a/hkmc2/shared/src/test/mlscript/bbml/bbList.mls b/hkmc2/shared/src/test/mlscript/bbml/bbList.mls deleted file mode 100644 index 1074f179e8..0000000000 --- a/hkmc2/shared/src/test/mlscript/bbml/bbList.mls +++ /dev/null @@ -1,108 +0,0 @@ -:bbml -//│ Type: ⊤ - -//│ Type: ⊤ - - -data class List[A](inspect: [E, Res] -> (() ->{E} Res, (A, List[A]) ->{E} Res) ->{E} Res) -//│ Type: ⊤ - -fun map: [A, B, E] -> List[out A] -> (A ->{E} B) ->{E} List[out B] -//│ Type: ⊤ - - -// * Dummy implementation -fun mapi: [A, E] -> List[out A] -> ((Int, A) ->{E} A) ->{E} List[out A] -fun mapi = s => f => - region r in - map(s) of x => f(0, x) -//│ Type: ⊤ - -fun mapi: [A, E] -> List[out A] -> ((Int, A) ->{E} A) ->{E} List[out A] -fun mapi = s => f => - region r in - let i = r.ref 0 - map(s) of x => - i := !i + 1 - f(!i, x) -//│ Type: ⊤ - -// * Example usage - -fun mkList: [A] -> A -> List[out A] -fun head: [A] -> List[out A] -> A -//│ Type: ⊤ - -region r in - let sum = r.ref 0 - let s1 = mkList of !sum - let s2 = mapi(s1) of (x, i) => x * i - !sum + head(s2) -//│ Type: Int - - -// * Should be an error. This definition would not be referentially transparent. -// * The error message needs improvement, though. -:e -fun mapi: [A, E] -> List[out A] -> ((Int, A) ->{E} A) ->{E} List[out A] -fun mapi = s => - region r in - let i = r.ref 0 - f => map(s) of x => - i := !i + 1 - f(!i, x) -//│ ╔══[ERROR] Type error in region expression with expected type ((Int, A) ->{E} A) ->{E} List[out A] -//│ ║ l.50: let i = r.ref 0 -//│ ║ ^^^^^^^ -//│ ║ l.51: f => map(s) of x => -//│ ║ ^^^^^^^^^^^^^^^^^^^^^^^ -//│ ║ l.52: i := !i + 1 -//│ ║ ^^^^^^^^^^^^^^^^^ -//│ ║ l.53: f(!i, x) -//│ ║ ^^^^^^^^^^^^^^ -//│ ╟── because: cannot constrain ('f) ->{'E1} (List[in ⊥ out 'B]) <: ((Int, A) ->{E} (A)) ->{E} (List[in ⊥ out A]) -//│ ╟── because: cannot constrain 'E1 <: E -//│ ╟── because: cannot constrain 'E1 <: E -//│ ╟── because: cannot constrain 'reg <: E -//│ ╟── because: cannot constrain 'reg <: E -//│ ╟── because: cannot constrain 'r ∧ ¬outer <: E -//│ ╟── because: cannot constrain 'r <: E ∨ outer -//│ ╙── because: cannot constrain ¬outer <: E ∨ outer -//│ ╔══[ERROR] Type error in region expression with expected type ((Int, A) ->{E} A) ->{E} List[out A] -//│ ║ l.50: let i = r.ref 0 -//│ ║ ^^^^^^^ -//│ ║ l.51: f => map(s) of x => -//│ ║ ^^^^^^^^^^^^^^^^^^^^^^^ -//│ ║ l.52: i := !i + 1 -//│ ║ ^^^^^^^^^^^^^^^^^ -//│ ║ l.53: f(!i, x) -//│ ║ ^^^^^^^^^^^^^^ -//│ ╟── because: cannot constrain ('f) ->{'E1} (List[in ⊥ out 'B]) <: ((Int, A) ->{E} (A)) ->{E} (List[in ⊥ out A]) -//│ ╟── because: cannot constrain 'E1 <: E -//│ ╟── because: cannot constrain 'E1 <: E -//│ ╟── because: cannot constrain 'reg <: E -//│ ╟── because: cannot constrain 'reg <: E -//│ ╟── because: cannot constrain 'r ∧ ¬outer <: E -//│ ╟── because: cannot constrain 'r <: E ∨ outer -//│ ╙── because: cannot constrain ¬outer <: E ∨ outer -//│ ╔══[ERROR] Type error in region expression with expected type ((Int, A) ->{E} A) ->{E} List[out A] -//│ ║ l.50: let i = r.ref 0 -//│ ║ ^^^^^^^ -//│ ║ l.51: f => map(s) of x => -//│ ║ ^^^^^^^^^^^^^^^^^^^^^^^ -//│ ║ l.52: i := !i + 1 -//│ ║ ^^^^^^^^^^^^^^^^^ -//│ ║ l.53: f(!i, x) -//│ ║ ^^^^^^^^^^^^^^ -//│ ╟── because: cannot constrain ('f) ->{'E1} (List[in ⊥ out 'B]) <: ((Int, A) ->{E} (A)) ->{E} (List[in ⊥ out A]) -//│ ╟── because: cannot constrain 'E1 <: E -//│ ╟── because: cannot constrain 'E1 <: E -//│ ╟── because: cannot constrain 'reg <: E -//│ ╟── because: cannot constrain 'reg <: E -//│ ╟── because: cannot constrain 'r ∧ ¬outer <: E -//│ ╟── because: cannot constrain 'r <: E ∨ outer -//│ ╙── because: cannot constrain ¬outer <: E ∨ outer -//│ Type: ⊤ - - - diff --git a/hkmc2/shared/src/test/mlscript/bbml/bbScratch.mls b/hkmc2/shared/src/test/mlscript/bbml/bbScratch.mls deleted file mode 100644 index 69915a701e..0000000000 --- a/hkmc2/shared/src/test/mlscript/bbml/bbScratch.mls +++ /dev/null @@ -1,14 +0,0 @@ -:bbml -//│ Type: ⊤ - -//│ Type: ⊤ - -// :d -let i = 1 -//│ Type: ⊤ - -let i = 1 -i -//│ Type: Int - - diff --git a/hkmc2/shared/src/test/mlscript/invalml/invalADT.mls b/hkmc2/shared/src/test/mlscript/invalml/invalADT.mls new file mode 100644 index 0000000000..8313224106 --- /dev/null +++ b/hkmc2/shared/src/test/mlscript/invalml/invalADT.mls @@ -0,0 +1,353 @@ +:invalml + + + +class IntList with + constructor + Nil + Cons(x: Int, xs: IntList) + +Nil +//│ Type: IntList + +Cons(1, Cons(2, Cons(3, Nil))) +//│ Type: IntList + + +:e +class Foo with + constructor + Bar(x) +//│ ╔══[ERROR] Invalid ADT parameter. +//│ ║ l.20: Bar(x) +//│ ╙── ^ + + +:e +Nil(1) +//│ ╔══[ERROR] Type error in application +//│ ║ l.27: Nil(1) +//│ ║ ^^^^^^ +//│ ╙── because: cannot constrain IntList <: (Int) ->{'eff} ('app) +//│ Type: ⊥ + +:e +Nil() +//│ ╔══[ERROR] Type error in application +//│ ║ l.35: Nil() +//│ ║ ^^^^^ +//│ ╙── because: cannot constrain IntList <: () ->{'eff} ('app) +//│ Type: ⊥ + + +:e +Cons("1", Nil) +//│ ╔══[ERROR] Type error in string literal with expected type Int +//│ ║ l.44: Cons("1", Nil) +//│ ║ ^^^ +//│ ╙── because: cannot constrain Str <: Int +//│ Type: IntList + + +class Option[T] with + constructor + None + Some(x: T) + + +None +//│ Type: Option[in ⊤ out ⊥] + +Some(42) +//│ Type: Option[in ⊤ out Int] + +Some(false) +//│ Type: Option[in ⊤ out Bool] + + +class Fun[T, S] with + constructor + Pure(f: T -> S) + + +Pure(x => x + 1) +//│ Type: Fun[in Int out ⊥, in ⊤ out Int] + + +class Value[T] with + constructor + IntVal(x: Int) extends Value[out Int] + BoolVal(x: Bool) extends Value[out Bool] + +IntVal(42) +//│ Type: Value[out Int] + +BoolVal(false) +//│ Type: Value[out Bool] + +:e +IntVal("1") +//│ ╔══[ERROR] Type error in string literal with expected type Int +//│ ║ l.89: IntVal("1") +//│ ║ ^^^ +//│ ╙── because: cannot constrain Str <: Int +//│ Type: Value[out Int] + +class Expr[T] with + constructor + Lit[S](x: S) extends Expr[out S] + Var[S](nme: Str) extends Expr[out S] + Add(lhs: Expr[out Int], rhs: Expr[out Int]) extends Expr[out Int] + Lam[U, V](f: Expr[out U] -> Expr[out V]) extends Expr[out U -> V] + App[U, V](f: Expr[out U -> V], a: Expr[out U]) extends Expr[out V] + +let a = Lit(42) +a +//│ Type: Expr[out Int] + +let f = Lam(x => Add(x, Lit(1))) +f +//│ Type: Expr[out Int -> Int] + +:e +Lam(42) +//│ ╔══[ERROR] Type error in integer literal with expected type (Expr[out 'U]) ->{⊥} Expr[out 'V] +//│ ║ l.113: Lam(42) +//│ ║ ^^ +//│ ╙── because: cannot constrain Int <: (Expr[in ⊥ out 'U]) ->{⊥} (Expr[in ⊥ out 'V]) +//│ Type: Expr[out ⊤ -> ⊥] + +App(f, a) +//│ Type: Expr[out Int] + + +let b = Lit(true) +b +//│ Type: Expr[out Bool] + +:e +App(f, b) +//│ ╔══[ERROR] Type error in reference with expected type Expr[out 'U] +//│ ║ l.129: App(f, b) +//│ ║ ^ +//│ ╟── because: cannot constrain Expr[in ⊥ out 'S] <: Expr[in ⊥ out 'U] +//│ ╟── because: cannot constrain 'S <: 'U +//│ ╟── because: cannot constrain 'S <: 'U1 +//│ ╟── because: cannot constrain Bool <: 'U1 +//│ ╙── because: cannot constrain Bool <: Int +//│ Type: Expr[out Int] + + +fun sum(xs) = + if xs is + Nil then 0 + Cons(x, xs) then x + sum(xs) +sum +//│ Type: IntList -> Int + + +sum(Cons(1, Cons(2, Cons(3, Cons(4, Nil))))) +//│ Type: Int + + +:e +fun badSum(xs) = + if xs is + Cons(x, xs) then x + badSum(xs) +//│ ╔══[ERROR] Expect 2 cases, but 1 got. +//│ ║ l.156: Cons(x, xs) then x + badSum(xs) +//│ ╙── ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ + +:e +fun badSum(xs) = + if xs is + Cons(x, xs) then x + badSum(xs) + Cons(x, xs) then x + badSum(xs) +//│ ╔══[ERROR] Duplicate match branches. +//│ ║ l.164: Cons(x, xs) then x + badSum(xs) +//│ ║ ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ +//│ ║ l.165: Cons(x, xs) then x + badSum(xs) +//│ ╙── ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ +//│ ╔══[ERROR] Expect 2 cases, but 1 got. +//│ ║ l.164: Cons(x, xs) then x + badSum(xs) +//│ ║ ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ +//│ ║ l.165: Cons(x, xs) then x + badSum(xs) +//│ ╙── ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ + + +fun getOrElse(m, d) = + if m is + Some(x) then x + None then d +getOrElse +//│ Type: ['d, 'Some] -> (Option[?] ∧ Option[out 'Some], 'd) -> ('Some ∨ 'd) + + +getOrElse(Some(42), 0) +//│ Type: Int + +getOrElse(None, false) +//│ Type: Bool + +getOrElse(Some(42), "42") +//│ Type: Int ∨ Str + + +if IntVal(1) is + IntVal(x) then 1 + BoolVal(x) then 0 +//│ Type: Int + + +fun toBool(v) = + if v is + IntVal(x) then x > 0 + BoolVal(x) then x +toBool +//│ Type: Value[?] -> Bool + +toBool(IntVal(1)) +//│ Type: Bool + + +class MyMap[K, V] with + constructor + Empty + Pair(k: K, v: V, rest: MyMap[out K, out V]) + +fun newMap(k, v) = Pair(k, v, Empty) +newMap +//│ Type: ['k, 'v] -> ('k, 'v) -> MyMap[in ⊤ out 'k, in ⊤ out 'v] + +fun insert(m, k, v) = Pair(k, v, m) +insert +//│ Type: ['k, 'v, 'K, 'V] -> (MyMap[out 'K, out 'V], 'k, 'v) -> MyMap[in ⊤ out 'K, in ⊤ out 'V] +//│ Where: +//│ 'k <: 'K +//│ 'v <: 'V + + +fun getOrElse: [K, V] -> (MyMap[out K, out V], K, V) -> V +fun getOrElse(m, k, d) = + if m is + Empty then d + Pair(k', v, r) then (if k == k' then v else getOrElse(r, k, d)) + +let incMap1 = newMap(1, 2) +incMap1 +//│ Type: MyMap[in ⊤ out Int, in ⊤ out Int] + +let incMap2 = insert(incMap1, 2, 3) +incMap2 +//│ Type: MyMap[in ⊤ out Int, in ⊤ out Int] + +getOrElse(incMap2, 3, 4) +//│ Type: Int + + +fun toString: Any -> Str + +fun concat: (Str, Str) -> Str + +fun print: [T] -> Expr[out T] -> Str +fun print(e) = + if e is + Lit(x) then toString(x) + Var(nme) then nme + Add(lhs, rhs) then concat(print(lhs), concat(" + ", print(rhs))) + Lam(f) then + let v = Var("arg") in concat(print(v), concat(" => ", print(f(v)))) + App(f, a) then concat(print(f), concat(" ", print(a))) + +let p = Lam(x => Add(x, Lit(1))) +p +//│ Type: Expr[out Int -> Int] + +let a = App(p, Lit(2)) +a +//│ Type: Expr[out Int] + +print(p) +print(a) +//│ Type: Str + + +:e +fun foo(x) = + if x is + Some(x) then 1 + None then 0 + 42 then 42 +//│ ╔══[ERROR] Mixing ADT pattern matching and general matching is not supported yet. +//│ ║ l.280: 42 then 42 +//│ ╙── ^^^^^^^^^^ +//│ ═══[ERROR] Variable not found: param0 + + +fun foo(x) = + if x is + Some(x) then x + else 0 + + +class List[out T] with + constructor + Nil + Cons(x: T, xs: List[T]) + + +Cons(42, Nil) +//│ Type: List[out Int] + + +fun foo: [T] -> T -> List[T] +foo +//│ Type: ['T] -> ('T) ->{⊥} List[out 'T] + + +class Bar[in T] with + constructor + B(f: T -> Int) + + +B(x => x + 1) +//│ Type: Bar[in Int] + + +fun bar: [T] -> (T, Bar[T]) -> Int +bar +//│ Type: ['T] -> ('T, Bar[in 'T]) ->{⊥} Int + + +class Option[out T] with + constructor + None + Some(x: T) + + +fun headOpt(xs) = if xs is + Nil then None + Cons(x, xs) then Some(x) +headOpt +//│ Type: ['Cons] -> (List[out 'Cons] ∧ List[?]) -> (Option[⊥] ∨ Option[out 'Cons]) + + +headOpt(Nil) +//│ Type: Option[⊥] + +headOpt(Cons(42, Nil)) +//│ Type: Option[⊥] ∨ Option[out Int] + + +fun getOrElse(v, d) = if v is + Some(x) then x + else d +getOrElse +//│ Type: ['d, 'Some] -> (Option[out 'Some], 'd) -> ('Some ∨ 'd) + + +getOrElse(headOpt(Nil), "foo") +//│ Type: Str + +getOrElse(headOpt(Cons(42, Nil)), 1) +//│ Type: Int diff --git a/hkmc2/shared/src/test/mlscript/invalml/invalAuthorResponse.mls b/hkmc2/shared/src/test/mlscript/invalml/invalAuthorResponse.mls new file mode 100644 index 0000000000..bb9ce292a3 --- /dev/null +++ b/hkmc2/shared/src/test/mlscript/invalml/invalAuthorResponse.mls @@ -0,0 +1,176 @@ +:invalml + + + + +fun wield: [R] -> (Region[out R]) ->{R} () +fun freeze: [R, E extends ~R, T] -> (Region[out R], () ->{~R & E} T) ->{R | E} T + +fun (;) seq(_, res) = res +fun rand: () -> Bool +fun print: Any -> () + + + +// ### Example 1 + + +fun foo1(r1, r2) = + freeze(r1, () => print("ok")) + wield(r2) + +region r in + foo1(r, r) + +region r in + region s in + foo1(r, s) + + +region r0 in + + fun foo1(r1, r2) = + freeze(r1, () => wield(r0)) + wield(r2) + + region r in + foo1(r, r) + + region r in + region s in + foo1(r, s) + + + +fun foo2(r1, r2) = + freeze(r1, () => wield(r2)) + wield(r2) + +:e +region r in + foo2(r, r) +//│ ╔══[ERROR] Type error in reference with expected type 'r2 +//│ ║ l.51: foo2(r, r) +//│ ║ ^ +//│ ╟── because: cannot constrain Region[in ⊥ out r] <: 'r2 +//│ ╟── because: cannot constrain Region[in ⊥ out r] <: Region[in ⊥ out 'R] +//│ ╟── because: cannot constrain r <: 'R +//│ ╟── because: cannot constrain r <: 'E +//│ ╟── because: cannot constrain r <: ¬'R1 +//│ ╟── because: cannot constrain 'R1 <: ¬r +//│ ╙── because: cannot constrain r <: ¬r + +region r in + region s in + foo2(r, s) + + + +// ### Example 2 + + +fun foo: [outer, R extends outer] -> Region[R] ->{outer} () +fun foo(r1) = + region r2 in + freeze(r2, () => + wield(r1) + ) +foo +//│ Type: [outer, 'R] -> (Region['R]) ->{outer} () +//│ Where: +//│ 'R <: outer + +fun foo': [outer] -> Region[outer] ->{outer} () +fun foo'(r) = foo(r) + +fun foo: [outer] -> Region[outer] ->{outer} () +fun foo(r1) = + region r2 in + freeze(r2, () => + wield(r1) + ) +foo +//│ Type: [outer] -> (Region[outer]) ->{outer} () + +fun foo: [outer, R extends outer] -> Region[R] ->{outer} () +fun foo'(r) = foo(r) + + +// ### Example 3 + + +fun foo(r1, r2, f) = + let exec = freeze(r1, () => freeze(r2, () => f(r1, r2))) + let r = exec() + !r + 1 + +region r in + region s in + foo(r, s, (x, y) => + if rand() then print("Chose x"); () => x.ref 0 + else print("Chose y"); () => y.ref 1) +//│ Type: Int + +// TODO: simplify this type more! +foo +//│ Type: ['r1, 'r2, 'R, 'E, 'R1, 'eff, 'reg, 'ref] -> ('r1, 'r2, ('r1, 'r2) ->{(('E ∧ ¬'R) ∧ ¬'R1) ∧ ¬'R1} (() ->{'eff} Ref['ref, out 'reg])) ->{(('reg ∨ 'R) ∨ 'E) ∨ 'eff} Int +//│ Where: +//│ 'r1 <: Region[out 'R] +//│ 'E <: ¬'R +//│ 'R1 <: 'E +//│ 'R1 <: ¬'R +//│ 'r2 <: Region[out 'R1] +//│ 'ref <: Int + + + + +// *** NOT CURRENTLY USED IN RESPONSE *** + + +fun wield: [R] -> (Region[out R]) ->{R} () +fun freeze: [R, E extends ~R, T] -> (Region[out R], () ->{~R | E} T) ->{E} T + + +fun foo(r1, r2, f) = + let r = freeze(r1, () => freeze(r2, () => f(r1, r2))) + wield(r) + +region r in + foo(r, r, (x, y) => if rand() then x else y) + +region r in + region s in + foo(r, s, (x, y) => if rand() then x else y) + + + +// *** NOTES *** + + +// Doesn't type check because r.ref has effect r + +fun foo(r1, r2, f) = + let r = freeze(r1, () => freeze(r2, () => f(r1, r2))) + r := !r + 1 + +:e +region r in + region s in + foo(r, s, (x, y) => (if rand() then x.ref 0 else y.ref 0)) +//│ ╔══[ERROR] Type error in function literal with expected type 'f +//│ ║ l.160: foo(r, s, (x, y) => (if rand() then x.ref 0 else y.ref 0)) +//│ ║ ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ +//│ ╟── because: cannot constrain ('x, 'y) ->{'reg ∨ 'reg1} (Ref[Int, in ⊥ out 'reg] ∨ Ref[Int, in ⊥ out 'reg1]) <: 'f +//│ ╟── because: cannot constrain ('x, 'y) ->{'reg ∨ 'reg1} (Ref[Int, in ⊥ out 'reg] ∨ Ref[Int, in ⊥ out 'reg1]) <: ('r1, 'r2) ->{'eff} ('app) +//│ ╟── because: cannot constrain 'reg ∨ 'reg1 <: 'eff +//│ ╟── because: cannot constrain 'reg1 <: 'eff +//│ ╟── because: cannot constrain s ∧ ¬r <: 'eff +//│ ╟── because: cannot constrain s ∧ ¬r <: 'E ∨ ¬'R +//│ ╟── because: cannot constrain 'R ∧ s ∧ ¬r <: 'E +//│ ╟── because: cannot constrain 'R ∧ s ∧ ¬r <: ¬'R +//│ ╟── because: cannot constrain 'R <: ¬s ∨ r +//│ ╙── because: cannot constrain s ∧ ¬r <: ¬s ∨ r +//│ Type: Int + + diff --git a/hkmc2/shared/src/test/mlscript/bbml/bbBasics.mls b/hkmc2/shared/src/test/mlscript/invalml/invalBasics.mls similarity index 82% rename from hkmc2/shared/src/test/mlscript/bbml/bbBasics.mls rename to hkmc2/shared/src/test/mlscript/invalml/invalBasics.mls index 59382d700c..c82debf851 100644 --- a/hkmc2/shared/src/test/mlscript/bbml/bbBasics.mls +++ b/hkmc2/shared/src/test/mlscript/invalml/invalBasics.mls @@ -1,7 +1,5 @@ -:bbml -//│ Type: ⊤ +:invalml -//│ Type: ⊤ 123 //│ Type: Int @@ -12,21 +10,18 @@ false //│ Type: Bool -"bbml" +"invalml" //│ Type: Str () -//│ Type: ⊤ fun id(x) = x id //│ Type: ['x] -> 'x -> 'x fun inc(x) = x + 1 -//│ Type: ⊤ fun mul(x, y) = x * y -//│ Type: ⊤ x => x //│ Type: ('x) ->{⊥} 'x @@ -43,7 +38,7 @@ x => x :e 114 + "514" //│ ╔══[ERROR] Type error in string literal with expected type Int -//│ ║ l.44: 114 + "514" +//│ ║ l.39: 114 + "514" //│ ║ ^^^^^ //│ ╙── because: cannot constrain Str <: Int //│ Type: Int @@ -61,18 +56,17 @@ let x = 1 in let y = 2 in x + y :e let x = 0 in x + "1" //│ ╔══[ERROR] Type error in string literal with expected type Int -//│ ║ l.62: let x = 0 in x + "1" +//│ ║ l.57: let x = 0 in x + "1" //│ ║ ^^^ //│ ╙── because: cannot constrain Str <: Int //│ Type: Int data class Foo(x: Int) -//│ Type: ⊤ :e new Nothingness(0) //│ ╔══[ERROR] Name not found: Nothingness -//│ ║ l.73: new Nothingness(0) +//│ ║ l.67: new Nothingness(0) //│ ╙── ^^^^^^^^^^^ //│ ═══[ERROR] Not a valid class: //│ Type: ⊥ @@ -80,7 +74,7 @@ new Nothingness(0) :e new 42 //│ ╔══[ERROR] Not a valid class: integer literal -//│ ║ l.81: new 42 +//│ ║ l.75: new 42 //│ ╙── ^^ //│ Type: ⊥ @@ -90,7 +84,6 @@ new Foo(42) data class Point(x: Num, y: Num, z: Num) -//│ Type: ⊤ new Point(0.0, 0.0, 0.0) @@ -99,14 +92,13 @@ new Point(0.0, 0.0, 0.0) :e new Foo("1!5!") //│ ╔══[ERROR] Type error in string literal with expected type Int -//│ ║ l.100: new Foo("1!5!") -//│ ║ ^^^^^^ +//│ ║ l.93: new Foo("1!5!") +//│ ║ ^^^^^^ //│ ╙── because: cannot constrain Str <: Int //│ Type: Foo data class Some[A](value: A) -//│ Type: ⊤ new Some(true) //│ Type: Some['A] @@ -128,20 +120,18 @@ let t = new Some(true) in t.Some#value :pe 42.Some#value //│ ╔══[LEXICAL ERROR] Expected at least one digit after the decimal point -//│ ║ l.129: 42.Some#value +//│ ║ l.121: 42.Some#value //│ ╙── ^ //│ ╔══[ERROR] Illegal juxtaposition right-hand side (operator application). -//│ ║ l.129: 42.Some#value +//│ ║ l.121: 42.Some#value //│ ╙── ^^^^^^^^^^ //│ Type: Num data class Printer[T](f: T -> Str) -//│ Type: ⊤ fun foofoo(x) = let t = x + 1 in "foo" -//│ Type: ⊤ new Printer(foofoo) //│ Type: Printer['T] @@ -154,20 +144,16 @@ let ip = new Printer(foofoo) in ip.Printer#f(42) :e let ip = new Printer(foofoo) in ip.Printer#f("42") //│ ╔══[ERROR] Type error in string literal with expected type 'T -//│ ║ l.155: let ip = new Printer(foofoo) in ip.Printer#f("42") +//│ ║ l.145: let ip = new Printer(foofoo) in ip.Printer#f("42") //│ ║ ^^^^ //│ ╟── because: cannot constrain Str <: 'T //│ ╟── because: cannot constrain Str <: 'T -//│ ╟── because: cannot constrain Str <: 'T -//│ ╟── because: cannot constrain Str <: 'T //│ ╙── because: cannot constrain Str <: Int //│ Type: Str data class TFun[T](f: T -> T) -//│ Type: ⊤ fun inc(x) = x + 1 -//│ Type: ⊤ new TFun(inc) //│ Type: TFun['T] @@ -181,17 +167,14 @@ let tf = new TFun(inc) in tf.TFun#f(1) :e let tf = new TFun(inc) in tf.TFun#f("1") //│ ╔══[ERROR] Type error in string literal with expected type 'T -//│ ║ l.182: let tf = new TFun(inc) in tf.TFun#f("1") +//│ ║ l.168: let tf = new TFun(inc) in tf.TFun#f("1") //│ ║ ^^^ //│ ╟── because: cannot constrain Str <: 'T //│ ╟── because: cannot constrain Str <: 'T -//│ ╟── because: cannot constrain Str <: 'T -//│ ╟── because: cannot constrain Str <: 'T //│ ╙── because: cannot constrain Str <: Int //│ Type: Str ∨ Int data class Pair[A, B](fst: A, snd: B) -//│ Type: ⊤ (new Pair(42, true)).Pair#fst //│ Type: Int @@ -245,7 +228,6 @@ test("1") fun fact(n) = if n > 1 then n * fact(n - 1) else 1 -//│ Type: ⊤ fact //│ Type: Int -> Int @@ -255,21 +237,17 @@ fact(1) fun fact2 = x => fact2(1) -//│ Type: ⊤ fun fact2 = x => if x is n then fact2(n - 1) -//│ Type: ⊤ fun fact2(x) = if x is n then fact2(n - 1) -//│ Type: ⊤ fun fact2 = case 0 then 1 n then n * fact2(n - 1) -//│ Type: ⊤ fact2 //│ Type: Int -> Int @@ -279,7 +257,6 @@ fact2(0) data class Foo[A](x: A -> A) -//│ Type: ⊤ new Foo(x => x) //│ Type: Foo['A] @@ -302,7 +279,7 @@ throw new Error("oops") :e throw 42 //│ ╔══[ERROR] Type error in throw -//│ ║ l.303: throw 42 +//│ ║ l.280: throw 42 //│ ║ ^^ //│ ╙── because: cannot constrain Int <: Error //│ Type: ⊥ diff --git a/hkmc2/shared/src/test/mlscript/bbml/bbBorrowing.mls b/hkmc2/shared/src/test/mlscript/invalml/invalBorrowing.mls similarity index 67% rename from hkmc2/shared/src/test/mlscript/bbml/bbBorrowing.mls rename to hkmc2/shared/src/test/mlscript/invalml/invalBorrowing.mls index 773602effb..bbe1e51d7d 100644 --- a/hkmc2/shared/src/test/mlscript/bbml/bbBorrowing.mls +++ b/hkmc2/shared/src/test/mlscript/invalml/invalBorrowing.mls @@ -1,39 +1,27 @@ -:bbml -//│ Type: ⊤ +:invalml -//│ Type: ⊤ class Reg[Rg, Br] -//│ Type: ⊤ fun letreg: [E, Res] -> ([Rg] -> Reg[Rg, E] ->{E | Rg} Res) ->{E} Res -//│ Type: ⊤ fun use_: [Rg, Br] -> Reg[Rg, Br] ->{Rg} Int -//│ Type: ⊤ class MutVec[A, Rg, Br] -//│ Type: ⊤ fun mkVec: [A, Rg, Br] -> Reg[Rg, Br] -> MutVec[A, Rg, Br] -//│ Type: ⊤ fun clear: [A, Rg, Br] -> MutVec[A, Rg, Br] ->{Rg} Int -//│ Type: ⊤ class Iter[A, Rg] -//│ Type: ⊤ fun iterate: [A, Rg, Br, Res] -> MutVec[A, Rg, Br] -> ([L] -> Iter[A, Br | L] ->{Br | L} Res) ->{Br} Res -//│ Type: ⊤ fun integers: [Rg, Br, Res] -> Reg[Rg, Br] ->{Rg} (Iter[Int, Br] ->{Br} Res) ->{Br} Res -//│ Type: ⊤ fun next: [A, Br] -> Iter[A, Br] ->{Br} A -//│ Type: ⊤ letreg(r => r) //│ Type: Reg[?, 'E] @@ -74,24 +62,23 @@ letreg of r => () => next(it) k() //│ ╔══[ERROR] Type error in block -//│ ║ l.68: letreg of r => +//│ ║ l.56: letreg of r => //│ ║ ^^^^^^^^^^^^^^ -//│ ║ l.69: let b = mkVec(r) +//│ ║ l.57: let b = mkVec(r) //│ ║ ^^^^^^^^^^^^^^^^^^ -//│ ║ l.70: clear(b) +//│ ║ l.58: clear(b) //│ ║ ^^^^^^^^^^ -//│ ║ l.71: let k = iterate(b) of it => +//│ ║ l.59: let k = iterate(b) of it => //│ ║ ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ -//│ ║ l.72: next(it) +//│ ║ l.60: next(it) //│ ║ ^^^^^^^^^^^^ -//│ ║ l.73: 123 +//│ ║ l.61: 123 //│ ║ ^^^^^^^ -//│ ║ l.74: () => next(it) +//│ ║ l.62: () => next(it) //│ ║ ^^^^^^^^^^^^^^^^^^ -//│ ║ l.75: k() +//│ ║ l.63: k() //│ ║ ^^^^^ //│ ╟── because: cannot constrain 'E <: ⊥ -//│ ╟── because: cannot constrain 'E <: ⊥ //│ ╟── because: cannot constrain ¬'Rg <: ⊥ //│ ╟── because: cannot constrain ⊤ <: 'Rg //│ ╙── because: cannot constrain ⊤ <: ⊥ @@ -108,28 +95,26 @@ letreg of r => clear(b) r //│ ╔══[ERROR] Type error in block -//│ ║ l.101: letreg of r => -//│ ║ ^^^^^^^^^^^^^^ -//│ ║ l.102: let b = mkVec(r) -//│ ║ ^^^^^^^^^^^^^^^^^^ -//│ ║ l.103: clear(b) -//│ ║ ^^^^^^^^^^ -//│ ║ l.104: iterate(b) of it => -//│ ║ ^^^^^^^^^^^^^^^^^^^^^ -//│ ║ l.105: next(it) -//│ ║ ^^^^^^^^^^^^ -//│ ║ l.106: clear(b) -//│ ║ ^^^^^^^^^^^^ -//│ ║ l.107: 123 -//│ ║ ^^^^^^^ -//│ ║ l.108: clear(b) -//│ ║ ^^^^^^^^^^ -//│ ║ l.109: r -//│ ║ ^^^ -//│ ╟── because: cannot constrain 'E <: ⊥ +//│ ║ l.88: letreg of r => +//│ ║ ^^^^^^^^^^^^^^ +//│ ║ l.89: let b = mkVec(r) +//│ ║ ^^^^^^^^^^^^^^^^^^ +//│ ║ l.90: clear(b) +//│ ║ ^^^^^^^^^^ +//│ ║ l.91: iterate(b) of it => +//│ ║ ^^^^^^^^^^^^^^^^^^^^^ +//│ ║ l.92: next(it) +//│ ║ ^^^^^^^^^^^^ +//│ ║ l.93: clear(b) +//│ ║ ^^^^^^^^^^^^ +//│ ║ l.94: 123 +//│ ║ ^^^^^^^ +//│ ║ l.95: clear(b) +//│ ║ ^^^^^^^^^^ +//│ ║ l.96: r +//│ ║ ^^^ //│ ╟── because: cannot constrain 'E <: ⊥ //│ ╟── because: cannot constrain 'Rg <: ⊥ -//│ ╟── because: cannot constrain 'Rg <: ⊥ //│ ╙── because: cannot constrain ⊤ <: ⊥ //│ Type: Reg[?, 'E] //│ Where: @@ -156,23 +141,21 @@ letreg of r => use_(r) r //│ ╔══[ERROR] Type error in block -//│ ║ l.151: letreg of r => +//│ ║ l.136: letreg of r => //│ ║ ^^^^^^^^^^^^^^ -//│ ║ l.152: use_(r) +//│ ║ l.137: use_(r) //│ ║ ^^^^^^^^^ -//│ ║ l.153: integers(r) of it => +//│ ║ l.138: integers(r) of it => //│ ║ ^^^^^^^^^^^^^^^^^^^^^^ -//│ ║ l.154: use_(r) +//│ ║ l.139: use_(r) //│ ║ ^^^^^^^^^^^ -//│ ║ l.155: next(it) +//│ ║ l.140: next(it) //│ ║ ^^^^^^^^^^^^ -//│ ║ l.156: use_(r) +//│ ║ l.141: use_(r) //│ ║ ^^^^^^^^^ -//│ ║ l.157: r +//│ ║ l.142: r //│ ║ ^^^ //│ ╟── because: cannot constrain 'E <: ⊥ -//│ ╟── because: cannot constrain 'E <: ⊥ -//│ ╟── because: cannot constrain 'Rg <: ⊥ //│ ╟── because: cannot constrain 'Rg <: ⊥ //│ ╙── because: cannot constrain ⊤ <: ⊥ //│ Type: Reg[?, 'E] diff --git a/hkmc2/shared/src/test/mlscript/bbml/bbBorrowing2.mls b/hkmc2/shared/src/test/mlscript/invalml/invalBorrowing2.mls similarity index 69% rename from hkmc2/shared/src/test/mlscript/bbml/bbBorrowing2.mls rename to hkmc2/shared/src/test/mlscript/invalml/invalBorrowing2.mls index aa1530dcc9..7c0fe39868 100644 --- a/hkmc2/shared/src/test/mlscript/bbml/bbBorrowing2.mls +++ b/hkmc2/shared/src/test/mlscript/invalml/invalBorrowing2.mls @@ -1,24 +1,17 @@ -:bbml -//│ Type: ⊤ +:invalml -//│ Type: ⊤ class Reg[Rg, Br] -//│ Type: ⊤ fun letreg: [E, Res] -> ([Rg] -> Reg[Rg, E] ->{E | Rg} Res) ->{E} Res -//│ Type: ⊤ fun subreg: [E, Rg, Br, Res] -> Reg[Rg, Br] -> ([Rg2] -> Reg[Rg2 & ~Rg, E] ->{E | Rg2} Res) ->{E} Res -//│ Type: ⊤ fun read: [Rg, Br] -> Reg[Rg, Br] ->{Br} Int fun write: [Rg, Br] -> Reg[Rg, Br] ->{Rg} Int -//│ Type: ⊤ fun borrow: [Rg, Br, Res] -> Reg[Rg, Br] ->{Rg} (() ->{Br} Res) ->{Br} Res -//│ Type: ⊤ letreg of r => read(r) @@ -35,28 +28,25 @@ letreg of r => read(r) write(r) //│ ╔══[ERROR] Type error in block -//│ ║ l.31: letreg of r => +//│ ║ l.24: letreg of r => //│ ║ ^^^^^^^^^^^^^^ -//│ ║ l.32: read(r) +//│ ║ l.25: read(r) //│ ║ ^^^^^^^^^ -//│ ║ l.33: borrow(r) of () => +//│ ║ l.26: borrow(r) of () => //│ ║ ^^^^^^^^^^^^^^^^^^^^ -//│ ║ l.34: write(r) +//│ ║ l.27: write(r) //│ ║ ^^^^^^^^^^^^ -//│ ║ l.35: read(r) +//│ ║ l.28: read(r) //│ ║ ^^^^^^^^^^^ -//│ ║ l.36: write(r) +//│ ║ l.29: write(r) //│ ║ ^^^^^^^^^^ //│ ╟── because: cannot constrain 'E <: ⊥ -//│ ╟── because: cannot constrain 'E <: ⊥ -//│ ╟── because: cannot constrain 'Rg <: ⊥ //│ ╟── because: cannot constrain 'Rg <: ⊥ //│ ╙── because: cannot constrain ⊤ <: ⊥ //│ Type: Int fun borrow: [Rg, Br, Res] -> Reg[Rg, Br] ->{Rg} (() ->{Br | ~Rg} Res) ->{Br} Res -//│ Type: ⊤ letreg of r => read(r) @@ -74,21 +64,19 @@ letreg of r => read(r) write(r) //│ ╔══[ERROR] Type error in block -//│ ║ l.70: letreg of r => +//│ ║ l.60: letreg of r => //│ ║ ^^^^^^^^^^^^^^ -//│ ║ l.71: read(r) +//│ ║ l.61: read(r) //│ ║ ^^^^^^^^^ -//│ ║ l.72: borrow(r) of () => +//│ ║ l.62: borrow(r) of () => //│ ║ ^^^^^^^^^^^^^^^^^^^^ -//│ ║ l.73: write(r) +//│ ║ l.63: write(r) //│ ║ ^^^^^^^^^^^^ -//│ ║ l.74: read(r) +//│ ║ l.64: read(r) //│ ║ ^^^^^^^^^^^ -//│ ║ l.75: write(r) +//│ ║ l.65: write(r) //│ ║ ^^^^^^^^^^ //│ ╟── because: cannot constrain 'E <: ⊥ -//│ ╟── because: cannot constrain 'E <: ⊥ -//│ ╟── because: cannot constrain 'Rg <: ⊥ //│ ╟── because: cannot constrain 'Rg <: ⊥ //│ ╙── because: cannot constrain ⊤ <: ⊥ //│ Type: Int diff --git a/hkmc2/shared/src/test/mlscript/bbml/bbBounds.mls b/hkmc2/shared/src/test/mlscript/invalml/invalBounds.mls similarity index 89% rename from hkmc2/shared/src/test/mlscript/bbml/bbBounds.mls rename to hkmc2/shared/src/test/mlscript/invalml/invalBounds.mls index 4d47f09c44..6661898285 100644 --- a/hkmc2/shared/src/test/mlscript/bbml/bbBounds.mls +++ b/hkmc2/shared/src/test/mlscript/invalml/invalBounds.mls @@ -1,7 +1,5 @@ -:bbml -//│ Type: ⊤ +:invalml -//│ Type: ⊤ (x => x + 1) as [A extends Int] -> A -> Int //│ Type: (Int) ->{⊥} Int @@ -21,7 +19,6 @@ fun iid: [A extends Int] -> A -> A fun iid(x) = x -//│ Type: ⊤ iid //│ Type: ['A] -> ('A) ->{⊥} 'A @@ -31,10 +28,9 @@ iid :e iid("42") //│ ╔══[ERROR] Type error in string literal with expected type 'A -//│ ║ l.32: iid("42") +//│ ║ l.29: iid("42") //│ ║ ^^^^ //│ ╟── because: cannot constrain Str <: 'A -//│ ╟── because: cannot constrain Str <: 'A //│ ╙── because: cannot constrain Str <: Int //│ Type: Str @@ -43,7 +39,6 @@ iid(42) //│ Type: Int class Foo[A] -//│ Type: ⊤ fun foo: [A extends Foo[in Nothing out Any] restricts Foo[in Num]] -> A -> A foo @@ -53,7 +48,6 @@ foo //│ 'A <: Foo[?] fun bar: Foo[in Num out Int] -//│ Type: ⊤ foo(bar) //│ Type: Foo[in Num out Int] ∨ Foo[in Num] @@ -61,10 +55,9 @@ foo(bar) :e fun badfoo: [A extends Str restricts Int] -> A -> A //│ ╔══[ERROR] Type error in block -//│ ║ l.62: fun badfoo: [A extends Str restricts Int] -> A -> A +//│ ║ l.56: fun badfoo: [A extends Str restricts Int] -> A -> A //│ ║ ^^^^^^ //│ ╙── because: cannot constrain Int <: Str -//│ Type: ⊤ fun baz: [A extends B, B extends A] -> A -> B @@ -101,18 +94,16 @@ cc //│ 'A <: 'B -> 'B fun w: Any -> Nothing -//│ Type: ⊤ cc(w)(w) //│ Type: Bool fun h: [C] -> ([A extends Int] -> A -> ([B extends A -> A restricts A -> A] -> B) -> A) -> C -> Int -//│ Type: ⊤ :e bazbaz as [A extends Int] -> A -> ([B extends A -> A restricts A -> A] -> B) -> A //│ ╔══[ERROR] Cannot type non-function term Ref(member:bazbaz) as (A) ->{⊥} ([outer, 'B] -> 'B) ->{⊥} A -//│ ║ l.113: bazbaz as [A extends Int] -> A -> ([B extends A -> A restricts A -> A] -> B) -> A +//│ ║ l.104: bazbaz as [A extends Int] -> A -> ([B extends A -> A restricts A -> A] -> B) -> A //│ ╙── ^^^^^^ //│ Type: ['A] -> ('A) ->{⊥} ('A -> 'A) ->{⊥} 'A //│ Where: diff --git a/hkmc2/shared/src/test/mlscript/bbml/bbCheck.mls b/hkmc2/shared/src/test/mlscript/invalml/invalCheck.mls similarity index 86% rename from hkmc2/shared/src/test/mlscript/bbml/bbCheck.mls rename to hkmc2/shared/src/test/mlscript/invalml/invalCheck.mls index 7ffb05c545..8979077acf 100644 --- a/hkmc2/shared/src/test/mlscript/bbml/bbCheck.mls +++ b/hkmc2/shared/src/test/mlscript/invalml/invalCheck.mls @@ -1,11 +1,8 @@ -:bbml -//│ Type: ⊤ +:invalml -//│ Type: ⊤ fun add: (Int, Int) -> Int fun add(x, y) = x + y -//│ Type: ⊤ // FIXME locations :e @@ -13,42 +10,38 @@ fun foo: Int -> Int fun foo: Int -> Int //│ ╔══[ERROR] Multiple declarations of symbol 'foo' //│ ╟── declared here -//│ ║ l.12: fun foo: Int -> Int -//│ ║ ^^^^^^^^^^^^^^^ +//│ ║ l.9: fun foo: Int -> Int +//│ ║ ^^^^^^^^^^^^^^^ //│ ╟── declared here -//│ ║ l.13: fun foo: Int -> Int +//│ ║ l.10: fun foo: Int -> Int //│ ╙── ^^^^^^^^^^^^^^^ -//│ Type: ⊤ :e fun id(x) = x fun id(y) = y //│ ╔══[ERROR] Multiple definitions of symbol 'id' //│ ╟── defined here -//│ ║ l.24: fun id(x) = x +//│ ║ l.20: fun id(x) = x //│ ║ ^^^^^^^^^ //│ ╟── defined here -//│ ║ l.25: fun id(y) = y +//│ ║ l.21: fun id(y) = y //│ ╙── ^^^^^^^^^ -//│ Type: ⊤ :e fun bar: Str -> Str fun bar(x) = let t = x + 1 in "aaa" //│ ╔══[ERROR] Type error in reference with expected type Int -//│ ║ l.37: fun bar(x) = let t = x + 1 in "aaa" +//│ ║ l.32: fun bar(x) = let t = x + 1 in "aaa" //│ ║ ^ //│ ╙── because: cannot constrain Str <: Int -//│ Type: ⊤ :e fun baz: Int -> Int fun baz(x) = "bbb" //│ ╔══[ERROR] Type error in string literal with expected type Int -//│ ║ l.46: fun baz(x) = "bbb" +//│ ║ l.40: fun baz(x) = "bbb" //│ ║ ^^^^^ //│ ╙── because: cannot constrain Str <: Int -//│ Type: ⊤ add(1, 2) //│ Type: Int @@ -60,7 +53,7 @@ add(1, 2) as Int :e add(0, 0) as Str //│ ╔══[ERROR] Type error in application with expected type Str -//│ ║ l.61: add(0, 0) as Str +//│ ║ l.54: add(0, 0) as Str //│ ║ ^^^^^^^^^ //│ ╙── because: cannot constrain Int <: Str //│ Type: Str @@ -68,14 +61,12 @@ add(0, 0) as Str :e fun errAdd(x: Int) = x + "1" //│ ╔══[ERROR] Type error in string literal with expected type Int -//│ ║ l.69: fun errAdd(x: Int) = x + "1" +//│ ║ l.62: fun errAdd(x: Int) = x + "1" //│ ║ ^^^ //│ ╙── because: cannot constrain Str <: Int -//│ Type: ⊤ fun high: ([A] -> A -> A) -> Int fun high(f) = f(42) -//│ Type: ⊤ high //│ Type: (['A] -> ('A) ->{⊥} 'A) ->{⊥} Int @@ -90,11 +81,11 @@ high(x => x) :e high(x => x + 1) //│ ╔══[ERROR] Type error in reference with expected type Int -//│ ║ l.91: high(x => x + 1) +//│ ║ l.82: high(x => x + 1) //│ ║ ^ //│ ╙── because: cannot constrain A <: Int //│ ╔══[ERROR] Type error in application with expected type A -//│ ║ l.91: high(x => x + 1) +//│ ║ l.82: high(x => x + 1) //│ ║ ^^^^^ //│ ╙── because: cannot constrain Int <: A //│ Type: Int @@ -110,17 +101,15 @@ high(x => x + 1) fun baz: Int -> (([A] -> A -> A), Int) -> Int fun baz(z) = ((f, x) => f(x)) -//│ Type: ⊤ fun baz: Int -> (([A] -> A -> A), Int) -> Int fun baz(z) = ((f, x) => f(x)) as (([A] -> A -> A), Int) -> Int -//│ Type: ⊤ :e baz as Int -> (([A] -> A -> A), Int) -> Int //│ ╔══[ERROR] Cannot type non-function term Ref(member:baz) as (Int) ->{⊥} ([outer, 'A] -> ('A) ->{⊥} 'A, Int) ->{⊥} Int -//│ ║ l.121: baz as Int -> (([A] -> A -> A), Int) -> Int +//│ ║ l.110: baz as Int -> (([A] -> A -> A), Int) -> Int //│ ╙── ^^^ //│ Type: ⊥ @@ -131,7 +120,7 @@ baz(42) :e baz(42) as (([A] -> A -> A), Int) -> Int //│ ╔══[ERROR] Cannot type non-function term App(Ref(member:baz),Tup(List(Fld(‹›,Lit(IntLit(42)),None)))) as ([outer, 'A] -> ('A) ->{⊥} 'A, Int) ->{⊥} Int -//│ ║ l.132: baz(42) as (([A] -> A -> A), Int) -> Int +//│ ║ l.121: baz(42) as (([A] -> A -> A), Int) -> Int //│ ╙── ^^^^^^^ //│ Type: ⊥ @@ -141,7 +130,6 @@ baz(42) as (([A] -> A -> A), Int) -> Int fun id: [A] -> A -> A fun id(x) = x -//│ Type: ⊤ id as [A] -> A -> A //│ Type: ['A] -> ('A) ->{⊥} 'A @@ -177,7 +165,7 @@ foo :e foo(42, 1) //│ ╔══[ERROR] Type error in integer literal with expected type ¬'A -//│ ║ l.178: foo(42, 1) +//│ ║ l.166: foo(42, 1) //│ ║ ^ //│ ╟── because: cannot constrain Int <: ¬'A //│ ╟── because: cannot constrain 'A <: ¬{Int} diff --git a/hkmc2/shared/src/test/mlscript/bbml/bbCodeGen.mls b/hkmc2/shared/src/test/mlscript/invalml/invalCodeGen.mls similarity index 95% rename from hkmc2/shared/src/test/mlscript/bbml/bbCodeGen.mls rename to hkmc2/shared/src/test/mlscript/invalml/invalCodeGen.mls index 48a7354751..b1d78c64f3 100644 --- a/hkmc2/shared/src/test/mlscript/bbml/bbCodeGen.mls +++ b/hkmc2/shared/src/test/mlscript/invalml/invalCodeGen.mls @@ -1,8 +1,7 @@ :js :global -:bbml -//│ Type: ⊤ +:invalml :sjs @@ -71,7 +70,6 @@ data class Foo(x: Int) //│ } //│ toString() { return "Foo(" + runtime.render(this.x) + ")"; } //│ }; -//│ Type: ⊤ :sjs @@ -94,7 +92,6 @@ let foo = new Foo(42) in foo.Foo#x fun inc(x) = x + 1 //│ JS (unsanitized): //│ let inc; inc = function inc(x1) { return x1 + 1 }; -//│ Type: ⊤ :sjs @@ -122,7 +119,6 @@ if 1 is Int then 1 else 0 data class Foo() -//│ Type: ⊤ @@ -165,7 +161,6 @@ fun pow(x) = case //│ }); //│ return lambda1 //│ }; -//│ Type: ⊤ :sjs @@ -187,7 +182,6 @@ fun not = case //│ }); //│ return lambda1 //│ }; -//│ Type: ⊤ :expect true @@ -221,7 +215,6 @@ fun fact = case //│ }); //│ return lambda1 //│ }; -//│ Type: ⊤ :expect 6 @@ -272,30 +265,23 @@ region x in let y = x.ref 42 in y := 0 data class LsAlg[A, E](nil:() -> E, cons: (A, E) -> E) -//│ Type: ⊤ fun nil(x) = x.LsAlg#nil() fun cons(x, y, z) = x.LsAlg#cons(y, z) -//│ Type: ⊤ data class Nil() data class Cons[A, B](val x: A,val y: B) -//│ Type: ⊤ fun mk() = new LsAlg(() => new Nil, (x, y) => new Cons(x, y)) -//│ Type: ⊤ // fun xs: [E] -> LsAlg[in Int, E] -> E fun xs(x) = x cons(1, x nil()) -//│ Type: ⊤ fun ys: [E] -> LsAlg[in Nothing, E] -> E fun ys(x) = x nil() -//│ Type: ⊤ fun zs: [E] -> LsAlg[in Int | E, E] -> E fun zs(x) = x cons(xs(x), x cons(ys(x),x nil())) -//│ Type: ⊤ mk() zs() //│ = Cons(Cons(1, Nil()), Cons(Nil(), Nil())) diff --git a/hkmc2/shared/src/test/mlscript/invalml/invalConSolver.mls b/hkmc2/shared/src/test/mlscript/invalml/invalConSolver.mls new file mode 100644 index 0000000000..303c018468 --- /dev/null +++ b/hkmc2/shared/src/test/mlscript/invalml/invalConSolver.mls @@ -0,0 +1,834 @@ +:js + +:global +:invalml + + +declare class Array[T] +declare class Map[K, V] + +fun mkArray: [T] -> () -> Array[T] +fun mkArray() = @untyped globalThis.Array() + +fun at: [T] -> (Array[T], Int) -> T +fun at(xs, i) = @untyped xs.at(i) + +fun not(b) = if b then false else true +fun (;) seq(_, res) = res +fun id(x) = x + +fun println: Any -> () +fun println(s) = @untyped print(s) + +fun (~) concat: (Str, Str) -> Str +fun concat(x, y) = @untyped x + y + +fun toString: Any -> Str +fun toString(x) = @untyped x.toString() + +fun (===) seq: (Str, Str) -> Bool +fun seq(x, y) = @untyped x == y + +fun mkMap: [K, V] -> () -> Map[K, V] +fun mkMap() = @untyped id(new globalThis.Map()) + +fun has: [K, V] -> (Map[K, V], K) -> Bool +fun has(m, k) = @untyped m.has(k) + +fun getFromMap: [K, V] -> (Map[K, V], K) -> V +fun getFromMap(m, k) = @untyped m.get(k) + +fun setToMap: [K, V] -> (Map[K, V], K, V) -> () +fun setToMap(m, k, v) = @untyped m.set(k, v) + + +fun error() = error() +fun (???) TODO() = TODO() + + + + +class PairOf[out A, out B] with + constructor + Pair(fst: A, snd: B) + +class Option[out A] with + constructor + None() + Some(value: A) + +class List[out A] with + constructor + Nil() + Cons(head: A, tail: List[A]) + +fun fold(x, xs, f) = if xs is + Nil() then x + Cons(y, ys) then fold(f(x, y), ys, f) + +fun map(xs, f) = if xs is + Nil() then Nil() + Cons(x, xs) then Cons(f(x), map(xs, f)) + +fun each(xs, f) = if xs is + Nil() then () + Cons(x, xs) then f(x); each(xs, f) + +fun find(xs, f) = if xs is + Nil() then None() + Cons(x, xs) then + if f(x) then Some(x) + else find(xs, f) + +class ArrayList[T, out R](val d: Array[T]) +class Iter[T, out R](val arr: Array[T], val i: Ref[Int, out R], val step: Int, val end: Int) +class HashMap[K, V, out R](val d: Map[Str, V], val f: K -> Str) +class MapIter[T, out R](val it: Any) + +// fun empty: [A, R] -> Region[R] ->{R} ArrayList[out A, out R] // TODO investigate: why does this break things? +fun empty: [A, R] -> Region[out R] ->{R} ArrayList[A, out R] +fun empty(r) = new ArrayList(mkArray()) + +fun clear: [A, R] -> (ArrayList[A, out R]) ->{R} () +fun clear(arr) = @untyped arr.ArrayList#d.splice(0, arr.length); () + +fun push: [A, R] -> (ArrayList[A, R], A) ->{R} () +fun push(arr, e) = @untyped arr.ArrayList#d.push(e); () + +fun len: [A, R] -> (ArrayList[A, R]) ->{R} Int +fun len(arr) = @untyped arr.ArrayList#d.length + +fun iter: [Res, R, E extends ~R, T] -> (ArrayList[T, R], [S] -> Iter[T, S] ->{S | E} Res) ->{E | R} Res +fun iter(arr, f) = + region r in f(new Iter(arr.ArrayList#d, (r.ref 0), 1, len(arr))) + +fun next: [T, S] -> Iter[T, S] ->{S} Option[T] +fun next(it) = + let i = !it.Iter#i + if i == it.Iter#end then None() + else + let res = Some(at of it.Iter#arr, i) + it.Iter#i := i + it.Iter#step + res + +fun whileDo: [R] -> (() ->{R} Bool) ->{R} () +fun whileDo(f) = + if f() then whileDo(f) else () + +fun foreach: [E, R, T] -> (Iter[T, R], T ->{E} ()) ->{R | E} () +fun foreach(it, f) = + whileDo of () => + if next(it) is + Some(x) then f(x); true + None then false + +fun freeze: [R, E extends ~R, T] -> (Region[out R], () ->{~R & E} T) ->{R | E} T +fun freeze(r, f) = f() + +fun max(x, y) = if x < y then y else x + + +fun mkHashMap: [R, K, V] -> (Region[out R], K -> Str) ->{R} HashMap[K, V, R] +fun mkHashMap(r, f) = new HashMap(mkMap(), f) + +fun getOrUpdate: [R, K, V, E] -> (HashMap[K, V, R], K, () ->{E} V) ->{E | R} V +fun getOrUpdate(m, k, fv) = + let sk = m.HashMap#f(k) + if has(m.HashMap#d, sk) then getFromMap(m.HashMap#d, sk) + else + let res = fv() + setToMap(m.HashMap#d, sk, res) + res + +fun hasOrUpdate: [R, K, V, E] -> (HashMap[K, V, R], K, () ->{E} V) ->{E | R} () +fun hasOrUpdate(m, k, fv) = getOrUpdate(m, k, fv); () + +fun iterMap: [Res, R, E extends ~R, K, V] -> (HashMap[K, V, R], [S] -> MapIter[V, S] ->{S | E} Res) ->{E | R} Res +fun iterMap(m, f) = @untyped f(id(new MapIter(m.HashMap#d.values()))) + +fun nextVal: [T, S] -> MapIter[T, S] ->{S} Option[T] +fun nextVal(it) = + @untyped id(let obj = it.MapIter#it.next() in if obj.done then None() else Some(obj.value) ) + + +fun hasKey: [K, V, R] -> (HashMap[K, V, R], K) ->{R} Bool +fun hasKey(m, k) = has(m.HashMap#d, m.HashMap#f(k)) + + +fun add: [K, V, R] -> (HashMap[K, V, R], K, V) ->{R} () +fun add(m, k, v) = setToMap(m.HashMap#d, m.HashMap#f(k), v) + + +fun values: [E, R, T] -> (MapIter[T, R], T ->{E} ()) ->{R | E} () +fun values(it, f) = + whileDo of () => + if nextVal(it) is + Some(x) then f(x); true + None then false + + +class Type[out R] with + constructor + IntType() + FunctionType(lhs: Type[R], rhs: Type[R]) + RecordType(fields: List[PairOf[Str, Type[R]]]) + TypeVariable(name: Str, level: Int, lowerBounds: ArrayList[Type[R], R], upperBounds: ArrayList[Type[R], R]) + + +fun isSimpl(ty) = if ty is + FunctionType(_, _) then false + else true + + +fun ty2Str(ty) = if ty is + IntType() then "Int" + FunctionType(lhs, rhs) then + let ls = if isSimpl(lhs) then ty2Str(lhs) else "(" ~ ty2Str(lhs) ~ ")" + ls ~ " -> " ~ ty2Str(rhs) + RecordType(fields) then "{ " ~ fold("", fields, (s, p) => if p is Pair(n, t) then s ~ n ~ ": " ~ ty2Str(t) ~ ", ") ~ "}" + TypeVariable(name, level, _, _) then name ~ "_" ~ toString(level) + +// fun levelOf: [R] -> Type[R] -> Int +fun levelOf(ty) = if ty is + IntType() then 0 + FunctionType(lhs, rhs) then max(levelOf(lhs), levelOf(rhs)) + RecordType(fields) then fold(0, fields, (r, p) => if p is Pair(_, t) then max(r, levelOf(t))) + TypeVariable(_, level, _, _) then level + + +:e +fun matchP = case + Pair(IntType, IntType) then () +//│ ╔══[ERROR] Pattern Ident(IntType) is not supported yet. +//│ ║ l.201: Pair(IntType, IntType) then () +//│ ╙── ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ +//│ ╔══[ERROR] Pattern Ident(IntType) is not supported yet. +//│ ║ l.201: Pair(IntType, IntType) then () +//│ ╙── ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ +//│ ╔══[ERROR] Expect 4 cases, but 1 got. +//│ ║ l.201: Pair(IntType, IntType) then () +//│ ╙── ^^^^^^^^^^^^^^^^ +//│ ╔══[ERROR] Expect 4 cases, but 1 got. +//│ ║ l.201: Pair(IntType, IntType) then () +//│ ╙── ^^^^^^^^^^^^^^^^^^^^^^^^^ + + +fun test: [R] -> (ArrayList[Int, R]) ->{R} Int +fun test(xs) = + region r in + iter of xs, it => + 1 + +fun test: [outer, R extends outer] -> (Region[R]) ->{R} Int +fun test(xs) = + region r in + let ncs = r.ref 0 + freeze of xs, () => + ncs := 1 + +fun test: [outer, R extends outer] -> (ArrayList[Int, R]) ->{R} Int +fun test(xs) = + region r in + let ncs = r.ref 0 + iter of xs, it => + ncs := 1 + +// * Note the missing `outer` bound +// TODO: assume that bound implicitly? +:e +fun test: [R] -> (ArrayList[Int, R]) ->{R} Int +fun test(xs) = + region r in + let ncs = r.ref 0 + iter of xs, it => + ncs := 1 +//│ ╔══[ERROR] Type error in function literal with expected type (Iter['T, out S]) ->{S ∨ 'E} 'Res +//│ ║ l.243: iter of xs, it => +//│ ║ ^^^^^ +//│ ║ l.244: ncs := 1 +//│ ║ ^^^^^^^^^^^^^^ +//│ ╟── because: cannot constrain 'reg <: S ∨ 'E +//│ ╟── because: cannot constrain 'reg <: 'E ∨ S +//│ ╟── because: cannot constrain 'reg1 <: 'E ∨ S +//│ ╟── because: cannot constrain ¬'S1 ∧ 'reg1 <: 'E +//│ ╟── because: cannot constrain ¬'S1 ∧ 'reg1 <: ¬'R +//│ ╟── because: cannot constrain 'R ∧ 'reg1 <: 'S1 +//│ ╟── because: cannot constrain 'R ∧ 'reg1 <: ⊥ +//│ ╟── because: cannot constrain 'R <: ¬'reg1 +//│ ╟── because: cannot constrain R1 <: ¬'reg1 +//│ ╟── because: cannot constrain 'reg1 <: ¬R1 +//│ ╙── because: cannot constrain r ∧ ¬outer <: ¬R1 + + + + +fun report(lhs, rhs) = + println("Cannot constrain " ~ ty2Str(lhs) ~ " <: " ~ ty2Str(rhs) ~ "!") + + +fun extrude: [outer, R extends outer] -> (Type[R], Bool, Int, (Str, Int) ->{R} Type[R], HashMap[PairOf[Type[R], PairOf[Int, Bool]], Type[R], R]) ->{R} Type[R] +fun extrude(ty, pol, lvl, freshVar, cache) = getOrUpdate of cache, Pair(ty, Pair(lvl, pol)), () => + if levelOf(ty) <= lvl then ty + else if ty is + IntType() then ty + FunctionType(lhs, rhs) then + FunctionType(extrude(lhs, not(pol), lvl, freshVar, cache), extrude(rhs, pol, lvl, freshVar, cache)) + RecordType(fields) then + RecordType(map(fields, p => if p is Pair(name, ty) then Pair(name, extrude(ty, pol, lvl, freshVar, cache)))) + TypeVariable(name, level, lb, ub) then + let nc = freshVar(name ~ "'" ~ (if pol then "+" else "-"), lvl) + if pol then + push(ub, nc) + let nlb = if nc is + TypeVariable(_, _, lb, _) then lb + else error() // impossible + region r in + let nbd = empty(r) + iter of lb, it => foreach(it, b => push(nbd, b)) + iter of nbd, it => foreach(it, b => push(nlb, extrude(b, pol, lvl, freshVar, cache))) + else + push(lb, nc) + let nub = if nc is + TypeVariable(_, _, _, ub) then ub + else error() // impossible + region r in + let nbd = empty(r) + iter of ub, it => foreach(it, b => push(nbd, b)) + iter of nbd, it => foreach(it, b => push(nub, extrude(b, pol, lvl, freshVar, cache))) + nc + +// fun solve: [outer, R extends outer] -> (List[PairOf[Type[R], Type[R]]], (Str, Int) ->{R} Type[R], HashMap[PairOf[Type[R], Type[R]], Any, R], () ->{R} HashMap[PairOf[Type[R], PairOf[Int, Bool]], Type[R], R]) ->{R} () +fun solve(constraints, freshVar, cache, genExtrCache) = if constraints is + Nil() then () + Cons(c, cs) then if c is + Pair(lhs, rhs) then hasOrUpdate of cache, c, () => + if lhs is + IntType() then if rhs is + IntType() then solve(cs, freshVar, cache, genExtrCache) + TypeVariable(name, level, lb, ub) then + push(lb, lhs) + region r in + let ncs = r.ref cs + iter(ub, it => foreach(it, b => ncs := Cons(Pair(lhs, b), !ncs); ())) + solve(!ncs, freshVar, cache, genExtrCache) + else report(lhs, rhs) + FunctionType(arg, res) then if rhs is + FunctionType(arg', res') then + solve(Cons(Pair(arg', arg), Cons(Pair(res, res'), cs)), freshVar, cache, genExtrCache) + TypeVariable(name, level, lb, ub) then + if levelOf(lhs) <= level then + push(lb, lhs) + region r in + let ncs = r.ref cs + iter(ub, it => foreach(it, b => ncs := Cons(Pair(lhs, b), !ncs); ())) + solve(!ncs, freshVar, cache, genExtrCache) + else + let lhs' = extrude(lhs, true, level, freshVar, genExtrCache()) + solve(Cons(Pair(lhs', rhs), cs), freshVar, cache, genExtrCache) + else report(lhs, rhs) + RecordType(flds) then if rhs is + RecordType(flds') then each(flds', p' => + if p' is Pair(n', t') then + if find(flds, p => if p is Pair(n, t) then n === n') is + Some(p) then if p is Pair(n, t) then solve(Cons(Pair(t, t'), cs), freshVar, cache, genExtrCache) + None() then println("Missing field " ~ n' ~ " in " ~ ty2Str(lhs)) + ) + TypeVariable(name, level, lb, ub) then + if levelOf(lhs) <= level then + push(lb, lhs) + region r in + let ncs = r.ref cs + iter(ub, it => foreach(it, b => ncs := Cons(Pair(lhs, b), !ncs); ())) + solve(!ncs, freshVar, cache, genExtrCache) + else + let lhs' = extrude(lhs, true, level, freshVar, genExtrCache()) + solve(Cons(Pair(lhs', rhs), cs), freshVar, cache, genExtrCache) + else report(lhs, rhs) + TypeVariable(name, level, lb, ub) then + if levelOf(rhs) <= level then + push(ub, rhs) + region r in + let ncs = r.ref cs + iter(lb, it => foreach(it, b => ncs := Cons(Pair(b, rhs), !ncs); ())) + solve(!ncs, freshVar, cache, genExtrCache) + else + let rhs' = extrude(rhs, false, level, freshVar, genExtrCache()) + solve(Cons(Pair(lhs, rhs'), cs), freshVar, cache, genExtrCache) + + +fun freshVar(r, ctx, name, lvl) = + if (not of hasKey(ctx, name)) then + add(ctx, name, 1) + TypeVariable(name, lvl, empty(r), empty(r)) + else + region r2 in + let i = r2.ref 0 + let res = r2.ref None() + whileDo of () => + let nn = name ~ toString(!i) + if (not of hasKey(ctx, nn)) then + res := Some(TypeVariable(nn, lvl, empty(r), empty(r))) + add(ctx, nn, 1) + false + else + i := !i + 1 + true + if !res is + Some(v) then v + else error() + + +fun genHash(r) = + mkHashMap(r, p => if p is Pair(x, y) then ty2Str(x) ~ " <: " ~ ty2Str(y)) + +fun genExtrHash(r) = + () => mkHashMap(r, t => if t is Pair(ty, p) then if p is Pair(lvl, pol) then ty2Str(ty) ~ (if pol then "+_" else "-_") ~ toString(lvl)) + + +fun printBounds(tv) = if tv is + TypeVariable(name, level, lb, ub) then + iter of lb, it => + foreach of it, b => println(" " ~ ty2Str(b) ~ " <: " ~ ty2Str(tv)) + iter of ub, it => + foreach of it, b => println(" " ~ ty2Str(tv) ~ " <: " ~ ty2Str(b)) + else () + +// fun printRes: [outer, R extends outer] -> (Type[R], Type[R]) ->{R} () +fun printRes(lhs, rhs) = + println(ty2Str(lhs) ~ " <: " ~ ty2Str(rhs)) + region r in + let tvs = mkHashMap(r, s => s) + // fun go: [outer, R extends outer, S extends outer] -> (Type[R], HashMap[Str, Type[R], S]) ->{R | S} () + fun go(t, tvs) = if t is + IntType() then () + FunctionType(lhs, rhs) then go(lhs, tvs); go(rhs, tvs) + RecordType(fields) then each(fields, p => if p is Pair(_, t) then go(t, tvs)) + TypeVariable(name, level, lb, ub) then + getOrUpdate of tvs, name ~ toString(level), () => + region r2 in + let tmp = empty(r2) + iter of lb, it => foreach(it, ty => push(tmp, ty)) + iter of ub, it => foreach(it, ty => push(tmp, ty)) + t + () + go(lhs, tvs); go(rhs, tvs) + println("where: ") + iterMap of tvs, it => + values of it, printBounds + + +region r in + let ctx = mkHashMap(r, s => s) + let lhs = FunctionType(IntType(), IntType()) + let rhs = IntType() + solve(Cons(Pair(lhs, rhs), Nil()), (n, l) => freshVar(r, ctx, n, l), genHash(r), genExtrHash(r)) +//│ > Cannot constrain Int -> Int <: Int! + + +region r in + let ctx = mkHashMap(r, s => s) + let lhs = FunctionType(IntType(), IntType()) + let a = freshVar(r, ctx, "a", 1) + let rhs = FunctionType(a, a) + solve(Cons(Pair(lhs, rhs), Nil()), (n, l) => freshVar(r, ctx, n, l), genHash(r), genExtrHash(r)) + printRes(lhs, rhs) +//│ > Int -> Int <: a_1 -> a_1 +//│ > where: +//│ > Int <: a_1 +//│ > a_1 <: Int + + +region r in + let ctx = mkHashMap(r, s => s) + let lhs = RecordType(Cons(Pair("a", IntType()), Cons(Pair("b", FunctionType(IntType(), IntType())), Nil()))) + let a = freshVar(r, ctx, "a", 1) + let b = freshVar(r, ctx, "b", 1) + let rhs = RecordType(Cons(Pair("a", a), Cons(Pair("b", b), Nil()))) + solve(Cons(Pair(lhs, rhs), Nil()), (n, l) => freshVar(r, ctx, n, l), genHash(r), genExtrHash(r)) + printRes(lhs, rhs) +//│ > { a: Int, b: Int -> Int, } <: { a: a_1, b: b_1, } +//│ > where: +//│ > Int <: a_1 +//│ > Int -> Int <: b_1 + + +region r in + let ctx = mkHashMap(r, s => s) + let a = freshVar(r, ctx, "a", 1) + let b = freshVar(r, ctx, "b", 1) + let lhs = a + let rhs = b + solve(Cons(Pair(lhs, rhs), Cons(Pair(rhs, lhs), Nil())), (n, l) => freshVar(r, ctx, n, l), genHash(r), genExtrHash(r)) + printRes(lhs, rhs) + printRes(rhs, lhs) +//│ > a_1 <: b_1 +//│ > where: +//│ > a_1 <: b_1 +//│ > b_1 <: a_1 +//│ > b_1 <: a_1 +//│ > where: +//│ > b_1 <: a_1 +//│ > a_1 <: b_1 + + +region r in + let ctx = mkHashMap(r, s => s) + let lhs = RecordType(Cons(Pair("a", IntType()), Cons(Pair("b", FunctionType(IntType(), IntType())), Nil()))) + let b = freshVar(r, ctx, "b", 1) + let rhs = RecordType(Cons(Pair("b", b), Nil())) + solve(Cons(Pair(lhs, rhs), Nil()), (n, l) => freshVar(r, ctx, n, l), genHash(r), genExtrHash(r)) + printRes(lhs, rhs) +//│ > { a: Int, b: Int -> Int, } <: { b: b_1, } +//│ > where: +//│ > Int -> Int <: b_1 + + +region r in + let ctx = mkHashMap(r, s => s) + let a = freshVar(r, ctx, "a", 1) + let b = freshVar(r, ctx, "b", 1) + let lhs = FunctionType(IntType(), a) + let rhs = FunctionType(IntType(), b) + if a is + TypeVariable(_, _, _, ub) then push(ub, lhs) + else error() // impossible + if b is + TypeVariable(_, _, lb, _) then push(lb, rhs) + else error() // impossible + solve(Cons(Pair(a, b), Nil()), (n, l) => freshVar(r, ctx, n, l), genHash(r), genExtrHash(r)) + printRes(a, b) +//│ > a_1 <: b_1 +//│ > where: +//│ > a_1 <: Int -> a_1 +//│ > a_1 <: b_1 +//│ > Int -> b_1 <: b_1 + + +region r in + let ctx = mkHashMap(r, s => s) + let a = freshVar(r, ctx, "a", 1) + let lhs = a + let rhs = FunctionType(IntType(), IntType()) + if a is + TypeVariable(_, _, lb, ub) then push(lb, IntType()) + else error() // impossible + solve(Cons(Pair(lhs, rhs), Nil()), (n, l) => freshVar(r, ctx, n, l), genHash(r), genExtrHash(r)) +//│ > Cannot constrain Int <: Int -> Int! + + +region r in + let ctx = mkHashMap(r, s => s) + let a = freshVar(r, ctx, "a", 1) + let b = freshVar(r, ctx, "b", 2) + let lhs = FunctionType(IntType(), a) + let rhs = FunctionType(IntType(), b) + solve(Cons(Pair(lhs, rhs), Nil()), (n, l) => freshVar(r, ctx, n, l), genHash(r), genExtrHash(r)) + printRes(lhs, rhs) +//│ > Int -> a_1 <: Int -> b_2 +//│ > where: +//│ > a_1 <: b'-_1 +//│ > b'-_1 <: b_2 + + +region r in + let ctx = mkHashMap(r, s => s) + let a = freshVar(r, ctx, "a", 1) + let b = freshVar(r, ctx, "a", 1) + let lhs = a + let rhs = b + solve(Cons(Pair(lhs, rhs), Nil()), (n, l) => freshVar(r, ctx, n, l), genHash(r), genExtrHash(r)) + printRes(lhs, rhs) +//│ > a_1 <: a0_1 +//│ > where: +//│ > a_1 <: a0_1 + + +region r in + let ctx = mkHashMap(r, s => s) + let a = freshVar(r, ctx, "a", 1) + let b = freshVar(r, ctx, "b", 2) + let lhs = a + let rhs = FunctionType(b, FunctionType(b, b)) + solve(Cons(Pair(lhs, rhs), Nil()), (n, l) => freshVar(r, ctx, n, l), genHash(r), genExtrHash(r)) + printRes(lhs, rhs) +//│ > a_1 <: b_2 -> b_2 -> b_2 +//│ > where: +//│ > a_1 <: b'+_1 -> b'+_1 -> b'-_1 +//│ > b'-_1 <: b_2 +//│ > b_2 <: b'+_1 + + +fun wrongSolve(constraints, freshVar, cache, genExtrCache) = if constraints is + Nil() then () + Cons(c, cs) then if c is + Pair(lhs, rhs) then hasOrUpdate of cache, c, () => + if lhs is + IntType() then TODO() + FunctionType(arg, res) then TODO() + RecordType(flds) then TODO() + TypeVariable(name, level, lb, ub) then + if levelOf(rhs) <= level then + push(ub, rhs) + iter(lb, it => foreach(it, b => solve(Cons(Pair(b, rhs), Nil()), freshVar, cache, genExtrCache))) + solve(cs, freshVar, cache, genExtrCache) + else + let rhs' = extrude(rhs, false, level, freshVar, genExtrCache()) + solve(Cons(Pair(lhs, rhs'), cs), freshVar, cache, genExtrCache) + + +:e +region r in + let ctx = mkHashMap(r, s => s) + let a = freshVar(r, ctx, "a", 1) + let b = freshVar(r, ctx, "a", 1) + let lhs = a + let rhs = b + wrongSolve(Cons(Pair(lhs, rhs), Nil()), (n, l) => freshVar(r, ctx, n, l), genHash(r), genExtrHash(r)) + printRes(lhs, rhs) +//│ > a_1 <: a0_1 +//│ > where: +//│ > a_1 <: a0_1 +//│ ╔══[ERROR] Type error in application with expected type 'constraints +//│ ║ l.586: wrongSolve(Cons(Pair(lhs, rhs), Nil()), (n, l) => freshVar(r, ctx, n, l), genHash(r), genExtrHash(r)) +//│ ║ ^^^^^^^^^^^^^^^^^^^^^^^^^^^ +//│ ╟── because: cannot constrain List[in ⊥ out 'A] <: 'constraints +//│ ╟── because: cannot constrain List[in ⊥ out 'A] <: List[in 'Cons out 'Cons1] +//│ ╟── because: cannot constrain 'A <: 'Cons1 +//│ ╟── because: cannot constrain PairOf[in ⊥ out 'A1, in ⊥ out 'B] <: 'Cons1 +//│ ╟── because: cannot constrain PairOf[in ⊥ out 'A1, in ⊥ out 'B] <: PairOf[in 'Pair out 'Pair1, in 'Pair2 out 'Pair3] +//│ ╟── because: cannot constrain 'A1 <: 'Pair1 +//│ ╟── because: cannot constrain 'A2 <: 'Pair1 +//│ ╟── because: cannot constrain 'A2 <: Type[in 'TypeVariable out 'TypeVariable1] +//│ ╟── because: cannot constrain 'Some <: Type[in 'TypeVariable out 'TypeVariable1] +//│ ╟── because: cannot constrain 'A3 <: Type[in 'TypeVariable out 'TypeVariable1] +//│ ╟── because: cannot constrain Type[in ⊥ out 'R] <: Type[in 'TypeVariable out 'TypeVariable1] +//│ ╟── because: cannot constrain 'R <: 'TypeVariable1 +//│ ╟── because: cannot constrain 'R <: ⊥ +//│ ╟── because: cannot constrain 'R1 <: ⊥ +//│ ╙── because: cannot constrain r <: ⊥ +//│ ╔══[ERROR] Type error in application with expected type 'constraints +//│ ║ l.586: wrongSolve(Cons(Pair(lhs, rhs), Nil()), (n, l) => freshVar(r, ctx, n, l), genHash(r), genExtrHash(r)) +//│ ║ ^^^^^^^^^^^^^^^^^^^^^^^^^^^ +//│ ╟── because: cannot constrain List[in ⊥ out 'A] <: 'constraints +//│ ╟── because: cannot constrain List[in ⊥ out 'A] <: List[in 'Cons out 'Cons1] +//│ ╟── because: cannot constrain 'A <: 'Cons1 +//│ ╟── because: cannot constrain PairOf[in ⊥ out 'A1, in ⊥ out 'B] <: 'Cons1 +//│ ╟── because: cannot constrain PairOf[in ⊥ out 'A1, in ⊥ out 'B] <: PairOf[in 'Pair out 'Pair1, in 'Pair2 out 'Pair3] +//│ ╟── because: cannot constrain 'B <: 'Pair3 +//│ ╟── because: cannot constrain 'A4 <: 'Pair3 +//│ ╟── because: cannot constrain 'A4 <: Type[in 'TypeVariable2 out 'TypeVariable3] +//│ ╟── because: cannot constrain 'Some1 <: Type[in 'TypeVariable2 out 'TypeVariable3] +//│ ╟── because: cannot constrain 'A5 <: Type[in 'TypeVariable2 out 'TypeVariable3] +//│ ╟── because: cannot constrain Type[in ⊥ out 'R2] <: Type[in 'TypeVariable2 out 'TypeVariable3] +//│ ╟── because: cannot constrain 'R2 <: 'TypeVariable3 +//│ ╟── because: cannot constrain 'R2 <: 'E +//│ ╟── because: cannot constrain 'R2 <: 'E1 ∨ 'S +//│ ╟── because: cannot constrain ¬'E1 ∧ 'R2 <: 'S +//│ ╟── because: cannot constrain ¬'E1 ∧ 'R2 <: ⊥ +//│ ╟── because: cannot constrain 'R2 <: 'E1 +//│ ╟── because: cannot constrain 'R2 <: ¬'R3 +//│ ╟── because: cannot constrain 'R3 <: ¬'R2 +//│ ╟── because: cannot constrain 'R4 <: ¬'R2 +//│ ╟── because: cannot constrain 'TypeVariable1 <: ¬'R2 +//│ ╟── because: cannot constrain 'R5 <: ¬'R2 +//│ ╟── because: cannot constrain 'R2 <: ¬'R5 +//│ ╟── because: cannot constrain 'R6 <: ¬'R5 +//│ ╟── because: cannot constrain r <: ¬'R5 +//│ ╟── because: cannot constrain 'R5 <: ¬r +//│ ╙── because: cannot constrain r <: ¬r +//│ ╔══[ERROR] Type error in function literal with expected type 'freshVar +//│ ║ l.586: wrongSolve(Cons(Pair(lhs, rhs), Nil()), (n, l) => freshVar(r, ctx, n, l), genHash(r), genExtrHash(r)) +//│ ║ ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ +//│ ╟── because: cannot constrain ('n, 'l) ->{'R7 ∨ 'R8 ∨ 'R9 ∨ 'R10 ∨ 'eff} (Type[in ⊥ out 'R11] ∨ 'A6 ∨ 'app) <: 'freshVar +//│ ╟── because: cannot constrain ('n, 'l) ->{'R7 ∨ 'R8 ∨ 'R9 ∨ 'R10 ∨ 'eff} (Type[in ⊥ out 'R11] ∨ 'A6 ∨ 'app) <: (Str, Int) ->{'R12} (Type[in ⊥ out 'R12]) +//│ ╟── because: cannot constrain Type[in ⊥ out 'R11] ∨ 'A6 ∨ 'app <: Type[in ⊥ out 'R12] +//│ ╟── because: cannot constrain 'R11 <: 'R12 +//│ ╟── because: cannot constrain r <: 'R12 +//│ ╟── because: cannot constrain r <: 'TypeVariable4 +//│ ╟── because: cannot constrain r <: 'E2 +//│ ╟── because: cannot constrain r <: 'E1 ∨ 'S1 +//│ ╟── because: cannot constrain ¬'E1 ∧ r <: 'S1 +//│ ╟── because: cannot constrain ¬'E1 ∧ r <: ⊥ +//│ ╟── because: cannot constrain r <: 'E1 +//│ ╟── because: cannot constrain r <: ¬'R3 +//│ ╟── because: cannot constrain 'R3 <: ¬r +//│ ╟── because: cannot constrain 'R4 <: ¬r +//│ ╟── because: cannot constrain 'R13 <: ¬r +//│ ╙── because: cannot constrain r <: ¬r +//│ ╔══[ERROR] Type error in application with expected type 'cache +//│ ║ l.586: wrongSolve(Cons(Pair(lhs, rhs), Nil()), (n, l) => freshVar(r, ctx, n, l), genHash(r), genExtrHash(r)) +//│ ║ ^^^^^^^^^^ +//│ ╟── because: cannot constrain HashMap['K, 'V, in ⊥ out 'R14] <: 'cache +//│ ╟── because: cannot constrain HashMap['K, 'V, in ⊥ out 'R14] <: HashMap[in 'K1 out 'K2, in 'V1 out 'V2, in ⊥ out 'R15] +//│ ╟── because: cannot constrain 'R14 <: 'R15 +//│ ╟── because: cannot constrain r <: 'R15 +//│ ╟── because: cannot constrain r <: 'E1 ∨ 'S2 +//│ ╟── because: cannot constrain ¬'E1 ∧ r <: 'S2 +//│ ╟── because: cannot constrain ¬'E1 ∧ r <: ⊥ +//│ ╟── because: cannot constrain r <: 'E1 +//│ ╟── because: cannot constrain r <: ¬'R3 +//│ ╟── because: cannot constrain 'R3 <: ¬r +//│ ╟── because: cannot constrain 'R4 <: ¬r +//│ ╟── because: cannot constrain 'R13 <: ¬r +//│ ╙── because: cannot constrain r <: ¬r +//│ ╔══[ERROR] Type error in application with expected type 'genExtrCache +//│ ║ l.586: wrongSolve(Cons(Pair(lhs, rhs), Nil()), (n, l) => freshVar(r, ctx, n, l), genHash(r), genExtrHash(r)) +//│ ║ ^^^^^^^^^^^^^^ +//│ ╟── because: cannot constrain () ->{'R16} (HashMap['K3, 'V3, in ⊥ out 'R16]) <: 'genExtrCache +//│ ╟── because: cannot constrain () ->{'R16} (HashMap['K3, 'V3, in ⊥ out 'R16]) <: () ->{'eff1} ('app1) +//│ ╟── because: cannot constrain HashMap['K3, 'V3, in ⊥ out 'R16] <: 'app1 +//│ ╟── because: cannot constrain HashMap['K3, 'V3, in ⊥ out 'R16] <: HashMap[in PairOf[in ⊥ out Type[in ⊥ out 'R17], in ⊥ out PairOf[in ⊥ out Int, in ⊥ out Bool]] out PairOf[in ⊥ out Type[in ⊥ out 'R18], in ⊥ out PairOf[in ⊥ out Int, in ⊥ out Bool]], in Type[in ⊥ out 'R17] out Type[in ⊥ out 'R18], in ⊥ out 'R18] +//│ ╟── because: cannot constrain 'K3 <: PairOf[in ⊥ out Type[in ⊥ out 'R18], in ⊥ out PairOf[in ⊥ out Int, in ⊥ out Bool]] +//│ ╟── because: cannot constrain PairOf[in ⊥ out Type[in ⊥ out 'R17], in ⊥ out PairOf[in ⊥ out Int, in ⊥ out Bool]] <: PairOf[in ⊥ out Type[in ⊥ out 'R18], in ⊥ out PairOf[in ⊥ out Int, in ⊥ out Bool]] +//│ ╟── because: cannot constrain Type[in ⊥ out 'R17] <: Type[in ⊥ out 'R18] +//│ ╟── because: cannot constrain 'R17 <: 'R18 +//│ ╟── because: cannot constrain 'R17 <: 'TypeVariable5 +//│ ╟── because: cannot constrain 'R17 <: 'E3 +//│ ╟── because: cannot constrain 'R17 <: 'E1 ∨ 'S3 +//│ ╟── because: cannot constrain 'R17 ∧ ¬'E1 <: 'S3 +//│ ╟── because: cannot constrain 'R17 ∧ ¬'E1 <: ⊥ +//│ ╟── because: cannot constrain 'R17 <: 'E1 +//│ ╟── because: cannot constrain 'R12 <: 'E1 +//│ ╟── because: cannot constrain 'R19 <: 'E1 +//│ ╟── because: cannot constrain 'R19 <: ¬'R3 +//│ ╟── because: cannot constrain 'R3 <: ¬'R19 +//│ ╟── because: cannot constrain 'R4 <: ¬'R19 +//│ ╟── because: cannot constrain 'R13 <: ¬'R19 +//│ ╟── because: cannot constrain r <: ¬'R19 +//│ ╟── because: cannot constrain 'R19 <: ¬r +//│ ╙── because: cannot constrain r <: ¬r +//│ ╔══[ERROR] Type error in application with expected type 'genExtrCache +//│ ║ l.586: wrongSolve(Cons(Pair(lhs, rhs), Nil()), (n, l) => freshVar(r, ctx, n, l), genHash(r), genExtrHash(r)) +//│ ║ ^^^^^^^^^^^^^^ +//│ ╟── because: cannot constrain () ->{'R16} (HashMap['K3, 'V3, in ⊥ out 'R16]) <: 'genExtrCache +//│ ╟── because: cannot constrain () ->{'R16} (HashMap['K3, 'V3, in ⊥ out 'R16]) <: () ->{'eff1} ('app1) +//│ ╟── because: cannot constrain HashMap['K3, 'V3, in ⊥ out 'R16] <: 'app1 +//│ ╟── because: cannot constrain HashMap['K3, 'V3, in ⊥ out 'R16] <: HashMap[in PairOf[in ⊥ out Type[in ⊥ out 'R17], in ⊥ out PairOf[in ⊥ out Int, in ⊥ out Bool]] out PairOf[in ⊥ out Type[in ⊥ out 'R18], in ⊥ out PairOf[in ⊥ out Int, in ⊥ out Bool]], in Type[in ⊥ out 'R17] out Type[in ⊥ out 'R18], in ⊥ out 'R18] +//│ ╟── because: cannot constrain 'K3 <: PairOf[in ⊥ out Type[in ⊥ out 'R18], in ⊥ out PairOf[in ⊥ out Int, in ⊥ out Bool]] +//│ ╟── because: cannot constrain PairOf[in ⊥ out Type[in ⊥ out 'R17], in ⊥ out PairOf[in ⊥ out Int, in ⊥ out Bool]] <: PairOf[in ⊥ out Type[in ⊥ out 'R18], in ⊥ out PairOf[in ⊥ out Int, in ⊥ out Bool]] +//│ ╟── because: cannot constrain Type[in ⊥ out 'R17] <: Type[in ⊥ out 'R18] +//│ ╟── because: cannot constrain 'R17 <: 'R18 +//│ ╟── because: cannot constrain 'R17 <: 'TypeVariable5 +//│ ╟── because: cannot constrain 'R17 <: 'E3 +//│ ╟── because: cannot constrain 'R17 <: 'E1 ∨ 'S3 +//│ ╟── because: cannot constrain 'R17 ∧ ¬'E1 <: 'S3 +//│ ╟── because: cannot constrain 'R17 ∧ ¬'E1 <: ⊥ +//│ ╟── because: cannot constrain 'R17 <: 'E1 +//│ ╟── because: cannot constrain 'R20 <: 'E1 +//│ ╟── because: cannot constrain 'R13 <: 'E1 +//│ ╟── because: cannot constrain 'R13 <: ¬'R3 +//│ ╟── because: cannot constrain 'R3 <: ¬'R13 +//│ ╟── because: cannot constrain 'R4 <: ¬'R13 +//│ ╟── because: cannot constrain 'R13 <: ¬'R13 +//│ ╟── because: cannot constrain 'R13 <: ⊥ +//│ ╙── because: cannot constrain r <: ⊥ + + +// * Paper example + + +region r in + let xs = empty(r) + xs +//│ = ArrayList([]) +//│ Type: ArrayList['A, ?] + +region r in + let xs = empty(r) + push(xs, "1") + clear(xs) + + +region r in // This is used to delimit the scope of mutation + let xs = empty(r) // Creates a new mutable list in region r + push(xs, "1"); push(xs, "2"); push(xs, "3") + iter(xs, it => foreach(it, e => println(e))) + clear(xs) +//│ > 1 +//│ > 2 +//│ > 3 + +:e +region r in // This is used to delimit the scope of mutation + let xs = empty(r) // Creates a new mutable list in region r + push(xs, "1"); push(xs, "2"); push(xs, "3") + iter(xs, it => foreach(it, e => println(e); clear(xs))) +//│ > 1 +//│ > 2 +//│ > 3 +//│ ╔══[ERROR] Type error in function literal with expected type (Iter['T, out S]) ->{S ∨ 'E} 'Res +//│ ║ l.755: iter(xs, it => foreach(it, e => println(e); clear(xs))) +//│ ║ ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ +//│ ╟── because: cannot constrain 'R ∨ 'E1 <: S ∨ 'E +//│ ╟── because: cannot constrain 'E1 <: 'E ∨ S +//│ ╟── because: cannot constrain 'R1 <: 'E ∨ S +//│ ╟── because: cannot constrain ¬'S1 ∧ 'R1 <: 'E +//│ ╟── because: cannot constrain ¬'S1 ∧ 'R1 <: ¬'R2 +//│ ╟── because: cannot constrain 'R2 ∧ 'R1 <: 'S1 +//│ ╟── because: cannot constrain 'R2 ∧ 'R1 <: ⊥ +//│ ╟── because: cannot constrain 'R2 <: ¬'R1 +//│ ╟── because: cannot constrain 'R1 <: ¬'R1 +//│ ╟── because: cannot constrain 'R1 <: ⊥ +//│ ╙── because: cannot constrain r <: ⊥ + + + +// ––––––––– TO IMPROVE LATER ––––––––– + +// TODO: simplify + +fun test(x) = case + IntType() then TODO() + FunctionType(l1, r1) then TODO() + RecordType(f) then TODO() + TypeVariable(id, lvl, lbs, ubs) then clear(ubs) + +test +//│ = [function test] +//│ Type: ['TypeVariable] -> ⊤ -> ((((Type[out 'TypeVariable] ∧ Type[?]) ∧ Type[?]) ∧ Type[?]) ->{'TypeVariable} ()) + + + + + +fun solve = case + Nil then () + Cons(c, cs) then if c is + Pair(lhs, rhs) then + if lhs is + IntType() then if rhs is + IntType() then () + else error() + FunctionType(l1, r1) then if rhs is + FunctionType(l2, r2) then + solve(Cons(Pair(l2, l1), cs)) + solve(Cons(Pair(r1, r2), cs)) + else error() + RecordType(f) then TODO() + TypeVariable(id, lvl, lbs, ubs) then + // Handle unification case here + error() // Placeholder for unification logic + + +fun solve = case + Nil then () + Cons(c, cs) and c is + Pair(lhs, rhs) and lhs is + IntType() and rhs is + IntType() then () + else error() + FunctionType(l1, r1) and rhs is + FunctionType(l2, r2) then + solve(Cons(Pair(l2, l1), cs)) + solve(Cons(Pair(r1, r2), cs)) + else error() + RecordType(f) then TODO() + TypeVariable(id, lvl, lbs, ubs) then + // Handle unification case here + error() // Placeholder for unification logic + +solve +//│ = [function] +//│ Type: (List[out PairOf[out Type[?], out Type[?]]] ∧ List[?]) -> () + + diff --git a/hkmc2/shared/src/test/mlscript/bbml/bbCyclicExtrude.mls b/hkmc2/shared/src/test/mlscript/invalml/invalCyclicExtrude.mls similarity index 89% rename from hkmc2/shared/src/test/mlscript/bbml/bbCyclicExtrude.mls rename to hkmc2/shared/src/test/mlscript/invalml/invalCyclicExtrude.mls index 8f73e09a5a..bff6c8b33c 100644 --- a/hkmc2/shared/src/test/mlscript/bbml/bbCyclicExtrude.mls +++ b/hkmc2/shared/src/test/mlscript/invalml/invalCyclicExtrude.mls @@ -1,7 +1,5 @@ -:bbml -//│ Type: ⊤ +:invalml -//│ Type: ⊤ let f = (x => (x as [A] -> A -> A)) in f @@ -21,11 +19,10 @@ f => (let g = x => x(x) in f(g(g))) as [A] -> A -> A :e f => (let g = x => f(x(x)) in g) as [A] -> A -> A //│ ╔══[ERROR] Type error in block with expected type (A) ->{⊥} A -//│ ║ l.22: f => (let g = x => f(x(x)) in g) as [A] -> A -> A +//│ ║ l.20: f => (let g = x => f(x(x)) in g) as [A] -> A -> A //│ ║ ^^^^^^^^^^^^^^^^^ //│ ╟── because: cannot constrain ('x) ->{'eff ∨ 'eff1} ('app) <: (A) ->{⊥} (A) //│ ╟── because: cannot constrain A <: 'x -//│ ╟── because: cannot constrain A <: 'x //│ ╙── because: cannot constrain A <: ('x) ->{'eff1} ('app1) //│ Type: (⊥ -> ⊥) ->{⊥} ['A] -> ('A) ->{⊥} 'A @@ -48,9 +45,8 @@ let foo(f) = (f(x => x(x)) as [A] -> A -> A) in foo :todo fun foo(f) = (f(x => x(x)) as [A] -> A -> A) //│ ╔══[ERROR] Expected a monomorphic type or an instantiable type here, but ('f) ->{⊥} [outer, 'A] -> ('A) ->{⊥} 'A found -//│ ║ l.49: fun foo(f) = (f(x => x(x)) as [A] -> A -> A) +//│ ║ l.46: fun foo(f) = (f(x => x(x)) as [A] -> A -> A) //│ ╙── ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ -//│ Type: ⊤ f => (let g = x => x(x) in let tmp = g(g) in f(g)) as [A] -> A -> A diff --git a/hkmc2/shared/src/test/mlscript/invalml/invalDP.mls b/hkmc2/shared/src/test/mlscript/invalml/invalDP.mls new file mode 100644 index 0000000000..d80a39efb2 --- /dev/null +++ b/hkmc2/shared/src/test/mlscript/invalml/invalDP.mls @@ -0,0 +1,334 @@ +:js + +:global +:invalml + + +declare class Array[T] + +fun mkArray: [T] -> () -> Array[T] +fun mkArray() = @untyped globalThis.Array() + +fun mkArrayWith: [T] -> (T, Int) -> Array[T] +fun mkArrayWith(iv, size) = @untyped globalThis.Array(size).fill(iv) + +fun at: [T] -> (Array[T], Int) -> T +fun at(xs, i) = @untyped xs.at(i) + +fun splice: [T] -> (Array[T], Int, T) -> () +fun splice(xs, i, v) = @untyped xs.splice(i, 1, v); () + +class Option[A] with + constructor + Some(x: A) + None() + + +class ArrayList[T, out R](val d: Array[T]) +class Iter[T, out R](val arr: Array[T], val i: Ref[Int, out R], val step: Int, val end: Int) +class Array2D[T, out R](val d: Array[Array[T]]) + +class Interviewee with + constructor + Itv(score: Int, salary: Int) + + +fun debug: Any -> () +fun debug(s) = @untyped print(s) + + +fun (;) seq(_, res) = res + +fun toString: Any -> Str +fun toString(x) = @untyped x.toString() + +fun concat: (Str, Str) -> Str +fun concat(x, y) = @untyped x + y + +fun println: Str -> () +fun println(s) = @untyped print(s) + +fun empty: [A, R] -> Region[out R] ->{R} ArrayList[A, R] +fun empty(r) = new ArrayList(mkArray()) + +fun push: [A, R] -> (ArrayList[A, R], A) ->{R} () +fun push(arr, e) = @untyped arr.ArrayList#d.push(e); () + +fun len: [A, R] -> (ArrayList[A, R]) ->{R} Int +fun len(arr) = @untyped arr.ArrayList#d.length + +fun iter: [Res, R, E extends ~R, T] -> (ArrayList[T, R], [S] -> Iter[T, S] ->{S | E} Res) ->{E | R} Res +fun iter(arr, f) = + region r in f(new Iter(arr.ArrayList#d, (r.ref 0), 1, len(arr))) + +fun revIter: [Res, R, E extends ~R, T] -> (ArrayList[T, R], [S] -> Iter[T, S] ->{S | E} Res) ->{E | R} Res +fun revIter(arr, f) = + region r in f(new Iter(arr.ArrayList#d, (r.ref (len(arr) - 1)), 0 - 1, 0 - 1)) + +fun next: [T, S] -> Iter[T, S] ->{S} Option[T] +fun next(it) = + let i = !it.Iter#i + if i == it.Iter#end then None() + else + let res = Some(at of it.Iter#arr, i) + it.Iter#i := i + it.Iter#step + res + +fun whileDo: [R] -> (() ->{R} Bool) ->{R} () +fun whileDo(f) = + if f() then whileDo(f) else () + +fun init: [A, R] -> (Region[out R], Int, Int, A) ->{R} Array2D[A, R] +fun init(r, d1, d2, iv) = + let res = new Array2D(mkArrayWith(mkArrayWith(iv, d2), d1)) + region r in + let i = r.ref 0 + whileDo of () => + if !i == d1 then false + else + splice(res.Array2D#d, !i, mkArrayWith(iv, d2)) + i := !i + 1 + true + res + +fun update: [A, R] -> (Array2D[A, R], Int, Int, A) ->{R} () +fun update(arr, d1, d2, v) = splice(at(arr.Array2D#d, d1), d2, v) + +fun get: [A, R] -> (Array2D[A, R], Int, Int) ->{R} A +fun get(arr, d1, d2) = at(at(arr.Array2D#d, d1), d2) + +fun max: (Int, Int) -> Int +fun max(x, y) = if x > y then x else y + + +fun format(it) = + if it is Itv(score, salary) then + concat("interviewee score: ", concat(toString(score), concat(", salary: ", toString(salary)))) + + +fun printAll(arr) = + iter of arr, it => + whileDo of () => + if next(it) is + Some(x) then println(format(x)); true + None then false + + +// fun select: [outer, R1 extends outer, R2 extends ~R1] -> (ArrayList[Interviewee, R1], Int, ArrayList[Interviewee, R2]) ->{R1 | R2} Int +fun select(interviewees, budget, results) = + region r in + let size = len(interviewees), let i = r.ref 1 + let dp = init(r, size + 1, budget + 1, 0) + iter of interviewees, it => whileDo of () => + if next(it) is + Some(itv) then if itv is Itv(score, salary) then + let j = r.ref 0 + whileDo of () => + if !j < salary then update(dp, !i, !j, get(dp, !i - 1, !j)) + else + let p = get(dp, !i - 1, !j - salary), let np = get(dp, !i - 1, !j) + update(dp, !i, !j, max of np, p + score) + j := !j + 1; !j <= budget + i := !i + 1 + true + None then false + i := size + let rest = r.ref budget + revIter of interviewees, it => + whileDo of () => + if next(it) is + Some(itv) then if itv is Itv(score, salary) then + if get(dp, !i, !rest) == get(dp, !i - 1, !rest - salary) + score + do push(results, itv); rest := !rest - salary + i := !i - 1 + true + None then false + get(dp, size, budget) + +select +//│ = [function select] +//│ Type: [outer, 'A, 'R, 'T, 'R1, 'T1, 'T2, 'R2, 'A1, 'R3] -> ((ArrayList[in 'T1 out 'T2, out 'R2] ∧ ArrayList[in 'T out Interviewee ∧ 'T, out 'R1]) ∧ ArrayList['A, out 'R], Int, ArrayList['A1, out 'R3]) ->{(('R2 ∨ 'R3) ∨ 'R1) ∨ 'R} Int +//│ Where: +//│ 'T <: Interviewee +//│ 'T <: 'T1 +//│ 'R <: outer +//│ 'R1 <: outer +//│ 'T <: 'A +//│ 'R2 <: ¬'R + +region r in + let interviewees = empty(r) + push(interviewees, Itv(20, 3)) + push(interviewees, Itv(50, 1)) + push(interviewees, Itv(30, 1)) + println("all interviewees:") + printAll(interviewees) + region r2 in + let results = empty(r2) + let m = select(interviewees, 4, results) + println("candidates:") + printAll(results) + m +//│ > all interviewees: +//│ > interviewee score: 20, salary: 3 +//│ > interviewee score: 50, salary: 1 +//│ > interviewee score: 30, salary: 1 +//│ > candidates: +//│ > interviewee score: 30, salary: 1 +//│ > interviewee score: 50, salary: 1 +//│ = 80 +//│ Type: Int + + +region r in + let interviewees = empty(r) + push(interviewees, Itv(100, 71)) + push(interviewees, Itv(1, 69)) + push(interviewees, Itv(2, 1)) + println("all interviewees:") + printAll(interviewees) + region r2 in + let results = empty(r2) + let m = select(interviewees, 70, results) + println("candidates:") + printAll(results) + m +//│ > all interviewees: +//│ > interviewee score: 100, salary: 71 +//│ > interviewee score: 1, salary: 69 +//│ > interviewee score: 2, salary: 1 +//│ > candidates: +//│ > interviewee score: 2, salary: 1 +//│ > interviewee score: 1, salary: 69 +//│ = 3 +//│ Type: Int + + +region r in + let interviewees = empty(r) + push(interviewees, Itv(40, 10)) + push(interviewees, Itv(60, 20)) + push(interviewees, Itv(120, 30)) + push(interviewees, Itv(70, 20)) + println("all interviewees:") + printAll(interviewees) + region r2 in + let results = empty(r2) + let m = select(interviewees, 60, results) + println("candidates:") + printAll(results) + m +//│ > all interviewees: +//│ > interviewee score: 40, salary: 10 +//│ > interviewee score: 60, salary: 20 +//│ > interviewee score: 120, salary: 30 +//│ > interviewee score: 70, salary: 20 +//│ > candidates: +//│ > interviewee score: 70, salary: 20 +//│ > interviewee score: 120, salary: 30 +//│ > interviewee score: 40, salary: 10 +//│ = 230 +//│ Type: Int + + +:e +region r in + let interviewees = empty(r) + push(interviewees, Itv(20, 3)) + push(interviewees, Itv(50, 1)) + push(interviewees, Itv(30, 1)) + let results = empty(r) + let m = select(interviewees, 4, results) + println("candidates:") + printAll(results) + m +// //│ ╔══[ERROR] Type error in reference with expected type 'results +// //│ ║ l.110: let m = select(interviewees, 4000, results) +// //│ ║ ^^^^^^^ +// //│ ╟── because: cannot constrain ArrayList['A, in ⊥ out 'R] <: 'results +// //│ ╟── because: cannot constrain ArrayList['A, in ⊥ out 'R] <: ArrayList['A1, in ⊥ out 'R1] +// //│ ╟── because: cannot constrain 'R <: 'R1 +// //│ ╟── because: cannot constrain 'R <: ¬'R2 +// //│ ╟── because: cannot constrain 'R2 <: ¬'R +// //│ ╟── because: cannot constrain 'R3 <: ¬'R +// //│ ╟── because: cannot constrain 'R <: ¬'R3 +// //│ ╟── because: cannot constrain r <: ¬'R3 +// //│ ╟── because: cannot constrain 'R3 <: ¬r +// //│ ╙── because: cannot constrain r <: ¬r +// //│ Type: Int +//│ > candidates: +//│ > interviewee score: 30, salary: 1 +//│ > interviewee score: 50, salary: 1 +//│ = 80 +//│ ╔══[ERROR] Type error in reference with expected type 'results +//│ ║ l.241: let m = select(interviewees, 4, results) +//│ ║ ^^^^^^^ +//│ ╟── because: cannot constrain ArrayList['A, in ⊥ out 'R] <: 'results +//│ ╟── because: cannot constrain ArrayList['A, in ⊥ out 'R] <: ArrayList['A1, in ⊥ out 'R1] +//│ ╟── because: cannot constrain 'R <: 'R1 +//│ ╟── because: cannot constrain 'R <: ¬'R2 +//│ ╟── because: cannot constrain 'R2 <: ¬'R +//│ ╟── because: cannot constrain 'R3 <: ¬'R +//│ ╟── because: cannot constrain 'R <: ¬'R3 +//│ ╟── because: cannot constrain r <: ¬'R3 +//│ ╟── because: cannot constrain 'R3 <: ¬r +//│ ╙── because: cannot constrain r <: ¬r +//│ Type: Int + + +fun wrongSelect(interviewees, budget, results) = + region r in + let size = len(interviewees), let i = r.ref 1 + let dp = init(r, size + 1, budget + 1, 0) + iter of interviewees, it => + whileDo of () => + if next(it) is + Some(itv) then if itv is Itv(score, salary) then + let j = r.ref 0 + whileDo of () => + if !j < salary then update(dp, !i, !j, get(dp, !i - 1, !j)) + else + let p = get(dp, !i - 1, !j - salary), let np = get(dp, !i - 1, !j) + update(dp, !i, !j, max of np, p + score) + j := !j + 1; !j <= budget + i := !i + 1 + true + None then false + i := size + let rest = r.ref budget + revIter of interviewees, it => + whileDo of () => + if next(it) is + Some(itv) then if itv is Itv(score, salary) then + if get(dp, !i, !rest) == get(dp, !i - 1, !rest - salary) + score + do push(interviewees, itv); rest := !rest - salary + i := !i - 1 + true + None then false + get(dp, size, budget) + +:e +region r in + let interviewees = empty(r) + push(interviewees, Itv(20, 3000)) + push(interviewees, Itv(50, 1000)) + push(interviewees, Itv(30, 1000)) + region r2 in + let results = empty(r2) + let m = wrongSelect(interviewees, 4000, results) + println("candidates:") + printAll(results) + m +//│ > candidates: +//│ = 80 +//│ ╔══[ERROR] Type error in reference with expected type 'interviewees +//│ ║ l.318: let m = wrongSelect(interviewees, 4000, results) +//│ ║ ^^^^^^^^^^^^ +//│ ╟── because: cannot constrain ArrayList['A, in ⊥ out 'R] <: 'interviewees +//│ ╟── because: cannot constrain ArrayList['A, in ⊥ out 'R] <: ArrayList[in 'T out 'T1, in ⊥ out 'R1] +//│ ╟── because: cannot constrain 'R <: 'R1 +//│ ╟── because: cannot constrain 'R <: ¬'R +//│ ╟── because: cannot constrain 'R <: ⊥ +//│ ╙── because: cannot constrain r <: ⊥ +//│ Type: Int + diff --git a/hkmc2/shared/src/test/mlscript/invalml/invalDisjoint.mls b/hkmc2/shared/src/test/mlscript/invalml/invalDisjoint.mls new file mode 100644 index 0000000000..ba855f4cbb --- /dev/null +++ b/hkmc2/shared/src/test/mlscript/invalml/invalDisjoint.mls @@ -0,0 +1,277 @@ +:invalml + + + +data class Pair[P, Q](fst: P, snd: Q) + +fun fork: [A, B extends ~A, T1, T2] -> (Any ->{A} T1, Any ->{B} T2) ->{A | B} Pair[out T1, out T2] +fork +//│ Type: ['A, 'B, 'T1, 'T2] -> ((⊤) ->{'A} 'T1, (⊤) ->{'B} 'T2) ->{'A ∨ 'B} Pair[out 'T1, out 'T2] +//│ Where: +//│ 'B <: ¬'A + + +fun foo: Any -> Int +fun bar: Any -> Str + + +fork(foo, bar) +//│ Type: Pair[out Int, out Str] + + +:e +region x in + fork((_ => x.ref 1), (_ => x.ref 2)) +//│ ╔══[ERROR] Type error in function literal with expected type (⊤) ->{'B} 'T2 +//│ ║ l.24: fork((_ => x.ref 1), (_ => x.ref 2)) +//│ ║ ^^^^^^^ +//│ ╟── because: cannot constrain 'reg <: 'B +//│ ╟── because: cannot constrain x <: 'B +//│ ╟── because: cannot constrain x <: ¬'A +//│ ╟── because: cannot constrain 'A <: ¬x +//│ ╙── because: cannot constrain x <: ¬x +//│ Type: Pair[out Ref[Int, ?], out Ref[Int, ?]] + + + +region x in + region y in + fork((_ => x.ref 1), (_ => y.ref 2)) +//│ Type: Pair[out Ref[Int, ?], out Ref[Int, ?]] + + +let naive_helper = r1 => // cannot infer the outer variable! + region r2 in + fork((_ => r1.ref 1), (_ => r2.ref 2)) +naive_helper +//│ Type: (Region[out 'reg]) ->{'reg} Pair[out Ref[Int, out 'reg], out Ref[Int, ?]] +//│ Where: +//│ 'reg <: ⊥ + + +fun f: [S, R, R extends ~S] -> (Region[out S], Region[out R]) ->{S | R} Int + +:e +region r1 in + let g = (r => region r2 in f(r, r2)) in + region r3 in g(r3) +//│ ╔══[ERROR] Type error in reference with expected type 'r +//│ ║ l.57: region r3 in g(r3) +//│ ║ ^^ +//│ ╟── because: cannot constrain Region[in ⊥ out r3] <: 'r +//│ ╟── because: cannot constrain Region[in ⊥ out 'r31] <: 'r +//│ ╟── because: cannot constrain Region[in ⊥ out 'r31] <: Region[in ⊥ out 'S] +//│ ╟── because: cannot constrain 'r31 <: 'S +//│ ╟── because: cannot constrain ¬r1 <: 'S +//│ ╟── because: cannot constrain ¬r1 <: ¬'r2 ∨ r1 +//│ ╟── because: cannot constrain 'r2 <: r1 +//│ ╙── because: cannot constrain ¬r1 <: r1 +//│ ╔══[ERROR] Type error in block +//│ ║ l.56: let g = (r => region r2 in f(r, r2)) in +//│ ║ ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ +//│ ║ l.57: region r3 in g(r3) +//│ ║ ^^^^^^^^^^^^^^^^^^^^^^ +//│ ╟── because: cannot constrain 'eff <: ⊥ +//│ ╟── because: cannot constrain ¬'r11 <: ⊥ +//│ ╟── because: cannot constrain ⊤ <: 'r11 +//│ ╙── because: cannot constrain ⊤ <: ⊥ +//│ Type: Int + +fun g(r) = + region r2 in f(r, r2) + +region r1 in + region r3 in g(r3) +//│ Type: Int + + +:e +region x in + naive_helper(x) +//│ ╔══[ERROR] Type error in reference with expected type 'r1 +//│ ║ l.90: naive_helper(x) +//│ ║ ^ +//│ ╟── because: cannot constrain Region[in ⊥ out x] <: 'r1 +//│ ╟── because: cannot constrain Region[in ⊥ out 'x1] <: 'r1 +//│ ╟── because: cannot constrain Region[in ⊥ out 'x1] <: Region[in ⊥ out 'reg] +//│ ╟── because: cannot constrain 'x1 <: 'reg +//│ ╟── because: cannot constrain ⊤ <: 'reg +//│ ╙── because: cannot constrain ⊤ <: ⊥ +//│ ╔══[ERROR] Type error in block +//│ ║ l.90: naive_helper(x) +//│ ║ ^^^^^^^^^^^^^^^ +//│ ╟── because: cannot constrain 'eff <: ⊥ +//│ ╟── because: cannot constrain ¬'x2 ∧ 'eff1 <: ⊥ +//│ ╟── because: cannot constrain 'eff1 <: 'x2 +//│ ╟── because: cannot constrain 'eff1 <: ⊥ +//│ ╟── because: cannot constrain 'reg <: ⊥ +//│ ╙── because: cannot constrain ⊤ <: ⊥ +//│ Type: Pair[out Ref[Int, ?], out Ref[Int, ?]] + + +fun helper(r1) = + region r2 in + fork((_ => r1.ref 1), (_ => r2.ref 2)) +helper +//│ Type: [outer, 'reg] -> Region[out 'reg] ->{'reg} Pair[out Ref[Int, out 'reg], out Ref[Int, out ¬outer]] +//│ Where: +//│ 'reg <: outer + + +region x in + helper(x) +//│ Type: Pair[out Ref[Int, ?], out Ref[Int, ?]] + + +region x in + (region y in let t = helper(y) in 42) as [A] -> Int +//│ Type: Int + + +region x in + region y in + let t = helper(x) in 42 +//│ Type: Int + + +:e +region x in + (region y in let t = helper(x) in 42) as [A] -> Int +//│ ╔══[ERROR] Type error in region expression with expected type [outer, 'A] -> Int +//│ ║ l.139: (region y in let t = helper(x) in 42) as [A] -> Int +//│ ║ ^^^^^^^^^^^^^^^ +//│ ╟── because: cannot constrain 'eff <: ⊥ +//│ ╟── because: cannot constrain ¬'y ∧ x <: ⊥ +//│ ╟── because: cannot constrain x <: 'y +//│ ╙── because: cannot constrain x <: ⊥ +//│ Type: Int + + +fun anno: [outer A] -> Int ->{A} Int + + +fun anno2: [outer] -> Int ->{outer} Int + + +:e +fun badanno: outer +//│ ═══[ERROR] Illegal outer reference. +//│ ═══[ERROR] Invalid type + +:e +fun badanno2: [outer A, outer B] -> Int ->{A | B} Int +//│ ╔══[ERROR] Only one outer variable can be bound. +//│ ║ l.162: fun badanno2: [outer A, outer B] -> Int ->{A | B} Int +//│ ╙── ^^^^^^^^^^^^^^^^^^ +//│ ╔══[ERROR] Illegal forall annotation. +//│ ║ l.162: fun badanno2: [outer A, outer B] -> Int ->{A | B} Int +//│ ╙── ^^^^^^^^^^^^^^^^^^ +//│ ═══[ERROR] Invalid type + + +fun annohelper: [outer, T extends outer] -> Region[out T] ->{T} Pair[out Ref[Int, out T], out Ref[Int, out ~outer]] +fun annohelper(r1) = + region r2 in + fork((_ => r1.ref 1), (_ => r2.ref 2)) +annohelper +//│ Type: [outer, 'T] -> (Region[out 'T]) ->{'T} Pair[out Ref[Int, out 'T], out Ref[Int, out ¬outer]] +//│ Where: +//│ 'T <: outer + + +region x in + annohelper(x) +//│ Type: Pair[out Ref[Int, ?], out Ref[Int, ?]] + + +fun annohelper: [outer, T] -> Region[out T & outer] ->{T & outer} Pair[out Ref[Int, out T & outer], out Ref[Int, out ~outer]] +fun annohelper(r1) = + region r2 in + fork((_ => r1.ref 1), (_ => r2.ref 2)) +annohelper +//│ Type: [outer, 'T] -> (Region[out 'T ∧ outer]) ->{'T ∧ outer} Pair[out Ref[Int, out 'T ∧ outer], out Ref[Int, out ¬outer]] + + +region x in + annohelper(x) +//│ Type: Pair[out Ref[Int, out 'env], out Ref[Int, ?]] +//│ Where: +//│ ⊤ <: 'env + + +// Cannot type check since foo: 'foo <: Region[T] ->{'eff} 'app +// Annotation is required for recursive calls +:e +fun foo(r1) = + region r2 in + fork((_ => r1.ref 1), (_ => r2.ref 2)) + foo(r2) +//│ ╔══[ERROR] Type error in function literal +//│ ║ l.205: fun foo(r1) = +//│ ║ ^^^^^ +//│ ║ l.206: region r2 in +//│ ║ ^^^^^^^^^^^^^^ +//│ ║ l.207: fork((_ => r1.ref 1), (_ => r2.ref 2)) +//│ ║ ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ +//│ ║ l.208: foo(r2) +//│ ║ ^^^^^^^^^^^ +//│ ╟── because: cannot constrain ('r1) ->{'eff} ('app) <: 'foo +//│ ╟── because: cannot constrain ('r1) ->{'eff} ('app) <: (Region[in ⊥ out 'r2]) ->{'eff1} ('app1) +//│ ╟── because: cannot constrain Region[in ⊥ out 'r2] <: 'r1 +//│ ╟── because: cannot constrain Region[in ⊥ out 'r2] <: Region[in ⊥ out 'reg] +//│ ╟── because: cannot constrain 'r2 <: 'reg +//│ ╟── because: cannot constrain ¬outer <: 'reg +//│ ╟── because: cannot constrain ¬outer <: ¬'r21 ∨ outer +//│ ╟── because: cannot constrain 'r21 <: outer +//│ ╙── because: cannot constrain ¬outer <: outer + + +fun foo: [outer S, T extends S] -> Region[out T] ->{T} Nothing +fun foo(r1) = + region r2 in + foo(r2) +foo +//│ Type: [outer S, 'T] -> (Region[out 'T]) ->{'T} ⊥ +//│ Where: +//│ 'T <: S + + +fun foo: [outer To, T extends To] -> Region[out T] ->{T} ([outer So, S extends So] -> Region[S]->{S} Pair[out Ref[Int, out S], out Ref[Int, out Any]]) +fun foo(r1) = + r3 => + region r4 in + fork((_ => r3.ref 3), (_ => r4.ref 4)) + + +fun bar: [outer S, T extends S] -> Region[out T] ->{T} Int + + +bar as [outer Q, P extends Q] -> Region[P] ->{P} Int +//│ Type: [outer Q, 'P] -> (Region['P]) ->{'P} Int +//│ Where: +//│ 'P <: Q + + +fun foo: [outer To, T extends To] -> Region[out T] ->{T} ([outer So, S extends So] -> Region[out S]->{S} Int) +fun foo(r1) = bar +foo +//│ Type: [outer To, 'T] -> (Region[out 'T]) ->{'T} [outer So, 'S] -> (Region[out 'S]) ->{'S} Int +//│ Where: +//│ 'T <: To +//│ 'S <: So + + +fun borrow: [S, T, E extends ~S] -> Region[out S] -> ([P] -> Region[out P] ->{E | P} T) ->{E} T + + +fun foo(f) = + region r in + let x = r.ref 0 + f(n => x := n) + borrow(r) of it => + foo(f) +foo +//│ Type: [outer, 'n, 'eff] -> (('n ->{¬outer} ('n ∨ Int)) ->{'eff} ⊤) ->{'eff} ⊥ +//│ Where: +//│ 'n <: Int +//│ 'eff <: outer diff --git a/hkmc2/shared/src/test/mlscript/bbml/bbEffectAnnots.mls b/hkmc2/shared/src/test/mlscript/invalml/invalEffectAnnots.mls similarity index 58% rename from hkmc2/shared/src/test/mlscript/bbml/bbEffectAnnots.mls rename to hkmc2/shared/src/test/mlscript/invalml/invalEffectAnnots.mls index 1d2db56d35..88cea0b34f 100644 --- a/hkmc2/shared/src/test/mlscript/bbml/bbEffectAnnots.mls +++ b/hkmc2/shared/src/test/mlscript/invalml/invalEffectAnnots.mls @@ -1,23 +1,15 @@ -:bbml -//│ Type: ⊤ +:invalml -//│ Type: ⊤ fun foo: Int ->{Int} Int -//│ Type: ⊤ fun foo: Int ->{Int} Int -//│ Type: ⊤ fun foo: Int -> Int ->{Int} Int -//│ Type: ⊤ fun foo: Int ->{Int} Int -> Int -//│ Type: ⊤ fun foo: Int ->{Int} Int ->{Int} Int -//│ Type: ⊤ fun foo: [A] -> Int ->{A} Int -//│ Type: ⊤ diff --git a/hkmc2/shared/src/test/mlscript/bbml/bbErrors.mls b/hkmc2/shared/src/test/mlscript/invalml/invalErrors.mls similarity index 78% rename from hkmc2/shared/src/test/mlscript/bbml/bbErrors.mls rename to hkmc2/shared/src/test/mlscript/invalml/invalErrors.mls index 8e44e7326c..861ce9698b 100644 --- a/hkmc2/shared/src/test/mlscript/bbml/bbErrors.mls +++ b/hkmc2/shared/src/test/mlscript/invalml/invalErrors.mls @@ -1,31 +1,28 @@ -:bbml -//│ Type: ⊤ +:invalml :e -//│ Type: ⊤ 2(2) //│ ╔══[ERROR] Type error in application -//│ ║ l.7: 2(2) +//│ ║ l.5: 2(2) //│ ║ ^^^^ //│ ╙── because: cannot constrain Int <: (Int) ->{'eff} ('app) //│ Type: ⊥ (x => x(0))(1) //│ ╔══[ERROR] Type error in integer literal with expected type 'x -//│ ║ l.14: (x => x(0))(1) +//│ ║ l.12: (x => x(0))(1) //│ ║ ^ //│ ╟── because: cannot constrain Int <: 'x -//│ ╟── because: cannot constrain Int <: 'x //│ ╙── because: cannot constrain Int <: (Int) ->{'eff} ('app) //│ Type: ⊥ (1).Foo#a() //│ ╔══[ERROR] Name not found: Foo -//│ ║ l.23: (1).Foo#a() +//│ ║ l.20: (1).Foo#a() //│ ╙── ^^^^ //│ ╔══[ERROR] Identifier `Foo` does not name a known class symbol. -//│ ║ l.23: (1).Foo#a() +//│ ║ l.20: (1).Foo#a() //│ ╙── ^^^^ //│ ═══[ERROR] Not a valid class: //│ Type: ⊥ @@ -34,20 +31,20 @@ fun Oops() = 1 Oops().Oops#a() //│ ╔══[ERROR] Identifier `Oops` does not name a known class symbol. -//│ ║ l.35: Oops().Oops#a() +//│ ║ l.32: Oops().Oops#a() //│ ╙── ^^^^^ //│ ╔══[ERROR] Not a valid class: selection -//│ ║ l.35: Oops().Oops#a() +//│ ║ l.32: Oops().Oops#a() //│ ╙── ^^^^^ //│ Type: ⊥ data class Oops2() (new Oops2()).Oops2#a() //│ ╔══[ERROR] Class 'Oops2' does not contain member 'a'. -//│ ║ l.45: (new Oops2()).Oops2#a() +//│ ║ l.42: (new Oops2()).Oops2#a() //│ ╙── ^ //│ ╔══[ERROR] a is not a valid member in class Oops2 -//│ ║ l.45: (new Oops2()).Oops2#a() +//│ ║ l.42: (new Oops2()).Oops2#a() //│ ╙── ^^^^^^^^^^^^^^^^ //│ Type: ⊥ @@ -56,17 +53,16 @@ data class Oops2() fun inc(x) = x + 1 inc("oops") //│ ╔══[ERROR] Type error in string literal with expected type 'x -//│ ║ l.57: inc("oops") +//│ ║ l.54: inc("oops") //│ ║ ^^^^^^ //│ ╟── because: cannot constrain Str <: 'x -//│ ╟── because: cannot constrain Str <: 'x //│ ╙── because: cannot constrain Str <: Int //│ Type: Int fun inc(x) = x + 1 inc as Int //│ ╔══[ERROR] Type error in reference with expected type Int -//│ ║ l.67: inc as Int +//│ ║ l.63: inc as Int //│ ║ ^^^ //│ ╙── because: cannot constrain ('x) ->{⊥} (Int) <: Int //│ Type: Int diff --git a/hkmc2/shared/src/test/mlscript/bbml/bbExtrude.mls b/hkmc2/shared/src/test/mlscript/invalml/invalExtrude.mls similarity index 82% rename from hkmc2/shared/src/test/mlscript/bbml/bbExtrude.mls rename to hkmc2/shared/src/test/mlscript/invalml/invalExtrude.mls index 23589a21e6..04f14d9962 100644 --- a/hkmc2/shared/src/test/mlscript/bbml/bbExtrude.mls +++ b/hkmc2/shared/src/test/mlscript/invalml/invalExtrude.mls @@ -1,10 +1,7 @@ -:bbml -//│ Type: ⊤ +:invalml -//│ Type: ⊤ fun f(y) = let local = ((x => y(x) + 1) as [A] -> A -> Int) in y -//│ Type: ⊤ // * the parameter type of y is extruded. f @@ -14,7 +11,6 @@ f fun foo: [A] -> A -> Int fun foo(x) = 0 -//│ Type: ⊤ foo //│ Type: (⊤) ->{⊥} Int @@ -25,7 +21,6 @@ f(foo) fun g: ([A] -> A -> Int) -> ([A] -> A -> Int) fun g(y) = let local = ((x => y(x) + 1) as ([A] -> A -> Int)) in y -//│ Type: ⊤ g //│ Type: ((⊤) ->{⊥} Int) ->{⊥} (⊤) ->{⊥} Int @@ -36,11 +31,10 @@ g(foo) :e y `=> (let t = run(x `=> x `+ y) in y) //│ ╔══[ERROR] Type error in quoted term with expected type CodeBase[out 'T, ⊥, ?] -//│ ║ l.37: y `=> (let t = run(x `=> x `+ y) in y) +//│ ║ l.32: y `=> (let t = run(x `=> x `+ y) in y) //│ ║ ^^^^^^^^^^^^ //│ ╟── because: cannot constrain CodeBase[in ⊥ out ('x) ->{⊥} ('cde), in ⊥ out 'ctx, in ⊥ out ⊤] <: CodeBase[in ⊥ out 'T, ⊥, in ⊥ out ⊤] //│ ╟── because: cannot constrain 'ctx <: ⊥ -//│ ╟── because: cannot constrain 'ctx <: ⊥ //│ ╟── because: cannot constrain ¬'x1 ∧ y <: ⊥ //│ ╟── because: cannot constrain y <: 'x1 //│ ╙── because: cannot constrain y <: ⊥ @@ -49,7 +43,6 @@ y `=> (let t = run(x `=> x `+ y) in y) //│ 'y <: Int data class C[A](m: A, n: A -> Int) -//│ Type: ⊤ fun f: [A] -> ([B] -> (C[out B] & A) -> B) -> A -> Int @@ -78,14 +71,11 @@ f(g)(foo) :fixme // ??? f(g)(bar) //│ ╔══[ERROR] Type error in reference with expected type 'A -//│ ║ l.79: f(g)(bar) +//│ ║ l.72: f(g)(bar) //│ ║ ^^^ //│ ╟── because: cannot constrain C[Int] <: 'A -//│ ╟── because: cannot constrain C[Int] <: 'A //│ ╟── because: cannot constrain C[Int] <: ¬{C[in ⊥ out ¬⊥ ∧ 'B]} ∨ C[in Int out 'D] //│ ╟── because: cannot constrain Int ∧ 'B <: 'D -//│ ╟── because: cannot constrain Int ∧ 'B <: 'D -//│ ╟── because: cannot constrain Int ∧ 'B <: 'B1 //│ ╟── because: cannot constrain Int ∧ 'B <: 'B1 //│ ╟── because: cannot constrain Int ∧ 'B <: ⊥ //│ ╟── because: cannot constrain 'B <: ¬{Int} @@ -101,9 +91,8 @@ k :e k(_ => "") //│ ╔══[ERROR] Type error in function literal with expected type 'x -//│ ║ l.102: k(_ => "") -//│ ║ ^^ -//│ ╟── because: cannot constrain ('_) ->{⊥} (Str) <: 'x +//│ ║ l.92: k(_ => "") +//│ ║ ^^ //│ ╟── because: cannot constrain ('_) ->{⊥} (Str) <: 'x //│ ╟── because: cannot constrain ('_) ->{⊥} (Str) <: (Int) ->{'eff} (Int) //│ ╙── because: cannot constrain Str <: Int @@ -124,10 +113,9 @@ k :e k(_ => "") //│ ╔══[ERROR] Type error in function literal with expected type 'x -//│ ║ l.125: k(_ => "") +//│ ║ l.114: k(_ => "") //│ ║ ^^ //│ ╟── because: cannot constrain ('_) ->{⊥} (Str) <: 'x -//│ ╟── because: cannot constrain ('_) ->{⊥} (Str) <: 'x //│ ╟── because: cannot constrain ('_) ->{⊥} (Str) <: (⊤) ->{⊥} ⊥ //│ ╙── because: cannot constrain Str <: ⊥ //│ Type: Int @@ -135,10 +123,9 @@ k(_ => "") :e k(_ => 42) //│ ╔══[ERROR] Type error in function literal with expected type 'x -//│ ║ l.136: k(_ => 42) +//│ ║ l.124: k(_ => 42) //│ ║ ^^ //│ ╟── because: cannot constrain ('_) ->{⊥} (Int) <: 'x -//│ ╟── because: cannot constrain ('_) ->{⊥} (Int) <: 'x //│ ╟── because: cannot constrain ('_) ->{⊥} (Int) <: (⊤) ->{⊥} ⊥ //│ ╙── because: cannot constrain Int <: ⊥ //│ Type: Int diff --git a/hkmc2/shared/src/test/mlscript/bbml/bbFunGenFix.mls b/hkmc2/shared/src/test/mlscript/invalml/invalFunGenFix.mls similarity index 78% rename from hkmc2/shared/src/test/mlscript/bbml/bbFunGenFix.mls rename to hkmc2/shared/src/test/mlscript/invalml/invalFunGenFix.mls index 3171b2b9e7..7b06743415 100644 --- a/hkmc2/shared/src/test/mlscript/bbml/bbFunGenFix.mls +++ b/hkmc2/shared/src/test/mlscript/invalml/invalFunGenFix.mls @@ -1,24 +1,17 @@ :global -:bbml -//│ Type: ⊤ +:invalml -//│ Type: ⊤ class Reg[out Rg, out AccI] -//│ Type: ⊤ class BaseEff -//│ Type: ⊤ fun basereg: Reg[Any, BaseEff] -//│ Type: ⊤ fun subreg: [E, Rg, AccI, Res] -> Reg[Rg, AccI] -> ([Rg2] -> Reg[Rg2 & AccI, AccI & ~Rg2] ->{E | Rg2} Res) ->{E} Res -//│ Type: ⊤ fun write: [Rg, AccI] -> Reg[Rg, AccI] ->{Rg} Int -//│ Type: ⊤ subreg(basereg) of r0 => @@ -28,7 +21,6 @@ subreg(basereg) of r0 => fun helper(a) = write(a) -//│ Type: ⊤ helper //│ Type: ['Rg] -> Reg[out 'Rg, ?] ->{'Rg} Int diff --git a/hkmc2/shared/src/test/mlscript/bbml/bbFuns.mls b/hkmc2/shared/src/test/mlscript/invalml/invalFuns.mls similarity index 51% rename from hkmc2/shared/src/test/mlscript/bbml/bbFuns.mls rename to hkmc2/shared/src/test/mlscript/invalml/invalFuns.mls index 8930015818..eacc13cd89 100644 --- a/hkmc2/shared/src/test/mlscript/bbml/bbFuns.mls +++ b/hkmc2/shared/src/test/mlscript/invalml/invalFuns.mls @@ -1,7 +1,5 @@ -:bbml -//│ Type: ⊤ +:invalml -//│ Type: ⊤ fun f(x, y) = x(y) f @@ -16,7 +14,6 @@ f(x => x, 42) fun id: [A] -> A -> A -//│ Type: ⊤ id as [A] -> A -> A //│ Type: ['A] -> ('A) ->{⊥} 'A @@ -29,7 +26,6 @@ id(id) as [A] -> A -> A data class Nil() data class Cons[A, B](val car: A, val cdr: B) data class Ls[A](prim: [R] -> (() -> R, (A, Ls[A]) -> R) -> R) -//│ Type: ⊤ fun nil() = new Ls((n, _) => n()) fun cons(p, q) = new Ls((n, r) => r(p, q)) @@ -37,7 +33,6 @@ fun from(x) = x.Ls#prim(() => new Nil, (x, y) => new Cons(x, from(y))) fun to(x) = if x is Nil then nil() Cons then cons(x.Cons#car, to(x.Cons#cdr)) -//│ Type: ⊤ let foo = nil() from() foo @@ -57,3 +52,26 @@ foo to() //│ ⊥ <: 'A1 //│ 'A1 <: 'A + +fun (;) seq(_, res) = res + +fun foo: [R1, R2] -> (Region[R1], Region[R2], Int ->{R1 & ~R2} (), Int ->{R2 & ~R1} ()) ->{R1 | R2} () +fun foo(r1, r2, f, g) = + f(123); g(456) + +foo +//│ Type: ['R1, 'R2] -> (Region['R1], Region['R2], (Int) ->{'R1 ∧ ¬'R2} (), (Int) ->{'R2 ∧ ¬'R1} ()) ->{'R1 ∨ 'R2} () + + +:e +fun foo[outer, R <: outer](r1: Region[R]) = + region r2 in 42 +//│ ═══[ERROR] Unsupported type parameter outer binding +//│ ╔══[ERROR] Unsupported type parameter operator application +//│ ║ l.67: fun foo[outer, R <: outer](r1: Region[R]) = +//│ ╙── ^^^^ +//│ ╔══[ERROR] Name not found: R +//│ ║ l.67: fun foo[outer, R <: outer](r1: Region[R]) = +//│ ╙── ^ +//│ ═══[ERROR] Expected a type symbol, got +//│ ═══[ERROR] Invalid type diff --git a/hkmc2/shared/src/test/mlscript/bbml/bbGPCE.mls b/hkmc2/shared/src/test/mlscript/invalml/invalGPCE.mls similarity index 93% rename from hkmc2/shared/src/test/mlscript/bbml/bbGPCE.mls rename to hkmc2/shared/src/test/mlscript/invalml/invalGPCE.mls index 5fd20effd7..2f023788bd 100644 --- a/hkmc2/shared/src/test/mlscript/bbml/bbGPCE.mls +++ b/hkmc2/shared/src/test/mlscript/invalml/invalGPCE.mls @@ -1,7 +1,5 @@ -:bbml -//│ Type: ⊤ +:invalml -//│ Type: ⊤ fun power: [C] -> CodeBase[out Num, out C, out Any] -> Int -> CodeBase[out Num, out C, out Any] fun power(x) = case @@ -13,7 +11,6 @@ power fun id: [A] -> A -> A fun id(x) = x -//│ Type: ⊤ run(x `=> id(x) `* x) @@ -52,7 +49,6 @@ fun body(x, y) = case fun gib_naive(n) = (x, y) `=> body(x, y)(n) let gn5 = run(gib_naive(5)) -//│ Type: ⊤ fun bind(rhs, k) = `let x = rhs `in k(x) bind @@ -65,15 +61,13 @@ fun body(x, y) = case 1 then y n then bind of x `+ y, (z => body(y, z)(n - 1)) //│ ╔══[ERROR] Type error in application with expected type CodeBase[out Int, out G, ?] -//│ ║ l.66: n then bind of x `+ y, (z => body(y, z)(n - 1)) +//│ ║ l.62: n then bind of x `+ y, (z => body(y, z)(n - 1)) //│ ║ ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ //│ ╟── because: cannot constrain CodeBase[in ⊥ out 'cde, in ⊥ out 'ctx ∨ 'ctx1, in ⊥ out ⊤] <: CodeBase[in ⊥ out Int, in ⊥ out G, in ⊥ out ⊤] //│ ╟── because: cannot constrain 'ctx ∨ 'ctx1 <: G //│ ╟── because: cannot constrain 'ctx1 <: G //│ ╟── because: cannot constrain 'ctx2 <: G -//│ ╟── because: cannot constrain 'ctx2 <: G //│ ╙── because: cannot constrain ⊤ <: G -//│ Type: ⊤ fun bind: [G] -> (CodeBase[out Int, out G, out Any], [C] -> CodeBase[out Int, out C, out Any] -> CodeBase[out Int, out C | G, out Any]) -> CodeBase[out Int, out G, out Any] fun bind(rhs, k) = `let x = rhs `in k(x) diff --git a/hkmc2/shared/src/test/mlscript/bbml/bbGetters.mls b/hkmc2/shared/src/test/mlscript/invalml/invalGetters.mls similarity index 81% rename from hkmc2/shared/src/test/mlscript/bbml/bbGetters.mls rename to hkmc2/shared/src/test/mlscript/invalml/invalGetters.mls index 3cc5d8ce31..e3f96920be 100644 --- a/hkmc2/shared/src/test/mlscript/bbml/bbGetters.mls +++ b/hkmc2/shared/src/test/mlscript/invalml/invalGetters.mls @@ -2,8 +2,7 @@ :noSanityCheck // * For some reason, these cause problems :global -:bbml -//│ Type: ⊤ +:invalml :todo @@ -11,18 +10,17 @@ fun test1() = fun sayHi = print("Hi") sayHi, sayHi, sayHi //│ ╔══[ERROR] Function definition shape not yet supported for sayHi -//│ ║ l.11: fun sayHi = print("Hi") +//│ ║ l.10: fun sayHi = print("Hi") //│ ╙── ^^^^^^^^^^^ //│ ╔══[ERROR] Variable not found: sayHi -//│ ║ l.12: sayHi, sayHi, sayHi +//│ ║ l.11: sayHi, sayHi, sayHi //│ ╙── ^^^^^ //│ ╔══[ERROR] Variable not found: sayHi -//│ ║ l.12: sayHi, sayHi, sayHi +//│ ║ l.11: sayHi, sayHi, sayHi //│ ╙── ^^^^^ //│ ╔══[ERROR] Variable not found: sayHi -//│ ║ l.12: sayHi, sayHi, sayHi +//│ ║ l.11: sayHi, sayHi, sayHi //│ ╙── ^^^^^ -//│ Type: ⊤ test1() //│ > Hi @@ -38,20 +36,18 @@ fun test2() = n then funny(n - 1) + 1 funny //│ ╔══[ERROR] Expected a monomorphic type or an instantiable type here, but () ->{⊥} [outer, 'caseScrut, 'eff] -> 'caseScrut ->{'eff} Int found -//│ ║ l.37: 0 then 0 +//│ ║ l.35: 0 then 0 //│ ║ ^^^^^^^^ -//│ ║ l.38: n then funny(n - 1) + 1 +//│ ║ l.36: n then funny(n - 1) + 1 //│ ║ ^^^^^^^^^^^^^^^^^^^^^^^^^^^ -//│ ║ l.39: funny +//│ ║ l.37: funny //│ ╙── ^^^^^^^ -//│ Type: ⊤ fun test2() = fun funny = case 0 then 0 n then funny(n - 1) + 1 funny(_) -//│ Type: ⊤ test2 //│ = [function test2] @@ -82,7 +78,7 @@ fun test2() = case n then funny(n - 1) + 1 funny //│ ╔══[WARNING] Pure expression in statement position -//│ ║ l.81: case 0 then 0 +//│ ║ l.77: case 0 then 0 //│ ╙── ^^^^^^^^ //│ JS (unsanitized): //│ let test22; @@ -104,25 +100,23 @@ fun test2() = //│ return tmp1 //│ }; //│ ╔══[WARNING] Pure expression in statement position -//│ ║ l.81: case 0 then 0 +//│ ║ l.77: case 0 then 0 //│ ╙── ^^^^^^^^ //│ ╔══[ERROR] Function definition shape not yet supported for funny -//│ ║ l.81: case 0 then 0 +//│ ║ l.77: case 0 then 0 //│ ║ ^^^^^^^^ -//│ ║ l.82: case n then funny(n - 1) + 1 +//│ ║ l.78: case n then funny(n - 1) + 1 //│ ╙── ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ //│ ╔══[ERROR] Variable not found: funny -//│ ║ l.83: funny +//│ ║ l.79: funny //│ ╙── ^^^^^ -//│ Type: ⊤ :todo fun test3 = print("Hi") //│ ╔══[ERROR] Function definition shape not yet supported for test3 -//│ ║ l.122: print("Hi") +//│ ║ l.117: print("Hi") //│ ╙── ^^^^^^^^^^^ -//│ Type: ⊤ diff --git a/hkmc2/shared/src/test/mlscript/bbml/bbId.mls b/hkmc2/shared/src/test/mlscript/invalml/invalId.mls similarity index 83% rename from hkmc2/shared/src/test/mlscript/bbml/bbId.mls rename to hkmc2/shared/src/test/mlscript/invalml/invalId.mls index 96d1536c59..ff00314ca0 100644 --- a/hkmc2/shared/src/test/mlscript/bbml/bbId.mls +++ b/hkmc2/shared/src/test/mlscript/invalml/invalId.mls @@ -1,10 +1,7 @@ -:bbml -//│ Type: ⊤ +:invalml -//│ Type: ⊤ fun id(x) = x -//│ Type: ⊤ id(1) //│ Type: Int @@ -20,7 +17,6 @@ id fun id(x) = x -//│ Type: ⊤ id as [A] -> A -> A //│ Type: ['A] -> ('A) ->{⊥} 'A diff --git a/hkmc2/shared/src/test/mlscript/bbml/bbLetRegEncoding.mls b/hkmc2/shared/src/test/mlscript/invalml/invalLetRegEncoding.mls similarity index 51% rename from hkmc2/shared/src/test/mlscript/bbml/bbLetRegEncoding.mls rename to hkmc2/shared/src/test/mlscript/invalml/invalLetRegEncoding.mls index 662e44cb61..008ea4f74e 100644 --- a/hkmc2/shared/src/test/mlscript/bbml/bbLetRegEncoding.mls +++ b/hkmc2/shared/src/test/mlscript/invalml/invalLetRegEncoding.mls @@ -1,40 +1,23 @@ -:bbml -//│ Type: ⊤ +:invalml -//│ Type: ⊤ -fun letreg: [E,Res] -> ([R] -> Region[R] ->{E | R} Res) ->{E} Res -//│ Type: ⊤ +fun letreg: [E,Res] -> ([R] -> Region[out R] ->{E | R} Res) ->{E} Res letreg -//│ Type: ['E, 'Res] -> (['R] -> (Region['R]) ->{'E ∨ 'R} 'Res) ->{'E} 'Res +//│ Type: ['E, 'Res] -> (['R] -> (Region[out 'R]) ->{'E ∨ 'R} 'Res) ->{'E} 'Res letreg(r => r) //│ Type: Region[?] :e letreg(r => r).ref 1 -//│ ╔══[ERROR] Type error in reference creation -//│ ║ l.17: letreg(r => r).ref 1 -//│ ║ ^^^^^^^^^^^^^^^^^^^^ -//│ ╟── because: cannot constrain 'Res <: Region['reg] -//│ ╟── because: cannot constrain 'Res <: Region['reg] -//│ ╟── because: cannot constrain Region[in 'R out 'R1] <: Region['reg] -//│ ╟── because: cannot constrain 'R1 <: 'reg -//│ ╟── because: cannot constrain 'R1 <: 'reg -//│ ╟── because: cannot constrain 'R1 <: 'R -//│ ╟── because: cannot constrain 'R1 <: 'R -//│ ╟── because: cannot constrain ⊤ <: 'R -//│ ╟── because: cannot constrain ⊤ <: 'R -//│ ╙── because: cannot constrain ⊤ <: ⊥ //│ ╔══[ERROR] Type error in block -//│ ║ l.17: letreg(r => r).ref 1 +//│ ║ l.14: letreg(r => r).ref 1 //│ ║ ^^^^^^^^^^^^^^^^^^^^ //│ ╟── because: cannot constrain 'reg ∨ 'E <: ⊥ //│ ╟── because: cannot constrain 'reg <: ⊥ -//│ ╟── because: cannot constrain 'R1 <: ⊥ -//│ ╟── because: cannot constrain 'R1 <: ⊥ +//│ ╟── because: cannot constrain 'R <: ⊥ //│ ╙── because: cannot constrain ⊤ <: ⊥ //│ Type: Ref[Int, ?] @@ -47,13 +30,11 @@ letreg(r => !(r.ref 1)) :e !letreg(r => r.ref 1) //│ ╔══[ERROR] Type error in block -//│ ║ l.48: !letreg(r => r.ref 1) +//│ ║ l.31: !letreg(r => r.ref 1) //│ ║ ^^^^^^^^^^^^^^^^^^^^ //│ ╟── because: cannot constrain 'reg ∨ 'E <: ⊥ //│ ╟── because: cannot constrain 'reg <: ⊥ //│ ╟── because: cannot constrain 'reg1 <: ⊥ -//│ ╟── because: cannot constrain 'reg1 <: ⊥ -//│ ╟── because: cannot constrain 'R <: ⊥ //│ ╟── because: cannot constrain 'R <: ⊥ //│ ╙── because: cannot constrain ⊤ <: ⊥ //│ Type: Int @@ -65,7 +46,6 @@ letreg of r => //│ Type: Int let f = letreg(r => arg => r.ref arg) -//│ Type: ⊤ f //│ Type: 'arg ->{⊤} Ref['arg, ?] @@ -73,13 +53,11 @@ f :e letreg(r => arg => r.ref arg)(0) //│ ╔══[ERROR] Type error in block -//│ ║ l.74: letreg(r => arg => r.ref arg)(0) +//│ ║ l.54: letreg(r => arg => r.ref arg)(0) //│ ║ ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ //│ ╟── because: cannot constrain 'eff ∨ 'E <: ⊥ //│ ╟── because: cannot constrain 'eff <: ⊥ //│ ╟── because: cannot constrain 'reg <: ⊥ -//│ ╟── because: cannot constrain 'reg <: ⊥ -//│ ╟── because: cannot constrain 'R <: ⊥ //│ ╟── because: cannot constrain 'R <: ⊥ //│ ╙── because: cannot constrain ⊤ <: ⊥ //│ Type: Ref['arg, ?] @@ -90,34 +68,25 @@ letreg(r => arg => r.ref arg)(0) // * An incorrect one, just for testing the error: -fun letreg: [E,Res] -> ([R] -> Region[R] -> Res) ->{E} Res -//│ Type: ⊤ +fun letreg: [E,Res] -> ([R] -> Region[out R] -> Res) ->{E} Res :e letreg(r => r.ref 1) -//│ ╔══[ERROR] Type error in function literal with expected type (Region[R]) ->{⊥} 'Res -//│ ║ l.97: letreg(r => r.ref 1) +//│ ╔══[ERROR] Type error in function literal with expected type (Region[out R]) ->{⊥} 'Res +//│ ║ l.74: letreg(r => r.ref 1) //│ ║ ^^^^^^^^^^^^ //│ ╟── because: cannot constrain 'reg <: ⊥ -//│ ╟── because: cannot constrain 'reg <: ⊥ //│ ╙── because: cannot constrain R <: ⊥ //│ Type: Ref[Int, ?] :e letreg(r => !(r.ref 1)) -//│ ╔══[ERROR] Type error in function literal with expected type (Region[R]) ->{⊥} 'Res -//│ ║ l.107: letreg(r => !(r.ref 1)) -//│ ║ ^^^^^^^^^^^^^^ +//│ ╔══[ERROR] Type error in function literal with expected type (Region[out R]) ->{⊥} 'Res +//│ ║ l.83: letreg(r => !(r.ref 1)) +//│ ║ ^^^^^^^^^^^^^^ //│ ╟── because: cannot constrain 'reg ∨ 'reg1 <: ⊥ //│ ╟── because: cannot constrain 'reg <: ⊥ //│ ╟── because: cannot constrain 'reg1 <: ⊥ -//│ ╟── because: cannot constrain 'reg1 <: ⊥ -//│ ╙── because: cannot constrain R <: ⊥ -//│ ╔══[ERROR] Type error in function literal with expected type (Region[R]) ->{⊥} 'Res -//│ ║ l.107: letreg(r => !(r.ref 1)) -//│ ║ ^^^^^^^^^^^^^^ -//│ ╟── because: cannot constrain 'reg ∨ 'reg1 <: ⊥ -//│ ╟── because: cannot constrain 'reg1 <: ⊥ //│ ╙── because: cannot constrain R <: ⊥ //│ Type: Int diff --git a/hkmc2/shared/src/test/mlscript/invalml/invalList.mls b/hkmc2/shared/src/test/mlscript/invalml/invalList.mls new file mode 100644 index 0000000000..6cfd7700f9 --- /dev/null +++ b/hkmc2/shared/src/test/mlscript/invalml/invalList.mls @@ -0,0 +1,64 @@ +:invalml + + + +data class List[A](inspect: [E, Res] -> (() ->{E} Res, (A, List[A]) ->{E} Res) ->{E} Res) + +fun map: [A, B, E] -> List[out A] -> (A ->{E} B) ->{E} List[out B] + + +// * Dummy implementation +fun mapi: [A, E] -> List[out A] -> ((Int, A) ->{E} A) ->{E} List[out A] +fun mapi = s => f => + region r in + map(s) of x => f(0, x) + +fun mapi: [A, E] -> List[out A] -> ((Int, A) ->{E} A) ->{E} List[out A] +fun mapi = s => f => + region r in + let i = r.ref 0 + map(s) of x => + i := !i + 1 + f(!i, x) + +// * Example usage + +fun mkList: [A] -> A -> List[out A] +fun head: [A] -> List[out A] -> A + +region r in + let sum = r.ref 0 + let s1 = mkList of !sum + let s2 = mapi(s1) of (x, i) => x * i + !sum + head(s2) +//│ Type: Int + + +// * Should be an error. This definition would not be referentially transparent. +// * The error message needs improvement, though. +:e +fun mapi: [A, E] -> List[out A] -> ((Int, A) ->{E} A) ->{E} List[out A] +fun mapi = s => + region r in + let i = r.ref 0 + f => map(s) of x => + i := !i + 1 + f(!i, x) +//│ ╔══[ERROR] Type error in region expression with expected type ((Int, A) ->{E} A) ->{E} List[out A] +//│ ║ l.43: let i = r.ref 0 +//│ ║ ^^^^^^^ +//│ ║ l.44: f => map(s) of x => +//│ ║ ^^^^^^^^^^^^^^^^^^^^^^^ +//│ ║ l.45: i := !i + 1 +//│ ║ ^^^^^^^^^^^^^^^^^ +//│ ║ l.46: f(!i, x) +//│ ║ ^^^^^^^^^^^^^^ +//│ ╟── because: cannot constrain ('f) ->{'E1} (List[in ⊥ out 'B]) <: ((Int, A) ->{E} (A)) ->{E} (List[in ⊥ out A]) +//│ ╟── because: cannot constrain 'E1 <: E +//│ ╟── because: cannot constrain 'reg <: E +//│ ╟── because: cannot constrain 'r ∧ ¬outer <: E +//│ ╟── because: cannot constrain 'r <: E ∨ outer +//│ ╙── because: cannot constrain ¬outer <: E ∨ outer + + + diff --git a/hkmc2/shared/src/test/mlscript/bbml/bbOption.mls b/hkmc2/shared/src/test/mlscript/invalml/invalOption.mls similarity index 93% rename from hkmc2/shared/src/test/mlscript/bbml/bbOption.mls rename to hkmc2/shared/src/test/mlscript/invalml/invalOption.mls index 12253e77c7..57bb993980 100644 --- a/hkmc2/shared/src/test/mlscript/bbml/bbOption.mls +++ b/hkmc2/shared/src/test/mlscript/invalml/invalOption.mls @@ -1,10 +1,7 @@ -:bbml -//│ Type: ⊤ +:invalml -//│ Type: ⊤ data class Option[out A](inspect: [E, Res] -> (() ->{E} Res, A ->{E} Res) ->{E} Res) -//│ Type: ⊤ opt => opt.Option#inspect //│ Type: (Option[out 'A]) ->{⊥} ['E, 'Res] -> (() ->{'E} 'Res, ('A) ->{'E} 'Res) ->{'E} 'Res diff --git a/hkmc2/shared/src/test/mlscript/bbml/bbPoly.mls b/hkmc2/shared/src/test/mlscript/invalml/invalPoly.mls similarity index 87% rename from hkmc2/shared/src/test/mlscript/bbml/bbPoly.mls rename to hkmc2/shared/src/test/mlscript/invalml/invalPoly.mls index a66aa7ec02..617882047c 100644 --- a/hkmc2/shared/src/test/mlscript/bbml/bbPoly.mls +++ b/hkmc2/shared/src/test/mlscript/invalml/invalPoly.mls @@ -1,7 +1,5 @@ -:bbml -//│ Type: ⊤ +:invalml -//│ Type: ⊤ 42 as [A] -> Int //│ Type: Int @@ -9,14 +7,13 @@ :e 42 as [A] -> Str //│ ╔══[ERROR] Type error in integer literal with expected type Str -//│ ║ l.10: 42 as [A] -> Str -//│ ║ ^^ +//│ ║ l.8: 42 as [A] -> Str +//│ ║ ^^ //│ ╙── because: cannot constrain Int <: Str //│ Type: Str fun id: [A] -> A -> A fun id(x) = x -//│ Type: ⊤ id //│ Type: ['A] -> ('A) ->{⊥} 'A @@ -24,11 +21,11 @@ id :e (x => x + 1) as [A] -> A -> A //│ ╔══[ERROR] Type error in reference with expected type Int -//│ ║ l.25: (x => x + 1) as [A] -> A -> A +//│ ║ l.22: (x => x + 1) as [A] -> A -> A //│ ║ ^ //│ ╙── because: cannot constrain A <: Int //│ ╔══[ERROR] Type error in application with expected type A -//│ ║ l.25: (x => x + 1) as [A] -> A -> A +//│ ║ l.22: (x => x + 1) as [A] -> A -> A //│ ║ ^^^^^ //│ ╙── because: cannot constrain Int <: A //│ Type: ['A] -> ('A) ->{⊥} 'A @@ -44,7 +41,6 @@ id as Int -> Int //│ Type: (Int) ->{⊥} Int fun myInc(inc: Int -> Int, x: Int) = inc(x) -//│ Type: ⊤ myInc(id, 0) //│ Type: Int @@ -61,7 +57,6 @@ id("abc") data class Pair[A, B](a: A, b: B) -//│ Type: ⊤ new Pair(42, true) //│ Type: Pair['A, 'B] @@ -71,7 +66,6 @@ new Pair(42, true) fun swap: [A, B] -> Pair[out A, out B] -> Pair[out B, out A] fun swap(p) = new Pair(p.Pair#b, p.Pair#a) -//│ Type: ⊤ swap @@ -91,7 +85,6 @@ let id = ((x => x) as [A] -> A -> A) in new Pair(id(42), id("42")) fun foo: ([A] -> A -> A) -> Int fun foo(x) = 42 -//│ Type: ⊤ foo //│ Type: (['A] -> ('A) ->{⊥} 'A) ->{⊥} Int @@ -103,7 +96,6 @@ foo(x => x) //│ Type: Int data class Foo(foo: [A] -> A -> A) -//│ Type: ⊤ new Foo(id) //│ Type: Foo @@ -116,7 +108,6 @@ let foo = new Foo(id) in foo.Foo#foo(42) //│ Type: Int data class Bar[A](x: A, f: [B] -> B -> B) -//│ Type: ⊤ new Bar(0, id) @@ -128,7 +119,6 @@ let bar = new Bar(0, id) in bar.Bar#f(bar.Bar#x) //│ Type: Int data class Some[A](value: A) -//│ Type: ⊤ new Some((x => x) as [A] -> A -> A) //│ Type: Some['A] @@ -141,7 +131,6 @@ let s = new Some((x => x) as [A] -> A -> A) in let t = s.Some#value(42) in s.Som fun gen: Int -> [A] -> A -> A fun gen(x) = let t = x + 1 in ((y => y) as [A] -> A -> A) -//│ Type: ⊤ gen //│ Type: (Int) ->{⊥} ['A] -> ('A) ->{⊥} 'A @@ -155,8 +144,7 @@ gen(42) fun cnt: Some[out [A] -> A -> A] -> Int fun cnt(x) = 42 //│ ╔══[ERROR] General type is not allowed here. -//│ ║ l.155: fun cnt: Some[out [A] -> A -> A] -> Int +//│ ║ l.144: fun cnt: Some[out [A] -> A -> A] -> Int //│ ╙── ^^^^^^ -//│ Type: ⊤ diff --git a/hkmc2/shared/src/test/mlscript/bbml/bbPrelude.mls b/hkmc2/shared/src/test/mlscript/invalml/invalPrelude.mls similarity index 97% rename from hkmc2/shared/src/test/mlscript/bbml/bbPrelude.mls rename to hkmc2/shared/src/test/mlscript/invalml/invalPrelude.mls index eea4ddf4cb..d08dab3ff6 100644 --- a/hkmc2/shared/src/test/mlscript/bbml/bbPrelude.mls +++ b/hkmc2/shared/src/test/mlscript/invalml/invalPrelude.mls @@ -1,4 +1,4 @@ -// :bbml +// :invalml declare class Any @@ -12,6 +12,8 @@ declare class Bool declare class Int declare class Num +fun String: Any -> Str + data class CodeBase[T, C, S] diff --git a/hkmc2/shared/src/test/mlscript/bbml/bbQQ.mls b/hkmc2/shared/src/test/mlscript/invalml/invalQQ.mls similarity index 88% rename from hkmc2/shared/src/test/mlscript/bbml/bbQQ.mls rename to hkmc2/shared/src/test/mlscript/invalml/invalQQ.mls index c61e4f1f97..5389830f6a 100644 --- a/hkmc2/shared/src/test/mlscript/bbml/bbQQ.mls +++ b/hkmc2/shared/src/test/mlscript/invalml/invalQQ.mls @@ -1,7 +1,5 @@ -:bbml -//│ Type: ⊤ +:invalml -//│ Type: ⊤ `42 //│ Type: CodeBase[out Int, ⊥, ?] @@ -29,7 +27,7 @@ x `=> `42 :e x `=> 42 //│ ╔══[ERROR] Type error in unquoted term -//│ ║ l.30: x `=> 42 +//│ ║ l.28: x `=> 42 //│ ║ ^^ //│ ╙── because: cannot constrain Int <: CodeBase[in ⊥ out 'cde, in ⊥ out 'ctx, in ⊥ out ⊤] //│ Type: CodeBase[out ⊤ -> ⊥, ⊥, ?] @@ -61,7 +59,7 @@ f `=> x `=> y `=> f`(x, y) :e `let x = 42 `in x //│ ╔══[ERROR] Type error in unquoted term -//│ ║ l.62: `let x = 42 `in x +//│ ║ l.60: `let x = 42 `in x //│ ║ ^^ //│ ╙── because: cannot constrain Int <: CodeBase[in ⊥ out 'cde, in ⊥ out 'ctx, in ⊥ out ⊤] //│ Type: CodeBase[⊥, ⊥, ?] @@ -69,7 +67,7 @@ f `=> x `=> y `=> f`(x, y) :e `let x = `0 `in 1 //│ ╔══[ERROR] Type error in unquoted term -//│ ║ l.70: `let x = `0 `in 1 +//│ ║ l.68: `let x = `0 `in 1 //│ ║ ^ //│ ╙── because: cannot constrain Int <: CodeBase[in ⊥ out 'cde, in ⊥ out 'ctx, in ⊥ out ⊤] //│ Type: CodeBase[⊥, ⊥, ?] @@ -91,7 +89,7 @@ run(`1) :e run(1) //│ ╔══[ERROR] Type error in integer literal with expected type CodeBase[out 'T, ⊥, ?] -//│ ║ l.92: run(1) +//│ ║ l.90: run(1) //│ ║ ^ //│ ╙── because: cannot constrain Int <: CodeBase[in ⊥ out 'T, ⊥, in ⊥ out ⊤] //│ Type: ⊥ @@ -99,8 +97,8 @@ run(1) :e x `=> run(x) //│ ╔══[ERROR] Type error in reference with expected type CodeBase[out 'T, ⊥, ?] -//│ ║ l.100: x `=> run(x) -//│ ║ ^ +//│ ║ l.98: x `=> run(x) +//│ ║ ^ //│ ╟── because: cannot constrain CodeBase['x, x, ⊥] <: CodeBase[in ⊥ out 'T, ⊥, in ⊥ out ⊤] //│ ╙── because: cannot constrain x <: ⊥ //│ Type: CodeBase[out CodeBase[out 'cde, ?, ?] -> 'cde, out 'ctx, ?] @@ -108,15 +106,14 @@ x `=> run(x) :e `let x = `42 `in run(x) //│ ╔══[ERROR] Type error in reference with expected type CodeBase[out 'T, ⊥, ?] -//│ ║ l.109: `let x = `42 `in run(x) +//│ ║ l.107: `let x = `42 `in run(x) //│ ║ ^ //│ ╟── because: cannot constrain CodeBase['cde, x, ⊥] <: CodeBase[in ⊥ out 'T, ⊥, in ⊥ out ⊤] //│ ╙── because: cannot constrain x <: ⊥ //│ ╔══[ERROR] Type error in unquoted term -//│ ║ l.109: `let x = `42 `in run(x) +//│ ║ l.107: `let x = `42 `in run(x) //│ ║ ^^^^^^ //│ ╟── because: cannot constrain 'T <: CodeBase[in ⊥ out 'cde1, in ⊥ out 'ctx, in ⊥ out ⊤] -//│ ╟── because: cannot constrain 'T <: CodeBase[in ⊥ out 'cde1, in ⊥ out 'ctx, in ⊥ out ⊤] //│ ╟── because: cannot constrain 'cde <: CodeBase[in ⊥ out 'cde1, in ⊥ out 'ctx, in ⊥ out ⊤] //│ ╟── because: cannot constrain 'cde <: CodeBase[in ⊥ out 'cde2, in ⊥ out 'ctx1, in ⊥ out ⊤] //│ ╙── because: cannot constrain Int <: CodeBase[in ⊥ out 'cde2, in ⊥ out 'ctx1, in ⊥ out ⊤] diff --git a/hkmc2/shared/src/test/mlscript/bbml/bbRec.mls b/hkmc2/shared/src/test/mlscript/invalml/invalRec.mls similarity index 68% rename from hkmc2/shared/src/test/mlscript/bbml/bbRec.mls rename to hkmc2/shared/src/test/mlscript/invalml/invalRec.mls index f4e3c9c8cc..92dc327c29 100644 --- a/hkmc2/shared/src/test/mlscript/bbml/bbRec.mls +++ b/hkmc2/shared/src/test/mlscript/invalml/invalRec.mls @@ -1,29 +1,26 @@ -:bbml -//│ Type: ⊤ +:invalml -//│ Type: ⊤ :fixme // parsing fun f x = f //│ ╔══[ERROR] Invalid function definition head: unexpected identifier in this position -//│ ║ l.7: fun f x = f +//│ ║ l.5: fun f x = f //│ ╙── ^ //│ ╔══[ERROR] Function definition shape not yet supported for f -//│ ║ l.7: fun f x = f +//│ ║ l.5: fun f x = f //│ ╙── ^ -//│ Type: ⊤ :e f //│ ╔══[ERROR] Variable not found: f -//│ ║ l.17: f +//│ ║ l.14: f //│ ╙── ^ //│ Type: ⊥ :e x //│ ╔══[ERROR] Name not found: x -//│ ║ l.24: x +//│ ║ l.21: x //│ ╙── ^ //│ Type: ⊥ @@ -39,19 +36,17 @@ f :todo fun f(x) = f(x.a) -//│ ╔══[ERROR] Term shape not yet supported by BbML: Sel(Ref(x),Ident(a)) -//│ ║ l.41: fun f(x) = f(x.a) +//│ ╔══[ERROR] Term shape not yet supported by InvalML: Sel(Ref(x),Ident(a)) +//│ ║ l.38: fun f(x) = f(x.a) //│ ╙── ^^^ -//│ Type: ⊤ data class Foo[A](a: A) -//│ Type: ⊤ :todo proper error Foo(123) //│ ╔══[ERROR] Variable not found: Foo -//│ ║ l.52: Foo(123) +//│ ║ l.47: Foo(123) //│ ╙── ^^^ //│ Type: ⊥ @@ -62,10 +57,9 @@ new Foo(123) :todo proper error fun f(x) = f(Foo.a(x)) -//│ ╔══[ERROR] Term shape not yet supported by BbML: Sel(Ref(member:Foo),Ident(a)) -//│ ║ l.64: fun f(x) = f(Foo.a(x)) +//│ ╔══[ERROR] Term shape not yet supported by InvalML: Sel(Ref(member:Foo),Ident(a)) +//│ ║ l.59: fun f(x) = f(Foo.a(x)) //│ ╙── ^^^^^ -//│ Type: ⊤ fun f(x) = f(x.Foo#a) f diff --git a/hkmc2/shared/src/test/mlscript/bbml/bbRef.mls b/hkmc2/shared/src/test/mlscript/invalml/invalRef.mls similarity index 69% rename from hkmc2/shared/src/test/mlscript/bbml/bbRef.mls rename to hkmc2/shared/src/test/mlscript/invalml/invalRef.mls index 5725f657bf..e0d21e74e0 100644 --- a/hkmc2/shared/src/test/mlscript/bbml/bbRef.mls +++ b/hkmc2/shared/src/test/mlscript/invalml/invalRef.mls @@ -1,7 +1,5 @@ -:bbml -//│ Type: ⊤ +:invalml -//│ Type: ⊤ region x in 42 //│ Type: Int @@ -21,15 +19,13 @@ r let r = region x in x.ref 42 !r //│ ╔══[ERROR] Type error in block -//│ ║ l.21: let r = region x in x.ref 42 +//│ ║ l.19: let r = region x in x.ref 42 //│ ║ ^^^^^^^^ -//│ ║ l.22: !r +//│ ║ l.20: !r //│ ║ ^^ //│ ╟── because: cannot constrain 'reg ∨ 'eff <: ⊥ //│ ╟── because: cannot constrain 'reg <: ⊥ //│ ╟── because: cannot constrain 'reg1 <: ⊥ -//│ ╟── because: cannot constrain 'reg1 <: ⊥ -//│ ╟── because: cannot constrain 'x <: ⊥ //│ ╟── because: cannot constrain 'x <: ⊥ //│ ╙── because: cannot constrain ⊤ <: ⊥ //│ Type: Int @@ -40,24 +36,12 @@ mkRef :e let t = region x in x in t.ref 42 -//│ ╔══[ERROR] Type error in reference creation -//│ ║ l.42: let t = region x in x in t.ref 42 -//│ ║ ^^^^^^^^ -//│ ╟── because: cannot constrain Region[in 'x out 'x1] <: Region['reg] -//│ ╟── because: cannot constrain 'x1 <: 'reg -//│ ╟── because: cannot constrain 'x1 <: 'reg -//│ ╟── because: cannot constrain 'x1 <: 'x -//│ ╟── because: cannot constrain 'x1 <: 'x -//│ ╟── because: cannot constrain ⊤ <: 'x -//│ ╟── because: cannot constrain ⊤ <: 'x -//│ ╙── because: cannot constrain ⊤ <: ⊥ //│ ╔══[ERROR] Type error in block -//│ ║ l.42: let t = region x in x in t.ref 42 +//│ ║ l.38: let t = region x in x in t.ref 42 //│ ║ ^^^^^^^^^^^^^ //│ ╟── because: cannot constrain 'reg ∨ 'eff <: ⊥ //│ ╟── because: cannot constrain 'reg <: ⊥ -//│ ╟── because: cannot constrain 'x1 <: ⊥ -//│ ╟── because: cannot constrain 'x1 <: ⊥ +//│ ╟── because: cannot constrain 'x <: ⊥ //│ ╙── because: cannot constrain ⊤ <: ⊥ //│ Type: Ref[Int, ?] @@ -71,15 +55,13 @@ let t = region x in x.ref 42 in t := 0 //│ ╔══[ERROR] Type error in block -//│ ║ l.71: x.ref 42 +//│ ║ l.55: x.ref 42 //│ ║ ^^^^^^^^ -//│ ║ l.72: in t := 0 +//│ ║ l.56: in t := 0 //│ ║ ^^^^^^^^^ //│ ╟── because: cannot constrain 'reg ∨ 'eff <: ⊥ //│ ╟── because: cannot constrain 'reg <: ⊥ //│ ╟── because: cannot constrain 'reg1 <: ⊥ -//│ ╟── because: cannot constrain 'reg1 <: ⊥ -//│ ╟── because: cannot constrain 'x <: ⊥ //│ ╟── because: cannot constrain 'x <: ⊥ //│ ╙── because: cannot constrain ⊤ <: ⊥ //│ Type: Int @@ -94,15 +76,13 @@ let t = region x in x.ref 42 in !t //│ ╔══[ERROR] Type error in block -//│ ║ l.94: x.ref 42 +//│ ║ l.76: x.ref 42 //│ ║ ^^^^^^^^ -//│ ║ l.95: in !t +//│ ║ l.77: in !t //│ ║ ^^^^^ //│ ╟── because: cannot constrain 'reg ∨ 'eff <: ⊥ //│ ╟── because: cannot constrain 'reg <: ⊥ //│ ╟── because: cannot constrain 'reg1 <: ⊥ -//│ ╟── because: cannot constrain 'reg1 <: ⊥ -//│ ╟── because: cannot constrain 'x <: ⊥ //│ ╟── because: cannot constrain 'x <: ⊥ //│ ╙── because: cannot constrain ⊤ <: ⊥ //│ Type: Int @@ -114,22 +94,19 @@ region x in fun rid: [A] -> A -> A fun rid(x) = let t = (region y in 42) in x -//│ Type: ⊤ fun rid: [A] -> A -> A fun rid(x) = let t = (region y in 42) in x -//│ Type: ⊤ :e region x in (let dz = x.ref 42 in 42) as [A] -> Int //│ ╔══[ERROR] Type error in block with expected type [outer, 'A] -> Int -//│ ║ l.127: (let dz = x.ref 42 in 42) as [A] -> Int +//│ ║ l.105: (let dz = x.ref 42 in 42) as [A] -> Int //│ ║ ^^^^^^^^^^^^^^ //│ ╟── because: cannot constrain 'reg <: ⊥ -//│ ╟── because: cannot constrain 'reg <: ⊥ //│ ╙── because: cannot constrain x <: ⊥ //│ Type: Int @@ -140,21 +117,19 @@ let t = y => x.ref y in t(42) //│ ╔══[ERROR] Type error in block -//│ ║ l.140: y => x.ref y +//│ ║ l.117: y => x.ref y //│ ║ ^^^^^^^^^^^^ -//│ ║ l.141: in t(42) +//│ ║ l.118: in t(42) //│ ║ ^^^^^^^^ //│ ╟── because: cannot constrain 'reg ∨ 'eff <: ⊥ //│ ╟── because: cannot constrain 'reg <: ⊥ //│ ╟── because: cannot constrain 'x <: ⊥ -//│ ╟── because: cannot constrain 'x <: ⊥ //│ ╙── because: cannot constrain ⊤ <: ⊥ //│ Type: Ref[in 'y out 'y ∨ Int, ?] fun foo: [A] -> Int ->{A} Int fun foo(x) = region y in x + 1 -//│ Type: ⊤ region x in @@ -164,7 +139,6 @@ region x in fun foo: [A extends Int] -> A -> A fun foo(x) = x -//│ Type: ⊤ foo //│ Type: ['A] -> ('A) ->{⊥} 'A @@ -176,7 +150,6 @@ region x in x.ref foo fun bar: ([A] -> A -> A) -> Int fun bar(f) = f(42) -//│ Type: ⊤ bar //│ Type: (['A] -> ('A) ->{⊥} 'A) ->{⊥} Int @@ -184,6 +157,6 @@ bar :e region x in x.ref bar //│ ╔══[ERROR] Expected a monomorphic type or an instantiable type here, but ([outer, 'A] -> ('A) ->{⊥} 'A) ->{⊥} Int found -//│ ║ l.185: region x in x.ref bar +//│ ║ l.158: region x in x.ref bar //│ ╙── ^^^ //│ Type: Ref[⊥, ?] diff --git a/hkmc2/shared/src/test/mlscript/invalml/invalScratch.mls b/hkmc2/shared/src/test/mlscript/invalml/invalScratch.mls new file mode 100644 index 0000000000..47e2ea99f2 --- /dev/null +++ b/hkmc2/shared/src/test/mlscript/invalml/invalScratch.mls @@ -0,0 +1,11 @@ +:invalml + + +// :d +let i = 1 + +let i = 1 +i +//│ Type: Int + + diff --git a/hkmc2/shared/src/test/mlscript/bbml/bbSelfApp.mls b/hkmc2/shared/src/test/mlscript/invalml/invalSelfApp.mls similarity index 78% rename from hkmc2/shared/src/test/mlscript/bbml/bbSelfApp.mls rename to hkmc2/shared/src/test/mlscript/invalml/invalSelfApp.mls index 08287f92b3..2b55b26326 100644 --- a/hkmc2/shared/src/test/mlscript/bbml/bbSelfApp.mls +++ b/hkmc2/shared/src/test/mlscript/invalml/invalSelfApp.mls @@ -1,7 +1,5 @@ -:bbml -//│ Type: ⊤ +:invalml -//│ Type: ⊤ (x => x(x)) (x => x(x)) @@ -9,7 +7,6 @@ fun f(x) = x(x) -//│ Type: ⊤ f //│ Type: ['x, 'eff, 'app] -> ('x ->{'eff} 'app) ->{'eff} 'app diff --git a/hkmc2/shared/src/test/mlscript/bbml/bbSeq.mls b/hkmc2/shared/src/test/mlscript/invalml/invalSeq.mls similarity index 55% rename from hkmc2/shared/src/test/mlscript/bbml/bbSeq.mls rename to hkmc2/shared/src/test/mlscript/invalml/invalSeq.mls index 64405db0f9..afed6400cf 100644 --- a/hkmc2/shared/src/test/mlscript/bbml/bbSeq.mls +++ b/hkmc2/shared/src/test/mlscript/invalml/invalSeq.mls @@ -1,21 +1,16 @@ -:bbml -//│ Type: ⊤ +:invalml -//│ Type: ⊤ data class Seq[A, E](next: () ->{E} A) -//│ Type: ⊤ fun map: [A, B, E] -> Seq[out A, out E] -> (A ->{E} B) -> Seq[out B, out E] -//│ Type: ⊤ // * Note: equivalent since Seq is covariant: // fun map: [A, B, E, F] -> Seq[out A, out E] -> (A ->{F} B) -> Seq[out B, out E | F] // * Forces the elements of the sequence to be evaluated and caches them fun force_cache: [A, B, E] -> Seq[out A, out E] ->{E} Seq[out B, Nothing] -//│ Type: ⊤ // * Dummy implementation @@ -23,7 +18,6 @@ fun mapi: [A, E] -> Seq[out A, out E] -> ((Int, A) ->{E} A) ->{Nothing} Seq[out fun mapi = s => f => region r in map(s) of x => f(0, x) -//│ Type: ⊤ // * Should be an error. This definition would not be referentially transparent. // * The error message needs improvement, though. @@ -36,57 +30,20 @@ fun mapi = s => f => i := !i + 1 f(!i, x) //│ ╔══[ERROR] Type error in region expression with expected type Seq[out A, out E] -//│ ║ l.34: let i = r.ref 0 +//│ ║ l.28: let i = r.ref 0 //│ ║ ^^^^^^^ -//│ ║ l.35: map(s) of x => +//│ ║ l.29: map(s) of x => //│ ║ ^^^^^^^^^^^^^^^^^^ -//│ ║ l.36: i := !i + 1 +//│ ║ l.30: i := !i + 1 //│ ║ ^^^^^^^^^^^^^^^^^ -//│ ║ l.37: f(!i, x) +//│ ║ l.31: f(!i, x) //│ ║ ^^^^^^^^^^^^^^ //│ ╟── because: cannot constrain Seq[in ⊥ out 'B, in ⊥ out 'E1] <: Seq[in ⊥ out A, in ⊥ out E] //│ ╟── because: cannot constrain 'E1 <: E -//│ ╟── because: cannot constrain 'E1 <: E -//│ ╟── because: cannot constrain 'reg <: E -//│ ╟── because: cannot constrain 'reg <: E -//│ ╟── because: cannot constrain 'r ∧ ¬outer <: E -//│ ╟── because: cannot constrain 'r <: E ∨ outer -//│ ╙── because: cannot constrain ¬outer <: E ∨ outer -//│ ╔══[ERROR] Type error in region expression with expected type Seq[out A, out E] -//│ ║ l.34: let i = r.ref 0 -//│ ║ ^^^^^^^ -//│ ║ l.35: map(s) of x => -//│ ║ ^^^^^^^^^^^^^^^^^^ -//│ ║ l.36: i := !i + 1 -//│ ║ ^^^^^^^^^^^^^^^^^ -//│ ║ l.37: f(!i, x) -//│ ║ ^^^^^^^^^^^^^^ -//│ ╟── because: cannot constrain Seq[in ⊥ out 'B, in ⊥ out 'E1] <: Seq[in ⊥ out A, in ⊥ out E] -//│ ╟── because: cannot constrain 'E1 <: E -//│ ╟── because: cannot constrain 'E1 <: E -//│ ╟── because: cannot constrain 'reg <: E -//│ ╟── because: cannot constrain 'reg <: E -//│ ╟── because: cannot constrain 'r ∧ ¬outer <: E -//│ ╟── because: cannot constrain 'r <: E ∨ outer -//│ ╙── because: cannot constrain ¬outer <: E ∨ outer -//│ ╔══[ERROR] Type error in region expression with expected type Seq[out A, out E] -//│ ║ l.34: let i = r.ref 0 -//│ ║ ^^^^^^^ -//│ ║ l.35: map(s) of x => -//│ ║ ^^^^^^^^^^^^^^^^^^ -//│ ║ l.36: i := !i + 1 -//│ ║ ^^^^^^^^^^^^^^^^^ -//│ ║ l.37: f(!i, x) -//│ ║ ^^^^^^^^^^^^^^ -//│ ╟── because: cannot constrain Seq[in ⊥ out 'B, in ⊥ out 'E1] <: Seq[in ⊥ out A, in ⊥ out E] -//│ ╟── because: cannot constrain 'E1 <: E -//│ ╟── because: cannot constrain 'E1 <: E -//│ ╟── because: cannot constrain 'reg <: E //│ ╟── because: cannot constrain 'reg <: E //│ ╟── because: cannot constrain 'r ∧ ¬outer <: E //│ ╟── because: cannot constrain 'r <: E ∨ outer //│ ╙── because: cannot constrain ¬outer <: E ∨ outer -//│ Type: ⊤ // * Notice the inferred type, which produces an unusable Sequence (of effect `?` ie `Any`) fun mapi = s => f => @@ -106,32 +63,28 @@ fun mapi_force = s => f => force_cache of map(s) of x => i := !i + 1 f(!i, x) -//│ Type: ⊤ // * An alternative version that takes an existing region in parameter -fun mapi: [A, R, E] -> (Seq[out A, out E], Region[R]) -> ((Int, A) ->{E} A) ->{R} Seq[out A, out E | R] +fun mapi: [A, R, E] -> (Seq[out A, out E], Region[out R]) -> ((Int, A) ->{E} A) ->{R} Seq[out A, out E | R] fun mapi = (s, r) => f => let i = r.ref 0 map(s) of x => i := !i + 1 f(!i, x) -//│ Type: ⊤ // * Simpler; should be equivalent when Region is covariant -fun mapi: [A, E] -> (Seq[out A, out E], Region[E]) -> ((Int, A) ->{E} A) ->{E} Seq[out A, out E] +fun mapi: [A, E] -> (Seq[out A, out E], Region[out E]) -> ((Int, A) ->{E} A) ->{E} Seq[out A, out E] fun mapi = (s, r) => f => let i = r.ref 0 map(s) of x => i := !i + 1 f(!i, x) -//│ Type: ⊤ // * Example usage fun mkSeq: [A, E] -> (() ->{E} A) ->{E} Seq[out A, out E] fun head: [A, E] -> Seq[out A, out E] ->{E} A -//│ Type: ⊤ region r in let sum = r.ref 0 @@ -144,7 +97,6 @@ region r in fun r: Ref[Int, Nothing] -//│ Type: ⊤ r := 1 !r @@ -154,7 +106,7 @@ r := 1 r := 1 ! r // because of the space, this is a NL-op //│ ╔══[ERROR] Variable not found: ! -//│ ║ l.155: ! r // because of the space, this is a NL-op +//│ ║ l.107: ! r // because of the space, this is a NL-op //│ ╙── ^ //│ Type: ⊥ diff --git a/hkmc2/shared/src/test/mlscript/bbml/bbSyntax.mls b/hkmc2/shared/src/test/mlscript/invalml/invalSyntax.mls similarity index 96% rename from hkmc2/shared/src/test/mlscript/bbml/bbSyntax.mls rename to hkmc2/shared/src/test/mlscript/invalml/invalSyntax.mls index c8242a81a3..7a46af9e07 100644 --- a/hkmc2/shared/src/test/mlscript/bbml/bbSyntax.mls +++ b/hkmc2/shared/src/test/mlscript/invalml/invalSyntax.mls @@ -1,8 +1,6 @@ -:bbml -//│ Type: ⊤ +:invalml :parseOnly -//│ Type: ⊤ data class Foo //│ Parsed: //│ Modified(keyword 'data',None,TypeDef(Cls,Ident(Foo),None)) @@ -187,7 +185,7 @@ g`(`1, `2) `if x `== `0.0 then `1.0 else x //│ Parsed: -//│ Quoted(IfLike(keyword 'if',Some(Loc(1,3,bbSyntax.mls:+188)),Block(List(InfixApp(Unquoted(Quoted(App(Ident(==),Tup(List(Unquoted(Ident(x)), Unquoted(Quoted(DecLit(0.0)))))))),keyword 'then',Unquoted(Quoted(DecLit(1.0)))), Modified(keyword 'else',None,Unquoted(Ident(x))))))) +//│ Quoted(IfLike(keyword 'if',Some(Loc(1,3,invalSyntax.mls:+186)),Block(List(InfixApp(Unquoted(Quoted(App(Ident(==),Tup(List(Unquoted(Ident(x)), Unquoted(Quoted(DecLit(0.0)))))))),keyword 'then',Unquoted(Quoted(DecLit(1.0)))), Modified(keyword 'else',None,Unquoted(Ident(x))))))) x `=> if 0 == 0 then x else `0 diff --git a/hkmc2/shared/src/test/mlscript/bbml/bbTODOs.mls b/hkmc2/shared/src/test/mlscript/invalml/invalTODOs.mls similarity index 67% rename from hkmc2/shared/src/test/mlscript/bbml/bbTODOs.mls rename to hkmc2/shared/src/test/mlscript/invalml/invalTODOs.mls index 9b8aaae4d3..e31c367cf0 100644 --- a/hkmc2/shared/src/test/mlscript/bbml/bbTODOs.mls +++ b/hkmc2/shared/src/test/mlscript/invalml/invalTODOs.mls @@ -1,31 +1,26 @@ -:bbml -//│ Type: ⊤ +:invalml -//│ Type: ⊤ :todo let id: [A] -> A -> A = x => x //│ ╔══[ERROR] Unsupported let binding shape -//│ ║ l.7: let id: [A] -> A -> A = x => x +//│ ║ l.5: let id: [A] -> A -> A = x => x //│ ╙── ^^^^^^^^^^^^^^^^^^^^^^^^^^ -//│ Type: ⊤ :todo fun id[A](x: A) = x //│ ╔══[ERROR] Variable not found: A -//│ ║ l.14: fun id[A](x: A) = x +//│ ║ l.11: fun id[A](x: A) = x //│ ╙── ^ -//│ Type: ⊤ :fixme fun id: [A] -> A -> A => x = x //│ ╔══[ERROR] Name not found: x -//│ ║ l.21: fun id: [A] -> A -> A => x = x +//│ ║ l.17: fun id: [A] -> A -> A => x = x //│ ╙── ^ //│ ╔══[ERROR] Name not found: x -//│ ║ l.21: fun id: [A] -> A -> A => x = x +//│ ║ l.17: fun id: [A] -> A -> A => x = x //│ ╙── ^ //│ ═══[ERROR] Function definition shape not yet supported for id -//│ Type: ⊤ diff --git a/hkmc2/shared/src/test/mlscript/bbml/bbUntyped.mls b/hkmc2/shared/src/test/mlscript/invalml/invalUntyped.mls similarity index 71% rename from hkmc2/shared/src/test/mlscript/bbml/bbUntyped.mls rename to hkmc2/shared/src/test/mlscript/invalml/invalUntyped.mls index f2b8a11597..6e6de703bb 100644 --- a/hkmc2/shared/src/test/mlscript/bbml/bbUntyped.mls +++ b/hkmc2/shared/src/test/mlscript/invalml/invalUntyped.mls @@ -1,8 +1,6 @@ -:bbml -//│ Type: ⊤ +:invalml :js -//│ Type: ⊤ @untyped 1 @@ -16,17 +14,13 @@ @untyped fun f: Int -//│ Type: ⊤ @untyped declare fun f: Int -//│ Type: ⊤ @untyped @untyped declare fun f: Int -//│ Type: ⊤ @untyped fun f() = 1 -//│ Type: ⊤ diff --git a/hkmc2/shared/src/test/mlscript/invalml/invalUsefulExtrusion.mls b/hkmc2/shared/src/test/mlscript/invalml/invalUsefulExtrusion.mls new file mode 100644 index 0000000000..9006d41a8f --- /dev/null +++ b/hkmc2/shared/src/test/mlscript/invalml/invalUsefulExtrusion.mls @@ -0,0 +1,228 @@ +:invalml + + +fun (;) seq(_, res) = res + + + + +fun wield: [R] -> (Region[out R]) ->{R} () +fun freeze: [R, E extends ~R, T] -> (Region[out R], () ->{~R & E} T) ->{R | E} T + +freeze +//│ Type: ['R, 'E, 'T] -> (Region[out 'R], () ->{¬'R ∧ 'E} 'T) ->{'R ∨ 'E} 'T +//│ Where: +//│ 'E <: ¬'R + + +fun foo(f) = + region r in + freeze(r, () => f(32)) + +foo +//│ Type: [outer, 'app, 'eff] -> (Int ->{'eff} 'app) ->{'eff} 'app +//│ Where: +//│ 'eff <: outer + +fun foo(f) = + region r in + freeze(r, f) + 123 + +foo +//│ Type: [outer, 'E] -> (() ->{'E ∧ outer} ⊤) ->{'E} Int +//│ Where: +//│ 'E <: outer + + +fun foo(r1, r2, f, g) = + freeze(r1, () => f(123)); freeze(r2, () => g(456)) + +foo +//│ Type: ['res, 'R, 'E, 'R1, 'E1] -> (Region[out 'R], Region[out 'R1], Int ->{'E ∧ ¬'R} ⊤, Int ->{'E1 ∧ ¬'R1} 'res) ->{(('R ∨ 'E) ∨ 'R1) ∨ 'E1} 'res +//│ Where: +//│ 'E <: ¬'R +//│ 'E1 <: ¬'R1 + + + +fun freeze: [E, R, S, T] -> (Region[out R], () ->{~R & E} T) ->{R | E} T + +freeze +//│ Type: ['E, 'R, 'T] -> (Region[out 'R], () ->{¬'R ∧ 'E} 'T) ->{'R ∨ 'E} 'T + + +fun foo(f) = + region r in + freeze(r, () => f(32)) + +foo +//│ Type: [outer, 'app, 'eff] -> (Int ->{'eff} 'app) ->{'eff} 'app +//│ Where: +//│ 'eff <: outer + +fun foo(f) = + region r in + freeze(r, f) + 123 + +foo +//│ Type: [outer, 'E] -> (() ->{'E ∧ outer} ⊤) ->{'E} Int + + + +fun foo: [R1, R2] -> (Region[out R1], Region[out R2], Int ->{R1 & ~R2} (), Int ->{R2 & ~R1} ()) ->{R1 | R2} () +fun foo(r1, r2, f, g) = + f(123); g(456) + +fun foo(r1, r2, f, g) = + freeze(r1, () => f(123)); freeze(r2, () => g(456)) + +foo +//│ Type: ['res, 'E, 'R, 'E1, 'R1] -> (Region[out 'R], Region[out 'R1], Int ->{'E ∧ ¬'R} ⊤, Int ->{'E1 ∧ ¬'R1} 'res) ->{(('R ∨ 'E) ∨ 'R1) ∨ 'E1} 'res + + +fun foo(r1, r2, f, g) = + freeze(r1, () => freeze(r2, () => f(r2); g(r1))) + +foo +//│ Type: ['r1, 'r2, 'E, 'R, 'T, 'R1] -> ('r1, 'r2, 'r2 ->{('E ∧ ¬'R) ∧ ¬'R1} ⊤, 'r1 ->{('E ∧ ¬'R) ∧ ¬'R1} 'T) ->{'R ∨ 'E} 'T +//│ Where: +//│ 'r1 <: Region[out 'R] +//│ 'R1 <: 'E +//│ 'R1 <: ¬'R +//│ 'r2 <: Region[out 'R1] + +:e +region r in + foo(r, r, wield, wield) +//│ ╔══[ERROR] Type error in reference with expected type 'r2 +//│ ║ l.98: foo(r, r, wield, wield) +//│ ║ ^ +//│ ╟── because: cannot constrain Region[in ⊥ out r] <: 'r2 +//│ ╟── because: cannot constrain Region[in ⊥ out r] <: Region[in ⊥ out 'R] +//│ ╟── because: cannot constrain r <: 'R +//│ ╟── because: cannot constrain r <: ¬'R1 +//│ ╟── because: cannot constrain 'R1 <: ¬r +//│ ╙── because: cannot constrain r <: ¬r +//│ ╔══[ERROR] Type error in reference with expected type 'f +//│ ║ l.98: foo(r, r, wield, wield) +//│ ║ ^^^^^ +//│ ╟── because: cannot constrain (Region[in ⊥ out 'R2]) ->{'R2} (()) <: 'f +//│ ╟── because: cannot constrain (Region[in ⊥ out 'R2]) ->{'R2} (()) <: ('r2) ->{¬'R ∧ ¬'R1 ∧ 'E} (⊤) +//│ ╟── because: cannot constrain 'R2 <: ¬'R ∧ ¬'R1 ∧ 'E +//│ ╟── because: cannot constrain 'R2 <: ¬'R1 +//│ ╟── because: cannot constrain r <: ¬'R1 +//│ ╟── because: cannot constrain 'R1 <: ¬r +//│ ╙── because: cannot constrain r <: ¬r +//│ ╔══[ERROR] Type error in reference with expected type 'g +//│ ║ l.98: foo(r, r, wield, wield) +//│ ║ ^^^^^ +//│ ╟── because: cannot constrain (Region[in ⊥ out 'R3]) ->{'R3} (()) <: 'g +//│ ╟── because: cannot constrain (Region[in ⊥ out 'R3]) ->{'R3} (()) <: ('r1) ->{¬'R ∧ ¬'R1 ∧ 'E} ('T) +//│ ╟── because: cannot constrain 'R3 <: ¬'R ∧ ¬'R1 ∧ 'E +//│ ╟── because: cannot constrain 'R3 <: ¬'R1 +//│ ╟── because: cannot constrain r <: ¬'R1 +//│ ╟── because: cannot constrain 'R1 <: ¬r +//│ ╙── because: cannot constrain r <: ¬r + +:e +region r in + region s in + foo(r, s, wield, wield) +//│ ╔══[ERROR] Type error in reference with expected type 'f +//│ ║ l.132: foo(r, s, wield, wield) +//│ ║ ^^^^^ +//│ ╟── because: cannot constrain (Region[in ⊥ out 'R]) ->{'R} (()) <: 'f +//│ ╟── because: cannot constrain (Region[in ⊥ out 'R]) ->{'R} (()) <: ('r2) ->{¬'R1 ∧ ¬'R2 ∧ 'E} (⊤) +//│ ╟── because: cannot constrain 'R <: ¬'R1 ∧ ¬'R2 ∧ 'E +//│ ╟── because: cannot constrain 'R <: ¬'R1 +//│ ╟── because: cannot constrain s ∧ ¬r <: ¬'R1 +//│ ╟── because: cannot constrain 'R1 <: ¬s ∨ r +//│ ╙── because: cannot constrain s ∧ ¬r <: ¬s ∨ r +//│ ╔══[ERROR] Type error in reference with expected type 'g +//│ ║ l.132: foo(r, s, wield, wield) +//│ ║ ^^^^^ +//│ ╟── because: cannot constrain (Region[in ⊥ out 'R3]) ->{'R3} (()) <: 'g +//│ ╟── because: cannot constrain (Region[in ⊥ out 'R3]) ->{'R3} (()) <: ('r1) ->{¬'R1 ∧ ¬'R2 ∧ 'E} ('T) +//│ ╟── because: cannot constrain 'R3 <: ¬'R1 ∧ ¬'R2 ∧ 'E +//│ ╟── because: cannot constrain 'R3 <: ¬'R2 +//│ ╟── because: cannot constrain r <: ¬'R2 +//│ ╟── because: cannot constrain 'R2 <: ¬r +//│ ╙── because: cannot constrain r <: ¬r + +region r in + region s in + foo(r, s, x => x, y => y) +//│ Type: Region[?] + + + +:fixme +fun foo[outer, R <: outer](r1: Region[R]) = + region r2 in + freeze(r2, () => + wield(r1) + ) +//│ ═══[ERROR] Unsupported type parameter outer binding +//│ ╔══[ERROR] Unsupported type parameter operator application +//│ ║ l.162: fun foo[outer, R <: outer](r1: Region[R]) = +//│ ╙── ^^^^ +//│ ╔══[ERROR] Name not found: R +//│ ║ l.162: fun foo[outer, R <: outer](r1: Region[R]) = +//│ ╙── ^ +//│ ═══[ERROR] Expected a type symbol, got +//│ ═══[ERROR] Invalid type + +:fixme +fun foo: [outer, R <: outer] -> Region[R] -> () +//│ ╔══[ERROR] Illegal forall annotation. +//│ ║ l.178: fun foo: [outer, R <: outer] -> Region[R] -> () +//│ ╙── ^^^^^^^^^^^^^^^^^^^ +//│ ═══[ERROR] Invalid type + + + +// * A function that executes its argument `f` in a frozen local region; +// * we show that this `f` can itself in turn freeze its own region from the call site + +fun foo(f) = + region r in + freeze of r, () => + f() + +foo +//│ Type: [outer, 'app, 'eff] -> (() ->{'eff} 'app) ->{'eff} 'app +//│ Where: +//│ 'eff <: outer + +region s in + foo(() => wield(s)) + +region s in + foo of () => + wield(s) + freeze(s, () => 42) +//│ Type: Int + +:e +region s in + foo of () => + freeze(s, () => wield(s)) +//│ ╔══[ERROR] Type error in function literal with expected type () ->{¬'R ∧ 'E} 'T +//│ ║ l.211: freeze(s, () => wield(s)) +//│ ║ ^^^^^^^^ +//│ ╟── because: cannot constrain 'R1 <: ¬'R ∧ 'E +//│ ╟── because: cannot constrain 'R1 <: ¬'R +//│ ╟── because: cannot constrain s <: ¬'R +//│ ╟── because: cannot constrain 'R <: ¬s +//│ ╙── because: cannot constrain s <: ¬s + +region s in + foo of () => + region t in + wield(s) + freeze(s, () => wield(t)) + + + diff --git a/hkmc2/shared/src/test/mlscript/bbml/bbVariance.mls b/hkmc2/shared/src/test/mlscript/invalml/invalVariance.mls similarity index 76% rename from hkmc2/shared/src/test/mlscript/bbml/bbVariance.mls rename to hkmc2/shared/src/test/mlscript/invalml/invalVariance.mls index 62e56acddf..fe82b05f6d 100644 --- a/hkmc2/shared/src/test/mlscript/bbml/bbVariance.mls +++ b/hkmc2/shared/src/test/mlscript/invalml/invalVariance.mls @@ -1,17 +1,13 @@ -:bbml -//│ Type: ⊤ +:invalml -//│ Type: ⊤ class Foo[out A] -//│ Type: ⊤ (x: Foo[Int]) => (x as Foo[Int | Str]) //│ Type: (Foo[out Int]) ->{⊥} Foo[out Int ∨ Str] class Foo[in A] -//│ Type: ⊤ (x: Foo[Int]) => (x as Foo[Int & Str]) //│ Type: (Foo[in Int]) ->{⊥} Foo[in Int ∧ Str] diff --git a/hkmc2/shared/src/test/mlscript/invalml/web-demos/DynamicProgramming.mls b/hkmc2/shared/src/test/mlscript/invalml/web-demos/DynamicProgramming.mls new file mode 100644 index 0000000000..3c058b027c --- /dev/null +++ b/hkmc2/shared/src/test/mlscript/invalml/web-demos/DynamicProgramming.mls @@ -0,0 +1,155 @@ +:invalml + +:... +//│ ———————————————————————————————————————————————————————————————————————————————— + +class Option[A] with + constructor + Some(x: A) + None + + +class ArrayList[T, out R] +class Iter[T, out R] +class Array2D[T, out R] + +class Interviewee with + constructor + Itv(score: Int, salary: Int) + +fun (;) seq(_, res) = res +fun toString: Any -> Str +fun concat: (Str, Str) -> Str +fun println: Str -> () + +fun + empty: [A, R] -> Region[out R] ->{R} ArrayList[A, out R] + push: [A, R] -> (ArrayList[A, out R], A) ->{R} () + iter: [Res, R, E extends ~R, T] -> + (ArrayList[T, out R], [S] -> Iter[T, S] ->{S | E} Res) ->{E | R} Res + revIter: [outer, Res, R, E extends ~R, T] -> + (ArrayList[T, out R], [S extends ~outer] -> Iter[T, S] ->{S | E} Res) ->{E | R} Res + next: [T, S] -> Iter[T, S] ->{S} Option[T] + len: [A, R] -> (ArrayList[A, out R]) ->{R} Int + whileDo: [R] -> (() ->{R} Bool) ->{R} () + init: [A, R] -> (Region[out R], Int, Int, A) ->{R} Array2D[A, R] + update: [A, R] -> (Array2D[A, out R], Int, Int, A) ->{R} () + get: [A, R] -> (Array2D[A, out R], Int, Int) ->{R} A + max: (Int, Int) -> Int + + + +fun format(it) = + if it is Itv(score, salary) then + concat("interviewee, score: ", concat(toString(score), concat("salary", toString(salary)))) + + +fun printAll(arr) = + iter of arr, it => + whileDo of () => + if next(it) is + Some(x) then println(format(x)); true + None then false + + +// fun select: [outer, R1 extends outer, R2 extends ~R1] -> (ArrayList[Interviewee, R1], Int, ArrayList[Interviewee, R2]) ->{R1 | R2} Int +fun select(interviewees, budget, results) = + region r in + let size = len(interviewees), let i = r.ref 1 + let dp = init(r, size + 1, budget + 1, 0) + iter of interviewees, it => whileDo of () => + if next(it) is + Some(itv) then if itv is Itv(score, salary) then + let j = r.ref 0 + whileDo of () => + if !j < salary then update(dp, !i, !j, get(dp, !i - 1, !j)) + else + let p = get(dp, !i - 1, !j - salary), let np = get(dp, !i - 1, !j) + update(dp, !i, !j, max of np, p + score) + j := !j + 1; !j <= budget + i := !i + 1 + true + None then false + i := size + let rest = r.ref budget + revIter of interviewees, it => + whileDo of () => + if next(it) is + Some(itv) then if itv is Itv(score, salary) then + if get(dp, !i, !rest) == get(dp, !i - 1, !rest - salary) + score + do push(results, itv); rest := !rest - salary + i := !i - 1 + true + None then false + get(dp, size, budget) + +// region r in +// let interviewees = empty(r) +// push(interviewees, Itv(20, 3000)) +// push(interviewees, Itv(50, 1000)) +// push(interviewees, Itv(30, 1000)) +// let results = empty(r) +// let m = select(interviewees, 4000, results) +// printAll(results) +// m + + +// fun wrongSelect(interviewees, budget, results) = +// region r in +// let size = len(interviewees), let i = r.ref 1 +// let dp = init(r, size + 1, budget + 1, 0) +// iter of interviewees, it => +// whileDo of () => +// if next(it) is +// Some(itv) then if itv is Itv(score, salary) then +// let j = r.ref 0 +// whileDo of () => +// if !j < salary then update(dp, !i, !j, get(dp, !i - 1, !j)) +// else +// let p = get(dp, !i - 1, !j - salary), let np = get(dp, !i - 1, !j) +// update(dp, !i, !j, max of np, p + score) +// j := !j + 1; !j <= budget +// i := !i + 1 +// true +// None then false +// i := size +// let rest = r.ref budget +// revIter of interviewees, it => +// whileDo of () => +// if next(it) is +// Some(itv) then if itv is Itv(score, salary) then +// if get(dp, !i, !rest) == get(dp, !i - 1, !rest - salary) + score +// do push(interviewees, itv); rest := !rest - salary +// i := !i - 1 +// true +// None then false +// get(dp, size, budget) + +// region r in +// let interviewees = empty(r) +// push(interviewees, Itv(20, 3000)) +// push(interviewees, Itv(50, 1000)) +// push(interviewees, Itv(30, 1000)) +// region r2 in +// let results = empty(r2) +// let m = wrongSelect(interviewees, 4000, results) +// printAll(results) +// m + + +region r in + let interviewees = empty(r) + push(interviewees, Itv(40, 10)) + push(interviewees, Itv(60, 20)) + push(interviewees, Itv(120, 30)) + push(interviewees, Itv(70, 20)) + println("all interviewees:") + printAll(interviewees) + region r2 in + let results = empty(r2) + let m = select(interviewees, 60, results) + println("candidates:") + printAll(results) + m +//│ Type: Int +//│ ———————————————————————————————————————————————————————————————————————————————— diff --git a/hkmc2/shared/src/test/mlscript/invalml/web-demos/ExamplesInResponse.mls b/hkmc2/shared/src/test/mlscript/invalml/web-demos/ExamplesInResponse.mls new file mode 100644 index 0000000000..0b737ff358 --- /dev/null +++ b/hkmc2/shared/src/test/mlscript/invalml/web-demos/ExamplesInResponse.mls @@ -0,0 +1,122 @@ +:invalml + + +:... +//│ ———————————————————————————————————————————————————————————————————————————————— + + +// * This file contains examples in the author response. A few typos therein are corrected. + + +// Some utility functions: + +fun wield: [R] -> (Region[out R]) ->{R} () +fun freeze: [R, E extends ~R, T] -> (Region[out R], () ->{~R & E} T) ->{R | E} T +// ^ Fixed a typo in the author response (`{~R | E}` should have been `{~R & E}`) + +fun (;) seq(_, res) = res +fun rand: () -> Bool +fun print: Any -> () + + +// ### Example 1 + + +// Passing the same region for both arguments fundamentally does not work approaches like Rust and Capability Calculus. +fun foo1(r1, r2) = + freeze(r1, () => print("ok")) + wield(r2) + +// InvalML allows r1 and r2 to alias as long as ‹body› does not use r2; for instance: +region r in + foo1(r, r) + +// Capability Calculus and related systems would require r2 to be distinct from r1. + +// Note – this also works: +region r in + region s in + foo1(r, s) + +// Here is a slightly less trivial examples that still type checks seamlessly in InvalML: +region r0 in + + fun foo1(r1, r2) = + freeze(r1, () => wield(r0)) + wield(r2) + + region r in + foo1(r, r) + + region r in + region s in + foo1(r, s) + + +// On the other hand, given +fun foo2(r1, r2) = + freeze(r1, () => wield(r2)) + wield(r2) + +// we rightfully reject +// region r in +// foo2(r, r) + +// but still accept +region r in + region s in + foo2(r, s) + + +// ### Example 2 + + +fun foo3: [outer, R extends outer] -> Region[out R] ->{outer} () +fun foo3(r1) = + region r2 in + freeze(r2, () => + wield(r1) + ) +// ^ Fixed typos in the author response (it used the paper's syntax instead of the implementation's syntax) + +// In fact, this formally equivalent signature also works: +fun foo3': [outer] -> Region[out outer] ->{outer} () +fun foo3'(r1) = foo3(r1) + + +// ### Example 3 + + +fun foo4(r1, r2, f) = + let exec = freeze(r1, () => freeze(r2, () => f(r1, r2))) + let r = exec() + !r + 1 + +region r in + region s in + foo4(r, s, (x, y) => + if rand() then print("Chose x"); () => x.ref 0 + else print("Chose y"); () => y.ref 1) + + +// ### Example 4 + + +fun foo5(f) = + region r in + freeze(r, () => f(32)) + + +fun freeze2: [R, E extends ~R, T] -> (Region[out R], () ->{~R & E} T) ->{R | E} T + +fun foo6(f) = + region r in + freeze(r, () => f(32)) + +foo6 + + +//│ Type: [outer, 'app, 'eff] -> (Int ->{'eff} 'app) ->{'eff} 'app +//│ Where: +//│ 'eff <: outer +//│ ———————————————————————————————————————————————————————————————————————————————— diff --git a/hkmc2/shared/src/test/mlscript/invalml/web-demos/ExamplesInThePaper.mls b/hkmc2/shared/src/test/mlscript/invalml/web-demos/ExamplesInThePaper.mls new file mode 100644 index 0000000000..923446917a --- /dev/null +++ b/hkmc2/shared/src/test/mlscript/invalml/web-demos/ExamplesInThePaper.mls @@ -0,0 +1,67 @@ +:invalml + +:... +//│ ———————————————————————————————————————————————————————————————————————————————— + + +// * This file contains examples in the paper + +class ArrayList[A, R] +class List[A] +class Iter[T, R] + +fun mkArrayList : [R, T] -> (Region[out R]) ->{R} ArrayList[T, R] +fun add : [R, T] -> (ArrayList[T, R], T) ->{R} () +fun clear : [R, T] -> ArrayList[T, R] ->{R} () +fun foreach : [E, R, T] -> (Iter[T, R], T ->{E} ()) -> {R | E} () +fun iter : [Res, R, E extends ~R, T] -> (ArrayList[T, R], [I] -> Iter[T, I] ->{I | E} Res) ->{E | R} Res +fun map: [T, S, E] -> (List[out T], T ->{E} S) ->{E} List[out S] + +fun println: Any -> () +fun (;) seq(_, res) = res + +region r in // This is used to delimit the scope of mutation + let xs = mkArrayList(r) // Creates a new mutable list in r egion r + add(xs, "1"); add(xs, "2"); add(xs, "3"); + iter(xs, it => foreach(it , e => println(e))) + +// region r in // This is used to delimit the scope of mutation +// let xs = mkArrayList(r) // Creates a new mutable list in r egion r +// add(xs, "1"); add(xs, "2"); add(xs, "3"); +// iter(xs, it => foreach(it , e => println (e); clear (xs))) + +fun mapi: [A, B, E] -> (List[out A], (Int, A) ->{E} B) ->{E} List[out B] +fun mapi(xs, f) = + region r in + let index = r.ref 0 in map(xs, x => let res = f(!index, x) in index := !index + 1; res) + + +fun f: [R1, R2 extends ~R1] -> (Region[out R1], Region[out R2]) ->{R1 | R2} Int + + +// region r1 in +// let g = (r => region r2 in f(r, r2)) in (region r3 in g(r3)) + + +region r1 in + fun g: [outer, R extends outer] -> Region[out R] ->{R} Int + fun g(r) = region r2 in f(r, r2) + region r3 in g(r3) + + +region r in + let a1 = mkArrayList(r) in add(a1, 12); add(a1, 34); + iter of a1, it1 => + region s in + let a2 = mkArrayList(s) + foreach of it1, v1 => add(a2 , v1) + iter of a2, it2 => foreach of it2 , v2 => println(v2) + clear(a2) + + +// region r in +// let a = mkArrayList(r) in add(a, 12); add(a, 34); +// iter of a, it => +// foreach of it, v => println(v); clear(a) + +//│ ———————————————————————————————————————————————————————————————————————————————— diff --git a/hkmc2/shared/src/test/mlscript/invalml/web-demos/Exception.mls b/hkmc2/shared/src/test/mlscript/invalml/web-demos/Exception.mls new file mode 100644 index 0000000000..69769f934c --- /dev/null +++ b/hkmc2/shared/src/test/mlscript/invalml/web-demos/Exception.mls @@ -0,0 +1,39 @@ +:invalml + +:... +//│ ———————————————————————————————————————————————————————————————————————————————— + +// * This files includes the exception handling extension of InvalML. + +class Exc[T] + +fun (;) seq(_, res) = res + +fun raise: [T, P extends Exc[T]] -> (P, T) ->{P} Nothing +fun hdle: [Res, E, T] -> ([P extends Exc[T]] -> (P) ->{E | P} Res, T ->{E} Res) ->{E} Res +fun print: Str -> Unit +fun noExc: [E extends ~Exc[in Nothing out Any], Res] -> (() ->{E} Res) ->{E} Res + + +hdle(e => raise(e, "oops!"), msg => print(msg)) + +// Error! The payload type is incorrect. +// hdle(e => raise(e, 42), msg => print(msg)) + + +fun div(x, y) = + hdle(e => if y is 0 then raise(e, "div-by-zero!") else x / y, msg => print(msg); 0) + + +hdle(e1 => hdle(e2 => raise(e1, "oops!"), msg => print(msg)), msg => print(msg)) +hdle(e1 => hdle(e2 => raise(e2, "oops!"), msg => print(msg)), msg => print(msg)) +hdle(e1 => hdle(e2 => raise(e1, "oops!"), msg => raise(e1, msg)), msg => print(msg)) + + +noExc(() => 42) +noExc(() => hdle(e => raise(e, "oops!"), msg => print(msg))) + +// Error! No exception is allowed. +// hdle(e => noExc(() => raise(e, "oops!")), msg => print(msg)) + +//│ ———————————————————————————————————————————————————————————————————————————————— diff --git a/hkmc2/shared/src/test/mlscript/invalml/web-demos/README.md b/hkmc2/shared/src/test/mlscript/invalml/web-demos/README.md new file mode 100644 index 0000000000..71af280b10 --- /dev/null +++ b/hkmc2/shared/src/test/mlscript/invalml/web-demos/README.md @@ -0,0 +1,62 @@ +# Web-Demo + +## Syntax + +Most syntax can be found in the paper. +We list the changed and non-mentioned syntax in this documentation. + +### ADT Declarations + +We use the following syntax to declare ADTs: +```fs +class List[T] with + constructor + Nil + Cons(x: T, xs: List[out T]) +``` +which is equivalent to the syntax used in the paper: +```scala +enum List[T]: + case Nil + case Cons(x: T, xs: List[out T]) +``` + +### Functions + +Keyword `case` is used to create a function that +pattern matches on the unique parameter. +```fs +fun fact = case + 1 then 1 + n then n * fact(n - 1) +``` +which is equivalent to +```fs +fun fact(x) = if x is + 1 then 1 + n then n * fact(n - 1) +``` + +Keyword `of` is used for function application +to avoid unnecessary parentheses. +```fs +fun add(x, y, z) = x + y + z +add of 1, 2, 3 +``` +which is equivalent to +```fs +fun add(x, y, z) = x + y + z +add(1, 2, 3) +``` + +### Type Annotations + +Type annotations are written in the following syntax: +```fs +[T] -> ... // equivalent to ∀ T. ... +[T extends S] -> ... // equivalent to ∀ T {T ≤ S}. ... +[T restricts S] -> ... // equivalent to ∀ T {S ≤ T}. ... +T | S // equivalent to T ∨ S +T & S // equivalent to T ∧ S +~T // equivalent to ¬T +``` diff --git a/hkmc2/shared/src/test/mlscript/invalml/web-demos/SimpleConstraintSolver.mls b/hkmc2/shared/src/test/mlscript/invalml/web-demos/SimpleConstraintSolver.mls new file mode 100644 index 0000000000..47fa227d7b --- /dev/null +++ b/hkmc2/shared/src/test/mlscript/invalml/web-demos/SimpleConstraintSolver.mls @@ -0,0 +1,404 @@ +:invalml + +:... +//│ ———————————————————————————————————————————————————————————————————————————————— + +// * In this file, we implement a simple constraint solver, originally presented in https://doi.org/10.1145/3410225 +// * We only implement int type, function types, and type variables for simplicity + +// *** infrastructures + +fun not(b) = if b then false else true +fun (;) seq(_, res) = res +fun id(x) = x + +fun println: Any -> () +fun (~) concat: (Str, Str) -> Str +fun toString: Any -> Str +fun (===) streq: (Str, Str) -> Bool +fun error() = error() + +class PairOf[out A, out B] with + constructor + Pair(fst: A, snd: B) + +class Option[out A] with + constructor + None() + Some(value: A) + +class List[out A] with + constructor + Nil() + Cons(head: A, tail: List[A]) + +fun fold(x, xs, f) = if xs is + Nil() then x + Cons(y, ys) then fold(f(x, y), ys, f) + +fun map(xs, f) = if xs is + Nil() then Nil() + Cons(x, xs) then Cons(f(x), map(xs, f)) + +fun each(xs, f) = if xs is + Nil() then () + Cons(x, xs) then f(x); each(xs, f) + +fun find(xs, f) = if xs is + Nil() then None() + Cons(x, xs) then + if f(x) then Some(x) + else find(xs, f) + +class ArrayList[T, out R] +class Iter[T, out R] +class HashMap[K, V, out R] +class MapIter[T, out R] + +// fun empty: [A, R] -> Region[R] ->{R} ArrayList[out A, out R] // TODO investigate: why does this break things? +fun empty: [A, R] -> Region[out R] ->{R} ArrayList[A, out R] +fun clear: [A, R] -> (ArrayList[A, out R]) ->{R} () +fun push: [A, R] -> (ArrayList[A, R], A) ->{R} () +fun len: [A, R] -> (ArrayList[A, R]) ->{R} Int +fun iter: [Res, R, E extends ~R, T] -> (ArrayList[T, R], [S] -> Iter[T, S] ->{S | E} Res) ->{E | R} Res +fun next: [T, S] -> Iter[T, S] ->{S} Option[T] +fun whileDo: [R] -> (() ->{R} Bool) ->{R} () +fun foreach: [E, R, T] -> (Iter[T, R], T ->{E} ()) ->{R | E} () +fun max(x, y) = if x < y then y else x + + +fun mkHashMap: [R, K, V] -> (Region[out R], K -> Str) ->{R} HashMap[K, V, R] +fun getOrUpdate: [R, K, V, E] -> (HashMap[K, V, R], K, () ->{E} V) ->{E | R} V +fun hasOrUpdate: [R, K, V, E] -> (HashMap[K, V, R], K, () ->{E} V) ->{E | R} () +fun iterMap: [Res, R, E extends ~R, K, V] -> (HashMap[K, V, R], [S] -> MapIter[V, S] ->{S | E} Res) ->{E | R} Res +fun nextVal: [T, S] -> MapIter[T, S] ->{S} Option[T] +fun hasKey: [K, V, R] -> (HashMap[K, V, R], K) ->{R} Bool +fun add: [K, V, R] -> (HashMap[K, V, R], K, V) ->{R} () +fun values: [E, R, T] -> (MapIter[T, R], T ->{E} ()) ->{R | E} () + +// *** simple constraint solver + + +// Unif contains a type variable's id, lower bounds, and upper bounds. +class Type[out R] with + constructor + IntType() + FunctionType(lhs: Type[R], rhs: Type[R]) + RecordType(fields: List[PairOf[Str, Type[R]]]) + TypeVariable(id: Str, level: Int, lowerBounds: ArrayList[Type[R], R], upperBounds: ArrayList[Type[R], R]) + + +fun isSimpl(ty) = if ty is + FunctionType(_, _) then false + else true + + +fun ty2Str(ty) = if ty is + IntType() then "Int" + FunctionType(lhs, rhs) then + let ls = if isSimpl(lhs) then ty2Str(lhs) else "(" ~ ty2Str(lhs) ~ ")" + ls ~ " -> " ~ ty2Str(rhs) + RecordType(fields) then "{ " ~ fold("", fields, (s, p) => if p is Pair(n, t) then s ~ n ~ ": " ~ ty2Str(t) ~ ", ") ~ "}" + TypeVariable(name, level, _, _) then name ~ "_" ~ toString(level) + +// fun levelOf: [R] -> Type[R] -> Int +fun levelOf(ty) = if ty is + IntType() then 0 + FunctionType(lhs, rhs) then max(levelOf(lhs), levelOf(rhs)) + RecordType(fields) then fold(0, fields, (r, p) => if p is Pair(_, t) then max(r, levelOf(t))) + TypeVariable(_, level, _, _) then level + +fun report(lhs, rhs) = + println("Cannot constrain " ~ ty2Str(lhs) ~ " <: " ~ ty2Str(rhs) ~ "!") + + +fun extrude: [outer, R extends outer] -> (Type[R], Bool, Int, (Str, Int) ->{R} Type[R], HashMap[PairOf[Type[R], PairOf[Int, Bool]], Type[R], R]) ->{R} Type[R] +fun extrude(ty, pol, lvl, freshVar, cache) = getOrUpdate of cache, Pair(ty, Pair(lvl, pol)), () => + if levelOf(ty) <= lvl then ty + else if ty is + IntType() then ty + FunctionType(lhs, rhs) then + FunctionType(extrude(lhs, not(pol), lvl, freshVar, cache), extrude(rhs, pol, lvl, freshVar, cache)) + RecordType(fields) then + RecordType(map(fields, p => if p is Pair(name, ty) then Pair(name, extrude(ty, pol, lvl, freshVar, cache)))) + TypeVariable(name, level, lb, ub) then + let nc = freshVar(name ~ "'" ~ (if pol then "+" else "-"), lvl) + if pol then + push(ub, nc) + let nlb = if nc is + TypeVariable(_, _, lb, _) then lb + else error() // impossible + region r in + let nbd = empty(r) + iter of lb, it => foreach(it, b => push(nbd, b)) + iter of nbd, it => foreach(it, b => push(nlb, extrude(b, pol, lvl, freshVar, cache))) + else + push(lb, nc) + let nub = if nc is + TypeVariable(_, _, _, ub) then ub + else error() // impossible + region r in + let nbd = empty(r) + iter of ub, it => foreach(it, b => push(nbd, b)) + iter of nbd, it => foreach(it, b => push(nub, extrude(b, pol, lvl, freshVar, cache))) + nc + +// fun solve: [outer, R extends outer] -> (List[PairOf[Type[R], Type[R]]], (Str, Int) ->{R} Type[R], HashMap[PairOf[Type[R], Type[R]], Any, R], () ->{R} HashMap[PairOf[Type[R], PairOf[Int, Bool]], Type[R], R]) ->{R} () +fun solve(constraints, freshVar, cache, genExtrCache) = if constraints is + Nil() then () + Cons(c, cs) then if c is + Pair(lhs, rhs) then hasOrUpdate of cache, c, () => + if lhs is + IntType() then if rhs is + IntType() then solve(cs, freshVar, cache, genExtrCache) + TypeVariable(name, level, lb, ub) then + push(lb, lhs) + region r in + let ncs = r.ref cs + iter(ub, it => foreach(it, b => ncs := Cons(Pair(lhs, b), !ncs); ())) + solve(!ncs, freshVar, cache, genExtrCache) + else report(lhs, rhs) + FunctionType(arg, res) then if rhs is + FunctionType(arg', res') then + solve(Cons(Pair(arg', arg), Cons(Pair(res, res'), cs)), freshVar, cache, genExtrCache) + TypeVariable(name, level, lb, ub) then + if levelOf(lhs) <= level then + push(lb, lhs) + region r in + let ncs = r.ref cs + iter(ub, it => foreach(it, b => ncs := Cons(Pair(lhs, b), !ncs); ())) + solve(!ncs, freshVar, cache, genExtrCache) + else + let lhs' = extrude(lhs, true, level, freshVar, genExtrCache()) + solve(Cons(Pair(lhs', rhs), cs), freshVar, cache, genExtrCache) + else report(lhs, rhs) + RecordType(flds) then if rhs is + RecordType(flds') then each(flds', p' => + if p' is Pair(n', t') then + if find(flds, p => if p is Pair(n, t) then n === n') is + Some(p) then if p is Pair(n, t) then solve(Cons(Pair(t, t'), cs), freshVar, cache, genExtrCache) + None() then println("Missing field " ~ n' ~ " in " ~ ty2Str(lhs)) + ) + TypeVariable(name, level, lb, ub) then + if levelOf(lhs) <= level then + push(lb, lhs) + region r in + let ncs = r.ref cs + iter(ub, it => foreach(it, b => ncs := Cons(Pair(lhs, b), !ncs); ())) + solve(!ncs, freshVar, cache, genExtrCache) + else + let lhs' = extrude(lhs, true, level, freshVar, genExtrCache()) + solve(Cons(Pair(lhs', rhs), cs), freshVar, cache, genExtrCache) + else report(lhs, rhs) + TypeVariable(name, level, lb, ub) then + if levelOf(rhs) <= level then + push(ub, rhs) + region r in + let ncs = r.ref cs + iter(lb, it => foreach(it, b => ncs := Cons(Pair(b, rhs), !ncs); ())) + solve(!ncs, freshVar, cache, genExtrCache) + else + let rhs' = extrude(rhs, false, level, freshVar, genExtrCache()) + solve(Cons(Pair(lhs, rhs'), cs), freshVar, cache, genExtrCache) + + +fun freshVar(r, ctx, name, lvl) = + if (not of hasKey(ctx, name)) then + add(ctx, name, 1) + TypeVariable(name, lvl, empty(r), empty(r)) + else + region r2 in + let i = r2.ref 0 + let res = r2.ref None() + whileDo of () => + let nn = name ~ toString(!i) + if (not of hasKey(ctx, nn)) then + res := Some(TypeVariable(nn, lvl, empty(r), empty(r))) + add(ctx, nn, 1) + false + else + i := !i + 1 + true + if !res is + Some(v) then v + else error() + + +fun genHash(r) = + mkHashMap(r, p => if p is Pair(x, y) then ty2Str(x) ~ " <: " ~ ty2Str(y)) + +fun genExtrHash(r) = + () => mkHashMap(r, t => if t is Pair(ty, p) then if p is Pair(lvl, pol) then ty2Str(ty) ~ (if pol then "+_" else "-_") ~ toString(lvl)) + +fun printBounds(tv) = if tv is + TypeVariable(name, level, lb, ub) then + iter of lb, it => + foreach of it, b => println(" " ~ ty2Str(b) ~ " <: " ~ ty2Str(tv)) + iter of ub, it => + foreach of it, b => println(" " ~ ty2Str(tv) ~ " <: " ~ ty2Str(b)) + else () + +// fun printRes: [outer, R extends outer] -> (Type[R], Type[R]) ->{R} () +fun printRes(lhs, rhs) = + println(ty2Str(lhs) ~ " <: " ~ ty2Str(rhs)) + region r in + let tvs = mkHashMap(r, s => s) + // fun go: [outer, R extends outer, S extends outer] -> (Type[R], HashMap[Str, Type[R], S]) ->{R | S} () + fun go(t, tvs) = if t is + IntType() then () + FunctionType(lhs, rhs) then go(lhs, tvs); go(rhs, tvs) + RecordType(fields) then each(fields, p => if p is Pair(_, t) then go(t, tvs)) + TypeVariable(name, level, lb, ub) then + getOrUpdate of tvs, name ~ toString(level), () => + region r2 in + let tmp = empty(r2) + iter of lb, it => foreach(it, ty => push(tmp, ty)) + iter of ub, it => foreach(it, ty => push(tmp, ty)) + t + () + go(lhs, tvs); go(rhs, tvs) + println("where: ") + iterMap of tvs, it => + values of it, printBounds + +// *** error example + +// if we call the `solve` function during the iteration, the `solve` function +// can only handle the cases where no allocation is required (i.e., no type variables) +// fun TODO() = TODO() +// fun wrongSolve(constraints, freshVar, cache, genExtrCache) = if constraints is +// Nil() then () +// Cons(c, cs) then if c is +// Pair(lhs, rhs) then hasOrUpdate of cache, c, () => +// if lhs is +// IntType() then TODO() +// FunctionType(arg, res) then TODO() +// RecordType(flds) then TODO() +// TypeVariable(name, level, lb, ub) then +// if levelOf(rhs) <= level then +// push(ub, rhs) +// iter(lb, it => foreach(it, b => solve(Cons(Pair(b, rhs), Nil()), freshVar, cache, genExtrCache))) +// solve(cs, freshVar, cache, genExtrCache) +// else +// let rhs' = extrude(rhs, false, level, freshVar, genExtrCache()) +// solve(Cons(Pair(lhs, rhs'), cs), freshVar, cache, genExtrCache) + + +// The error' version of `solve` function can only be used for constraints without type variables +// wrongSolve(Cons(Pair(IntType, IntType), Nil())) + +// Calling the `wrongSolve` function to solve constraints involving type variables will lead to type errors +// region r in +// let ctx = mkHashMap(r, s => s) +// let a = freshVar(r, ctx, "a", 1) +// let b = freshVar(r, ctx, "a", 1) +// let lhs = a +// let rhs = b +// wrongSolve(Cons(Pair(lhs, rhs), Nil()), (n, l) => freshVar(r, ctx, n, l), genHash(r), genExtrHash(r)) +// printRes(lhs, rhs) + +// *** examples + +region r in + let ctx = mkHashMap(r, s => s) + let lhs = FunctionType(IntType(), IntType()) + let rhs = IntType() + solve(Cons(Pair(lhs, rhs), Nil()), (n, l) => freshVar(r, ctx, n, l), genHash(r), genExtrHash(r)) + +region r in + let ctx = mkHashMap(r, s => s) + let lhs = FunctionType(IntType(), IntType()) + let a = freshVar(r, ctx, "a", 1) + let rhs = FunctionType(a, a) + solve(Cons(Pair(lhs, rhs), Nil()), (n, l) => freshVar(r, ctx, n, l), genHash(r), genExtrHash(r)) + printRes(lhs, rhs) + + +region r in + let ctx = mkHashMap(r, s => s) + let lhs = RecordType(Cons(Pair("a", IntType()), Cons(Pair("b", FunctionType(IntType(), IntType())), Nil()))) + let a = freshVar(r, ctx, "a", 1) + let b = freshVar(r, ctx, "b", 1) + let rhs = RecordType(Cons(Pair("a", a), Cons(Pair("b", b), Nil()))) + solve(Cons(Pair(lhs, rhs), Nil()), (n, l) => freshVar(r, ctx, n, l), genHash(r), genExtrHash(r)) + printRes(lhs, rhs) + + +region r in + let ctx = mkHashMap(r, s => s) + let a = freshVar(r, ctx, "a", 1) + let b = freshVar(r, ctx, "b", 1) + let lhs = a + let rhs = b + solve(Cons(Pair(lhs, rhs), Cons(Pair(rhs, lhs), Nil())), (n, l) => freshVar(r, ctx, n, l), genHash(r), genExtrHash(r)) + printRes(lhs, rhs) + printRes(rhs, lhs) + + +region r in + let ctx = mkHashMap(r, s => s) + let lhs = RecordType(Cons(Pair("a", IntType()), Cons(Pair("b", FunctionType(IntType(), IntType())), Nil()))) + let b = freshVar(r, ctx, "b", 1) + let rhs = RecordType(Cons(Pair("b", b), Nil())) + solve(Cons(Pair(lhs, rhs), Nil()), (n, l) => freshVar(r, ctx, n, l), genHash(r), genExtrHash(r)) + printRes(lhs, rhs) + + +region r in + let ctx = mkHashMap(r, s => s) + let a = freshVar(r, ctx, "a", 1) + let b = freshVar(r, ctx, "b", 1) + let lhs = FunctionType(IntType(), a) + let rhs = FunctionType(IntType(), b) + if a is + TypeVariable(_, _, _, ub) then push(ub, lhs) + else error() // impossible + if b is + TypeVariable(_, _, lb, _) then push(lb, rhs) + else error() // impossible + solve(Cons(Pair(a, b), Nil()), (n, l) => freshVar(r, ctx, n, l), genHash(r), genExtrHash(r)) + printRes(a, b) + + +region r in + let ctx = mkHashMap(r, s => s) + let a = freshVar(r, ctx, "a", 1) + let lhs = a + let rhs = FunctionType(IntType(), IntType()) + if a is + TypeVariable(_, _, lb, ub) then push(lb, IntType()) + else error() // impossible + solve(Cons(Pair(lhs, rhs), Nil()), (n, l) => freshVar(r, ctx, n, l), genHash(r), genExtrHash(r)) + + +region r in + let ctx = mkHashMap(r, s => s) + let a = freshVar(r, ctx, "a", 1) + let b = freshVar(r, ctx, "b", 2) + let lhs = FunctionType(IntType(), a) + let rhs = FunctionType(IntType(), b) + solve(Cons(Pair(lhs, rhs), Nil()), (n, l) => freshVar(r, ctx, n, l), genHash(r), genExtrHash(r)) + printRes(lhs, rhs) + + +region r in + let ctx = mkHashMap(r, s => s) + let a = freshVar(r, ctx, "a", 1) + let b = freshVar(r, ctx, "a", 1) + let lhs = a + let rhs = b + solve(Cons(Pair(lhs, rhs), Nil()), (n, l) => freshVar(r, ctx, n, l), genHash(r), genExtrHash(r)) + printRes(lhs, rhs) + + +region r in + let ctx = mkHashMap(r, s => s) + let a = freshVar(r, ctx, "a", 1) + let b = freshVar(r, ctx, "b", 2) + let lhs = a + let rhs = FunctionType(b, FunctionType(b, b)) + solve(Cons(Pair(lhs, rhs), Nil()), (n, l) => freshVar(r, ctx, n, l), genHash(r), genExtrHash(r)) + printRes(lhs, rhs) + + +//│ ———————————————————————————————————————————————————————————————————————————————— diff --git a/hkmc2/shared/src/test/mlscript/invalml/web-demos/StackMM.mls b/hkmc2/shared/src/test/mlscript/invalml/web-demos/StackMM.mls new file mode 100644 index 0000000000..d952cc946c --- /dev/null +++ b/hkmc2/shared/src/test/mlscript/invalml/web-demos/StackMM.mls @@ -0,0 +1,47 @@ +:invalml + +:... +//│ ———————————————————————————————————————————————————————————————————————————————— + +// * This files includes the stack-based memory management extension of InvalML. + +class Stack[S, R] +class StackRef[T, R] + +fun (;) seq(_, res) = res + +fun allocStack: [E, Res] -> ([S, R] -> Stack[S, R] ->{S | R | E} Res) ->{E} Res +fun alloc: [S, R, A] -> (Stack[S, R], A) ->{S} StackRef[A, R] +fun read: [R, A] -> StackRef[A, R] ->{R} A +fun write: [R, A] -> (StackRef[A, R], A) ->{R} () +fun push: [Res, S, R, E extends ~S] -> (Stack[S, R], [U] -> Stack[U, R] -> {U | R | E} Res) ->{E | R | S} Res + + +allocStack of s => + let r1 = alloc(s, 42) + let r2 = alloc(s, 0) + write(r1, 1) + read(r2) + + +allocStack of s1 => + let r1 = alloc(s1, 42) + let r2 = alloc(s1, 0) + write(r1, 1) + read(r2) + push of s1, s2 => + let r3 = alloc(s2, 0) in read(r3) + + +// Error! After pusing `s1`, one can not allocate references on it. +// allocStack of s1 => +// let r1 = alloc(s1, 42) +// let r2 = alloc(s1, 0) +// write(r1, 1) +// read(r2) +// push of s1, s2 => +// let r3 = alloc(s1, 0) in read(r3) + + +//│ Type: Int +//│ ———————————————————————————————————————————————————————————————————————————————— diff --git a/hkmc2/shared/src/test/mlscript/invalml/web-demos/Staging.mls b/hkmc2/shared/src/test/mlscript/invalml/web-demos/Staging.mls new file mode 100644 index 0000000000..cd8d9aad8f --- /dev/null +++ b/hkmc2/shared/src/test/mlscript/invalml/web-demos/Staging.mls @@ -0,0 +1,75 @@ +:invalml + +:... +//│ ———————————————————————————————————————————————————————————————————————————————— + +// * This files includes the metaprogramming extension of InvalML. + +// Type `CodeBase[T, R, S]`: +// T: type of quoted expression +// R: union of free variables' skolems +// S: can be either top or bot. `CodeBase[T, R, bot]` is equivalent to `Var[T, R]`; `CodeBase[T, R, top]` is equivalent to `Code[T, R]`. + +fun power: [C] -> CodeBase[out Num, out C, out Any] -> Int -> CodeBase[out Num, out C, out Any] +fun power(x) = case + 0 then `1.0 + n then x `*. power(x)(n - 1) +power + +fun id: [A] -> A -> A +fun id(x) = x + + +run(x `=> id(x) `* x) + + +fun assertNotZero: [C] -> CodeBase[out Num, out C, out Any] -> CodeBase[out Num, out C, out Any] +fun assertNotZero(x) = + `if (x `== `0.0) then `error else x +let checkedDiv = x `=> y `=> x `/. (assertNotZero(y)) +run(checkedDiv) + + + +fun show: [T] -> CodeBase[out T, out Any, out Any] -> Str = s => "debug" + +fun inc(dbg) = + x `=> let c = x `+ `1 in let t = dbg(c) in c + +inc(c => log(show(c))) + +fun body_naive: [T, C] -> (CodeBase[out Int, out T, out Any], CodeBase[out Int, out C, out Any]) -> Int -> CodeBase[out Int, out T | C, out Any] +fun body_naive(x, y) = case + 0 then x + 1 then y + n then body_naive(y, x `+ y)(n - 1) +fun gib_naive(n) = + (x, y) `=> body_naive(x, y)(n) +let gn5 = run(gib_naive(5)) + + +// Wrong version! There is an unexpected extrusion in `bind`, making `bind` unusable. +// fun bind(rhs, k) = `let x = rhs `in k(x) +// fun body: [G] -> (CodeBase[out Int, out G, out Any], CodeBase[out Int, out G, out Any]) -> Int -> CodeBase[out Int, out G, out Any] +// fun body(x, y) = case +// 0 then x +// 1 then y +// n then bind of x `+ y, (z => body(y, z)(n - 1)) + + +fun bind: [G] -> (CodeBase[out Int, out G, out Any], [C] -> CodeBase[out Int, out C, out Any] -> CodeBase[out Int, out C | G, out Any]) -> CodeBase[out Int, out G, out Any] +fun bind(rhs, k) = `let x = rhs `in k(x) + +fun body: [G] -> (CodeBase[out Int, out G, out Any], CodeBase[out Int, out G, out Any]) -> Int -> CodeBase[out Int, out G, out Any] +fun body(x, y) = case + 0 then x + 1 then y + n then bind of x `+ y, (z => body(y, z)(n - 1)) + +fun gib(n) = (x, y) `=> body(x, y)(n) +let g5 = run(gib(5)) +g5 + + +//│ Type: (Int, Int) -> Int +//│ ———————————————————————————————————————————————————————————————————————————————— diff --git a/hkmc2/shared/src/test/mlscript/invalml/web-demos/flix/GUI.mls b/hkmc2/shared/src/test/mlscript/invalml/web-demos/flix/GUI.mls new file mode 100644 index 0000000000..6e496c501e --- /dev/null +++ b/hkmc2/shared/src/test/mlscript/invalml/web-demos/flix/GUI.mls @@ -0,0 +1,60 @@ +:invalml + +:... +//│ ———————————————————————————————————————————————————————————————————————————————— + +// * This file includes the type checking implementation for the GUI example +// * adapted from https://doi.org/10.5281/zenodo.7990289 + +class Block +class IO +class Label +class Button + +// * So far, our system does not support impure programs. +// * We explicitly insert this handle function at **the top level** to allow primitive effects like IO and Block +fun doPrimitiveEffects: [Res, E] -> (() ->{E | IO | Block} Res) ->{E} Res + +fun sleep: (Int) ->{Block} () + +fun mkLabel: (Str) ->{IO} Label +fun mkButton: (Str) ->{IO} Button + +fun setText: (Str, Label) ->{IO} () + +// The callback function should not block the execution +// so `E` has an upper bound `~Block` +fun addActionListener: [T, E extends ~Block] -> (() ->{E} (), Button) ->{E | T} () + + + +// examples + +doPrimitiveEffects of () => + sleep(42) + +doPrimitiveEffects of () => + mkLabel("Hello, World!") + +doPrimitiveEffects of () => + let label = mkLabel("Hello, World!") + sleep(42) + setText("Goodbye, World!", label) + +// ok! `setText` will not block the execution +doPrimitiveEffects of () => + let label = mkLabel("label") + let button = mkButton("button") + addActionListener(() => setText("clicked!", label), button) + + + +// error! `sleep` will block the execution and the compiler reject the following program +// doPrimitiveEffects of () => +// let label = mkLabel("label") +// let button = mkButton("button") +// addActionListener(() => sleep(1), button) + + +//│ ———————————————————————————————————————————————————————————————————————————————— + diff --git a/hkmc2/shared/src/test/mlscript/invalml/web-demos/flix/Interpreter.mls b/hkmc2/shared/src/test/mlscript/invalml/web-demos/flix/Interpreter.mls new file mode 100644 index 0000000000..b36d3dc019 --- /dev/null +++ b/hkmc2/shared/src/test/mlscript/invalml/web-demos/flix/Interpreter.mls @@ -0,0 +1,208 @@ +:invalml + +:... +//│ ———————————————————————————————————————————————————————————————————————————————— + +// * This file includes the implementation for an interpreter and a compiler for a small toy programming language. +// * Adapted from https://doi.org/10.5281/zenodo.7990289 + + +class List[T] with + constructor + Nil + Cons(x: T, xs: List[out T]) + + +fun concat: [T] -> (List[out T], List[out T]) -> List[out T] +fun (;) seq(_, res) = res +fun error: Nothing + + +// * Arithmetical Expression +class AExp with + constructor + Cst(v: Int) + Plus(lhs: AExp, rhs: AExp) + Minus(lhs: AExp, rhs: AExp) + Times(lhs: AExp, rhs: AExp) + IfThenElse(cond: BExp, cons: AExp, alts: AExp) + + +// * Boolean Expression +class BExp with + constructor + True + False + Not(v: BExp) + Conj(lhs: BExp, rhs: BExp) + Disj(lhs: BExp, rhs: BExp) + Eq(lhs: AExp, rhs: AExp) + Neq(lhs: AExp, rhs: AExp) + + +// * Evaliation functions + +fun evalBExp: BExp -> Bool + +fun evalAExp(e) = if e is + Cst(v) then v + Plus(e1, e2) then evalAExp(e1) + evalAExp(e2) + Minus(e1, e2) then evalAExp(e1) - evalAExp(e2) + Times(e1, e2) then evalAExp(e1) * evalAExp(e2) + IfThenElse(cond, e1, e2) then + if evalBExp(cond) then evalAExp(e1) else evalAExp(e2) + + +fun evalBExp(e) = if e is + True then true + False then false + Not(e) then evalBExp(e) is false + Conj(e1, e2) then evalBExp(e1) && evalBExp(e2) + Disj(e1, e2) then evalBExp(e1) || evalBExp(e2) + Eq(e1, e2) then evalAExp(e1) == evalAExp(e2) + Neq(e1, e2) then evalAExp(e1) != evalAExp(e2) + + +// * Examples + +evalAExp(Cst(42)) +evalAExp(Plus(Cst(42), Cst(21))) +evalAExp(Minus(Cst(42), Cst(21))) +evalAExp(IfThenElse(True, Cst(1), Cst(2))) +evalAExp(IfThenElse(Neq(Cst(1), Cst(2)), Cst(42), Cst(21))) + +evalBExp(True) +evalBExp(Not(True)) +evalBExp(Conj(True, False)) +evalBExp(Disj(True, False)) +evalBExp(Neq(Cst(1), Cst(2))) + + +// * Instruction +class Inst with + constructor + Push(v: Int) + Add + Sub + Mul + Neg + And + Or + Cmp + Branch(cons: List[out Inst], alts: List[out Inst]) + + +// * Compilation functions + +fun compileBExp: BExp -> List[out Inst] + +fun compileAExp(e) = if e is + Cst(v) then Cons(Push(v), Nil) + Plus(e1, e2) then + let is1 = compileAExp(e1) in + let is2 = compileAExp(e2) in + concat(concat(is2, is1), Cons(Add, Nil)) + Minus(e1, e2) then + let is1 = compileAExp(e1) in + let is2 = compileAExp(e2) in + concat(concat(is2, is1), Cons(Sub, Nil)) + Times(e1, e2) then + let is1 = compileAExp(e1) in + let is2 = compileAExp(e2) in + concat(concat(is2, is1), Cons(Mul, Nil)) + IfThenElse(e1, e2, e3) then + let is1 = compileBExp(e1) in + let is2 = compileAExp(e2) in + let is3 = compileAExp(e3) in + concat(is1, Cons(Branch(is2, is3), Nil)) + + +fun compileBExp(e) = if e is + True then Cons(Push(1), Nil) + False then Cons(Push(0), Nil) + Not(e) then concat(compileBExp(e), Cons(Neg, Nil)) + Conj(e1, e2) then + let is1 = compileBExp(e1) in + let is2 = compileBExp(e2) in + concat(concat(is2, is1), Cons(And, Nil)) + Disj(e1, e2) then + let is1 = compileBExp(e1) in + let is2 = compileBExp(e2) in + concat(concat(is2, is1), Cons(Or, Nil)) + Eq(e1, e2) then + let is1 = compileAExp(e1) in + let is2 = compileAExp(e2) in + concat(concat(is2, is1), Cons(Cmp, Nil)) + Neq(e1, e2) then + let is1 = compileAExp(e1) in + let is2 = compileAExp(e2) in + concat(concat(is2, is1), Cons(Neg, Cons(Cmp, Nil))) + + +// * Examples + +compileAExp(Cst(42)) +compileAExp(Plus(Cst(42), Cst(21))) +compileAExp(Minus(Cst(42), Cst(21))) +compileAExp(IfThenElse(True, Cst(1), Cst(2))) +compileAExp(IfThenElse(Neq(Cst(1), Cst(2)), Cst(42), Cst(21))) +compileBExp(True) +compileBExp(Not(True)) +compileBExp(Conj(True, False)) +compileBExp(Disj(True, False)) +compileBExp(Neq(Cst(1), Cst(2))) + + +// So far, we have not supported nested patterns. +// This helper function is for the following pattern matching: +// `if lst is Cons(x, Cons(y, ys)) then f(x, y, ys) else g()` +fun matchTwo(lst, f, g) = if lst is + Nil then g() + Cons(x, xs) then + if xs is + Nil then g() + Cons(y, ys) then f(x, y, ys) + + +// * Instruction evaluation + +fun evalInst(insts, stack) = if insts is + Nil then + if stack is + Cons(x, xs) then + if xs is + Nil then x + Cons(_, _) then error + Nil then error + Cons(inst, rest) then if inst is + Push(i) then evalInst(rest, Cons(i, stack)) + Add then matchTwo(stack, (x, y, r) => evalInst(rest, Cons(x + y, r)), () => error) + Sub then matchTwo(stack, (x, y, r) => evalInst(rest, Cons(x - y, r)), () => error) + Mul then matchTwo(stack, (x, y, r) => evalInst(rest, Cons(x * y, r)), () => error) + Neg then if stack is + Nil then error + Cons(x, xs) then evalInst(rest, Cons(if x == 0 then 1 else 0, xs)) + And then + matchTwo(stack, (x, y, r) => evalInst(rest, Cons(if x != 0 && y != 0 then 1 else 0, r)), () => error) + Or then + matchTwo(stack, (x, y, r) => evalInst(rest, Cons(if x != 0 || y != 0 then 1 else 0, r)), () => error) + Cmp then + matchTwo(stack, (x, y, r) => evalInst(rest, Cons(if x == y then 1 else 0, r)), () => error) + Branch(is1, is2) then if stack is + Nil then error + Cons(x, xs) then + if x != 0 then evalInst(is1, xs) + else evalInst(is2, xs) + + +// * Examples + +evalInst(compileAExp(Cst(42)), Nil) +evalInst(compileAExp(Plus(Cst(42), Cst(21))), Nil) +evalInst(compileAExp(Minus(Cst(42), Cst(21))), Nil) +evalInst(compileAExp(IfThenElse(True, Cst(1), Cst(2))), Nil) +evalInst(compileAExp(IfThenElse(Neq(Cst(1), Cst(2)), Cst(42), Cst(21))), Nil) +evalInst(compileAExp(IfThenElse(Eq(Cst(1), Cst(2)), Cst(42), Times(Cst(21), Cst(82)))), Nil) + +//│ Type: Int +//│ ———————————————————————————————————————————————————————————————————————————————— diff --git a/hkmc2/shared/src/test/mlscript/invalml/web-demos/reml/MergeSort.mls b/hkmc2/shared/src/test/mlscript/invalml/web-demos/reml/MergeSort.mls new file mode 100644 index 0000000000..97d492c1f8 --- /dev/null +++ b/hkmc2/shared/src/test/mlscript/invalml/web-demos/reml/MergeSort.mls @@ -0,0 +1,122 @@ +:invalml + +:... +//│ ———————————————————————————————————————————————————————————————————————————————— + +// * This file includes the implementation for merge sorting, +// * executed sequentially or in parallel. +// * Adapted from https://doi.org/10.5281/zenodo.8425443 + + +// *** infrastructures + + +declare class Array[T, R] + + +class Pair[T, S] with + constructor + Pr(fst: T, snd: S) + + +fun + mkArray: [T, R] -> Region[out R] ->{R} Array[T, out R] + push: [T, R] -> (Array[in T, out R], T) ->{R} () + unshift: [T, R] -> (Array[in T, out R], T) ->{R} () + map: [T, S, R, E extends ~R] -> (Array[out T, out R], T ->{E} S) ->{E | R} Array[S, out R] + foreach: [T, R, E extends ~R] -> (Array[out T, out R], T ->{E} ()) ->{E | R} () + len: [R] -> Array[in Nothing out Any, out R] ->{R} Int + at: [T, R] -> (Array[out T, out R], Int) ->{R} T + slice: [T, R] -> (Array[out T, out R], Int) ->{R} Array[out T, out R] + concat: [T, R1, R2, R3] -> (Region[out R3], Array[in T, out R1], Array[out T, out R2]) ->{R1 | R2 | R3} Array[T, out R3] + + +// Matching on js array is not supported yet. +// This helper function is equivalent to `if xs is Cons(x, xs) then fh(x, xs) else fn(xs)` +fun matchOne(xs, fn, fh) = + if len(xs) is 0 then fn(xs) + else fh(at(xs, 0), slice(xs, 1)) + +// Matching on js array is not supported yet. +// This helper function is equivalent to +// `if xs is Cons(x, Cons(y, ys)) then f2(x, y, ys) else if xs is Cons(x, xs) then f1(x, xs) else fn(xs)` +// fun matchTwo: [T, R, E1, E2, E3, S] -> (Array[out T, out R], Array[out T, out R] ->{E1} S, T ->{E2} S, (T, T, Array[out T, out R]) ->{E3} S) ->{E1 | E2 | E3 | R} S +fun matchTwo(xs, fn, f1, f2) = + if len(xs) is 0 then fn(xs) + else if len(xs) is 1 then f1(at(xs, 0)) + else f2(at(xs, 0), at(xs, 1), slice(xs, 2)) + +fun (;) seq(_, res) = res + +fun println: Any -> () +fun forkJoin: [T, S, P, E1, E2 extends ~E1, E3] -> + (() ->{E1} T, () ->{E2} S, (T, S) ->{E3} P) ->{E1 | E2 | E3} P + + +// *** pmsort implementation + +// Split the given array into two sub-arrays. +// Region r1 and r2 indicate where the two sub-arrays should be stored. +fun split(xs, r1, r2) = + fun rs(xs, ys, zs) = + matchTwo of xs, _ => Pr(ys, zs), x => push(ys, x); Pr(ys, zs), (x1, x2, r) => push(ys, x1); push(zs, x2); rs(r, ys, zs) + rs(xs, mkArray(r1), mkArray(r2)) + + +// Merge arr1 and arr2. The result is stored in region r. +// fun merge: [T, R1, R2, R] -> (Array[out T, out R1], Array[out T, out R2], Region[R]) ->{R1 | R2 | R} Array[T, out R] +fun merge(arr1, arr2, r) = + fun recm(xs, ys, acc) = + matchOne of xs, _ => concat(r, acc, ys), (x, rx) => + matchOne of ys, _ => concat(r, acc, xs), (y, ry) => + if x < y then push(acc, x); recm(rx, ys, acc) + else push(acc, y); recm(xs, ry, acc) + recm(arr1, arr2, mkArray(r)) + + +// Merge sort in single thread. +fun smsort(xs, r) = + matchTwo of xs, _ => mkArray(r), x => let res = mkArray(r) in push(res, x); res, (_, _, _) => + let p = split(xs, r, r) in + if p is Pr(fst, snd) then merge(smsort(fst, r), smsort(snd, r), r) + + +// Wrong version! Sub-arrays cannot be stored in the same region! +// fun pmsort: [R1, R2] -> (Array[out Int, out R1], Region[R2]) ->{R1 | R2} Array[Int, out R2] +// fun pmsort(xs, r) = +// matchTwo of xs, _ => mkArray(r), x => let res = mkArray(r) in push(res, x); res, (_, _, _) => +// let p = split(xs, r, r) in +// if p is Pr(fst, snd) then +// forkJoin(_ => pmsort(fst, r), pmsort(snd, r), (r1, r2) => merge(r1, r2, r)) + + +// Merge sort in parallel. +fun pmsort: [R1, R2] -> (Array[out Int, out R1], Region[out R2]) ->{R1 | R2} Array[Int, out R2] +fun pmsort(xs, r) = + matchTwo of xs, _ => mkArray(r), x => let res = mkArray(r) in push(res, x); res, (_, _, _) => + region r1 in + region r2 in + let p = split(xs, r1, r2) in + if p is Pr(fst, snd) then + forkJoin(() => pmsort(fst, r1), () => pmsort(snd, r2), (rx, ry) => merge(rx, ry, r)) + + +// *** simple tests + +region r in + let arr = mkArray(r) + push(arr, 10) + push(arr, 23) + push(arr, 13) + push(arr, 4) + smsort(arr, r) + +region r in + let arr = mkArray(r) + push(arr, 10) + push(arr, 23) + push(arr, 13) + push(arr, 4) + pmsort(arr, r) +//│ Type: Array[Int, ?] +//│ ———————————————————————————————————————————————————————————————————————————————— diff --git a/hkmc2DiffTests/src/test/scala/hkmc2/BbmlDiffMaker.scala b/hkmc2DiffTests/src/test/scala/hkmc2/InvalmlDiffMaker.scala similarity index 54% rename from hkmc2DiffTests/src/test/scala/hkmc2/BbmlDiffMaker.scala rename to hkmc2DiffTests/src/test/scala/hkmc2/InvalmlDiffMaker.scala index 71b8248465..6cbe9bddb9 100644 --- a/hkmc2DiffTests/src/test/scala/hkmc2/BbmlDiffMaker.scala +++ b/hkmc2DiffTests/src/test/scala/hkmc2/InvalmlDiffMaker.scala @@ -3,43 +3,43 @@ package hkmc2 import mlscript.utils.*, shorthands.* import hkmc2.semantics.* -import hkmc2.bbml.* +import hkmc2.invalml.* import utils.Scope -abstract class BbmlDiffMaker extends JSBackendDiffMaker: +abstract class InvalmlDiffMaker extends JSBackendDiffMaker: - val bbPreludeFile = file / os.up / os.RelPath("bbPrelude.mls") + val invalPreludeFile = os.Path(rootPath) / "hkmc2" / "shared" / "src" / "test" / "mlscript" / "invalml" / "invalPrelude.mls" - val bbmlOpt = new NullaryCommand("bbml"): + val invalmlOpt = new NullaryCommand("invalml"): override def onSet(): Unit = super.onSet() noSanityCheck.isGlobal = true noSanityCheck.set - if file =/= bbPreludeFile then + if file =/= invalPreludeFile then curCtx = Elaborator.State.init given Config = mkConfig - importFile(bbPreludeFile, verbose = false) + importFile(invalPreludeFile, verbose = false) override def init(): Unit = super.init() - lazy val bbCtx = + lazy val invalCtx = given Elaborator.Ctx = curCtx - bbml.BbCtx.init(_ => die) + invalml.InvalCtx.init(_ => die) - var bbmlTyper: Opt[BBTyper] = None + var invalmlTyper: Opt[InvalTyper] = None override def processTerm(trm: semantics.Term.Blk, inImport: Bool)(using Config, Raise): Unit = super.processTerm(trm, inImport) - if bbmlOpt.isSet then + if invalmlOpt.isSet then given Scope = Scope.empty - if bbmlTyper.isEmpty then - bbmlTyper = S(BBTyper()) - given hkmc2.bbml.BbCtx = bbCtx.copy(raise = summon) - val typer = bbmlTyper.get + if invalmlTyper.isEmpty then + invalmlTyper = S(InvalTyper()) + given hkmc2.invalml.InvalCtx = invalCtx.copy(raise = summon) + val typer = invalmlTyper.get val ty = typer.typePurely(trm) val printer = PrettyPrinter((msg: String) => output(msg)) if debug.isSet then printer.print(ty) diff --git a/hkmc2DiffTests/src/test/scala/hkmc2/LlirDiffMaker.scala b/hkmc2DiffTests/src/test/scala/hkmc2/LlirDiffMaker.scala index cba44a064f..f2b0c9d746 100644 --- a/hkmc2DiffTests/src/test/scala/hkmc2/LlirDiffMaker.scala +++ b/hkmc2DiffTests/src/test/scala/hkmc2/LlirDiffMaker.scala @@ -18,7 +18,7 @@ import hkmc2.codegen.cpp._ import hkmc2.semantics.Elaborator import scala.collection.mutable.ListBuffer -abstract class LlirDiffMaker extends BbmlDiffMaker: +abstract class LlirDiffMaker extends InvalmlDiffMaker: val llir = NullaryCommand("llir") val sllir = NullaryCommand("sllir") val intl = NullaryCommand("intl") diff --git a/hkmc2DiffTests/src/test/scala/hkmc2/MLsDiffMaker.scala b/hkmc2DiffTests/src/test/scala/hkmc2/MLsDiffMaker.scala index 21e4866c50..300dd705af 100644 --- a/hkmc2DiffTests/src/test/scala/hkmc2/MLsDiffMaker.scala +++ b/hkmc2DiffTests/src/test/scala/hkmc2/MLsDiffMaker.scala @@ -12,7 +12,7 @@ import semantics.Elaborator.Ctx abstract class MLsDiffMaker extends DiffMaker: - val bbmlOpt: Command[?] + val invalmlOpt: Command[?] val rootPath: Str // * Absolute path to the root of the project val preludeFile: os.Path // * Contains declarations of JS builtins