{- Copyright 2010 Dominique Devriese
This file is part of the grammar-combinators library.
The grammar-combinators library is free software: you can
redistribute it and/or modify it under the terms of the GNU
Lesser General Public License as published by the Free
Software Foundation, either version 3 of the License, or (at
your option) any later version.
Foobar is distributed in the hope that it will be useful, but
WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
GNU Lesser General Public License for more details.
You should have received a copy of the GNU Lesser General
Public License along with Foobar. If not, see
<http://www.gnu.org/licenses/>.
-}{-# LANGUAGE RankNTypes #-}{-# LANGUAGE KindSignatures #-}{-# LANGUAGE NoMonomorphismRestriction #-}{-# LANGUAGE FlexibleContexts #-}{-# LANGUAGE FlexibleInstances #-}{-# LANGUAGE MultiParamTypeClasses #-}{-# LANGUAGE ScopedTypeVariables #-}{-# LANGUAGE GADTs #-}{-# LANGUAGE GeneralizedNewtypeDeriving #-}moduleText.GrammarCombinators.Parser.LL1(LL1Table(LL1Table),calcLL1Table,parseLL1)whereimportData.Set(Set,union,singleton)importqualifiedData.SetasSetimportData.Map(Map)importqualifiedData.MapasMapimportData.MaybeimportData.Enumerable(enumerate)importControl.MonadimportControl.Monad.StateimportText.GrammarCombinators.BaseimportText.GrammarCombinators.Parser.TopDowndataFirstSett=FS{firstSet::Sett,canBeEmpty::Bool,canBeEOI::Bool}typeFirstSetGrammarphit=forallix.phiix->[FirstSett]newtype(Domainphi,Tokent)=>FSCalculatorphiixT(r::*->*)tv=MkFSCalculator{calcFS::FirstSetGrammarphit->[FirstSett]}typeFirstSetGrammarRecphiixTrtrr=forallix.phiix->FSCalculatorphiixTrt(rrix)unionL::(Orda)=>[Seta]->SetaunionL=foldrSet.unionSet.emptyinstance(Domainphi,Tokent)=>ProductionRule(FSCalculatorphiixTrt)wherea>>>b=MkFSCalculator$\g->doFSfsaeafa<-calcFSagFSfsbebfb<-calcFSbgreturn$FS(ifeathenfsa`union`fsbelsefsa)(ea&&eb)(fa||(ea&&fb))a|||b=MkFSCalculatordisjFSwheredisjFS::FirstSetGrammarphit->[FirstSett]disjFSg=calcFSag++calcFSbgdie=MkFSCalculator$\_->[FSSet.emptyFalseFalse]endOfInput=MkFSCalculator$\_->[FSSet.emptyFalseTrue]instance(Domainphi,Tokent)=>EpsProductionRule(FSCalculatorphiixTrt)whereepsilon_=MkFSCalculator$\_->[FSSet.emptyTrueFalse]instance(Domainphi,Tokent)=>LiftableProductionRule(FSCalculatorphiixTrt)whereepsilonLv_=epsilonvinstance(Tokent,Domainphi)=>TokenProductionRule(FSCalculatorphiixTrt)twheretokenc=MkFSCalculator$\_->[FS(singletonc)FalseFalse]anyToken=MkFSCalculator$\_->[FS(Set.fromListenumerate)FalseFalse]instance(Domainphi,Tokent)=>RecProductionRule(FSCalculatorphiixTrt)phirwhererefidx=MkFSCalculator$\g->[FS(unionL$mapfirstSet$gidx)(anycanBeEmpty$gidx)(anycanBeEOI$gidx)]fixFSGrammar::(Domainphi,Tokent)=>FirstSetGrammarRecphiixTrtrr->FirstSetGrammarphitfixFSGrammargidx=calcFS(gidx)$fixFSGrammargdata(Tokent)=>LL1Tablephit=LL1Table{ruleForTokenTable::Memophi(K0(MaptInt)),ruleForEOITable::Memophi(K0(MaybeInt)),ruleForEmptyTable::Memophi(K0(MaybeInt))}calcLL1Table::forallphirtrr.(Tokent,Domainphi)=>GContextFreeGrammarphitrrr->LL1TablephitcalcLL1Tablegrammar=letg::FirstSetGrammarphitg=fixFSGrammargrammarfss::forallix.phiix->[Sett]fss=mapfirstSet.gn::forallix.phiix->Intn=length.fssttableContents::forallix.phiix->[(t,Int)]ttableContentsidx=do(fs,i)<-zip(fssidx)[0..nidx-1]c<-Set.toListfsreturn(c,i)rftTable::forallix.phiix->MaptIntrftTableidx=Map.fromListWithnotLL1Error$ttableContentsidxcbe::forallix.phiix->[Bool]cbe=mapcanBeEOI.getableContents::forallix.phiix->[Int]etableContentsidx=do(True,i)<-zip(cbeidx)[0..nidx-1]returnirfeTable::forallix.phiix->MaybeIntrfeTable=listToMaybe.etableContentsrfnTable::forallix.phiix->MaybeIntrfnTable=listToMaybe.ntableContentscbn::forallix.phiix->[Bool]cbn=mapcanBeEmpty.gntableContents::forallix.phiix->[Int]ntableContentsidx=do(True,i)<-zip(cbnidx)[0..nidx-1]returninotLL1Error=error"Not LL1"inLL1Table(toMemoKrftTable)(toMemoKrfeTable)(toMemoKrfnTable)newtypeLLRulephiixTrtv=MkLLRule{llRuleAlts::[NonBranchingRulephirtv]}instanceFunctor(LLRulephiixTrt)wherefmapf(MkLLRulerules)=MkLLRule[fmapfrule|rule<-rules]instanceProductionRule(LLRulephiixTrt)where(MkLLRulerulesa)>>>(MkLLRulerulesb)=letseqrule=liftM2($)inMkLLRule[seqrulerulearuleb|rulea<-rulesa,ruleb<-rulesb](MkLLRulerulesa)|||(MkLLRulerulesb)=MkLLRule$rulesa++rulesbdie=MkLLRule[]endOfInput=MkLLRule[nbrEndOfInput]instanceEpsProductionRule(LLRulephiixTrt)whereepsilonv=MkLLRule[returnv]instanceLiftableProductionRule(LLRulephiixTrt)whereepsilonLv_=MkLLRule[returnv]instance(Tokent)=>TokenProductionRule(LLRulephiixTrt)twheretokent=letrule=do(c:r)<-MkNBR$\_->getifclassifyc==tthendoMkNBR$\_->putrreturncelsefail$errWrongTokencerrWrongTokenc=showc++" read when "++showt++" expected."inMkLLRule[rule]anyToken=letrule=do(c:r)<-MkNBR$\_->getMkNBR$\_->putrreturncinMkLLRule[rule]instanceRecProductionRule(LLRulephiixTrt)phirwhererefidx=MkLLRule[MkNBR$\g->get>>=\s->unNBR(gidxs)g]newtypeWrapNonBranchingRuleListphirtix=WrapNBRL{unWrapNBRL::[NonBranchingRulephirt(rix)]}ll1Disambiguate::forallphirt.(Domainphi,Tokent)=>ProcessingContextFreeGrammarphitr->LL1Tablephit->UnambiguousTopDownGrammarphirtll1Disambiguategramtable=lettableidx::phiix->K0(MaptInt)ixtableidx=fromMemo(ruleForTokenTabletable)ttable::phiix->MaptIntttableidx=unK0$tableidxidxeoitable::phiix->MaybeInteoitableidx=unK0$fromMemo(ruleForEOITabletable)idxemptytable::phiix->MaybeIntemptytableidx=unK0$fromMemo(ruleForEmptyTabletable)idxtidx::phiix->ConcreteTokent->Inttidxidxc=fromMaybe(emptyidxidx)$Map.lookup(classifyc)$ttableidxeoiidx::phiix->Inteoiidxidx=fromMaybe(emptyidxidx)$eoitableidxemptyidx::phiix->Intemptyidxidx=fromJust$emptytableidxcandidateRules::phiix->[NonBranchingRulephirt(rix)]candidateRulesidx=llRuleAlts$gramidxmemoCR::phiix->[NonBranchingRulephirt(rix)]memoCR=unWrapNBRL.memoFamily(WrapNBRL.candidateRules)ruleForString::phiix->[ConcreteTokent]->NonBranchingRulephirt(rix)ruleForStringidx(c:_)=memoCRidx!!tidxidxcruleForStringidx[]=memoCRidx!!eoiidxidxinruleForStringparseLL1::forallphiixTrtix.(Domainphi,Tokent,ProductionRule(LLRulephiixTrt))=>ProcessingContextFreeGrammarphitr->LL1Tablephit->phiix->[ConcreteTokent]->Maybe(rix)parseLL1gramtable=letunambGram::UnambiguousTopDownGrammarphirtunambGram=ll1DisambiguategramtableinparseTopDownunambGram