with file(f, 'wb') as tmp:
tmp.write(code)
os.system('rm -f %s.anf' % f) # clean up any existing ANF output
- assert 0 == os.system("""ghc -isrc Dyna.Analysis.ANFSelftest -e 'normalizeFile "%s"' """ % f), \
+ assert 0 == os.system("""ghc -isrc Dyna.Backend.Python -e 'normalizeFile "%s"' """ % f), \
'failed to convert file.'
with file('%s.anf' % f) as h:
return h.read()
t3 = testNormRule e3
p3 = printANF $ t3
-}
-
-normalizeFile file = do
- contents <- B.readFile file
- writeFile (file ++ ".anf")
- (show $ vcat (map (\(P.LRule x T.:~ _) -> printANF $ runNormalize $ normRule x)
- (unsafeParse P.dlines contents))
- <> text "\n") -- add newline at end of file...
- return ()
--- /dev/null
+---------------------------------------------------------------------------
+-- | Check that the aggregations in a program are well-founded.
+--
+-- Consumes "Dyna.Analysis.ANF" for a whole program.
+
+
+-- Header material {{{
+module Dyna.Analysis.Aggregation (
+ AggMap, buildAggMap
+) where
+
+import qualified Data.ByteString as B
+import qualified Data.Map as M
+import Dyna.Analysis.ANF
+import Dyna.Term.TTerm
+import Dyna.XXX.DataUtils
+
+------------------------------------------------------------------------}}}
+-- Preliminaries {{{
+
+type AggMap = M.Map DFunctAr DAgg
+
+------------------------------------------------------------------------}}}
+-- Processing {{{
+
+-- 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 }) =
+ case M.lookup h us of
+ Nothing -> Left $ "I can't process head-variables"
+ Just t -> case t of
+ TString _ -> Left $ "Malformed rule with string head"
+ TNumeric _ -> Left $ "Malformed rule with numeric head"
+ TFunctor f as -> Right ((f,length as),a)
+
+buildAggMap :: [(FDR, ANFState)] -> Either String AggMap
+buildAggMap = go (M.empty)
+ where
+ go m [] = Right m
+ go m (ar:xs) =
+ case procANF ar of
+ Left e -> Left e
+ Right (d,a) ->
+ case mapUpsert d a m of
+ Left a' -> Left $ "Conflicting aggregators"
+ Right m' -> go m' xs
+
+------------------------------------------------------------------------}}}
{-# LANGUAGE Rank2Types #-}
{-# LANGUAGE ScopedTypeVariables #-}
-module Dyna.Analysis.RuleMode where
+module Dyna.Analysis.RuleMode (
+ Det(..), DOpAMine(..), detOfDop, planEachEval
+) where
import Control.Monad
import qualified Data.ByteString.Char8 as BC
-- get a plan for doing so.
plan :: (Crux ModedNT -> [Action])
-> (PartialPlan -> Action -> Cost)
- -> (FDR, ANFState)
+ -> ANFState
-> Crux NTV
- -> (Cost, Action)
-plan st sc (_, anfs) cr@(_,ci,co) =
- let cruxes = eval_cruxes anfs
- ++ unif_cruxes anfs
+ -> Maybe (Cost, Action)
+plan st sc anf cr@(_,ci,co) =
+ let cruxes = eval_cruxes anf
+ ++ unif_cruxes anf
initPlan = PP { pp_cruxes = S.delete cr (S.fromList cruxes)
, pp_binds = S.fromList $ filterNTs (co:ci)
, pp_score = 0
, pp_plan = []
}
- in L.minimumBy (O.comparing fst) $ stepAgenda st sc [initPlan]
+ in case stepAgenda st sc [initPlan] of
+ [] -> Nothing
+ plans -> Just $ L.minimumBy (O.comparing fst) plans
+
+planEachEval anf =
+ map (\c -> (c, plan possible simpleCost anf c))
+ $ filter (\(f,_,_) -> case f of
+ CFCall f' -> not $ isMath f'
+ _ -> False )
+ $ eval_cruxes anf
------------------------------------------------------------------------}}}
-- Experimental Detritus {{{
-
testPlanRule x =
- let (fr,anfs) = runNormalize $ normRule (unsafeParse DP.drule x)
- updatePlans = map (\c -> (c, plan possible simpleCost (fr,anfs) c))
- $ filter (\(f,_,_) -> case f of { CFCall f' -> not $ isMath f' ; _ -> False })
- $ eval_cruxes anfs
- in updatePlans
+ let (_,anf) = runNormalize $ normRule (unsafeParse DP.drule x)
+ in planEachEval anf
main :: IO ()
-main = mapM_ (\(c,(s,p)) -> do
+main = mapM_ (\(c,msp) -> do
putStrLn $ show c
- putStrLn $ "SCORE: " ++ show s
- forM_ p (putStrLn . show)
+ case msp of
+ Just (s,p) -> do
+ putStrLn $ "SCORE: " ++ show s
+ forM_ p (putStrLn . show)
+ Nothing -> putStrLn "NO PLAN"
putStrLn "")
$ testPlanRule
-- $ "fib(X) :- fib(X-1) + fib(X-2)"
--- /dev/null
+---------------------------------------------------------------------------
+-- | Some week-before-the-deadline heroics to try to get something
+-- (anything) up and running.
+--
+-- XXX This is terrible. Just terrible.
+
+-- Header material {{{
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE Rank2Types #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+
+module Dyna.Backend.Python where
+
+import qualified Data.ByteString as B
+import qualified Data.ByteString.Char8 as BC
+import Data.Char
+-- import Data.Either
+import qualified Data.List as L
+import qualified Data.Map as M
+import qualified Data.Maybe as MA
+import qualified Data.Ord as O
+import qualified Data.Set as S
+import qualified Debug.Trace as XT
+import Dyna.Analysis.ANF
+import Dyna.Analysis.Aggregation
+import Dyna.Analysis.RuleMode
+import Dyna.Term.TTerm
+import qualified Dyna.ParserHS.Parser as P
+import Dyna.XXX.PPrint
+import Dyna.XXX.TrifectaTest
+import Text.PrettyPrint.Free
+import qualified Text.Trifecta as T
+
+------------------------------------------------------------------------}}}
+-- Preliminaries {{{
+
+------------------------------------------------------------------------}}}
+-- Experimental Detritus {{{
+
+processFile fileName = do
+ pr <- T.parseFromFileEx (P.dlines) 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
+ eaggm = buildAggMap anfs
+ in -- Ensure that we have an aggregator plan
+ case eaggm of
+ Left e -> print e >> putStrLn "while building aggregator map."
+ Right aggm -> print "Got an agg plan..."
+ -- XXX now, build an update plan for each rule
+
+
+------------------------------------------------------------------------}}}
+-- Experimental Residuals? {{{
+
+-- | Normalize all the rules in a file and emit S-exprs for the ANF
+-- normalized form.
+--
+-- NOTE: This is used by bin/prototype.py
+normalizeFile file = do
+ contents <- B.readFile file
+ writeFile (file ++ ".anf")
+ (show $ vcat (map (\(P.LRule x T.:~ _) ->
+ printANF $ runNormalize $ normRule x)
+ (unsafeParse P.dlines contents))
+ <> line)
+ return ()
+------------------------------------------------------------------------}}}
projects / dyna2 / commitdiff