Add Bench.SumSquare1.

Makefile

@@ -194,6 +194,9 @@ bench3: tests/Bench/Tak.lcbc  $(PRIM_MODULES)
 bench4: tests/Bench/Primes.lcbc $(PRIM_MODULES)
 	./interp Bench.Primes
 
+bench5: tests/Bench/SumSquare1.lcbc $(PRIM_MODULES)
+	./interp Bench.SumSquare1
+
 pr:
 	@echo $(PRIM_MODULES)
 

compiler/Lambdachine/Ghc/Pipeline.hs

@@ -30,7 +30,7 @@ compileToCore file = do
   case find ((== file) . msHsFilePath) mod_graph of
     Just mod_summary -> 
       withTempSession (\env ->
-                         env{ hsc_dflags = updOptLevel 1 $ ms_hspp_opts mod_summary }) $
+                         env{ hsc_dflags = updOptLevel 0 $ ms_hspp_opts mod_summary }) $
         hscParse mod_summary >>=
           hscTypecheck mod_summary >>=
             hscDesugar mod_summary >>=

tests/Bench/SumSquare1.hs

@@ -0,0 +1,28 @@
+{-# LANGUAGE NoImplicitPrelude, BangPatterns, MagicHash #-}
+module Bench.SumSquare1 where
+
+import GHC.Prim
+import GHC.List
+import GHC.Base
+import GHC.Num
+
+enumFromTo'Int :: Int -> Int -> [Int]
+enumFromTo'Int from@(I# m) to@(I# n) =
+  if m ># n then [] else
+    from : enumFromTo'Int (I# (m +# 1#)) to
+
+sum :: [Int] -> Int
+sum l = sum_aux (I# 0#) l
+
+{-# NOINLINE sum_aux #-}
+sum_aux :: Int -> [Int] -> Int
+sum_aux !acc [] = acc
+sum_aux !(I# a) (I# x:xs) = sum_aux (I# (a +# x)) xs
+
+{-# NOINLINE root #-}
+root :: Int -> Int
+root x = sum [ I# (a# *# b#) 
+             | a@(I# a#) <- enumFromTo'Int 1 x
+             , I# b# <- enumFromTo'Int a x ] 
+
+test = root 100 == 12920425

tests/base/GHC/Base.hs

@@ -1,4 +1,4 @@
-{-# LANGUAGE MagicHash, NoImplicitPrelude #-}
+{-# LANGUAGE MagicHash, NoImplicitPrelude, Rank2Types #-}
 module GHC.Base
   ( module GHC.Base
   , module GHC.Bool
@@ -129,3 +129,12 @@ otherwise               =  True
 map :: (a -> b) -> [a] -> [b]
 map _ []     = []
 map f (x:xs) = f x : map f xs
+
+foldr :: (a -> b -> b) -> b -> [a] -> b
+foldr k z = go
+  where
+    go []     = z
+    go (y:ys) = y `k` go ys
+
+build :: (forall b. (a -> b -> b) -> b -> b) -> [a]
+build g = g (:) []