{-# LANGUAGE UndecidableInstances #-}-- | Basic optimization of expressionsmoduleLanguage.Syntactic.Constructs.Binding.OptimizewhereimportControl.Monad.WriterimportData.SetasSetimportData.ProxyimportLanguage.SyntacticimportLanguage.Syntactic.Constructs.BindingimportLanguage.Syntactic.Constructs.ConditionimportLanguage.Syntactic.Constructs.ConstructimportLanguage.Syntactic.Constructs.IdentityimportLanguage.Syntactic.Constructs.LiteralimportLanguage.Syntactic.Constructs.Tuple-- | Constant folder---- Given an expression and the statically known value of that expression,-- returns a (possibly) new expression with the same meaning as the original.-- Typically, the result will be a 'Literal', if the relevant type constraints-- are satisfied.typeConstFolderdom=foralla.ASTFdoma->a->ASTFdoma-- | Basic optimization of a sub-domainclassEvalBinddom=>Optimizesubctxdomwhere-- | Bottom-up optimization of a sub-domain. The optimization performed is-- up to each instance, but the intention is to provide a sensible set of-- \"always-appropriate\" optimizations. The default implementation-- 'optimizeSymDefault' does only constant folding. This constant folding-- uses the set of free variables to know when it's static evaluation is-- possible. Thus it is possible to help constant folding of other-- constructs by pruning away parts of the syntax tree that are known not to-- be needed. For example, by replacing (using ordinary Haskell as an-- example)---- > if True then a else b---- with @a@, we don't need to report the free variables in @b@. This, in-- turn, can lead to more constant folding higher up in the syntax tree.optimizeSym::Proxyctx->ConstFolderdom->suba->Args(ASTdom)a->Writer(SetVarId)(ASTFdom(DenResulta))-- The reason for having @dom@ as a class parameter is that many instances-- require the constraint @(sub :<: dom)@. If @dom@ was forall-quantified in-- 'optimizeSym', this constraint would not be allowed. On the other hand, it-- is not possible to add the constraint @(sub :<: dom)@ to 'optimizeSym',-- because the instance for '(:+:)' doesn't satisfy it.instance(Optimizesub1ctxdom,Optimizesub2ctxdom)=>Optimize(sub1:+:sub2)ctxdomwhereoptimizeSymctxconstFold(InjLa)=optimizeSymctxconstFoldaoptimizeSymctxconstFold(InjRa)=optimizeSymctxconstFoldaoptimizeM::Optimizedomctxdom=>Proxyctx->ConstFolderdom->ASTFdoma->Writer(SetVarId)(ASTFdoma)optimizeMctxconstFold=transformNode(optimizeSymctxconstFold)-- | Optimize an expressionoptimize::Optimizedomctxdom=>Proxyctx->ConstFolderdom->ASTFdoma->ASTFdomaoptimizectxconstFold=fst.runWriter.optimizeMctxconstFold-- | Convenient default implementation of 'optimizeSym' (uses 'evalBind' to-- partially evaluate)optimizeSymDefault::(sub:<:dom,WitnessConssub,Optimizedomctxdom)=>Proxyctx->ConstFolderdom->suba->Args(ASTdom)a->Writer(SetVarId)(ASTFdom(DenResulta))optimizeSymDefaultctxconstFoldsym@(witnessCons->ConsWit)args=do(args',vars)<-listen$mapArgsM(optimizeMctxconstFold)argsletresult=appArgs(Sym$injsym)args'value=evalBindresultifSet.nullvarsthenreturn$constFoldresultvalueelsereturnresultinstance(Identityctx':<:dom,Optimizedomctxdom)=>Optimize(Identityctx')ctxdomwhereoptimizeSym=optimizeSymDefaultinstance(Constructctx':<:dom,Optimizedomctxdom)=>Optimize(Constructctx')ctxdomwhereoptimizeSym=optimizeSymDefaultinstance(Literalctx':<:dom,Optimizedomctxdom)=>Optimize(Literalctx')ctxdomwhereoptimizeSym=optimizeSymDefaultinstance(Tuplectx':<:dom,Optimizedomctxdom)=>Optimize(Tuplectx')ctxdomwhereoptimizeSym=optimizeSymDefaultinstance(Selectctx':<:dom,Optimizedomctxdom)=>Optimize(Selectctx')ctxdomwhereoptimizeSym=optimizeSymDefaultinstance(Letctxactxb:<:dom,Optimizedomctxdom)=>Optimize(Letctxactxb)ctxdomwhereoptimizeSym=optimizeSymDefaultinstance(Conditionctx':<:dom,Lambdactx:<:dom,Variablectx:<:dom,AlphaEqdomdomdom[(VarId,VarId)],Optimizedomctxdom)=>Optimize(Conditionctx')ctxdomwhereoptimizeSymctxconstFoldcond@Conditionargs@(c:*t:*e:*Nil)|Set.nullcVars=optimizeMctxconstFoldt_or_e|alphaEqte=optimizeMctxconstFoldt|otherwise=optimizeSymDefaultctxconstFoldcondargswhere(c',cVars)=runWriter$optimizeMctxconstFoldct_or_e=ifevalBindc'thentelseeinstance(Variablectx:<:dom,Optimizedomctxdom)=>Optimize(Variablectx)ctxdomwhereoptimizeSym__var@(Variablev)Nil=dotell(singletonv)return(injvar)instance(Lambdactx:<:dom,Optimizedomctxdom)=>Optimize(Lambdactx)ctxdomwhereoptimizeSymctxconstFoldlam@(Lambdav)(body:*Nil)=dobody'<-censor(deletev)$optimizeMctxconstFoldbodyreturn$injlam:$body'