[add test case calender and primes from nofib suite
John Meacham <john@repetae.net>**20060126010750] hunk ./Makefile 64
+tests: calendar primes
+
+calendar: jhc
+	./jhc -v $(JHC_TEST) test/Calendar.hs -o $@ 2>&1 | tee $@.log
+primes: jhc
+	./jhc -v $(JHC_TEST) test/Primes.hs -o $@ 2>&1 | tee $@.log
addfile ./test/Calendar.hs
hunk ./test/Calendar.hs 1
+-- This is a modification of the calendar program described in section 4.5
+-- of Bird and Wadler's ``Introduction to functional programming'', with
+-- two ways of printing the calendar ... as in B+W, or like UNIX `cal':
+
+import IO -- 1.3
+import System -- 1.3
+import List -- 1.3
+import Char -- 1.3
+
+
+-- Picture handling:
+
+infixr 5 `above`, `beside`
+
+type Picture   =  [[Char]]
+
+height, width :: Picture -> Int
+height p       = length p
+width  p       = length (head p)
+
+above, beside :: Picture -> Picture -> Picture
+above          = (++)
+beside         = zipWith (++)
+
+stack, spread :: [Picture] -> Picture
+stack          = foldr1 above
+spread         = foldr1 beside
+
+empty         :: (Int,Int) -> Picture
+empty (h,w)    = copy h (copy w ' ')
+
+block, blockT :: Int -> [Picture] -> Picture
+block n        = stack . map spread . groop n
+blockT n       = spread . map stack . groop n
+
+groop         :: Int -> [a] -> [[a]]
+groop n []     = []
+groop n xs     = take n xs : groop n (drop n xs)
+
+lframe        :: (Int,Int) -> Picture -> Picture
+lframe (m,n) p = (p `beside` empty (h,n-w)) `above` empty (m-h,n)
+		 where h = height p
+                       w = width p
+
+-- Information about the months in a year:
+
+monthLengths year = [31,feb,31,30,31,30,31,31,30,31,30,31]
+                    where feb | leap year = 29
+                              | otherwise = 28
+
+leap year         = if year`mod`100 == 0 then year`mod`400 == 0
+                                         else year`mod`4   == 0
+
+monthNames        = ["January","February","March","April",
+		     "May","June","July","August",
+		     "September","October","November","December"]
+
+jan1st year       = (year + last`div`4 - last`div`100 + last`div`400) `mod` 7
+                    where last = year - 1
+
+firstDays year    = take 12
+                         (map (`mod`7)
+                              (scanl (+) (jan1st year) (monthLengths year)))
+
+-- Producing the information necessary for one month:
+
+dates fd ml = map (date ml) [1-fd..42-fd]
+              where date ml d | d<1 || ml<d  = ["   "]
+                              | otherwise    = [rjustify 3 (show d)]
+
+-- The original B+W calendar:
+
+calendar :: Int -> String
+calendar  = unlines . block 3 . map picture . months
+            where picture (mn,yr,fd,ml)  = title mn yr `above` table fd ml
+                  title mn yr    = lframe (2,25) [mn ++ " " ++ show yr]
+                  table fd ml    = lframe (8,25)
+                                          (daynames `beside` entries fd ml)
+                  daynames       = ["Sun","Mon","Tue","Wed","Thu","Fri","Sat"]
+                  entries fd ml  = blockT 7 (dates fd ml)
+                  months year    = zip4 monthNames
+                                        (copy 12 year)
+                                        (firstDays year)
+                                        (monthLengths year)
+
+-- In a format somewhat closer to UNIX cal:
+
+cal year = unlines (banner year `above` body year)
+           where banner yr      = [cjustify 75 (show yr)] `above` empty (1,75)
+                 body           = block 3 . map (pad . pic) . months
+                 pic (mn,fd,ml) = title mn `above` table fd ml
+                 pad p          = (side`beside`p`beside`side)`above`end
+                 side           = empty (8,2)
+                 end            = empty (1,25)
+                 title mn       = [cjustify 21 mn]
+                 table fd ml    = daynames `above` entries fd ml
+                 daynames       = [" Su Mo Tu We Th Fr Sa"]
+                 entries fd ml  = block 7 (dates fd ml)
+                 months year    = zip3 monthNames
+                                       (firstDays year)
+                                       (monthLengths year)
+
+-- For a standalone calendar program:
+
+main = do
+    strs <- getArgs
+    case strs of [year] -> calFor year
+                 _      -> fail ("Usage: cal year\n")
+
+
+calFor year | illFormed = fail ("Bad argument")
+            | otherwise = putStr (cal yr)
+              where illFormed = null ds || not (null rs)
+                    (ds,rs)   = span isDigit year
+                    yr        = atoi ds
+                    atoi s    = foldl (\a d -> 10*a+d) 0 (map toDigit s)
+                    toDigit d = fromEnum d - fromEnum '0'
+
+
+-- End of calendar program
+
+-- tacked on by partain
+copy    :: Int -> a -> [a]
+copy n x = take n (repeat x)
+
+cjustify, ljustify, rjustify :: Int -> String -> String
+
+cjustify n s = space halfm ++ s ++ space (m - halfm)
+               where m     = n - length s
+                     halfm = m `div` 2
+ljustify n s = s ++ space (n - length s)
+rjustify n s = space (n - length s) ++ s
+
+space       :: Int -> String
+space n      = copy n ' '
+-- end of tack
addfile ./test/Primes.hs
hunk ./test/Primes.hs 1
+
+import System
+
+suCC :: Int -> Int
+suCC x = x + 1
+
+isdivs :: Int  -> Int -> Bool
+isdivs n x = mod x n /= 0
+
+the_filter :: [Int] -> [Int]
+the_filter (n:ns) = filter (isdivs n) ns
+
+primes :: [Int]
+primes = map head (iterate the_filter (iterate suCC 2))
+
+main = do
+	[arg] <- getArgs
+	print $ primes !! (read arg)