moduleUU.Parsing.MachineInterfacewhereimportGHC.Prim-- | The 'InputState' class contains the interface that the AnaParser-- parsers expect for the input. A minimal complete instance definition-- consists of 'splitStateE', 'splitState' and 'getPosition'.classInputStatestatespos|state->s,state->poswhere-- | Splits the state in a strict variant of 'Either', with 'Left'' if a symbol-- can be split off and 'Right'' if none cansplitStateE::state->Either'states-- | Splits the state in the first symbol and the remaining statesplitState::state->(#s,state#)-- | Gets the current position in the inputgetPosition::state->pos-- | Reports an errorreportError::Messagespos->state->statereportError_=id-- | Modify the state as the result of inserting a symbol 's' in the input.-- The symbol that has already been considered as having been inserted -- is passed. It should normally not be added to the state.insertSymbol::s->state->stateinsertSymbol_=id-- | Modify the state as the result of deleting a symbol 's' from the input.-- The symbol that has already been deleted from the input state is passed.-- It should normally not be deleted from the state.deleteSymbol::s->state->statedeleteSymbol_=id{-# INLINE splitStateE #-}{-# INLINE splitState #-}{-# INLINE insertSymbol #-}{-# INLINE deleteSymbol #-}classOutputStaterwhereacceptR::v->rest->rvrestnextR::(a->rest->rest')->(b->a)->(rbrest)->rest'{-# INLINE acceptR #-}{-# INLINE nextR #-}classSymbolswheredeleteCost::s->Int#symBefore::s->ssymAfter::s->sdeleteCostb=5#symBefore=error"You should have made your token type an instance of the Class Symbol. eg by defining symBefore = pred"symAfter=error"You should have made your token type an instance of the Class Symbol. eg by defining symAfter = succ"dataEither'states=Left'!s(state)|Right'(state)-- =======================================================================================-- ===== STEPS ===========================================================================-- =======================================================================================dataStepsvalsp=foralla.OkVal(a->val)(Stepsasp)|Ok{rest::Stepsvalsp}|Cost{costing::Int#,rest::Stepsvalsp}|StRepair{costing::Int#,m::!(Messagesp),rest::Stepsvalsp}|Best(Stepsvalsp)(Stepsvalsp)(Stepsvalsp)|NoMoreStepsvaldataActions=Inserts|Deletes|OtherStringval::(a->b)->Stepsasp->Stepsbspvalf(OkValarest)=OkVal(f.a)restvalf(Okrest)=OkValfrestvalf(Costirest)=Costi(valfrest)valf(StRepaircmr)=StRepaircm(valfr)valf(Bestlsr)=Best(valfl)(valfs)(valfr)valf(NoMoreStepsv)=NoMoreSteps(fv)evalSteps::Stepsasp->aevalSteps(OkValvrest)=v(evalStepsrest)evalSteps(Okrest)=evalStepsrestevalSteps(Cost_rest)=evalStepsrestevalSteps(StRepair_msgrest)=evalStepsrestevalSteps(Best_rest_)=evalStepsrestevalSteps(NoMoreStepsv)=vgetMsgs::Stepsasp->[Messagesp]getMsgs(OkVal_rest)=getMsgsrestgetMsgs(Okrest)=getMsgsrestgetMsgs(Cost_rest)=getMsgsrestgetMsgs(StRepair_mrest)=m:getMsgsrestgetMsgs(Best_m_)=getMsgsmgetMsgs(NoMoreSteps_)=[]dataMessagesympos=Msg(Expectingsym)!pos(Actionsym)-- Msg (String, String, Expecting s) -- action, position, expecting instance(Eqs,Shows)=>Show(Expectings)whereshow(ESyms)=showsshow(EStrstr)=strshow(EOr[])="Nothing expected "show(EOr[e])=showeshow(EOr(e:ee))=showe++" or "++show(EOree)show(ESeqseq)=concat(mapshowseq)instance(Eqs,Shows,Showp)=>Show(Messagesp)whereshow(Msgexpectingpositionaction)="\n?? Error : "++showposition++"\n?? Expecting : "++showexpecting++"\n?? Repaired by: "++showaction++"\n"instanceShows=>Show(Actions)whereshow(Inserts)="inserting: "++showsshow(Deletes)="deleting: "++showsshow(Others)=sdataExpectings=ESym(SymbolRs)|EStrString|EOr[Expectings]|ESeq[Expectings]deriving(Ord,Eq)-- =======================================================================================-- ===== SYMBOLS and RANGES ==============================================================-- =======================================================================================dataSymbolRs=Range!s!s|EmptyRderiving(Eq,Ord)instance(Eqs,Shows)=>Show(SymbolRs)whereshowEmptyR="the empty range"show(Rangeab)=ifa==bthenshowaelseshowa++".."++showbmk_rangelr=ifl>rthenEmptyRelseRangelrsymInRange(Rangelr)=ifl==rthen(l==)else(\s->s>=l&&s<=r)symRS(Rangelr)=ifl==rthen(comparel)else(\s->ifs<lthenGTelseifs>rthenLTelseEQ)range`except`elems=foldrremoveelem[range]elemswhereremoveelemelemranges=[r|ran<-ranges,r<-ran`minus`elem]EmptyR`minus`_=[]ran@(Rangelr)`minus`elem=ifsymInRangeranelemthen[mk_rangel(symBeforeelem),mk_range(symAfterelem)r]else[ran]-- =======================================================================================-- ===== TRACING and ERRORS and MISC ===================================================-- =======================================================================================usererrorm=error("Your grammar contains a problem:\n"++m)systemerrormodnamem=error("I apologise: I made a mistake in my design. This should not have happened.\n"++" Please report: "++modname++": "++m++" to doaitse@cs.uu.nl\n")