summaryrefslogtreecommitdiff
path: root/src/compiler/GF/Infra
diff options
context:
space:
mode:
authorhallgren <hallgren@chalmers.se>2015-09-28 22:23:56 +0000
committerhallgren <hallgren@chalmers.se>2015-09-28 22:23:56 +0000
commit35be1828241bb8dacdf326810af388b7b349e591 (patch)
tree78ff946a0726e39c7eb5d871d903b9bdcd06520a /src/compiler/GF/Infra
parent82f238fe2b418a715fef52abc7136551fa535aac (diff)
Preliminary new shell feature: cc -trace.
You can now do things like cc -trace mkV "debug" to see a trace of all opers with their arguments and results during the computation of mkV "debug".
Diffstat (limited to 'src/compiler/GF/Infra')
-rw-r--r--src/compiler/GF/Infra/Location.hs16
-rw-r--r--src/compiler/GF/Infra/Option.hs10
2 files changed, 18 insertions, 8 deletions
diff --git a/src/compiler/GF/Infra/Location.hs b/src/compiler/GF/Infra/Location.hs
index 36bfab044..0bf85b37f 100644
--- a/src/compiler/GF/Infra/Location.hs
+++ b/src/compiler/GF/Infra/Location.hs
@@ -25,10 +25,16 @@ noLoc = L NoLoc
ppLocation :: FilePath -> Location -> Doc
ppLocation fpath NoLoc = pp fpath
ppLocation fpath (External p l) = ppLocation p l
-ppLocation fpath (Local b e)
- | b == e = fpath <> ":" <> b
- | otherwise = fpath <> ":" <> b <> "-" <> e
+ppLocation fpath (Local b e) =
+ opt (fpath/="") (fpath <> ":") <> b <> opt (b/=e) ("-" <> e)
+ where
+ opt False x = empty
+ opt True x = x
+ppL (L loc x) msg = hang (loc<>":") 4 ("In"<+>x<>":"<+>msg)
+
+
+instance Pretty Location where pp = ppLocation ""
+
+instance Pretty a => Pretty (L a) where pp (L loc x) = loc<>":"<>x
-ppL (L loc x) msg = hang (ppLocation "" loc<>":") 4
- ("In"<+>x<>":"<+>msg)
diff --git a/src/compiler/GF/Infra/Option.hs b/src/compiler/GF/Infra/Option.hs
index a9a517a6e..48cb25cc7 100644
--- a/src/compiler/GF/Infra/Option.hs
+++ b/src/compiler/GF/Infra/Option.hs
@@ -178,7 +178,8 @@ data Flags = Flags {
optHeuristicFactor :: Maybe Double,
optCaseSensitive :: Bool,
optPlusAsBind :: Bool,
- optJobs :: Maybe (Maybe Int)
+ optJobs :: Maybe (Maybe Int),
+ optTrace :: Bool
}
deriving (Show)
@@ -289,7 +290,8 @@ defaultFlags = Flags {
optHeuristicFactor = Nothing,
optCaseSensitive = True,
optPlusAsBind = False,
- optJobs = Nothing
+ optJobs = Nothing,
+ optTrace = False
}
-- | Option descriptions
@@ -318,6 +320,8 @@ optDescr =
Option [] ["make"] (NoArg (liftM2 addOptions (mode ModeCompiler) (phase Link))) "Build .pgf file and other output files and exit.",
Option [] ["cpu"] (NoArg (cpu True)) "Show compilation CPU time statistics.",
Option [] ["no-cpu"] (NoArg (cpu False)) "Don't show compilation CPU time statistics (default).",
+-- Option ['t'] ["trace"] (NoArg (trace True)) "Trace computations",
+-- Option [] ["no-trace"] (NoArg (trace False)) "Don't trace computations",
Option [] ["gfo-dir"] (ReqArg gfoDir "DIR") "Directory to put .gfo files in (default = '.').",
Option ['f'] ["output-format"] (ReqArg outFmt "FMT")
(unlines ["Output format. FMT can be one of:",
@@ -383,7 +387,6 @@ optDescr =
dumpOption "refresh" Refresh,
dumpOption "opt" Optimize,
dumpOption "canon" Canon
-
]
where phase x = set $ \o -> o { optStopAfterPhase = x }
mode x = set $ \o -> o { optMode = x }
@@ -406,6 +409,7 @@ optDescr =
Just i -> set $ \o -> o { optVerbosity = i }
Nothing -> fail $ "Bad verbosity: " ++ show v
cpu x = set $ \o -> o { optShowCPUTime = x }
+-- trace x = set $ \o -> o { optTrace = x }
gfoDir x = set $ \o -> o { optGFODir = Just x }
outFmt x = readOutputFormat x >>= \f ->
set $ \o -> o { optOutputFormats = optOutputFormats o ++ [f] }