Change String to Text types in AST and source

compiler/acton/test/syntaxerrors/err10.golden

@@ -1,12 +1,12 @@
 Building file test/syntaxerrors/err10.act using temporary scratch directory
 [error Parse error]: unexpected newline
-                     expecting ':', call arguments, slice/index expression, digit, if clause, or operator
+                     expecting ':', call arguments, slice/index expression, decimal digit, if clause, or operator
 
      +--> test/syntaxerrors/err10.act@3:13-3:14
      |
    3 |     if x > 0
      :             ^
      :             `- unexpected newline
-     :                expecting ':', call arguments, slice/index expression, digit, if clause, or operator
+     :                expecting ':', call arguments, slice/index expression, decimal digit, if clause, or operator
      :                
 -----+

compiler/acton/test/syntaxerrors/err15.golden

@@ -1,12 +1,12 @@
 Building file test/syntaxerrors/err15.act using temporary scratch directory
 [error Parse error]: unexpected '}'
-                     expecting call arguments, slice/index expression, closing ']', comma, digit, if clause, or operator
+                     expecting call arguments, slice/index expression, closing ']', comma, decimal digit, if clause, or operator
 
      +--> test/syntaxerrors/err15.act@4:17-4:18
      |
    4 |     return arr[0}
      :                 ^
      :                 `- unexpected '}'
-     :                    expecting call arguments, slice/index expression, closing ']', comma, digit, if clause, or operator
+     :                    expecting call arguments, slice/index expression, closing ']', comma, decimal digit, if clause, or operator
      :                    
 -----+

compiler/acton/test/syntaxerrors/err27.golden

@@ -1,12 +1,12 @@
 Building file test/syntaxerrors/err27.act using temporary scratch directory
 [error Parse error]: unexpected "ab"
-                     expecting ';', call arguments, slice/index expression, comma, digit, end of line, if clause, or operator
+                     expecting ';', call arguments, slice/index expression, comma, decimal digit, end of line, if clause, or operator
 
      +--> test/syntaxerrors/err27.act@3:15-3:16
      |
    3 |     return 123abc
      :               ^ 
      :               `- unexpected "ab"
-     :                  expecting ';', call arguments, slice/index expression, comma, digit, end of line, if clause, or operator
+     :                  expecting ';', call arguments, slice/index expression, comma, decimal digit, end of line, if clause, or operator
      :                  
 -----+

compiler/acton/test/syntaxerrors/err37.golden

@@ -1,12 +1,12 @@
 Building file test/syntaxerrors/err37.act using temporary scratch directory
 [error Parse error]: unexpected "b1"
-                     expecting ';', call arguments, slice/index expression, comma, digit, end of line, if clause, or operator
+                     expecting ';', call arguments, slice/index expression, comma, decimal digit, end of line, if clause, or operator
 
      +--> test/syntaxerrors/err37.act@3:13-3:14
      |
    3 |     return 0b102
      :             ^ 
      :             `- unexpected "b1"
-     :                expecting ';', call arguments, slice/index expression, comma, digit, end of line, if clause, or operator
+     :                expecting ';', call arguments, slice/index expression, comma, decimal digit, end of line, if clause, or operator
      :                
 -----+

compiler/acton/test/syntaxerrors/err38.golden

@@ -1,12 +1,12 @@
 Building file test/syntaxerrors/err38.act using temporary scratch directory
 [error Parse error]: unexpected 'G'
