Tweaks to Analysis.ANF and friends

diff --git a/src/Dyna/Analysis/ANF.hs b/src/Dyna/Analysis/ANF.hs
index 3379911fbc54206eb2df1214c01492c537fee052..65fb413f5edc7fa5d3cca6753b73a3100fb899f6 100644 (file)
--- a/src/Dyna/Analysis/ANF.hs
+++ b/src/Dyna/Analysis/ANF.hs
@@ -304,7 +304,7 @@ normTerm c (t T.:~ s) = normTerm_ (ECFunctor,if c then ADEval else ADQuote)
 ------------------------------------------------------------------------}}}
 -- Normalize a Rule                                                     {{{
 
-data FDR = FRule DVar B.ByteString [DVar] DVar
+data FDR = FRule DVar DAgg [DVar] DVar
  deriving (Show)
 
 -- XXX

diff --git a/src/Dyna/Analysis/ANFSelftest.hs b/src/Dyna/Analysis/ANFSelftest.hs
index 26970b22a5be750a836ec61736c294d5d91a4a88..c711a79ef43b5b02ba603b392c5d2171b6d1c60b 100644 (file)
--- a/src/Dyna/Analysis/ANFSelftest.hs
+++ b/src/Dyna/Analysis/ANFSelftest.hs
@@ -33,6 +33,7 @@ testNormRule :: B.ByteString -> (FDR, ANFState)
 testNormRule = runNormalize . normRule . unsafeParse P.drule
 
 
+{-
 e1 = testNormRule "f(X)."
 e2 = testNormRule "f(X) := 1."
 
@@ -46,7 +47,7 @@ t4 = unsafeParse P.dlines e4
 e3 = "f(X,Y) += (g(X,\"str\",d) - h(X,X,Y) - c)^2 + f(Y,Z)/exp(3.0) whenever ?c, (d < 10), e(f(h(X)), g(X))"
 t3 = testNormRule e3
 p3 = printANF $ t3
-
+-}
 
 normalizeFile file = do
     contents <- B.readFile file

diff --git a/src/Dyna/Analysis/RuleMode.hs b/src/Dyna/Analysis/RuleMode.hs
index 266e09835d6e2500d278680d12d0d2acf3ab29a5..3d8a09b7918c2dceab3baf9b72fd0d02a240b883 100644 (file)
--- a/src/Dyna/Analysis/RuleMode.hs
+++ b/src/Dyna/Analysis/RuleMode.hs
@@ -13,26 +13,21 @@
 module Dyna.Analysis.RuleMode where
 
 import           Control.Monad
-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.Term.TTerm
 import qualified Dyna.ParserHS.Parser       as DP
-import           Dyna.XXX.PPrint
 import           Dyna.XXX.TrifectaTest
-import           Text.PrettyPrint.Free
 
 ------------------------------------------------------------------------}}}
 -- Utilities                                                            {{{
 
+filterNTs :: [NT v] -> [v]
 filterNTs = MA.mapMaybe isNTVar
  where
   isNTVar (NTVar x) = Just x
@@ -48,8 +43,8 @@ type BindChart = S.Set DVar
 
 varMode :: BindChart -> NTV -> Mode
 varMode c (NTVar v) = if v `S.member` c then MBound else MFree
-varMode c (NTString _) = MBound
-varMode c (NTNumeric _) = MBound
+varMode _ (NTString _) = MBound
+varMode _ (NTNumeric _) = MBound
 
 type ModedVar = (Mode,DVar)
 
@@ -88,7 +83,7 @@ type Crux n = (CFunct,[n],n)
 cruxMode :: Crux NTV -> BindChart -> Crux ModedNT
 cruxMode (f,is,o) c = (f, map (mode c) is, mode c o)
  where
-  mode c x@(NTVar v)   = case varMode c x of
+  mode b x@(NTVar v)   = case varMode b x of
                            MBound -> MB x
                            MFree  -> MF v
   mode _ (NTString s)  = MB (NTString s)
@@ -172,40 +167,44 @@ possible (f,is,o) = case f of
                            : map (\(c,x) -> (OPCheck c x)) cis
                          ]
          where
-          mkChks n (MF i) = (i, Nothing)
+          mkChks _ (MF i) = (i, Nothing)
           mkChks n (MB v) = let chk = BC.pack $ "_chk_" ++ (show n)
                             in (chk, Just (chk, v))
 
-          (is',mcis) = unzip $ zipWith mkChks [0..] is
+          (is',mcis) = unzip $ zipWith mkChks [0::Int ..] is
           cis        = MA.catMaybes mcis
+
+        MB _ -> []   -- XXX shouldn't happen
           
     -- Backward-chainable mathematics (this is such a hack XXX)
-  CFCall f | isMath f ->
+  CFCall funct | isMath funct ->
       if not $ all isBound is
-       then case inv f is o of
+       then case inv funct is o of
               Nothing -> []
               Just (f',is',o') -> [[OPCall o' is' f']]
        else let is' = map ntvOfMNT is in
             case o of
-              MF o' ->  [[OPCall o' is' f]]
+              MF o' ->  [[OPCall o' is' funct]]
               MB o' -> let cv = "_chk"
-                       in [[OPCall  cv is' f
+                       in [[OPCall  cv is' funct
                            ,OPCheck cv o'
                            ]]
 
-  CFCall f | otherwise -> [[OPIter o is f ]]
+    -- Otherwise, we assume it's an extensional table and ask to iterate
+    -- over it.
+  CFCall funct | otherwise -> [[OPIter o is funct]]
 
  where
-  inv "+" is o | length is == 2 && isBound o
-               = case L.partition isFree is of
-                   ([MF fi],bis) -> Just ("-",map ntvOfMNT $ o:bis,fi)
+  inv "+" is' (MB o') | length is' == 2
+               = case L.partition isFree is' of
+                   ([MF fi],bis) -> Just ("-",o':map ntvOfMNT bis,fi)
                    _ -> Nothing
 
-  inv "-" [(MB x),(MF y)] (MB o)
-                  = Just ("-",[x,o],y)
+  inv "-" [(MB x),(MF y)] (MB o')
+                  = Just ("-",[x,o'],y)
 
-  inv "-" [(MF x),(MB y)] (MB o)
-                  = Just ("+",[o,y],x)
+  inv "-" [(MF x),(MB y)] (MB o')
+                  = Just ("+",[o',y],x)
   inv _   _  _  = Nothing
 
 
@@ -268,17 +267,20 @@ simpleCost (PP { pp_score = osc }) act =
 ------------------------------------------------------------------------}}}
 -- ANF to Cruxes                                                        {{{
 
+eval_cruxes :: ANFState -> [Crux NTV]
 eval_cruxes = M.foldrWithKey (\o i -> (crux o i :)) [] . as_evals
  where
   crux :: DVar -> EVF -> Crux NTV
   crux o (Left v) = (CFEval,[NTVar v],NTVar o)
   crux o (Right (TFunctor n as)) = (CFCall n,as,NTVar o)
+  -- XXX Missing cases
 
+unif_cruxes :: ANFState -> [Crux NTV]
 unif_cruxes = M.foldrWithKey (\o i -> (crux o i :)) [] . as_unifs
  where
   crux :: DVar -> FDT -> Crux NTV
-  crux o t@(TString s) = (CFAssign,[NTString s], NTVar o)
-  crux o t@(TNumeric n) = (CFAssign,[NTNumeric n], NTVar o)
+  crux o (TString s) = (CFAssign,[NTString s], NTVar o)
+  crux o (TNumeric n) = (CFAssign,[NTNumeric n], NTVar o)
   crux o (TFunctor x as) = (CFUnif x, as, NTVar o)
 
 -- | Given a normalized form and an initial crux, saturate the graph and
@@ -288,7 +290,7 @@ plan :: (Crux ModedNT -> [Action])
      -> (FDR, ANFState)
      -> Crux NTV
      -> (Cost, Action)
-plan st sc (fr, anfs) cr@(c,ci,co) = 
+plan st sc (_, anfs) cr@(_,ci,co) = 
   let cruxes =    eval_cruxes anfs
                ++ unif_cruxes anfs
       initPlan = PP { pp_cruxes = S.delete cr (S.fromList cruxes)

diff --git a/src/Dyna/Term/TTerm.hs b/src/Dyna/Term/TTerm.hs
index 8adee60ba4bb986559aa6412a8584f08638844f0..952c4020f509327a7bb6add148d9a1e63d355bce 100644 (file)
--- a/src/Dyna/Term/TTerm.hs
+++ b/src/Dyna/Term/TTerm.hs
@@ -18,10 +18,10 @@ module Dyna.Term.TTerm (
     Annotation(..),
 
         -- * Terms
-    TermF(..), DTermV, DVar, DFunct, DTerm,
+    TermF(..), DTermV, DVar, DFunct, DFunctAr, DTerm,
 
         -- * Rules
-    DRule(..),
+    DAgg, DRule(..),
 
         -- * Convenience re-export
     UTerm(..)
@@ -44,6 +44,7 @@ data TermF a t = TFunctor !a ![t]
  deriving (Eq,F.Foldable,Functor,Ord,Show,T.Traversable)
 
 type DFunct = B.ByteString
+type DFunctAr = (DFunct,Int)
 type DTermV v = UTerm (TermF DFunct) v
 
 type DVar  = B.ByteString
@@ -61,7 +62,9 @@ instance (Eq a) => Unifiable (TermF a) where
 ------------------------------------------------------------------------}}}
 -- Rules                                                                {{{
 
-data DRule = Rule !DTerm !B.ByteString ![DTerm] !DTerm
+type DAgg = B.ByteString
+
+data DRule = Rule !DTerm !DAgg ![DTerm] !DTerm
  deriving (Show)
 
 ------------------------------------------------------------------------}}}