Create Dyna.Main. and move exceptions there

diff --git a/README b/README
index c32a82d8ac69344867136f3661326b79d328ec3f..dd5466abfd73f6f2d03acf1eb41c4f62492c1497 100644 (file)
--- a/README
+++ b/README
@@ -16,12 +16,17 @@ src/Dyna/
                    -- done in finally-tagless style.
                    -- Includes some "Examples", even if not self-tests.
 
+  Backend          -- Compilation to target languages
+
+  Main             -- Dyna compiler main modules
+
   ParserHS         -- the Haskell front-end parser and selftests
 
   Term             -- Different representations of terms and
-                   --  utilities
+                   -- utilities
 
   Test             -- code used by self-tests throughout the codebase
+                   -- and the top-level test harness itself
 
   XXX              -- code that should probably go upstream;
                    -- modules here are named by the upstream package.

diff --git a/src/Dyna/Analysis/RuleMode.hs b/src/Dyna/Analysis/RuleMode.hs
index d50f6b14d01ec0bd300ad3397c76a1de9b002be7..a7e86973202765d451953466162871507e1b5a9a 100644 (file)
--- a/src/Dyna/Analysis/RuleMode.hs
+++ b/src/Dyna/Analysis/RuleMode.hs
@@ -32,6 +32,7 @@ import qualified Data.Set                   as S
 import qualified Debug.Trace                as XT
 import           Dyna.Analysis.ANF
 import           Dyna.Term.TTerm
+import           Dyna.Main.Exception
 import qualified Dyna.ParserHS.Parser       as DP
 import           Dyna.XXX.DataUtils(argmin)
 import           Dyna.XXX.TrifectaTest
@@ -416,7 +417,7 @@ initializeForCrux :: (Crux DVar a, DVar, DVar)
 initializeForCrux (cr, hi, v) = case cr of
   CFCall o is f -> ( ((f,length is), hi, o)
                    , [ OPGetArgsIf is hi f, OPAssign o (NTVar v) ])
-  _             -> error "Don't know how to initially plan !CFCall"
+  _             -> sorryDynac "Don't know how to initially plan !CFCall"
 
 -- | Given a normalized form and an initial crux, saturate the graph and
 --   get a plan for doing so.

diff --git a/src/Dyna/Backend/Python.hs b/src/Dyna/Backend/Python.hs
index bc990b0344ab344be2ff79ff148017553d53022e..f32eea6ac8a5118140b55653dd94728c446c93a9 100644 (file)
--- a/src/Dyna/Backend/Python.hs
+++ b/src/Dyna/Backend/Python.hs
@@ -1,14 +1,10 @@
 ---------------------------------------------------------------------------
--- | Some week-before-the-deadline heroics to try to get something
--- (anything) up and running.
+-- | Compile to Python
 --
