modulePGF.GeneratewhereimportPGF.CIdimportPGF.DataimportPGF.MacrosimportPGF.TypeCheckimportPGF.ProbabilisticimportqualifiedData.MapasMimportSystem.Random-- generate all fillings of metavariables in an exprgenerateAllFrom::MaybeExpr->PGF->Type->MaybeInt->[Expr]generateAllFrommexpgftymi=maybe(genty)(generateForMetasFalsepgfgen)mexwheregenty=generatepgftymi-- generate random fillings of metavariables in an exprgenerateRandomFrom::MaybeExpr->MaybeProbabilities->StdGen->PGF->Type->[Expr]generateRandomFrommexpsrgpgfty=maybe(genty)(generateForMetasTruepgfgen)mexwheregenty=genRandomProbpsrgpgfty-- generic algorithm for filling holes in a generator-- for random, should be breadth-first, since otherwise first metas always get the same-- value when a list is generatedgenerateForMetas::Bool->PGF->(Type->[Expr])->Expr->[Expr]generateForMetasbreadthpgfgenexp=caseexpofEAppf(EMeta_)->[EAppga|g<-generf,a<-genArgg]EAppfx|breadth->[EAppga|(g,a)<-zip(generf)(generx)]EAppfx->[EAppga|(g,a)<-zip(generf)(generx)]_->ifbreadththenrepeatexpelse[exp]wheregener=generateForMetasbreadthpgfgengenArgf=caseinferExprpgffofRight(_,DTyp((_,_,ty):_)__)->genty_->[]-- generate an infinite list of trees exhaustivelygenerate::PGF->Type->MaybeInt->[Expr]generatepgfty@(DTyp_cat_)dp=filter(\e->casecheckExprpgfetyofLeft_->FalseRight_->True)(concatMap(\i->genericat)depths)wheregener0c=[EFunf|(f,([],_))<-fnsc]generic=[tr|(f,(cs,_))<-fnsc,letalts=map(gener(i-1))cs,ts<-combinationsalts,lettr=foldlEApp(EFunf)ts,depthtr>=i]fnsc=[(f,catSkeletonty)|(f,ty)<-functionsToCatpgfc]depths=maybe[0..](\d->[0..d])dp-- generate an infinite list of trees randomlygenRandom::StdGen->PGF->Type->[Expr]genRandom=genRandomProbNothinggenRandomProb::MaybeProbabilities->StdGen->PGF->Type->[Expr]genRandomProbmprobsgenpgfty@(DTyp_cat_)=filter(\e->casecheckExprpgfetyofLeft_->FalseRight_->True)(genTrees(randomRs(0.0,1.0::Double)gen)cat)wheretimeout=47-- give upgenTreesds0cat=let(ds,ds2)=splitAt(timeout+1)ds0-- for time out, else ds(t,k)=genTreedscatin(ifk>timeoutthenidelse(t:))(genTreesds2cat)-- else (drop k ds)genTreers=gettrswheregettdscid|cid==cidString=(ELit(LStr"foo"),1)gettdscid|cid==cidInt=(ELit(LInt12345),1)gettdscid|cid==cidFloat=(ELit(LFlt12345),1)gett[]_=(ELit(LStr"TIMEOUT"),1)----gettdscat=casefnscatof[]->(EMeta0,1)fs->letd:ds2=ds(f,args)=getfdfs(ts,k)=gettsds2argsin(foldlEAppfts,k+1)getfdfs=casemprobsofJust_->hitRegiond[(p,(f,args))|(p,(f,args))<-fs]_->letlg=lengthfs(f,v)=snd(fs!!(floor(d*fromIntegrallg)))in(EFunf,v)gettsdscats=casecatsofc:cs->let(t,k)=gettdsc(ts,ks)=getts(dropkds)csin(t:ts,k+ks)_->([],0)fns::CId->[(Double,(CId,[CId]))]fnscat=casemprobsofJustprobs->maybe[]id$M.lookupcat(catProbsprobs)_->[(deflt,(f,(fst(catSkeletonty))))|letfs=functionsToCatpgfcat,(f,ty)<-fs,letdeflt=1.0/fromIntegral(lengthfs)]hitRegion::Double->[(Double,(CId,[a]))]->(Expr,[a])hitRegiondvs=casevsof(p1,(f,v1)):vs2->ifd<p1then(EFunf,v1)elsehitRegion(d-p1)vs2_->(EMeta9,[])