From 79c23b0327de12bd715734729680a9c60ff43e4c Mon Sep 17 00:00:00 2001 From: Nathaniel Wesley Filardo Date: Thu, 13 Dec 2012 01:25:58 -0500 Subject: [PATCH] Create Dyna.Main. and move exceptions there --- README | 7 ++++- src/Dyna/Analysis/RuleMode.hs | 3 ++- src/Dyna/Backend/Python.hs | 48 ++++++++--------------------------- src/Dyna/Main/Exception.hs | 42 ++++++++++++++++++++++++++++++ 4 files changed, 60 insertions(+), 40 deletions(-) create mode 100644 src/Dyna/Main/Exception.hs diff --git a/README b/README index c32a82d..dd5466a 100644 --- 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 d50f6b1..a7e8697 100644 --- 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 bc990b0..f32eea6 100644 --- 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 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 + +------------------------------------------------------------------------}}} -- 2.50.1