Permalink
Browse files

Add an experimental Data.Text based 'pretty printer'.

This has dramatically superior performance during compilation, but obviously
doesn't wrap lines and isn't com posable in the same way. However, the
benefits probably outweigh the costs.
  • Loading branch information...
1 parent 1e6fe1d commit ac59a6eee1ab61efe332d02dd2d57326bbefced7 @tomgr committed Apr 22, 2012
Showing with 71 additions and 3 deletions.
  1. +4 −2 libcspm.cabal
  2. +19 −1 src/CSPM/Evaluator/Values.hs
  3. +48 −0 src/Util/TextPrettyPrint.hs
View
@@ -111,13 +111,15 @@ Library
Util.Monad,
Util.PartialFunctions,
Util.Prelude,
- Util.PrettyPrint
+ Util.PrettyPrint,
+ Util.TextPrettyPrint
Other-Modules:
Paths_libcspm
GHC-Options: -O3
-
+ GHC-Prof-Options: -auto-all -prof
+
Hs-Source-Dirs: src
Extensions: DoAndIfThenElse
@@ -1,3 +1,4 @@
+{-# LANGUAGE OverloadedStrings #-}
module CSPM.Evaluator.Values (
Value(..), UProc, Proc(..), CSPOperator(..), ProcOperator(..), Event(..),
compareValues,
@@ -24,6 +25,7 @@ import Util.Exception
import Util.List
import Util.Prelude
import Util.PrettyPrint
+import qualified Util.TextPrettyPrint as T
type UProc = UnCompiledProc
@@ -243,9 +245,25 @@ procId n vss pn = ProcName n vss pn
annonymousProcId :: [[Value]] -> Maybe ProcName -> ProcName
annonymousProcId vss pn = AnnonymousProcName vss pn
+instance T.FastPrettyPrintable Name where
+ toBuilder (Name { nameOccurrence = OccName s }) = T.text s
+instance T.FastPrettyPrintable Value where
+ toBuilder (VInt i) = T.integral i
+ toBuilder (VBool b) = if b then T.stext "true" else T.stext "false"
+ toBuilder (VTuple vs) = T.parens (T.list (map T.toBuilder vs))
+ toBuilder (VDot vs) = T.punctuate T.dot (map T.toBuilder vs)
+ toBuilder (VChannel n) = T.toBuilder n
+ toBuilder (VDataType n) = T.toBuilder n
+ toBuilder (VList vs) = T.angles (T.list (map T.toBuilder vs))
+ toBuilder (VSet vs) = T.text (show (prettyPrint vs))
+ toBuilder (VFunction _) = T.stext "<function>"
+ toBuilder (VProc (PProcCall pn _)) = T.text (show (prettyPrint pn))
+ toBuilder (VProc p) = T.text (show (prettyPrint p))
+ toBuilder (VThunk th) = T.stext "<thunk>"
+
-- | This assumes that the value is a VDot with the left is a VChannel
valueEventToEvent :: Value -> Event
-valueEventToEvent v = newUserEvent (show (prettyPrint v))
+valueEventToEvent v = UserEvent $ T.toText v
-- | Returns an x such that ev.x has been extended by exactly one atomic field.
-- This could be inside a subfield or elsewhere.
@@ -0,0 +1,48 @@
+module Util.TextPrettyPrint where
+
+import Data.Monoid
+import qualified Data.Text as ST
+import qualified Data.Text.Lazy as T hiding (singleton)
+import qualified Data.Text.Lazy.Builder as T
+import qualified Data.Text.Lazy.Builder.Int as T
+
+text :: String -> T.Builder
+text = T.fromString
+
+stext :: ST.Text -> T.Builder
+stext = T.fromText
+
+ltext :: T.Text -> T.Builder
+ltext = T.fromLazyText
+
+integral :: Integral a => a -> T.Builder
+integral a = T.decimal a
+
+comma, dot :: T.Builder
+comma = T.singleton ','
+dot = T.singleton '.'
+
+wrap :: T.Builder -> T.Builder -> T.Builder -> T.Builder
+wrap l t r = l `mappend` t `mappend` r
+
+angles, braces, parens :: T.Builder -> T.Builder
+parens b = wrap (T.singleton '(') b (T.singleton ')')
+angles b = wrap (T.singleton '<') b (T.singleton '>')
+braces b = wrap (T.singleton '{') b (T.singleton '}')
+
+punctuate :: T.Builder -> [T.Builder] -> T.Builder
+punctuate p [] = mempty
+punctuate p [x] = x
+punctuate p (x:xs) = x `mappend` p `mappend` punctuate p xs
+
+list :: [T.Builder] -> T.Builder
+list = punctuate comma
+
+class FastPrettyPrintable a where
+ toText :: a -> ST.Text
+ toText a = T.toStrict (toLazyText a)
+
+ toLazyText :: a -> T.Text
+ toLazyText a = T.toLazyText (toBuilder a)
+
+ toBuilder :: a -> T.Builder

0 comments on commit ac59a6e

Please sign in to comment.