Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
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...
commit ac59a6eee1ab61efe332d02dd2d57326bbefced7 1 parent 1e6fe1d
Thomas Gibson-Robinson authored
6 libcspm.cabal
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
20 src/CSPM/Evaluator/Values.hs
View
@@ -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.
48 src/Util/TextPrettyPrint.hs
View
@@ -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
Please sign in to comment.
Something went wrong with that request. Please try again.