From 514c39fb224d18a7ad4759bfeb85b2bf14f5a7bc Mon Sep 17 00:00:00 2001
From: timv <timv@herman0.(none)>
Date: Wed, 28 Nov 2012 23:47:09 -0500
Subject: [PATCH] added ANF pretty printer

---
 src/Dyna/Analysis/NormalizeParse.hs         | 50 +++++++++++++++++++++
 src/Dyna/Analysis/NormalizeParseSelftest.hs | 45 ++++++++++++++++++-
 2 files changed, 94 insertions(+), 1 deletion(-)

diff --git a/src/Dyna/Analysis/NormalizeParse.hs b/src/Dyna/Analysis/NormalizeParse.hs
index 5652b0e..c9b48a0 100644
--- a/src/Dyna/Analysis/NormalizeParse.hs
+++ b/src/Dyna/Analysis/NormalizeParse.hs
@@ -57,6 +57,9 @@ import           Dyna.Term.TTerm
 
 import qualified Data.Char as C
 
+import Text.PrettyPrint
+
+
 data ANFDict = AD
   { -- | A map from (functor,arity) to a list of bits indicating whether to
     -- (True) or not to (False) evaluate that positional argument.
@@ -216,3 +219,50 @@ runNormalize :: ReaderT ANFDict (State ANFState) a -> (a, ANFState)
 runNormalize =
   flip runState   (AS 0 M.empty M.empty) .
   flip runReaderT (AD dynaFunctorArgDispositions dynaFunctorSelfDispositions)
+
+
+
+-- FIXME: "str" is the same a constant str.
+
+-- TODO: ANF Normalizer should return *flat terms* so that we have type-safety
+-- can a lint checker can verify we have exhaustive pattern matching... etc.
+
+--     timv: should there ever be more than one side condition? shouldn't it be
+--     a single result variable after normalization? I see that if I use comma
+--     to combine my conditions I get mutliple variables but should side
+--     condtions be combined with comma? I was under the impression that we
+--     always want strong Boolean values (i.e. none of that three-values null
+--     stuff).
+--
+--     it might be nice if terms came in with a type that verified that they are
+--     "flat term" -- they've been normalized.
+--
+--     It would also be nice if spans were killed... maybe there is an argument
+--     against this.
+--
+--     ANF Rule, `result` always the name of a variable -- it would be nice for
+--     its type were string in that case. Similarly, side conditions are always
+--     variables.
+--
+--  TODO: there might too much special handling of the comma operator...
+--
+bs :: B.ByteString -> Doc  -- PrettyPrinter doesn't like ByteStrings
+bs = text . show
+
+pp ((Rule h a e result), AS {as_evals = evals, as_unifs = unifs}) =
+  parens $ (bs a)
+           <+> vcat [ (p h)
+                    , parens $ text "side"   <+> (vcat $ map (text.show) e)
+                    , parens $ text "evals"  <+> (q evals)
+                    , parens $ text "unifs"  <+> (q unifs)
+                    , parens $ text "result" <+> (text $ show result)
+                    ]
+  where
+    p (UTerm (TFunctor fn args)) = parens $ fcat $ punctuate (text " ") $ (bs fn : (map g args))
+
+    q x = vcat $ map (\(x,y)-> parens $ bs x <+> p y) $ M.toList x
+
+    -- todo: doesn't cover annotations or Functor (will `g` ever be passed a Functor?)
+    g (UTerm (TNumeric (Left x))) = text $ show x
+    g (UTerm (TNumeric (Right x))) = text $ show x
+    g (UVar x) = text $ show x
diff --git a/src/Dyna/Analysis/NormalizeParseSelftest.hs b/src/Dyna/Analysis/NormalizeParseSelftest.hs
index 616115a..f18639a 100644
--- a/src/Dyna/Analysis/NormalizeParseSelftest.hs
+++ b/src/Dyna/Analysis/NormalizeParseSelftest.hs
@@ -4,16 +4,59 @@
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE StandaloneDeriving #-}
 
+
+--------------------------------------------------------------------------------
+-- Don't forget to run the following command at the ghci promt
+--    ghci> :set -XOverloadedStrings
+--
+
 module Dyna.Analysis.NormalizeParseSelftest where
 
+import Text.PrettyPrint
+
 import qualified Data.ByteString              as B
 import           Dyna.Analysis.NormalizeParse
+
 import qualified Dyna.ParserHS.Parser         as P
-import           Dyna.Term.TTerm
+import qualified Data.ByteString              as B
+
+
+import Dyna.Term.TTerm
+
 import           Dyna.XXX.TrifectaTest
+import           Dyna.ParserHS.Selftest
+
+import qualified Data.List     as L
+import qualified Data.Map      as M
+import qualified Text.Trifecta as T
 
 testNormTerm :: B.ByteString -> (DTerm, ANFState)
 testNormTerm = runNormalize . normTerm False . unsafeParse P.dterm
 
 testNormRule :: B.ByteString -> (DRule, ANFState)
 testNormRule = runNormalize . normRule . unsafeParse P.drule
+
+
+-- XXX fix periods, parser thinks it's an infix op and fails.
+e1 = testNormRule "f(X)."
+e2 = testNormRule "f(X) := 1." -- does not work
+
+t1 = testNormRule "f(X) max= g(X) + h(X,X)"
+t2 = testNormRule "f(X, g(I)) += (g(I, h(X)) + 10)^2"
+
+e4 = "fib(X+1) += fib(X) * fib(X-1) := 1 .\nfib(a) := 1 ."
+t4 = unsafeParse P.dlines e4
+
+-- hideous monster rule
+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 = pp $ t3
+
+
+normalizeFile file = do
+    contents <- B.readFile file
+    writeFile (file ++ ".anf")
+              (show $ vcat (map (\(P.LRule x T.:~ _) -> pp $ runNormalize $ normRule x)
+                                (unsafeParse P.dlines contents))
+                      <> text "\n") -- add newline at end of file...
+    return ()
-- 
2.50.1