From 584d589041f63fdd3ea777019679275657902c2d Mon Sep 17 00:00:00 2001 From: "kr.angelov" Date: Mon, 11 Aug 2014 10:59:10 +0000 Subject: a partial support for def rules in the C runtime The def rules are now compiled to byte code by the compiler and then to native code by the JIT compiler in the runtime. Not all constructions are implemented yet. The partial implementation is now in the repository but it is not activated by default since this requires changes in the PGF format. I will enable it only after it is complete. --- src/runtime/haskell/PGF/Probabilistic.hs | 20 ++++++++++---------- 1 file changed, 10 insertions(+), 10 deletions(-) (limited to 'src/runtime/haskell/PGF/Probabilistic.hs') diff --git a/src/runtime/haskell/PGF/Probabilistic.hs b/src/runtime/haskell/PGF/Probabilistic.hs index 7d8d58134..555ae0ce9 100644 --- a/src/runtime/haskell/PGF/Probabilistic.hs +++ b/src/runtime/haskell/PGF/Probabilistic.hs @@ -52,7 +52,7 @@ readProbabilitiesFromFile file pgf = do mkProbabilities :: PGF -> Map.Map CId Double -> Probabilities mkProbabilities pgf probs = let funs1 = Map.fromList [(f,p) | (_,(_,fns)) <- Map.toList cats1, (p,f) <- fns] - cats1 = Map.mapWithKey (\c (_,fns,_,_) -> + cats1 = Map.mapWithKey (\c (_,fns,_) -> let p' = fromMaybe 0 (Map.lookup c probs) fns' = sortBy cmpProb (fill fns) in (p', fns')) @@ -76,15 +76,15 @@ defaultProbabilities pgf = mkProbabilities pgf Map.empty getProbabilities :: PGF -> Probabilities getProbabilities pgf = Probs { - funProbs = Map.map (\(_,_,_,p,_) -> p ) (funs (abstract pgf)), - catProbs = Map.map (\(_,fns,p,_) -> (p,fns)) (cats (abstract pgf)) + funProbs = Map.map (\(_,_,_,p) -> p ) (funs (abstract pgf)), + catProbs = Map.map (\(_,fns,p) -> (p,fns)) (cats (abstract pgf)) } setProbabilities :: Probabilities -> PGF -> PGF setProbabilities probs pgf = pgf { abstract = (abstract pgf) { - funs = mapUnionWith (\(ty,a,df,_,addr) p -> (ty,a,df, p,addr)) (funs (abstract pgf)) (funProbs probs), - cats = mapUnionWith (\(hypos,_,_,addr) (p,fns) -> (hypos,fns,p,addr)) (cats (abstract pgf)) (catProbs probs) + funs = mapUnionWith (\(ty,a,df,_) p -> (ty,a,df, p)) (funs (abstract pgf)) (funProbs probs), + cats = mapUnionWith (\(hypos,_,_) (p,fns) -> (hypos,fns,p)) (cats (abstract pgf)) (catProbs probs) }} where mapUnionWith f map1 map2 = @@ -95,8 +95,8 @@ probTree :: PGF -> Expr -> Double probTree pgf t = case t of EApp f e -> probTree pgf f * probTree pgf e EFun f -> case Map.lookup f (funs (abstract pgf)) of - Just (_,_,_,p,_) -> p - Nothing -> 1 + Just (_,_,_,p) -> p + Nothing -> 1 _ -> 1 -- | rank from highest to lowest probability @@ -107,13 +107,13 @@ rankTreesByProbs pgf ts = sortBy (\ (_,p) (_,q) -> compare q p) mkProbDefs :: PGF -> ([[CId]],[(CId,Type,[Equation])]) mkProbDefs pgf = - let cs = [(c,hyps,fns) | (c,(hyps0,fs,_,_)) <- Map.toList (cats (abstract pgf)), + let cs = [(c,hyps,fns) | (c,(hyps0,fs,_)) <- Map.toList (cats (abstract pgf)), not (elem c [cidString,cidInt,cidFloat]), let hyps = zipWith (\(bt,_,ty) n -> (bt,mkCId ('v':show n),ty)) hyps0 [1..] fns = [(f,ty) | (_,f) <- fs, - let Just (ty,_,_,_,_) = Map.lookup f (funs (abstract pgf))] + let Just (ty,_,_,_) = Map.lookup f (funs (abstract pgf))] ] ((_,css),eqss) = mapAccumL (\(ngen,css) (c,hyps,fns) -> let st0 = (1,Map.empty) @@ -263,7 +263,7 @@ computeConstrs pgf st fns = where addArgs (cn,fns) = addArg (length args) cn [] fns where - Just (ty@(DTyp args _ es),_,_,_,_) = Map.lookup cn (funs (abstract pgf)) + Just (ty@(DTyp args _ es),_,_,_) = Map.lookup cn (funs (abstract pgf)) addArg 0 cn ps fns = [(PApp cn (reverse ps),fns)] addArg n cn ps fns = concat [addArg (n-1) cn (arg:ps) fns' | (arg,fns') <- computeConstr fns] -- cgit v1.2.3