Merge pull request #168 from haskell-jp/strict-gotchas

Strict拡張を使用する際の注意点

Author: igrep

.gitignore

@@ -5,6 +5,7 @@ cabal-dev
 *.chi
 *.chs.h
 .virtualenv
+*.exe
 .hsenv
 .cabal-sandbox/
 cabal.sandbox.config
@@ -16,3 +17,5 @@ cabal.config
 
 # stack
 .stack-work/
+
+*~

examples/2020/strict-gotchas/README.md

@@ -0,0 +1,8 @@
+# haskell-jp-blog-example-strict-gotchas
+
+[こちらのIssue](https://github.com/haskell-jp/blog/issues/167)について、せっかく盛り上がってきたので少しでも進めようと、まずはサンプルを書いてみることにしました。
+
+## 注記
+
+- 記事の内容と大きく連動しそうなので、敢えて同じリポジトリーに上げています。
+- 各 `*.hs ` ファイルを `runghc --ghc-arg=-XStrict` で実行した場合と `--ghc-arg=-XStrict` なしで実行した場合とで比較することで、挙動の違いを体験できるように作っています。

examples/2020/strict-gotchas/const.hs

@@ -0,0 +1,10 @@
+dontReferArgs :: a -> b -> a
+dontReferArgs = const
+
+referArgs :: a -> b -> a
+referArgs x _ = x
+
+main :: IO ()
+main = do
+  print $ dontReferArgs "dontReferArgs" (undefined :: Int)
+  print $ referArgs "referArgs" (undefined :: Int)

examples/2020/strict-gotchas/stack.yaml

@@ -0,0 +1,65 @@
+# This file was automatically generated by 'stack init'
+#
+# Some commonly used options have been documented as comments in this file.
+# For advanced use and comprehensive documentation of the format, please see:
+# https://docs.haskellstack.org/en/stable/yaml_configuration/
+
+# Resolver to choose a 'specific' stackage snapshot or a compiler version.
+# A snapshot resolver dictates the compiler version and the set of packages
+# to be used for project dependencies. For example:
+#
+# resolver: lts-3.5
+# resolver: nightly-2015-09-21
+# resolver: ghc-7.10.2
+#
+# The location of a snapshot can be provided as a file or url. Stack assumes
+# a snapshot provided as a file might change, whereas a url resource does not.
+#
+# resolver: ./custom-snapshot.yaml
+# resolver: https://example.com/snapshots/2018-01-01.yaml
+resolver: ghc-8.10.1
+
+# User packages to be built.
+# Various formats can be used as shown in the example below.
+#
+# packages:
+# - some-directory
+# - https://example.com/foo/bar/baz-0.0.2.tar.gz
+#   subdirs:
+#   - auto-update
+#   - wai
+packages: []
+# Dependency packages to be pulled from upstream that are not in the resolver.
+# These entries can reference officially published versions as well as
+# forks / in-progress versions pinned to a git hash. For example:
+#
+# extra-deps:
+# - acme-missiles-0.3
+# - git: https://github.com/commercialhaskell/stack.git
+#   commit: e7b331f14bcffb8367cd58fbfc8b40ec7642100a
+#
+# extra-deps: []
+
+# Override default flag values for local packages and extra-deps
+# flags: {}
+
+# Extra package databases containing global packages
+# extra-package-dbs: []
+
+# Control whether we use the GHC we find on the path
+# system-ghc: true
+#
+# Require a specific version of stack, using version ranges
+# require-stack-version: -any # Default
+# require-stack-version: ">=2.1"
+#
+# Override the architecture used by stack, especially useful on Windows
+# arch: i386
+# arch: x86_64
+#
+# Extra directories used by stack for building
+# extra-include-dirs: [/path/to/dir]
+# extra-lib-dirs: [/path/to/dir]
+#
+# Allow a newer minor version of GHC than the snapshot specifies
+# compiler-check: newer-minor

examples/2020/strict-gotchas/stack.yaml.lock

@@ -0,0 +1,7 @@
+# This file was autogenerated by Stack.
+# You should not edit this file by hand.
+# For more information, please see the documentation at:
+#   https://docs.haskellstack.org/en/stable/lock_files
+
+packages: []
+snapshots: []

examples/2020/strict-gotchas/stackoverflow-foldr.hs

@@ -0,0 +1,17 @@
+{-
+  GHCRTS=-K100k stack exec runghc -- ./stackoverflow-foldr.hs
+  GHCRTS=-K100k stack exec runghc -- --ghc-arg=-XStrict ./stackoverflow-foldr.hs
+-}
+
+import Control.Exception
+import Data.List
+
+main :: IO ()
+main = do
+  let size = 5000
+
+  evaluate . length $ foldr (:) [] [1 .. size]
+  putStrLn "DONE: foldr 1"
+
+  evaluate . length $ foldr (\x z -> x : z) [] [1 .. size]
+  putStrLn "DONE: foldr 2"

examples/2020/strict-gotchas/storable.hs

@@ -0,0 +1,16 @@
+{-# LANGUAGE ScopedTypeVariables #-}
+
+import Foreign.Marshal.Alloc
+import Foreign.Ptr
+import Foreign.Storable
+
+data Test = Test Int Int deriving Show
+
+instance Storable Test where
+  sizeOf _ = sizeOf (1 :: Int) * 2
+  alignment _ = 8
+  peek = error "This should not be called in this program"
+  poke = error "This should not be called in this program"
+
+main :: IO ()
+main = alloca $ \(_ :: Ptr Test) -> putStrLn "This won't be printed when Strict is enabled"

examples/2020/strict-gotchas/where.hs

@@ -0,0 +1,18 @@
+-- Originally created by @pxfnc
+-- https://qiita.com/pxfnc/items/a26bda6d11402daba675
+
+-- Compare
+--    runghc where.hs
+-- And
+--    runghc --ghc-arg=-XStrict where.hs
+
+
+main :: IO ()
+main = print $ div10 0
+
+div10 :: Int -> Int
+div10 n
+  | n == 0    = 0
+  | otherwise = result
+ where
+  result = 10 `div` n