ghc-core-html 0.1.1 → 0.1.2

raw patch · 3 files changed

+30/−19 lines, 3 files

Files

• GhcCore/Parser.hs +28/−16
• ghc-core-html.cabal +1/−1
• ghc-core-html.hs +1/−2

@@ -1,5 +1,6 @@ -- | -- Parser for output of GHC core dump using @-ddump-simpl@.+ module GhcCore.Parser where  import Data.Maybe          (fromMaybe)@@ -10,8 +11,6 @@  import qualified Data.Map as M -- data Token =       Symbol String     | Number String@@ -65,11 +64,20 @@     ]  symbolBind :: Parser String-symbolBind = do-    h <- alphaNum-    r <- many symb-    return (h:r)+symbolBind = name <|> nameWithType   where+    name = do+        h <- alphaNum+        r <- many symb+        return (h:r)+    nameWithType = do+        _ <- char '('+        n <- name+        _ <- spaces+        _ <- string "::" *> spaces+        _type <- many1 $ noneOf ")"+        _ <- char ')'+        return n     symb = oneOf symChars     symChars = ['A'..'Z']++['a'..'z']++['0'..'9']++"_'" @@ -93,7 +101,7 @@     op s = fromMaybe (Unknown s) $ lookup s tokenTable  tokenify :: String -> [Token]-tokenify = either (error . show) id . runP (manyTill tok eof) () ""+tokenify = either (error . show) id . runCoreParser (manyTill tok eof) () ""   where     tok      = choice [spaceTok,stringTok,charTok,typeDef,sym,number,syntax,unknown] <?> "token"     spaceTok = Spaces <$> many1 (oneOf " \n\t")@@ -161,13 +169,17 @@ core :: Parser [Atom] core = many (try binding <|> junk)   where junk    = Junk <$> (anyChar >>= \c -> liftM (c :) (manyTill anyChar (eof <|> try eoBinding)))-        binding = do recursive <- option False (string "Rec" >> spaces >> string "{" >> spaces >> return True)-                     s <- try symbol-                     spaces-                     optional (manyTill anyChar (lookAhead (string "::")))-                     _ <- string "::" *> spaces-                     z <- manyTill anyChar (try (spaces >> eof) <|> try eoBinding)-                     case runP (parseBinding s recursive) () ("binding " ++ s) z of-                        Left err -> return $ RawBinding s z (show err)-                        Right b  -> return $ BindingP b+        binding = do+            recursive <- option False (string "Rec" >> spaces >> string "{" >> spaces >> return True)+            s <- try symbol+            spaces+            optional (manyTill anyChar (lookAhead (string "::")))+            _ <- string "::" *> spaces+            z <- manyTill anyChar (try (spaces >> eof) <|> try eoBinding)+            case runCoreParser (parseBinding s recursive) () ("binding " ++ s) z of+                Left err -> return $ RawBinding s z (show err)+                Right b  -> return $ BindingP b         eoBinding = string "\n\n" >> return ()++runCoreParser :: Parsec String u a -> u -> SourceName -> String -> Either ParseError a+runCoreParser = runParser

@@ -1,5 +1,5 @@ Name:                ghc-core-html-Version:             0.1.1+Version:             0.1.2 Synopsis:            Core to HTML display Description:         Display GHC core using a friendly colored, clickable and dynamic html output License:             BSD3

@@ -1,7 +1,6 @@ {-# LANGUAGE OverloadedStrings #-} module Main where -import Text.Parsec import Text.Parsec.String import System.Environment import System.Console.GetOpt@@ -61,7 +60,7 @@                 (x,out,err) <- readProcessWithExitCode ghcProgram (args ++ [f]) []                 case x of                     ExitFailure _ -> error ("dumping ghc core failed: " ++ err)-                    ExitSuccess   -> return $ runP core () "core" out+                    ExitSuccess   -> return $ runCoreParser core () "core" out     case result of         Left err -> print err         Right xs