{-# OPTIONS_GHC -fglasgow-exts #-}moduleMO.Run(moduleMO.Run,moduleMO.Base)where-- FIXME: systematize a nice order for imports (steal Pugs')importMO.UtilimportMO.BaseimportMO.CompileasCimportStringTable.AtomMapasMimportData.Typeablehiding(cast)importqualifiedData.TypeableasTypeableimportData.Sequence(Seq)importqualifiedData.SequenceasSeq-- Little overview.---- Suppose someone is calling a method, like: $foo.moose(1,2,3). Usually, we-- create a MethodInvocation containing "moose" as the name of the method and-- some Arguments thing, contaning the "1,2,3".---- The "$foo" object is _represented_ by an Invocant datatype, which has a-- pointer to "$foo" itself and an ResponderInterface (usually provided by the-- Class that $foo was instantiated), which knows how to answer for a method-- call, this is called 'dispatch' in the ResponderInterface class.---- One example of ResponderInterface is the MethodTable, it has a Map of-- MethodCompileds (identified by MethodName). Its 'dispatch' takes an Invocant-- and a MethodInvocation, add the Invocant to the MInv Arguments,-- lookup the MInv method name in it's on table, if found, run the compiled method-- with the augmented Arguments.---- The function ivDispatch does almost same as 'dispatch', but it gets the RI-- that the Invocant has inside it (given by the Class, for example). So you can-- think of "$foo.moose(1,2,3)" as a call to-- "ivDispatch (Invocant_of_$foo) (Arguments_containing_(1,2,3))"-- FIXME: At first we thought of having these two abstractions, but now-- seem unnecessary, but I may be forgetting something :P-- class Invocation a-- class Responder adataMethodInvocationm=MkMethodInvocation{mi_name::!MethodName,mi_arguments::!(Argumentsm)}classMonadm=>ResponderInterfacema|a->mwherefromMethodList::[(MethodName,MethodCompiledm)]->madispatch::a->Invocantm->MethodInvocationm->m(Invocantm)-- here for debugging purposes.-- toNameList :: a -> [MethodName]{-
instance ResponderInterface m a => Show a where
show = show . toNameList
-}dataMonadm=>NoResponsem=NoResponseinstanceMonadm=>ResponderInterfacem(NoResponsem)wheredispatch___=fail"Dispatch failed - NO CARRIER"fromMethodList_=returnNoResponse-- toNameList _ = []emptyResponder::(Typeable1m,Monadm)=>AnyRespondermemptyResponder=MkResponder(returnNoResponse)-- | This is a static method table.dataMethodTablem=MkMethodTable{mt_methods::!(M.AtomMap(MethodCompiledm))}instance(Typeable1m,Monadm)=>ResponderInterfacem(MethodTablem)wherefromMethodList=return.MkMethodTable.M.fromListdispatchmtresponderinv@(MkMethodInvocationnargs)=caseM.lookupn(mt_methodsmt)ofJustmethod_compiled->dorunMCmethod_compiled(withInvocantargsresponder)_->fail$"Can't locate object method "++shown++" of invocant: "++showresponder-- toNameList = M.keys . mt_methodsdataAnyResponderm=forallc.ResponderInterfacemc=>MkResponder!(mc)instance(Typeable1m,Monadm)=>Typeable(AnyResponderm)wheretypeOf_=mkTyConApp(mkTyCon"AnyResponder")[typeOf1(undefined::m())]-- Invocant represent an object aggregated with an ResponderInterfacefromInvocant::forallmb.(Typeable1m,Monadm,Typeableb)=>Argumentsm->mbfromInvocantCaptSub{}=fail"No invocant"fromInvocantCaptMeth{c_invocant=MkInvocantx_}=caseTypeable.castxofJusty->returny_->fail$"Could not coerce from "++(show$typeOfx)++" to "++(show$typeOf(undefined::b))instance(Typeable1m,Monadm)=>Typeable(Invocantm)wheretypeOf_=mkTyConApp(mkTyCon"Invocant")[typeOf1(undefined::m())]ivDispatch::(Typeable1m,Monadm)=>Invocantm->MethodInvocationm->m(Invocantm)ivDispatchi@(MkInvocant_(MkResponderri))mi=dotable<-ridispatchtableimiinstance(Typeable1m,Monadm)=>Show(Invocantm)whereshow(MkInvocantx_)=showxinstance(Typeable1m,Monadm)=>Eq(Invocantm)whereMkInvocanta_==MkInvocantb_=a?==?binstance(Typeable1m,Monadm)=>Ord(Invocantm)whereMkInvocanta_`compare`MkInvocantb_=a?<=>?b-- Helpers to create simple/empty invocants.__::(Typeable1m,Monadm,Orda,Showa,Typeablea)=>a->Invocantm__=(`MkInvocant`emptyResponder)-- Helper to create a Arguments based on a list of InvocantsmkArgs::(Typeable1m,Monadm)=>[Invocantm]->ArgumentsmmkArgsx=CaptSub{c_feeds=Seq.singleton(MkFeed{f_positionals=Seq.fromListx,f_nameds=M.empty})}