--- XXX This is terrible.  Just terrible.
+-- See bin/stdlib.py
 
 -- Header material                                                      {{{
-{-# LANGUAGE DeriveDataTypeable #-}
 {-# LANGUAGE OverloadedStrings #-}
-{-# LANGUAGE Rank2Types #-}
-{-# LANGUAGE ScopedTypeVariables #-}
 
 module Dyna.Backend.Python where
 
@@ -25,50 +21,22 @@ 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 Data.Typeable              as DT
 import qualified Debug.Trace                as XT
 import           Dyna.Analysis.ANF
 import           Dyna.Analysis.Aggregation
 import           Dyna.Analysis.RuleMode
+import           Dyna.Main.Exception
 import           Dyna.Term.TTerm
 import qualified Dyna.ParserHS.Parser       as P
 import           Dyna.XXX.DataUtils (mapInOrApp)
 import           Dyna.XXX.PPrint
-import           Dyna.XXX.TrifectaTest
+import           Dyna.XXX.Trifecta (prettySpanLoc)
 import           System.IO
 import           Text.PrettyPrint.Free
 import qualified Text.Trifecta              as T
 
-import Dyna.XXX.Trifecta (prettySpanLoc)
 
 
-------------------------------------------------------------------------}}}
--- Top Level Exceptions                                                 {{{
---
--- Make the control flow a little cleaner by bailing out rather than
--- anything right-branching.  Probably not what we actually want.
-
-data TopLevelException = TLEAggPlan    String
-                       | TLENoUpdPlan  FRule  (DFunct,Int)
- deriving (DT.Typeable)
-
-instance Eq TopLevelException where
-  (==) (TLENoUpdPlan (FRule h1 a1 e1 r1 s1 _) f1)
-       (TLENoUpdPlan (FRule h2 a2 e2 r2 s2 _) f2) =
-        h1 == h2 && a1 == a2 && e1 == e2
-     && r1 == r2 && s1 == s2 && f1 == f2
-
-  (==) (TLEAggPlan s1) (TLEAggPlan s2) = s1 == s2
-  (==) _ _ = False
-
-instance Show TopLevelException where
-  show (TLEAggPlan s) = "TLEAggPlan: " ++ s
-  show (TLENoUpdPlan r fa) = show $
-       text "TLENoUpdPlan" <+> text "for" <+> pretty fa <> line
-    <> printANF r
-
-instance Exception TopLevelException
-
 ------------------------------------------------------------------------}}}
 -- DOpAMine Printout                                                    {{{
 
@@ -136,7 +104,11 @@ combinePlans = go (M.empty)
   go' xs _  []           m = go m xs
   go' xs fr ((fa,mca):ys) m =
     case mca of
-      Nothing -> throw $ TLENoUpdPlan fr fa
+      Nothing -> throw $ UserProgramError 
+                       $ "No update plan for "
+                          <+> (pretty fa)
+                          <+> "in rule at"
+                          <+> (prettySpanLoc $ fr_span fr)
       Just (c,a) -> go' xs fr ys $ mapInOrApp fa (fr,c,a) m
 
 py (f,a) mu (FRule h _ _ r span _) dope =
@@ -198,7 +170,7 @@ processFile_ fileName fh = do
                          $ map (\x -> (x, planInitializer x)) frs
       in do
          aggm <- case buildAggMap frs of
-                   Left e -> throw $ TLEAggPlan e
+                   Left e -> throw $ UserProgramError (text e)
                    Right x -> return x
 
          hPutStrLn fh $ "agg_decl = {}"

diff --git a/src/Dyna/Main/Exception.hs b/src/Dyna/Main/Exception.hs
new file mode 100644 (file)
index 0000000..d6d3eda
--- /dev/null
+++ b/src/Dyna/Main/Exception.hs
@@ -0,0 +1,42 @@
+---------------------------------------------------------------------------
+-- | Top Level Exceptions from the Dyna Compiler
+--
+-- Modeled on GHC's GhcException
+
+-- Header material                                                      {{{
+{-# LANGUAGE DeriveDataTypeable #-}
+{-# LANGUAGE StandaloneDeriving #-}
+
+module Dyna.Main.Exception where
+
+import           Control.Exception
+import qualified Data.Typeable                       as DT
+import qualified System.Console.Terminfo.PrettyPrint as TP
+import qualified Text.PrettyPrint.Free               as PP
+
+------------------------------------------------------------------------}}}
+-- Dyna Compiler Exceptions                                             {{{
+
+data DynacException =
+    -- | The user program contains an error
+    UserProgramError (PP.Doc TP.Effect)
+
+    -- | We don't implement a feature yet.
+  | Sorry            (PP.Doc TP.Effect)
+
+    -- | Something we did not believe possible actually happened
+  | Panic            (PP.Doc TP.Effect)
+ deriving (DT.Typeable)
+
+deriving instance Show DynacException
+instance Exception DynacException
+
+------------------------------------------------------------------------}}}
+-- Utilities                                                            {{{
+
+throwDynac :: DynacException -> a
+throwDynac = throw
+
+sorryDynac = throw . Sorry
+
+------------------------------------------------------------------------}}}