jhcコンパイルパイプラインの内どれぐらいが型推論にかかってるか調べたよ

doc.markdown

1回目

2013-02-27 12:26:53.10771 UTC 2013-02-27 12:26:53.190323 UTC 2013-02-27 12:26:53.258174 UTC 2013-02-27 12:26:54.958025 UTC

全体: 1.850 型推論: 0.06785 (= 3.67%)

2回目

2013-02-27 12:26:54.988056 UTC 2013-02-27 12:26:55.064315 UTC 2013-02-27 12:26:55.14388 UTC 2013-02-27 12:26:56.912577 UTC

全体: 1.925 型推論: 0.07957 (= 4.13%)

3回目

2013-02-27 12:26:56.942465 UTC 2013-02-27 12:26:57.020611 UTC 2013-02-27 12:26:57.09379 UTC 2013-02-27 12:26:58.832228 UTC

全体: 1.890 型推論: 0.07318 (= 3.87%)

平均

コンパイルパイプラインの4%が型推論に費やされている。

jhc.diff

diff --git a/Makefile.am b/Makefile.am
index cea3fae..5e91f77 100644
--- a/Makefile.am
+++ b/Makefile.am
@@ -50,7 +50,7 @@ GHCINC=  -i @GHCINC@ -i$(srcdir)/drift_processed \
 PACKAGES= -hide-all-packages -package base -package fgl -package regex-compat -package random -package array -package directory \
           -package bytestring -package binary -package mtl -package containers \
 	  -package unix -package utf8-string -package zlib -package HsSyck \
-	  -package filepath -package process
+	  -package filepath -package process -package time
 
 GHCLANG= -XTypeFamilies -XViewPatterns -XUndecidableInstances -XOverlappingInstances \
 	-XRecordWildCards -XRecursiveDo -XTupleSections -XParallelListComp \
diff --git a/src/Grin/Main.hs b/src/Grin/Main.hs
index 55cb741..a202553 100644
--- a/src/Grin/Main.hs
+++ b/src/Grin/Main.hs
@@ -34,6 +34,7 @@ import Util.Gen
 import qualified C.FromGrin2 as FG2
 import qualified FlagDump as FD
 import qualified Stats
