{-# LANGUAGE TemplateHaskell #-}-- | Default implementations of some interpretation functionsmoduleLanguage.Syntactic.Interpretation.SemanticswhereimportLanguage.Haskell.THimportLanguage.Haskell.TH.QuoteimportData.HashimportLanguage.Syntactic.SyntaximportLanguage.Syntactic.Interpretation.EqualityimportLanguage.Syntactic.Interpretation.RenderimportLanguage.Syntactic.Interpretation.Evaluation-- | A representation of a syntactic construct as a 'String' and an evaluation-- function. It is not meant to be used as a syntactic symbol in an 'AST'. Its-- only purpose is to provide the default implementations of functions like-- `equal` via the `Semantic` class.dataSemanticsawhereSem::{semanticName::String,semanticEval::Denotationa}->SemanticsainstanceEqualitySemanticswhereequal(Sema_)(Semb_)=a==bexprHash(Semname_)=hashnameinstanceRenderSemanticswhererenderSym(Semname_)=namerenderArgs[](Semname_)=namerenderArgsargs(Semname_)|isInfix="("++unwords[a,op,b]++")"|otherwise="("++unwords(name:args)++")"where[a,b]=argsop=init$tailnameisInfix=not(nullname)&&headname=='('&&lastname==')'&&lengthargs==2instanceEvalSemanticswhereevaluate(Sem_a)=a-- | Class of expressions that can be treated as constructsclassSemanticexprwheresemantics::expra->Semanticsa-- | Default implementation of 'equal'equalDefault::Semanticexpr=>expra->exprb->BoolequalDefaultab=equal(semanticsa)(semanticsb)-- | Default implementation of 'exprHash'exprHashDefault::Semanticexpr=>expra->HashexprHashDefault=exprHash.semantics-- | Default implementation of 'renderSym'renderSymDefault::Semanticexpr=>expra->StringrenderSymDefault=renderSym.semantics-- | Default implementation of 'renderArgs'renderArgsDefault::Semanticexpr=>[String]->expra->StringrenderArgsDefaultargs=renderArgsargs.semantics-- | Default implementation of 'evaluate'evaluateDefault::Semanticexpr=>expra->DenotationaevaluateDefault=evaluate.semantics-- | Derive instances for 'Semantic' related classes-- ('Equality', 'Render', 'StringTree', 'Eval')semanticInstances::Name->DecsQsemanticInstancesn=[d|instanceEquality$(typ)whereequal=equalDefaultexprHash=exprHashDefaultinstanceRender$(typ)whererenderSym=renderSymDefaultrenderArgs=renderArgsDefaultinstanceStringTree$(typ)instanceEval$(typ)whereevaluate=evaluateDefault|]wheretyp=conTn