From: timv Date: Mon, 10 Dec 2012 22:14:24 +0000 (-0500) Subject: Minor refactoring: ANFRules carry around ANFState and Trifecta Span information. X-Git-Url: https://hydra-www.ietfng.org/gitweb/?a=commitdiff_plain;h=0f8e5b9535b6784cb9df2d6d9293bb780cae43b6;p=dyna2 Minor refactoring: ANFRules carry around ANFState and Trifecta Span information. renamed type FDR to FRule to match the constructor. --- diff --git a/src/Dyna/Analysis/ANF.hs b/src/Dyna/Analysis/ANF.hs index dcd8458..eda63ce 100644 --- a/src/Dyna/Analysis/ANF.hs +++ b/src/Dyna/Analysis/ANF.hs @@ -65,7 +65,7 @@ {-# LANGUAGE OverloadedStrings #-} module Dyna.Analysis.ANF ( - ANFState(..), NT(..), FDT, NTV, ENF, EVF, FDR(..), + ANFState(..), NT(..), FDT, NTV, ENF, EVF, FRule(..), normTerm, normRule, runNormalize, printANF ) where @@ -319,18 +319,22 @@ normTerm c (t T.:~ s) = normTerm_ (ECFunctor,if c then ADEval else ADQuote) ------------------------------------------------------------------------}}} -- Normalize a Rule {{{ -data FDR = FRule DVar DAgg [DVar] DVar -- timv: rename type to FRule? +data FRule = FRule { fr_functor :: DVar -- timv: rename type to FRule? + , fr_aggregator :: DAgg + , fr_side :: [DVar] + , fr_result :: DVar + , fr_span :: T.Span + , fr_anf :: ANFState } deriving (Show) -- XXX -normRule :: (Functor m, MonadState ANFState m, MonadReader ANFDict m) - => T.Spanned P.Rule -- ^ Term to digest - -> m FDR -normRule (P.Rule h a es r T.:~ _) = do +normRule :: T.Spanned P.Rule -- ^ Term to digest + -> FRule +normRule (P.Rule h a es r T.:~ span) = uncurry ($) $ runNormalize $ do nh <- normTerm False h >>= newUnifNT "_h" nr <- normTerm True r >>= newUnifNT "_r" nes <- mapM (\e -> normTerm True e >>= newUnifNT "_c") es - return $ FRule nh a nes nr + return $ FRule nh a nes nr span ------------------------------------------------------------------------}}} -- Run the normalizer {{{ @@ -346,15 +350,17 @@ runNormalize = ------------------------------------------------------------------------}}} -- Pretty Printer {{{ -printANF :: (FDR, ANFState) -> Doc e -printANF ((FRule h a e result), AS {as_evals = evals, as_unifs = unifs}) = - parens $ (pretty a) - <+> valign [ (pretty h) - , parens $ text "side" <+> (valign $ map pretty e) - , parens $ text "evals" <+> (pev evals) - , parens $ text "unifs" <+> (pun unifs) - , parens $ text "result" <+> (pretty result) - ] +printANF :: FRule -> Doc e +printANF (FRule h a s result span (AS {as_evals = evals, as_unifs = unifs})) = + ";;" <+> (text $ show span) `above` ( + parens $ (pretty a) + <+> valign [ (pretty h) + , parens $ text "side" <+> (valign $ map pretty s) + , parens $ text "evals" <+> (pev evals) + , parens $ text "unifs" <+> (pun unifs) + , parens $ text "result" <+> (pretty result) + ] + ) where pft :: FDT -> Doc e diff --git a/src/Dyna/Analysis/ANFSelftest.hs b/src/Dyna/Analysis/ANFSelftest.hs index 4a15325..0d79bd2 100644 --- a/src/Dyna/Analysis/ANFSelftest.hs +++ b/src/Dyna/Analysis/ANFSelftest.hs @@ -29,7 +29,7 @@ import Dyna.XXX.TrifectaTest testNormTerm :: Bool -> B.ByteString -> (NTV, ANFState) testNormTerm c = runNormalize . normTerm c . unsafeParse P.dterm -testNormRule :: B.ByteString -> (FDR, ANFState) +testNormRule :: B.ByteString -> (FRule, ANFState) testNormRule = runNormalize . normRule . unsafeParse P.drule diff --git a/src/Dyna/Analysis/Aggregation.hs b/src/Dyna/Analysis/Aggregation.hs index 3eb4ffb..76e5d48 100644 --- a/src/Dyna/Analysis/Aggregation.hs +++ b/src/Dyna/Analysis/Aggregation.hs @@ -26,15 +26,15 @@ type AggMap = M.Map DFunctAr DAgg -- XXX These functions really would like to have span information, so they -- could report which line of the source caused an error. -procANF :: (FDR, ANFState) -> Either String (DFunctAr, DAgg) -procANF (FRule h a _ _, AS { as_unifs = us }) = +procANF :: FRule -> Either String (DFunctAr, DAgg) +procANF (FRule h a _ _ _ (AS { as_unifs = us })) = case M.lookup h us of Nothing -> Left $ "I can't process head-variables" Just t -> case t of Left _ -> Left "Malformed head" Right (f,as) -> Right ((f,length as),a) -buildAggMap :: [(FDR, ANFState)] -> Either String AggMap +buildAggMap :: [FRule] -> Either String AggMap buildAggMap = go (M.empty) where go m [] = Right m diff --git a/src/Dyna/Analysis/RuleMode.hs b/src/Dyna/Analysis/RuleMode.hs index a672da9..6ba3326 100644 --- a/src/Dyna/Analysis/RuleMode.hs +++ b/src/Dyna/Analysis/RuleMode.hs @@ -16,7 +16,7 @@ module Dyna.Analysis.RuleMode ( Crux(..), DOpAMine(..), detOfDop, - + Action, Cost, Det(..), planEachEval, adornedQueries @@ -347,8 +347,8 @@ plan st sc anf cr hi v = plans -> Just $ L.minimumBy (O.comparing fst) plans) $ plan_ st sc anf cr hi v -planEachEval :: DVar -> DVar -> ANFState -> [(DFunctAr, Maybe (Cost,Action))] -planEachEval hi v anf = +planEachEval :: DVar -> DVar -> FRule -> [(DFunctAr, Maybe (Cost,Action))] +planEachEval hi v (FRule { fr_anf = anf }) = map (\(c,fa) -> (fa, plan possible simpleCost anf c hi v)) $ MA.mapMaybe (\c -> case c of CFCall _ is f | not $ isMath f @@ -385,9 +385,7 @@ ntMode _ (NTString _) = MBound ntMode _ (NTNumeric _) = MBound -} -testPlanRule x = - let (_,anf) = runNormalize $ normRule (unsafeParse DP.drule x) - in planEachEval "HEAD" "VALUE" anf +testPlanRule x = planEachEval "HEAD" "VALUE" $ normRule (unsafeParse DP.drule x) main :: IO () main = mapM_ (\(c,msp) -> do diff --git a/src/Dyna/Backend/Python.hs b/src/Dyna/Backend/Python.hs index f96b329..28cf450 100644 --- a/src/Dyna/Backend/Python.hs +++ b/src/Dyna/Backend/Python.hs @@ -94,9 +94,9 @@ pf f vs = pretty f <> (tupled $ map pretty vs) -- -- timv: might want to fuse these into one circuit -- -combinePlans :: [(FDR,[(DFunctAr, Maybe (Cost,Action))])] -> - Either String (M.Map DFunctAr [(FDR, Cost, Action)]) -- all plans for functor/arity - -- XXX are FDR's unique keys? what if a rule is repeated? +combinePlans :: [(FRule,[(DFunctAr, Maybe (Cost,Action))])] -> + Either String (M.Map DFunctAr [(FRule, Cost, Action)]) -- all plans for functor/arity + -- XXX: are FDR's unique keys? suppose a rule is repeated? combinePlans = go (M.empty) where go m [] = Right m @@ -119,7 +119,7 @@ combinePlans = go (M.empty) -- timv: consider flattening FRUle and ANFState -py (cruxf,cruxa) (FRule h _ _ r) dope = +py (cruxf,cruxa) (FRule h _ _ r span _) dope = "@register" <> (parens $ dquotes $ pretty cruxf <> "/" <> (text $ show cruxa)) `above` "def _(_H, _V):" `above` (indent 4 $ go dope) @@ -135,38 +135,49 @@ py (cruxf,cruxa) (FRule h _ _ r) dope = emit = "emit" <> tupled [pretty h, pretty r] + processFile fileName = do + fh <- openFile (fileName ++ ".plan") WriteMode + processFile_ fileName fh + hClose fh + + +processFileStdout fileName = do + processFile_ fileName stdout + + +processFile_ fileName fh = do pr <- T.parseFromFileEx (P.dlines <* T.eof) fileName + case pr of T.Failure td -> T.display td T.Success rs -> let urs = map (\(P.LRule x T.:~ _) -> x) rs - anfs = map (runNormalize . normRule) urs + anfs = map normRule urs in do aggm <- case buildAggMap anfs of -- only used for error checking? Left e -> throw $ TLEAggPlan e -- multiple aggregators Right a -> return a cPlans <- case combinePlans -- crux plans - $ map (A.second $ planEachEval headVar valVar) - anfs of + $ map (\x -> (x, planEachEval headVar valVar x)) anfs of Left e -> throw $ TLEUpdPlan e -- no plan found Right a -> return a - forM_ (M.toList cPlans) $ \(fa, ps) -> do - putStrLn $ "\n# ==============" - putStrLn $ "# " ++ show fa - forM_ ps $ \(r, cost, dope) -> do -- plans for the functor/arity - -- XXX why has body disappeared? - putStrLn $ "# --" - putStrLn $ "# Cost: " ++ (show cost) - displayIO stdout $ renderPretty 1.0 100 + forM_ (M.toList cPlans) $ \(fa, ps) -> do -- plans aggregated by functor/arity + hPutStrLn fh $ "\n# ==============" + hPutStrLn fh $ "# " ++ show fa + forM_ ps $ \(r, cost, dope) -> do -- display plan + hPutStrLn fh $ "# --" + hPutStrLn fh $ "# Cost: " ++ (show cost) + displayIO fh $ renderPretty 1.0 100 $ py fa r dope - putStrLn "" + hPutStrLn fh "" +-- hPutStrLn fh "" - putStrLn "" where headVar = "_H" valVar = "_V" + -- TEST: processFile "examples/cky.dyna" ------------------------------------------------------------------------}}} @@ -180,7 +191,7 @@ normalizeFile file = do contents <- B.readFile file writeFile (file ++ ".anf") (show $ vcat (map (\(P.LRule x T.:~ _) -> - printANF $ runNormalize $ normRule x) + printANF $ normRule x) (unsafeParse P.dlines contents)) <> line) return ()