-- | Simply-typed Church-style (nominal) lambda-calculus-- with integers and zero-comparison-- Type reconstruction, for all subterms---- <http://okmij.org/ftp/Computation/Computation.html#teval>--moduleLanguage.TEval.TEvalNRwhereimportqualifiedData.MapasMdataTyp=TInt|!Typ:>!Typderiving(Show,Eq)infixr9:>dataTerm=VVarName|LVarNameTypTerm|ATermTerm|IInt|Term:+Term-- addition|IFZTermTermTerm-- if zero|FixTerm-- fix f, where f :: (a->b)->(a->b)deriving(Show,Eq)infixl9`A`typeVarName=String-- | Type Environment: associating types with `free' variablestypeTEnv=[(VarName,Typ)]env0::TEnvenv0=[]lkup::TEnv->VarName->Typlkupenvx=maybeerrid$lookupxenvwhereerr=error$"Unbound variable "++xext::TEnv->(VarName,Typ)->TEnvextenvxt=xt:env-- | A virtual typed AST: associating a type to each subtermtypeTermIndex=[Int]-- an index of a subterm in a termtypeTyps=M.MapTermIndexTyptopterm::Typ->Typstopterm=M.singleton[]toptyp::Typs->Typtoptypts=(M.!)ts[]shift::Int->Typs->Typsshiftn=M.mapKeys(n:)-- | Type reconstruction: abstract evaluationteval::TEnv->Term->Typstevalenv(Vx)=topterm$lkupenvxtevalenv(Lxte)=letts=teval(extenv(x,t))eintopterm(t:>toptypts)`M.union`shift0tstevalenv(Ae1e2)=lett1=tevalenve1t2=tevalenve2incasetoptypt1oft1a:>t1r|t1a==toptypt2->toptermt1r`M.union`shift0t1`M.union`shift1t2t1a:>t1r->error$unwords["Applying a function of arg type",showt1a,"to argument of type",show$toptypt2]t1->error$"Trying to apply a non-function: "++showt1tevalenv(In)=toptermTInttevalenv(e1:+e2)=lett1=tevalenve1t2=tevalenve2incase(toptypt1,toptypt2)of(TInt,TInt)->toptermTInt`M.union`shift0t1`M.union`shift1t2ts->error$"Trying to add non-integers: "++showtstevalenv(IFZe1e2e3)=lett1=tevalenve1t2=tevalenve2t3=tevalenve3tr=shift0t1`M.union`shift1t2`M.union`shift2t3incasetoptypt1ofTInt|toptypt2==toptypt3->topterm(toptypt2)`M.union`trTInt->error$unwords["Branches of IFZ have different types:",show(toptypt2),"and",show(toptypt3)]t->error$"Trying to compare a non-integer to 0: "++showttevalenv(Fixe)=lett=tevalenveincasetoptyptof((ta1:>tb1):>(ta2:>tb2))|ta1==ta2&&tb1==tb2->topterm(ta1:>tb1)`M.union`shift0tt->error$"Inappropriate type in Fix: "++showt(vx,vy)=(V"x",V"y")term1=L"x"TInt(IFZvx(I1)(vx:+(I2)))test1=tevalenv0term1-- TInt :> TIntterm2a=L"x"TInt(L"y"TInt(vx`A`vy))test2a=tevalenv0term2aterm2b=L"x"(TInt:>TInt)(L"y"TInt(vx`A`vy))test2b=tevalenv0term2b-- (TInt :> TInt) :> (TInt :> TInt)-- can we write term2c with a different assignment of types to x and y?-- Used to be hidden problem. The main benefit of types: static approximation-- of program behaviorterm3=L"x"TInt(IFZvx(I1)vy)test3=tevalenv0term3term4a=L"x"TInt(IFZvx(I1)(vx`A`(I1)))test4a=tevalenv0term4aterm4b=L"x"(TInt:>TInt)(IFZvx(I1)(vx`A`(I1)))test4b=tevalenv0term4btmul1=L"x"TInt(L"y"TInt(IFZvx(I0)((tmul1`A`(vx:+(I(-1)))`A`vy):+vy)))testm1=tevalenv0tmul1-- is typechecking really decidable?-- Can termY be typechecked?delta=L"y"(TInt:>TInt)(vy`A`vy)testd=tevalenv0deltatmul=Fix(L"self"(TInt:>TInt:>TInt)(L"x"TInt(L"y"TInt(IFZvx(I0)(((V"self")`A`(vx:+(I(-1)))`A`vy):+vy)))))testm21=tevalenv0tmul-- TInt :> (TInt :> TInt)testm22=tevalenv0(tmul`A`(I2))-- TInt :> TInttestm23=tevalenv0(tmul`A`(I2)`A`(I3))-- TInt