+import Data.Time
 
 {-# NOINLINE compileToGrin #-}
 compileToGrin prog = do
@@ -132,6 +133,7 @@ compileGrinToC grin = do
     LBS.writeFile cf $ LBS.intercalate (LBS.fromString "\n") [
         globalvar "jhc_c_compile" comm, globalvar "jhc_command" argstring,
         globalvar "jhc_version" sversion,LBS.empty,cg]
+    getCurrentTime >>= print
     when (optStop options == StopC) $
         exitSuccess
     putProgressLn ("Running: " ++ comm)
diff --git a/src/Ho/Build.hs b/src/Ho/Build.hs
index 8a08607..45b2202 100644
--- a/src/Ho/Build.hs
+++ b/src/Ho/Build.hs
@@ -66,6 +66,7 @@ import qualified FlagDump as FD
 import qualified FlagOpts as FO
 import qualified Support.MD5 as MD5
 import qualified Util.Graph as G
+import Data.Time
 
 -- Ho File Format
 --
@@ -402,7 +403,9 @@ parseFiles options targets elibs need ifunc func = do
     when (optStop options == StopParse) exitSuccess
     performGC
     putProgressLn "Typechecking..."
+    getCurrentTime >>= print
     typeCheckGraph options cnode
+    getCurrentTime >>= print
     if isJust (optAnnotate options) then exitSuccess else do
     when (optStop options  == StopTypeCheck) exitSuccess
     performGC
diff --git a/src/Main.hs b/src/Main.hs
index 7d892f4..9135ceb 100644
--- a/src/Main.hs
+++ b/src/Main.hs
@@ -29,8 +29,12 @@ import Util.SetLike as S
 import Version.Version(versionSimple)
 import qualified FlagDump as FD
 import qualified Interactive
+import Data.Time
 
-main = wrapMain $ do
+main = do getCurrentTime >>= print
+          go
+  where
+    go = wrapMain $ do
     hSetEncoding stdout utf8
     hSetEncoding stderr utf8
     o <- processOptions

Main.hs

import Data.Word
import Data.Bits
import Control.Monad
import Foreign.Ptr
import Foreign.Storable

foreign import ccall "c_extern.h Delay" c_delay :: Word32 -> IO ()

gpioPin8, gpioPin9, gpioPin10, gpioPin11, gpioPin12, gpioPin13, gpioPin14, gpioPin15, led3, led4, led5, led6, led7, led8, led9, led10 :: Word16
gpioPin8  = 0x0100
gpioPin9  = 0x0200
gpioPin10 = 0x0400
gpioPin11 = 0x0800
gpioPin12 = 0x1000
gpioPin13 = 0x2000
gpioPin14 = 0x4000
gpioPin15 = 0x8000
led3  = gpioPin9
led4  = gpioPin8
led5  = gpioPin10
led6  = gpioPin15
led7  = gpioPin11
led8  = gpioPin14
led9  = gpioPin12
led10 = gpioPin13

brrPtr :: Ptr Word16
brrPtr = nullPtr `plusPtr` 0x48001028

bsrrPtr :: Ptr Word16
bsrrPtr = nullPtr `plusPtr` 0x48001018

ledOff :: Word16 -> IO ()
ledOff n = do
  poke brrPtr n

ledOn :: Word16 -> IO ()
ledOn n = do
  poke bsrrPtr n

main :: IO ()
main = forever $ do
  mapM_ (\a -> a led9) pat
  where pat = take 10 $ cycle [ledOn, const $ c_delay 50, ledOff, const $ c_delay 50]

runjhc.txt

$ for i in 1 2 3; do
jhc -fffi -C -o hs_main.c hs_src/Main.hs --ignore-cache; done >& 20130227_jhc_time_typecheck.log
$ cat 20130227_jhc_time_typecheck.log
2013-02-27 12:26:53.10771 UTC
jhc -fffi -C -o hs_main.c hs_src/Main.hs --ignore-cache
jhc 0.8.1 (-0)
Finding Dependencies...
Using Ho Cache: '/home/kiwamu/.jhc/cache'
Main                    [hs_src/Main.hs]
Typechecking...
2013-02-27 12:26:53.190323 UTC
[1 of 1] Main             (.............................................)
2013-02-27 12:26:53.258174 UTC
Compiling...
[1 of 1] Main             <..................................................>
Collected Compilation...
-- TypeAnalyzeMethods
-- BoxifyProgram
-- Boxy WorkWrap
-- LambdaLift
Converting to Grin...
Updatable CAFS: 0
Constant CAFS:  4
Recursive CAFS: 0
WARNING: Wrapper still exists at grin transformation time: Main.ledOn::Jhc.Type.Word.Word16::* -> Jhc.Prim.IO.IO Jhc.Prim.Prim.()::*::*
WARNING: Wrapper still exists at grin transformation time: theMain$3::Jhc.Type.Word.Word16::* -> Jhc.Prim.IO.IO Jhc.Prim.Prim.()::*::*
WARNING: Wrapper still exists at grin transformation time: Main.ledOff::Jhc.Type.Word.Word16::* -> Jhc.Prim.IO.IO Jhc.Prim.Prim.()::*::*
WARNING: Wrapper still exists at grin transformation time: theMain$2::Jhc.Type.Word.Word16::* -> Jhc.Prim.IO.IO Jhc.Prim.Prim.()::*::*
-- Speculative Execution Optimization
-- Node Usage Analysis
-- Grin Devolution
Writing "hs_main.c"
2013-02-27 12:26:54.958025 UTC
2013-02-27 12:26:54.988056 UTC
jhc -fffi -C -o hs_main.c hs_src/Main.hs --ignore-cache
jhc 0.8.1 (-0)
Finding Dependencies...
Using Ho Cache: '/home/kiwamu/.jhc/cache'
Main                    [hs_src/Main.hs]
Typechecking...
2013-02-27 12:26:55.064315 UTC
[1 of 1] Main             (.............................................)
2013-02-27 12:26:55.14388 UTC
Compiling...
[1 of 1] Main             <..................................................>
Collected Compilation...
-- TypeAnalyzeMethods
-- BoxifyProgram
-- Boxy WorkWrap
-- LambdaLift
Converting to Grin...
Updatable CAFS: 0
Constant CAFS:  4
Recursive CAFS: 0
WARNING: Wrapper still exists at grin transformation time: Main.ledOn::Jhc.Type.Word.Word16::* -> Jhc.Prim.IO.IO Jhc.Prim.Prim.()::*::*
WARNING: Wrapper still exists at grin transformation time: theMain$3::Jhc.Type.Word.Word16::* -> Jhc.Prim.IO.IO Jhc.Prim.Prim.()::*::*
WARNING: Wrapper still exists at grin transformation time: Main.ledOff::Jhc.Type.Word.Word16::* -> Jhc.Prim.IO.IO Jhc.Prim.Prim.()::*::*
WARNING: Wrapper still exists at grin transformation time: theMain$2::Jhc.Type.Word.Word16::* -> Jhc.Prim.IO.IO Jhc.Prim.Prim.()::*::*
-- Speculative Execution Optimization
-- Node Usage Analysis
-- Grin Devolution
Writing "hs_main.c"
2013-02-27 12:26:56.912577 UTC
2013-02-27 12:26:56.942465 UTC
jhc -fffi -C -o hs_main.c hs_src/Main.hs --ignore-cache
jhc 0.8.1 (-0)
Finding Dependencies...
Using Ho Cache: '/home/kiwamu/.jhc/cache'
Main                    [hs_src/Main.hs]
Typechecking...
2013-02-27 12:26:57.020611 UTC
[1 of 1] Main             (.............................................)
2013-02-27 12:26:57.09379 UTC
Compiling...
[1 of 1] Main             <..................................................>
Collected Compilation...
-- TypeAnalyzeMethods
-- BoxifyProgram
-- Boxy WorkWrap
-- LambdaLift
Converting to Grin...
Updatable CAFS: 0
Constant CAFS:  4
Recursive CAFS: 0
WARNING: Wrapper still exists at grin transformation time: Main.ledOn::Jhc.Type.Word.Word16::* -> Jhc.Prim.IO.IO Jhc.Prim.Prim.()::*::*
WARNING: Wrapper still exists at grin transformation time: theMain$3::Jhc.Type.Word.Word16::* -> Jhc.Prim.IO.IO Jhc.Prim.Prim.()::*::*
WARNING: Wrapper still exists at grin transformation time: Main.ledOff::Jhc.Type.Word.Word16::* -> Jhc.Prim.IO.IO Jhc.Prim.Prim.()::*::*
WARNING: Wrapper still exists at grin transformation time: theMain$2::Jhc.Type.Word.Word16::* -> Jhc.Prim.IO.IO Jhc.Prim.Prim.()::*::*
-- Speculative Execution Optimization
-- Node Usage Analysis
-- Grin Devolution
Writing "hs_main.c"
2013-02-27 12:26:58.832228 UTC