-                     expecting hexadecimal integer
+                     expecting hexadecimal digit
 
      +--> test/syntaxerrors/err38.act@3:14-3:15
      |
    3 |     return 0xGHI
      :              ^ 
      :              `- unexpected 'G'
-     :                 expecting hexadecimal integer
+     :                 expecting hexadecimal digit
      :                 
 -----+

compiler/acton/test_incremental.hs

@@ -1209,7 +1209,7 @@ p27_overlay_source_provider = testCase "27-overlay snapshots drive readModuleTas
   _ <- buildOutIn proj
   actAAbs <- canonicalizePath actA
   bytes <- B.readFile actAAbs
-  let text = T.unpack (TE.decodeUtf8 bytes)
+  let text = TE.decodeUtf8 bytes
       snapSame = Source.SourceSnapshot
         { Source.ssText = text
         , Source.ssBytes = bytes
@@ -1233,7 +1233,7 @@ p27_overlay_source_provider = testCase "27-overlay snapshots drive readModuleTas
     Compile.TyTask{} -> pure ()
     _ -> assertFailure "expected TyTask when overlay matches header"
   let textDiff = "\"\"\"Overlay doc\"\"\"\naaa = 2\n"
-      bytesDiff = TE.encodeUtf8 (T.pack textDiff)
+      bytesDiff = TE.encodeUtf8 textDiff
       snapDiff = Source.SourceSnapshot
         { Source.ssText = textDiff
         , Source.ssBytes = bytesDiff

compiler/lib/bench/KindsBench.hs

@@ -7,6 +7,7 @@ import qualified Acton.Syntax as Syntax
 import Control.DeepSeq (rnf)
 import qualified Control.Exception as E
 import qualified Data.HashMap.Strict as HashMap
+import qualified Data.Text.IO as TIO
 import Data.Time.Clock (diffUTCTime, getCurrentTime)
 import GHC.Stats
 import System.Environment (getArgs)
@@ -45,7 +46,7 @@ main = do
     case args of
       [typesPath, sourcePath] -> do
         statsEnabled <- getRTSStatsEnabled
-        src <- readFile sourcePath
+        src <- TIO.readFile sourcePath
         env0 <- Env.initEnv typesPath False
         let modName = Syntax.modName [takeBaseName sourcePath]
 

compiler/lib/bench/ParserHeapBench.hs

@@ -0,0 +1,174 @@
+{-# LANGUAGE BangPatterns, OverloadedStrings #-}
+
+module Main where
+
+import qualified Acton.Parser as Parser
+import qualified Acton.Syntax as A
+
+import Control.DeepSeq
+import Control.Exception
+import Control.Monad
+import qualified Data.ByteString as BS
+import Data.IORef
+import Data.Int
+import qualified Data.Text as T
+import Data.Text (Text)
+import qualified Data.Text.Encoding as TE
+import GHC.Stats
+import System.Clock
+import System.CPUTime
+import System.Environment
+import System.Exit
+import System.Mem
+import Text.Printf
+
+data Measurement = Measurement
+  { mLabel :: String
+  , mLiveBytes :: Integer
+  , mExtra :: String
+  }
+
+data Timing = Timing
+  { tWallNs :: Integer
+  , tCpuPs :: Integer
+  , tAllocated :: Integer
+  }
+
+main :: IO ()
+main = do
+  enabled <- getRTSStatsEnabled
+  unless enabled $ do
+    putStrLn "RTS stats are disabled; run with +RTS -T -RTS"
+    exitFailure
+  files <- getArgs
+  when (null files) $ do
+    putStrLn "usage: parser-heap-bench FILE.act [...]"
+    exitFailure
+  _ <- parseAst "<warm>" ""
+  performMajorGC
+  forM_ files measureFile
+
+measureFile :: FilePath -> IO ()
+measureFile file = do
+  diskBytes <- BS.length <$> BS.readFile file
+  putStrLn $ "file " ++ file ++ " bytes " ++ show diskBytes
+  (topStmts, timing) <- measureParseTiming file
+  printf "parse              wall %.3f s  cpu %.3f s  allocated %.3f MiB  %d top stmts\n"
+    (nsToSeconds (tWallNs timing))
+    (psToSeconds (tCpuPs timing))
+    (bytesToMiB (tAllocated timing))
+    topStmts
+  ms <- sequence
+    [ measureSource file
+    , measureAstOnly file
+    , measureAstAndSource file
+    ]
+  forM_ ms $ \m ->
+    printf "%-18s %12d bytes  %.3f MiB  %s\n"
+      (mLabel m)
+      (mLiveBytes m)
+      (bytesToMiB (mLiveBytes m))
+      (mExtra m)
+  putStrLn ""
+
+measureParseTiming :: FilePath -> IO (Int, Timing)
+measureParseTiming file = do
+  src <- readSource file
+  evaluate (rnf src)
+  performMajorGC
+  timed $ do
+    m <- parseAst file src
+    return (length (A.mbody m))
+
+measureSource :: FilePath -> IO Measurement
+measureSource file =
+  measured "source" $ do
+    src <- readSource file
+    evaluate (rnf src)
+    return (src, show (sourceLength src) ++ " chars")
+
+measureAstOnly :: FilePath -> IO Measurement
+measureAstOnly file =
+  measured "AST only" $ do
+    m <- parseFile file
+    return (m, show (length (A.mbody m)) ++ " top stmts")
+
+measureAstAndSource :: FilePath -> IO Measurement
+measureAstAndSource file =
+  measured "AST + source" $ do
+    src <- readSource file
+    evaluate (rnf src)
+    m <- parseAst file src
+    return ((m, src), show (length (A.mbody m)) ++ " top stmts")
+
+measured :: NFData a => String -> IO (a, String) -> IO Measurement
+measured label build = do
+  performMajorGC
+  base <- liveBytes
+  (x, extra) <- build
+  evaluate (rnf x)
+  ref <- newIORef (Just x)
+  performMajorGC
+  after <- liveBytes
+  keep <- readIORef ref
+  evaluate (case keep of
+              Just _ -> ()
+              Nothing -> ())
+  writeIORef ref Nothing
+  performMajorGC
+  return Measurement
+    { mLabel = label
+    , mLiveBytes = toInteger after - toInteger base
+    , mExtra = extra
+    }
+
+timed :: NFData a => IO a -> IO (a, Timing)
+timed action = do
+  stats0 <- getRTSStats
+  cpu0 <- getCPUTime
+  wall0 <- getTime Monotonic
+  x <- action
+  evaluate (rnf x)
+  wall1 <- getTime Monotonic
+  cpu1 <- getCPUTime
+  stats1 <- getRTSStats
+  return (x, Timing
+    { tWallNs = timeSpecNs (wall1 - wall0)
+    , tCpuPs = toInteger (cpu1 - cpu0)
+    , tAllocated = toInteger (allocated_bytes stats1 - allocated_bytes stats0)
+    })
+
+parseFile :: FilePath -> IO A.Module
+parseFile file = do
+  src <- readSource file
+  evaluate (rnf src)
+  parseAst file src
+
+parseAst :: FilePath -> Text -> IO A.Module
+parseAst file src = do
+  m <- Parser.parseModule (A.modName ["heap_probe"]) file src Nothing
+  evaluate (rnf m)
+  return m
+
+readSource :: FilePath -> IO Text
+readSource file = TE.decodeUtf8 <$> BS.readFile file
+
+sourceLength :: Text -> Int
+sourceLength = T.length
+
+liveBytes :: IO Int64
+liveBytes = do
+  stats <- getRTSStats
+  return (fromIntegral (gcdetails_live_bytes (gc stats)))
+
+timeSpecNs :: TimeSpec -> Integer
+timeSpecNs t = toInteger (sec t) * 1000000000 + toInteger (nsec t)
+
+nsToSeconds :: Integer -> Double
+nsToSeconds n = fromIntegral n / 1000000000
+
+psToSeconds :: Integer -> Double
+psToSeconds n = fromIntegral n / 1000000000000
+
+bytesToMiB :: Integer -> Double
+bytesToMiB n = fromIntegral n / (1024 * 1024)

compiler/lib/bench/TypesBench.hs

@@ -8,6 +8,7 @@ import qualified Acton.Types as Types
 import Control.DeepSeq (rnf)
 import qualified Control.Exception as E
 import qualified Data.HashMap.Strict as HashMap
+import qualified Data.Text.IO as TIO
 import Data.Time.Clock (diffUTCTime, getCurrentTime)
 import GHC.Stats
 import System.Environment (getArgs)
@@ -46,7 +47,7 @@ main = do
     case args of
       [typesPath, sourcePath] -> do
         statsEnabled <- getRTSStatsEnabled
-        src <- readFile sourcePath
+        src <- TIO.readFile sourcePath
         env0 <- Env.initEnv typesPath False
         let modName = Syntax.modName [takeBaseName sourcePath]
 

compiler/lib/package.yaml.in

@@ -105,16 +105,16 @@ tests:
       - -with-rtsopts=-N
 
 executables:
-  kinds-bench:
-    main: KindsBench.hs
+  parser-heap-bench:
+    main: ParserHeapBench.hs
     source-dirs: bench
     other-modules: []
     dependencies:
       - libacton
     ghc-options:
       - -threaded
       - -rtsopts
-      - '"-with-rtsopts=-N -A64M"'
+      - -with-rtsopts=-T
   types-bench:
     main: TypesBench.hs
     source-dirs: bench
@@ -125,3 +125,13 @@ executables:
       - -threaded
       - -rtsopts
       - '"-with-rtsopts=-N -A64M"'
+  kinds-bench:
+    main: KindsBench.hs
+    source-dirs: bench
+    other-modules: []
+    dependencies:
+      - libacton
+    ghc-options:
+      - -threaded
+      - -rtsopts
+      - '"-with-rtsopts=-N -A64M"'

compiler/lib/src/Acton/Boxing.hs

@@ -14,6 +14,7 @@ import Utils
 import Debug.Trace
 import Control.Monad.State.Strict
 import Control.Monad.Except
+import Data.Text (Text)
 
 doBoxing                           :: Acton.Env.Env0 -> Module -> IO Module
 doBoxing env m                     = do return m{mbody = ss}
@@ -23,12 +24,12 @@ doBoxing env m                     = do return m{mbody = ss}
 
 type BoxM a                        = State Int a
 
-newName                            :: String -> BoxM Name
+newName                            :: Text -> BoxM Name
 newName s                          = do n <- get
                                         put (n+1)
                                         return $ Internal BoxPass s n
 
-newNames (n : ns)                  = do un <- newName (nstr n)
+newNames (n : ns)                  = do un <- newName (ntext n)
                                         ps <- newNames ns
                                         return ((n,un) : ps)
 newNames []                        = return []
@@ -108,7 +109,7 @@ instance {-# OVERLAPS #-} Boxing ([Stmt]) where
     boxing env (x@(Assign l [p@(PVar _ n (Just t))] e) : xs)
        | isUnboxable t               = do case lookup n (unboxedVars env) of
                                               Nothing -> do (ws1, e') <- boxing env e
-                                                            un <- newName  (nstr n)
+                                                            un <- newName  (ntext n)
                                                             let env1 = define (envOf x) (addUnboxedVars [(n,un)] env)
                                                             (ws2,p') <- boxing env1 p
                                                             (ws3,xs') <- boxing env1 xs