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.Backend.Python -e 'normalizeFile "%s"' """ % f), \
+ assert 0 == os.system("""ghc -isrc Dyna.Backend.Debugging -e 'normalizeFile "%s"' """ % f), \
'failed to convert file.'
with file('%s.anf' % f) as h:
return h.read()
import qualified Data.Char as C
-import Dyna.XXX.Trifecta (renderSpan)
+import Dyna.XXX.Trifecta (prettySpanLoc)
------------------------------------------------------------------------}}}
-- Preliminaries {{{
x@(NTVar v) | v `elem` vs -> do
v' <- newAssign "_x" (Left x)
return (vs,v':r)
- x@(NTVar v) -> do
+ NTVar v -> do
return (v:vs,v:r)
_ -> do
v' <- newAssignNT "_x" x
------------------------------------------------------------------------}}}
-- Pretty Printer {{{
-printANF :: FRule -> Doc T.Effect
+printANF :: FRule -> Doc e
printANF (FRule h a s result span
(AS {as_evals = evals, as_assgn = assgn, as_unifs = unifs})) =
- --";;" <+> (renderSpan span) `above`
- (
- parens $ (pretty a)
+ text ";;" <+> prettySpanLoc span
+ `above`
+ ( parens $ (pretty a)
<+> valign [ (pretty h)
, parens $ text "side" <+> (valign $ map pretty s)
, parens $ text "evals" <+> pev
, parens $ text "unifs" <+> pun
, parens $ text "result" <+> (pretty result)
]
- )
+ ) <> line
where
pft :: FDT -> Doc e
pft (fn,args) = parens $ hsep $ (pretty fn : (map pretty args))
--- /dev/null
+---------------------------------------------------------------------------
+-- | A variety of debugging backends.
+--
+-- XXX Eventually, these may want such things kicked on by flags rather
+-- than invoked directly.
+
+-- Header material {{{
+module Dyna.Backend.Debugging where
+
+import Control.Applicative ((<*))
+import Control.Exception
+import Dyna.Analysis.ANF
+import qualified Dyna.ParserHS.Parser as P
+import System.IO
+import Text.PrettyPrint.Free as PP
+import qualified Text.Trifecta as T
+
+------------------------------------------------------------------------}}}
+-- File to ANF {{{
+
+-- | 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 oh = do
+ pr <- T.parseFromFileEx (P.dlines <* T.eof) file
+ case pr of
+ T.Failure td -> T.display td
+ T.Success rs -> mapM_ (PP.hPutDoc oh)
+ $ map (\(P.LRule x T.:~ _) -> printANF $ normRule x) rs
+
+normalizeFile i o = bracket
+ (openFile o WriteMode)
+ (hClose)
+ $ normalizeFile_ i
+
+normalizeFileStdout file = normalizeFile_ file stdout
+
+------------------------------------------------------------------------}}}
module Dyna.Backend.Python where
-import Control.Applicative ((<*))
-
+import Control.Applicative ((<*))
import qualified Control.Arrow as A
import Control.Exception
import Control.Monad
import Text.PrettyPrint.Free
import qualified Text.Trifecta as T
-import Dyna.XXX.Trifecta (renderSpan)
+import Dyna.XXX.Trifecta (prettySpanLoc)
------------------------------------------------------------------------}}}
printPlan fh fa mu (r, cost, dope) = do -- display plan
hPutStrLn fh $ "# --"
displayIO fh $ prefixSD "# " $ renderPretty 1.0 100
- $ (renderSpan $ fr_span r) <> line
+ $ (prettySpanLoc $ fr_span r) <> line
hPutStrLn fh $ "# Cost: " ++ (show cost)
displayIO fh $ renderPretty 1.0 100
$ py fa mu r dope <> line
hPutStrLn fh ""
-
-
-processFile fileName = do
- fh <- openFile (fileName ++ ".plan") WriteMode
- processFile_ fileName fh
- hClose fh
-
+processFile fileName = bracket
+ (openFile (fileName ++ ".plan") WriteMode)
+ hClose
+ $ processFile_ fileName
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 ->
valVar = "_v"
--- TEST: processFile "examples/cky.dyna"
-
-------------------------------------------------------------------------}}}
--- Experimental Residuals? {{{
+-- TEST: processFileStdout "examples/cky.dyna"
--- | 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 $ normRule x)
- (unsafeParse P.dlines contents))
- <> line)
- return ()
------------------------------------------------------------------------}}}
{-# LANGUAGE OverloadedStrings #-}
-- XXX contribute back to trifecta
+-- Header material {{{
module Dyna.XXX.Trifecta (
- identNL, pureSpanned, stringLiteralSQ, triInteract, renderSpan
+ identNL, pureSpanned, stringLiteralSQ, triInteract, prettySpanLoc
) where
import Control.Applicative
import Text.Trifecta
import Text.Trifecta.Delta
-import Text.PrettyPrint.Free ((<+>), above, indent)
+import qualified Text.PrettyPrint.Free as PP
-- import Debug.Trace
+------------------------------------------------------------------------}}}
+-- identNL {{{
+
-- | Just like ident but without the "token $" prefix
--
-- belongs in Text.Parser.Token
when (HashSet.member name (styleReserved s)) $ unexpected $ "reserved " ++ styleName s ++ " " ++ show name
return name
+------------------------------------------------------------------------}}}
+-- String literal variants {{{
+
-- | Just like stringLiteral but with single quotes.
--
-- belongs in Text.Parser.Token
number base baseDigit =
foldl' (\x d -> base*x + toInteger (digitToInt d)) 0 <$> some baseDigit
+------------------------------------------------------------------------}}}
+-- pureSpanned {{{
-- | Just like "pure" but right here in the parsing state
--
pureSpanned :: DeltaParsing m => a -> m (Spanned a)
pureSpanned r = (liftA (r :~) $ Span <$> position <*> position <*> line)
+------------------------------------------------------------------------}}}
+-- Interaction {{{
-- | A multi-line interaction mechanism, for the REPL.
--
------------------------------------------------------------------------}}}
--- Utilities {{{
-
-renderSpan (Span s e bs) =
- prettyTerm s
- <+> "-"
- <+> prettyTerm e
- <+> ":"
- `above` (indent 2 (prettyTerm $ rendering s bs))
+-- Diagnostic utilities {{{
+
+-- XXX I'd really like (but cannot seem to get) the ability to suppress the
+-- file name if it's the same in both cases. Stripping Directed to Lines
+-- results in the lie of "(interactive)". In any case, this function is
+-- here as a placeholder for doing the right thing.
+prettySpanLoc :: Span -> PP.Doc e
+prettySpanLoc (Span s e l) = PP.pretty s PP.<> PP.char '-' PP.<> PP.pretty e
+
+------------------------------------------------------------------------}}}
projects / dyna2 / commitdiff