[project @ 1997-07-27 00:43:10 by sof]
authorsof <unknown>
Sun, 27 Jul 1997 00:45:50 +0000 (00:45 +0000)
committersof <unknown>
Sun, 27 Jul 1997 00:45:50 +0000 (00:45 +0000)
144 files changed:
ghc/tests/programs/10queens/10queens.stdout [new file with mode: 0644]
ghc/tests/programs/10queens/Main.hs [new file with mode: 0644]
ghc/tests/programs/10queens/Makefile [new file with mode: 0644]
ghc/tests/programs/Makefile [new file with mode: 0644]
ghc/tests/programs/andre_monad/Main.hs [new file with mode: 0644]
ghc/tests/programs/andre_monad/Makefile [new file with mode: 0644]
ghc/tests/programs/andre_monad/andre_monad.stdout [new file with mode: 0644]
ghc/tests/programs/andy_cherry/DataTypes.lhs [new file with mode: 0644]
ghc/tests/programs/andy_cherry/GenUtils.lhs [new file with mode: 0644]
ghc/tests/programs/andy_cherry/Interp.lhs [new file with mode: 0644]
ghc/tests/programs/andy_cherry/InterpUtils.lhs [new file with mode: 0644]
ghc/tests/programs/andy_cherry/Main.lhs [new file with mode: 0644]
ghc/tests/programs/andy_cherry/Makefile [new file with mode: 0644]
ghc/tests/programs/andy_cherry/Parser.lhs [new file with mode: 0644]
ghc/tests/programs/andy_cherry/PrintTEX.lhs [new file with mode: 0644]
ghc/tests/programs/andy_cherry/andy_cherry.stdout [new file with mode: 0644]
ghc/tests/programs/andy_cherry/mygames.pgn [new file with mode: 0644]
ghc/tests/programs/areid_pass/Main.hs [new file with mode: 0644]
ghc/tests/programs/areid_pass/Makefile [new file with mode: 0644]
ghc/tests/programs/areid_pass/areid_pass.stdout [new file with mode: 0644]
ghc/tests/programs/cholewo-eval/Arr.lhs [new file with mode: 0644]
ghc/tests/programs/cholewo-eval/Main.lhs [new file with mode: 0644]
ghc/tests/programs/cholewo-eval/Makefile [new file with mode: 0644]
ghc/tests/programs/cholewo-eval/cholewo-eval.stdout [new file with mode: 0644]
ghc/tests/programs/cvh_unboxing/Append.lhs [new file with mode: 0644]
ghc/tests/programs/cvh_unboxing/Main.lhs [new file with mode: 0644]
ghc/tests/programs/cvh_unboxing/Makefile [new file with mode: 0644]
ghc/tests/programs/cvh_unboxing/README [new file with mode: 0644]
ghc/tests/programs/cvh_unboxing/Types.lhs [new file with mode: 0644]
ghc/tests/programs/cvh_unboxing/cvh_unboxing.stdout [new file with mode: 0644]
ghc/tests/programs/dmgob_native1/BugReport [new file with mode: 0644]
ghc/tests/programs/dmgob_native1/Main.lhs [new file with mode: 0644]
ghc/tests/programs/dmgob_native1/Makefile [new file with mode: 0644]
ghc/tests/programs/dmgob_native1/MaybeStateT.lhs [new file with mode: 0644]
ghc/tests/programs/dmgob_native1/dmgob_native1.stdout [new file with mode: 0644]
ghc/tests/programs/dmgob_native1/generate_vectors.c [new file with mode: 0644]
ghc/tests/programs/dmgob_native1/test_data [new file with mode: 0644]
ghc/tests/programs/dmgob_native2/Bug_report [new file with mode: 0644]
ghc/tests/programs/dmgob_native2/LPA.lhs [new file with mode: 0644]
ghc/tests/programs/dmgob_native2/Main.lhs [new file with mode: 0644]
ghc/tests/programs/dmgob_native2/Makefile [new file with mode: 0644]
ghc/tests/programs/dmgob_native2/dmgob_native2.stdin [new file with mode: 0644]
ghc/tests/programs/dmgob_native2/dmgob_native2.stdout [new file with mode: 0644]
ghc/tests/programs/dmgob_native2/dmgob_native2.stdout2 [new file with mode: 0644]
ghc/tests/programs/fast2haskell/Fast2haskell.hs [new file with mode: 0644]
ghc/tests/programs/fast2haskell/Main.hs [new file with mode: 0644]
ghc/tests/programs/fast2haskell/Makefile [new file with mode: 0644]
ghc/tests/programs/fast2haskell/Word.hs [new file with mode: 0644]
ghc/tests/programs/fast2haskell/fast2haskell.stdout [new file with mode: 0644]
ghc/tests/programs/fun_insts/Main.hs [new file with mode: 0644]
ghc/tests/programs/fun_insts/Makefile [new file with mode: 0644]
ghc/tests/programs/fun_insts/fun_insts.stdout [new file with mode: 0644]
ghc/tests/programs/hill_stk_oflow/MAIL [new file with mode: 0644]
ghc/tests/programs/hill_stk_oflow/Main.hs [new file with mode: 0644]
ghc/tests/programs/hill_stk_oflow/Makefile [new file with mode: 0644]
ghc/tests/programs/hill_stk_oflow/hill_stk_oflow.stdout [new file with mode: 0644]
ghc/tests/programs/ipoole_spec_class/GoferPreludeBits.lhs [new file with mode: 0644]
ghc/tests/programs/ipoole_spec_class/Io.lhs [new file with mode: 0644]
ghc/tests/programs/ipoole_spec_class/JobApp.lhs [new file with mode: 0644]
ghc/tests/programs/ipoole_spec_class/JobImp.lhs [new file with mode: 0644]
ghc/tests/programs/ipoole_spec_class/Lib.lhs [new file with mode: 0644]
ghc/tests/programs/ipoole_spec_class/Lognum.lhs [new file with mode: 0644]
ghc/tests/programs/ipoole_spec_class/Main.lhs [new file with mode: 0644]
ghc/tests/programs/ipoole_spec_class/Makefile [new file with mode: 0644]
ghc/tests/programs/ipoole_spec_class/README [new file with mode: 0644]
ghc/tests/programs/ipoole_spec_class/ipoole_spec_class.stdout [new file with mode: 0644]
ghc/tests/programs/jl_defaults/Main.hs [new file with mode: 0644]
ghc/tests/programs/jl_defaults/Makefile [new file with mode: 0644]
ghc/tests/programs/jl_defaults/jl_defaults.stdin [new file with mode: 0644]
ghc/tests/programs/jl_defaults/jl_defaults.stdout [new file with mode: 0644]
ghc/tests/programs/jq_readsPrec/Main.hs [new file with mode: 0644]
ghc/tests/programs/jq_readsPrec/Makefile [new file with mode: 0644]
ghc/tests/programs/jq_readsPrec/jq_readsPrec.stdin [new file with mode: 0644]
ghc/tests/programs/jq_readsPrec/jq_readsPrec.stdout [new file with mode: 0644]
ghc/tests/programs/jtod_circint/Bit.hs [new file with mode: 0644]
ghc/tests/programs/jtod_circint/LogFun.hs [new file with mode: 0644]
ghc/tests/programs/jtod_circint/Main.hs [new file with mode: 0644]
ghc/tests/programs/jtod_circint/Makefile [new file with mode: 0644]
ghc/tests/programs/jtod_circint/Signal.hs [new file with mode: 0644]
ghc/tests/programs/jtod_circint/jtod_circint.stdout [new file with mode: 0644]
ghc/tests/programs/jules_xref/Main.hs [new file with mode: 0644]
ghc/tests/programs/jules_xref/Makefile [new file with mode: 0644]
ghc/tests/programs/jules_xref/jules_xref.stdin [new file with mode: 0644]
ghc/tests/programs/jules_xref/jules_xref.stdout [new file with mode: 0644]
ghc/tests/programs/jules_xref2/Main.hs [new file with mode: 0644]
ghc/tests/programs/jules_xref2/Makefile [new file with mode: 0644]
ghc/tests/programs/jules_xref2/jules_xref2.stdin [new file with mode: 0644]
ghc/tests/programs/jules_xref2/jules_xref2.stdout [new file with mode: 0644]
ghc/tests/programs/launchbury/Main.hs [new file with mode: 0644]
ghc/tests/programs/launchbury/Makefile [new file with mode: 0644]
ghc/tests/programs/launchbury/launchbury.stdin [new file with mode: 0644]
ghc/tests/programs/launchbury/launchbury.stdout [new file with mode: 0644]
ghc/tests/programs/lennart_array/Main.hs [new file with mode: 0644]
ghc/tests/programs/lennart_array/Makefile [new file with mode: 0644]
ghc/tests/programs/lennart_array/lennart_array.stdout [new file with mode: 0644]
ghc/tests/programs/lennart_range/Main.hs [new file with mode: 0644]
ghc/tests/programs/lennart_range/Makefile [new file with mode: 0644]
ghc/tests/programs/lennart_range/lennart_range.stdout [new file with mode: 0644]
ghc/tests/programs/lex/Main.hs [new file with mode: 0644]
ghc/tests/programs/lex/Makefile [new file with mode: 0644]
ghc/tests/programs/lex/lex.stdin [new file with mode: 0644]
ghc/tests/programs/lex/lex.stdout [new file with mode: 0644]
ghc/tests/programs/life_space_leak/Main.hs [new file with mode: 0644]
ghc/tests/programs/life_space_leak/Makefile [new file with mode: 0644]
ghc/tests/programs/life_space_leak/life.test [new file with mode: 0644]
ghc/tests/programs/life_space_leak/life_space_leak.stdout [new file with mode: 0644]
ghc/tests/programs/north_array/Main.hs [new file with mode: 0644]
ghc/tests/programs/north_array/Makefile [new file with mode: 0644]
ghc/tests/programs/north_array/north_array.stdout [new file with mode: 0644]
ghc/tests/programs/north_lias/Bits.lhs [new file with mode: 0644]
ghc/tests/programs/north_lias/LIAS.lhs [new file with mode: 0644]
ghc/tests/programs/north_lias/Main.lhs [new file with mode: 0644]
ghc/tests/programs/north_lias/Makefile [new file with mode: 0644]
ghc/tests/programs/north_lias/north_lias.stdout [new file with mode: 0644]
ghc/tests/programs/record_upd/Main.hs [new file with mode: 0644]
ghc/tests/programs/record_upd/Makefile [new file with mode: 0644]
ghc/tests/programs/record_upd/record_upd.stdout [new file with mode: 0644]
ghc/tests/programs/rittri/Main.hs [new file with mode: 0644]
ghc/tests/programs/rittri/Makefile [new file with mode: 0644]
ghc/tests/programs/rittri/rittri.stdin [new file with mode: 0644]
ghc/tests/programs/rittri/rittri.stdout [new file with mode: 0644]
ghc/tests/programs/sanders_array/Main.hs [new file with mode: 0644]
ghc/tests/programs/sanders_array/Makefile [new file with mode: 0644]
ghc/tests/programs/sanders_array/sanders_array.stdout [new file with mode: 0644]
ghc/tests/programs/seward-space-leak/Main.lhs [new file with mode: 0644]
ghc/tests/programs/seward-space-leak/Makefile [new file with mode: 0644]
ghc/tests/programs/seward-space-leak/README [new file with mode: 0644]
ghc/tests/programs/seward-space-leak/cg023.stdout [new file with mode: 0644]
ghc/tests/programs/seward-space-leak/seward-space-leak.stdout [new file with mode: 0644]
ghc/tests/programs/strict_anns/Main.hs [new file with mode: 0644]
ghc/tests/programs/strict_anns/Makefile [new file with mode: 0644]
ghc/tests/programs/strict_anns/strict_anns.stdout [new file with mode: 0644]
ghc/tests/programs/waugh_neural/BpGen.lhs [new file with mode: 0644]
ghc/tests/programs/waugh_neural/MAIL [new file with mode: 0644]
ghc/tests/programs/waugh_neural/Main.lhs [new file with mode: 0644]
ghc/tests/programs/waugh_neural/Makefile [new file with mode: 0644]
ghc/tests/programs/waugh_neural/ReadLists.lhs [new file with mode: 0644]
ghc/tests/programs/waugh_neural/waugh_neural.stdout [new file with mode: 0644]
ghc/tests/programs/waugh_neural/xor [new file with mode: 0644]
ghc/tests/programs/zhang_ccall/MAIL [new file with mode: 0644]
ghc/tests/programs/zhang_ccall/Main.hs [new file with mode: 0644]
ghc/tests/programs/zhang_ccall/Makefile [new file with mode: 0644]
ghc/tests/programs/zhang_ccall/ccall.c [new file with mode: 0644]
ghc/tests/programs/zhang_ccall/zhang_ccall.stdout [new file with mode: 0644]

diff --git a/ghc/tests/programs/10queens/10queens.stdout b/ghc/tests/programs/10queens/10queens.stdout
new file mode 100644 (file)
index 0000000..67adbdb
--- /dev/null
@@ -0,0 +1 @@
+724
diff --git a/ghc/tests/programs/10queens/Main.hs b/ghc/tests/programs/10queens/Main.hs
new file mode 100644 (file)
index 0000000..6e2fdc0
--- /dev/null
@@ -0,0 +1,30 @@
+module Main (main) -- q
+where {
+--import Fast2haskell;
+
+    f_queens a_n=f_queens' (enumFromTo (1 :: Int) a_n) a_n;
+    f_queens' a_positions 0=(:) [] [];
+    f_queens' a_positions a_n=c_concat (f_map (f_place (f_queens' a_positions (((-) :: (Int -> Int -> Int)) a_n (1 :: Int)))) a_positions);
+    f_place a_boards a_q=[(:) a_q a_bs|a_bs<-a_boards,f_safe (1 :: Int) a_q a_bs];
+    f_safe a_d a_q []=True;
+    f_safe a_d a_q (a_h:a_t)=
+        if (((==) :: (Int -> Int -> Bool)) a_q a_h)
+        then False
+        else 
+        if (((==) :: (Int -> Int -> Bool)) (f_absi (((-) :: (Int -> Int -> Int)) a_q a_h)) a_d)
+        then False
+        else 
+            (f_safe (((+) :: (Int -> Int -> Int)) a_d (1 :: Int)) a_q a_t);
+    f_absi a_n=
+        if (((<) :: (Int -> Int -> Bool)) a_n (0 :: Int))
+        then (((negate) :: (Int -> Int)) a_n)
+        else 
+            a_n;
+    f_main a_n=(++) (show (length (f_queens a_n))) "\n";
+    c_input=(10 :: Int);
+    c_concat=f_foldr (++) [];
+    f_foldr a_op a_r []=a_r;
+    f_foldr a_op a_r (a_a:a_x)=a_op a_a (f_foldr a_op a_r a_x);
+    f_map a_f a_x=[a_f a_a|a_a<-a_x];
+    main = putStr (f_main c_input)
+}
diff --git a/ghc/tests/programs/10queens/Makefile b/ghc/tests/programs/10queens/Makefile
new file mode 100644 (file)
index 0000000..de6e7e0
--- /dev/null
@@ -0,0 +1,7 @@
+TOP = ../..
+include $(TOP)/mk/boilerplate.mk
+
+all :: runtest
+
+include $(TOP)/mk/target.mk
+
diff --git a/ghc/tests/programs/Makefile b/ghc/tests/programs/Makefile
new file mode 100644 (file)
index 0000000..8d16d44
--- /dev/null
@@ -0,0 +1,9 @@
+TOP = ..
+include $(TOP)/mk/boilerplate.mk
+
+NOT_THESE = Makefile ipoole_spec_class areid_pass
+
+SUBDIRS = $(filter-out $(NOT_THESE), $(wildcard *))
+
+include $(TOP)/mk/target.mk
+
diff --git a/ghc/tests/programs/andre_monad/Main.hs b/ghc/tests/programs/andre_monad/Main.hs
new file mode 100644 (file)
index 0000000..c2226a2
--- /dev/null
@@ -0,0 +1,89 @@
+-- Evaluator in a monad: with execution counts
+-- Phil Wadler, 11 October 1991
+
+-- Types are optional.  Some must be commented out to
+-- work around a bug in Gofer.
+
+-- The count monad
+
+type  M a              =  (a, Int)
+
+unit                   :: a -> M a
+unit a                 =  (a, 0)
+
+bind                   :: M a -> (a -> M b) -> M b
+m `bind` k             =  case m of 
+                             (a,i) -> case k a of 
+                                        (b,j) -> (b,i+j)
+
+-- disp                        :: Text a => M a -> String
+disp (a,i)             =  show a ++ "\nCount: " ++ show i
+
+tick                   :: M ()
+tick                   =  ((), 1)
+
+-- The evaluator
+-- Lines with * are only change from evalIdent
+
+data  Op               =  Add | Sub | Mul | Quo
+data  Term             =  Con Int | Bin Op Term Term
+
+eval                   :: Term -> M Int
+eval (Con i)           =  unit i
+eval (Bin op u v)      =  eval u     `bind` (\a  ->
+                          eval v     `bind` (\b  ->
+                          go op a b  `bind` (\c  ->    -- *
+                          tick       `bind` (\ () ->   -- *
+                          unit c))))                   -- *
+
+go                     :: Op -> Int -> Int -> M Int
+go Add a b             =  unit (a+b)
+go Sub a b             =  unit (a-b)
+go Mul a b             =  unit (a*b)
+go Quo a b             =  unit (a `quot` b) -- WDP: was "div"
+
+test                   :: Term -> String
+test t                 =  disp (eval t)
+
+-- Test data
+
+add, sub, mul, quo     :: Term -> Term -> Term
+u `add` v              =  Bin Add u v
+u `sub` v              =  Bin Sub u v
+u `mul` v              =  Bin Mul u v
+u `quo` v              =  Bin Quo u v
+
+term0,term1,term2      :: Term
+term0                  =  Con 6 `mul` Con 9
+term1                  =  (Con 4 `mul` Con 13) `add` Con 2
+term2                  =  (Con 1 `quo` Con 0) `add` Con 2
+term3                   =  ((((((((((((((((((((((((((((((((
+                           ((((((((((((((((((((((((((((((
+                                 Con 7777 `mul` Con  13) `quo` Con  13)
+                           `mul` Con 755) `quo` Con 755) `mul` Con 333)
+                           `quo` Con 755) `mul` Con 755) `mul` Con 333)
+                           `mul` Con 755) `quo` Con 755) `mul` Con 333)
+                           `quo` Con 755) `mul` Con 755) `mul` Con 333)
+                           `mul` Con 755) `quo` Con 755) `mul` Con 333)
+                           `quo` Con 755) `mul` Con 755) `mul` Con 333)
+                           `mul` Con 755) `quo` Con 755) `mul` Con 333)
+                           `quo` Con 755) `mul` Con 755) `mul` Con 333)
+                           `mul` Con 755) `quo` Con 755) `mul` Con 333)
+                           `quo` Con 755) `mul` Con 755) `mul` Con 333)
+                           `mul` Con 755) `quo` Con 755) `mul` Con 333)
+                           `quo` Con 755) `mul` Con 755) `mul` Con 333)
+                           `mul` Con 755) `quo` Con 755) `mul` Con 333)
+                           `quo` Con 755) `mul` Con 755) `mul` Con 333)
+                           `mul` Con 755) `quo` Con 755) `mul` Con 333)
+                           `quo` Con 755) `mul` Con 755) `mul` Con 333)
+                           `mul` Con 755) `quo` Con 755) `mul` Con 333)
+                           `quo` Con 755) `mul` Con 755) `mul` Con 333)
+                           `mul` Con 755) `quo` Con 755) `mul` Con 333)
+                           `quo` Con 755) `mul` Con 755) `mul` Con 333)
+
+sb 0 = term2
+sb n = if (n `mod` 2) == 0
+       then term2 `add` (sb (n-1))
+       else term2 `sub` (sb (n-1))
+
+main = print (show (eval (sb 5000)))
diff --git a/ghc/tests/programs/andre_monad/Makefile b/ghc/tests/programs/andre_monad/Makefile
new file mode 100644 (file)
index 0000000..de6e7e0
--- /dev/null
@@ -0,0 +1,7 @@
+TOP = ../..
+include $(TOP)/mk/boilerplate.mk
+
+all :: runtest
+
+include $(TOP)/mk/target.mk
+
diff --git a/ghc/tests/programs/andre_monad/andre_monad.stdout b/ghc/tests/programs/andre_monad/andre_monad.stdout
new file mode 100644 (file)
index 0000000..e69de29
diff --git a/ghc/tests/programs/andy_cherry/DataTypes.lhs b/ghc/tests/programs/andy_cherry/DataTypes.lhs
new file mode 100644 (file)
index 0000000..a800394
--- /dev/null
@@ -0,0 +1,621 @@
+> module DataTypes where
+
+> import GenUtils
+> import Array -- 1.3
+> import Ix
+> import Char
+> infix 1 =: -- 1.3
+> (=:) a b = (a,b)
+
+%------------------------------------------------------------------------------
+
+The `presentable' class, my own co-class for Text
+
+> class Presentable a where
+>      userFormat :: a -> String       -- in prefered display format
+
+Defaults, in terms of each other
+
+And the default for lists.
+
+> instance (Presentable a) => Presentable [a] where
+>     userFormat xs = unlines (map userFormat xs)
+
+%------------------------------------------------------------------------------
+ Here are all the pieces allowed in chess.
+
+> data Piece
+>      = King
+>      | Queen
+>      | Rook
+>      | Knight
+>      | Bishop
+>      | Pawn deriving(Eq)
+
+> instance Presentable Piece where
+>   userFormat King   = "K"
+>   userFormat Queen  = "Q"
+>   userFormat Rook   = "R"
+>   userFormat Knight = "N"
+>   userFormat Bishop = "B"
+>   userFormat Pawn   = "P"
+
+
+%------------------------------------------------------------------------------
+
+> castleK = "O-O"
+> castleQ = "O-O-O"
+
+%------------------------------------------------------------------------------
+
+Here are the two sides.
+
+> data Colour = Black | White deriving (Eq)
+
+> instance Presentable Colour where
+>      userFormat White = "White"
+>      userFormat Black = "Black"
+
+> changeColour :: Colour -> Colour
+> changeColour White = Black
+> changeColour Black = White
+
+%------------------------------------------------------------------------------
+
+Now the ranks and files.
+
+> type ChessRank = Int -- 1-8
+> type ChessFile = Int -- 1-8
+
+> type BoardPos = (ChessFile,ChessRank)        -- ChessFile (0-7) and ChessRank (0-7)
+> type ExBoardPos = (Maybe ChessFile,Maybe ChessRank)
+
+> extendBP :: BoardPos -> ExBoardPos 
+> extendBP (a,b) = (Just a,Just b)
+
+> compExBPandBP :: ExBoardPos -> BoardPos -> Bool
+> compExBPandBP (a,b) (c,d) = a `cmp` c && b `cmp` d
+>    where 
+>      cmp Nothing  _ = True
+>      cmp (Just x) y = x == y
+
+> userFormatBoardPos :: BoardPos -> String
+> userFormatBoardPos (f,r) = userFormatFile f ++ userFormatRank r
+> userFormatExBoardPos :: ExBoardPos -> String
+> userFormatExBoardPos (Just f,Just r)  = userFormatFile f ++ userFormatRank r
+> userFormatExBoardPos (Just f,Nothing) = userFormatFile f 
+> userFormatExBoardPos (Nothing,Just r) = userFormatRank r
+> userFormatExBoardPos _ = ""
+> userFormatRank r = [toEnum (r + 48)]
+> userFormatFile f = [toEnum (f + 96)]
+
+%------------------------------------------------------------------------------
+
+These are the components of a move.
+
+> data MoveTok 
+>      = PieceTok Piece        -- Q,K,R,B,N
+>      | RankTok ChessRank     -- 1 .. 8
+>      | FileTok ChessFile     -- a .. h
+>      | PartCastleTok         -- 0 | O | o
+>      | CaptureTok            -- x
+>      | MoveToTok             -- -
+>      | QueensWith            -- =
+>      | CheckTok              -- +
+>      | MateTok               -- #
+
+> charToMoveTok 'Q' = Just (PieceTok Queen)
+> charToMoveTok 'K' = Just (PieceTok King)
+> charToMoveTok 'R' = Just (PieceTok Rook)
+> charToMoveTok 'B' = Just (PieceTok Bishop)
+> charToMoveTok 'N' = Just (PieceTok Knight)
+> charToMoveTok '1' = Just (RankTok 1)
+> charToMoveTok '2' = Just (RankTok 2)
+> charToMoveTok '3' = Just (RankTok 3)
+> charToMoveTok '4' = Just (RankTok 4)
+> charToMoveTok '5' = Just (RankTok 5)
+> charToMoveTok '6' = Just (RankTok 6)
+> charToMoveTok '7' = Just (RankTok 7)
+> charToMoveTok '8' = Just (RankTok 8)
+> charToMoveTok 'a' = Just (FileTok 1)
+> charToMoveTok 'b' = Just (FileTok 2)
+> charToMoveTok 'c' = Just (FileTok 3)
+> charToMoveTok 'd' = Just (FileTok 4)
+> charToMoveTok 'e' = Just (FileTok 5)
+> charToMoveTok 'f' = Just (FileTok 6)
+> charToMoveTok 'g' = Just (FileTok 7)
+> charToMoveTok 'h' = Just (FileTok 8)
+> charToMoveTok '0' = Just (PartCastleTok)
+> charToMoveTok 'O' = Just (PartCastleTok)
+> charToMoveTok 'o' = Just (PartCastleTok)
+> charToMoveTok 'x' = Just (CaptureTok)
+> charToMoveTok '-' = Just (MoveToTok)
+> charToMoveTok '=' = Just (QueensWith)
+> charToMoveTok '+' = Just (CheckTok)
+> charToMoveTok '#' = Just (MateTok)
+> charToMoveTok _   = Nothing
+
+%------------------------------------------------------------------------------
+
+> data Quantum 
+>      = QuantumMove   String          -- Short Description of move
+>                      String          -- Check or Mate (+ or #)
+>                      String          -- !,??,?!, etc
+>                      Board           -- Snap Shot of Board
+>      | QuantumNAG Int                -- !,??,?! stuff
+>      | QuantumComment [String]       -- { comment }
+>      | QuantumResult String          -- 1-0, etc (marks end of game)
+>      | QuantumAnalysis [Quantum]     -- ( analysis )
+>      | QuantumPrintBoard             -- {^D}
+
+> instance Presentable Quantum where
+>      userFormat (QuantumMove mv ch ann _) 
+>              = mv ++ ch ++ ann
+>      userFormat (QuantumNAG nag) = "$" ++ show nag
+>      userFormat (QuantumComment comment) 
+>              = "[" ++ unwords comment ++ "]"
+>      --userFormat (QuantumNumber num)  = userFormat num
+>      userFormat (QuantumResult str) = str
+>      userFormat (QuantumAnalysis anal) =
+>              "( " ++ unwords (map userFormat anal) ++ " )"
+
+%------------------------------------------------------------------------------
+
+> data Result = Win | Draw | Loss | Unknown
+
+> instance Presentable Result where
+>      userFormat Win     = "1-0"
+>      userFormat Draw    = "1/2-1/2"
+>      userFormat Loss    = "0-1"
+>      userFormat Unknown = "*"
+
+> mkResult :: String -> Result
+> mkResult "1-0"     = Win
+> mkResult "1/2-1/2" = Draw
+> mkResult "0-1"     = Loss
+> mkResult _         = Unknown
+
+%------------------------------------------------------------------------------
+
+> data TagStr = TagStr String String
+
+> instance Presentable TagStr where
+>      userFormat (TagStr tag str) = "[" ++ tag ++ " \"" ++ str ++ "\"]"
+
+> getTagStr :: String -> String -> [TagStr] -> String
+> getTagStr str def [] = def
+> getTagStr str def (TagStr st ans:rest) 
+>              | str == st = ans
+>              | otherwise = getTagStr str def rest
+
+> getHeaderInfo 
+>      :: [TagStr]
+>      -> (
+>              String,         -- Date
+>              String,         -- Site
+>              Maybe Int,      -- Game Number
+>              Result,         -- W/D/L
+>              String,         -- White
+>              String,         -- Black
+>              String          -- Opening
+>      )
+> getHeaderInfo tags = (
+>              date,
+>              site,
+>              gameno,
+>              result,
+>              white `par` whiteElo,
+>              black `par` blackElo,
+>              opening)
+>   where
+>      date   = case getTagStr "Date" "?" tags of
+>                 [a,b,c,d,'.','?','?','.','?','?'] -> [a,b,c,d]
+>                 [a,b,c,d,'.',x,y,'.','?','?'] -> getMonth [x,y] ++ " " ++ [a,b,c,d]
+>                 def -> "?"
+>      site     = getTagStr "Site" "?" tags
+>      gameno   = case getTagStr "GameNumber" "" tags of
+>                      xs | all isDigit xs && not (null xs) -> Just (read xs)
+>                      _ -> Nothing
+>      result   = mkResult (getTagStr "Result" "*" tags)
+>      white    = cannon (getTagStr "White" "?" tags)
+>      whiteElo = getTagStr "WhiteElo" "" tags
+>      black    = cannon (getTagStr "Black" "?" tags)
+>      blackElo = getTagStr "BlackElo" "" tags
+>      opening  = getOpening (getTagStr "ECO" "" tags)
+
+>      par xs "" = xs
+>      par xs ys = xs ++ " (" ++ ys ++ ")"
+
+>      getMonth "01" = "Jan"
+>      getMonth "02" = "Feb"
+>      getMonth "03" = "Mar"
+>      getMonth "04" = "Apr"
+>      getMonth "05" = "May"
+>      getMonth "06" = "Jun"
+>      getMonth "07" = "Jul"
+>      getMonth "08" = "Aug"
+>      getMonth "09" = "Sep"
+>      getMonth "10" = "Oct"
+>      getMonth "11" = "Nov"
+>      getMonth "12" = "Dec"
+
+>      cannon name = case span (/= ',') name of
+>                      (a,[',',' ',b]) -> b : ". " ++ a
+>                      (a,[',',b]) -> b : ". " ++ a
+>                      (a,',':' ':b) -> b ++ " " ++ a
+>                      (a,',':b) -> b ++ " " ++ a
+>                      _ -> name
+
+
+> getOpening eco@[a,b,c] |  a >= 'A' && a <= 'E' && isDigit b && isDigit c 
+>    = getOpenName ((fromEnum a - fromEnum 'A') * 100 
+>              + (fromEnum b - fromEnum '0') * 10 
+>              + (fromEnum c - fromEnum '0')) ++ " " ++ eco
+> getOpening other = other
+
+> getOpenName :: Int -> String
+> getOpenName eco 
+>      | otherwise = "Foo"
+> {-
+>      | eco == 000 = "Irregular Openings"
+>      | eco == 001 = "Larsen Opening"
+>      | eco == 002 = "From's Gambit and Bird's Open"
+>      | eco == 003 = "Bird's Opening"
+>      | eco == 004 = "Dutch System"
+>      | eco == 005 = "Transposition to various Open"
+>      | eco == 006 = "Zukertort Opening"
+>      | eco >= 007 && eco <= 008
+>                   = "Barcza System"
+>      | eco == 009 = "Reti Opening"
+>      | eco == 010 = "Variations of Dutch, QI, KI"
+>      | eco >= 011 && eco <= 014
+>                   = "Reti Opening"
+>      | eco == 015 = "English counter King's Fianch"
+>      | eco >= 016 && eco <= 039
+>                   = "English Opening"
+>      | eco == 040 = "Unusual replies to 1.d4"
+>      | eco == 041 = "Modern Defence counter 1.d4"
+>      | eco == 042 = "Modern Defence with c2-c4"
+>      | eco >= 043 && eco <= 044
+>                   = "Old Benoni"
+>      | eco == 045 = "Queen's Pawn-Trompowski Var"
+>      | eco == 046 = "Queen's Pawn Opening"
+>      | eco == 047 = "Queen's Indian"
+>      | eco >= 048 && eco <= 049
+>                   = "King's Indian"
+>      | eco == 050 = "Queen's Indian"
+>      | eco >= 051 && eco <= 052
+>                   = "Budapest Defence"
+>      | eco >= 053 && eco <= 056
+>                   = "Old Indian Defence"
+>      | eco >= 057 && eco <= 059
+>                   = "Volga-Benko Gambit"
+>      | eco >= 060 && eco <= 079
+>                   = "Benoni"
+>      | eco >= 080 && eco <= 099
+>                   = "Dutch Defence"
+>      | eco == 100 = "Owen Def, Nimzowitsch Def"
+>      | eco == 101 = "Center Counter"
+>      | eco >= 102 && eco <= 105
+>                   = "Alekhine's Defence"
+>      | eco == 106 = "Modern Defence"
+>      | eco >= 107 && eco <= 109
+>                   = "Pirc Defence"
+>      | eco >= 110 && eco <= 119
+>                   = "Caro-Kann Defence"
+>      | eco >= 120 && eco <= 199
+>                   = "Sicilian Defence"
+>      | eco >= 200 && eco <= 219
+>                   = "French Defence"
+>      | eco == 220 = "Rare moves"
+>      | eco == 221 = "Nordic Gambit"
+>      | eco == 222 = "Central Gambit"
+>      | eco >= 223 && eco <= 224
+>                   = "Bishop's Opening"
+>      | eco >= 225 && eco <= 229
+>                   = "Vienna Game"
+>      | eco == 230 = "King's Gambit Declined"
+>      | eco >= 231 && eco <= 232
+>                   = "Falkbeer Counter Gambit"
+>      | eco >= 233 && eco <= 239
+>                   = "King's Gambit"
+>      | eco == 240 = "Latvian Gambit"
+>      | eco == 241 = "Philidor Defence"
+>      | eco >= 242 && eco <= 243
+>                   = "Russian Defence-Petrov"
+>      | eco >= 244 && eco <= 245
+>                   = "Scotch Opening"
+>      | eco >= 246 && eco <= 249
+>                   = "Four Knight's"
+>      | eco == 250 = "Italian Opening"
+>      | eco >= 251 && eco <= 252
+>                   = "Evans Gambit"
+>      | eco >= 253 && eco <= 254
+>                   = "Italian Opening"
+>      | eco >= 255 && eco <= 259
+>                   = "Two Knight's Play"
+>      | eco >= 260 && eco <= 299
+>                   = "Ruy Lopez"
+>      | eco >= 300 && eco <= 305
+>                   = "Queen Pawn's Opening"
+>      | eco >= 306 && eco <= 307
+>                   = "Queen's Gambit"
+>      | eco >= 308 && eco <= 309
+>                   = "Albins Counter Gambit"
+>      | eco >= 310 && eco <= 319
+>                   = "Slav Defence"
+>      | eco >= 320 && eco <= 329
+>                   = "Queen's Gambit Accepted"
+>      | eco >= 330 && eco <= 369
+>                   = "Queen's Gambit"
+>      | eco >= 370 && eco <= 399
+>                   = "Gruenfeld Defence"
+>      | eco >= 400 && eco <= 409
+>                   = "Catalan"
+>      | eco == 410 = "Blumenfeld Gambit"
+>      | eco >= 411 && eco <= 419
+>                   = "Queen's Indian"
+>      | eco >= 420 && eco <= 459
+>                   = "Nimzo Indian"
+>      | eco >= 460 && eco <= 499
+>                   = "King's Indian"
+> -}
+
+%------------------------------------------------------------------------------
+
+> data MoveNumber = MoveNumber Int Colour
+> instance Presentable MoveNumber where
+>      userFormat (MoveNumber n White)  = show n ++ "."
+>      userFormat (MoveNumber n Black)  = show n ++ "..."
+
+> initMoveNumber = MoveNumber 1 White
+> incMove (MoveNumber i White) = MoveNumber i Black
+> incMove (MoveNumber i Black) = MoveNumber (i+1) White
+> decMove (MoveNumber i White) = MoveNumber (i-1) Black
+> decMove (MoveNumber i Black) = MoveNumber i White
+> getMoveColour :: MoveNumber -> Colour
+> getMoveColour (MoveNumber _ c) = c
+
+%------------------------------------------------------------------------------
+
+> data Token 
+
+Both first and second level.
+
+>      = StringToken   String
+>      | AsterixToken
+>      | LeftABToken           -- ??
+>      | RightABToken          -- ??
+>      | NAGToken      Int     -- `normal' NAGS
+>      | NAGAnnToken   Int String
+>                              -- `special' move annotating NAGS (1-6)
+>      | SymbolToken   String
+>      | CommentToken  [String] -- list of words
+>      | LeftSBToken
+>      | RightSBToken
+>      | LeftRBToken
+>      | RightRBToken
+>      | IntToken      Int
+>      | PeriodToken
+
+Second level Token, as produced by the parser.
+
+>      | AnalToken     [Token]
+
+> instance Presentable Token where
+>      userFormat (StringToken str) = show str
+>      userFormat (IntToken n)      = show n
+>      userFormat (PeriodToken)     = "."
+>      userFormat (AsterixToken)    = "*"
+>      userFormat (LeftSBToken)     = "["
+>      userFormat (RightSBToken)    = "]"
+>      userFormat (LeftRBToken)     = "("
+>      userFormat (RightRBToken)    = ")"
+>      userFormat (LeftABToken)     = "<"
+>      userFormat (RightABToken)    = ">"
+>      userFormat (NAGToken i)      = "$" ++ show i
+>      userFormat (NAGAnnToken i s) = "$" ++ show i
+>      userFormat (SymbolToken str) = str
+>      userFormat (CommentToken str) = "{" ++ unwords str ++ "}"
+>      userFormat (AnalToken toks) = "( " ++ unwords (map userFormat toks)
+>                                      ++ " )"
+
+%------------------------------------------------------------------------------
+
+The Parser Emits a list of these.
+
+> data Game a = Game [TagStr] [a]
+
+> type AbsGame = Game Token
+> type RealGame = Game Quantum
+
+> instance (Presentable a) => Presentable (Game a) where
+>      userFormat (Game tags toks) = 
+>              unlines (map userFormat tags 
+>                 ++ formatText 78 (map userFormat toks))
+
+%------------------------------------------------------------------------------
+
+Here are the moves that actually can be played,
+all in the context of a particular board.
+
+> data PlayMove
+>      = PlayMove
+>              Piece           -- with this
+>              BoardPos        -- from here
+>              BoardPos        -- to here (possibly capturing)
+>              SpecialMove
+
+> mkPlayMove p f t = PlayMove p f t NothingSpecial
+
+> data SpecialMove 
+>      = NothingSpecial        
+>      | BigPawnMove           -- allows e.p. next move
+>      | Queening Piece        -- queen with this
+>      | EnPassant             -- capture e.p.
+>    deriving (Eq)
+               
+> instance Presentable PlayMove where
+>      userFormat (PlayMove piece pos pos' sp) = 
+>              userFormat piece ++
+>              userFormatBoardPos pos ++ "-" ++
+>              userFormatBoardPos pos' ++ 
+>              userFormat sp
+
+> instance Presentable SpecialMove where
+>      userFormat (NothingSpecial) = ""
+>      userFormat (BigPawnMove) = "{b.p.m.}"
+>      userFormat (Queening p) = "=" ++ userFormat p
+>      userFormat (EnPassant) = "e.p."
+
+> extractSrcFromPlayMove :: PlayMove -> BoardPos
+> extractSrcFromPlayMove (PlayMove _ src _ _) = src
+
+> extractDestFromPlayMove :: PlayMove -> BoardPos
+> extractDestFromPlayMove (PlayMove _ _ dest _)       = dest
+
+> extractSpecialFromPlayMove :: PlayMove -> SpecialMove
+> extractSpecialFromPlayMove (PlayMove _ _ _ sp)       = sp
+
+
+%------------------------------------------------------------------------------
+
+Now the representation of the board itself.
+
+> data BoardSquare
+>      = VacantSq
+>      | WhitesSq Piece
+>      | BlacksSq Piece
+
+> data SquareContent
+>      = Vacant
+>      | Friendly
+>      | Baddy
+>      | OffBoard deriving (Eq)
+
+> instance Presentable SquareContent where
+>      userFormat Vacant   = "."
+>      userFormat Friendly = "*"
+>      userFormat Baddy    = "#"
+>      userFormat OffBoard = "?"
+
+
+%------------------------------------------------------------------------------
+
+A Static representation of what the current placement of pieces is.
+
+> data Board 
+>      = Board (Array BoardPos BoardSquare)
+>              MoveNumber              -- current player & and move
+>              (Maybe ChessFile)       -- e.p. possibilties.
+
+This is Christmas for foldr/build !
+
+> displayBoard :: Colour -> Board -> [String]
+> displayBoard col (Board arr _ ep) = 
+>      ([cjustify 33 (userFormat (changeColour col)),""] ++
+>      [
+>   concat [ (case (even x,even y) of
+>      (True,True)   -> showSq (x `div` 2) (y `div` 2)
+>      (False,False) -> "+"
+>      (True,False)  -> "---"
+>      (False,True)  -> (if x == 17 then "| " ++ show (y `div` 2) else "|"))
+>              | x <- [1..17::Int]]
+>              | y <- reverse [1..17::Int]] ++
+>      [concat [ "  " ++ [x] ++ " " | x <- "abcdefgh" ]] ++
+>      ["",cjustify 33 (userFormat col),"",
+>              case ep of
+>               Nothing -> ""
+>               Just p -> "EnPassant:" ++ userFormatFile p ])
+>    where
+>      make n str = take n (str ++ repeat ' ')
+>      lookupPlace :: Int -> Int -> BoardSquare
+>      lookupPlace x' y' = arr ! (x',y')
+
+>      bold :: String -> String
+>      bold str = map toLower str
+
+>      showSq x y = case lookupPlace x y of
+>              VacantSq     -> [if_dot,if_dot,if_dot]
+>              (WhitesSq p) -> (if_dot : userFormat p) ++ [if_dot]
+>              (BlacksSq p)  -> (if_dot : bold (userFormat p)) ++ [if_dot]
+>         where
+>              if_dot = if (x - y) `rem` 2 == 0 then '.' else ' '
+
+> instance Presentable Board where
+>   userFormat = unlines . displayBoard White
+
+> boardSize :: (BoardPos,BoardPos)
+> boardSize = ((1,1),(8,8))
+
+
+This uses forsyth notation.
+
+> buildBoard :: String -> Board
+> buildBoard str = Board brd initMoveNumber Nothing
+>    where
+>      brd = array boardSize (zipWith (=:) allSq (mkPieces str))
+>      allSq = [ (x,y) | y <- reverse [1..8::Int],x <- [1..8::Int]]
+>      mkPieces :: String -> [BoardSquare]
+>      mkPieces (hd:rest) | hd `elem` "KQRNBPkqrnbp" = pc : mkPieces rest
+>         where
+>              pc = case hd of
+>                      'K' -> WhitesSq King    
+>                      'Q' -> WhitesSq Queen
+>                      'R' -> WhitesSq Rook
+>                      'N' -> WhitesSq Knight
+>                      'B' -> WhitesSq Bishop  
+>                      'P' -> WhitesSq Pawn
+>                      'k' -> BlacksSq King    
+>                      'q' -> BlacksSq Queen
+>                      'r' -> BlacksSq Rook
+>                      'n' -> BlacksSq Knight
+>                      'b' -> BlacksSq Bishop  
+>                      'p' -> BlacksSq Pawn
+>      mkPieces ('/':rest) = mkPieces rest
+>      mkPieces (c:rest) | isDigit c =
+>              case span isDigit rest of
+>                (cs,rest') -> take (read (c:cs)) (repeat VacantSq) 
+>                                      ++ mkPieces rest'
+>      mkPieces [] = []
+
+> startBoard :: Board  -- the uni before the big bang.
+> startBoard = buildBoard "rnbqkbnr/pppppppp/32/PPPPPPPP/RNBQKBNR"
+
+> lookupSquare :: Colour -> BoardSquare -> SquareContent
+> lookupSquare _      VacantSq    = Vacant
+> lookupSquare White (WhitesSq p) = Friendly
+> lookupSquare Black (WhitesSq p) = Baddy
+> lookupSquare White (BlacksSq p) = Baddy
+> lookupSquare Black (BlacksSq p) = Friendly
+
+> lookupBoard :: Board -> BoardPos -> SquareContent
+> lookupBoard (Board arr col _) pos = 
+>      if inRange boardSize pos
+>      then lookupSquare (getMoveColour col) (arr ! pos)
+>      else OffBoard
+
+> lookupBoardSquare :: Board -> BoardPos -> BoardSquare
+> lookupBoardSquare (Board arr _ _) pos = arr ! pos
+
+> getSquarePiece :: BoardSquare -> Maybe Piece
+> getSquarePiece VacantSq    = Nothing
+> getSquarePiece (WhitesSq p) = Just p
+> getSquarePiece (BlacksSq p) = Just p
+
+> lookupBoardPiece :: Board -> BoardPos -> Maybe Piece
+> lookupBoardPiece (Board arr _ _) pos = 
+>     case arr ! pos of
+>      VacantSq -> Nothing
+>      WhitesSq piece -> Just piece
+>      BlacksSq piece -> Just piece
+
+This will improve sharing, by 
+
+> {-# INLINE mkColBoardSq #-}
+> mkColBoardSq :: Colour -> Piece -> BoardSquare
+> mkColBoardSq White p = WhitesSq p
+> mkColBoardSq Black p = BlacksSq p
+
+> getBoardColour (Board _ mv _) = getMoveColour mv
+
diff --git a/ghc/tests/programs/andy_cherry/GenUtils.lhs b/ghc/tests/programs/andy_cherry/GenUtils.lhs
new file mode 100644 (file)
index 0000000..e10035a
--- /dev/null
@@ -0,0 +1,243 @@
+Some General Utilities, including sorts, etc.
+This is realy just an extended prelude.
+All the code below is understood to be in the public domain.
+
+> module GenUtils (
+
+       trace,
+
+>       assocMaybe, assocMaybeErr,
+>       arrElem,
+>       arrCond,
+>       memoise,
+>       Maybe(..),
+>       MaybeErr(..),
+>       mapMaybe,
+>       mapMaybeFail,
+>       maybeToBool,
+>       maybeToObj,
+>       maybeMap,
+>       joinMaybe,
+>       mkClosure,
+>       foldb,
+
+>      mapAccumL,
+
+>       sortWith,
+>       sort,
+>       cjustify,
+>       ljustify,
+>       rjustify,
+>       space,
+>       copy,
+>      combinePairs,
+>      formatText ) where
+
+> import Array -- 1.3
+> import Ix    -- 1.3
+
+>#ifndef __GLASGOW_HASKELL__
+
+> import {-fool mkdependHS-}
+>       Trace
+
+>#endif
+
+%------------------------------------------------------------------------------
+
+Here are two defs that everyone seems to define ... 
+HBC has it in one of its builtin modules
+
+>#if defined(__GLASGOW_HASKELL__) || defined(__GOFER__)
+
+> --in 1.3: data Maybe a = Nothing | Just a deriving (Eq,Ord,Text)
+
+>#endif
+> infix 1 =: -- 1.3
+> type Assoc a b = (a,b) -- 1.3
+> (=:) a b = (a,b)
+
+> mapMaybe :: (a -> Maybe b) -> [a] -> [b]
+> mapMaybe f [] = []
+> mapMaybe f (a:r) = case f a of
+>                       Nothing -> mapMaybe f r
+>                       Just b  -> b : mapMaybe f r
+
+This version returns nothing, if *any* one fails.
+
+> mapMaybeFail f (x:xs) = case f x of
+>                      Just x' -> case mapMaybeFail f xs of
+>                                  Just xs' -> Just (x':xs')
+>                                  Nothing -> Nothing
+>                      Nothing -> Nothing
+> mapMaybeFail f [] = Just []
+
+> maybeToBool :: Maybe a -> Bool
+> maybeToBool (Just _) = True
+> maybeToBool _        = False
+
+> maybeToObj  :: Maybe a -> a
+> maybeToObj (Just a) = a
+> maybeToObj _        = error "Trying to extract object from a Nothing"
+
+> maybeMap :: (a -> b) -> Maybe a -> Maybe b
+> maybeMap f (Just a) = Just (f a)
+> maybeMap f Nothing  = Nothing
+
+
+> joinMaybe :: (a -> a -> a) -> Maybe a -> Maybe a -> Maybe a 
+> joinMaybe _ Nothing  Nothing  = Nothing
+> joinMaybe _ (Just g) Nothing  = Just g
+> joinMaybe _ Nothing  (Just g) = Just g
+> joinMaybe f (Just g) (Just h) = Just (f g h)
+
+> data MaybeErr a err = Succeeded a | Failed err deriving (Eq,Show{-was:Text-})
+
+@mkClosure@ makes a closure, when given a comparison and iteration loop. 
+Be careful, because if the functional always makes the object different, 
+This will never terminate.
+
+> mkClosure :: (a -> a -> Bool) -> (a -> a) -> a -> a
+> mkClosure eq f = match . iterate f
+>   where
+>       match (a:b:c) | a `eq` b = a
+>       match (_:c)              = match c
+
+fold-binary.
+It combines the element of the list argument in balanced mannerism.
+
+> foldb :: (a -> a -> a) -> [a] -> a
+> foldb f [] = error "can't reduce an empty list using foldb"
+> foldb f [x] = x
+> foldb f l  = foldb f (foldb' l)
+>    where 
+>       foldb' (x:y:x':y':xs) = f (f x y) (f x' y') : foldb' xs
+>       foldb' (x:y:xs) = f x y : foldb' xs
+>       foldb' xs = xs
+
+Merge two ordered lists into one ordered list. 
+
+> mergeWith               :: (a -> a -> Bool) -> [a] -> [a] -> [a] 
+> mergeWith _ []     ys      = ys
+> mergeWith _ xs     []      = xs
+> mergeWith le (x:xs) (y:ys)
+>        | x `le` y  = x : mergeWith le xs (y:ys)
+>        | otherwise = y : mergeWith le (x:xs) ys
+
+> insertWith              :: (a -> a -> Bool) -> a -> [a] -> [a]
+> insertWith _ x []          = [x]
+> insertWith le x (y:ys)
+>        | x `le` y     = x:y:ys
+>        | otherwise    = y:insertWith le x ys
+
+Sorting is something almost every program needs, and this is the
+quickest sorting function I know of.
+
+> sortWith :: (a -> a -> Bool) -> [a] -> [a]
+> sortWith le [] = []
+> sortWith le lst = foldb (mergeWith le) (splitList lst)
+>   where
+>       splitList (a1:a2:a3:a4:a5:xs) = 
+>                insertWith le a1 
+>               (insertWith le a2 
+>               (insertWith le a3
+>               (insertWith le a4 [a5]))) : splitList xs
+>       splitList [] = []
+>       splitList (r:rs) = [foldr (insertWith le) [r] rs]
+
+> sort :: (Ord a) => [a] -> [a]
+> sort = sortWith (<=)
+
+Gofer-like stuff:
+
+> 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 (max 0 (n - length s))
+> rjustify n s = space (max 0 (n - length s)) ++ s
+
+> space       :: Int -> String
+> space n      = copy n ' '
+
+> copy  :: Int -> a -> [a]      -- make list of n copies of x
+> copy n x = take n xs where xs = x:xs
+
+> combinePairs :: (Ord a) => [(a,b)] -> [(a,[b])]
+> combinePairs xs = 
+>      combine [ (a,[b]) | (a,b) <- sortWith (\ (a,_) (b,_) -> a <= b) xs]
+>  where
+>      combine [] = []
+>      combine ((a,b):(c,d):r) | a == c = combine ((a,b++d) : r)
+>      combine (a:r) = a : combine r
+> 
+
+> 
+> assocMaybe :: (Eq a) => [(a,b)] -> a -> Maybe b
+> assocMaybe env k = case [ val | (key,val) <- env, k == key] of
+>                [] -> Nothing
+>                (val:vs) -> Just val
+> 
+> assocMaybeErr :: (Eq a) => [(a,b)] -> a -> MaybeErr b String
+> assocMaybeErr env k = case [ val | (key,val) <- env, k == key] of
+>                        [] -> Failed "assoc: "
+>                        (val:vs) -> Succeeded val
+> 
+
+> deSucc (Succeeded e) = e
+
+> mapAccumL :: (a -> b -> (c,a)) -> a -> [b] -> ([c],a)
+> mapAccumL f s [] = ([],s)
+> mapAccumL f s (b:bs) = (c:cs,s'')
+>      where
+>              (c,s') = f s b
+>              (cs,s'') = mapAccumL f s' bs
+
+
+
+Now some utilties involving arrays.
+Here is a version of @elem@ that uses partual application
+to optimise lookup.
+
+> arrElem :: (Ix a) => [a] -> a -> Bool
+> arrElem obj = \x -> inRange size x && arr ! x 
+>   where
+>       size = (maximum obj,minimum obj)
+>       arr = listArray size [ i `elem` obj | i <- range size ]
+
+Here is the functional version of a multi-way conditional,
+again using arrays, of course. Remember @b@ can be a function !
+Note again the use of partiual application.
+
+> arrCond :: (Ix a) 
+>         => (a,a)                      -- the bounds
+>         -> [(Assoc [a] b)]            -- the simple lookups
+>         -> [(Assoc (a -> Bool) b)]    -- the functional lookups
+>         -> b                          -- the default
+>         -> a -> b                     -- the (functional) result
+
+> arrCond bds pairs fnPairs def = (!) arr'
+>   where
+>       arr' = array bds [ t =: head
+>                       ([ r | (p, r) <- pairs, elem t p ] ++
+>                        [ r | (f, r) <- fnPairs, f t ] ++
+>                        [ def ])
+>               | t <- range bds ]
+
+> memoise :: (Ix a) => (a,a) -> (a -> b) -> a -> b
+> memoise bds f = (!) arr
+>   where arr = array bds [ t =: f t | t <- range bds ]
+
+Quite neat this. Formats text to fit in a column.
+
+> formatText :: Int -> [String] -> [String]
+> formatText n = map unwords . cutAt n []
+>   where
+>      cutAt :: Int -> [String] -> [String] -> [[String]]
+>      cutAt m wds [] = [reverse wds]
+>      cutAt m wds (wd:rest) = if len <= m || null wds
+>                              then cutAt (m-(len+1)) (wd:wds) rest 
+>                              else reverse wds : cutAt n [] (wd:rest)
+>        where len = length wd
+
+
diff --git a/ghc/tests/programs/andy_cherry/Interp.lhs b/ghc/tests/programs/andy_cherry/Interp.lhs
new file mode 100644 (file)
index 0000000..7a7bb7e
--- /dev/null
@@ -0,0 +1,261 @@
+
+> module Interp (runInterp) where
+
+> import GenUtils
+> import DataTypes
+> import InterpUtils
+> import Parser (pgnLexer)
+
+This is a Interp for PGN.
+
+> runInterp :: AbsGame -> RealGame
+> runInterp (Game tags toks) = Game tags (pgnInterp toks initParState)
+
+%------------------------------------------------------------------------------
+
+> initParState = (FirstBoard startBoard)
+
+> type Par a = StoreBoard -> a
+> thenP :: Par a -> (a -> Par b) -> Par b
+> returnP :: a -> Par a
+
+> returnP a = \s -> a
+> thenP m k s = case m s of
+>                r -> k r s
+>                
+> failP a = \s -> error a
+> consP q rest = \s -> q : pgnInterp rest s
+> thenP' :: Par StoreBoard -> Par a -> Par a
+> thenP' m k s = case m s of
+>                r -> k r 
+> newGameP :: Par a -> Par a
+> newGameP m = \ _ -> m initParState
+
+> getCurrColour :: Par Colour
+> getCurrColour = 
+>      getBoard                `thenP` \ (Board _ (MoveNumber _ col) _) ->
+>      returnP col
+
+> checkColour :: MoveNumber -> Par ()
+> checkColour (MoveNumber i col) =
+>      getBoard                `thenP` \ (Board _ (MoveNumber i' col') _) ->
+>      if i == i' && col == col' 
+>      then returnP ()
+>      else failP ("number mis-match: " 
+>              ++ userFormat (MoveNumber i col) 
+>              ++ " (looking for " 
+>              ++ userFormat (MoveNumber i' col') 
+>              ++ ")\n")
+
+%------------------------------------------------------------------------------
+
+> data StoreBoard 
+>      = FirstBoard Board
+>      | UndoableBoard Board {- new -} Board {- back one -}
+
+> updateBoard :: Board -> Par StoreBoard
+> updateBoard brd (FirstBoard old_brd) 
+>      = UndoableBoard brd old_brd
+> updateBoard brd (UndoableBoard old_brd _) 
+>      = UndoableBoard brd old_brd
+
+> getBoard :: Par Board
+> getBoard s@(FirstBoard brd) 
+>      = brd
+> getBoard s@(UndoableBoard brd _) 
+>      = brd
+
+> undoBoard :: Par StoreBoard
+> undoBoard (FirstBoard _) 
+>      = error "Incorrect start to some analysis"
+> undoBoard (UndoableBoard _ old_brd)
+>      = FirstBoard old_brd
+
+%------------------------------------------------------------------------------
+
+> pgnInterp :: [Token] -> Par [Quantum]
+> pgnInterp (IntToken n:PeriodToken:PeriodToken:PeriodToken:rest) =
+>      checkColour (MoveNumber n Black)                `thenP` \ () ->
+>      pgnInterp rest
+> pgnInterp (IntToken n:PeriodToken:rest) =
+>      checkColour (MoveNumber n White)                `thenP` \ () ->
+>      pgnInterp rest
+
+> pgnInterp (SymbolToken str:CommentToken (ann:rs):r)
+>      | all (flip elem "!?") ann =
+>      pgnInterp (SymbolToken str:pgnLexer ann ++ (CommentToken rs:r))
+
+This hack lets us add in analysis, as done by Fritz2,
+taking it from the comment, and adding as a variation.
+
+> pgnInterp (CommentToken (n:tag:rest):r)
+>      | head tag == '(' && take 2 (reverse tag) == ":)" && length rest > 1 =
+>      getCurrColour                           `thenP` \ col ->
+>      let 
+>          invert Black r   = r -- because the move has *already* happend
+>          invert _ "0.00"  = "0.00"   -- dont negate 0
+>          invert _ ('-':r) = r
+>          invert _ r       = '-':r
+>      in 
+>      pgnInterp (LeftRBToken:map SymbolToken (take (length rest-1) rest)
+>              ++ [CommentToken ["Score:",invert col n],RightRBToken] ++ r)
+
+
+> pgnInterp (CommentToken []:rest) = pgnInterp rest
+> pgnInterp (CommentToken comm:rest) =
+>      consP (QuantumComment comm) rest
+> pgnInterp (NAGToken nag:rest) =
+>      consP (QuantumNAG nag) rest
+> pgnInterp (NAGAnnToken nag _:rest) =
+>      consP (QuantumNAG nag) rest
+> pgnInterp (SymbolToken "0-1":rest) =
+>      consP (QuantumResult "0-1") rest
+> pgnInterp (SymbolToken "1-0":rest) =
+>      consP (QuantumResult "1-0") rest
+> pgnInterp (SymbolToken "1/2-1/2":rest) =
+>      consP (QuantumResult "1/2-1/2") rest
+> pgnInterp (AsterixToken:rest) =
+>      consP (QuantumResult "*") rest
+> pgnInterp (SymbolToken move:rest@(NAGAnnToken _ str:_)) =
+>      getBoard                `thenP` \ brd ->
+>      parseMove move brd      `thenP` \ (mv,ch,corrMv,new_brd) ->
+>      updateBoard new_brd     `thenP'`
+>      consP (QuantumMove mv ch str new_brd) rest
+> pgnInterp (SymbolToken move:rest) =
+>      getBoard                `thenP` \ brd ->
+>      parseMove move brd      `thenP` \ (mv,ch,corrMv,new_brd) ->
+>      updateBoard new_brd     `thenP'`
+>      consP (QuantumMove mv ch "" new_brd) rest
+> pgnInterp (LeftRBToken:rest) =
+>      getAnalysis rest 0 []   `thenP` \ (anal,rest) -> 
+>      (undoBoard              `thenP'`
+>      pgnInterp anal)         `thenP` \ anal' ->
+>      consP (QuantumAnalysis anal') rest
+> pgnInterp [] = returnP []
+> pgnInterp toks = failP ("when reading: " 
+>              ++ unwords (map userFormat (take 10 toks)))
+
+This has a *horable* complexity
+
+> getAnalysis (t@LeftRBToken:r) n anal = getAnalysis r (n+1) (t:anal)
+> getAnalysis (t@RightRBToken:r) n anal 
+>      | n == (0 :: Int) = returnP (reverse anal,r)
+>      | otherwise = getAnalysis r (n-1) (t:anal)
+> getAnalysis (t:r) n anal = getAnalysis r n (t:anal)
+> getAnalysis [] n anal = failP "no closing ')'"
+
+This is the *real* Interpreter, that makes sense of the move,
+and checks that it is possible to do, etc, etc.
+
+> parseMove :: String -> Board -> Par (String,String,String,Board)
+> parseMove move brd@(Board _ (MoveNumber _ col) _) = 
+>   case mapMaybeFail charToMoveTok move of
+>    Nothing -> failP ("strange move:" ++ move)
+>    Just mv_toks ->
+>      let 
+>         (chs,mv_toks') = getChecks (reverse mv_toks)
+>         (queen,mv_toks'') = getQueen mv_toks'
+>      in 
+>      case parseAlgMove mv_toks'' queen brd of 
+>        (the_mv,new_brd) -> returnP (the_mv,chs,"$$",new_brd)
+
+O-O
+
+> parseAlgMove 
+>      :: [MoveTok]
+>      -> Maybe Piece 
+>      -> Board 
+>      -> (String,Board)
+> parseAlgMove [PartCastleTok,MoveToTok,PartCastleTok] Nothing
+>              = findCastleKMove
+> parseAlgMove [PartCastleTok,MoveToTok,PartCastleTok,
+>                  MoveToTok,PartCastleTok] Nothing
+>              = findCastleQMove
+
+> parseAlgMove (PieceTok King:r) Nothing   = parsePieceMove r King 
+> parseAlgMove (PieceTok Queen:r) Nothing  = parsePieceMove r Queen 
+> parseAlgMove (PieceTok Rook:r) Nothing   = parsePieceMove r Rook 
+> parseAlgMove (PieceTok Knight:r) Nothing  = parsePieceMove r Knight 
+> parseAlgMove (PieceTok Bishop:r) Nothing  = parsePieceMove r Bishop 
+
+f5[-x]g8
+
+> parseAlgMove [FileTok sf,RankTok sr,MoveToTok,FileTok df,RankTok dr] q  =
+>      findAPawnMove (extendBP (sf,sr)) (extendBP (df,dr)) q 
+> parseAlgMove [FileTok sf,RankTok sr,CaptureTok,FileTok df,RankTok dr] q  =
+>      findAPawnMove (extendBP (sf,sr)) (extendBP (df,dr)) q 
+
+f5g7
+
+> parseAlgMove [FileTok sf,RankTok sr,FileTok df,RankTok dr] q = \ brd -> 
+>   case lookupBoardPiece brd (sf,sr) of
+>      Nothing -> error ("cant find piece at: " ++ userFormatBoardPos (sf,sr))
+>      Just Pawn -> findAPawnMove (extendBP (sf,sr)) (extendBP (df,dr)) q brd
+>      Just King | sf == 5 && df == 7 -> findCastleKMove brd
+>      Just King | sf == 5 && df == 3 -> findCastleQMove brd
+>      Just p -> findAMove p (extendBP (sf,sr)) (extendBP (df,dr)) brd
+
+> -- later !
+
+f3
+
+> parseAlgMove [FileTok df,RankTok dr] q =
+>      findAPawnMove (Nothing,Nothing) (extendBP (df,dr)) q 
+
+fxg4
+
+> parseAlgMove [FileTok sf,CaptureTok,FileTok df,RankTok dr] q  =
+>      findAPawnMove (Just sf,Nothing) (extendBP (df,dr)) q 
+
+fg
+
+> parseAlgMove [FileTok sf,FileTok df] q  =
+>      findAPawnMove (Just sf,Nothing) (Just df,Nothing) q 
+
+fxg
+
+> parseAlgMove [FileTok sf,CaptureTok,FileTok df] q  =
+>      findAPawnMove (Just sf,Nothing) (Just df,Nothing) q 
+> parseAlgMove _ _ = error "!>!"
+
+Rf8
+
+> parsePieceMove [FileTok df,RankTok dr] p
+>      = findAMove p (Nothing,Nothing) (extendBP (df,dr)) 
+
+Rxf8
+
+> parsePieceMove [CaptureTok,FileTok df,RankTok dr] p
+>      = findAMove p (Nothing,Nothing) (extendBP (df,dr))
+
+R4x?f8
+
+> parsePieceMove [RankTok sr,FileTok df,RankTok dr] p 
+>      = findAMove p (Nothing,Just sr) (extendBP (df,dr))
+> parsePieceMove [RankTok sr,CaptureTok,FileTok df,RankTok dr] p
+>      = findAMove p (Nothing,Just sr) (extendBP (df,dr))
+
+Rfx?f8
+
+> parsePieceMove [FileTok sf,FileTok df,RankTok dr] p 
+>      = findAMove p (Just sf,Nothing) (extendBP (df,dr))
+> parsePieceMove [FileTok sf,CaptureTok,FileTok df,RankTok dr] p
+>      = findAMove p (Just sf,Nothing) (extendBP (df,dr))
+
+Rf8[-x]?g8
+
+> parsePieceMove [FileTok sf,RankTok sr,MoveToTok,FileTok df,RankTok dr] p
+>      = findAMove p (extendBP (sf,sr)) (extendBP (df,dr))
+> parsePieceMove [FileTok sf,RankTok sr,CaptureTok,FileTok df,RankTok dr] p
+>      = findAMove p (extendBP (sf,sr)) (extendBP (df,dr))
+> parsePieceMove _ p = failP ("syntax error in move:")
+
+> getChecks (CheckTok:CheckTok:r) = ("#",r)
+> getChecks (CheckTok:r) = ("+",r)
+> getChecks (MateTok:r)  = ("#",r)
+> getChecks r           = ("",r)
+
+> getQueen (PieceTok p:QueensWith:r) = (Just p,reverse r)
+> getQueen r = (Nothing,reverse r)
+
+
diff --git a/ghc/tests/programs/andy_cherry/InterpUtils.lhs b/ghc/tests/programs/andy_cherry/InterpUtils.lhs
new file mode 100644 (file)
index 0000000..225bf3b
--- /dev/null
@@ -0,0 +1,370 @@
+> module InterpUtils where
+
+> import GenUtils
+> import DataTypes
+> import Array -- 1.3
+
+%------------------------------------------------------------------------------
+
+This part computes the effect a move has on its board.
+
+> findCastleKMove brd = (castleK,makeACastleK brd)
+> findCastleQMove brd = (castleQ,makeACastleQ brd)
+
+> findAPawnMove
+>      :: ExBoardPos 
+>      -> ExBoardPos 
+>      -> Maybe Piece 
+>      -> Board
+>      -> (String,Board)
+
+First the pawns. They are seprate because:
+ 1. There are many pawns, so knowing the file helps.
+ 2. You dont need to dis-ambiguate a pawn move. exf7 is fine.
+
+> findAPawnMove move_src move_dest queen brd@(Board arr mv _) 
+>      = debug (move_txt,new_brd)
+>   where
+
+>      move_colour = getMoveColour mv
+
+>      debug   = {- trace (
+>              {- userFormat brd ++ -}
+>              userFormat (getMoveColour mv) ++ 
+>              -- " (" ++ userFormat absmove ++ ")" ++
+>              "\nALL   :" ++ unwords (map userFormat all_moves) ++
+>              "\n") -} id 
+
+Now get all valid moves (for the correct piece), including some 
+illegal moves (ie. pinned pieces).
+
+>      correct_src = concat (map (getAllMovesFor brd) currPieces)
+
+>      currPieces  =
+>              [ (Pawn,x,y) |
+>                      (x,y) <- start_range,
+>                      r <- [arr ! (x,y)],
+>                      lookupSquare move_colour r == Friendly,
+>                      (Just Pawn) <- [getSquarePiece r]]
+
+Now filter out the moves it *cant* be.
+
+>      start_range
+>         = case (move_src,move_dest) of
+>              ((Just f,Just r),_) -> [(f,r)]
+>              ((Just f,_),_) -> [(f,r) | r <- [2..7]]
+>              -- no capture !
+>              (_,(Just f,_)) -> [(f,r) | r <- [2..7]]
+>              _ -> error "strange pawn move:"
+
+>      the_correct_move = if (length correct_move /= 1)
+>                         then error ("\nAmbiguous move:"
+>              ++ show (unwords (map userFormat correct_move))
+>              ++ ":" ++ {- userFormat absmove ++ -} "\n"
+>              ++ userFormat brd)
+>              else head correct_move
+
+>      correct_move = 
+>              filter (sameQueening queen.extractSpecialFromPlayMove)
+>              (filter (compExBPandBP move_dest.extractDestFromPlayMove)
+>                      correct_src)
+>      sameQueening (Just p) (Queening p') = p == p'
+>      sameQueening Nothing  (Queening p') = Queen == p'
+>      sameQueening _ _ = True
+
+>      move_txt = createShortMove the_correct_move "" brd
+>      corr_txt = 
+>          userFormatBoardPos 
+>              (extractSrcFromPlayMove the_correct_move) ++
+>          userFormatBoardPos
+>              (extractDestFromPlayMove the_correct_move) 
+>              {- queening ?? -}
+>      new_brd = makeAMove brd the_correct_move
+
+Now castling, which is very obvious.
+       
+Now piece movement.
+
+> findAMove
+>      :: Piece
+>      -> ExBoardPos 
+>      -> ExBoardPos 
+>      -> Board
+>      -> (String,Board)
+
+> findAMove move_piece move_src move_dest brd@(Board arr mv _) 
+>      = debug (move_txt,new_brd)
+>   where
+
+First get char's about this move
+
+>      move_colour = getMoveColour mv
+
+>      debug   = {- trace (
+>              {- userFormat brd ++ -}
+>              userFormat (getMoveColour mv) ++ 
+>              " (" ++ {- userFormat absmove ++ -} ")" ++
+>              "\nALL   :" ++ unwords (map userFormat all_moves) ++
+>              "\nDEST  :" ++ unwords (map userFormat correct_dest) ++
+>              "\nSRC   :" ++ unwords (map userFormat correct_move) ++
+>              "\n") -} id 
+>              
+
+Now get all valid moves (for the correct piece), including some 
+illegal moves (ie. pinned pieces).
+
+>      all_moves = allValidMoves brd move_piece (const True)
+
+Now filter out the moves it *cant* be.
+
+>      correct_dest = filter
+>              (compExBPandBP move_dest.extractDestFromPlayMove)
+>                      all_moves
+>      correct_move = filter
+>              (compExBPandBP move_src.extractSrcFromPlayMove)
+>                      correct_dest
+>      the_correct_move = if (length correct_move /= 1)
+>                         then error ("\nAmbiguous move:"
+>              ++ show (unwords (map userFormat correct_move))
+>              ++ ":" {- ++ userFormat absmove -} ++ "\n"
+>              ++ userFormat brd)
+>              else head correct_move
+>      disamb = case move_dest of
+>                (Just _,Nothing) -> ""        -- fg => fxg4, no disambig.
+>                _ -> disAmb
+>                   (extractSrcFromPlayMove the_correct_move)
+>                   (map (extractSrcFromPlayMove) correct_dest)
+
+>      move_txt = createShortMove the_correct_move disamb brd
+>      corr_txt = 
+>          userFormatBoardPos 
+>              (extractSrcFromPlayMove the_correct_move) ++
+>          userFormatBoardPos
+>              (extractDestFromPlayMove the_correct_move) 
+>              {- queening -}
+>      new_brd = makeAMove brd the_correct_move
+> --partain: findAMove _ _ _ brd = error ("strange move: ")
+
+> allValidMoves :: Board -> Piece -> (ChessFile -> Bool) -> [PlayMove]
+> allValidMoves brd piece corr_file
+>   = concat (map (getAllMovesFor brd) (getCurrPieces brd piece corr_file)) 
+
+> getCurrPieces 
+>      :: Board 
+>      -> Piece 
+>      -> (ChessFile -> Bool)
+>      -> [(Piece,ChessFile,ChessRank)]
+> getCurrPieces (Board arr (MoveNumber _ col) _) pc corr_file =
+>      [ (p,x,y) |
+>              ((x,y), r) <- assocs arr,
+>              lookupSquare col r == Friendly,
+>              (Just p) <- [getSquarePiece r],
+>              p == pc,
+>              corr_file x
+>               ]
+
+%------------------------------------------------------------------------------
+
+Given a board and a particular piece,
+where can it get to ?
+
+> getAllMovesFor :: Board -> (Piece,Int,Int) -> [PlayMove]
+
+First the easy pieces, the gliders.
+
+> getAllMovesFor brd (Rook,x,y) = 
+>      [ mkPlayMove Rook (x,y) (x',y')
+>        | (x',y') <- (
+>              movePiece 0    1 brd x y ++
+>              movePiece 0 (-1) brd x y ++
+>              movePiece 1    0 brd x y ++
+>              movePiece (-1) 0 brd x y) ]
+> getAllMovesFor brd (Bishop,x,y) = 
+>      [ mkPlayMove Bishop (x,y) (x',y')
+>        | (x',y') <- (
+>              movePiece 1      1  brd x y ++
+>              movePiece 1    (-1) brd x y ++
+>              movePiece (-1)   1  brd x y ++
+>              movePiece (-1) (-1) brd x y) ]
+> getAllMovesFor brd (Queen,x,y) = 
+>      [ mkPlayMove Queen (x,y) (x',y')
+>        | (x',y') <- (
+>              movePiece 0    1    brd x y ++
+>              movePiece 0 (-1)    brd x y ++
+>              movePiece 1    0    brd x y ++
+>              movePiece (-1) 0    brd x y ++
+>              movePiece 1      1  brd x y ++
+>              movePiece 1    (-1) brd x y ++
+>              movePiece (-1)   1  brd x y ++
+>              movePiece (-1) (-1) brd x y) ]
+
+Now the `hoppers'.
+
+> getAllMovesFor brd (Knight,x,y) =
+>      [ mkPlayMove Knight (x,y) (x',y')
+>          | (xd,yd) <- concat 
+>                      [ [(d1,d2 * 2),(d1 * 2,d2)]
+>                              | d1 <- [1,-1], d2 <- [1,-1]],
+>              x' <- [xd + x],
+>              y' <- [yd + y],
+>              case lookupBoard brd (x',y') of
+>                Vacant -> True
+>                Friendly -> False
+>                Baddy -> True
+>                OffBoard -> False]
+
+> getAllMovesFor brd (King,x,y) =
+>      [ mkPlayMove King (x,y) (x',y')
+>          | (xd,yd) <- [(1,1),(1,0),(1,-1),(0,1),
+>                        (0,-1),(-1,1),(-1,0),(-1,-1)],
+>              x' <- [xd + x],
+>              y' <- [yd + y],
+>              case lookupBoard brd (x',y') of
+>                Vacant -> True
+>                Friendly -> False
+>                Baddy -> True
+>                OffBoard -> False]
+
+Now the *special* case, the pawn! Pain in the neck.
+ToDo: add en-passant
+
+> getAllMovesFor brd@(Board _ (MoveNumber _ col) may_ep) (Pawn,x,y) 
+>      = real_pawn_moves
+>   where
+>      pawn_moves = 
+>              case lookupBoard brd (x,y+del) of
+>                Friendly -> []
+>                Baddy -> []
+>                Vacant -> (mkPlayMove Pawn (x,y) (x,y+del) :
+>                   if y /= sta then [] else
+>                   case lookupBoard brd (x,y+del*2) of
+>                      Friendly -> []
+>                      Baddy -> []
+>                      Vacant -> 
+>                        [ PlayMove Pawn (x,y) (x,y+del*2) BigPawnMove])
+>      left_pc = case lookupBoard brd (x-1,y+del) of
+>                       Baddy -> [mkPlayMove Pawn (x,y) (x-1,y+del) ]
+>                       _ -> []
+>      right_pc = case lookupBoard brd (x+1,y+del) of
+>                       Baddy -> [mkPlayMove Pawn (x,y) (x+1,y+del) ]
+>                       _ -> []
+>      all_pawn_moves = pawn_moves ++ left_pc ++ right_pc 
+>      real_pawn_moves = en_passant ++
+>              (if y + del == qn       -- if can queens
+>              then concat [ let fn = PlayMove Pawn f t . Queening
+>                            in
+>                              [ fn Queen,
+>                                fn Rook,
+>                                fn Bishop,
+>                                fn Knight ]
+>                              | PlayMove _ f t _ <- all_pawn_moves ]
+>                else all_pawn_moves)
+>      en_passant = 
+>          case (y == ep,may_ep) of
+>              (True,Just f) | f == x+1 || f == x-1 
+>                -> [PlayMove Pawn (x,y) (f,y+del) EnPassant]
+>              _ -> []
+>      del,sta,qn,ep :: Int
+>      (del,sta,qn,ep) -- delta (direction), start, Queening and E.P. Rank
+>          = case col of
+>              White -> (1,2,8,5)
+>              Black -> (-1,7,1,4)
+
+> movePiece xd yd brd x y = 
+>      case lookupBoard brd (x',y') of
+>        OffBoard -> []
+>        Friendly -> []
+>        Baddy    -> [(x',y')]
+>        Vacant   ->  (x',y') : movePiece xd yd brd x' y'
+>      where
+>          x' = x + xd
+>          y' = y + yd 
+
+
+%------------------------------------------------------------------------------
+
+> makeAMove :: Board -> PlayMove -> Board
+> makeAMove board@(Board brd mv@(MoveNumber _ col) _)
+>      move@(PlayMove piece pos pos' NothingSpecial)  =
+>      Board (brd //  [ pos =: VacantSq,
+>                      pos' =: mkColBoardSq col piece ])
+>                      (incMove mv) Nothing
+> makeAMove board@(Board brd mv@(MoveNumber _ col) _)
+>      move@(PlayMove piece pos@(f,_) pos' BigPawnMove)  =
+>      Board (brd //  [ pos =: VacantSq,
+>                      pos' =: mkColBoardSq col piece ])
+>                      (incMove mv) (Just f)
+> makeAMove board@(Board brd mv@(MoveNumber _ col) _)
+>      move@(PlayMove piece pos@(f,_) pos' (Queening q))  =
+>      Board (brd //  [ pos =: VacantSq,
+>                      pos' =: mkColBoardSq col q])
+>                      (incMove mv) (Just f)
+> makeAMove board@(Board brd mv@(MoveNumber _ col) _)  -- ASSERT ?
+>      move@(PlayMove piece (f,_) (f',_) EnPassant) =
+>      Board (brd // [ (f,st) =: VacantSq,
+>                      (f',fn) =: mkColBoardSq col Pawn,
+>                      (f',st) =: VacantSq ])
+>                      (incMove mv) Nothing
+>   where (st,fn) = case col of
+>                    White -> (5,6)
+>                    Black -> (4,3)
+
+> makeACastleK (Board brd mv@(MoveNumber _ White) _) =
+>      Board (brd //
+>            [ (5,1) =: VacantSq,
+>              (6,1) =: mkColBoardSq White Rook,
+>              (7,1) =: mkColBoardSq White King,
+>              (8,1) =: VacantSq ]) (incMove mv) Nothing
+> makeACastleK (Board brd mv@(MoveNumber _ Black) _) =
+
+>      Board (brd //
+>            [ (5,8) =: VacantSq,
+>              (6,8) =: mkColBoardSq Black Rook,
+>              (7,8) =: mkColBoardSq Black King,
+>              (8,8) =: VacantSq ]) (incMove mv) Nothing
+> makeACastleQ (Board brd mv@(MoveNumber _ White) _) =
+>      Board (brd //
+>            [ (5,1) =: VacantSq,
+>              (4,1) =: mkColBoardSq White Rook,
+>              (3,1) =: mkColBoardSq White King,
+>              (1,1) =: VacantSq ]) (incMove mv) Nothing
+> makeACastleQ (Board brd mv@(MoveNumber _ Black) _) =
+>      Board (brd //
+>            [ (5,8) =: VacantSq,
+>              (4,8) =: mkColBoardSq Black Rook,
+>              (3,8) =: mkColBoardSq Black King,
+>              (1,8) =: VacantSq ]) (incMove mv) Nothing
+
+> disAmb _ [_] = ""
+> disAmb (a,b) t@[(n,m),(x,y)] 
+>      | n == x    = userFormatRank b
+>      | otherwise = userFormatFile a
+> disAmb src lst = error ("PANIC: cant disambiguate: " ++ show src ++ show lst)
+
+> createShortMove :: PlayMove -> String -> Board -> String
+> createShortMove (PlayMove Pawn (f,r) dest q) "" brd = 
+>      (if lookupBoard brd dest == Baddy || EnPassant == q
+>       then userFormatFile f ++ "x" ++ userFormatBoardPos dest
+>       else userFormatBoardPos dest) ++
+>      case q of
+>        Queening p -> "=" ++ userFormat p
+>        _ -> ""
+> createShortMove (PlayMove p _ dest _) extra brd =
+>      userFormat p ++ extra ++ capt ++ userFormatBoardPos dest
+>   where
+>      capt = if lookupBoard brd dest == Baddy
+>             then "x"
+>             else ""
+
+> getEPStart :: Colour -> ChessFile
+> getEPStart White = 5
+> getEPStart Black = 4
+
+> getEPEnd :: Colour -> ChessFile
+> getEPEnd White = 6
+> getEPEnd Black = 3
+
+> getHomeRank :: Colour -> ChessRank
+> getHomeRank White = 1
+> getHomeRank Black = 8
+
diff --git a/ghc/tests/programs/andy_cherry/Main.lhs b/ghc/tests/programs/andy_cherry/Main.lhs
new file mode 100644 (file)
index 0000000..beab702
--- /dev/null
@@ -0,0 +1,203 @@
+> module Main (main) where
+
+> import GenUtils
+> import DataTypes
+> import Parser
+> import Interp
+> import PrintTEX
+
+> import System -- 1.3 (partain)
+> import Char -- 1.3
+
+> --fakeArgs = "game001.txt"
+> --fakeArgs = "pca2.pgn"
+> --fakeArgs = "silly.pgn"
+> --fakeArgs = "small.pgn"
+> --fakeArgs = "sicil.pgn"
+> --fakeArgs = "badgame.pgn"
+> --fakeArgs = "mycgames.pgn"
+> fakeArgs = "rab.pgn"
+
+> version = "0.3"
+
+
+> main = do
+>      args <- getArgs
+>      let (style,fn,filename) = interpArgs args
+>      file <- readFile filename
+>      std_in <- getContents
+>      let games = pgnParser fn file   -- parse relavent pgn games
+>      putStr (prog style std_in games)
+
+>{- OLD 1.2:
+> main = 
+>      getArgs         abort                           $ \ args ->
+>      --let args = (words "-d tex analgames.pgn") in
+>      let (style,fn,filename) = interpArgs args in
+>      readFile filename abort                         $ \ file ->
+>      readChan stdin abort                            $ \ std_in ->
+>      let games = pgnParser fn file   -- parse relavent pgn games
+>      in
+>      appendChan stdout (prog style std_in games) abort done
+>-}
+
+> interpArgs :: [String] -> (OutputStyle,Int -> Bool,String)
+> --interpArgs [] = (ViewGame,const True,fakeArgs)
+> interpArgs [] = interpArgs (words "-d pgn analgames.pgn")
+> interpArgs files = interpArgs' OutputPGN (const True) files
+
+> interpArgs' style fn ("-d":"pgn":xs)    = interpArgs' OutputPGN    fn xs
+> interpArgs' style fn ("-d":"rawpgn":xs) = interpArgs' OutputRawPGN fn xs
+> interpArgs' style fn ("-d":"play":xs)   = interpArgs' ViewGame     fn xs
+> interpArgs' style fn ("-d":"parser":xs) = interpArgs' OutputParser fn xs
+> interpArgs' style fn ("-d":"tex":xs)    = interpArgs' OutputTEX    fn xs
+> interpArgs' style fn ("-d":"head":xs)   = interpArgs' OutputHeader fn xs
+> interpArgs' style fn ("-g":range:xs) 
+>      = interpArgs' style (changeFn (parse range)) xs
+>    where
+>      changeFn (Digit n:Line:Digit m:r) x = moreChangeFn r x || x >= n && x <= m 
+>      changeFn (Line:Digit m:r) x = moreChangeFn r x || x <= m 
+>      changeFn (Digit n:Line:r) x = moreChangeFn r x || x >= n 
+>      changeFn (Digit n:r) x = moreChangeFn r x || x == n
+>      changeFn _ _ = rangeError
+>      moreChangeFn [] = const False
+>      moreChangeFn (Comma:r) = changeFn r
+>      moreChangeFn _ = rangeError
+>      parse xs@(n:_) 
+>              | isDigit n = case span isDigit xs of
+>                              (dig,rest) -> Digit (read dig) : parse rest
+>      parse ('-':r) = Line : parse r
+>      parse (',':r) = Comma : parse r
+>      parse [] = []
+>      parse _ = rangeError
+>      rangeError = error ("incorrect -g option (" ++ range ++ ")\n")
+
+> interpArgs' style fn [file] = (style,fn,file)
+> interpArgs' style fn args = error ("bad args: " ++ unwords args)
+
+> data Tok 
+>      = Digit Int             -- n
+>      | Line                  -- -
+>      | Comma                 -- ,
+
+> data OutputStyle
+
+>      = OutputPGN             -- pgn
+>      | OutputRawPGN          -- rawpgn
+>      | OutputHeader          -- header
+>      | ViewGame              -- play
+>      | ViewGameEmacs         -- emacs
+>      | TwoColumn             -- 2col
+>      | TestGames             -- test
+>      | OutputTEX
+
+Finally the debug options.
+
+>      | OutputParser  -- simply dump out the string read in.
+>      | CmpGen        -- cmp 2nd and 3rd generations of output 
+
+The *main* program. 
+
+> prog :: OutputStyle          -- style of action
+>      -> String               -- stdin (for interactive bits)
+>      -> [AbsGame]            -- input games
+>      -> String               -- result
+> prog OutputPGN _
+>              = pgnPrinter True       -- print out game(s)
+>              . map runInterp         -- interprete all games
+> prog OutputRawPGN _
+>              = pgnPrinter False      -- print out game(s)
+>              . map runInterp         -- interprete all games
+> prog OutputHeader _
+>              = pgnHeadPrinter        -- print out game(s) headers
+>              . map runInterp         -- interprete all games
+> prog OutputTEX _
+>              = texPrinter            -- print out game(s)
+>              . map runInterp         -- interprete all games
+> prog ViewGame std_in
+>              = interactViewer std_in -- print out game(s)
+>              . runInterp             -- interprete the game
+>              . head                  -- should check for only *one* object
+> prog OutputParser _ 
+>              = userFormat
+
+%------------------------------------------------------------------------------
+
+Printing the pgn file.
+
+1) if White, *always* print number,
+2) is After comment / variation, print number, ie 2. Nf4 ( <stuff> ) 2... Rh8 
+
+
+> type PrintState = (Bool,MoveNumber) 
+
+> pgnPrinter :: Bool -> [RealGame] -> String
+> pgnPrinter detail = unlines . concat . map printGame
+>   where
+>      printMoveNumber :: Bool -> MoveNumber -> String
+>      printMoveNumber False (MoveNumber _ Black) = ""
+>      printMoveNumber _     mvnum = userFormat mvnum ++ " "
+
+>      printQuantums :: PrintState -> [Quantum] -> [String]
+>      printQuantums ps = concat . fst . mapAccumL printQuantum ps
+
+>      printQuantum :: PrintState -> Quantum -> ([String],PrintState)
+>      printQuantum (pnt,mv) (QuantumMove move ch an brd) =
+>              ([printMoveNumber pnt mv ++ move ++ ch],(False,incMove mv))
+>      printQuantum (pnt,mv) (QuantumNAG i) = 
+>              if detail
+>              then (["$" ++ show i],(False,mv))
+>              else ([],(False,mv))
+>      printQuantum (pnt,mv) (QuantumComment comms) = 
+>              if detail
+>              then ("{" : comms ++ ["}"],(True,mv))
+>              else ([],(False,mv))
+>      printQuantum (pnt,mv) (QuantumAnalysis anal) = 
+>              if detail
+>              then ("(" : printQuantums (True,decMove mv) anal ++ [")"],
+>                      (True,mv))
+>              else ([],(False,mv))
+>      printQuantum (pnt,mv) (QuantumResult str) = ([str],(True,mv))
+>      printQuantum _ _ = error "PANIC: strange Quantum"
+
+>      printGame :: RealGame -> [String]
+>      printGame (Game tags qu) = 
+>              [ userFormat tag | tag <- tags] ++
+>              formatText 75 (printQuantums (False,initMoveNumber) qu)
+
+%------------------------------------------------------------------------------
+
+> printHeadGame :: RealGame -> [String]
+> printHeadGame (Game tags qu) = [
+>      rjustify 4 gameno ++ " " ++
+>      take 20 (rjustify 20 white) ++ " - " ++ 
+>      take 20 (ljustify 20 black) ++ " " ++ 
+>      take 26 (ljustify 28 site) ++ " " ++ result ]
+>   where
+>      (date,site,game_no,res,white,black,opening) = getHeaderInfo tags
+>      gameno = case game_no of
+>                Nothing -> ""
+>                Just n -> show n
+>      result = userFormat res
+
+> pgnHeadPrinter :: [RealGame] -> String
+> pgnHeadPrinter = unlines . concat . map printHeadGame
+
+%------------------------------------------------------------------------
+
+This gives an interactive playback of a game.
+
+> interactViewer :: String -> RealGame -> String
+> interactViewer stdin (Game tags qu) = replayQ qu (lines stdin)
+
+> replayQ (QuantumMove _ _ _ brd:rest) std_in 
+>      = "\027[H" ++ userFormat brd ++ waitQ rest std_in
+> replayQ (_:rest) std_in = replayQ rest std_in
+> replayQ [] _ = []
+
+> waitQ game std_in = ">>" ++ 
+>    (case std_in of
+>      [] -> ""
+>      (q:qs) -> replayQ game qs)
+
+
diff --git a/ghc/tests/programs/andy_cherry/Makefile b/ghc/tests/programs/andy_cherry/Makefile
new file mode 100644 (file)
index 0000000..9e09011
--- /dev/null
@@ -0,0 +1,10 @@
+TOP = ../..
+include $(TOP)/mk/boilerplate.mk
+
+SRC_HC_OPTS += -cpp
+SRC_RUNTEST_OPTS += -d tex mygames.pgn
+
+all :: runtest
+
+include $(TOP)/mk/target.mk
+
diff --git a/ghc/tests/programs/andy_cherry/Parser.lhs b/ghc/tests/programs/andy_cherry/Parser.lhs
new file mode 100644 (file)
index 0000000..020e4f4
--- /dev/null
@@ -0,0 +1,97 @@
+> module Parser (pgnLexer,pgnParser) where
+
+> import GenUtils
+> import DataTypes
+> import Char -- 1.3
+
+This is a PGN lexer. Simple, and straightforward.
+
+> pgnLexer :: String -> [Token]
+> pgnLexer ('.':r) = PeriodToken  : pgnLexer r
+> pgnLexer ('*':r) = AsterixToken : pgnLexer r
+> pgnLexer ('[':r) = LeftSBToken  : pgnLexer r
+> pgnLexer (']':r) = RightSBToken : pgnLexer r
+> pgnLexer ('(':r) = LeftRBToken  : pgnLexer r
+> pgnLexer (')':r) = RightRBToken : pgnLexer r
+> pgnLexer ('<':r) = LeftABToken  : pgnLexer r
+> pgnLexer ('>':r) = RightABToken : pgnLexer r
+> pgnLexer ('"':r) = readString r ""
+> pgnLexer ('{':r) = readComment r ""
+> pgnLexer ('$':r) = readNAG r ""
+> pgnLexer ('!':'?':r) = mkNAGToken 5 : pgnLexer r
+> pgnLexer ('!':'!':r) = mkNAGToken 3 : pgnLexer r
+> pgnLexer ('!':r)     = mkNAGToken 1 : pgnLexer r
+> pgnLexer ('?':'?':r) = mkNAGToken 4 : pgnLexer r
+> pgnLexer ('?':'!':r) = mkNAGToken 6 : pgnLexer r
+> pgnLexer ('?':r)     = mkNAGToken 2 : pgnLexer r
+> pgnLexer ('%':r) = pgnLexer (dropWhile (/= '\n') r)
+> pgnLexer (c:r)
+>      | isSpace c = pgnLexer r
+>      | isAlpha c || isDigit c = pgnSymbolLexer r [c]
+>      | otherwise = error ("Error lexing: " ++ takeWhile (/= '\n') (c:r))
+> pgnLexer [] = []
+
+> pgnSymbolLexer (c:r) sym 
+>      | isAlpha c 
+>      || isDigit c 
+>      || elem c "_+#=:-/" = pgnSymbolLexer r (c:sym)
+> pgnSymbolLexer r sym 
+>      | all isDigit sym = IntToken (read (reverse sym)) : pgnLexer r
+> pgnSymbolLexer r sym   = SymbolToken (reverse sym) : pgnLexer r
+
+> readString ('\\':'\\':r) str = readString r ('\\':str)
+> readString ('\\':'"':r) str = readString r ('"':str)
+> readString ('"':r) str     = StringToken (reverse str) : pgnLexer r
+> readString (c:r) str       = readString r (c:str)
+
+> readComment ('}':r) str = CommentToken (revwords str []) : pgnLexer r
+> readComment (c:r) str = readComment r (c:str)
+
+> revwords (c:r) wds
+>    | isSpace c = revwords r wds
+>    | otherwise = revwords' r [c] wds
+> revwords [] wds = wds
+> revwords' (c:r) wd wds 
+>    | isSpace c = revwords r (wd:wds)
+>    | otherwise = revwords' r (c:wd) wds
+> revwords' [] wd wds = wd : wds
+
+> readNAG (c:r) str
+>      | isDigit c = readNAG r (c:str)
+> readNAG r str = mkNAGToken (read (reverse str)) : pgnLexer r
+
+> mkNAGToken 1 = NAGAnnToken 1 "!" 
+> mkNAGToken 2 = NAGAnnToken 2 "?" 
+> mkNAGToken 3 = NAGAnnToken 3 "!!"
+> mkNAGToken 4 = NAGAnnToken 4 "??"
+> mkNAGToken 5 = NAGAnnToken 5 "!?"
+> mkNAGToken 6 = NAGAnnToken 6 "?!"
+> mkNAGToken n = NAGToken n
+
+And this is a parser for PGN. It takes a list of tokens,
+and splits up games, as well as nesting varations, etc.
+
+> pgnParser :: (Int -> Bool) -> String -> [AbsGame]
+> pgnParser fn str = 
+>      [ game | (no,game) <- zip [1..] (parseTags (pgnLexer str) id),
+>               fn no]
+
+> type FL a = [a] -> [a]
+
+> parseTags :: [Token] -> FL TagStr -> [AbsGame]
+> parseTags (LeftSBToken:SymbolToken sym:StringToken str:RightSBToken:rest) 
+>          other_tags = parseTags rest (other_tags . ((:) (TagStr sym str)))
+> parseTags toks@(LeftSBToken:_) _
+>      = error ("BAD Token:" ++ unwords (map userFormat (take 10 toks)))
+> parseTags toks tags = parseToks toks id tags
+
+> parseToks :: [Token] 
+>      -> FL Token 
+>      -> FL TagStr
+>      -> [AbsGame]
+> parseToks next@(LeftSBToken:_)     = \ toks tags ->
+>      Game (tags []) (toks []) : parseTags next id
+> parseToks (tk:r)                   = pushToken tk r 
+> parseToks [] = \ toks tags -> [Game (tags []) (toks [])]
+
+> pushToken tok r toks = parseToks r (toks . ((:) tok))
diff --git a/ghc/tests/programs/andy_cherry/PrintTEX.lhs b/ghc/tests/programs/andy_cherry/PrintTEX.lhs
new file mode 100644 (file)
index 0000000..31d632d
--- /dev/null
@@ -0,0 +1,181 @@
+> module PrintTEX (texPrinter) where
+
+> import GenUtils
+> import DataTypes
+> import Array -- 1.3
+> import Char -- 1.3
+
+This is the driver that prints a file suitable for input into latex.
+
+print_TeX_move :: String -> MoveNumber -> 
+
+1. turn [Quantum] -> [[Quantum]]
+
+> splitUpQuantum :: [Quantum] -> [[Quantum]]
+> splitUpQuantum q = splitUpQuantums q []
+>   where
+>      splitUpQuantums [] [] = []
+>      splitUpQuantums [] mvs = [reverse mvs]
+>      splitUpQuantums (mv@(QuantumMove _ _ _ _):rest) mvs
+>              = splitUpQuantums rest (mv:mvs)
+>      splitUpQuantums (mv@(QuantumNAG _):rest) mvs
+>              = splitUpQuantums rest mvs
+>      splitUpQuantums (x:xs) [] = [x] : splitUpQuantums xs []
+>      splitUpQuantums (x:xs) mvs 
+>              = [reverse mvs,[x]] ++ splitUpQuantums xs []
+
+> type TeXState = 
+>      (Bool,          -- if Top level !
+>      Board,          -- current board
+>      MoveNumber)     -- the Current Move Number
+
+> printTeXQuantums :: TeXState -> [Quantum] -> [String]
+> printTeXQuantums ps
+>      = concat . fst . mapAccumL printTeXQuantum ps . splitUpQuantum
+
+> printTeXQuantum :: TeXState -> [Quantum] -> ([String],TeXState)
+> printTeXQuantum state@(_,board,_) [QuantumComment ["\004"]] = 
+>      (mkTeXBoard board,state)
+> printTeXQuantum state@(_,board,_) [QuantumComment (('\004':comm):comms)] = 
+>      (mkTeXBoard board ++ formatText 70 (parseSquiggles (comm:comms)),state)
+> printTeXQuantum state [QuantumComment comms] = 
+>      (formatText 70 (parseSquiggles comms),state)
+> printTeXQuantum (pnt,brd,mv) [QuantumAnalysis anal] =
+>      (printTeXQuantums (False,err,decMove mv) anal,(pnt,brd,mv))
+>   where err = error "Syntax error using ^D"
+> printTeXQuantum state@(_,board,_) [QuantumResult str] = 
+>      (mkTeXBoard board ++ [printTeXResult (mkResult str)],state)
+> printTeXQuantum state mvs@(QuantumMove _ _ _ _:_) =
+>      printTeXMoves state mvs
+> printTeXQuantum _ _ = error "PANIC: strange Quantum"
+
+
+> parseSquiggles = map parseSquiggle
+> parseSquiggle ('<':'s':'a':'w':'>':r) = "\\wbetter{}" ++ r
+> parseSquiggle ('<':'a':'w':'>':r)     = "\\wupperhand{}" ++ r
+> parseSquiggle ('<':'w':'a':'w':'>':r) = "\\wdecisive{}" ++ r
+> parseSquiggle ('<':'s':'a':'b':'>':r) = "\\bbetter{}" ++ r
+> parseSquiggle ('<':'a':'b':'>':r)     = "\\bupperhand{}" ++ r
+> parseSquiggle ('<':'w':'a':'b':'>':r) = "\\bdecisive{}" ++ r
+> parseSquiggle wd = wd
+
+
+> printTeXResult :: Result -> String
+> printTeXResult Win     = "$1\\!-\\!0$"
+> printTeXResult Loss    = "$0\\!-\\!1$"
+> printTeXResult Draw    = "${1 \\over 2}\\!-\\!{1 \\over 2}$"
+> printTeXResult Unknown = "$*$"
+
+> printTeXMoves (tl,_,mv) mvs 
+>      = ([text],(True,brd,incMove last_mv_num))
+>    where
+>      aux_mvs = zip3 mvs (iterate incMove mv) (False:repeat True)
+
+>      (QuantumMove _ _ _ brd,last_mv_num,_) = last aux_mvs
+>      text = initText tl
+>          ++ concat (fst (mapAccumL (pntMove tl) (mv,False) mvs))
+>          ++ endText tl 
+
+>      initText False = 
+>           case mv of
+>              MoveNumber i Black -> "|" ++ show i ++ "\\ldots~"
+>              _ -> "|"
+>      initText True = 
+>              "\\begin{center}|\n" ++
+>              "{\\bf" ++
+>              "\\begin{tabular}{rp{50pt}p{50pt}}\n" ++
+>           case mv of
+>              MoveNumber i Black -> show i ++ " & \\ldots"
+>              _ -> ""
+
+>      endText True = case getMoveColour last_mv_num of
+>              White -> "&\\\\\n\\end{tabular}}|\n\\end{center}"
+>              Black -> "\\end{tabular}}|\n\\end{center}"
+>      endText False =  "|"
+
+Use zip here !
+
+>      pntMove True (mv@(MoveNumber i White),bl) move
+>              = (show i ++ " & " 
+>              ++ printableMove move,
+>                (incMove mv,True))
+>      pntMove True (mv@(MoveNumber i Black),bl) move
+>              = (" & " ++ printableMove move ++ "\\\\\n",
+>                (incMove mv,True))
+>      pntMove False (mv@(MoveNumber i White),bl) move
+>              = ((if bl then "; " else "") ++ show i ++ ".~"
+>                      ++ printableMove move,
+>                (incMove mv,True))
+>      pntMove False (mv@(MoveNumber i Black),bl) move
+>              = ((if bl then ", " else "") ++ printableMove move,
+>                (incMove mv,True))
+
+> printableMove :: Quantum -> String
+> printableMove (QuantumMove move ch an _) = map fn move ++ rest
+>    where
+>      fn 'x' = '*'
+>      fn 'O' = '0'
+>      fn c   = c
+>      rest = case ch of
+>              "#" -> an ++ " mate"
+>              _   -> ch ++ an
+
+> mkTeXBoard :: Board -> [String]
+> mkTeXBoard (Board arr _ _) = 
+>      ["\n\\board"] ++
+>      ["{" ++ [ fn ((x-y) `rem` 2 == 0) (arr ! (x,y)) | x <- [1..8]] ++ "}" 
+>                      | y <- reverse [1..8]] ++
+>      ["$$\\showboard$$"]
+>  where
+>      fn _ (WhitesSq p) = head (userFormat p)
+>      fn _ (BlacksSq p) = toLower (head (userFormat p))
+>      fn True VacantSq = '*'
+>      fn False VacantSq = ' '
+
+> printTeXGame :: RealGame -> [String]
+> printTeXGame (Game tags qu) = [
+>      "\\clearpage",
+>      "\\begin{center}",
+>      "\\fbox{\\fbox{\\large\\begin{tabular}{l}",
+>      ("Game " ++ gameno ++ " \\hspace{.3 in} " 
+>              ++ date 
+>              ++ " \\hspace{.3 in} " 
+>              ++ result 
+>              ++ "\\\\"),
+>      "\\hline" ++ (if null opening then "" else "\n" ++ opening ++ "\\\\"),
+>      "\\raisebox{2.5pt}[11pt]{\\framebox[11pt]{\\rule{0pt}{4.25pt}}} "
+>              ++ white ++ "\\\\",
+>      "\\rule[-1pt]{11pt}{11pt} "++ black ++ "\\\\",
+>      site,
+>      "\\end{tabular}}}",
+>      "\\end{center}"] ++
+>      (printTeXQuantums (True,startBoard,initMoveNumber) qu)
+>   where
+>      (date,site,game_no,res,white,black,opening) = getHeaderInfo tags
+>      gameno = case game_no of
+>                Nothing -> ""
+>                Just n -> show n
+>      result = printTeXResult res
+
+> texPrinter :: [RealGame] -> String
+> texPrinter games = 
+>         texHeader 
+>      ++ (unlines(concat(map printTeXGame games)))
+>      ++ texFooter
+
+> texHeader =
+>      "\\documentstyle[twocolumn,a4wide,chess]{article}\n" ++
+>      "\\textwidth 7.0 in\n" ++
+>      "\\textheight 63\\baselineskip\n" ++
+>      "\\columnsep .4 in\n" ++
+>      "\\columnseprule .5 pt\n" ++
+>      "\\topmargin -0.5 in\n" ++
+>      "\\headheight 0 pt\n" ++
+>      "\\headsep 0 pt\n" ++
+>      "\\oddsidemargin -0.3 in\n" ++
+>      "\\font\\sc=cmcsc10\n\\pagestyle{empty}\n" ++
+>      "\\begin{document}\n\\thispagestyle{empty}\n\n"
+
+> texFooter = "\n\\end{document}\n"
+
+
diff --git a/ghc/tests/programs/andy_cherry/andy_cherry.stdout b/ghc/tests/programs/andy_cherry/andy_cherry.stdout
new file mode 100644 (file)
index 0000000..ef160b0
--- /dev/null
@@ -0,0 +1,7258 @@
+\documentstyle[twocolumn,a4wide,chess]{article}
+\textwidth 7.0 in
+\textheight 63\baselineskip
+\columnsep .4 in
+\columnseprule .5 pt
+\topmargin -0.5 in
+\headheight 0 pt
+\headsep 0 pt
+\oddsidemargin -0.3 in
+\font\sc=cmcsc10
+\pagestyle{empty}
+\begin{document}
+\thispagestyle{empty}
+
+\clearpage
+\begin{center}
+\fbox{\fbox{\large\begin{tabular}{l}
+Game  \hspace{.3 in} Oct 1993 \hspace{.3 in} $1\!-\!0$\\
+\hline
+Foo C10\\
+\raisebox{2.5pt}[11pt]{\framebox[11pt]{\rule{0pt}{4.25pt}}} George Webb\\
+\rule[-1pt]{11pt}{11pt} Andy Gill\\
+Dunfermline Club Championship
+\end{tabular}}}
+\end{center}
+\begin{center}|
+{\bf\begin{tabular}{rp{50pt}p{50pt}}
+1 & Nf3 & d5\\
+2 & d4 & Nc6\\
+3 & Nc3 & Nf6\\
+\end{tabular}}|
+\end{center}
+|3\ldots~Bf5|
+is more natural.
+\begin{center}|
+{\bf\begin{tabular}{rp{50pt}p{50pt}}
+4 & e4?&\\
+\end{tabular}}|
+\end{center}
+|4.~Bf4|
+is better.
+\begin{center}|
+{\bf\begin{tabular}{rp{50pt}p{50pt}}
+4 & \ldots & e6?\\
+\end{tabular}}|
+\end{center}
+|4\ldots~d*e4; 5.~d5, e*f3; 6.~d*c6, Q*d1+; 7.~N*d1|
+and black is a clear pawn up.
+\begin{center}|
+{\bf\begin{tabular}{rp{50pt}p{50pt}}
+5 & e5 & Ne4\\
+\end{tabular}}|
+\end{center}
+
+\board
+{r*bqkb r}
+{ppp *ppp}
+{ *n*p* *}
+{* *pP * }
+{ * Pn* *}
+{* N *N* }
+{PPP* PPP}
+{R BQKB*R}
+$$\showboard$$
+\begin{center}|
+{\bf\begin{tabular}{rp{50pt}p{50pt}}
+6 & N*e4?&\\
+\end{tabular}}|
+\end{center}
+Taking this knight looses a pawn
+\begin{center}|
+{\bf\begin{tabular}{rp{50pt}p{50pt}}
+6 & \ldots & d*e4\\
+7 & Nd2 & Q*d4\\
+8 & Nc4 & Q*d1+\\
+9 & K*d1 & Bd7\\
+\end{tabular}}|
+\end{center}
+|9\ldots~Bc5; 10.~f3, e*f3; 11.~g*f3, 0-0; 12.~Bd3|
+White can get presure down the `g' file, but first needs to solve the
+problem of the Bishop on c5 guarding g8.
+\begin{center}|
+{\bf\begin{tabular}{rp{50pt}p{50pt}}
+10 & Bd2&\\
+\end{tabular}}|
+\end{center}
+|10.~Be3|
+is better.
+\begin{center}|
+{\bf\begin{tabular}{rp{50pt}p{50pt}}
+10 & \ldots & Bb4\\
+11 & c3 & Bc5\\
+12 & Ke1 & 0-0-0\\
+\end{tabular}}|
+\end{center}
+|12\ldots~b5; 13.~Ne3, B*e3; 14.~B*e3, N*e5|
+wins a pawn, but black might have problems because of queenside
+weaknesses.
+\begin{center}|
+{\bf\begin{tabular}{rp{50pt}p{50pt}}
+13 & g3&\\
+\end{tabular}}|
+\end{center}
+|13.~Bg5, Be7; 14.~B*e7, N*e7; 15.~Rd1|
+and white is starting to contest the `d' file.
+\begin{center}|
+{\bf\begin{tabular}{rp{50pt}p{50pt}}
+13 & \ldots & Rhf8\\
+14 & Bg2 & f5?\\
+\end{tabular}}|
+\end{center}
+black is throwing away a pawn.
+\begin{center}|
+{\bf\begin{tabular}{rp{50pt}p{50pt}}
+15 & e*f6 & g*f6\\
+\end{tabular}}|
+\end{center}
+|15\ldots~R*f6|
+gives black more piece activity.
+\begin{center}|
+{\bf\begin{tabular}{rp{50pt}p{50pt}}
+16 & B*e4&\\
+\end{tabular}}|
+\end{center}
+taking the weak pawn, and attacking h7.
+\begin{center}|
+{\bf\begin{tabular}{rp{50pt}p{50pt}}
+16 & \ldots & e5?\\
+\end{tabular}}|
+\end{center}
+|16\ldots~Rh8|
+is required to protect the weak h pawn.
+\begin{center}|
+{\bf\begin{tabular}{rp{50pt}p{50pt}}
+17 & B*h7&\\
+\end{tabular}}|
+\end{center}
+
+\board
+{ *kr r *}
+{pppb* *B}
+{ *n* p *}
+{* b p * }
+{ *N* * *}
+{* P * P }
+{PP B P P}
+{R * K *R}
+$$\showboard$$
+\begin{center}|
+{\bf\begin{tabular}{rp{50pt}p{50pt}}
+17 & \ldots & f5\\
+\end{tabular}}|
+\end{center}
+|17\ldots~B*f2+; 18.~K*f2, Be6; 19.~N*e5, R*d2+; 20.~Ke1, R*b2|
+winning material, and striping whites king of protection.
+\begin{center}|
+{\bf\begin{tabular}{rp{50pt}p{50pt}}
+18 & b4 & Be6\\
+19 & b5&\\
+\end{tabular}}|
+\end{center}
+|19.~b*c5, B*c4|
+and white has the two bishops.
+\begin{center}|
+{\bf\begin{tabular}{rp{50pt}p{50pt}}
+19 & \ldots & B*c4\\
+20 & b*c6 & b*c6\\
+\end{tabular}}|
+\end{center}
+|20\ldots~B*f2+; 21.~K*f2, R*d2+; 22.~Ke1, Re2+; 23.~Kd1, b*c6; 24.~h4, Rd8+|
+with a winning attack on whites exposed king.
+\begin{center}|
+{\bf\begin{tabular}{rp{50pt}p{50pt}}
+21 & Rb1?&\\
+\end{tabular}}|
+\end{center}
+Throws away a pawn needlessly.
+\begin{center}|
+{\bf\begin{tabular}{rp{50pt}p{50pt}}
+21 & \ldots & B*a2\\
+\end{tabular}}|
+\end{center}
+|21\ldots~B*f2+; 22.~K*f2, R*d2+; 23.~Ke1, R*a2|
+winning two pawns rather than one.
+\begin{center}|
+{\bf\begin{tabular}{rp{50pt}p{50pt}}
+22 & Rb2 & Bd5\\
+23 & Rg1 & e4\\
+\end{tabular}}|
+\end{center}
+|23\ldots~a5; 24.~h4, a4; 25.~Bh6, Bf3; 26.~Rd2, R*d2; 27.~B*d2|
+is a better plan, with a dangerous passed `a' pawn.
+\begin{center}|
+{\bf\begin{tabular}{rp{50pt}p{50pt}}
+24 & Bh6? & Ba3\\
+\end{tabular}}|
+\end{center}
+|24\ldots~Rf7; 25.~Bg5, R*h7; 26.~B*d8, Ba3; 27.~Rd2, K*d8|
+two bishops vs a rook, a difficult win for black.
+\begin{center}|
+{\bf\begin{tabular}{rp{50pt}p{50pt}}
+25 & Rb1 & Rfe8?\\
+\end{tabular}}|
+\end{center}
+another missed opertunity.
+\begin{center}|
+{\bf\begin{tabular}{rp{50pt}p{50pt}}
+26 & B*f5+ & Be6\\
+27 & Bg6 & Rh8\\
+28 & Be3&\\
+\end{tabular}}|
+\end{center}
+
+\board
+{ *kr * r}
+{p p * * }
+{ *p*b*B*}
+{* * * * }
+{ * *p* *}
+{b P B P }
+{ * * P P}
+{*R* K R }
+$$\showboard$$
+\begin{center}|
+{\bf\begin{tabular}{rp{50pt}p{50pt}}
+28 & \ldots & Rd3?\\
+\end{tabular}}|
+\end{center}
+|28\ldots~R*h2; 29.~B*e4, c5; 30.~Rb7, a5|
+and black has a fighting chance
+\begin{center}|
+{\bf\begin{tabular}{rp{50pt}p{50pt}}
+29 & Bd4&\\
+\end{tabular}}|
+\end{center}
+|29.~B*e4, R*c3; 30.~Bd4, Rc4; 31.~B*h8, R*e4+|
+and black is lost.
+\begin{center}|
+{\bf\begin{tabular}{rp{50pt}p{50pt}}
+29 & \ldots & Bd5??\\
+30 & B*h8 & e3??\\
+31 & f3?&\\
+\end{tabular}}|
+\end{center}
+|31.~B*d3, e*f2+; 32.~K*f2, Bc5+; 33.~Bd4|
+and white is two rooks up.
+\begin{center}|
+{\bf\begin{tabular}{rp{50pt}p{50pt}}
+31 & \ldots & Rd2\\
+32 & Bf6 & Bb2\\
+33 & h4&\\
+\end{tabular}}|
+\end{center}
+|33.~Bf5+, Kb7; 34.~c4, B*c4; 35.~R*b2+, R*b2; 36.~B*b2|
+winning.
+\begin{center}|
+{\bf\begin{tabular}{rp{50pt}p{50pt}}
+33 & \ldots & Kb7\\
+34 & Bg5 & B*f3\\
+\end{tabular}}|
+\end{center}
+|34\ldots~Ba2; 35.~Bc2, B*b1; 36.~B*b1, Rh2; 37.~B*e3, B*c3+|
+and black is just a bishop down in a pawn race.
+\begin{center}|
+{\bf\begin{tabular}{rp{50pt}p{50pt}}
+35 & B*e3 & Re2+\\
+36 & Kf1 & R*e3\\
+37 & Re1??&\\
+\end{tabular}}|
+\end{center}
+giving black a chance to equalize.
+\begin{center}|
+{\bf\begin{tabular}{rp{50pt}p{50pt}}
+37 & \ldots & Re2??\\
+\end{tabular}}|
+\end{center}
+Returning the complement.
+|37\ldots~R*e1+; 38.~K*e1, B*c3+; 39.~Kf2, Bd4+; 40.~K*f3, B*g1|
+and White still has the edge with 2 connected passed pawns, but black
+has real chances.
+\begin{center}|
+{\bf\begin{tabular}{rp{50pt}p{50pt}}
+38 & R*e2&\\
+\end{tabular}}|
+\end{center}
+
+\board
+{ * * * *}
+{pkp * * }
+{ *p* *B*}
+{* * * * }
+{ * * * P}
+{* P *bP }
+{ b *R* *}
+{* * *KR }
+$$\showboard$$
+$1\!-\!0$
+\clearpage
+\begin{center}
+\fbox{\fbox{\large\begin{tabular}{l}
+Game  \hspace{.3 in} Nov 1993 \hspace{.3 in} $1\!-\!0$\\
+\hline
+Foo C65\\
+\raisebox{2.5pt}[11pt]{\framebox[11pt]{\rule{0pt}{4.25pt}}} Andy Gill\\
+\rule[-1pt]{11pt}{11pt} Barry Dunne\\
+Dunfermline Club Championship
+\end{tabular}}}
+\end{center}
+\begin{center}|
+{\bf\begin{tabular}{rp{50pt}p{50pt}}
+1 & e4 & e5\\
+2 & Nf3 & Nc6\\
+3 & Bb5 & Nf6\\
+4 & d3&\\
+\end{tabular}}|
+\end{center}
+|4.~0-0|
+Ruy Lopez, Berlin Defence
+\begin{center}|
+{\bf\begin{tabular}{rp{50pt}p{50pt}}
+4 & \ldots & Be7\\
+\end{tabular}}|
+\end{center}
+|4\ldots~Bc5|
+is better.
+\begin{center}|
+{\bf\begin{tabular}{rp{50pt}p{50pt}}
+5 & 0-0&\\
+\end{tabular}}|
+\end{center}
+|5.~B*c6, d*c6; 6.~N*e5, Bd6; 7.~Nf3, 0-0; 8.~0-0, Be6|
+and white is a pawn up, but black has a lead in development.
+\begin{center}|
+{\bf\begin{tabular}{rp{50pt}p{50pt}}
+5 & \ldots & 0-0?\\
+\end{tabular}}|
+\end{center}
+|5\ldots~d6|
+is needed to protect e5.
+\begin{center}|
+{\bf\begin{tabular}{rp{50pt}p{50pt}}
+6 & Nc3&\\
+\end{tabular}}|
+\end{center}
+|6.~B*c6, d*c6; 7.~N*e5, Bd6; 8.~Nf3, Bg4; 9.~Be3|
+and white is a clean pawn up.
+\begin{center}|
+{\bf\begin{tabular}{rp{50pt}p{50pt}}
+6 & \ldots & b6?\\
+7 & a3 & Bb7\\
+8 & b4 & Nd4\\
+\end{tabular}}|
+\end{center}
+
+\board
+{r* q rk*}
+{pbppbppp}
+{ p * n *}
+{*B* p * }
+{ P nP* *}
+{P NP*N* }
+{ *P* PPP}
+{R BQ*RK }
+$$\showboard$$
+A bit ambitious.
+\begin{center}|
+{\bf\begin{tabular}{rp{50pt}p{50pt}}
+9 & N*e5&\\
+\end{tabular}}|
+\end{center}
+|9.~N*d4, e*d4; 10.~Ne2, d5; 11.~e5, Nd7|
+is whites best line.
+\begin{center}|
+{\bf\begin{tabular}{rp{50pt}p{50pt}}
+9 & \ldots & N*b5\\
+\end{tabular}}|
+\end{center}
+|9\ldots~d5; 10.~Bb2, d*e4; 11.~d*e4, N*e4|
+with equal chances.
+\begin{center}|
+{\bf\begin{tabular}{rp{50pt}p{50pt}}
+10 & N*b5 & d5\\
+11 & Bb2 & d*e4\\
+12 & d*e4&\\
+\end{tabular}}|
+\end{center}
+|12.~f3|
+is a better approach.
+\begin{center}|
+{\bf\begin{tabular}{rp{50pt}p{50pt}}
+12 & \ldots & Q*d1\\
+13 & Ra*d1 & Bd6\\
+\end{tabular}}|
+\end{center}
+
+\board
+{r* * rk*}
+{pbp *ppp}
+{ p b n *}
+{*N* N * }
+{ P *P* *}
+{P * * * }
+{ BP* PPP}
+{* *R*RK }
+$$\showboard$$
+|13\ldots~B*e4; 14.~Nd7, B*c2; 15.~B*f6, g*f6; 16.~Rd2|
+with a slight advantage for white.
+\begin{center}|
+{\bf\begin{tabular}{rp{50pt}p{50pt}}
+14 & Nf3&\\
+\end{tabular}}|
+\end{center}
+|14.~N*d6, c*d6; 15.~R*d6, B*e4; 16.~c4, Rfd8; 17.~c5, b*c5; 18.~b*c5|
+winning for white.
+\begin{center}|
+{\bf\begin{tabular}{rp{50pt}p{50pt}}
+14 & \ldots & B*e4\\
+\end{tabular}}|
+\end{center}
+|14\ldots~N*e4|
+is better.
+\begin{center}|
+{\bf\begin{tabular}{rp{50pt}p{50pt}}
+15 & N*d6 & c*d6\\
+16 & B*f6 & g*f6\\
+17 & R*d6 & B*c2\\
+\end{tabular}}|
+\end{center}
+|17\ldots~B*f3; 18.~g*f3, Rac8; 19.~Rc1, Rc3; 20.~Rd3, R*d3; 21.~c*d3|
+and whites passed pawn is a long way from queening.
+\begin{center}|
+{\bf\begin{tabular}{rp{50pt}p{50pt}}
+18 & R*f6&\\
+\end{tabular}}|
+\end{center}
+|18.~Nd4, Ba4; 19.~R*f6, Rfd8; 20.~Rf4, Rd7; 21.~Re4|
+a pawn up, but with chances for black, because of the powerful Bishop.
+\begin{center}|
+{\bf\begin{tabular}{rp{50pt}p{50pt}}
+18 & \ldots & Rfd8\\
+19 & Ne5 & Kg7\\
+\end{tabular}}|
+\end{center}
+|19\ldots~Bg6|
+is better, defending the weak pawn.
+\begin{center}|
+{\bf\begin{tabular}{rp{50pt}p{50pt}}
+20 & R*f7+ & Kg8\\
+21 & Rc7&\\
+\end{tabular}}|
+\end{center}
+|21.~f4, a6; 22.~g3, Rd2; 23.~Rb7, b5|
+and white should win.
+\begin{center}|
+{\bf\begin{tabular}{rp{50pt}p{50pt}}
+21 & \ldots & Re8\\
+\end{tabular}}|
+\end{center}
+|21\ldots~Rdc8; 22.~Rb7, Be4; 23.~Rd7, Rc2; 24.~Rfd1|
+with connected rooks for white.
+\begin{center}|
+{\bf\begin{tabular}{rp{50pt}p{50pt}}
+22 & Re1&\\
+\end{tabular}}|
+\end{center}
+|22.~f4|
+is better for protecting the knight.
+\begin{center}|
+{\bf\begin{tabular}{rp{50pt}p{50pt}}
+22 & \ldots & Rac8\\
+\end{tabular}}|
+\end{center}
+should have moved the `e' Rook.
+\begin{center}|
+{\bf\begin{tabular}{rp{50pt}p{50pt}}
+23 & R*a7 & Bf5\\
+\end{tabular}}|
+\end{center}
+|23\ldots~Ra8!?|
+planning to attack the weak `a' pawn.
+\begin{center}|
+{\bf\begin{tabular}{rp{50pt}p{50pt}}
+24 & f4 & Bg4\\
+\end{tabular}}|
+\end{center}
+|24\ldots~Rc2|
+penatraiting the 7th.
+\begin{center}|
+{\bf\begin{tabular}{rp{50pt}p{50pt}}
+25 & Kf2 & Rc2+\\
+26 & Kg3 & Re2\\
+27 & R*e2 & B*e2\\
+28 & Nc6?&\\
+\end{tabular}}|
+\end{center}
+where is that knight going ?
+\begin{center}|
+{\bf\begin{tabular}{rp{50pt}p{50pt}}
+28 & \ldots & Re3+\\
+29 & Kf2 & Re4\\
+\end{tabular}}|
+\end{center}
+
+\board
+{ * * *k*}
+{R * * *p}
+{ pN* * *}
+{* * * * }
+{ P *rP *}
+{P * * * }
+{ * *bKPP}
+{* * * * }
+$$\showboard$$
+\begin{center}|
+{\bf\begin{tabular}{rp{50pt}p{50pt}}
+30 & f5&\\
+\end{tabular}}|
+\end{center}
+|30.~Ne7+, Kf8; 31.~Nd5, Bd3; 32.~N*b6, Re7|
+totally winning for white
+\begin{center}|
+{\bf\begin{tabular}{rp{50pt}p{50pt}}
+30 & \ldots & Bg4\\
+31 & Ne7+&\\
+\end{tabular}}|
+\end{center}
+|31.~Kg3, h6; 32.~f6, Be6; 33.~Re7|
+looking very good for white.
+\begin{center}|
+{\bf\begin{tabular}{rp{50pt}p{50pt}}
+31 & \ldots & Kf8\\
+32 & f6 & Rf4+\\
+33 & Kg3 & Re4\\
+34 & h3&\\
+\end{tabular}}|
+\end{center}
+|34.~Nd5, Be6; 35.~N*b6, Rg4+; 36.~Kf3, Rg6; 37.~R*h7, R*f6+; 38.~Ke4|
+and with 4 connected passed white will win.
+\begin{center}|
+{\bf\begin{tabular}{rp{50pt}p{50pt}}
+34 & \ldots & Bh5\\
+35 & Nd5 & b5\\
+36 & R*h7 & Bg6\\
+37 & Rh4&\\
+\end{tabular}}|
+\end{center}
+|37.~Rh8+, Kf7; 38.~Rb8, Bf5; 39.~R*b5, Be6; 40.~Rb7+, Kg6; 41.~Rg7+|
+just look at whites advantage.
+\begin{center}|
+{\bf\begin{tabular}{rp{50pt}p{50pt}}
+37 & \ldots & R*h4\\
+38 & K*h4 & Be4\\
+39 & Nc3&\\
+\end{tabular}}|
+\end{center}
+|39.~Ne3, Kf7; 40.~Kg5, Bc6; 41.~g4, Be4; 42.~h4, Bd3; 43.~h5|
+winning.
+\begin{center}|
+{\bf\begin{tabular}{rp{50pt}p{50pt}}
+39 & \ldots & Bc6\\
+\end{tabular}}|
+\end{center}
+|39\ldots~B*g2; 40.~N*b5, Kf7; 41.~Kg5, B*h3; 42.~Nd6+, Kg8; 43.~a4, Kh7|
+\begin{center}|
+{\bf\begin{tabular}{rp{50pt}p{50pt}}
+40 & g4 & Kf7\\
+41 & g5&\\
+\end{tabular}}|
+\end{center}
+|41.~Kg5, Kg8; 42.~h4, Bd7; 43.~h5, Kf7; 44.~Ne4, Kg8; 45.~Nd6|
+\begin{center}|
+{\bf\begin{tabular}{rp{50pt}p{50pt}}
+41 & \ldots & Kg6\\
+42 & Kg4? & Bd7+\\
+43 & Kf4 & B*h3\\
+44 & N*b5 & Bd7\\
+\end{tabular}}|
+\end{center}
+|44\ldots~Kf7; 45.~Nd6+, Ke6; 46.~f7, Ke7; 47.~g6, Kf8; 48.~a4, Kg7|
+\begin{center}|
+{\bf\begin{tabular}{rp{50pt}p{50pt}}
+45 & a4 & Bc6\\
+46 & Nc3 & Bd7\\
+47 & b5&\\
+\end{tabular}}|
+\end{center}
+
+\board
+{ * * * *}
+{* *b* * }
+{ * * Pk*}
+{*P* * P }
+{P* * K *}
+{* N * * }
+{ * * * *}
+{* * * * }
+$$\showboard$$
+$1\!-\!0$
+\clearpage
+\begin{center}
+\fbox{\fbox{\large\begin{tabular}{l}
+Game  \hspace{.3 in} Nov 1993 \hspace{.3 in} $0\!-\!1$\\
+\hline
+Foo C65\\
+\raisebox{2.5pt}[11pt]{\framebox[11pt]{\rule{0pt}{4.25pt}}} Andy Gill\\
+\rule[-1pt]{11pt}{11pt} Rab Brown\\
+Dunfermline Club Championship
+\end{tabular}}}
+\end{center}
+\begin{center}|
+{\bf\begin{tabular}{rp{50pt}p{50pt}}
+1 & e4 & e5\\
+2 & Nf3 & Nc6\\
+3 & Bb5 & Bc5\\
+4 & 0-0 & Nf6\\
+5 & Nc3 & d6\\
+6 & a3 & Ng4?\\
+7 & Qe1&\\
+\end{tabular}}|
+\end{center}
+|7.~h3|
+\begin{center}|
+{\bf\begin{tabular}{rp{50pt}p{50pt}}
+7 & \ldots & 0-0\\
+\end{tabular}}|
+\end{center}
+
+\board
+{r*bq rk*}
+{ppp *ppp}
+{ *np * *}
+{*Bb p * }
+{ * *P*n*}
+{P N *N* }
+{ PPP PPP}
+{R B QRK }
+$$\showboard$$
+\begin{center}|
+{\bf\begin{tabular}{rp{50pt}p{50pt}}
+8 & B*c6 & b*c6\\
+9 & b4 & Ba6\\
+10 & b*c5 & B*f1\\
+11 & K*f1&\\
+\end{tabular}}|
+\end{center}
+|11.~Q*f1, Qd7; 12.~Bb2, d*c5; 13.~d3, Rfb8; 14.~Rb1|
+clearly winning for white.
+\begin{center}|
+{\bf\begin{tabular}{rp{50pt}p{50pt}}
+11 & \ldots & Qf6\\
+\end{tabular}}|
+\end{center}
+
+\board
+{r* * rk*}
+{p p *ppp}
+{ *pp q *}
+{* P p * }
+{ * *P*n*}
+{P N *N* }
+{ *PP PPP}
+{R B QK* }
+$$\showboard$$
+|11\ldots~Rb8; 12.~Qe2, Qd7; 13.~Qa6, Ra8; 14.~h3, Nf6; 15.~d4, e*d4|
+is a better plan.
+\begin{center}|
+{\bf\begin{tabular}{rp{50pt}p{50pt}}
+12 & d3 & Qg6\\
+13 & Rb1&\\
+\end{tabular}}|
+\end{center}
+|13.~h3, Nh6|
+\begin{center}|
+{\bf\begin{tabular}{rp{50pt}p{50pt}}
+13 & \ldots & Qh5\\
+14 & Rb7&\\
+\end{tabular}}|
+\end{center}
+|14.~h3, Nf6; 15.~Rb7, Rfc8; 16.~Bg5, Qg6; 17.~Qe3, Ne8|
+and white has a commanding lead.
+\begin{center}|
+{\bf\begin{tabular}{rp{50pt}p{50pt}}
+14 & \ldots & N*h2+\\
+15 & N*h2 & Q*h2\\
+16 & R*c7 & Qh1+\\
+17 & Ke2 & Q*g2\\
+18 & R*c6&\\
+\end{tabular}}|
+\end{center}
+|18.~c*d6, Rfc8; 19.~R*c8+, R*c8; 20.~Be3, Rd8; 21.~Bc5, h5|
+\begin{center}|
+{\bf\begin{tabular}{rp{50pt}p{50pt}}
+18 & \ldots & d*c5\\
+\end{tabular}}|
+\end{center}
+|18\ldots~Qg4+; 19.~f3, Qg2+; 20.~Qf2, Q*f2+; 21.~K*f2, Rfc8; 22.~Nd5, R*c6; 23.~Ne7+|
+\begin{center}|
+{\bf\begin{tabular}{rp{50pt}p{50pt}}
+19 & R*c5 & f5\\
+20 & Be3 & Qg4+\\
+21 & f3 & Qg2+\\
+22 & Qf2 & Qh1\\
+23 & R*e5 & Qa1\\
+\end{tabular}}|
+\end{center}
+
+\board
+{r* * rk*}
+{p * * pp}
+{ * * * *}
+{* * Rp* }
+{ * *P* *}
+{P NPBP* }
+{ *P*KQ *}
+{q * * * }
+$$\showboard$$
+\begin{center}|
+{\bf\begin{tabular}{rp{50pt}p{50pt}}
+24 & Bc5?&\\
+\end{tabular}}|
+\end{center}
+|24.~Qe1, Qb2; 25.~Qd2, Q*a3; 26.~Bc5, Qa5; 27.~e*f5|
+white has the advantage.
+\begin{center}|
+{\bf\begin{tabular}{rp{50pt}p{50pt}}
+24 & \ldots & Q*c3\\
+25 & R*f5&\\
+\end{tabular}}|
+\end{center}
+|25.~B*f8, Q*c2+; 26.~Kf1, Q*d3+; 27.~Qe2, Qb1+; 28.~Qe1, Q*e1+; 29.~K*e1|
+now black has only a slight advantage.
+\begin{center}|
+{\bf\begin{tabular}{rp{50pt}p{50pt}}
+25 & \ldots & Q*c2+\\
+\end{tabular}}|
+\end{center}
+|25\ldots~R*f5; 26.~e*f5, Q*c2+; 27.~Kf1, Q*d3+; 28.~Kg2, Rd8; 29.~f4|
+and black has a clear lead.
+\begin{center}|
+{\bf\begin{tabular}{rp{50pt}p{50pt}}
+26 & Ke3 & Q*f2+\\
+27 & K*f2 & R*f5\\
+28 & e*f5 & Rc8\\
+29 & d4 & a6\\
+30 & a4 & Kf7\\
+31 & Ke3&\\
+\end{tabular}}|
+\end{center}
+|31.~Kg3, Kf6; 32.~Kf4, g5+; 33.~f*g6, h*g6; 34.~a5, g5+; 35.~Kg4|
+\begin{center}|
+{\bf\begin{tabular}{rp{50pt}p{50pt}}
+31 & \ldots & h5\\
+\end{tabular}}|
+\end{center}
+|31\ldots~Kf6; 32.~Kf4, Rd8; 33.~a5, Rd5; 34.~Ke4, R*f5|
+\begin{center}|
+{\bf\begin{tabular}{rp{50pt}p{50pt}}
+32 & Kf4 & h4\\
+33 & Kg4 & Rh8\\
+34 & d5 & h3\\
+35 & Bd6 & g6\\
+\end{tabular}}|
+\end{center}
+|35\ldots~h2; 36.~B*h2, R*h2; 37.~Kf4, Rh4+; 38.~Ke5, R*a4; 39.~d6, Rc4|
+totaly won for black.
+\begin{center}|
+{\bf\begin{tabular}{rp{50pt}p{50pt}}
+36 & f*g6+ & K*g6\\
+37 & Bh2 & Kf6\\
+\end{tabular}}|
+\end{center}
+
+\board
+{ * * * r}
+{* * * * }
+{p* * k *}
+{* *P* * }
+{P* * *K*}
+{* * *P*p}
+{ * * * B}
+{* * * * }
+$$\showboard$$
+\begin{center}|
+{\bf\begin{tabular}{rp{50pt}p{50pt}}
+38 & f4&\\
+\end{tabular}}|
+\end{center}
+|38.~a5, Ke7; 39.~Kf5, Rh5+; 40.~Ke4, Rh4+; 41.~f4, Kd6; 42.~Kd4|
+holding the position.
+\begin{center}|
+{\bf\begin{tabular}{rp{50pt}p{50pt}}
+38 & \ldots & Ke7\\
+39 & f5 & a5\\
+\end{tabular}}|
+\end{center}
+|39\ldots~Kf6|
+is needed.
+\begin{center}|
+{\bf\begin{tabular}{rp{50pt}p{50pt}}
+40 & d6+ & Kd7\\
+\end{tabular}}|
+\end{center}
+|40\ldots~Kf6|
+is still needed.
+\begin{center}|
+{\bf\begin{tabular}{rp{50pt}p{50pt}}
+41 & Kg5 & Rb8\\
+\end{tabular}}|
+\end{center}
+|41\ldots~Ke8|
+\begin{center}|
+{\bf\begin{tabular}{rp{50pt}p{50pt}}
+42 & f6 & Rb2\\
+\end{tabular}}|
+\end{center}
+|42\ldots~Ke6; 43.~Kg4, Rb4+; 44.~K*h3, R*a4; 45.~d7, K*d7; 46.~Be5|
+but black should still win.
+\begin{center}|
+{\bf\begin{tabular}{rp{50pt}p{50pt}}
+43 & Kg6&\\
+\end{tabular}}|
+\end{center}
+|43.~f7, Rg2+; 44.~Kh6, Rf2; 45.~Kg7, Rg2+; 46.~Kh7, Rf2; 47.~Kg7|
+white has equalised!
+\begin{center}|
+{\bf\begin{tabular}{rp{50pt}p{50pt}}
+43 & \ldots & Rf2\\
+\end{tabular}}|
+\end{center}
+
+\board
+{ * * * *}
+{* *k* * }
+{ * P PK*}
+{p * * * }
+{P* * * *}
+{* * * *p}
+{ * * r B}
+{* * * * }
+$$\showboard$$
+$0\!-\!1$
+\clearpage
+\begin{center}
+\fbox{\fbox{\large\begin{tabular}{l}
+Game  \hspace{.3 in} Nov 1993 \hspace{.3 in} $0\!-\!1$\\
+\hline
+Foo C60\\
+\raisebox{2.5pt}[11pt]{\framebox[11pt]{\rule{0pt}{4.25pt}}} Andy Gill\\
+\rule[-1pt]{11pt}{11pt} Ian Kennedy\\
+Dunfermline C vs Stirling B
+\end{tabular}}}
+\end{center}
+\begin{center}|
+{\bf\begin{tabular}{rp{50pt}p{50pt}}
+1 & e4 & e5\\
+2 & Nf3 & Nc6\\
+3 & Bb5 & Bd6\\
+4 & 0-0 & a6\\
+5 & Ba4 & b5\\
+6 & Bb3 & Bb7\\
+7 & d3 & Nf6\\
+\end{tabular}}|
+\end{center}
+|7\ldots~Na5; 8.~Nbd2, f6; 9.~a4, N*b3; 10.~N*b3, Bb4; 11.~a*b5, a*b5|
+with equality.
+\begin{center}|
+{\bf\begin{tabular}{rp{50pt}p{50pt}}
+8 & Nc3&\\
+\end{tabular}}|
+\end{center}
+|8.~a4, b4; 9.~Nbd2, Bc5; 10.~Nc4, d6|
+\wbetter{}
+\begin{center}|
+{\bf\begin{tabular}{rp{50pt}p{50pt}}
+8 & \ldots & 0-0\\
+\end{tabular}}|
+\end{center}
+|8\ldots~Na5; 9.~Bd2, N*b3; 10.~a*b3, 0-0; 11.~Bg5, Rb8|
+=
+\begin{center}|
+{\bf\begin{tabular}{rp{50pt}p{50pt}}
+9 & Be3 & Na5\\
+\end{tabular}}|
+\end{center}
+
+\board
+{r* q rk*}
+{*bpp*ppp}
+{p* b n *}
+{np* p * }
+{ * *P* *}
+{*BNPBN* }
+{PPP* PPP}
+{R *Q*RK }
+$$\showboard$$
+|9\ldots~Be7; 10.~a3, Ng4; 11.~Bd2|
+\wbetter{}
+\begin{center}|
+{\bf\begin{tabular}{rp{50pt}p{50pt}}
+10 & Bd5?!&\\
+\end{tabular}}|
+\end{center}
+where is that bishop going.
+\begin{center}|
+{\bf\begin{tabular}{rp{50pt}p{50pt}}
+10 & \ldots & b4\\
+\end{tabular}}|
+\end{center}
+|10\ldots~c6; 11.~Bb3, Bc7; 12.~Bg5, N*b3; 13.~B*f6, Q*f6; 14.~a*b3|
+\bbetter{}
+\begin{center}|
+{\bf\begin{tabular}{rp{50pt}p{50pt}}
+11 & B*b7 & N*b7\\
+12 & Nd5&\\
+\end{tabular}}|
+\end{center}
+|12.~Ne2, Ng4; 13.~Bd2, f5; 14.~e*f5, R*f5; 15.~Ng3, Rf6|
+\wbetter{}
+\begin{center}|
+{\bf\begin{tabular}{rp{50pt}p{50pt}}
+12 & \ldots & c6\\
+\end{tabular}}|
+\end{center}
+|12\ldots~N*d5; 13.~e*d5, f6; 14.~c3, b*c3; 15.~b*c3, Be7; 16.~d4, d6|
+\bbetter{}
+\begin{center}|
+{\bf\begin{tabular}{rp{50pt}p{50pt}}
+13 & N*f6+&\\
+\end{tabular}}|
+\end{center}
+|13.~Bb6, Qc8; 14.~N*f6+, g*f6; 15.~d4, Bc7; 16.~B*c7, Q*c7|
+\wbetter{} and the black king is exposed.
+\begin{center}|
+{\bf\begin{tabular}{rp{50pt}p{50pt}}
+13 & \ldots & Q*f6\\
+14 & Bb6?!&\\
+\end{tabular}}|
+\end{center}
+strange move.
+|14.~Qd2, Be7; 15.~c3, a5; 16.~a3, b*a3; 17.~b*a3|
+\wbetter{} with the plan ofs owning the `b' file.
+\begin{center}|
+{\bf\begin{tabular}{rp{50pt}p{50pt}}
+14 & \ldots & Bc5\\
+\end{tabular}}|
+\end{center}
+|14\ldots~Be7|
+\begin{center}|
+{\bf\begin{tabular}{rp{50pt}p{50pt}}
+15 & Bc7&\\
+\end{tabular}}|
+\end{center}
+|15.~N*e5|
+but black can easly win back the pawn.
+\begin{center}|
+{\bf\begin{tabular}{rp{50pt}p{50pt}}
+15 & \ldots & Rac8?\\
+\end{tabular}}|
+\end{center}
+|15\ldots~d6; 16.~d4, e*d4; 17.~e5, Qe7; 18.~e*d6, N*d6; 19.~B*d6, Q*d6|
+\bupperhand{}
+\begin{center}|
+{\bf\begin{tabular}{rp{50pt}p{50pt}}
+16 & B*e5 & Qg6\\
+17 & d4&\\
+\end{tabular}}|
+\end{center}
+|17.~Bg3, Rfe8; 18.~Ne5, Qf6; 19.~N*d7, Q*b2; 20.~Re1|
+\wupperhand{} white should now try use his center pawns to push home
+his advantage.
+\begin{center}|
+{\bf\begin{tabular}{rp{50pt}p{50pt}}
+17 & \ldots & Bd6\\
+18 & B*d6&\\
+\end{tabular}}|
+\end{center}
+this is to early, leaving myself underdeveloped.
+|18.~Re1, f6; 19.~B*d6, N*d6; 20.~Qd3|
+\wupperhand{}
+\begin{center}|
+{\bf\begin{tabular}{rp{50pt}p{50pt}}
+18 & \ldots & N*d6\\
+19 & Ne5&\\
+\end{tabular}}|
+\end{center}
+|19.~e5, Nc4; 20.~b3, Na3; 21.~Rc1, d6; 22.~Re1|
+\wupperhand{}
+\begin{center}|
+{\bf\begin{tabular}{rp{50pt}p{50pt}}
+19 & \ldots & Q*e4\\
+20 & N*d7 & Rfe8\\
+21 & Nc5 & Qg6?\\
+\end{tabular}}|
+\end{center}
+|21\ldots~Qe2; 22.~Re1, Qc4; 23.~Qd2, Rcd8; 24.~Rad1, a5|
+\wupperhand{} white is a clear pawn up.
+\begin{center}|
+{\bf\begin{tabular}{rp{50pt}p{50pt}}
+22 & N*a6 & Nf5\\
+23 & N*b4&\\
+\end{tabular}}|
+\end{center}
+
+\board
+{ *r*r*k*}
+{* * *ppp}
+{ *p* *q*}
+{* * *n* }
+{ N P * *}
+{* * * * }
+{PPP* PPP}
+{R *Q*RK }
+$$\showboard$$
+ white should now win the endgame quite comfortably.
+\begin{center}|
+{\bf\begin{tabular}{rp{50pt}p{50pt}}
+23 & \ldots & Nh4\\
+\end{tabular}}|
+\end{center}
+|23\ldots~Rcd8; 24.~c3, c5; 25.~Nc2, c*d4; 26.~N*d4, Qf6; 27.~Qf3, N*d4|
+\wupperhand{} though still two clear pawns up.
+\begin{center}|
+{\bf\begin{tabular}{rp{50pt}p{50pt}}
+24 & g3&\\
+\end{tabular}}|
+\end{center}
+forced.
+\begin{center}|
+{\bf\begin{tabular}{rp{50pt}p{50pt}}
+24 & \ldots & c5\\
+25 & d*c5 & R*c5\\
+\end{tabular}}|
+\end{center}
+|25\ldots~Qe4; 26.~g*h4, Q*b4; 27.~a4, Q*h4; 28.~Qd5, Re2|
+\wupperhand{}, but whites king is dangerously exposed, and the `a'
+rook is not (yet) part of the game.
+\begin{center}|
+{\bf\begin{tabular}{rp{50pt}p{50pt}}
+26 & a4&\\
+\end{tabular}}|
+\end{center}
+crap plan! Its just too slow.
+|26.~Nd3, Rf5; 27.~f4, Rd5; 28.~a4, Qb6+; 29.~Rf2, Nf5|
+\wdecisive{} black will never stop 3 connected passed pawns!
+\begin{center}|
+{\bf\begin{tabular}{rp{50pt}p{50pt}}
+26 & \ldots & f5\\
+27 & Nd5 & Rd8??\\
+\end{tabular}}|
+\end{center}
+|27\ldots~Qd6; 28.~Nf4, Q*d1; 29.~Rf*d1, Nf3+; 30.~Kg2, Ne5|
+\wdecisive{}
+\begin{center}|
+{\bf\begin{tabular}{rp{50pt}p{50pt}}
+28 & Ne7+! & Kf7\\
+29 & Q*d8 & Qg5\\
+\end{tabular}}|
+\end{center}
+
+\board
+{ * Q * *}
+{* * Nkpp}
+{ * * * *}
+{* r *pq }
+{P* * * n}
+{* * * P }
+{ PP* P P}
+{R * *RK }
+$$\showboard$$
+|29\ldots~Nf3+; 30.~Kg2|
+is an idea.
+\begin{center}|
+{\bf\begin{tabular}{rp{50pt}p{50pt}}
+30 & a5&\\
+\end{tabular}}|
+\end{center}
+this plan is still to slow.
+|30.~Qg8+, K*e7; 31.~Rfe1+, Kd6; 32.~Qf8+, Kc6; 33.~Qc8+, Kb6; 34.~Re6+, Rc6; 35.~Q*c6+, Ka7; 36.~Qb6+, Ka8; 37.~Re8+, Qd8; 38.~R*d8 mate|
+\begin{center}|
+{\bf\begin{tabular}{rp{50pt}p{50pt}}
+30 & \ldots & f4\\
+\end{tabular}}|
+\end{center}
+
+\board
+{ * Q * *}
+{* * Nkpp}
+{ * * * *}
+{P r * q }
+{ * * p n}
+{* * * P }
+{ PP* P P}
+{R * *RK }
+$$\showboard$$
+\begin{center}|
+{\bf\begin{tabular}{rp{50pt}p{50pt}}
+31 & f3??&\\
+\end{tabular}}|
+\end{center}
+|31.~Nc6, Nf3+; 32.~Kg2, f*g3; 33.~Qd7+, Kf8; 34.~Qc8+, Kf7; 35.~f*g3|
+\wdecisive{} but there are still some hairy tactics.
+\begin{center}|
+{\bf\begin{tabular}{rp{50pt}p{50pt}}
+31 & \ldots & f*g3\\
+32 & h*g3??&\\
+\end{tabular}}|
+\end{center}
+|32.~Qg8+, K*e7; 33.~Rfe1+, Re5; 34.~R*e5+, Q*e5; 35.~h3, N*f3+; 36.~Kg2|
+and white can still win!
+\begin{center}|
+{\bf\begin{tabular}{rp{50pt}p{50pt}}
+32 & \ldots & Q*g3+\\
+33 & Kh1 & Qg2 mate\\
+\end{tabular}}|
+\end{center}
+painfull!
+
+\board
+{ * Q * *}
+{* * Nkpp}
+{ * * * *}
+{P r * * }
+{ * * * n}
+{* * *P* }
+{ PP* *q*}
+{R * *R*K}
+$$\showboard$$
+$0\!-\!1$
+\clearpage
+\begin{center}
+\fbox{\fbox{\large\begin{tabular}{l}
+Game  \hspace{.3 in} Nov 1993 \hspace{.3 in} $1\!-\!0$\\
+\hline
+Foo C41\\
+\raisebox{2.5pt}[11pt]{\framebox[11pt]{\rule{0pt}{4.25pt}}} Andy Gill\\
+\rule[-1pt]{11pt}{11pt} Neil Langham\\
+Dunfermline Club Championship
+\end{tabular}}}
+\end{center}
+\begin{center}|
+{\bf\begin{tabular}{rp{50pt}p{50pt}}
+1 & e4 & e5\\
+2 & Nf3 & d6\\
+3 & Nc3 & Nf6\\
+4 & Bc4 & h6\\
+\end{tabular}}|
+\end{center}
+|4\ldots~Bg4; 5.~d3, Nc6; 6.~h3, Bh5; 7.~0-0, B*f3; 8.~Q*f3|
+=
+\begin{center}|
+{\bf\begin{tabular}{rp{50pt}p{50pt}}
+5 & 0-0 & Bd7\\
+6 & d3 & Nc6\\
+7 & Bd2&\\
+\end{tabular}}|
+\end{center}
+|7.~Be3, Be7; 8.~Nd5, 0-0; 9.~h3, N*d5; 10.~B*d5, Bf6|
+\begin{center}|
+{\bf\begin{tabular}{rp{50pt}p{50pt}}
+7 & \ldots & Na5\\
+\end{tabular}}|
+\end{center}
+
+\board
+{r* qkb r}
+{pppb*pp }
+{ * p n p}
+{n * p * }
+{ *B*P* *}
+{* NP*N* }
+{PPPB PPP}
+{R *Q*RK }
+$$\showboard$$
+\begin{center}|
+{\bf\begin{tabular}{rp{50pt}p{50pt}}
+8 & b4&\\
+\end{tabular}}|
+\end{center}
+|8.~Bd5, Bg4; 9.~a3, c6; 10.~Ba2, d5; 11.~Be3, d*e4; 12.~N*e4|
+but black is having the freer game
+\begin{center}|
+{\bf\begin{tabular}{rp{50pt}p{50pt}}
+8 & \ldots & N*c4\\
+9 & d*c4 & Be6\\
+\end{tabular}}|
+\end{center}
+|9\ldots~Be7; 10.~Qe2, 0-0; 11.~Rfd1, Be6; 12.~c5, c6; 13.~c*d6, Q*d6|
+\bbetter{}
+\begin{center}|
+{\bf\begin{tabular}{rp{50pt}p{50pt}}
+10 & Nd5? & N*e4\\
+11 & Qe2&\\
+\end{tabular}}|
+\end{center}
+|11.~Re1, N*d2; 12.~Q*d2, c6; 13.~Ne3, Be7; 14.~Rad1, 0-0|
+\bupperhand{}, with white a pawn and position down.
+\begin{center}|
+{\bf\begin{tabular}{rp{50pt}p{50pt}}
+11 & \ldots & N*d2\\
+12 & N*d2&\\
+\end{tabular}}|
+\end{center}
+|12.~Q*d2|
+is better.
+\begin{center}|
+{\bf\begin{tabular}{rp{50pt}p{50pt}}
+12 & \ldots & Qg5??\\
+\end{tabular}}|
+\end{center}
+
+\board
+{r* *kb r}
+{ppp *pp }
+{ * pb* p}
+{* *Np q }
+{ PP* * *}
+{* * * * }
+{P*PNQPPP}
+{R * *RK }
+$$\showboard$$
+|12\ldots~g6; 13.~Ne3, f5; 14.~c5, d*c5; 15.~b*c5, c6|
+\bupperhand{}, ready for a pawn charge on white's king.
+\begin{center}|
+{\bf\begin{tabular}{rp{50pt}p{50pt}}
+13 & N*c7+ & Ke7\\
+\end{tabular}}|
+\end{center}
+|13\ldots~Kd7|
+is better, stoping the future escape of the white knight.
+\begin{center}|
+{\bf\begin{tabular}{rp{50pt}p{50pt}}
+14 & N*a8 & Bh3\\
+\end{tabular}}|
+\end{center}
+going for the cheapo.
+\begin{center}|
+{\bf\begin{tabular}{rp{50pt}p{50pt}}
+15 & f4! & Qg6\\
+16 & Nc7&\\
+\end{tabular}}|
+\end{center}
+|16.~f*e5, Kd8; 17.~Qe4, Be6; 18.~Q*g6, f*g6|
+is the best line Fritz2 found.
+\begin{center}|
+{\bf\begin{tabular}{rp{50pt}p{50pt}}
+16 & \ldots & Kd7\\
+17 & Nd5 & Bg4\\
+18 & Qf2 & f6\\
+\end{tabular}}|
+\end{center}
+|18\ldots~Q*c2; 19.~Ne3, Qg6; 20.~f*e5, Be6; 21.~Nf3|
+rather cheeky, but still a rook down.
+\begin{center}|
+{\bf\begin{tabular}{rp{50pt}p{50pt}}
+19 & Ne3 & Ke6?\\
+\end{tabular}}|
+\end{center}
+
+\board
+{ * * b r}
+{pp* * p }
+{ * pkpqp}
+{* * p * }
+{ PP* Pb*}
+{* * N * }
+{P*PN QPP}
+{R * *RK }
+$$\showboard$$
+\begin{center}|
+{\bf\begin{tabular}{rp{50pt}p{50pt}}
+20 & f5+ & B*f5\\
+21 & Q*f5+&\\
+\end{tabular}}|
+\end{center}
+|21.~N*f5, Qg5; 22.~h4, Qg4|
+actually wins more material, but with this level of inequality, you
+want to swap of queens.
+\begin{center}|
+{\bf\begin{tabular}{rp{50pt}p{50pt}}
+21 & \ldots & Q*f5\\
+22 & N*f5 & g6\\
+23 & Ng3&\\
+\end{tabular}}|
+\end{center}
+At this point the score sheet goes wrong, but the game was won by now
+anyway!
+
+\board
+{ * * b r}
+{pp* * * }
+{ * pkppp}
+{* * p * }
+{ PP* * *}
+{* * * N }
+{P*PN *PP}
+{R * *RK }
+$$\showboard$$
+$1\!-\!0$
+\clearpage
+\begin{center}
+\fbox{\fbox{\large\begin{tabular}{l}
+Game  \hspace{.3 in} Nov 1993 \hspace{.3 in} $1\!-\!0$\\
+\hline
+\raisebox{2.5pt}[11pt]{\framebox[11pt]{\rule{0pt}{4.25pt}}} Andy Gill\\
+\rule[-1pt]{11pt}{11pt} Dennis Duncan\\
+Dunfermline Club Championship
+\end{tabular}}}
+\end{center}
+\begin{center}|
+{\bf\begin{tabular}{rp{50pt}p{50pt}}
+1 & e4 & e5\\
+2 & Nf3 & d6\\
+3 & Bc4 & Bg4\\
+4 & 0-0 & Nf6\\
+5 & Nc3&\\
+\end{tabular}}|
+\end{center}
+|5.~d3, Nc6; 6.~Be3, d5; 7.~e*d5, N*d5; 8.~Nbd2, N*e3; 9.~f*e3|
+=
+\begin{center}|
+{\bf\begin{tabular}{rp{50pt}p{50pt}}
+5 & \ldots & c6\\
+\end{tabular}}|
+\end{center}
+|5\ldots~Nc6; 6.~Bb5, Qd7; 7.~h3, B*f3; 8.~Q*f3, 0-0-0|
+=
+\begin{center}|
+{\bf\begin{tabular}{rp{50pt}p{50pt}}
+6 & Bb3 & d5\\
+7 & d3&\\
+\end{tabular}}|
+\end{center}
+|7.~e*d5, c*d5; 8.~Re1, e4; 9.~d3, B*f3|
+=
+\begin{center}|
+{\bf\begin{tabular}{rp{50pt}p{50pt}}
+7 & \ldots & b5\\
+\end{tabular}}|
+\end{center}
+|7\ldots~d*e4; 8.~d*e4, Q*d1; 9.~R*d1, B*f3|
+\bbetter{}
+\begin{center}|
+{\bf\begin{tabular}{rp{50pt}p{50pt}}
+8 & h3&\\
+\end{tabular}}|
+\end{center}
+
+\board
+{rn qkb r}
+{p * *ppp}
+{ *p* n *}
+{*p*pp * }
+{ * *P*b*}
+{*BNP*N*P}
+{PPP* PP*}
+{R BQ*RK }
+$$\showboard$$
+|8.~e*d5, b4; 9.~Ne4, c*d5; 10.~N*f6+, g*f6; 11.~d4, e*d4; 12.~Q*d4|
+\wupperhand{}
+\begin{center}|
+{\bf\begin{tabular}{rp{50pt}p{50pt}}
+8 & \ldots & Bc8\\
+\end{tabular}}|
+\end{center}
+|8\ldots~B*f3; 9.~Q*f3, d4; 10.~Ne2, Nbd7; 11.~Bg5, Be7|
+\wbetter{}
+\begin{center}|
+{\bf\begin{tabular}{rp{50pt}p{50pt}}
+9 & N*e5&\\
+\end{tabular}}|
+\end{center}
+|9.~e*d5, N*d5; 10.~N*e5, Be6; 11.~N*d5|
+\wupperhand{}
+\begin{center}|
+{\bf\begin{tabular}{rp{50pt}p{50pt}}
+9 & \ldots & Qc7\\
+\end{tabular}}|
+\end{center}
+|9\ldots~Bd6; 10.~Nf3, d*e4; 11.~N*e4, N*e4; 12.~Re1, B*h3; 13.~R*e4+, Be6|
+\wupperhand{}
+\begin{center}|
+{\bf\begin{tabular}{rp{50pt}p{50pt}}
+10 & Nf3 & Nh5\\
+\end{tabular}}|
+\end{center}
+|10\ldots~Be6; 11.~Nd4, d*e4; 12.~B*e6|
+\wupperhand{}
+\begin{center}|
+{\bf\begin{tabular}{rp{50pt}p{50pt}}
+11 & e*d5 & c5\\
+12 & N*b5&\\
+\end{tabular}}|
+\end{center}
+|12.~Re1+!, Be7; 13.~N*b5, Qb6; 14.~d6, Q*b5; 15.~R*e7+, Kd8; 16.~B*f7|
+\wdecisive{}
+\begin{center}|
+{\bf\begin{tabular}{rp{50pt}p{50pt}}
+12 & \ldots & Qb6\\
+\end{tabular}}|
+\end{center}
+|12\ldots~Qb7; 13.~Re1+, Kd8; 14.~Ne5, Nf6; 15.~Bg5, Bf5; 16.~B*f6+, g*f6|
+\wdecisive{}
+\begin{center}|
+{\bf\begin{tabular}{rp{50pt}p{50pt}}
+13 & Ba4&\\
+\end{tabular}}|
+\end{center}
+|13.~Re1+, Kd8; 14.~Ne5, Q*b5; 15.~N*f7+, Kc7; 16.~N*h8, Nf6; 17.~Bf4+|
+\wdecisive{}
+\begin{center}|
+{\bf\begin{tabular}{rp{50pt}p{50pt}}
+13 & \ldots & Bd7\\
+14 & Qe2+ & Be7\\
+\end{tabular}}|
+\end{center}
+
+\board
+{rn *k* r}
+{p *bbppp}
+{ q * * *}
+{*NpP* *n}
+{B* * * *}
+{* *P*N*P}
+{PPP*QPP*}
+{R B *RK }
+$$\showboard$$
+\begin{center}|
+{\bf\begin{tabular}{rp{50pt}p{50pt}}
+15 & d4&\\
+\end{tabular}}|
+\end{center}
+|15.~d6, 0-0; 16.~d*e7, Re8; 17.~d4, c*d4; 18.~Nf*d4|
+\wdecisive{}
+\begin{center}|
+{\bf\begin{tabular}{rp{50pt}p{50pt}}
+15 & \ldots & B*b5\\
+16 & B*b5+ & Nd7\\
+\end{tabular}}|
+\end{center}
+|16\ldots~Kf8; 17.~Re1, Qd6; 18.~Nh4, Qf6; 19.~Q*h5|
+\wdecisive{}
+\begin{center}|
+{\bf\begin{tabular}{rp{50pt}p{50pt}}
+17 & B*d7+ & K*d7\\
+18 & Ne5+ & Ke8\\
+19 & d*c5&\\
+\end{tabular}}|
+\end{center}
+|19.~Nc6, Qc7; 20.~Re1, c*d4; 21.~c4, Nf6|
+\wdecisive{}
+\begin{center}|
+{\bf\begin{tabular}{rp{50pt}p{50pt}}
+19 & \ldots & Q*c5\\
+20 & Rd1&\\
+\end{tabular}}|
+\end{center}
+|20.~d6, Q*d6; 21.~Qf3, Rc8; 22.~N*f7, Qf6; 23.~Q*f6, N*f6; 24.~N*h8|
+\wdecisive{}
+\begin{center}|
+{\bf\begin{tabular}{rp{50pt}p{50pt}}
+20 & \ldots & Ng3\\
+21 & Qe3&\\
+\end{tabular}}|
+\end{center}
+|21.~Qg4, Q*c2; 22.~Rd2, Qf5; 23.~Q*g3, Bf6|
+\wdecisive{}
+\begin{center}|
+{\bf\begin{tabular}{rp{50pt}p{50pt}}
+21 & \ldots & Nf5\\
+22 & Q*c5&\\
+\end{tabular}}|
+\end{center}
+|22.~Qf3, Nd6; 23.~c4, Bf6; 24.~Re1, B*e5; 25.~R*e5+, Kf8|
+\wdecisive{}
+\begin{center}|
+{\bf\begin{tabular}{rp{50pt}p{50pt}}
+22 & \ldots & B*c5\\
+\end{tabular}}|
+\end{center}
+
+\board
+{r* *k* r}
+{p * *ppp}
+{ * * * *}
+{* bPNn* }
+{ * * * *}
+{* * * *P}
+{PPP* PP*}
+{R BR* K }
+$$\showboard$$
+\begin{center}|
+{\bf\begin{tabular}{rp{50pt}p{50pt}}
+23 & Be3?&\\
+\end{tabular}}|
+\end{center}
+|23.~Re1, Ne7; 24.~c4, f6; 25.~Nd3, Bd4|
+\wdecisive{}
+\begin{center}|
+{\bf\begin{tabular}{rp{50pt}p{50pt}}
+23 & \ldots & N*e3\\
+\end{tabular}}|
+\end{center}
+|23\ldots~B*e3; 24.~f*e3, N*e3; 25.~Rd2, Rc8; 26.~Re2, N*d5; 27.~Ng6+, Kd7|
+Blacks best line
+\begin{center}|
+{\bf\begin{tabular}{rp{50pt}p{50pt}}
+24 & f*e3 & B*e3+\\
+25 & Kf1 & Bf4\\
+26 & Re1&\\
+\end{tabular}}|
+\end{center}
+|26.~Nd3, Bd6; 27.~c4, Rc8; 28.~b3|
+\wdecisive{}
+\begin{center}|
+{\bf\begin{tabular}{rp{50pt}p{50pt}}
+26 & \ldots & f6\\
+\end{tabular}}|
+\end{center}
+
+\board
+{r* *k* r}
+{p * * pp}
+{ * * p *}
+{* *PN * }
+{ * * b *}
+{* * * *P}
+{PPP* *P*}
+{R * RK* }
+$$\showboard$$
+\begin{center}|
+{\bf\begin{tabular}{rp{50pt}p{50pt}}
+27 & Ng6+ & Kf7\\
+28 & N*f4 & Rhe8\\
+29 & R*e8&\\
+\end{tabular}}|
+\end{center}
+|29.~c4, Rac8; 30.~b3, h6; 31.~Kf2, R*e1; 32.~R*e1, Rc5|
+\wdecisive{}
+\begin{center}|
+{\bf\begin{tabular}{rp{50pt}p{50pt}}
+29 & \ldots & R*e8\\
+30 & d6&\\
+\end{tabular}}|
+\end{center}
+|30.~Kf2, Re5; 31.~Rd1, g5; 32.~Ne2|
+\wdecisive{}
+\begin{center}|
+{\bf\begin{tabular}{rp{50pt}p{50pt}}
+30 & \ldots & Rd8\\
+31 & Rd1 & g6\\
+32 & Nd5&\\
+\end{tabular}}|
+\end{center}
+|32.~c4, g5; 33.~Ne2, Ke6; 34.~Nd4+, Kd7; 35.~c5, h6|
+\wdecisive{},5.25
+\begin{center}|
+{\bf\begin{tabular}{rp{50pt}p{50pt}}
+32 & \ldots & R*d6\\
+33 & c4&\\
+\end{tabular}}|
+\end{center}
+|33.~Ke2, Ke6; 34.~c4, Rc6; 35.~Kd3, f5; 36.~b3|
+\wdecisive{},4.53
+\begin{center}|
+{\bf\begin{tabular}{rp{50pt}p{50pt}}
+33 & \ldots & f5\\
+34 & Ke1&\\
+\end{tabular}}|
+\end{center}
+|34.~b3|
+\wdecisive{},4.22
+\begin{center}|
+{\bf\begin{tabular}{rp{50pt}p{50pt}}
+34 & \ldots & Ra6\\
+35 & a3 & f4??\\
+\end{tabular}}|
+\end{center}
+Simply throws away a pawn.
+\begin{center}|
+{\bf\begin{tabular}{rp{50pt}p{50pt}}
+36 & c5&\\
+\end{tabular}}|
+\end{center}
+
+\board
+{ * * * *}
+{p * *k*p}
+{r* * *p*}
+{* PN* * }
+{ * * p *}
+{P * * *P}
+{ P * *P*}
+{* *RK * }
+$$\showboard$$
+ why not take the pawn?
+|36.~N*f4, h6; 37.~g3, g5; 38.~Nd5, Re6+; 39.~Kd2, Re4|
+\wdecisive{},5.06 looks good to me.
+\begin{center}|
+{\bf\begin{tabular}{rp{50pt}p{50pt}}
+36 & \ldots & Ke6?\\
+37 & Nc7+&\\
+\end{tabular}}|
+\end{center}
+Black resigns
+
+\board
+{ * * * *}
+{p N * *p}
+{r* *k*p*}
+{* P * * }
+{ * * p *}
+{P * * *P}
+{ P * *P*}
+{* *RK * }
+$$\showboard$$
+$1\!-\!0$
+\clearpage
+\begin{center}
+\fbox{\fbox{\large\begin{tabular}{l}
+Game  \hspace{.3 in} Nov 1993 \hspace{.3 in} $1\!-\!0$\\
+\hline
+Foo C70\\
+\raisebox{2.5pt}[11pt]{\framebox[11pt]{\rule{0pt}{4.25pt}}} Andy Gill\\
+\rule[-1pt]{11pt}{11pt} Adam Rintoul\\
+Dunfermline Club Championship
+\end{tabular}}}
+\end{center}
+\begin{center}|
+{\bf\begin{tabular}{rp{50pt}p{50pt}}
+1 & e4 & e5\\
+2 & Nf3 & Nc6\\
+3 & Bb5 & a6\\
+4 & Ba4 & b5\\
+5 & Bb3 & Nf6\\
+6 & d3 & Bc5\\
+\end{tabular}}|
+\end{center}
+|6\ldots~Bb7; 7.~0-0, d5; 8.~e*d5, N*d5; 9.~Bg5, Be7; 10.~B*e7, Nd*e7|
+=
+\begin{center}|
+{\bf\begin{tabular}{rp{50pt}p{50pt}}
+7 & Be3?&\\
+\end{tabular}}|
+\end{center}
+
+\board
+{r*bqk* r}
+{* pp*ppp}
+{p*n* n *}
+{*pb p * }
+{ * *P* *}
+{*B*PBN* }
+{PPP* PPP}
+{RN*QK *R}
+$$\showboard$$
+|7.~Nc3|
+\begin{center}|
+{\bf\begin{tabular}{rp{50pt}p{50pt}}
+7 & \ldots & B*e3\\
+8 & f*e3 & 0-0\\
+9 & 0-0 & d6\\
+10 & Nbd2&\\
+\end{tabular}}|
+\end{center}
+|10.~a3, Bb7; 11.~Nc3, Rb8; 12.~Nd5, a5|
+\bbetter{},0.13
+\begin{center}|
+{\bf\begin{tabular}{rp{50pt}p{50pt}}
+10 & \ldots & Bg4\\
+11 & d4?&\\
+\end{tabular}}|
+\end{center}
+|11.~a4, Rb8; 12.~a*b5, a*b5; 13.~h3, Bh5; 14.~Qe2, Nd7|
+\bbetter{},-0.22
+\begin{center}|
+{\bf\begin{tabular}{rp{50pt}p{50pt}}
+11 & \ldots & B*f3\\
+\end{tabular}}|
+\end{center}
+|11\ldots~e*d4; 12.~Qe1, d*e3; 13.~Q*e3, Na5; 14.~Nd4, c6; 15.~c3, N*b3|
+\bupperhand{} a pawn up.
+\begin{center}|
+{\bf\begin{tabular}{rp{50pt}p{50pt}}
+12 & N*f3 & N*e4??\\
+\end{tabular}}|
+\end{center}
+
+\board
+{r* q rk*}
+{* p *ppp}
+{p*np * *}
+{*p* p * }
+{ * Pn* *}
+{*B* PN* }
+{PPP* *PP}
+{R *Q*RK }
+$$\showboard$$
+|12\ldots~Qe8; 13.~d5, Na5; 14.~Qd3, N*b3; 15.~a*b3, c6; 16.~Rad1|
+\bupperhand{}
+\begin{center}|
+{\bf\begin{tabular}{rp{50pt}p{50pt}}
+13 & Bd5 & Qd7\\
+\end{tabular}}|
+\end{center}
+|13\ldots~Ng5; 14.~B*c6, N*f3+; 15.~B*f3, Rb8; 16.~d*e5, d*e5; 17.~a3|
+\wdecisive{}
+\begin{center}|
+{\bf\begin{tabular}{rp{50pt}p{50pt}}
+14 & B*e4 & f5\\
+15 & Bd5+ & Kh8\\
+16 & Ng5 & e*d4\\
+17 & Qh5&\\
+\end{tabular}}|
+\end{center}
+
+\board
+{r* * r k}
+{* pq* pp}
+{p*np * *}
+{*p*B*pNQ}
+{ * p * *}
+{* * P * }
+{PPP* *PP}
+{R * *RK }
+$$\showboard$$
+|17.~N*h7, Rfb8; 18.~Ng5, g6; 19.~Qf3, Ne5; 20.~Qh3+, Kg7; 21.~B*a8|
+\wdecisive{},4.44
+\begin{center}|
+{\bf\begin{tabular}{rp{50pt}p{50pt}}
+17 & \ldots & h6?\\
+\end{tabular}}|
+\end{center}
+|17\ldots~g6; 18.~B*c6, g*h5; 19.~B*d7, d*e3; 20.~R*f5, R*f5; 21.~B*f5|
+\wdecisive{},4.90
+\begin{center}|
+{\bf\begin{tabular}{rp{50pt}p{50pt}}
+18 & e*d4&\\
+\end{tabular}}|
+\end{center}
+|18.~Qg6, Qe8; 19.~Qh7 mate|
+\begin{center}|
+{\bf\begin{tabular}{rp{50pt}p{50pt}}
+18 & \ldots & Rae8\\
+\end{tabular}}|
+\end{center}
+|18\ldots~Rf6; 19.~Rae1, Raf8; 20.~Ne6, Re8; 21.~Qf3|
+\wdecisive{},2.66
+\begin{center}|
+{\bf\begin{tabular}{rp{50pt}p{50pt}}
+19 & Rae1 & R*e1\\
+20 & R*e1 & Nd8\\
+21 & Qg6&\\
+\end{tabular}}|
+\end{center}
+I finally find the two move mate!
+
+\board
+{ * n r k}
+{* pq* p }
+{p* p *Qp}
+{*p*B*pN }
+{ * P * *}
+{* * * * }
+{PPP* *PP}
+{* * R K }
+$$\showboard$$
+$1\!-\!0$
+\clearpage
+\begin{center}
+\fbox{\fbox{\large\begin{tabular}{l}
+Game  \hspace{.3 in} Nov 1993 \hspace{.3 in} $1\!-\!0$\\
+\hline
+Foo C30\\
+\raisebox{2.5pt}[11pt]{\framebox[11pt]{\rule{0pt}{4.25pt}}} Ian Robertson (2150)\\
+\rule[-1pt]{11pt}{11pt} Andy Gill\\
+Dunfermline Club Championship
+\end{tabular}}}
+\end{center}
+\begin{center}|
+{\bf\begin{tabular}{rp{50pt}p{50pt}}
+1 & e4 & e5\\
+2 & f4 & d6\\
+3 & Nf3 & Nc6\\
+\end{tabular}}|
+\end{center}
+|3\ldots~e*f4|
+Just take the pawn, and then follow the main line KG.
+\begin{center}|
+{\bf\begin{tabular}{rp{50pt}p{50pt}}
+4 & Bb5 & Bd7\\
+5 & 0-0 & Nf6\\
+6 & Nc3 & Be7\\
+\end{tabular}}|
+\end{center}
+|6\ldots~a6; 7.~Ba4, e*f4; 8.~d3, b5; 9.~Bb3, b4|
+Who knows?
+\begin{center}|
+{\bf\begin{tabular}{rp{50pt}p{50pt}}
+7 & d3&\\
+\end{tabular}}|
+\end{center}
+
+\board
+{r* qk* r}
+{pppbbppp}
+{ *np n *}
+{*B* p * }
+{ * *PP *}
+{* NP*N* }
+{PPP* *PP}
+{R BQ*RK }
+$$\showboard$$
+ At this point white is winning.
+\begin{center}|
+{\bf\begin{tabular}{rp{50pt}p{50pt}}
+7 & \ldots & 0-0\\
+8 & Kh1!&\\
+\end{tabular}}|
+\end{center}
+A clever waiting move, to avoid temp gaining checks.
+|8.~Ne2|
+\begin{center}|
+{\bf\begin{tabular}{rp{50pt}p{50pt}}
+8 & \ldots & Nd4?\\
+\end{tabular}}|
+\end{center}
+losses a pawn
+\begin{center}|
+{\bf\begin{tabular}{rp{50pt}p{50pt}}
+9 & B*d7 & Q*d7\\
+\end{tabular}}|
+\end{center}
+|9\ldots~N*f3; 10.~Bh3, Nd4; 11.~Be3, c5; 12.~f*e5, d*e5|
+\wbetter{}
+\begin{center}|
+{\bf\begin{tabular}{rp{50pt}p{50pt}}
+10 & f*e5 & N*f3??\\
+\end{tabular}}|
+\end{center}
+
+\board
+{r* * rk*}
+{pppqbppp}
+{ * p n *}
+{* * P * }
+{ * *P* *}
+{* NP*n* }
+{PPP* *PP}
+{R BQ*R*K}
+$$\showboard$$
+ Losses the piece.
+\begin{center}|
+{\bf\begin{tabular}{rp{50pt}p{50pt}}
+11 & e*f6 & B*f6\\
+12 & Q*f3 & b5?\\
+\end{tabular}}|
+\end{center}
+what is this for?
+|12\ldots~Rae8|
+Planning taking control over the very white center.
+\begin{center}|
+{\bf\begin{tabular}{rp{50pt}p{50pt}}
+13 & Nd5&\\
+\end{tabular}}|
+\end{center}
+
+\board
+{r* * rk*}
+{p pq*ppp}
+{ * p b *}
+{*p*N* * }
+{ * *P* *}
+{* *P*Q* }
+{PPP* *PP}
+{R B *R*K}
+$$\showboard$$
+\begin{center}|
+{\bf\begin{tabular}{rp{50pt}p{50pt}}
+13 & \ldots & Qd8??\\
+\end{tabular}}|
+\end{center}
+Losses another pawn, as well as weakening the kingside, and allowing
+exchange of queens.
+|13\ldots~Bd8|
+\begin{center}|
+{\bf\begin{tabular}{rp{50pt}p{50pt}}
+14 & N*f6+ & Q*f6\\
+15 & Q*f6 & g*f6\\
+16 & R*f6 & Kg7\\
+17 & Bg5&\\
+\end{tabular}}|
+\end{center}
+Black is just out of good moves.
+\begin{center}|
+{\bf\begin{tabular}{rp{50pt}p{50pt}}
+17 & \ldots & Rae8?\\
+\end{tabular}}|
+\end{center}
+Blocking in the f rook, allowing the skew.
+\begin{center}|
+{\bf\begin{tabular}{rp{50pt}p{50pt}}
+18 & Raf1 & d5?\\
+\end{tabular}}|
+\end{center}
+again lack of vision
+\begin{center}|
+{\bf\begin{tabular}{rp{50pt}p{50pt}}
+19 & Bh6+ & Kg8\\
+20 & e*d5 & Rd8\\
+21 & B*f8 & R*f8\\
+22 & Rc6&\\
+\end{tabular}}|
+\end{center}
+Planning an invasion of the 7th. Textbook play.
+\begin{center}|
+{\bf\begin{tabular}{rp{50pt}p{50pt}}
+22 & \ldots & Rd8\\
+\end{tabular}}|
+\end{center}
+
+\board
+{ * r *k*}
+{p p *p*p}
+{ *R* * *}
+{*p*P* * }
+{ * * * *}
+{* *P* * }
+{PPP* *PP}
+{* * *R*K}
+$$\showboard$$
+ Planing to remove the dangerous white pawn, but missing the connected
+rooks that arrive on the 7th.
+\begin{center}|
+{\bf\begin{tabular}{rp{50pt}p{50pt}}
+23 & R*c7 & R*d5\\
+24 & Rf*f7 & Rd8\\
+\end{tabular}}|
+\end{center}
+Silly, blocking the kings escape, athough its over anyway. I should
+have tried for at least one cheapo.
+|24\ldots~Re5|
+\begin{center}|
+{\bf\begin{tabular}{rp{50pt}p{50pt}}
+25 & R*h7 & Rf8??\\
+\end{tabular}}|
+\end{center}
+Again just missing the action.
+\begin{center}|
+{\bf\begin{tabular}{rp{50pt}p{50pt}}
+26 & Rcg7 mate&\\
+\end{tabular}}|
+\end{center}
+
+\board
+{ * * rk*}
+{p * * RR}
+{ * * * *}
+{*p* * * }
+{ * * * *}
+{* *P* * }
+{PPP* *PP}
+{* * * *K}
+$$\showboard$$
+$1\!-\!0$
+\clearpage
+\begin{center}
+\fbox{\fbox{\large\begin{tabular}{l}
+Game  \hspace{.3 in} Dec 1993 \hspace{.3 in} $1\!-\!0$\\
+\hline
+Foo B10\\
+\raisebox{2.5pt}[11pt]{\framebox[11pt]{\rule{0pt}{4.25pt}}} Andy Gill\\
+\rule[-1pt]{11pt}{11pt} Bob Colquhoun\\
+Dunfermline Club Knockout
+\end{tabular}}}
+\end{center}
+\begin{center}|
+{\bf\begin{tabular}{rp{50pt}p{50pt}}
+1 & e4 & c6\\
+2 & Nf3 & d5\\
+3 & e*d5 & c*d5\\
+4 & c4&\\
+\end{tabular}}|
+\end{center}
+|4.~d4|
+Score: 0.06
+\begin{center}|
+{\bf\begin{tabular}{rp{50pt}p{50pt}}
+4 & \ldots & Nf6\\
+\end{tabular}}|
+\end{center}
+|4\ldots~d4; 5.~b3, Nc6; 6.~Bb2, Nf6; 7.~Na3, e5|
+Score: -0.03
+\begin{center}|
+{\bf\begin{tabular}{rp{50pt}p{50pt}}
+5 & c*d5&\\
+\end{tabular}}|
+\end{center}
+|5.~d4, e6; 6.~c*d5, N*d5; 7.~Nbd2, Bd6; 8.~Bc4|
+Score: 0.13
+\begin{center}|
+{\bf\begin{tabular}{rp{50pt}p{50pt}}
+5 & \ldots & N*d5\\
+6 & Bc4 & e6\\
+\end{tabular}}|
+\end{center}
+|6\ldots~Nb6; 7.~Bb3, Nc6; 8.~d4, Bf5; 9.~Bg5, Be4|
+Score: 0.00
+\begin{center}|
+{\bf\begin{tabular}{rp{50pt}p{50pt}}
+7 & 0-0 & Nc6\\
+8 & d4 & a6\\
+\end{tabular}}|
+\end{center}
+|8\ldots~Bb4; 9.~Bd2, B*d2; 10.~Nb*d2, Nf4; 11.~Nb3, 0-0|
+Score: -0.16
+\begin{center}|
+{\bf\begin{tabular}{rp{50pt}p{50pt}}
+9 & Re1&\\
+\end{tabular}}|
+\end{center}
+|9.~Nc3|
+Score: -0.09
+\begin{center}|
+{\bf\begin{tabular}{rp{50pt}p{50pt}}
+9 & \ldots & b5\\
+\end{tabular}}|
+\end{center}
+|9\ldots~Be7; 10.~Nc3, 0-0; 11.~Qd3, Qd7; 12.~N*d5|
+Score: -0.03
+\begin{center}|
+{\bf\begin{tabular}{rp{50pt}p{50pt}}
+10 & B*d5 & Q*d5\\
+11 & Nc3 & Qf5\\
+\end{tabular}}|
+\end{center}
+|11\ldots~Qd8; 12.~d5, Ne7; 13.~d6, Nf5; 14.~Qd5, Bd7|
+Score: 0.41
+\begin{center}|
+{\bf\begin{tabular}{rp{50pt}p{50pt}}
+12 & d5 & Nd8\\
+\end{tabular}}|
+\end{center}
+|12\ldots~Nb4; 13.~d6, Nd3; 14.~Re4, N*c1; 15.~R*c1, Rb8|
+Score: 0.34
+\begin{center}|
+{\bf\begin{tabular}{rp{50pt}p{50pt}}
+13 & d*e6&\\
+\end{tabular}}|
+\end{center}
+|13.~d6, Nb7; 14.~Ne4, Nc5; 15.~Nd4|
+Score: 0.34
+\begin{center}|
+{\bf\begin{tabular}{rp{50pt}p{50pt}}
+13 & \ldots & B*e6\\
+14 & Qd5&\\
+\end{tabular}}|
+\end{center}
+|14.~Nd5, Rc8; 15.~Nd4, Qg6; 16.~Bf4, Bc5; 17.~Nc7, Kf8; 18.~N*a6|
+Score: 0.75
+\begin{center}|
+{\bf\begin{tabular}{rp{50pt}p{50pt}}
+14 & \ldots & Q*d5\\
+15 & N*d5 & Bd6\\
+16 & Bg5&\\
+\end{tabular}}|
+\end{center}
+|16.~Nd4, Rb8; 17.~Bf4, B*f4; 18.~N*f4, Rb6; 19.~Nd*e6, N*e6; 20.~N*e6|
+Score: 0.00
+\begin{center}|
+{\bf\begin{tabular}{rp{50pt}p{50pt}}
+16 & \ldots & 0-0\\
+\end{tabular}}|
+\end{center}
+|16\ldots~h6; 17.~Bd2, 0-0; 18.~Bf4|
+Score: -0.25
+\begin{center}|
+{\bf\begin{tabular}{rp{50pt}p{50pt}}
+17 & Rad1 & Nc6\\
+\end{tabular}}|
+\end{center}
+|17\ldots~Nb7; 18.~Be7, B*e7|
+Score: 0.00
+\begin{center}|
+{\bf\begin{tabular}{rp{50pt}p{50pt}}
+18 & Nd4&\\
+\end{tabular}}|
+\end{center}
+|18.~Nb6, Bb4; 19.~R*e6, f*e6; 20.~N*a8, R*a8|
+Score: 0.16
+\begin{center}|
+{\bf\begin{tabular}{rp{50pt}p{50pt}}
+18 & \ldots & B*d5\\
+\end{tabular}}|
+\end{center}
+|18\ldots~N*d4; 19.~R*d4, h6; 20.~Ne7, Kh7; 21.~R*d6, h*g5; 22.~Nd5|
+Score: -0.25
+\begin{center}|
+{\bf\begin{tabular}{rp{50pt}p{50pt}}
+19 & N*c6 & B*h2+\\
+\end{tabular}}|
+\end{center}
+|19\ldots~Rfe8; 20.~R*e8, R*e8; 21.~h3, Re6; 22.~Nd4, Re4|
+Score: -0.13
+\begin{center}|
+{\bf\begin{tabular}{rp{50pt}p{50pt}}
+20 & K*h2 & B*c6\\
+21 & Rd6 & Rfe8\\
+\end{tabular}}|
+\end{center}
+|21\ldots~Rac8|
+Score: -0.44
+\begin{center}|
+{\bf\begin{tabular}{rp{50pt}p{50pt}}
+22 & R*e8+&\\
+\end{tabular}}|
+\end{center}
+|22.~Rc1, Be4; 23.~Rc7, h6; 24.~Be3, Kf8|
+Score: -0.41
+\begin{center}|
+{\bf\begin{tabular}{rp{50pt}p{50pt}}
+22 & \ldots & B*e8\\
+23 & a3&\\
+\end{tabular}}|
+\end{center}
+|23.~Be3, h6; 24.~b3, Kh7; 25.~a3, g6; 26.~Bd4|
+Score: -0.78
+\begin{center}|
+{\bf\begin{tabular}{rp{50pt}p{50pt}}
+23 & \ldots & a5\\
+\end{tabular}}|
+\end{center}
+|23\ldots~h6; 24.~Be3, Kh7; 25.~b3, f6; 26.~Bd4, Bf7; 27.~b4|
+Score: -0.88
+\begin{center}|
+{\bf\begin{tabular}{rp{50pt}p{50pt}}
+24 & Kg3&\\
+\end{tabular}}|
+\end{center}
+|24.~b3, h6; 25.~Rd8, R*d8; 26.~B*d8, a4; 27.~b*a4, b*a4|
+Score: -0.81
+\begin{center}|
+{\bf\begin{tabular}{rp{50pt}p{50pt}}
+24 & \ldots & a4\\
+\end{tabular}}|
+\end{center}
+|24\ldots~h6|
+Score: -0.91
+\begin{center}|
+{\bf\begin{tabular}{rp{50pt}p{50pt}}
+25 & Bc1&\\
+\end{tabular}}|
+\end{center}
+|25.~Kh4, h6; 26.~Be3, Kh7; 27.~Bd4, Rc8; 28.~g3, Bc6|
+Score: -1.03
+\begin{center}|
+{\bf\begin{tabular}{rp{50pt}p{50pt}}
+25 & \ldots & Rc8\\
+\end{tabular}}|
+\end{center}
+|25\ldots~h6; 26.~Be3, Kh7; 27.~Kh4, Rc8; 28.~Bd4, Bc6; 29.~f3|
+Score: -1.09
+\begin{center}|
+{\bf\begin{tabular}{rp{50pt}p{50pt}}
+26 & Bd2&\\
+\end{tabular}}|
+\end{center}
+|26.~Be3, h6; 27.~Kh4, Kh7; 28.~Bd4, Bc6; 29.~f3|
+Score: -1.13
+\begin{center}|
+{\bf\begin{tabular}{rp{50pt}p{50pt}}
+26 & \ldots & Rc4\\
+\end{tabular}}|
+\end{center}
+|26\ldots~Bc6; 27.~Be3, h6; 28.~f3, Kh7|
+Score: -1.16
+\begin{center}|
+{\bf\begin{tabular}{rp{50pt}p{50pt}}
+27 & Rd8 & Re4\\
+28 & Bb4&\\
+\end{tabular}}|
+\end{center}
+|28.~f4|
+Score: -0.88
+\begin{center}|
+{\bf\begin{tabular}{rp{50pt}p{50pt}}
+28 & \ldots & f6\\
+\end{tabular}}|
+\end{center}
+|28\ldots~h6; 29.~Kf3, Re6; 30.~Kg4, Kh7; 31.~f4, Re4; 32.~g3|
+Score: -1.13
+\begin{center}|
+{\bf\begin{tabular}{rp{50pt}p{50pt}}
+29 & f4&\\
+\end{tabular}}|
+\end{center}
+|29.~Kf3, Re6; 30.~Kg4, Kf7; 31.~Kh4, Re2; 32.~Rd2|
+Score: -0.91
+\begin{center}|
+{\bf\begin{tabular}{rp{50pt}p{50pt}}
+29 & \ldots & Kf7\\
+30 & Kf3&\\
+\end{tabular}}|
+\end{center}
+|30.~Rc8, Kg6; 31.~Kf3|
+Score: -1.16
+\begin{center}|
+{\bf\begin{tabular}{rp{50pt}p{50pt}}
+30 & \ldots & Bc6\\
+31 & Rc8&\\
+\end{tabular}}|
+\end{center}
+|31.~Kg3, Re2; 32.~Rd2, R*d2; 33.~B*d2, Ke6; 34.~Be3|
+Score: -1.25
+\begin{center}|
+{\bf\begin{tabular}{rp{50pt}p{50pt}}
+31 & \ldots & R*b4+\\
+32 & R*c6 & R*b2\\
+33 & g4&\\
+\end{tabular}}|
+\end{center}
+|33.~Rb6|
+Score: -2.06
+\begin{center}|
+{\bf\begin{tabular}{rp{50pt}p{50pt}}
+33 & \ldots & Rb3+\\
+34 & Ke4 & R*a3\\
+35 & Rc7+&\\
+\end{tabular}}|
+\end{center}
+|35.~f5, h6; 36.~Rc7, Kg8; 37.~Rb7, Rb3; 38.~Rd7, Rb4; 39.~Kf3|
+Score: -3.28
+\begin{center}|
+{\bf\begin{tabular}{rp{50pt}p{50pt}}
+35 & \ldots & Kg6\\
+36 & Rb7&\\
+\end{tabular}}|
+\end{center}
+|36.~f5, Kh6; 37.~Rc2, Rb3; 38.~g5, Kh5; 39.~g*f6, g*f6; 40.~Rh2|
+Score: -3.34
+\begin{center}|
+{\bf\begin{tabular}{rp{50pt}p{50pt}}
+36 & \ldots & Rb3\\
+37 & f5+&\\
+\end{tabular}}|
+\end{center}
+|37.~Kd4|
+Score: -3.44
+\begin{center}|
+{\bf\begin{tabular}{rp{50pt}p{50pt}}
+37 & \ldots & Kh6\\
+38 & g5+&\\
+\end{tabular}}|
+\end{center}
+|38.~Kd4, a3; 39.~Ra7, b4; 40.~Kc4, Rb2; 41.~Rb7, Rc2|
+Score: -3.59
+\begin{center}|
+{\bf\begin{tabular}{rp{50pt}p{50pt}}
+38 & \ldots & f*g5\\
+39 & Rb6+ & Kh5\\
+40 & Rb7 & Rb4+\\
+\end{tabular}}|
+\end{center}
+|40\ldots~Kg4; 41.~R*g7, Rb4; 42.~Ke5, Rf4; 43.~f6, h5; 44.~Ra7, h4|
+Score: -4.09
+\begin{center}|
+{\bf\begin{tabular}{rp{50pt}p{50pt}}
+41 & Ke5 & Rf4\\
+\end{tabular}}|
+\end{center}
+|41\ldots~Kg4; 42.~R*g7, Rf4; 43.~f6, h5; 44.~Ra7, Rf5; 45.~Ke6, h4|
+Score: -4.22
+\begin{center}|
+{\bf\begin{tabular}{rp{50pt}p{50pt}}
+42 & R*b5 & Kg4\\
+43 & Ke6 & R*f5\\
+\end{tabular}}|
+\end{center}
+|43\ldots~h5; 44.~Re5, h4; 45.~Re1, a3; 46.~Ra1, Rf3; 47.~Rg1, Kh5|
+Score: -3.94
+\begin{center}|
+{\bf\begin{tabular}{rp{50pt}p{50pt}}
+44 & R*f5&\\
+\end{tabular}}|
+\end{center}
+
+\board
+{ * * * *}
+{* * * pp}
+{ * *K* *}
+{* * *Rp }
+{p* * *k*}
+{* * * * }
+{ * * * *}
+{* * * * }
+$$\showboard$$
+$1\!-\!0$
+\clearpage
+\begin{center}
+\fbox{\fbox{\large\begin{tabular}{l}
+Game  \hspace{.3 in} Dec 1993 \hspace{.3 in} $0\!-\!1$\\
+\hline
+\raisebox{2.5pt}[11pt]{\framebox[11pt]{\rule{0pt}{4.25pt}}} Andy Gill\\
+\rule[-1pt]{11pt}{11pt} George Petrie\\
+Dunfermline Club Championship
+\end{tabular}}}
+\end{center}
+\begin{center}|
+{\bf\begin{tabular}{rp{50pt}p{50pt}}
+1 & e4 & c5\\
+2 & Nf3 & Nc6\\
+3 & Bc4 & d6\\
+\end{tabular}}|
+\end{center}
+|3\ldots~e6; 4.~Nc3, Nge7; 5.~d3, d5; 6.~Bb3, d4; 7.~Ne2, e5|
+Score: 0.09
+\begin{center}|
+{\bf\begin{tabular}{rp{50pt}p{50pt}}
+4 & 0-0&\\
+\end{tabular}}|
+\end{center}
+|4.~c3|
+Score: 0.03
+\begin{center}|
+{\bf\begin{tabular}{rp{50pt}p{50pt}}
+4 & \ldots & e6\\
+\end{tabular}}|
+\end{center}
+|4\ldots~g6; 5.~d4, c*d4; 6.~N*d4, Bg7; 7.~Be3, N*d4; 8.~B*d4, Nf6|
+Score: -0.16
+\begin{center}|
+{\bf\begin{tabular}{rp{50pt}p{50pt}}
+5 & d3&\\
+\end{tabular}}|
+\end{center}
+|5.~Bb5, Nf6; 6.~d3, Bd7; 7.~Nc3, Be7; 8.~Bg5, 0-0|
+Score: 0.00
+\begin{center}|
+{\bf\begin{tabular}{rp{50pt}p{50pt}}
+5 & \ldots & Be7\\
+\end{tabular}}|
+\end{center}
+|5\ldots~d5; 6.~Bb5, Nf6; 7.~Ne5, Bd7; 8.~N*d7, Q*d7; 9.~Bg5|
+Score: 0.03
+\begin{center}|
+{\bf\begin{tabular}{rp{50pt}p{50pt}}
+6 & Nc3 & Bd7\\
+\end{tabular}}|
+\end{center}
+|6\ldots~Bf6|
+Score: 0.00
+\begin{center}|
+{\bf\begin{tabular}{rp{50pt}p{50pt}}
+7 & Bf4&\\
+\end{tabular}}|
+\end{center}
+|7.~Re1, Nf6; 8.~Be3, 0-0; 9.~a3, Rc8; 10.~Bf4, Nd4; 11.~N*d4|
+Score: 0.06
+\begin{center}|
+{\bf\begin{tabular}{rp{50pt}p{50pt}}
+7 & \ldots & a6\\
+\end{tabular}}|
+\end{center}
+|7\ldots~Na5; 8.~Nd2, N*c4; 9.~N*c4, e5; 10.~Bg3, Be6; 11.~Ne3|
+Score: -0.06
+\begin{center}|
+{\bf\begin{tabular}{rp{50pt}p{50pt}}
+8 & d4&\\
+\end{tabular}}|
+\end{center}
+|8.~a3, Nf6; 9.~Re1, 0-0; 10.~Be3, e5; 11.~Nd5, Be6; 12.~N*e7|
+Score: 0.06
+\begin{center}|
+{\bf\begin{tabular}{rp{50pt}p{50pt}}
+8 & \ldots & c*d4\\
+9 & Ne2 & e5\\
+\end{tabular}}|
+\end{center}
+|9\ldots~Na5|
+Score: -0.94
+\begin{center}|
+{\bf\begin{tabular}{rp{50pt}p{50pt}}
+10 & Bg3 & Nf6\\
+11 & Bd5&\\
+\end{tabular}}|
+\end{center}
+|11.~c3, N*e4; 12.~c*d4, 0-0; 13.~Bd5, N*g3|
+Score: -0.97
+\begin{center}|
+{\bf\begin{tabular}{rp{50pt}p{50pt}}
+11 & \ldots & 0-0\\
+\end{tabular}}|
+\end{center}
+|11\ldots~Nb4; 12.~c3, Nb*d5; 13.~e*d5, d3; 14.~Nc1, e4; 15.~Nd2|
+Score: -1.16
+\begin{center}|
+{\bf\begin{tabular}{rp{50pt}p{50pt}}
+12 & c4&\\
+\end{tabular}}|
+\end{center}
+|12.~c3, d*c3; 13.~N*c3, b6; 14.~a3, Qc7; 15.~b3, Be6; 16.~B*e6|
+Score: -0.63
+\begin{center}|
+{\bf\begin{tabular}{rp{50pt}p{50pt}}
+12 & \ldots & Qb6\\
+\end{tabular}}|
+\end{center}
+|12\ldots~Bg4; 13.~Qb3, Qc7; 14.~Rac1, Rac8; 15.~Qd3, b6|
+Score: -1.13
+\begin{center}|
+{\bf\begin{tabular}{rp{50pt}p{50pt}}
+13 & Qd2&\\
+\end{tabular}}|
+\end{center}
+|13.~b3, Bg4; 14.~Nc1, Rac8; 15.~Nd3, Nh5; 16.~a3, N*g3; 17.~f*g3|
+Score: -1.22
+\begin{center}|
+{\bf\begin{tabular}{rp{50pt}p{50pt}}
+13 & \ldots & Rac8\\
+\end{tabular}}|
+\end{center}
+|13\ldots~Nb4; 14.~b3, Bg4; 15.~Rfd1, Nb*d5|
+Score: -1.22
+\begin{center}|
+{\bf\begin{tabular}{rp{50pt}p{50pt}}
+14 & Bh4&\\
+\end{tabular}}|
+\end{center}
+|14.~Rac1|
+Score: -1.25
+\begin{center}|
+{\bf\begin{tabular}{rp{50pt}p{50pt}}
+14 & \ldots & Nb4\\
+\end{tabular}}|
+\end{center}
+|14\ldots~Bg4; 15.~Bg3, Nb4; 16.~b3, Nb*d5; 17.~e*d5, B*f3; 18.~g*f3|
+Score: -1.53
+\begin{center}|
+{\bf\begin{tabular}{rp{50pt}p{50pt}}
+15 & Ne*d4&\\
+\end{tabular}}|
+\end{center}
+|15.~B*f6, B*f6; 16.~h3, N*d5; 17.~c*d5|
+Score: -1.44
+\begin{center}|
+{\bf\begin{tabular}{rp{50pt}p{50pt}}
+15 & \ldots & Nb*d5\\
+\end{tabular}}|
+\end{center}
+|15\ldots~e*d4; 16.~b3, Bg4; 17.~Qf4, Nd3|
+Score: -3.34
+\begin{center}|
+{\bf\begin{tabular}{rp{50pt}p{50pt}}
+16 & B*f6&\\
+\end{tabular}}|
+\end{center}
+|16.~e*d5, e*d4; 17.~Rfe1, Bd8; 18.~b3, Ng4; 19.~B*d8, Rf*d8; 20.~N*d4|
+Score: -1.94
+\begin{center}|
+{\bf\begin{tabular}{rp{50pt}p{50pt}}
+16 & \ldots & N*f6\\
+17 & Ne2&\\
+\end{tabular}}|
+\end{center}
+|17.~Nf5, B*f5; 18.~e*f5, R*c4; 19.~b3, Ne4; 20.~Qd5, Rb4|
+Score: -4.75
+\begin{center}|
+{\bf\begin{tabular}{rp{50pt}p{50pt}}
+17 & \ldots & R*c4\\
+18 & b3&\\
+\end{tabular}}|
+\end{center}
+|18.~Nc3, Rb4; 19.~b3, N*e4; 20.~N*e4, R*e4; 21.~Rfd1|
+Score: -5.13
+\begin{center}|
+{\bf\begin{tabular}{rp{50pt}p{50pt}}
+18 & \ldots & R*e4\\
+19 & Nc3&\\
+\end{tabular}}|
+\end{center}
+|19.~Ng3, Rb4; 20.~Rfe1, Bg4; 21.~Qd3, Rf4; 22.~Qe3, Q*e3; 23.~f*e3|
+Score: -5.38
+\begin{center}|
+{\bf\begin{tabular}{rp{50pt}p{50pt}}
+19 & \ldots & Rg4\\
+\end{tabular}}|
+\end{center}
+|19\ldots~Rf4; 20.~Qe3, Qc7|
+Score: -5.34
+\begin{center}|
+{\bf\begin{tabular}{rp{50pt}p{50pt}}
+20 & Qd1&\\
+\end{tabular}}|
+\end{center}
+|20.~Rae1|
+Score: -5.41
+\begin{center}|
+{\bf\begin{tabular}{rp{50pt}p{50pt}}
+20 & \ldots & Bc6\\
+21 & Na4&\\
+\end{tabular}}|
+\end{center}
+|21.~Rc1, Rf4; 22.~Re1, B*f3; 23.~g*f3, Re8; 24.~a3|
+Score: -5.66
+\begin{center}|
+{\bf\begin{tabular}{rp{50pt}p{50pt}}
+21 & \ldots & Qb4\\
+\end{tabular}}|
+\end{center}
+|21\ldots~B*a4; 22.~b*a4, Qa5; 23.~Qb3, Rb4; 24.~Qc2, R*a4; 25.~Rfc1|
+Score: -5.94
+\begin{center}|
+{\bf\begin{tabular}{rp{50pt}p{50pt}}
+22 & Rc1&\\
+\end{tabular}}|
+\end{center}
+|22.~h3, Rf4; 23.~Nb2, B*f3; 24.~g*f3, Rd4; 25.~Nd3, Qc3|
+Score: -5.81
+\begin{center}|
+{\bf\begin{tabular}{rp{50pt}p{50pt}}
+22 & \ldots & R*g2+\\
+23 & K*g2 & Qg4+\\
+24 & Kh1 & B*f3+\\
+25 & Q*f3 & Q*f3+\\
+26 & Kg1 & Nh5\\
+\end{tabular}}|
+\end{center}
+|26\ldots~Nd5; 27.~Rc4, b5; 28.~Rfc1, b*c4; 29.~R*c4, Bf6|
+Score: -14.53
+\begin{center}|
+{\bf\begin{tabular}{rp{50pt}p{50pt}}
+27 & Rc3 & Qd5\\
+\end{tabular}}|
+\end{center}
+|27\ldots~Qg4; 28.~Kh1, b5; 29.~Rg1, Qd4; 30.~Rh3, Nf4; 31.~Rhg3, b*a4|
+Score: -12.00
+\begin{center}|
+{\bf\begin{tabular}{rp{50pt}p{50pt}}
+28 & Nb6&\\
+\end{tabular}}|
+\end{center}
+|28.~h3, Nf4; 29.~Rg3, Ne2; 30.~Kh2, N*g3; 31.~K*g3, Qd3; 32.~Kg2|
+Score: -11.94
+\begin{center}|
+{\bf\begin{tabular}{rp{50pt}p{50pt}}
+28 & \ldots & Qd4\\
+29 & Rfc1&\\
+\end{tabular}}|
+\end{center}
+|29.~Na4, b5; 30.~h3, Nf4; 31.~Kh2, b*a4; 32.~Rc7, Re8|
+Score: -12.97
+\begin{center}|
+{\bf\begin{tabular}{rp{50pt}p{50pt}}
+29 & \ldots & Q*b6\\
+30 & Rc8&\\
+\end{tabular}}|
+\end{center}
+|30.~R1c2, d5; 31.~h3, Qg6; 32.~Kh2, Nf4; 33.~f3, b6|
+Score: -13.97
+\begin{center}|
+{\bf\begin{tabular}{rp{50pt}p{50pt}}
+30 & \ldots & Nf4\\
+31 & R1c7&\\
+\end{tabular}}|
+\end{center}
+|31.~R8c3, Ne2; 32.~Kf1, N*c1; 33.~R*c1, d5; 34.~h3, Bc5; 35.~f3|
+Score: -15.63
+\begin{center}|
+{\bf\begin{tabular}{rp{50pt}p{50pt}}
+31 & \ldots & Bh4\\
+\end{tabular}}|
+\end{center}
+|31\ldots~Nh3; 32.~Kh1, Q*f2; 33.~Rc4, d5; 34.~Rc3, Qg1|
+Score: -#4
+\begin{center}|
+{\bf\begin{tabular}{rp{50pt}p{50pt}}
+32 & Rc2&\\
+\end{tabular}}|
+\end{center}
+|32.~R*f8, K*f8; 33.~Rc8, Ke7; 34.~Rc2, Qd4; 35.~h3, B*f2; 36.~Kh2|
+Score: -18.41
+\begin{center}|
+{\bf\begin{tabular}{rp{50pt}p{50pt}}
+32 & \ldots & Nd3\\
+\end{tabular}}|
+\end{center}
+|32\ldots~B*f2; 33.~Kf1, Qe3; 34.~R*f8, K*f8; 35.~Rc8, Ke7; 36.~Rc7, Kd8|
+Score: -19.53
+\begin{center}|
+{\bf\begin{tabular}{rp{50pt}p{50pt}}
+33 & R*f8+&\\
+\end{tabular}}|
+\end{center}
+|33.~Kf1, B*f2; 34.~R*f8, K*f8; 35.~Rc8, Ke7; 36.~Rg8, Bg3; 37.~Ke2|
+Score: -14.78
+\begin{center}|
+{\bf\begin{tabular}{rp{50pt}p{50pt}}
+33 & \ldots & K*f8\\
+\end{tabular}}|
+\end{center}
+
+\board
+{ * * k *}
+{*p* *ppp}
+{pq p * *}
+{* * p * }
+{ * * * b}
+{*P*n* * }
+{P*R* P P}
+{* * * K }
+$$\showboard$$
+$0\!-\!1$
+\clearpage
+\begin{center}
+\fbox{\fbox{\large\begin{tabular}{l}
+Game  \hspace{.3 in} Dec 1993 \hspace{.3 in} $0\!-\!1$\\
+\hline
+\raisebox{2.5pt}[11pt]{\framebox[11pt]{\rule{0pt}{4.25pt}}} Andy Gill\\
+\rule[-1pt]{11pt}{11pt} Peter Horne\\
+Dunfermline Club Championship
+\end{tabular}}}
+\end{center}
+\begin{center}|
+{\bf\begin{tabular}{rp{50pt}p{50pt}}
+1 & e4 & e6\\
+2 & Nf3 & Nc6\\
+3 & Bb5 & a6\\
+\end{tabular}}|
+\end{center}
+|3\ldots~d5; 4.~d3, d*e4; 5.~B*c6, b*c6; 6.~d*e4, Q*d1; 7.~K*d1|
+Score: 0.19
+\begin{center}|
+{\bf\begin{tabular}{rp{50pt}p{50pt}}
+4 & Ba4&\\
+\end{tabular}}|
+\end{center}
+|4.~B*c6, d*c6; 5.~0-0, Nf6; 6.~Re1, Be7; 7.~d4, c5; 8.~e5|
+Score: 0.22
+\begin{center}|
+{\bf\begin{tabular}{rp{50pt}p{50pt}}
+4 & \ldots & b5\\
+5 & Bb3 & Bb7\\
+\end{tabular}}|
+\end{center}
+|5\ldots~Na5; 6.~d3, N*b3; 7.~a*b3, Bb7; 8.~0-0, Bc5; 9.~Nc3|
+Score: -0.13
+\begin{center}|
+{\bf\begin{tabular}{rp{50pt}p{50pt}}
+6 & d4&\\
+\end{tabular}}|
+\end{center}
+|6.~c3, Nf6; 7.~d3, Be7; 8.~Be3, 0-0; 9.~Nbd2, d5|
+Score: -0.09
+\begin{center}|
+{\bf\begin{tabular}{rp{50pt}p{50pt}}
+6 & \ldots & Na5\\
+7 & Nbd2&\\
+\end{tabular}}|
+\end{center}
+|7.~e5, N*b3; 8.~a*b3, c5; 9.~Bg5, f6; 10.~Be3, c*d4; 11.~B*d4|
+Score: -0.38
+\begin{center}|
+{\bf\begin{tabular}{rp{50pt}p{50pt}}
+7 & \ldots & Nf6\\
+\end{tabular}}|
+\end{center}
+|7\ldots~N*b3; 8.~a*b3, c5; 9.~0-0, d5; 10.~e*d5, B*d5|
+Score: -0.41
+\begin{center}|
+{\bf\begin{tabular}{rp{50pt}p{50pt}}
+8 & e5 & Nd5\\
+\end{tabular}}|
+\end{center}
+|8\ldots~N*b3; 9.~N*b3, Ne4; 10.~0-0, Be7; 11.~c3, 0-0; 12.~Be3, d5|
+Score: -0.19
+\begin{center}|
+{\bf\begin{tabular}{rp{50pt}p{50pt}}
+9 & 0-0 & d6\\
+\end{tabular}}|
+\end{center}
+|9\ldots~Nf4|
+Score: -0.09
+\begin{center}|
+{\bf\begin{tabular}{rp{50pt}p{50pt}}
+10 & a4&\\
+\end{tabular}}|
+\end{center}
+|10.~B*d5, B*d5; 11.~a4, d*e5; 12.~a*b5, c5; 13.~b*a6, e*d4|
+Score: 0.09
+\begin{center}|
+{\bf\begin{tabular}{rp{50pt}p{50pt}}
+10 & \ldots & b4\\
+\end{tabular}}|
+\end{center}
+|10\ldots~d*e5; 11.~B*d5, Q*d5; 12.~d*e5, c5; 13.~a*b5, a*b5; 14.~b3|
+Score: 0.06
+\begin{center}|
+{\bf\begin{tabular}{rp{50pt}p{50pt}}
+11 & Nc4&\\
+\end{tabular}}|
+\end{center}
+|11.~B*d5, B*d5; 12.~c3, d*e5; 13.~N*e5, Bd6; 14.~c*b4, B*b4; 15.~Ndf3|
+Score: 0.03
+\begin{center}|
+{\bf\begin{tabular}{rp{50pt}p{50pt}}
+11 & \ldots & N*b3\\
+12 & c*b3 & a5\\
+\end{tabular}}|
+\end{center}
+|12\ldots~Rb8; 13.~Qc2, Be7; 14.~Na5, c5; 15.~e*d6, Q*d6; 16.~N*b7, R*b7|
+Score: -0.34
+\begin{center}|
+{\bf\begin{tabular}{rp{50pt}p{50pt}}
+13 & Qe2&\\
+\end{tabular}}|
+\end{center}
+|13.~Bg5, Be7; 14.~B*e7, Q*e7; 15.~Re1, d*e5|
+Score: -0.56
+\begin{center}|
+{\bf\begin{tabular}{rp{50pt}p{50pt}}
+13 & \ldots & f6\\
+\end{tabular}}|
+\end{center}
+|13\ldots~Be7; 14.~Rd1, 0-0; 15.~Be3, d*e5; 16.~d*e5|
+Score: -0.63
+\begin{center}|
+{\bf\begin{tabular}{rp{50pt}p{50pt}}
+14 & e*d6&\\
+\end{tabular}}|
+\end{center}
+|14.~e*f6, Bc8; 15.~f7, K*f7; 16.~Ng5, Ke7; 17.~Ne4, Qd7; 18.~Bg5|
+Score: 0.47
+\begin{center}|
+{\bf\begin{tabular}{rp{50pt}p{50pt}}
+14 & \ldots & c*d6\\
+\end{tabular}}|
+\end{center}
+|14\ldots~B*d6; 15.~Q*e6, Be7; 16.~Bd2, Ra6; 17.~Qf5, c5; 18.~d*c5, B*c5|
+Score: 0.03
+\begin{center}|
+{\bf\begin{tabular}{rp{50pt}p{50pt}}
+15 & Q*e6+ & Qe7\\
+\end{tabular}}|
+\end{center}
+|15\ldots~Be7; 16.~Re1, Ra6; 17.~Nh4, Nc7; 18.~Q*e7, Q*e7; 19.~R*e7, K*e7|
+Score: 0.72
+\begin{center}|
+{\bf\begin{tabular}{rp{50pt}p{50pt}}
+16 & Qh3&\\
+\end{tabular}}|
+\end{center}
+|16.~N*d6, Kd8; 17.~Q*e7, B*e7; 18.~N*b7, Kc8; 19.~Nc5, Re8; 20.~Re1|
+Score: 4.66
+\begin{center}|
+{\bf\begin{tabular}{rp{50pt}p{50pt}}
+16 & \ldots & Qf7\\
+\end{tabular}}|
+\end{center}
+|16\ldots~Qc7; 17.~Re1, Be7; 18.~Qe6, Ra6; 19.~Bd2, Qc8; 20.~Q*c8, B*c8|
+Score: 0.97
+\begin{center}|
+{\bf\begin{tabular}{rp{50pt}p{50pt}}
+17 & Re1+ & Kd8\\
+18 & Bd2 & Qg6\\
+\end{tabular}}|
+\end{center}
+|18\ldots~g6|
+Score: 0.97
+\begin{center}|
+{\bf\begin{tabular}{rp{50pt}p{50pt}}
+19 & Re2&\\
+\end{tabular}}|
+\end{center}
+|19.~Rac1, Ra6; 20.~Ne3, N*e3; 21.~B*e3, d5; 22.~Bf4, Bd6|
+Score: 0.88
+\begin{center}|
+{\bf\begin{tabular}{rp{50pt}p{50pt}}
+19 & \ldots & Be7\\
+\end{tabular}}|
+\end{center}
+|19\ldots~Ra6; 20.~Rae1, Be7; 21.~Qe6, Re8; 22.~Ne3, N*e3; 23.~B*e3, B*f3|
+Score: 0.88
+\begin{center}|
+{\bf\begin{tabular}{rp{50pt}p{50pt}}
+20 & Rae1&\\
+\end{tabular}}|
+\end{center}
+|20.~Nh4, Qh5; 21.~Rae1, Bc8; 22.~Qg3, Qg4; 23.~Bf4, N*f4; 24.~Q*g4|
+Score: 1.06
+\begin{center}|
+{\bf\begin{tabular}{rp{50pt}p{50pt}}
+20 & \ldots & Re8\\
+\end{tabular}}|
+\end{center}
+|20\ldots~Bc8; 21.~Qh4, Bb7; 22.~Bf4, Ba6; 23.~Qg3|
+Score: 0.91
+\begin{center}|
+{\bf\begin{tabular}{rp{50pt}p{50pt}}
+21 & Nh4&\\
+\end{tabular}}|
+\end{center}
+|21.~N*d6, Bc8; 22.~Nh4, Qh5; 23.~Qg3, Rg8; 24.~Nf3, Bg4|
+Score: 2.06
+\begin{center}|
+{\bf\begin{tabular}{rp{50pt}p{50pt}}
+21 & \ldots & Qh5\\
+22 & Nf5&\\
+\end{tabular}}|
+\end{center}
+|22.~N*d6, Ba6; 23.~Re6, Bc8; 24.~g4, B*e6; 25.~R*e6, Nf4; 26.~B*f4|
+Score: 3.06
+\begin{center}|
+{\bf\begin{tabular}{rp{50pt}p{50pt}}
+22 & \ldots & Q*h3\\
+23 & g*h3 & g6\\
+\end{tabular}}|
+\end{center}
+|23\ldots~Bc6; 24.~N*g7, Rg8; 25.~Bh6, Bd7; 26.~Nb6|
+Score: 1.53
+\begin{center}|
+{\bf\begin{tabular}{rp{50pt}p{50pt}}
+24 & Nc*d6&\\
+\end{tabular}}|
+\end{center}
+|24.~Nf*d6, Bc6; 25.~N*e8, K*e8; 26.~Re6, Bd7; 27.~Nd6, Kd8; 28.~Nf7|
+Score: 3.41
+\begin{center}|
+{\bf\begin{tabular}{rp{50pt}p{50pt}}
+24 & \ldots & g*f5\\
+25 & N*e8&\\
+\end{tabular}}|
+\end{center}
+|25.~N*b7, Kd7; 26.~Nc5, B*c5; 27.~d*c5, R*e2|
+Score: 1.66
+\begin{center}|
+{\bf\begin{tabular}{rp{50pt}p{50pt}}
+25 & \ldots & K*e8\\
+26 & Bh6&\\
+\end{tabular}}|
+\end{center}
+|26.~f3, Kd7; 27.~Kf2, Rg8; 28.~Rd1, Bd6; 29.~Kf1, Bc6|
+Score: -0.16
+\begin{center}|
+{\bf\begin{tabular}{rp{50pt}p{50pt}}
+26 & \ldots & Kf7\\
+\end{tabular}}|
+\end{center}
+|26\ldots~Kd7; 27.~f3, Rg8; 28.~Kf2, Bd6; 29.~Rg1, Rg6; 30.~R*g6, h*g6|
+Score: -0.47
+\begin{center}|
+{\bf\begin{tabular}{rp{50pt}p{50pt}}
+27 & Bf4&\\
+\end{tabular}}|
+\end{center}
+|27.~f3, Rg8; 28.~Kf2, Bd6; 29.~Rg1, Rg6; 30.~R*g6, h*g6; 31.~Ke1|
+Score: -0.41
+\begin{center}|
+{\bf\begin{tabular}{rp{50pt}p{50pt}}
+27 & \ldots & Rg8+\\
+28 & Kf1 & Ba6\\
+29 & Bd2 & Bd6\\
+30 & f3&\\
+\end{tabular}}|
+\end{center}
+|30.~Rc1, B*h2; 31.~f3, Bg1; 32.~Rc4, B*c4; 33.~b*c4, B*d4; 34.~Rg2|
+Score: -3.00
+\begin{center}|
+{\bf\begin{tabular}{rp{50pt}p{50pt}}
+30 & \ldots & B*h2\\
+31 & Kf2&\\
+\end{tabular}}|
+\end{center}
+|31.~Rc1, Bg1; 32.~Rc4, B*c4; 33.~b*c4, B*d4; 34.~Re1, Ne7|
+Score: -3.13
+\begin{center}|
+{\bf\begin{tabular}{rp{50pt}p{50pt}}
+31 & \ldots & Bg3+\\
+32 & Kf1 & B*e1\\
+33 & B*e1&\\
+\end{tabular}}|
+\end{center}
+|33.~K*e1, Rg1; 34.~Kf2, Rb1; 35.~Re1, R*b2; 36.~Rd1, Nc3; 37.~Ke1|
+Score: -4.84
+\begin{center}|
+{\bf\begin{tabular}{rp{50pt}p{50pt}}
+33 & \ldots & Ne3+\\
+\end{tabular}}|
+\end{center}
+|33\ldots~Re8; 34.~Bg3, R*e2; 35.~Kg1, R*b2; 36.~Bd6, R*b3|
+Score: -8.31
+\begin{center}|
+{\bf\begin{tabular}{rp{50pt}p{50pt}}
+34 & Kf2 & f4\\
+\end{tabular}}|
+\end{center}
+|34\ldots~Nd1; 35.~Kf1, Re8; 36.~Kg1, B*e2; 37.~f4, Rd8; 38.~Kg2, R*d4|
+Score: -7.81
+\begin{center}|
+{\bf\begin{tabular}{rp{50pt}p{50pt}}
+35 & R*e3 & f*e3+\\
+36 & K*e3 & Re8+\\
+37 & Kd2 & Re2+\\
+38 & Kd1 & R*b2\\
+39 & d5&\\
+\end{tabular}}|
+\end{center}
+|39.~f4, R*b3; 40.~h4, Rd3; 41.~Kc1, R*d4; 42.~Bg3, Rd3; 43.~Bf2|
+Score: -6.09
+\begin{center}|
+{\bf\begin{tabular}{rp{50pt}p{50pt}}
+39 & \ldots & R*b3\\
+\end{tabular}}|
+\end{center}
+
+\board
+{ * * * *}
+{* * *k*p}
+{b* * p *}
+{p *P* * }
+{Pp * * *}
+{*r* *P*P}
+{ * * * *}
+{* *KB * }
+$$\showboard$$
+$0\!-\!1$
+\clearpage
+\begin{center}
+\fbox{\fbox{\large\begin{tabular}{l}
+Game  \hspace{.3 in} Jan 1994 \hspace{.3 in} $1\!-\!0$\\
+\hline
+\raisebox{2.5pt}[11pt]{\framebox[11pt]{\rule{0pt}{4.25pt}}} Andy Gill\\
+\rule[-1pt]{11pt}{11pt} Brian Easton\\
+Dunfermline Club Championship
+\end{tabular}}}
+\end{center}
+\begin{center}|
+{\bf\begin{tabular}{rp{50pt}p{50pt}}
+1 & e4 & Nf6\\
+2 & Nc3 & e6\\
+3 & d4 & d5\\
+4 & e5 & Ne4\\
+5 & N*e4 & d*e4\\
+6 & Bc4 & Nc6\\
+7 & Be3 & Bb4+\\
+8 & c3 & Be7\\
+9 & Ne2 & Bg5\\
+10 & Qd2 & Na5\\
+11 & B*g5 & N*c4\\
+12 & Qf4 & Qd5\\
+13 & b3 & Nb2\\
+14 & 0-0 & b6\\
+15 & Ng3 & Ba6\\
+16 & c4 & Nd3\\
+17 & Q*e4 & Q*e4\\
+18 & N*e4 & Bb7\\
+19 & f3 & 0-0\\
+20 & Nf2 & f6\\
+21 & e*f6 & g*f6\\
+22 & Bh6 & Rf7\\
+23 & N*d3 & Rd8\\
+24 & Nf4 & Re7\\
+25 & Rfe1 & Kf7\\
+26 & Rad1 & e5\\
+27 & d*e5 & R*d1\\
+28 & R*d1 & f*e5\\
+29 & Nd5 & Rd7\\
+30 & f4 & e4\\
+31 & f5 & c6\\
+32 & Nc3 & c5\\
+33 & R*d7+ & Kf6\\
+34 & R*b7 & K*f5\\
+35 & R*h7 & Kg6\\
+36 & Rh8&\\
+\end{tabular}}|
+\end{center}
+
+\board
+{ * * * R}
+{p * * * }
+{ p * *kB}
+{* p * * }
+{ *P*p* *}
+{*PN * * }
+{P* * *PP}
+{* * * K }
+$$\showboard$$
+$1\!-\!0$
+\clearpage
+\begin{center}
+\fbox{\fbox{\large\begin{tabular}{l}
+Game  \hspace{.3 in} Jan 1994 \hspace{.3 in} $1\!-\!0$\\
+\hline
+\raisebox{2.5pt}[11pt]{\framebox[11pt]{\rule{0pt}{4.25pt}}} George Plant\\
+\rule[-1pt]{11pt}{11pt} Andy Gill\\
+Wester-Hailes Congress
+\end{tabular}}}
+\end{center}
+\begin{center}|
+{\bf\begin{tabular}{rp{50pt}p{50pt}}
+1 & e4 & e5\\
+2 & Nf3 & Nc6\\
+3 & Bb5 & a6\\
+4 & Ba4 & Nf6\\
+5 & d4 & b5\\
+6 & Bb3 & d6\\
+7 & Ng5 & Qd7\\
+8 & B*f7+ & Kd8\\
+9 & d5 & Nb4\\
+10 & c3 & N*e4\\
+11 & Be6 & Qe8\\
+12 & c*b4 & N*g5\\
+13 & B*g5+ & Be7\\
+14 & B*e7+ & Q*e7\\
+15 & B*c8 & R*c8\\
+16 & 0-0 & c6\\
+17 & d*c6 & R*c6\\
+18 & Re1 & h5\\
+19 & Nc3 & Rc4\\
+20 & a3 & g5\\
+21 & Nd5 & Qg7\\
+22 & Ne3 & Rc7\\
+23 & Nf5 & Qf6\\
+24 & Q*d6+ & Q*d6\\
+25 & N*d6 & Re7\\
+26 & R*e5 & R*e5\\
+27 & Nf7+ & Ke7\\
+28 & N*e5 & Rc8\\
+29 & Nd3 & Kd6\\
+30 & Kf1 & h4\\
+31 & h3 & Kd5\\
+32 & Ne1 & Ke4\\
+33 & Nf3 & Kf4\\
+34 & Nd4 & Re8\\
+35 & Re1 & R*e1+\\
+36 & K*e1 & Ke5\\
+37 & Nc2 & Ke4\\
+38 & Ke2 & Kf4\\
+39 & Kd3 & Ke5\\
+40 & Ne3 & Kf4\\
+41 & Nd5+ & Kf5\\
+42 & Nc7&\\
+\end{tabular}}|
+\end{center}
+
+\board
+{ * * * *}
+{* N * * }
+{p* * * *}
+{*p* *kp }
+{ P * * p}
+{P *K* *P}
+{ P * PP*}
+{* * * * }
+$$\showboard$$
+$1\!-\!0$
+\clearpage
+\begin{center}
+\fbox{\fbox{\large\begin{tabular}{l}
+Game  \hspace{.3 in} Jan 1994 \hspace{.3 in} $1\!-\!0$\\
+\hline
+\raisebox{2.5pt}[11pt]{\framebox[11pt]{\rule{0pt}{4.25pt}}} Andy Gill\\
+\rule[-1pt]{11pt}{11pt} C. McIntee\\
+Wester-Hailes Congress
+\end{tabular}}}
+\end{center}
+\begin{center}|
+{\bf\begin{tabular}{rp{50pt}p{50pt}}
+1 & e4 & c5\\
+2 & Nf3 & Nc6\\
+3 & Be2 & Nf6\\
+4 & Nc3 & e6\\
+5 & 0-0 & d5\\
+6 & e*d5 & N*d5\\
+7 & N*d5 & Q*d5\\
+8 & c4 & Qd8\\
+9 & Re1 & h5\\
+10 & b3 & f6\\
+11 & Bb2 & h4\\
+12 & h3 & Qc7\\
+13 & d4 & Qf4\\
+14 & d5 & e*d5\\
+15 & c*d5 & Nd8\\
+16 & Bb5+ & Kf7\\
+17 & Qc1 & Qd6\\
+18 & Qe3 & Be7\\
+19 & Qe4 & g5\\
+20 & Bd3 & Ke8\\
+21 & Qg6+ & Kd7\\
+22 & Bb5+ & Kc7\\
+23 & Ne5 & Q*d5\\
+24 & Rad1 & Qg8\\
+25 & Bc4 & Ne6\\
+26 & Q*g8 & R*g8\\
+27 & B*e6 & B*e6\\
+28 & Nf3 & Rad8\\
+29 & R*d8 & R*d8\\
+30 & R*e6 & Rd1+\\
+31 & Kh2 & Bd6+\\
+32 & g3 & f5\\
+33 & Be5 & h*g3+\\
+34 & f*g3 & B*e5\\
+35 & R*e5 & Ra1\\
+36 & R*c5+ & Kb6\\
+37 & Rc2 & g4\\
+38 & h*g4 & f*g4\\
+39 & Ne5 & Kb5\\
+40 & N*g4 & a5\\
+41 & Ne3 & Re1\\
+42 & Nc4 & Re6\\
+43 & g4 & Rh6+\\
+44 & Kg3 & Rg6\\
+45 & Rg2 & a4\\
+46 & Ne5 & Rg5\\
+47 & b*a4+ & K*a4\\
+48 & Kf4 & Rg7\\
+49 & g5 & b5\\
+50 & g6 & b4\\
+51 & Kf5 & Ka3\\
+52 & Kf6 & Rg8\\
+53 & g7&\\
+\end{tabular}}|
+\end{center}
+
+\board
+{ * * *r*}
+{* * * P }
+{ * * K *}
+{* * N * }
+{ p * * *}
+{k * * * }
+{P* * *R*}
+{* * * * }
+$$\showboard$$
+$1\!-\!0$
+\clearpage
+\begin{center}
+\fbox{\fbox{\large\begin{tabular}{l}
+Game  \hspace{.3 in} Jan 1994 \hspace{.3 in} $1\!-\!0$\\
+\hline
+\raisebox{2.5pt}[11pt]{\framebox[11pt]{\rule{0pt}{4.25pt}}} F. Robertson\\
+\rule[-1pt]{11pt}{11pt} Andy Gill\\
+Wester-Hailes Congress
+\end{tabular}}}
+\end{center}
+\begin{center}|
+{\bf\begin{tabular}{rp{50pt}p{50pt}}
+1 & d4 & d5\\
+2 & Nf3 & e6\\
+3 & Bf4 & Be7\\
+4 & e3 & Nf6\\
+5 & Bd3 & b6\\
+6 & 0-0 & 0-0\\
+7 & Re1 & Bb7\\
+8 & Nbd2 & c5\\
+9 & c3 & Nc6\\
+10 & Ne5 & Rc8\\
+11 & Ndf3 & c4\\
+12 & Bc2 & b5\\
+13 & b3 & Qa5\\
+14 & b4 & Qd8\\
+15 & a4 & a6\\
+16 & a*b5 & a*b5\\
+17 & N*c6 & B*c6\\
+18 & Ne5 & Bb7\\
+19 & Ra5 & Qe8\\
+20 & Ra7 & Ba8\\
+21 & Ng4 & Bc6\\
+22 & Be5 & Qd8\\
+23 & Qf3 & Ra8\\
+24 & R*a8 & B*a8\\
+25 & N*f6+ & B*f6\\
+26 & e4 & B*e5\\
+27 & d*e5 & d*e4\\
+28 & B*e4 & B*e4\\
+29 & Q*e4 & Qd3\\
+30 & Q*d3 & c*d3\\
+31 & Rd1 & Rd8\\
+32 & f4 & f5\\
+33 & Kf2 & Kf8\\
+34 & Ke3 & Ke7\\
+35 & R*d3 & R*d3+\\
+36 & K*d3 & Kd7\\
+37 & h3 & g6\\
+38 & Kd4 & Kc6\\
+39 & g3 & Kb6\\
+40 & g4 & Kc6\\
+41 & c4 & Kb6\\
+42 & c5+ & Kc6\\
+43 & Ke3 & Kc7\\
+44 & Ke2 & Kc6\\
+45 & Kf3 & Kd5\\
+46 & g*f5 & g*f5\\
+47 & h4 & Kc4\\
+\end{tabular}}|
+\end{center}
+
+\board
+{ * * * *}
+{* * * *p}
+{ * *p* *}
+{*pP Pp* }
+{ Pk* P P}
+{* * *K* }
+{ * * * *}
+{* * * * }
+$$\showboard$$
+$1\!-\!0$
+\clearpage
+\begin{center}
+\fbox{\fbox{\large\begin{tabular}{l}
+Game  \hspace{.3 in} Jan 1994 \hspace{.3 in} $0\!-\!1$\\
+\hline
+\raisebox{2.5pt}[11pt]{\framebox[11pt]{\rule{0pt}{4.25pt}}} Andy Gill\\
+\rule[-1pt]{11pt}{11pt} A. McKerrow\\
+Wester-Hailes Congress
+\end{tabular}}}
+\end{center}
+\begin{center}|
+{\bf\begin{tabular}{rp{50pt}p{50pt}}
+1 & e4 & e5\\
+2 & Nf3 & Nc6\\
+3 & Bb5 & a6\\
+4 & Ba4 & Nf6\\
+5 & 0-0 & Be7\\
+6 & Nc3 & b5\\
+7 & Bb3 & 0-0\\
+8 & a3 & d6\\
+9 & Re1 & Rb8\\
+10 & d3 & Bg4\\
+11 & h3 & Bh5\\
+12 & Nd5 & N*d5\\
+13 & e*d5 & Nd4\\
+14 & g4 & N*f3+\\
+15 & Q*f3 & Bg6\\
+16 & a4 & b4\\
+17 & a5 & Qc8\\
+18 & Ba4 & f5\\
+19 & g*f5 & R*f5\\
+20 & Qg4 & Bh5\\
+21 & Qc4 & Rf6\\
+22 & Bg5 & Rg6\\
+23 & f4 & h6\\
+24 & R*e5 & d*e5\\
+25 & d6+ & Qe6\\
+26 & Q*e6+ & R*e6\\
+27 & Bb3 & h*g5\\
+28 & d*e7 & Bf7\\
+29 & f*g5 & Rg6\\
+30 & Rf1 & B*b3\\
+31 & c*b3 & R*g5+\\
+32 & Kh2 & Re8\\
+33 & h4 & Rg4\\
+34 & Kh3 & Rf4\\
+35 & R*f4 & e*f4\\
+36 & Kg4 & R*e7\\
+37 & K*f4 & Rd7\\
+38 & Ke4 & Rd6\\
+\end{tabular}}|
+\end{center}
+
+\board
+{ * * *k*}
+{* p * p }
+{p* r * *}
+{P * * * }
+{ p *K* P}
+{*P*P* * }
+{ P * * *}
+{* * * * }
+$$\showboard$$
+$0\!-\!1$
+\clearpage
+\begin{center}
+\fbox{\fbox{\large\begin{tabular}{l}
+Game  \hspace{.3 in} Jan 1994 \hspace{.3 in} $1\!-\!0$\\
+\hline
+\raisebox{2.5pt}[11pt]{\framebox[11pt]{\rule{0pt}{4.25pt}}} S. McCluskey\\
+\rule[-1pt]{11pt}{11pt} Andy Gill\\
+Wester-Hailes Congress
+\end{tabular}}}
+\end{center}
+\begin{center}|
+{\bf\begin{tabular}{rp{50pt}p{50pt}}
+1 & e4 & e5\\
+2 & Nf3 & Nc6\\
+3 & Bb5 & a6\\
+4 & B*c6 & d*c6\\
+5 & d3 & Bd6\\
+6 & 0-0 & Bg4\\
+7 & h3 & Bh5\\
+8 & Be3 & Qe7\\
+9 & Nc3 & Nf6\\
+10 & Re1 & 0-0-0\\
+11 & Nb1 & Bb4\\
+12 & c3 & Ba5\\
+13 & b4 & Bb6\\
+14 & a3 & N*e4\\
+15 & B*b6 & B*f3\\
+16 & Q*f3 & Ng5\\
+17 & Qe3 & c*b6\\
+18 & d4 & Rhe8\\
+19 & h4 & Ne6\\
+20 & g3 & e*d4\\
+21 & c*d4 & R*d4\\
+22 & Nc3 & c5\\
+23 & Rac1 & Red8\\
+24 & b*c5 & b*c5\\
+25 & Ne4 & R8d7\\
+26 & N*c5 & Rc7\\
+27 & N*e6 & Q*e6\\
+28 & Q*d4 & R*c1\\
+29 & R*c1+ & Kb8\\
+30 & Q*g7&\\
+\end{tabular}}|
+\end{center}
+
+\board
+{ k * * *}
+{*p* *pQp}
+{p* *q* *}
+{* * * * }
+{ * * * P}
+{P * * P }
+{ * * P *}
+{* R * K }
+$$\showboard$$
+$1\!-\!0$
+\clearpage
+\begin{center}
+\fbox{\fbox{\large\begin{tabular}{l}
+Game  \hspace{.3 in} Jan 1994 \hspace{.3 in} $1\!-\!0$\\
+\hline
+\raisebox{2.5pt}[11pt]{\framebox[11pt]{\rule{0pt}{4.25pt}}} Andy Gill\\
+\rule[-1pt]{11pt}{11pt} Rab Brown\\
+Dunferline Club Knockout
+\end{tabular}}}
+\end{center}
+\begin{center}|
+{\bf\begin{tabular}{rp{50pt}p{50pt}}
+1 & e4 & e5\\
+2 & Nf3 & d6\\
+3 & d4 & Nc6\\
+4 & d*e5 & N*e5\\
+5 & N*e5 & d*e5\\
+6 & Q*d8+ & K*d8\\
+7 & Bc4 & Bb4+\\
+8 & Nc3 & B*c3+\\
+9 & b*c3 & Be6\\
+10 & B*e6 & f*e6\\
+11 & 0-0 & Nf6\\
+12 & Bb2 & N*e4\\
+13 & c4 & Nd2\\
+14 & Rfd1 & Ke7\\
+15 & R*d2 & c5\\
+16 & B*e5 & Rhg8\\
+17 & Rad1 & g5\\
+18 & Rd7+ & Ke8\\
+19 & R*b7 & g4\\
+20 & R*h7 & Rd8\\
+21 & R*d8+ & K*d8\\
+22 & Rh8 & R*h8\\
+23 & B*h8 & Kd7\\
+24 & f3 & g*f3\\
+25 & g*f3 & Ke7\\
+26 & Be5 & Kd7\\
+27 & Kg2 & Ke7\\
+28 & Kg3 & Kf7\\
+29 & Bd6 & Kf6\\
+30 & B*c5 & a5\\
+31 & Kf4 & e5+\\
+32 & Ke4 & Ke6\\
+33 & f4 & a4\\
+34 & f*e5 & a3\\
+35 & B*a3 & Kd7\\
+36 & Kd5 & Ke8\\
+37 & Ke6 & Kd8\\
+38 & Kf7 & Kd7\\
+39 & e6+ & Kc6\\
+40 & e7 & Kc7\\
+41 & e8=Q & Kb7\\
+42 & Qe6 & Kc7\\
+43 & Qd6+ & Kb7\\
+44 & Ke7 & Ka7\\
+45 & Qb4 & Ka8\\
+46 & Kd7 & Ka7\\
+47 & Kc7 & Ka6\\
+48 & Qb6 mate&\\
+\end{tabular}}|
+\end{center}
+
+\board
+{ * * * *}
+{* K * * }
+{kQ * * *}
+{* * * * }
+{ *P* * *}
+{B * * * }
+{P*P* * P}
+{* * * * }
+$$\showboard$$
+$1\!-\!0$
+\clearpage
+\begin{center}
+\fbox{\fbox{\large\begin{tabular}{l}
+Game  \hspace{.3 in} Jan 1994 \hspace{.3 in} $0\!-\!1$\\
+\hline
+\raisebox{2.5pt}[11pt]{\framebox[11pt]{\rule{0pt}{4.25pt}}} Andy Gill\\
+\rule[-1pt]{11pt}{11pt} Dick Patterson\\
+Dunfermline C vs Grangemouth B
+\end{tabular}}}
+\end{center}
+\begin{center}|
+{\bf\begin{tabular}{rp{50pt}p{50pt}}
+1 & e4 & c5\\
+2 & Nf3 & Nc6\\
+3 & Be2 & e6\\
+4 & b3 & a6\\
+5 & 0-0 & b5\\
+6 & Bb2 & Nf6\\
+7 & e5 & Nd5\\
+8 & d4 & Bb7\\
+9 & c4 & Nf4\\
+10 & c*b5 & N*e2+\\
+11 & Q*e2 & a*b5\\
+12 & Re1 & c*d4\\
+13 & N*d4 & N*d4\\
+14 & B*d4 & Qg5\\
+15 & g3 & Rc8\\
+16 & f4 & Qg6\\
+17 & Q*b5 & Bc6\\
+18 & Qe2 & Be7\\
+19 & a4 & 0-0\\
+20 & a5 & f6\\
+21 & e*f6 & B*f6\\
+22 & B*f6 & R*f6\\
+23 & b4 & R*f4\\
+24 & Qd2 & Rf3\\
+25 & Rf1 & R*f1+\\
+26 & K*f1 & Qf5+\\
+27 & Qf4 & Qd3+\\
+28 & Ke1 & Rf8\\
+29 & Q*f8+ & K*f8\\
+30 & a6 & Qd4\\
+31 & Ke2 & Q*a1\\
+32 & Nd2 & Q*a6+\\
+33 & Ke3 & Qa3+\\
+\end{tabular}}|
+\end{center}
+
+\board
+{ * * k *}
+{* *p* pp}
+{ *b*p* *}
+{* * * * }
+{ P * * *}
+{q * K P }
+{ * N * P}
+{* * * * }
+$$\showboard$$
+$0\!-\!1$
+\clearpage
+\begin{center}
+\fbox{\fbox{\large\begin{tabular}{l}
+Game  \hspace{.3 in} Jan 1994 \hspace{.3 in} $1\!-\!0$\\
+\hline
+\raisebox{2.5pt}[11pt]{\framebox[11pt]{\rule{0pt}{4.25pt}}} Ian Mitchell (1660)\\
+\rule[-1pt]{11pt}{11pt} Andy Gill\\
+Dunfermline Club Championship
+\end{tabular}}}
+\end{center}
+\begin{center}|
+{\bf\begin{tabular}{rp{50pt}p{50pt}}
+1 & e4 & e5\\
+2 & f4 & e*f4\\
+3 & Nf3 & Nc6\\
+4 & d4 & Nf6\\
+5 & Bd3 & d5\\
+6 & e5 & Ne4\\
+7 & 0-0 & g5\\
+8 & c3 & Qe7\\
+9 & Nfd2 & Bf5\\
+10 & Qe2 & N*d2\\
+11 & N*d2 & B*d3\\
+12 & Q*d3 & 0-0-0\\
+13 & a4 & Rg8\\
+14 & a5 & a6\\
+15 & b4 & h6\\
+16 & b5 & Nb8\\
+17 & Nb3 & a*b5\\
+18 & Q*b5 & Qd7\\
+19 & Qd3 & f6\\
+20 & e*f6 & Bd6\\
+21 & Bd2 & Qg4\\
+22 & a6 & N*a6\\
+23 & R*a6 & b*a6\\
+24 & Q*a6+ & Kd7\\
+25 & Qb5+ & Ke6\\
+26 & c4 & f3\\
+27 & R*f3 & Rb8\\
+28 & Q*d5+ & Kd7\\
+29 & Nc5+ & Kd8\\
+30 & Q*g8+&\\
+\end{tabular}}|
+\end{center}
+
+\board
+{ r k *Q*}
+{* p * * }
+{ * b P p}
+{* N * p }
+{ *PP *q*}
+{* * *R* }
+{ * B *PP}
+{* * * K }
+$$\showboard$$
+$1\!-\!0$
+\clearpage
+\begin{center}
+\fbox{\fbox{\large\begin{tabular}{l}
+Game  \hspace{.3 in} Feb 1994 \hspace{.3 in} $0\!-\!1$\\
+\hline
+\raisebox{2.5pt}[11pt]{\framebox[11pt]{\rule{0pt}{4.25pt}}} Andy Gill\\
+\rule[-1pt]{11pt}{11pt} Paul Burtwistle\\
+Dunfermline Club Championship
+\end{tabular}}}
+\end{center}
+\begin{center}|
+{\bf\begin{tabular}{rp{50pt}p{50pt}}
+1 & e4 & c5\\
+2 & Nf3 & e6\\
+3 & Be2 & Nc6\\
+4 & 0-0 & Nf6\\
+5 & Nc3 & d5\\
+6 & e5 & Nd7\\
+7 & Re1 & Nd*e5\\
+8 & N*e5 & N*e5\\
+9 & Bb5+ & Nc6\\
+10 & d4 & a6\\
+11 & B*c6+ & b*c6\\
+12 & Be3 & c*d4\\
+13 & B*d4 & c5\\
+14 & Be5 & Bb7\\
+15 & Qd2 & f6\\
+16 & Bc7 & Q*c7\\
+17 & R*e6+ & Kf7\\
+18 & Rae1 & d4\\
+19 & Nd1 & Bd6\\
+20 & f4 & Rhe8\\
+21 & f5 & Bd5\\
+22 & R*e8 & R*e8\\
+23 & c3 & R*e1+\\
+24 & Q*e1 & B*h2+\\
+25 & Kh1 & Be5\\
+26 & c*d4 & c*d4\\
+27 & Qe2 & Qc4\\
+28 & Qh5+ & Kf8\\
+29 & Kg1 & Qc2\\
+\end{tabular}}|
+\end{center}
+
+\board
+{ * * k *}
+{* * * pp}
+{p* * p *}
+{* *bbP*Q}
+{ * p * *}
+{* * * * }
+{PPq* *P*}
+{* *N* K }
+$$\showboard$$
+$0\!-\!1$
+\clearpage
+\begin{center}
+\fbox{\fbox{\large\begin{tabular}{l}
+Game  \hspace{.3 in} Feb 1994 \hspace{.3 in} $0\!-\!1$\\
+\hline
+\raisebox{2.5pt}[11pt]{\framebox[11pt]{\rule{0pt}{4.25pt}}} Andy Gill\\
+\rule[-1pt]{11pt}{11pt} Jim O'Neill (1875)\\
+Dunfermline Club Knockout
+\end{tabular}}}
+\end{center}
+\begin{center}|
+{\bf\begin{tabular}{rp{50pt}p{50pt}}
+1 & e4 & c5\\
+2 & Nf3 & d6\\
+3 & d4 & c*d4\\
+4 & N*d4 & Nf6\\
+5 & Bd3 & a6\\
+6 & 0-0 & e5\\
+7 & Nf3 & Bg4\\
+8 & Nc3 & Nbd7\\
+9 & Re1 & Rc8\\
+10 & Be3 & b5\\
+11 & Nd5 & N*d5\\
+12 & e*d5 & Nf6\\
+13 & Bg5 & Be7\\
+14 & B*f6 & B*f6\\
+15 & Be4 & 0-0\\
+16 & c3 & Bh4\\
+17 & Qc2 & f5\\
+18 & N*h4 & Q*h4\\
+19 & g3 & Qh5\\
+20 & Bg2 & Rf6\\
+21 & f3 & B*f3\\
+22 & B*f3 & Q*f3\\
+23 & Rad1 & f4\\
+24 & g*f4 & Rg6+\\
+\end{tabular}}|
+\end{center}
+
+\board
+{ *r* *k*}
+{* * * pp}
+{p* p *r*}
+{*p*Pp * }
+{ * * P *}
+{* P *q* }
+{PPQ* * P}
+{* *RR K }
+$$\showboard$$
+$0\!-\!1$
+\clearpage
+\begin{center}
+\fbox{\fbox{\large\begin{tabular}{l}
+Game  \hspace{.3 in} Feb 1994 \hspace{.3 in} $1\!-\!0$\\
+\hline
+\raisebox{2.5pt}[11pt]{\framebox[11pt]{\rule{0pt}{4.25pt}}} Andy Gill\\
+\rule[-1pt]{11pt}{11pt} Bill Bell\\
+Dunfermline Club Championship
+\end{tabular}}}
+\end{center}
+\begin{center}|
+{\bf\begin{tabular}{rp{50pt}p{50pt}}
+1 & e4 & e6\\
+2 & d4 & d5\\
+3 & Nf3 & d*e4\\
+4 & Nfd2 & Q*d4\\
+5 & c3 & Qd5\\
+6 & Be2 & e3\\
+7 & Nf3 & Q*d1+\\
+8 & B*d1 & e*f2+\\
+9 & K*f2 & Nc6\\
+10 & Be3 & Bd7\\
+11 & Re1 & h6\\
+12 & Nbd2 & 0-0-0\\
+13 & Ba4 & Kb8\\
+14 & Rad1 & Bd6\\
+15 & b4 & a6\\
+16 & Nc4 & Be7\\
+17 & Nfe5 & Be8\\
+18 & R*d8+ & B*d8\\
+19 & B*c6 & B*c6\\
+20 & N*f7 & Rh7\\
+21 & N*d8 & Bd5\\
+22 & Nd2 & g5\\
+23 & Rd1 & Kc8\\
+24 & Nb3 & Rd7\\
+25 & N*b7 & B*b7\\
+26 & R*d7 & K*d7\\
+27 & Nc5+ & Kc6\\
+28 & N*e6 & Nf6\\
+29 & Nd8+ & Kd7\\
+30 & N*b7 & Ne4+\\
+31 & Kf3 & N*c3\\
+32 & Nc5+ & Kc6\\
+33 & N*a6 & N*a2\\
+34 & Bd2 & Kb6\\
+35 & Nc5 & Kc6\\
+36 & Nd3 & Kb5\\
+37 & Ke4 & Kc4\\
+38 & g3 & Kb3\\
+39 & h4 & g*h4\\
+40 & g*h4 & Nc3+\\
+41 & B*c3 & K*c3\\
+42 & h5 & Kc4\\
+43 & Ne5+ & K*b4\\
+44 & Kd5 & c5\\
+45 & Nd3+ & Kb5\\
+46 & N*c5 & Kb6\\
+47 & Ne6 & Kb7\\
+48 & Nf8 & Kc7\\
+49 & Ke6 & Kd8\\
+50 & Kf7 & Kc8\\
+51 & Kg6 & Kd8\\
+52 & K*h6 & Ke8\\
+53 & Kg7&\\
+\end{tabular}}|
+\end{center}
+
+\board
+{ * *kN *}
+{* * * K }
+{ * * * *}
+{* * * *P}
+{ * * * *}
+{* * * * }
+{ * * * *}
+{* * * * }
+$$\showboard$$
+$1\!-\!0$
+\clearpage
+\begin{center}
+\fbox{\fbox{\large\begin{tabular}{l}
+Game  \hspace{.3 in} Feb 1994 \hspace{.3 in} $1\!-\!0$\\
+\hline
+\raisebox{2.5pt}[11pt]{\framebox[11pt]{\rule{0pt}{4.25pt}}} John MacArthur (1725)\\
+\rule[-1pt]{11pt}{11pt} Andy Gill\\
+Dunfermline Club Championship
+\end{tabular}}}
+\end{center}
+\begin{center}|
+{\bf\begin{tabular}{rp{50pt}p{50pt}}
+1 & d4 & e6\\
+2 & Nf3 & Nf6\\
+3 & c4 & d5\\
+4 & Nc3 & Nc6\\
+5 & e3 & Be7\\
+6 & Be2 & 0-0\\
+7 & 0-0 & Qd6\\
+8 & c5 & Qd7\\
+9 & Ne5 & N*e5\\
+10 & d*e5 & Ne4\\
+11 & N*e4 & d*e4\\
+12 & Qc2 & Qc6\\
+13 & b4 & Rd8\\
+14 & Bb2 & a5\\
+15 & a3 & a*b4\\
+16 & a*b4 & R*a1\\
+17 & R*a1 & b6\\
+18 & Bd4 & b*c5\\
+19 & b*c5 & Bb7\\
+20 & Ra5 & Ra8\\
+21 & Bb5 & Qd5\\
+22 & Qa4 & R*a5\\
+23 & Q*a5 & B*c5\\
+24 & Q*c7 & Bf8\\
+25 & Be8 & h6\\
+26 & Q*f7+ & Kh7\\
+27 & Q*f8 & Bc6\\
+\end{tabular}}|
+\end{center}
+
+\board
+{ * *BQ *}
+{* * * pk}
+{ *b*p* p}
+{* *qP * }
+{ * Bp* *}
+{* * P * }
+{ * * PPP}
+{* * * K }
+$$\showboard$$
+$1\!-\!0$
+\clearpage
+\begin{center}
+\fbox{\fbox{\large\begin{tabular}{l}
+Game  \hspace{.3 in} Feb 1994 \hspace{.3 in} $1\!-\!0$\\
+\hline
+\raisebox{2.5pt}[11pt]{\framebox[11pt]{\rule{0pt}{4.25pt}}} Ian Sneddon (1685)\\
+\rule[-1pt]{11pt}{11pt} Andy Gill\\
+Dunfermline Club Championship
+\end{tabular}}}
+\end{center}
+\begin{center}|
+{\bf\begin{tabular}{rp{50pt}p{50pt}}
+1 & c4 & e5\\
+2 & Nc3 & Nf6\\
+3 & Nf3 & Nc6\\
+4 & g3 & d5\\
+5 & c*d5 & N*d5\\
+6 & Bg2 & Be6\\
+7 & 0-0 & Bb4\\
+8 & Ne4 & Qd7\\
+9 & d4 & e*d4\\
+10 & N*d4 & 0-0-0\\
+11 & N*e6 & Q*e6\\
+12 & Qc2 & h6\\
+13 & Rd1 & f5\\
+14 & Nc5 & B*c5\\
+15 & Q*c5 & Nde7\\
+16 & Be3 & R*d1+\\
+17 & R*d1 & Rd8\\
+18 & R*d8+ & K*d8\\
+19 & b3 & a6\\
+20 & Qc3 & Qe5\\
+21 & Q*e5 & N*e5\\
+22 & B*b7 & N7c6\\
+23 & Bf4 & Na5\\
+24 & B*e5 & N*b7\\
+25 & B*g7 & h5\\
+26 & Kg2 & Nd6\\
+27 & f3 & Ne8\\
+28 & Be5 & c6\\
+29 & Kh3 & Ke7\\
+30 & Kh4 & Nf6\\
+31 & B*f6+ & K*f6\\
+32 & K*h5 & c5\\
+33 & g4 & f4\\
+34 & g5+ & Kg7\\
+35 & Kg4&\\
+\end{tabular}}|
+\end{center}
+
+\board
+{ * * * *}
+{* * * k }
+{p* * * *}
+{* p * P }
+{ * * pK*}
+{*P* *P* }
+{P* *P* P}
+{* * * * }
+$$\showboard$$
+$1\!-\!0$
+\clearpage
+\begin{center}
+\fbox{\fbox{\large\begin{tabular}{l}
+Game  \hspace{.3 in} Mar 1994 \hspace{.3 in} $0\!-\!1$\\
+\hline
+Foo B70\\
+\raisebox{2.5pt}[11pt]{\framebox[11pt]{\rule{0pt}{4.25pt}}} Andy Gill\\
+\rule[-1pt]{11pt}{11pt} Paul Connally\\
+Dunfermline Club Championship
+\end{tabular}}}
+\end{center}
+\begin{center}|
+{\bf\begin{tabular}{rp{50pt}p{50pt}}
+1 & e4 & c5\\
+2 & Nf3 & d6\\
+3 & d4 & c*d4\\
+4 & N*d4 & g6\\
+5 & Nc3 & Nf6\\
+6 & Bd3 & Bg7\\
+7 & 0-0 & 0-0\\
+8 & f4 & Nc6\\
+9 & N*c6 & b*c6\\
+10 & Kh1 & Rb8\\
+11 & Qe1 & Ng4\\
+12 & h3 & Nf6\\
+13 & b3 & e5\\
+14 & f*e5 & Nh5\\
+15 & Bb2 & d*e5\\
+16 & Rf3 & a5\\
+17 & g4 & Nf4\\
+18 & Rd1 & Qg5\\
+19 & Bc1 & B*g4\\
+20 & B*f4 & B*f3+\\
+\end{tabular}}|
+\end{center}
+
+\board
+{ r * rk*}
+{* * *pbp}
+{ *p* *p*}
+{p * p q }
+{ * *PB *}
+{*PNB*b*P}
+{P*P* * *}
+{* *RQ *K}
+$$\showboard$$
+$0\!-\!1$
+\clearpage
+\begin{center}
+\fbox{\fbox{\large\begin{tabular}{l}
+Game  \hspace{.3 in} Mar 1994 \hspace{.3 in} ${1 \over 2}\!-\!{1 \over 2}$\\
+\hline
+\raisebox{2.5pt}[11pt]{\framebox[11pt]{\rule{0pt}{4.25pt}}} Tom Hunt\\
+\rule[-1pt]{11pt}{11pt} Andy Gill\\
+Glenrothes Congress
+\end{tabular}}}
+\end{center}
+\begin{center}|
+{\bf\begin{tabular}{rp{50pt}p{50pt}}
+1 & Nf3 & Nc6\\
+2 & g3 & e5\\
+3 & Nc3 & d5\\
+4 & d3 & Be6\\
+5 & Bg2 & Qd7\\
+6 & Ng5 & d4\\
+7 & Nce4 & Bf5\\
+8 & a3 & Be7\\
+9 & 0-0 & B*g5\\
+10 & N*g5 & f6\\
+11 & Ne4 & Bh3\\
+12 & Nc5 & Qc8\\
+13 & B*h3 & Q*h3\\
+14 & N*b7 & Rb8\\
+15 & Nc5 & h5\\
+16 & e4 & g5\\
+17 & Qf3 & g4\\
+18 & Qf5 & Kf7\\
+19 & Bg5 & Nce7\\
+20 & Qe6+ & Kg6\\
+21 & f4 & e*f4\\
+22 & R*f4 & K*g5\\
+23 & Raf1 & h4\\
+24 & Qf7 & h*g3\\
+25 & Ne6+ & Kh4\\
+26 & h*g3+ & Q*g3+\\
+\end{tabular}}|
+\end{center}
+
+\board
+{ r * *nr}
+{p p nQ* }
+{ * *Np *}
+{* * * * }
+{ * pPRpk}
+{P *P* q }
+{ PP* * *}
+{* * *RK }
+$$\showboard$$
+${1 \over 2}\!-\!{1 \over 2}$
+\clearpage
+\begin{center}
+\fbox{\fbox{\large\begin{tabular}{l}
+Game  \hspace{.3 in} Mar 1994 \hspace{.3 in} $1\!-\!0$\\
+\hline
+\raisebox{2.5pt}[11pt]{\framebox[11pt]{\rule{0pt}{4.25pt}}} Andy Gill\\
+\rule[-1pt]{11pt}{11pt} Dan Husband\\
+Glenrothes Congress
+\end{tabular}}}
+\end{center}
+\begin{center}|
+{\bf\begin{tabular}{rp{50pt}p{50pt}}
+1 & e4 & c5\\
+2 & Nf3 & Nc6\\
+3 & d4 & N*d4\\
+4 & N*d4 & c*d4\\
+5 & Q*d4 & e6\\
+6 & Nc3 & Qb6\\
+7 & Q*b6 & a*b6\\
+8 & Bb5 & Bc5\\
+9 & 0-0 & Nf6\\
+10 & Be3 & 0-0\\
+11 & Rfe1 & d6\\
+12 & a4 & Bd7\\
+13 & Bg5 & Bc6\\
+14 & B*f6 & g*f6\\
+15 & Rad1 & Kh8\\
+16 & Rd3 & Rad8\\
+17 & Rh3 & Rg8\\
+18 & Bd3 & Rg7\\
+19 & Nb5 & B*b5\\
+20 & a*b5 & Rdg8\\
+21 & Rg3 & R*g3\\
+22 & h*g3 & h6\\
+23 & Kf1 & Kg7\\
+24 & c3 & d5\\
+25 & e*d5 & e*d5\\
+26 & Ra1 & d4\\
+27 & Ra7 & d*c3\\
+28 & b*c3 & Rd8\\
+29 & Be4 & Rd1+\\
+30 & Ke2 & Rc1\\
+31 & R*b7 & R*c3\\
+32 & Kf1 & Rb3\\
+33 & R*f7+ & Kh8\\
+34 & R*f6 & R*b5\\
+35 & R*h6+ & Kg7\\
+36 & Rg6+ & Kh7\\
+37 & R*b6+&\\
+\end{tabular}}|
+\end{center}
+
+\board
+{ * * * *}
+{* * * *k}
+{ R * * *}
+{*rb * * }
+{ * *B* *}
+{* * * P }
+{ * * PP*}
+{* * *K* }
+$$\showboard$$
+$1\!-\!0$
+\clearpage
+\begin{center}
+\fbox{\fbox{\large\begin{tabular}{l}
+Game  \hspace{.3 in} Mar 1994 \hspace{.3 in} ${1 \over 2}\!-\!{1 \over 2}$\\
+\hline
+\raisebox{2.5pt}[11pt]{\framebox[11pt]{\rule{0pt}{4.25pt}}} Keith Chance\\
+\rule[-1pt]{11pt}{11pt} Andy Gill\\
+Glenrothes Congress
+\end{tabular}}}
+\end{center}
+\begin{center}|
+{\bf\begin{tabular}{rp{50pt}p{50pt}}
+1 & Nf3 & Nc6\\
+2 & e4 & e5\\
+3 & d4 & e*d4\\
+4 & N*d4 & d6\\
+5 & N*c6 & b*c6\\
+6 & Bd3 & Bb7\\
+7 & 0-0 & Nf6\\
+8 & Re1 & Be7\\
+9 & e5 & d*e5\\
+10 & R*e5 & 0-0\\
+11 & h3 & Re8\\
+12 & Re1 & Qd7\\
+13 & Bg5 & Rad8\\
+14 & B*f6 & B*f6\\
+15 & R*e8+ & Q*e8\\
+16 & Nc3 & Ba6\\
+17 & Qe1 & Q*e1+\\
+18 & R*e1 & B*d3\\
+19 & c*d3 & g6\\
+20 & Rd1 & Rb8\\
+21 & Ne4 & B*b2\\
+22 & Rb1 & a5\\
+23 & Nc3 & Rb4\\
+24 & Nd1 & Ba3\\
+25 & R*b4 & B*b4\\
+26 & Kf1 & f5\\
+27 & Nb2 & Kf7\\
+28 & Nc4 & Ke6\\
+29 & Ke2 & Kd5\\
+30 & a3 & Bc5\\
+31 & N*a5 & B*a3\\
+32 & Nc4 & Bc5\\
+33 & f3 & h5\\
+34 & g4 & h*g4\\
+35 & h*g4 & f*g4\\
+36 & f*g4 & Ke6\\
+37 & Kf3 & Bd6\\
+38 & Ke4 & g5\\
+39 & Na5 & c5\\
+40 & Nc4 & Bf4\\
+41 & Na5 & Bd2\\
+42 & Nc4 & Bb4\\
+43 & Ne5 & Bd2\\
+44 & Nf3 & Bc1\\
+45 & Ne5 & Bf4\\
+46 & Ng6 & Bg3\\
+47 & Nf8+ & Kd6\\
+48 & Nh7 & Bf4\\
+49 & Kf5 & Kd5\\
+50 & N*g5 & B*g5\\
+51 & K*g5 & Kd4\\
+52 & Kf5 & K*d3\\
+53 & g5 & c4\\
+54 & g6 & c3\\
+55 & g7 & c2\\
+56 & g8=Q & c1=Q\\
+57 & Qd5+ & Ke2\\
+58 & Qg2+ & Kd1\\
+59 & Qg1+&\\
+\end{tabular}}|
+\end{center}
+
+\board
+{ * * * *}
+{* p * * }
+{ * * * *}
+{* * *K* }
+{ * * * *}
+{* * * * }
+{ * * * *}
+{* qk* Q }
+$$\showboard$$
+${1 \over 2}\!-\!{1 \over 2}$
+\clearpage
+\begin{center}
+\fbox{\fbox{\large\begin{tabular}{l}
+Game  \hspace{.3 in} Mar 1994 \hspace{.3 in} ${1 \over 2}\!-\!{1 \over 2}$\\
+\hline
+\raisebox{2.5pt}[11pt]{\framebox[11pt]{\rule{0pt}{4.25pt}}} Andy Gill\\
+\rule[-1pt]{11pt}{11pt} Jim King\\
+Glenrothes Congress
+\end{tabular}}}
+\end{center}
+\begin{center}|
+{\bf\begin{tabular}{rp{50pt}p{50pt}}
+1 & e4 & c5\\
+2 & Nf3 & Nc6\\
+3 & d4 & c*d4\\
+4 & N*d4 & d6\\
+5 & Bb5 & Qc7\\
+6 & 0-0 & a6\\
+7 & Ba4 & b5\\
+8 & Bb3 & Nf6\\
+9 & Re1 & e6\\
+10 & Bg5 & Be7\\
+11 & c3 & 0-0\\
+12 & Nd2 & Bb7\\
+13 & Qe2 & Rfe8\\
+14 & Rac1 & d5\\
+15 & Bc2 & Rac8\\
+16 & e5 & Nd7\\
+17 & B*e7 & R*e7\\
+18 & N2f3 & h6\\
+19 & Qd3 & g6\\
+20 & Qe3 & Kg7\\
+21 & Nh4 & Nc*e5\\
+22 & b3 & Q*c3\\
+23 & Q*c3 & R*c3\\
+24 & Bb1 & b4\\
+25 & R*c3 & b*c3\\
+26 & Rc1 & g5\\
+27 & Nhf3 & N*f3+\\
+28 & N*f3 & g4\\
+29 & Nd4 & e5\\
+30 & Nf5+ & Kf6\\
+31 & N*e7 & K*e7\\
+32 & R*c3 & Kd6\\
+33 & h3 & Nf6\\
+34 & h*g4 & N*g4\\
+35 & Bf5 & Nf6\\
+36 & Bc8 & d4\\
+37 & Rc4 & Bd5\\
+38 & Rc2 & a5\\
+39 & f3 & Nh5\\
+40 & Ba6 & Nf4\\
+41 & Rd2 & f6\\
+42 & Bd3 & Bc6\\
+43 & Kf2 & h5\\
+44 & g3 & Ne6\\
+45 & a4 & Be8\\
+46 & Bb5 & Bg6\\
+\end{tabular}}|
+\end{center}
+
+\board
+{ * * * *}
+{* * * * }
+{ * knpb*}
+{pB* p *p}
+{P* p * *}
+{*P* *PP }
+{ * R K *}
+{* * * * }
+$$\showboard$$
+${1 \over 2}\!-\!{1 \over 2}$
+\clearpage
+\begin{center}
+\fbox{\fbox{\large\begin{tabular}{l}
+Game  \hspace{.3 in} Mar 1994 \hspace{.3 in} $1\!-\!0$\\
+\hline
+\raisebox{2.5pt}[11pt]{\framebox[11pt]{\rule{0pt}{4.25pt}}} R. Gourley\\
+\rule[-1pt]{11pt}{11pt} Andy Gill\\
+Glenrothes Congress
+\end{tabular}}}
+\end{center}
+\begin{center}|
+{\bf\begin{tabular}{rp{50pt}p{50pt}}
+1 & Nf3 & Nc6\\
+2 & d4 & e6\\
+3 & c4 & d5\\
+4 & Nc3 & Bb4\\
+5 & e3 & Nf6\\
+6 & Bd2 & 0-0\\
+7 & Ne5 & N*e5\\
+8 & d*e5 & Ne4\\
+9 & N*e4 & d*e4\\
+10 & B*b4 & c5\\
+11 & B*c5 & Qa5+\\
+12 & b4 & Rd8\\
+13 & b*a5 & R*d1+\\
+14 & R*d1 & h6\\
+15 & Rd8+ & Kh7\\
+16 & Be7 & b6\\
+17 & a*b6 & a*b6\\
+\end{tabular}}|
+\end{center}
+
+\board
+{r*bR * *}
+{* * Bppk}
+{ p *p* p}
+{* * P * }
+{ *P*p* *}
+{* * P * }
+{P* * PPP}
+{* * KB*R}
+$$\showboard$$
+$1\!-\!0$
+\clearpage
+\begin{center}
+\fbox{\fbox{\large\begin{tabular}{l}
+Game  \hspace{.3 in} Mar 1994 \hspace{.3 in} $1\!-\!0$\\
+\hline
+\raisebox{2.5pt}[11pt]{\framebox[11pt]{\rule{0pt}{4.25pt}}} Andy Gill\\
+\rule[-1pt]{11pt}{11pt} Grant Glynis\\
+Dunfermline Club Championship
+\end{tabular}}}
+\end{center}
+\begin{center}|
+{\bf\begin{tabular}{rp{50pt}p{50pt}}
+1 & e4 & c5\\
+2 & Nf3 & d6\\
+3 & d4 & c*d4\\
+4 & N*d4 & Nf6\\
+5 & Nc3 & a6\\
+6 & Bc4 & Nc6\\
+7 & N*c6 & b*c6\\
+8 & Be3 & e6\\
+9 & 0-0 & Be7\\
+10 & Bb3 & 0-0\\
+11 & Qe2 & Bb7\\
+12 & Rad1 & Qc7\\
+13 & f4 & e5\\
+14 & Kh1 & Rfd8\\
+15 & Qf3 & Qc8\\
+16 & f*e5 & d*e5\\
+17 & Qg3 & R*d1\\
+18 & N*d1 & Qg4\\
+19 & Q*e5 & Q*e4\\
+20 & Q*e4 & N*e4\\
+21 & R*f7 & Nd6\\
+22 & R*e7+ & Kh8\\
+23 & Re5 & Rf8\\
+24 & Kg1 & h6\\
+25 & Bc5 & Rf6\\
+26 & c3 & a5\\
+27 & g3 & Ba6\\
+28 & Bc2 & g5\\
+29 & Bd4 & Kg8\\
+30 & R*a5 & Rf1+\\
+31 & Kg2 & Rf8\\
+32 & R*a6 & Nc4\\
+33 & R*c6 & Na5\\
+34 & R*h6 & Rf7\\
+35 & Rh8 mate&\\
+\end{tabular}}|
+\end{center}
+
+\board
+{ * * *kR}
+{* * *r* }
+{ * * * *}
+{n * * p }
+{ * B * *}
+{* P * P }
+{PPB* *KP}
+{* *N* * }
+$$\showboard$$
+$1\!-\!0$
+\clearpage
+\begin{center}
+\fbox{\fbox{\large\begin{tabular}{l}
+Game  \hspace{.3 in} Mar 1994 \hspace{.3 in} $0\!-\!1$\\
+\hline
+Foo B20\\
+\raisebox{2.5pt}[11pt]{\framebox[11pt]{\rule{0pt}{4.25pt}}} Alistair Welshman\\
+\rule[-1pt]{11pt}{11pt} Andy Gill\\
+Dunfermline Club Championship
+\end{tabular}}}
+\end{center}
+\begin{center}|
+{\bf\begin{tabular}{rp{50pt}p{50pt}}
+1 & e4 & c5\\
+2 & Bc4 & d6\\
+3 & Nc3 & Nf6\\
+4 & Nf3 & e6\\
+5 & 0-0 & Be7\\
+6 & d3 & 0-0\\
+7 & Bg5 & Nc6\\
+8 & B*f6 & B*f6\\
+9 & Bb5 & Bd7\\
+10 & B*c6 & B*c6\\
+11 & Qe2 & Re8\\
+12 & Rae1 & B*c3\\
+13 & b*c3 & Qa5\\
+14 & e5 & d5\\
+15 & d4 & Bb5\\
+16 & Qe3 & B*f1\\
+17 & R*f1 & c*d4\\
+18 & Q*d4 & Rac8\\
+19 & Qb4 & Q*b4\\
+20 & c*b4 & R*c2\\
+21 & Ra1 & Rec8\\
+22 & Kf1 & Rc1+\\
+23 & R*c1 & R*c1+\\
+24 & Ke2 & Rc2+\\
+25 & Nd2 & R*a2\\
+26 & g4 & Rb2\\
+\end{tabular}}|
+\end{center}
+
+\board
+{ * * *k*}
+{pp* *ppp}
+{ * *p* *}
+{* *pP * }
+{ P * *P*}
+{* * * * }
+{ r NKP P}
+{* * * * }
+$$\showboard$$
+$0\!-\!1$
+\clearpage
+\begin{center}
+\fbox{\fbox{\large\begin{tabular}{l}
+Game  \hspace{.3 in} Mar 1994 \hspace{.3 in} $1\!-\!0$\\
+\hline
+Foo C02\\
+\raisebox{2.5pt}[11pt]{\framebox[11pt]{\rule{0pt}{4.25pt}}} Robin Taylor (1610)\\
+\rule[-1pt]{11pt}{11pt} Andy Gill\\
+Dunfermline Club Championship
+\end{tabular}}}
+\end{center}
+\begin{center}|
+{\bf\begin{tabular}{rp{50pt}p{50pt}}
+1 & d4 & e6\\
+2 & e4 & d5\\
+3 & e5 & c5\\
+4 & c3 & Nc6\\
+5 & Nf3 & Bd7\\
+6 & Bf4 & c*d4\\
+7 & c*d4 & Bb4+\\
+8 & Bd2 & B*d2+\\
+9 & Q*d2 & Nge7\\
+10 & Nc3 & a6\\
+11 & a3 & Qc7\\
+12 & Bd3 & 0-0-0\\
+13 & 0-0 & Rdf8\\
+14 & b4 & f6\\
+15 & b5 & N*d4\\
+16 & N*d4 & Q*e5\\
+17 & b*a6 & Q*d4\\
+18 & a*b7+ & Kb8\\
+19 & Ne2 & Qa7\\
+20 & Qb4 & Nf5\\
+21 & B*f5 & e*f5\\
+22 & Qd6+ & K*b7\\
+23 & Rab1+ & Kc8\\
+24 & Rfc1+ & Kd8\\
+25 & Rb8+ & Q*b8\\
+26 & Q*b8+ & Ke7\\
+27 & Qb4+ & Kf7\\
+28 & f4 & Rc8\\
+29 & R*c8 & R*c8\\
+30 & Qd6 & Be6\\
+31 & Nd4 & Rc1+\\
+32 & Kf2 & Rd1\\
+33 & Q*e6+ & Kf8\\
+34 & N*f5 & Rd2+\\
+35 & Ke3&\\
+\end{tabular}}|
+\end{center}
+
+\board
+{ * * k *}
+{* * * pp}
+{ * *Qp *}
+{* *p*N* }
+{ * * P *}
+{P * K * }
+{ * r *PP}
+{* * * * }
+$$\showboard$$
+$1\!-\!0$
+\clearpage
+\begin{center}
+\fbox{\fbox{\large\begin{tabular}{l}
+Game  \hspace{.3 in} Mar 1994 \hspace{.3 in} $1\!-\!0$\\
+\hline
+Foo B92\\
+\raisebox{2.5pt}[11pt]{\framebox[11pt]{\rule{0pt}{4.25pt}}} Steve Smith (1745)\\
+\rule[-1pt]{11pt}{11pt} Andy Gill\\
+Dunfermline C vs Stirling A
+\end{tabular}}}
+\end{center}
+\begin{center}|
+{\bf\begin{tabular}{rp{50pt}p{50pt}}
+1 & e4 & c5\\
+2 & Nf3 & d6\\
+3 & d4 & c*d4\\
+4 & N*d4 & Nf6\\
+5 & Nc3 & a6\\
+6 & Be2 & e5\\
+7 & Nb3 & Be7\\
+8 & 0-0 & 0-0\\
+9 & a4 & Be6\\
+10 & f4 & B*b3\\
+11 & c*b3 & Nc6\\
+12 & Be3 & Qd7\\
+13 & Bc4 & Rad8\\
+14 & f5 & Kh8\\
+15 & Qf3 & Nb4\\
+16 & Rfd1 & Nc2\\
+17 & Rac1 & N*e3\\
+18 & Q*e3 & Qc6\\
+19 & Nd5 & N*d5\\
+20 & B*d5 & Qd7\\
+21 & Qb6 & Rb8\\
+22 & Rc7 & Bd8\\
+23 & R*d7 & B*b6+\\
+24 & Kf1 & f6\\
+25 & B*b7 & Bd4\\
+26 & Rc1 & B*b2\\
+27 & Rcc7 & Rg8\\
+28 & B*a6 & h5\\
+29 & Bc4 & Rgc8\\
+30 & R*g7 & R*c7\\
+31 & R*c7 & Bd4\\
+32 & Rf7 & Rg8\\
+33 & R*f6 & Rg4\\
+34 & Bd5 & Rf4+\\
+35 & Ke1 & Bc3+\\
+36 & Ke2 & Bd4\\
+37 & Rh6+ & Kg7\\
+38 & R*h5 & Rf2+\\
+39 & Kd3 & R*g2\\
+40 & Kc4 & Bg1\\
+41 & h4 & Rc2+\\
+42 & Kd3 & Rg2\\
+43 & Rg5+ & R*g5\\
+44 & h*g5 & Bb6\\
+45 & Kc4 & Bd8\\
+46 & f6+ & Kg6\\
+47 & f7 & Be7\\
+\end{tabular}}|
+\end{center}
+
+\board
+{ * * * *}
+{* * bP* }
+{ * p *k*}
+{* *Bp P }
+{P*K*P* *}
+{*P* * * }
+{ * * * *}
+{* * * * }
+$$\showboard$$
+$1\!-\!0$
+\clearpage
+\begin{center}
+\fbox{\fbox{\large\begin{tabular}{l}
+Game  \hspace{.3 in} Apr 1994 \hspace{.3 in} $0\!-\!1$\\
+\hline
+Foo C10\\
+\raisebox{2.5pt}[11pt]{\framebox[11pt]{\rule{0pt}{4.25pt}}} Andy Gill\\
+\rule[-1pt]{11pt}{11pt} Phillips Bill\\
+Dunfermline Club Championship
+\end{tabular}}}
+\end{center}
+\begin{center}|
+{\bf\begin{tabular}{rp{50pt}p{50pt}}
+1 & e4 & e6\\
+2 & d4 & d5\\
+3 & Nc3 & c5\\
+4 & e5 & Nc6\\
+5 & Nf3 & Qb6\\
+6 & Bb5 & Bd7\\
+7 & B*c6 & B*c6\\
+8 & 0-0 & Ne7\\
+9 & d*c5 & Q*c5\\
+10 & Be3 & Qa5\\
+11 & Qd3 & Nf5\\
+12 & Nd4 & N*e3\\
+13 & N*c6 & b*c6\\
+14 & Q*e3 & Bc5\\
+15 & Qd3 & 0-0\\
+16 & a3 & Qc7\\
+17 & b4 & Bb6\\
+18 & Rfe1 & a6\\
+19 & Na4 & Rfb8\\
+20 & N*b6 & R*b6\\
+21 & c4 & d*c4\\
+22 & Q*c4 & Rb5\\
+23 & Qe4 & Rd5\\
+24 & Rad1 & Rad8\\
+25 & R*d5 & c*d5\\
+26 & Qd4 & Rc8\\
+27 & f4 & g6\\
+28 & Re3 & h5\\
+29 & Kf2 & Qc2+\\
+30 & Kf3 & Rc4\\
+31 & Qd3 & Qc1\\
+32 & Qe2 & d4\\
+33 & Rd3 & Rc3\\
+34 & Ke4 & R*a3\\
+35 & R*a3 & Q*a3\\
+36 & Qc4 & Qe3 mate\\
+\end{tabular}}|
+\end{center}
+
+\board
+{ * * *k*}
+{* * *p* }
+{p* *p*p*}
+{* * P *p}
+{ PQpKP *}
+{* * q * }
+{ * * *PP}
+{* * * * }
+$$\showboard$$
+$0\!-\!1$
+\clearpage
+\begin{center}
+\fbox{\fbox{\large\begin{tabular}{l}
+Game  \hspace{.3 in} Apr 1994 \hspace{.3 in} $0\!-\!1$\\
+\hline
+Foo C97\\
+\raisebox{2.5pt}[11pt]{\framebox[11pt]{\rule{0pt}{4.25pt}}} Andy Gill\\
+\rule[-1pt]{11pt}{11pt} Andrew Watt\\
+Edinburgh Congress
+\end{tabular}}}
+\end{center}
+\begin{center}|
+{\bf\begin{tabular}{rp{50pt}p{50pt}}
+1 & e4 & e5\\
+2 & Nf3 & Nc6\\
+3 & Bb5 & a6\\
+4 & Ba4 & Nf6\\
+5 & 0-0 & Be7\\
+6 & Re1 & b5\\
+7 & Bb3 & d6\\
+8 & c3 & 0-0\\
+9 & h3 & Na5\\
+10 & Bc2 & c5\\
+11 & d4 & Qc7\\
+12 & b4 & c*b4\\
+13 & c*b4 & Nc4\\
+14 & Nbd2 & Bb7\\
+15 & N*c4 & Q*c4\\
+16 & d*e5 & d*e5\\
+17 & a3 & Rac8\\
+18 & Bd3 & Qc3\\
+19 & Bg5 & Rfd8\\
+20 & Re3 & B*e4\\
+21 & Rc1 & Q*c1\\
+22 & Q*c1 & R*c1+\\
+23 & Re1 & R*e1+\\
+24 & N*e1 & B*d3\\
+25 & Nf3 & Be4\\
+26 & N*e5 & Rd1+\\
+27 & Kh2 & Bd6\\
+28 & f4 & h6\\
+29 & Bh4 & g5\\
+30 & Bg3 & B*e5\\
+31 & f*e5 & Nh5\\
+32 & e6 & N*g3\\
+33 & e7 & Nf1+\\
+34 & Kg1 & Bc6\\
+35 & Kf2 & f6\\
+36 & Ke2 & Ra1\\
+37 & Kd3 & Kf7\\
+\end{tabular}}|
+\end{center}
+
+\board
+{ * * * *}
+{* * Pk* }
+{p*b* p p}
+{*p* * p }
+{ P * * *}
+{P *K* *P}
+{ * * *P*}
+{r * *n* }
+$$\showboard$$
+$0\!-\!1$
+\clearpage
+\begin{center}
+\fbox{\fbox{\large\begin{tabular}{l}
+Game  \hspace{.3 in} Apr 1994 \hspace{.3 in} $0\!-\!1$\\
+\hline
+Foo B50\\
+\raisebox{2.5pt}[11pt]{\framebox[11pt]{\rule{0pt}{4.25pt}}} Jake Milne\\
+\rule[-1pt]{11pt}{11pt} Andy Gill\\
+Edinburgh Congress
+\end{tabular}}}
+\end{center}
+\begin{center}|
+{\bf\begin{tabular}{rp{50pt}p{50pt}}
+1 & e4 & c5\\
+2 & Nf3 & d6\\
+3 & Bc4 & e6\\
+4 & d3 & Nf6\\
+5 & a3 & Nc6\\
+6 & Nc3 & Be7\\
+7 & 0-0 & 0-0\\
+8 & Be3 & b6\\
+9 & h3 & Bb7\\
+10 & Ne2 & d5\\
+11 & e*d5 & e*d5\\
+12 & Ba2 & Re8\\
+13 & c3 & Qc7\\
+14 & Bf4 & Bd6\\
+15 & B*d6 & Q*d6\\
+16 & d4 & c*d4\\
+17 & Ne*d4 & N*d4\\
+18 & N*d4 & Rad8\\
+19 & Qd2 & Ba6\\
+20 & Qg5 & Re5\\
+21 & Nf5 & R*f5\\
+22 & Q*f5 & B*f1\\
+23 & R*f1 & g6\\
+24 & Qf3 & Kg7\\
+25 & Rd1 & Qe5\\
+26 & g3 & a5\\
+27 & Kg2 & h5\\
+28 & h4 & Rd6\\
+29 & Bb1 & d4\\
+30 & Qd3 & Qd5+\\
+31 & Qf3 & Qb3\\
+32 & Qe2 & Qd5+\\
+33 & f3 & Qe6\\
+34 & Q*e6 & R*e6\\
+35 & Be4 & d*c3\\
+36 & b*c3 & N*e4\\
+37 & f*e4 & R*e4\\
+38 & Rd6 & Re2+\\
+39 & Kf3 & Rb2\\
+40 & Rd3 & a4\\
+41 & Ke4 & f5+\\
+42 & Kd5 & Re2\\
+43 & c4 & Re8\\
+44 & Kc6 & Rc8+\\
+45 & K*b6 & R*c4\\
+46 & Kb5 & Rg4\\
+47 & Rd7+ & Kf6\\
+48 & Ra7 & f4\\
+49 & g*f4 & R*f4\\
+50 & R*a4 & R*a4\\
+51 & K*a4 & g5\\
+52 & h*g5+ & K*g5\\
+53 & Kb5 & h4\\
+54 & a4 & h3\\
+55 & a5 & h2\\
+56 & a6 & h1=Q\\
+57 & Kb6 & Qb1+\\
+58 & Ka7 & Kf5\\
+59 & Ka8 & Qe4+\\
+60 & Kb8 & Qe8+\\
+61 & Kb7 & Qd7+\\
+62 & Kb6 & Qd8+\\
+63 & Kb7 & Qd5+\\
+64 & Kb6 & Qa8\\
+65 & Ka5 & Ke5\\
+66 & Kb6 & Kd5\\
+67 & Ka5 & Kc5\\
+68 & Ka4 & Q*a6+\\
+69 & Kb3 & Qc4+\\
+70 & Ka3 & Qb5\\
+71 & Ka2 & Kc4\\
+72 & Ka1 & Kc3\\
+\end{tabular}}|
+\end{center}
+
+\board
+{ * * * *}
+{* * * * }
+{ * * * *}
+{*q* * * }
+{ * * * *}
+{* k * * }
+{ * * * *}
+{K * * * }
+$$\showboard$$
+$0\!-\!1$
+\clearpage
+\begin{center}
+\fbox{\fbox{\large\begin{tabular}{l}
+Game  \hspace{.3 in} Apr 1994 \hspace{.3 in} $0\!-\!1$\\
+\hline
+Foo C54\\
+\raisebox{2.5pt}[11pt]{\framebox[11pt]{\rule{0pt}{4.25pt}}} Andy Gill\\
+\rule[-1pt]{11pt}{11pt} John Bourke\\
+Edinburgh Congress
+\end{tabular}}}
+\end{center}
+\begin{center}|
+{\bf\begin{tabular}{rp{50pt}p{50pt}}
+1 & e4 & e5\\
+2 & Nf3 & Nc6\\
+3 & Bc4 & Bc5\\
+4 & c3 & Nf6\\
+5 & d4 & e*d4\\
+6 & c*d4 & Bb4+\\
+7 & Bd2 & N*e4\\
+8 & B*b4 & N*b4\\
+9 & B*f7+ & K*f7\\
+10 & Qb3+ & d5\\
+11 & Q*b4 & Re8\\
+12 & 0-0 & Kg8\\
+13 & Nc3 & b6\\
+14 & Rfe1 & Bf5\\
+15 & Qb3 & c6\\
+16 & Rac1 & Qd6\\
+17 & Re3 & N*c3\\
+18 & Q*c3 & R*e3\\
+19 & Q*e3 & Rc8\\
+20 & Re1 & h6\\
+21 & Qe7 & Q*e7\\
+22 & R*e7 & a5\\
+23 & Rb7 & b5\\
+24 & Ne5 & c5\\
+25 & R*b5 & c*d4\\
+26 & f4 & Be4\\
+27 & R*a5 & Rc1+\\
+28 & Kf2 & Rc2+\\
+29 & Kg3 & R*g2+\\
+30 & Kh3 & R*b2\\
+31 & Ra3 & Rd2\\
+32 & Kg3 & Rg2+\\
+33 & Kh3 & Rd2\\
+34 & Kg3 & d3\\
+35 & Nf3 & Rb2\\
+36 & h4 & d2\\
+37 & N*d2 & R*d2\\
+38 & Kg4 & Rd3\\
+39 & R*d3 & B*d3\\
+40 & Kf3 & Bc4\\
+41 & a4 & Kf7\\
+42 & Ke3 & Ke6\\
+43 & Kd4 & Kf5\\
+44 & a5 & K*f4\\
+45 & a6 & B*a6\\
+46 & K*d5 & Kg4\\
+47 & Ke6 & K*h4\\
+48 & Kf7 & g5\\
+\end{tabular}}|
+\end{center}
+
+\board
+{ * * * *}
+{* * *K* }
+{b* * * p}
+{* * * p }
+{ * * * k}
+{* * * * }
+{ * * * *}
+{* * * * }
+$$\showboard$$
+$0\!-\!1$
+\clearpage
+\begin{center}
+\fbox{\fbox{\large\begin{tabular}{l}
+Game  \hspace{.3 in} Apr 1994 \hspace{.3 in} $1\!-\!0$\\
+\hline
+Foo C70\\
+\raisebox{2.5pt}[11pt]{\framebox[11pt]{\rule{0pt}{4.25pt}}} Andy Gill\\
+\rule[-1pt]{11pt}{11pt} David King\\
+Edinburgh Congress
+\end{tabular}}}
+\end{center}
+\begin{center}|
+{\bf\begin{tabular}{rp{50pt}p{50pt}}
+1 & e4 & e5\\
+2 & Nf3 & Nc6\\
+3 & Bb5 & a6\\
+4 & Ba4 & b5\\
+5 & Bb3 & Bc5\\
+6 & 0-0 & Nge7\\
+7 & c3 & d6\\
+8 & d4 & e*d4\\
+9 & c*d4 & Ba7\\
+10 & Be3 & Na5\\
+11 & Bc2 & 0-0\\
+12 & Nbd2 & f5\\
+13 & Bg5 & Qe8\\
+14 & Re1 & h6\\
+15 & B*e7 & Q*e7\\
+16 & e*f5 & Qf6\\
+17 & Be4 & Bb7\\
+18 & B*b7 & N*b7\\
+19 & Qb3+ & Kh8\\
+20 & Qd5 & Rab8\\
+21 & Rac1 & Bb6\\
+22 & g4 & Nd8\\
+23 & Ne4 & Qf7\\
+24 & Q*f7 & R*f7\\
+25 & h3&\\
+\end{tabular}}|
+\end{center}
+At this point the score sheet goes wrong. Black eventually looses on
+time!
+
+\board
+{ r n * k}
+{* p *rp }
+{pb p * p}
+{*p* *P* }
+{ * PN*P*}
+{* * *N*P}
+{PP * P *}
+{* R R K }
+$$\showboard$$
+$1\!-\!0$
+\clearpage
+\begin{center}
+\fbox{\fbox{\large\begin{tabular}{l}
+Game  \hspace{.3 in} Apr 1994 \hspace{.3 in} $1\!-\!0$\\
+\hline
+Foo D20\\
+\raisebox{2.5pt}[11pt]{\framebox[11pt]{\rule{0pt}{4.25pt}}} C. Tait\\
+\rule[-1pt]{11pt}{11pt} Andy Gill\\
+Edinburgh Congress
+\end{tabular}}}
+\end{center}
+\begin{center}|
+{\bf\begin{tabular}{rp{50pt}p{50pt}}
+1 & d4 & d5\\
+2 & c4 & d*c4\\
+3 & e4 & c6\\
+4 & B*c4 & e6\\
+\end{tabular}}|
+\end{center}
+|4\ldots~Nf6; 5.~Nc3, e5; 6.~Be3, e*d4; 7.~B*d4, Bd6; 8.~f3|
+Score: 0.22
+\begin{center}|
+{\bf\begin{tabular}{rp{50pt}p{50pt}}
+5 & Nf3 & Bb4+\\
+\end{tabular}}|
+\end{center}
+|5\ldots~Nf6; 6.~Qe2, Bb4; 7.~Bd2, Qb6; 8.~Nc3, 0-0; 9.~0-0, Nbd7|
+Score: 0.25
+\begin{center}|
+{\bf\begin{tabular}{rp{50pt}p{50pt}}
+6 & Bd2 & B*d2+\\
+7 & Q*d2&\\
+\end{tabular}}|
+\end{center}
+|7.~Nb*d2, Nf6; 8.~0-0, 0-0; 9.~Rc1, Nbd7; 10.~Qe2, c5; 11.~Bd3|
+Score: 0.41
+\begin{center}|
+{\bf\begin{tabular}{rp{50pt}p{50pt}}
+7 & \ldots & Nf6\\
+8 & Nc3 & 0-0\\
+\end{tabular}}|
+\end{center}
+|8\ldots~Nbd7; 9.~0-0, 0-0; 10.~Rad1, Qe7; 11.~Rfe1, e5|
+Score: 0.38
+\begin{center}|
+{\bf\begin{tabular}{rp{50pt}p{50pt}}
+9 & 0-0 & b6\\
+10 & e5&\\
+\end{tabular}}|
+\end{center}
+|10.~Rac1, Bb7; 11.~Rfd1, c5; 12.~d*c5, Q*d2; 13.~R*d2, b*c5|
+Score: 0.28
+\begin{center}|
+{\bf\begin{tabular}{rp{50pt}p{50pt}}
+10 & \ldots & Nfd7\\
+\end{tabular}}|
+\end{center}
+|10\ldots~Nd5; 11.~Rfd1, Ba6; 12.~B*a6, N*a6; 13.~Rac1, Nac7; 14.~N*d5, c*d5|
+Score: 0.28
+\begin{center}|
+{\bf\begin{tabular}{rp{50pt}p{50pt}}
+11 & Rfd1 & Ba6\\
+\end{tabular}}|
+\end{center}
+|11\ldots~Bb7; 12.~Ne4, c5; 13.~d5, b5; 14.~B*b5, B*d5; 15.~Qe3, Qe7|
+Score: 0.34
+\begin{center}|
+{\bf\begin{tabular}{rp{50pt}p{50pt}}
+12 & Bb3&\\
+\end{tabular}}|
+\end{center}
+|12.~B*a6, N*a6; 13.~Rac1, Qe7; 14.~Ne4, c5; 15.~Qe2, Nb4; 16.~d*c5|
+Score: 0.34
+\begin{center}|
+{\bf\begin{tabular}{rp{50pt}p{50pt}}
+12 & \ldots & Re8\\
+\end{tabular}}|
+\end{center}
+|12\ldots~h6; 13.~Rac1, Qe7; 14.~Ne4, Rd8; 15.~Nd6, Nf6; 16.~Qe3|
+Score: 0.31
+\begin{center}|
+{\bf\begin{tabular}{rp{50pt}p{50pt}}
+13 & Ne4 & c5\\
+\end{tabular}}|
+\end{center}
+|13\ldots~h6; 14.~Nd6, Re7; 15.~Rac1, c5; 16.~Bc2, Nc6; 17.~Be4, Qc7|
+Score: 0.44
+\begin{center}|
+{\bf\begin{tabular}{rp{50pt}p{50pt}}
+14 & Nd6&\\
+\end{tabular}}|
+\end{center}
+|14.~d*c5, Bb7; 15.~Qe3, Re7; 16.~Nd6, Bc6; 17.~Ne4, b*c5; 18.~N*c5|
+Score: 1.25
+\begin{center}|
+{\bf\begin{tabular}{rp{50pt}p{50pt}}
+14 & \ldots & Rf8\\
+\end{tabular}}|
+\end{center}
+|14\ldots~Re7; 15.~N*f7, R*f7; 16.~B*e6, c*d4; 17.~Bd5, Nc6; 18.~B*c6|
+Score: 0.44
+\begin{center}|
+{\bf\begin{tabular}{rp{50pt}p{50pt}}
+15 & d5 & b5\\
+\end{tabular}}|
+\end{center}
+|15\ldots~Qe7; 16.~N*f7, c4; 17.~d*e6, N*e5; 18.~N3*e5, c*b3; 19.~Qd5|
+Score: 1.06
+\begin{center}|
+{\bf\begin{tabular}{rp{50pt}p{50pt}}
+16 & d*e6 & f*e6\\
+\end{tabular}}|
+\end{center}
+|16\ldots~c4; 17.~N*f7, Qb6; 18.~e*d7, N*d7; 19.~Q*d7, R*f7; 20.~Qd5|
+Score: 3.75
+\begin{center}|
+{\bf\begin{tabular}{rp{50pt}p{50pt}}
+17 & B*e6+ & Kh8\\
+18 & Nf7+&\\
+\end{tabular}}|
+\end{center}
+|18.~Qd5, Qe7; 19.~Nf7, R*f7; 20.~B*f7, h6|
+Score: 4.56
+\begin{center}|
+{\bf\begin{tabular}{rp{50pt}p{50pt}}
+18 & \ldots & R*f7\\
+19 & B*f7 & Nc6\\
+\end{tabular}}|
+\end{center}
+|19\ldots~Bb7; 20.~Ng5, h6; 21.~Bd5|
+Score: 3.03
+\begin{center}|
+{\bf\begin{tabular}{rp{50pt}p{50pt}}
+20 & e6&\\
+\end{tabular}}|
+\end{center}
+|20.~Q*d7, Nd4; 21.~Qg4, Qe7; 22.~N*d4, Q*f7; 23.~e6, Qf6|
+Score: 5.84
+\begin{center}|
+{\bf\begin{tabular}{rp{50pt}p{50pt}}
+20 & \ldots & Qe7\\
+\end{tabular}}|
+\end{center}
+|20\ldots~Nf6; 21.~Rac1, c4; 22.~b3, Q*d2; 23.~R*d2, Rd8; 24.~R*d8, N*d8|
+Score: 3.06
+\begin{center}|
+{\bf\begin{tabular}{rp{50pt}p{50pt}}
+21 & Q*d7 & Bc8\\
+\end{tabular}}|
+\end{center}
+|21\ldots~Bb7; 22.~Q*e7, N*e7; 23.~Rd7, B*f3; 24.~g*f3, Nc6; 25.~e7, N*e7|
+Score: 7.41
+\begin{center}|
+{\bf\begin{tabular}{rp{50pt}p{50pt}}
+22 & Q*c6&\\
+\end{tabular}}|
+\end{center}
+|22.~Q*e7, B*e6; 23.~Q*e6, Nd4; 24.~N*d4, c*d4; 25.~R*d4, a6|
+Score: 17.72
+\begin{center}|
+{\bf\begin{tabular}{rp{50pt}p{50pt}}
+22 & \ldots & Rb8\\
+\end{tabular}}|
+\end{center}
+|22\ldots~Bb7; 23.~Qd7, Q*d7; 24.~e*d7, Rd8; 25.~Re1, g6; 26.~Re8, Kg7|
+Score: 10.66
+\begin{center}|
+{\bf\begin{tabular}{rp{50pt}p{50pt}}
+23 & Qe8+&\\
+\end{tabular}}|
+\end{center}
+|23.~Q*c5, B*e6; 24.~Q*e7, B*f7; 25.~Q*a7, Rf8; 26.~Q*f7, Rc8|
+Score: 18.22
+\begin{center}|
+{\bf\begin{tabular}{rp{50pt}p{50pt}}
+23 & \ldots & Q*e8\\
+24 & B*e8 & Bb7\\
+\end{tabular}}|
+\end{center}
+|24\ldots~B*e6; 25.~Bd7, Bg8; 26.~Ne5, g6; 27.~Rac1, c4; 28.~a4, b*a4|
+Score: 7.88
+\begin{center}|
+{\bf\begin{tabular}{rp{50pt}p{50pt}}
+25 & Bf7&\\
+\end{tabular}}|
+\end{center}
+|25.~B*b5, B*f3; 26.~g*f3, Kg8; 27.~e7, Kf7; 28.~Rd8, K*e7; 29.~R*b8|
+Score: 12.03
+\begin{center}|
+{\bf\begin{tabular}{rp{50pt}p{50pt}}
+25 & \ldots & Bc6\\
+\end{tabular}}|
+\end{center}
+|25\ldots~g5; 26.~e7, Kg7; 27.~Rd8, Bc6; 28.~R*b8, K*f7; 29.~Ne5, K*e7|
+Score: 12.03
+\begin{center}|
+{\bf\begin{tabular}{rp{50pt}p{50pt}}
+26 & Rd2&\\
+\end{tabular}}|
+\end{center}
+|26.~Ne5, B*g2; 27.~e7, g6; 28.~K*g2|
+Score: 15.75
+
+\board
+{ r * * k}
+{p * *Bpp}
+{ *b*P* *}
+{*pp * * }
+{ * * * *}
+{* * *N* }
+{PP R PPP}
+{R * * K }
+$$\showboard$$
+$1\!-\!0$
+\clearpage
+\begin{center}
+\fbox{\fbox{\large\begin{tabular}{l}
+Game  \hspace{.3 in} Apr 1994 \hspace{.3 in} $1\!-\!0$\\
+\hline
+Foo B50\\
+\raisebox{2.5pt}[11pt]{\framebox[11pt]{\rule{0pt}{4.25pt}}} J. Comrie\\
+\rule[-1pt]{11pt}{11pt} Andy Gill\\
+Dunfermline C vs Alloa
+\end{tabular}}}
+\end{center}
+\begin{center}|
+{\bf\begin{tabular}{rp{50pt}p{50pt}}
+1 & e4 & c5\\
+2 & Nf3 & d6\\
+3 & Bc4 & e6\\
+4 & Nc3 & Be7\\
+5 & d4 & c*d4\\
+6 & Q*d4 & Nf6\\
+7 & e5 & d*e5\\
+8 & Q*d8+ & B*d8\\
+9 & N*e5 & 0-0\\
+10 & 0-0 & Nbd7\\
+11 & N*d7 & B*d7\\
+12 & Be3 & a6\\
+13 & a4 & Ba5\\
+14 & Ne2 & Bc6\\
+15 & Nd4 & Nd5\\
+16 & N*c6 & b*c6\\
+17 & B*d5 & c*d5\\
+18 & c3 & Rab8\\
+19 & b4 & Bc7\\
+20 & Rfd1 & Rfd8\\
+21 & Rac1 & Bb6\\
+22 & Kf1 & B*e3\\
+23 & f*e3 & f5\\
+24 & Rc2 & g5\\
+25 & Kf2 & Kf7\\
+26 & Kf3 & Rdc8\\
+27 & g4 & R*b4\\
+28 & g*f5 & Kf6\\
+29 & f*e6 & K*e6\\
+30 & Rd4 & R*d4\\
+31 & e*d4 & Rf8+\\
+32 & Kg4 & h6\\
+33 & Re2+ & Kd6\\
+34 & Rb2 & Rc8\\
+35 & Kh5 & R*c3\\
+36 & Rb6+ & Rc6\\
+37 & R*c6+ & K*c6\\
+38 & K*h6 & g4\\
+39 & Kg5 & Kd6\\
+40 & K*g4 & Ke6\\
+41 & Kg5 & Ke7\\
+42 & h4 & Kf7\\
+43 & h5 & Kg7\\
+44 & Kf5&\\
+\end{tabular}}|
+\end{center}
+
+\board
+{ * * * *}
+{* * * k }
+{p* * * *}
+{* *p*K*P}
+{P* P * *}
+{* * * * }
+{ * * * *}
+{* * * * }
+$$\showboard$$
+$1\!-\!0$
+\clearpage
+\begin{center}
+\fbox{\fbox{\large\begin{tabular}{l}
+Game  \hspace{.3 in} Apr 1994 \hspace{.3 in} $1\!-\!0$\\
+\hline
+Foo C65\\
+\raisebox{2.5pt}[11pt]{\framebox[11pt]{\rule{0pt}{4.25pt}}} Andy Gill\\
+\rule[-1pt]{11pt}{11pt} Scott Hunter\\
+Dunfermline Club Championship
+\end{tabular}}}
+\end{center}
+\begin{center}|
+{\bf\begin{tabular}{rp{50pt}p{50pt}}
+1 & e4 & e5\\
+2 & Nf3 & Nc6\\
+3 & Bb5 & Nf6\\
+4 & d3 & Bc5\\
+5 & 0-0 & 0-0\\
+6 & Re1 & d5\\
+7 & Be3 & B*e3\\
+8 & e*d5 & Q*d5\\
+9 & B*c6 & Q*c6\\
+10 & R*e3 & e4\\
+11 & d*e4 & N*e4\\
+12 & Nc3 & N*c3\\
+13 & R*c3 & Qd6\\
+14 & Q*d6 & c*d6\\
+15 & Rd1 & Re8\\
+16 & R*d6 & g5\\
+17 & g4 & B*g4\\
+18 & N*g5 & Re1+\\
+19 & Kg2 & Rae8\\
+20 & Rg3 & f5\\
+21 & h3 & Be2\\
+22 & Nf3+ & Kf7\\
+23 & N*e1 & f4\\
+24 & Rf3 & B*f3+\\
+25 & N*f3 & Re2\\
+26 & Rd7+ & Kf8\\
+27 & R*b7 & R*c2\\
+28 & R*a7 & R*b2\\
+29 & Ra4 & Kf7\\
+30 & R*f4+ & Kg6\\
+31 & a4 & h5\\
+32 & h4 & Ra2\\
+33 & Kg3 & Ra3\\
+34 & Rc4 & Rd3\\
+35 & Kf4 & Rd5\\
+36 & Ne5+ & Kf6\\
+37 & Re4 & Ra5\\
+38 & Nd7+ & Kg6\\
+39 & f3 & Rf5+\\
+40 & Ke3&\\
+\end{tabular}}|
+\end{center}
+
+\board
+{ * * * *}
+{* *N* * }
+{ * * *k*}
+{* * *r*p}
+{P* *R* P}
+{* * KP* }
+{ * * * *}
+{* * * * }
+$$\showboard$$
+$1\!-\!0$
+\clearpage
+\begin{center}
+\fbox{\fbox{\large\begin{tabular}{l}
+Game  \hspace{.3 in} May 1994 \hspace{.3 in} $1\!-\!0$\\
+\hline
+Foo B20\\
+\raisebox{2.5pt}[11pt]{\framebox[11pt]{\rule{0pt}{4.25pt}}} James Hepburn\\
+\rule[-1pt]{11pt}{11pt} Andy Gill\\
+Under 1500 Final
+\end{tabular}}}
+\end{center}
+\begin{center}|
+{\bf\begin{tabular}{rp{50pt}p{50pt}}
+1 & e4 & c5\\
+2 & Bc4 & d6\\
+3 & d3 & e6\\
+4 & Nc3 & Nf6\\
+5 & Nf3 & a6\\
+6 & Bd2 & Nc6\\
+7 & 0-0 & Be7\\
+8 & Re1 & 0-0\\
+9 & a3 & e5\\
+10 & h3 & b5\\
+11 & Bb3 & Bb7\\
+12 & Nd5 & N*d5\\
+13 & B*d5 & Qd7\\
+14 & c3 & Na5\\
+15 & b4 & B*d5\\
+16 & e*d5 & Nb7\\
+17 & Re4 & f5\\
+18 & Re2 & c*b4\\
+19 & a*b4 & Bf6\\
+20 & Qb3 & a5\\
+21 & Rae1 & a*b4\\
+22 & c*b4 & Rfe8\\
+23 & Bg5 & B*g5\\
+24 & N*g5 & Nd8\\
+25 & f4 & Nf7\\
+26 & N*f7 & Q*f7\\
+27 & f*e5 & d*e5\\
+28 & R*e5 & R*e5\\
+29 & R*e5 & Ra1+\\
+30 & Kh2 & g5\\
+31 & d4 & Kg7\\
+32 & Qd3 & Qd7\\
+33 & R*f5 & Qd6+\\
+34 & Re5 & Q*b4\\
+35 & R*g5+ & Kf7\\
+36 & Q*h7+ & Kf6\\
+37 & Qh6+ & Ke7\\
+38 & Rg7+ & Kd8\\
+39 & Qh8+&\\
+\end{tabular}}|
+\end{center}
+
+\board
+{ * k * Q}
+{* * * R }
+{ * * * *}
+{*p*P* * }
+{ q P * *}
+{* * * *P}
+{ * * *PK}
+{r * * * }
+$$\showboard$$
+$1\!-\!0$
+\clearpage
+\begin{center}
+\fbox{\fbox{\large\begin{tabular}{l}
+Game  \hspace{.3 in} May 1994 \hspace{.3 in} $1\!-\!0$\\
+\hline
+Foo D02\\
+\raisebox{2.5pt}[11pt]{\framebox[11pt]{\rule{0pt}{4.25pt}}} D. Heron (1790)\\
+\rule[-1pt]{11pt}{11pt} Andy Gill\\
+East of Scotland Championship
+\end{tabular}}}
+\end{center}
+\begin{center}|
+{\bf\begin{tabular}{rp{50pt}p{50pt}}
+1 & Nf3 & Nc6\\
+2 & d4 & d5\\
+3 & Bf4 & Bf5\\
+4 & e3 & a6\\
+5 & c4 & e6\\
+6 & Nc3 & Nf6\\
+7 & a3 & Qd7\\
+8 & b4 & Bd6\\
+9 & B*d6 & Q*d6\\
+10 & Be2 & 0-0\\
+11 & 0-0 & Ne4\\
+12 & N*e4 & B*e4\\
+13 & Nd2 & Bg6\\
+14 & Qb3 & Ne7\\
+15 & c5 & Qd7\\
+16 & a4 & c6\\
+17 & b5 & Nf5\\
+18 & Ra3 & Rfe8\\
+19 & Qb2 & Kh8\\
+20 & Rb3 & Nh6\\
+21 & b*c6 & b*c6\\
+22 & Rb7 & Qc8\\
+23 & Nf3 & Rb8\\
+24 & B*a6 & R*b7\\
+25 & Q*b7 & Q*b7\\
+26 & B*b7 & f6\\
+27 & B*c6 & Rb8\\
+28 & Bb5 & Bc2\\
+29 & Rc1 & Be4\\
+30 & Nd2 & Bg6\\
+31 & Nb1 & Ng8\\
+32 & Nc3 & Ne7\\
+33 & a5 & Nc8\\
+34 & Bd7 & Bf5\\
+35 & N*d5 & e*d5\\
+36 & B*f5 & Ne7\\
+37 & Bd3 & Nc6\\
+38 & Rb1 & R*b1+\\
+39 & B*b1 & N*a5\\
+40 & Ba2&\\
+\end{tabular}}|
+\end{center}
+
+\board
+{ * * * k}
+{* * * pp}
+{ * * p *}
+{n Pp* * }
+{ * P * *}
+{* * P * }
+{B* * PPP}
+{* * * K }
+$$\showboard$$
+$1\!-\!0$
+\clearpage
+\begin{center}
+\fbox{\fbox{\large\begin{tabular}{l}
+Game  \hspace{.3 in} May 1994 \hspace{.3 in} ${1 \over 2}\!-\!{1 \over 2}$\\
+\hline
+Foo A15\\
+\raisebox{2.5pt}[11pt]{\framebox[11pt]{\rule{0pt}{4.25pt}}} Andy Gill\\
+\rule[-1pt]{11pt}{11pt} W. Falconer\\
+East of Scotland Chalengers
+\end{tabular}}}
+\end{center}
+\begin{center}|
+{\bf\begin{tabular}{rp{50pt}p{50pt}}
+1 & c4 & Nf6\\
+2 & d3 & e6\\
+3 & Nf3 & d5\\
+4 & c*d5 & N*d5\\
+5 & a3 & Bd6\\
+6 & e3 & Nc6\\
+7 & Nbd2 & 0-0\\
+8 & Nc4 & Bd7\\
+9 & Be2 & b5\\
+10 & N*d6 & c*d6\\
+11 & 0-0 & Rc8\\
+12 & Bd2 & Qb6\\
+13 & Qb3 & Ne5\\
+14 & Rac1 & a6\\
+15 & Rc2 & R*c2\\
+16 & Q*c2 & Rc8\\
+17 & Qb1 & N*f3+\\
+18 & B*f3 & Bc6\\
+19 & Rc1 & Qd8\\
+20 & B*d5 & B*d5\\
+21 & Ba5 & Qd7\\
+22 & R*c8+ & Q*c8\\
+23 & Bb4 & Qc6\\
+24 & f3 & Bb3\\
+25 & Qe1 & Qc2\\
+26 & Qc3 & Q*c3\\
+27 & B*c3 & d5\\
+28 & Kf2 & f6\\
+29 & d4&\\
+\end{tabular}}|
+\end{center}
+
+\board
+{ * * *k*}
+{* * * pp}
+{p* *pp *}
+{*p*p* * }
+{ * P * *}
+{PbB PP* }
+{ P * KPP}
+{* * * * }
+$$\showboard$$
+${1 \over 2}\!-\!{1 \over 2}$
+\clearpage
+\begin{center}
+\fbox{\fbox{\large\begin{tabular}{l}
+Game  \hspace{.3 in} May 1994 \hspace{.3 in} $0\!-\!1$\\
+\hline
+Foo A20\\
+\raisebox{2.5pt}[11pt]{\framebox[11pt]{\rule{0pt}{4.25pt}}} Andy Gill\\
+\rule[-1pt]{11pt}{11pt} Walter Pearson (1650)\\
+East of Scotland Chalengers
+\end{tabular}}}
+\end{center}
+\begin{center}|
+{\bf\begin{tabular}{rp{50pt}p{50pt}}
+1 & c4 & e5\\
+2 & d3 & Ne7\\
+3 & Nf3 & d6\\
+4 & e3 & g6\\
+5 & Be2 & Bg7\\
+6 & 0-0 & 0-0\\
+7 & Nbd2 & Nd7\\
+8 & Nb3 & b6\\
+9 & d4 & e*d4\\
+10 & Nf*d4 & Bb7\\
+\end{tabular}}|
+\end{center}
+
+\board
+{r* q rk*}
+{pbpnnpbp}
+{ p p *p*}
+{* * * * }
+{ *PN * *}
+{*N* P * }
+{PP *BPPP}
+{R BQ*RK }
+$$\showboard$$
+$0\!-\!1$
+\clearpage
+\begin{center}
+\fbox{\fbox{\large\begin{tabular}{l}
+Game  \hspace{.3 in} May 1994 \hspace{.3 in} $1\!-\!0$\\
+\hline
+Foo D61\\
+\raisebox{2.5pt}[11pt]{\framebox[11pt]{\rule{0pt}{4.25pt}}} Douglas Heatlie (1650)\\
+\rule[-1pt]{11pt}{11pt} Andy Gill\\
+East of Scotland Chalengers
+\end{tabular}}}
+\end{center}
+\begin{center}|
+{\bf\begin{tabular}{rp{50pt}p{50pt}}
+1 & d4 & e6\\
+2 & c4 & d5\\
+3 & Nc3 & Nf6\\
+4 & Bg5 & Be7\\
+5 & e3 & Nbd7\\
+6 & Qc2 & 0-0\\
+7 & Nf3 & Re8\\
+8 & h4 & Nb6\\
+9 & b3 & d*c4\\
+10 & b*c4 & Bd7\\
+11 & Bd3 & g6\\
+12 & B*f6 & B*f6\\
+13 & h5 & B*d4\\
+14 & e*d4 & Qf6\\
+15 & h*g6 & f*g6\\
+16 & Ne4 & Qg7\\
+17 & Nc5 & Bc6\\
+18 & Ne5 & Nd5\\
+19 & c*d5 & e*d5\\
+20 & 0-0-0 & R*e5\\
+21 & d*e5 & Q*e5\\
+22 & g3 & Qg5+\\
+23 & Qd2 & Qe5\\
+24 & Nb3 & Ba4\\
+25 & Qh6 & Qc3+\\
+26 & Bc2 & B*b3\\
+27 & Q*h7+ & Kf8\\
+28 & Qh8+&\\
+\end{tabular}}|
+\end{center}
+
+\board
+{r* * k Q}
+{ppp * * }
+{ * * *p*}
+{* *p* * }
+{ * * * *}
+{*bq * P }
+{P*B* P *}
+{* KR* *R}
+$$\showboard$$
+$1\!-\!0$
+\clearpage
+\begin{center}
+\fbox{\fbox{\large\begin{tabular}{l}
+Game  \hspace{.3 in} Jul 1994 \hspace{.3 in} $1\!-\!0$\\
+\hline
+Foo B50\\
+\raisebox{2.5pt}[11pt]{\framebox[11pt]{\rule{0pt}{4.25pt}}} Graham Mill\\
+\rule[-1pt]{11pt}{11pt} Andy Gill\\
+Scottish Chess Minor
+\end{tabular}}}
+\end{center}
+\begin{center}|
+{\bf\begin{tabular}{rp{50pt}p{50pt}}
+1 & e4 & c5\\
+2 & Nf3 & d6\\
+3 & Bc4&\\
+\end{tabular}}|
+\end{center}
+This is an unusual way of opening, but is common at the Minor level.
+\begin{center}|
+{\bf\begin{tabular}{rp{50pt}p{50pt}}
+3 & \ldots & e6\\
+4 & Nc3 & Nf6\\
+5 & d3&\\
+\end{tabular}}|
+\end{center}
+|5.~0-0|
+\begin{center}|
+{\bf\begin{tabular}{rp{50pt}p{50pt}}
+5 & \ldots & Nc6\\
+\end{tabular}}|
+\end{center}
+|5\ldots~d5; 6.~Bb3, d*e4; 7.~N*e4, N*e4; 8.~d*e4, Q*d1+; 9.~K*d1|
+=
+\begin{center}|
+{\bf\begin{tabular}{rp{50pt}p{50pt}}
+6 & Bf4&\\
+\end{tabular}}|
+\end{center}
+|6.~0-0, Be7|
+\begin{center}|
+{\bf\begin{tabular}{rp{50pt}p{50pt}}
+6 & \ldots & a6\\
+7 & 0-0 & Be7\\
+\end{tabular}}|
+\end{center}
+|7\ldots~Na5; 8.~Bb3, N*b3; 9.~a*b3, Be7; 10.~Re1, 0-0; 11.~Qd2|
+\bbetter{}
+\begin{center}|
+{\bf\begin{tabular}{rp{50pt}p{50pt}}
+8 & Re1 & 0-0\\
+\end{tabular}}|
+\end{center}
+
+\board
+{r*bq rk*}
+{*p* bppp}
+{p*nppn *}
+{* p * * }
+{ *B*PB *}
+{* NP*N* }
+{PPP* PPP}
+{R *QR K }
+$$\showboard$$
+ I often find this sort of position when playing the sicilian, where
+white has the e file, pushes his pawn, and gains a winning advantage.
+\begin{center}|
+{\bf\begin{tabular}{rp{50pt}p{50pt}}
+9 & e5 & d*e5\\
+10 & N*e5 & Bd7\\
+\end{tabular}}|
+\end{center}
+|10\ldots~N*e5|
+\begin{center}|
+{\bf\begin{tabular}{rp{50pt}p{50pt}}
+11 & Ne4&\\
+\end{tabular}}|
+\end{center}
+|11.~Bb3|
+\wbetter{}
+\begin{center}|
+{\bf\begin{tabular}{rp{50pt}p{50pt}}
+11 & \ldots & N*e5\\
+12 & B*e5 & Bc6\\
+\end{tabular}}|
+\end{center}
+
+\board
+{r* q rk*}
+{*p* bppp}
+{p*b*pn *}
+{* p B * }
+{ *B*N* *}
+{* *P* * }
+{PPP* PPP}
+{R *QR K }
+$$\showboard$$
+|12\ldots~N*e4; 13.~d*e4, b5; 14.~Bb3, Bc6; 15.~Qh5, Re8|
+=
+\begin{center}|
+{\bf\begin{tabular}{rp{50pt}p{50pt}}
+13 & B*f6&\\
+\end{tabular}}|
+\end{center}
+|13.~Qf3, N*e4; 14.~d*e4, b6; 15.~Rad1, Qe8|
+\wbetter{}
+\begin{center}|
+{\bf\begin{tabular}{rp{50pt}p{50pt}}
+13 & \ldots & B*e4??\\
+\end{tabular}}|
+\end{center}
+|13\ldots~B*f6; 14.~N*f6+, Q*f6; 15.~c3, b6; 16.~Qe2|
+\bbetter{}
+\begin{center}|
+{\bf\begin{tabular}{rp{50pt}p{50pt}}
+14 & B*e7 & Q*e7\\
+15 & R*e4 & Rac8\\
+16 & f4&\\
+\end{tabular}}|
+\end{center}
+|16.~a4, Qf6; 17.~c3, Rfd8; 18.~Qe2, h6; 19.~Re1|
+\wdecisive{}
+\begin{center}|
+{\bf\begin{tabular}{rp{50pt}p{50pt}}
+16 & \ldots & b5\\
+17 & Bb3 & Rc6\\
+\end{tabular}}|
+\end{center}
+|17\ldots~a5|
+and I might be able to stir up a queenside pawn charge.
+\begin{center}|
+{\bf\begin{tabular}{rp{50pt}p{50pt}}
+18 & c4&\\
+\end{tabular}}|
+\end{center}
+|18.~a4|
+striking at the ambushing pawns.
+\begin{center}|
+{\bf\begin{tabular}{rp{50pt}p{50pt}}
+18 & \ldots & Rd8\\
+\end{tabular}}|
+\end{center}
+|18\ldots~Rd6; 19.~c*b5, a*b5; 20.~a4, c4|
+\begin{center}|
+{\bf\begin{tabular}{rp{50pt}p{50pt}}
+19 & Qe2&\\
+\end{tabular}}|
+\end{center}
+|19.~c*b5, a*b5; 20.~a4, b*a4; 21.~Ra*a4, Rcd6; 22.~d4, c*d4; 23.~Re*d4|
+\begin{center}|
+{\bf\begin{tabular}{rp{50pt}p{50pt}}
+19 & \ldots & Rd4\\
+\end{tabular}}|
+\end{center}
+|19\ldots~b4|
+\begin{center}|
+{\bf\begin{tabular}{rp{50pt}p{50pt}}
+20 & R*d4&\\
+\end{tabular}}|
+\end{center}
+|20.~c*b5, a*b5; 21.~a4, b*a4; 22.~R*a4, Rd8; 23.~d4, c*d4; 24.~Re*d4|
+All variations just win for white.
+\begin{center}|
+{\bf\begin{tabular}{rp{50pt}p{50pt}}
+20 & \ldots & c*d4\\
+21 & Re1&\\
+\end{tabular}}|
+\end{center}
+|21.~c*b5|
+\begin{center}|
+{\bf\begin{tabular}{rp{50pt}p{50pt}}
+21 & \ldots & Rc5\\
+22 & Qe4&\\
+\end{tabular}}|
+\end{center}
+|22.~Qf2, b*c4; 23.~B*c4, Qd6|
+Blacks score is rapidly going down.
+\begin{center}|
+{\bf\begin{tabular}{rp{50pt}p{50pt}}
+22 & \ldots & Rh5\\
+\end{tabular}}|
+\end{center}
+|22\ldots~Qd7; 23.~Qa8+, Qc8; 24.~Q*c8+, R*c8; 25.~g3, b*c4; 26.~d*c4|
+a passed pawn for white! Blacks passed pawn will not live long.
+\begin{center}|
+{\bf\begin{tabular}{rp{50pt}p{50pt}}
+23 & g4&\\
+\end{tabular}}|
+\end{center}
+|23.~f5, Rh6; 24.~c*b5, a*b5|
+Totally won for white.
+\begin{center}|
+{\bf\begin{tabular}{rp{50pt}p{50pt}}
+23 & \ldots & Rh4\\
+24 & Qa8+ & Qf8\\
+25 & Q*f8+ & K*f8\\
+\end{tabular}}|
+\end{center}
+
+\board
+{ * * k *}
+{* * *ppp}
+{p* *p* *}
+{*p* * * }
+{ *Pp PPr}
+{*B*P* * }
+{PP * * P}
+{* * R K }
+$$\showboard$$
+\begin{center}|
+{\bf\begin{tabular}{rp{50pt}p{50pt}}
+26 & h3?&\\
+\end{tabular}}|
+\end{center}
+|26.~Bd1, Rh3; 27.~Be2, Ke7; 28.~Kg2, Re3; 29.~h3, Kd6|
+Just a piece up.
+\begin{center}|
+{\bf\begin{tabular}{rp{50pt}p{50pt}}
+26 & \ldots & R*h3\\
+27 & Bc2 & Rg3+\\
+28 & Kf2 & R*g4\\
+29 & Kf3 & h5\\
+\end{tabular}}|
+\end{center}
+|29\ldots~Rh4; 30.~Kg3, Rh6; 31.~Re4, Rg6+; 32.~Kh3, Rh6+; 33.~Kg2|
+And black has drawing chances.
+\begin{center}|
+{\bf\begin{tabular}{rp{50pt}p{50pt}}
+30 & Re4&\\
+\end{tabular}}|
+\end{center}
+|30.~Re5, g6; 31.~Re4, Rh4; 32.~R*d4, g5|
+Black is only a pawn or so down.
+\begin{center}|
+{\bf\begin{tabular}{rp{50pt}p{50pt}}
+30 & \ldots & Ke7\\
+31 & R*d4&\\
+\end{tabular}}|
+\end{center}
+|31.~c*b5, a*b5; 32.~Re5, g6; 33.~R*b5, Kd6; 34.~Ke4|
+\begin{center}|
+{\bf\begin{tabular}{rp{50pt}p{50pt}}
+31 & \ldots & e5\\
+\end{tabular}}|
+\end{center}
+|31\ldots~g5; 32.~c*b5, a*b5; 33.~a4, e5; 34.~Re4, R*f4+; 35.~R*f4, e*f4|
+Blacks is a `pawn` down, with 3 connected passed pawns. Not so bad,
+but still winning for white.
+\begin{center}|
+{\bf\begin{tabular}{rp{50pt}p{50pt}}
+32 & Re4 & R*f4+\\
+33 & R*f4 & e*f4\\
+34 & K*f4 & Kf6\\
+35 & c5 & Ke7\\
+36 & b4 & f6\\
+37 & d4 & g5+\\
+38 & Kg3 & h4+\\
+39 & Kg4 & Ke6\\
+40 & c6 & Kd6\\
+41 & d5 & Kc7\\
+42 & Be4 & Kd6\\
+43 & Bg2 & Kc7\\
+44 & Bh3 & Kd6\\
+45 & Kf5 & Kc7\\
+46 & K*f6 & Kb6\\
+47 & K*g5&\\
+\end{tabular}}|
+\end{center}
+I finally resigned here.
+
+\board
+{ * * * *}
+{* * * * }
+{pkP* * *}
+{*p*P* K }
+{ P * * p}
+{* * * *B}
+{P* * * *}
+{* * * * }
+$$\showboard$$
+$1\!-\!0$
+\clearpage
+\begin{center}
+\fbox{\fbox{\large\begin{tabular}{l}
+Game  \hspace{.3 in} Jul 1994 \hspace{.3 in} $1\!-\!0$\\
+\hline
+Foo C67\\
+\raisebox{2.5pt}[11pt]{\framebox[11pt]{\rule{0pt}{4.25pt}}} Andy Gill\\
+\rule[-1pt]{11pt}{11pt} A. McMonigle\\
+Scottish Chess Minor
+\end{tabular}}}
+\end{center}
+\begin{center}|
+{\bf\begin{tabular}{rp{50pt}p{50pt}}
+1 & e4 & e5\\
+2 & Nf3 & Nc6\\
+3 & Bb5 & Nf6\\
+4 & 0-0 & N*e4\\
+\end{tabular}}|
+\end{center}
+
+\board
+{r*bqkb r}
+{pppp*ppp}
+{ *n* * *}
+{*B* p * }
+{ * *n* *}
+{* * *N* }
+{PPPP PPP}
+{RNBQ*RK }
+$$\showboard$$
+\begin{center}|
+{\bf\begin{tabular}{rp{50pt}p{50pt}}
+5 & Re1&\\
+\end{tabular}}|
+\end{center}
+|5.~d4, Be7; 6.~d*e5, 0-0; 7.~Be3, a6|
+and white has the edge.
+\begin{center}|
+{\bf\begin{tabular}{rp{50pt}p{50pt}}
+5 & \ldots & d5\\
+\end{tabular}}|
+\end{center}
+|5\ldots~Nd6; 6.~B*c6, d*c6; 7.~N*e5, Be6; 8.~Nc3, Be7; 9.~Kh1|
+\wbetter{}
+\begin{center}|
+{\bf\begin{tabular}{rp{50pt}p{50pt}}
+6 & N*e5&\\
+\end{tabular}}|
+\end{center}
+|6.~d3|
+is a killer move.
+\begin{center}|
+{\bf\begin{tabular}{rp{50pt}p{50pt}}
+6 & \ldots & Qf6\\
+7 & Nf3&\\
+\end{tabular}}|
+\end{center}
+|7.~N*c6, b*c6; 8.~Qf3, Qg6; 9.~Bd3, Bf5; 10.~B*e4|
+\wbetter{}
+\begin{center}|
+{\bf\begin{tabular}{rp{50pt}p{50pt}}
+7 & \ldots & Be7\\
+8 & d3! & Nd6\\
+\end{tabular}}|
+\end{center}
+
+\board
+{r*b*k* r}
+{ppp bppp}
+{ *nn q *}
+{*B*p* * }
+{ * * * *}
+{* *P*N* }
+{PPP* PPP}
+{RNBQR K }
+$$\showboard$$
+|8\ldots~N*f2; 9.~K*f2, Bg4; 10.~Nbd2, 0-0; 11.~B*c6, b*c6|
+\wupperhand{}
+\begin{center}|
+{\bf\begin{tabular}{rp{50pt}p{50pt}}
+9 & B*c6+&\\
+\end{tabular}}|
+\end{center}
+|9.~Bg5, Q*b2; 10.~B*c6+, b*c6; 11.~R*e7+, Kf8; 12.~Nbd2, h6|
+White is a couple of pawns up, but the tactices are hairy!
+\begin{center}|
+{\bf\begin{tabular}{rp{50pt}p{50pt}}
+9 & \ldots & b*c6\\
+10 & c3 & 0-0\\
+\end{tabular}}|
+\end{center}
+
+\board
+{r*b* rk*}
+{p p bppp}
+{ *pn q *}
+{* *p* * }
+{ * * * *}
+{* PP*N* }
+{PP * PPP}
+{RNBQR K }
+$$\showboard$$
+|10\ldots~h6; 11.~Be3, Nf5; 12.~Bf4, Rb8; 13.~Be5, Qg6|
+\wbetter{}
+\begin{center}|
+{\bf\begin{tabular}{rp{50pt}p{50pt}}
+11 & Bg5 & Qg6\\
+\end{tabular}}|
+\end{center}
+|11\ldots~Q*f3; 12.~Q*f3, B*g5; 13.~b3, Bb7; 14.~Qg3, Bf6|
+Is blacks best line.
+\begin{center}|
+{\bf\begin{tabular}{rp{50pt}p{50pt}}
+12 & B*e7 & Re8\\
+13 & B*d6 & R*e1+\\
+14 & Q*e1 & Q*d6\\
+15 & Qe8+ & Qf8\\
+16 & Q*f8+&\\
+\end{tabular}}|
+\end{center}
+|16.~Q*c6, Rb8; 17.~Q*c7, R*b2; 18.~Q*a7, Bf5; 19.~Qd4, Qb8; 20.~Nfd2|
+\wdecisive{} The proper continuation, and well winning for white.
+\begin{center}|
+{\bf\begin{tabular}{rp{50pt}p{50pt}}
+16 & \ldots & K*f8\\
+17 & Ne5&\\
+\end{tabular}}|
+\end{center}
+|17.~h3|
+Still a \wdecisive{}
+\begin{center}|
+{\bf\begin{tabular}{rp{50pt}p{50pt}}
+17 & \ldots & Bf5\\
+\end{tabular}}|
+\end{center}
+|17\ldots~c5; 18.~h3, f6; 19.~Nf3|
+and white moving the knight was a waste of two tempi.
+\begin{center}|
+{\bf\begin{tabular}{rp{50pt}p{50pt}}
+19 & \ldots & Rb8\\
+20 & b3 & Bf5\\
+\end{tabular}}|
+\end{center}
+\wdecisive{}
+\begin{center}|
+{\bf\begin{tabular}{rp{50pt}p{50pt}}
+18 & d4&\\
+\end{tabular}}|
+\end{center}
+|18.~Nd2, Re8; 19.~Ndf3, c5; 20.~g4, f6; 21.~Kg2, f*e5; 22.~g*f5|
+\wdecisive{}
+\begin{center}|
+{\bf\begin{tabular}{rp{50pt}p{50pt}}
+18 & \ldots & Re8\\
+19 & Nd2 & Re6\\
+\end{tabular}}|
+\end{center}
+
+\board
+{ * * k *}
+{p p *ppp}
+{ *p*r* *}
+{* *pNb* }
+{ * P * *}
+{* P * * }
+{PP N PPP}
+{R * * K }
+$$\showboard$$
+\begin{center}|
+{\bf\begin{tabular}{rp{50pt}p{50pt}}
+20 & Re1&\\
+\end{tabular}}|
+\end{center}
+|20.~g4, B*g4; 21.~N*g4, Rg6; 22.~h3, h5; 23.~f3, h*g4; 24.~h*g4|
+\wdecisive{} what a cou.
+\begin{center}|
+{\bf\begin{tabular}{rp{50pt}p{50pt}}
+20 & \ldots & f6\\
+21 & Nd7+ & Ke7\\
+22 & R*e6+ & B*e6\\
+23 & Nc5 & Bf5\\
+24 & f3&\\
+\end{tabular}}|
+\end{center}
+|24.~h3, h6; 25.~Kh2, Kd6; 26.~Nb7+, Ke7; 27.~g4, Bd3|
+\wdecisive{}
+\begin{center}|
+{\bf\begin{tabular}{rp{50pt}p{50pt}}
+24 & \ldots & Bc8\\
+25 & g4&\\
+\end{tabular}}|
+\end{center}
+|25.~Kf2, Kd6; 26.~f4, g6; 27.~Kf3, h6; 28.~g3, f5|
+\begin{center}|
+{\bf\begin{tabular}{rp{50pt}p{50pt}}
+25 & \ldots & Kf7\\
+26 & Kg2&\\
+\end{tabular}}|
+\end{center}
+|26.~Kf2, Ke7; 27.~Ke3, Kd6; 28.~Kd3, h6; 29.~c4, d*c4+; 30.~N*c4+|
+\wdecisive{} with a plan
+\begin{center}|
+{\bf\begin{tabular}{rp{50pt}p{50pt}}
+26 & \ldots & f5\\
+27 & Kg3 & Kg6\\
+28 & Nd3&\\
+\end{tabular}}|
+\end{center}
+|28.~g*f5+, B*f5; 29.~Na6, Kf6; 30.~h3, h6; 31.~N*c7|
+Attacking the weak backwards pawn.
+\begin{center}|
+{\bf\begin{tabular}{rp{50pt}p{50pt}}
+28 & \ldots & f*g4\\
+\end{tabular}}|
+\end{center}
+
+\board
+{ *b* * *}
+{p p * pp}
+{ *p* *k*}
+{* *p* * }
+{ * P *p*}
+{* PN*PK }
+{PP N * P}
+{* * * * }
+$$\showboard$$
+|28\ldots~Kf6; 29.~g*f5, K*f5; 30.~Ne5, Bb7|
+Score: 3.19
+\begin{center}|
+{\bf\begin{tabular}{rp{50pt}p{50pt}}
+29 & Ne5+ & Kf6\\
+30 & N*c6 & a6\\
+31 & f*g4 & g5\\
+32 & h4&\\
+\end{tabular}}|
+\end{center}
+|32.~Nb3, Bb7; 33.~Nb8, h6; 34.~Nc5, Bc8; 35.~b4, Kg6; 36.~Nb*a6|
+Successfully ganing up on the `a` pawn.
+\begin{center}|
+{\bf\begin{tabular}{rp{50pt}p{50pt}}
+32 & \ldots & g*h4+\\
+33 & K*h4 & Bd7\\
+34 & g5+&\\
+\end{tabular}}|
+\end{center}
+|34.~Nb4, c6; 35.~N*a6, h6; 36.~Kh5, Kg7|
+Totally won.
+\begin{center}|
+{\bf\begin{tabular}{rp{50pt}p{50pt}}
+34 & \ldots & Kg7\\
+35 & Ne5&\\
+\end{tabular}}|
+\end{center}
+|35.~Nb4, c6; 36.~N*a6, h6; 37.~Nc5, Bf5; 38.~a4, Kg6; 39.~g*h6|
+And either the 'a' or 'b' pawn will queen.
+\begin{center}|
+{\bf\begin{tabular}{rp{50pt}p{50pt}}
+35 & \ldots & Be8\\
+36 & Nb3 & Bg6\\
+\end{tabular}}|
+\end{center}
+At this point black resigned.
+
+\board
+{ * * * *}
+{* p * kp}
+{p* * *b*}
+{* *pN P }
+{ * P * K}
+{*NP * * }
+{PP * * *}
+{* * * * }
+$$\showboard$$
+$1\!-\!0$
+\clearpage
+\begin{center}
+\fbox{\fbox{\large\begin{tabular}{l}
+Game  \hspace{.3 in} Jul 1994 \hspace{.3 in} $1\!-\!0$\\
+\hline
+Foo B86\\
+\raisebox{2.5pt}[11pt]{\framebox[11pt]{\rule{0pt}{4.25pt}}} Brian Swanson\\
+\rule[-1pt]{11pt}{11pt} Andy Gill\\
+Scottish Chess Minor
+\end{tabular}}}
+\end{center}
+\begin{center}|
+{\bf\begin{tabular}{rp{50pt}p{50pt}}
+1 & e4 & c5\\
+2 & Nf3 & d6\\
+3 & d4 & c*d4\\
+4 & N*d4 & Nf6\\
+5 & Nc3 & a6\\
+6 & Bc4 & e6\\
+\end{tabular}}|
+\end{center}
+|6\ldots~e5; 7.~Nf3, Qc7; 8.~Bd5, Bg4; 9.~0-0, N*d5; 10.~N*d5|
+Is another line of the Sicilian.
+\begin{center}|
+{\bf\begin{tabular}{rp{50pt}p{50pt}}
+7 & Bg5&\\
+\end{tabular}}|
+\end{center}
+|7.~0-0, Qc7; 8.~Qd3, e5; 9.~Nf3, Bg4; 10.~Bg5|
+\wbetter{},0.25
+\begin{center}|
+{\bf\begin{tabular}{rp{50pt}p{50pt}}
+7 & \ldots & Be7\\
+8 & f4 & b5\\
+\end{tabular}}|
+\end{center}
+
+\board
+{rnbqk* r}
+{* * bppp}
+{p* ppn *}
+{*p* * B }
+{ *BNPP *}
+{* N * * }
+{PPP* *PP}
+{R *QK *R}
+$$\showboard$$
+|8\ldots~d5; 9.~B*f6, B*f6; 10.~e*d5, Qc7; 11.~Be2, Q*f4|
+\bupperhand{}
+\begin{center}|
+{\bf\begin{tabular}{rp{50pt}p{50pt}}
+9 & Bd3?&\\
+\end{tabular}}|
+\end{center}
+|9.~Bb3, h6; 10.~B*f6, B*f6; 11.~0-0, B*d4+; 12.~Q*d4|
+\bbetter{}
+\begin{center}|
+{\bf\begin{tabular}{rp{50pt}p{50pt}}
+9 & \ldots & Bb7\\
+10 & b4&\\
+\end{tabular}}|
+\end{center}
+|10.~Qf3, Qb6; 11.~Nde2, d5|
+=
+\begin{center}|
+{\bf\begin{tabular}{rp{50pt}p{50pt}}
+10 & \ldots & Nc6\\
+11 & Nf3?&\\
+\end{tabular}}|
+\end{center}
+|11.~N*c6, B*c6; 12.~0-0, d5; 13.~e*d5, N*d5; 14.~B*e7, Q*e7|
+\bbetter{}
+\begin{center}|
+{\bf\begin{tabular}{rp{50pt}p{50pt}}
+11 & \ldots & N*b4\\
+12 & Qe2 & 0-0\\
+13 & 0-0&\\
+\end{tabular}}|
+\end{center}
+|13.~a3, Qc7; 14.~Qd2|
+\bupperhand{},by a pawn or so.
+\begin{center}|
+{\bf\begin{tabular}{rp{50pt}p{50pt}}
+13 & \ldots & Rc8\\
+\end{tabular}}|
+\end{center}
+|13\ldots~Qc7; 14.~Qd2, d5; 15.~B*f6, B*f6|
+\bupperhand{}
+\begin{center}|
+{\bf\begin{tabular}{rp{50pt}p{50pt}}
+14 & Nd1 & d5\\
+15 & e*d5&\\
+\end{tabular}}|
+\end{center}
+|15.~e5, Ne4; 16.~B*e7, Q*e7; 17.~B*e4, d*e4; 18.~Nd4|
+\begin{center}|
+{\bf\begin{tabular}{rp{50pt}p{50pt}}
+15 & \ldots & B*d5\\
+16 & Ne3&\\
+\end{tabular}}|
+\end{center}
+
+\board
+{ *rq rk*}
+{* * bppp}
+{p* *pn *}
+{*p*b* B }
+{ n * P *}
+{* *BNN* }
+{P*P*Q*PP}
+{R * *RK }
+$$\showboard$$
+\begin{center}|
+{\bf\begin{tabular}{rp{50pt}p{50pt}}
+16 & \ldots & Bc5\\
+\end{tabular}}|
+\end{center}
+|16\ldots~B*a2; 17.~Rad1, N*d3; 18.~c*d3, Nd5|
+\bdecisive{},2+ pawns up, but getting a bit tactical.
+\begin{center}|
+{\bf\begin{tabular}{rp{50pt}p{50pt}}
+17 & Kh1 & B*e3\\
+18 & Q*e3 & N*c2\\
+19 & B*c2 & R*c2\\
+20 & a4 & Ra2\\
+\end{tabular}}|
+\end{center}
+|20\ldots~h6|
+\bdecisive{}, just winning.
+\begin{center}|
+{\bf\begin{tabular}{rp{50pt}p{50pt}}
+21 & R*a2 & B*a2\\
+22 & a*b5&\\
+\end{tabular}}|
+\end{center}
+|22.~Ra1, Bd5; 23.~a*b5, a*b5; 24.~Rb1, Ng4|
+\bdecisive{}, to or so pawns up.
+\begin{center}|
+{\bf\begin{tabular}{rp{50pt}p{50pt}}
+22 & \ldots & Bc4\\
+\end{tabular}}|
+\end{center}
+|22\ldots~a*b5; 23.~Ra1, Bd5; 24.~Ra7, h6|
+\bupperhand{}, even with the rook on blacks 2nd. This rook should be
+able to get to 'b' pawn, though.
+\begin{center}|
+{\bf\begin{tabular}{rp{50pt}p{50pt}}
+23 & Rc1 & B*b5\\
+24 & Ne5&\\
+\end{tabular}}|
+\end{center}
+
+\board
+{ * q rk*}
+{* * *ppp}
+{p* *pn *}
+{*b* N B }
+{ * * P *}
+{* * Q * }
+{ * * *PP}
+{* R * *K}
+$$\showboard$$
+\begin{center}|
+{\bf\begin{tabular}{rp{50pt}p{50pt}}
+24 & \ldots & Nd5?\\
+\end{tabular}}|
+\end{center}
+A bit wild.
+|24\ldots~h6; 25.~B*f6, Q*f6; 26.~Rc7, a5; 27.~Qc5, Be2; 28.~Q*a5, Q*f4|
+\bdecisive{}, almost three pawns up, and threating the forced queen
+exchage on f1.
+\begin{center}|
+{\bf\begin{tabular}{rp{50pt}p{50pt}}
+25 & Qg3&\\
+\end{tabular}}|
+\end{center}
+Alarms bells !!!, the bishop is going to h6. Remember.
+\begin{center}|
+{\bf\begin{tabular}{rp{50pt}p{50pt}}
+25 & \ldots & f6\\
+\end{tabular}}|
+\end{center}
+I though I was going to win a piece for a pawn.
+\begin{center}|
+{\bf\begin{tabular}{rp{50pt}p{50pt}}
+26 & Bh6 & g6??\\
+\end{tabular}}|
+\end{center}
+|26\ldots~Qe7; 27.~Nc6, Qc7; 28.~Rc2, Ba4; 29.~Rc4, Nb6|
+Black still leads (two pawns up), but the tactics are hairy.
+\begin{center}|
+{\bf\begin{tabular}{rp{50pt}p{50pt}}
+27 & B*f8?&\\
+\end{tabular}}|
+\end{center}
+|27.~N*g6, Kf7; 28.~N*f8, Ke8; 29.~N*e6, Qd7; 30.~Re1|
+\wdecisive{},5.47
+\begin{center}|
+{\bf\begin{tabular}{rp{50pt}p{50pt}}
+27 & \ldots & f*e5\\
+\end{tabular}}|
+\end{center}
+|27\ldots~K*f8; 28.~Qh4, a5; 29.~g3, a4|
+\bbetter{}, but critically depending on the weak a pawn.
+\begin{center}|
+{\bf\begin{tabular}{rp{50pt}p{50pt}}
+28 & Bh6 & e*f4\\
+29 & Qe1&\\
+\end{tabular}}|
+\end{center}
+
+\board
+{ * q *k*}
+{* * * *p}
+{p* *p*pB}
+{*b*n* * }
+{ * * p *}
+{* * * * }
+{ * * *PP}
+{* R Q *K}
+$$\showboard$$
+|29.~B*f4, N*f4; 30.~Q*f4, a5; 31.~h3, g5; 32.~Qe5|
+\wupperhand{}
+\begin{center}|
+{\bf\begin{tabular}{rp{50pt}p{50pt}}
+29 & \ldots & g5??\\
+\end{tabular}}|
+\end{center}
+My major blunder.
+|29\ldots~Kf7; 30.~g3, f3; 31.~Qf2, Qf6|
+\bupperhand{}, but tricky.
+\begin{center}|
+{\bf\begin{tabular}{rp{50pt}p{50pt}}
+30 & Q*e6+ & Kh8\\
+31 & Rc8&\\
+\end{tabular}}|
+\end{center}
+Mate is in a couple of moves.
+
+\board
+{ *Rq * k}
+{* * * *p}
+{p* *Q* B}
+{*b*n* p }
+{ * * p *}
+{* * * * }
+{ * * *PP}
+{* * * *K}
+$$\showboard$$
+$1\!-\!0$
+\clearpage
+\begin{center}
+\fbox{\fbox{\large\begin{tabular}{l}
+Game  \hspace{.3 in} Jul 1994 \hspace{.3 in} $1\!-\!0$\\
+\hline
+Foo B54\\
+\raisebox{2.5pt}[11pt]{\framebox[11pt]{\rule{0pt}{4.25pt}}} Andy Gill\\
+\rule[-1pt]{11pt}{11pt} Brian Thomson\\
+Scottish Chess Minor
+\end{tabular}}}
+\end{center}
+\begin{center}|
+{\bf\begin{tabular}{rp{50pt}p{50pt}}
+1 & e4 & c5\\
+2 & Nf3 & d6\\
+3 & d4 & c*d4\\
+4 & N*d4 & Nc6\\
+5 & Bb5 & Bd7\\
+6 & Nc3&\\
+\end{tabular}}|
+\end{center}
+|6.~N*c6|
+Score: 0.06
+\begin{center}|
+{\bf\begin{tabular}{rp{50pt}p{50pt}}
+6 & \ldots & Nf6\\
+\end{tabular}}|
+\end{center}
+|6\ldots~N*d4; 7.~Q*d4, B*b5; 8.~N*b5, Qa5; 9.~Nc3, e5; 10.~Qd5, Qc7|
+Score: -0.03
+\begin{center}|
+{\bf\begin{tabular}{rp{50pt}p{50pt}}
+7 & Bg5 & h6\\
+\end{tabular}}|
+\end{center}
+|7\ldots~N*d4; 8.~B*d7, N*d7; 9.~Q*d4, e5; 10.~Qd2, Be7; 11.~Be3|
+Score: -0.03
+\begin{center}|
+{\bf\begin{tabular}{rp{50pt}p{50pt}}
+8 & Bh4&\\
+\end{tabular}}|
+\end{center}
+|8.~B*f6, e*f6; 9.~f4, N*d4; 10.~B*d7, Q*d7; 11.~Q*d4, Be7|
+Score: 0.16
+\begin{center}|
+{\bf\begin{tabular}{rp{50pt}p{50pt}}
+8 & \ldots & Qb6\\
+\end{tabular}}|
+\end{center}
+|8\ldots~g5; 9.~Bg3, N*d4; 10.~Q*d4, Bg7; 11.~0-0, 0-0|
+Score: -0.22
+\begin{center}|
+{\bf\begin{tabular}{rp{50pt}p{50pt}}
+9 & N*c6&\\
+\end{tabular}}|
+\end{center}
+|9.~B*f6, g*f6; 10.~B*c6, b*c6; 11.~Na4, Qa5; 12.~c3, Bg7|
+Score: 0.06
+\begin{center}|
+{\bf\begin{tabular}{rp{50pt}p{50pt}}
+9 & \ldots & b*c6\\
+10 & B*f6&\\
+\end{tabular}}|
+\end{center}
+|10.~Bd3, Q*b2; 11.~B*f6, e*f6; 12.~Na4, Qd4; 13.~c3|
+Score: -1.03
+\begin{center}|
+{\bf\begin{tabular}{rp{50pt}p{50pt}}
+10 & \ldots & e*f6\\
+11 & Ba4&\\
+\end{tabular}}|
+\end{center}
+|11.~Bd3, Q*b2; 12.~Na4, Qa3; 13.~c3, Be6; 14.~Qc2, 0-0-0|
+Score: -1.31
+\begin{center}|
+{\bf\begin{tabular}{rp{50pt}p{50pt}}
+11 & \ldots & Qc7\\
+\end{tabular}}|
+\end{center}
+|11\ldots~Q*b2; 12.~Kd2, Qb6; 13.~Qf3, Be6; 14.~e5, Qd4|
+Score: -1.44
+\begin{center}|
+{\bf\begin{tabular}{rp{50pt}p{50pt}}
+12 & 0-0 & Be7\\
+13 & Re1&\\
+\end{tabular}}|
+\end{center}
+|13.~Rb1, 0-0; 14.~Qd3, Be6; 15.~f4, f5|
+Score: -0.09
+\begin{center}|
+{\bf\begin{tabular}{rp{50pt}p{50pt}}
+13 & \ldots & 0-0\\
+14 & Qd4&\\
+\end{tabular}}|
+\end{center}
+|14.~Bb3|
+Score: -0.09
+\begin{center}|
+{\bf\begin{tabular}{rp{50pt}p{50pt}}
+14 & \ldots & Be6\\
+\end{tabular}}|
+\end{center}
+|14\ldots~Rab8; 15.~b3, Be6; 16.~Rad1, Rb6; 17.~f4, Re8|
+Score: -0.16
+\begin{center}|
+{\bf\begin{tabular}{rp{50pt}p{50pt}}
+15 & Nd1&\\
+\end{tabular}}|
+\end{center}
+|15.~f4, Rab8; 16.~Bb3, f5; 17.~e5, B*b3; 18.~a*b3|
+Score: -0.16
+\begin{center}|
+{\bf\begin{tabular}{rp{50pt}p{50pt}}
+15 & \ldots & Qa5\\
+\end{tabular}}|
+\end{center}
+|15\ldots~Rab8; 16.~Qc3, Rb6; 17.~Ne3, Qb7; 18.~f4|
+Score: -0.09
+\begin{center}|
+{\bf\begin{tabular}{rp{50pt}p{50pt}}
+16 & Nc3 & Qc7\\
+\end{tabular}}|
+\end{center}
+|16\ldots~Rab8; 17.~b3, Qc7; 18.~Rad1, Rfe8; 19.~f4, Rb6|
+Score: -0.13
+\begin{center}|
+{\bf\begin{tabular}{rp{50pt}p{50pt}}
+17 & Ne2&\\
+\end{tabular}}|
+\end{center}
+|17.~Nd1|
+Score: 0.00
+\begin{center}|
+{\bf\begin{tabular}{rp{50pt}p{50pt}}
+17 & \ldots & Rab8\\
+\end{tabular}}|
+\end{center}
+|17\ldots~Rfb8; 18.~Nf4, Rb6; 19.~N*e6, f*e6; 20.~Bb3, d5; 21.~e*d5, c*d5|
+Score: -0.06
+\begin{center}|
+{\bf\begin{tabular}{rp{50pt}p{50pt}}
+18 & b3&\\
+\end{tabular}}|
+\end{center}
+|18.~Nf4|
+Score: -0.13
+\begin{center}|
+{\bf\begin{tabular}{rp{50pt}p{50pt}}
+18 & \ldots & a5\\
+\end{tabular}}|
+\end{center}
+|18\ldots~f5; 19.~Rad1, f*e4; 20.~Q*e4, Bd5; 21.~Qd4|
+Score: -0.41
+\begin{center}|
+{\bf\begin{tabular}{rp{50pt}p{50pt}}
+19 & Nf4&\\
+\end{tabular}}|
+\end{center}
+|19.~Qc3, c5; 20.~Nd4, Rb7; 21.~Nc6, Ra8; 22.~Rad1|
+Score: 0.06
+\begin{center}|
+{\bf\begin{tabular}{rp{50pt}p{50pt}}
+19 & \ldots & Bd7\\
+\end{tabular}}|
+\end{center}
+|19\ldots~Rfc8; 20.~c4, Rd8; 21.~f3, Rd7|
+Score: 0.00
+\begin{center}|
+{\bf\begin{tabular}{rp{50pt}p{50pt}}
+20 & Qd2&\\
+\end{tabular}}|
+\end{center}
+|20.~Qc3, Rb7; 21.~a3, Re8; 22.~Nd3, Reb8; 23.~f4|
+Score: -0.09
+\begin{center}|
+{\bf\begin{tabular}{rp{50pt}p{50pt}}
+20 & \ldots & g5\\
+\end{tabular}}|
+\end{center}
+|20\ldots~Rfe8|
+Score: -0.09
+\begin{center}|
+{\bf\begin{tabular}{rp{50pt}p{50pt}}
+21 & Nh5&\\
+\end{tabular}}|
+\end{center}
+|21.~Ne2, Rb7; 22.~Nd4, Re8; 23.~Qc3, c5; 24.~B*d7, Q*d7|
+Score: 0.13
+\begin{center}|
+{\bf\begin{tabular}{rp{50pt}p{50pt}}
+21 & \ldots & Qb6\\
+\end{tabular}}|
+\end{center}
+|21\ldots~Bg4; 22.~Ng3, Rfe8; 23.~c4, Bf8; 24.~f3, Be6|
+Score: 0.13
+\begin{center}|
+{\bf\begin{tabular}{rp{50pt}p{50pt}}
+22 & Qc3 & Qd8\\
+23 & Rad1&\\
+\end{tabular}}|
+\end{center}
+|23.~a3, Rc8; 24.~Ng3, Re8; 25.~Rad1, Bg4; 26.~B*c6, B*d1; 27.~R*d1|
+Score: 0.31
+\begin{center}|
+{\bf\begin{tabular}{rp{50pt}p{50pt}}
+23 & \ldots & Bg4\\
+24 & Ng3 & B*d1\\
+25 & R*d1 & c5\\
+26 & Nh5&\\
+\end{tabular}}|
+\end{center}
+|26.~Nf5, h5; 27.~a3, Rb7; 28.~Qd3, Rb6; 29.~Qd2|
+Score: -0.06
+\begin{center}|
+{\bf\begin{tabular}{rp{50pt}p{50pt}}
+26 & \ldots & Kh8\\
+\end{tabular}}|
+\end{center}
+|26\ldots~Rb4; 27.~Ng3, Qa8; 28.~a3, Rb6|
+Score: -0.75
+\begin{center}|
+{\bf\begin{tabular}{rp{50pt}p{50pt}}
+27 & Rd3&\\
+\end{tabular}}|
+\end{center}
+|27.~Ng3, Rg8; 28.~Nf5, Bf8; 29.~Qd2, Qc7|
+Score: -0.34
+\begin{center}|
+{\bf\begin{tabular}{rp{50pt}p{50pt}}
+27 & \ldots & Rg8\\
+\end{tabular}}|
+\end{center}
+|27\ldots~Rb4; 28.~Ng3, c4; 29.~Rd5, c*b3; 30.~c*b3, Qb6; 31.~Bc6|
+Score: -0.88
+\begin{center}|
+{\bf\begin{tabular}{rp{50pt}p{50pt}}
+28 & Rf3&\\
+\end{tabular}}|
+\end{center}
+|28.~Ng3, Rg6; 29.~Nf5, Rb4; 30.~Bc6, Qc7; 31.~a3, Rb6|
+Score: -0.81
+\begin{center}|
+{\bf\begin{tabular}{rp{50pt}p{50pt}}
+28 & \ldots & Rg6\\
+\end{tabular}}|
+\end{center}
+|28\ldots~d5; 29.~e*d5, Q*d5; 30.~Re3, Qd1; 31.~Re1, Qd8; 32.~Ng3|
+Score: -1.00
+\begin{center}|
+{\bf\begin{tabular}{rp{50pt}p{50pt}}
+29 & Bc6&\\
+\end{tabular}}|
+\end{center}
+|29.~Rd3, Rb4; 30.~f3, c4; 31.~Re3, c*b3; 32.~c*b3|
+Score: -0.97
+\begin{center}|
+{\bf\begin{tabular}{rp{50pt}p{50pt}}
+29 & \ldots & Kg8\\
+30 & Bd5&\\
+\end{tabular}}|
+\end{center}
+|30.~Ng3, Qc7; 31.~Nf5, Bf8; 32.~Bd5, Bg7; 33.~Rd3, Bh8|
+Score: -1.00
+\begin{center}|
+{\bf\begin{tabular}{rp{50pt}p{50pt}}
+30 & \ldots & a4\\
+31 & Qc4 & Qe8\\
+32 & Qd3&\\
+\end{tabular}}|
+\end{center}
+|32.~Qc3, a*b3; 33.~c*b3, Qd8; 34.~a4, Rb6; 35.~Rd3|
+Score: -0.78
+\begin{center}|
+{\bf\begin{tabular}{rp{50pt}p{50pt}}
+32 & \ldots & Rb4\\
+\end{tabular}}|
+\end{center}
+|32\ldots~Qb5; 33.~Ng3, a*b3; 34.~Nf5, Bf8|
+Score: -0.97
+\begin{center}|
+{\bf\begin{tabular}{rp{50pt}p{50pt}}
+33 & e5&\\
+\end{tabular}}|
+\end{center}
+|33.~c3, Rb6; 34.~e5, Kf8; 35.~N*f6|
+Score: -0.25
+\begin{center}|
+{\bf\begin{tabular}{rp{50pt}p{50pt}}
+33 & \ldots & d*e5\\
+\end{tabular}}|
+\end{center}
+|33\ldots~Kh8; 34.~c3, Rh4; 35.~e*f6, Bd8; 36.~Re3, Qd7|
+Score: -0.22
+\begin{center}|
+{\bf\begin{tabular}{rp{50pt}p{50pt}}
+34 & Q*g6+&\\
+\end{tabular}}|
+\end{center}
+
+\board
+{ * *q*k*}
+{* * bp* }
+{ * * pQp}
+{* pBp pN}
+{pr * * *}
+{*P* *R* }
+{P*P* PPP}
+{* * * K }
+$$\showboard$$
+$1\!-\!0$
+\clearpage
+\begin{center}
+\fbox{\fbox{\large\begin{tabular}{l}
+Game  \hspace{.3 in} Jul 1994 \hspace{.3 in} ${1 \over 2}\!-\!{1 \over 2}$\\
+\hline
+Foo B50\\
+\raisebox{2.5pt}[11pt]{\framebox[11pt]{\rule{0pt}{4.25pt}}} M. Navmann\\
+\rule[-1pt]{11pt}{11pt} Andy Gill\\
+Scottish Chess Minor
+\end{tabular}}}
+\end{center}
+\begin{center}|
+{\bf\begin{tabular}{rp{50pt}p{50pt}}
+1 & e4 & c5\\
+2 & Nf3 & d6\\
+3 & Bc4 & e6\\
+\end{tabular}}|
+\end{center}
+|3\ldots~Nc6|
+Score: 0.00
+\begin{center}|
+{\bf\begin{tabular}{rp{50pt}p{50pt}}
+4 & Nc3 & a6\\
+\end{tabular}}|
+\end{center}
+|4\ldots~Nf6; 5.~d3, d5; 6.~Bb3, d*e4; 7.~N*e4, N*e4; 8.~d*e4, Q*d1|
+Score: 0.00
+\begin{center}|
+{\bf\begin{tabular}{rp{50pt}p{50pt}}
+5 & a4&\\
+\end{tabular}}|
+\end{center}
+|5.~d3, Nc6; 6.~Bf4, Na5; 7.~e5, d5; 8.~Bg5, Ne7|
+Score: 0.09
+\begin{center}|
+{\bf\begin{tabular}{rp{50pt}p{50pt}}
+5 & \ldots & Nf6\\
+6 & d3&\\
+\end{tabular}}|
+\end{center}
+|6.~d4|
+Score: 0.06
+\begin{center}|
+{\bf\begin{tabular}{rp{50pt}p{50pt}}
+6 & \ldots & Be7\\
+\end{tabular}}|
+\end{center}
+|6\ldots~d5; 7.~Ba2, d*e4; 8.~N*e4, N*e4; 9.~d*e4, Q*d1; 10.~K*d1|
+Score: 0.09
+\begin{center}|
+{\bf\begin{tabular}{rp{50pt}p{50pt}}
+7 & b3&\\
+\end{tabular}}|
+\end{center}
+|7.~Bg5, h6; 8.~Bh4, d5; 9.~e*d5, N*d5; 10.~N*d5, e*d5|
+Score: 0.16
+\begin{center}|
+{\bf\begin{tabular}{rp{50pt}p{50pt}}
+7 & \ldots & 0-0\\
+\end{tabular}}|
+\end{center}
+|7\ldots~d5; 8.~e*d5, e*d5; 9.~N*d5, N*d5; 10.~0-0, 0-0|
+Score: -1.59
+\begin{center}|
+{\bf\begin{tabular}{rp{50pt}p{50pt}}
+8 & d4&\\
+\end{tabular}}|
+\end{center}
+|8.~Qe2, Nc6; 9.~0-0, d5; 10.~e*d5, e*d5|
+Score: 0.06
+\begin{center}|
+{\bf\begin{tabular}{rp{50pt}p{50pt}}
+8 & \ldots & c*d4\\
+\end{tabular}}|
+\end{center}
+|8\ldots~d5; 9.~e*d5, e*d5; 10.~Bd3, b6; 11.~0-0, Nc6|
+Score: -0.09
+\begin{center}|
+{\bf\begin{tabular}{rp{50pt}p{50pt}}
+9 & N*d4&\\
+\end{tabular}}|
+\end{center}
+|9.~Q*d4|
+Score: -0.09
+\begin{center}|
+{\bf\begin{tabular}{rp{50pt}p{50pt}}
+9 & \ldots & d5\\
+\end{tabular}}|
+\end{center}
+|9\ldots~Qa5; 10.~Qd2, b5; 11.~Bd3, e5; 12.~Nf3, Bg4|
+Score: -0.16
+\begin{center}|
+{\bf\begin{tabular}{rp{50pt}p{50pt}}
+10 & e*d5 & e*d5\\
+11 & Bd3 & Re8\\
+\end{tabular}}|
+\end{center}
+|11\ldots~Nc6; 12.~Nce2, N*d4; 13.~N*d4, Bb4; 14.~Bd2, Qa5; 15.~Ne2, B*d2|
+Score: -0.22
+\begin{center}|
+{\bf\begin{tabular}{rp{50pt}p{50pt}}
+12 & 0-0 & Bb4\\
+\end{tabular}}|
+\end{center}
+|12\ldots~Nc6; 13.~Nce2, Bg4; 14.~f3, Bc5; 15.~c3|
+Score: -0.03
+\begin{center}|
+{\bf\begin{tabular}{rp{50pt}p{50pt}}
+13 & Bd2&\\
+\end{tabular}}|
+\end{center}
+|13.~Nce2, Nc6; 14.~Bb2, Bg4; 15.~f3, N*d4; 16.~N*d4|
+Score: 0.00
+\begin{center}|
+{\bf\begin{tabular}{rp{50pt}p{50pt}}
+13 & \ldots & Qa5\\
+\end{tabular}}|
+\end{center}
+|13\ldots~b6|
+Score: -0.09
+\begin{center}|
+{\bf\begin{tabular}{rp{50pt}p{50pt}}
+14 & Nb1 & Kh8\\
+\end{tabular}}|
+\end{center}
+|14\ldots~Nc6; 15.~B*b4, N*b4; 16.~Re1, Bg4; 17.~Be2, Rad8|
+Score: -0.09
+\begin{center}|
+{\bf\begin{tabular}{rp{50pt}p{50pt}}
+15 & B*b4 & Q*b4\\
+16 & c3 & Qe7\\
+\end{tabular}}|
+\end{center}
+|16\ldots~Qc5; 17.~Re1, R*e1; 18.~Q*e1, Nc6; 19.~Nf5, b6|
+Score: 0.09
+\begin{center}|
+{\bf\begin{tabular}{rp{50pt}p{50pt}}
+17 & Nd2&\\
+\end{tabular}}|
+\end{center}
+|17.~Ra2, Qc7; 18.~Re2, R*e2; 19.~Q*e2, Nc6; 20.~Rd1, N*d4; 21.~c*d4|
+Score: 0.09
+\begin{center}|
+{\bf\begin{tabular}{rp{50pt}p{50pt}}
+17 & \ldots & Bg4\\
+\end{tabular}}|
+\end{center}
+|17\ldots~Qc5; 18.~Qc2, Nc6; 19.~N2f3, N*d4; 20.~N*d4, Ne4|
+Score: 0.00
+\begin{center}|
+{\bf\begin{tabular}{rp{50pt}p{50pt}}
+18 & Qc1&\\
+\end{tabular}}|
+\end{center}
+|18.~N2f3, Qc7; 19.~Qd2, Nc6; 20.~Rfe1, Rad8; 21.~R*e8, R*e8|
+Score: 0.00
+\begin{center}|
+{\bf\begin{tabular}{rp{50pt}p{50pt}}
+18 & \ldots & Nc6\\
+19 & N*c6&\\
+\end{tabular}}|
+\end{center}
+|19.~Re1, Ne5; 20.~Qc2, Qc7; 21.~c4, N*d3; 22.~Q*d3|
+Score: 0.03
+\begin{center}|
+{\bf\begin{tabular}{rp{50pt}p{50pt}}
+19 & \ldots & b*c6\\
+20 & Re1 & Qd7\\
+\end{tabular}}|
+\end{center}
+|20\ldots~Qb7; 21.~Qc2, Rad8; 22.~h3, Bh5; 23.~c4, R*e1; 24.~R*e1|
+Score: 0.03
+\begin{center}|
+{\bf\begin{tabular}{rp{50pt}p{50pt}}
+21 & R*e8+ & Q*e8\\
+22 & Qe1&\\
+\end{tabular}}|
+\end{center}
+|22.~Qc2, c5; 23.~h3, Bh5; 24.~b4, c4; 25.~Bf5|
+Score: 0.03
+\begin{center}|
+{\bf\begin{tabular}{rp{50pt}p{50pt}}
+22 & \ldots & a5\\
+\end{tabular}}|
+\end{center}
+|22\ldots~Qd7|
+Score: 0.09
+\begin{center}|
+{\bf\begin{tabular}{rp{50pt}p{50pt}}
+23 & h3 & Bd7\\
+\end{tabular}}|
+\end{center}
+|23\ldots~Bh5; 24.~g4, Bg6; 25.~B*g6, h*g6; 26.~Rd1, Rd8; 27.~Q*e8, N*e8|
+Score: 0.19
+\begin{center}|
+{\bf\begin{tabular}{rp{50pt}p{50pt}}
+24 & Nf3&\\
+\end{tabular}}|
+\end{center}
+|24.~Rd1, Rb8; 25.~c4, h6; 26.~Q*e8, R*e8; 27.~c*d5, c*d5|
+Score: 0.16
+\begin{center}|
+{\bf\begin{tabular}{rp{50pt}p{50pt}}
+24 & \ldots & Q*e1+\\
+\end{tabular}}|
+\end{center}
+|24\ldots~Rb8; 25.~Bc2, c5; 26.~c4, Q*e1; 27.~R*e1, d4|
+Score: 0.16
+\begin{center}|
+{\bf\begin{tabular}{rp{50pt}p{50pt}}
+25 & R*e1 & Re8\\
+\end{tabular}}|
+\end{center}
+|25\ldots~Rb8; 26.~Bc2, g6; 27.~Re7, Kg7; 28.~Ne5, Be8|
+Score: 0.44
+\begin{center}|
+{\bf\begin{tabular}{rp{50pt}p{50pt}}
+26 & R*e8+&\\
+\end{tabular}}|
+\end{center}
+|26.~Ne5|
+Score: 0.53
+\begin{center}|
+{\bf\begin{tabular}{rp{50pt}p{50pt}}
+26 & \ldots & B*e8\\
+27 & c4&\\
+\end{tabular}}|
+\end{center}
+|27.~g3|
+Score: 0.28
+\begin{center}|
+{\bf\begin{tabular}{rp{50pt}p{50pt}}
+27 & \ldots & h6\\
+\end{tabular}}|
+\end{center}
+|27\ldots~g6; 28.~g3, Kg7; 29.~Kg2, h6; 30.~Ne5, d4; 31.~f4, c5|
+Score: 0.13
+\begin{center}|
+{\bf\begin{tabular}{rp{50pt}p{50pt}}
+28 & Kf1&\\
+\end{tabular}}|
+\end{center}
+|28.~g3, g6; 29.~Ne5, Kg7; 30.~Kg2, d4; 31.~Kf3, c5|
+Score: 0.25
+\begin{center}|
+{\bf\begin{tabular}{rp{50pt}p{50pt}}
+28 & \ldots & g6\\
+29 & Ke2&\\
+\end{tabular}}|
+\end{center}
+|29.~c*d5|
+Score: 0.31
+\begin{center}|
+{\bf\begin{tabular}{rp{50pt}p{50pt}}
+29 & \ldots & Kg7\\
+30 & Ke3&\\
+\end{tabular}}|
+\end{center}
+|30.~Ne5|
+Score: 0.31
+\begin{center}|
+{\bf\begin{tabular}{rp{50pt}p{50pt}}
+30 & \ldots & Nd7\\
+\end{tabular}}|
+\end{center}
+|30\ldots~c5; 31.~Ne5, d4; 32.~Kd2, Bd7; 33.~N*d7, N*d7; 34.~Be4, Ne5|
+Score: 0.09
+\begin{center}|
+{\bf\begin{tabular}{rp{50pt}p{50pt}}
+31 & Kd4&\\
+\end{tabular}}|
+\end{center}
+|31.~c*d5, c*d5; 32.~Kd4, Nf6; 33.~Ne5, Kf8; 34.~g3, Kg7; 35.~f4|
+Score: 0.59
+\begin{center}|
+{\bf\begin{tabular}{rp{50pt}p{50pt}}
+31 & \ldots & d*c4\\
+32 & B*c4&\\
+\end{tabular}}|
+\end{center}
+|32.~K*c4, f5; 33.~Kc3, Bf7; 34.~g3, Nc5; 35.~Bc2, Bd5|
+Score: 0.16
+\begin{center}|
+{\bf\begin{tabular}{rp{50pt}p{50pt}}
+32 & \ldots & Kf6\\
+\end{tabular}}|
+\end{center}
+|32\ldots~f5; 33.~Ke3, Bf7; 34.~B*f7, K*f7; 35.~Kf4, Ke6; 36.~Nd4, Kd5|
+Score: -0.03
+\begin{center}|
+{\bf\begin{tabular}{rp{50pt}p{50pt}}
+33 & Bd3&\\
+\end{tabular}}|
+\end{center}
+|33.~Nd2, Nb6; 34.~Ne4, Ke7; 35.~Bd3, f5; 36.~Nc5, Bf7|
+Score: 0.22
+\begin{center}|
+{\bf\begin{tabular}{rp{50pt}p{50pt}}
+33 & \ldots & Ke6\\
+34 & Kc4&\\
+\end{tabular}}|
+\end{center}
+|34.~Ke3, Nb6; 35.~Nd4, Kd6; 36.~Kf3, Ke5; 37.~Ne2, f5|
+Score: 0.09
+\begin{center}|
+{\bf\begin{tabular}{rp{50pt}p{50pt}}
+34 & \ldots & f6\\
+\end{tabular}}|
+\end{center}
+|34\ldots~f5; 35.~g4, f*g4; 36.~h*g4, Ne5; 37.~N*e5, K*e5; 38.~Kc3|
+Score: -0.13
+
+\board
+{ * *b* *}
+{* *n* * }
+{ *p*kppp}
+{p * * * }
+{P*K* * *}
+{*P*B*N*P}
+{ * * PP*}
+{* * * * }
+$$\showboard$$
+${1 \over 2}\!-\!{1 \over 2}$
+\clearpage
+\begin{center}
+\fbox{\fbox{\large\begin{tabular}{l}
+Game  \hspace{.3 in} Sep 1994 \hspace{.3 in} $1\!-\!0$\\
+\hline
+Foo B01\\
+\raisebox{2.5pt}[11pt]{\framebox[11pt]{\rule{0pt}{4.25pt}}} Andy Gill\\
+\rule[-1pt]{11pt}{11pt} Stewart McKay\\
+Grangemouth Congress
+\end{tabular}}}
+\end{center}
+\begin{center}|
+{\bf\begin{tabular}{rp{50pt}p{50pt}}
+1 & e4 & d5\\
+2 & e*d5 & Nf6\\
+3 & Bb5+ & Bd7\\
+4 & B*d7+ & Q*d7\\
+5 & Nf3 & N*d5\\
+6 & 0-0 & Nc6\\
+7 & Re1 & e6\\
+8 & d3 & g6\\
+9 & Bg5 & Bg7\\
+10 & c3 & Nf6\\
+11 & d4 & h6\\
+12 & B*f6 & B*f6\\
+13 & d5 & Rd8\\
+14 & Qd2 & Q*d5\\
+15 & Qf4 & Bg7\\
+16 & Q*c7 & 0-0\\
+17 & Qf4 & g5\\
+18 & Qd2 & Qf5\\
+19 & Qe3 & Rd3\\
+20 & Qe4 & Q*e4\\
+21 & R*e4 & Rd1+\\
+22 & Re1 & Rfd8\\
+23 & h3 & Ne5\\
+24 & Na3 & N*f3+\\
+25 & g*f3 & R1d3\\
+26 & Kg2 & a6\\
+27 & Rac1 & b5\\
+28 & Re2 & Bf8\\
+29 & Nc2 & Bc5\\
+30 & Ne1 & Rd2\\
+31 & R*d2 & R*d2\\
+32 & Rc2 & Rd1\\
+33 & Kf1 & Be7\\
+34 & a3 & Bf6\\
+35 & Ke2 & Rd5\\
+36 & Nd3 & Rd8\\
+37 & Kd2 & Rc8\\
+38 & Ke3 & Bg7\\
+39 & f4 & Bf6\\
+40 & Ne5 & Rc5\\
+41 & Nd7 & g*f4+\\
+42 & K*f4 & Bg5+\\
+43 & Ke4 & f5+\\
+44 & Kf3 & Rd5\\
+45 & Nb8 & Rd6\\
+46 & c4 & b*c4\\
+47 & R*c4 & Rb6\\
+48 & Rb4 & Rd6\\
+49 & Ra4 & Rb6\\
+50 & N*a6 & R*b2\\
+51 & Nc7 & Rb3+\\
+52 & Kg2 & Be7\\
+53 & N*e6 & R*a3\\
+54 & R*a3 & B*a3\\
+55 & Kg3 & Kf7\\
+56 & Nd4 & Kg6\\
+57 & Kf4 & Kh5\\
+58 & N*f5&\\
+\end{tabular}}|
+\end{center}
+And White won by queening the f pawn.
+
+\board
+{ * * * *}
+{* * * * }
+{ * * * p}
+{* * *N*k}
+{ * * K *}
+{b * * *P}
+{ * * P *}
+{* * * * }
+$$\showboard$$
+$1\!-\!0$
+\clearpage
+\begin{center}
+\fbox{\fbox{\large\begin{tabular}{l}
+Game  \hspace{.3 in} Sep 1994 \hspace{.3 in} $0\!-\!1$\\
+\hline
+Foo D02\\
+\raisebox{2.5pt}[11pt]{\framebox[11pt]{\rule{0pt}{4.25pt}}} Harward Shaughan\\
+\rule[-1pt]{11pt}{11pt} Andy Gill\\
+Grangemouth Minor Congress
+\end{tabular}}}
+\end{center}
+\begin{center}|
+{\bf\begin{tabular}{rp{50pt}p{50pt}}
+1 & d4 & e6\\
+2 & Bf4 & d5\\
+3 & Nf3 & Nf6\\
+4 & Nbd2 & c5\\
+5 & e3 & a6\\
+6 & c4 & Nc6\\
+7 & Ne5 & c*d4\\
+8 & N*c6 & b*c6\\
+9 & e*d4 & Qb6\\
+10 & c*d5 & c*d5\\
+11 & Qc2 & Bd7\\
+12 & Be3 & Bb4\\
+13 & a3 & B*d2+\\
+14 & Q*d2 & 0-0\\
+15 & Bd3 & Rfc8\\
+16 & 0-0 & Bb5\\
+17 & b3 & Rc6\\
+18 & f3 & Rac8\\
+19 & Rfc1 & B*d3\\
+20 & R*c6 & R*c6\\
+21 & Q*d3 & Qc7\\
+22 & Bd2 & h6\\
+23 & Rb1 & Nh5\\
+24 & b4 & Nf4\\
+25 & B*f4 & Q*f4\\
+26 & b5 & Rc1+\\
+27 & R*c1 & Q*c1+\\
+28 & Kf2 & Qb2+\\
+29 & Kg3 & Q*b5\\
+30 & Q*b5 & a*b5\\
+31 & Kf2 & Kf8\\
+32 & Ke3 & Ke7\\
+33 & Kd3 & Kd6\\
+34 & f4 & f6\\
+35 & h4 & e5\\
+36 & d*e5+ & f*e5\\
+37 & f5 & e4+\\
+38 & Kd4 & Ke7\\
+39 & g4 & Kf6\\
+40 & Ke3 & g6\\
+41 & g5+ & h*g5\\
+42 & h*g5+ & K*f5\\
+\end{tabular}}|
+\end{center}
+
+\board
+{ * * * *}
+{* * * * }
+{ * * *p*}
+{*p*p*kP }
+{ * *p* *}
+{P * K * }
+{ * * * *}
+{* * * * }
+$$\showboard$$
+$0\!-\!1$
+\clearpage
+\begin{center}
+\fbox{\fbox{\large\begin{tabular}{l}
+Game  \hspace{.3 in} Sep 1994 \hspace{.3 in} $1\!-\!0$\\
+\hline
+Foo C65\\
+\raisebox{2.5pt}[11pt]{\framebox[11pt]{\rule{0pt}{4.25pt}}} Andy Gill\\
+\rule[-1pt]{11pt}{11pt} Lindsay Ridland\\
+Grangemouth Minor Congress
+\end{tabular}}}
+\end{center}
+\begin{center}|
+{\bf\begin{tabular}{rp{50pt}p{50pt}}
+1 & e4 & e5\\
+2 & Nf3 & Nc6\\
+3 & Bb5 & Nf6\\
+4 & 0-0 & Bc5\\
+5 & Re1 & a6\\
+\end{tabular}}|
+\end{center}
+|5\ldots~Ng4; 6.~Re2, 0-0; 7.~d3, Nd4; 8.~N*d4, B*d4; 9.~Nd2|
+\wbetter{},0.13 but a bit messy for white.
+\begin{center}|
+{\bf\begin{tabular}{rp{50pt}p{50pt}}
+6 & Ba4&\\
+\end{tabular}}|
+\end{center}
+|6.~B*c6, d*c6; 7.~h3, Qe7; 8.~d3, 0-0; 9.~Bg5, h6; 10.~Bh4|
+=, taking the exchange way out.
+\begin{center}|
+{\bf\begin{tabular}{rp{50pt}p{50pt}}
+6 & \ldots & b5\\
+7 & Bb3 & d6\\
+\end{tabular}}|
+\end{center}
+
+\board
+{r*bqk* r}
+{* p *ppp}
+{p*np n *}
+{*pb p * }
+{ * *P* *}
+{*B* *N* }
+{PPPP PPP}
+{RNBQR K }
+$$\showboard$$
+ We have now reached a main line of the Ruy Lopez.
+\begin{center}|
+{\bf\begin{tabular}{rp{50pt}p{50pt}}
+8 & c3&\\
+\end{tabular}}|
+\end{center}
+|8.~a4, Ng4; 9.~Re2, Bb7; 10.~a*b5, a*b5|
+=, and very like Game 7 of the Short-Kasparov WC, where Kasparov as
+white scored a decisive victory.
+\begin{center}|
+{\bf\begin{tabular}{rp{50pt}p{50pt}}
+8 & \ldots & Bg4\\
+9 & d3 & h6\\
+10 & Be3 & 0-0\\
+\end{tabular}}|
+\end{center}
+|10\ldots~B*e3; 11.~R*e3, 0-0; 12.~a4, b4; 13.~h3, Bh5; 14.~Nbd2, Rb8|
+=
+\begin{center}|
+{\bf\begin{tabular}{rp{50pt}p{50pt}}
+11 & B*c5 & d*c5\\
+12 & Bc2 & Qd7\\
+13 & Nbd2&\\
+\end{tabular}}|
+\end{center}
+|13.~h3, Bh5; 14.~Nbd2, Rfd8; 15.~Nb3, Qd6; 16.~Qe2, Rab8; 17.~Red1|
+Fritz is deperate to put h3, but I dont see why.
+\begin{center}|
+{\bf\begin{tabular}{rp{50pt}p{50pt}}
+13 & \ldots & Nh5\\
+\end{tabular}}|
+\end{center}
+
+\board
+{r* * rk*}
+{* pq*pp }
+{p*n* * p}
+{*pp p *n}
+{ * *P*b*}
+{* PP*N* }
+{PPBN PPP}
+{R *QR K }
+$$\showboard$$
+|13\ldots~Rad8|
+is an idea.
+\begin{center}|
+{\bf\begin{tabular}{rp{50pt}p{50pt}}
+14 & Nb3&\\
+\end{tabular}}|
+\end{center}
+|14.~h3|
+\wbetter{},0.33 I now agree with this, because the knight block the h5
+retreat square.
+\begin{center}|
+{\bf\begin{tabular}{rp{50pt}p{50pt}}
+14 & \ldots & Nf4?\\
+\end{tabular}}|
+\end{center}
+|14\ldots~Qd6; 15.~h3, Be6; 16.~Ng5, B*b3; 17.~a*b3, Nf4; 18.~Nf3|
+\bbetter{}
+\begin{center}|
+{\bf\begin{tabular}{rp{50pt}p{50pt}}
+15 & N*c5 & Qc8\\
+\end{tabular}}|
+\end{center}
+|15\ldots~Qe7; 16.~Nb3, Rfd8; 17.~h3, Be6; 18.~d4, Qf6; 19.~Rc1, e*d4|
+=
+\begin{center}|
+{\bf\begin{tabular}{rp{50pt}p{50pt}}
+16 & Re3&\\
+\end{tabular}}|
+\end{center}
+|16.~b4|
+White is just a pawn up.
+\begin{center}|
+{\bf\begin{tabular}{rp{50pt}p{50pt}}
+16 & \ldots & Rd8\\
+17 & Qd2 & Rd6\\
+\end{tabular}}|
+\end{center}
+|17\ldots~B*f3!; 18.~R*f3, Qg4; 19.~R*f4, e*f4; 20.~h3, Qh4; 21.~d4|
+and black has equalised!
+\begin{center}|
+{\bf\begin{tabular}{rp{50pt}p{50pt}}
+18 & Bd1&\\
+\end{tabular}}|
+\end{center}
+
+\board
+{r*q* *k*}
+{* p *pp }
+{p*nr * p}
+{*pN p * }
+{ * *Pnb*}
+{* PPRN* }
+{PP Q PPP}
+{R *B* K }
+$$\showboard$$
+\begin{center}|
+{\bf\begin{tabular}{rp{50pt}p{50pt}}
+18 & \ldots & N*g2??\\
+\end{tabular}}|
+\end{center}
+Throws away a piece for a very temp. inititive.
+|18\ldots~Rb8; 19.~d4, e*d4; 20.~c*d4, Ne6; 21.~N*e6, Q*e6|
+and white is starting to push home his advantage.
+\begin{center}|
+{\bf\begin{tabular}{rp{50pt}p{50pt}}
+19 & K*g2 & Bh3+\\
+20 & Kh1 & Qg4\\
+\end{tabular}}|
+\end{center}
+|20\ldots~Rg6|
+is another idea, but the whole plan is conceptually flawed.
+\begin{center}|
+{\bf\begin{tabular}{rp{50pt}p{50pt}}
+21 & Ne1 & Qg5\\
+22 & Qe2 & Be6\\
+23 & Rg3 & Qf6\\
+24 & N*e6&\\
+\end{tabular}}|
+\end{center}
+
+\board
+{r* * *k*}
+{* p *pp }
+{p*nrNq p}
+{*p* p * }
+{ * *P* *}
+{* PP* R }
+{PP *QP P}
+{R *BN *K}
+$$\showboard$$
+|24.~Nf3, Ne7; 25.~N*e6, Q*e6; 26.~Bb3, Qf6; 27.~Rag1|
+\wdecisive{}
+\begin{center}|
+{\bf\begin{tabular}{rp{50pt}p{50pt}}
+24 & \ldots & R*e6\\
+\end{tabular}}|
+\end{center}
+|24\ldots~Q*e6; 25.~Bb3, Qe7; 26.~Bd5, Rad8; 27.~Nf3, R8d7; 28.~Rd1|
+\begin{center}|
+{\bf\begin{tabular}{rp{50pt}p{50pt}}
+25 & Qf3&\\
+\end{tabular}}|
+\end{center}
+Crude plan of exchanging queens to avoid `acidents`.
+|25.~Bb3|
+\begin{center}|
+{\bf\begin{tabular}{rp{50pt}p{50pt}}
+25 & \ldots & Qe7\\
+26 & Bb3 & Rf6\\
+27 & Qe3&\\
+\end{tabular}}|
+\end{center}
+|27.~Qg2|
+\begin{center}|
+{\bf\begin{tabular}{rp{50pt}p{50pt}}
+27 & \ldots & Rd8\\
+28 & Nc2 & Kh7\\
+29 & Rag1 & g6\\
+30 & Rf3&\\
+\end{tabular}}|
+\end{center}
+
+\board
+{ * r * *}
+{* p qp*k}
+{p*n* rpp}
+{*p* p * }
+{ * *P* *}
+{*BPPQR* }
+{PPN* P P}
+{* * * RK}
+$$\showboard$$
+\begin{center}|
+{\bf\begin{tabular}{rp{50pt}p{50pt}}
+30 & \ldots & R*f3\\
+\end{tabular}}|
+\end{center}
+|30\ldots~Rfd6??; 31.~R*f7+|
+Trying to avoid the exchance, but black loses his Queen! Black
+actually moved his rook to d6, but before letting it go, spotted the
+danger, and then took the exchange. Shame...
+\begin{center}|
+{\bf\begin{tabular}{rp{50pt}p{50pt}}
+31 & Q*f3 & Rd7\\
+32 & Ne3 & h5?\\
+33 & Nd5!&\\
+\end{tabular}}|
+\end{center}
+At least winning the exchange. Black resigned here.
+
+\board
+{ * * * *}
+{* prqp*k}
+{p*n* *p*}
+{*p*Np *p}
+{ * *P* *}
+{*BPP*Q* }
+{PP * P P}
+{* * * RK}
+$$\showboard$$
+$1\!-\!0$
+
+\end{document}
diff --git a/ghc/tests/programs/andy_cherry/mygames.pgn b/ghc/tests/programs/andy_cherry/mygames.pgn
new file mode 100644 (file)
index 0000000..3d2e46f
--- /dev/null
@@ -0,0 +1,1323 @@
+% --------------
+%  Season 93/94
+% --------------
+
+[Site "Dunfermline Club Championship"]
+[Date "1993.10.??"]
+[Round "1"]
+[White "Webb, George"]
+[Black "Gill, Andy"]
+[Result "1-0"]
+[ECO "C10"]
+
+1. Nf3 d5 2. d4 Nc6 3. Nc3 Nf6 (3... Bf5 {is more natural.}) 4. e4? (
+4. Bf4 {is better.}) 4... e6? (4... dxe4 5. d5 exf3 6. dxc6 Qxd1+ 7. 
+Nxd1 {and black is a clear pawn up.}) 5. e5 Ne4 {\ 4} 6. Nxe4? { Taking
+this knight looses a pawn} 6... dxe4 7. Nd2 Qxd4 8. Nc4 Qxd1+ 9. Kxd1 
+Bd7 (9... Bc5 10. f3 exf3 11. gxf3 O-O 12. Bd3 {White can get presure
+down the `g' file, but first needs to solve the problem of the Bishop on
+c5 guarding g8.}) 10. Bd2 (10. Be3 {is better.}) 10... Bb4 11. c3 Bc5 12. 
+Ke1 O-O-O (12... b5 13. Ne3 Bxe3 14. Bxe3 Nxe5 {wins a pawn, but black
+might have problems because of queenside weaknesses.}) 13. g3 (13. Bg5 
+Be7 14. Bxe7 Nxe7 15. Rd1 {and white is starting to contest the `d'
+file.}) 13... Rhf8 14. Bg2 f5? {black is throwing away a pawn.} 15. 
+exf6 gxf6 (15... Rxf6 {gives black more piece activity.}) 16. Bxe4 {
+taking the weak pawn, and attacking h7.} 16... e5? (16... Rh8 {is
+required to protect the weak h pawn.}) 17. Bxh7 {\ 4} 17... f5 (17... Bxf2+ 
+18. Kxf2 Be6 19. Nxe5 Rxd2+ 20. Ke1 Rxb2 {winning material, and striping
+whites king of protection.}) 18. b4 Be6 19. b5 (19. bxc5 Bxc4 {and white
+has the two bishops.}) 19... Bxc4 20. bxc6 bxc6 (20... Bxf2+ 21. Kxf2 
+Rxd2+ 22. Ke1 Re2+ 23. Kd1 bxc6 24. h4 Rd8+ {with a winning attack on
+whites exposed king.}) 21. Rb1? {Throws away a pawn needlessly.} 21... 
+Bxa2 (21... Bxf2+ 22. Kxf2 Rxd2+ 23. Ke1 Rxa2 {winning two pawns rather
+than one.}) 22. Rb2 Bd5 23. Rg1 e4 (23... a5 24. h4 a4 25. Bh6 Bf3 26. 
+Rd2 Rxd2 27. Bxd2 {is a better plan, with a dangerous passed `a' pawn.}) 
+24. Bh6? 24... Ba3 (24... Rf7 25. Bg5 Rxh7 26. Bxd8 Ba3 27. Rd2 Kxd8 {
+two bishops vs a rook, a difficult win for black.}) 25. Rb1 Rfe8? {
+another missed opertunity.} 26. Bxf5+ Be6 27. Bg6 Rh8 28. Be3 {\ 4
+28... Rd3?  (28... Rxh2 29. Bxe4 c5 30. Rb7 a5 {and black has a
+fighting chance}) 29. Bd4 (29. Bxe4 Rxc3 30. Bd4 Rc4 31. Bxh8 Rxe4+ {and
+black is lost.}) 29... Bd5?? 30. Bxh8 e3?? 31. f3? (31. Bxd3 
+exf2+ 32. Kxf2 Bc5+ 33. Bd4 {and white is two rooks up.}) 31... Rd2 32. 
+Bf6 Bb2 33. h4 (33. Bf5+ Kb7 34. c4 Bxc4 35. Rxb2+ Rxb2 36. Bxb2 {
+winning.}) 33... Kb7 34. Bg5 Bxf3 (34... Ba2 35. Bc2 Bxb1 36. Bxb1 Rh2 
+37. Bxe3 Bxc3+ {and black is just a bishop down in a pawn race.}) 35. 
+Bxe3 Re2+ 36. Kf1 Rxe3 37. Re1?? {giving black a chance to equalize.} 
+37... Re2?? {Returning the complement.} (37... Rxe1+ 38. Kxe1 Bxc3+ 
+39. Kf2 Bd4+ 40. Kxf3 Bxg1 {and White still has the edge with 2
+connected passed pawns, but black has real chances.}) 38. Rxe2 1-0
+
+
+[Site "Dunfermline Club Championship"]
+[Date "1993.11.??"]
+[Round "2"]
+[White "Gill, Andy"]
+[Black "Dunne, Barry"]
+[Result "1-0"]
+[ECO "C65"]
+
+1. e4 e5 2. Nf3 Nc6 3. Bb5 Nf6 4. d3 (4. O-O {Ruy Lopez, Berlin Defence}) 
+4... Be7 (4... Bc5 {is better.}) 5. O-O (5. Bxc6 dxc6 6. Nxe5 Bd6 7. Nf3 
+O-O 8. O-O Be6 {and white is a pawn up, but black has a lead in
+development.}) 5... O-O $2 (5... d6 {is needed to protect e5.}) 6. Nc3 (6. 
+Bxc6 dxc6 7. Nxe5 Bd6 8. Nf3 Bg4 9. Be3 {and white is a clean pawn up.}) 
+6... b6 $2 7. a3 Bb7 8. b4 Nd4 {\ 4A bit ambitious.} 9. Nxe5 (9. Nxd4 exd4 
+10. Ne2 d5 11. e5 Nd7 {is whites best line.}) 9... Nxb5 (9... d5 10. Bb2 
+dxe4 11. dxe4 Nxe4 {with equal chances.}) 10. Nxb5 d5 11. Bb2 dxe4 12. 
+dxe4 (12. f3 {is a better approach.}) 12... Qxd1 13. Raxd1 Bd6 {\ 4} (13... 
+Bxe4 14. Nd7 Bxc2 15. Bxf6 gxf6 16. Rd2 {with a slight advantage for
+white.}) 14. Nf3 (14. Nxd6 cxd6 15. Rxd6 Bxe4 16. c4 Rfd8 17. c5 bxc5 
+18. bxc5 {winning for white.}) 14... Bxe4 (14... Nxe4 {is better.}) 15. 
+Nxd6 cxd6 16. Bxf6 gxf6 17. Rxd6 Bxc2 (17... Bxf3 18. gxf3 Rac8 19. Rc1 
+Rc3 20. Rd3 Rxd3 21. cxd3 {and whites passed pawn is a long way from
+queening.}) 18. Rxf6 (18. Nd4 Ba4 19. Rxf6 Rfd8 20. Rf4 Rd7 21. Re4 {a
+pawn up, but with chances for black, because of the powerful Bishop.}) 
+18... Rfd8 19. Ne5 Kg7 (19... Bg6 {is better, defending the weak pawn.}) 
+20. Rxf7+ Kg8 21. Rc7 (21. f4 a6 22. g3 Rd2 23. Rb7 b5 {and white should
+win.}) 21... Re8 (21... Rdc8 22. Rb7 Be4 23. Rd7 Rc2 24. Rfd1 {with
+connected rooks for white.}) 22. Re1 (22. f4 {is better for protecting the
+knight.}) 22... Rac8 {should have moved the `e' Rook.} 23. Rxa7 Bf5 (
+23... Ra8 $5 {planning to attack the weak `a' pawn.}) 24. f4 Bg4 (24... 
+Rc2 {penatraiting the 7th.}) 25. Kf2 Rc2+ 26. Kg3 Re2 27. Rxe2 Bxe2 28. 
+Nc6 $2 {where is that knight going ?} 28... Re3+ 29. Kf2 Re4 {\ 4} 30. f5 (
+30. Ne7+ Kf8 31. Nd5 Bd3 32. Nxb6 Re7 {totally winning for white}) 
+30... Bg4 31. Ne7+ (31. Kg3 h6 32. f6 Be6 33. Re7 {looking very good for
+white.}) 31... Kf8 32. f6 Rf4+ 33. Kg3 Re4 34. h3 (34. Nd5 Be6 35. Nxb6 
+Rg4+ 36. Kf3 Rg6 37. Rxh7 Rxf6+ 38. Ke4 {and with 4 connected passed
+white will win.}) 34... Bh5 35. Nd5 b5 36. Rxh7 Bg6 37. Rh4 (37. Rh8+ Kf7 
+38. Rb8 Bf5 39. Rxb5 Be6 40. Rb7+ Kg6 41. Rg7+ {just look at whites
+advantage.}) 37... Rxh4 38. Kxh4 Be4 39. Nc3 (39. Ne3 Kf7 40. Kg5 Bc6 
+41. g4 Be4 42. h4 Bd3 43. h5 {winning.}) 39... Bc6 (39... Bxg2 40. Nxb5 
+Kf7 41. Kg5 Bxh3 42. Nd6+ Kg8 43. a4 Kh7) 40. g4 Kf7 41. g5 (41. Kg5 Kg8 
+42. h4 Bd7 43. h5 Kf7 44. Ne4 Kg8 45. Nd6) 41... Kg6 42. Kg4? 42... 
+Bd7+ 43. Kf4 Bxh3 44. Nxb5 Bd7 (44... Kf7 45. Nd6+ Ke6 46. f7 Ke7 47. g6 
+Kf8 48. a4 Kg7) 45. a4 Bc6 46. Nc3 Bd7 47. b5 1-0
+
+[Site "Dunfermline Club Championship"]
+[Date "1993.11.??"]
+[Round "3"]
+[White "Gill, Andy"]
+[Black "Brown, Rab"]
+[Result "0-1"]
+[ECO "C65"]
+
+1. e4 e5 2. Nf3 Nc6 3. Bb5 Bc5 4. O-O Nf6 5. Nc3 d6 6. a3 Ng4? 7. 
+Qe1 (7. h3) 7... O-O {\ 4} 8. Bxc6 bxc6 9. b4 Ba6 10. bxc5 Bxf1 11. Kxf1 (
+11. Qxf1 Qd7 12. Bb2 dxc5 13. d3 Rfb8 14. Rb1 {clearly winning for
+white.}) 11... Qf6 {\ 4} (11... Rb8 12. Qe2 Qd7 13. Qa6 Ra8 14. h3 Nf6 15. 
+d4 exd4 {is a better plan.}) 12. d3 Qg6 13. Rb1 (13. h3 Nh6) 13... Qh5 
+14. Rb7 (14. h3 Nf6 15. Rb7 Rfc8 16. Bg5 Qg6 17. Qe3 Ne8 {and white has a
+commanding lead.}) 14... Nxh2+ 15. Nxh2 Qxh2 16. Rxc7 Qh1+ 17. Ke2 Qxg2 
+18. Rxc6 (18. cxd6 Rfc8 19. Rxc8+ Rxc8 20. Be3 Rd8 21. Bc5 h5) 18... dxc5 (
+18... Qg4+ 19. f3 Qg2+ 20. Qf2 Qxf2+ 21. Kxf2 Rfc8 22. Nd5 Rxc6 23. 
+Ne7+) 19. Rxc5 f5 20. Be3 Qg4+ 21. f3 Qg2+ 22. Qf2 Qh1 23. Rxe5 Qa1 {\ 4
+24. Bc5? (24. Qe1 Qb2 25. Qd2 Qxa3 26. Bc5 Qa5 27. exf5 {white has the
+advantage.}) 24... Qxc3 25. Rxf5 (25. Bxf8 Qxc2+ 26. Kf1 Qxd3+ 27. Qe2 
+Qb1+ 28. Qe1 Qxe1+ 29. Kxe1 {now black has only a slight advantage.}) 
+25... Qxc2+ (25... Rxf5 26. exf5 Qxc2+ 27. Kf1 Qxd3+ 28. Kg2 Rd8 29. f4 {
+and black has a clear lead.}) 26. Ke3 Qxf2+ 27. Kxf2 Rxf5 28. exf5 Rc8 
+29. d4 a6 30. a4 Kf7 31. Ke3 (31. Kg3 Kf6 32. Kf4 g5+ 33. fxg6 hxg6 34. 
+a5 g5+ 35. Kg4) 31... h5 (31... Kf6 32. Kf4 Rd8 33. a5 Rd5 34. Ke4 Rxf5) 
+32. Kf4 h4 33. Kg4 Rh8 34. d5 h3 35. Bd6 g6 (35... h2 36. Bxh2 Rxh2 37. 
+Kf4 Rh4+ 38. Ke5 Rxa4 39. d6 Rc4 {totaly won for black.}) 36. fxg6+ Kxg6 
+37. Bh2 Kf6 {\ 4} 38. f4 (38. a5 Ke7 39. Kf5 Rh5+ 40. Ke4 Rh4+ 41. f4 Kd6 
+42. Kd4 {holding the position.}) 38... Ke7 39. f5 a5 (39... Kf6 {is
+needed.}) 40. d6+ Kd7 (40... Kf6 {is still needed.}) 41. Kg5 Rb8 (41... Ke8) 
+42. f6 Rb2 (42... Ke6 43. Kg4 Rb4+ 44. Kxh3 Rxa4 45. d7 Kxd7 46. Be5 {
+but black should still win.}) 43. Kg6 (43. f7 Rg2+ 44. Kh6 Rf2 45. Kg7 
+Rg2+ 46. Kh7 Rf2 47. Kg7 {white has equalised!}) 43... Rf2 0-1
+
+[Site "Dunfermline C vs Stirling B"]
+[Date "1993.11.??"]
+[Round "4"]
+[White "Gill, Andy"]
+[Black "Kennedy, Ian"]
+[Result "0-1"]
+[ECO "C60"]
+
+1. e4 e5 2. Nf3 Nc6 3. Bb5 Bd6 4. O-O a6 5. Ba4 b5 6. Bb3 Bb7 7. d3 Nf6 (
+7... Na5 8. Nbd2 f6 9. a4 Nxb3 10. Nxb3 Bb4 11. axb5 axb5 {with
+equality.}) 8. Nc3 (8. a4 b4 9. Nbd2 Bc5 10. Nc4 d6 {<saw>}) 8... O-O (
+8... Na5 9. Bd2 Nxb3 10. axb3 O-O 11. Bg5 Rb8 {=}) 9. Be3 Na5 {\ 4} (9... 
+Be7 10. a3 Ng4 11. Bd2 {<saw>}) 10. Bd5?! {where is that bishop going.} 
+10... b4 (10... c6 11. Bb3 Bc7 12. Bg5 Nxb3 13. Bxf6 Qxf6 14. axb3 {
+<sab>}) 11. Bxb7 Nxb7 12. Nd5 (12. Ne2 Ng4 13. Bd2 f5 14. exf5 Rxf5 15. 
+Ng3 Rf6 {<saw>}) 12... c6 (12... Nxd5 13. exd5 f6 14. c3 bxc3 15. bxc3 
+Be7 16. d4 d6 {<sab>}) 13. Nxf6+ (13. Bb6 Qc8 14. Nxf6+ gxf6 15. d4 Bc7 
+16. Bxc7 Qxc7 {<saw> and the black king is exposed.}) 13... Qxf6 14. Bb6 {
+?! strange move.} (14. Qd2 Be7 15. c3 a5 16. a3 bxa3 17. bxa3 {<saw> with
+the plan ofs owning the `b' file.}) 14... Bc5 (14... Be7) 15. Bc7 (15. Nxe5 {
+but black can easly win back the pawn.}) 15... Rac8? (15... d6 16. d4 
+exd4 17. e5 Qe7 18. exd6 Nxd6 19. Bxd6 Qxd6 {<ab>}) 16. Bxe5 Qg6 17. d4 (
+17. Bg3 Rfe8 18. Ne5 Qf6 19. Nxd7 Qxb2 20. Re1 {<aw> white should now
+try use his center pawns to push home his advantage.}) 17... Bd6 18. 
+Bxd6 {this is to early, leaving myself underdeveloped.} (18. Re1 f6 19. 
+Bxd6 Nxd6 20. Qd3 {<aw>}) 18... Nxd6 19. Ne5 (19. e5 Nc4 20. b3 Na3 21. 
+Rc1 d6 22. Re1 {<aw>}) 19... Qxe4 20. Nxd7 Rfe8 21. Nc5 Qg6? (21... 
+Qe2 22. Re1 Qc4 23. Qd2 Rcd8 24. Rad1 a5 {<aw> white is a clear pawn up.}) 
+22. Nxa6 Nf5 23. Nxb4 {\ 4 white should now win the endgame quite
+comfortably.} 23... Nh4 (23... Rcd8 24. c3 c5 25. Nc2 cxd4 26. Nxd4 Qf6 
+27. Qf3 Nxd4 {<aw> though still two clear pawns up.}) 24. g3 {forced.} 
+24... c5 25. dxc5 Rxc5 (25... Qe4 26. gxh4 Qxb4 27. a4 Qxh4 28. Qd5 Re2 {
+<aw>, but whites king is dangerously exposed, and the `a' rook is not
+(yet) part of the game.}) 26. a4 {crap plan! Its just too slow.} (26. Nd3 
+Rf5 27. f4 Rd5 28. a4 Qb6+ 29. Rf2 Nf5 {<waw> black will never stop 3
+connected passed pawns!}) 26... f5 27. Nd5 Rd8?? (27... Qd6 28. Nf4 
+Qxd1 29. Rfxd1 Nf3+ 30. Kg2 Ne5 {<waw>}) 28. Ne7+! 28... Kf7 29. Qxd8 
+Qg5 {\ 4} (29... Nf3+ 30. Kg2 {is an idea.}) 30. a5 {this plan is still to
+slow.} (30. Qg8+ Kxe7 31. Rfe1+ Kd6 32. Qf8+ Kc6 33. Qc8+ Kb6 34. Re6+ 
+Rc6 35. Qxc6+ Ka7 36. Qb6+ Ka8 37. Re8+ Qd8 38. Rxd8#) 30... f4 {\ 4} 31. 
+f3?? (31. Nc6 Nf3+ 32. Kg2 fxg3 33. Qd7+ Kf8 34. Qc8+ Kf7 35. fxg3 {
+<waw> but there are still some hairy tactics.}) 31... fxg3 32. hxg3?? (
+32. Qg8+ Kxe7 33. Rfe1+ Re5 34. Rxe5+ Qxe5 35. h3 Nxf3+ 36. Kg2 {and
+white can still win!}) 32... Qxg3+ 33. Kh1 Qg2# {painfull!} 0-1
+
+[Site "Dunfermline Club Championship"]
+[Date "1993.11.??"]
+[Round "5"]
+[White "Gill, Andy"]
+[Black "Langham, Neil"]
+[Result "1-0"]
+[ECO "C41"]
+
+1. e4 e5 2. Nf3 d6 3. Nc3 Nf6 4. Bc4 h6 ( 4... Bg4 5. d3 Nc6 6. h3 Bh5 7. O-O
+Bxf3 8. Qxf3 { = } ) 5. O-O Bd7 6. d3 Nc6 7. Bd2 ( 7. Be3 Be7 8. Nd5 O-O 9. h3
+Nxd5 10. Bxd5 Bf6 ) 7... Na5 { \ 4 } 8. b4 ( 8. Bd5 Bg4 9. a3 c6 10. Ba2 d5
+11. Be3 dxe4 12. Nxe4 { but black is having the freer game } ) 8... Nxc4
+9. dxc4 Be6 ( 9... Be7 10. Qe2 O-O 11. Rfd1 Be6 12. c5 c6 13. cxd6 Qxd6 { <sab>
+} ) 10. Nd5 $2 Nxe4 11. Qe2 ( 11. Re1 Nxd2 12. Qxd2 c6 13. Ne3 Be7 14. Rad1 O-O
+{ <ab>, with white a pawn and position down. } ) 11... Nxd2 12. Nxd2 ( 12. Qxd2
+{ is better. } ) 12... Qg5 $4 { \ 4 } ( 12... g6 13. Ne3 f5 14. c5 dxc5 15. bxc5
+c6 { <ab>, ready for a pawn charge on white's king. } ) 13. Nxc7+ Ke7 (
+13... Kd7 { is better, stoping the future escape of the white knight. } )
+14. Nxa8 Bh3 { going for the cheapo. } 15. f4 $1 Qg6 16. Nc7 ( 16. fxe5 Kd8
+17. Qe4 Be6 18. Qxg6 fxg6 { is the best line Fritz2 found. } ) 16... Kd7
+17. Nd5 Bg4 18. Qf2 f6 ( 18... Qxc2 19. Ne3 Qg6 20. fxe5 Be6 21. Nf3 { rather
+cheeky, but still a rook down. } ) 19. Ne3 Ke6 $2 { \ 4 } 20. f5+ Bxf5 21. Qxf5+
+( 21. Nxf5 Qg5 22. h4 Qg4 { actually wins more material, but with this level of
+inequality, you want to swap of queens. } ) 21... Qxf5 22. Nxf5 g6 23. Ng3 { At
+this point the score sheet goes wrong, but the game was won by now anyway! }
+1-0
+
+[Site "Dunfermline Club Championship"]
+[Date "1993.11.??"]
+[Round "6"]
+[White "Gill, Andy"]
+[Black "Duncan, Dennis"]
+[Result "1-0"]
+
+1. e4 e5 2. Nf3 d6 3. Bc4 Bg4 4. O-O Nf6 5. Nc3 ( 5. d3 Nc6 6. Be3 d5 7. exd5
+Nxd5 8. Nbd2 Nxe3 9. fxe3 { = } ) 5... c6 ( 5... Nc6 6. Bb5 Qd7 7. h3 Bxf3
+8. Qxf3 O-O-O { = } ) 6. Bb3 d5 7. d3 ( 7. exd5 cxd5 8. Re1 e4 9. d3 Bxf3 { = }
+) 7... b5 ( 7... dxe4 8. dxe4 Qxd1 9. Rxd1 Bxf3 { <sab> } ) 8. h3 { \ 4 } (
+8. exd5 b4 9. Ne4 cxd5 10. Nxf6+ gxf6 11. d4 exd4 12. Qxd4 { <aw> } ) 8... Bc8
+( 8... Bxf3 9. Qxf3 d4 10. Ne2 Nbd7 11. Bg5 Be7 { <saw> } ) 9. Nxe5 ( 9. exd5
+Nxd5 10. Nxe5 Be6 11. Nxd5 { <aw> } ) 9... Qc7 ( 9... Bd6 10. Nf3 dxe4 11. Nxe4
+Nxe4 12. Re1 Bxh3 13. Rxe4+ Be6 { <aw> } ) 10. Nf3 Nh5 ( 10... Be6 11. Nd4 dxe4
+12. Bxe6 { <aw> } ) 11. exd5 c5 12. Nxb5 ( 12. Re1+ $1 Be7 13. Nxb5 Qb6 14. d6
+Qxb5 15. Rxe7+ Kd8 16. Bxf7 { <waw> } ) 12... Qb6 ( 12... Qb7 13. Re1+ Kd8
+14. Ne5 Nf6 15. Bg5 Bf5 16. Bxf6+ gxf6 { <waw> } ) 13. Ba4 ( 13. Re1+ Kd8
+14. Ne5 Qxb5 15. Nxf7+ Kc7 16. Nxh8 Nf6 17. Bf4+ { <waw> } ) 13... Bd7 14. Qe2+
+Be7 { \ 4 } 15. d4 ( 15. d6 O-O 16. dxe7 Re8 17. d4 cxd4 18. Nfxd4 { <waw> } )
+15... Bxb5 16. Bxb5+ Nd7 ( 16... Kf8 17. Re1 Qd6 18. Nh4 Qf6 19. Qxh5 { <waw> }
+) 17. Bxd7+ Kxd7 18. Ne5+ Ke8 19. dxc5 ( 19. Nc6 Qc7 20. Re1 cxd4 21. c4 Nf6 {
+<waw> } ) 19... Qxc5 20. Rd1 ( 20. d6 Qxd6 21. Qf3 Rc8 22. Nxf7 Qf6 23. Qxf6
+Nxf6 24. Nxh8 { <waw> } ) 20... Ng3 21. Qe3 ( 21. Qg4 Qxc2 22. Rd2 Qf5 23. Qxg3
+Bf6 { <waw> } ) 21... Nf5 22. Qxc5 ( 22. Qf3 Nd6 23. c4 Bf6 24. Re1 Bxe5
+25. Rxe5+ Kf8 { <waw> } ) 22... Bxc5 { \ 4 } 23. Be3 $2 ( 23. Re1 Ne7 24. c4 f6
+25. Nd3 Bd4 { <waw> } ) 23... Nxe3 ( 23... Bxe3 24. fxe3 Nxe3 25. Rd2 Rc8
+26. Re2 Nxd5 27. Ng6+ Kd7 { Blacks best line } ) 24. fxe3 Bxe3+ 25. Kf1 Bf4
+26. Re1 ( 26. Nd3 Bd6 27. c4 Rc8 28. b3 { <waw> } ) 26... f6 { \ 4 } 27. Ng6+ Kf7
+28. Nxf4 Rhe8 29. Rxe8 ( 29. c4 Rac8 30. b3 h6 31. Kf2 Rxe1 32. Rxe1 Rc5 {
+<waw> } ) 29... Rxe8 30. d6 ( 30. Kf2 Re5 31. Rd1 g5 32. Ne2 { <waw> } )
+30... Rd8 31. Rd1 g6 32. Nd5 ( 32. c4 g5 33. Ne2 Ke6 34. Nd4+ Kd7 35. c5 h6 {
+<waw>,5.25 } ) 32... Rxd6 33. c4 ( 33. Ke2 Ke6 34. c4 Rc6 35. Kd3 f5 36. b3 {
+<waw>,4.53 } ) 33... f5 34. Ke1 ( 34. b3 { <waw>,4.22 } ) 34... Ra6 35. a3 f4
+$4 { Simply throws away a pawn. } 36. c5 { \ 4 why not take the pawn? } (
+36. Nxf4 h6 37. g3 g5 38. Nd5 Re6+ 39. Kd2 Re4 { <waw>,5.06 looks good to me. }
+) 36... Ke6 $2 37. Nc7+ { Black resigns } 1-0
+
+[Site "Dunfermline Club Championship"]
+[Date "1993.11.??"]
+[Round "7"]
+[White "Gill, Andy"]
+[Black "Rintoul, Adam"]
+[Result "1-0"]
+[ECO "C70"]
+1. e4 e5 2. Nf3 Nc6 3. Bb5 a6 4. Ba4 b5 5. Bb3 Nf6 6. d3 Bc5 ( 6... Bb7 7. O-O
+d5 8. exd5 Nxd5 9. Bg5 Be7 10. Bxe7 Ndxe7 { = } ) 7. Be3 $2 { \ 4 } ( 7. Nc3 )
+7... Bxe3 8. fxe3 O-O 9. O-O d6 10. Nbd2 ( 10. a3 Bb7 11. Nc3 Rb8 12. Nd5 a5 {
+<sab>,0.13 } ) 10... Bg4 11. d4 $2 ( 11. a4 Rb8 12. axb5 axb5 13. h3 Bh5
+14. Qe2 Nd7 { <sab>,-0.22 } ) 11... Bxf3 ( 11... exd4 12. Qe1 dxe3 13. Qxe3 Na5
+14. Nd4 c6 15. c3 Nxb3 { <ab> a pawn up. } ) 12. Nxf3 Nxe4 $4 { \ 4 } ( 12... Qe8
+13. d5 Na5 14. Qd3 Nxb3 15. axb3 c6 16. Rad1 { <ab> } ) 13. Bd5 Qd7 ( 13... Ng5
+14. Bxc6 Nxf3+ 15. Bxf3 Rb8 16. dxe5 dxe5 17. a3 { <waw> } ) 14. Bxe4 f5
+15. Bd5+ Kh8 16. Ng5 exd4 17. Qh5 { \ 4 } ( 17. Nxh7 Rfb8 18. Ng5 g6 19. Qf3 Ne5
+20. Qh3+ Kg7 21. Bxa8 { <waw>,4.44 } ) 17... h6 $2 ( 17... g6 18. Bxc6 gxh5
+19. Bxd7 dxe3 20. Rxf5 Rxf5 21. Bxf5 { <waw>,4.90 } ) 18. exd4 ( 18. Qg6 Qe8
+19. Qh7# ) 18... Rae8 ( 18... Rf6 19. Rae1 Raf8 20. Ne6 Re8 21. Qf3 {
+<waw>,2.66 } ) 19. Rae1 Rxe1 20. Rxe1 Nd8 21. Qg6 { I finally find the two move
+mate! } 1-0
+
+[Site "Dunfermline Club Championship"]
+[Date "1993.11.??"]
+[Round "8"]
+[White "Robertson, Ian"]
+[Black "Gill, Andy"]
+[Result "1-0"]
+[ECO "C30"]
+[WhiteElo "2150"]
+
+1. e4 e5 2. f4 d6 3. Nf3 Nc6 (3... exf4 {Just take the pawn, and then
+follow the main line KG.}) 4. Bb5 Bd7 5. O-O Nf6 6. Nc3 Be7 (6... a6 7. 
+Ba4 exf4 8. d3 b5 9. Bb3 b4 {Who knows?}) 7. d3 {\ 4 At this point white is
+winning.} 7... O-O 8. Kh1 {! A clever waiting move, to avoid temp
+gaining checks.} (8. Ne2) 8... Nd4 {? losses a pawn} 9. Bxd7 Qxd7 (9... 
+Nxf3 10. Bh3 Nd4 11. Be3 c5 12. fxe5 dxe5 {<saw>}) 10. fxe5 Nxf3 {?? \ 4
+Losses the piece.} 11. exf6 Bxf6 12. Qxf3 b5 {? what is this for?} (
+12... Rae8 {Planning taking control over the very white center.}) 13. 
+Nd5 {\ 4} 13... Qd8 {?? Losses another pawn, as well as weakening the
+kingside, and allowing exchange of queens.} (13... Bd8) 14. Nxf6+ Qxf6 
+15. Qxf6 gxf6 16. Rxf6 Kg7 17. Bg5 {Black is just out of good moves.} 
+17... Rae8 {? Blocking in the f rook, allowing the skew.} 18. Raf1 d5 {
+? again lack of vision} 19. Bh6+ Kg8 20. exd5 Rd8 21. Bxf8 Rxf8 22. Rc6 {
+Planning an invasion of the 7th. Textbook play.} 22... Rd8 {\ 4 Planing to
+remove the dangerous white pawn, but missing the connected rooks that
+arrive on the 7th.} 23. Rxc7 Rxd5 24. Rfxf7 Rd8 {Silly, blocking the
+kings escape, athough its over anyway. I should have tried for at least
+one cheapo.} (24... Re5) 25. Rxh7 Rf8 {?? Again just missing the action.} 
+26. Rcg7# 1-0
+
+[Site "Dunfermline Club Knockout"]
+[Date "1993.12.??"]
+[Round "9"]
+[White "Gill, Andy"]
+[Black "Colquhoun, Bob"]
+[Result "1-0"]
+[ECO "B10"]
+
+1. e4 c6 2. Nf3 d5 3. exd5 cxd5 4. c4 ( 4. d4 { Score: 0.06 } ) 4... Nf6 (
+4... d4 5. b3 Nc6 6. Bb2 Nf6 7. Na3 e5 { Score: -0.03 } ) 5. cxd5 ( 5. d4 e6
+6. cxd5 Nxd5 7. Nbd2 Bd6 8. Bc4 { Score: 0.13 } ) 5... Nxd5 6. Bc4 e6 (
+6... Nb6 7. Bb3 Nc6 8. d4 Bf5 9. Bg5 Be4 { Score: 0.00 } ) 7. O-O Nc6 8. d4 a6
+( 8... Bb4 9. Bd2 Bxd2 10. Nbxd2 Nf4 11. Nb3 O-O { Score: -0.16 } ) 9. Re1 (
+9. Nc3 { Score: -0.09 } ) 9... b5 ( 9... Be7 10. Nc3 O-O 11. Qd3 Qd7 12. Nxd5 {
+Score: -0.03 } ) 10. Bxd5 Qxd5 11. Nc3 Qf5 ( 11... Qd8 12. d5 Ne7 13. d6 Nf5
+14. Qd5 Bd7 { Score: 0.41 } ) 12. d5 Nd8 ( 12... Nb4 13. d6 Nd3 14. Re4 Nxc1
+15. Rxc1 Rb8 { Score: 0.34 } ) 13. dxe6 ( 13. d6 Nb7 14. Ne4 Nc5 15. Nd4 {
+Score: 0.34 } ) 13... Bxe6 14. Qd5 ( 14. Nd5 Rc8 15. Nd4 Qg6 16. Bf4 Bc5
+17. Nc7 Kf8 18. Nxa6 { Score: 0.75 } ) 14... Qxd5 15. Nxd5 Bd6 16. Bg5 (
+16. Nd4 Rb8 17. Bf4 Bxf4 18. Nxf4 Rb6 19. Ndxe6 Nxe6 20. Nxe6 { Score: 0.00 } )
+16... O-O ( 16... h6 17. Bd2 O-O 18. Bf4 { Score: -0.25 } ) 17. Rad1 Nc6 (
+17... Nb7 18. Be7 Bxe7 { Score: 0.00 } ) 18. Nd4 ( 18. Nb6 Bb4 19. Rxe6 fxe6
+20. Nxa8 Rxa8 { Score: 0.16 } ) 18... Bxd5 ( 18... Nxd4 19. Rxd4 h6 20. Ne7 Kh7
+21. Rxd6 hxg5 22. Nd5 { Score: -0.25 } ) 19. Nxc6 Bxh2+ ( 19... Rfe8 20. Rxe8
+Rxe8 21. h3 Re6 22. Nd4 Re4 { Score: -0.13 } ) 20. Kxh2 Bxc6 21. Rd6 Rfe8 (
+21... Rac8 { Score: -0.44 } ) 22. Rxe8+ ( 22. Rc1 Be4 23. Rc7 h6 24. Be3 Kf8 {
+Score: -0.41 } ) 22... Bxe8 23. a3 ( 23. Be3 h6 24. b3 Kh7 25. a3 g6 26. Bd4 {
+Score: -0.78 } ) 23... a5 ( 23... h6 24. Be3 Kh7 25. b3 f6 26. Bd4 Bf7 27. b4 {
+Score: -0.88 } ) 24. Kg3 ( 24. b3 h6 25. Rd8 Rxd8 26. Bxd8 a4 27. bxa4 bxa4 {
+Score: -0.81 } ) 24... a4 ( 24... h6 { Score: -0.91 } ) 25. Bc1 ( 25. Kh4 h6
+26. Be3 Kh7 27. Bd4 Rc8 28. g3 Bc6 { Score: -1.03 } ) 25... Rc8 ( 25... h6
+26. Be3 Kh7 27. Kh4 Rc8 28. Bd4 Bc6 29. f3 { Score: -1.09 } ) 26. Bd2 ( 26. Be3
+h6 27. Kh4 Kh7 28. Bd4 Bc6 29. f3 { Score: -1.13 } ) 26... Rc4 ( 26... Bc6
+27. Be3 h6 28. f3 Kh7 { Score: -1.16 } ) 27. Rd8 Re4 28. Bb4 ( 28. f4 { Score:
+-0.88 } ) 28... f6 ( 28... h6 29. Kf3 Re6 30. Kg4 Kh7 31. f4 Re4 32. g3 {
+Score: -1.13 } ) 29. f4 ( 29. Kf3 Re6 30. Kg4 Kf7 31. Kh4 Re2 32. Rd2 { Score:
+-0.91 } ) 29... Kf7 30. Kf3 ( 30. Rc8 Kg6 31. Kf3 { Score: -1.16 } ) 30... Bc6
+31. Rc8 ( 31. Kg3 Re2 32. Rd2 Rxd2 33. Bxd2 Ke6 34. Be3 { Score: -1.25 } )
+31... Rxb4+ 32. Rxc6 Rxb2 33. g4 ( 33. Rb6 { Score: -2.06 } ) 33... Rb3+
+34. Ke4 Rxa3 35. Rc7+ ( 35. f5 h6 36. Rc7 Kg8 37. Rb7 Rb3 38. Rd7 Rb4 39. Kf3 {
+Score: -3.28 } ) 35... Kg6 36. Rb7 ( 36. f5 Kh6 37. Rc2 Rb3 38. g5 Kh5 39. gxf6
+gxf6 40. Rh2 { Score: -3.34 } ) 36... Rb3 37. f5+ ( 37. Kd4 { Score: -3.44 } )
+37... Kh6 38. g5+ ( 38. Kd4 a3 39. Ra7 b4 40. Kc4 Rb2 41. Rb7 Rc2 { Score:
+-3.59 } ) 38... fxg5 39. Rb6+ Kh5 40. Rb7 Rb4+ ( 40... Kg4 41. Rxg7 Rb4 42. Ke5
+Rf4 43. f6 h5 44. Ra7 h4 { Score: -4.09 } ) 41. Ke5 Rf4 ( 41... Kg4 42. Rxg7
+Rf4 43. f6 h5 44. Ra7 Rf5 45. Ke6 h4 { Score: -4.22 } ) 42. Rxb5 Kg4 43. Ke6
+Rxf5 ( 43... h5 44. Re5 h4 45. Re1 a3 46. Ra1 Rf3 47. Rg1 Kh5 { Score: -3.94 }
+) 44. Rxf5 1-0
+
+
+[Site "Dunfermline Club Championship"]
+[Date "1993.12.??"]
+[Round "10"]
+[White "Gill, Andy"]
+[Black "Petrie, George"]
+[Result "0-1"]
+
+1. e4 c5 2. Nf3 Nc6 3. Bc4 d6 ( 3... e6 4. Nc3 Nge7 5. d3 d5 6. Bb3 d4 7. Ne2
+e5 { Score: 0.09 } ) 4. O-O ( 4. c3 { Score: 0.03 } ) 4... e6 ( 4... g6 5. d4
+cxd4 6. Nxd4 Bg7 7. Be3 Nxd4 8. Bxd4 Nf6 { Score: -0.16 } ) 5. d3 ( 5. Bb5 Nf6
+6. d3 Bd7 7. Nc3 Be7 8. Bg5 O-O { Score: 0.00 } ) 5... Be7 ( 5... d5 6. Bb5 Nf6
+7. Ne5 Bd7 8. Nxd7 Qxd7 9. Bg5 { Score: 0.03 } ) 6. Nc3 Bd7 ( 6... Bf6 { Score:
+0.00 } ) 7. Bf4 ( 7. Re1 Nf6 8. Be3 O-O 9. a3 Rc8 10. Bf4 Nd4 11. Nxd4 { Score:
+0.06 } ) 7... a6 ( 7... Na5 8. Nd2 Nxc4 9. Nxc4 e5 10. Bg3 Be6 11. Ne3 { Score:
+-0.06 } ) 8. d4 ( 8. a3 Nf6 9. Re1 O-O 10. Be3 e5 11. Nd5 Be6 12. Nxe7 { Score:
+0.06 } ) 8... cxd4 9. Ne2 e5 ( 9... Na5 { Score: -0.94 } ) 10. Bg3 Nf6 11. Bd5
+( 11. c3 Nxe4 12. cxd4 O-O 13. Bd5 Nxg3 { Score: -0.97 } ) 11... O-O (
+11... Nb4 12. c3 Nbxd5 13. exd5 d3 14. Nc1 e4 15. Nd2 { Score: -1.16 } ) 12. c4
+( 12. c3 dxc3 13. Nxc3 b6 14. a3 Qc7 15. b3 Be6 16. Bxe6 { Score: -0.63 } )
+12... Qb6 ( 12... Bg4 13. Qb3 Qc7 14. Rac1 Rac8 15. Qd3 b6 { Score: -1.13 } )
+13. Qd2 ( 13. b3 Bg4 14. Nc1 Rac8 15. Nd3 Nh5 16. a3 Nxg3 17. fxg3 { Score:
+-1.22 } ) 13... Rac8 ( 13... Nb4 14. b3 Bg4 15. Rfd1 Nbxd5 { Score: -1.22 } )
+14. Bh4 ( 14. Rac1 { Score: -1.25 } ) 14... Nb4 ( 14... Bg4 15. Bg3 Nb4 16. b3
+Nbxd5 17. exd5 Bxf3 18. gxf3 { Score: -1.53 } ) 15. Nexd4 ( 15. Bxf6 Bxf6
+16. h3 Nxd5 17. cxd5 { Score: -1.44 } ) 15... Nbxd5 ( 15... exd4 16. b3 Bg4
+17. Qf4 Nd3 { Score: -3.34 } ) 16. Bxf6 ( 16. exd5 exd4 17. Rfe1 Bd8 18. b3 Ng4
+19. Bxd8 Rfxd8 20. Nxd4 { Score: -1.94 } ) 16... Nxf6 17. Ne2 ( 17. Nf5 Bxf5
+18. exf5 Rxc4 19. b3 Ne4 20. Qd5 Rb4 { Score: -4.75 } ) 17... Rxc4 18. b3 (
+18. Nc3 Rb4 19. b3 Nxe4 20. Nxe4 Rxe4 21. Rfd1 { Score: -5.13 } ) 18... Rxe4
+19. Nc3 ( 19. Ng3 Rb4 20. Rfe1 Bg4 21. Qd3 Rf4 22. Qe3 Qxe3 23. fxe3 { Score:
+-5.38 } ) 19... Rg4 ( 19... Rf4 20. Qe3 Qc7 { Score: -5.34 } ) 20. Qd1 (
+20. Rae1 { Score: -5.41 } ) 20... Bc6 21. Na4 ( 21. Rc1 Rf4 22. Re1 Bxf3
+23. gxf3 Re8 24. a3 { Score: -5.66 } ) 21... Qb4 ( 21... Bxa4 22. bxa4 Qa5
+23. Qb3 Rb4 24. Qc2 Rxa4 25. Rfc1 { Score: -5.94 } ) 22. Rc1 ( 22. h3 Rf4
+23. Nb2 Bxf3 24. gxf3 Rd4 25. Nd3 Qc3 { Score: -5.81 } ) 22... Rxg2+ 23. Kxg2
+Qg4+ 24. Kh1 Bxf3+ 25. Qxf3 Qxf3+ 26. Kg1 Nh5 ( 26... Nd5 27. Rc4 b5 28. Rfc1
+bxc4 29. Rxc4 Bf6 { Score: -14.53 } ) 27. Rc3 Qd5 ( 27... Qg4 28. Kh1 b5
+29. Rg1 Qd4 30. Rh3 Nf4 31. Rhg3 bxa4 { Score: -12.00 } ) 28. Nb6 ( 28. h3 Nf4
+29. Rg3 Ne2 30. Kh2 Nxg3 31. Kxg3 Qd3 32. Kg2 { Score: -11.94 } ) 28... Qd4
+29. Rfc1 ( 29. Na4 b5 30. h3 Nf4 31. Kh2 bxa4 32. Rc7 Re8 { Score: -12.97 } )
+29... Qxb6 30. Rc8 ( 30. R1c2 d5 31. h3 Qg6 32. Kh2 Nf4 33. f3 b6 { Score:
+-13.97 } ) 30... Nf4 31. R1c7 ( 31. R8c3 Ne2 32. Kf1 Nxc1 33. Rxc1 d5 34. h3
+Bc5 35. f3 { Score: -15.63 } ) 31... Bh4 ( 31... Nh3 32. Kh1 Qxf2 33. Rc4 d5
+34. Rc3 Qg1 { Score: -#4 } ) 32. Rc2 ( 32. Rxf8 Kxf8 33. Rc8 Ke7 34. Rc2 Qd4
+35. h3 Bxf2 36. Kh2 { Score: -18.41 } ) 32... Nd3 ( 32... Bxf2 33. Kf1 Qe3
+34. Rxf8 Kxf8 35. Rc8 Ke7 36. Rc7 Kd8 { Score: -19.53 } ) 33. Rxf8+ ( 33. Kf1
+Bxf2 34. Rxf8 Kxf8 35. Rc8 Ke7 36. Rg8 Bg3 37. Ke2 { Score: -14.78 } )
+33... Kxf8 0-1
+
+[Site "Dunfermline Club Championship"]
+[Date "1993.12.??"]
+[Round "11"]
+[White "Gill, Andy"]
+[Black "Horne, Peter"]
+[Result "0-1"]
+
+1. e4 e6 2. Nf3 Nc6 3. Bb5 a6 ( 3... d5 4. d3 dxe4 5. Bxc6 bxc6 6. dxe4 Qxd1
+7. Kxd1 { Score: 0.19 } ) 4. Ba4 ( 4. Bxc6 dxc6 5. O-O Nf6 6. Re1 Be7 7. d4 c5
+8. e5 { Score: 0.22 } ) 4... b5 5. Bb3 Bb7 ( 5... Na5 6. d3 Nxb3 7. axb3 Bb7
+8. O-O Bc5 9. Nc3 { Score: -0.13 } ) 6. d4 ( 6. c3 Nf6 7. d3 Be7 8. Be3 O-O
+9. Nbd2 d5 { Score: -0.09 } ) 6... Na5 7. Nbd2 ( 7. e5 Nxb3 8. axb3 c5 9. Bg5
+f6 10. Be3 cxd4 11. Bxd4 { Score: -0.38 } ) 7... Nf6 ( 7... Nxb3 8. axb3 c5
+9. O-O d5 10. exd5 Bxd5 { Score: -0.41 } ) 8. e5 Nd5 ( 8... Nxb3 9. Nxb3 Ne4
+10. O-O Be7 11. c3 O-O 12. Be3 d5 { Score: -0.19 } ) 9. O-O d6 ( 9... Nf4 {
+Score: -0.09 } ) 10. a4 ( 10. Bxd5 Bxd5 11. a4 dxe5 12. axb5 c5 13. bxa6 exd4 {
+Score: 0.09 } ) 10... b4 ( 10... dxe5 11. Bxd5 Qxd5 12. dxe5 c5 13. axb5 axb5
+14. b3 { Score: 0.06 } ) 11. Nc4 ( 11. Bxd5 Bxd5 12. c3 dxe5 13. Nxe5 Bd6
+14. cxb4 Bxb4 15. Ndf3 { Score: 0.03 } ) 11... Nxb3 12. cxb3 a5 ( 12... Rb8
+13. Qc2 Be7 14. Na5 c5 15. exd6 Qxd6 16. Nxb7 Rxb7 { Score: -0.34 } ) 13. Qe2 (
+13. Bg5 Be7 14. Bxe7 Qxe7 15. Re1 dxe5 { Score: -0.56 } ) 13... f6 ( 13... Be7
+14. Rd1 O-O 15. Be3 dxe5 16. dxe5 { Score: -0.63 } ) 14. exd6 ( 14. exf6 Bc8
+15. f7 Kxf7 16. Ng5 Ke7 17. Ne4 Qd7 18. Bg5 { Score: 0.47 } ) 14... cxd6 (
+14... Bxd6 15. Qxe6 Be7 16. Bd2 Ra6 17. Qf5 c5 18. dxc5 Bxc5 { Score: 0.03 } )
+15. Qxe6+ Qe7 ( 15... Be7 16. Re1 Ra6 17. Nh4 Nc7 18. Qxe7 Qxe7 19. Rxe7 Kxe7 {
+Score: 0.72 } ) 16. Qh3 ( 16. Nxd6 Kd8 17. Qxe7 Bxe7 18. Nxb7 Kc8 19. Nc5 Re8
+20. Re1 { Score: 4.66 } ) 16... Qf7 ( 16... Qc7 17. Re1 Be7 18. Qe6 Ra6 19. Bd2
+Qc8 20. Qxc8 Bxc8 { Score: 0.97 } ) 17. Re1+ Kd8 18. Bd2 Qg6 ( 18... g6 {
+Score: 0.97 } ) 19. Re2 ( 19. Rac1 Ra6 20. Ne3 Nxe3 21. Bxe3 d5 22. Bf4 Bd6 {
+Score: 0.88 } ) 19... Be7 ( 19... Ra6 20. Rae1 Be7 21. Qe6 Re8 22. Ne3 Nxe3
+23. Bxe3 Bxf3 { Score: 0.88 } ) 20. Rae1 ( 20. Nh4 Qh5 21. Rae1 Bc8 22. Qg3 Qg4
+23. Bf4 Nxf4 24. Qxg4 { Score: 1.06 } ) 20... Re8 ( 20... Bc8 21. Qh4 Bb7
+22. Bf4 Ba6 23. Qg3 { Score: 0.91 } ) 21. Nh4 ( 21. Nxd6 Bc8 22. Nh4 Qh5
+23. Qg3 Rg8 24. Nf3 Bg4 { Score: 2.06 } ) 21... Qh5 22. Nf5 ( 22. Nxd6 Ba6
+23. Re6 Bc8 24. g4 Bxe6 25. Rxe6 Nf4 26. Bxf4 { Score: 3.06 } ) 22... Qxh3
+23. gxh3 g6 ( 23... Bc6 24. Nxg7 Rg8 25. Bh6 Bd7 26. Nb6 { Score: 1.53 } )
+24. Ncxd6 ( 24. Nfxd6 Bc6 25. Nxe8 Kxe8 26. Re6 Bd7 27. Nd6 Kd8 28. Nf7 {
+Score: 3.41 } ) 24... gxf5 25. Nxe8 ( 25. Nxb7 Kd7 26. Nc5 Bxc5 27. dxc5 Rxe2 {
+Score: 1.66 } ) 25... Kxe8 26. Bh6 ( 26. f3 Kd7 27. Kf2 Rg8 28. Rd1 Bd6 29. Kf1
+Bc6 { Score: -0.16 } ) 26... Kf7 ( 26... Kd7 27. f3 Rg8 28. Kf2 Bd6 29. Rg1 Rg6
+30. Rxg6 hxg6 { Score: -0.47 } ) 27. Bf4 ( 27. f3 Rg8 28. Kf2 Bd6 29. Rg1 Rg6
+30. Rxg6 hxg6 31. Ke1 { Score: -0.41 } ) 27... Rg8+ 28. Kf1 Ba6 29. Bd2 Bd6
+30. f3 ( 30. Rc1 Bxh2 31. f3 Bg1 32. Rc4 Bxc4 33. bxc4 Bxd4 34. Rg2 { Score:
+-3.00 } ) 30... Bxh2 31. Kf2 ( 31. Rc1 Bg1 32. Rc4 Bxc4 33. bxc4 Bxd4 34. Re1
+Ne7 { Score: -3.13 } ) 31... Bg3+ 32. Kf1 Bxe1 33. Bxe1 ( 33. Kxe1 Rg1 34. Kf2
+Rb1 35. Re1 Rxb2 36. Rd1 Nc3 37. Ke1 { Score: -4.84 } ) 33... Ne3+ ( 33... Re8
+34. Bg3 Rxe2 35. Kg1 Rxb2 36. Bd6 Rxb3 { Score: -8.31 } ) 34. Kf2 f4 (
+34... Nd1 35. Kf1 Re8 36. Kg1 Bxe2 37. f4 Rd8 38. Kg2 Rxd4 { Score: -7.81 } )
+35. Rxe3 fxe3+ 36. Kxe3 Re8+ 37. Kd2 Re2+ 38. Kd1 Rxb2 39. d5 ( 39. f4 Rxb3
+40. h4 Rd3 41. Kc1 Rxd4 42. Bg3 Rd3 43. Bf2 { Score: -6.09 } ) 39... Rxb3 0-1
+
+[Site "Dunfermline Club Championship"]
+[Date "1994.01.??"]
+[Round "12"]
+[White "Gill, Andy"]
+[Black "Easton, Brian"]
+[Result "1-0"]
+
+1. e4 Nf6 2. Nc3 e6 3. d4 d5 4. e5 Ne4 5. Nxe4 dxe4 6. Bc4 Nc6 7. Be3 
+Bb4+ 8. c3 Be7 9. Ne2 Bg5 10. Qd2 Na5 11. Bxg5 Nxc4 12. Qf4 Qd5 13. b3 
+Nb2 14. O-O b6 15. Ng3 Ba6 16. c4 Nd3 17. Qxe4 Qxe4 18. Nxe4 Bb7 19. f3 
+O-O 20. Nf2 f6 21. exf6 gxf6 22. Bh6 Rf7 23. Nxd3 Rd8 24. Nf4 Re7 25. 
+Rfe1 Kf7 26. Rad1 e5 27. dxe5 Rxd1 28. Rxd1 fxe5 29. Nd5 Rd7 30. f4 e4 
+31. f5 c6 32. Nc3 c5 33. Rxd7+ Kf6 34. Rxb7 Kxf5 35. Rxh7 Kg6 36. Rh8
+1-0
+
+[Site "Wester-Hailes Congress"]
+[Date "1994.01.??"]
+[Round "13"]
+[White "Plant, George"]
+[Black "Gill, Andy"]
+[Result "1-0"]
+
+1. e4 e5 2. Nf3 Nc6 3. Bb5 a6 4. Ba4 Nf6 5. d4 b5 6. Bb3 d6 7. Ng5 Qd7 
+8. Bxf7+ Kd8 9. d5 Nb4 10. c3 Nxe4 11. Be6 Qe8 12. cxb4 Nxg5 13. Bxg5+ 
+Be7 14. Bxe7+ Qxe7 15. Bxc8 Rxc8 16. O-O c6 17. dxc6 Rxc6 18. Re1 h5 
+19. Nc3 Rc4 20. a3 g5 21. Nd5 Qg7 22. Ne3 Rc7 23. Nf5 Qf6 24. Qxd6+ 
+Qxd6 25. Nxd6 Re7 26. Rxe5 Rxe5 27. Nf7+ Ke7 28. Nxe5 Rc8 29. Nd3 Kd6 
+30. Kf1 h4 31. h3 Kd5 32. Ne1 Ke4 33. Nf3 Kf4 34. Nd4 Re8 35. Re1 Rxe1+ 
+36. Kxe1 Ke5 37. Nc2 Ke4 38. Ke2 Kf4 39. Kd3 Ke5 40. Ne3 Kf4 41. Nd5+ 
+Kf5 42. Nc7 1-0
+
+[Site "Wester-Hailes Congress"]
+[Date "1994.01.??"]
+[Round "14"]
+[White "Gill, Andy"]
+[Black "McIntee, C."]
+[Result "1-0"]
+
+1. e4 c5 2. Nf3 Nc6 3. Be2 Nf6 4. Nc3 e6 5. O-O d5 6. exd5 Nxd5 7. Nxd5 
+Qxd5 8. c4 Qd8 9. Re1 h5 10. b3 f6 11. Bb2 h4 12. h3 Qc7 13. d4 Qf4 
+14. d5 exd5 15. cxd5 Nd8 16. Bb5+ Kf7 17. Qc1 Qd6 18. Qe3 Be7 19. Qe4 
+g5 20. Bd3 Ke8 21. Qg6+ Kd7 22. Bb5+ Kc7 23. Ne5 Qxd5 24. Rad1 Qg8 25. 
+Bc4 Ne6 26. Qxg8 Rxg8 27. Bxe6 Bxe6 28. Nf3 Rad8 29. Rxd8 Rxd8 30. Rxe6 
+Rd1+ 31. Kh2 Bd6+ 32. g3 f5 33. Be5 hxg3+ 34. fxg3 Bxe5 35. Rxe5 Ra1 
+36. Rxc5+ Kb6 37. Rc2 g4 38. hxg4 fxg4 39. Ne5 Kb5 40. Nxg4 a5 41. Ne3 
+Re1 42. Nc4 Re6 43. g4 Rh6+ 44. Kg3 Rg6 45. Rg2 a4 46. Ne5 Rg5 47. 
+bxa4+ Kxa4 48. Kf4 Rg7 49. g5 b5 50. g6 b4 51. Kf5 Ka3 52. Kf6 Rg8 53. 
+g7 1-0
+
+[Site "Wester-Hailes Congress"]
+[Date "1994.01.??"]
+[Round "15"]
+[White "Robertson, F."]
+[Black "Gill, Andy"]
+[Result "1-0"]
+
+1. d4 d5 2. Nf3 e6 3. Bf4 Be7 4. e3 Nf6 5. Bd3 b6 6. O-O O-O 7. Re1 Bb7 
+8. Nbd2 c5 9. c3 Nc6 10. Ne5 Rc8 11. Ndf3 c4 12. Bc2 b5 13. b3 Qa5 14. 
+b4 Qd8 15. a4 a6 16. axb5 axb5 17. Nxc6 Bxc6 18. Ne5 Bb7 19. Ra5 Qe8 
+20. Ra7 Ba8 21. Ng4 Bc6 22. Be5 Qd8 23. Qf3 Ra8 24. Rxa8 Bxa8 25. Nxf6+ 
+Bxf6 26. e4 Bxe5 27. dxe5 dxe4 28. Bxe4 Bxe4 29. Qxe4 Qd3 30. Qxd3 cxd3 
+31. Rd1 Rd8 32. f4 f5 33. Kf2 Kf8 34. Ke3 Ke7 35. Rxd3 Rxd3+ 36. Kxd3 
+Kd7 37. h3 g6 38. Kd4 Kc6 39. g3 Kb6 40. g4 Kc6 41. c4 Kb6 42. c5+ Kc6 
+43. Ke3 Kc7 44. Ke2 Kc6 45. Kf3 Kd5 46. gxf5 gxf5 47. h4 Kc4 1-0
+
+[Site "Wester-Hailes Congress"]
+[Date "1994.01.??"]
+[Round "16"]
+[White "Gill, Andy"]
+[Black "McKerrow, A."]
+[Result "0-1"]
+
+1. e4 e5 2. Nf3 Nc6 3. Bb5 a6 4. Ba4 Nf6 5. O-O Be7 6. Nc3 b5 7. Bb3 
+O-O 8. a3 d6 9. Re1 Rb8 10. d3 Bg4 11. h3 Bh5 12. Nd5 Nxd5 13. exd5 Nd4 
+14. g4 Nxf3+ 15. Qxf3 Bg6 16. a4 b4 17. a5 Qc8 18. Ba4 f5 19. gxf5 Rxf5 
+20. Qg4 Bh5 21. Qc4 Rf6 22. Bg5 Rg6 23. f4 h6 24. Rxe5 dxe5 25. d6+ Qe6 
+26. Qxe6+ Rxe6 27. Bb3 hxg5 28. dxe7 Bf7 29. fxg5 Rg6 30. Rf1 Bxb3 31. 
+cxb3 Rxg5+ 32. Kh2 Re8 33. h4 Rg4 34. Kh3 Rf4 35. Rxf4 exf4 36. Kg4 
+Rxe7 37. Kxf4 Rd7 38. Ke4 Rd6 0-1
+
+[Site "Wester-Hailes Congress"]
+[Date "1994.01.??"]
+[Round "17"]
+[White "McCluskey, S."]
+[Black "Gill, Andy"]
+[Result "1-0"]
+
+1. e4 e5 2. Nf3 Nc6 3. Bb5 a6 4. Bxc6 dxc6 5. d3 Bd6 6. O-O Bg4 7. h3 
+Bh5 8. Be3 Qe7 9. Nc3 Nf6 10. Re1 O-O-O 11. Nb1 Bb4 12. c3 Ba5 13. b4 
+Bb6 14. a3 Nxe4 15. Bxb6 Bxf3 16. Qxf3 Ng5 17. Qe3 cxb6 18. d4 Rhe8 
+19. h4 Ne6 20. g3 exd4 21. cxd4 Rxd4 22. Nc3 c5 23. Rac1 Red8 24. bxc5 
+bxc5 25. Ne4 R8d7 26. Nxc5 Rc7 27. Nxe6 Qxe6 28. Qxd4 Rxc1 29. Rxc1+ 
+Kb8 30. Qxg7 1-0
+
+[Site "Dunferline Club Knockout"]
+[Date "1994.01.??"]
+[Round "18"]
+[White "Gill, Andy"]
+[Black "Brown, Rab"]
+[Result "1-0"]
+
+1. e4 e5 2. Nf3 d6 3. d4 Nc6 4. dxe5 Nxe5 5. Nxe5 dxe5 6. Qxd8+ Kxd8 
+7. Bc4 Bb4+ 8. Nc3 Bxc3+ 9. bxc3 Be6 10. Bxe6 fxe6 11. O-O Nf6 12. Bb2 
+Nxe4 13. c4 Nd2 14. Rfd1 Ke7 15. Rxd2 c5 16. Bxe5 Rhg8 17. Rad1 g5 18. 
+Rd7+ Ke8 19. Rxb7 g4 20. Rxh7 Rd8 21. Rxd8+ Kxd8 22. Rh8 Rxh8 23. Bxh8 
+Kd7 24. f3 gxf3 25. gxf3 Ke7 26. Be5 Kd7 27. Kg2 Ke7 28. Kg3 Kf7 29. 
+Bd6 Kf6 30. Bxc5 a5 31. Kf4 e5+ 32. Ke4 Ke6 33. f4 a4 34. fxe5 a3 35. 
+Bxa3 Kd7 36. Kd5 Ke8 37. Ke6 Kd8 38. Kf7 Kd7 39. e6+ Kc6 40. e7 Kc7 
+41. e8=Q Kb7 42. Qe6 Kc7 43. Qd6+ Kb7 44. Ke7 Ka7 45. Qb4 Ka8 46. Kd7 
+Ka7 47. Kc7 Ka6 48. Qb6# 1-0
+
+[Site "Dunfermline C vs Grangemouth B"]
+[Date "1994.01.??"]
+[Round "19"]
+[White "Gill, Andy"]
+[Black "Patterson, Dick"]
+[Result "0-1"]
+
+1. e4 c5 2. Nf3 Nc6 3. Be2 e6 4. b3 a6 5. O-O b5 6. Bb2 Nf6 7. e5 Nd5 
+8. d4 Bb7 9. c4 Nf4 10. cxb5 Nxe2+ 11. Qxe2 axb5 12. Re1 cxd4 13. Nxd4 
+Nxd4 14. Bxd4 Qg5 15. g3 Rc8 16. f4 Qg6 17. Qxb5 Bc6 18. Qe2 Be7 19. a4 
+O-O 20. a5 f6 21. exf6 Bxf6 22. Bxf6 Rxf6 23. b4 Rxf4 24. Qd2 Rf3 25. 
+Rf1 Rxf1+ 26. Kxf1 Qf5+ 27. Qf4 Qd3+ 28. Ke1 Rf8 29. Qxf8+ Kxf8 30. a6 
+Qd4 31. Ke2 Qxa1 32. Nd2 Qxa6+ 33. Ke3 Qa3+ 0-1
+
+[Site "Dunfermline Club Championship"]
+[Date "1994.01.??"]
+[Round "20"]
+[White "Mitchell, Ian"]
+[Black "Gill, Andy"]
+[Result "1-0"]
+[WhiteElo "1660"]
+
+1. e4 e5 2. f4 exf4 3. Nf3 Nc6 4. d4 Nf6 5. Bd3 d5 6. e5 Ne4 7. O-O g5 
+8. c3 Qe7 9. Nfd2 Bf5 10. Qe2 Nxd2 11. Nxd2 Bxd3 12. Qxd3 O-O-O 13. a4 
+Rg8 14. a5 a6 15. b4 h6 16. b5 Nb8 17. Nb3 axb5 18. Qxb5 Qd7 19. Qd3 f6 
+20. exf6 Bd6 21. Bd2 Qg4 22. a6 Nxa6 23. Rxa6 bxa6 24. Qxa6+ Kd7 25. 
+Qb5+ Ke6 26. c4 f3 27. Rxf3 Rb8 28. Qxd5+ Kd7 29. Nc5+ Kd8 30. Qxg8+
+1-0
+
+[Site "Dunfermline Club Championship"]
+[Date "1994.02.??"]
+[Round "21"]
+[White "Gill, Andy"]
+[Black "Burtwistle, Paul"]
+[Result "0-1"]
+
+1. e4 c5 2. Nf3 e6 3. Be2 Nc6 4. O-O Nf6 5. Nc3 d5 6. e5 Nd7 7. Re1 
+Ndxe5 8. Nxe5 Nxe5 9. Bb5+ Nc6 10. d4 a6 11. Bxc6+ bxc6 12. Be3 cxd4 
+13. Bxd4 c5 14. Be5 Bb7 15. Qd2 f6 16. Bc7 Qxc7 17. Rxe6+ Kf7 18. Rae1 
+d4 19. Nd1 Bd6 20. f4 Rhe8 21. f5 Bd5 22. Rxe8 Rxe8 23. c3 Rxe1+ 24. 
+Qxe1 Bxh2+ 25. Kh1 Be5 26. cxd4 cxd4 27. Qe2 Qc4 28. Qh5+ Kf8 29. Kg1 
+Qc2 0-1
+
+[Site "Dunfermline Club Knockout"]
+[Date "1994.02.??"]
+[Round "22"]
+[White "Gill, Andy"]
+[Black "O'Neill, Jim"]
+[Result "0-1"]
+[BlackElo "1875"]
+
+1. e4 c5 2. Nf3 d6 3. d4 cxd4 4. Nxd4 Nf6 5. Bd3 a6 6. O-O e5 7. Nf3 
+Bg4 8. Nc3 Nbd7 9. Re1 Rc8 10. Be3 b5 11. Nd5 Nxd5 12. exd5 Nf6 13. Bg5 
+Be7 14. Bxf6 Bxf6 15. Be4 O-O 16. c3 Bh4 17. Qc2 f5 18. Nxh4 Qxh4 19. 
+g3 Qh5 20. Bg2 Rf6 21. f3 Bxf3 22. Bxf3 Qxf3 23. Rad1 f4 24. gxf4 Rg6+
+0-1
+
+[Site "Dunfermline Club Championship"]
+[Date "1994.02.??"]
+[Round "23"]
+[White "Gill, Andy"]
+[Black "Bell, Bill"]
+[Result "1-0"]
+
+1. e4 e6 2. d4 d5 3. Nf3 dxe4 4. Nfd2 Qxd4 5. c3 Qd5 6. Be2 e3 7. Nf3 
+Qxd1+ 8. Bxd1 exf2+ 9. Kxf2 Nc6 10. Be3 Bd7 11. Re1 h6 12. Nbd2 O-O-O 
+13. Ba4 Kb8 14. Rad1 Bd6 15. b4 a6 16. Nc4 Be7 17. Nfe5 Be8 18. Rxd8+ 
+Bxd8 19. Bxc6 Bxc6 20. Nxf7 Rh7 21. Nxd8 Bd5 22. Nd2 g5 23. Rd1 Kc8 
+24. Nb3 Rd7 25. Nxb7 Bxb7 26. Rxd7 Kxd7 27. Nc5+ Kc6 28. Nxe6 Nf6 29. 
+Nd8+ Kd7 30. Nxb7 Ne4+ 31. Kf3 Nxc3 32. Nc5+ Kc6 33. Nxa6 Nxa2 34. Bd2 
+Kb6 35. Nc5 Kc6 36. Nd3 Kb5 37. Ke4 Kc4 38. g3 Kb3 39. h4 gxh4 40. gxh4 
+Nc3+ 41. Bxc3 Kxc3 42. h5 Kc4 43. Ne5+ Kxb4 44. Kd5 c5 45. Nd3+ Kb5 
+46. Nxc5 Kb6 47. Ne6 Kb7 48. Nf8 Kc7 49. Ke6 Kd8 50. Kf7 Kc8 51. Kg6 
+Kd8 52. Kxh6 Ke8 53. Kg7 1-0
+
+[Site "Dunfermline Club Championship"]
+[Date "1994.02.??"]
+[Round "24"]
+[White "MacArthur, John"]
+[Black "Gill, Andy"]
+[Result "1-0"]
+[WhiteElo "1725"]
+
+1. d4 e6 2. Nf3 Nf6 3. c4 d5 4. Nc3 Nc6 5. e3 Be7 6. Be2 O-O 7. O-O Qd6 
+8. c5 Qd7 9. Ne5 Nxe5 10. dxe5 Ne4 11. Nxe4 dxe4 12. Qc2 Qc6 13. b4 Rd8 
+14. Bb2 a5 15. a3 axb4 16. axb4 Rxa1 17. Rxa1 b6 18. Bd4 bxc5 19. bxc5 
+Bb7 20. Ra5 Ra8 21. Bb5 Qd5 22. Qa4 Rxa5 23. Qxa5 Bxc5 24. Qxc7 Bf8 
+25. Be8 h6 26. Qxf7+ Kh7 27. Qxf8 Bc6 1-0
+
+[Site "Dunfermline Club Championship"]
+[Date "1994.02.??"]
+[Round "25"]
+[White "Sneddon, Ian"]
+[Black "Gill, Andy"]
+[Result "1-0"]
+[WhiteElo "1685"]
+
+1. c4 e5 2. Nc3 Nf6 3. Nf3 Nc6 4. g3 d5 5. cxd5 Nxd5 6. Bg2 Be6 7. O-O 
+Bb4 8. Ne4 Qd7 9. d4 exd4 10. Nxd4 O-O-O 11. Nxe6 Qxe6 12. Qc2 h6 13. 
+Rd1 f5 14. Nc5 Bxc5 15. Qxc5 Nde7 16. Be3 Rxd1+ 17. Rxd1 Rd8 18. Rxd8+ 
+Kxd8 19. b3 a6 20. Qc3 Qe5 21. Qxe5 Nxe5 22. Bxb7 N7c6 23. Bf4 Na5 24. 
+Bxe5 Nxb7 25. Bxg7 h5 26. Kg2 Nd6 27. f3 Ne8 28. Be5 c6 29. Kh3 Ke7 
+30. Kh4 Nf6 31. Bxf6+ Kxf6 32. Kxh5 c5 33. g4 f4 34. g5+ Kg7 35. Kg4
+1-0
+
+[Site "Dunfermline Club Championship"]
+[Date "1994.03.??"]
+[Round "26"]
+[White "Gill, Andy"]
+[Black "Connally, Paul"]
+[Result "0-1"]
+[ECO "B70"]
+
+1. e4 c5 2. Nf3 d6 3. d4 cxd4 4. Nxd4 g6 5. Nc3 Nf6 6. Bd3 Bg7 7. O-O 
+O-O 8. f4 Nc6 9. Nxc6 bxc6 10. Kh1 Rb8 11. Qe1 Ng4 12. h3 Nf6 13. b3 e5 
+14. fxe5 Nh5 15. Bb2 dxe5 16. Rf3 a5 17. g4 Nf4 18. Rd1 Qg5 19. Bc1 
+Bxg4 20. Bxf4 Bxf3+ 0-1
+
+[Site "Glenrothes Congress"]
+[Date "1994.03.??"]
+[Round "27"]
+[White "Hunt, Tom"]
+[Black "Gill, Andy"]
+[Result "1/2-1/2"]
+
+1. Nf3 Nc6 2. g3 e5 3. Nc3 d5 4. d3 Be6 5. Bg2 Qd7 6. Ng5 d4 7. Nce4 
+Bf5 8. a3 Be7 9. O-O Bxg5 10. Nxg5 f6 11. Ne4 Bh3 12. Nc5 Qc8 13. Bxh3 
+Qxh3 14. Nxb7 Rb8 15. Nc5 h5 16. e4 g5 17. Qf3 g4 18. Qf5 Kf7 19. Bg5 
+Nce7 20. Qe6+ Kg6 21. f4 exf4 22. Rxf4 Kxg5 23. Raf1 h4 24. Qf7 hxg3 
+25. Ne6+ Kh4 26. hxg3+ Qxg3+ 1/2-1/2
+
+[Site "Glenrothes Congress"]
+[Date "1994.03.??"]
+[Round "28"]
+[White "Gill, Andy"]
+[Black "Husband, Dan"]
+[Result "1-0"]
+
+1. e4 c5 2. Nf3 Nc6 3. d4 Nxd4 4. Nxd4 cxd4 5. Qxd4 e6 6. Nc3 Qb6 7. 
+Qxb6 axb6 8. Bb5 Bc5 9. O-O Nf6 10. Be3 O-O 11. Rfe1 d6 12. a4 Bd7 13. 
+Bg5 Bc6 14. Bxf6 gxf6 15. Rad1 Kh8 16. Rd3 Rad8 17. Rh3 Rg8 18. Bd3 Rg7 
+19. Nb5 Bxb5 20. axb5 Rdg8 21. Rg3 Rxg3 22. hxg3 h6 23. Kf1 Kg7 24. c3 
+d5 25. exd5 exd5 26. Ra1 d4 27. Ra7 dxc3 28. bxc3 Rd8 29. Be4 Rd1+ 30. 
+Ke2 Rc1 31. Rxb7 Rxc3 32. Kf1 Rb3 33. Rxf7+ Kh8 34. Rxf6 Rxb5 35. Rxh6+ 
+Kg7 36. Rg6+ Kh7 37. Rxb6+ 1-0
+
+[Site "Glenrothes Congress"]
+[Date "1994.03.??"]
+[Round "29"]
+[White "Chance, Keith"]
+[Black "Gill, Andy"]
+[Result "1/2-1/2"]
+
+1. Nf3 Nc6 2. e4 e5 3. d4 exd4 4. Nxd4 d6 5. Nxc6 bxc6 6. Bd3 Bb7 7. 
+O-O Nf6 8. Re1 Be7 9. e5 dxe5 10. Rxe5 O-O 11. h3 Re8 12. Re1 Qd7 13. 
+Bg5 Rad8 14. Bxf6 Bxf6 15. Rxe8+ Qxe8 16. Nc3 Ba6 17. Qe1 Qxe1+ 18. 
+Rxe1 Bxd3 19. cxd3 g6 20. Rd1 Rb8 21. Ne4 Bxb2 22. Rb1 a5 23. Nc3 Rb4 
+24. Nd1 Ba3 25. Rxb4 Bxb4 26. Kf1 f5 27. Nb2 Kf7 28. Nc4 Ke6 29. Ke2 
+Kd5 30. a3 Bc5 31. Nxa5 Bxa3 32. Nc4 Bc5 33. f3 h5 34. g4 hxg4 35. hxg4 
+fxg4 36. fxg4 Ke6 37. Kf3 Bd6 38. Ke4 g5 39. Na5 c5 40. Nc4 Bf4 41. Na5 
+Bd2 42. Nc4 Bb4 43. Ne5 Bd2 44. Nf3 Bc1 45. Ne5 Bf4 46. Ng6 Bg3 47. 
+Nf8+ Kd6 48. Nh7 Bf4 49. Kf5 Kd5 50. Nxg5 Bxg5 51. Kxg5 Kd4 52. Kf5 
+Kxd3 53. g5 c4 54. g6 c3 55. g7 c2 56. g8=Q c1=Q 57. Qd5+ Ke2 58. Qg2+ 
+Kd1 59. Qg1+ 1/2-1/2
+
+[Site "Glenrothes Congress"]
+[Date "1994.03.??"]
+[Round "30"]
+[White "Gill, Andy"]
+[Black "King, Jim"]
+[Result "1/2-1/2"]
+
+1. e4 c5 2. Nf3 Nc6 3. d4 cxd4 4. Nxd4 d6 5. Bb5 Qc7 6. O-O a6 7. Ba4 
+b5 8. Bb3 Nf6 9. Re1 e6 10. Bg5 Be7 11. c3 O-O 12. Nd2 Bb7 13. Qe2 Rfe8 
+14. Rac1 d5 15. Bc2 Rac8 16. e5 Nd7 17. Bxe7 Rxe7 18. N2f3 h6 19. Qd3 
+g6 20. Qe3 Kg7 21. Nh4 Ncxe5 22. b3 Qxc3 23. Qxc3 Rxc3 24. Bb1 b4 25. 
+Rxc3 bxc3 26. Rc1 g5 27. Nhf3 Nxf3+ 28. Nxf3 g4 29. Nd4 e5 30. Nf5+ Kf6 
+31. Nxe7 Kxe7 32. Rxc3 Kd6 33. h3 Nf6 34. hxg4 Nxg4 35. Bf5 Nf6 36. Bc8 
+d4 37. Rc4 Bd5 38. Rc2 a5 39. f3 Nh5 40. Ba6 Nf4 41. Rd2 f6 42. Bd3 Bc6 
+43. Kf2 h5 44. g3 Ne6 45. a4 Be8 46. Bb5 Bg6 1/2-1/2
+
+[Site "Glenrothes Congress"]
+[Date "1994.03.??"]
+[Round "31"]
+[White "Gourley, R."]
+[Black "Gill, Andy"]
+[Result "1-0"]
+
+1. Nf3 Nc6 2. d4 e6 3. c4 d5 4. Nc3 Bb4 5. e3 Nf6 6. Bd2 O-O 7. Ne5 
+Nxe5 8. dxe5 Ne4 9. Nxe4 dxe4 10. Bxb4 c5 11. Bxc5 Qa5+ 12. b4 Rd8 13. 
+bxa5 Rxd1+ 14. Rxd1 h6 15. Rd8+ Kh7 16. Be7 b6 17. axb6 axb6 1-0
+
+[Site "Dunfermline Club Championship"]
+[Date "1994.03.??"]
+[Round "32"]
+[White "Gill, Andy"]
+[Black "Glynis, Grant"]
+[Result "1-0"]
+
+1. e4 c5 2. Nf3 d6 3. d4 cxd4 4. Nxd4 Nf6 5. Nc3 a6 6. Bc4 Nc6 7. Nxc6 
+bxc6 8. Be3 e6 9. O-O Be7 10. Bb3 O-O 11. Qe2 Bb7 12. Rad1 Qc7 13. f4 
+e5 14. Kh1 Rfd8 15. Qf3 Qc8 16. fxe5 dxe5 17. Qg3 Rxd1 18. Nxd1 Qg4 
+19. Qxe5 Qxe4 20. Qxe4 Nxe4 21. Rxf7 Nd6 22. Rxe7+ Kh8 23. Re5 Rf8 24. 
+Kg1 h6 25. Bc5 Rf6 26. c3 a5 27. g3 Ba6 28. Bc2 g5 29. Bd4 Kg8 30. Rxa5 
+Rf1+ 31. Kg2 Rf8 32. Rxa6 Nc4 33. Rxc6 Na5 34. Rxh6 Rf7 35. Rh8# 1-0
+
+[Site "Dunfermline Club Championship"]
+[Date "1994.03.??"]
+[Round "33"]
+[White "Welshman, Alistair"]
+[Black "Gill, Andy"]
+[Result "0-1"]
+[ECO "B20"]
+
+1. e4 c5 2. Bc4 d6 3. Nc3 Nf6 4. Nf3 e6 5. O-O Be7 6. d3 O-O 7. Bg5 Nc6 
+8. Bxf6 Bxf6 9. Bb5 Bd7 10. Bxc6 Bxc6 11. Qe2 Re8 12. Rae1 Bxc3 13. 
+bxc3 Qa5 14. e5 d5 15. d4 Bb5 16. Qe3 Bxf1 17. Rxf1 cxd4 18. Qxd4 Rac8 
+19. Qb4 Qxb4 20. cxb4 Rxc2 21. Ra1 Rec8 22. Kf1 Rc1+ 23. Rxc1 Rxc1+ 
+24. Ke2 Rc2+ 25. Nd2 Rxa2 26. g4 Rb2 0-1
+
+[Site "Dunfermline Club Championship"]
+[Date "1994.03.??"]
+[Round "34"]
+[White "Taylor, Robin"]
+[Black "Gill, Andy"]
+[Result "1-0"]
+[ECO "C02"]
+[WhiteElo "1610"]
+
+1. d4 e6 2. e4 d5 3. e5 c5 4. c3 Nc6 5. Nf3 Bd7 6. Bf4 cxd4 7. cxd4 
+Bb4+ 8. Bd2 Bxd2+ 9. Qxd2 Nge7 10. Nc3 a6 11. a3 Qc7 12. Bd3 O-O-O 13. 
+O-O Rdf8 14. b4 f6 15. b5 Nxd4 16. Nxd4 Qxe5 17. bxa6 Qxd4 18. axb7+ 
+Kb8 19. Ne2 Qa7 20. Qb4 Nf5 21. Bxf5 exf5 22. Qd6+ Kxb7 23. Rab1+ Kc8 
+24. Rfc1+ Kd8 25. Rb8+ Qxb8 26. Qxb8+ Ke7 27. Qb4+ Kf7 28. f4 Rc8 29. 
+Rxc8 Rxc8 30. Qd6 Be6 31. Nd4 Rc1+ 32. Kf2 Rd1 33. Qxe6+ Kf8 34. Nxf5 
+Rd2+ 35. Ke3 1-0
+
+[Site "Dunfermline C vs Stirling A"]
+[Date "1994.03.??"]
+[Round "35"]
+[White "Smith, Steve"]
+[Black "Gill, Andy"]
+[Result "1-0"]
+[ECO "B92"]
+[WhiteElo "1745"]
+
+1. e4 c5 2. Nf3 d6 3. d4 cxd4 4. Nxd4 Nf6 5. Nc3 a6 6. Be2 e5 7. Nb3 
+Be7 8. O-O O-O 9. a4 Be6 10. f4 Bxb3 11. cxb3 Nc6 12. Be3 Qd7 13. Bc4 
+Rad8 14. f5 Kh8 15. Qf3 Nb4 16. Rfd1 Nc2 17. Rac1 Nxe3 18. Qxe3 Qc6 
+19. Nd5 Nxd5 20. Bxd5 Qd7 21. Qb6 Rb8 22. Rc7 Bd8 23. Rxd7 Bxb6+ 24. 
+Kf1 f6 25. Bxb7 Bd4 26. Rc1 Bxb2 27. Rcc7 Rg8 28. Bxa6 h5 29. Bc4 Rgc8 
+30. Rxg7 Rxc7 31. Rxc7 Bd4 32. Rf7 Rg8 33. Rxf6 Rg4 34. Bd5 Rf4+ 35. 
+Ke1 Bc3+ 36. Ke2 Bd4 37. Rh6+ Kg7 38. Rxh5 Rf2+ 39. Kd3 Rxg2 40. Kc4 
+Bg1 41. h4 Rc2+ 42. Kd3 Rg2 43. Rg5+ Rxg5 44. hxg5 Bb6 45. Kc4 Bd8 46. 
+f6+ Kg6 47. f7 Be7 1-0
+
+[Site "Dunfermline Club Championship"]
+[Date "1994.04.??"]
+[Round "36"]
+[White "Gill, Andy"]
+[Black "Bill, Phillips"]
+[Result "0-1"]
+[ECO "C10"]
+
+1. e4 e6 2. d4 d5 3. Nc3 c5 4. e5 Nc6 5. Nf3 Qb6 6. Bb5 Bd7 7. Bxc6 
+Bxc6 8. O-O Ne7 9. dxc5 Qxc5 10. Be3 Qa5 11. Qd3 Nf5 12. Nd4 Nxe3 13. 
+Nxc6 bxc6 14. Qxe3 Bc5 15. Qd3 O-O 16. a3 Qc7 17. b4 Bb6 18. Rfe1 a6 
+19. Na4 Rfb8 20. Nxb6 Rxb6 21. c4 dxc4 22. Qxc4 Rb5 23. Qe4 Rd5 24. 
+Rad1 Rad8 25. Rxd5 cxd5 26. Qd4 Rc8 27. f4 g6 28. Re3 h5 29. Kf2 Qc2+ 
+30. Kf3 Rc4 31. Qd3 Qc1 32. Qe2 d4 33. Rd3 Rc3 34. Ke4 Rxa3 35. Rxa3 
+Qxa3 36. Qc4 Qe3# 0-1
+
+[Site "Edinburgh Congress"]
+[Date "1994.04.??"]
+[Round "37"]
+[White "Gill, Andy"]
+[Black "Watt, Andrew"]
+[Result "0-1"]
+[ECO "C97"]
+
+1. e4 e5 2. Nf3 Nc6 3. Bb5 a6 4. Ba4 Nf6 5. O-O Be7 6. Re1 b5 7. Bb3 d6 
+8. c3 O-O 9. h3 Na5 10. Bc2 c5 11. d4 Qc7 12. b4 cxb4 13. cxb4 Nc4 14. 
+Nbd2 Bb7 15. Nxc4 Qxc4 16. dxe5 dxe5 17. a3 Rac8 18. Bd3 Qc3 19. Bg5 
+Rfd8 20. Re3 Bxe4 21. Rc1 Qxc1 22. Qxc1 Rxc1+ 23. Re1 Rxe1+ 24. Nxe1 
+Bxd3 25. Nf3 Be4 26. Nxe5 Rd1+ 27. Kh2 Bd6 28. f4 h6 29. Bh4 g5 30. Bg3 
+Bxe5 31. fxe5 Nh5 32. e6 Nxg3 33. e7 Nf1+ 34. Kg1 Bc6 35. Kf2 f6 36. 
+Ke2 Ra1 37. Kd3 Kf7 0-1
+
+[Site "Edinburgh Congress"]
+[Date "1994.04.??"]
+[Round "38"]
+[White "Milne, Jake"]
+[Black "Gill, Andy"]
+[Result "0-1"]
+[ECO "B50"]
+
+1. e4 c5 2. Nf3 d6 3. Bc4 e6 4. d3 Nf6 5. a3 Nc6 6. Nc3 Be7 7. O-O O-O 
+8. Be3 b6 9. h3 Bb7 10. Ne2 d5 11. exd5 exd5 12. Ba2 Re8 13. c3 Qc7 
+14. Bf4 Bd6 15. Bxd6 Qxd6 16. d4 cxd4 17. Nexd4 Nxd4 18. Nxd4 Rad8 19. 
+Qd2 Ba6 20. Qg5 Re5 21. Nf5 Rxf5 22. Qxf5 Bxf1 23. Rxf1 g6 24. Qf3 Kg7 
+25. Rd1 Qe5 26. g3 a5 27. Kg2 h5 28. h4 Rd6 29. Bb1 d4 30. Qd3 Qd5+ 
+31. Qf3 Qb3 32. Qe2 Qd5+ 33. f3 Qe6 34. Qxe6 Rxe6 35. Be4 dxc3 36. bxc3 
+Nxe4 37. fxe4 Rxe4 38. Rd6 Re2+ 39. Kf3 Rb2 40. Rd3 a4 41. Ke4 f5+ 42. 
+Kd5 Re2 43. c4 Re8 44. Kc6 Rc8+ 45. Kxb6 Rxc4 46. Kb5 Rg4 47. Rd7+ Kf6 
+48. Ra7 f4 49. gxf4 Rxf4 50. Rxa4 Rxa4 51. Kxa4 g5 52. hxg5+ Kxg5 53. 
+Kb5 h4 54. a4 h3 55. a5 h2 56. a6 h1=Q 57. Kb6 Qb1+ 58. Ka7 Kf5 59. Ka8 
+Qe4+ 60. Kb8 Qe8+ 61. Kb7 Qd7+ 62. Kb6 Qd8+ 63. Kb7 Qd5+ 64. Kb6 Qa8 
+65. Ka5 Ke5 66. Kb6 Kd5 67. Ka5 Kc5 68. Ka4 Qxa6+ 69. Kb3 Qc4+ 70. Ka3 
+Qb5 71. Ka2 Kc4 72. Ka1 Kc3 0-1
+
+[Site "Edinburgh Congress"]
+[Date "1994.04.??"]
+[Round "39"]
+[White "Gill, Andy"]
+[Black "Bourke, John"]
+[Result "0-1"]
+[ECO "C54"]
+
+1. e4 e5 2. Nf3 Nc6 3. Bc4 Bc5 4. c3 Nf6 5. d4 exd4 6. cxd4 Bb4+ 7. Bd2 
+Nxe4 8. Bxb4 Nxb4 9. Bxf7+ Kxf7 10. Qb3+ d5 11. Qxb4 Re8 12. O-O Kg8 
+13. Nc3 b6 14. Rfe1 Bf5 15. Qb3 c6 16. Rac1 Qd6 17. Re3 Nxc3 18. Qxc3 
+Rxe3 19. Qxe3 Rc8 20. Re1 h6 21. Qe7 Qxe7 22. Rxe7 a5 23. Rb7 b5 24. 
+Ne5 c5 25. Rxb5 cxd4 26. f4 Be4 27. Rxa5 Rc1+ 28. Kf2 Rc2+ 29. Kg3 
+Rxg2+ 30. Kh3 Rxb2 31. Ra3 Rd2 32. Kg3 Rg2+ 33. Kh3 Rd2 34. Kg3 d3 35. 
+Nf3 Rb2 36. h4 d2 37. Nxd2 Rxd2 38. Kg4 Rd3 39. Rxd3 Bxd3 40. Kf3 Bc4 
+41. a4 Kf7 42. Ke3 Ke6 43. Kd4 Kf5 44. a5 Kxf4 45. a6 Bxa6 46. Kxd5 Kg4 
+47. Ke6 Kxh4 48. Kf7 g5 0-1
+
+[Site "Edinburgh Congress"]
+[Date "1994.04.??"]
+[Round "40"]
+[White "Gill, Andy"]
+[Black "King, David"]
+[Result "1-0"]
+[ECO "C70"]
+
+1. e4 e5 2. Nf3 Nc6 3. Bb5 a6 4. Ba4 b5 5. Bb3 Bc5 6. O-O Nge7 7. c3 d6 
+8. d4 exd4 9. cxd4 Ba7 10. Be3 Na5 11. Bc2 O-O 12. Nbd2 f5 13. Bg5 Qe8 
+14. Re1 h6 15. Bxe7 Qxe7 16. exf5 Qf6 17. Be4 Bb7 18. Bxb7 Nxb7 19. 
+Qb3+ Kh8 20. Qd5 Rab8 21. Rac1 Bb6 22. g4 Nd8 23. Ne4 Qf7 24. Qxf7 Rxf7 
+25. h3 {At this point the score sheet goes wrong. Black eventually
+looses on time!} 1-0
+
+[Site "Edinburgh Congress"]
+[Date "1994.04.??"]
+[Round "41"]
+[White "Tait, C."]
+[Black "Gill, Andy"]
+[Result "1-0"]
+[ECO "D20"]
+
+1. d4 d5 2. c4 dxc4 3. e4 c6 4. Bxc4 e6 ( 4... Nf6 5. Nc3 e5 6. Be3 exd4
+7. Bxd4 Bd6 8. f3 { Score: 0.22 } ) 5. Nf3 Bb4+ ( 5... Nf6 6. Qe2 Bb4 7. Bd2
+Qb6 8. Nc3 O-O 9. O-O Nbd7 { Score: 0.25 } ) 6. Bd2 Bxd2+ 7. Qxd2 ( 7. Nbxd2
+Nf6 8. O-O O-O 9. Rc1 Nbd7 10. Qe2 c5 11. Bd3 { Score: 0.41 } ) 7... Nf6 8. Nc3
+O-O ( 8... Nbd7 9. O-O O-O 10. Rad1 Qe7 11. Rfe1 e5 { Score: 0.38 } ) 9. O-O b6
+10. e5 ( 10. Rac1 Bb7 11. Rfd1 c5 12. dxc5 Qxd2 13. Rxd2 bxc5 { Score: 0.28 } )
+10... Nfd7 ( 10... Nd5 11. Rfd1 Ba6 12. Bxa6 Nxa6 13. Rac1 Nac7 14. Nxd5 cxd5 {
+Score: 0.28 } ) 11. Rfd1 Ba6 ( 11... Bb7 12. Ne4 c5 13. d5 b5 14. Bxb5 Bxd5
+15. Qe3 Qe7 { Score: 0.34 } ) 12. Bb3 ( 12. Bxa6 Nxa6 13. Rac1 Qe7 14. Ne4 c5
+15. Qe2 Nb4 16. dxc5 { Score: 0.34 } ) 12... Re8 ( 12... h6 13. Rac1 Qe7
+14. Ne4 Rd8 15. Nd6 Nf6 16. Qe3 { Score: 0.31 } ) 13. Ne4 c5 ( 13... h6 14. Nd6
+Re7 15. Rac1 c5 16. Bc2 Nc6 17. Be4 Qc7 { Score: 0.44 } ) 14. Nd6 ( 14. dxc5
+Bb7 15. Qe3 Re7 16. Nd6 Bc6 17. Ne4 bxc5 18. Nxc5 { Score: 1.25 } ) 14... Rf8 (
+14... Re7 15. Nxf7 Rxf7 16. Bxe6 cxd4 17. Bd5 Nc6 18. Bxc6 { Score: 0.44 } )
+15. d5 b5 ( 15... Qe7 16. Nxf7 c4 17. dxe6 Nxe5 18. N3xe5 cxb3 19. Qd5 { Score:
+1.06 } ) 16. dxe6 fxe6 ( 16... c4 17. Nxf7 Qb6 18. exd7 Nxd7 19. Qxd7 Rxf7
+20. Qd5 { Score: 3.75 } ) 17. Bxe6+ Kh8 18. Nf7+ ( 18. Qd5 Qe7 19. Nf7 Rxf7
+20. Bxf7 h6 { Score: 4.56 } ) 18... Rxf7 19. Bxf7 Nc6 ( 19... Bb7 20. Ng5 h6
+21. Bd5 { Score: 3.03 } ) 20. e6 ( 20. Qxd7 Nd4 21. Qg4 Qe7 22. Nxd4 Qxf7
+23. e6 Qf6 { Score: 5.84 } ) 20... Qe7 ( 20... Nf6 21. Rac1 c4 22. b3 Qxd2
+23. Rxd2 Rd8 24. Rxd8 Nxd8 { Score: 3.06 } ) 21. Qxd7 Bc8 ( 21... Bb7 22. Qxe7
+Nxe7 23. Rd7 Bxf3 24. gxf3 Nc6 25. e7 Nxe7 { Score: 7.41 } ) 22. Qxc6 (
+22. Qxe7 Bxe6 23. Qxe6 Nd4 24. Nxd4 cxd4 25. Rxd4 a6 { Score: 17.72 } )
+22... Rb8 ( 22... Bb7 23. Qd7 Qxd7 24. exd7 Rd8 25. Re1 g6 26. Re8 Kg7 { Score:
+10.66 } ) 23. Qe8+ ( 23. Qxc5 Bxe6 24. Qxe7 Bxf7 25. Qxa7 Rf8 26. Qxf7 Rc8 {
+Score: 18.22 } ) 23... Qxe8 24. Bxe8 Bb7 ( 24... Bxe6 25. Bd7 Bg8 26. Ne5 g6
+27. Rac1 c4 28. a4 bxa4 { Score: 7.88 } ) 25. Bf7 ( 25. Bxb5 Bxf3 26. gxf3 Kg8
+27. e7 Kf7 28. Rd8 Kxe7 29. Rxb8 { Score: 12.03 } ) 25... Bc6 ( 25... g5 26. e7
+Kg7 27. Rd8 Bc6 28. Rxb8 Kxf7 29. Ne5 Kxe7 { Score: 12.03 } ) 26. Rd2 ( 26. Ne5
+Bxg2 27. e7 g6 28. Kxg2 { Score: 15.75 } ) 1-0
+
+[Site "Dunfermline C vs Alloa"]
+[Date "1994.04.??"]
+[Round "42"]
+[White "Comrie, J."]
+[Black "Gill, Andy"]
+[Result "1-0"]
+[ECO "B50"]
+
+1. e4 c5 2. Nf3 d6 3. Bc4 e6 4. Nc3 Be7 5. d4 cxd4 6. Qxd4 Nf6 7. e5 
+dxe5 8. Qxd8+ Bxd8 9. Nxe5 O-O 10. O-O Nbd7 11. Nxd7 Bxd7 12. Be3 a6 
+13. a4 Ba5 14. Ne2 Bc6 15. Nd4 Nd5 16. Nxc6 bxc6 17. Bxd5 cxd5 18. c3 
+Rab8 19. b4 Bc7 20. Rfd1 Rfd8 21. Rac1 Bb6 22. Kf1 Bxe3 23. fxe3 f5 
+24. Rc2 g5 25. Kf2 Kf7 26. Kf3 Rdc8 27. g4 Rxb4 28. gxf5 Kf6 29. fxe6 
+Kxe6 30. Rd4 Rxd4 31. exd4 Rf8+ 32. Kg4 h6 33. Re2+ Kd6 34. Rb2 Rc8 
+35. Kh5 Rxc3 36. Rb6+ Rc6 37. Rxc6+ Kxc6 38. Kxh6 g4 39. Kg5 Kd6 40. 
+Kxg4 Ke6 41. Kg5 Ke7 42. h4 Kf7 43. h5 Kg7 44. Kf5 1-0
+
+[Site "Dunfermline Club Championship"]
+[Date "1994.04.??"]
+[Round "43"]
+[White "Gill, Andy"]
+[Black "Hunter, Scott"]
+[Result "1-0"]
+[ECO "C65"]
+
+1. e4 e5 2. Nf3 Nc6 3. Bb5 Nf6 4. d3 Bc5 5. O-O O-O 6. Re1 d5 7. Be3 
+Bxe3 8. exd5 Qxd5 9. Bxc6 Qxc6 10. Rxe3 e4 11. dxe4 Nxe4 12. Nc3 Nxc3 
+13. Rxc3 Qd6 14. Qxd6 cxd6 15. Rd1 Re8 16. Rxd6 g5 17. g4 Bxg4 18. Nxg5 
+Re1+ 19. Kg2 Rae8 20. Rg3 f5 21. h3 Be2 22. Nf3+ Kf7 23. Nxe1 f4 24. 
+Rf3 Bxf3+ 25. Nxf3 Re2 26. Rd7+ Kf8 27. Rxb7 Rxc2 28. Rxa7 Rxb2 29. Ra4 
+Kf7 30. Rxf4+ Kg6 31. a4 h5 32. h4 Ra2 33. Kg3 Ra3 34. Rc4 Rd3 35. Kf4 
+Rd5 36. Ne5+ Kf6 37. Re4 Ra5 38. Nd7+ Kg6 39. f3 Rf5+ 40. Ke3 1-0
+
+[Site "Under 1500 Final"]
+[Date "1994.05.??"]
+[Round "44"]
+[White "Hepburn, James"]
+[Black "Gill, Andy"]
+[Result "1-0"]
+[ECO "B20"]
+
+1. e4 c5 2. Bc4 d6 3. d3 e6 4. Nc3 Nf6 5. Nf3 a6 6. Bd2 Nc6 7. O-O Be7 
+8. Re1 O-O 9. a3 e5 10. h3 b5 11. Bb3 Bb7 12. Nd5 Nxd5 13. Bxd5 Qd7 
+14. c3 Na5 15. b4 Bxd5 16. exd5 Nb7 17. Re4 f5 18. Re2 cxb4 19. axb4 
+Bf6 20. Qb3 a5 21. Rae1 axb4 22. cxb4 Rfe8 23. Bg5 Bxg5 24. Nxg5 Nd8 
+25. f4 Nf7 26. Nxf7 Qxf7 27. fxe5 dxe5 28. Rxe5 Rxe5 29. Rxe5 Ra1+ 30. 
+Kh2 g5 31. d4 Kg7 32. Qd3 Qd7 33. Rxf5 Qd6+ 34. Re5 Qxb4 35. Rxg5+ Kf7 
+36. Qxh7+ Kf6 37. Qh6+ Ke7 38. Rg7+ Kd8 39. Qh8+ 1-0
+
+
+[Site "East of Scotland Championship"]
+[Date "1994.05.??"]
+[Round "45"]
+[White "Heron, D."]
+[Black "Gill, Andy"]
+[Result "1-0"]
+[ECO "D02"]
+[WhiteElo "1790"]
+
+1. Nf3 Nc6 2. d4 d5 3. Bf4 Bf5 4. e3 a6 5. c4 e6 6. Nc3 Nf6 7. a3 Qd7 
+8. b4 Bd6 9. Bxd6 Qxd6 10. Be2 O-O 11. O-O Ne4 12. Nxe4 Bxe4 13. Nd2 
+Bg6 14. Qb3 Ne7 15. c5 Qd7 16. a4 c6 17. b5 Nf5 18. Ra3 Rfe8 19. Qb2 
+Kh8 20. Rb3 Nh6 21. bxc6 bxc6 22. Rb7 Qc8 23. Nf3 Rb8 24. Bxa6 Rxb7 
+25. Qxb7 Qxb7 26. Bxb7 f6 27. Bxc6 Rb8 28. Bb5 Bc2 29. Rc1 Be4 30. Nd2 
+Bg6 31. Nb1 Ng8 32. Nc3 Ne7 33. a5 Nc8 34. Bd7 Bf5 35. Nxd5 exd5 36. 
+Bxf5 Ne7 37. Bd3 Nc6 38. Rb1 Rxb1+ 39. Bxb1 Nxa5 40. Ba2 1-0
+
+[Site "East of Scotland Chalengers"]
+[Date "1994.05.??"]
+[Round "46"]
+[White "Gill, Andy"]
+[Black "Falconer, W."]
+[Result "1/2-1/2"]
+[ECO "A15"]
+
+1. c4 Nf6 2. d3 e6 3. Nf3 d5 4. cxd5 Nxd5 5. a3 Bd6 6. e3 Nc6 7. Nbd2 
+O-O 8. Nc4 Bd7 9. Be2 b5 10. Nxd6 cxd6 11. O-O Rc8 12. Bd2 Qb6 13. Qb3 
+Ne5 14. Rac1 a6 15. Rc2 Rxc2 16. Qxc2 Rc8 17. Qb1 Nxf3+ 18. Bxf3 Bc6 
+19. Rc1 Qd8 20. Bxd5 Bxd5 21. Ba5 Qd7 22. Rxc8+ Qxc8 23. Bb4 Qc6 24. f3 
+Bb3 25. Qe1 Qc2 26. Qc3 Qxc3 27. Bxc3 d5 28. Kf2 f6 29. d4 1/2-1/2
+
+
+
+[Site "East of Scotland Chalengers"]
+[Date "1994.05.??"]
+[Round "47"]
+[White "Gill, Andy"]
+[Black "Pearson, Walter"]
+[Result "0-1"]
+[ECO "A20"]
+[BlackElo "1650"]
+
+1. c4 e5 2. d3 Ne7 3. Nf3 d6 4. e3 g6 5. Be2 Bg7 6. O-O O-O 7. Nbd2 Nd7 
+8. Nb3 b6 9. d4 exd4 10. Nfxd4 Bb7 0-1
+
+[Site "East of Scotland Chalengers"]
+[Date "1994.05.??"]
+[Round "48"]
+[White "Heatlie, Douglas"]
+[Black "Gill, Andy"]
+[Result "1-0"]
+[ECO "D61"]
+[WhiteElo "1650"]
+
+1. d4 e6 2. c4 d5 3. Nc3 Nf6 4. Bg5 Be7 5. e3 Nbd7 6. Qc2 O-O 7. Nf3 
+Re8 8. h4 Nb6 9. b3 dxc4 10. bxc4 Bd7 11. Bd3 g6 12. Bxf6 Bxf6 13. h5 
+Bxd4 14. exd4 Qf6 15. hxg6 fxg6 16. Ne4 Qg7 17. Nc5 Bc6 18. Ne5 Nd5 
+19. cxd5 exd5 20. O-O-O Rxe5 21. dxe5 Qxe5 22. g3 Qg5+ 23. Qd2 Qe5 24. 
+Nb3 Ba4 25. Qh6 Qc3+ 26. Bc2 Bxb3 27. Qxh7+ Kf8 28. Qh8+ 1-0
+
+[Site "Scottish Chess Minor"]
+[Date "1994.07.??"]
+[Round "49"]
+[White "Mill, Graham"]
+[Black "Gill, Andy"]
+[Result "1-0"]
+[ECO "B50"]
+
+1. e4 c5 2. Nf3 d6 3. Bc4 { This is an unusual way of opening, but is common at
+the Minor level. } 3... e6 4. Nc3 Nf6 5. d3 ( 5. O-O ) 5... Nc6 ( 5... d5
+6. Bb3 dxe4 7. Nxe4 Nxe4 8. dxe4 Qxd1+ 9. Kxd1 { = } ) 6. Bf4 ( 6. O-O Be7 )
+6... a6 7. O-O Be7 ( 7... Na5 8. Bb3 Nxb3 9. axb3 Be7 10. Re1 O-O 11. Qd2 {
+<sab> } ) 8. Re1 O-O { \ 4 I often find this sort of position when playing the
+sicilian, where white has the e file, pushes his pawn, and gains a winning
+advantage. } 9. e5 dxe5 10. Nxe5 Bd7 ( 10... Nxe5 ) 11. Ne4 ( 11. Bb3 { <saw> }
+) 11... Nxe5 12. Bxe5 Bc6 { \ 4 } ( 12... Nxe4 13. dxe4 b5 14. Bb3 Bc6 15. Qh5
+Re8 { = } ) 13. Bxf6 ( 13. Qf3 Nxe4 14. dxe4 b6 15. Rad1 Qe8 { <saw> } )
+13... Bxe4 $4 ( 13... Bxf6 14. Nxf6+ Qxf6 15. c3 b6 16. Qe2 { <sab> } )
+14. Bxe7 Qxe7 15. Rxe4 Rac8 16. f4 ( 16. a4 Qf6 17. c3 Rfd8 18. Qe2 h6 19. Re1
+{ <waw> } ) 16... b5 17. Bb3 Rc6 ( 17... a5 { and I might be able to stir up a
+queenside pawn charge. } ) 18. c4 ( 18. a4 { striking at the ambushing pawns. }
+) 18... Rd8 ( 18... Rd6 19. cxb5 axb5 20. a4 c4 ) 19. Qe2 ( 19. cxb5 axb5
+20. a4 bxa4 21. Raxa4 Rcd6 22. d4 cxd4 23. Rexd4 ) 19... Rd4 ( 19... b4 )
+20. Rxd4 ( 20. cxb5 axb5 21. a4 bxa4 22. Rxa4 Rd8 23. d4 cxd4 24. Rexd4 { All
+variations just win for white. } ) 20... cxd4 21. Re1 ( 21. cxb5 ) 21... Rc5
+22. Qe4 ( 22. Qf2 bxc4 23. Bxc4 Qd6 { Blacks score is rapidly going down. } )
+22... Rh5 ( 22... Qd7 23. Qa8+ Qc8 24. Qxc8+ Rxc8 25. g3 bxc4 26. dxc4 { a
+passed pawn for white! Blacks passed pawn will not live long. } ) 23. g4 (
+23. f5 Rh6 24. cxb5 axb5 { Totally won for white. } ) 23... Rh4 24. Qa8+ Qf8
+25. Qxf8+ Kxf8 { \ 4 } 26. h3 $2 ( 26. Bd1 Rh3 27. Be2 Ke7 28. Kg2 Re3 29. h3 Kd6
+{ Just a piece up. } ) 26... Rxh3 27. Bc2 Rg3+ 28. Kf2 Rxg4 29. Kf3 h5 (
+29... Rh4 30. Kg3 Rh6 31. Re4 Rg6+ 32. Kh3 Rh6+ 33. Kg2 { And black has drawing
+chances. } ) 30. Re4 ( 30. Re5 g6 31. Re4 Rh4 32. Rxd4 g5 { Black is only a
+pawn or so down. } ) 30... Ke7 31. Rxd4 ( 31. cxb5 axb5 32. Re5 g6 33. Rxb5 Kd6
+34. Ke4 ) 31... e5 ( 31... g5 32. cxb5 axb5 33. a4 e5 34. Re4 Rxf4+ 35. Rxf4
+exf4 { Blacks is a `pawn` down, with 3 connected passed pawns. Not so bad, but
+still winning for white. } ) 32. Re4 Rxf4+ 33. Rxf4 exf4 34. Kxf4 Kf6 35. c5
+Ke7 36. b4 f6 37. d4 g5+ 38. Kg3 h4+ 39. Kg4 Ke6 40. c6 Kd6 41. d5 Kc7 42. Be4
+Kd6 43. Bg2 Kc7 44. Bh3 Kd6 45. Kf5 Kc7 46. Kxf6 Kb6 47. Kxg5 { I finally
+resigned here. } 1-0
+
+[Site "Scottish Chess Minor"]
+[Date "1994.07.??"]
+[Round "50"]
+[White "Gill, Andy"]
+[Black "McMonigle, A."]
+[Result "1-0"]
+[ECO "C67"]
+
+1. e4 e5 2. Nf3 Nc6 3. Bb5 Nf6 4. O-O Nxe4 { \ 4 } 5. Re1 ( 5. d4 Be7 6. dxe5 O-O
+7. Be3 a6 { and white has the edge. } ) 5... d5 ( 5... Nd6 6. Bxc6 dxc6 7. Nxe5
+Be6 8. Nc3 Be7 9. Kh1 { <saw> } ) 6. Nxe5 ( 6. d3 { is a killer move. } )
+6... Qf6 7. Nf3 ( 7. Nxc6 bxc6 8. Qf3 Qg6 9. Bd3 Bf5 10. Bxe4 { <saw> } )
+7... Be7 8. d3 $1 Nd6 { \ 4 } ( 8... Nxf2 9. Kxf2 Bg4 10. Nbd2 O-O 11. Bxc6 bxc6
+{ <aw> } ) 9. Bxc6+ ( 9. Bg5 Qxb2 10. Bxc6+ bxc6 11. Rxe7+ Kf8 12. Nbd2 h6 {
+White is a couple of pawns up, but the tactices are hairy! } ) 9... bxc6 10. c3
+O-O { \ 4 } ( 10... h6 11. Be3 Nf5 12. Bf4 Rb8 13. Be5 Qg6 { <saw> } ) 11. Bg5
+Qg6 ( 11... Qxf3 12. Qxf3 Bxg5 13. b3 Bb7 14. Qg3 Bf6 { Is blacks best line. }
+) 12. Bxe7 Re8 13. Bxd6 Rxe1+ 14. Qxe1 Qxd6 15. Qe8+ Qf8 16. Qxf8+ ( 16. Qxc6
+Rb8 17. Qxc7 Rxb2 18. Qxa7 Bf5 19. Qd4 Qb8 20. Nfd2 { <waw> The proper
+continuation, and well winning for white. } ) 16... Kxf8 17. Ne5 ( 17. h3 {
+Still a <waw> } ) 17... Bf5 ( 17... c5 18. h3 f6 19. Nf3 { and white moving the
+knight was a waste of two tempi. } 19... Rb8 20. b3 Bf5 { <waw> } ) 18. d4 (
+18. Nd2 Re8 19. Ndf3 c5 20. g4 f6 21. Kg2 fxe5 22. gxf5 { <waw> } ) 18... Re8
+19. Nd2 Re6 { \ 4 } 20. Re1 ( 20. g4 Bxg4 21. Nxg4 Rg6 22. h3 h5 23. f3 hxg4
+24. hxg4 { <waw> what a cou. } ) 20... f6 21. Nd7+ Ke7 22. Rxe6+ Bxe6 23. Nc5
+Bf5 24. f3 ( 24. h3 h6 25. Kh2 Kd6 26. Nb7+ Ke7 27. g4 Bd3 { <waw> } )
+24... Bc8 25. g4 ( 25. Kf2 Kd6 26. f4 g6 27. Kf3 h6 28. g3 f5 ) 25... Kf7
+26. Kg2 ( 26. Kf2 Ke7 27. Ke3 Kd6 28. Kd3 h6 29. c4 dxc4+ 30. Nxc4+ { <waw>
+with a plan } ) 26... f5 27. Kg3 Kg6 28. Nd3 ( 28. gxf5+ Bxf5 29. Na6 Kf6
+30. h3 h6 31. Nxc7 { Attacking the weak backwards pawn. } ) 28... fxg4 { \ 4 } (
+28... Kf6 29. gxf5 Kxf5 30. Ne5 Bb7 { Score: 3.19 } ) 29. Ne5+ Kf6 30. Nxc6 a6
+31. fxg4 g5 32. h4 ( 32. Nb3 Bb7 33. Nb8 h6 34. Nc5 Bc8 35. b4 Kg6 36. Nbxa6 {
+Successfully ganing up on the `a` pawn. } ) 32... gxh4+ 33. Kxh4 Bd7 34. g5+ (
+34. Nb4 c6 35. Nxa6 h6 36. Kh5 Kg7 { Totally won. } ) 34... Kg7 35. Ne5 (
+35. Nb4 c6 36. Nxa6 h6 37. Nc5 Bf5 38. a4 Kg6 39. gxh6 { And either the 'a' or
+'b' pawn will queen. } ) 35... Be8 36. Nb3 Bg6 { At this point black resigned.
+} 1-0
+
+[Site "Scottish Chess Minor"]
+[Date "1994.07.??"]
+[Round "51"]
+[White "Swanson, Brian"]
+[Black "Gill, Andy"]
+[Result "1-0"]
+[ECO "B86"]
+1. e4 c5 2. Nf3 d6 3. d4 cxd4 4. Nxd4 Nf6 5. Nc3 a6 6. Bc4 e6 ( 6... e5 7. Nf3
+Qc7 8. Bd5 Bg4 9. O-O Nxd5 10. Nxd5 { Is another line of the Sicilian. } )
+7. Bg5 ( 7. O-O Qc7 8. Qd3 e5 9. Nf3 Bg4 10. Bg5 { <saw>,0.25 } ) 7... Be7
+8. f4 b5 { \ 4 } ( 8... d5 9. Bxf6 Bxf6 10. exd5 Qc7 11. Be2 Qxf4 { <ab> } )
+9. Bd3 $2 ( 9. Bb3 h6 10. Bxf6 Bxf6 11. O-O Bxd4+ 12. Qxd4 { <sab> } ) 9... Bb7
+10. b4 ( 10. Qf3 Qb6 11. Nde2 d5 { = } ) 10... Nc6 11. Nf3 $2 ( 11. Nxc6 Bxc6
+12. O-O d5 13. exd5 Nxd5 14. Bxe7 Qxe7 { <sab> } ) 11... Nxb4 12. Qe2 O-O
+13. O-O ( 13. a3 Qc7 14. Qd2 { <ab>,by a pawn or so. } ) 13... Rc8 ( 13... Qc7
+14. Qd2 d5 15. Bxf6 Bxf6 { <ab> } ) 14. Nd1 d5 15. exd5 ( 15. e5 Ne4 16. Bxe7
+Qxe7 17. Bxe4 dxe4 18. Nd4 ) 15... Bxd5 16. Ne3 { \ 4 } 16... Bc5 ( 16... Bxa2
+17. Rad1 Nxd3 18. cxd3 Nd5 { <wab>,2+ pawns up, but getting a bit tactical. } )
+17. Kh1 Bxe3 18. Qxe3 Nxc2 19. Bxc2 Rxc2 20. a4 Ra2 ( 20... h6 { <wab>, just
+winning. } ) 21. Rxa2 Bxa2 22. axb5 ( 22. Ra1 Bd5 23. axb5 axb5 24. Rb1 Ng4 {
+<wab>, to or so pawns up. } ) 22... Bc4 ( 22... axb5 23. Ra1 Bd5 24. Ra7 h6 {
+<ab>, even with the rook on blacks 2nd. This rook should be able to get to 'b'
+pawn, though. } ) 23. Rc1 Bxb5 24. Ne5 { \ 4 } 24... Nd5 $2 { A bit wild. } (
+24... h6 25. Bxf6 Qxf6 26. Rc7 a5 27. Qc5 Be2 28. Qxa5 Qxf4 { <wab>, almost
+three pawns up, and threating the forced queen exchage on f1. } ) 25. Qg3 {
+Alarms bells !!!, the bishop is going to h6. Remember. } 25... f6 { I though I
+was going to win a piece for a pawn. } 26. Bh6 g6 $4 ( 26... Qe7 27. Nc6 Qc7
+28. Rc2 Ba4 29. Rc4 Nb6 { Black still leads (two pawns up), but the tactics are
+hairy. } ) 27. Bxf8 $2 ( 27. Nxg6 Kf7 28. Nxf8 Ke8 29. Nxe6 Qd7 30. Re1 {
+<waw>,5.47 } ) 27... fxe5 ( 27... Kxf8 28. Qh4 a5 29. g3 a4 { <sab>, but
+critically depending on the weak a pawn. } ) 28. Bh6 exf4 29. Qe1 { \ 4 } (
+29. Bxf4 Nxf4 30. Qxf4 a5 31. h3 g5 32. Qe5 { <aw> } ) 29... g5 $4 { My major
+blunder. } ( 29... Kf7 30. g3 f3 31. Qf2 Qf6 { <ab>, but tricky. } ) 30. Qxe6+
+Kh8 31. Rc8 { Mate is in a couple of moves. } 1-0
+
+[Site "Scottish Chess Minor"]
+[Date "1994.07.??"]
+[Round "52"]
+[White "Gill, Andy"]
+[Black "Thomson, Brian"]
+[Result "1-0"]
+[ECO "B54"]
+
+1. e4 c5 2. Nf3 d6 3. d4 cxd4 4. Nxd4 Nc6 5. Bb5 Bd7 6. Nc3 ( 6. Nxc6 { Score:
+0.06 } ) 6... Nf6 ( 6... Nxd4 7. Qxd4 Bxb5 8. Nxb5 Qa5 9. Nc3 e5 10. Qd5 Qc7 {
+Score: -0.03 } ) 7. Bg5 h6 ( 7... Nxd4 8. Bxd7 Nxd7 9. Qxd4 e5 10. Qd2 Be7
+11. Be3 { Score: -0.03 } ) 8. Bh4 ( 8. Bxf6 exf6 9. f4 Nxd4 10. Bxd7 Qxd7
+11. Qxd4 Be7 { Score: 0.16 } ) 8... Qb6 ( 8... g5 9. Bg3 Nxd4 10. Qxd4 Bg7
+11. O-O O-O { Score: -0.22 } ) 9. Nxc6 ( 9. Bxf6 gxf6 10. Bxc6 bxc6 11. Na4 Qa5
+12. c3 Bg7 { Score: 0.06 } ) 9... bxc6 10. Bxf6 ( 10. Bd3 Qxb2 11. Bxf6 exf6
+12. Na4 Qd4 13. c3 { Score: -1.03 } ) 10... exf6 11. Ba4 ( 11. Bd3 Qxb2 12. Na4
+Qa3 13. c3 Be6 14. Qc2 O-O-O { Score: -1.31 } ) 11... Qc7 ( 11... Qxb2 12. Kd2
+Qb6 13. Qf3 Be6 14. e5 Qd4 { Score: -1.44 } ) 12. O-O Be7 13. Re1 ( 13. Rb1 O-O
+14. Qd3 Be6 15. f4 f5 { Score: -0.09 } ) 13... O-O 14. Qd4 ( 14. Bb3 { Score:
+-0.09 } ) 14... Be6 ( 14... Rab8 15. b3 Be6 16. Rad1 Rb6 17. f4 Re8 { Score:
+-0.16 } ) 15. Nd1 ( 15. f4 Rab8 16. Bb3 f5 17. e5 Bxb3 18. axb3 { Score: -0.16
+} ) 15... Qa5 ( 15... Rab8 16. Qc3 Rb6 17. Ne3 Qb7 18. f4 { Score: -0.09 } )
+16. Nc3 Qc7 ( 16... Rab8 17. b3 Qc7 18. Rad1 Rfe8 19. f4 Rb6 { Score: -0.13 } )
+17. Ne2 ( 17. Nd1 { Score: 0.00 } ) 17... Rab8 ( 17... Rfb8 18. Nf4 Rb6
+19. Nxe6 fxe6 20. Bb3 d5 21. exd5 cxd5 { Score: -0.06 } ) 18. b3 ( 18. Nf4 {
+Score: -0.13 } ) 18... a5 ( 18... f5 19. Rad1 fxe4 20. Qxe4 Bd5 21. Qd4 {
+Score: -0.41 } ) 19. Nf4 ( 19. Qc3 c5 20. Nd4 Rb7 21. Nc6 Ra8 22. Rad1 { Score:
+0.06 } ) 19... Bd7 ( 19... Rfc8 20. c4 Rd8 21. f3 Rd7 { Score: 0.00 } ) 20. Qd2
+( 20. Qc3 Rb7 21. a3 Re8 22. Nd3 Reb8 23. f4 { Score: -0.09 } ) 20... g5 (
+20... Rfe8 { Score: -0.09 } ) 21. Nh5 ( 21. Ne2 Rb7 22. Nd4 Re8 23. Qc3 c5
+24. Bxd7 Qxd7 { Score: 0.13 } ) 21... Qb6 ( 21... Bg4 22. Ng3 Rfe8 23. c4 Bf8
+24. f3 Be6 { Score: 0.13 } ) 22. Qc3 Qd8 23. Rad1 ( 23. a3 Rc8 24. Ng3 Re8
+25. Rad1 Bg4 26. Bxc6 Bxd1 27. Rxd1 { Score: 0.31 } ) 23... Bg4 24. Ng3 Bxd1
+25. Rxd1 c5 26. Nh5 ( 26. Nf5 h5 27. a3 Rb7 28. Qd3 Rb6 29. Qd2 { Score: -0.06
+} ) 26... Kh8 ( 26... Rb4 27. Ng3 Qa8 28. a3 Rb6 { Score: -0.75 } ) 27. Rd3 (
+27. Ng3 Rg8 28. Nf5 Bf8 29. Qd2 Qc7 { Score: -0.34 } ) 27... Rg8 ( 27... Rb4
+28. Ng3 c4 29. Rd5 cxb3 30. cxb3 Qb6 31. Bc6 { Score: -0.88 } ) 28. Rf3 (
+28. Ng3 Rg6 29. Nf5 Rb4 30. Bc6 Qc7 31. a3 Rb6 { Score: -0.81 } ) 28... Rg6 (
+28... d5 29. exd5 Qxd5 30. Re3 Qd1 31. Re1 Qd8 32. Ng3 { Score: -1.00 } )
+29. Bc6 ( 29. Rd3 Rb4 30. f3 c4 31. Re3 cxb3 32. cxb3 { Score: -0.97 } )
+29... Kg8 30. Bd5 ( 30. Ng3 Qc7 31. Nf5 Bf8 32. Bd5 Bg7 33. Rd3 Bh8 { Score:
+-1.00 } ) 30... a4 31. Qc4 Qe8 32. Qd3 ( 32. Qc3 axb3 33. cxb3 Qd8 34. a4 Rb6
+35. Rd3 { Score: -0.78 } ) 32... Rb4 ( 32... Qb5 33. Ng3 axb3 34. Nf5 Bf8 {
+Score: -0.97 } ) 33. e5 ( 33. c3 Rb6 34. e5 Kf8 35. Nxf6 { Score: -0.25 } )
+33... dxe5 ( 33... Kh8 34. c3 Rh4 35. exf6 Bd8 36. Re3 Qd7 { Score: -0.22 } )
+34. Qxg6+ 1-0
+
+[Site "Scottish Chess Minor"]
+[Date "1994.07.??"]
+[Round "53"]
+[White "Navmann, M."]
+[Black "Gill, Andy"]
+[Result "1/2-1/2"]
+[ECO "B50"]
+
+1. e4 c5 2. Nf3 d6 3. Bc4 e6 ( 3... Nc6 { Score: 0.00 } ) 4. Nc3 a6 ( 4... Nf6
+5. d3 d5 6. Bb3 dxe4 7. Nxe4 Nxe4 8. dxe4 Qxd1 { Score: 0.00 } ) 5. a4 ( 5. d3
+Nc6 6. Bf4 Na5 7. e5 d5 8. Bg5 Ne7 { Score: 0.09 } ) 5... Nf6 6. d3 ( 6. d4 {
+Score: 0.06 } ) 6... Be7 ( 6... d5 7. Ba2 dxe4 8. Nxe4 Nxe4 9. dxe4 Qxd1
+10. Kxd1 { Score: 0.09 } ) 7. b3 ( 7. Bg5 h6 8. Bh4 d5 9. exd5 Nxd5 10. Nxd5
+exd5 { Score: 0.16 } ) 7... O-O ( 7... d5 8. exd5 exd5 9. Nxd5 Nxd5 10. O-O O-O
+{ Score: -1.59 } ) 8. d4 ( 8. Qe2 Nc6 9. O-O d5 10. exd5 exd5 { Score: 0.06 } )
+8... cxd4 ( 8... d5 9. exd5 exd5 10. Bd3 b6 11. O-O Nc6 { Score: -0.09 } )
+9. Nxd4 ( 9. Qxd4 { Score: -0.09 } ) 9... d5 ( 9... Qa5 10. Qd2 b5 11. Bd3 e5
+12. Nf3 Bg4 { Score: -0.16 } ) 10. exd5 exd5 11. Bd3 Re8 ( 11... Nc6 12. Nce2
+Nxd4 13. Nxd4 Bb4 14. Bd2 Qa5 15. Ne2 Bxd2 { Score: -0.22 } ) 12. O-O Bb4 (
+12... Nc6 13. Nce2 Bg4 14. f3 Bc5 15. c3 { Score: -0.03 } ) 13. Bd2 ( 13. Nce2
+Nc6 14. Bb2 Bg4 15. f3 Nxd4 16. Nxd4 { Score: 0.00 } ) 13... Qa5 ( 13... b6 {
+Score: -0.09 } ) 14. Nb1 Kh8 ( 14... Nc6 15. Bxb4 Nxb4 16. Re1 Bg4 17. Be2 Rad8
+{ Score: -0.09 } ) 15. Bxb4 Qxb4 16. c3 Qe7 ( 16... Qc5 17. Re1 Rxe1 18. Qxe1
+Nc6 19. Nf5 b6 { Score: 0.09 } ) 17. Nd2 ( 17. Ra2 Qc7 18. Re2 Rxe2 19. Qxe2
+Nc6 20. Rd1 Nxd4 21. cxd4 { Score: 0.09 } ) 17... Bg4 ( 17... Qc5 18. Qc2 Nc6
+19. N2f3 Nxd4 20. Nxd4 Ne4 { Score: 0.00 } ) 18. Qc1 ( 18. N2f3 Qc7 19. Qd2 Nc6
+20. Rfe1 Rad8 21. Rxe8 Rxe8 { Score: 0.00 } ) 18... Nc6 19. Nxc6 ( 19. Re1 Ne5
+20. Qc2 Qc7 21. c4 Nxd3 22. Qxd3 { Score: 0.03 } ) 19... bxc6 20. Re1 Qd7 (
+20... Qb7 21. Qc2 Rad8 22. h3 Bh5 23. c4 Rxe1 24. Rxe1 { Score: 0.03 } )
+21. Rxe8+ Qxe8 22. Qe1 ( 22. Qc2 c5 23. h3 Bh5 24. b4 c4 25. Bf5 { Score: 0.03
+} ) 22... a5 ( 22... Qd7 { Score: 0.09 } ) 23. h3 Bd7 ( 23... Bh5 24. g4 Bg6
+25. Bxg6 hxg6 26. Rd1 Rd8 27. Qxe8 Nxe8 { Score: 0.19 } ) 24. Nf3 ( 24. Rd1 Rb8
+25. c4 h6 26. Qxe8 Rxe8 27. cxd5 cxd5 { Score: 0.16 } ) 24... Qxe1+ ( 24... Rb8
+25. Bc2 c5 26. c4 Qxe1 27. Rxe1 d4 { Score: 0.16 } ) 25. Rxe1 Re8 ( 25... Rb8
+26. Bc2 g6 27. Re7 Kg7 28. Ne5 Be8 { Score: 0.44 } ) 26. Rxe8+ ( 26. Ne5 {
+Score: 0.53 } ) 26... Bxe8 27. c4 ( 27. g3 { Score: 0.28 } ) 27... h6 (
+27... g6 28. g3 Kg7 29. Kg2 h6 30. Ne5 d4 31. f4 c5 { Score: 0.13 } ) 28. Kf1 (
+28. g3 g6 29. Ne5 Kg7 30. Kg2 d4 31. Kf3 c5 { Score: 0.25 } ) 28... g6 29. Ke2
+( 29. cxd5 { Score: 0.31 } ) 29... Kg7 30. Ke3 ( 30. Ne5 { Score: 0.31 } )
+30... Nd7 ( 30... c5 31. Ne5 d4 32. Kd2 Bd7 33. Nxd7 Nxd7 34. Be4 Ne5 { Score:
+0.09 } ) 31. Kd4 ( 31. cxd5 cxd5 32. Kd4 Nf6 33. Ne5 Kf8 34. g3 Kg7 35. f4 {
+Score: 0.59 } ) 31... dxc4 32. Bxc4 ( 32. Kxc4 f5 33. Kc3 Bf7 34. g3 Nc5
+35. Bc2 Bd5 { Score: 0.16 } ) 32... Kf6 ( 32... f5 33. Ke3 Bf7 34. Bxf7 Kxf7
+35. Kf4 Ke6 36. Nd4 Kd5 { Score: -0.03 } ) 33. Bd3 ( 33. Nd2 Nb6 34. Ne4 Ke7
+35. Bd3 f5 36. Nc5 Bf7 { Score: 0.22 } ) 33... Ke6 34. Kc4 ( 34. Ke3 Nb6
+35. Nd4 Kd6 36. Kf3 Ke5 37. Ne2 f5 { Score: 0.09 } ) 34... f6 ( 34... f5 35. g4
+fxg4 36. hxg4 Ne5 37. Nxe5 Kxe5 38. Kc3 { Score: -0.13 } ) 1/2-1/2
+
+[Site "Grangemouth Congress"]
+[Date "1994.09.??"]
+[Round "54"]
+[White "Gill, Andy"]
+[Black "McKay, Stewart"]
+[Result "1-0"]
+[ECO "B01"]
+1. e4 d5 2. exd5 Nf6 3. Bb5+ Bd7 4. Bxd7+ Qxd7 5. Nf3 Nxd5
+6. O-O Nc6 7. Re1 e6 8. d3 g6 9. Bg5 Bg7 10. c3 Nf6 11. d4 h6 12. Bxf6 Bxf6
+13. d5 Rd8 14. Qd2 Qxd5 15. Qf4 Bg7 16. Qxc7 O-O 17. Qf4 g5 18. Qd2 Qf5 19. Qe3
+Rd3 20. Qe4 Qxe4 21. Rxe4 Rd1+ 22. Re1 Rfd8 23. h3 Ne5 24. Na3 Nxf3+ 25. gxf3
+R1d3 26. Kg2 a6 27. Rac1 b5 28. Re2 Bf8 29. Nc2 Bc5 30. Ne1 Rd2 31. Rxd2 Rxd2
+32. Rc2 Rd1 33. Kf1 Be7 34. a3 Bf6 35. Ke2 Rd5 36. Nd3 Rd8 37. Kd2 Rc8 38. Ke3
+Bg7 39. f4 Bf6 40. Ne5 Rc5 41. Nd7 gxf4+ 42. Kxf4 Bg5+ 43. Ke4 f5+ 44. Kf3 Rd5
+45. Nb8 Rd6 46. c4 bxc4 47. Rxc4 Rb6 48. Rb4 Rd6 49. Ra4 Rb6 50. Nxa6 Rxb2
+51. Nc7 Rb3+ 52. Kg2 Be7 53. Nxe6 Rxa3 54. Rxa3 Bxa3 55. Kg3 Kf7 56. Nd4 Kg6
+57. Kf4 Kh5 58. Nxf5 { And White won by queening the f pawn. } 1-0
+
+[Site "Grangemouth Minor Congress"]
+[Date "1994.09.??"]
+[Round "55"]
+[White "Shaughan, Harward"]
+[Black "Gill, Andy"]
+[Result "0-1"]
+[ECO "D02"]
+1. d4 e6 2. Bf4 d5 3. Nf3 Nf6 4. Nbd2 c5 5. e3 a6 6. c4 Nc6 7. Ne5 cxd4 8. Nxc6
+bxc6 9. exd4 Qb6 10. cxd5 cxd5 11. Qc2 Bd7 12. Be3 Bb4 13. a3 Bxd2+ 14. Qxd2
+O-O 15. Bd3 Rfc8 16. O-O Bb5 17. b3 Rc6 18. f3 Rac8 19. Rfc1 Bxd3 20. Rxc6 Rxc6
+21. Qxd3 Qc7 22. Bd2 h6 23. Rb1 Nh5 24. b4 Nf4 25. Bxf4 Qxf4 26. b5 Rc1+
+27. Rxc1 Qxc1+ 28. Kf2 Qb2+ 29. Kg3 Qxb5 30. Qxb5 axb5 31. Kf2 Kf8 32. Ke3 Ke7
+33. Kd3 Kd6 34. f4 f6 35. h4 e5 36. dxe5+ fxe5 37. f5 e4+ 38. Kd4 Ke7 39. g4
+Kf6 40. Ke3 g6 41. g5+ hxg5 42. hxg5+ Kxf5 0-1
+
+[Site "Grangemouth Minor Congress"]
+[Date "1994.09.??"]
+[Round "56"]
+[White "Gill, Andy"]
+[Black "Ridland, Lindsay"]
+[Result "1-0"]
+[ECO "C65"]
+1. e4 e5 2. Nf3 Nc6 3. Bb5 Nf6 4. O-O Bc5 5. Re1 a6 (5... Ng4 6. Re2 O-O 
+7. d3 Nd4 8. Nxd4 Bxd4 9. Nd2 {<saw>,0.13 but a bit messy for white.}) 
+6. Ba4 (6. Bxc6 dxc6 7. h3 Qe7 8. d3 O-O 9. Bg5 h6 10. Bh4 {=, taking the
+exchange way out.}) 6... b5 7. Bb3 d6 {\ 4 We have now reached a main line
+of the Ruy Lopez.} 8. c3 (8. a4 Ng4 9. Re2 Bb7 10. axb5 axb5 {=, and very
+like Game 7 of the Short-Kasparov WC, where Kasparov as white scored a
+decisive victory.}) 8... Bg4 9. d3 h6 10. Be3 O-O (10... Bxe3 11. Rxe3 
+O-O 12. a4 b4 13. h3 Bh5 14. Nbd2 Rb8 {=}) 11. Bxc5 dxc5 12. Bc2 Qd7 
+13. Nbd2 (13. h3 Bh5 14. Nbd2 Rfd8 15. Nb3 Qd6 16. Qe2 Rab8 17. Red1 {
+Fritz is deperate to put h3, but I dont see why.}) 13... Nh5 {\ 4} (13... 
+Rad8 {is an idea.}) 14. Nb3 (14. h3 {<saw>,0.33 I now agree with this,
+because the knight block the h5 retreat square.}) 14... Nf4 {?} (14... 
+Qd6 15. h3 Be6 16. Ng5 Bxb3 17. axb3 Nf4 18. Nf3 {<sab>}) 15. Nxc5 Qc8 (
+15... Qe7 16. Nb3 Rfd8 17. h3 Be6 18. d4 Qf6 19. Rc1 exd4 {=}) 16. Re3 (
+16. b4 {White is just a pawn up.}) 16... Rd8 17. Qd2 Rd6 (17... Bxf3 {!} 
+18. Rxf3 Qg4 19. Rxf4 exf4 20. h3 Qh4 21. d4 {and black has equalised!}) 
+18. Bd1 {\ 4} 18... Nxg2 {?? Throws away a piece for a very temp.
+inititive.} (18... Rb8 19. d4 exd4 20. cxd4 Ne6 21. Nxe6 Qxe6 {and white
+is starting to push home his advantage.}) 19. Kxg2 Bh3+ 20. Kh1 Qg4 (
+20... Rg6 {is another idea, but the whole plan is conceptually flawed.}) 
+21. Ne1 Qg5 22. Qe2 Be6 23. Rg3 Qf6 24. Nxe6 {\ 4} (24. Nf3 Ne7 25. Nxe6 
+Qxe6 26. Bb3 Qf6 27. Rag1 {<waw>}) 24... Rxe6 (24... Qxe6 25. Bb3 Qe7 
+26. Bd5 Rad8 27. Nf3 R8d7 28. Rd1) 25. Qf3 {Crude plan of exchanging
+queens to avoid `acidents`.} (25. Bb3) 25... Qe7 26. Bb3 Rf6 27. Qe3 (27. 
+Qg2) 27... Rd8 28. Nc2 Kh7 29. Rag1 g6 30. Rf3 {\ 4} 30... Rxf3 (30... Rfd6 {
+??} 31. Rxf7+ {Trying to avoid the exchance, but black loses his Queen!
+Black actually moved his rook to d6, but before letting it go, spotted
+the danger, and then took the exchange. Shame...}) 31. Qxf3 Rd7 32. Ne3 
+h5 {?} 33. Nd5 {! At least winning the exchange. Black resigned here.}
+1-0
+
diff --git a/ghc/tests/programs/areid_pass/Main.hs b/ghc/tests/programs/areid_pass/Main.hs
new file mode 100644 (file)
index 0000000..43fc314
--- /dev/null
@@ -0,0 +1,44 @@
+module Main ( main ) where
+
+main = do_actions [
+        sleep 5,
+        wrapup (_ccall_ printf ``"%d\n"'' (pass (14::Int)))
+       ]
+
+do_actions :: [IO ()] -> IO ()
+do_actions = foldr thenIO_ (returnIO ())
+
+class Wrapper a where
+ wrapup :: IO_Int# -> IO a
+
+instance Wrapper () where
+  wrapup a = a `thenIO_Int#` \ _ -> returnIO ()
+
+instance Wrapper Int where
+  wrapup a = a `thenIO_Int#` \ x# -> returnIO (I# x#)
+
+instance Wrapper Char where
+  wrapup a = a `thenIO_Int#` \ x# -> returnIO (toEnum (I# x#))
+
+instance Wrapper Bool where
+  wrapup a = a `thenIO_Int#` \ x# -> returnIO (x# /=# 0#)
+
+class Pass a where
+  pass :: a -> Int#
+
+instance Pass Int where
+  pass (I# i#) = i#
+
+instance Pass Char where
+  pass c = pass (fromEnum c)
+
+instance Pass Bool where
+  pass True = 0#
+  pass False = 1#
+
+sleep :: Int -> IO ()
+usleep :: Int -> IO ()
+
+sleep t = wrapup (ccall sleep (pass t))
+usleep t = wrapup (ccall usleep (pass t))
+
diff --git a/ghc/tests/programs/areid_pass/Makefile b/ghc/tests/programs/areid_pass/Makefile
new file mode 100644 (file)
index 0000000..5b9af21
--- /dev/null
@@ -0,0 +1,9 @@
+TOP = ../..
+include $(TOP)/mk/boilerplate.mk
+
+SRC_HC_OPTS += -fglasgow-exts
+
+all :: runtest
+
+include $(TOP)/mk/target.mk
+
diff --git a/ghc/tests/programs/areid_pass/areid_pass.stdout b/ghc/tests/programs/areid_pass/areid_pass.stdout
new file mode 100644 (file)
index 0000000..8351c19
--- /dev/null
@@ -0,0 +1 @@
+14
diff --git a/ghc/tests/programs/cholewo-eval/Arr.lhs b/ghc/tests/programs/cholewo-eval/Arr.lhs
new file mode 100644 (file)
index 0000000..51a936b
--- /dev/null
@@ -0,0 +1,395 @@
+
+\begin{code}
+module Arr (
+  module Array,
+
+  safezipWith, safezip,
+  row,
+  sum1, map2, map3,
+  mapat, mapat2, mapat3,
+  mapindexed, mapindexed2, mapindexed3,
+--  zipArr, sumArr, scaleArr,
+  arraySize,
+
+  matvec, inner, 
+  outerVector,
+  
+  Vector (Vector), toVector, fromVector, listVector, vectorList, vector, 
+  zipVector, scaleVector, sumVector, vectorNorm2, vectorSize,
+  
+  Matrix (Matrix), toMatrix, fromMatrix, listMatrix, matrixList, matrix, 
+  zipMatrix, scaleMatrix, sumMatrix,
+
+  augment,
+  trMatrix,
+
+--   showsVector,
+--   showsMatrix,
+-- showsVecList, showsMatList
+--  spy,
+) where
+import Array
+import Numeric
+--import Trace
+--import IOExtensions(unsafePerformIO)
+\end{code}
+
+@Vector@ and @Matrix@ are 1-based arrays with read/show in form of Lists.
+
+\begin{code}
+data Vector a = Vector (Array Int a) deriving (Eq) --, Show)
+
+toVector :: Array Int a -> Vector a
+toVector x = Vector x
+
+fromVector :: Vector a -> Array Int a
+fromVector (Vector x) = x
+
+instance Functor (Vector) where
+  map fn x = toVector (map fn (fromVector x))    
+
+{-instance Eq a => Eq (Vector a) where
+--  (Vector x) == (Vector y) = x == y
+-}
+
+instance Show a => Show (Vector a) where
+  showsPrec p x = showsPrec p (elems (fromVector x))
+
+instance Read a => Read (Vector a) where
+  readsPrec p = readParen False 
+                  (\r -> [(listVector s, t) | (s, t) <- reads r])
+
+instance Num b => Num (Vector b) where
+  (+) = zipVector "+" (+)
+  (-) = zipVector "-" (-)
+  negate = map negate
+  abs = map abs
+  signum = map signum
+--   (*) = matMult -- works only for matrices!
+--  fromInteger = map fromInteger
+\end{code}
+
+
+Convert a list to 1-based vector.
+
+\begin{code}
+listVector :: [a] -> Vector a
+listVector x = toVector (listArray (1,length x) x)
+
+vectorList :: Vector a -> [a]
+vectorList = elems . fromVector
+
+vector (l,u) x | l == 1 = toVector (array (l,u) x)
+               | otherwise = error "vector: l != 1"
+               
+zipVector :: String -> (b -> c -> d) -> Vector b -> Vector c -> Vector d
+zipVector s f (Vector a) (Vector b) 
+  | bounds a == bounds b = vector (bounds a) [(i, f (a!i) (b!i)) | i <- indices a]
+  | otherwise            = error ("zipVector: " ++ s ++ ": unconformable arrays")
+
+scaleVector :: Num a => a -> Vector a -> Vector a
+scaleVector a = map (* a)
+
+sumVector :: Num a => Vector a -> a
+sumVector = sum . elems . fromVector
+
+vectorNorm2 :: Num a => Vector a -> a
+vectorNorm2 x = inner x x
+
+vectorSize :: Vector a -> Int
+vectorSize (Vector x) = rangeSize (bounds x)
+
+\end{code}
+
+==============
+
+\begin{code}
+data Matrix a = Matrix (Array (Int, Int) a) deriving Eq
+
+toMatrix :: Array (Int, Int) a -> Matrix a
+toMatrix x = Matrix x
+
+fromMatrix :: Matrix a -> Array (Int, Int) a
+fromMatrix (Matrix x) = x
+
+instance Functor (Matrix) where
+  map fn x = toMatrix (map fn (fromMatrix x))    
+
+--instance Eq a => Eq (Matrix a) where
+--  (Matrix x) == (Matrix y) = x == y
+
+instance Show a => Show (Matrix a) where
+  showsPrec p x = vertl (matrixList x)
+  
+vertl [] = showString "[]"
+vertl (x:xs) = showChar '[' . shows x . showl xs 
+    where showl [] = showChar ']'
+          showl (x:xs) = showString ",\n" . shows x . showl xs
+
+instance Read a => Read (Matrix a) where
+    readsPrec p = readParen False
+                  (\r -> [(listMatrix s, t) | (s, t) <- reads r])
+
+instance Num b => Num (Matrix b) where
+  (+) = zipMatrix "+" (+)
+  (-) = zipMatrix "-" (-)
+  negate = map negate
+  abs = map abs
+  signum = map signum
+  x * y = toMatrix (matMult (fromMatrix x) (fromMatrix y)) -- works only for matrices!
+--  fromInteger = map fromInteger
+\end{code}
+
+Convert a nested list to a matrix.
+
+\begin{code}
+listMatrix :: [[a]] -> Matrix a
+listMatrix x = Matrix (listArray ((1, 1), (length x, length (x!!0))) (concat x))
+
+matrixList :: Matrix a -> [[a]]
+matrixList (Matrix x) = [ [x!(i,j) | j <- range (l',u')] | i <- range (l,u)]
+         where ((l,l'),(u,u')) = bounds x
+
+matrix ((l,l'),(u,u')) x | l == 1 && l' == 1 = toMatrix (array ((l,l'),(u,u')) x)
+                         | otherwise = error "matrix: l != 1"
+
+zipMatrix :: String -> (b -> c -> d) -> Matrix b -> Matrix c -> Matrix d
+zipMatrix s f (Matrix a) (Matrix b) 
+  | bounds a == bounds b = matrix (bounds a) [(i, f (a!i) (b!i)) | i <- indices a]
+  | otherwise            = error ("zipMatrix: " ++ s ++ ": unconformable arrays")
+
+scaleMatrix :: Num a => a -> Matrix a -> Matrix a
+scaleMatrix a = map (* a)
+
+sumMatrix :: Num a => Matrix a -> a
+sumMatrix = sum . elems . fromMatrix
+
+\end{code}
+
+
+============
+
+\begin{code}
+safezipWith :: String -> (a -> b -> c) -> [a] -> [b] -> [c]
+safezipWith _ _ [] [] = []
+safezipWith s f (x:xs) (y:ys) = f x y : safezipWith s f xs ys
+safezipWith s _ _ _ = error ("safezipWith: " ++ s ++ ": unconformable vectors")
+
+safezip :: [a] -> [b] -> [(a,b)]
+safezip = safezipWith "(,)" (,)
+
+trMatrix :: Matrix a -> Matrix a
+trMatrix (Matrix x) = matrix ((l,l'),(u',u)) [((j,i), x!(i,j)) | j <- range (l',u'), i <- range (l,u)]
+         where ((l,l'),(u,u')) = bounds x
+
+row :: (Ix a, Ix b) => a -> Array (a,b) c -> Array b c
+row i x = ixmap (l',u') (\j->(i,j)) x where ((l,l'),(u,u')) = bounds x
+
+zipArr :: (Ix a) => String -> (b -> c -> d) -> Array a b -> Array a c -> Array a d
+zipArr s f a b | bounds a == bounds b = array (bounds a) [(i, f (a!i) (b!i)) | i <- indices a]
+               | otherwise            = error ("zipArr: " ++ s ++ ": unconformable arrays")
+\end{code}
+
+Valid only for b -> c -> b functions.
+
+\begin{code}
+zipArr' :: (Ix a) => String -> (b -> c -> b) -> Array a b -> Array a c -> Array a b
+zipArr' s f a b | bounds a == bounds b = accum f a (assocs b)
+                | otherwise            = error ("zipArr': " ++ s ++ ": unconformable arrays")
+\end{code}
+
+Overload arithmetical operators to work on lists.
+
+\begin{code}
+instance Num a => Num [a] where
+  (+) = safezipWith "+" (+)
+  (-) = safezipWith "-" (-)
+  negate = map negate
+  abs = map abs
+  signum = map signum
+--   (*) = undefined
+--   fromInteger = undefined
+\end{code}
+
+\begin{code}
+sum1 :: (Num a) => [a] -> a
+sum1 = foldl1 (+)
+
+--main = print (sum1 [[4,1,1], [5,1,2], [6,1,3,4]])
+\end{code}
+
+\begin{code}
+map2 f = map (map f) 
+map3 f = map (map2 f) 
+\end{code}
+
+Map function f at position n only.  Out of range indices are silently
+ignored.
+
+\begin{code}
+mapat n f x = mapat1 0 f x where
+    mapat1 _ _ [] = []
+    mapat1 i f (x:xs) = (if i == n then f x else x) : mapat1 (i + 1) f xs
+
+mapat2 (i,j) = mapat i . mapat j
+mapat3 (i,j,k) = mapat i . mapat j . mapat k
+
+-- main = print (mapat 2 (10+) [1,2,3,4])
+-- main = print (mapat2 (1,0) (1000+) ginp)
+-- main = print (mapat3 (1,0,1) (1000+) gw)
+\end{code}
+
+\begin{code}
+mapindexed f x = mapindexed1 f 0 x where
+    mapindexed1 _ _ [] = []
+    mapindexed1 f n (x:xs) = f n x : mapindexed1 f (n + 1) xs
+
+mapindexed2 f = mapindexed (\i -> mapindexed (\j -> f (i, j))) 
+mapindexed3 f = mapindexed (\i -> mapindexed (\j -> mapindexed (\k -> f (i, j, k))))
+
+-- main = print (mapindexed (\x y -> mapat (10+) [1,2,3,4] y) [1,2,3,4])
+-- main = print (mapindexed2 (\(i,j) x -> 100*i + 10*j + x) ginp)
+-- main = print (mapindexed3 (\(i,j,k) x -> 1000*i + 100*j + 10*k + x) gw)
+\end{code}
+
+
+
+Overload arithmetical operators to work on arrays.
+
+\begin{code}
+instance (Ix a, Show a, Num b) => Num (Array a b) where
+  (+) = zipArr "+" (+)
+  (-) = zipArr "-" (-)
+  negate = map negate
+  abs = map abs
+  signum = map signum
+--   (*) = matMult -- works only for matrices!
+--   fromInteger = map fromInteger
+\end{code}
+
+\begin{xcode}
+scaleArr :: (Ix i, Num a) => a -> Array i a -> Array i a
+scaleArr a = map (*a)
+
+sumArr :: (Ix i, Num a) => Array i a -> a
+sumArr = sum . elems
+\end{xcode}
+
+\begin{code}
+arraySize :: (Ix i) => Array i a -> Int
+arraySize = rangeSize . bounds
+\end{code}
+
+\begin{code}
+matMult         :: (Ix a, Ix b, Ix c, Num d) =>
+                   Array (a,b) d -> Array (b,c) d -> Array (a,c) d
+matMult x y     =  array resultBounds
+                         [((i,j), sum [x!(i,k) * y!(k,j) | k <- range (lj,uj)])
+                                       | i <- range (li,ui),
+                                         j <- range (lj',uj') ]
+        where ((li,lj),(ui,uj))         =  bounds x
+              ((li',lj'),(ui',uj'))     =  bounds y
+              resultBounds
+                | (lj,uj)==(li',ui')    =  ((li,lj'),(ui,uj'))
+                | otherwise             = error "matMult: incompatible bounds"
+\end{code}
+
+
+Inner product of two vectors.
+
+\begin{code}
+inner :: Num a => Vector a -> Vector a -> a
+inner (Vector v) (Vector w) = if b == bounds w
+               then sum [v!i * w!i | i <- range b]
+               else error "nn.inner: inconformable vectors"
+            where b = bounds v
+\end{code}
+
+Outer product of two vectors $v \dot w^\mathrm{T}$.
+
+\begin{code}
+outerVector :: Num b => Vector b -> Vector b -> Matrix b
+outerVector (Vector v) (Vector w) = if (l,u) == (l',u')
+               then matrix ((l,l'),(u,u')) [((i,j), v!i * w!j) | i <- range (l,u), j <- range (l',u')]
+               else error "nn.outer: inconformable vectors"
+            where ((l,u),(l',u')) = (bounds v, bounds w)
+\end{code}
+
+\begin{code}
+outerArr :: (Ix a, Num b) => Array a b -> Array a b -> Array (a,a) b
+outerArr v w = if (l,u) == (l',u')
+               then array ((l,l'),(u,u')) [((i,j), v!i * w!j) | i <- range (l,u), j <- range (l',u')]
+               else error "nn.outer: inconformable vectors"
+            where ((l,u),(l',u')) = (bounds v, bounds w)
+\end{code}
+
+Inner product of a matrix and a vector.
+
+\begin{code}
+matvec :: (Ix a, Num b) => Array (a,a) b -> Array a b -> Array a b
+matvec w x | bounds x == (l',u') =
+                array (l,u) [(i, sum [w!(i,j) * x!j | j <- range (l',u')]) 
+                                | i <- range (l,u)]
+           | otherwise           = error "nn.matvec: inconformable arrays"
+         where ((l,l'),(u,u')) = bounds w
+\end{code}
+
+Append to a vector.
+
+\begin{code}
+augment :: (Num a) => Vector a -> a -> Vector a
+augment (Vector x) y = Vector (array (a,b') ((b',y) : assocs x))
+            where (a,b) = bounds x
+                  b' = b + 1
+\end{code}
+
+Older approach (x!!i!!j fails in ghc-2.03).
+
+\begin{code}
+toMatrix' :: [[a]] -> Matrix a
+toMatrix' x = Matrix (array ((1,1),(u,u')) [((i,j), (x!!(i-1))!!(j-1)) 
+                             | i <- range (1,u), j <- range (1,u')])
+          where (u,u') = (length x,length (x!!0))
+\end{code}
+
+Matrix 2D printout.
+
+\begin{code}
+padleft :: Int -> String -> String
+padleft n x | n <= length x = x
+            | otherwise = replicate (n - length x) ' ' ++ x
+\end{code}
+
+\begin{code}
+padMatrix :: RealFloat a => Int -> Matrix a -> Matrix String
+padMatrix n x = let ss = map (\a -> showFFloat (Just n) a "") x 
+                    maxw = maximum (map length (elems (fromMatrix ss)))
+              in map (padleft maxw) ss
+\end{code}
+
+\begin{xcode}
+showsVector :: (RealFloat a) => Int -> Vector a -> ShowS
+showsVector n x z1 = let x' = padArr n x
+                         (l,u) = bounds x' in
+                  concat (map (\ (i, s) -> if i == u then s ++ "\n" else s ++ " ") (assocs x')) ++ z1
+\end{xcode}
+
+\begin{xcode}
+showsMatrix :: RealFloat a => Int -> Matrix a -> ShowS
+showsMatrix n x z1 = let x' = padMatrix n x
+                         ((l,l'),(u,u')) = bounds x' in
+                   concat (map (\ ((i,j), s) -> if j == u' then s ++ "\n" else s ++ " ") (assocs x')) ++ z1
+\end{xcode}
+
+{-
+showsVecList n x s = foldr (showsVector n) s x
+showsMatList n x s = foldr (showsMatrix n) s x
+-}
+
+
+\begin{code}
+--spy :: Show a => String -> a -> a
+--spy msg x = trace ('<' : msg ++ ": " ++ shows x ">\n") x
+--spy x  = seq (unsafePerformIO (putStr ('<' : shows x ">\n"))) x
+--spy x  = traceShow "z" x
+\end{code}
diff --git a/ghc/tests/programs/cholewo-eval/Main.lhs b/ghc/tests/programs/cholewo-eval/Main.lhs
new file mode 100644 (file)
index 0000000..0c50141
--- /dev/null
@@ -0,0 +1,98 @@
+\begin{code}
+module Main(main) where
+import Arr
+\end{code}
+
+\begin{code}
+type F a = Vector a -> a
+type DF a = Vector a -> Vector a
+\end{code}
+
+\begin{code}
+data (Eval a) => ScgData a = ScgData {k :: !Int, err :: !a,
+                          w, p, r :: !(Vector a),
+                          delta, pnorm2, lambda, lambdabar :: !a,
+                          success :: !Bool}
+\end{code}
+
+\begin{code}
+calculate2order :: Floating a => ScgData a -> a -> DF a -> ScgData a
+calculate2order d sigma1 df = 
+  let pnorm2' = vectorNorm2 (p d)
+      sigma = sigma1 / (sqrt pnorm2')
+      s = scaleVector (1/sigma) (df ((w d) + (scaleVector sigma (p d))) - df (w d)) 
+  in d {pnorm2 = pnorm2', delta = inner (p d) s}
+\end{code}
+
+\begin{code}
+hessPosDef :: (Floating a, Ord a) => ScgData a -> ScgData a
+hessPosDef d =
+  let delta' = delta d + (lambda d - lambdabar d) * pnorm2 d {- step 3 -}
+  in if delta' <= 0                             {- step 4 -}
+     then let lambdabar' = 2.0 * (lambda d - delta' / pnorm2 d)
+          in d {delta = -delta' + lambda d * pnorm2 d, lambda = lambdabar', lambdabar = lambdabar'}
+     else d {delta = delta'}
+\end{code}
+
+\begin{code}
+reduceError :: (Floating a, Ord a) => ScgData a -> DF a -> Bool -> a -> a -> ScgData a
+reduceError d df restart bdelta mu = 
+  let r' = negate (df (w d))
+      p' = if restart
+           then r'
+           else let beta = (vectorNorm2 r' - inner r' (r d)) / mu
+                in r' + scaleVector beta (p d)
+  in d {p = p', r = r', lambda = if bdelta >= 0.75 then lambda d / 4 else lambda d
+    }
+\end{code}
+
+\begin{code}
+data ScgInput a = ScgInput (F a) (DF a) (Vector a)
+\end{code}
+
+\begin{code}
+scgIter :: (Floating a, Ord a) => ScgInput a -> [ScgData a]
+scgIter (ScgInput f df w1) =
+    let p1 = negate (df w1)                     {- step 1 -}
+        r1 = p1
+        pnorm21 = vectorNorm2 p1
+        n = vectorSize w1
+        sigma1 = 1.0e-4
+        lambda1 = 1.0e-6
+        err1 = f w1
+    in iterate (\d ->
+           let d1 = if success d                {- step 2 -}
+                    then calculate2order d sigma1 df
+                    else d
+               d2 = hessPosDef d1
+               mu = inner (p d2) (r d2)         {- step 5 -}
+               alpha = mu / (delta d2)
+               w' = (w d2) + scaleVector alpha (p d2)
+               err' = f w'
+               bdelta = 2 * (delta d2) * ((err d2) - err') / (mu^2) {- step 6 -}
+               success' = (bdelta >= 0)         {- step 7 -}
+               restart = ((k d) `mod` n == 0)
+               d3 = if success' 
+                    then (reduceError (d2 {w = w'}) df restart bdelta mu) 
+                            {err = err', lambdabar = 0}
+                    else d2 {lambdabar = lambda d2}
+               d4 = if bdelta < 0.25          {- step 8 -}
+                    then d3 {lambda = (lambda d3) + (delta d3) * (1 - bdelta) / (pnorm2 d3)}
+                    else d3
+           in d4 {k = k d4 + 1, success = success'}
+       )
+       (ScgData 1 err1 w1 p1 r1 0.0 pnorm21 lambda1 0.0 True)
+\end{code}
+
+\begin{code}
+rosenbrock = ScgInput
+  (\ (Vector x) -> 100 * (x!2 - x!1^2)^2 + (1 - x!1)^2)
+  (\ (Vector x) -> listVector [-2 * (1 - x!1) - 400 * x!1 * (x!2 - x!1^2), 
+                              200 * (x!2 -x!1^2)])
+  (listVector [-1,-1.0])
+\end{code}
+
+
+\begin{code}
+main = print (w ((scgIter rosenbrock)!!1))
+\end{code}
diff --git a/ghc/tests/programs/cholewo-eval/Makefile b/ghc/tests/programs/cholewo-eval/Makefile
new file mode 100644 (file)
index 0000000..de6e7e0
--- /dev/null
@@ -0,0 +1,7 @@
+TOP = ../..
+include $(TOP)/mk/boilerplate.mk
+
+all :: runtest
+
+include $(TOP)/mk/target.mk
+
diff --git a/ghc/tests/programs/cholewo-eval/cholewo-eval.stdout b/ghc/tests/programs/cholewo-eval/cholewo-eval.stdout
new file mode 100644 (file)
index 0000000..d44ace1
--- /dev/null
@@ -0,0 +1 @@
+[-0.5105811455265337, -0.7565080326002654]
diff --git a/ghc/tests/programs/cvh_unboxing/Append.lhs b/ghc/tests/programs/cvh_unboxing/Append.lhs
new file mode 100644 (file)
index 0000000..a78e57f
--- /dev/null
@@ -0,0 +1,140 @@
+\section{Versions of {\tt append}}
+
+\begin{code}
+module Append where
+
+import PrelBase
+import Types
+\end{code}
+
+\begin{code}
+append_ :: [a] -> [a] -> [a]
+append_ (x:xs) ys = x : (append_ xs ys)
+append_ [] ys = ys
+
+append_L_S_S :: String -> S Char -> S Char
+append_L_S_S (a: b: c: d: e: a1: b1: c1: d1: e1: xs) ys  
+ = S5 a b c d e (S5 a1 b1 c1 d1 e1 (append_L_S_S xs ys))
+append_L_S_S (a: b: c: d: e: xs) ys  
+ = S5 a b c d e (append_L_S_S xs ys)
+append_L_S_S (a: b: c: d: _) ys
+ = S4 a b c d ys
+append_L_S_S (a: b: c: _) ys
+ = S3 a b c ys
+append_L_S_S (a: b: _) ys
+ = S2 a b ys
+append_L_S_S [a] ys
+ = S1 a ys
+append_L_S_S [] ys = ys
+
+append_F_S_S :: F Char -> S Char -> S Char
+append_F_S_S (F5 a b c d e (F5 a1 b1 c1 d1 e1 xs)) ys  
+ = S5 a b c d e (S5 a1 b1 c1 d1 e1 (append_F_S_S xs ys))
+append_F_S_S (F5 a b c d e xs) ys  
+ = S5 a b c d e (append_F_S_S xs ys)
+append_F_S_S (F4 a b c d) ys
+ = S4 a b c d ys
+append_F_S_S (F3 a b c) ys
+ = S3 a b c ys
+append_F_S_S (F2 a b) ys
+ = S2 a b ys
+append_F_S_S (F1 a) ys
+ = S1 a ys
+append_F_S_S FN ys = ys
+
+
+append_L_SC_SC :: String -> SC -> SC
+append_L_SC_SC (C# a: C# b: C# c: C# d: 
+                C# e: C# a1: C# b1: C# c1: 
+                C# d1: C# e1: xs) ys  
+ = SC5 a b c d e (SC5 a1 b1 c1 d1 e1 (append_L_SC_SC xs ys))
+append_L_SC_SC (C# a: C# b: C# c: C# d: 
+                C# e: xs) ys  
+ = SC5 a b c d e (append_L_SC_SC xs ys)
+append_L_SC_SC (C# a: C# b: C# c: C# d: _) ys
+ = SC4 a b c d ys
+append_L_SC_SC (C# a: C# b: C# c: _) ys
+ = SC3 a b c ys
+append_L_SC_SC (C# a: C# b: _) ys
+ = SC2 a b ys
+append_L_SC_SC [C# a] ys
+ = SC1 a ys
+append_L_SC_SC [] ys = ys
+
+
+append_FC_SC_SC :: FC -> SC -> SC
+append_FC_SC_SC (FC5 a b c d e (FC5 a1 b1 c1 d1 e1 xs)) ys  
+ = SC5 a b c d e (SC5 a1 b1 c1 d1 e1 (append_FC_SC_SC xs ys))
+append_FC_SC_SC (FC5 a b c d e xs) ys  
+ = SC5 a b c d e (append_FC_SC_SC xs ys)
+append_FC_SC_SC (FC4 a b c d) ys
+ = SC4 a b c d ys
+append_FC_SC_SC (FC3 a b c) ys
+ = SC3 a b c ys
+append_FC_SC_SC (FC2 a b) ys
+ = SC2 a b ys
+append_FC_SC_SC (FC1 a) ys
+ = SC1 a ys
+append_FC_SC_SC FCN ys = ys
+
+append_F_L_L :: F a -> [a] -> [a]
+append_F_L_L (F5 a b c d e (F5 a1 b1 c1 d1 e1 xs)) ys  
+ = a: b: c: d: e: a1: b1: c1: d1: e1: (append_F_L_L xs ys)
+append_F_L_L (F5 a b c d e xs) ys  
+ = a: b: c: d: e: (append_F_L_L xs ys)
+append_F_L_L (F4 a b c d) ys  = a: b: c: d: ys
+append_F_L_L (F3 a b c) ys  = a: b: c: ys
+append_F_L_L (F2 a b) ys  = a: b: ys
+append_F_L_L (F1 a) ys  = a: ys
+append_F_L_L FN ys = ys
+
+append_S_L_L :: S Char -> String -> String
+append_S_L_L (S5 a b c d e (S5 a1 b1 c1 d1 e1 xs)) ys  
+ =  a:  b:  c:  d:  e:  a1: b1:  c1:  d1:  e1: (append_S_L_L xs ys)
+append_S_L_L (S5 a b c d e xs) ys  
+ =  a:  b:  c:  d: e: (append_S_L_L xs ys)
+append_S_L_L (S4 a b c d xs) ys  
+ =  a:  b:  c:  d: (append_S_L_L xs ys)
+append_S_L_L (S3 a b c xs) ys  
+ =  a:  b:  c: (append_S_L_L xs ys)
+append_S_L_L (S2 a b xs) ys  
+ =  a:  b: (append_S_L_L xs ys)
+append_S_L_L (S1 a xs) ys  
+ =  a: (append_S_L_L xs ys)
+append_S_L_L SN ys = ys
+
+
+append_FC_L_L :: FC -> String -> String
+append_FC_L_L (FC5 a b c d e (FC5 a1 b1 c1 d1 e1 xs)) ys  
+ = C# a: C# b: C# c: C# d: C# e: C# a1: 
+      C# b1: C# c1: C# d1: C# e1: 
+         (append_FC_L_L xs ys)
+append_FC_L_L (FC5 a b c d e xs) ys  
+ = C# a: C# b: C# c: C# d: 
+      C# e: (append_FC_L_L xs ys)
+append_FC_L_L (FC4 a b c d) ys  
+ = C# a: C# b: C# c: C# d: ys
+append_FC_L_L (FC3 a b c) ys  
+ = C# a: C# b: C# c: ys
+append_FC_L_L (FC2 a b) ys  = C# a: C# b: ys
+append_FC_L_L (FC1 a) ys  = C# a: ys
+append_FC_L_L FCN ys = ys
+
+append_SC_L_L :: SC -> String -> String
+append_SC_L_L (SC5 a b c d e (SC5 a1 b1 c1 d1 e1 xs)) ys  
+ = C# a: C# b: C# c: C# d: C# e: C# a1: 
+      C# b1: C# c1: C# d1: C# e1: 
+          (append_SC_L_L xs ys)
+append_SC_L_L (SC5 a b c d e xs) ys  
+ = C# a: C# b: C# c: C# d: 
+      C# e: (append_SC_L_L xs ys)
+append_SC_L_L (SC4 a b c d xs) ys  
+ = C# a: C# b: C# c: C# d: (append_SC_L_L xs ys)
+append_SC_L_L (SC3 a b c xs) ys  
+ = C# a: C# b: C# c: (append_SC_L_L xs ys)
+append_SC_L_L (SC2 a b xs) ys  
+ = C# a: C# b: (append_SC_L_L xs ys)
+append_SC_L_L (SC1 a xs) ys  
+ = C# a: (append_SC_L_L xs ys)
+append_SC_L_L SCN ys = ys
+\end{code}
diff --git a/ghc/tests/programs/cvh_unboxing/Main.lhs b/ghc/tests/programs/cvh_unboxing/Main.lhs
new file mode 100644 (file)
index 0000000..42f508c
--- /dev/null
@@ -0,0 +1,8 @@
+\begin{code}
+import PrelBase
+import Types
+import Append
+
+main = putStr (show (append_FC_L_L (FC2 a_ a_) []))
+   where a_ = case 'a' of { C# x -> x }
+\end{code}
diff --git a/ghc/tests/programs/cvh_unboxing/Makefile b/ghc/tests/programs/cvh_unboxing/Makefile
new file mode 100644 (file)
index 0000000..5b9af21
--- /dev/null
@@ -0,0 +1,9 @@
+TOP = ../..
+include $(TOP)/mk/boilerplate.mk
+
+SRC_HC_OPTS += -fglasgow-exts
+
+all :: runtest
+
+include $(TOP)/mk/target.mk
+
diff --git a/ghc/tests/programs/cvh_unboxing/README b/ghc/tests/programs/cvh_unboxing/README
new file mode 100644 (file)
index 0000000..e80b542
--- /dev/null
@@ -0,0 +1,4 @@
+
+These files should typecheck and compile, but while they do
+typecheck, they don't assemble without warnings, and when executed,
+generate an illegal instruction.
diff --git a/ghc/tests/programs/cvh_unboxing/Types.lhs b/ghc/tests/programs/cvh_unboxing/Types.lhs
new file mode 100644 (file)
index 0000000..c1e2848
--- /dev/null
@@ -0,0 +1,60 @@
+\section{IDS types}
+
+\begin{code}
+module Types where
+import PrelBase
+
+data F a = FN | F1 a | F2 a a | F3 a a a 
+         | F4 a a a a 
+         | F5 a a a a a (F a) 
+
+data FI = FIN | FI1 Int# | FI2 Int# Int# | FI3 Int# Int# Int# 
+        | FI4 Int# Int# Int# Int# 
+        | FI5 Int# Int# Int# Int# Int# FI
+
+data FC = FCN | FC1 Char# | FC2 Char# Char# 
+        | FC3 Char# Char# Char# 
+        | FC4 Char# Char# Char# Char# 
+        | FC5 Char# Char# Char# Char# Char# FC
+\end{code}
+
+\begin{code}
+data F2 a b = F2N | F21 a b | F22 a b a b | F23 a b a b a b 
+            | F24 a b a b a b a b 
+            | F25 a b a b a b a b a b (F2 a b) 
+
+data F3 a b c = F3N | F31 a b c | F32 a b c a b c 
+              | F33 a b c a b c a b c
+              | F34 a b c a b c a b c a b c
+              | F35 a b c a b c a b c a b c a b c (F3 a b c) 
+
+data F3I = F3IN 
+         | F3I1 Int# Int# Int# 
+         | F3I2 Int# Int# Int# Int# Int# Int# 
+         | F3I3 Int# Int# Int# Int# Int# Int# Int# Int# Int#
+         | F3I4 Int# Int# Int# Int# Int# Int# Int# Int# Int# 
+                Int# Int# Int#
+         | F3I5 Int# Int# Int# Int# Int# Int# Int# Int# Int# 
+                Int# Int# Int# Int# Int# Int# F3I
+\end{code}
+
+\begin{code}
+data S a = SN | S1 a (S a) | S2 a a (S a) | S3 a a a (S a)
+         | S4 a a a a (S a)
+         | S5 a a a a a (S a) 
+
+data SI = SIN | SI1 Int# SI | SI2 Int# Int# SI 
+        | SI3 Int# Int# Int# SI
+        | SI4 Int# Int# Int# Int# SI
+        | SI5 Int# Int# Int# Int# Int# SI
+
+
+data SC = SCN | SC1 Char# SC | SC2 Char# Char# SC 
+        | SC3 Char# Char# Char# SC
+        | SC4 Char# Char# Char# Char# SC
+        | SC5 Char# Char# Char# Char# Char# SC
+\end{code}
+
+
+
+
diff --git a/ghc/tests/programs/cvh_unboxing/cvh_unboxing.stdout b/ghc/tests/programs/cvh_unboxing/cvh_unboxing.stdout
new file mode 100644 (file)
index 0000000..742e221
--- /dev/null
@@ -0,0 +1 @@
+"aa"
\ No newline at end of file
diff --git a/ghc/tests/programs/dmgob_native1/BugReport b/ghc/tests/programs/dmgob_native1/BugReport
new file mode 100644 (file)
index 0000000..e055d39
--- /dev/null
@@ -0,0 +1,66 @@
+Hi,
+
+-- The Good News --
+
+I was able to compile my suite of programs for training phonetic
+hidden Markov models for speech recognizers using ghc.  The first
+program in the suite produced the same output as hbc, but with a
+reduction in run time of 35%.  Yeah!!
+
+
+-- The Bad News --
+
+The second program in the suite, the one that runs for 21 hours on an
+unloaded Sparc 10 (compiled with hbc -O) doesn't work.
+
+There appears to be a bug somewhere in your code for reading "Native"
+binary data.  I don't know what the source of the error is, but here
+is a simpler program that shows the problem.  I am sending you a C
+program for generating a binary test data file (called "test_data")
+and a Haskell program to read it and display the contents.  Here are
+the steps:
+
+% make
+
+% generate_vectors
+
+% ReadNative test_data
+
+
+If you look at the code for generate_vectors, it will be obvious that
+the program ReadNative is NOT reading the vectors properly :-( You can
+do
+
+        % od -fv test_data
+
+to look at the vector components, and 
+
+        % od -fd test_data
+
+to see the dimensions.  If you do, you'll notice that the output of
+ReadNative makes it look like there's an offset of 8 bytes.
+
+
+-- An observation --
+
+I don't know if this is the source of the error, but your definition
+of ``hasNElems'' in Native.hs has an ambiguous case:
+
+        hasNElems 0 []
+
+is assigned True by the first def and would be assigned False by the
+6th definition.  I know that the first def will be picked, but this
+overlap makes me wonder if there is a flaw in the logic that has
+something to do with the problem.
+
+
+-- The Begging --
+
+Here's hoping you can find and squash this one; if I get a 35%
+reduction on this second program, my 21 hour job will finish in less
+than 14 hours!  Until this is fixed, though, I can't even run the
+second program.
+
+Thanks, and good luck!
+
+dave goblirsch
diff --git a/ghc/tests/programs/dmgob_native1/Main.lhs b/ghc/tests/programs/dmgob_native1/Main.lhs
new file mode 100644 (file)
index 0000000..4b01cee
--- /dev/null
@@ -0,0 +1,67 @@
+
+Test program for reading a binary file containing a sequence of
+vectors of possibly different dimension.  The format of the file is 
+
+        Block size                              Data
+        --------------------------------        ---------------------
+
+        sizeof(int) bytes                       dimension of vector 1
+        sizeof(float) x dimension1 bytes        vector 1
+        sizeof(int) bytes                       dimension of vector 2
+        sizeof(float) x dimension2 bytes        vector 2
+        sizeof(int) bytes                       dimension of vector 3
+        sizeof(float) x dimension3 bytes        vector 3
+
+                :                                  :
+
+This program will print the dimension, then the vector, then a blank
+line, then the dimension of the next vector, the next vector, then a
+blank line, etc.
+
+----------------------------------------------------------------------
+
+> module Main where
+
+> import Native
+> import MaybeStateT
+> import System
+
+> main = getArgs           >>= \ args ->
+>       case args of
+>
+>       [file]  -> readFile file   >>= \ bs ->
+>                  let
+>                    vs = readVectors bs
+>                  in
+>                  putStr (display vs)
+>
+>       _       -> error " need a binary file name"
+
+
+
+> type Vector           = [Float]
+
+
+> readVectors           :: Bytes -> [Vector]
+> readVectors bs =
+>       case readVector bs of
+>       Nothing         -> []   -- assume there are no more vectors to read
+>       Just (v, bs')   -> v : readVectors bs'
+
+
+> readVector            :: MST Bytes Vector
+> readVector =
+>       readBytes                               `bindMST` \dimension ->
+>       listReadBytes dimension                 `bindMST` \v ->
+>       returnMST v
+
+
+
+> display :: [Vector] -> String
+> display (v:vs) = displayVector v ++ display vs
+> display []     = "\n"
+
+> displayVector :: Vector -> String
+> displayVector v = shows (length v) "\n" ++
+>                   shows v "\n\n"
+
diff --git a/ghc/tests/programs/dmgob_native1/Makefile b/ghc/tests/programs/dmgob_native1/Makefile
new file mode 100644 (file)
index 0000000..fc4b455
--- /dev/null
@@ -0,0 +1,10 @@
+TOP = ../..
+include $(TOP)/mk/boilerplate.mk
+
+SRC_RUNTEST_OPTS += test_data 
+SRC_HC_OPTS += -cpp -syslib hbc
+
+all :: runtest
+
+include $(TOP)/mk/target.mk
+
diff --git a/ghc/tests/programs/dmgob_native1/MaybeStateT.lhs b/ghc/tests/programs/dmgob_native1/MaybeStateT.lhs
new file mode 100644 (file)
index 0000000..aa75bd9
--- /dev/null
@@ -0,0 +1,27 @@
+        This module implements the ``State Transformer''
+monad coupled with the ``Maybe'' monad, where the ``Maybe'' type is
+wrapped around the pair containing the return value and the state.
+        \begin{haskell}{MaybeStateT}
+
+> module MaybeStateT(
+>#ifndef __GLASGOW_HASKELL__
+>       Maybe..,
+>#endif
+>       MST(..),
+>       returnMST,
+>       bindMST
+>       ) where
+
+>#ifndef __GLASGOW_HASKELL__
+> import Maybe
+>#endif
+
+> type MST s a  =  s -> Maybe (a, s)
+
+> returnMST     :: a -> MST s a
+> returnMST x   = \s -> Just (x, s)
+
+> bindMST       :: MST s a -> (a -> MST s b) -> MST s b
+> bindMST m k s =  m s >>= \(x, s') -> k x s'
+
+\end{haskell}
diff --git a/ghc/tests/programs/dmgob_native1/dmgob_native1.stdout b/ghc/tests/programs/dmgob_native1/dmgob_native1.stdout
new file mode 100644 (file)
index 0000000..5b4a0bc
--- /dev/null
@@ -0,0 +1,10 @@
+3
+[1.00000000, 2.00000000, 3.00000000]
+
+2
+[1.00000000, 2.00000000]
+
+4
+[1.00000000, 2.00000000, 3.00000000, 4.00000000]
+
+
diff --git a/ghc/tests/programs/dmgob_native1/generate_vectors.c b/ghc/tests/programs/dmgob_native1/generate_vectors.c
new file mode 100644 (file)
index 0000000..f4ca8d0
--- /dev/null
@@ -0,0 +1,42 @@
+#include <stdio.h>
+
+int main ( )
+{
+  FILE *ptr_output_file;
+
+  int dim;
+  float x[10];
+
+
+  ptr_output_file = fopen("test_data", "wb");
+  if ( ptr_output_file == (FILE *) NULL ) {
+    fprintf(stderr, "Can't open file test_data\n");
+    perror("fopen");
+    exit(1);
+  }
+
+
+  dim = 3;
+  x[0] = 1.0F;
+  x[1] = 2.0F;
+  x[2] = 3.0F;
+  fwrite( &dim, sizeof(int), 1, ptr_output_file );
+  fwrite( x, sizeof(float), dim, ptr_output_file );
+
+  dim = 2;
+  x[0] = 1.0F;
+  x[1] = 2.0F;
+  fwrite( &dim, sizeof(int), 1, ptr_output_file );
+  fwrite( x, sizeof(float), dim, ptr_output_file );
+
+  dim = 4;
+  x[0] = 1.0F;
+  x[1] = 2.0F;
+  x[2] = 3.0F;
+  x[3] = 4.0F;
+  fwrite( &dim, sizeof(int), 1, ptr_output_file );
+  fwrite( x, sizeof(float), dim, ptr_output_file );
+
+  fclose( ptr_output_file );
+  return 0;
+}
diff --git a/ghc/tests/programs/dmgob_native1/test_data b/ghc/tests/programs/dmgob_native1/test_data
new file mode 100644 (file)
index 0000000..b7ec9fd
Binary files /dev/null and b/ghc/tests/programs/dmgob_native1/test_data differ
diff --git a/ghc/tests/programs/dmgob_native2/Bug_report b/ghc/tests/programs/dmgob_native2/Bug_report
new file mode 100644 (file)
index 0000000..1080ed2
--- /dev/null
@@ -0,0 +1,60 @@
+Will,
+
+There may be a subtle bug in exectuable code produced by your
+compiler. I am sending you an example program that displays wierd
+behaviour when compiled using ghc, but not when compiled using hbc.
+The results have been check by hand against a commercial C-based
+signal processing tool, and the hbc numbers agree (within numercial
+precision limitations) to the commerical package.  Most of the ghc
+numbers agree too, but some are off in a systematic way.
+
+NOTE: This program uses the Native module, so perhaps the problem lies
+there; I don't know.
+
+
+The package contains the following:
+
+1) a module LPA.lhs
+
+2) a main program  Main.lhs
+
+3) a Makefile, set up for ghc 0.19 and hbc (you can use 0.999.5 if you
+want)
+
+4) an example speech file
+
+
+To compile, edit the Makefile and comment/uncomment the definitions
+for which compiler you want to use; then type make.
+
+Run the program first for hbc:
+
+        % lpa speech speech.cep.hbc
+
+Then ``make clean'', edit the Makefile, remake and run for ghc:
+
+        % lpa speech speech.cep.ghc
+
+Now look at the first 10 lines of each ``cep'' file using od:
+
+        % od -fv speech.cep.hbc | head -10
+
+        % od -fv speech.cep.ghc | head -10
+
+Notice that the numbers pretty much agree, except for the 1st, the
+18th, the 35th, etc.
+
+You see, the program analyzes frames of speech 100 times per second.
+For each analysis frame, it dumps 17 floating point numbers.  Your
+program disagrees with the hbc program about the FIRST coordinate of
+each of these vectors.  I don't understand how this can happen.
+
+I'm writing an applications paper for JFP, but I can't include a
+comparison to your compiler if it produces bad numbers.  So... I know
+your busy, but could you look at this soon?
+
+Good luck!!
+
+dave g.
+
+
diff --git a/ghc/tests/programs/dmgob_native2/LPA.lhs b/ghc/tests/programs/dmgob_native2/LPA.lhs
new file mode 100644 (file)
index 0000000..26f28ee
--- /dev/null
@@ -0,0 +1,754 @@
+\begin{comment}
+
+> module LPA where
+>#ifndef __GLASGOW_HASKELL__
+> import Trace
+>#endif
+
+\end{comment}
+
+
+%----------------------------------------------------------------------
+\section {A Brief Review of Discrete-Time Signal Processing}
+%----------------------------------------------------------------------
+
+%%------------------------------------------------------------
+\subsection {Discrete-Time Signals}
+%%------------------------------------------------------------
+
+        This section only provides some background terminology;
+see~\cite{OppeScha75} or \cite{ProaMano92} for motivation and more
+details.
+
+
+        A {\em discrete-time signal\/} is simply a sequence of
+numbers.  That is, a discrete-time signal is a function whose domain
+is the set of integers and whose range is some set of numbers, e.g.,
+the real or complex numbers.  The elements of the sequence are called
+{\em samples}.  The $n$th sample of the signal $x$ is denoted by
+$x_n$.  For the rest of this paper, we will refer to discrete-time
+signals as ``signals'' or ``sequences'' interchangeably.
+
+
+        It is mathematically convenient to consider signals to be
+defined for all integers, with samples taking the value zero if not
+otherwise specified.  A signal $x$ is {\em finite-duration\/} if there
+are integers $n_1$ and $n_2$ such that $x_n = 0$ whenever $n<n_1$ or
+$n>n_2$.  A {\em right-sided sequence\/} $x$ is one for which there is
+an integer $n_1$ such that $x_n = 0$ for all $n < n_1$; if $n_1 \geq
+0$ then the signal is also said to be {\em causal}.  {\em
+Left-sided\/} and {\em two-sided\/} sequences are defined similarly.
+All signals in this paper are assumed to be causal with $n_1 = 0$.
+
+
+        Since signals are sequences of numbers, they are naturally
+represented in Haskell using lists, particularly since we are assuming
+causal signals indexed from zero and Haskell lists are indexed from
+zero.
+
+
+        We will often use the notation $x^n_k$ to denote the list of
+samples $[x_k,x_{k+1},\ldots,x_n]$ of the signal $x$.  If $x$ is
+potentially infinite in duration or if knowing its duration is not
+important, we will replace $n$ by $\infty$.  For a causal signal, this
+convention means that $x^\infty_0$ represents the entire signal.
+
+
+        For convenience, we introduce the following type synonym:
+        \begin{verbatim}
+
+> type Signal a = [a]
+
+\end{verbatim}
+        The element type is unspecified because signals can be
+sequences of integers, floating point numbers, or complex numbers.
+Thus, \verb~Signal Int~ represents a signal whose samples are
+finite-precision integers, \verb~Signal Float~ represents a signal
+whose samples are floating point numbers, etc.
+
+
+%%------------------------------------------------------------
+\subsection {The $Z$ Transform}
+%%------------------------------------------------------------
+
+        Given a signal $x$, the {\em Z transform\/} of $x$ is the
+complex-valued function $X(z)$ of the complex variable $z$ defined by
+        \begin{equation}
+        X(z) \isDefined \sum_{k=-\infty}^\infty x_k z^{-k}
+        \label{eq:Z-transform}
+        \end{equation}
+        for all $z$ for which the power series converges.  If the
+signal $x$ has $Z$ transform $X(z)$, we will write
+        \[
+        x \transformPair X(z)
+        \]
+        The $Z$ transform is useful because it allows us to study
+discrete-time systems (Section~\ref{sc:discrete-time-systems}) using
+algebraic manipulations.  This is because the $Z$ transform has a
+number of useful properties, only three of which are needed here.
+        \begin{enumerate}
+
+        \item {\em scaling}
+
+        If we multiply each sample of the signal $x$ by a scalar $a$
+and call the resulting sequence $y$, then
+        \[
+        y \transformPair Y(z) = aX(z) \transformPair map\ (a*)\ x
+        \]
+
+        \item {\em superposition}
+
+        Given two signals $x$ and $y$, if we add them
+sample-by-sample to get a new signal $w$, then
+        \[
+        w \transformPair W(z)  =  X(z) + Y(z)
+        \]
+
+        \item {\em shift}
+
+        Given a signal $x$ and an integer $k$, define the signal $y$
+by
+        \[
+        y_n = x_{n-k}
+        \]
+        we have
+        \[
+        y \transformPair Y(z) = z^{-k}X(z)
+        \]
+        
+
+        \end{enumerate}
+
+
+%%------------------------------------------------------------
+\subsection {Discrete-Time Systems}
+\label{sc:discrete-time-systems}
+%%------------------------------------------------------------
+
+        A {\em discrete-time system\/} is an operator that transforms
+an {\em input\/} signal into an {\em output\/} signal.  These systems
+are commonly called {\em filters\/} when their function is to suppress
+or enhance some feature of the input signal.  In Section~\ref{sc:fir}
+we will define a function for performing a particular type of
+filtering.
+        \begin{verbatim}
+
+> type Filter a = Signal a -> Signal a
+
+\end{verbatim}
+
+
+%%------------------------------------------------------------
+\subsection {Finite Impulse Response Filtering}
+\label{sc:fir}
+%%------------------------------------------------------------
+
+        A (causal) {\em finite impulse response\/} (FIR) filter is
+characterized by a finite-duration signal $h$ called the {\em impulse
+response\/} of the filter.  For an arbitrary input signal $x$, the
+samples of the output signal $y$ are defined by the {\em convolution
+sum\/}
+        \begin{equation}
+        y_n = \sum^{M-1}_{k=0} h_k x_{n-k}
+        \label{eq:convolution}
+        \end{equation}
+        where $M$ is the length of $h$. We will use FIR filtering
+twice, once in the definition of the function \verb~preemph~ in
+Section~\ref{sc:preemph} and again in the definition of the function
+\verb~cepstra~ in Section~\ref{sc:cepstra}.  Hence we need to define a
+Haskell function that implements FIR filtering.  In doing so, we will
+demonstrate how it is often possible to derive an executable
+definition from a mathematical specification.
+
+
+        $Z$ transforms can be used to express the filtering operation.
+Suppose signals $x$, $h$, and $y$ are related by
+(\ref{eq:convolution}).  Denoting the $Z$ transforms of these signals
+by $X(z), Y(z)$, and $H(z)$, respectively, it is easy to show that
+        \begin{equation}
+        Y(z) = H(z)X(z)
+        \end{equation}
+        We now derive a Haskell function for performing FIR filtering.
+        \begin{eqnarray*}
+        Y(z) & = & H(z)X(z) \\
+             & = & \sum^{M-1}_{k=0} h_k z^{-k} X(z)\\
+             & = & \sum^{M-1}_{k=0} z^{-k} (h_kX(z)) \\
+             & = & \sum^{M-1}_{k=0} z^{-k} W^{(k)}(z)
+        \end{eqnarray*}
+        where we have set $W^{(k)}(z) = h_kX(z)$.  Using Horner's rule,
+        \begin{eqnarray*}
+        Y(z) & = & W^{(0)}(z)\ +\ z^{-1}(W^{(1)}(z)
+                               +\ z^{-1}(W^{(2)}(z) 
+                               +\ \ldots \nonumber \\
+             &   & \hspace{1.2in}
+                               +\ z^{-1}(W^{(M-2)}(z)
+                               +\ z^{-1} W^{(M-1)}(z)) \ldots\ ))
+        \end{eqnarray*}
+        %
+        %
+        Defining the transform relationships $w^{(k)} \transformPair
+W^{(k)}(z)$, we get
+        \begin{equation}
+        y  =  w^{(0)} \oplus (w^{(1)} \oplus (w^{(2)} \oplus \ldots
+                   \oplus (w^{(M-2)} \oplus w^{(M-1)}) \ldots\ ))
+        \label{eq:ws}
+        \end{equation}
+        where the operator $\oplus$ is such that, for two arbitrary
+signals $u$ and $v$ having $Z$ transforms $U(z)$ and $V(z)$ we have
+        \[
+        u \oplus v \ \transformPair\  U(z) + z^{-1}V(z).
+        \]
+        From the superposition and shift properties of the $Z$
+transform, it is clear that the operator $\oplus$ is implemented by
+delaying the second operand by one sample and then performing
+sample-by-sample addition.  Let's call this operation
+``\verb~delayAdd~'':
+        \begin{verbatim}
+
+> delayAdd :: (Num a) => Signal a -> Signal a -> Signal a
+> (x:rxs) `delayAdd` y  = x : combine rxs y
+> []      `delayAdd` y  = 0 : y
+
+\end{verbatim}
+        (The second equation treats the empty list as the all-zero
+signal.)  This definition uses a function \verb~combine~ which is
+similar to the Standard Prelude function \verb~zipWith~, except that
+\verb~combine~ returns a list as long as the {\em longer\/} of the two
+lists, with the ``missing'' values from the shorter list assumed to be
+zero.
+        \begin{verbatim}
+
+> combine :: (Num a) => Signal a -> Signal a -> Signal a
+> combine (x:rxs) (y:rys) = x+y : combine rxs rys
+> combine  []       ys    = ys
+> combine  xs       []    = xs
+
+\end{verbatim}
+
+
+        Now we observe that (\ref{eq:ws}) can be rewritten using
+$foldr1$:
+        \begin{eqnarray*}
+         y    & = & foldr1\ \ (\oplus)\ \ [\: w^{(0)},\ 
+                                 w^{(1)},\ \ldots,\ w^{(M-1)} \:] \\
+              & = & foldr1\ \ (\oplus)\ \ [\: map\ \ (h_k *)\ \ x \:|\:
+                                           k \leftarrow [0..M-1] \:]
+        \end{eqnarray*}
+
+
+        Thus, we can implement an FIR filter having impulse response
+\verb~hs~ on an input signal \verb~x~ as follows:\footnote{My thanks
+to Mark Jones of Yale University who first suggested this form of the
+definition.}
+        \begin{verbatim}
+
+> fir :: Signal Float -> Filter Float
+> fir hs x = foldr1 delayAdd [map (h*) x | h <- hs]
+
+\end{verbatim}
+
+
+%----------------------------------------------------------------------
+\section {Linear Predictive Analysis}
+%----------------------------------------------------------------------
+
+        The processor described here is rather conventional; we just
+implement most of the blocks described in~\cite[pp.\ 
+112--117]{RabiJuan93}.
+
+
+%--------------------------------------------------
+\subsection {Preemphasis}
+\label{sc:preemph}
+%--------------------------------------------------
+
+        The speech signal is first passed through a simple high-pass
+filter to reduce the degree of spectral tilt.  The system
+function is
+        \[
+        P(z) = 1 - a z^{-1}
+        \]
+        where $a$ is a real number less than but close to 1; a typical
+value is 0.95.  Hence, the preemphasis filter is an FIR filter with
+the impulse response $[1,\ -a\ ]$.
+        \begin{verbatim}
+
+> preemph :: Float -> Filter Float
+> preemph a =  fir [1,-a]
+
+\end{verbatim}
+
+
+%--------------------------------------------------
+\subsection {Framing}
+%--------------------------------------------------
+
+        Because of the time-varying nature of speech, the signal is
+broken into a list of equal-length {\em frames}, each offset from its
+predecessor by a fixed number of samples.  Typically, the frame length
+is about $20$ ms and the offset is about $10$ ms.  We need a function
+\verb~frames~ that takes three arguments: a frame length, an offset,
+and the signal.  We can derive the definition of \verb~frames~ as
+follows:
+        \begin{eqnarray*}
+      frames\ n\ m\ x^\infty_0
+      & = & [
+          x_0^{n-1},\;  
+          x_m^{m+n-1},\;   
+          x_{2m}^{2m+n-1},\   
+          \ldots\ ] \\
+      & = & map\ (take\ n)\ 
+          [
+          x_0^\infty,\;
+          x_m^\infty,\;
+          x_{2m}^\infty,\;
+          \ldots\ ] \\ 
+      & = & map\ (take\ n)\ (iterate\ (drop\ m)\ x_0^\infty).
+\end{eqnarray*}
+and thus
+        \begin{equation}
+        frame\ n\ m\ = map\ (take\ n)\ \circ\ iterate\ (drop\ m)
+        \end{equation}
+        But the signal may be finite, so we define and use a function
+\verb~check_for_end~ to avoid processing an infinite stream of empty
+lists.
+        \begin{verbatim}
+
+> type Frame a =  [a]
+> frames      :: Int -> Int -> Signal a -> [Frame a]
+> frames n m  =  check_for_end . map (take n) . iterate (drop m)
+
+\end{verbatim}
+        Here is the definition of \verb~check_for_end~:
+        \begin{verbatim}
+
+> check_for_end = takeWhile (not . null)
+
+\end{verbatim}
+
+
+%--------------------------------------------------
+\subsection {Windowing}
+%--------------------------------------------------
+
+        A {\em window\/} is used to smoothly attenuate samples at the
+edges of a frame prior to analysis.  A window is applied by
+sample-by-sample multiplication. It is tempting to define the
+windowing operation using the Standard Prelude function
+\verb~zipWith~, however, we don't want to analyze a frame of data that
+is too short, as would happen if the length of the entire signal
+exceeded that of an integral number of frames by only a few samples.
+Hence we define the function \verb~window~ using a utility function
+\verb~window'~ that makes sure that the segment being windowed is at
+least as long as the window itself; otherwise an empty frame is
+returned.  Note that \verb~window'~ is not a stream function; the
+output list is accumulated in the third argument so that it can be
+forgotten if the signal turns out to be shorter than the window.
+        \begin{verbatim}
+
+> type Window = [Float]
+
+> window      :: Window -> Signal Float -> Frame Float
+> window w x  =  window' w x []
+
+> window' (w:rws) (x:rxs) buf = window' rws rxs (w*x : buf)
+> window' (_:_)    []     _   = []
+> window'  []      _      buf = buf
+
+\end{verbatim}
+
+
+        A popular window is the {\em Hamming window}.  If the window
+is to have $N$ samples, the formula for the $n$th sample is:
+        \[
+        w(n) = 0.54 - 0.46 \cos( \frac{2\pi}{N-1} n )
+        \]
+        Here is the function for building a Hamming window of \verb~n~
+samples:
+        \begin{verbatim}
+
+> hamming_window :: Int -> Window
+> hamming_window npts =
+>       let angle = (2*pi)/fromInt (npts-1)
+>       in  [0.54 - 0.46*cos (angle*fromInt n) | n <- [0..npts-1]]
+
+\end{verbatim}
+
+
+        One advantage of lazy evaluation is that by defining the
+windowing function the way we have we can do the windowing and the
+framing simultaneously. Thus, it turns out that we don't need the
+function \verb~frames~.  Let the first argument be the window width
+and the second argument be the offset between frames.
+        \begin{verbatim}
+
+> windows :: Int -> Int -> Signal Float -> [Frame Float]
+> windows n m =
+>       let
+>         hw           = hamming_window n
+>         apply_window = window hw
+>       in 
+>         check_for_end . map apply_window . iterate (drop m)
+
+\end{verbatim}
+
+
+%--------------------------------------------------
+\subsection {The Autocorrelation Sequence}
+%--------------------------------------------------
+
+        The function \verb~autocorr~ computes the autocorrelation
+sequence for the signal $x$ as a prelude to computing the coefficients
+of the optimal $p$th-order linear prediction filter
+(Section~\ref{sc:Durbin}). The $i$th sample of the autocorrelation
+sequence for an $N$-point signal is defined by the equation
+        \[
+        r_i = \left\{
+              \begin{array}{ll}
+              \sum^{N-1-i}_{n=0} x_n x_{n+i} & 0 \leq i < N \\
+               0                             & i \geq N
+              \end{array}
+              \right.
+        \]
+        The summation operation is just the familiar dot product of
+linear algebra.  The dot product can be coded in Haskell as follows:
+        \begin{verbatim}
+
+> x `dot` y = sum (zipWith (*) x y)
+
+\end{verbatim}
+        However, the operator \verb~`dot`~ is actually more general
+than the familiar dot product because the two argument lists can have
+different length; the longer list is essentially truncated to the
+length of the shorter list.  For derivation purposes, let `$\odot$'
+denote this more general operation, and let `$\cdot$' denote the
+standard dot product.  In general,
+        \[
+        x^n_0 \cdot y^n_0 = x_0^{n+k} \odot y^n_0 =
+        x^n_0 \odot y^{n+k}_0
+        \]
+        for all $k \geq 0$, whereas $x^{n+k}_0 \cdot y^n_0$ would be
+undefined.  We can now formally derive the Haskell function for
+computing the non-zero portion of the autocorrelation sequence as
+follows:
+        \begin{eqnarray*}
+        [r_0,\ r_1,\ \ldots,\ r_{N-1} ]
+        & = & [ \sum^{N-1-i}_{n=0} x_n x_{n+i} \ |\ i \leftarrow [0..N-1]\:]\\
+        & = & [ x^{N-1-i}_0 \cdot x^{N-1}_i    \ |\ i \leftarrow [0..N-1]\:]\\
+        & = & [ x^{N-1}_0 \odot x^{N-1}_i      \ |\ i \leftarrow [0..N-1]\:]\\
+        & = & map\ \ (x^{N-1}_0\ \odot)\ \ [ x^{N-1}_i \ |\ i \leftarrow
+                                                         [0..N-1]\:]\\
+        & = & map\ \ (x^{N-1}_0\ \odot)\ \ (tails\ x^{N-1}_0)
+        \end{eqnarray*}
+        where the function $tails$ is such that
+        \[
+        tails\ x^N_0 = [\ x^N_0,\ x^N_1,\ x^N_2,\ \ldots,\ x^N_N\ ]
+        \]
+        To get the complete autocorrelation sequence, we just append
+an infinite list of zeros:
+        \begin{verbatim}
+
+> autocorr x = map (x `dot`) (tails x) ++ repeat 0.0
+
+\end{verbatim}
+        The function \verb~tails~ is defined as follows:\footnote{This
+function is also provided in the Chalmer's hbc library module {tt
+ListUtil}.}
+        \begin{verbatim}
+
+> tails xs@(_:rxs) | null rxs   = [xs]
+>                  | otherwise  = xs : tails rxs
+
+\end{verbatim}
+
+
+        In a conventional imperative language we would need to pass
+{\em two\/} arguments to this function, one specifying how many
+autocorrelation values are to be computed.  The function would then
+return an array containing precisely that many values.  However, in a
+lazy language the autocorrelation values will only be computed as
+needed, so we do not need to specify such a value for this function.
+
+
+        The value $r_0$ is the {\em energy} of the signal.  The
+logarithm of the energy is often included as a parameter in feature
+vectors used in recognizers.
+
+
+%--------------------------------------------------
+\subsection {The Durbin Algorithm}
+\label{sc:Durbin}
+%--------------------------------------------------
+
+        The next step is to solve for the optimum linear predictor
+filter coefficients for a given order $p$.  This can be done
+efficiently using the {\em Durbin Algorithm}.  The steps are listed in
+Figure~\ref{fg:durbin} as they appear in~\cite[p.\ 411]{RabiScha78}
+but with a few changes in notation.  Basically, we successively
+compute the optimum prediction filters for each order $i$ starting
+with $i=1$.  The optimum $i$th-order filter coefficients, $a^{(i)} =
+[a^{(i)}_1,\ldots,a^{(i)}_i]$, are calculated from the optimum
+$(i-1)$th-order filter coefficients, $a^{(i-1)} = [
+a^{(i-1)}_1,\ldots, a^{(i-1)}_{i-1}]$, the mean squared error of that
+filter, $e_{i-1}$, the autocorrelation value $r_i$, and the
+autocorrelation values $r_1, r_2,\ldots, r_{i-1}$.
+        \begin{figure}
+        \fbox{
+        \begin{tabular}{cl}
+Initialization: & $e_0 = r_0$ \\[0.10in]
+%
+%  Durbin algorithm
+%
+\shortstack{ Iteration: \\ $(i=1,2,\ldots,p)$} &
+   \begin{minipage}{2.850in}
+        \begin{eqnarray*}
+%
+      k_i & = & \left( r_i - \sum^{i-1}_{j=1} a_j^{(i-1)} r_{i-j}
+                \right) \left/ \: e_{i-1} \right. \\
+%
+      a_j^{(i)} & = & \left\{ \begin{array}{ll}
+                              a_j^{(i-1)} - k_i a_{i-j}^{(i-1)}, &
+                                    j = 1, \ldots, i-1 \\
+                              k_i, & j=i
+                             \end{array}
+                       \right.\\
+%
+      e_i   & = & (1 - k_i^2) e_{i-1}
+%
+        \end{eqnarray*}
+   \end{minipage}
+%
+\end{tabular}
+  }
+\caption[]{The Durbin Algorithm.}
+\label{fg:durbin}
+\end{figure}
+
+
+        This description can be straightforwardly realized in a
+conventional language using arrays; we will implement the algorithm in
+Haskell without using arrays.
+        \begin{verbatim}
+
+> type LPA_Filter = (Float, [Float])
+
+\end{verbatim}
+
+
+%%------------------------------------------------------------
+        \subsubsection {Updating the Predictor Polynomial}
+%%------------------------------------------------------------
+
+        First, we derive a function \verb~new_as~ that takes the
+optimal $(i-1)$th-order linear prediction filter coefficients and the
+$i$th reflection coefficient and returns the optimal $i$th-order
+linear prediction filter coefficients.  From Figure~\ref{fg:durbin},
+the optimal $i$th-order linear prediction filter is given by
+        \begin{eqnarray*}
+        a^{(i)} & \isDefined &
+                      [ a^{(i)}_1,\ a^{(i)}_2,\ \ldots,\ a^{(i)}_i ] \\
+                & = & [ a^{(i-1)}_1 - k_i a^{(i-1)}_{i-1},\ \ 
+                        a^{(i-1)}_2 - k_i a^{(i-1)}_{i-2},\ \ 
+                        \ldots,\ \ 
+                        a^{(i-1)}_{i-1} - k_i a^{(i-1)}_1,\ \ 
+                        k_i ]
+        \end{eqnarray*}
+        Note that the subtraction operation involves the first and
+last coefficients, the second and second-to-last coefficients, etc.
+If we place two copies of $a^{(i-1)}$ side by side,
+        \[
+        [ a^{(i-1)}_1,\ a^{(i-1)}_2,\ \ldots,\ 
+          a^{(i-1)}_{i-2},\ a^{(i-1)}_{i-1} ]\ \ \  
+        [ a^{(i-1)}_1,\ a^{(i-1)}_2,\ \ldots,\   
+          a^{(i-1)}_{i-2},\ a^{(i-1)}_{i-1} ]
+        \]
+        it is easy to see that what is called for is some type
+of \verb~foldr~ operation that consumes the list on the right as it
+moves through the list on the left.  Indeed, if we define the binary
+operator $\oplus$ by (assuming that $k_i$ is in scope)
+        \begin{equation}
+        a \oplus (p,\ b:bs)  =  ((a-k_i*b):p,\ bs)
+        \label{eq:oplus}
+        \end{equation}
+        then we have
+        \begin{equation}
+        a^{(i)} = fst\ \ (foldr\ \ (\oplus)\ \ ([k_i], a^{(i-1)})\ \ 
+                        a^{(i-1)})
+        \label{eq:new-as}
+        \end{equation}
+        Combining (\ref{eq:oplus}) and (\ref{eq:new-as}) into a
+Haskell definition:
+        \begin{verbatim}
+
+> new_as as k = fst (foldr op ([k],as) as)
+>               where  a `op` (p,b:bs) = ((a-k*b):p,bs)
+
+\end{verbatim}
+
+
+%%------------------------------------------------------------
+        \subsubsection {Computing the Reflection Coefficient}
+%%------------------------------------------------------------
+
+        Next we consider the calculation of the $i$th reflection
+coefficient.  Ignoring the division by $e_{i-1}$ for the moment,
+consider just the expression
+        \begin{equation}
+        r_i - \sum^{i-1}_{j=1} a^{(i-1)}_j r_{i-j}
+        \label{eq:k-numerator}
+        \end{equation}
+        For the summation term we can use the same approach we used
+for calculating the new prediction filter coefficients: a
+\verb~foldr~ operation that consumes one list while moving through
+another.  Defining the binary operator $\otimes$ by
+        \begin{equation}
+        a \otimes (s,\ b:bs) = (s + a*b,\ bs)
+        \label{eq:otimes}
+        \end{equation}
+        the summation is the first component of the pair returned by
+the expression
+        \begin{equation}
+        foldr\ \ (\otimes)\ \ (0,rs)\ \ as
+        \label{eq:k-summation}
+        \end{equation}
+        where it is assumed that the length of $rs$ is at least as
+great as that of $as$ (it is in practice).  The second component of
+the pair returned by (\ref{eq:k-summation}) is a list having $r_i$ as
+its head, which, as we see from (\ref{eq:k-numerator}), is what we are
+subtracting the summation from.  Combining (\ref{eq:otimes}) and
+(\ref{eq:k-summation}) with the division by $e_{i-1}$ yields the
+following definition.
+        \begin{verbatim}
+
+> new_k rs (e,as) =
+>       let (summation,r:_) = foldr op (0,rs) as
+>                             where  a `op` (s,b:bs) = (s+a*b,bs)
+>       in (r - summation)/e
+
+\end{verbatim}
+
+
+%%------------------------------------------------------------
+        \subsubsection {One Step in the Durbin Algorithm}
+%%------------------------------------------------------------
+
+        We can now define the function that produces the optimal
+$i$th-order linear prediction filter from the autocorrelation sequence
+and the optimal $(i-1)$th-order filter.
+        \begin{verbatim}
+
+> durbin_step rs (e,as) = let k = new_k rs (e,as)
+>                         in  ((1-k*k)*e, new_as as k)
+
+\end{verbatim}
+
+
+%%------------------------------------------------------------
+        \subsubsection {The Durbin Algorithm}
+%%------------------------------------------------------------
+
+        To get the optimal $p$th-order linear predictor given the
+autocorrelation sequence, we just iteratively apply the function
+\verb~durbin_step~ to the appropriate initial condition and select the
+$p$th element of the resulting sequence.  If $(r : rrs)$ is the
+autocorrelation sequence for a frame, then the expression
+        \[
+        iterate\ \ (durbin\_step\ rrs)\ \ (r,[\ ])
+        \]
+        produces the list
+        \[
+        [\: (e_0,[\ ]),\ (e_1,a^{(1)}),\ (e_2,a^{(2)}),\ \ldots \:]
+        \]
+from which we want the element at position $p$.
+        \begin{verbatim}
+
+> durbin :: Int -> Signal Float -> LPA_Filter
+> durbin p (r:rrs) = (iterate (durbin_step rrs) (r,[]))!!p
+
+\end{verbatim}
+
+
+%%------------------------------------------------------------
+\subsection {Conversion to Cepstral Coefficients}
+\label{sc:cepstra}
+%%------------------------------------------------------------
+
+        Given a discrete-time linear system with the system function
+        \[
+        \frac{G}{1 - \sum^p_{i=1} a_i z^{-i}}
+        \]
+        the sequence of {\em cepstral coefficients\/} $c^\infty_0$ for
+this system is defined by
+        \begin{equation}
+        c_n = \left\{
+              \begin{array}{ll}
+              \ln G     & n=0 \\[0.10in]
+              a_n + \frac{1}{n} \sum^{n-1}_{k=1} a_k \cdot (n-k)
+                                                     \cdot c_{n-k} &
+                        1 \leq n \leq p \\[0.10in]
+        \frac{1}{n} \sum^p_{k=1} a_k \cdot (n-k) \cdot c_{n-k} & n > p
+                \end{array}
+              \right.
+        \label{eq:cepstra}
+        \end{equation}
+        Note that the summation terms of (\ref{eq:cepstra}) are just
+convolution sums for the FIR filter with $a^{(p)}$ as its impulse
+response and the scaled cepstral coefficient signal $[c_1, 2c_2, 3c_3,
+4c_4, \ldots]$.  Also, the second and third formulas are the same
+except for the adding of the $a_i$'s to the scaled and filtered
+cepstral coefficients.  Hence, we can use the function \verb~delayAdd~
+that we defined when developing the FIR filtering function \verb~fir~
+(Section~\ref{sc:fir}).  Also, the gain term is usually ignored in
+forming the feature vector, so we just compute the sequence
+$[c_1,c_2,\ldots]$.
+        \begin{verbatim}
+
+> cepstra :: LPA_Filter -> Signal Float
+> cepstra (_,as) = cs
+>       where
+>       cs  = as `delayAdd` xs
+>       xs  = zipWith (/) (fir as (zipWith (*) [1..] cs)) [2..]
+
+\end{verbatim}
+        Because there is no terminating condition and because of the
+recursion---the sequence \verb~cs~ appears in the definition of the
+sequence \verb~xs~---this definition relies on lazy evaluation in a
+critical way.
+
+
+        \subsection {Putting it all together}
+
+        The function \verb~analyze~ transforms a windowed frame of
+samples to a pair of values, a log gain term and a list of cepstral
+coeficients.  The first argument is the order of the linear prediction
+analysis.  The second argument is the number of cepstral coefficients.
+        \begin{verbatim}
+
+> analyze :: Int -> Int -> Frame Float -> (Float, [Float])
+
+> analyze p q wxs = let
+>                     rs         = autocorr wxs
+>                     log_energy = log10 (head rs)
+>                     cep        = take q (cepstra (durbin p rs))
+>                   in
+>                     (log_energy, cep)
+
+> log10 :: Float -> Float
+> log10 x = log x / log 10
+> --log10 x = let result = log x / log 10 in
+> --  trace ("log10:"++(shows x ":")++(shows (log x) "/")++(shows (log 10) "=")++(show result)) result
+
+\end{verbatim}
+
+
+
+        \subsection {The Main Program}
+
+        Figure~\ref{fg:complete} shows the main Haskell program,
+including the speech/feature I/O functions.
+        \begin{figure}[p]
+        \input{Main.lhs}
+        \caption[]{The linear predictive speech analysis main program}
+        \label{fg:complete}
+        \end{figure}
+
diff --git a/ghc/tests/programs/dmgob_native2/Main.lhs b/ghc/tests/programs/dmgob_native2/Main.lhs
new file mode 100644 (file)
index 0000000..46239a1
--- /dev/null
@@ -0,0 +1,82 @@
+\begin{verbatim}
+
+> module Main(main) where
+
+>#ifndef __GLASGOW_HASKELL__
+> import Trace
+> import Maybe   -- an hbc library module defining the ``Maybe'' type
+>#endif
+
+> import Native  -- an hbc library module for native-mode binary IO
+
+> import LPA     -- the linear predictive analysis module
+
+
+> main = getContents   >>= \bs ->
+>        putStr (program bs)
+> {- 1.2
+> main = readChan stdin exit                            $ \bs ->
+>        appendChan stdout (program bs) exit done
+> -}
+> {- ORIGINAL: partain:
+> main = getArgs exit                                   $ \args ->
+>        case args of
+>        [file1, file2] -> readFile file1 exit          $ \bs ->
+>                          writeFile file2 (program bs) exit done
+>        _              -> error usage
+> -}
+
+> usage = "usage: lpa  <speech file>  <output file>"
+
+
+> window_width      = 384 :: Int  -- 24 ms @ 16 kHz
+> window_offset     = 160 :: Int  -- 10 ms @ 16 kHz
+> p                 =  14 :: Int  -- LP analysis order
+> q                 =  16 :: Int  -- cepstral analysis order
+
+
+> readRawSpeech :: Bytes -> Signal Int
+> readRawSpeech bs =
+>       case bytesToShortInt bs of
+>       Nothing      -> if null bs then [] else error read_error
+>       Just (v,bs') -> v : readRawSpeech bs'
+
+> read_error = "Left-over byte encountered by readRawSpeech"
+
+
+> castSignal :: Signal Int -> Signal Float
+> castSignal = map fromInt
+
+
+> program :: Bytes -> String
+> {-TEST:
+> program bs
+>  = let signal = readRawSpeech bs in
+>    -- trace (shows (take 200 signal) "\n\n") (
+>    ((foldr writesFrame []
+>         . map (analyze p q)
+>         . windows window_width window_offset
+>         . preemph 0.95
+>         . castSignal) signal)
+>    -- )
+> -}
+>
+> program = foldr writesFrame []
+>         . map (analyze p q)
+>         . windows window_width window_offset
+>         . preemph 0.95
+>         . castSignal
+>         . readRawSpeech
+
+\end{verbatim}
+
+        It only remains to define a function for writing the analysis
+parameters to a file.
+        \begin{verbatim}
+
+> writesFrame :: (Float, [Float]) -> Bytes -> Bytes
+> writesFrame (log_energy, cep) bs =
+>       showBytes log_energy (listShowBytes cep bs)
+
+\end{verbatim}
+
diff --git a/ghc/tests/programs/dmgob_native2/Makefile b/ghc/tests/programs/dmgob_native2/Makefile
new file mode 100644 (file)
index 0000000..c28f624
--- /dev/null
@@ -0,0 +1,9 @@
+TOP = ../..
+include $(TOP)/mk/boilerplate.mk
+
+SRC_HC_OPTS += -cpp -syslib hbc
+
+all :: runtest
+
+include $(TOP)/mk/target.mk
+
diff --git a/ghc/tests/programs/dmgob_native2/dmgob_native2.stdin b/ghc/tests/programs/dmgob_native2/dmgob_native2.stdin
new file mode 100644 (file)
index 0000000..572c4a1
Binary files /dev/null and b/ghc/tests/programs/dmgob_native2/dmgob_native2.stdin differ
diff --git a/ghc/tests/programs/dmgob_native2/dmgob_native2.stdout b/ghc/tests/programs/dmgob_native2/dmgob_native2.stdout
new file mode 100644 (file)
index 0000000..cd64812
Binary files /dev/null and b/ghc/tests/programs/dmgob_native2/dmgob_native2.stdout differ
diff --git a/ghc/tests/programs/dmgob_native2/dmgob_native2.stdout2 b/ghc/tests/programs/dmgob_native2/dmgob_native2.stdout2
new file mode 100644 (file)
index 0000000..97729b0
Binary files /dev/null and b/ghc/tests/programs/dmgob_native2/dmgob_native2.stdout2 differ
diff --git a/ghc/tests/programs/fast2haskell/Fast2haskell.hs b/ghc/tests/programs/fast2haskell/Fast2haskell.hs
new file mode 100644 (file)
index 0000000..dc591ba
--- /dev/null
@@ -0,0 +1,48 @@
+       module Fast2haskell (
+            Complex_type, Array_type, Assoc_type, Descr_type,
+            abortstr, delay, fix, force, iff, iffrev, seQ,
+            pair, strcmp,
+            entier,
+            land_i, lnot_i, lor_i, lshift_i, rshift_i,
+            descr,
+            destr_update, indassoc, lowbound, tabulate, upbound, update, valassoc) where {
+            import Word;
+           import Complex; -- 1.3
+           import Array; -- 1.3
+            type Complex_type   = Complex Double;
+            type Array_type b   = Array Int b;
+            type Assoc_type a   = (Int, a);
+            type Descr_type     = (Int,Int);
+            abortstr      str                 = error ("abort:"++str); -- abort (OtherError str);
+            delay         x                   = abortstr "delay not implemented";
+            fix           f                   = fix_f where {fix_f = f fix_f};
+            force         x                   = x; -- error  "force not implemented";
+            iff           b     x  y          = if b then x else y;
+            iffrev        y  x      b         = if b then x else y;
+            seQ           x    y              = seq_const y (x{-#STRICT-});
+            seq_const     x    y              = x ;
+            pair          []                  = False;
+            pair          x                   = True;
+            strcmp        :: [Char] -> [Char] -> Bool;
+            strcmp        x      y            = x == y;
+            entier        x                   = fromIntegral (floor x);
+            land_i        :: Int -> Int -> Int;
+            land_i        x    y              = wordToInt (bitAnd (fromInt x) (fromInt y));
+            lnot_i        :: Int -> Int;
+            lnot_i        x                   = wordToInt (bitCompl (fromInt x));
+            lor_i         :: Int -> Int -> Int;
+            lor_i         x    y              = wordToInt (bitOr (fromInt x) (fromInt y));
+            lshift_i      :: Int -> Int -> Int;
+            lshift_i      x    y              = wordToInt (bitLsh (fromInt x) y);
+            rshift_i      :: Int -> Int -> Int;
+            rshift_i      x    y              = wordToInt (bitRsh (fromInt x) y);
+            write         x                   = abortstr "write not implemented";
+            descr         l    u              = (l,u);
+            destr_update  ar  i  x            = ar // [(i,x)];
+            indassoc      (i,v)              = i;
+            lowbound      (l,u)               = l;
+            tabulate      f (l,u)             = listArray (l,u) [f i | i <- [l..u]];
+            upbound       (l,u)               = u;
+            update        ar i x              = ar // [(i,x)];
+            valassoc      (i,v)               = v;
+       }
diff --git a/ghc/tests/programs/fast2haskell/Main.hs b/ghc/tests/programs/fast2haskell/Main.hs
new file mode 100644 (file)
index 0000000..b0c2935
--- /dev/null
@@ -0,0 +1,296 @@
+module Main (main) -- TEST
+where {
+import Fast2haskell;
+import Complex;--1.3
+import Array;--1.3
+
+    c_eps=(5.00000e-06 :: Double);
+    c_t=True;
+    c_f=False;
+    c_input=(0 :: Int);
+    f_main a_n=
+        let { 
+            r_x=[(a_tf,(++) (show a_i) ((++) "\t" a_str))|(a_i,(a_tf,a_str))<-f_zip2 (enumFrom (1 :: Int)) c_testlist];
+            r_noks=[(++) a_str "\n"|(a_tf,a_str)<-r_x,not a_tf];
+            r_oks=[(++) a_str "\n"|(a_tf,a_str)<-r_x,a_tf]
+         } in  
+            if (((>) :: (Int -> Int -> Bool)) a_n (0 :: Int))
+            then (f_onetest ((!!) c_testlist (((-) :: (Int -> Int -> Int)) a_n (1 :: Int))))
+            else 
+                ((++) (show (length r_oks)) ((++) " tests passed and " ((++) (show 
+                (length r_noks)) ((++) " failed\n" (c_concat r_noks)))));
+    f_onetest (True,a_str)=(++) "true:  " ((++) a_str "\n");
+    f_onetest (False,a_str)=(++) "false: " ((++) a_str "\n");
+    f_booltest a_name True a_try=
+        if a_try
+        then (True,"")
+        else 
+            (False,(++) a_name "\tok: true is: false");
+    f_booltest a_name False a_try=
+        if (not a_try)
+        then (True,"")
+        else 
+            (False,(++) a_name "\tok: false is: true");
+    f_inttest a_name a_ok a_try=
+        if (((==) :: (Int -> Int -> Bool)) a_ok a_try)
+        then (True,"")
+        else 
+            (False,(++) a_name ((++) "\tok: " ((++) (show a_ok) ((++) "\tis: " 
+            (show a_try)))));
+    f_chartest a_name a_ok a_try=
+        if (((==) :: (Int -> Int -> Bool)) (fromEnum a_ok) (fromEnum a_try))
+        then (True,"")
+        else 
+            (False,(++) a_name ((++) "\tok: " ((++) ((:) a_ok []) ((++) "\tis: " 
+            ((:) a_try [])))));
+    f_strtest a_name a_ok a_try=
+        if (strcmp a_ok a_try)
+        then (True,"")
+        else 
+            (False,(++) a_name ((++) "\tok: " ((++) a_ok ((++) "\tis: " a_try))));
+    f_linttest a_name a_ok a_try=
+        if (f_lintcmp a_ok a_try)
+        then (True,"")
+        else 
+            (False,(++) a_name ((++) "\tok: " ((++) (f_showlint a_ok) ((++) "\tis: " 
+            (f_showlint a_try)))));
+    f_doubtest a_name a_ok a_try=
+        if (((<=) :: (Double -> Double -> Bool)) (f_abs (((-) :: (Double -> Double -> Double)) a_ok a_try)) c_eps)
+        then (True,"")
+        else 
+            (False,(++) a_name ((++) "\tok: " ((++) (show a_ok) ((++) "\tis: " 
+            ((++) (show a_try) ((++) "\tok-is: " (show (((-) :: (Double -> Double -> Double)) a_ok a_try))))))));
+    f_alternating a_l=(:) (0 :: Int) ((:) (1 :: Int) a_l);
+    f_showlint []=[];
+    f_showlint a_xs=tail (c_concat [(++) "," (show a_x)|a_x<-a_xs]);
+    f_lintcmp [] []=True;
+    f_lintcmp [] a_ys=False;
+    f_lintcmp a_xs []=False;
+    f_lintcmp (a_x:a_xs) (a_y:a_ys)=
+        if (((==) :: (Int -> Int -> Bool)) a_x a_y)
+        then (f_lintcmp a_xs a_ys)
+        else 
+            False;
+    c_testlist=(:) (f_inttest "array" (10 :: Int) ((!) (array (descr (1 :: Int) (3 :: Int)) ((:) 
+        ((,) (3 :: Int) (30 :: Int)) ((:) ((,) (1 :: Int) (10 :: Int)) ((:) ((,) (2 :: Int) (20 :: Int)) [])))) (1 :: Int))) ((:) (f_inttest "array" (20 :: Int) 
+        ((!) (array (descr (1 :: Int) (3 :: Int)) ((:) ((,) (3 :: Int) (30 :: Int)) ((:) ((,) (1 :: Int) (10 :: Int)) 
+        ((:) ((,) (2 :: Int) (20 :: Int)) [])))) (2 :: Int))) ((:) (f_inttest "array" (30 :: Int) ((!) (array (descr (1 :: Int) (3 :: Int)) 
+        ((:) ((,) (3 :: Int) (30 :: Int)) [])) (3 :: Int))) ((:) (f_inttest "assoc" (0 :: Int) (indassoc ((,) (0 :: Int) (1 :: Int)))) ((:) 
+        (f_inttest "assoc" (1 :: Int) (valassoc ((,) (0 :: Int) (1 :: Int)))) ((:) (f_inttest "bounds" (1 :: Int) (lowbound (bounds 
+        (listArray (descr (1 :: Int) (3 :: Int)) ((:) (1 :: Int) ((:) (2 :: Int) ((:) (3 :: Int) []))))))) ((:) (f_inttest "bounds" (3 :: Int) 
+        (upbound (bounds (listArray (descr (1 :: Int) (3 :: Int)) ((:) (1 :: Int) ((:) (2 :: Int) ((:) (3 :: Int) []))))))) 
+        ((:) (f_inttest "descr" (0 :: Int) (lowbound (descr (0 :: Int) (1 :: Int)))) ((:) (f_inttest "descr" (1 :: Int) (upbound 
+        (descr (0 :: Int) (1 :: Int)))) ((:) (f_linttest "destr_update" ((:) (1 :: Int) ((:) (0 :: Int) ((:) (3 :: Int) []))) (elems 
+        (destr_update (listArray (descr (0 :: Int) (2 :: Int)) ((:) (1 :: Int) ((:) (2 :: Int) ((:) (3 :: Int) [])))) (1 :: Int) (0 :: Int)))) ((:) 
+        (f_linttest "destr_update" ((:) (0 :: Int) []) (elems (destr_update (listArray (descr (0 :: Int) (0 :: Int)) ((:) (1 :: Int) 
+        ((:) (2 :: Int) ((:) (3 :: Int) [])))) (0 :: Int) (0 :: Int)))) ((:) (f_linttest "elems" ((:) (1 :: Int) ((:) (2 :: Int) ((:) (3 :: Int) []))) 
+        (elems (listArray (descr (0 :: Int) (2 :: Int)) ((:) (1 :: Int) ((:) (2 :: Int) ((:) (3 :: Int) [])))))) ((:) 
+        (f_linttest "elems" ((:) (1 :: Int) []) (elems (listArray (descr (0 :: Int) (0 :: Int)) ((:) (1 :: Int) ((:) (2 :: Int) 
+        ((:) (3 :: Int) [])))))) ((:) (f_inttest "indassoc" (0 :: Int) (indassoc ((,) (0 :: Int) (1 :: Int)))) ((:) (f_linttest "listarray" 
+        ((:) (1 :: Int) ((:) (2 :: Int) ((:) (3 :: Int) []))) (elems (listArray (descr (0 :: Int) (2 :: Int)) ((:) (1 :: Int) 
+        ((:) (2 :: Int) ((:) (3 :: Int) [])))))) ((:) (f_linttest "listarray" ((:) (1 :: Int) []) (elems (listArray 
+        (descr (0 :: Int) (0 :: Int)) ((:) (1 :: Int) ((:) (2 :: Int) ((:) (3 :: Int) [])))))) ((:) (f_inttest "lowbound" (0 :: Int) (lowbound 
+        (descr (0 :: Int) (1 :: Int)))) ((:) (f_inttest "subscript" (1 :: Int) ((!) (tabulate ((!!) ((:) (1 :: Int) 
+        ((:) (2 :: Int) ((:) (3 :: Int) [])))) (descr (0 :: Int) (2 :: Int))) (0 :: Int))) ((:) (f_inttest "subscript" (2 :: Int) ((!) (tabulate 
+        ((!!) ((:) (1 :: Int) ((:) (2 :: Int) ((:) (3 :: Int) [])))) (descr (0 :: Int) (2 :: Int))) (1 :: Int))) ((:) (f_inttest "subscript" (3 :: Int) 
+        ((!) (tabulate ((!!) ((:) (1 :: Int) ((:) (2 :: Int) ((:) (3 :: Int) [])))) (descr (0 :: Int) (2 :: Int))) (2 :: Int))) 
+        ((:) (f_linttest "tabulate" ((:) (1 :: Int) ((:) (2 :: Int) ((:) (3 :: Int) []))) (elems (tabulate 
+        ((!!) ((:) (1 :: Int) ((:) (2 :: Int) ((:) (3 :: Int) [])))) (descr (0 :: Int) (2 :: Int))))) ((:) (f_linttest "tabulate" 
+        ((:) (1 :: Int) []) (elems (tabulate ((!!) ((:) (1 :: Int) ((:) (2 :: Int) ((:) (3 :: Int) [])))) 
+        (descr (0 :: Int) (0 :: Int))))) ((:) (f_inttest "upbound" (1 :: Int) (upbound (descr (0 :: Int) (1 :: Int)))) ((:) (f_inttest "valassoc" (1 :: Int) 
+        (valassoc ((,) (0 :: Int) (1 :: Int)))) ((:) (f_doubtest "add_x" (0.00000 :: Double) (realPart (((+) :: (Complex_type -> Complex_type -> Complex_type)) ((:+) (0.00000 :: Double) (0.00000 :: Double)) 
+        ((:+) (0.00000 :: Double) (0.00000 :: Double))))) ((:) (f_doubtest "add_x" (0.00000 :: Double) (imagPart (((+) :: (Complex_type -> Complex_type -> Complex_type)) ((:+) (0.00000 :: Double) (0.00000 :: Double)) ((:+) (0.00000 :: Double) (0.00000 :: Double))))) 
+        ((:) (f_doubtest "add_x" (4.00000 :: Double) (realPart (((+) :: (Complex_type -> Complex_type -> Complex_type)) ((:+) (1.00000 :: Double) (2.00000 :: Double)) ((:+) (3.00000 :: Double) (4.00000 :: Double))))) ((:) 
+        (f_doubtest "add_x" (6.00000 :: Double) (imagPart (((+) :: (Complex_type -> Complex_type -> Complex_type)) ((:+) (1.00000 :: Double) (2.00000 :: Double)) ((:+) (3.00000 :: Double) (4.00000 :: Double))))) ((:) (f_doubtest "complex" (1.00000 :: Double) 
+        (realPart ((:+) (1.00000 :: Double) (0.00000 :: Double)))) ((:) (f_doubtest "complex" (1.00000 :: Double) (imagPart ((:+) (0.00000 :: Double) (1.00000 :: Double)))) ((:) 
+        (f_doubtest "complex_im" (0.00000 :: Double) (imagPart ((:+) (1.00000 :: Double) (0.00000 :: Double)))) ((:) (f_doubtest "complex_im" (1.00000 :: Double) (imagPart ((:+) (0.00000 :: Double) (1.00000 :: Double)))) 
+        ((:) (f_doubtest "complex_re" (0.00000 :: Double) (realPart ((:+) (0.00000 :: Double) (1.00000 :: Double)))) ((:) (f_doubtest "complex_re" (1.00000 :: Double) (realPart 
+        ((:+) (1.00000 :: Double) (0.00000 :: Double)))) ((:) (f_doubtest "mul_x" (0.00000 :: Double) (realPart (((*) :: (Complex_type -> Complex_type -> Complex_type)) ((:+) (0.00000 :: Double) (0.00000 :: Double)) ((:+) (0.00000 :: Double) (0.00000 :: Double))))) 
+        ((:) (f_doubtest "mul_x" (0.00000 :: Double) (imagPart (((*) :: (Complex_type -> Complex_type -> Complex_type)) ((:+) (0.00000 :: Double) (0.00000 :: Double)) ((:+) (0.00000 :: Double) (0.00000 :: Double))))) ((:) 
+        (f_doubtest "mul_x" (((negate) :: (Double -> Double)) (5.00000 :: Double)) (realPart (((*) :: (Complex_type -> Complex_type -> Complex_type)) ((:+) (1.00000 :: Double) (2.00000 :: Double)) ((:+) (3.00000 :: Double) (4.00000 :: Double))))) ((:) 
+        (f_doubtest "mul_x" (10.0000 :: Double) (imagPart (((*) :: (Complex_type -> Complex_type -> Complex_type)) ((:+) (1.00000 :: Double) (2.00000 :: Double)) ((:+) (3.00000 :: Double) (4.00000 :: Double))))) ((:) (f_doubtest "sub_x" (0.00000 :: Double) 
+        (realPart (((-) :: (Complex_type -> Complex_type -> Complex_type)) ((:+) (0.00000 :: Double) (0.00000 :: Double)) ((:+) (0.00000 :: Double) (0.00000 :: Double))))) ((:) (f_doubtest "sub_x" (0.00000 :: Double) (imagPart 
+        (((-) :: (Complex_type -> Complex_type -> Complex_type)) ((:+) (0.00000 :: Double) (0.00000 :: Double)) ((:+) (0.00000 :: Double) (0.00000 :: Double))))) ((:) (f_doubtest "sub_x" (((negate) :: (Double -> Double)) (2.00000 :: Double)) (realPart 
+        (((-) :: (Complex_type -> Complex_type -> Complex_type)) ((:+) (1.00000 :: Double) (2.00000 :: Double)) ((:+) (3.00000 :: Double) (4.00000 :: Double))))) ((:) (f_doubtest "sub_x" (((negate) :: (Double -> Double)) (2.00000 :: Double)) (imagPart 
+        (((-) :: (Complex_type -> Complex_type -> Complex_type)) ((:+) (1.00000 :: Double) (2.00000 :: Double)) ((:+) (3.00000 :: Double) (4.00000 :: Double))))) ((:) (f_inttest "seq" (2 :: Int) (seq (enumFrom (1 :: Int)) (2 :: Int))) 
+        ((:) (f_strtest "**" "this one" "should fail") [])))))))))))))))))))))))))))))))))))))))))));
+    f_abs a_x=
+        if (((<=) :: (Double -> Double -> Bool)) a_x (0.00000 :: Double))
+        then (((negate) :: (Double -> Double)) a_x)
+        else 
+            a_x;
+    c_and=f_foldr (&&) True;
+    f_cjustify a_n a_s=
+        let { 
+            r_margin=((-) :: (Int -> Int -> Int)) a_n (length a_s);
+            r_lmargin=((div) :: (Int -> Int -> Int)) r_margin (2 :: Int);
+            r_rmargin=((-) :: (Int -> Int -> Int)) r_margin r_lmargin
+         } in  (++) (f_spaces r_lmargin) ((++) a_s (f_spaces r_rmargin));
+    c_concat=f_foldr (++) [];
+    f_const a_x a_y=a_x;
+    f_digit a_x=
+        if (((<=) :: (Int -> Int -> Bool)) (fromEnum '0') (fromEnum a_x))
+        then (((<=) :: (Int -> Int -> Bool)) (fromEnum a_x) (fromEnum '9'))
+        else 
+            False;
+    f_drop 0 a_x=a_x;
+    f_drop a_n (a_a:a_x)=f_drop (((-) :: (Int -> Int -> Int)) a_n (1 :: Int)) a_x;
+    f_drop a_n a_x=[];
+    f_dropwhile a_f []=[];
+    f_dropwhile a_f (a_a:a_x)=
+        if (a_f a_a)
+        then (f_dropwhile a_f a_x)
+        else 
+            ((:) a_a a_x);
+    c_e=((exp) :: (Double -> Double)) (1.00000 :: Double);
+    f_filter a_f a_x=[a_a|a_a<-a_x,a_f a_a];
+    f_foldl a_op a_r []=a_r;
+    f_foldl a_op a_r (a_a:a_x)=
+        let { 
+            f_strict a_f a_x=seq a_x (a_f a_x)
+         } in  f_foldl a_op (f_strict a_op a_r a_a) a_x;
+    f_foldl1 a_op (a_a:a_x)=f_foldl a_op a_a a_x;
+    f_foldr a_op a_r []=a_r;
+    f_foldr a_op a_r (a_a:a_x)=a_op a_a (f_foldr a_op a_r a_x);
+    f_foldr1 a_op (a_a:[])=a_a;
+    f_foldr1 a_op (a_a:a_b:a_x)=a_op a_a (f_foldr1 a_op ((:) a_b a_x));
+    f_fst (a_a,a_b)=a_a;
+    f_id a_x=a_x;
+    f_index a_x=
+        let { 
+            f_f a_n []=[];
+            f_f a_n (a_a:a_x)=(:) a_n (f_f (((+) :: (Int -> Int -> Int)) a_n (1 :: Int)) a_x)
+         } in  f_f (0 :: Int) a_x;
+    f_init (a_a:a_x)=
+        if (null a_x)
+        then []
+        else 
+            ((:) a_a (f_init a_x));
+    f_iterate a_f a_x=(:) a_x (f_iterate a_f (a_f a_x));
+    f_last a_x=(!!) a_x (((-) :: (Int -> Int -> Int)) (length a_x) (1 :: Int));
+    f_lay []=[];
+    f_lay (a_a:a_x)=(++) a_a ((++) "\n" (f_lay a_x));
+    f_layn a_x=
+        let { 
+            f_f a_n []=[];
+            f_f a_n (a_a:a_x)=(++) (f_rjustify (4 :: Int) (show a_n)) ((++) ") " ((++) a_a ((++) "\n" 
+                (f_f (((+) :: (Int -> Int -> Int)) a_n (1 :: Int)) a_x))))
+         } in  f_f (1 :: Int) a_x;
+    f_letter a_c=
+        if (
+            if (((<=) :: (Int -> Int -> Bool)) (fromEnum 'a') (fromEnum a_c))
+            then (((<=) :: (Int -> Int -> Bool)) (fromEnum a_c) (fromEnum 'z'))
+            else 
+                False)
+        then True
+        else 
+        if (((<=) :: (Int -> Int -> Bool)) (fromEnum 'A') (fromEnum a_c))
+        then (((<=) :: (Int -> Int -> Bool)) (fromEnum a_c) (fromEnum 'Z'))
+        else 
+            False;
+    f_limit (a_a:a_b:a_x)=
+        if (((==) :: (Double -> Double -> Bool)) a_a a_b)
+        then a_a
+        else 
+            (f_limit ((:) a_b a_x));
+    f_lines []=[];
+    f_lines (a_a:a_x)=
+        let { 
+            r_xs=
+                if (pair a_x)
+                then (f_lines a_x)
+                else 
+                    ((:) [] [])
+         } in  
+            if (((==) :: (Int -> Int -> Bool)) (fromEnum a_a) (fromEnum '\o012'))
+            then ((:) [] (f_lines a_x))
+            else 
+                ((:) ((:) a_a (head r_xs)) (tail r_xs));
+    f_ljustify a_n a_s=(++) a_s (f_spaces (((-) :: (Int -> Int -> Int)) a_n (length a_s)));
+    f_map a_f a_x=[a_f a_a|a_a<-a_x];
+    f_map2 a_f a_x a_y=[a_f a_a a_b|(a_a,a_b)<-f_zip2 a_x a_y];
+    f_max a_xs=f_foldl1 f_max2 a_xs;
+    f_max2 a_a a_b=
+        if (((>=) :: (Int -> Int -> Bool)) a_a a_b)
+        then a_a
+        else 
+            a_b;
+    f_member a_x a_a=c_or (f_map (flip ((==) :: (Int -> Int -> Bool)) a_a) a_x);
+    f_merge [] a_y=a_y;
+    f_merge (a_a:a_x) []=(:) a_a a_x;
+    f_merge (a_a:a_x) (a_b:a_y)=
+        if (((<=) :: (Int -> Int -> Bool)) a_a a_b)
+        then ((:) a_a (f_merge a_x ((:) a_b a_y)))
+        else 
+            ((:) a_b (f_merge ((:) a_a a_x) a_y));
+    f_min a_xs=f_foldl1 f_min2 a_xs;
+    f_min2 a_a a_b=
+        if (((>) :: (Int -> Int -> Bool)) a_a a_b)
+        then a_b
+        else 
+            a_a;
+    f_mkset []=[];
+    f_mkset (a_a:a_x)=(:) a_a (f_filter (flip ((/=) :: (Int -> Int -> Bool)) a_a) (f_mkset a_x));
+    c_or=f_foldr (||) False;
+    c_pi=((*) :: (Double -> Double -> Double)) (4.00000 :: Double) (((atan) :: (Double -> Double)) (1.00000 :: Double));
+    f_postfix a_a a_x=(++) a_x ((:) a_a []);
+    c_product=f_foldl ((*) :: (Int -> Int -> Int)) (1 :: Int);
+    f_rep a_n a_x=f_take a_n (f_repeat a_x);
+    f_repeat a_x=(:) a_x (f_repeat a_x);
+    c_reverse=f_foldl (flip (:)) [];
+    f_rjustify a_n a_s=(++) (f_spaces (((-) :: (Int -> Int -> Int)) a_n (length a_s))) a_s;
+    f_scan a_op=
+        let { 
+            f_g a_r []=(:) a_r [];
+            f_g a_r (a_a:a_x)=(:) a_r (f_g (a_op a_r a_a) a_x)
+         } in  f_g;
+    f_snd (a_a,a_b)=a_b;
+    f_sort a_x=
+        let { 
+            r_n=length a_x;
+            r_n2=((div) :: (Int -> Int -> Int)) r_n (2 :: Int)
+         } in  
+            if (((<=) :: (Int -> Int -> Bool)) r_n (1 :: Int))
+            then a_x
+            else 
+                (f_merge (f_sort (f_take r_n2 a_x)) (f_sort (f_drop r_n2 a_x)));
+    f_spaces a_n=f_rep a_n ' ';
+    f_subtract a_x a_y=((-) :: (Int -> Int -> Int)) a_y a_x;
+    c_sum=f_foldl ((+) :: (Int -> Int -> Int)) (0 :: Int);
+data 
+    T_sys_message=F_Stdout [Char] | F_Stderr [Char] | F_Tofile [Char] [Char] | F_Closefile [Char] | F_Appendfile [Char] | F_System [Char] | F_Exit Int;
+    f_take 0 a_x=[];
+    f_take a_n (a_a:a_x)=(:) a_a (f_take (((-) :: (Int -> Int -> Int)) a_n (1 :: Int)) a_x);
+    f_take a_n a_x=[];
+    f_takewhile a_f []=[];
+    f_takewhile a_f (a_a:a_x)=
+        if (a_f a_a)
+        then ((:) a_a (f_takewhile a_f a_x))
+        else 
+            [];
+    f_transpose a_x=
+        let { 
+            r_x'=f_takewhile pair a_x
+         } in  
+            if (null r_x')
+            then []
+            else 
+                ((:) (f_map head r_x') (f_transpose (f_map tail r_x')));
+    f_until a_f a_g a_x=
+        if (a_f a_x)
+        then a_x
+        else 
+            (f_until a_f a_g (a_g a_x));
+    f_zip2 (a_a:a_x) (a_b:a_y)=(:) (a_a,a_b) (f_zip2 a_x a_y);
+    f_zip2 a_x a_y=[];
+    f_zip3 (a_a:a_x) (a_b:a_y) (a_c:a_z)=(:) (a_a,a_b,a_c) (f_zip3 a_x a_y a_z);
+    f_zip3 a_x a_y a_z=[];
+    f_zip4 (a_a:a_w) (a_b:a_x) (a_c:a_y) (a_d:a_z)=(:) (a_a,a_b,a_c,a_d) (f_zip4 a_w a_x a_y a_z);
+    f_zip4 a_w a_x a_y a_z=[];
+    f_zip5 (a_a:a_v) (a_b:a_w) (a_c:a_x) (a_d:a_y) (a_e:a_z)=(:) (a_a,a_b,a_c,a_d,a_e) (f_zip5 a_v a_w a_x a_y a_z);
+    f_zip5 a_v a_w a_x a_y a_z=[];
+    f_zip6 (a_a:a_u) (a_b:a_v) (a_c:a_w) (a_d:a_x) (a_e:a_y) (a_f:a_z)=(:) (a_a,a_b,a_c,a_d,a_e,a_f) (f_zip6 a_u a_v a_w a_x a_y a_z);
+    f_zip6 a_u a_v a_w a_x a_y a_z=[];
+    f_zip (a_x,a_y)=f_zip2 a_x a_y;
+    main = putStr (f_main c_input)
+}
diff --git a/ghc/tests/programs/fast2haskell/Makefile b/ghc/tests/programs/fast2haskell/Makefile
new file mode 100644 (file)
index 0000000..5b9af21
--- /dev/null
@@ -0,0 +1,9 @@
+TOP = ../..
+include $(TOP)/mk/boilerplate.mk
+
+SRC_HC_OPTS += -fglasgow-exts
+
+all :: runtest
+
+include $(TOP)/mk/target.mk
+
diff --git a/ghc/tests/programs/fast2haskell/Word.hs b/ghc/tests/programs/fast2haskell/Word.hs
new file mode 100644 (file)
index 0000000..351193e
--- /dev/null
@@ -0,0 +1,87 @@
+-- mimic "hbc_library" module, Word.
+-- [seriously non-std Haskell here]
+
+module Word2 (
+       Bits(..),               -- class
+       Byte, Short, Word,      -- data types: abstract
+       byteToInt, shortToInt, wordToInt
+    ) where
+
+import GHC
+import PrelBase
+
+infixl 8 `bitLsh`, `bitRsh`
+infixl 7 `bitAnd`
+infixl 6 `bitXor`
+infixl 5 `bitOr`
+
+class Bits a where
+       bitAnd, bitOr, bitXor :: a -> a -> a
+       bitCompl :: a -> a
+       bitRsh, bitLsh :: a -> Int -> a
+       bitSwap :: a -> a
+       bit0 :: a
+       bitSize :: a -> Int
+
+------------------------------------------------------------------
+data Word = Word Word# deriving (Eq, Ord)
+
+instance Bits Word where
+       bitAnd (Word x) (Word y) = case and# x y of z -> Word z
+       bitOr  (Word x) (Word y) = case or#  x y of z -> Word z
+       bitXor (Word x) (Word y) = error "later..." -- Word (XOR x y)
+       bitCompl (Word x)        = case not# x of x' -> Word x'
+       bitLsh (Word x) (I# y)   = case shiftL# x y of z -> Word z
+       bitRsh (Word x) (I# y)   = case shiftRA# x y of z -> Word z
+        bitSwap (Word x)         = --Word (OR (LSH x 16) (AND (RSH x 16) 65535))
+                                  case shiftL# x 16# of { a# ->
+                                  case shiftRA# x 16# of { b# ->
+                                  case and# b# (i2w 65535#) of { c# ->
+                                  case or#  a# c# of  { r# ->
+                                  Word r# }}}}
+       bit0                     = Word (i2w 1#)
+       bitSize (Word _)         = 32
+
+w2i x = word2Int# x
+i2w x = int2Word# x
+
+instance Num Word where
+       Word x + Word y = case plusInt#  (w2i x) (w2i y) of z -> Word (i2w z)
+       Word x - Word y = case minusInt# (w2i x) (w2i y) of z -> Word (i2w z)
+       Word x * Word y = case timesInt# (w2i x) (w2i y) of z -> Word (i2w z)
+       negate (Word x) = case negateInt# (w2i x)  of z -> Word (i2w z)
+       fromInteger (J# a# s# d#)
+         = case integer2Int# a# s# d# of { z# ->
+           Word (i2w z#) }
+
+instance Show Word where
+       showsPrec _ (Word w) =
+               let i = toInteger (I# (w2i w)) + (if geWord# w (i2w 0#) then 0 else  2*(toInteger maxBound + 1))
+               in  showString (conv 8 i)
+
+conv :: Int -> Integer -> String
+conv 0 _ = ""
+
+-- Was: 
+--     conv n i = conv (n-1) q ++ ["0123456789ABCDEF"!!r] where (q, r) = quotRem (fromInteger i) 16
+-- But !!'s type has changed (Haskell 1.3) to take an Int index
+
+conv n i = conv (n-1) q ++ ["0123456789ABCDEF"!!fromInteger r] 
+         where 
+          (q, r) = quotRem i 16
+
+------------------------------------------------------------------
+data Short = Short Int# deriving (Eq, Ord)
+
+------------------------------------------------------------------
+data Byte = Byte Int# deriving (Eq, Ord)
+
+------------------------------------------------------------------
+wordToInt :: Word -> Int
+wordToInt (Word w) = I# (w2i w)
+
+shortToInt :: Short -> Int
+shortToInt (Short w) = I# w
+
+byteToInt :: Byte -> Int
+byteToInt (Byte w) = I# w
diff --git a/ghc/tests/programs/fast2haskell/fast2haskell.stdout b/ghc/tests/programs/fast2haskell/fast2haskell.stdout
new file mode 100644 (file)
index 0000000..2f49316
--- /dev/null
@@ -0,0 +1,2 @@
+43 tests passed and 1 failed
+44     **      ok: this one    is: should fail
diff --git a/ghc/tests/programs/fun_insts/Main.hs b/ghc/tests/programs/fun_insts/Main.hs
new file mode 100644 (file)
index 0000000..b7f9053
--- /dev/null
@@ -0,0 +1,23 @@
+--!!! Defines functions as an instance of Num
+
+module Main where
+
+instance (Eq a, Eq b) => Eq (a->b)
+
+instance (Num a, Num b) => Num (a->b) where
+    f + g    = \x -> f x + g x
+    negate f = \x -> - (f x)
+    f * g    = \x -> f x * g x
+    fromInteger n = \x -> fromInteger n
+
+ss :: Float -> Float
+cc :: Float -> Float
+tt :: Float -> Float
+
+ss = sin * sin
+cc = cos * cos
+tt = ss + cc
+-- sin**2 + cos**2 = 1
+
+main = putStr ((show (tt 0.4))++ "  "++(show (tt 1.652)))
diff --git a/ghc/tests/programs/fun_insts/Makefile b/ghc/tests/programs/fun_insts/Makefile
new file mode 100644 (file)
index 0000000..de6e7e0
--- /dev/null
@@ -0,0 +1,7 @@
+TOP = ../..
+include $(TOP)/mk/boilerplate.mk
+
+all :: runtest
+
+include $(TOP)/mk/target.mk
+
diff --git a/ghc/tests/programs/fun_insts/fun_insts.stdout b/ghc/tests/programs/fun_insts/fun_insts.stdout
new file mode 100644 (file)
index 0000000..7886e55
--- /dev/null
@@ -0,0 +1 @@
+1.0  1.0
diff --git a/ghc/tests/programs/hill_stk_oflow/MAIL b/ghc/tests/programs/hill_stk_oflow/MAIL
new file mode 100644 (file)
index 0000000..af721e6
--- /dev/null
@@ -0,0 +1,122 @@
+From sah@ukc.ac.uk Thu Aug 13 16:22:15 1992
+Return-Path: <sah@ukc.ac.uk>
+Received: from dcs.glasgow.ac.uk by pp.dcs.gla.ac.uk with SMTP (PP) 
+          id <18256-0@pp.dcs.gla.ac.uk>; Thu, 13 Aug 1992 16:21:57 +0100
+Message-Id: <13760.9208131521@vanuata.dcs.glasgow.ac.uk>
+Via: uk.ac.ukc; Thu, 13 Aug 92 16:21:50 BST
+Received: from gos by mercury.ukc.ac.uk with UKC POP3+ id aa10412;
+          13 Aug 92 16:21 BST
+From: Steve Hill <sah@ukc.ac.uk>
+To: glasgow-haskell-bugs@dcs.gla.ac.uk
+Subject: Possible bug.
+Date: Thu, 13 Aug 92 16:21:53 +0100
+
+Report from Dr. Steve Hill, Computing Laboratory, University of Kent.
+(sah@ukc.ac.uk)
+
+--------
+The following (rather silly) program causes a stack overflow (the B
+stack I think):
+----------------
+module Main where
+
+#include "GhcPrelude.h"
+
+main :: Dialogue
+main = print (final nums)
+
+nums :: [Int]
+nums = fromn 1
+
+fromn :: Int -> [Int]
+fromn n = n : fromn (n+1)
+
+final :: [Int] -> Int
+final (a:l) = seq (force a) (final l)
+
+force :: Int -> Int
+force a | a == a = a
+
+seq :: Int -> Int -> Int
+seq a b | a == a = b
+-----------------
+
+I would expect it to be able to run in constant space - I may be wrong.
+
+This is the output:
+
+beech.ukc.ac.uk% a.out
+croaked in StackOverflow
+beech.ukc.ac.uk% 
+
+This is the output of a -v compilation:
+
+beech.ukc.ac.uk% ghc -v Try.hs -cpp
+The Glorious New Glasgow Haskell Compilation System, version 0.06
+project label: `ghc'; setup label: `std'
+using a `sun4' host to build a Haskell compiler to run on a
+`sun4' host that will generate `C' code
+
+Haskellised C pre-processor:
+        echo '{-# LINE 1 "Try.hs"-}' > /tmp/ghc15040.cpp;
+/proj/haskell/ghc-0.06/./driver/.././utils/scripts/hscpp  -v 
+-D__HASKELL1__=2 -D__GLASGOW_HASKELL__ -I.
+-I/proj/haskell/ghc-0.06/imports Try.hs >> /tmp/ghc15040.cpp
+        0.1 real         0.0 user         0.0 sys  
+hscpp:CPP invoked: /lib/cpp           -D__HASKELL1__=2
+-D__GLASGOW_HASKELL__ -I. -I/proj/haskell/ghc-0.06/imports Try.hs
+
+Haskell parser:
+        /proj/haskell/ghc-0.06/./driver/.././parsers/hsp/hsp -v  -I.
+-I/proj/haskell/ghc-0.06/imports /tmp/ghc15040.cpp > /tmp/ghc15040.hsp
+Glasgow Haskell parser, version 0.06
+Hash Table Contains 993 entries
+        1.2 real         0.4 user         0.2 sys  
+
+Haskell compiler:
+        /proj/haskell/ghc-0.06/./driver/.././compiler/hsc <
+/tmp/ghc15040.hsp  - -v > /tmp/ghc15040.hsc
+Glasgow Haskell Compiler, version 0.06
+
+       17.4 real         7.0 user         2.0 sys  
+
+Pin on Haskell consistency info:
+        echo 'static char ghc_hsc_ID[] = "@(#)hsc_comp Try.hs  
+ver=1.0,";' >> /tmp/ghc15040.hsc
+        0.1 real         0.0 user         0.0 sys  
+extracting C (/tmp/ghc15040.hc) and interface (Try.hi) from /tmp/ghc15040.hsc
+interface really going into: Main.hi
+
+Comparing old and new .hi files:
+        cmp -s /tmp/ghc15040.hi Main.hi || mv /tmp/ghc15040.hi Main.hi
+        0.2 real         0.0 user         0.0 sys  
+
+ANSI-C Haskell assembler:
+        cc -v -S -DDO_RUNTIME_PROFILING -DDO_RUNTIME_TRACE_UPDATES -g
+-DGC2s  -D__HASKELL1__=2 -D__GLASGOW_HASKELL__ -I.
+-I/proj/haskell/ghc-0.06/imports /tmp/ghc15040.c -o /tmp/ghc15040.s
+/lib/cpp -I. -I/proj/haskell/ghc-0.06/imports -undef -Dunix -Dsun
+-Dsparc -DDO_RUNTIME_PROFILING -DDO_RUNTIME_TRACE_UPDATES -DGC2s
+-D__HASKELL1__=2 -D__GLASGOW_HASKELL__ /tmp/ghc15040.c >/tmp/cpp.15067.0.i
+/lib/ccom - -Xg </tmp/cpp.15067.0.i >/tmp/ghc15040.s
+rm /tmp/cpp.15067.0.i
+        2.6 real         1.6 user         0.5 sys  
+
+Unix assembler:
+        as  /tmp/ghc15040.s -o Try.o
+        2.3 real         1.1 user         0.5 sys  
+
+Linker:
+        cc   Try.o
+/proj/haskell/ghc-0.06/./driver/.././runtime/main/Preloads.sun4.o
+-L/proj/haskell/ghc-0.06/./driver/.././runtime/objs-sun4
+-L/proj/haskell/ghc-0.06/./driver/.././lib/objs-sun4 -lHS_2s -lHSrts_2s
+       51.1 real        12.1 user         5.6 sys  
+Checking consistency of: a.out
+
+rm -f /tmp/ghc15040*
+beech.ukc.ac.uk% 
+
+
+Steve Hill.
+
diff --git a/ghc/tests/programs/hill_stk_oflow/Main.hs b/ghc/tests/programs/hill_stk_oflow/Main.hs
new file mode 100644 (file)
index 0000000..1e2aa92
--- /dev/null
@@ -0,0 +1,24 @@
+{- Without strictness analysis, this program runs in constants
+   space, giving non-termination.
+   With strictness analysis, the recursive call to final is not
+   a tail call, so stack overflow results.
+-}
+
+module Main where
+
+main = print (final nums)
+
+nums :: [Int]
+nums = fromn 1
+
+fromn :: Int -> [Int]
+fromn n = n : fromn (n+1)
+
+final :: [Int] -> Int
+final (a:l) = seqq (force a) (final l)
+
+force :: Int -> Int
+force a | a == a = a
+
+seqq :: Int -> Int -> Int
+seqq a b | a == a = b
diff --git a/ghc/tests/programs/hill_stk_oflow/Makefile b/ghc/tests/programs/hill_stk_oflow/Makefile
new file mode 100644 (file)
index 0000000..de6e7e0
--- /dev/null
@@ -0,0 +1,7 @@
+TOP = ../..
+include $(TOP)/mk/boilerplate.mk
+
+all :: runtest
+
+include $(TOP)/mk/target.mk
+
diff --git a/ghc/tests/programs/hill_stk_oflow/hill_stk_oflow.stdout b/ghc/tests/programs/hill_stk_oflow/hill_stk_oflow.stdout
new file mode 100644 (file)
index 0000000..e69de29
diff --git a/ghc/tests/programs/ipoole_spec_class/GoferPreludeBits.lhs b/ghc/tests/programs/ipoole_spec_class/GoferPreludeBits.lhs
new file mode 100644 (file)
index 0000000..10d9ca1
--- /dev/null
@@ -0,0 +1,59 @@
+\begin{vb}
+
+> module GoferPreludeBits where
+
+This script contains some useful functions taken from the standard
+Gofer prelude, but which do not appear in the Haskell prelude
+
+SCCS: %W% %G%
+
+> 
+> copy             :: Int -> a -> [a]      -- make list of n copies of x
+> copy n x          = take n xs where xs = x:xs
+
+
+> 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 ' '
+
+> layn        :: [String] -> String
+> layn         = lay (1::Int) where lay _ []     = []
+>                                   lay n (x:xs) = rjustify 4 (show n) ++ ") "
+>                                            ++ x ++ "\n" ++ lay (n+1) xs
+
+> -- Merging and sorting lists:
+
+> merge               :: Ord a => [a] -> [a] -> [a]
+> merge []     ys      = ys
+> merge xs     []      = xs
+> merge (x:xs) (y:ys)
+>         | x <= y     = x : merge xs (y:ys)
+>         | otherwise  = y : merge (x:xs) ys
+
+> sort                :: Ord a => [a] -> [a]
+> sort                 = foldr insert []
+
+> insert              :: Ord a => a -> [a] -> [a]
+> insert x []          = [x]
+> insert x (y:ys)
+>         | x <= y     = x:y:ys
+>         | otherwise  = y:insert x ys
+
+> qsort               :: Ord a => [a] -> [a]
+> qsort []             = []
+> qsort (x:xs)         = qsort [ u | u<-xs, u<x ] ++
+>                              [ x ] ++
+>                        qsort [ u | u<-xs, u>=x ]
+
+> --1.3: undefined = error "undefined"
+
+\end{vb}
+
+
diff --git a/ghc/tests/programs/ipoole_spec_class/Io.lhs b/ghc/tests/programs/ipoole_spec_class/Io.lhs
new file mode 100644 (file)
index 0000000..7fecec5
--- /dev/null
@@ -0,0 +1,91 @@
+\input{LiterateUtils}
+{
+\DownLevel
+\filetitle{IO.lgs --- Implementation of the basic I/O monad}
+\author{Andy Gill \\ University of Glasgow.\\(edited by IP)}
+\maybemaketitle
+%
+%
+% SCCS: %W% %G%
+%
+% Modifications
+% -------------
+% 15-01-94     ipoole         IO --> Io  (to keep ghc happy)
+% 04-09-93     ipoole         #ifdef Gofer, so we can compile with hbc
+%                              (and maybe ghc)
+% 02-09-93     ipoole         extracted from Andy's prelude, name changes:
+%                              returnIO --> unitIO, thenIO --> bindIO.
+
+\begin{vb}
+
+> module Io where
+
+\end{verbatim}\end{vb}
+
+This is the basic monad upon which the \verb@Job s1 s2 a@ monad is defined.
+
+\begin{Dec}{Io}         
+The Io monad, defined in terms of a Haskell Dialogue.
+\begin{vb}
+
+> type Io a = (a -> Dialogue) -> Dialogue
+
+#ifdef Gofer
+
+>       in unitIo,  bindIo,
+>          ioToDialogue, processRequestIo, doneIo
+>
+
+#endif
+
+\end{verbatim}\end{vb}\end{Dec}
+
+\begin{Def}{unitIo}
+The operation which returns a result without performing I/O.
+
+\begin{vb}
+
+> unitIo :: x -> Io x
+> unitIo x cont = cont x
+
+\end{verbatim}\end{vb}\end{Def}
+
+\begin{Def}{bindIo}
+Connect an Io operation to a continuation.
+\begin{vb}
+
+> bindIo :: Io a -> (a -> Io b) -> Io b
+> bindIo m k cont = m (\ a -> k a cont)
+
+\end{verbatim}\end{vb}\end{Def}
+
+\begin{Def}{ioToDialogue}
+Convert an Io to a runable Haskell Dialogue
+\begin{vb}
+
+> ioToDialogue :: Io a -> Dialogue
+> ioToDialogue io = io (const (const []))
+
+\end{verbatim}\end{vb}\end{Def}
+
+\begin{Def}{processRequestIo}
+Output a Haskell Request and get back the response.
+\begin{vb}
+
+> processRequestIo   :: Request -> Io Response
+> processRequestIo req cont ~(resp:resps) = req : cont resp resps
+
+\end{verbatim}\end{vb}\end{Def}
+
+\begin{Def}{doneIo}
+Terminate the Io.
+\begin{vb}
+
+> doneIo :: Io a
+> doneIo cont = \ _ -> []
+
+\end{verbatim}\end{vb}\end{Def}
+}
+\EndFile
+
+
diff --git a/ghc/tests/programs/ipoole_spec_class/JobApp.lhs b/ghc/tests/programs/ipoole_spec_class/JobApp.lhs
new file mode 100644 (file)
index 0000000..b617a36
--- /dev/null
@@ -0,0 +1,513 @@
+\input{LiterateUtils}
+{
+\DownLevel
+\filetitle{JobApp.lgs --- Convenience functions for the I/O / state monad}
+\author{Andy Gordon and Ian Poole}
+\maybemaketitle
+
+% 
+%               Copyright (C) 1993  Medical Research Council
+% 
+% SCCS: %W% %G%
+%
+%  MODIFICATIONS
+%  -------------
+%     02-09-93  ipoole  Job now carries application state.
+%                       Note addition of >>>, >>>=
+%     20-08-93  ipoole  infixl 0 >> (was infixr 0)
+%     16-08-93  ipoole  JobS s
+%     20-06-93  ipoole  readRemainingInputJ :: Job String
+%     11-03-93  derekc  strToInt, isNat, isInt -> Lib.lgs,
+%                       trace <- Lib.lgs
+%     02-03-93  derekc  newStyleIdentifiersUsed, put under sccs
+%     23-02-93  ipoole  Moved some definition in from Lib, to make IO
+%                       more self contained.
+%     21-02-93  ipoole  Added clearScreen
+%     21-02-93  ipoole  Mods to match those in IOimp.lgs,
+%                       ie to use outputReq and inputResp.
+%                       Added getEnvJ, getArgsJ, getProgNameJ,
+%                       writeFileJ, appendFileJ, readFileJ.
+%                       (The postfixed "j" is to avoid conflict with
+%                       standard continuation versions)
+%     11-11-92  ipoole  added getWord, getInt and putInt
+%     08-11-92  ipoole  infixl 0 ##= (was infix 0 ##=)
+%     08-11-92  ipoole  'gather' made polymorphic
+%     25-10-92  ipoole  priority of >> set to 1 (was "infixr >>" ??)
+
+
+%==========================================================================
+\iftopdocument{\tableofcontents}
+
+This script builds on top of the facilities provided in
+\verb@IO.lgs@ and \verb@JobImp.lgs@ without requiring access to the
+implementation of the \verb@IO@ or \verb@Job@  datatypes.  In particular,
+it operator synonyms for the most-used combinators.  
+
+
+\begin{vb}
+
+> module JobApp where
+> import Lib
+> import Io
+> import JobImp
+
+> infixl 1 >>=          -- bindJobh
+> infixl 1 >>>=         -- bindJob
+
+> infixl 0 >>           
+> infixl 0 >>>          
+
+> infixr 0 ?            
+> infixl 0 ##=
+
+\end{verbatim}\end{vb}
+
+
+
+\sectionH{Synonyms for basic types and combinators}
+
+\begin{Dec}{Task}
+Things of type \verb@Task s1 s2@ may perform I/O, but returns no result.
+It may read/modify state if the state type parameters are instantiated.
+\begin{vb}
+
+> type Task s1 s2 = Job s1 s2 ()
+
+\end{verbatim}\end{vb}\end{Dec}
+
+\begin{Def}{arrow-arrow-equal}
+
+Synonyms for various combinators.
+
+\begin{vb}
+
+> (>>=) = bindJobh
+> (>>>=) = bindJob
+> val = unitJob
+
+\end{verbatim}\end{vb}\end{Def}
+
+\begin{Def}{arrow-arrow}
+Perform the first Job, discard any result, then perform the second job.
+\begin{vb}
+
+> (>>>)     :: Job s1 s2 a -> Job s2 s3 b -> Job s1 s3 b
+> a >>> b   = a >>>= (\_ -> b)
+
+> (>>)      :: Job s1 s2 a -> Job s2 s2 b -> Job s1 s2 b
+> a >> b    = a >>= (\_ -> b)
+
+\end{verbatim}\end{vb}\end{Def}
+
+\begin{Def}{questionmark}
+
+So-called "biased choice";  Perform the first Job and iff it raises
+an unhandled error, perform the second job.
+\begin{vb}
+
+
+> (?)       :: Job s s a -> Job s s a -> Job s s a   
+> a ? b     = a `handle` (\x -> b)
+
+\end{verbatim}\end{vb}\end{Def}
+
+
+\begin{Def}{zeroT} The null Task --- does nothing.
+\begin{vb}
+
+> zeroT      :: Task s s
+> zeroT      = val ()
+
+\end{verbatim}\end{vb}\end{Def}
+
+
+
+%==========================================================================
+
+\sectionH{Useful imperative combinators}
+
+\begin{Def}{FoldT} 
+Sequentially perform a list of tasks.
+\begin{vb}
+
+> foldT     :: [Task s s] -> Task s s
+> foldT     = foldr (>>) zeroT
+
+\end{verbatim}\end{vb}\end{Def}
+
+
+\begin{Def}{while}
+Iteratively perform a continuation Job, while a condition on the
+result holds true.
+\begin{vb}
+
+> while :: (a -> Bool) -> (a -> Job s s a) -> (a -> Job s s a)
+> while f p a | f a       = p a >>= while f p
+>             | otherwise = val a
+
+\end{verbatim}\end{vb}\end{Def}
+
+\begin{Def}{gather}
+Gather input items into list a by repeatedly performing the given Job, as
+long as the given continuation condition holds true.
+\begin{vb}
+
+> gather :: Job s s a -> (a -> Bool) -> Job s s [a]
+> gather inputFun cond =
+>     inputFun >>= (\c ->
+>     while
+>         (\(c,cs) -> cond c)
+>         (\(c,cs) -> inputFun >>= (\c' -> val (c', c:cs)))
+>         (c,[]) >>=
+>     val . reverse . snd)
+
+\end{verbatim}\end{vb}\end{Def}
+
+
+\begin{Def}{hash--hash--equals}
+Perform the first job followed by the second, combining their results
+into a 2-tuple.  Note that no change of state type is permitted.
+\begin{vb}
+
+
+> (##=) :: Job s s a -> Job s s b -> Job s s (a,b)
+> p ##= q =
+>     p >>= (\a ->
+>     q >>= (\b ->
+>     val (a,b)))
+
+\end{verbatim}\end{vb}\end{Def}
+
+
+%==========================================================================
+\sectionH{Teletype I/O}
+
+Some higher-level IO operations on stdin and stdout.  Note that the
+low-level functions \verb@getChar, getRest, ungetChar@ and \verb@ungetStr@
+are defined in \verb@JobImp.lgs@.
+
+\begin{Def}{getWord,getLine}
+
+Read the next word from stdin.  A word is defined as
+a sequence of non-space characters,  a space being any of
+\verb@<space>,\t,\n,\r,\f,\v@.
+\begin{vb}
+
+> getWord :: Job s s String
+> getWord = gather getChar (not . isSpace) >>=
+>           (\str -> if null str  || isSpace (head str) then
+>                        getWord
+>                    else
+>                        val str
+>           )
+
+> getLine :: Job s s String
+> getLine = gather getChar (\x -> x /= '\n')
+
+\end{verbatim}\end{vb}\end{Def}
+
+\begin{Def}{getInt}
+Read the next word of input from stdin and interpret as
+a integer.  If the word is not a valid integer, then raise a
+(handleable) error.
+\begin{vb}
+
+> getInt  :: Job s s Int
+> getInt = getWord >>= (\str ->
+>       if isInt str then(val . strToInt) str
+>       else raise "getInt: invalid string")
+
+\end{verbatim}\end{vb}\end{Def}
+
+
+\begin{Def}{putChar,putLine,etc}~~\begin{vb}
+
+> putChar :: Char -> Task s s
+> putLine :: String -> Task s s
+> putStr  :: String -> Task s s
+> putInt  :: Int -> Task s s
+> putStrStderr :: String -> Task s s
+> askFor  :: String -> Job s s String
+
+> putChar c = putStr [c]
+> putLine xs = putStr xs >> putStr "\n"
+> putStr = appendChanJ stdout 
+> putStrStderr = appendChanJ stderr
+> putInt = putStr . show
+> askFor xs = putStr xs >> getLine
+
+\end{verbatim}\end{vb}\end{Def}
+
+\begin{Def}{clearScreen}
+On an xterm at least, clear the screen, leaving the cursor at the top left
+position.
+
+\begin{vb}
+
+> clearScreen :: Task s s
+> clearScreen = putStr (map toEnum [27, 91, 72, 27, 91, 50, 74])
+
+
+\end{verbatim}\end{vb}\end{Def}
+
+
+\sectionH{Job equivalents of Dialogue IO}
+
+Note that these functions raise exceptions upon encountering an
+error condition.
+
+\begin{Def}{appendChanJ}
+Append to the given channel (stdout, or stdin).
+
+\begin{vb}
+
+> appendChanJ :: String -> String -> Task s s
+> appendChanJ chan str
+>       = processRequestJ (AppendChan chan str) >>=
+>       (\resp -> case resp of
+>               Success -> zeroT
+>               Failure (SearchError estr) -> 
+>                       raise ("Error in appendChanJ: " ++ estr))
+
+\end{verbatim}\end{vb}\end{Def}
+
+
+\begin{Def}{writeFileJ}~~\begin{vb}
+
+> writeFileJ :: String -> String -> Task s s
+> writeFileJ fname str 
+>       = processRequestJ (WriteFile fname str) >>=
+>         (\resp -> case resp of
+>               Success -> zeroT
+>               Failure err -> raise ("writeFileJ " ++ fname) )
+
+\end{verbatim}\end{vb}\end{Def}
+
+\begin{Def}{appendFileJ}~~\begin{vb}
+
+> appendFileJ :: String -> String -> Task s s
+> appendFileJ fname str 
+>       = processRequestJ (AppendFile fname str) >>=
+>         (\resp -> case resp of
+>               Success -> zeroT
+>               Failure err -> 
+>                       raise ("Error in appendFileJ " ++ fname) )
+
+\end{verbatim}\end{vb}\end{Def}
+
+\begin{Def}{readFileJ}
+\begin{vb}
+
+> readFileJ :: String -> Job s s String
+> readFileJ fname 
+>       = processRequestJ (ReadFile fname) >>=
+>         (\resp -> case resp of
+>               Str l -> val l
+>               Failure (SearchError estr) -> 
+>                       raise ("Search error in readFileJ: " ++ estr) 
+>               Failure err -> 
+>                       raise ("Error in readFileJ: " ++ fname))
+
+\end{verbatim}\end{vb}\end{Def}
+
+\begin{Def}{readChanJ}
+\begin{vb}
+
+> readChanJ :: String -> Job s s String
+> readChanJ fname 
+>       = processRequestJ (ReadChan fname) >>=
+>         (\resp -> case resp of
+>               Str l -> val l
+>               Failure (SearchError estr) -> 
+>                       raise ("Search error in readChanJ: " ++ estr) 
+>               Failure err -> 
+>                       raise ("Error in readChanJ: " ++ fname))
+
+\end{verbatim}\end{vb}\end{Def}
+
+
+
+\sectionHH{Reading from a Pipe (HGU extension)}
+
+\begin{Def}{readPipeJ}
+The argument is any shell command, the return is the result from
+stdout after executing the command under sh.
+\begin{vb}
+
+#ifdef Gofer   -- the ReadPipe request is a HGU extension to Gofer.
+
+> readPipeJ :: String -> Job s s String
+
+> readPipeJ fname 
+>       = processRequestJ (ReadPipe fname) >>=
+>         (\resp -> case resp of
+>               Str l -> val l
+>               Failure (SearchError estr) -> 
+>                       raise ("Search error in readPipeJ: " ++ estr) 
+>               Failure err -> 
+>                       raise ("Error in readPipeJ: " ++ fname))
+
+#endif Gofer
+\end{verbatim}\end{vb}\end{Def}
+
+
+
+\sectionH{Environment I/O}
+
+These Jobs use the the new I/O requests available in Gofer 2.28.
+
+\begin{Def}{getEnvJ}
+Return the value of the given Unix environment variable.
+\begin{vb}
+
+> getEnvJ :: String -> Job s s String
+> getEnvJ var = processRequestJ (GetEnv var) >>=
+>       (\resp -> case resp of
+>               Str l -> val l
+>               Failure (SearchError estr) -> 
+>                       raise ("Error in getEnvJ: " ++ estr))
+
+\end{verbatim}\end{vb}\end{Def}
+
+\begin{Def}{getArgsJ}
+Return command-line arguments.  Returns [] when used from the interpreter.
+\begin{vb}
+
+
+
+> getArgsJ :: Job s s [String]
+> getArgsJ = processRequestJ GetArgs >>=
+>       (\resp -> case resp of
+>               StrList ll -> val ll)
+
+\end{verbatim}\end{vb}\end{Def}
+
+\begin{Def}{getProgNameJ}
+Reurn program name.  Returns "" when used from the interpreter.
+\begin{vb}
+
+> getProgNameJ :: Job s s String
+> getProgNameJ = processRequestJ GetProgName >>=
+>       (\resp -> case resp of
+>               Str l   -> val l
+>               Failure (OtherError l) -> val "")
+
+\end{verbatim}\end{vb}\end{Def}
+
+
+\sectionH{Some higher level functions operating on state}
+
+\sectionHH{A dynamic `state stack'}
+\label{sec-StateStack}
+Some functions, inspired by Simon Thompson's work, to allow stacking
+of state values.  Values in the 'state stack' can be of differing types.
+
+Note that we have:
+\begin{vb}
+
+        pushState s `bindJob` (\_ -> popState) == unitJob s
+
+\end{verbatim}\end{vb}
+The stack is in fact implemented by nested 2-tuples, so that, for example,
+\newline \verb@pushState 1 >>> pushState 2.0 >>> pusState "Fred"@ has type
+\newline \verb@Task s ([Char],(Float,(Int,s)))@.
+
+\begin{Def}{pushState,etc}~~\begin{vb}
+
+> pushState :: st -> Job s (st,s) ()
+> pushState st = getState `bindJob` (\s ->
+>                setState (st,s))
+
+> popState :: Job (st,s) s st
+> popState = getState `bindJob` (\(st,s) ->
+>            setState s `bindJob` (\_-> unitJob st))
+
+> getTopState :: Job (st,s) (st,s) st
+> getTopState = getState `bindJob` (unitJob . fst)
+
+> setTopState :: st2 -> Job (st1,s) (st2,s) ()
+> setTopState st2 = popState `bindJob` (\_ -> pushState st2)
+
+\end{verbatim}\end{vb}\end{Def}
+
+The point of these functions is that they provide a form of dynamic
+scoping of state, whilst being fully visible to the type
+system\footnote{expect this could be said better, or even
+correctly...}.  Thus, a package may create and use 
+state internally whilst remaining transparent to any state used by the
+calling program; the package will have type \verb@Job s s a@.
+
+\sectionHH{SJob and STask}
+
+[NOT YET FULLY WORKED OUT]
+
+It seems desirable to write programs in units which conform to the
+above conventions --- ie, which at worst modify the top of
+the state stack, but are transparent to any other state in the stack.
+
+The types \verb@SJob@ and \verb@STask@ enforce the above,
+providing the first parameter remains un-instantiated.
+
+\begin{vb}
+
+> type SJob s t1 t2 a = Job (t1,s) (t2,s) a
+> type STask s t1 t2 = SJob s t1 t2 ()
+
+\end{verbatim}\end{vb}
+
+Thus, a function of type \verb@STask s T1 T2@ expects to find state
+of type \verb@T1@ on top of the state stack, and may transform it
+to type \verb@T2@, but neither reads, nor modifies the remainder of the 
+rest of the state stack. 
+
+Here is a very silly example --- one would never use state for 
+such programming in the small.
+
+\begin{vb}
+
+> greet_ :: STask s t t
+> greet_ 
+>    = putLine "Hello, who's there?" >>>
+>      pushState "Ian" >>    
+>      greetme_ >>>
+>      popState >>= (\name -> putLine ("Oh, hi " ++ name))
+
+> greetme_ :: STask s String String
+> greetme_ 
+>    = getTopState >>= (\name->
+>      putLine ("Hi " ++ name ++ ", it's only me")) >>
+>      setTopState "John" 
+
+\end{verbatim}\end{vb}
+
+Evaluating \verb@go greet_@ produces,
+
+\begin{vb}
+
+Hello, who's there?
+Hi Ian, it's only me
+Oh, hi John
+
+\end{verbatim}\end{vb}
+Security is gained, since type errors will be generated if any
+of the push/pops are not balanced and of appropriate type.
+
+Ideally, we would like to {\em enforce\/} this style by making
+\verb@SJob@ fully abstract, and disallowing use of \verb@getState@
+and \verb@setState@,  but this is still TO-DO.
+
+\sectionHH{Mutate state by a given function}
+
+\begin{Def}{applyToState,applyToTopState}~~\begin{vb}
+        
+> applyToState :: (s1->s2) -> Task s1 s2
+> applyToState sf = getState `bindJob` (setState . sf)
+
+> applyToTopState :: (t1->t2) -> STask s t1 t2
+> applyToTopState sf = getTopState `bindJob` (setTopState . sf)
+
+\end{verbatim}\end{vb}\end{Def}
+
+}
+\EndFile
+
diff --git a/ghc/tests/programs/ipoole_spec_class/JobImp.lhs b/ghc/tests/programs/ipoole_spec_class/JobImp.lhs
new file mode 100644 (file)
index 0000000..3ea804a
--- /dev/null
@@ -0,0 +1,349 @@
+\input{LiterateUtils}
+{
+\DownLevel
+
+\filetitle{JobImp.lgs --- I/O monad with state}
+
+% SCCS: %W% %G%
+% MODIFICATIONS
+% =============
+% 15-01-94     ipoole         IO --> Io  (to keep ghc happy)
+% 06-01-94     ipoole  added performJob (type sig. only)
+
+\author{Ian Poole (editor), Andy Gordon and Andy Gill}
+\maybemaketitle
+\iftopdocument{\tableofcontents}
+\begin{vb}
+
+> module JobImp where
+> import Io
+> infixl 1 `bindJob` 
+> infixl 1 `bindJobh`
+
+\end{verbatim}\end{vb}
+\sectionH{Introduction}
+
+Here we implement a monad which can carry application defined state.
+Facilities for character-by-character reading of stdin are also 
+implemented here.
+
+A value of type Job s1 s2 a is understood to potentially perform I/O
+returning a result of type a and transforming its internal state to
+type s2.  Both the I/O, the result and the final state may depend
+on the input state.
+
+Note that the typing of a particular Job tells us quite alot.
+In the following table, ``Type'' is a values most general type.
+\verb@S@ is some concrete application-specific type.
+
+\begin{tabular}{ll}
+        Type    &       Properties \\~~\\
+
+        Job s s a       & can neither modify nor read the application state \\
+        Job s S a       & the state is overwritten but never read\\
+        Job S S a       & state is read and modified\\
+\end{tabular}
+\footnote{Unfortunately, a Job which only reads the state 
+has type \verb@Job S S a@,
+not \verb@Job S s a@ as one might at first think}.
+Note that a Job which is defined in terms of other Jobs, inherits
+the most general type which which is able to include all the nested Jobs.
+
+The implementation is presented here, for brevity, as a single layer,
+on top of the basic \verb@IO@ monad.  In fact several layers could be
+made explicit as follows:
+
+\begin{vb}
+
+    type IOS s1 s2 a = s1 -> IO (a,s2)    -- IO monad with state
+    type IOSE s1 s2 a = IOS s1 s2 (E a)    -- ... with exceptions
+    type Job s1 s2 a = IOSE (s1,[Char]) (s2,[Char]) a  -- with stdin stream
+
+\end{verbatim}\end{vb}
+
+\sectionH{The \protect\verb@Job@ monad}
+
+\begin{Dec}{Job} The state monad, parameterised by initial state type 
+(\verb@s1@), final state type (\verb@s2@), and result type, (\verb@a@).
+\begin{vb}
+
+> type Job s1 s2 a = (s1, MS) -> Io (E a, (s2, MS)) 
+
+#ifdef Gofer   -- (Gofer doesn't run cpp, so will ignore this!)
+
+>              in
+>              unitJob, bindJob, bindJobh,
+>              handle,
+>              setState, getState,
+>              getChar, getRest,
+>              ungetChar, ungetStr,
+>              iOtoJob, jobtoIo,
+>              raise, handle
+
+#endif
+
+> data E a = Ret a | Fail Exn
+> type Exn = String
+
+\end{verbatim}\end{vb}\end{Dec}
+
+\begin{Dec}{MS}
+
+Type MS holds any fixed-type state we want always (and invisibly)
+to carry in the Job monad.   
+At present, we carry only the input stream, but we'll make
+it abstract so that other things can easily be added if desired.
+\begin{vb}
+
+> type MS = String 
+
+#ifdef Gofer
+
+>           in getinputMS, setinputMS, initMS
+
+#endif
+
+> initMS :: MS
+> initMS = []
+> getinputMS :: MS -> String
+> getinputMS ms = ms
+> setinputMS :: MS -> String -> MS
+> setinputMS ms inp = inp
+
+\end{verbatim}\end{vb}\end{Dec}
+
+
+\sectionH{Basic combinators}
+
+\begin{Def}{unitJob}
+
+Return a value without I/O.
+
+\begin{vb}
+
+> unitJob :: a -> Job s s a    
+> unitJob a = \ss -> unitIo (Ret a ,ss)
+
+\end{verbatim}\end{vb}\end{Def}
+
+\begin{Def}{bindJob}
+
+Connect a Job to a continuation.  Notice the chaining of the state types.
+Note that if the first Job generates a failure, then the application
+state becomes undefined, since there is no way we can then obtain
+state of type s3.
+
+\begin{vb}
+
+
+> bindJob :: Job s1 s2 a -> (a -> Job s2 s3 b) -> Job s1 s3 b
+> bindJob m k (s1, ms) =
+>       m (s1, ms)             `bindIo` \ (a,(s3, ms3)) ->
+>       case a of
+>       Ret v -> k v (s3, ms3)
+>       Fail str -> unitIo (Fail str, (nostate, ms3))
+>           where
+>               nostate = error "State not defined due to failure"
+
+\end{verbatim}\end{vb}\end{Def}
+
+
+Because of the above noted problem with raising exceptions,  we provide
+a variant of \verb@bindJob@ which does not allow its right-hand argument to 
+modify the state type. Thus we are able to perform the error
+continuation with the state as it was before the failure was raised.  
+Programs should use this function whenever possible, ie, 
+when binding to a Job which does
+not change the state type.
+
+\begin{Def}{bindJobh} ~~ \begin{vb}
+
+
+> bindJobh :: Job s1 s2 a -> (a -> Job s2 s2 b) -> Job s1 s2 b
+> bindJobh m k (s1, ms) =
+>       m (s1, ms)             `bindIo` \ (a,(s2, ms2)) ->
+>       case a of
+>       Ret v -> k v (s2, ms2)
+>       Fail str -> unitIo (Fail str, (s2, ms2))
+
+\end{verbatim}\end{vb}\end{Def}
+
+\begin{Def}{doneJ}
+
+Terminate the program.
+
+\begin{vb}
+
+> doneJ :: Job s s a
+> doneJ = iOtoJob (doneIo)
+
+\end{verbatim}\end{vb}\end{Def}
+
+\begin{Def}{raise}
+
+Raise an exception which can later be trapped by \verb@handle@.
+\begin{vb}
+
+> raise :: Exn -> Job s s a
+> raise exn ss = unitIo (Fail exn, ss)
+
+\end{verbatim}\end{vb}\end{Def}
+
+\begin{Def}{handle}~~\begin{vb}
+
+> handle :: Job s s a -> (Exn -> Job s s a) -> Job s s a
+> handle p h ss
+>       = p ss `bindIo` (\(a, ss2) ->
+>         case a of
+>         Ret v -> unitIo (a, ss2)
+>         Fail str -> h str ss2)
+
+\end{verbatim}\end{vb}\end{Def}
+
+\sectionH{Access to application specific state}
+
+\begin{Def}{setState}
+Overwrite state, potentially changing its type.
+
+\begin{vb}
+
+> setState :: s2 -> Job s1 s2 ()      
+> setState s2 = \(_,ms) -> unitIo (Ret (),(s2,ms))
+
+\end{verbatim}\end{vb}\end{Def}
+
+
+\begin{Def}{getState}
+
+Return state as result.
+
+\begin{vb}
+
+> getState :: Job s s s 
+> getState = \(s,ms) -> unitIo (Ret s,(s,ms))
+
+\end{verbatim}\end{vb}\end{Def}
+
+
+\sectionH{Reading from stdin}
+
+\begin{Def}{getChar}.
+Read a single character from stdin.  This is done by reading from the string 
+that we carry around in the \verb@MS@ data.  If there is no more data
+to be read, an exception is raised.
+\begin{vb}
+
+> getChar :: Job s s Char
+> getChar = \(s,ms) -> 
+>               case (getinputMS ms) of
+>               [] -> unitIo (Fail "Attempt to read past end of stdin", (s,ms))
+>               (x:xs) ->  unitIo (Ret x, (s, setinputMS ms xs))
+
+\end{verbatim}\end{vb}\end{Def}
+
+
+\begin{Def}{getRest}
+Read (lazily) all remaining characters from stdin.
+\begin{vb}
+
+> getRest :: Job s s String
+> getRest = \(s,ms) -> unitIo (Ret (getinputMS ms), (s, setinputMS ms []))
+
+\end{verbatim}\end{vb}\end{Def}
+
+\begin{Def}{ungetChar}
+Place a character onto the input stream, so that it will be read next.
+\begin{vb}
+
+> ungetChar :: Char -> Job s s ()
+> ungetChar c = \(s,ms) -> 
+>           unitIo (Ret (), (s, setinputMS ms (c:getinputMS ms)))
+
+\end{verbatim}\end{vb}\end{Def}
+
+\begin{Def}{ungetStr}
+Place a string onto the input stream, so that it will be read next.
+\begin{vb}
+
+> ungetStr :: String -> Job s s ()
+> ungetStr str = \(s,ms) -> 
+>           unitIo (Ret (), (s, setinputMS ms (str++(getinputMS ms))))
+
+\end{verbatim}\end{vb}\end{Def}
+
+
+
+\sectionH{Conversions}
+
+\begin{Def}{iOtoJob}
+Conversion to allow access to facilities of the basic Io monad.
+
+\begin{vb}
+
+> iOtoJob :: Io a -> Job s s a         
+> iOtoJob m = \ss ->                   
+>       m               `bindIo` \v ->
+>       unitIo (Ret v,ss)
+
+\end{verbatim}\end{vb}\end{Def}
+\begin{Def}{jobtoIo}
+
+Conversion to allow a Job to be run as an Io.
+
+\begin{vb}
+
+> jobtoIo :: s1 -> MS -> Job s1 s2 a -> Io a  -- strip out state so we can run
+> jobtoIo s1 ms m =
+>       m (s1, ms)           `bindIo` \ (a,_) ->
+>       case a of
+>       Ret v -> unitIo v
+>       Fail str -> error ("iOtoJob:  Failed with: " ++ str)
+
+\end{verbatim}\end{vb}\end{Def}
+
+\begin{Def}{processRequestJ}
+
+Perform a Haskell \verb@Request->Response@ interaction.
+\begin{vb}
+
+> processRequestJ :: Request -> Job s s Response
+> processRequestJ req = iOtoJob (processRequestIo req)
+
+\end{verbatim}\end{vb}\end{Def}
+
+\begin{Def}{go}
+
+Execute a Job as a Haskell Dialogue.  Note that we must first
+(lazily) read input from stdin so that we can then allow 
+character-by-character reading.
+
+\begin{vb}
+
+> go :: Job s1 s2 a -> Dialogue
+> go t = ioToDialogue (processRequestIo (ReadChan stdin) `bindIo` (\resp ->
+>         case resp of
+>               Str inp-> let nostate = error "Application state not set"
+>                         in jobtoIo nostate (setinputMS initMS inp) t
+>               Failure (SearchError estr) -> 
+>                       error ("Search error by ReadChan in goS: " ++ estr) 
+>               Failure err -> 
+>                       error ("Error by readChan in goS")))
+
+\end{verbatim}\end{vb}\end{Def}
+
+\begin{Def}{performJob}
+This is an UNSAFE function to perform a job and return (as a simple value)
+the result.   If the job has any observable side-effects then the behvior
+will be unpredictable.  
+
+Having said all that, I don't think it can be implemented under our
+definition of the I/O monad!   It is provided here simply to make it possible
+for jobs to be defined implicitly, in terms of an abstraction which
+is assumed RT.
+
+> performJob :: Job s s a -> a
+> performJob = error "performJob: not implemented!"
+
+\end{verbatim}\end{vb}\end{Def}
+}
+\EndFile
diff --git a/ghc/tests/programs/ipoole_spec_class/Lib.lhs b/ghc/tests/programs/ipoole_spec_class/Lib.lhs
new file mode 100644 (file)
index 0000000..fc81f00
--- /dev/null
@@ -0,0 +1,416 @@
+%\documentstyle[a4wIde,11pt]{report}
+%\begin{document}
+%\section{Lib.lgs --- Some miscellaneous functions}
+
+%\begin{verbatim}
+
+> module Lib where
+> import Char(isDigit) -- 1.3
+> import GoferPreludeBits
+
+% 
+%               Copyright (C) 1993  Medical Research Council
+%
+% SCCS: %W% %G%
+%
+%  MODIFICATIONS
+%  ----------
+% 18-01-94      ipoole  added toDouble
+% 08-11-93      ipoole  added toFloat
+% 08-11-93       derekc  added Coord2
+% 04-08-93      ipoole  now compiles with hbc and ghc-0.16.  added seq etc
+% 18-08-93      ipoole  appended mrclib.lgs
+% 09-06-93      ipoole  fixed strToFloat "0.0" bug
+% 11-03-93       derekc  added position, occurences, strToFloat, isDecimalFracn
+% 11-03-93       derekc  strToInt, isNat, isInt <- IOapp.lgs,
+%                       trace -> IOapp.lgs
+% 02-03-93       derekc  newStyleIdentifiersUsed, put under sccs
+% 23-02-03      ipoole  deleted strToInt
+% 14-02-93      ipoole  now no need for sqrt or truncate (use iSqrt)
+% 08-11-92       ipoole  type coord moved in from mrclib, and added to
+% 07-11-92       ipoole  added map2, numVal
+
+%\end{verbatim}
+
+
+\subsection{Miranda equivalents}
+%------------------------------------------------------------------------------
+
+\begin{Def}{hd, tail, map2, numVal}
+These definitions are included to make the conversion of Miranda programs
+into Gofer just a little easier. In general, prefer the Gofer forms.
+\begin{vb}
+
+> hd = head
+> tl = tail
+> map2 = zipWith
+> numVal = strToInt    -- NB capitalised to meet SADLI coding standard
+
+\end{verbatim}\end{vb}\end{Def}
+
+
+\subsection{Standard Numerical Functions}
+%------------------------------------------------------------------------------
+
+\begin{Def}{absolute}~~\begin{vb}
+
+> absolute :: Float -> Float
+> absolute f | f < 0.0   = (-f)
+>            | otherwise = f
+
+\end{verbatim}\end{vb}\end{Def}
+
+\begin{Def}{strToFloat} 
+A first attempt at converting strings to Floats. This cannot cope with
+scientific notation, more than 10 significant digits or more than 9 decimal
+places.  
+\begin{vb}
+
+> strToFloat :: String -> Float
+> strToFloat "" = error "strToFloat (Null)"
+> strToFloat str
+>    | isDecimalFraction str = valAsInt / fromInt (10 ^ decimalPlaces str)
+>    | otherwise             = error ("strToFloat: " ++ str)
+>      where
+>                valAsInt
+>            | sigDigits str' >10 = error "strToFloat: >10 significant digits!"
+>            | otherwise          = fromInt (strToInt str') :: Float
+>         str'            =  filter (/='.') str
+>        sigDigits "0" = 1
+>         sigDigits (ch:chs) | elem ch ['1'..'9'] =  1 + length chs
+>                            | otherwise          =  sigDigits chs
+>        decimalPlaces str 
+>            | pos  < 0   =  0
+>           | decs > 9   =  error "strToFloat: >9 decimal places!"
+>            | otherwise  =  decs
+>         decs            =  length str - pos - 1
+>         pos             =  position '.' str
+
+\end{verbatim}\end{vb}\end{Def}
+
+\begin{Def}{strToInt}
+Turn a string containing only digits plus (optionally) leading spaces and 
+minuses into an integer.
+\begin{vb}
+
+> strToInt :: String -> Int
+> strToInt "" = error "strToInt (Null)"
+> strToInt (' ':xs) = strToInt xs
+> strToInt ('-':xs) = (negate . strToInt) xs
+> strToInt xs
+>              = loop 0 xs where
+>           loop n [] = n
+>           loop n (' ':xs) = n
+>           loop n (x:xs) | isDigit x = loop (10*n+(fromEnum x - fromEnum '0')) xs
+>                                | otherwise = error ("strToInt: " ++ xs)
+
+> toFloat :: Real a => a -> Float
+> toFloat = fromRational . toRational
+
+> toDouble :: Real a => a -> Double
+> toDouble = fromRational . toRational
+
+\end{verbatim}\end{vb}\end{Def}
+
+\begin{Def}{isInt}~~\begin{vb}
+
+> isInt :: String -> Bool
+> isInt [] = False
+> isInt ('-':l) = isNat l
+> isInt l = isNat l
+
+\end{verbatim}\end{vb}\end{Def}
+
+\begin{Def}{isNat}~~\begin{vb}
+
+> isNat :: String -> Bool
+> isNat [] = False
+> isNat l = all isDigit l
+
+\end{verbatim}\end{vb}\end{Def}
+
+\begin{Def}{isDecimalFraction}~~\begin{vb}
+
+> isDecimalFraction :: String -> Bool
+> isDecimalFraction [] = False
+> isDecimalFraction str = isInt str' && ((occurences '.' str) <= 1)
+>   where str' = filter (/='.') str
+
+\end{verbatim}\end{vb}\end{Def}
+
+\begin{Def}{iSqrt}~~\begin{vb}
+
+> iSqrt :: Int -> Int
+> iSqrt = truncate . (+ 0.5) . sqrt . fromInt
+
+\end{verbatim}\end{vb}\end{Def}
+
+\begin{Def}{hugenum}~~\begin{vb}
+
+> hugenum = 2147483647::Int  -- largest integer
+
+\end{verbatim}\end{vb}\end{Def}
+
+
+\subsection{Other general functions}
+%------------------------------------------------------------------------------
+
+\begin{Def}{tupled}~~\begin{vb}
+
+> tupled :: (a -> b) -> (a, a) -> (b, b)
+> tupled f (x, y) = (f x, f y)
+
+\end{verbatim}\end{vb}\end{Def}
+
+\begin{Def}{occurences}~~\begin{vb}
+
+> occurences :: Eq a => a -> [a] -> Int
+> occurences a [] = 0
+> occurences a (a':as) 
+>           | a == a'   =  1 + occurences a as
+>           | otherwise =      occurences a as
+
+\end{verbatim}\end{vb}\end{Def}
+
+\begin{Def}{position} 
+Return the index of the given element in the list, or (-1)
+if it is not present.
+\begin{vb}
+
+> position :: Eq a => a -> [a] -> Int
+> position a as = posit 0 a as
+>    where
+>       posit n a [] = -1
+>       posit n a (a':as)  | a==a'     =  n
+>                          | otherwise =  posit (n+1) a as
+
+\end{verbatim}\end{vb}\end{Def}
+
+\subsection{Type Coord}
+%------------------------------------------------------------------------------
+
+\begin{Def}{Coord}~~\begin{vb}
+
+> type Coord  = (Int,Int)
+> type Coord2 = Coord
+
+\end{verbatim}\end{vb}\end{Def}
+
+\begin{Def}{sqDistance}~~\begin{vb}
+
+> sqDistance (x1,y1) (x2,y2) = (x1-x2)^2 + (y1-y2)^2
+
+\end{verbatim}\end{vb}\end{Def}
+
+\begin{Def}{scaleCoord}~~\begin{vb}
+
+> scaleCoord :: Float -> Coord -> Coord
+> scaleCoord s (x,y) = (round ((fromInt x) * s),
+>                        round ((fromInt y) * s))
+
+\end{verbatim}\end{vb}\end{Def}
+
+\begin{Def}{addCoord}~~\begin{vb}
+
+> addCoord (x1,y1) (x2, y2) = (x1+x2, y1+y2)
+
+\end{verbatim}\end{vb}\end{Def}
+
+\begin{Def}{subCoord}~~\begin{vb}
+
+> subCoord (x1,y1) (x2, y2) = (x1-x2, y1-y2)
+
+\end{verbatim}\end{vb}\end{Def}
+
+\begin{Def}{relativeTo}~~\begin{vb}
+
+> relativeTo (x',y') (x,y) = (x - x', y - y')
+
+\end{verbatim}\end{vb}\end{Def}
+
+\begin{Def}{inside}
+Is a point inside the rectangle with the given boxCorners?
+\begin{vb}
+
+> inside :: Coord -> (Coord,Coord) -> Bool        
+> (x,y) `inside` ((blx,bly),(trx,try)) =
+>           (blx <= x) && (x <= trx)  &&  (bly <= y) && (y <= try)
+
+\end{verbatim}\end{vb}\end{Def}
+
+#ifndef __GLASGOW_HASKELL__
+
+\begin{Dec}{Coords are Nums}
+Tuples are already members of Text, so nothing is needed to implement
+Coord as a member of text (I think). But
+let's make Coord an instance of class Num, in part at least:
+\begin{vb}
+
+> instance (Num a, Num b) => Num (a,b) where
+>       (+) = addCoord
+>       (-) = subCoord
+>       negate (x,y) = (-x,-y)
+> --    abs (x,y) = (abs x, abs y)            
+> --    signum (x,y) = (signum x, signum y)
+
+\end{verbatim}\end{vb}\end{Dec}
+
+\begin{Def}{Coord3}
+Coord3 will similarly come in handy:
+\begin{vb}
+
+> type Coord3 = (Int, Int, Int)
+
+> instance (Num a, Num b, Num c) => Num (a,b,c) where
+>       (x1,y1,z1) + (x2,y2,z2) = (x1+x2, y1+y2, z1+z2)
+>       (x1,y1,z1) - (x2,y2,z2) = (x1-x2, y1-y2, z1-z2)
+>       negate (x,y,z) = (-x,-y,-z)
+> --    abs (x,y,z) = (abs x, abs y, abs z)            
+> --    signum (x,y,z) = (signum x, signum y, signum z)
+
+\end{verbatim}\end{vb}\end{Def}
+
+#endif __GLASGOW_HASKELL__
+
+% Here to end was mrclib.lgs
+
+
+\begin{Def}{sortBy} accepts a function and a list, and returns the list
+ordered (ascending) according to the given function.  It can thus be used
+on lists of structured types for which the \verb@'<'@ operator is not
+valid, e.g. 
+\begin{vb}
+
+               sortBy fst [(4,"Fred"), (2,"Bert"), (6,"Gill")]
+                      --> [(2,"Bert"), (4,"Fred"), (6,"Gill")]
+
+> sortBy :: Ord b => (a->b) -> [a] -> [a]
+> sortBy v [] = []
+> sortBy v (a:x) 
+>       = (sortBy v left) ++ [a] ++ (sortBy v right)
+>         where
+>         left  = [b | b <- x, (v b) <= va ]
+>         right = [b | b <- x, (v b)  > va ]
+>         va = v a
+
+\end{verbatim}\end{vb}\end{Def}
+
+\begin{Def}{maxBy} returns the the element in the given list which yields the 
+greatest value under the given function.
+\begin{vb}
+
+> maxBy :: Ord b => (a->b) -> [a] -> a
+> maxBy f = foldl1 max2by
+>               where max2by a b | (f a) >= (f b)  = a
+>                                | otherwise       = b
+
+\end{verbatim}\end{vb}\end{Def}
+
+\begin{Def}{minBy} similar to \verb@maxBy@
+\begin{vb}
+
+> minBy :: Ord b => (a->b) -> [a] -> a
+> minBy f = foldl1 min2By
+>               where min2By a b | (f a) <= (f b) = a
+>                                | otherwise      = b
+
+\begin{Def}{readTable} 
+converts a text table of numbers (eg from a `feature file').
+into [[Int]]
+\begin{vb}
+
+> readTable:: String -> [[Int]]
+> readTable = map (map strToInt) . map words . lines
+
+\end{verbatim}\end{vb}\end{Def}
+
+\begin{Def}{writeTable} the converse of readTable.
+\begin{vb}
+
+> writeTable:: Show{-was:Text-} a => [[a]] -> String
+> writeTable = unlines . map unwords . (map . map) show
+
+\end{verbatim}\end{vb}\end{Def}
+
+\begin{Def}{writeTableN} like readTable, but number each line.
+\begin{vb}
+
+> writeTableN:: Show{-was:Text-} a => [[a]] -> String
+> writeTableN = layn . map unwords . (map . map) show
+
+\end{verbatim}\end{vb}\end{Def}
+
+\begin{Def}{plotSurface} 
+invokes the program ``surface'' to plot a 2--D surface via 
+stoX. The \verb@switches@ parameter will be passed to ``surface'' 
+(see "man l surface") and for a first try can be "".
+\begin{vb}
+
+> plotSurface :: String -> [[Int]] -> FailCont -> SuccCont -> Dialogue
+> plotSurface switches table fail succ =
+>   writeFile "surfacedata" surfData fail
+>     (writeFile "plotsurf" surfCommand fail succ)
+>     where
+>       surfData = "Plotsurface" ++ "\n" ++
+>                  show yLen ++ " " ++ show xLen ++ "\n" ++
+>                  writeTable table
+>       surfCommand = "cat surfacedata | surface " ++ switches ++ " | stoX\n"
+>       xLen = length (table!!0)
+>       yLen = length table
+
+\end{verbatim}\end{vb}\end{Def}
+
+\begin{Def}{quadSolve} 
+solve the quadratic equation $a x^2 + b x + c = 0$ for $x$, if
+possible.  Both solutions are returned, in ascending order.  
+Deals sensibly with $a=0$.
+\begin{vb}
+
+> quadSolve :: Float -> Float -> Float -> (Float, Float)
+> quadSolve a b c
+>    | a /= 0.0 && s1 > s2   =  (s1, s2)
+>    | a /= 0.0 && s1 <= s2  =  (s2, s1) 
+>    | otherwise           =  (-c/b, -c/b) 
+>    where
+>       s1 = (-b + root) / (2.0 * a)
+>       s2 = (-b - root) / (2.0 * a)
+>       bs4ac = b*b - 4.0*a*c
+>       root | bs4ac >= 0.0  =  {-sqrt-} bs4ac 
+>            | otherwise    
+>                 = error ("quadSolve " ++ show [a,b,c] ++ " - no solution!") 
+
+\end{verbatim}\end{vb}\end{Def}
+
+\begin{Def}{number}
+Here is a utility to check that a number is a (non negative) number.
+\begin{vb}
+
+> number :: String -> Bool
+> number [] = False
+> number [a] = isDigit a
+> number (a:l) = isDigit a && (number l)
+
+\end{verbatim}\end{vb}\end{Def}
+
+
+
+\sectionHH{Some strict functions}
+
+#ifdef Gofer
+
+\begin{vb}
+
+> seq :: a -> b -> b
+> seq a b = strict (const b) a
+
+> hyperSeq :: [a] -> b -> b
+> hyperSeq as b = foldr seq b as
+
+> hyperStrict :: ([a] -> b) -> ([a] -> b)
+> hyperStrict f x = hyperSeq x (f x)
+
+\end{verbatim}\end{vb}
+
+#endif
+
+%\end{document}
diff --git a/ghc/tests/programs/ipoole_spec_class/Lognum.lhs b/ghc/tests/programs/ipoole_spec_class/Lognum.lhs
new file mode 100644 (file)
index 0000000..3335e10
--- /dev/null
@@ -0,0 +1,63 @@
+MODIFICATIONS
+-------------
+07-04-94   ipoole  added pi method for Lognum
+
+SCCS: %W% %G%
+
+A packeage for log representations of numbers.
+
+> module Lognum where
+> import Lib
+
+> data Lognum = LN Double
+
+> instance Num Lognum where
+>      LN x * LN y = LN (x+y)
+>      LN x + LN y = LN (d+(mylog 1 (exp (x-d) + exp (y-d))))
+>                    where d = max x y
+>      LN x - LN y = if y > x then error "subtract LN" else
+>                   LN (d+(mylog 2 (exp (x-d) - exp (y-d))))
+>                    where d = x
+>      fromInteger 0 = LN (-1.0e99)
+>      fromInteger x = LN (mylog 3 (fromInteger x))
+
+> instance Ord Lognum where
+>      LN x > LN y = x > y
+>       a <= b = not  (a > b)
+
+> instance Eq Lognum where
+>      LN x == LN y = x == y
+
+> instance Floating Lognum where
+>      sqrt (LN x) = LN (x/2.0)
+>      (LN x) ** (LN y) = (LN (x * exp y))
+>       pi = (LN (log pi))
+
+> instance Fractional Lognum where
+>      LN x / LN y = LN (x-y)
+>      fromRational x = if x == toRational 0.0 then fromInteger 0 
+>                       else LN (mylog 4 (toDouble x))
+
+
+> instance Enum Lognum where
+>    enumFrom n       = iterate ((fromRational 1.0)+) n
+>    enumFromThen n m = iterate ((m-n)+) n
+
+
+> instance Real Lognum where
+>      toRational (LN x) = toRational (exp x)
+
+> toLognum :: Real a => a -> Lognum
+> toLognum = fromRational . toRational
+
+> instance RealFloat Lognum
+
+> instance RealFrac Lognum
+
+> instance Show{-was:Text-} Lognum 
+
+> mylog :: Int -> Double -> Double
+> mylog n x = if toDouble x < 0.0 then error ("mylog" ++ show n) else log x
+
+
+
diff --git a/ghc/tests/programs/ipoole_spec_class/Main.lhs b/ghc/tests/programs/ipoole_spec_class/Main.lhs
new file mode 100644 (file)
index 0000000..f588424
--- /dev/null
@@ -0,0 +1,437 @@
+\input{LiterateUtils}
+{
+\DownLevel
+\author{Ian Poole}
+\filetitle{Specimen classification (Animation)}
+\maybemaketitle
+\noindent{\verb{!%W% %G%!}
+\begin{vb}
+
+> module Main (main) where
+> import GoferPreludeBits
+> import Io
+> import Lib
+> import JobImp
+> import JobApp
+> import Lognum
+
+
+\end{verbatim}\end{vb}
+
+Here we give the Gofer specification of the Cytoline/ILDAS
+specimen classifier.  This is based on the
+description given in appendix C of the software requirements
+specification.  Note however that the scheme here
+is modified to admit that even normal specimens contain 
+abnormal objects.   Thus, beta distributions are allowed
+for both the normal and abnormal specimens.
+
+
+The purpose of the specimen classifier is to integrate all 
+evidence from the low and high resolution passes (and in
+Cytoline, from interactive review), to deliver a decision
+for the slide:
+\footnote{We will consistently adopt the order Abnormal, Normal
+ Leukocyte, Junk for object classes, which we
+will abbreviate to {\tt A, N, L, J}, and Abnormal, Normal for
+specimen classifications, which we will abbreviate as {\tt Abn, Nrm}}
+
+\begin{Dec}{SpecDecision}
+The specimen level decision.
+\begin{vb}
+
+> data SpecDecision = SignOut | Review
+
+\end{verbatim}\end{vb}\end{Dec}
+
+
+\sectionH{Specimen level evidence}
+
+\begin{Dec}{SpecEvidence}
+We assume that all evidence is expressed as likelihoods of observed
+features given each the four object classes, Normal, Abnormal, Leukocyte,
+Junk.  A posterior probability is assumed to exist for every object seen,
+based (only) on the most refined evidence available.
+\begin{vb}
+
+> type Prob = Double
+> type SpecEvidence = [(Int, ObjProbVec)]
+> type ObjProbVec = (Prob, Prob, Prob, Prob)
+
+\end{verbatim}\end{vb}\end{Dec}
+
+
+\begin{Def}{composeEvidence}
+
+Extract object level evidence from the low and high resolution
+target structures.   The evidence those objects which were not rescaned
+is fabricated by replicating the mean PP within the object class, 
+according to the count in that object class.
+\begin{vb}
+
+> type TargetList =  ()
+> type TargetRecord = ()
+
+> composeEvidence :: TargetList -> TargetList -> SpecEvidence
+> composeEvidence high low
+>       = extractEvidence low ++ extractEvidence high
+>       where
+>       extractEvidence ts
+>               = [(1, getPPs t) | t <- ts] ++ 
+>                 [(countA', meanPPA),
+>                  (countN, meanPPN),
+>                  (countL, meanPPL),
+>                  (countJ, meanPPJ)]
+>                  
+>                 where
+>                        countA' = countA - length ts  -- avoid double count
+
+The extraction functions should come from the TargetList ADT,
+but we leave this as yet unresolved.
+
+>                        getPPs :: TargetRecord -> ObjProbVec
+>                        getPPs = undefined
+>                        (ts,
+>                         countA, countN, countL, countJ,
+>                         meanPPA, meanPPN, meanPPL, meanPPJ)
+>                              = extractFromStruct ts
+>                        extractFromStruct ts = undefined
+>       
+
+\end{verbatim}\end{vb}\end{Def}
+
+\sectionH{Specimen level model}
+
+\begin{Dec}{SpecModel}
+It is assumed that the following model parameters are known:
+\begin{itemize}
+\item {\tt specPriorSM}      --- Prior probability for specimen classification 
+\item {\tt objProportionsSM} --- Mean proportions of objects, by class, on normal and
+      abnormal specimens.
+\item {\tt cvAbnObjSM}       --- Coefficient of variation in proportion of abnormal cells 
+      on normal and abnormal specimens.
+\item {\tt fnrSM}            --- Acceptable false negative rate.
+\end{itemize}
+There is facility to read parameters from a file.
+\begin{vb}
+
+> type SpecModel = SpecModelImp 
+
+#ifdef Gofer
+
+>      in
+>      specPriorSM, abnPropsSM, qLqJSM, cvAbnObjSM, betaParamsSM, fnrSM,
+>      calibFuncSM, readSpecModelSM, testSpecModelSM
+
+#endif Gofer
+
+> specPriorSM      :: SpecModel -> (Double, Double)
+> abnPropsSM       :: SpecModel -> (Double, Double)
+> qLqJSM           :: SpecModel -> (Double, Double)
+> cvAbnObjSM       :: SpecModel -> (Double, Double)
+> betaParamsSM     :: SpecModel -> (BetaParams, BetaParams)
+> fnrSM            :: SpecModel -> Double
+> calibFuncSM      :: SpecModel -> (Double -> Double)
+> readSpecModelSM  :: FileName  -> Job s s SpecModel
+> testSpecModelSM  :: SpecModel
+> 
+> type FileName = String
+> type BetaParams = (Double, Double, Lognum)
+
+> type SpecModelImp = ((Double, Double), (Double, Double), (Double, Double),
+>                      (Double, Double), (BetaParams, BetaParams), Double)
+>                        
+> readSpecModelSM = undefined
+
+> specPriorSM (a,b,c,d,e,f)      = a
+> abnPropsSM (a,b,c,d,e,f)       = b
+> qLqJSM (a,b,c,d,e,f)        = c
+> cvAbnObjSM (a,b,c,d,e,f)       = d
+> betaParamsSM (a,b,c,d,e,f)     = e
+> fnrSM (a,b,c,d,e,f)            = f
+> calibFuncSM (a,b,c,d,e,f) = id
+
+> calcBetaParams :: SpecModel -> (BetaParams, BetaParams)
+> calcBetaParams sm
+>      = (betaAbn, betaNrm)
+>        where
+>            betaAbn = cv qAbnA cvAbn
+>            betaNrm = cv qNrmA cvNrm
+>            (qAbnA, qNrmA) = abnPropsSM sm
+>            (cvAbn, cvNrm) = cvAbnObjSM sm
+
+> betaAbnDist sm  = beta p 
+>      where
+>      (_,p) = betaParamsSM sm
+
+
+
+\end{verbatim}\end{vb}\end{Dec}
+
+
+\sectionH{Specimen classifier decision}
+
+\begin{Def}{SpecClassifier}
+Make a Sign-out / Review decision on the basis of evidence
+from all objects seen.   The decision is a simple threshold
+--- is the predicted false negative rate (fnr) acceptable
+in the light of the posterior probability of abnormality
+and specimen prior?
+
+\begin{vb}
+
+> type SpecClass a = (a,a) -> a
+> classAbn = fst
+> classNrm = snd
+
+> specClassifier :: SpecModel -> SpecEvidence -> SpecDecision
+> specClassifier sm evidence
+>
+>       = if (truePostProb / pAbn) < fnr then
+>               SignOut
+>         else
+>               Review
+>
+>       where
+>            truePostProb = calibFunc (pAbnGvnEv sm evidence)
+>            (pAbn, _) = specPriorSM sm
+>            calibFunc = calibFuncSM sm
+>            fnr       = fnrSM sm
+
+\end{verbatim}\end{vb}\end{Def}
+
+\sectionH{Specimen posterior probability}
+
+\begin{Def}{pAbnGvnEv}
+Compute the posterior probability $P(S=\mbox{Abn} | {\bf x})$.
+\begin{vb}
+
+> type LikelyHood = Prob
+> type LikeVec = [LikelyHood]
+
+> pAbnGvnEv :: SpecModel -> SpecEvidence -> Prob
+> pAbnGvnEv sm evidence  
+>
+>           = toDouble (
+>             (pEvGvnAbn * pAbnL) / 
+>             (pEvGvnAbn * pAbnL + pEvGvnNrm * pNrmL)) -- Bayes theorem
+
+>       where
+>          pEvGvnAbn = lklf sm betaAbn likelihoods
+>          pEvGvnNrm = lklf sm betaNrm likelihoods
+
+Convert the evidence, which is in the  form of posterior probably vectors
+on objects, into likelyhood vectors on objects.
+
+>          likelihoods :: SpecEvidence
+>          likelihoods = [(c,bayes ppvec) | (c,ppvec) <- evidence]
+>                     where
+>                     bayes (ppA,ppN,ppL,ppJ) =
+>                               (ppA/pA, ppN/pN, ppL/pL, ppJ/pJ)
+   
+Form the marginal object priors from the specimen-conditional priors.
+
+>
+>          pA = let it = qAbnA * pAbn + qNrmA * pNrm in it
+>          pN = let it = 1.0 - (pA + pL + pJ) in it
+
+Extract model parameters.
+
+>         (pAbnL, pNrmL) = (toLognum pAbn, toLognum pNrm)
+>          (pAbn, pNrm)                 = specPriorSM sm
+>         (pL, pJ)                     = qLqJSM sm
+>          (betaAbn, betaNrm)           = let it = betaParamsSM sm in it
+>          (qAbnA, qNrmA)              = abnPropsSM sm
+
+\end{verbatim}\end{vb}\end{Def}
+
+\begin{Def}{lklf}
+Computes the likelyhood $p({\bf x} | S=s)$. The specimen class, $s$,
+(Normal or Abnormal) is passed by the within
+specimen class objectPriors ({\tt priors}) and coefficient of
+variation of abnormal objects {\tt v}).   ${\bf x}$, representing
+feature data for all observed objects, is passed as the list
+of likelyhood vectors for for each object.  In fact, these likelihoods
+are are required only to proportionality.
+\begin{vb}
+
+> lklf :: SpecModel -> BetaParams -> SpecEvidence -> Lognum
+> lklf sm betaParams evi =
+>      integratePowN 6 (fromRational 0.000001, fromRational 0.999) 
+>          (\ r ->
+>              let r' = toDouble r in
+>               beta betaParams r *
+>               product [toLognum (let y =
+>                                      lA * r' * (1.0 - q) +
+>                                      lN * (1.0 - r')*(1.0 - q) +
+>                                      lL * qL +
+>                                      lJ * qJ 
+>                                 in 
+>--                                     trace 
+>--                                     ("y="++show y ++ " r=" ++ show r ++ 
+>--                                      " r'="++ show r' ++ " lA=" ++ show lA) 
+>                                        y)`pow` c
+>                              | (c,(lA,lN,lL,lJ)) <- evi]
+>          )
+>       where 
+>              (qL, qJ) = qLqJSM sm
+>               q = qL + qJ
+
+> pow :: (Real b) => Lognum -> b -> Lognum
+> (LN x) `pow` n = LN (x* toDouble n)
+
+\end{verbatim}\end{vb}\end{Def}
+
+
+
+
+\sectionH{Function integration}
+
+(These definitions more properly belong in a library module).
+
+\begin{Def}{integrate, limitFromAbove}~~~
+
+\begin{itemize}
+\item
+        \verb@integrate (a,b) f@ = $ \int_a^b f (x) dx $
+\item
+        \verb@limitFromAbove a f@ = $  \lim_{x \rightarrow a} f (x) $
+\end{itemize}
+
+\begin{vb} 
+
+> integrate :: (Enum a, Fractional a) => 
+>              (a, a) -> (a -> a) -> a
+> integrate (a, b) f =
+>--       limitFromAbove zero 
+>--              (\dx -> sum [ (f x) * dx | x <- [a, a+dx ..b]])
+>       simpsons (a,b) f
+
+> integratePowN :: (Enum a, Fractional a, Floating a) => 
+>                Int -> (a, a) -> (a -> a) -> a
+> integratePowN n (a,b) f
+>      = integrate (invufunc a, invufunc b) (\u -> (f . ufunc) u * dxdu u)
+>                    where
+>                      invufunc x = x ** (fromInt 1 / fromInt n)
+>                      ufunc u = u ^ n
+>                      dxdu u = (u ^ (n-1)) * fromInt n
+
+> simpsons :: (Enum a, Fractional a) =>
+>              (a, a) -> (a -> a) -> a
+> simpsons (a,b) f
+>      = (h/v3) * 
+>         (f a + f b + v4 * odds + v2 * evens)
+>        where
+>          h = ((b-a)/fromInt(n-1))
+>          odds =  (sum) [f x | x <- (take ((n-1)`div`2) [a+h,    a+v3*h..])]
+>          evens = (sum) [f x | x <- (take ((n-3)`div`2) [a+v2*h, a+v4*h..])]
+>          n=201
+>          [v1,v2,v3,v4] = map fromInt [1..4]
+>          
+
+\end{verbatim}\end{vb}\end{Def}
+
+\sectionH{The beta distribution}
+
+A beta distribution is used to model the proportion of abnormal objects
+on normal and abnormal specimens.
+
+\begin{Def}{beta}
+This is a distribution of a continuous variable in the range 0 to 1.
+\begin{vb}
+
+> beta :: BetaParams -> Lognum -> Lognum
+> beta (a,b,n) x =
+>        f x / n
+>         where
+>         f x = (x `pow` (a-1.0)) * (((one - x) `pow` (b-1.0)))
+>        one = fromInt 1
+
+\end{verbatim}\end{vb}\end{Def}
+
+\sectionH{Testing}
+
+\begin{vb}
+
+> testSpecModelSM 
+>      = sm 
+>      where     
+>              sm   = ((0.5, 0.5),                     -- P(S)
+>                     (0.005, 0.0002),                 -- (P(O=A|S=Abn), P(O=A|S=Nrm))
+>                     (0.2,0.2),                       -- qL, qN
+>                     (0.7, 0.7),                      -- cv - (Abn, Nrm)
+>                      calcBetaParams sm,              -- beta dist parmaeters
+>                      0.01)                           -- FNR
+
+> showSpecModel sm
+>      = unlines [s "P(S)=" ++ (show . specPriorSM) sm,
+>                 s "(P(O=A|S=Abn), P(O=A|S=Nrm))=" ++ (show . abnPropsSM) sm,
+>                 s "(qL, qN)=" ++ (show . qLqJSM) sm,
+>                 s "cvAbnObj=" ++ (show . cvAbnObjSM) sm]
+>        where s = (ljustify 33 . show)
+
+> nrm = (0.0, 1.0, 0.0, 0.0)
+> abn = (1.0, 0.0, 0.0, 0.0)
+
+> runS nAbn nNrm =
+>          pAbnGvnEv testSpecModelSM [(nAbn, abn), (nNrm, nrm)]
+
+
+> cv :: Double -> Double -> BetaParams
+> cv m v = (a, b,n)
+>         where
+>               a = (1.0 - m) / v^2 - m
+>               b = a / m - a
+>              n = integratePowN 6 
+>                      (toLognum 0.000001, toLognum 0.999) 
+>                      (\x-> beta (a,b, toLognum 1) x)
+
+
+> main = go (
+>              (putLine . showSpecModel) testSpecModelSM >>
+>              putLine (tabulate2D 5
+>                     [0, 10]
+>                     [0, 100, 20000]
+>                     runS))
+
+}
+\EndFile
+
+
+  tabulate2D :: (Show{-was:Text-} a, Show{-was:Text-} b, Show{-was:Text-} c) => Int -> [a] -> [b] -> (a->b->c) -> String
+
+> tabulate2D w alist blist f
+>      = (jshow2' " ") ++ "   " ++ concat (map jshow alist) ++ "\n\n" ++
+>        unlines [jshow2 b ++ " : " ++ concat [jshow (f a b) | a <- alist ] 
+>                | b <- blist]
+>        where
+>        jshow x =  (ljustify w (take w (showFixed x))) ++ " "
+>        jshow2 x = (ljustify (w*2) (take w (showFixed x))) ++ " "
+>        jshow2' x = (ljustify (w*2) (take w (show x))) ++ " "
+>        
+
+> tabulate1D :: (Show{-was:Text-} a, Show{-was:Text-} b) => Int -> [a] -> (a->b) -> String
+> tabulate1D w alist f
+>      = unlines [jshow a ++ "   " ++ jshow (f  a)
+>                | a <- alist]
+>        where
+>        jshow x = (ljustify w (show x))
+>        
+
+Showfixed formats a Real in *non* exponent form.  
+Big hack --- must be a better way !?!
+
+> showFixed :: Real a => a -> String
+> showFixed x
+>      | dx >= 1.0 = show x
+>      | dx < 0.0000001 = show x
+>      | otherwise = showFixed' 0 dx
+>        where
+>        dx = toDouble x
+>        showFixed' n x = if x > 0.1 then
+>                            "0." ++ (take n (repeat '0')) ++ show (round (x*1000000.0))
+>                         else
+>                            showFixed' (n+1) (x*fromInt 10)
+>                         
+
diff --git a/ghc/tests/programs/ipoole_spec_class/Makefile b/ghc/tests/programs/ipoole_spec_class/Makefile
new file mode 100644 (file)
index 0000000..a62acb1
--- /dev/null
@@ -0,0 +1,9 @@
+TOP = ../..
+include $(TOP)/mk/boilerplate.mk
+
+SRC_HC_OPTS += -cpp
+
+all :: runtest
+
+include $(TOP)/mk/target.mk
+
diff --git a/ghc/tests/programs/ipoole_spec_class/README b/ghc/tests/programs/ipoole_spec_class/README
new file mode 100644 (file)
index 0000000..688a9de
--- /dev/null
@@ -0,0 +1,52 @@
+SCCS: %W% %G%
+
+Specimen Classifier Simulator
+-----------------------------
+Comments relate to ghc, version 0.19
+------------------------------------
+
+
+MODIFICATIONS
+-------------
+07-04-94 ipoole   added pi method for Lognum
+
+
+
+To make, type "make".
+
+To run, type "SpecClass".   The program prints a table (take several minutes).
+
+Some notes:
+
+1) SpecClass.lhs seems to take ~10 times longer to compile than any
+   of the other modules, even though it is not the biggest.  (Without
+   optimisation it seems normal).
+
+2) Execution appears to be ~ 4 times slower than interpreted gofer!
+   This is almost certainly due to the functions toDouble and toLognum
+   which in Haskell have to go via Rational.  What is clearly needed
+   is a method of type Real a => a -> Double, which could then be
+   defined efficiently for each Real type.   The default method
+   could still go via Rational.   I don't understand how
+   Haskell has survived for so long without such a method (which
+   makes me fear I've missed something...).
+
+3) When compiled *without* optimsation, the program now (7-04-94)
+   segmentation faults.   
+
+4) A very hacky "showFixed" is used, to force Reals < 0.0 to be displayed 
+   as 0.XXXXX, rather than in scientific form.   There must be better 
+   way to do this.
+
+5) The source is not pretty.
+
+6) To run with Gofer, you'll need our Haskellised Gofer prelude, which I
+   can provide (it originated from Andy Gill).
+
+7) Anyone interested in the statistics underlying the classifier model should
+   request: Ian Poole, "A statistical model for classifying cervical 
+   monolayers", RN94_003,  MRC Human Genetics Unit, Edinburgh.
+
+Ian Poole, MRC HGU
+
+18-01-93
diff --git a/ghc/tests/programs/ipoole_spec_class/ipoole_spec_class.stdout b/ghc/tests/programs/ipoole_spec_class/ipoole_spec_class.stdout
new file mode 100644 (file)
index 0000000..9da058f
--- /dev/null
@@ -0,0 +1,11 @@
+"P(S)="                          (5.0000000000000000e-1, 5.0000000000000000e-1)
+"(P(O=A|S=Abn), P(O=A|S=Nrm))="  (5.0000000000000001e-3, 2.0000000000000001e-4)
+"(qL, qN)="                      (2.0000000000000001e-1, 2.0000000000000001e-1)
+"cvAbnObj="                      (6.9999999999999996e-1, 6.9999999999999996e-1)
+
+" "           0     10    
+
+0           : 0.500 0.100 
+100         : 0.394 0.100 
+20000       : 0.003 0.136 
+
diff --git a/ghc/tests/programs/jl_defaults/Main.hs b/ghc/tests/programs/jl_defaults/Main.hs
new file mode 100644 (file)
index 0000000..7264c53
--- /dev/null
@@ -0,0 +1,24 @@
+d=25637784375346753+0158409406114519728029864689069987389733-25637784375346753
+
+cox(n)=foldr   (\x(y)->128*      y+x)0(n)
+de(n)=un(\x->  (x`mod`128,x    `div`128),(                  ==0))n
+coll=    un(\  zs->(          take(   35)zs,          drop(35)zs),(==""))
+pe(n,m)x=s(p(  n`div`2,m)x)  `mod`m   --2323         -- john launchbury --
+p(n,m)x=if(    n==0)then(1)  else(if(even(n))    then(pe(n,m)x)else(po(n,m)x))
+po(n,  m)x=           (x*p(  n-1,m)   x)`mod`                 m
+un(f,   p)n=   if(p(n))then  []else   (let(a,       b)=f(n)in(a:un(f,p)b))
+(g,s)    =(\x  ->x,\x->x*x)  --v(f)   t*g+172
+
+e=4998372704153806867349631861645896723396264061670520817438963311707989737197
+n=6133011105483442903214719346445720362447680717496623906453276570566830154479
+
+a=g
+  (concat.map(map(chr.fromIntegral).de.p(d,n).read).lines)
+main=interact
+  (unlines.map(show.p(e,n).cox.map(fromIntegral.ord)).coll)
+b=g
+--p::(Integer,Integer)->Integer->Integer
+default (Integer)
+-- 1.3
+ord = (fromEnum :: Char -> Int)
+chr = (toEnum   :: Int  -> Char)
diff --git a/ghc/tests/programs/jl_defaults/Makefile b/ghc/tests/programs/jl_defaults/Makefile
new file mode 100644 (file)
index 0000000..de6e7e0
--- /dev/null
@@ -0,0 +1,7 @@
+TOP = ../..
+include $(TOP)/mk/boilerplate.mk
+
+all :: runtest
+
+include $(TOP)/mk/target.mk
+
diff --git a/ghc/tests/programs/jl_defaults/jl_defaults.stdin b/ghc/tests/programs/jl_defaults/jl_defaults.stdin
new file mode 100644 (file)
index 0000000..9f42b3c
--- /dev/null
@@ -0,0 +1,97 @@
+module Main
+where
+
+import Rsa
+
+main = interact (decrypt 2036450659413645137870851576872812267542175329986469156678671505255564383842535488743101632280716717779536712424613501441720195827856504007305662157107
+                         5282760067491066073559694937813662322539426172665930660813609694132726350877)
+module Main
+where
+
+import Rsa
+
+main = interact (prompt . keys . lines)
+
+keys (x:y:xs) = makeKeys (read x) (read y)
+prompt ks = "\nEnter two random numbers on separate lines:\n" ++
+            case ks of
+              (n,e,d) -> "The numbers n, e, and d are:\n" ++
+                         unlines (map show [n,e,d]) ++ "\n"
+
+
+
+module Main
+where
+
+import Rsa
+
+main = interact (encrypt 2036450659413645137870851576872812267542175329986469156678671505255564383842535488743101632280716717779536712424613501441720195827856504007305662157107
+
+                         387784473137902876992546516170169092918207676456888779623592396031349415024943784869634893342729620092877891356118467738167515879252473323905128540213) 
+module Rsa (encrypt, decrypt, makeKeys)
+where
+
+
+encrypt, decrypt :: Integer -> Integer -> String -> String
+encrypt n e = unlines . map (show . power e n . code) . collect (size n)
+decrypt n d = concat . map (decode . power d n . read) . lines
+
+
+-------- Converting between Strings and Integers -----------
+
+code :: String -> Integer
+code = foldl accum 0
+  where accum x y = (128 * x) + fromIntegral (ord y)
+
+decode :: Integer -> String
+decode n = reverse (expand n)
+   where expand 0 = []
+         expand x = chr (fromIntegral (x `mod` 128)) : expand (x `div` 128)
+
+collect :: Int -> [a] -> [[a]]
+collect 0 xs = []
+collect n [] = []
+collect n xs = take n xs : collect n (drop n xs)
+
+size :: Integer -> Int
+size n = (length (show n) * 47) `div` 100      -- log_128 10 = 0.4745
+
+
+------- Constructing keys -------------------------
+
+makeKeys :: Integer -> Integer -> (Integer, Integer, Integer)
+makeKeys p' q' = (n, invert phi d, d)
+   where   p = nextPrime p'
+           q = nextPrime q'
+          n = p*q              
+          phi = (p-1)*(q-1)
+          d = nextPrime (p+q+1)
+
+nextPrime :: Integer -> Integer
+nextPrime a = head (filter prime [odd,odd+2..])
+  where  odd | even a = a+1
+             | True   = a
+         prime p = and [power (p-1) p x == 1 | x <- [3,5,7]]
+
+invert :: Integer -> Integer -> Integer
+invert n a = if e<0 then e+n else e
+  where  e=iter n 0 a 1
+
+iter :: Integer -> Integer -> Integer -> Integer -> Integer
+iter g v 0  w = v
+iter g v h w = iter h w (g - fact * h) (v - fact * w)
+    where  fact = g `div` h 
+
+
+------- Fast exponentiation, mod m -----------------
+
+power :: Integer -> Integer -> Integer -> Integer
+power 0 m x          = 1
+power n m x | even n = sqr (power (n `div` 2) m x) `mod` m
+           | True   = (x * power (n-1) m x) `mod` m
+
+sqr :: Integer -> Integer
+sqr x = x * x
+
+
diff --git a/ghc/tests/programs/jl_defaults/jl_defaults.stdout b/ghc/tests/programs/jl_defaults/jl_defaults.stdout
new file mode 100644 (file)
index 0000000..96af88d
--- /dev/null
@@ -0,0 +1,81 @@
+4920809715423652126833300223898584158049941072841886687495995700883334743100
+5432330858306872686500084883710596485987545962633593608556693314985929397278
+4339248871826075716689365252959383603865108452038731242628114027468386889392
+5093536091168354561903967261876376065518631989366599364453052968769674546808
+452255175131343471422777502400803159982075304884934452744062890985998925579
+5651794710074432381863213344353720104403137760112806914487431596242938363430
+3061160482336986047106286569124179361131165975312875785380225174897705056247
+3707532298830907015078026151401521396408816523701073885235911174226183847616
+1672527229229602085474445755878025438634885550315976736763448691537272636397
+2694095939000995014017603368080556297555174784041262508235371067342645255524
+374377465877617758578798366250540382775835183912685973484329204081752413108
+70670677534061236024006132424883477045800689401223889299851269113903609674
+4000628399955471904243661544397767048125987794908180173183625871229892876397
+4906565929095346836492941810877575932437495191179616117416632984168943509597
+5516346249998806624976191380102290469940913229929556365185124042458931748107
+3249082870923755215225394643296748590367123662573818411184222619514686103707
+1491720335558719705869091168528404980739494271046932349218229579321184830523
+1686737417317757855955298010512776238712753331633604323753903197890876799373
+1805585126801071079811419697627136537113089029403553023028612722432622665752
+3511736403324390887823438889080816442699457593665362088272279450694662350325
+3059090617697805984966883699385391457394972451765807015618308229682170754691
+1791469209415048698889701534711117102841920419919199191251466207775050401648
+4909486343080247382855393243376373590835553788279147318500120102235277324688
+6105584463845350869346463822943556344444743115967948397202046370564408862801
+3101811255702323827681538739391405240305979676311679950655332212164728286905
+502301603479002276983794250287799138413539671219594405716785181026407853070
+4358061173842713923727596635618515537510627182560600542063351264350418316626
+164453598598861572154717095227623488925677211321244997860334336257326798364
+4394558632435728786563083951771397684083785946746450795656358634203698441707
+6006851346698376668509905281824701381916163461685508740794674441125858788140
+3867538230503966184572683721734208947665221540440622466928061154772391187329
+5338109760830381076911983869920441650716477560575467116072876135764595748095
+3743970364360709692565346166809854918016520774549917187253761579957026935285
+5338885389104874014929439098775791103906923949376645756253431737471221283700
+2348178884706827085411484833459920161135814667852004573467265439960241493131
+5254623865012121523980274965685942704689624593023469438181719491186136936015
+3986275158016351977835439147155809957999996272270283467743293472532115583617
+526935137060210001028448464377173261084183239425747466381941443743544027195
+507273794051233348674698212476241189139986916720908541050194948680762996344
+1033556763489852311463603207019927285083136108137572596117745744242871916900
+3446795433667187698189441512959300936201773618507473942386709884930451135074
+545931880879424996206435364533933413676207664131244784634909342311706884452
+2795801327214218413435627230002144566845535290174353455844445456463875729434
+2931834269644667286282273161824736012205083677965116753449411073863166504357
+4321226293197008552166855291951448174194860947478057945983594070230611540335
+2915201550606214604494324179626096006121149723557886610883841340815238149840
+4811620416165033750799620419212417505145222669364398338747204968522878524911
+1466224263109815153902563034416239744965838185919402925858674448761002454779
+2438889162050605487686752760988810450126857080767315726495753536171323863054
+5998821980800057085636781495295707864684178467171746799651972228599139201266
+6089567412803075636381417941158119969114523106164962143432961423089887792292
+3050021010531468802113118367257671370659795560347299789117728278864278450131
+5945718375382831109423632944705128211793085885913633593861683167159528782591
+3026204398245236798354704986302023975861815145437855415245441815308415387953
+2676529366868155998394698157879317295826322813777929555458747920862958367966
+2510144819506913011833805684069407453087501420718601429525528464579648027945
+927261031293985730579168798603066378051891567746020053024936290977579745443
+5915344780625405584011111029616932649698677975010841120923573679748044000720
+3148048140163124147500328788647215500539594107393850553079025886755275538822
+2287692746592755607916955694183169908842703620578310343535165175569710544053
+1063693689244866698553354251617273211405432367453924577142357801317603990975
+3849377130782157501991218894503189735241973306948618262933858934701817306449
+4936383948961571782723042323182925874145007039724697967700967643799136008113
+1509617705803393270808477952473702864659023851066698294243357961717765168672
+5472216837765373996121128218666257320756026383617272333703957906641519754263
+4780254190063899712174761115854857641499167561602339838395636904013647414584
+5581514826041367626669555434100028158983453767987104047095662205070800757827
+5309252036506593340513508392734823467337429965923448711237185191264932184860
+4583433054186756079090681370045250784557808030067459137931281644720019191362
+5575463174094526452776738273855782291534405989081458614218391164048773471067
+5852605354443026555410261612196443374066160991330461866108439516671532034102
+1874394262755169898049882304381434185778432126556225514931962873197932483312
+788055637358938666586632974037948121627136430004899534614992989099047141460
+2622180375354647151274534995106977971178016843195527033965282744574806644939
+4796950796491327077781445701993257220109214573739662989797578674154036157406
+233413414192494514986495864446565635199384720742811236012866416296376677246
+2347993888467688740232778654271044706092005506762442826710421788460808408534
+91161250689328982701754090976033028590711392587459602281964712770783938325
+1819439705826650262304124492559936132802903570523631190847187428885890378612
+2856891250452648545493984485566790848211215232771965243626157791018496330646
+1757223836152519443955234766296600906372788951356756698651751141731568824792
diff --git a/ghc/tests/programs/jq_readsPrec/Main.hs b/ghc/tests/programs/jq_readsPrec/Main.hs
new file mode 100644 (file)
index 0000000..360a411
--- /dev/null
@@ -0,0 +1,20 @@
+module Main where
+
+data Vertex = V Int deriving (Read, Show)
+
+main = do
+    userInput <- getContents
+    (parseVertex.lines) userInput report
+
+report::Vertex -> IO ()
+report int = putStr (show int)
+
+parseVertex::[String] -> (Vertex -> IO ()) -> IO ()
+parseVertex inputLines cont
+ = case inputLines of
+      (l1:rest) -> case (reads l1) of
+                     [(x,"")] -> cont x
+                     other    -> putStr
+                                      ((showString "Error - retype the edges\n".                                      shows other) "")
+      _         -> putStr "No Vertex"
+
diff --git a/ghc/tests/programs/jq_readsPrec/Makefile b/ghc/tests/programs/jq_readsPrec/Makefile
new file mode 100644 (file)
index 0000000..de6e7e0
--- /dev/null
@@ -0,0 +1,7 @@
+TOP = ../..
+include $(TOP)/mk/boilerplate.mk
+
+all :: runtest
+
+include $(TOP)/mk/target.mk
+
diff --git a/ghc/tests/programs/jq_readsPrec/jq_readsPrec.stdin b/ghc/tests/programs/jq_readsPrec/jq_readsPrec.stdin
new file mode 100644 (file)
index 0000000..8cc78bf
--- /dev/null
@@ -0,0 +1 @@
+(V 1)
diff --git a/ghc/tests/programs/jq_readsPrec/jq_readsPrec.stdout b/ghc/tests/programs/jq_readsPrec/jq_readsPrec.stdout
new file mode 100644 (file)
index 0000000..725c38e
--- /dev/null
@@ -0,0 +1 @@
+V 1
\ No newline at end of file
diff --git a/ghc/tests/programs/jtod_circint/Bit.hs b/ghc/tests/programs/jtod_circint/Bit.hs
new file mode 100644 (file)
index 0000000..be11a6f
--- /dev/null
@@ -0,0 +1,183 @@
+module Bit where
+import LogFun
+import Signal
+
+data Bit = Bot | WeakZero | WeakOne | Zero | One | Top
+  deriving (Eq,Show{-was:Text-})
+
+instance Static Bit where
+  intToSig = intToSigBit
+  sigToInt = sigToIntBit
+  showStaticSig = showBit
+
+instance Lattice Bit where
+  bot = Bot
+  top = Top
+  weakZero = WeakZero
+  weakOne = WeakOne
+  lub = lubBit
+  pass = passBit
+
+instance Signal Bit where
+  showSig = showBit
+  initial = Zero
+  zerO    = Zero
+  one     = One
+  tt1     = tt1Bit
+  tt2     = tt2Bit
+
+instance Log Bit where
+  dumLog = Zero
+
+tt1Bit :: TT1 -> Bit -> Bit
+tt1Bit (a,b) =
+  let p = intBit a
+      q = intBit b
+      f x = case x of
+              Bot  -> Bot
+              Zero -> p
+              One  -> q
+              Top  -> Top
+  in f
+
+tt2Bit :: TT2 -> Bit -> Bit -> Bit
+tt2Bit (a,b,c,d) = f
+  where p = intBit a
+        q = intBit b
+        r = intBit c
+        s = intBit d
+        f x y = case x of
+                  Bot  ->     case y of
+                                Bot      -> Bot
+                                WeakZero -> Bot
+                                WeakOne  -> Bot
+                                Zero     -> Bot
+                                One      -> Bot
+                                Top      -> Top
+                  WeakZero -> case y of
+                                Bot      -> Bot
+                                WeakZero -> p
+                                WeakOne  -> q
+                                Zero     -> p
+                                One      -> q
+                                Top      -> Top
+                  WeakOne  -> case y of
+                                Bot      -> Bot
+                                WeakZero -> r
+                                WeakOne  -> s
+                                Zero     -> r
+                                One      -> s
+                                Top      -> Top
+                  Zero     -> case y of
+                                Bot      -> Bot
+                                WeakZero -> p
+                                WeakOne  -> q
+                                Zero     -> p
+                                One      -> q
+                                Top      -> Top
+                  One      -> case y of
+                                Bot      -> Bot
+                                WeakZero -> r
+                                WeakOne  -> s
+                                Zero     -> r
+                                One      -> s
+                                Top      -> Top
+                  Top      -> case y of
+                                Bot      -> Top
+                                WeakZero -> Top
+                                WeakOne  -> Top
+                                Zero     -> Top
+                                One      -> Top
+                                Top      -> Top
+
+lubBit :: Bit -> Bit -> Bit
+lubBit a b =
+  case a of
+    Bot      -> case b of
+                  Bot      -> Bot
+                  WeakZero -> WeakZero
+                  WeakOne  -> WeakOne
+                  Zero     -> Zero
+                  One      -> One
+                  Top      -> Top
+    WeakZero -> case b of
+                  Bot      -> Zero
+                  WeakZero -> WeakZero
+                  WeakOne  -> Top
+                  Zero     -> Zero
+                  One      -> One
+                  Top      -> Top
+    WeakOne  -> case b of
+                  Bot      -> WeakOne
+                  WeakZero -> Top
+                  WeakOne  -> WeakOne
+                  Zero     -> Zero
+                  One      -> One
+                  Top      -> Top
+    Zero     -> case b of
+                  Bot      -> Zero
+                  WeakZero -> Zero
+                  WeakOne  -> Zero
+                  Zero     -> Zero
+                  One      -> Top
+                  Top      -> Top
+    One      -> case b of
+                  Bot      -> One
+                  WeakZero -> One
+                  WeakOne  -> One
+                  Zero     -> Top
+                  One      -> One
+                  Top      -> Top
+    Top      -> case b of
+                  Bot      -> Top
+                  WeakZero -> Top
+                  WeakOne  -> Top
+                  Zero     -> Top
+                  One      -> Top
+                  Top      -> Top
+
+showBit :: Bit -> String
+showBit Bot      = "v"
+showBit WeakZero = "z"
+showBit WeakOne  = "o"
+showBit Zero     = "0"
+showBit One      = "1"
+showBit Top      = "^"
+
+
+intBit :: Int -> Bit
+intBit 0 = Zero
+intBit 1 = One
+intBit x =
+  error ("\nintBit received bad Int " ++ show x ++ ".\n")
+
+intToSigBit :: Int -> Bit
+intToSigBit i
+  | i==0  =  Zero
+  | i==1  =  One
+  | i==8  =  Bot
+  | i==9  =  Top
+
+sigToIntBit :: Bit -> Int
+sigToIntBit Zero = 0
+sigToIntBit One  = 1
+sigToIntBit Bot  = 8
+sigToIntBit Top  = 9
+
+passBit :: Bit -> Bit -> Bit
+passBit c a =
+  case c of
+    Bot  -> Bot
+    Zero -> Bot
+    One  -> a
+    Top  -> Top
+
+instance Num Bit where
+  (+) = or2
+  (*) = and2
+  a - b  = xor a b
+  negate = inv
+  abs    = error "abs not defined for Signals"
+  signum = error "signum not defined for Signals"
+  fromInteger = error "fromInteger not defined for Signals"
+
diff --git a/ghc/tests/programs/jtod_circint/LogFun.hs b/ghc/tests/programs/jtod_circint/LogFun.hs
new file mode 100644 (file)
index 0000000..b9a5bf1
--- /dev/null
@@ -0,0 +1,34 @@
+module LogFun where
+
+type TT1 = (Int,Int)
+type TT2 = (Int,Int,Int,Int)
+
+tt_con10, tt_id, tt_inv, tt_con11 :: TT1
+
+tt_con10 = (0,0)
+tt_id    = (0,1)
+tt_inv   = (1,0)
+tt_con11 = (1,1)
+
+tt_con20, tt_and2, tt_nimp,  tt_id21   :: TT2
+tt_nimp', tt_id22, tt_xor,   tt_or2    :: TT2
+tt_nor2,  tt_equ2, tt_inv22, tt_imp'   :: TT2
+tt_inv21, tt_imp,  tt_nand2, tt_con21  :: TT2
+
+tt_con20 = (0,0,0,0)
+tt_and2  = (0,0,0,1)
+tt_nimp  = (0,0,1,0)
+tt_id21  = (0,0,1,1)
+tt_nimp' = (0,1,0,0)
+tt_id22  = (0,1,0,1)
+tt_xor   = (0,1,1,0)
+tt_or2   = (0,1,1,1)
+tt_nor2  = (1,0,0,0)
+tt_equ2  = (1,0,0,1)
+tt_inv22 = (1,0,1,0)
+tt_imp'  = (1,0,1,1)
+tt_inv21 = (1,1,0,0)
+tt_imp   = (1,1,0,1)
+tt_nand2 = (1,1,1,0)
+tt_con21 = (1,1,1,1)
+
diff --git a/ghc/tests/programs/jtod_circint/Main.hs b/ghc/tests/programs/jtod_circint/Main.hs
new file mode 100644 (file)
index 0000000..a1907dc
--- /dev/null
@@ -0,0 +1,12 @@
+module Main where
+import Signal
+import Bit
+
+main = putStr test
+
+test = stest
+
+type B =  Stream Bit
+
+stest = take 80 (shows z "\n")
+  where z = one :: B
diff --git a/ghc/tests/programs/jtod_circint/Makefile b/ghc/tests/programs/jtod_circint/Makefile
new file mode 100644 (file)
index 0000000..de6e7e0
--- /dev/null
@@ -0,0 +1,7 @@
+TOP = ../..
+include $(TOP)/mk/boilerplate.mk
+
+all :: runtest
+
+include $(TOP)/mk/target.mk
+
diff --git a/ghc/tests/programs/jtod_circint/Signal.hs b/ghc/tests/programs/jtod_circint/Signal.hs
new file mode 100644 (file)
index 0000000..38a1fc8
--- /dev/null
@@ -0,0 +1,146 @@
+module Signal where
+
+import LogFun
+
+class (Eq a, Show{-was:Text-} a, Num a) => Signal a where
+  showSig :: a -> String
+
+  zerO, one, initial :: a
+
+  tt1 :: TT1 -> a -> a
+  tt2 :: TT2 -> a -> a -> a
+
+  con10, buf, inv, con11 :: a -> a
+
+  con20, and2, nimp,  id21  :: a -> a -> a
+  nimp', id22, xor,   or2   :: a -> a -> a
+  nor2,  equ2, inv22, imp'  :: a -> a -> a
+  inv21, imp,  nand2, con21 :: a -> a -> a
+  and3,  or3,  nand3, nor3  :: a -> a -> a -> a
+  and4,  or4,  nand4, nor4  :: a -> a -> a -> a -> a
+
+  con10 = tt1 tt_con10
+  buf   = tt1 tt_id
+  inv   = tt1 tt_inv
+  con11 = tt1 tt_con11
+
+  con20 = tt2 tt_con20
+  and2  = tt2 tt_and2
+  nimp  = tt2 tt_nimp
+  id21  = tt2 tt_id21
+  nimp' = tt2 tt_nimp'
+  id22  = tt2 tt_id22
+  xor   = tt2 tt_xor
+  or2   = tt2 tt_or2
+  nor2  = tt2 tt_nor2
+  equ2  = tt2 tt_equ2
+  inv22 = tt2 tt_inv22
+  imp'  = tt2 tt_imp'
+  inv21 = tt2 tt_inv21
+  imp   = tt2 tt_imp
+  nand2 = tt2 tt_nand2
+  con21 = tt2 tt_con21
+
+  and3  a b c = a*b*c
+  or3   a b c = a+b+c
+  nand3 a b c = nand2 a (nand2 b c)
+  nor3  a b c = nor2 a (nor2 b c)
+
+  and4  a b c d = (a*b)*(c*d)
+  or4   a b c d = (a+b)+(c+d)
+  nand4 a b c d = nand2 (nand2 a b) (nand2 c d)
+  nor4  a b c d = nor2 (nor2 a b) (nor2 c d)
+
+class (Signal a) => Lattice a where
+  bot, top, weakZero, weakOne :: a
+  lub  :: a -> a -> a
+  pass :: a -> a -> a
+
+class (Signal a) => Static a where
+  intToSig :: Int -> a
+  sigToInt :: a -> Int
+  showStaticSig :: a -> String
+
+class (Signal a) => Dynamic a where
+  latch, dff :: a -> a
+
+class (Lattice a, Static a) => Log a where
+  dumLog :: a
+
+class (Lattice a, Dynamic a) => Sig a where
+  dumSig :: a
+
+data Stream a = Snil | Scons a (Stream a)  deriving (Eq,Show{-was:Text-})
+
+shead :: Stream a -> a
+shead (Scons x xs) = x
+
+stail :: Stream a -> Stream a
+stail (Scons x xs) = xs
+
+snull :: Stream a -> Bool
+snull Snil = True
+snull (Scons x xs) = False
+
+smap :: (a->b) -> Stream a -> Stream b
+smap f Snil = Snil
+smap f (Scons x xs) = Scons (f x) (smap f xs)
+
+stake, sdrop :: Int -> Stream a -> Stream a
+
+stake 0 xs = xs
+--should be: stake (i+1) (Scons x xs) = Scons x (stake i xs)
+stake i (Scons x xs) | i < 0     = error "Signal.stake: < 0"
+                    | otherwise = Scons x (stake (i-1) xs)
+
+sdrop 0 xs = xs
+--should be:sdrop (i+1) (Scons x xs) = sdrop i xs
+sdrop i (Scons x xs) | i < 0    = error "Signal.sdrop: < 0"
+                    | otherwise = sdrop i xs
+
+smap2 :: (a->b->c) -> Stream a -> Stream b -> Stream c
+smap2 f as bs =
+  case as of
+    Snil -> Snil
+    Scons a as' ->
+      case bs of
+        Snil -> Snil
+        Scons b bs' -> Scons (f a b) (smap2 f as' bs')
+
+srepeat :: (Static a) => a -> Stream a
+srepeat x = xs where xs = Scons x xs
+
+stream :: [a] -> Stream a
+stream [] = Snil
+stream (x:xs) = Scons x (stream xs)
+
+instance (Signal a, Static a) => Dynamic (Stream a) where
+  latch xs = Scons initial xs
+  dff xs = Scons initial xs
+
+instance (Lattice a, Static a) => Lattice (Stream a) where
+  bot      = srepeat bot
+  top      = srepeat top
+  weakZero = srepeat weakZero
+  weakOne  = srepeat weakOne
+  lub      = smap2 lub
+  pass     = smap2 pass
+
+instance (Signal a, Static a) => Signal (Stream a) where
+  zerO = srepeat zerO
+  one  = srepeat one
+  tt1  = smap . tt1
+  tt2  = smap2 . tt2
+
+instance (Lattice a, Static a) => Sig (Stream a) where
+  dumSig = bot  -- ??? shouldn't be necessary, check compiler
+
+instance (Static a) => Num (Stream a) where
+  (+) = or2
+  (*) = and2
+  a - b  = xor a b
+  negate = inv
+  abs    = error "abs not defined for Signals"
+  signum = error "signum not defined for Signals"
+  fromInteger = error "fromInteger not defined for Signals"
+
diff --git a/ghc/tests/programs/jtod_circint/jtod_circint.stdout b/ghc/tests/programs/jtod_circint/jtod_circint.stdout
new file mode 100644 (file)
index 0000000..bc629da
--- /dev/null
@@ -0,0 +1 @@
+Scons One (Scons One (Scons One (Scons One (Scons One (Scons One (Scons One (Sco
\ No newline at end of file
diff --git a/ghc/tests/programs/jules_xref/Main.hs b/ghc/tests/programs/jules_xref/Main.hs
new file mode 100644 (file)
index 0000000..453d7b5
--- /dev/null
@@ -0,0 +1,174 @@
+--!!! a performance-problem test from Jules.
+--  further comment at the end
+-- 
+module Main where 
+
+import Char -- 1.3
+
+--1.3:data Maybe a = Nothing | Just a
+
+data ATree a b = ALeaf
+               | ABranch (ATree a b) a [b] (ATree a b) Int
+                 -- deriving (Eq)
+
+type SymTable = ATree String Int
+
+
+pp_tree :: SymTable -> String
+pp_tree ALeaf = ""
+pp_tree (ABranch l k vs r h)
+  = pp_tree l ++ show (k,reverse vs) ++ "\n" ++ pp_tree r
+
+{-
+avAdd :: Ord a  =>  ATree a b -> 
+                    a -> 
+                    b -> 
+                    ATree a b
+-}
+avAdd ALeaf xk xv = ABranch ALeaf xk [xv] ALeaf 1
+
+avAdd (ABranch l yk yv r hy) xk xv
+   | yk > xk = let (ABranch l1 zk zv l2 _) = avAdd l xk xv
+               in avCombine l1 (f l1) l2 (f l2) r (f r) zk zv yk yv
+   | xk > yk = let (ABranch r1 zk zv r2 _) = avAdd r xk xv
+               in avCombine l (f l) r1 (f r1) r2 (f r2) yk yv zk zv
+   | otherwise  = ABranch l yk (xv:yv) r hy
+   where
+      f :: ATree a b -> Int
+      f ALeaf = 0
+      f (ABranch _ _ _ _ d) = d
+      
+
+
+--==========================================================--
+--
+{-
+avLookup :: Ord a  =>  ATree a b -> 
+                       a -> 
+                       Maybe b
+-}
+avLookup ALeaf _ = Nothing
+
+avLookup (ABranch l k v r _) kk
+   | kk < k     = avLookup l kk
+   | kk > k     = avLookup r kk
+   | otherwise  = Just v
+
+
+
+--==========================================================--
+--
+avCombine :: ATree a b -> 
+             Int -> 
+             ATree a b -> 
+             Int -> 
+             ATree a b -> 
+             Int -> 
+             a -> 
+             [b] -> 
+             a -> 
+             [b] -> 
+             ATree a b
+
+avCombine t1 h1 t2 h2 t3 h3 ak av ck cv
+   | h2 > h1 && h2 > h3
+      = ABranch (ABranch t1 ak av t21 (h1+1)) bk bv 
+                (ABranch t22 ck cv t3 (h3+1)) (h1+2)
+   | h1 >= h2 && h1 >= h3
+      = ABranch t1 ak av (ABranch t2 ck cv t3 (max1 h2 h3)) 
+                (max1 h1 (max1 h2 h3))
+   | h3 >= h2 && h3 >= h1
+      = ABranch (ABranch t1 ak av t2 (max1 h1 h2)) ck cv t3 
+                (max1 (max1 h1 h2) h3)
+   where
+      (ABranch t21 bk bv t22 _) = t2
+      max1 :: Int -> Int -> Int
+      max1 n m = 1 + (if n > m then n else m)
+
+
+--==========================================================--
+--=== end                                     AVLTree.hs ===--
+--==========================================================--
+
+
+
+
+xref :: SymTable -> Int -> String -> SymTable
+
+xref stab lineno [] = stab
+xref stab lineno ('\n':cs) = xref stab (lineno+1) cs
+xref stab lineno (c:cs) 
+   = if isAlpha c then 
+        let (word, rest) = span isAlphanum cs
+        in  xref (avAdd stab (c:word) lineno) lineno rest
+     else xref stab lineno cs
+
+main = do
+    s <- getContents
+    putStr (pp_tree (xref ALeaf 1 s))
+
+{-
+Date: Thu, 29 Oct 92 19:38:31 GMT
+From: Julian Seward (DRL PhD) <sewardj@uk.ac.man.cs>
+Message-Id: <9210291938.AA27685@r6b.cs.man.ac.uk>
+To: partain@uk.ac.glasgow.dcs
+Subject: More ghc vs hbc fiddling (OR: nofib ephemeral contribution (unsolicited :-))
+
+Will,
+
+There are still some very simple programs for which ghc's performance
+falls far behind that of hbc's -- even with ghc using a better
+GC.  The stat files below are from a 
+crude cross reference program we hacked together for the purposes
+of an internal "what-language-to-teach-first-year-undergrads" debate.
+
+Is this something to do with dictionary zapping?
+
+Program included below.  Use as a pipe.  Suggest you feed it any
+large Haskell source file (I used TypeCheck5.hs from Anna).
+
+Jules
+
+---------------------------------------------------------
+
+a.out -H9000000 -S 
+Nw Heap Tt Heap   Stk    GC(real) GC acc (real)     tot (real) newheap    in -dupl  -new  -del  +stk   out  mcode
+  99192   99192    20  0.06   0.1   0.06    0.1    0.16    0.4  396768     0     0     0     0     0     0
+ 247752  247752    14  0.13   0.1   0.19    0.2    0.44    0.8  991008     0     0     0     0     0     0
+ 623104  623104    34  0.32   0.3   0.51    0.5    1.08    1.5 2492416     0     0     0     0     0     0
+1433968 1433968 15879  0.62   0.8   1.13    1.4    2.66    3.6 5735872     0     0     0     0     0     0
+3009700 3009700  2382  1.56   1.6   2.69    3.0    6.88    8.6 9000000     0     0     0     0     0     0
+         5 GCs,
+      8.69 (13.1) seconds total time,
+      2.69 (3.0) seconds GC time (31.0(23.1)% of total time)
+      0.00 (0.0) seconds major GC time ( 0.0( 0.0)% of total time)
+   9303816 bytes allocated from the heap.
+
+------------------------------------------------
+
+xref +RTS -H9M -S -K200k 
+
+Collector: APPEL  HeapSize: 9,437,184 (bytes)
+
+  Alloc   Live   Live   Astk   Bstk OldGen   GC    GC     TOT     TOT  Page Flts  Collec  Resid
+  bytes   bytes    %   bytes  bytes  roots  user  elap    user    elap   GC  TOT   tion   %heap
+4718580  786672  16.7     40    220    424  0.37  0.52    3.67    4.68    0    0   Minor
+4325248  808804  18.7  62724  62820 564968  0.50  0.60    6.63    8.05    0    0   Minor
+3920848  743508  19.0  47512  47600 743220  0.47  0.60    8.60   10.17    0    0   Minor
+3549096  681464  19.2  34644  34892 680820  0.46  0.53   10.43   12.13    0    0   Minor
+3208348  604892  18.9  23564  23676 604512  0.41  0.48   12.07   13.89    0    0   Minor
+2905900  528584  18.2  14164  14396 527952  0.35  0.41   13.53   15.42    0    0   Minor
+2641592  490812  18.6   5228   5388 490476  0.30  0.37   14.85   16.82    0    0   Minor
+2396204  534400  22.3     16     40 534380  0.28  0.32   16.41   18.75    0    0   Minor
+2129016  691708  32.5     36    144 691420  0.33  0.39   18.38   21.68    0    0   Minor
+1090480
+
+30,885,312 bytes allocated in the heap
+         9 garbage collections performed
+
+  Total time  19.29s  (23.06s elapsed)
+  GC time      3.47s  (4.22s elapsed)
+  %GC time    18.0%
+
+--------------------------------------------------
+-}
diff --git a/ghc/tests/programs/jules_xref/Makefile b/ghc/tests/programs/jules_xref/Makefile
new file mode 100644 (file)
index 0000000..de6e7e0
--- /dev/null
@@ -0,0 +1,7 @@
+TOP = ../..
+include $(TOP)/mk/boilerplate.mk
+
+all :: runtest
+
+include $(TOP)/mk/target.mk
+
diff --git a/ghc/tests/programs/jules_xref/jules_xref.stdin b/ghc/tests/programs/jules_xref/jules_xref.stdin
new file mode 100644 (file)
index 0000000..a43907d
--- /dev/null
@@ -0,0 +1,1105 @@
+--==========================================================--
+--=== A type-checker -- v5        File: TypeCheck5.m (1) ===--
+--=== Corrected version for 0.210a                       ===--
+--==========================================================--
+
+module TypeCheck5 where
+import BaseDefs
+import Utils
+import MyUtils
+
+--==========================================================--
+--=== Formatting of results                              ===--
+--==========================================================--
+
+tcMapAnnExpr :: (a -> b) ->
+                AnnExpr c a ->
+                AnnExpr c b
+
+tcMapAnnExpr f (ann, node) 
+   = (f ann, mapAnnExpr' node)
+     where
+        mapAnnExpr' (AVar v) = AVar v
+        mapAnnExpr' (ANum n) = ANum n
+        mapAnnExpr' (AConstr c) = AConstr c
+        mapAnnExpr' (AAp ae1 ae2) 
+           = AAp (tcMapAnnExpr f ae1) (tcMapAnnExpr f ae2)
+        mapAnnExpr' (ALet recFlag annDefs mainExpr)
+           = ALet recFlag (map mapAnnDefn annDefs) (tcMapAnnExpr f mainExpr)
+        mapAnnExpr' (ACase switchExpr annAlts)
+           = ACase (tcMapAnnExpr f switchExpr) (map mapAnnAlt annAlts)
+        mapAnnExpr' (ALam vs e) = ALam vs (tcMapAnnExpr f e)
+
+        mapAnnDefn (naam, expr) 
+           = (naam, tcMapAnnExpr f expr)
+
+        mapAnnAlt (naam, (pars, resExpr))
+           = (naam, (pars, tcMapAnnExpr f resExpr))
+
+
+--======================================================--
+--
+tcSubstAnnTree :: Subst -> 
+                  AnnExpr Naam TExpr -> 
+                  AnnExpr Naam TExpr
+
+tcSubstAnnTree phi tree = tcMapAnnExpr (tcSub_type phi) tree
+
+
+--======================================================--
+--
+tcTreeToEnv :: AnnExpr Naam TExpr ->
+               TypeEnv
+
+tcTreeToEnv tree
+   = t2e tree
+     where
+        t2e (nodeType, node) = t2e' node
+
+        t2e' (AVar v) = []
+        t2e' (ANum n) = []
+        t2e' (AConstr c) = []
+        t2e' (AAp ae1 ae2) = (t2e ae1) ++ (t2e ae2)
+        t2e' (ALam cs e) = t2e e
+        t2e' (ALet rf dl me) 
+           = (concat (map aFN dl)) ++ (t2e me)
+        t2e' (ACase sw alts)
+           = (t2e sw) ++ (concat (map (t2e.second.second) alts))
+   
+        aFN (naam, (tijp, body)) 
+          = (naam, tijp):(t2e' body)
+
+
+
+--======================================================--
+--
+tcShowtExpr :: TExpr ->
+               [Char]
+
+tcShowtExpr t 
+   = pretty' False t
+     where 
+       pretty' b (TVar tvname) = [' ', chr (96+(lookup tvname tvdict))]
+       pretty' b (TCons "int" []) = " int"
+       pretty' b (TCons "bool" []) = " bool"
+       pretty' b (TCons "char" []) = " char"
+       pretty' True (TArr t1 t2) 
+          = " (" ++ (pretty' True t1) ++ " -> " ++
+            (pretty' False t2) ++ ")" 
+       pretty' False (TArr t1 t2) 
+          = (pretty' True t1) ++ " -> " ++
+            (pretty' False t2)
+       pretty' b (TCons notArrow cl) 
+          = " (" ++ notArrow ++ 
+             concat (map (pretty' True) cl) ++ ")"
+       lookup tvname [] 
+          = panic "tcShowtExpr: Type name lookup failed"
+       lookup tvname (t:ts) | t==tvname = 1
+                           | otherwise = 1 + (lookup tvname ts)
+       tvdict = nub (tvdict' t)
+       tvdict' (TVar t) = [t]
+       tvdict' (TCons c ts) = concat (map tvdict' ts)
+       tvdict' (TArr t1 t2) = tvdict' t1 ++ tvdict' t2
+
+
+--======================================================--
+--
+tcPretty :: (Naam, TExpr) -> 
+            [Char]
+
+tcPretty (naam, tipe)
+   = "\n   " ++ (ljustify 25 (naam ++ " :: ")) ++ 
+            (tcShowtExpr tipe)
+
+
+--======================================================--
+tcCheck :: TcTypeEnv -> 
+           TypeNameSupply ->
+           AtomicProgram -> 
+           ([Char],  Reply (AnnExpr Naam TExpr, TypeEnv) Message)
+
+tcCheck baseTypes ns (tdefs, expr)
+   = if good tcResult 
+         then (fullEnvWords,  Ok (rootTree, fullEnv))
+         else ("",            Fail "No type")
+     where
+        tcResult = tc (tdefs++builtInTypes)
+                   (baseTypes++finalConstrTypes) finalNs expr
+
+        good (Ok x) = True
+        good (Fail x2) = False
+        
+        (rootSubst, rootType, annoTree) = f tcResult where f (Ok x) = x
+
+        rootTree = tcSubstAnnTree rootSubst annoTree
+
+        rootEnv = tcTreeToEnv rootTree
+
+        fullEnv = rootEnv ++ map f finalConstrTypes
+                  where
+                     f (naam, (Scheme vs t)) = (naam, t)
+
+        fullEnvWords = concat (map tcPretty fullEnv)
+
+        (finalNs, constrTypes) = 
+           mapAccuml tcConstrTypeSchemes ns (tdefs++builtInTypes)
+        finalConstrTypes = concat constrTypes
+
+        builtInTypes 
+           = [ ("bool", [], [("True", []), ("False", [])]) ]
+        
+
+
+--==========================================================--
+--=== 9.2 Representation of type expressions             ===--
+--==========================================================--
+
+----======================================================--
+--tcArrow :: TExpr -> 
+--           TExpr -> 
+--           TExpr
+--
+--tcArrow t1 t2 = TArr t1 t2
+
+
+
+--======================================================--
+tcInt :: TExpr
+
+tcInt = TCons "int" []
+
+
+
+--======================================================--
+tcBool :: TExpr
+
+tcBool = TCons "bool" []
+
+
+
+--======================================================--
+tcTvars_in :: TExpr -> 
+              [TVName]
+
+tcTvars_in t = tvars_in' t []
+               where
+                  tvars_in' (TVar x) l = x:l
+                  tvars_in' (TCons y ts) l = foldr tvars_in' l ts
+                  tvars_in' (TArr t1 t2) l = tvars_in' t1 (tvars_in' t2 l)
+
+
+--==========================================================--
+--=== 9.41 Substitutions                                 ===--
+--==========================================================--
+
+--======================================================--
+tcApply_sub :: Subst ->
+               TVName ->
+               TExpr
+
+tcApply_sub phi tvn 
+   = if TVar tvn == lookUpResult
+        then TVar tvn
+        else tcSub_type phi lookUpResult
+     where
+        lookUpResult = utLookupDef phi tvn (TVar tvn)
+
+
+--======================================================--
+tcSub_type :: Subst -> 
+              TExpr -> 
+              TExpr
+
+tcSub_type phi (TVar tvn) = tcApply_sub phi tvn
+
+tcSub_type phi (TCons tcn ts) = TCons tcn (map (tcSub_type phi) ts)
+
+tcSub_type phi (TArr t1 t2) = TArr (tcSub_type phi t1) (tcSub_type phi t2)
+
+
+--======================================================--
+tcScomp :: Subst -> 
+           Subst -> 
+           Subst
+
+tcScomp sub2 sub1 = sub1 ++ sub2
+
+
+
+--======================================================--
+tcId_subst :: Subst
+
+tcId_subst = []
+
+
+
+--======================================================--
+tcDelta :: TVName -> 
+           TExpr -> 
+           Subst
+-- all TVar -> TVar substitutions lead downhill
+tcDelta tvn (TVar tvn2) 
+   | tvn == tvn2   = []
+   | tvn >  tvn2   = [(tvn, TVar tvn2)]
+   | tvn <  tvn2   = [(tvn2, TVar tvn)]
+
+tcDelta tvn non_var_texpr = [(tvn, non_var_texpr)]
+
+
+--==========================================================--
+--=== 9.42 Unification                                   ===--
+--==========================================================--
+
+--======================================================--
+tcExtend :: Subst -> 
+            TVName -> 
+            TExpr -> 
+            Reply Subst Message
+
+tcExtend phi tvn t 
+    | t == TVar tvn   
+    = Ok phi
+    | tvn `notElem` (tcTvars_in t)
+    = Ok ((tcDelta tvn t) `tcScomp` phi)
+    | otherwise
+    = fail
+         (   "Type error in source program:\n\n"         ++
+             "Circular substitution:\n      "            ++
+             tcShowtExpr (TVar tvn)                     ++ 
+              "\n   going to\n"                          ++
+             "      "                                   ++ 
+              tcShowtExpr t                              ++ 
+              "\n")
+
+
+
+--======================================================--
+tcUnify :: Subst -> 
+           (TExpr, TExpr) -> 
+           Reply Subst Message
+
+tcUnify phi (TVar tvn, t) 
+  = if phitvn == TVar tvn
+       then tcExtend phi tvn phit
+       else tcUnify phi (phitvn, phit)
+     where
+       phitvn = tcApply_sub phi tvn
+       phit = tcSub_type phi t
+
+tcUnify phi (p@(TCons _ _), q@(TVar _))
+   = tcUnify phi (q, p)
+
+tcUnify phi (p@(TArr _ _), q@(TVar _))
+   = tcUnify phi (q, p)
+
+tcUnify phi (TArr t1 t2, TArr t1' t2')
+   = tcUnifyl phi [(t1, t1'), (t2, t2')]
+
+tcUnify phi (TCons tcn ts, TCons tcn' ts') 
+   | tcn == tcn' 
+   = tcUnifyl phi (ts `zip` ts')
+
+tcUnify phi (t1, t2)
+   = fail
+        (   "Type error in source program:\n\n"          ++
+            "Cannot unify\n      "                       ++
+            tcShowtExpr t1                               ++
+            "\n   with\n      "                          ++
+            tcShowtExpr t2                               ++
+            "\n"
+        )
+
+
+
+--======================================================--
+tcUnifyl :: Subst ->  
+            [(TExpr, TExpr)] -> 
+            Reply Subst Message
+
+tcUnifyl phi eqns 
+   = foldr unify' (Ok phi) eqns
+     where
+       unify' eqn (Ok phi) = tcUnify phi eqn
+       unify' eqn (Fail m) = Fail m
+
+
+
+--==========================================================--
+--=== 9.42.2 Merging of substitutions                    ===--
+--==========================================================--
+
+--======================================================--
+tcMergeSubs :: Subst ->
+               Subst
+
+tcMergeSubs phi 
+   = if newBinds == []
+        then unifiedOlds
+        else tcMergeSubs (unifiedOlds ++ newBinds)
+     where
+        (newBinds, unifiedOlds) = tcMergeSubsMain phi
+
+
+
+--======================================================--
+tcMergeSubsMain :: Subst -> 
+                   (Subst, Subst)   -- pair of new binds, unified olds
+
+tcMergeSubsMain phi
+   = (concat newUnifiersChecked,
+      zip oldVars (tcOldUnified newUnifiersChecked oldGroups))
+     where
+        oldVars = nub (utDomain phi)
+        oldGroups = map (utLookupAll phi) oldVars
+        newUnifiers = map (tcUnifySet tcId_subst) oldGroups
+        newUnifiersChecked = map tcCheckUnifier newUnifiers
+
+
+
+--======================================================--
+tcCheckUnifier :: Reply Subst Message -> Subst
+
+tcCheckUnifier (Ok r) = r
+tcCheckUnifier (Fail m) 
+   = panic ("tcCheckUnifier: " ++ m)
+
+
+
+--======================================================--
+tcOldUnified :: [Subst] -> [[TExpr]] -> [TExpr]
+
+tcOldUnified [] [] = []
+tcOldUnified (u:us) (og:ogs) 
+      = (tcSub_type u (head og)): tcOldUnified us ogs
+
+
+--==========================================================--
+--=== 9.5 Keeping track of types                         ===--
+--==========================================================--
+
+--======================================================--
+tcUnknowns_scheme :: TypeScheme -> 
+                     [TVName]
+
+tcUnknowns_scheme (Scheme scvs t) = tcTvars_in t `tcBar` scvs
+
+
+
+--======================================================--
+tcBar :: (Eq a) => [a] -> 
+                   [a] -> 
+                   [a]
+
+tcBar xs ys = [ x | x <- xs,  not (x `elem` ys)]
+
+
+
+--======================================================--
+tcSub_scheme :: Subst -> 
+                TypeScheme -> 
+                TypeScheme
+
+tcSub_scheme phi (Scheme scvs t)
+    = Scheme scvs (tcSub_type (tcExclude phi scvs) t)
+      where
+         tcExclude phi scvs = [(n,e) | (n,e) <- phi,  not (n `elem` scvs)]
+
+
+
+--==========================================================--
+--=== 9.53 Association lists                             ===--
+--==========================================================--
+
+--======================================================--
+tcCharVal :: AList Naam b -> Naam -> b
+
+tcCharVal al k
+   = utLookupDef al k (panic ("tcCharVal: no such variable: " ++ k))
+
+
+--======================================================--
+tcUnknowns_te :: TcTypeEnv -> 
+                 [TVName]
+
+tcUnknowns_te gamma = concat (map tcUnknowns_scheme (utRange gamma))
+
+
+
+--======================================================--
+tcSub_te :: Subst -> 
+            TcTypeEnv -> 
+            TcTypeEnv
+
+tcSub_te phi gamma = [(x, tcSub_scheme phi st) | (x, st) <- gamma]
+
+
+--==========================================================--
+--=== 9.6 New variables                                  ===--
+--==========================================================--
+
+--======================================================--
+tcNext_name :: TypeNameSupply -> 
+               TVName
+
+tcNext_name ns@(f, s) = ns
+
+
+
+--======================================================--
+tcDeplete :: TypeNameSupply -> 
+             TypeNameSupply
+
+tcDeplete (f, s) = (f, tcNSSucc s)
+
+
+
+--======================================================--
+tcSplit :: TypeNameSupply -> 
+           (TypeNameSupply, TypeNameSupply)
+
+tcSplit (f, s) = ((f2, [0]), (tcNSSucc f2, [0]))
+                 where f2 = tcNSDouble f
+
+
+
+--======================================================--
+tcName_sequence :: TypeNameSupply -> 
+                   [TVName]
+
+tcName_sequence ns = tcNext_name ns: tcName_sequence (tcDeplete ns)
+
+
+--======================================================--
+tcNSSucc :: [Int] ->
+            [Int]
+
+tcNSSucc []     = [1]
+tcNSSucc (n:ns) | n < tcNSslimit  = n+1: ns
+                | otherwise       = 0: tcNSSucc ns
+
+
+--======================================================--
+tcNSDouble :: [Int] ->
+              [Int]
+
+tcNSDouble []   = []
+tcNSDouble (n:ns) 
+    = 2*n': ns'
+       where n' | n > tcNSdlimit  = n - tcNSdlimit
+               | otherwise       = n
+            ns' | n' == n    = tcNSDouble ns
+                | otherwise  = tcNSSucc (tcNSDouble ns)
+
+                       
+tcNSdlimit :: Int
+tcNSdlimit = 2^30
+
+tcNSslimit :: Int
+tcNSslimit = tcNSdlimit + (tcNSdlimit - 1)
+
+
+--==========================================================--
+--=== 9.7 The type-checker                               ===--
+--==========================================================--
+
+
+--======================================================--
+tc :: [TypeDef] ->
+      TcTypeEnv -> 
+      TypeNameSupply -> 
+      CExpr -> 
+      Reply TypeInfo Message
+
+tc tds gamma ns (ENum n) 
+   = Ok (tcId_subst, TCons "int" [], (TCons "int" [], ANum n))
+
+tc tds gamma ns (EVar x) 
+   = tcvar tds gamma ns x
+
+tc tds gamma ns (EConstr c)
+   = tcvar tds gamma ns c
+
+tc tds gamma ns (EAp e1 e2)
+   = tcap tds gamma ns e1 e2
+
+tc tds gamma ns (ELam [] e)
+   = tc tds gamma ns e
+tc tds gamma ns (ELam [x] e)
+   = tclambda tds gamma ns x e
+tc tds gamma ns (ELam (x:y:xs) e)
+   = tclambda tds gamma ns x (ELam (y:xs) e)
+
+tc tds gamma ns (ELet recursive dl e)
+   = if not recursive
+        then tclet tds gamma ns xs es e
+        else tcletrec tds gamma ns xs es e
+     where
+       (xs, es) = unzip2 dl
+
+tc tds gamma ns (ECase switch alts)
+   = tccase tds gamma ns switch constructors arglists exprs
+     where
+        (constructors, alters) = unzip2 alts
+        (arglists, exprs) = unzip2 alters
+
+--==========================================================--
+--=== 0.00 Type-checking case-expressions                ===--
+--==========================================================--
+
+tcConstrTypeSchemes :: TypeNameSupply ->
+                       TypeDef ->
+                       (TypeNameSupply, AList Naam TypeScheme)
+
+tcConstrTypeSchemes ns (tn, stvs, cal)
+   = (finalNameSupply, map2nd enScheme cAltsCurried)
+     where
+        -- associates new type vars with each poly var
+        -- in the type
+        newTVs = tcNewTypeVars (tn, stvs, cal) ns
+
+        -- the actual type variables themselves
+        tVs = map second newTVs
+
+        -- the types of the constructor functions         
+        cAltsCurried = map2nd (foldr TArr tdSignature) cAltsXLated
+        cAltsXLated = map2nd (map (tcTDefSubst newTVs)) cal
+        tdSignature = TCons tn (map TVar tVs)
+        enScheme texp = Scheme ((nub.tcTvars_in) texp) texp
+
+        -- the revised name supply
+        finalNameSupply = applyNtimes ( length tVs + 2) tcDeplete ns
+
+        -- apply a function n times to an arg
+        applyNtimes n func arg 
+           | n ==0       = arg
+           | otherwise   = applyNtimes (n-1) func (func arg)
+                    
+
+
+--======================================================--
+--
+tccase :: [TypeDef] ->         -- constructor type definitions
+          TcTypeEnv ->         -- current type bindings
+          TypeNameSupply ->    -- name supply
+          CExpr ->             -- switch expression
+          [Naam] ->            -- constructors
+          [[Naam]] ->          -- argument lists
+          [CExpr] ->           -- resulting expressions
+          Reply TypeInfo Message
+
+
+tccase tds gamma ns sw cs als res
+-- get the type definition in use, & an association of
+-- variables therein to type vars & pass
+-- Also, reorder the argument lists
+-- and resulting expressions so as to reflect the 
+-- sequence of constructors in the definition
+ = if length tdCNames /=  length (nub cs)
+      then  fail
+            "Error in source program: missing alternatives in CASE"
+      else tccase1 tds gamma ns1 sw reOals reOres newTVs tdInUse
+     where
+        tdInUse = tcGetTypeDef tds cs
+        newTVs = tcNewTypeVars tdInUse ns2
+        (ns1, ns2) = tcSplit ns
+        merge = zip cs (zip als res)
+        tdCNames = map first (tcK33 tdInUse)
+        (reOals, reOres) = unzip2 (tcReorder tdCNames merge)
+
+
+
+--======================================================--
+--
+tcReorder :: [Naam] -> [(Naam,b)] -> [b]
+
+tcReorder []     uol =  []
+tcReorder (k:ks) uol 
+   = (utLookupDef uol k 
+        (fail
+            ("Error in source program: undeclared constructor '" ++ k ++
+               "' in CASE") ) )
+        : tcReorder ks uol 
+
+
+--======================================================--
+-- Projection functions and similar rubbish.
+tcDeOksel (Ok x) = x
+tcDeOksel (Fail m) = panic ("tcDeOkSel: " ++ m)
+tcOk13sel (Ok (a, b, c)) = a
+tcOk13sel (Fail m) = panic ("tcOk13sel: " ++ m)
+tcOk23sel (Ok (a, b, c)) = b
+tcOk23sel (Fail m) = panic ("tcOk23sel: " ++ m)
+tcOk33sel (Ok (a, b, c)) = c
+tcOk33sel (Fail m) = panic ("tcOk33sel: " ++ m)
+tcK31sel (a, b, c) = a
+tcK33 (a,b,c) = c
+
+
+
+--======================================================--
+--
+tccase1 :: [TypeDef] ->
+           TcTypeEnv -> 
+           TypeNameSupply ->
+           CExpr -> 
+           [[Naam]] ->
+           [CExpr] ->
+           AList Naam TVName ->
+           TypeDef ->
+           Reply TypeInfo Message
+
+tccase1 tds gamma ns sw reOals reOres newTVs tdInUse
+-- calculate all the gammas for the RHS's
+-- call tc for each RHS, so as to gather all the
+-- sigmas and types for each RHS, then pass on
+   = tccase2 tds gamma ns2 sw reOals newTVs tdInUse rhsTcs
+     where
+        rhsGammas = tcGetAllGammas newTVs (tcK33 tdInUse) reOals
+        rhsTcs = rhsTc1 ns1 rhsGammas reOres
+        rhsTc1 nsl []     []     = []
+        rhsTc1 nsl (g:gs) (r:rs) 
+           = tc tds (g++gamma) nsl1 r : rhsTc1 nsl2 gs rs
+             where (nsl1, nsl2) = tcSplit nsl
+        (ns1, ns2) = tcSplit ns  
+        
+
+--======================================================--
+--
+tccase2 :: [TypeDef] ->
+           TcTypeEnv -> 
+           TypeNameSupply ->
+           CExpr -> 
+           [[Naam]] ->
+           AList Naam TVName ->
+           TypeDef ->
+           [Reply TypeInfo Message] ->
+           Reply TypeInfo Message
+
+tccase2 tds gamma ns sw reOals newTVs tdInUse rhsTcs
+-- get the unifiers for T1 to Tk and hence the unifier for all
+-- type variables in the type definition.  Also compute the
+-- unifier of the result types.
+   = tccase3 tds gamma ns sw reOals newTVs tdInUse rhsTcs 
+             phi_1_to_n tau_1_to_n phi_rhs
+     where
+        phi_1_to_n = map tcOk13sel rhsTcs
+        tau_1_to_n = map tcOk23sel rhsTcs
+        phi_rhs = tcDeOksel (tcUnifySet tcId_subst tau_1_to_n)
+
+
+--======================================================--
+--
+tccase3 :: [TypeDef] ->                    -- tds
+           TcTypeEnv ->                    -- gamma
+           TypeNameSupply ->               -- ns
+           CExpr ->                        -- sw
+           [[Naam]] ->                     -- reOals
+           AList Naam TVName ->            -- newTVs
+           TypeDef ->                      -- tdInUse
+           [Reply TypeInfo Message] ->     -- rhsTcs
+           [Subst] ->                      -- phi_1_to_n
+           [TExpr] ->                      -- tau_1_to_n
+           Subst ->                        -- phi_rhs
+           Reply TypeInfo Message
+
+tccase3 tds gamma ns sw reOals newTVs tdInUse rhsTcs
+        phi_1_to_n tau_1_to_n phi_rhs
+-- make up substitutions for each of the unknown tvars
+-- merge the substitutions into one
+-- apply the substitution to the typedef's signature to get the
+-- most general allowable input type
+-- call tc to get the type of the switch expression
+-- check that this is an instance of the deduced input type
+-- gather the new bindings from the RHSs and switch expression
+-- return Ok (the big substitution, the result type, gathered bindings)
+   = Ok (phi_Big, tau_final, 
+            (tau_final, ACase tree_s 
+                        (zip tdCNames (zip reOals annotatedRHSs))))
+     where
+        phi_sTau_sTree_s = tc tds gamma ns sw 
+        phi_s  = tcOk13sel phi_sTau_sTree_s
+        tau_s  = tcOk23sel phi_sTau_sTree_s
+        tree_s = tcOk33sel phi_sTau_sTree_s
+        
+        phi = tcMergeSubs (concat phi_1_to_n ++ phi_rhs ++ phi_s)
+
+        tau_lhs = tcSub_type phi tdSignature
+
+        phi_lhs = tcUnify tcId_subst (tau_lhs, tau_s) -- reverse these?
+
+        phi_Big = tcMergeSubs (tcDeOksel phi_lhs ++ phi) 
+
+        tau_final = tcSub_type phi_Big (head (map tcOk23sel rhsTcs))
+
+        annotatedRHSs = map tcOk33sel rhsTcs
+        tVs = map second newTVs
+        tdSignature = TCons (tcK31sel tdInUse) (map TVar tVs)
+        tdCNames = map first (tcK33 tdInUse)
+
+
+--======================================================--
+--
+tcUnifySet :: Subst -> 
+              [TExpr] -> 
+              Reply Subst Message
+
+tcUnifySet sub (e1:[]) = Ok sub
+tcUnifySet sub (e1:e2:[]) 
+   = tcUnify sub (e1, e2)
+tcUnifySet sub (e1:e2:e3:es) 
+   = tcUnifySet newSub (e2:e3:es)
+     where 
+        newSub = tcDeOksel (tcUnify sub (e1, e2))
+
+
+--======================================================--
+--
+tcNewTypeVars :: TypeDef -> 
+                 TypeNameSupply ->
+                 AList Naam TVName
+
+tcNewTypeVars (t, vl, c) ns = zip vl (tcName_sequence ns)
+
+
+
+--======================================================--
+--
+tcGetGammaN :: AList Naam TVName ->
+               ConstrAlt -> 
+               [Naam] ->
+               AList Naam TypeScheme
+
+tcGetGammaN tvl (cname, cal) cparams 
+   = zip cparams (map (Scheme [] . tcTDefSubst tvl) cal)
+
+
+
+--======================================================--
+--
+tcTDefSubst :: AList Naam TVName ->
+               TDefExpr ->
+               TExpr
+
+tcTDefSubst nameMap (TDefVar n)
+   = f result 
+     where
+        f (Just tvn) = TVar tvn
+        f Nothing    = TCons n []
+        result = utLookup nameMap n
+
+tcTDefSubst nameMap (TDefCons c al)
+   = TCons c (map (tcTDefSubst nameMap) al)
+
+
+--======================================================--
+--
+tcGetAllGammas :: AList Naam TVName ->
+                  [ConstrAlt] ->
+                  [[Naam]] ->
+                  [AList Naam TypeScheme]
+
+tcGetAllGammas tvl []           [] = []
+-- note param lists cparamss must be ordered in
+-- accordance with calts
+tcGetAllGammas tvl (calt:calts) (cparams:cparamss) = 
+      tcGetGammaN tvl calt cparams : 
+         tcGetAllGammas tvl calts cparamss
+
+
+--======================================================--
+--
+tcGetTypeDef :: [TypeDef] ->    -- type definitions
+                [Naam] ->       -- list of constructors used here
+                TypeDef
+
+tcGetTypeDef tds cs 
+   = if length tdefset == 0 
+        then fail "Undeclared constructors in use"
+     else if length tdefset > 1
+        then fail "CASE expression contains mixed constructors"
+     else head tdefset
+     where
+        tdefset = nub
+                  [ (tname, ftvs, cl) |
+                    (tname, ftvs, cl) <- tds,
+                    usedc <- cs,
+                    usedc `elem` (map first cl) ]
+
+
+--==========================================================--
+--=== 9.71 Type-checking lists of expressions            ===--
+--==========================================================--
+
+--======================================================--
+--
+tcl :: [TypeDef] ->
+       TcTypeEnv     -> 
+       TypeNameSupply  -> 
+       [CExpr]       -> 
+       Reply (Subst, [TExpr], [AnnExpr Naam TExpr]) Message
+
+tcl tds gamma ns []
+   = Ok (tcId_subst, [], [])
+tcl tds gamma ns (e:es) 
+   = tcl1 tds gamma ns0 es (tc tds gamma ns1 e)
+     where
+        (ns0, ns1) = tcSplit ns
+
+
+--======================================================--
+--
+tcl1 tds gamma ns es (Fail m) = Fail m
+tcl1 tds gamma ns es (Ok (phi, t, annotatedE)) 
+   = tcl2 phi t (tcl tds (tcSub_te phi gamma) ns es) annotatedE
+
+
+--======================================================--
+--
+tcl2 phi t (Fail m) annotatedE = Fail m
+tcl2 phi t (Ok (psi, ts, annotatedEs)) annotatedE 
+   = Ok (psi `tcScomp` phi, (tcSub_type psi t):ts, 
+         annotatedE:annotatedEs)
+
+
+--==========================================================--
+--=== 9.72 Type-checking variables                       ===--
+--==========================================================--
+
+--======================================================--
+--
+tcvar :: [TypeDef] ->
+         TcTypeEnv     -> 
+         TypeNameSupply  -> 
+         Naam        -> 
+         Reply TypeInfo Message
+
+tcvar tds gamma ns x = Ok (tcId_subst, finalType, (finalType, AVar x))
+                       where
+                          scheme = tcCharVal gamma x
+                          finalType = tcNewinstance ns scheme
+
+
+--======================================================--
+--
+tcNewinstance :: TypeNameSupply -> 
+                 TypeScheme -> 
+                 TExpr
+
+tcNewinstance ns (Scheme scvs t) = tcSub_type phi t
+                                   where 
+                                      al  = scvs `zip` (tcName_sequence ns)
+                                      phi = tcAl_to_subst al
+
+
+--======================================================--
+--
+tcAl_to_subst :: AList TVName TVName -> 
+                 Subst
+
+tcAl_to_subst al = map2nd TVar al
+
+
+--==========================================================--
+--=== 9.73 Type-checking applications                    ===--
+--==========================================================--
+
+--======================================================--
+--
+tcap :: [TypeDef] ->
+        TcTypeEnv     -> 
+        TypeNameSupply  -> 
+        CExpr         -> 
+        CExpr         -> 
+        Reply TypeInfo Message
+
+tcap tds gamma ns e1 e2 = tcap1 tvn (tcl tds gamma ns' [e1, e2])
+                          where
+                             tvn = tcNext_name ns
+                             ns' = tcDeplete ns
+
+
+--======================================================--
+--
+tcap1 tvn (Fail m)
+   = Fail m
+tcap1 tvn (Ok (phi, [t1, t2], [ae1, ae2])) 
+   = tcap2 tvn (tcUnify phi (t1, t2 `TArr` (TVar tvn))) [ae1, ae2]
+
+
+--======================================================--
+--
+tcap2 tvn (Fail m) [ae1, ae2]
+   = Fail m
+tcap2 tvn (Ok phi) [ae1, ae2] 
+   = Ok (phi, finalType, (finalType, AAp ae1 ae2))
+     where
+        finalType = tcApply_sub phi tvn
+
+
+--==========================================================--
+--=== 9.74 Type-checking lambda abstractions             ===--
+--==========================================================--
+
+--======================================================--
+--
+tclambda :: [TypeDef] ->
+            TcTypeEnv     -> 
+            TypeNameSupply  -> 
+            Naam        -> 
+            CExpr         -> 
+            Reply TypeInfo Message
+
+tclambda tds gamma ns x e = tclambda1 tvn x (tc tds gamma' ns' e)
+                            where
+                               ns' = tcDeplete ns
+                               gamma' = tcNew_bvar (x, tvn): gamma
+                               tvn = tcNext_name ns
+
+
+--======================================================--
+--
+tclambda1 tvn x (Fail m) = Fail m
+
+tclambda1 tvn x (Ok (phi, t, annotatedE)) = 
+   Ok (phi, finalType, (finalType, ALam [x] annotatedE))
+   where
+      finalType = (tcApply_sub phi tvn) `TArr` t
+
+
+--======================================================--
+--
+tcNew_bvar (x, tvn) = (x, Scheme [] (TVar tvn))
+
+
+--==========================================================--
+--=== 9.75 Type-checking let-expressions                 ===--
+--==========================================================--
+
+--======================================================--
+--
+tclet :: [TypeDef] ->
+         TcTypeEnv     -> 
+         TypeNameSupply  -> 
+         [Naam]       -> 
+         [CExpr]       -> 
+         CExpr         -> 
+         Reply TypeInfo Message
+
+tclet tds gamma ns xs es e 
+   = tclet1 tds gamma ns0 xs e rhsTypes
+     where
+        (ns0, ns1) = tcSplit ns
+        rhsTypes = tcl tds gamma ns1 es
+        
+
+--======================================================--
+--
+tclet1 tds gamma ns xs e (Fail m) = Fail m
+
+tclet1 tds gamma ns xs e (Ok (phi, ts, rhsAnnExprs)) 
+   = tclet2 phi xs False (tc tds gamma'' ns1 e) rhsAnnExprs
+     where
+        gamma'' = tcAdd_decls gamma' ns0 xs ts
+        gamma'  = tcSub_te phi gamma
+        (ns0, ns1) = tcSplit ns
+
+
+--======================================================--
+--
+tclet2 phi xs recFlag (Fail m) rhsAnnExprs = Fail m
+
+tclet2 phi xs recFlag (Ok (phi', t, annotatedE)) rhsAnnExprs
+   = Ok (phi' `tcScomp` phi, t, (t, ALet recFlag (zip xs rhsAnnExprs) annotatedE))
+
+
+--======================================================--
+--
+tcAdd_decls :: TcTypeEnv     ->
+               TypeNameSupply  -> 
+               [Naam]       ->
+               [TExpr]   ->
+               TcTypeEnv
+
+tcAdd_decls gamma ns xs ts = (xs `zip` schemes) ++ gamma
+                             where
+                                schemes = map (tcGenbar unknowns ns) ts
+                                unknowns = tcUnknowns_te gamma
+
+
+--======================================================--
+--
+tcGenbar unknowns ns t = Scheme (map second al) t'
+                         where
+                            al = scvs `zip` (tcName_sequence ns)
+                            scvs = (nub (tcTvars_in t)) `tcBar` unknowns
+                            t' = tcSub_type (tcAl_to_subst al) t
+
+
+
+--==========================================================--
+--=== 9.76 Type-checking letrec-expressions              ===--
+--==========================================================--
+
+--======================================================--
+--
+tcletrec :: [TypeDef] ->
+            TcTypeEnv     -> 
+            TypeNameSupply  -> 
+            [Naam]       -> 
+            [CExpr]       -> 
+            CExpr         -> 
+            Reply TypeInfo Message
+
+tcletrec tds gamma ns xs es e 
+   = tcletrec1 tds gamma ns0 xs nbvs e 
+               (tcl tds (nbvs ++ gamma) ns1 es)
+     where
+        (ns0, ns') = tcSplit ns
+        (ns1, ns2) = tcSplit ns'
+        nbvs = tcNew_bvars xs ns2
+
+
+--======================================================--
+--
+tcNew_bvars xs ns = map tcNew_bvar (xs `zip` (tcName_sequence ns))
+
+
+
+--======================================================--
+--
+tcletrec1 tds gamma ns xs nbvs e (Fail m) = (Fail m)
+
+tcletrec1 tds gamma ns xs nbvs e (Ok (phi, ts, rhsAnnExprs)) 
+   = tcletrec2 tds gamma' ns xs nbvs' e (tcUnifyl phi (ts `zip` ts')) rhsAnnExprs
+     where
+        ts' = map tcOld_bvar nbvs'
+        nbvs' = tcSub_te phi nbvs
+        gamma' = tcSub_te phi gamma
+
+
+--======================================================--
+--
+tcOld_bvar (x, Scheme [] t) = t
+
+
+--======================================================--
+--
+tcletrec2 tds gamma ns xs nbvs e (Fail m) rhsAnnExprs = (Fail m)
+
+tcletrec2 tds gamma ns xs nbvs e (Ok phi) rhsAnnExprs
+   = tclet2 phi xs True (tc tds gamma'' ns1 e) rhsAnnExprs 
+     where
+        ts = map tcOld_bvar nbvs'
+        nbvs' = tcSub_te phi nbvs
+        gamma' = tcSub_te phi gamma
+        gamma'' = tcAdd_decls gamma' ns0 (map first nbvs) ts
+        (ns0, ns1) = tcSplit ns
+        subnames = map first nbvs
+
+
+--==========================================================--
+--=== End                               TypeCheck5.m (1) ===--
+--==========================================================--
diff --git a/ghc/tests/programs/jules_xref/jules_xref.stdout b/ghc/tests/programs/jules_xref/jules_xref.stdout
new file mode 100644 (file)
index 0000000..b92c5a0
--- /dev/null
@@ -0,0 +1,500 @@
+("A", [3])
+("AAp", [26, 27, 63, 937])
+("ACase", [30, 31, 67, 719])
+("AConstr", [25, 25, 62])
+("ALam", [32, 32, 64, 967])
+("ALet", [28, 29, 65, 1015])
+("AList", [415, 553, 649, 675, 700, 762, 770, 773, 782, 799, 802, 899])
+("ANum", [24, 24, 61, 515])
+("AVar", [23, 23, 60, 879])
+("Also", [596, 682])
+("AnnExpr", [17, 18, 44, 45, 52, 120, 842])
+("Association", [411])
+("AtomicProgram", [119])
+("BaseDefs", [8])
+("Big", [718, 733, 735])
+("CASE", [601, 622, 822])
+("CExpr", [511, 586, 589, 646, 648, 673, 698, 841, 914, 915, 952, 987, 988, 1052, 1053])
+("Cannot", [306])
+("Char", [78, 109, 120])
+("Circular", [268])
+("ConstrAlt", [771, 800])
+("Corrected", [4])
+("EAp", [523])
+("ECase", [540])
+("EConstr", [520])
+("ELam", [526, 528, 530, 531])
+("ELet", [533])
+("ENum", [514])
+("EVar", [517])
+("End", [1104])
+("Eq", [390])
+("Error", [601, 621])
+("Fail", [125, 131, 324, 324, 364, 629, 631, 633, 635, 854, 854, 861, 861, 926, 927, 934, 935, 964, 964, 1000, 1000, 1012, 1012, 1073, 1073, 1090, 1090])
+("False", [81, 89, 90, 92, 131, 150, 1003])
+("File", [3])
+("Formatting", [13])
+("Int", [474, 475, 483, 484, 495, 498])
+("Just", [789])
+("Keeping", [378])
+("Merging", [329])
+("Message", [120, 258, 280, 318, 361, 512, 590, 651, 677, 678, 702, 706, 747, 842, 877, 916, 953, 989, 1054])
+("MyUtils", [10])
+("Naam", [44, 45, 52, 108, 120, 415, 415, 553, 587, 588, 615, 615, 647, 649, 674, 675, 699, 700, 762, 770, 772, 773, 782, 799, 801, 802, 815, 842, 876, 951, 986, 1022, 1051])
+("New", [438])
+("No", [125])
+("Nothing", [790])
+("Ok", [124, 130, 133, 262, 264, 321, 323, 363, 515, 628, 630, 632, 634, 717, 718, 749, 845, 855, 862, 863, 879, 928, 936, 937, 966, 967, 1002, 1014, 1015, 1075, 1092])
+("Projection", [627])
+("RHS", [654, 655, 656])
+("RHSs", [716])
+("Reply", [120, 258, 280, 318, 361, 512, 590, 651, 677, 678, 702, 706, 747, 842, 877, 916, 953, 989, 1054])
+("Representation", [155])
+("Scheme", [141, 385, 403, 404, 569, 776, 891, 974, 1034, 1085])
+("Subst", [43, 197, 210, 222, 223, 224, 231, 240, 255, 258, 278, 280, 316, 318, 333, 334, 346, 347, 347, 361, 361, 370, 399, 430, 703, 705, 745, 747, 842, 900])
+("Substitutions", [193])
+("T1", [681])
+("TArr", [87, 90, 103, 163, 189, 218, 218, 293, 296, 296, 566, 929, 969])
+("TCons", [84, 85, 86, 93, 102, 170, 177, 188, 216, 216, 290, 299, 299, 515, 515, 568, 739, 790, 794])
+("TDefCons", [793])
+("TDefExpr", [783])
+("TDefVar", [786])
+("TExpr", [44, 45, 52, 77, 108, 120, 159, 160, 161, 168, 175, 182, 199, 211, 212, 239, 257, 279, 279, 317, 317, 370, 370, 704, 746, 784, 842, 842, 889, 1023])
+("TVName", [183, 198, 238, 256, 383, 423, 443, 468, 649, 675, 700, 762, 770, 782, 799, 899, 899])
+("TVar", [83, 101, 187, 202, 203, 206, 214, 241, 241, 242, 244, 245, 261, 269, 282, 283, 290, 293, 568, 739, 789, 902, 929, 974])
+("TcTypeEnv", [117, 422, 431, 432, 509, 584, 644, 671, 696, 839, 874, 912, 949, 984, 1020, 1024, 1049])
+("The", [503])
+("Tk", [681])
+("True", [87, 88, 91, 95, 130, 150, 1093])
+("Type", [97, 267, 305, 548, 833, 868, 906, 943, 978, 1043])
+("TypeCheck5", [3, 7, 1104])
+("TypeDef", [508, 552, 583, 643, 650, 670, 676, 695, 701, 760, 814, 816, 838, 873, 911, 948, 983, 1048])
+("TypeEnv", [53, 120])
+("TypeInfo", [512, 590, 651, 677, 678, 702, 706, 877, 916, 953, 989, 1054])
+("TypeNameSupply", [118, 442, 450, 451, 458, 459, 459, 467, 510, 551, 553, 585, 645, 672, 697, 761, 840, 875, 887, 913, 950, 985, 1021, 1050])
+("TypeScheme", [382, 400, 401, 553, 773, 802, 888])
+("Undeclared", [820])
+("Unification", [251])
+("Utils", [9])
+("a", [4, 16, 17, 390, 390, 391, 392, 574, 630, 630, 632, 634, 636, 636, 637])
+("aFN", [66, 70])
+("abstractions", [943])
+("accordance", [806])
+("actual", [562])
+("ae1", [26, 27, 63, 63, 928, 929, 934, 936, 937])
+("ae2", [26, 27, 63, 63, 928, 929, 934, 936, 937])
+("al", [417, 418, 793, 794, 893, 894, 902, 902, 1034, 1036, 1038])
+("all", [241, 654, 655, 681])
+("allowable", [713])
+("als", [593, 607])
+("alternatives", [601])
+("alters", [543, 544])
+("alts", [67, 68, 540, 543])
+("an", [574, 594, 715])
+("and", [597, 627, 656, 681, 716])
+("ann", [20, 21])
+("annAlts", [30, 31])
+("annDefs", [28, 29])
+("annoTree", [133, 135])
+("annotatedE", [855, 856, 861, 862, 864, 966, 967, 1014, 1015])
+("annotatedEs", [862, 864])
+("annotatedRHSs", [720, 737])
+("applications", [906])
+("apply", [574, 712])
+("applyNtimes", [572, 575, 577])
+("arg", [574, 575, 576, 577])
+("arglists", [541, 544])
+("argument", [588, 596])
+("as", [597, 655])
+("associates", [558])
+("association", [594])
+("b", [16, 18, 83, 84, 85, 86, 93, 415, 415, 615, 615, 630, 632, 632, 634, 636, 637])
+("baseTypes", [122, 128])
+("be", [805])
+("big", [717])
+("bindings", [584, 716, 717])
+("binds", [347])
+("body", [70, 71])
+("bool", [85, 85, 150, 177])
+("builtInTypes", [127, 146, 149])
+("bvar", [958, 974, 1067, 1078, 1085, 1095])
+("bvars", [1062, 1067])
+("c", [17, 18, 25, 25, 62, 102, 520, 521, 630, 632, 634, 634, 636, 637, 637, 764, 793, 794])
+("cAltsCurried", [556, 566])
+("cAltsXLated", [566, 567])
+("cal", [555, 560, 567, 775, 776])
+("calculate", [654])
+("call", [655, 714])
+("calt", [807, 808])
+("calts", [806, 807, 809])
+("case", [548])
+("char", [86, 86])
+("check", [715])
+("checker", [3, 503])
+("checking", [548, 833, 868, 906, 943, 978, 1043])
+("chr", [83])
+("cl", [93, 95, 826, 827, 829])
+("cname", [775])
+("compute", [682])
+("concat", [66, 68, 95, 102, 143, 147, 350, 425, 727])
+("constrTypes", [145, 147])
+("constructor", [565, 583, 621])
+("constructors", [541, 543, 587, 598, 815, 820, 822])
+("contains", [822])
+("cparams", [775, 776, 807, 808])
+("cparamss", [805, 807, 809])
+("cs", [64, 593, 599, 604, 607, 818, 828])
+("current", [584])
+("decls", [1005, 1020, 1026, 1098])
+("deduced", [715])
+("definition", [594, 598, 682])
+("definitions", [583, 814])
+("dl", [65, 66, 533, 538])
+("downhill", [241])
+("e", [32, 32, 64, 64, 406, 406, 526, 527, 528, 529, 530, 531, 533, 535, 536, 846, 847, 955, 955, 991, 992, 1000, 1002, 1003, 1056, 1057, 1073, 1075, 1076, 1090, 1092, 1093])
+("e1", [523, 524, 749, 750, 751, 752, 755, 918, 918])
+("e2", [523, 524, 750, 751, 752, 753, 755, 918, 918])
+("e3", [752, 753])
+("each", [558, 655, 656, 710])
+("elem", [394, 406, 829])
+("else", [125, 204, 285, 339, 536, 602, 821, 823])
+("enScheme", [556, 569])
+("eqn", [323, 323, 324])
+("eqns", [320, 321])
+("error", [267, 305])
+("es", [535, 536, 538, 752, 753, 846, 847, 854, 855, 856, 991, 995, 1056, 1058])
+("expr", [34, 35, 122, 128])
+("expression", [586, 714, 716, 822])
+("expressions", [155, 548, 589, 597, 833, 978, 1043])
+("exprs", [541, 544])
+("f", [20, 21, 27, 27, 29, 31, 32, 35, 38, 133, 133, 139, 141, 445, 453, 453, 461, 462, 787, 789, 790])
+("f2", [461, 461, 462])
+("fail", [266, 304, 600, 620, 820, 822])
+("failed", [97])
+("final", [718, 719, 735])
+("finalConstrTypes", [128, 139, 147])
+("finalNameSupply", [556, 572])
+("finalNs", [128, 145])
+("finalType", [879, 879, 882, 937, 937, 939, 967, 967, 969])
+("first", [608, 740, 829, 1098, 1100])
+("foldr", [188, 321, 566])
+("for", [4, 654, 655, 656, 681, 681, 710])
+("from", [716])
+("ftvs", [826, 827])
+("fullEnv", [124, 139, 143])
+("fullEnvWords", [124, 143])
+("func", [575, 577, 577])
+("function", [574])
+("functions", [565, 627])
+("g", [662, 663])
+("gamma", [425, 425, 434, 434, 514, 517, 518, 520, 521, 523, 524, 526, 527, 528, 529, 530, 531, 533, 535, 536, 540, 541, 593, 602, 653, 657, 663, 680, 684, 696, 708, 722, 844, 846, 847, 847, 854, 855, 856, 879, 881, 918, 918, 955, 955, 958, 958, 991, 992, 995, 1000, 1002, 1003, 1005, 1005, 1006, 1006, 1026, 1026, 1029, 1056, 1057, 1058, 1073, 1075, 1076, 1080, 1080, 1090, 1092, 1093, 1097, 1097, 1098, 1098])
+("gammas", [654])
+("gather", [655, 716])
+("gathered", [717])
+("general", [713])
+("get", [594, 681, 712, 714])
+("going", [270])
+("good", [123, 130, 131])
+("gs", [662, 663])
+("head", [374, 735, 823])
+("hence", [681])
+("here", [815])
+("if", [123, 202, 283, 337, 534, 599, 819, 821])
+("import", [8, 9, 10])
+("in", [182, 185, 185, 187, 188, 188, 189, 189, 189, 263, 267, 305, 385, 559, 569, 594, 598, 601, 601, 621, 622, 682, 805, 820, 1037])
+("input", [713, 715])
+("instance", [715])
+("int", [84, 84, 170, 515, 515])
+("into", [711])
+("is", [715])
+("k", [417, 418, 418, 618, 619, 621])
+("ks", [618, 623])
+("l", [187, 187, 188, 188, 189, 189])
+("lambda", [943])
+("lead", [241])
+("length", [572, 599, 599, 819, 821])
+("let", [978])
+("letrec", [1043])
+("lhs", [729, 731, 731, 733])
+("list", [815])
+("lists", [411, 588, 596, 805, 833])
+("ljustify", [112])
+("lookUpResult", [202, 204, 206])
+("lookup", [83, 96, 97, 98, 99])
+("m", [3, 324, 324, 364, 365, 629, 629, 631, 631, 633, 633, 635, 635, 854, 854, 861, 861, 926, 927, 934, 935, 964, 964, 1000, 1000, 1012, 1012, 1073, 1073, 1090, 1090, 1104])
+("mainExpr", [28, 29])
+("make", [710])
+("map", [29, 31, 66, 68, 95, 102, 139, 143, 216, 354, 355, 356, 425, 563, 567, 568, 608, 687, 688, 735, 737, 738, 739, 740, 776, 794, 829, 1028, 1034, 1067, 1078, 1095, 1098, 1100])
+("map2nd", [556, 566, 567, 902])
+("mapAccuml", [146])
+("mapAnnAlt", [31, 37])
+("mapAnnDefn", [29, 34])
+("mapAnnExpr", [21, 23, 24, 25, 26, 28, 30, 32])
+("me", [65, 66])
+("merge", [607, 609, 711])
+("missing", [601])
+("mixed", [822])
+("module", [7])
+("most", [713])
+("must", [805])
+("n", [24, 24, 61, 112, 267, 267, 268, 270, 270, 273, 305, 305, 306, 308, 308, 310, 406, 406, 406, 478, 478, 478, 487, 488, 489, 489, 489, 490, 491, 491, 514, 515, 574, 575, 576, 577, 685, 685, 687, 688, 689, 703, 704, 709, 709, 727, 786, 790, 791])
+("naam", [34, 35, 37, 38, 70, 71, 111, 112, 141, 141])
+("name", [97, 442, 445, 470, 571, 585, 920, 959])
+("nameMap", [786, 791, 793, 794])
+("nbvs", [1057, 1058, 1062, 1073, 1075, 1076, 1078, 1079, 1079, 1090, 1092, 1095, 1096, 1096, 1098, 1100])
+("new", [347, 558, 716])
+("newBinds", [337, 339, 341])
+("newSub", [753, 755])
+("newTVs", [560, 563, 567, 602, 605, 653, 657, 659, 680, 684, 700, 708, 738])
+("newUnifiers", [355, 356])
+("newUnifiersChecked", [350, 351, 356])
+("no", [418])
+("node", [20, 21, 58, 58])
+("nodeType", [58])
+("non", [247, 247])
+("not", [394, 406, 534])
+("notArrow", [93, 94])
+("notElem", [263])
+("note", [805])
+("ns", [122, 146, 445, 445, 470, 470, 470, 478, 478, 479, 487, 488, 491, 491, 492, 514, 517, 518, 520, 521, 523, 524, 526, 527, 528, 529, 530, 531, 533, 535, 536, 540, 541, 555, 560, 572, 593, 606, 653, 665, 680, 684, 697, 708, 722, 764, 764, 844, 846, 849, 854, 855, 856, 879, 882, 891, 893, 918, 918, 920, 921, 921, 955, 955, 957, 957, 959, 991, 994, 1000, 1002, 1007, 1026, 1028, 1034, 1036, 1056, 1060, 1060, 1061, 1067, 1067, 1073, 1075, 1076, 1090, 1092, 1099])
+("ns0", [847, 849, 992, 994, 1005, 1007, 1057, 1060, 1098, 1099])
+("ns1", [602, 606, 660, 665, 847, 849, 994, 995, 1003, 1007, 1058, 1061, 1093, 1099])
+("ns2", [605, 606, 657, 665, 1061, 1062])
+("nsl", [661, 662, 664])
+("nsl1", [663, 664])
+("nsl2", [663, 664])
+("nub", [100, 353, 569, 599, 825, 1037])
+("of", [13, 155, 329, 347, 378, 565, 594, 598, 683, 710, 714, 715, 815, 833])
+("og", [373, 374])
+("ogs", [373, 374])
+("oldGroups", [351, 354, 355])
+("oldVars", [351, 353, 354])
+("olds", [347])
+("on", [656])
+("one", [711])
+("ordered", [805])
+("otherwise", [99, 265, 479, 490, 492, 577])
+("p", [290, 291, 293, 294])
+("pair", [347])
+("panic", [97, 365, 418, 629, 631, 633, 635])
+("param", [805])
+("pars", [37, 38])
+("pass", [595, 656])
+("phi", [47, 47, 201, 204, 206, 214, 214, 216, 216, 218, 218, 218, 260, 262, 264, 282, 284, 285, 287, 288, 290, 291, 293, 294, 296, 297, 299, 301, 303, 320, 321, 323, 323, 336, 341, 349, 353, 354, 403, 404, 406, 406, 434, 434, 685, 685, 687, 689, 703, 705, 709, 709, 718, 722, 723, 723, 724, 725, 727, 727, 727, 727, 729, 731, 733, 733, 733, 735, 855, 856, 856, 861, 862, 863, 891, 894, 928, 929, 936, 937, 939, 966, 967, 969, 1002, 1003, 1006, 1012, 1014, 1014, 1015, 1015, 1075, 1076, 1079, 1080, 1092, 1093, 1096, 1097])
+("phit", [284, 285, 288])
+("phitvn", [283, 285, 287])
+("poly", [558])
+("pretty", [81, 83, 84, 85, 86, 87, 88, 89, 90, 91, 92, 93, 95])
+("program", [267, 305, 601, 621])
+("psi", [862, 863, 863])
+("q", [290, 291, 293, 294])
+("r", [363, 363, 662, 663])
+("reOals", [602, 609, 653, 657, 659, 680, 684, 699, 708, 720])
+("reOres", [602, 609, 653, 660])
+("recFlag", [28, 29, 1012, 1014, 1015])
+("recursive", [533, 534])
+("reflect", [597])
+("reorder", [596])
+("res", [593, 607])
+("resExpr", [37, 38])
+("result", [683, 717, 787, 791])
+("resulting", [589, 597])
+("results", [13])
+("return", [717])
+("reverse", [731])
+("revised", [571])
+("rf", [65])
+("rhs", [685, 689, 705, 709, 727])
+("rhsAnnExprs", [1002, 1003, 1012, 1014, 1015, 1075, 1076, 1090, 1092, 1093])
+("rhsGammas", [659, 660])
+("rhsTc1", [660, 661, 662, 663])
+("rhsTcs", [657, 660, 680, 684, 687, 688, 702, 708, 735, 737])
+("rhsTypes", [992, 995])
+("rootEnv", [137, 139])
+("rootSubst", [133, 135])
+("rootTree", [124, 135, 137])
+("rootType", [133])
+("rs", [662, 663])
+("rubbish", [627])
+("s", [445, 453, 453, 461, 654, 712, 719, 722, 723, 723, 724, 724, 725, 725, 727, 731])
+("sTau", [722, 723, 724, 725])
+("sTree", [722, 723, 724, 725])
+("scheme", [382, 385, 399, 403, 425, 434, 881, 882])
+("schemes", [1026, 1028])
+("scvs", [385, 385, 403, 404, 404, 406, 406, 891, 893, 1036, 1037])
+("second", [68, 68, 563, 738, 1034])
+("sequence", [467, 470, 470, 598, 764, 893, 1036, 1067])
+("sigmas", [656])
+("signature", [712])
+("similar", [627])
+("so", [597, 655])
+("source", [267, 305, 601, 621])
+("st", [434, 434])
+("stvs", [555, 560])
+("sub", [197, 201, 214, 287, 749, 749, 750, 751, 752, 755, 939, 969])
+("sub1", [226, 226])
+("sub2", [226, 226])
+("subnames", [1100])
+("subst", [231, 233, 355, 515, 689, 731, 845, 879, 894, 899, 902, 1038])
+("substitution", [268, 712, 717])
+("substitutions", [241, 329, 710, 711])
+("such", [418])
+("supply", [571, 585])
+("sw", [67, 68, 593, 602, 653, 657, 680, 684, 698, 708, 722])
+("switch", [540, 541, 586, 714, 716])
+("switchExpr", [30, 31])
+("t", [80, 81, 98, 98, 100, 101, 101, 141, 141, 185, 185, 260, 261, 263, 264, 272, 282, 288, 385, 385, 403, 404, 764, 855, 856, 861, 862, 863, 891, 891, 966, 969, 1014, 1015, 1015, 1034, 1034, 1037, 1038, 1038, 1085, 1085])
+("t1", [87, 88, 90, 91, 103, 103, 163, 163, 189, 189, 218, 218, 296, 296, 297, 297, 303, 307, 928, 929])
+("t2", [87, 89, 90, 92, 103, 103, 163, 163, 189, 189, 218, 218, 296, 296, 297, 297, 303, 309, 928, 929])
+("t2e", [56, 58, 58, 60, 61, 62, 63, 63, 63, 64, 64, 65, 66, 67, 68, 68, 71])
+("tVs", [563, 568, 572, 738, 739])
+("tau", [685, 688, 689, 704, 709, 718, 719, 724, 729, 731, 731, 735])
+("tc", [127, 508, 514, 517, 520, 523, 526, 527, 528, 530, 533, 540, 655, 663, 714, 722, 847, 955, 1003, 1093])
+("tcAdd", [1005, 1020, 1026, 1098])
+("tcAl", [894, 899, 902, 1038])
+("tcApply", [197, 201, 214, 287, 939, 969])
+("tcArrow", [159, 163])
+("tcBar", [385, 390, 394, 1037])
+("tcBool", [175, 177])
+("tcCharVal", [415, 417, 418, 881])
+("tcCheck", [117, 122])
+("tcCheckUnifier", [356, 361, 363, 364, 365])
+("tcConstrTypeSchemes", [146, 551, 555])
+("tcDeOkSel", [629])
+("tcDeOksel", [628, 629, 689, 733, 755])
+("tcDelta", [238, 242, 247, 264])
+("tcDeplete", [450, 453, 470, 572, 921, 957])
+("tcExclude", [404, 406])
+("tcExtend", [255, 260, 284])
+("tcGenbar", [1028, 1034])
+("tcGetAllGammas", [659, 799, 804, 807, 809])
+("tcGetGammaN", [770, 775, 808])
+("tcGetTypeDef", [604, 814, 818])
+("tcId", [231, 233, 355, 515, 689, 731, 845, 879])
+("tcInt", [168, 170])
+("tcK31sel", [636, 739])
+("tcK33", [608, 637, 659, 740])
+("tcMapAnnExpr", [16, 20, 27, 27, 29, 31, 32, 35, 38, 47])
+("tcMergeSubs", [333, 336, 339, 727, 733])
+("tcMergeSubsMain", [341, 346, 349])
+("tcNSDouble", [462, 483, 486, 487, 491, 492])
+("tcNSSucc", [453, 461, 474, 477, 478, 479, 492])
+("tcNSdlimit", [489, 489, 495, 496, 499, 499])
+("tcNSslimit", [478, 498, 499])
+("tcName", [467, 470, 470, 764, 893, 1036, 1067])
+("tcNew", [958, 974, 1062, 1067, 1067])
+("tcNewTypeVars", [560, 605, 760, 764])
+("tcNewinstance", [882, 887, 891])
+("tcNext", [442, 445, 470, 920, 959])
+("tcOk13sel", [630, 631, 631, 687, 723])
+("tcOk23sel", [632, 633, 633, 688, 724, 735])
+("tcOk33sel", [634, 635, 635, 725, 737])
+("tcOld", [1078, 1085, 1095])
+("tcOldUnified", [351, 370, 372, 373, 374])
+("tcPretty", [108, 111, 143])
+("tcReorder", [609, 615, 617, 618, 623])
+("tcResult", [123, 127, 133])
+("tcScomp", [222, 226, 264, 863, 1015])
+("tcShowtExpr", [77, 80, 97, 113, 269, 272, 307, 309])
+("tcSplit", [458, 461, 606, 664, 665, 849, 994, 1007, 1060, 1061, 1099])
+("tcSub", [47, 204, 210, 214, 216, 216, 218, 218, 218, 288, 374, 399, 403, 404, 430, 434, 434, 729, 735, 856, 863, 891, 1006, 1038, 1079, 1080, 1096, 1097])
+("tcSubstAnnTree", [43, 47, 135])
+("tcTDefSubst", [567, 776, 782, 786, 793, 794])
+("tcTreeToEnv", [52, 55, 137])
+("tcTvars", [182, 185, 263, 385, 569, 1037])
+("tcUnify", [278, 282, 285, 290, 291, 293, 294, 296, 299, 303, 323, 731, 751, 755, 929])
+("tcUnifySet", [355, 689, 745, 749, 750, 752, 753])
+("tcUnifyl", [297, 301, 316, 320, 1076])
+("tcUnknowns", [382, 385, 422, 425, 425, 1029])
+("tcap", [524, 911, 918])
+("tcap1", [918, 926, 928])
+("tcap2", [929, 934, 936])
+("tccase", [541, 583, 593])
+("tccase1", [602, 643, 653])
+("tccase2", [657, 670, 680])
+("tccase3", [684, 695, 708])
+("tcl", [838, 844, 846, 856, 918, 995, 1058])
+("tcl1", [847, 854, 855])
+("tcl2", [856, 861, 862])
+("tclambda", [529, 531, 948, 955])
+("tclambda1", [955, 964, 966])
+("tclet", [535, 983, 991])
+("tclet1", [992, 1000, 1002])
+("tclet2", [1003, 1012, 1014, 1093])
+("tcletrec", [536, 1048, 1056])
+("tcletrec1", [1057, 1073, 1075])
+("tcletrec2", [1076, 1090, 1092])
+("tcn", [216, 216, 299, 299, 300, 300])
+("tcvar", [518, 521, 873, 879])
+("tdCNames", [599, 608, 609, 720, 740])
+("tdInUse", [602, 604, 605, 608, 653, 657, 659, 680, 684, 701, 708, 739, 740])
+("tdSignature", [566, 568, 729, 739])
+("tdefs", [122, 127, 146])
+("tdefset", [819, 821, 823, 825])
+("tds", [514, 517, 518, 520, 521, 523, 524, 526, 527, 528, 529, 530, 531, 533, 535, 536, 540, 541, 593, 602, 604, 653, 657, 663, 680, 684, 695, 708, 722, 818, 827, 844, 846, 847, 847, 854, 855, 856, 879, 918, 918, 955, 955, 991, 992, 995, 1000, 1002, 1003, 1056, 1057, 1058, 1073, 1075, 1076, 1090, 1092, 1093])
+("te", [422, 425, 430, 434, 856, 1006, 1029, 1079, 1080, 1096, 1097])
+("texp", [569, 569, 569])
+("texpr", [247, 247])
+("that", [715])
+("the", [559, 562, 565, 565, 571, 594, 596, 597, 598, 654, 654, 655, 681, 681, 682, 682, 683, 710, 711, 712, 712, 712, 714, 714, 715, 716, 716, 717, 717])
+("themselves", [562])
+("then", [124, 203, 284, 338, 535, 600, 656, 820, 822])
+("therein", [595])
+("these", [731])
+("this", [715])
+("tijp", [70, 71])
+("times", [574])
+("tipe", [111, 113])
+("tn", [555, 560, 568])
+("tname", [826, 827])
+("to", [270, 574, 595, 597, 655, 681, 685, 685, 687, 688, 689, 703, 704, 709, 709, 712, 712, 714, 727, 894, 899, 902, 1038])
+("track", [378])
+("tree", [47, 47, 55, 56, 719, 725])
+("ts", [98, 99, 102, 102, 188, 188, 216, 216, 299, 299, 301, 301, 862, 863, 1002, 1005, 1026, 1028, 1075, 1076, 1076, 1078, 1095, 1098])
+("tvars", [185, 187, 188, 188, 189, 189, 189, 710])
+("tvdict", [83, 100, 100, 101, 102, 102, 103, 103, 103])
+("tvl", [775, 776, 804, 807, 808, 809])
+("tvn", [201, 202, 203, 206, 206, 214, 214, 242, 243, 244, 244, 245, 245, 247, 247, 260, 261, 263, 264, 269, 282, 283, 284, 287, 789, 789, 918, 920, 926, 928, 929, 929, 934, 936, 939, 955, 958, 959, 964, 966, 969, 974, 974])
+("tvn2", [242, 243, 244, 244, 245, 245])
+("tvname", [83, 83, 96, 98, 98, 99])
+("type", [3, 47, 125, 155, 204, 210, 214, 216, 216, 218, 218, 218, 288, 374, 404, 503, 558, 559, 562, 583, 584, 594, 595, 682, 682, 713, 714, 715, 717, 729, 735, 814, 863, 891, 1038])
+("typedef", [712])
+("types", [378, 565, 656, 683])
+("u", [373, 374])
+("undeclared", [621])
+("unified", [347])
+("unifiedOlds", [338, 339, 341])
+("unifier", [681, 683])
+("unifiers", [681])
+("unify", [306, 321, 323, 324])
+("unknown", [710])
+("unknowns", [1028, 1029, 1034, 1037])
+("unzip2", [538, 543, 544, 609])
+("uol", [617, 618, 619, 623])
+("up", [710])
+("us", [373, 374])
+("use", [594, 820])
+("used", [815])
+("usedc", [828, 829])
+("utDomain", [353])
+("utLookup", [791])
+("utLookupAll", [354])
+("utLookupDef", [206, 418, 619])
+("utRange", [425])
+("v", [23, 23, 60])
+("v5", [3])
+("var", [247, 247, 558])
+("variable", [418])
+("variables", [438, 562, 595, 682, 868])
+("vars", [558, 595])
+("version", [4])
+("vl", [764, 764])
+("vs", [32, 32, 141])
+("where", [7, 22, 57, 82, 126, 133, 140, 186, 205, 286, 322, 340, 352, 405, 462, 489, 537, 542, 557, 603, 658, 664, 686, 721, 754, 788, 824, 848, 880, 892, 919, 938, 956, 968, 993, 1004, 1027, 1035, 1059, 1077, 1094])
+("with", [308, 558, 806])
+("x", [130, 133, 133, 187, 187, 394, 394, 394, 434, 434, 517, 518, 528, 529, 530, 531, 628, 628, 879, 879, 881, 955, 955, 958, 964, 966, 967, 974, 974, 1085])
+("x2", [131])
+("xs", [394, 394, 530, 531, 535, 536, 538, 991, 992, 1000, 1002, 1003, 1005, 1012, 1014, 1015, 1026, 1026, 1056, 1057, 1062, 1067, 1067, 1073, 1075, 1076, 1090, 1092, 1093])
+("y", [188, 530, 531])
+("ys", [394, 394])
+("zip", [301, 351, 607, 607, 720, 720, 764, 776, 893, 1015, 1026, 1036, 1067, 1076])
diff --git a/ghc/tests/programs/jules_xref2/Main.hs b/ghc/tests/programs/jules_xref2/Main.hs
new file mode 100644 (file)
index 0000000..10d20a5
--- /dev/null
@@ -0,0 +1,73 @@
+-- partain: the failure (crashing) was w/ -prof-auto compilation
+
+module Main where
+
+xreff :: Int -> [String] -> Table -> Int -> String -> String
+xreff cc exs stab lineno [] = display (foldl delete stab exs)
+xreff cc exs stab lineno ('\n':cs) = xreff cc exs stab (lineno+1) cs
+xreff cc exs stab lineno (c:cs) 
+  = if (c >= 'a' && c <= 'z') || (c >= 'A' && c <= 'Z') then
+       case getRestWord cs of
+         (word, rest) -> if (cc :: Int) == 0
+          then   if stab == stab
+                 then
+                    xreff 1000 exs 
+                          (enter lineno stab (c:word)) lineno rest
+                 else error "Force failed?!"
+          else      xreff (cc-1) exs 
+                        (enter lineno stab (c:word)) lineno rest
+      else xreff cc exs stab lineno cs
+
+xref exceptions source = xreff 1000 exceptions ALeaf 1 source
+
+getRestWord [] = ([], [])
+getRestWord xs@(x:xs')
+   | (x >= 'a' && x <= 'z') || (x >= 'A' && x <= 'Z') || (x >= '0' && x <= '9')
+   = case getRestWord xs' of 
+        (ys,zs) -> if (x >= 'A' && x <= 'Z')
+                   then (toEnum (fromEnum x + (32::Int)):ys, zs)
+                   else (x:ys, zs)
+   | otherwise 
+   = ([],xs)
+
+data Table = ALeaf | ABranch Table String [Int] Table deriving (Eq)
+
+enter n ALeaf w = ABranch ALeaf w [n] ALeaf
+enter n (ABranch l k ns r) w
+ = if w < k then ABranch (enter n l w) k ns r else
+   if w > k then ABranch l k ns (enter n r w) else
+                 ABranch l k (n:ns) r
+
+delete ALeaf w              = ALeaf
+delete (ABranch l k ns r) w
+ = if w < k then ABranch (delete l w) k ns r else
+   if w > k then ABranch l k ns (delete r w) else
+                 ABranch l k [] r
+
+display :: Table -> String
+display t = display_a t ""
+
+display_a :: Table -> String -> String
+display_a ALeaf acc = acc
+display_a (ABranch l k ns r) acc
+ = display_a l (dispLine k ns ++ display_a r acc)
+
+dispLine k [] = ""
+dispLine k ns = k ++ ":" ++ dispNos ns ++ "\n"
+
+dispNos :: [Int] -> String
+dispNos []     = ""
+dispNos (n:ns) = ' ':(show n ++ dispNos ns)
+
+main = do
+    input <- getContents
+    exceptions <- catch (readFile "exceptions") (\ e -> return "")
+    putStr (xref (lines exceptions) input)
+
+{- OLD 1.2:
+main = readChan stdin abort (\input ->
+       readFile "exceptions"
+                (\errors     -> output (xref []                 input))
+                (\exceptions -> output (xref (lines exceptions) input)))
+       where output s = appendChan stdout s abort done
+-}
diff --git a/ghc/tests/programs/jules_xref2/Makefile b/ghc/tests/programs/jules_xref2/Makefile
new file mode 100644 (file)
index 0000000..de6e7e0
--- /dev/null
@@ -0,0 +1,7 @@
+TOP = ../..
+include $(TOP)/mk/boilerplate.mk
+
+all :: runtest
+
+include $(TOP)/mk/target.mk
+
diff --git a/ghc/tests/programs/jules_xref2/jules_xref2.stdin b/ghc/tests/programs/jules_xref2/jules_xref2.stdin
new file mode 100644 (file)
index 0000000..a43907d
--- /dev/null
@@ -0,0 +1,1105 @@
+--==========================================================--
+--=== A type-checker -- v5        File: TypeCheck5.m (1) ===--
+--=== Corrected version for 0.210a                       ===--
+--==========================================================--
+
+module TypeCheck5 where
+import BaseDefs
+import Utils
+import MyUtils
+
+--==========================================================--
+--=== Formatting of results                              ===--
+--==========================================================--
+
+tcMapAnnExpr :: (a -> b) ->
+                AnnExpr c a ->
+                AnnExpr c b
+
+tcMapAnnExpr f (ann, node) 
+   = (f ann, mapAnnExpr' node)
+     where
+        mapAnnExpr' (AVar v) = AVar v
+        mapAnnExpr' (ANum n) = ANum n
+        mapAnnExpr' (AConstr c) = AConstr c
+        mapAnnExpr' (AAp ae1 ae2) 
+           = AAp (tcMapAnnExpr f ae1) (tcMapAnnExpr f ae2)
+        mapAnnExpr' (ALet recFlag annDefs mainExpr)
+           = ALet recFlag (map mapAnnDefn annDefs) (tcMapAnnExpr f mainExpr)
+        mapAnnExpr' (ACase switchExpr annAlts)
+           = ACase (tcMapAnnExpr f switchExpr) (map mapAnnAlt annAlts)
+        mapAnnExpr' (ALam vs e) = ALam vs (tcMapAnnExpr f e)
+
+        mapAnnDefn (naam, expr) 
+           = (naam, tcMapAnnExpr f expr)
+
+        mapAnnAlt (naam, (pars, resExpr))
+           = (naam, (pars, tcMapAnnExpr f resExpr))
+
+
+--======================================================--
+--
+tcSubstAnnTree :: Subst -> 
+                  AnnExpr Naam TExpr -> 
+                  AnnExpr Naam TExpr
+
+tcSubstAnnTree phi tree = tcMapAnnExpr (tcSub_type phi) tree
+
+
+--======================================================--
+--
+tcTreeToEnv :: AnnExpr Naam TExpr ->
+               TypeEnv
+
+tcTreeToEnv tree
+   = t2e tree
+     where
+        t2e (nodeType, node) = t2e' node
+
+        t2e' (AVar v) = []
+        t2e' (ANum n) = []
+        t2e' (AConstr c) = []
+        t2e' (AAp ae1 ae2) = (t2e ae1) ++ (t2e ae2)
+        t2e' (ALam cs e) = t2e e
+        t2e' (ALet rf dl me) 
+           = (concat (map aFN dl)) ++ (t2e me)
+        t2e' (ACase sw alts)
+           = (t2e sw) ++ (concat (map (t2e.second.second) alts))
+   
+        aFN (naam, (tijp, body)) 
+          = (naam, tijp):(t2e' body)
+
+
+
+--======================================================--
+--
+tcShowtExpr :: TExpr ->
+               [Char]
+
+tcShowtExpr t 
+   = pretty' False t
+     where 
+       pretty' b (TVar tvname) = [' ', chr (96+(lookup tvname tvdict))]
+       pretty' b (TCons "int" []) = " int"
+       pretty' b (TCons "bool" []) = " bool"
+       pretty' b (TCons "char" []) = " char"
+       pretty' True (TArr t1 t2) 
+          = " (" ++ (pretty' True t1) ++ " -> " ++
+            (pretty' False t2) ++ ")" 
+       pretty' False (TArr t1 t2) 
+          = (pretty' True t1) ++ " -> " ++
+            (pretty' False t2)
+       pretty' b (TCons notArrow cl) 
+          = " (" ++ notArrow ++ 
+             concat (map (pretty' True) cl) ++ ")"
+       lookup tvname [] 
+          = panic "tcShowtExpr: Type name lookup failed"
+       lookup tvname (t:ts) | t==tvname = 1
+                           | otherwise = 1 + (lookup tvname ts)
+       tvdict = nub (tvdict' t)
+       tvdict' (TVar t) = [t]
+       tvdict' (TCons c ts) = concat (map tvdict' ts)
+       tvdict' (TArr t1 t2) = tvdict' t1 ++ tvdict' t2
+
+
+--======================================================--
+--
+tcPretty :: (Naam, TExpr) -> 
+            [Char]
+
+tcPretty (naam, tipe)
+   = "\n   " ++ (ljustify 25 (naam ++ " :: ")) ++ 
+            (tcShowtExpr tipe)
+
+
+--======================================================--
+tcCheck :: TcTypeEnv -> 
+           TypeNameSupply ->
+           AtomicProgram -> 
+           ([Char],  Reply (AnnExpr Naam TExpr, TypeEnv) Message)
+
+tcCheck baseTypes ns (tdefs, expr)
+   = if good tcResult 
+         then (fullEnvWords,  Ok (rootTree, fullEnv))
+         else ("",            Fail "No type")
+     where
+        tcResult = tc (tdefs++builtInTypes)
+                   (baseTypes++finalConstrTypes) finalNs expr
+
+        good (Ok x) = True
+        good (Fail x2) = False
+        
+        (rootSubst, rootType, annoTree) = f tcResult where f (Ok x) = x
+
+        rootTree = tcSubstAnnTree rootSubst annoTree
+
+        rootEnv = tcTreeToEnv rootTree
+
+        fullEnv = rootEnv ++ map f finalConstrTypes
+                  where
+                     f (naam, (Scheme vs t)) = (naam, t)
+
+        fullEnvWords = concat (map tcPretty fullEnv)
+
+        (finalNs, constrTypes) = 
+           mapAccuml tcConstrTypeSchemes ns (tdefs++builtInTypes)
+        finalConstrTypes = concat constrTypes
+
+        builtInTypes 
+           = [ ("bool", [], [("True", []), ("False", [])]) ]
+        
+
+
+--==========================================================--
+--=== 9.2 Representation of type expressions             ===--
+--==========================================================--
+
+----======================================================--
+--tcArrow :: TExpr -> 
+--           TExpr -> 
+--           TExpr
+--
+--tcArrow t1 t2 = TArr t1 t2
+
+
+
+--======================================================--
+tcInt :: TExpr
+
+tcInt = TCons "int" []
+
+
+
+--======================================================--
+tcBool :: TExpr
+
+tcBool = TCons "bool" []
+
+
+
+--======================================================--
+tcTvars_in :: TExpr -> 
+              [TVName]
+
+tcTvars_in t = tvars_in' t []
+               where
+                  tvars_in' (TVar x) l = x:l
+                  tvars_in' (TCons y ts) l = foldr tvars_in' l ts
+                  tvars_in' (TArr t1 t2) l = tvars_in' t1 (tvars_in' t2 l)
+
+
+--==========================================================--
+--=== 9.41 Substitutions                                 ===--
+--==========================================================--
+
+--======================================================--
+tcApply_sub :: Subst ->
+               TVName ->
+               TExpr
+
+tcApply_sub phi tvn 
+   = if TVar tvn == lookUpResult
+        then TVar tvn
+        else tcSub_type phi lookUpResult
+     where
+        lookUpResult = utLookupDef phi tvn (TVar tvn)
+
+
+--======================================================--
+tcSub_type :: Subst -> 
+              TExpr -> 
+              TExpr
+
+tcSub_type phi (TVar tvn) = tcApply_sub phi tvn
+
+tcSub_type phi (TCons tcn ts) = TCons tcn (map (tcSub_type phi) ts)
+
+tcSub_type phi (TArr t1 t2) = TArr (tcSub_type phi t1) (tcSub_type phi t2)
+
+
+--======================================================--
+tcScomp :: Subst -> 
+           Subst -> 
+           Subst
+
+tcScomp sub2 sub1 = sub1 ++ sub2
+
+
+
+--======================================================--
+tcId_subst :: Subst
+
+tcId_subst = []
+
+
+
+--======================================================--
+tcDelta :: TVName -> 
+           TExpr -> 
+           Subst
+-- all TVar -> TVar substitutions lead downhill
+tcDelta tvn (TVar tvn2) 
+   | tvn == tvn2   = []
+   | tvn >  tvn2   = [(tvn, TVar tvn2)]
+   | tvn <  tvn2   = [(tvn2, TVar tvn)]
+
+tcDelta tvn non_var_texpr = [(tvn, non_var_texpr)]
+
+
+--==========================================================--
+--=== 9.42 Unification                                   ===--
+--==========================================================--
+
+--======================================================--
+tcExtend :: Subst -> 
+            TVName -> 
+            TExpr -> 
+            Reply Subst Message
+
+tcExtend phi tvn t 
+    | t == TVar tvn   
+    = Ok phi
+    | tvn `notElem` (tcTvars_in t)
+    = Ok ((tcDelta tvn t) `tcScomp` phi)
+    | otherwise
+    = fail
+         (   "Type error in source program:\n\n"         ++
+             "Circular substitution:\n      "            ++
+             tcShowtExpr (TVar tvn)                     ++ 
+              "\n   going to\n"                          ++
+             "      "                                   ++ 
+              tcShowtExpr t                              ++ 
+              "\n")
+
+
+
+--======================================================--
+tcUnify :: Subst -> 
+           (TExpr, TExpr) -> 
+           Reply Subst Message
+
+tcUnify phi (TVar tvn, t) 
+  = if phitvn == TVar tvn
+       then tcExtend phi tvn phit
+       else tcUnify phi (phitvn, phit)
+     where
+       phitvn = tcApply_sub phi tvn
+       phit = tcSub_type phi t
+
+tcUnify phi (p@(TCons _ _), q@(TVar _))
+   = tcUnify phi (q, p)
+
+tcUnify phi (p@(TArr _ _), q@(TVar _))
+   = tcUnify phi (q, p)
+
+tcUnify phi (TArr t1 t2, TArr t1' t2')
+   = tcUnifyl phi [(t1, t1'), (t2, t2')]
+
+tcUnify phi (TCons tcn ts, TCons tcn' ts') 
+   | tcn == tcn' 
+   = tcUnifyl phi (ts `zip` ts')
+
+tcUnify phi (t1, t2)
+   = fail
+        (   "Type error in source program:\n\n"          ++
+            "Cannot unify\n      "                       ++
+            tcShowtExpr t1                               ++
+            "\n   with\n      "                          ++
+            tcShowtExpr t2                               ++
+            "\n"
+        )
+
+
+
+--======================================================--
+tcUnifyl :: Subst ->  
+            [(TExpr, TExpr)] -> 
+            Reply Subst Message
+
+tcUnifyl phi eqns 
+   = foldr unify' (Ok phi) eqns
+     where
+       unify' eqn (Ok phi) = tcUnify phi eqn
+       unify' eqn (Fail m) = Fail m
+
+
+
+--==========================================================--
+--=== 9.42.2 Merging of substitutions                    ===--
+--==========================================================--
+
+--======================================================--
+tcMergeSubs :: Subst ->
+               Subst
+
+tcMergeSubs phi 
+   = if newBinds == []
+        then unifiedOlds
+        else tcMergeSubs (unifiedOlds ++ newBinds)
+     where
+        (newBinds, unifiedOlds) = tcMergeSubsMain phi
+
+
+
+--======================================================--
+tcMergeSubsMain :: Subst -> 
+                   (Subst, Subst)   -- pair of new binds, unified olds
+
+tcMergeSubsMain phi
+   = (concat newUnifiersChecked,
+      zip oldVars (tcOldUnified newUnifiersChecked oldGroups))
+     where
+        oldVars = nub (utDomain phi)
+        oldGroups = map (utLookupAll phi) oldVars
+        newUnifiers = map (tcUnifySet tcId_subst) oldGroups
+        newUnifiersChecked = map tcCheckUnifier newUnifiers
+
+
+
+--======================================================--
+tcCheckUnifier :: Reply Subst Message -> Subst
+
+tcCheckUnifier (Ok r) = r
+tcCheckUnifier (Fail m) 
+   = panic ("tcCheckUnifier: " ++ m)
+
+
+
+--======================================================--
+tcOldUnified :: [Subst] -> [[TExpr]] -> [TExpr]
+
+tcOldUnified [] [] = []
+tcOldUnified (u:us) (og:ogs) 
+      = (tcSub_type u (head og)): tcOldUnified us ogs
+
+
+--==========================================================--
+--=== 9.5 Keeping track of types                         ===--
+--==========================================================--
+
+--======================================================--
+tcUnknowns_scheme :: TypeScheme -> 
+                     [TVName]
+
+tcUnknowns_scheme (Scheme scvs t) = tcTvars_in t `tcBar` scvs
+
+
+
+--======================================================--
+tcBar :: (Eq a) => [a] -> 
+                   [a] -> 
+                   [a]
+
+tcBar xs ys = [ x | x <- xs,  not (x `elem` ys)]
+
+
+
+--======================================================--
+tcSub_scheme :: Subst -> 
+                TypeScheme -> 
+                TypeScheme
+
+tcSub_scheme phi (Scheme scvs t)
+    = Scheme scvs (tcSub_type (tcExclude phi scvs) t)
+      where
+         tcExclude phi scvs = [(n,e) | (n,e) <- phi,  not (n `elem` scvs)]
+
+
+
+--==========================================================--
+--=== 9.53 Association lists                             ===--
+--==========================================================--
+
+--======================================================--
+tcCharVal :: AList Naam b -> Naam -> b
+
+tcCharVal al k
+   = utLookupDef al k (panic ("tcCharVal: no such variable: " ++ k))
+
+
+--======================================================--
+tcUnknowns_te :: TcTypeEnv -> 
+                 [TVName]
+
+tcUnknowns_te gamma = concat (map tcUnknowns_scheme (utRange gamma))
+
+
+
+--======================================================--
+tcSub_te :: Subst -> 
+            TcTypeEnv -> 
+            TcTypeEnv
+
+tcSub_te phi gamma = [(x, tcSub_scheme phi st) | (x, st) <- gamma]
+
+
+--==========================================================--
+--=== 9.6 New variables                                  ===--
+--==========================================================--
+
+--======================================================--
+tcNext_name :: TypeNameSupply -> 
+               TVName
+
+tcNext_name ns@(f, s) = ns
+
+
+
+--======================================================--
+tcDeplete :: TypeNameSupply -> 
+             TypeNameSupply
+
+tcDeplete (f, s) = (f, tcNSSucc s)
+
+
+
+--======================================================--
+tcSplit :: TypeNameSupply -> 
+           (TypeNameSupply, TypeNameSupply)
+
+tcSplit (f, s) = ((f2, [0]), (tcNSSucc f2, [0]))
+                 where f2 = tcNSDouble f
+
+
+
+--======================================================--
+tcName_sequence :: TypeNameSupply -> 
+                   [TVName]
+
+tcName_sequence ns = tcNext_name ns: tcName_sequence (tcDeplete ns)
+
+
+--======================================================--
+tcNSSucc :: [Int] ->
+            [Int]
+
+tcNSSucc []     = [1]
+tcNSSucc (n:ns) | n < tcNSslimit  = n+1: ns
+                | otherwise       = 0: tcNSSucc ns
+
+
+--======================================================--
+tcNSDouble :: [Int] ->
+              [Int]
+
+tcNSDouble []   = []
+tcNSDouble (n:ns) 
+    = 2*n': ns'
+       where n' | n > tcNSdlimit  = n - tcNSdlimit
+               | otherwise       = n
+            ns' | n' == n    = tcNSDouble ns
+                | otherwise  = tcNSSucc (tcNSDouble ns)
+
+                       
+tcNSdlimit :: Int
+tcNSdlimit = 2^30
+
+tcNSslimit :: Int
+tcNSslimit = tcNSdlimit + (tcNSdlimit - 1)
+
+
+--==========================================================--
+--=== 9.7 The type-checker                               ===--
+--==========================================================--
+
+
+--======================================================--
+tc :: [TypeDef] ->
+      TcTypeEnv -> 
+      TypeNameSupply -> 
+      CExpr -> 
+      Reply TypeInfo Message
+
+tc tds gamma ns (ENum n) 
+   = Ok (tcId_subst, TCons "int" [], (TCons "int" [], ANum n))
+
+tc tds gamma ns (EVar x) 
+   = tcvar tds gamma ns x
+
+tc tds gamma ns (EConstr c)
+   = tcvar tds gamma ns c
+
+tc tds gamma ns (EAp e1 e2)
+   = tcap tds gamma ns e1 e2
+
+tc tds gamma ns (ELam [] e)
+   = tc tds gamma ns e
+tc tds gamma ns (ELam [x] e)
+   = tclambda tds gamma ns x e
+tc tds gamma ns (ELam (x:y:xs) e)
+   = tclambda tds gamma ns x (ELam (y:xs) e)
+
+tc tds gamma ns (ELet recursive dl e)
+   = if not recursive
+        then tclet tds gamma ns xs es e
+        else tcletrec tds gamma ns xs es e
+     where
+       (xs, es) = unzip2 dl
+
+tc tds gamma ns (ECase switch alts)
+   = tccase tds gamma ns switch constructors arglists exprs
+     where
+        (constructors, alters) = unzip2 alts
+        (arglists, exprs) = unzip2 alters
+
+--==========================================================--
+--=== 0.00 Type-checking case-expressions                ===--
+--==========================================================--
+
+tcConstrTypeSchemes :: TypeNameSupply ->
+                       TypeDef ->
+                       (TypeNameSupply, AList Naam TypeScheme)
+
+tcConstrTypeSchemes ns (tn, stvs, cal)
+   = (finalNameSupply, map2nd enScheme cAltsCurried)
+     where
+        -- associates new type vars with each poly var
+        -- in the type
+        newTVs = tcNewTypeVars (tn, stvs, cal) ns
+
+        -- the actual type variables themselves
+        tVs = map second newTVs
+
+        -- the types of the constructor functions         
+        cAltsCurried = map2nd (foldr TArr tdSignature) cAltsXLated
+        cAltsXLated = map2nd (map (tcTDefSubst newTVs)) cal
+        tdSignature = TCons tn (map TVar tVs)
+        enScheme texp = Scheme ((nub.tcTvars_in) texp) texp
+
+        -- the revised name supply
+        finalNameSupply = applyNtimes ( length tVs + 2) tcDeplete ns
+
+        -- apply a function n times to an arg
+        applyNtimes n func arg 
+           | n ==0       = arg
+           | otherwise   = applyNtimes (n-1) func (func arg)
+                    
+
+
+--======================================================--
+--
+tccase :: [TypeDef] ->         -- constructor type definitions
+          TcTypeEnv ->         -- current type bindings
+          TypeNameSupply ->    -- name supply
+          CExpr ->             -- switch expression
+          [Naam] ->            -- constructors
+          [[Naam]] ->          -- argument lists
+          [CExpr] ->           -- resulting expressions
+          Reply TypeInfo Message
+
+
+tccase tds gamma ns sw cs als res
+-- get the type definition in use, & an association of
+-- variables therein to type vars & pass
+-- Also, reorder the argument lists
+-- and resulting expressions so as to reflect the 
+-- sequence of constructors in the definition
+ = if length tdCNames /=  length (nub cs)
+      then  fail
+            "Error in source program: missing alternatives in CASE"
+      else tccase1 tds gamma ns1 sw reOals reOres newTVs tdInUse
+     where
+        tdInUse = tcGetTypeDef tds cs
+        newTVs = tcNewTypeVars tdInUse ns2
+        (ns1, ns2) = tcSplit ns
+        merge = zip cs (zip als res)
+        tdCNames = map first (tcK33 tdInUse)
+        (reOals, reOres) = unzip2 (tcReorder tdCNames merge)
+
+
+
+--======================================================--
+--
+tcReorder :: [Naam] -> [(Naam,b)] -> [b]
+
+tcReorder []     uol =  []
+tcReorder (k:ks) uol 
+   = (utLookupDef uol k 
+        (fail
+            ("Error in source program: undeclared constructor '" ++ k ++
+               "' in CASE") ) )
+        : tcReorder ks uol 
+
+
+--======================================================--
+-- Projection functions and similar rubbish.
+tcDeOksel (Ok x) = x
+tcDeOksel (Fail m) = panic ("tcDeOkSel: " ++ m)
+tcOk13sel (Ok (a, b, c)) = a
+tcOk13sel (Fail m) = panic ("tcOk13sel: " ++ m)
+tcOk23sel (Ok (a, b, c)) = b
+tcOk23sel (Fail m) = panic ("tcOk23sel: " ++ m)
+tcOk33sel (Ok (a, b, c)) = c
+tcOk33sel (Fail m) = panic ("tcOk33sel: " ++ m)
+tcK31sel (a, b, c) = a
+tcK33 (a,b,c) = c
+
+
+
+--======================================================--
+--
+tccase1 :: [TypeDef] ->
+           TcTypeEnv -> 
+           TypeNameSupply ->
+           CExpr -> 
+           [[Naam]] ->
+           [CExpr] ->
+           AList Naam TVName ->
+           TypeDef ->
+           Reply TypeInfo Message
+
+tccase1 tds gamma ns sw reOals reOres newTVs tdInUse
+-- calculate all the gammas for the RHS's
+-- call tc for each RHS, so as to gather all the
+-- sigmas and types for each RHS, then pass on
+   = tccase2 tds gamma ns2 sw reOals newTVs tdInUse rhsTcs
+     where
+        rhsGammas = tcGetAllGammas newTVs (tcK33 tdInUse) reOals
+        rhsTcs = rhsTc1 ns1 rhsGammas reOres
+        rhsTc1 nsl []     []     = []
+        rhsTc1 nsl (g:gs) (r:rs) 
+           = tc tds (g++gamma) nsl1 r : rhsTc1 nsl2 gs rs
+             where (nsl1, nsl2) = tcSplit nsl
+        (ns1, ns2) = tcSplit ns  
+        
+
+--======================================================--
+--
+tccase2 :: [TypeDef] ->
+           TcTypeEnv -> 
+           TypeNameSupply ->
+           CExpr -> 
+           [[Naam]] ->
+           AList Naam TVName ->
+           TypeDef ->
+           [Reply TypeInfo Message] ->
+           Reply TypeInfo Message
+
+tccase2 tds gamma ns sw reOals newTVs tdInUse rhsTcs
+-- get the unifiers for T1 to Tk and hence the unifier for all
+-- type variables in the type definition.  Also compute the
+-- unifier of the result types.
+   = tccase3 tds gamma ns sw reOals newTVs tdInUse rhsTcs 
+             phi_1_to_n tau_1_to_n phi_rhs
+     where
+        phi_1_to_n = map tcOk13sel rhsTcs
+        tau_1_to_n = map tcOk23sel rhsTcs
+        phi_rhs = tcDeOksel (tcUnifySet tcId_subst tau_1_to_n)
+
+
+--======================================================--
+--
+tccase3 :: [TypeDef] ->                    -- tds
+           TcTypeEnv ->                    -- gamma
+           TypeNameSupply ->               -- ns
+           CExpr ->                        -- sw
+           [[Naam]] ->                     -- reOals
+           AList Naam TVName ->            -- newTVs
+           TypeDef ->                      -- tdInUse
+           [Reply TypeInfo Message] ->     -- rhsTcs
+           [Subst] ->                      -- phi_1_to_n
+           [TExpr] ->                      -- tau_1_to_n
+           Subst ->                        -- phi_rhs
+           Reply TypeInfo Message
+
+tccase3 tds gamma ns sw reOals newTVs tdInUse rhsTcs
+        phi_1_to_n tau_1_to_n phi_rhs
+-- make up substitutions for each of the unknown tvars
+-- merge the substitutions into one
+-- apply the substitution to the typedef's signature to get the
+-- most general allowable input type
+-- call tc to get the type of the switch expression
+-- check that this is an instance of the deduced input type
+-- gather the new bindings from the RHSs and switch expression
+-- return Ok (the big substitution, the result type, gathered bindings)
+   = Ok (phi_Big, tau_final, 
+            (tau_final, ACase tree_s 
+                        (zip tdCNames (zip reOals annotatedRHSs))))
+     where
+        phi_sTau_sTree_s = tc tds gamma ns sw 
+        phi_s  = tcOk13sel phi_sTau_sTree_s
+        tau_s  = tcOk23sel phi_sTau_sTree_s
+        tree_s = tcOk33sel phi_sTau_sTree_s
+        
+        phi = tcMergeSubs (concat phi_1_to_n ++ phi_rhs ++ phi_s)
+
+        tau_lhs = tcSub_type phi tdSignature
+
+        phi_lhs = tcUnify tcId_subst (tau_lhs, tau_s) -- reverse these?
+
+        phi_Big = tcMergeSubs (tcDeOksel phi_lhs ++ phi) 
+
+        tau_final = tcSub_type phi_Big (head (map tcOk23sel rhsTcs))
+
+        annotatedRHSs = map tcOk33sel rhsTcs
+        tVs = map second newTVs
+        tdSignature = TCons (tcK31sel tdInUse) (map TVar tVs)
+        tdCNames = map first (tcK33 tdInUse)
+
+
+--======================================================--
+--
+tcUnifySet :: Subst -> 
+              [TExpr] -> 
+              Reply Subst Message
+
+tcUnifySet sub (e1:[]) = Ok sub
+tcUnifySet sub (e1:e2:[]) 
+   = tcUnify sub (e1, e2)
+tcUnifySet sub (e1:e2:e3:es) 
+   = tcUnifySet newSub (e2:e3:es)
+     where 
+        newSub = tcDeOksel (tcUnify sub (e1, e2))
+
+
+--======================================================--
+--
+tcNewTypeVars :: TypeDef -> 
+                 TypeNameSupply ->
+                 AList Naam TVName
+
+tcNewTypeVars (t, vl, c) ns = zip vl (tcName_sequence ns)
+
+
+
+--======================================================--
+--
+tcGetGammaN :: AList Naam TVName ->
+               ConstrAlt -> 
+               [Naam] ->
+               AList Naam TypeScheme
+
+tcGetGammaN tvl (cname, cal) cparams 
+   = zip cparams (map (Scheme [] . tcTDefSubst tvl) cal)
+
+
+
+--======================================================--
+--
+tcTDefSubst :: AList Naam TVName ->
+               TDefExpr ->
+               TExpr
+
+tcTDefSubst nameMap (TDefVar n)
+   = f result 
+     where
+        f (Just tvn) = TVar tvn
+        f Nothing    = TCons n []
+        result = utLookup nameMap n
+
+tcTDefSubst nameMap (TDefCons c al)
+   = TCons c (map (tcTDefSubst nameMap) al)
+
+
+--======================================================--
+--
+tcGetAllGammas :: AList Naam TVName ->
+                  [ConstrAlt] ->
+                  [[Naam]] ->
+                  [AList Naam TypeScheme]
+
+tcGetAllGammas tvl []           [] = []
+-- note param lists cparamss must be ordered in
+-- accordance with calts
+tcGetAllGammas tvl (calt:calts) (cparams:cparamss) = 
+      tcGetGammaN tvl calt cparams : 
+         tcGetAllGammas tvl calts cparamss
+
+
+--======================================================--
+--
+tcGetTypeDef :: [TypeDef] ->    -- type definitions
+                [Naam] ->       -- list of constructors used here
+                TypeDef
+
+tcGetTypeDef tds cs 
+   = if length tdefset == 0 
+        then fail "Undeclared constructors in use"
+     else if length tdefset > 1
+        then fail "CASE expression contains mixed constructors"
+     else head tdefset
+     where
+        tdefset = nub
+                  [ (tname, ftvs, cl) |
+                    (tname, ftvs, cl) <- tds,
+                    usedc <- cs,
+                    usedc `elem` (map first cl) ]
+
+
+--==========================================================--
+--=== 9.71 Type-checking lists of expressions            ===--
+--==========================================================--
+
+--======================================================--
+--
+tcl :: [TypeDef] ->
+       TcTypeEnv     -> 
+       TypeNameSupply  -> 
+       [CExpr]       -> 
+       Reply (Subst, [TExpr], [AnnExpr Naam TExpr]) Message
+
+tcl tds gamma ns []
+   = Ok (tcId_subst, [], [])
+tcl tds gamma ns (e:es) 
+   = tcl1 tds gamma ns0 es (tc tds gamma ns1 e)
+     where
+        (ns0, ns1) = tcSplit ns
+
+
+--======================================================--
+--
+tcl1 tds gamma ns es (Fail m) = Fail m
+tcl1 tds gamma ns es (Ok (phi, t, annotatedE)) 
+   = tcl2 phi t (tcl tds (tcSub_te phi gamma) ns es) annotatedE
+
+
+--======================================================--
+--
+tcl2 phi t (Fail m) annotatedE = Fail m
+tcl2 phi t (Ok (psi, ts, annotatedEs)) annotatedE 
+   = Ok (psi `tcScomp` phi, (tcSub_type psi t):ts, 
+         annotatedE:annotatedEs)
+
+
+--==========================================================--
+--=== 9.72 Type-checking variables                       ===--
+--==========================================================--
+
+--======================================================--
+--
+tcvar :: [TypeDef] ->
+         TcTypeEnv     -> 
+         TypeNameSupply  -> 
+         Naam        -> 
+         Reply TypeInfo Message
+
+tcvar tds gamma ns x = Ok (tcId_subst, finalType, (finalType, AVar x))
+                       where
+                          scheme = tcCharVal gamma x
+                          finalType = tcNewinstance ns scheme
+
+
+--======================================================--
+--
+tcNewinstance :: TypeNameSupply -> 
+                 TypeScheme -> 
+                 TExpr
+
+tcNewinstance ns (Scheme scvs t) = tcSub_type phi t
+                                   where 
+                                      al  = scvs `zip` (tcName_sequence ns)
+                                      phi = tcAl_to_subst al
+
+
+--======================================================--
+--
+tcAl_to_subst :: AList TVName TVName -> 
+                 Subst
+
+tcAl_to_subst al = map2nd TVar al
+
+
+--==========================================================--
+--=== 9.73 Type-checking applications                    ===--
+--==========================================================--
+
+--======================================================--
+--
+tcap :: [TypeDef] ->
+        TcTypeEnv     -> 
+        TypeNameSupply  -> 
+        CExpr         -> 
+        CExpr         -> 
+        Reply TypeInfo Message
+
+tcap tds gamma ns e1 e2 = tcap1 tvn (tcl tds gamma ns' [e1, e2])
+                          where
+                             tvn = tcNext_name ns
+                             ns' = tcDeplete ns
+
+
+--======================================================--
+--
+tcap1 tvn (Fail m)
+   = Fail m
+tcap1 tvn (Ok (phi, [t1, t2], [ae1, ae2])) 
+   = tcap2 tvn (tcUnify phi (t1, t2 `TArr` (TVar tvn))) [ae1, ae2]
+
+
+--======================================================--
+--
+tcap2 tvn (Fail m) [ae1, ae2]
+   = Fail m
+tcap2 tvn (Ok phi) [ae1, ae2] 
+   = Ok (phi, finalType, (finalType, AAp ae1 ae2))
+     where
+        finalType = tcApply_sub phi tvn
+
+
+--==========================================================--
+--=== 9.74 Type-checking lambda abstractions             ===--
+--==========================================================--
+
+--======================================================--
+--
+tclambda :: [TypeDef] ->
+            TcTypeEnv     -> 
+            TypeNameSupply  -> 
+            Naam        -> 
+            CExpr         -> 
+            Reply TypeInfo Message
+
+tclambda tds gamma ns x e = tclambda1 tvn x (tc tds gamma' ns' e)
+                            where
+                               ns' = tcDeplete ns
+                               gamma' = tcNew_bvar (x, tvn): gamma
+                               tvn = tcNext_name ns
+
+
+--======================================================--
+--
+tclambda1 tvn x (Fail m) = Fail m
+
+tclambda1 tvn x (Ok (phi, t, annotatedE)) = 
+   Ok (phi, finalType, (finalType, ALam [x] annotatedE))
+   where
+      finalType = (tcApply_sub phi tvn) `TArr` t
+
+
+--======================================================--
+--
+tcNew_bvar (x, tvn) = (x, Scheme [] (TVar tvn))
+
+
+--==========================================================--
+--=== 9.75 Type-checking let-expressions                 ===--
+--==========================================================--
+
+--======================================================--
+--
+tclet :: [TypeDef] ->
+         TcTypeEnv     -> 
+         TypeNameSupply  -> 
+         [Naam]       -> 
+         [CExpr]       -> 
+         CExpr         -> 
+         Reply TypeInfo Message
+
+tclet tds gamma ns xs es e 
+   = tclet1 tds gamma ns0 xs e rhsTypes
+     where
+        (ns0, ns1) = tcSplit ns
+        rhsTypes = tcl tds gamma ns1 es
+        
+
+--======================================================--
+--
+tclet1 tds gamma ns xs e (Fail m) = Fail m
+
+tclet1 tds gamma ns xs e (Ok (phi, ts, rhsAnnExprs)) 
+   = tclet2 phi xs False (tc tds gamma'' ns1 e) rhsAnnExprs
+     where
+        gamma'' = tcAdd_decls gamma' ns0 xs ts
+        gamma'  = tcSub_te phi gamma
+        (ns0, ns1) = tcSplit ns
+
+
+--======================================================--
+--
+tclet2 phi xs recFlag (Fail m) rhsAnnExprs = Fail m
+
+tclet2 phi xs recFlag (Ok (phi', t, annotatedE)) rhsAnnExprs
+   = Ok (phi' `tcScomp` phi, t, (t, ALet recFlag (zip xs rhsAnnExprs) annotatedE))
+
+
+--======================================================--
+--
+tcAdd_decls :: TcTypeEnv     ->
+               TypeNameSupply  -> 
+               [Naam]       ->
+               [TExpr]   ->
+               TcTypeEnv
+
+tcAdd_decls gamma ns xs ts = (xs `zip` schemes) ++ gamma
+                             where
+                                schemes = map (tcGenbar unknowns ns) ts
+                                unknowns = tcUnknowns_te gamma
+
+
+--======================================================--
+--
+tcGenbar unknowns ns t = Scheme (map second al) t'
+                         where
+                            al = scvs `zip` (tcName_sequence ns)
+                            scvs = (nub (tcTvars_in t)) `tcBar` unknowns
+                            t' = tcSub_type (tcAl_to_subst al) t
+
+
+
+--==========================================================--
+--=== 9.76 Type-checking letrec-expressions              ===--
+--==========================================================--
+
+--======================================================--
+--
+tcletrec :: [TypeDef] ->
+            TcTypeEnv     -> 
+            TypeNameSupply  -> 
+            [Naam]       -> 
+            [CExpr]       -> 
+            CExpr         -> 
+            Reply TypeInfo Message
+
+tcletrec tds gamma ns xs es e 
+   = tcletrec1 tds gamma ns0 xs nbvs e 
+               (tcl tds (nbvs ++ gamma) ns1 es)
+     where
+        (ns0, ns') = tcSplit ns
+        (ns1, ns2) = tcSplit ns'
+        nbvs = tcNew_bvars xs ns2
+
+
+--======================================================--
+--
+tcNew_bvars xs ns = map tcNew_bvar (xs `zip` (tcName_sequence ns))
+
+
+
+--======================================================--
+--
+tcletrec1 tds gamma ns xs nbvs e (Fail m) = (Fail m)
+
+tcletrec1 tds gamma ns xs nbvs e (Ok (phi, ts, rhsAnnExprs)) 
+   = tcletrec2 tds gamma' ns xs nbvs' e (tcUnifyl phi (ts `zip` ts')) rhsAnnExprs
+     where
+        ts' = map tcOld_bvar nbvs'
+        nbvs' = tcSub_te phi nbvs
+        gamma' = tcSub_te phi gamma
+
+
+--======================================================--
+--
+tcOld_bvar (x, Scheme [] t) = t
+
+
+--======================================================--
+--
+tcletrec2 tds gamma ns xs nbvs e (Fail m) rhsAnnExprs = (Fail m)
+
+tcletrec2 tds gamma ns xs nbvs e (Ok phi) rhsAnnExprs
+   = tclet2 phi xs True (tc tds gamma'' ns1 e) rhsAnnExprs 
+     where
+        ts = map tcOld_bvar nbvs'
+        nbvs' = tcSub_te phi nbvs
+        gamma' = tcSub_te phi gamma
+        gamma'' = tcAdd_decls gamma' ns0 (map first nbvs) ts
+        (ns0, ns1) = tcSplit ns
+        subnames = map first nbvs
+
+
+--==========================================================--
+--=== End                               TypeCheck5.m (1) ===--
+--==========================================================--
diff --git a/ghc/tests/programs/jules_xref2/jules_xref2.stdout b/ghc/tests/programs/jules_xref2/jules_xref2.stdout
new file mode 100644 (file)
index 0000000..6adf88b
--- /dev/null
@@ -0,0 +1,499 @@
+A: 3
+Aap: 937 63 27 26
+Acase: 719 67 31 30
+Aconstr: 62 25 25
+Alam: 967 64 32 32
+Alet: 1015 65 29 28
+Alist: 899 802 799 782 773 770 762 700 675 649 553 415
+Also: 682 596
+Annexpr: 842 120 52 45 44 18 17
+Anum: 515 61 24 24
+Association: 411
+Atomicprogram: 119
+Avar: 879 60 23 23
+Basedefs: 8
+Big: 735 733 718
+Cannot: 306
+Case: 822 622 601
+Cexpr: 1053 1052 988 987 952 915 914 841 698 673 648 646 589 586 511
+Char: 120 109 78
+Circular: 268
+Constralt: 800 771
+Corrected: 4
+Eap: 523
+Ecase: 540
+Econstr: 520
+Elam: 531 530 528 526
+Elet: 533
+End: 1104
+Enum: 514
+Eq: 390
+Error: 621 601
+Evar: 517
+Fail: 1090 1090 1073 1073 1012 1012 1000 1000 964 964 935 934 927 926 861 861 854 854 635 633 631 629 364 324 324 131 125
+False: 1003 150 131 92 90 89 81
+File: 3
+Formatting: 13
+Int: 498 495 484 483 475 474
+Just: 789
+Keeping: 378
+Merging: 329
+Message: 1054 989 953 916 877 842 747 706 702 678 677 651 590 512 361 318 280 258 120
+Myutils: 10
+Naam: 1051 1022 986 951 876 842 815 802 801 799 782 773 772 770 762 700 699 675 674 649 647 615 615 588 587 553 415 415 120 108 52 45 44
+New: 438
+No: 125
+Nothing: 790
+Ok: 1092 1075 1015 1014 1002 967 966 937 936 928 879 863 862 855 845 749 718 717 634 632 630 628 515 363 323 321 264 262 133 130 124
+Projection: 627
+Reply: 1054 989 953 916 877 842 747 706 702 678 677 651 590 512 361 318 280 258 120
+Representation: 155
+Rhs: 656 655 654
+Rhss: 716
+Scheme: 1085 1034 974 891 776 569 404 403 385 141
+Subst: 900 842 747 745 705 703 430 399 370 361 361 347 347 346 334 333 318 316 280 278 258 255 240 231 224 223 222 210 197 43
+Substitutions: 193
+T1: 681
+Tarr: 969 929 566 296 296 293 218 218 189 163 103 90 87
+Tcons: 794 790 739 568 515 515 299 299 290 216 216 188 177 170 102 93 86 85 84
+Tctypeenv: 1049 1024 1020 984 949 912 874 839 696 671 644 584 509 432 431 422 117
+Tdefcons: 793
+Tdefexpr: 783
+Tdefvar: 786
+Texpr: 1023 889 842 842 784 746 704 370 370 317 317 279 279 257 239 212 211 199 182 175 168 161 160 159 120 108 77 52 45 44
+The: 503
+Tk: 681
+True: 1093 150 130 95 91 88 87
+Tvar: 974 929 902 789 739 568 293 290 283 282 269 261 245 244 242 241 241 214 206 203 202 187 101 83
+Tvname: 899 899 799 782 770 762 700 675 649 468 443 423 383 256 238 198 183
+Type: 1043 978 943 906 868 833 548 305 267 97
+Typecheck5: 1104 7 3
+Typedef: 1048 983 948 911 873 838 816 814 760 701 695 676 670 650 643 583 552 508
+Typeenv: 120 53
+Typeinfo: 1054 989 953 916 877 706 702 678 677 651 590 512
+Typenamesupply: 1050 1021 985 950 913 887 875 840 761 697 672 645 585 553 551 510 467 459 459 458 451 450 442 118
+Typescheme: 888 802 773 553 401 400 382
+Undeclared: 820
+Unification: 251
+Utils: 9
+a: 637 636 636 634 632 630 630 574 392 391 390 390 17 16 4
+abstractions: 943
+accordance: 806
+actual: 562
+ae1: 937 936 934 929 928 63 63 27 26
+ae2: 937 936 934 929 928 63 63 27 26
+afn: 70 66
+al: 1038 1036 1034 902 902 894 893 794 793 418 417
+all: 681 655 654 241
+allowable: 713
+als: 607 593
+alternatives: 601
+alters: 544 543
+alts: 543 540 68 67
+an: 715 594 574
+and: 716 681 656 627 597
+ann: 21 20
+annalts: 31 30
+anndefs: 29 28
+annotatede: 1015 1014 967 966 864 862 861 856 855
+annotatedes: 864 862
+annotatedrhss: 737 720
+annotree: 135 133
+applications: 906
+apply: 712 574
+applyntimes: 577 575 572
+arg: 577 576 575 574
+arglists: 544 541
+argument: 596 588
+as: 655 597
+associates: 558
+association: 594
+b: 637 636 634 632 632 630 615 615 415 415 93 86 85 84 83 18 16
+basetypes: 128 122
+be: 805
+big: 717
+bindings: 717 716 584
+binds: 347
+body: 71 70
+bool: 177 150 85 85
+builtintypes: 149 146 127
+bvar: 1095 1085 1078 1067 974 958
+bvars: 1067 1062
+c: 794 793 764 637 637 636 634 634 632 630 521 520 102 62 25 25 18 17
+cal: 776 775 567 560 555
+calculate: 654
+call: 714 655
+calt: 808 807
+calts: 809 807 806
+caltscurried: 566 556
+caltsxlated: 567 566
+case: 548
+char: 86 86
+check: 715
+checker: 503 3
+checking: 1043 978 943 906 868 833 548
+chr: 83
+cl: 829 827 826 95 93
+cname: 775
+compute: 682
+concat: 727 425 350 147 143 102 95 68 66
+constrtypes: 147 145
+constructor: 621 583 565
+constructors: 822 820 815 598 587 543 541
+contains: 822
+cparams: 808 807 776 775
+cparamss: 809 807 805
+cs: 828 818 607 604 599 593 64
+current: 584
+decls: 1098 1026 1020 1005
+deduced: 715
+definition: 682 598 594
+definitions: 814 583
+dl: 538 533 66 65
+downhill: 241
+e: 1093 1092 1090 1076 1075 1073 1057 1056 1003 1002 1000 992 991 955 955 847 846 536 535 533 531 530 529 528 527 526 406 406 64 64 32 32
+e1: 918 918 755 752 751 750 749 524 523
+e2: 918 918 755 753 752 751 750 524 523
+e3: 753 752
+each: 710 656 655 558
+elem: 829 406 394
+else: 823 821 602 536 339 285 204 125
+enscheme: 569 556
+eqn: 324 323 323
+eqns: 321 320
+error: 305 267
+es: 1058 1056 995 991 856 855 854 847 846 753 752 538 536 535
+expr: 128 122 35 34
+expression: 822 716 714 586
+expressions: 1043 978 833 597 589 548 155
+exprs: 544 541
+f: 790 789 787 462 461 453 453 445 141 139 133 133 38 35 32 31 29 27 27 21 20
+f2: 462 461 461
+fail: 822 820 620 600 304 266
+failed: 97
+final: 735 719 718
+finalconstrtypes: 147 139 128
+finalnamesupply: 572 556
+finalns: 145 128
+finaltype: 969 967 967 939 937 937 882 879 879
+first: 1100 1098 829 740 608
+foldr: 566 321 188
+for: 710 681 681 656 655 654 4
+from: 716
+ftvs: 827 826
+fullenv: 143 139 124
+fullenvwords: 143 124
+func: 577 577 575
+function: 574
+functions: 627 565
+g: 663 662
+gamma: 1098 1098 1097 1097 1093 1092 1090 1080 1080 1076 1075 1073 1058 1057 1056 1029 1026 1026 1006 1006 1005 1005 1003 1002 1000 995 992 991 958 958 955 955 918 918 881 879 856 855 854 847 847 846 844 722 708 696 684 680 663 657 653 602 593 541 540 536 535 533 531 530 529 528 527 526 524 523 521 520 518 517 514 434 434 425 425
+gammas: 654
+gather: 716 655
+gathered: 717
+general: 713
+get: 714 712 681 594
+going: 270
+good: 131 130 123
+gs: 663 662
+head: 823 735 374
+hence: 681
+here: 815
+if: 821 819 599 534 337 283 202 123
+import: 10 9 8
+in: 1037 820 805 682 622 621 601 601 598 594 569 559 385 305 267 263 189 189 189 188 188 187 185 185 182
+input: 715 713
+instance: 715
+int: 515 515 170 84 84
+into: 711
+is: 715
+k: 621 619 618 418 418 417
+ks: 623 618
+l: 189 189 188 188 187 187
+lambda: 943
+lead: 241
+length: 821 819 599 599 572
+let: 978
+letrec: 1043
+lhs: 733 731 731 729
+list: 815
+lists: 833 805 596 588 411
+ljustify: 112
+lookup: 99 98 97 96 83
+lookupresult: 206 204 202
+m: 1104 1090 1090 1073 1073 1012 1012 1000 1000 964 964 935 934 927 926 861 861 854 854 635 635 633 633 631 631 629 629 365 364 324 324 3
+mainexpr: 29 28
+make: 710
+map: 1100 1098 1095 1078 1067 1034 1028 829 794 776 740 739 738 737 735 688 687 608 568 567 563 425 356 355 354 216 143 139 102 95 68 66 31 29
+map2nd: 902 567 566 556
+mapaccuml: 146
+mapannalt: 37 31
+mapanndefn: 34 29
+mapannexpr: 32 30 28 26 25 24 23 21
+me: 66 65
+merge: 711 609 607
+missing: 601
+mixed: 822
+module: 7
+most: 713
+must: 805
+n: 791 790 786 727 709 709 704 703 689 688 687 685 685 577 576 575 574 515 514 491 491 490 489 489 489 488 487 478 478 478 406 406 406 310 308 308 306 305 305 273 270 270 268 267 267 112 61 24 24
+naam: 141 141 112 111 71 70 38 37 35 34
+name: 959 920 585 571 470 445 442 97
+namemap: 794 793 791 786
+nbvs: 1100 1098 1096 1096 1095 1092 1090 1079 1079 1078 1076 1075 1073 1062 1058 1057
+new: 716 558 347
+newbinds: 341 339 337
+newsub: 755 753
+newtvs: 738 708 700 684 680 659 657 653 605 602 567 563 560
+newunifiers: 356 355
+newunifierschecked: 356 351 350
+no: 418
+node: 58 58 21 20
+nodetype: 58
+non: 247 247
+not: 534 406 394
+notarrow: 94 93
+note: 805
+notelem: 263
+ns: 1099 1092 1090 1076 1075 1073 1067 1067 1061 1060 1060 1056 1036 1034 1028 1026 1007 1002 1000 994 991 959 957 957 955 955 921 921 920 918 918 893 891 882 879 856 855 854 849 846 844 764 764 722 708 697 684 680 665 653 606 593 572 560 555 541 540 536 535 533 531 530 529 528 527 526 524 523 521 520 518 517 514 492 491 491 488 487 479 478 478 470 470 470 445 445 146 122
+ns0: 1099 1098 1060 1057 1007 1005 994 992 849 847
+ns1: 1099 1093 1061 1058 1007 1003 995 994 849 847 665 660 606 602
+ns2: 1062 1061 665 657 606 605
+nsl: 664 662 661
+nsl1: 664 663
+nsl2: 664 663
+nub: 1037 825 599 569 353 100
+of: 833 815 715 714 710 683 598 594 565 378 347 329 155 13
+og: 374 373
+ogs: 374 373
+oldgroups: 355 354 351
+olds: 347
+oldvars: 354 353 351
+on: 656
+one: 711
+ordered: 805
+otherwise: 577 492 490 479 265 99
+p: 294 293 291 290
+pair: 347
+panic: 635 633 631 629 418 365 97
+param: 805
+pars: 38 37
+pass: 656 595
+phi: 1097 1096 1093 1092 1080 1079 1076 1075 1015 1015 1014 1014 1012 1006 1003 1002 969 967 966 939 937 936 929 928 894 891 863 862 861 856 856 855 735 733 733 733 731 729 727 727 727 727 725 724 723 723 722 718 709 709 705 703 689 687 685 685 434 434 406 406 404 403 354 353 349 341 336 323 323 321 320 303 301 299 297 296 294 293 291 290 288 287 285 284 282 264 262 260 218 218 218 216 216 214 214 206 204 201 47 47
+phit: 288 285 284
+phitvn: 287 285 283
+poly: 558
+pretty: 95 93 92 91 90 89 88 87 86 85 84 83 81
+program: 621 601 305 267
+psi: 863 863 862
+q: 294 293 291 290
+r: 663 662 363 363
+recflag: 1015 1014 1012 29 28
+recursive: 534 533
+reflect: 597
+reoals: 720 708 699 684 680 659 657 653 609 602
+reorder: 596
+reores: 660 653 609 602
+res: 607 593
+resexpr: 38 37
+result: 791 787 717 683
+resulting: 597 589
+results: 13
+return: 717
+reverse: 731
+revised: 571
+rf: 65
+rhs: 727 709 705 689 685
+rhsannexprs: 1093 1092 1090 1076 1075 1015 1014 1012 1003 1002
+rhsgammas: 660 659
+rhstc1: 663 662 661 660
+rhstcs: 737 735 708 702 688 687 684 680 660 657
+rhstypes: 995 992
+rootenv: 139 137
+rootsubst: 135 133
+roottree: 137 135 124
+roottype: 133
+rs: 663 662
+rubbish: 627
+s: 731 727 725 725 724 724 723 723 722 719 712 654 461 453 453 445
+scheme: 882 881 434 425 403 399 385 382
+schemes: 1028 1026
+scvs: 1037 1036 893 891 406 406 404 404 403 385 385
+second: 1034 738 563 68 68
+sequence: 1067 1036 893 764 598 470 470 467
+sigmas: 656
+signature: 712
+similar: 627
+so: 655 597
+source: 621 601 305 267
+st: 434 434
+stau: 725 724 723 722
+stree: 725 724 723 722
+stvs: 560 555
+sub: 969 939 755 752 751 750 749 749 287 214 201 197
+sub1: 226 226
+sub2: 226 226
+subnames: 1100
+subst: 1038 902 899 894 879 845 731 689 515 355 233 231
+substitution: 717 712 268
+substitutions: 711 710 329 241
+such: 418
+supply: 585 571
+sw: 722 708 698 684 680 657 653 602 593 68 67
+switch: 716 714 586 541 540
+switchexpr: 31 30
+t: 1085 1085 1038 1038 1037 1034 1034 1015 1015 1014 969 966 891 891 863 862 861 856 855 764 404 403 385 385 288 282 272 264 263 261 260 185 185 141 141 101 101 100 98 98 81 80
+t1: 929 928 307 303 297 297 296 296 218 218 189 189 163 163 103 103 91 90 88 87
+t2: 929 928 309 303 297 297 296 296 218 218 189 189 163 163 103 103 92 90 89 87
+t2e: 71 68 68 67 66 65 64 64 63 63 63 62 61 60 58 58 56
+tau: 735 731 731 729 724 719 718 709 704 689 688 685
+tc: 1093 1003 955 847 722 714 663 655 540 533 530 528 527 526 523 520 517 514 508 127
+tcadd: 1098 1026 1020 1005
+tcal: 1038 902 899 894
+tcap: 918 911 524
+tcap1: 928 926 918
+tcap2: 936 934 929
+tcapply: 969 939 287 214 201 197
+tcarrow: 163 159
+tcbar: 1037 394 390 385
+tcbool: 177 175
+tccase: 593 583 541
+tccase1: 653 643 602
+tccase2: 680 670 657
+tccase3: 708 695 684
+tccharval: 881 418 417 415
+tccheck: 122 117
+tccheckunifier: 365 364 363 361 356
+tcconstrtypeschemes: 555 551 146
+tcdelta: 264 247 242 238
+tcdeoksel: 755 733 689 629 629 628
+tcdeplete: 957 921 572 470 453 450
+tcexclude: 406 404
+tcextend: 284 260 255
+tcgenbar: 1034 1028
+tcgetallgammas: 809 807 804 799 659
+tcgetgamman: 808 775 770
+tcgettypedef: 818 814 604
+tcid: 879 845 731 689 515 355 233 231
+tcint: 170 168
+tck31sel: 739 636
+tck33: 740 659 637 608
+tcl: 1058 995 918 856 846 844 838
+tcl1: 855 854 847
+tcl2: 862 861 856
+tclambda: 955 948 531 529
+tclambda1: 966 964 955
+tclet: 991 983 535
+tclet1: 1002 1000 992
+tclet2: 1093 1014 1012 1003
+tcletrec: 1056 1048 536
+tcletrec1: 1075 1073 1057
+tcletrec2: 1092 1090 1076
+tcmapannexpr: 47 38 35 32 31 29 27 27 20 16
+tcmergesubs: 733 727 339 336 333
+tcmergesubsmain: 349 346 341
+tcn: 300 300 299 299 216 216
+tcname: 1067 1036 893 764 470 470 467
+tcnew: 1067 1067 1062 974 958
+tcnewinstance: 891 887 882
+tcnewtypevars: 764 760 605 560
+tcnext: 959 920 470 445 442
+tcnsdlimit: 499 499 496 495 489 489
+tcnsdouble: 492 491 487 486 483 462
+tcnsslimit: 499 498 478
+tcnssucc: 492 479 478 477 474 461 453
+tcok13sel: 723 687 631 631 630
+tcok23sel: 735 724 688 633 633 632
+tcok33sel: 737 725 635 635 634
+tcold: 1095 1085 1078
+tcoldunified: 374 373 372 370 351
+tcpretty: 143 111 108
+tcreorder: 623 618 617 615 609
+tcresult: 133 127 123
+tcscomp: 1015 863 264 226 222
+tcshowtexpr: 309 307 272 269 113 97 80 77
+tcsplit: 1099 1061 1060 1007 994 849 665 664 606 461 458
+tcsub: 1097 1096 1080 1079 1038 1006 891 863 856 735 729 434 434 430 404 403 399 374 288 218 218 218 216 216 214 210 204 47
+tcsubstanntree: 135 47 43
+tctdefsubst: 794 793 786 782 776 567
+tctreetoenv: 137 55 52
+tctvars: 1037 569 385 263 185 182
+tcunify: 929 755 751 731 323 303 299 296 294 293 291 290 285 282 278
+tcunifyl: 1076 320 316 301 297
+tcunifyset: 753 752 750 749 745 689 355
+tcunknowns: 1029 425 425 422 385 382
+tcvar: 879 873 521 518
+tdcnames: 740 720 609 608 599
+tdefs: 146 127 122
+tdefset: 825 823 821 819
+tdinuse: 740 739 708 701 684 680 659 657 653 608 605 604 602
+tds: 1093 1092 1090 1076 1075 1073 1058 1057 1056 1003 1002 1000 995 992 991 955 955 918 918 879 856 855 854 847 847 846 844 827 818 722 708 695 684 680 663 657 653 604 602 593 541 540 536 535 533 531 530 529 528 527 526 524 523 521 520 518 517 514
+tdsignature: 739 729 568 566
+te: 1097 1096 1080 1079 1029 1006 856 434 430 425 422
+texp: 569 569 569
+texpr: 247 247
+that: 715
+the: 717 717 716 716 715 714 714 712 712 712 711 710 683 682 682 681 681 655 654 654 598 597 596 594 571 565 565 562 559
+themselves: 562
+then: 822 820 656 600 535 338 284 203 124
+therein: 595
+these: 731
+this: 715
+tijp: 71 70
+times: 574
+tipe: 113 111
+tn: 568 560 555
+tname: 827 826
+to: 1038 902 899 894 727 714 712 712 709 709 704 703 689 688 687 685 685 681 655 597 595 574 270
+track: 378
+tree: 725 719 56 55 47 47
+ts: 1098 1095 1078 1076 1076 1075 1028 1026 1005 1002 863 862 301 301 299 299 216 216 188 188 102 102 99 98
+tvars: 710 189 189 189 188 188 187 185
+tvdict: 103 103 103 102 102 101 100 100 83
+tvl: 809 808 807 804 776 775
+tvn: 974 974 969 966 964 959 958 955 939 936 934 929 929 928 926 920 918 789 789 287 284 283 282 269 264 263 261 260 247 247 245 245 244 244 243 242 214 214 206 206 203 202 201
+tvn2: 245 245 244 244 243 242
+tvname: 99 98 98 96 83 83
+tvs: 739 738 572 568 563
+type: 1038 891 863 814 735 729 717 715 714 713 682 682 595 594 584 583 562 559 558 503 404 374 288 218 218 218 216 216 214 210 204 155 125 47 3
+typedef: 712
+types: 683 656 565 378
+u: 374 373
+undeclared: 621
+unified: 347
+unifiedolds: 341 339 338
+unifier: 683 681
+unifiers: 681
+unify: 324 323 321 306
+unknown: 710
+unknowns: 1037 1034 1029 1028
+unzip2: 609 544 543 538
+uol: 623 619 618 617
+up: 710
+us: 374 373
+use: 820 594
+used: 815
+usedc: 829 828
+utdomain: 353
+utlookup: 791
+utlookupall: 354
+utlookupdef: 619 418 206
+utrange: 425
+v: 60 23 23
+v5: 3
+var: 558 247 247
+variable: 418
+variables: 868 682 595 562 438
+vars: 595 558
+version: 4
+vl: 764 764
+vs: 141 32 32
+where: 1094 1077 1059 1035 1027 1004 993 968 956 938 919 892 880 848 824 788 754 721 686 664 658 603 557 542 537 489 462 405 352 340 322 286 205 186 140 133 126 82 57 22 7
+with: 806 558 308
+x: 1085 974 974 967 966 964 958 955 955 881 879 879 628 628 531 530 529 528 518 517 434 434 394 394 394 187 187 133 133 130
+x2: 131
+xs: 1093 1092 1090 1076 1075 1073 1067 1067 1062 1057 1056 1026 1026 1015 1014 1012 1005 1003 1002 1000 992 991 538 536 535 531 530 394 394
+y: 531 530 188
+ys: 394 394
+zip: 1076 1067 1036 1026 1015 893 776 764 720 720 607 607 351 301
diff --git a/ghc/tests/programs/launchbury/Main.hs b/ghc/tests/programs/launchbury/Main.hs
new file mode 100644 (file)
index 0000000..6351d54
--- /dev/null
@@ -0,0 +1,18 @@
+e=181021504832735228091659724090293195791121747536890433
+
+u(f,m)x=i(m(x),       [],let(a,b)=f(x)       in(a:u(f,m)b))
+(v,h)=(foldr(\x(y    )->00+128*y+x)0,u(     sp(25),((==)"")))
+p::(Integer,Integer )->Integer      ->     Integer    --NotInt
+p(n,m)x     =i(n==0 ,1,i(z n             ,q(n,m)x,    r(n,m)x))
+i(n,e,d     )=if(n) then(e)              else  (d)    --23+3d4f
+(g,main     ,s,un)= (\x->x,             y(j),\x->x*x,unlines)--)
+j(o)=i(take(2)o==   "e=","e="++t        (drop(4-2)o),i(d>e,k,l)o)
+l=un.map (show.p      (e,n).v.map(      fromIntegral{-g-}.fromEnum)).h
+k=co.map(map(toEnum       .fromIntegral    ).w.p(d,n).   read).lines
+(t,y)=(\ (o:q)->              i(o=='-'  ,'1','-' ):   q,interact)
+q(n,m)x=   mod(s(    p(        div(n)2, m{-jl-})x)    )m--hd&&gdb
+(r,z,co)    =(\(n,   m)x->mod(x*p(n-1,  m)x)m,even    ,concat)--6
+(w,sp)=(    u(\x->(   mod(x)128,div(x   )128),(==0    )),splitAt)
+
+d=563347325936+1197371806136556985877790097-563347325936
+n=351189532146914946493104395525009571831256157560461451
diff --git a/ghc/tests/programs/launchbury/Makefile b/ghc/tests/programs/launchbury/Makefile
new file mode 100644 (file)
index 0000000..de6e7e0
--- /dev/null
@@ -0,0 +1,7 @@
+TOP = ../..
+include $(TOP)/mk/boilerplate.mk
+
+all :: runtest
+
+include $(TOP)/mk/target.mk
+
diff --git a/ghc/tests/programs/launchbury/launchbury.stdin b/ghc/tests/programs/launchbury/launchbury.stdin
new file mode 100644 (file)
index 0000000..085b33d
--- /dev/null
@@ -0,0 +1,18 @@
+e=181021504832735228091659724090293195791121747536890433
+
+u(f,m)x=i(m(x),       [],let(a,b)=f(x)       in(a:u(f,m)b))
+(v,h)=(foldr(\x(y    )->00+128*y+x)0,u(     sp(25),((==)"")))
+p::(Integer,Integer )->Integer      ->     Integer    --NotInt
+p(n,m)x     =i(n==0 ,1,i(z n             ,q(n,m)x,    r(n,m)x))
+i(n,e,d     )=if(n) then(e)              else  (d)    --23+3d4f
+(g,main     ,s,un)= (\x->x,             y(j),\x->x*x,unlines)--)
+j(o)=i(take(2)o==   "e=","e="++t        (drop(4-2)o),i(d>e,k,l)o)
+l=un.map (show.p      (e,n).v.map(      fromIntegral{-g-}.ord)).h
+k=co.map(map(chr       .fromIntegral    ).w.p(d,n).   read).lines
+(t,y)=(\ (o:q)->              i(o=='-'  ,'1','-' ):   q,interact)
+q(n,m)x=   mod(s(    p(        div(n)2, m{-jl-})x)    )m--hd&&gdb
+(r,z,co)    =(\(n,   m)x->mod(x*p(n-1,  m)x)m,even    ,concat)--6
+(w,sp)=(    u(\x->(   mod(x)128,div(x   )128),(==0    )),splitAt)
+
+d=563347325936+1197371806136556985877790097-563347325936
+n=351189532146914946493104395525009571831256157560461451
diff --git a/ghc/tests/programs/launchbury/launchbury.stdout b/ghc/tests/programs/launchbury/launchbury.stdout
new file mode 100644 (file)
index 0000000..9eb0357
--- /dev/null
@@ -0,0 +1,18 @@
+e=-81021504832735228091659724090293195791121747536890433
+
+u(f,m)x=i(m(x),       [],let(a,b)=f(x)       in(a:u(f,m)b))
+(v,h)=(foldr(\x(y    )->00+128*y+x)0,u(     sp(25),((==)"")))
+p::(Integer,Integer )->Integer      ->     Integer    --NotInt
+p(n,m)x     =i(n==0 ,1,i(z n             ,q(n,m)x,    r(n,m)x))
+i(n,e,d     )=if(n) then(e)              else  (d)    --23+3d4f
+(g,main     ,s,un)= (\x->x,             y(j),\x->x*x,unlines)--)
+j(o)=i(take(2)o==   "e=","e="++t        (drop(4-2)o),i(d>e,k,l)o)
+l=un.map (show.p      (e,n).v.map(      fromIntegral{-g-}.ord)).h
+k=co.map(map(chr       .fromIntegral    ).w.p(d,n).   read).lines
+(t,y)=(\ (o:q)->              i(o=='-'  ,'1','-' ):   q,interact)
+q(n,m)x=   mod(s(    p(        div(n)2, m{-jl-})x)    )m--hd&&gdb
+(r,z,co)    =(\(n,   m)x->mod(x*p(n-1,  m)x)m,even    ,concat)--6
+(w,sp)=(    u(\x->(   mod(x)128,div(x   )128),(==0    )),splitAt)
+
+d=563347325936+1197371806136556985877790097-563347325936
+n=351189532146914946493104395525009571831256157560461451
diff --git a/ghc/tests/programs/lennart_array/Main.hs b/ghc/tests/programs/lennart_array/Main.hs
new file mode 100644 (file)
index 0000000..6f00ec6
--- /dev/null
@@ -0,0 +1,23 @@
+{-
+Date: Thu, 22 Sep 1994 01:45:39 +0200
+From: Lennart Augustsson <augustss@cs.chalmers.se>
+Message-Id: <199409212345.BAA01703@statler.cs.chalmers.se>
+To: glasgow-haskell-bugs@dcs.glasgow.ac.uk
+Subject: ghc bug
+
+
+Ghc has the wrong semantics for arrays as exemplified by this simple
+program:
+-}
+
+import Array -- 1.3
+
+main = print (array (1,1) [ (1,2), (1,3) ])
+
+{-
+As can be seen from the reference implementation in the report this
+should give an error, but there is no complaint when the program
+is run.
+
+       -- Lennart
+-}
diff --git a/ghc/tests/programs/lennart_array/Makefile b/ghc/tests/programs/lennart_array/Makefile
new file mode 100644 (file)
index 0000000..de6e7e0
--- /dev/null
@@ -0,0 +1,7 @@
+TOP = ../..
+include $(TOP)/mk/boilerplate.mk
+
+all :: runtest
+
+include $(TOP)/mk/target.mk
+
diff --git a/ghc/tests/programs/lennart_array/lennart_array.stdout b/ghc/tests/programs/lennart_array/lennart_array.stdout
new file mode 100644 (file)
index 0000000..e69de29
diff --git a/ghc/tests/programs/lennart_range/Main.hs b/ghc/tests/programs/lennart_range/Main.hs
new file mode 100644 (file)
index 0000000..c45e4b2
--- /dev/null
@@ -0,0 +1,24 @@
+{-
+Date: Thu, 22 Sep 1994 01:59:49 +0200
+From: Lennart Augustsson <augustss@cs.chalmers.se>
+Message-Id: <199409212359.BAA01719@statler.cs.chalmers.se>
+To: glasgow-haskell-bugs@dcs.glasgow.ac.uk
+Subject: ghc bug
+
+
+Some floating constants that are within the floating range
+become wrong, e.g. 
+
+       1.82173691287639817263897126389712638972163e-300::Double
+
+       -- Lennart
+
+PS.  Maybe you use fromRational as defined in the Prelude?
+That won't do.  It is badly broken, tell me if you want
+one that works.
+-}
+
+-- I have turned this into a general test of extreme constants.
+-- WDP 94/12
+
+main = putStr (shows (1.82173691287639817263897126389712638972163e-300::Double) "\n")
diff --git a/ghc/tests/programs/lennart_range/Makefile b/ghc/tests/programs/lennart_range/Makefile
new file mode 100644 (file)
index 0000000..de6e7e0
--- /dev/null
@@ -0,0 +1,7 @@
+TOP = ../..
+include $(TOP)/mk/boilerplate.mk
+
+all :: runtest
+
+include $(TOP)/mk/target.mk
+
diff --git a/ghc/tests/programs/lennart_range/lennart_range.stdout b/ghc/tests/programs/lennart_range/lennart_range.stdout
new file mode 100644 (file)
index 0000000..5196dcc
--- /dev/null
@@ -0,0 +1 @@
+1.821736912876398e-300
diff --git a/ghc/tests/programs/lex/Main.hs b/ghc/tests/programs/lex/Main.hs
new file mode 100644 (file)
index 0000000..4c9a448
--- /dev/null
@@ -0,0 +1,9 @@
+module Main where
+
+main = interact ( \ s -> shows (lex' s) "\n")
+     where lex' "" = []
+          lex' s = tok : lex' s' where -- [(tok,s')] = lex s
+                                       (tok,s') = case lex s of
+                                                   [r]   -> r
+                                                   []    -> error ("Empty: " ++ s) 
+                                                   other -> error ("Multi: " ++ s)
diff --git a/ghc/tests/programs/lex/Makefile b/ghc/tests/programs/lex/Makefile
new file mode 100644 (file)
index 0000000..de6e7e0
--- /dev/null
@@ -0,0 +1,7 @@
+TOP = ../..
+include $(TOP)/mk/boilerplate.mk
+
+all :: runtest
+
+include $(TOP)/mk/target.mk
+
diff --git a/ghc/tests/programs/lex/lex.stdin b/ghc/tests/programs/lex/lex.stdin
new file mode 100644 (file)
index 0000000..dcd009c
--- /dev/null
@@ -0,0 +1,170 @@
+module Graph  where
+
+import Parse
+import StdLib
+import PSlib
+import GRIP
+
+paperX = 280::Int
+paperY = 190::Int
+
+fromInt :: Num a => Int -> a
+fromInt = fromInteger . toInteger
+
+gspostscript str = initialise stdheader ++ portrait ++ str ++ "showpage\n"
+postscript str = initialise stdheader ++ landscape ++ str ++ "showpage\n"
+
+ePostscript (reqdx,reqdy) str = initialise (stdheader++
+       "%%BoundingBox: 0 0 "++show (cms2pts reqdx)++" "++show (cms2pts reqdy)++"\n"
+                       ++ "%%EndComments\n")
+       ++ scale (fromInt reqdx*10/fromInt paperX) (fromInt reqdy*10/fromInt paperY) ++ str ++
+       showpage
+
+initGraph title pedata (topX,topY) (xlabel,ylabel) keys = 
+       drawBox (Pt 0 0) paperX paperY ++
+       drawBox (Pt 1 1) (paperX-2) 5 ++ 
+       drawBox (Pt 1 (paperY-7)) (paperX-2) 6 ++
+       setfont "BOLD" ++ moveto (Pt (paperX `div` 2) (paperY-6)) ++ cjustify (title) ++
+       setfont "NORM" ++
+       placePEs pedata ++
+       translate 20 25 ++
+       newpath ++ moveto (Pt 0 (-5)) ++ lineto (Pt 0 dimY) ++  
+        moveto (Pt (-5) 0) ++ lineto (Pt dimX 0) ++ stroke ++   
+       setfont "SMALL" ++
+       markXAxis dimX topX++
+       markYAxis dimY topY++
+       moveto (Pt 0 (dimY+4)) ++ rjustify ylabel ++ stroke ++
+       moveto (Pt dimX (-8)) ++ rjustify xlabel ++ stroke ++
+       setfont "NORM" ++
+       dokeys dimX keys 
+
+placePEs (pes,on) | checkPEs (tail pes) on = 
+               showActive (length pes) (length used) ++
+               showUsed pes used ++ setfont "NORM"
+               where used = if on==[] then tail pes else on
+               
+
+cms2pts :: Int -> Int
+cms2pts x = round (28.4584 * fromInt x)
+
+plotCurve ::  Int -> [Point] -> Postscript
+plotCurve x pts = setgray x ++ fillObject pts
+
+plot :: [Point] -> Postscript
+plot points = plotCurve 5 (Pt 0 0:points)
+
+dokeys left keys = concat (map2 format (places 0) keys)
+       where
+       format pt@(Pt x y) (col,tex,pc) = fillBox pt 16 9 col ++ stroke ++ moveto (Pt (x+17) (y+3))
+                                       ++ text tex ++ stroke ++ moveto (Pt (x+8) (y+3)) ++
+                                       inv col ++ setfont "BOLD" ++ cjustify (pc) ++ 
+                                       stroke ++ setfont "NORM" ++ setgray 10 
+       no=left `div` length keys
+       places n | n == no = []
+       places n = (Pt (n*no) (-17)):places (n+1)
+
+showActive t f = 
+               setfont "LARGE" ++ moveto (Pt 10 16) ++ cjustify (show f) ++
+               setfont "SMALL" ++ moveto (Pt 10 12) ++ cjustify "PE(s)" ++ stroke ++ 
+               setfont "SMALL" ++ moveto (Pt 10 8) ++ cjustify "displayed" ++ stroke ++ 
+               setfont "NORM"
+
+showUsed (m:pes) on = moveto (Pt 2 2) ++ setfont "SMALL" ++ text "Configuration:" ++
+                       dopes (paperX-27) (("SMALLITALIC",showPE m):map f pes) ++ stroke
+       where
+       f pe | elem pe on = ("SMALLBOLD",showPE pe)
+            | otherwise = ("SMALL",showPE pe)
+
+dopes left pes = concat (map2 format (places 0) pes)
+        where
+        format pt@(Pt x y) (font,tex) = setfont font ++ moveto pt  ++ text tex ++ stroke
+        no=left `div` ((length pes*2)+1)
+       f x = (no*((x*2)+1)) + 27
+        places n | n>2*no = []
+        places n = (Pt (f n) 2):places (n+1)
+
+
+
+checkPEs pes [] = True
+checkPEs pes (p:ps) | elem p pes = checkPEs pes ps
+                   | otherwise = error ("Attempt to gather information from inactive PE - "++ showPE p)
+
+showPE :: PElement -> String
+showPE (PE str no) = str++"."++show no
+
+inv x | x>=5 = setgray 0
+      | otherwise = setgray 10
+
+dimX = paperX-30
+dimY = paperY-40
+
+markXAxis :: Int -> Int -> Postscript
+markXAxis dimX maxX = label 10 ++ markOnX 100
+       where
+       label 0 = ""
+       label x = newpath ++ moveto (Pt (notch x) 0) ++ rlineto 0 (-2) ++ 
+                 moveto (Pt (notch x) (-5)) ++ 
+                 cjustify (printFloat (t x)) ++ stroke ++ label (x-1)
+       t x = fromInt x*(fromInt maxX / fromInt 10) 
+       notch x = x*(dimX `div` 10)
+
+markOnX n = mapcat notches [1..n] ++ stroke
+       where
+       notches n = movetofloat (m*fromInt n) 0 ++  (rlineto 0 (-1)) ++ stroke
+       m = fromInt dimX/fromInt n
+
+
+markYAxis :: Int -> Int -> Postscript
+markYAxis dimY maxY = label 10 ++ markOnY (calibrate maxY)
+       where
+       label 0 = ""
+       label x = newpath ++ moveto (Pt 0 (notch x)) ++ rlineto (-2) 0 ++ 
+                 moveto (Pt (-3) (notch x)) ++ 
+                 rjustify (printFloat (t x)) ++ stroke ++ label (x-1)
+       t x = fromInt x*(fromInt maxY / fromInt 10) 
+       notch x = x*(dimY `div` 10)
+
+calibrate x | x<=1 = 1
+           | x<=100 = x
+           | otherwise = calibrate (x `div` 10)
+
+markOnY n = mapcat notches [1..n] ++ stroke
+       where
+       notches n = movetofloat 0 (m*fromInt n) ++  (rlineto (-1) 0) 
+       m = fromInt dimY/fromInt n
+
+movetofloat x y = show x ++ " " ++ show y ++ " moveto\n"
+
+
+determineScale :: [Point] -> (Int,Int)
+determineScale pts = (axisScale x, axisScale y)
+       where   (min,Pt x y) = minandmax pts
+
+axisScale :: Int -> Int
+axisScale x = axisScale' x 1
+axisScale' x m | x <= m = m
+               | x <= m*2 = m*2
+               | x <= m*5 = m*5
+               | x <= m*10 = m*10
+               | otherwise = axisScale' x (m*10) 
+
+minandmax :: [Point] -> (Point,Point)
+minandmax [] = error "No points"
+minandmax (p:ps) = f (p,p) ps
+       where
+       f p [] = p
+       f (Pt minx miny,Pt maxx maxy) (Pt x y:ps) = f (Pt minx' miny',Pt maxx' maxy') ps
+                       where   minx' = min x minx
+                               miny' = min y miny
+                               maxx' = max x maxx
+                               maxy' = max y maxy
+
+
+printFloat :: Float -> String
+printFloat x = f (show (round (x*10)))
+               where
+               f "0" = "0"
+               f r | x<1 = "0."++r
+               f (r:"0") | x<10 = [r]
+               f (r:m) | x<10 = r:'.':m
+               f _ = show (round x)
diff --git a/ghc/tests/programs/lex/lex.stdout b/ghc/tests/programs/lex/lex.stdout
new file mode 100644 (file)
index 0000000..1623480
--- /dev/null
@@ -0,0 +1 @@
+["module", "Graph", "where", "import", "Parse", "import", "StdLib", "import", "PSlib", "import", "GRIP", "paperX", "=", "280", "::", "Int", "paperY", "=", "190", "::", "Int", "fromInt", "::", "Num", "a", "=>", "Int", "->", "a", "fromInt", "=", "fromInteger", ".", "toInteger", "gspostscript", "str", "=", "initialise", "stdheader", "++", "portrait", "++", "str", "++", "\"showpage\\n\"", "postscript", "str", "=", "initialise", "stdheader", "++", "landscape", "++", "str", "++", "\"showpage\\n\"", "ePostscript", "(", "reqdx", ",", "reqdy", ")", "str", "=", "initialise", "(", "stdheader", "++", "\"%%BoundingBox: 0 0 \"", "++", "show", "(", "cms2pts", "reqdx", ")", "++", "\" \"", "++", "show", "(", "cms2pts", "reqdy", ")", "++", "\"\\n\"", "++", "\"%%EndComments\\n\"", ")", "++", "scale", "(", "fromInt", "reqdx", "*", "10", "/", "fromInt", "paperX", ")", "(", "fromInt", "reqdy", "*", "10", "/", "fromInt", "paperY", ")", "++", "str", "++", "showpage", "initGraph", "title", "pedata", "(", "topX", ",", "topY", ")", "(", "xlabel", ",", "ylabel", ")", "keys", "=", "drawBox", "(", "Pt", "0", "0", ")", "paperX", "paperY", "++", "drawBox", "(", "Pt", "1", "1", ")", "(", "paperX", "-", "2", ")", "5", "++", "drawBox", "(", "Pt", "1", "(", "paperY", "-", "7", ")", ")", "(", "paperX", "-", "2", ")", "6", "++", "setfont", "\"BOLD\"", "++", "moveto", "(", "Pt", "(", "paperX", "`", "div", "`", "2", ")", "(", "paperY", "-", "6", ")", ")", "++", "cjustify", "(", "title", ")", "++", "setfont", "\"NORM\"", "++", "placePEs", "pedata", "++", "translate", "20", "25", "++", "newpath", "++", "moveto", "(", "Pt", "0", "(", "-", "5", ")", ")", "++", "lineto", "(", "Pt", "0", "dimY", ")", "++", "moveto", "(", "Pt", "(", "-", "5", ")", "0", ")", "++", "lineto", "(", "Pt", "dimX", "0", ")", "++", "stroke", "++", "setfont", "\"SMALL\"", "++", "markXAxis", "dimX", "topX", "++", "markYAxis", "dimY", "topY", "++", "moveto", "(", "Pt", "0", "(", "dimY", "+", "4", ")", ")", "++", "rjustify", "ylabel", "++", "stroke", "++", "moveto", "(", "Pt", "dimX", "(", "-", "8", ")", ")", "++", "rjustify", "xlabel", "++", "stroke", "++", "setfont", "\"NORM\"", "++", "dokeys", "dimX", "keys", "placePEs", "(", "pes", ",", "on", ")", "|", "checkPEs", "(", "tail", "pes", ")", "on", "=", "showActive", "(", "length", "pes", ")", "(", "length", "used", ")", "++", "showUsed", "pes", "used", "++", "setfont", "\"NORM\"", "where", "used", "=", "if", "on", "==", "[", "]", "then", "tail", "pes", "else", "on", "cms2pts", "::", "Int", "->", "Int", "cms2pts", "x", "=", "round", "(", "28.4584", "*", "fromInt", "x", ")", "plotCurve", "::", "Int", "->", "[", "Point", "]", "->", "Postscript", "plotCurve", "x", "pts", "=", "setgray", "x", "++", "fillObject", "pts", "plot", "::", "[", "Point", "]", "->", "Postscript", "plot", "points", "=", "plotCurve", "5", "(", "Pt", "0", "0", ":", "points", ")", "dokeys", "left", "keys", "=", "concat", "(", "map2", "format", "(", "places", "0", ")", "keys", ")", "where", "format", "pt", "@", "(", "Pt", "x", "y", ")", "(", "col", ",", "tex", ",", "pc", ")", "=", "fillBox", "pt", "16", "9", "col", "++", "stroke", "++", "moveto", "(", "Pt", "(", "x", "+", "17", ")", "(", "y", "+", "3", ")", ")", "++", "text", "tex", "++", "stroke", "++", "moveto", "(", "Pt", "(", "x", "+", "8", ")", "(", "y", "+", "3", ")", ")", "++", "inv", "col", "++", "setfont", "\"BOLD\"", "++", "cjustify", "(", "pc", ")", "++", "stroke", "++", "setfont", "\"NORM\"", "++", "setgray", "10", "no", "=", "left", "`", "div", "`", "length", "keys", "places", "n", "|", "n", "==", "no", "=", "[", "]", "places", "n", "=", "(", "Pt", "(", "n", "*", "no", ")", "(", "-", "17", ")", ")", ":", "places", "(", "n", "+", "1", ")", "showActive", "t", "f", "=", "setfont", "\"LARGE\"", "++", "moveto", "(", "Pt", "10", "16", ")", "++", "cjustify", "(", "show", "f", ")", "++", "setfont", "\"SMALL\"", "++", "moveto", "(", "Pt", "10", "12", ")", "++", "cjustify", "\"PE(s)\"", "++", "stroke", "++", "setfont", "\"SMALL\"", "++", "moveto", "(", "Pt", "10", "8", ")", "++", "cjustify", "\"displayed\"", "++", "stroke", "++", "setfont", "\"NORM\"", "showUsed", "(", "m", ":", "pes", ")", "on", "=", "moveto", "(", "Pt", "2", "2", ")", "++", "setfont", "\"SMALL\"", "++", "text", "\"Configuration:\"", "++", "dopes", "(", "paperX", "-", "27", ")", "(", "(", "\"SMALLITALIC\"", ",", "showPE", "m", ")", ":", "map", "f", "pes", ")", "++", "stroke", "where", "f", "pe", "|", "elem", "pe", "on", "=", "(", "\"SMALLBOLD\"", ",", "showPE", "pe", ")", "|", "otherwise", "=", "(", "\"SMALL\"", ",", "showPE", "pe", ")", "dopes", "left", "pes", "=", "concat", "(", "map2", "format", "(", "places", "0", ")", "pes", ")", "where", "format", "pt", "@", "(", "Pt", "x", "y", ")", "(", "font", ",", "tex", ")", "=", "setfont", "font", "++", "moveto", "pt", "++", "text", "tex", "++", "stroke", "no", "=", "left", "`", "div", "`", "(", "(", "length", "pes", "*", "2", ")", "+", "1", ")", "f", "x", "=", "(", "no", "*", "(", "(", "x", "*", "2", ")", "+", "1", ")", ")", "+", "27", "places", "n", "|", "n", ">", "2", "*", "no", "=", "[", "]", "places", "n", "=", "(", "Pt", "(", "f", "n", ")", "2", ")", ":", "places", "(", "n", "+", "1", ")", "checkPEs", "pes", "[", "]", "=", "True", "checkPEs", "pes", "(", "p", ":", "ps", ")", "|", "elem", "p", "pes", "=", "checkPEs", "pes", "ps", "|", "otherwise", "=", "error", "(", "\"Attempt to gather information from inactive PE - \"", "++", "showPE", "p", ")", "showPE", "::", "PElement", "->", "String", "showPE", "(", "PE", "str", "no", ")", "=", "str", "++", "\".\"", "++", "show", "no", "inv", "x", "|", "x", ">=", "5", "=", "setgray", "0", "|", "otherwise", "=", "setgray", "10", "dimX", "=", "paperX", "-", "30", "dimY", "=", "paperY", "-", "40", "markXAxis", "::", "Int", "->", "Int", "->", "Postscript", "markXAxis", "dimX", "maxX", "=", "label", "10", "++", "markOnX", "100", "where", "label", "0", "=", "\"\"", "label", "x", "=", "newpath", "++", "moveto", "(", "Pt", "(", "notch", "x", ")", "0", ")", "++", "rlineto", "0", "(", "-", "2", ")", "++", "moveto", "(", "Pt", "(", "notch", "x", ")", "(", "-", "5", ")", ")", "++", "cjustify", "(", "printFloat", "(", "t", "x", ")", ")", "++", "stroke", "++", "label", "(", "x", "-", "1", ")", "t", "x", "=", "fromInt", "x", "*", "(", "fromInt", "maxX", "/", "fromInt", "10", ")", "notch", "x", "=", "x", "*", "(", "dimX", "`", "div", "`", "10", ")", "markOnX", "n", "=", "mapcat", "notches", "[", "1", "..", "n", "]", "++", "stroke", "where", "notches", "n", "=", "movetofloat", "(", "m", "*", "fromInt", "n", ")", "0", "++", "(", "rlineto", "0", "(", "-", "1", ")", ")", "++", "stroke", "m", "=", "fromInt", "dimX", "/", "fromInt", "n", "markYAxis", "::", "Int", "->", "Int", "->", "Postscript", "markYAxis", "dimY", "maxY", "=", "label", "10", "++", "markOnY", "(", "calibrate", "maxY", ")", "where", "label", "0", "=", "\"\"", "label", "x", "=", "newpath", "++", "moveto", "(", "Pt", "0", "(", "notch", "x", ")", ")", "++", "rlineto", "(", "-", "2", ")", "0", "++", "moveto", "(", "Pt", "(", "-", "3", ")", "(", "notch", "x", ")", ")", "++", "rjustify", "(", "printFloat", "(", "t", "x", ")", ")", "++", "stroke", "++", "label", "(", "x", "-", "1", ")", "t", "x", "=", "fromInt", "x", "*", "(", "fromInt", "maxY", "/", "fromInt", "10", ")", "notch", "x", "=", "x", "*", "(", "dimY", "`", "div", "`", "10", ")", "calibrate", "x", "|", "x", "<=", "1", "=", "1", "|", "x", "<=", "100", "=", "x", "|", "otherwise", "=", "calibrate", "(", "x", "`", "div", "`", "10", ")", "markOnY", "n", "=", "mapcat", "notches", "[", "1", "..", "n", "]", "++", "stroke", "where", "notches", "n", "=", "movetofloat", "0", "(", "m", "*", "fromInt", "n", ")", "++", "(", "rlineto", "(", "-", "1", ")", "0", ")", "m", "=", "fromInt", "dimY", "/", "fromInt", "n", "movetofloat", "x", "y", "=", "show", "x", "++", "\" \"", "++", "show", "y", "++", "\" moveto\\n\"", "determineScale", "::", "[", "Point", "]", "->", "(", "Int", ",", "Int", ")", "determineScale", "pts", "=", "(", "axisScale", "x", ",", "axisScale", "y", ")", "where", "(", "min", ",", "Pt", "x", "y", ")", "=", "minandmax", "pts", "axisScale", "::", "Int", "->", "Int", "axisScale", "x", "=", "axisScale'", "x", "1", "axisScale'", "x", "m", "|", "x", "<=", "m", "=", "m", "|", "x", "<=", "m", "*", "2", "=", "m", "*", "2", "|", "x", "<=", "m", "*", "5", "=", "m", "*", "5", "|", "x", "<=", "m", "*", "10", "=", "m", "*", "10", "|", "otherwise", "=", "axisScale'", "x", "(", "m", "*", "10", ")", "minandmax", "::", "[", "Point", "]", "->", "(", "Point", ",", "Point", ")", "minandmax", "[", "]", "=", "error", "\"No points\"", "minandmax", "(", "p", ":", "ps", ")", "=", "f", "(", "p", ",", "p", ")", "ps", "where", "f", "p", "[", "]", "=", "p", "f", "(", "Pt", "minx", "miny", ",", "Pt", "maxx", "maxy", ")", "(", "Pt", "x", "y", ":", "ps", ")", "=", "f", "(", "Pt", "minx'", "miny'", ",", "Pt", "maxx'", "maxy'", ")", "ps", "where", "minx'", "=", "min", "x", "minx", "miny'", "=", "min", "y", "miny", "maxx'", "=", "max", "x", "maxx", "maxy'", "=", "max", "y", "maxy", "printFloat", "::", "Float", "->", "String", "printFloat", "x", "=", "f", "(", "show", "(", "round", "(", "x", "*", "10", ")", ")", ")", "where", "f", "\"0\"", "=", "\"0\"", "f", "r", "|", "x", "<", "1", "=", "\"0.\"", "++", "r", "f", "(", "r", ":", "\"0\"", ")", "|", "x", "<", "10", "=", "[", "r", "]", "f", "(", "r", ":", "m", ")", "|", "x", "<", "10", "=", "r", ":", "'.'", ":", "m", "f", "_", "=", "show", "(", "round", "x", ")", ""]
diff --git a/ghc/tests/programs/life_space_leak/Main.hs b/ghc/tests/programs/life_space_leak/Main.hs
new file mode 100644 (file)
index 0000000..847ed63
--- /dev/null
@@ -0,0 +1,360 @@
+--------------------------------
+--     The Game of Life      --
+--------------------------------
+
+generations x = 30
+
+data L a = N | C1 a (L a) | C2 a a (L a)
+
+data Tuple2 a b = T2 a b
+
+data Tuple3 a b c = T3 a b c
+
+
+main = putStr (listChar_string
+                    (append1 (C1 '\FF' N)
+                             (life1 (generations ()) (start ()))))
+
+listChar_string :: L Char -> String
+listChar_string N = []
+listChar_string (C1 x xs) = x : listChar_string xs
+
+start :: a -> L (L Int)
+start x = (C1 N
+          (C1 N
+          (C1 N
+          (C1 N
+          (C1 N
+          (C1 N
+          (C1 N
+          (C1 N
+          (C1 N
+          (C1 N
+          (C1 N
+          (C1 N
+          (C1 N
+          (C1 N
+          (C1
+           (C1 0
+           (C1 0
+           (C1 0
+           (C1 1
+           (C1 1
+           (C1 1
+           (C1 1
+           (C1 1
+           (C1 0
+           (C1 1
+           (C1 1
+           (C1 1
+           (C1 1
+           (C1 1
+           (C1 0
+           (C1 1
+           (C1 1
+           (C1 1
+           (C1 1
+           (C1 1
+           (C1 0
+           (C1 1
+           (C1 1
+           (C1 1
+           (C1 1
+           (C1 1
+           (C1 0 N))))))))))))))))))))))))))) N)))))))))))))))
+
+-- Calculating the next generation
+
+gen1 :: Int -> L (L Int) -> L (L Int)
+gen1 n board = map1 row1 (shift1 (copy1 n 0) board)
+
+row1 :: Tuple3 (L Int) (L Int) (L Int) -> L Int
+row1 (T3 last this next)
+  = zipWith31 elt1 (shift2 0 last) 
+                   (shift2 0 this) 
+                   (shift2 0 next)
+
+
+elt1 :: Tuple3 Int Int Int 
+        -> (Tuple3 Int Int Int) 
+        -> (Tuple3 Int Int Int) -> Int
+elt1 (T3 a b c) (T3 d e f) (T3 g h i) 
+ = if (not (eq tot 2))
+          && (not (eq tot 3))
+      then 0
+      else if (eq tot 3) then 1 else e
+   where tot = a `plus` b `plus` c `plus` d 
+               `plus` f `plus` g `plus` h `plus` i
+
+eq :: Int -> Int -> Bool
+eq x y = x == y
+
+plus :: Int -> Int -> Int
+plus x y = x + y
+
+shiftr1 :: L Int -> L (L Int) -> L (L Int)
+shiftr1 x xs = append2 (C1 x N)  (init1 xs)
+
+shiftl1 :: L Int -> L (L Int) -> L (L Int)
+shiftl1 x xs = append2 (tail1 xs) (C1 x N)
+
+shift1 :: L Int -> L (L Int) 
+            -> L (Tuple3 (L Int) (L Int) (L Int))
+shift1 x xs = zip31 (shiftr1 x xs) xs (shiftl1 x xs)
+
+shiftr2 :: Int -> L Int -> L Int
+shiftr2 x xs = append3 (C1 x N) (init2 xs)
+
+shiftl2 :: Int -> L Int -> L Int
+shiftl2 x xs = append3 (tail2 xs) (C1 x N)
+
+shift2 :: Int -> L Int -> L (Tuple3 Int Int Int)
+shift2 x xs = zip32 (shiftr2 x xs) xs (shiftl2 x xs)
+
+-- copy
+
+copy1 :: Int -> Int -> L Int
+copy1 0 x = N
+copy1 n x = C1 x (copy1 (n-1) x)
+
+copy2 :: Int -> L Int -> L (L Int)
+copy2 0 x = N
+copy2 n x = C1 x (copy2 (n-1) x)
+
+copy3 :: Int -> Char -> L Char
+copy3 0 x = N
+copy3 n x = C1 x (copy3 (n-1) x)
+
+-- Displaying one generation
+
+disp1 :: (Tuple2 (L Char) (L (L Int))) -> L Char
+disp1 (T2 gen xss) 
+ = append1 gen 
+    (append1 (C1 '\n' (C1 '\n' N)) 
+             (foldr_1 (glue1 (C1 '\n' N)) N
+                       (map4 (compose2 concat1 (map2 star1)) xss)))
+
+star1 :: Int -> L Char
+star1 i = case i of
+           0 -> C1 ' ' (C1 ' ' N)
+           1 -> C1 ' ' (C1 'o' N)
+
+glue1 :: L Char -> L Char -> L Char -> L Char 
+glue1 s xs ys = append1 xs (append1 s ys)
+
+-- Generating and displaying a sequence of generations
+
+life1 :: Int -> L (L Int) -> L Char
+life1 n xss 
+  = foldr_1 (glue1 (copy3 (n+2) '\VT')) N
+            (map5 disp1
+              (zip1_ (map6 (string_ListChar.show) (ints 0))
+                    gens))
+    where
+    gens = take3 (740::Int) (iterate1 (gen1 n) (initial1 n xss))
+
+ints :: Int -> L Int
+ints x = C1 x (ints (x+1))
+
+string_ListChar :: String -> L Char
+string_ListChar [] = N
+string_ListChar (x:xs) = C1 x (string_ListChar xs)
+
+initial1 :: Int -> L (L Int) -> L (L Int)
+initial1 n xss = take1 n (append2 (map3 (compose1 (take2 n)
+                           (`append3` (copy1 n 0))) xss)
+                                (copy2 n (copy1 n 0)))
+
+iterate1 :: (L (L Int) -> L (L Int)) 
+               -> L (L Int) -> L (L (L Int))
+iterate1 f x = C1 x (iterate1 f (f x))
+
+-- versions of built in functions
+
+-- take
+take1 :: Int -> L (L Int) -> L (L Int)
+take1 0 _ = N
+take1 _ N = N
+--should be:take1 (n+1) (C1 x xs) = C1 x (take1 n xs)
+take1 n (C1 x xs) | n < 0     = error "Main.take1"
+                 | otherwise = C1 x (take1 (n-1) xs)
+
+take2 :: Int -> L Int -> L Int
+take2 0 _ = N
+take2 _ N = N
+--should be:take2 (n+1) (C1 x xs) = C1 x (take2 n xs)
+take2 n (C1 x xs) | n < 0     = error "Main.take2"
+                 | otherwise = C1 x (take2 (n-1) xs)
+
+take3 :: Int -> L (L (L Int))
+             -> L (L (L Int))
+take3 0 _ = N
+take3 _ N = N
+take3 n (C1 x xs) = C1 x (take3 (n-1) xs)
+
+-- init
+
+init1 :: L (L Int) -> L (L Int)
+init1 (C1 x N) = N
+init1 (C1 x xs) = C1 x (init1 xs)
+init1 N = error "init1 got a bad list"
+
+init2 :: L Int -> L Int
+init2 (C1 x N) = N
+init2 (C1 x xs) = C1 x (init2 xs)
+init2 N = error "init1 got a bad list"
+
+-- tail
+
+tail1 :: L (L Int) -> L (L Int)
+tail1 (C1 _ xs) = xs
+tail1 N = error "tail1 got a bad list"
+
+tail2 :: L Int -> L Int
+tail2 (C1 _ xs) = xs
+tail2 N = error "tail2 got a bad list"
+
+-- maps
+
+map1 :: (Tuple3 (L Int) (L Int) (L Int) -> L Int) -> 
+                L (Tuple3 (L Int) (L Int) (L Int))
+             -> L (L Int)
+map1 f N = N
+map1 f (C1 x xs) = C1 (f x) (map1 f xs)
+
+map2 :: (Int -> L Char) -> L Int -> L (L Char)
+map2 f N = N
+map2 f (C1 x xs) = C1 (f x) (map2 f xs)
+
+map3 :: (L Int -> L Int) -> L (L Int) -> L (L Int)
+map3 f N = N
+map3 f (C1 x xs) = C1 (f x) (map3 f xs)
+
+map4 :: (L Int -> L Char)
+         -> L (L Int) -> L (L Char)
+map4 f N = N
+map4 f (C1 x xs) = C1 (f x) (map4 f xs)
+
+map5 :: (Tuple2 (L Char) (L (L Int)) -> L Char) 
+          -> L (Tuple2 (L Char) (L (L Int)))
+          -> L (L Char)
+map5 f N = N
+map5 f (C1 x xs) = C1 (f x) (map5 f xs)
+
+map6 :: (Int -> L Char) -> L Int -> L (L Char)
+map6 f N = N
+map6 f (C1 x xs) = C1 (f x) (map6 f xs)
+
+-- compose
+
+compose2 :: (L (L Char) -> L Char) 
+            -> (L Int -> L (L Char)) 
+            -> L Int -> L Char
+compose2 f g xs = f (g xs)
+
+compose1 :: (L Int -> L Int) 
+             -> (L Int -> L Int) -> L Int -> L Int
+compose1 f g xs = f (g xs)
+
+-- concat
+
+concat1 :: L (L Char) -> L Char
+concat1 = foldr_1 append1 N
+
+-- foldr
+
+foldr_1 :: (L Char -> L Char -> L Char) 
+            -> L Char -> L (L Char) -> L Char
+foldr_1 f a N = a
+foldr_1 f a (C1 x xs) = f x (foldr_1 f a xs)
+
+-- appends
+
+append1 :: L Char -> L Char -> L Char
+append1 N ys = ys
+append1 (C1 x xs) ys = C1 x (append1 xs ys)
+
+append2 :: L (L Int) -> L (L Int) -> L (L Int)
+append2 N ys = ys
+append2 (C1 x xs) ys = C1 x (append2 xs ys)
+
+append3 :: L Int -> L Int -> L Int
+append3 N ys = ys
+append3 (C1 x xs) ys = C1 x (append3 xs ys)
+
+-- zips
+
+pzip f (C1 x1 xs) (C1 y1 ys)
+ = C1 (f x1 y1) (pzip f xs ys)
+pzip f _ _ = N
+
+
+zip1_ :: L (L Char)
+         -> L (L (L Int))
+         -> L (Tuple2 (L Char) (L (L Int)))
+zip1_ = pzip T2
+
+zip2_ :: L (L Int)
+         -> L (L Int)
+         -> L (Tuple2 (L Int) (L Int))
+zip2_ = pzip T2 
+
+zip3d :: L Int -> (Tuple2 (L Int) (L Int)) 
+            -> (Tuple3 (L Int) (L Int) (L Int))
+zip3d x (T2 y z) = T3 x y z
+
+zip3_ :: L (L Int) 
+         -> L (Tuple2 (L Int) (L Int))
+         -> L (Tuple3 (L Int) (L Int) (L Int))
+zip3_ = pzip zip3d
+
+zip4_ :: L Int
+         -> L Int 
+         -> L (Tuple2 Int Int)
+zip4_ = pzip T2
+
+zip5d :: Int -> (Tuple2 Int Int) -> (Tuple3 Int Int Int)
+zip5d x (T2 y z) = T3 x y z
+
+zip5_ :: L Int 
+         -> L (Tuple2 Int Int)
+         -> L (Tuple3 Int Int Int)
+zip5_ = pzip zip5d
+
+zip6_ :: L (Tuple3 Int Int Int)
+         -> L (Tuple3 Int Int Int)
+         -> L (Tuple2 (Tuple3 Int Int Int)
+                      (Tuple3 Int Int Int))
+zip6_ = pzip T2
+
+zip31 :: L (L Int) -> L (L Int) 
+         -> L (L Int)  
+         -> L (Tuple3 (L Int) (L Int) (L Int))
+zip31 as bs cs
+  = zip3_ as (zip2_ bs cs)
+
+zip32 :: L Int -> L Int -> L Int 
+          -> L (Tuple3 Int Int Int)
+zip32 as bs cs
+  = zip5_ as (zip4_ bs cs)
+
+-- zipWith
+
+zipWith21 :: ((Tuple3 Int Int Int) 
+              -> (Tuple2 (Tuple3 Int Int Int) 
+                         (Tuple3 Int Int Int)) -> Int)
+              -> L (Tuple3 Int Int Int) 
+              -> L (Tuple2 (Tuple3 Int Int Int) 
+                           (Tuple3 Int Int Int))
+              -> L Int
+zipWith21 = pzip 
+
+zipWith31 :: ((Tuple3 Int Int Int) 
+              -> (Tuple3 Int Int Int) 
+              -> (Tuple3 Int Int Int) -> Int)
+               -> L (Tuple3 Int Int Int)
+               -> L (Tuple3 Int Int Int)
+               -> L (Tuple3 Int Int Int) -> L Int
+zipWith31 z as bs cs
+ = zipWith21 z' as (zip6_ bs cs)
+   where z' a (T2 b c) = z a b c
diff --git a/ghc/tests/programs/life_space_leak/Makefile b/ghc/tests/programs/life_space_leak/Makefile
new file mode 100644 (file)
index 0000000..2c16a81
--- /dev/null
@@ -0,0 +1,9 @@
+TOP = ../..
+include $(TOP)/mk/boilerplate.mk
+
+SRC_RUNTEST_OPTS += -prescript ./life.test
+
+all :: runtest
+
+include $(TOP)/mk/target.mk
+
diff --git a/ghc/tests/programs/life_space_leak/life.test b/ghc/tests/programs/life_space_leak/life.test
new file mode 100644 (file)
index 0000000..7bc7e38
--- /dev/null
@@ -0,0 +1,17 @@
+#! /bin/sh
+#
+$1 | sum > /tmp/sum-real-$$
+
+cat > /tmp/sum-expected-$$ << EOTHING
+02845  1350
+EOTHING
+
+if cmp -s /tmp/sum-real-$$ /tmp/sum-expected-$$ ; then
+    /bin/rm /tmp/sum*$$
+    exit 0
+else
+    echo -n '*** sum I got: ' ;      cat /tmp/sum-real-$$ 
+    echo -n '*** sum I expected: ' ; cat /tmp/sum-expected-$$ 
+    /bin/rm /tmp/sum*$$
+    exit 1
+fi
diff --git a/ghc/tests/programs/life_space_leak/life_space_leak.stdout b/ghc/tests/programs/life_space_leak/life_space_leak.stdout
new file mode 100644 (file)
index 0000000..e69de29
diff --git a/ghc/tests/programs/north_array/Main.hs b/ghc/tests/programs/north_array/Main.hs
new file mode 100644 (file)
index 0000000..049d8bf
--- /dev/null
@@ -0,0 +1,10 @@
+import Array -- 1.3
+
+val1, val2 :: Array (Int,Int) Int
+val1 = array ((1,2), (2,1)) []
+val2 = array ((2,1), (1,2)) []
+val3 :: Array Integer Double
+val3 = array (4, -3) []
+
+main = print ((val1 == val1) && (val2 == val2) && (val3 == val3))
diff --git a/ghc/tests/programs/north_array/Makefile b/ghc/tests/programs/north_array/Makefile
new file mode 100644 (file)
index 0000000..de6e7e0
--- /dev/null
@@ -0,0 +1,7 @@
+TOP = ../..
+include $(TOP)/mk/boilerplate.mk
+
+all :: runtest
+
+include $(TOP)/mk/target.mk
+
diff --git a/ghc/tests/programs/north_array/north_array.stdout b/ghc/tests/programs/north_array/north_array.stdout
new file mode 100644 (file)
index 0000000..0ca9514
--- /dev/null
@@ -0,0 +1 @@
+True
diff --git a/ghc/tests/programs/north_lias/Bits.lhs b/ghc/tests/programs/north_lias/Bits.lhs
new file mode 100644 (file)
index 0000000..f0b2735
--- /dev/null
@@ -0,0 +1,20 @@
+% Bits.lhs - useful extras for testing LIAS
+
+> module Bits (
+>     Cont(..),
+>     showit, showits, new_line, pad
+>     ) where
+
+> type Cont  =  IO () --was: Dialogue
+
+> showit :: (Show a) => a -> Cont -> Cont
+> showit x c  =  putStr (show x) >> c
+
+> showits :: String -> Cont -> Cont
+> showits x c  =  putStr x >> c
+
+> new_line :: Cont -> Cont
+> new_line  =  showits "\n"
+
+> pad :: Int -> String -> String
+> pad n cs  =  take (n - length cs) (repeat ' ') ++ cs
diff --git a/ghc/tests/programs/north_lias/LIAS.lhs b/ghc/tests/programs/north_lias/LIAS.lhs
new file mode 100644 (file)
index 0000000..b65b34b
--- /dev/null
@@ -0,0 +1,367 @@
+% lias.lhs - Language Independent Arithmetic Standard in Haskell
+
+% @(#)LIAS.lhs 1.11 dated 92/12/07 at 15:01:23
+
+\documentstyle[a4wide,11pt,times]{article}
+
+\title{Haskell and the Language Independent Arithmetic Standard}
+\author{N D North\\
+       National Physical Laboratory\\
+       Teddington, TW11 0LW, UK.\\
+       {\tt ndn@seg.npl.co.uk}}
+
+% Some macros lifted from elsewhere to make this more standalone.
+\makeatletter
+% INLINE PROGRAM CODE
+%
+% \prog{foo} sets its argument in typewriter font.
+\def\prog#1{\ifmmode\mbox{\tt #1}\else{\tt #1}\fi}
+
+% NEWVERBATIM (from iso.sty)
+%
+% \newverbatim{foo} creates a new environment, foo, which behaves exactly
+% like the verbatim environment except that it is delimited by
+% \begin{foo} ... \end{foo}.
+% See the VERBATIM section of latex.tex for the inspiration behind this.
+%
+\def\newverbatim#1{\expandafter\def\csname #1\endcsname{%
+\@verbatim \frenchspacing\@vobeyspaces \csname @x#1verbatim\endcsname}
+\expandafter\let\csname end#1\endcsname=\endtrivlist
+\new@xverbatim{#1}}
+
+\begingroup \catcode `|=0 \catcode `[= 1
+\catcode`]=2 \catcode `\{=12 \catcode `\}=12
+\catcode`\\=12
+|gdef|new@xverbatim#1[
+|expandafter|def|csname @x#1verbatim|endcsname##1\end{#1}[##1|end[#1]]]
+|endgroup
+\makeatother
+
+\newverbatim{haskell}
+
+% \lias{id} sets an identifier in LIAS font (italic)
+\def\lias#1{\mbox{\it #1}}
+
+% \liass{id}{sub} sets the identifier in LIAS font, with the given
+%   subscript.
+\def\liass#1#2{\mbox{$\lias{#1}_{#2}$}}
+
+% \liasss{id}{sub}{sup} sets the identifier in LIAS font, with the
+%   subscript and superscript.
+\def\liasss#1#2#3{\mbox{$\lias{#1}_{#2}^{#3}$}}
+
+\begin{document}
+\maketitle
+
+\section*{Introduction}
+
+Haskell~\cite{hudak} is intended as an ``industrial strength'' 
+functional programming language and, in partial fulfillment of that
+aim, includes a rich set of numeric types and operators.
+However, the semantics of numeric operations are rather imprecise, so
+that determining the accuracy of numerical analysis programs is impossible
+in Haskell, limiting its applicability.
+The Language Independent Arithmetic Standard (LIAS)~\cite{lias}
+defines the behaviour of numerical operations precisely, yet flexibly
+enough that it is compatible with virtually all major arithmetic
+implementations including, for example IEEE~754~\cite{ieee754}.
+
+This report examines the extent to which Haskell and LIAS are compatible,
+provides a model implementation of LIAS in Haskell, and recommends a
+small addition to Haskell to improve compatibility.
+The intention is to improve the portability of programs, both between
+Haskell implementations and between Haskell and other LIAS-compliant
+languages.
+
+
+\section{Compatibility between Haskell and LIAS}
+
+\subsection{Denormalised numbers}
+\label{denorm}
+Parameters for LIAS are all available in Haskell, with the exception of
+\lias{denorm}, so few problems in principle.
+
+\subsection{Accuracy}
+Haskell implementations tend to use arithmetic of underlying system, so
+extent to which accuracy complies depends on that of underlying system.
+
+\subsection{Notification}
+\label{notification}
+Semantics of overflow etc are ``undefined'' so demanding notification is
+impossible.
+{\em Check what systems actually do.}
+
+\subsection{Integers}
+Haskell provides a class \prog{Integral}, whose members are integer
+types.
+In particular, \prog{Integer} is the type of arbitrary-precision
+integers, and \prog{Int} is a type of fixed-precision integers with
+range at least $[-2^{29} + 1, 2^{29} - 1]$ and closed under
+negation.
+Implementations are at liberty provide other integer types.
+
+Both \prog{Integer} and \prog{Int} should comply with LIAS, with the
+exception of notifications, as described in Section~\ref{notification}.
+
+\subsection{Floating point}
+Haskell provides a class \prog{RealFloat}, whose members are real (as
+opposed to complex) floating point numbers.
+In particular, \prog{Float} and \prog{Double} are supposed to
+be at least equal in range and precision to IEEE single and double
+precision respectively.
+Implementations are at liberty provide other floating point types.
+
+Both \prog{Float} and \prog{Double} should comply with LIAS, with the
+exceptions of notifications, as described in Section~\ref{notification},
+and \lias{denorm}, as described in Section~\ref{denorm}.
+
+
+\section{LIAS in Haskell}
+
+This section provides a model implementation of LIAS in Haskell.
+Many of the required parameters and functions already exist, in which
+case this section just describes how to obtain them in Haskell.
+Others are not part of the standard language, and code is given to
+implement these.
+
+The section begins with the module header giving the module name and
+exported identifiers.
+
+\begin{haskell}
+
+> module LIAS (
+>     emax, emin, denorm,
+>     fmax, fminN, fmin, epsilon,
+>     signf, succf, predf, ulpf, truncf, roundf, fractpart
+>     ) where
+
+\end{haskell}
+
+
+\subsection{Integers}
+The LIAS parameters are: \lias{minint}, \lias{maxint} and \lias{bounded}.
+Whether an integer type is bounded or not is part of the language
+definition, so this parameter is not available to the user in Haskell.
+The minimum and maximum parameters are available for the \prog{Int}
+type, and are accessed as follows:
+\begin{tabbing}
+\lias{minint} \= \prog{minInt} \kill
+\lias{minint} \> \prog{minInt} \\
+\lias{maxint} \> \prog{maxInt} (\prog{= -minInt})
+\end{tabbing}
+Note that the Haskell Report (Section 6.8.2) states that
+\prog{maxInt = -minInt}, which is compatible with LIAS.
+
+All the integer operations required by LIAS are available in Haskell,
+and are accessed as described in the table below:
+\begin{tabbing}
+mmmmmmmmmmmmmmm \= mmmmmmmmmm \= \kill
+\liass{add}{I}     \>  \prog{x + y} \\
+\liass{sub}{I}     \>  \prog{x - y} \\
+\liass{mul}{I}     \>  \prog{x * y} \\
+\liass{div}{I}     \>  \prog{x `div` y} (round to $-\infty$) \\
+                   \>  \prog{x `quot` y} (round to 0) \\
+\liass{rem}{I}     \>  \prog{x `mod` y} (round to $-\infty$) \\
+                   \>  \prog{x `rem` y} (round to 0) \\
+\liass{mod}{I}     \>  \prog{x `mod` y} (this is \liasss{mod}{I}{1}) \\
+\liass{neg}{I}     \>  \prog{negate x} \\
+\liass{abs}{I}     \>  \prog{abs x} \\
+\liass{eq}{I}      \>  \prog{x == y} \\
+\liass{neq}{I}     \>  \prog{x /= y} \\
+\liass{lss}{I}     \>  \prog{x < y} \\
+\liass{leq}{I}     \>  \prog{x <= y} \\
+\liass{gtr}{I}     \>  \prog{x > y} \\
+\liass{geq}{I}     \>  \prog{x >= y}
+\end{tabbing}
+The table shows that Haskell provides integer division with rounding
+towards $-\infty$ and with rounding towards 0.
+
+\subsection{Floating point}
+Haskell provides all the parameters for floating point numbers, except
+for \lias{denorm}.
+The available parameters are determined as follows:
+\begin{tabbing}
+\lias{emax}  \=  fst (floatRange x) \= \prog{Int} \kill
+\lias{r}     \>  floatRadix x       \> \prog{Integer} \\
+\lias{p}     \>  floatDigits x      \> \prog{Int} \\
+\lias{emax}  \>  fst (floatRange x) \> \prog{Int} \\
+\lias{emin}  \>  snd (floatRange x) \> \prog{Int}
+\end{tabbing}
+In the table, \prog{x} is an expression of the type for which the
+parameter is required.
+For example, \prog{floatRadix (1.0 :: Float)} would give the radix of
+the \prog{Float} type.
+The alternative to this mechanism is to provide a separate set of
+identifiers for each floating point type.
+
+For convenience, we provide Haskell identifiers for \lias{emax} and
+\lias{emin}.
+\begin{haskell}
+
+> emax, emin :: (RealFloat a) => a -> Int
+> emax x  =  snd (floatRange x)
+> emin x  =  fst (floatRange x)
+
+\end{haskell}
+
+The derived constants require some coding as follows:
+\begin{haskell}
+
+> fmax, fminN, fminD, fmin, epsilon :: (RealFloat a) => a -> a
+
+> fmax x  =  encodeFloat (floatRadix x ^ floatDigits x - 1)
+>                        (emax x - floatDigits x)
+
+> fminN x  =  encodeFloat 1 (emin x - 1)
+
+> fminD x  =  encodeFloat 1 (emin x - floatDigits x)
+
+> fmin x  =  if denorm x then fminD x else fminN x
+
+> epsilon x  =  encodeFloat 1 (1 - floatDigits x)
+
+\end{haskell}
+
+The definition of \lias{denorm} assumes that the implementation gives
+zero on underflow.
+The Haskell Report leaves behaviour on underflow undefined, which
+makes this definition less than satisfactory and suggests that
+\prog{denorm} should be part of the language.
+\begin{haskell}
+
+> denorm :: (RealFloat a) => a -> Bool
+> denorm x  =  fminN x / fromInteger (floatRadix x) /= 0
+
+\end{haskell}
+
+The floating point operations are listed below, with the syntax for
+invoking them.
+The operations marked ``$\dagger$'' are not part of Haskell and are
+defined later in the LIAS module.
+\begin{tabbing}
+mmmmmmmmmmmmmmm \= mmmmmmmmmm \= \kill
+\liass{add}{F}       \>  \prog{x + y} \\
+\liass{sub}{F}       \>  \prog{x - y} \\
+\liass{mul}{F}       \>  \prog{x * y} \\
+\liass{div}{F}       \>  \prog{x / y} \\
+\liass{neg}{F}       \>  \prog{negate x} \\
+\liass{abs}{F}       \>  \prog{abs x} \\
+\liass{sqrt}{F}      \>  \prog{sqrt x} \\
+\liass{sign}{F}      \>  \prog{signf x} \> $\dagger$ \\
+\liass{exponent}{F}  \>  \prog{exponent x} \\
+\liass{fraction}{F}  \>  \prog{significand x} \\
+\liass{scale}{F}     \>  \prog{scaleFloat n x} \\
+\liass{succ}{F}      \>  \prog{succf x} \> $\dagger$ \\
+\liass{pred}{F}      \>  \prog{predf x} \> $\dagger$ \\
+\liass{ulp}{F}       \>  \prog{ulpf x} \> $\dagger$ \\
+\liass{trunc}{F}     \>  \prog{truncf x n} \> $\dagger$ \\
+\liass{round}{F}     \>  \prog{roundf x n} \> $\dagger$ \\
+\liass{intpart}{F}   \>  \prog{truncate x} \\
+\liass{fractpart}{F} \>  \prog{snd (properFraction x)} \\
+\liass{eq}{F}        \>  \prog{x == y} \\
+\liass{neq}{F}       \>  \prog{x /= y} \\
+\liass{lss}{F}       \>  \prog{x < y} \\
+\liass{leq}{F}       \>  \prog{x <= y} \\
+\liass{gtr}{F}       \>  \prog{x > y} \\
+\liass{geq}{F}       \>  \prog{x >= y}
+\end{tabbing}
+
+The code below provides definitions of the operations marked ``$\dagger$''
+and, for convenience, a definition of \liass{fractpart}{F}.
+
+\begin{haskell}
+
+> signf :: (RealFloat a) => a -> a
+> signf x | x >= 0  =  1
+>         | x <  0  =  -1
+
+\end{haskell}
+
+\prog{floatRadixf} is a useful utility function which gives the floating
+point radix as a member of the class \prog{RealFloat}.
+\begin{haskell}
+
+> floatRadixf :: (RealFloat a) => a -> a
+> floatRadixf x  =  fromInteger (floatRadix x)
+
+\end{haskell}
+
+\begin{haskell}
+
+> succf, predf :: (RealFloat a) => a -> a
+> succf x | x == 0          =  fmin x
+>         | x == -(fmin x)  =  0
+>         | True            =  encodeFloat (m + 1) n
+>                              where
+>                              (m, n)  =  decodeFloat x
+
+> predf x  =  - succf (- x)
+
+\end{haskell}
+
+\begin{haskell}
+
+> ulpf :: (RealFloat a) => a -> a
+> ulpf x | x == 0  =  error "ulpf of 0"
+>        | True    =  res (encodeFloat 1 (expf x - floatDigits x))
+>                     where
+>                     res 0  =  error "ulpf underflow"
+>                     res x  =  x
+
+\end{haskell}
+
+\begin{haskell}
+
+> floorf :: (RealFloat a) => a -> a
+> floorf x  =  fromInteger (floor x)
+
+> expf :: (RealFloat a) => a -> Int
+> expf x  =  if abs x >= fminN x then exponent x else emin x
+
+> truncf :: (RealFloat a) => a -> Int -> a
+> truncf x n | n <= 0          =  error "truncf with n <= 0"
+>            | j >= eemin - p  =  encodeFloat (i `quot` (r ^ (p - n)))
+>                                             (j + p - n)
+>            | True            =  encodeFloat (i `quot` (r ^ (eemin - j - n)))
+>                                             (eemin -n)
+>                                 where
+>                                 (i, j)  =  decodeFloat x
+>                                 eemin   =  emin x
+>                                 r       =  floatRadix x
+>                                 p       =  floatDigits x
+
+\end{haskell}
+
+\begin{haskell}
+
+> roundf ::  (RealFloat a) => a -> Int -> a
+> roundf x n | n <= 0              =  error "roundf with n <= 0"
+>            | n >= floatDigits x  =  x
+>            | True                =  signf x * floorf (abs x / y + 0.5) * y
+>                                     where
+>                                     y  =  encodeFloat 1 (expf x - n)
+
+\end{haskell}
+
+\begin{haskell}
+
+> fractpart :: (RealFloat a) => a -> a
+> fractpart x  =  snd (properFraction x)
+
+\end{haskell}
+
+\section{Recommendations}
+
+
+\begin{thebibliography}{9}
+\bibitem{hudak} P Hudak, S Peyton Jones, P Wadler et al.
+{\it Report on the Functional Programming Language Haskell, Version 1.1.}
+Department of Computing Science, University of Glasgow, August 1991.
+\bibitem{ieee754} IEEE Standard for Binary Floating-Point Arithmetic.
+    ANSI/IEEE Std 754-1985, 1985.
+\bibitem{lias} M~Payne, C~Schaffert, and B~A~Wichmann.
+{\em The Language Compatible Arithmetic Standard}.
+ January 1990. ACM SIGPLAN Notices, Vol 25,
+  pp59-86, and ACM SIGNUM Newsletter, Vol 25, No 1, pp2-43.
+\end{thebibliography}
+\end{document}
diff --git a/ghc/tests/programs/north_lias/Main.lhs b/ghc/tests/programs/north_lias/Main.lhs
new file mode 100644 (file)
index 0000000..3f4a437
--- /dev/null
@@ -0,0 +1,316 @@
+This version includes checks to see if `extended precision' is
+used in expressions, but does not determine the characteristics.
+
+
+> module Main (main) where
+
+> import Bits
+> import LIAS
+
+> version = "@(#)TestLIAS.lhs  1.2 dated 92/07/31 at 08:53:52"
+> int_name = "Int"
+> flp_name = "Float"
+> int_val :: Int
+> int_val = 1
+> flp_val :: Float
+> flp_val = 1
+
+> maxInt, minInt :: Int
+> maxInt = maxBound
+> minInt = minBound
+
+> main  =  (initial_checks flp_parms . main_identities flp_parms .
+>           notification_checks flp_parms) (return ())
+>          where
+>          flp_parms  =  makeFloatParms flp_val
+
+Data type for representing parameters of a RealFloat.
+AN element has the form
+(MkFloatParms r p emin emax denorm fmax fmin fminN epsilon)
+
+> data (RealFloat a) =>
+>      FloatParms a = MkFloatParms Integer Int Int Int Bool a a a a
+
+> makeFloatParms :: (RealFloat a) => a -> FloatParms a
+> makeFloatParms x
+>     =  MkFloatParms (floatRadix x) (floatDigits x) (emin x) (emax x)
+>                     (denorm x) (fmax x) (fmin x) (fminN x) (epsilon x)
+
+> initial_checks :: (RealFloat a) => FloatParms a -> Cont -> Cont
+> initial_checks (MkFloatParms r p eemin eemax ddenorm ffmax ffmin ffminN eps)
+>     =   -- text is output here to form the basis of a report.
+>        new_line .
+>        showits "LIAS Model Implementation " . showits version . new_line .
+>        new_line .
+>        showits "Test results" .  new_line .
+>        showits "Computer: " .  new_line .
+>        showits "Compiler: " .   new_line .
+>        showits "Options used: " . new_line .
+>        showits "Program modifications (with reasons): " . new_line .
+>        showits "Date tested: " . new_line .
+>        showits "Tested by: " . new_line .
+>        new_line .
+>        showits "Integer type (int) name " . showits int_name . new_line .
+>        showits "Floating point type (flp) name " . showits flp_name .
+>        new_line . new_line .
+>        showits "Parameter values" . new_line .
+>        showits "        minint,         maxint" .
+>        new_line .
+>        showits (pad 15 (show minInt)) . showits (pad 15 (show maxInt)) .
+>        new_line .
+>        showits " r,  p,    emin,   emax, denorm" .
+>        new_line .
+>        showits (pad 3 (show r)) .
+>        showits (pad 4 (show p)) .
+>        showits (pad 8 (show eemin)) . showits (pad 8 (show eemax)) .
+>        (if ddenorm then
+>           showits "  true"
+>        else
+>           showits "  false") .
+>        new_line .
+>        showits "fmax    " . showit ffmax . new_line .
+>        showits "fmin    " . showit ffmin . new_line .
+>        showits "fminn   " . showit ffminN . new_line .
+>        showits "epsilon " . showit eps . new_line .
+>        (if (r `mod` 2 /= 0) || (r < 0) then
+>           showits "floatRadix value is not positive even integer" .
+>           new_line
+>        else id) .
+>        (if fromIntegral (p -1) * log (fromInteger r)
+>            < log 1.0e6 then
+>           --  the accuracy of the log function used here is not critical
+>           showits "precision less than six decimal floatDigits" .
+>           new_line
+>        else id) .
+>        (if (eemin -1) >= -2*(fromInteger r -1) then
+>           showits "Exponent minimum too large" .
+>           new_line
+>        else id) .
+>        (if eemax <= 2*(fromInteger r -1) then
+>           showits "Exponent maximum not large enough" .
+>           new_line
+>        else id) .
+>        (if (-2 > eemin -1+eemax) ||
+>           (eemin -1+eemax > 2) then
+>           showits "Exponent range not roughly symmetric" .
+>           new_line
+>        else id) .
+>        new_line
+
+> equal_int :: (Integral a) => (a, a, Int) -> Cont -> Cont
+> equal_int (i,j, test_number)
+>     | i /= j  =  showits "Integer operation check number " .
+>                  showit test_number . showits " fails with " .
+>                  showit i . showits " ". showit j . new_line
+>     | True    =  id
+
+> equal_flp :: (RealFloat a) => (a, a, Int) -> Cont -> Cont
+> equal_flp (x, y, test_number)
+>     | x /= y  =  showits "Floating point operation check number " .
+>                  showit test_number . showits " fails" . new_line .
+>                  showit x . showits " " . showit y . new_line
+>     | True    =  id
+
+> test_true :: (Bool, Int) -> Cont -> Cont
+> test_true (b, test_number)
+>     | not b  =  showits "Predicate number " . showit test_number .
+>                 showits " fails " .  showit b . new_line
+>     | True    =  id
+
+> -- This procedure checks that sqrt(y*y) = y when y*y is exact 
+> check_exact_squares :: (RealFloat a) => FloatParms a -> Cont -> Cont
+> check_exact_squares (MkFloatParms r p eemin eemax ddenorm
+>                                   ffmax ffmin ffminN eps)
+>     =  foldr (.) id (map foo list)
+>        where
+>        list  =  takeWhile in_range (iterate mul 10)
+>        mul y  =  fromInteger (truncate (1.2 * y)) :: Float
+>        in_range y  =  exponent y < p `div` 2
+>        foo y  =  if y /= sqrt (fromInteger (truncate (y * y)))
+>                  then showits "Square root not exact for a square" .
+>                       showit y . new_line
+>                  else id
+
+> flp :: (Integral a, RealFloat b) => a -> b
+> flp  =  fromIntegral
+
+> int_part :: (RealFloat a) => a -> a
+> int_part x  =  flp (truncate x)
+
+> main_identities :: (RealFloat a) => FloatParms a -> Cont -> Cont
+> main_identities flp_parms@(MkFloatParms r p eemin eemax ddenorm
+>                                         ffmax ffmin ffminN eps)
+>     =  equal_int(-(-maxInt), maxInt, 1) .
+>        equal_int(2+2, 2*2, 2) .
+>        equal_int(minInt `rem` (-1), 0, 3) .
+>        equal_flp(1.0+1.0, 2.0, 4) .
+>        equal_flp(ffmax-1.0, ffmax, 5) .
+>        equal_flp(ffmax/2.0+ffmax/2.0, ffmax, 6) .
+>        equal_flp(ffmax/ffmax, 1.0, 7) .
+>        equal_flp((ffmax/flp(r))*flp(r), ffmax, 8) .
+>        equal_flp(ffmin/ffmin, 1.0, 9) .
+>        equal_flp(-(-1.1), 1.1, 10) .
+>        equal_flp(abs(-ffmax), ffmax, 11) .
+>        equal_flp(abs(-ffminN), ffminN, 12) .
+>        equal_flp(signf(-ffmin), -1.0, 13) .
+>        equal_flp(signf(0.0), 1.0, 14) .
+>        equal_flp(signf(ffmin), 1.0, 15) .
+>        -- NDN Tests 16-25 changed as they were incorrect
+>        equal_int(exponent 1.0, 1, 16) .
+>        equal_int(exponent 1.6, 1, 17) .
+>        equal_int(exponent(flp(r)), 2, 18) .
+>        equal_int(exponent(ffmax), eemax, 19) .
+>        equal_int(exponent(ffminN), eemin, 20) .
+>        (if ddenorm then
+>           equal_int(exponent(ffmin), eemin-p+1, 21)
+>        else id) .
+>        equal_flp(significand(0.9), 0.9, 22) .
+>        equal_flp(significand(1.0), scaleFloat (-1) 1, 23) .
+>        -- NDN This fails on hbc. I'm not sure  if the test is correct.
+>        equal_flp(significand(ffmax), predf(1), 24) .
+>        -- equal_flp(significand(-ffmin), -1.0, 25) .
+>        equal_flp(scaleFloat 1 1.1, 1.1*flp(r), 26) .
+>        equal_flp(scaleFloat (-11) (scaleFloat 11 1.7), 1.7, 27) .
+>        equal_flp(succf(1.0), 1.0+eps, 28) .
+>        -- NDN Test 29 changed as it was incorrect
+>        equal_flp(succf(significand(ffmax)), 1.0, 29) .
+>        equal_flp(succf(-ffmin), 0.0, 30) .
+>        equal_flp(succf(0.0), ffmin, 31) .
+>        equal_flp(predf(succf(ffmin)), ffmin, 32) .
+>        test_true(predf(flp(r)) < flp(r), 33) .
+>        test_true(predf 1.1 < 1.1, 34) .
+>        equal_flp(predf(succf 1.2), 1.2, 35) .
+>        equal_flp(ulpf(1.0), eps, 36) .
+>        equal_flp(flp(r)*ulpf(predf 1.0), eps, 37) .
+>        equal_flp(succf(predf(ffmax)), ffmax, 38) .
+>        equal_flp(truncf (1.0 + 3.0*eps) p, 1.0 + 3.0*eps, 39) .
+>        equal_flp(truncf (1.0 + 3.0*eps) (p-1), 1.0 + 2.0*eps, 40) .
+>        equal_flp(truncf (1.0 + 3.0*eps) (p-2), 1.0, 41) .
+>        equal_flp(roundf (1.0 + 3.0*eps) p, 1.0 + 3.0*eps, 42) .
+>        equal_flp(roundf (1.0 + 3.0*eps) (p-1), 1.0 + 4.0*eps, 43) .
+>        equal_flp(roundf (1.0 + 3.0*eps) (p-2), 1.0 + 4.0*eps, 44) .
+>        equal_flp(int_part 1.0, 1.0, 45) .
+>        equal_flp(int_part(succf 1.0), 1.0, 46) .
+>        equal_flp(int_part(predf 2.0), 1.0, 47) .
+>        equal_flp(int_part(-ffmin), 0.0, 48) .
+>        equal_flp(int_part(ffmin), 0.0, 49) .
+>        equal_flp(fractpart(ffmax), 0.0, 50) .
+>        equal_flp(fractpart(ffmin), ffmin, 51) .
+>        equal_flp(fractpart(succf 1.0), eps, 52) .
+>        equal_flp(fractpart(flp(r)), 0.0, 53) .
+>        equal_flp(fractpart(-ffmin), -ffmin, 54) .
+>        test_true(ffmin > 0.0, 55) .
+>        test_true(-ffmax < -ffmin, 56) .
+>        check_exact_squares flp_parms .
+>        -- equal_int(int(predf 3.5), 3, 57) .
+>        -- equal_int(int(succf 3.5), 4, 58) .
+>        -- equal_int(int(predf -3.5), -4, 59) .
+>        -- equal_flp(flp(int(-5.0)), -5.0, 60) .
+>        -- equal_flp(flp(int(-5.6)), -6.0, 61) .
+>        -- equal_flp(scaleFloat (eemax+1) (ffminN),
+>        --        flp(r) ^^ integer(eemax+eemin), 62) .
+>        -- equal_flp(scaleFloat(ffmax, eemin-2),
+>        --        significand(ffmax) *
+>        --          flp(r) ^^ integer(eemax+eemin-3), 63) .
+>        -- check_conversions .
+>        id
+
+> notification_checks :: (RealFloat a) => FloatParms a -> Cont -> Cont
+> notification_checks (MkFloatParms r p eemin eemax ddenorm
+>                                   ffmax ffmin ffminN eps)
+>     =  showits "Test  condition tested notify  result(ce/ne/other/no)" .
+>        new_line .
+>        let my_maxint = maxInt in
+>            showits " 1   addi overflow pos  overf " .
+>            showit (my_maxint + 1) .
+>            new_line .
+>            showits " 2   addi overflow neg  overf " .
+>            (let tempi1 = -minInt ; tempi2 = -1 in
+>            showit (tempi1 + tempi2)) .
+>            new_line .
+>            showits " 3   subi overflow neg  overf " .
+>            showit (minInt - 1) .
+>            new_line .
+>            showits " 4   subi overflow pos  overf " .
+>            (let tempi1 = maxInt ; tempi2 = -1 in
+>            showit (tempi1 - tempi2)) .
+>            new_line .
+>            showits " 5   muli overflow pos  overf " .
+>            (let tempi1 = my_maxint `div` 2 + 1 ; tempi2 = 2 in
+>            showit (tempi1 * tempi2)) .
+>            new_line .
+>            showits " 6   muli overflow neg  overf " .
+>            (let tempi1 = -2 ; tempi2 = my_maxint `div` 2 + 2 in
+>            showit (tempi1 * tempi2)) .
+>            new_line .
+>            showits " 7   int divide by zero zerod " .
+>            (let tempi1 = 1 ; tempi2 = my_maxint - maxInt in
+>            showit (tempi1 `div` tempi2)) .
+>            new_line .
+>            showits " 8   int divide by zero zerod " .
+>            showit (1 `div` (my_maxint-maxInt)) .
+>            new_line .
+>            showits " 9   remi divide by 0   zerod " .
+>            showit (1 `rem` (my_maxint - maxInt)) .
+>            new_line .
+>            showits "10   modi divide by 0   zerod " .
+>            (let tempi1 = 1 ; tempi2 = my_maxint - maxInt in
+>            showit (tempi1 `mod` tempi2)) .
+>            new_line .
+>            showits "11  divide by zero      zerod " .
+>            showit (1 `div` (my_maxint-maxInt)) .
+>            new_line .
+>            showits "12  divide by zero      zerod " .
+>            showit (1 `div` (my_maxint-maxInt)) .
+>            new_line .
+>            -- showits "13   addf overflow      overf " .
+>            -- showit (ffmax + flp(r) ** integer(eemax-p+1)) .
+>            -- new_line .
+>            -- showits "14   subf overflow      overf " .
+>            -- showit (-ffmax - flp(r) ** integer(eemax-p+1)) .
+>            -- new_line .
+>            showits "15   mulf overflow      overf " .
+>            showit (ffmax * 1.001) .
+>            new_line .
+>            showits "16   divf overflow      overf " .
+>            showit (ffmax / 0.7) .
+>            new_line .
+>            showits "17   divf by zero       zerod " .
+>            (let tempf1 = flp(my_maxint-maxInt) in
+>            showit (1.0 / tempf1)) .
+>            new_line .
+>            showits "18   sqrt of tiny neg   undef " .
+>            showit (sqrt(-ffmin)) .
+>            new_line .
+>            showits "19   exponentf(zero)    undef " .
+>            (let tempf1 = flp(my_maxint-maxInt) in
+>            showit (exponent(tempf1))) .
+>            new_line .
+>            showits "20   succf of fmax      overf " .
+>            showit (succf(ffmax)) .
+>            new_line .
+>            showits "21   predf of -fmax     overf " .
+>            showit (predf(-ffmax)) .
+>            new_line .
+>            showits "22   ulpf(zero)         undef " .
+>            showit (ulpf(0.0)) .
+>            new_line .
+>            showits "23   roundf to 0 p undef " .
+>            showit (roundf 1.0 0) .
+>            new_line .
+>            showits "24   roundf  overflow   overf " .
+>            showit (roundf ffmax 2) .
+>            -- new_line .
+>            -- showits "25   trunc  overflow    overf " .
+>            -- (if flp(maxInt) < max_mantissa then
+>            --    showit (int(flp(maxInt)+1.0))
+>            -- else
+>            --    showit (int(succf(flp(maxInt))))) .
+>            -- new_line .
+>            -- showits "26   round overflow     overf " .
+>            -- (if flp(maxInt) < max_mantissa then
+>            --    showit (int(flp(minInt)-1.0))
+>            -- else
+>            --    showit (int(predf(flp(minInt)))))
+>            id
+
diff --git a/ghc/tests/programs/north_lias/Makefile b/ghc/tests/programs/north_lias/Makefile
new file mode 100644 (file)
index 0000000..de6e7e0
--- /dev/null
@@ -0,0 +1,7 @@
+TOP = ../..
+include $(TOP)/mk/boilerplate.mk
+
+all :: runtest
+
+include $(TOP)/mk/target.mk
+
diff --git a/ghc/tests/programs/north_lias/north_lias.stdout b/ghc/tests/programs/north_lias/north_lias.stdout
new file mode 100644 (file)
index 0000000..e69de29
diff --git a/ghc/tests/programs/record_upd/Main.hs b/ghc/tests/programs/record_upd/Main.hs
new file mode 100644 (file)
index 0000000..3b6b3ae
--- /dev/null
@@ -0,0 +1,25 @@
+{-     The purpose of this is to test that record update is
+       sufficiently polymorphic.  See comments with
+       tcExpr (RecordUpd) in TcExpr.lhs
+-}
+
+module Main where
+
+data T a b c d  = MkT1 { op1 :: a, op2 :: b }
+              | MkT2 { op1 :: a, op3 :: c }
+              | MkT3 { op4 :: a, op5 :: d }
+
+update1 :: a2 -> T a b c d -> T a2 b c d2
+update1 x t = t { op1 = x }
+       -- NB: the MkT3.op4 case doesn't constrain the result because
+       -- it doesn't have an op1 field
+
+update2 :: a2 -> T a b c d -> T a2 b2 c2 d
+update2 x t = t { op4 = x }
+
+main = print (op4 $ 
+             update2 True $ 
+             MkT3 { op4 = op2 $
+                          update1 (1::Int) $
+                          MkT1 { op1 = True }
+             })
diff --git a/ghc/tests/programs/record_upd/Makefile b/ghc/tests/programs/record_upd/Makefile
new file mode 100644 (file)
index 0000000..de6e7e0
--- /dev/null
@@ -0,0 +1,7 @@
+TOP = ../..
+include $(TOP)/mk/boilerplate.mk
+
+all :: runtest
+
+include $(TOP)/mk/target.mk
+
diff --git a/ghc/tests/programs/record_upd/record_upd.stdout b/ghc/tests/programs/record_upd/record_upd.stdout
new file mode 100644 (file)
index 0000000..0ca9514
--- /dev/null
@@ -0,0 +1 @@
+True
diff --git a/ghc/tests/programs/rittri/Main.hs b/ghc/tests/programs/rittri/Main.hs
new file mode 100644 (file)
index 0000000..e62c8a4
--- /dev/null
@@ -0,0 +1,39 @@
+infixr ->!,=\
+
+-- auxiliary functions -----------------------------------------------------
+
+g u v w (x:y:z) = i(v x y)(u x y (w z) z)(x:w(y:z))
+g u v w [x]    = [x,512]
+q u v w nil    = u : 95 : z v : w
+
+long = several.length
+((->!),(=\))=(map,($))
+a          = g q f
+y          = (-)32
+z          = (+)32
+several            = (>)2
+fairlySmall = (<)64
+notTooSmall = (>)91
+justRight   = (==)95
+notTooBig   = (<)96
+veryBig            = (>)123
+goodSize x  =foldr(&&)
+  otherwise =\($x)->![notTooBig,veryBig]
+f y z      =fairlySmall(z)&&goodSize(y)&&notTooSmall(z)
+i cond th el=if(cond)then(th)else(el)
+toBeIsToDoAndToDoIsToBeSaidConFuTse
+
+-- main functions ----------------------------------------------------------
+
+  g  = interact$map
+           toEnum.g.map
+           fromEnum
+main =
+ toBeIsToDoAndToDoIsToBeSaidConFuTse(let h=a;t=x where x x=i(long x)x(h t x)
+                                                      q v w x z = - y w:x
+                                                      a = g q f
+                                                      f x y = justRight x
+                                                            && goodSize y
+                                    in t)
+
+-- rittri@cs.chalmers.se ---------------------------------------------------
diff --git a/ghc/tests/programs/rittri/Makefile b/ghc/tests/programs/rittri/Makefile
new file mode 100644 (file)
index 0000000..de6e7e0
--- /dev/null
@@ -0,0 +1,7 @@
+TOP = ../..
+include $(TOP)/mk/boilerplate.mk
+
+all :: runtest
+
+include $(TOP)/mk/target.mk
+
diff --git a/ghc/tests/programs/rittri/rittri.stdin b/ghc/tests/programs/rittri/rittri.stdin
new file mode 100644 (file)
index 0000000..84e5ba1
--- /dev/null
@@ -0,0 +1,39 @@
+infixr ->!,=\
+
+-- auxiliary functions -----------------------------------------------------
+
+g u v w (x:y:z) = i(v x y)(u x y (w z) z)(x:w(y:z))
+g u v w [x]    = [x,512]
+q u v w nil    = u : 95 : z v : w
+
+long = several.length
+((->!),(=\))=(map,($))
+a          = g q f
+y          = (-)32
+z          = (+)32
+several            = (>)2
+fairlySmall = (<)64
+notTooSmall = (>)91
+justRight   = (==)95
+notTooBig   = (<)96
+veryBig            = (>)123
+goodSize x  =foldr(&&)
+  otherwise =\($x)->![notTooBig,veryBig]
+f y z      =fairlySmall(z)&&goodSize(y)&&notTooSmall(z)
+i cond th el=if(cond)then(th)else(el)
+toBeIsToDoAndToDoIsToBeSaidConFuTse
+
+-- main functions ----------------------------------------------------------
+
+  g  = interact$map
+           chr.g.map
+           ord
+main =
+ toBeIsToDoAndToDoIsToBeSaidConFuTse(let h=a;t=x where x x=i(long x)x(h t x)
+                                                      q v w x z =- y w:x
+                                                      a = g q f
+                                                      f x y = justRight x
+                                                            && goodSize y
+                                    in t)
+
+-- rittri@cs.chalmers.se ---------------------------------------------------
diff --git a/ghc/tests/programs/rittri/rittri.stdout b/ghc/tests/programs/rittri/rittri.stdout
new file mode 100644 (file)
index 0000000..c904cda
--- /dev/null
@@ -0,0 +1,39 @@
+infixr ->!,=\
+
+-- auxiliary functions -----------------------------------------------------
+
+g u v w (x:y:z) = i(v x y)(u x y (w z) z)(x:w(y:z))
+g u v w [x]    = [x,512]
+q u v w nil    = u : 95 : z v : w
+
+long = several.length
+((->!),(=\))=(map,($))
+a          = g q f
+y          = (-)32
+z          = (+)32
+several            = (>)2
+fairly_small = (<)64
+not_too_small = (>)91
+just_right   = (==)95
+not_too_big   = (<)96
+very_big           = (>)123
+good_size x  =foldr(&&)
+  otherwise =\($x)->![not_too_big,very_big]
+f y z      =fairly_small(z)&&good_size(y)&&not_too_small(z)
+i cond th el=if(cond)then(th)else(el)
+to_be_is_to_do_and_to_do_is_to_be_said_con_fu_tse
+
+-- main functions ----------------------------------------------------------
+
+  g  = interact$map
+           chr.g.map
+           ord
+main =
+ to_be_is_to_do_and_to_do_is_to_be_said_con_fu_tse(let h=a;t=x where x x=i(long x)x(h t x)
+                                                      q v w x z =- y w:x
+                                                      a = g q f
+                                                      f x y = just_right x
+                                                            && good_size y
+                                    in t)
+
+-- rittri@cs.chalmers.se ---------------------------------------------------
diff --git a/ghc/tests/programs/sanders_array/Main.hs b/ghc/tests/programs/sanders_array/Main.hs
new file mode 100644 (file)
index 0000000..a502652
--- /dev/null
@@ -0,0 +1,52 @@
+{-
+From: Paul Sanders <psanders@srd.bt.co.uk>
+To: partain
+Subject: A puzzle for you
+Date: Mon, 28 Oct 91 17:02:19 GMT
+
+I'm struggling with the following code fragment at the moment:
+-}
+
+import Array -- 1.3
+import Ix    -- 1.3
+
+conv_list :: (Ix a, Ix b) => [a] -> [b] -> [[c]] -> Array (a,b) c -> Array (a,b) c
+conv_list [] _ _ ar = ar
+conv_list _ _ [] ar = ar
+conv_list (r:rs) cls (rt:rts) ar
+      = conv_list rs cls rts ar'
+        where ar' = conv_elems r cls rt ar
+
+conv_elems :: (Ix a, Ix b) => a -> [b] -> [c] -> Array (a,b) c -> Array (a,b) c
+conv_elems row [] _ ar = ar
+conv_elems _ _ [] ar = ar
+conv_elems row (col:cls) (rt:rts) ar
+      = conv_elems row cls rts ar'
+        where ar' = ar // [((row,col), rt)]
+
+ar :: Array (Int, Int) Int
+ar = conv_list [(1::Int)..(3::Int)] [(1::Int)..(3::Int)] ar_list init_ar
+     where init_ar = array (((1::Int),(1::Int)),((3::Int),(3::Int))) []
+
+
+ar_list :: [[Int]] -- WDP
+ar_list = [[1,2,3],
+           [6,7,8],
+           [10,12,15]]
+
+main = putStr (show ar)
+
+{-
+What it tries to do is turn a list of lists into a 2-d array in an incremental
+fashion using 2 nested for-loops. It compiles okay on the prototype compiler
+but gives a segmentation fault when it executes. I know I can define in the
+array in one go (and I have done) but, for my piece of mind, I want to get this
+way working properly.
+
+Is it a bug in the prototype or is there a glaringly obvious error in my code
+which I've been stupid to spot ????
+
+Hoping its the latter,
+
+Paul.
+-}
diff --git a/ghc/tests/programs/sanders_array/Makefile b/ghc/tests/programs/sanders_array/Makefile
new file mode 100644 (file)
index 0000000..de6e7e0
--- /dev/null
@@ -0,0 +1,7 @@
+TOP = ../..
+include $(TOP)/mk/boilerplate.mk
+
+all :: runtest
+
+include $(TOP)/mk/target.mk
+
diff --git a/ghc/tests/programs/sanders_array/sanders_array.stdout b/ghc/tests/programs/sanders_array/sanders_array.stdout
new file mode 100644 (file)
index 0000000..dd3e055
--- /dev/null
@@ -0,0 +1 @@
+array ((1, 1), (3, 3)) [((1, 1), 1), ((1, 2), 2), ((1, 3), 3), ((2, 1), 6), ((2, 2), 7), ((2, 3), 8), ((3, 1), 10), ((3, 2), 12), ((3, 3), 15)]
\ No newline at end of file
diff --git a/ghc/tests/programs/seward-space-leak/Main.lhs b/ghc/tests/programs/seward-space-leak/Main.lhs
new file mode 100644 (file)
index 0000000..c481597
--- /dev/null
@@ -0,0 +1,650 @@
+{-
+
+This test runs for a Long Time (10mins for the registerised version)
+and allocates 3.4Gbytes.  It also hammers the GC; with -H16M it spend
+40% of the time in the GC.
+
+
+
+Date: Sun, 25 Oct 92 16:38:12 GMT
+From: Julian Seward (DRL PhD) <sewardj@uk.ac.man.cs>
+Message-Id: <9210251638.AA21153@r6b.cs.man.ac.uk>
+To: partain@uk.ac.glasgow.dcs
+Subject: Space consumption in 0.09 produced binary
+Cc: sewardj@uk.ac.man.cs, simonpj@uk.ac.glasgow.dcs
+
+Folks,
+
+At the risk of wasting even more of your valuable time, here is
+a small problem I ran into:
+
+The program (XXXX.lhs) listed below runs in constant space (about 4k)
+in both Gofer and hbc 0.998.5.  When compiled with 0.09, it runs out
+of heap in seconds (4 meg heap).
+
+The program builds a gigantic list of things (CDSs, in fact), I believe
+at least 100,000 long, and searches to find out if a particular CDS is
+present.  The CDS list is generated lazily, and should be thrown away
+as it goes, until apply_cds is found (see the bottom of the listing).
+Gofer and hbc behave as expected, but I suspect ghc is holding onto 
+the complete list unnecessarily.
+
+I include XXXX.stat as supporting evidence.
+
+Jules
+
+(compiled hence:
+ghc9 -v -O -gc-ap -flet-float -Rgc-stats -Rmax-heapsize 14M -o XXXX XXXX.lhs
+)
+
+-----------------------------------------------------------------------
+
+XXXX +RTS -S 
+
+Collector: APPEL  HeapSize: 4,194,304 (bytes)
+
+  Alloc   Live   Live   Astk   Bstk OldGen   GC    GC     TOT     TOT  Page Flts  Collec  Resid
+  bytes   bytes    %   bytes  bytes  roots  user  elap    user    elap   GC  TOT   tion   %heap
+2097108 1119672  53.4     52    132 1119616  0.33  0.35    1.01    1.15    0    0   Minor
+1537300  918200  59.7     48    128 918188  0.26  0.31    1.76    1.95    0    0   Minor
+1078216  654212  60.7     56    160 652612  0.19  0.18    2.29    2.46    0    0   Minor
+ 751108  442140  58.9     52    108 442140  0.12  0.12    2.64    2.84    0    0   Minor
+3134224 2935044  93.6     52    108         1.49  1.50    4.13    4.34    0    0  *MAJOR* 70.0%
+ 629612  376848  59.9     52    132 376836  0.11  0.11    4.44    4.64    0    0   Minor
+ 441184  265100  60.1     96    200 264416  0.08  0.07    4.66    4.86    0    0   Minor
+ 308640  204072  66.1     56    160 199476  0.06  0.05    4.81    5.01    0    0   Minor
+3781064 3687092  97.5     56    160         1.81  1.85    6.62    6.86    0    0  *MAJOR* 87.9%
+ 253600  160584  63.3     52    108 160584  0.05  0.04    6.75    6.98    0    0   Minor
+ 173312  112344  64.8     56    160 110304  0.03  0.03    6.83    7.07    0    0   Minor
+ 117128   77260  66.0     36    140  74112  0.01  0.02    6.88    7.13    0    0   Minor
+4037280 3985284  98.7     36    140         1.96  1.98    8.85    9.11    0    0  *MAJOR* 95.0%
+
+-------------------------------------------------------------------------
+-}
+
+> module Main where
+
+%============================================================
+%============================================================
+
+\section{A CDS interpreter}
+
+\subsection{Declarations}
+
+Second attempt at a CDS interpreter.  Should do
+loop detection correctly in the presence of higher order functions.
+
+The types allowed are very restrictive at the mo.
+
+> data Type = Two
+>           | Fn [Type]
+
+Now, we also have to define CDSs and selectors.
+\begin{itemize}
+\item
+@Empty@ is a non-legitimate CDS, denoting no value at all.  We use
+it as an argument in calls to other CDSs denoting that 
+the particular argument is not really supplied.
+\item
+@Par@ is similarly a non-legit CDS, but useful for constructing
+selectors.  It simply denotes the parameter specified (note
+parameter numbering starts at 1).
+\item
+@Zero@ and @One@ are constant valued CDSs.
+\item 
+@Call@.
+Calls to other functions are done with @Call@, which expects
+the callee to return @Zero@ or @One@, and selects the relevant
+branch.  The @Tag@s identify calls in the dependancy list.
+Although a @Call@ is a glorified @Case@ statement, the only allowed
+return values are @Zero@ and @One@.  Hence the @CDS CDS@ continuations
+rather than the more comprehensive @(AList Return CDS)@.
+We require arguments to be fully disassembled.
+\item @Case@
+Case selectors can only be of the following form:
+\begin{itemize}
+\item
+   @[Par n]@  if the n'th parameter is not a function space.
+\item
+   @[Par n, v1 ... vn]@ if the n'th parameter is a function space of
+                      arity n.  The v's may be only @Empty@, @Zero@,
+                      @One@, or @Par n@.
+\end{itemize}
+\end{itemize}
+We also have a @Magic@ CDS which is a load of mumbo-jumbo for use
+in enumeration of and compilation to CDSs.  Of no significance 
+whatever here.
+
+> data CDS = Empty
+>          | Par Int
+>          | Zero
+>          | One
+>          | Case [CDS] (AList Return CDS)
+>          | Call String Tag [CDS] CDS CDS
+>          | Magic
+>
+> type AList a b = [(a, b)]
+>
+> type Tag = Int
+
+> instance Eq CDS where
+>    (Par n1) == (Par n2) = n1 == n2
+>    Zero == Zero = True
+>    One == One = True
+>    (Case sels1 rets1) == (Case sels2 rets2) = sels1 == sels2 && 
+>                                               rets1 == rets2
+>    (Call f1 t1 sels1 a1 b1) == (Call f2 t2 sels2 a2 b2)
+>       = f1 == f2 && t1 == t2 && sels1 == sels2 && a1 == a2 && b1 == b2
+>    Magic == Magic = True
+>    _ == _ = False
+
+
+A @Return@ is a temporary thing used to decide which way to go at
+a @Case@ statement.
+
+> data Return = RZero
+>             | ROne
+>             | RP Int
+
+> instance Eq Return where
+>    RZero == RZero  = True
+>    ROne == ROne = True
+>    (RP p1) == (RP p2) = p1 == p2
+>    _ == _ = False
+
+We need a code store, which gives out a fresh instance of a CDS
+as necessary.  ToDo: Need to rename call sites?  I don't think so.
+
+> type Code = AList String CDS
+
+%============================================================
+%============================================================
+
+\subsection{The evaluator}
+Main CDS evaluator takes
+\begin{itemize}
+\item the code store
+\item the dependancy list, a list of @Tag@s of calls which are
+      currently in progress
+\item the current arguments
+\item the CDS fragment currently being worked on
+\end{itemize}
+
+> type Depends = [Tag]
+>
+> eval :: Code -> Depends -> [CDS] -> CDS -> CDS
+
+Evaluating a constant valued CDS is trivial.  There may be arguments
+present -- this is not a mistake.
+
+> eval co de args Zero = Zero
+> eval co de args One  = One
+
+Making a call is also pretty simple, because we assume
+that all non-functional arguments are presented as literals,
+and all functional values have already been dismantled (unless
+they are being passed unchanged in the same position in a recursive call
+to the same function, something for the compiler to detect).
+
+Two other issues are at work here.  Guided by the selectors,
+we copy the args to make a set of args for the call.  However, if an
+copied arg is Empty, the call cannot proceed, so we return the CDS as-is.
+Note that an Empty *selector* is not allowed in a Call (although it is
+in a Case).
+
+The second issue arises if the call can go ahead.  We need to check the
+tag on the call just about to be made with the tags of calls already in 
+progress (in de) to see if we are looping.  If the tag has already been
+encountered, the result of the call is Zero, so the Zero alternative is
+immediately selected.
+
+> eval co de args cds@(Call fname tag params alt0 alt1)
+>   = let (copied_an_empty, callee_args) = copy_args args params
+>         augmented_de      = tag : de
+>         callee_code       = lkup co fname
+>         callee_result     = eval co augmented_de callee_args callee_code
+>         been_here_before  = tag `elem` de
+>     in
+>         if    copied_an_empty
+>         then  cds
+>         else
+>         if    been_here_before
+>         then  eval co augmented_de args alt0
+>         else  case callee_result of
+>                  Zero -> eval co de args alt0
+>                  One  -> eval co de args alt1
+>                  _    -> error "Bad callee result"
+
+Case really means "evaluate".  
+
+   - make sure first selector is non-Empty.  If so, return CDS as-is.
+
+   - Copy other args.  If Empty is *copied*, return CDS as-is.
+     Otherwise, call evaluator and switch on head of result.
+
+Note about switching on the head of the result.  We expect to see
+*only* the following as results:
+
+   Zero
+   One
+   Case [Param m, rest]
+
+in which case switching is performed on
+
+   Zero
+   One
+   Case (Param m)
+
+ToDo: what happens if a Call turns up ???
+
+> eval co de args cds@(Case ((Par n):ps) alts)
+>   = let (copied_an_empty, new_args) = copy_args args ps
+>         functional_param = args !! (n-1)
+>     in  if    functional_param == Empty || 
+>               copied_an_empty
+>         then  cds
+>         else  eval co de args 
+>                    (lkup alts (get_head 
+>                                    (eval co de new_args functional_param)))
+
+Auxiliary for evaluating Case expressions.
+
+> get_head Zero                  = RZero
+> get_head One                   = ROne
+> get_head (Case ((Par n):_) _)  = RP n
+
+Copy args based on directions in a list of selectors.
+Also returns a boolean which is True if an Empty has been
+*copied*.  An Empty *selector* simply produces Empty in the
+corresponding output position.
+
+> copy_args :: [CDS] -> [CDS] -> (Bool, [CDS])
+>
+> copy_args args params
+>   = case cax False params [] of
+>        (empty_copied, res) -> (empty_copied, reverse res)
+>     where
+>        cax empty [] res = (empty, res)
+>        cax empty (Zero:ps) res = cax empty ps (Zero:res)
+>        cax empty (One:ps) res = cax empty ps (One:res)
+>        cax empty (Empty:ps) res = cax empty ps (Empty:res)
+>        cax empty ((Par n):ps) res
+>           = case args !! (n-1) of
+>                Empty -> cax True ps (Empty:res)
+>                other -> cax empty ps (other:res)
+
+> lkup env k = head ( [v | (kk,v) <- env, kk == k] ++ 
+>                       [error ( "Can't look up " ) ] )
+
+%============================================================
+%============================================================
+
+%============================================================
+%============================================================
+
+Something to make running tests easier ...
+
+> eval0 fname args = eval test [] args (lkup test fname)
+>
+> two = [Zero, One]
+
+Now for some test data ...
+
+> test
+>  =
+>  [
+>    ("add",     add_cds),
+>    ("apply",   apply_cds),
+>    ("k0",      k0_cds),
+>    ("id",      id_cds),
+>    ("k1",      k1_cds),
+>    ("kkkr",    kkkr_cds),
+>    ("kkkl",    kkkl_cds),
+>    ("apply2",  apply2_cds)
+>  ]
+>
+
+Constant Zero function.
+
+> k0_cds
+>   = Case [Par 1]
+>         [(RZero, Zero),
+>          (ROne,  Zero)]
+>
+
+Identity.
+
+> id_cds
+>   = Case [Par 1]
+>         [(RZero, Zero),
+>          (ROne,  One)]
+
+Constant One function.
+
+> k1_cds
+>   = Case [Par 1]
+>         [(RZero, One),
+>          (ROne,  One)]
+
+Strict in both of two arguments, for example (+).
+
+> add_cds
+>  =    Case [Par 1]
+>          [(RZero, Case [Par 2]
+>                        [(RZero, Zero),
+>                         (ROne,  Zero)
+>                        ]),
+>           (ROne, Case [Par 2]
+>                       [(RZero, Zero),
+>                        (ROne, One)
+>                       ])
+>          ]
+
+The (in)famous apply function.
+
+> apply_cds
+>  = Case [Par 1, Empty]
+>        [(RZero, Zero),
+>         (ROne, One),
+>         (RP 1, Case [Par 2]
+>                    [(RZero, Case [Par 1, Zero]
+>                                 [(RZero, Zero),
+>                                  (ROne, One)]),
+>                     (ROne,  Case [Par 1, One]
+>                                 [(RZero, Zero),
+>                                  (ROne, One)])
+>                    ])
+>        ]
+
+The inverse K-combinator: K x y = y
+
+> kkkr_cds
+>  = Case [Par 2]
+>        [(RZero, Zero),
+>         (ROne, One)
+>        ]
+
+The standard K-combinator, defined thus: K x y = K-inverse y x.
+Purpose of this is to test function calling.
+
+> kkkl_cds
+>  = Case [Par 1]
+>        [(RZero, Case [Par 2]
+>                     [(RZero, Call "kkkr" 101 [Zero, Zero] Zero One),
+>                      (ROne,  Call "kkkr" 102 [One, Zero]  Zero One)
+>                     ]),
+>         (ROne,  Case [Par 2]
+>                     [(RZero, Call "kkkr" 103 [Zero, One]  Zero One),
+>                      (ROne,  Call "kkkr" 104 [One, One]   Zero One)
+>                     ])
+>        ]
+
+Apply a 2-argument function (apply2 f x y = f x y).
+
+> apply2_cds
+>  = Case [Par 1, Empty, Empty]
+>        [(RZero, Zero),
+>         (ROne, One),
+>         (RP 1, Case [Par 2]
+>               [(RZero, Case [Par 1, Zero, Empty]
+>                            [(RZero, Zero),
+>                             (ROne, One),
+>                             (RP 2, Case [Par 3]
+>                                        [(RZero, Case [Par 1, Zero, Zero]
+>                                                [(RZero, Zero),
+>                                                 (ROne, One)]),
+>                                         (ROne, Case [Par 1, Zero, One]
+>                                                [(RZero, Zero),
+>                                                 (ROne, One)])
+>                                        ])
+>                            ]),
+>                (ROne,  Case [Par 1, One, Empty]
+>                            [(RZero, Zero),
+>                             (ROne, One),
+>                             (RP 2, Case [Par 3]
+>                                        [(RZero, Case [Par 1, One, Zero]
+>                                                [(RZero, Zero),
+>                                                 (ROne, One)]),
+>                                         (ROne, Case [Par 1, One, One]
+>                                                [(RZero, Zero),
+>                                                 (ROne, One)])
+>                                        ])
+>                            ])
+>               ]),
+>         (RP 2, Case [Par 3]
+>               [(RZero, Case [Par 1, Empty, Zero]
+>                            [(RZero, Zero),
+>                             (ROne, One),
+>                             (RP 1, Case [Par 2]
+>                                        [(RZero, Case [Par 1, Zero, Zero]
+>                                                [(RZero, Zero),
+>                                                 (ROne, One)]),
+>                                         (ROne, Case [Par 1, One, Zero]
+>                                                [(RZero, Zero),
+>                                                 (ROne, One)])
+>                                        ])
+>                            ]),
+>                (ROne,  Case [Par 1, Empty, One]
+>                            [(RZero, Zero),
+>                             (ROne, One),
+>                             (RP 1, Case [Par 2]
+>                                        [(RZero, Case [Par 1, Zero, One]
+>                                                [(RZero, Zero),
+>                                                 (ROne, One)]),
+>                                         (ROne, Case [Par 1, One, One]
+>                                                [(RZero, Zero),
+>                                                 (ROne, One)])
+>                                        ])
+>                            ])
+>               ])
+>           ]
+
+Simple, isn't it!
+
+%============================================================
+%============================================================
+
+%============================================================
+%============================================================
+
+Enumeration of all CDSs of a given type.
+
+Define n-ary branched trees.  These are used to hold the 
+possible prefixes of function arguments, something essential
+when enumerating higher-order CDSs. ToDo: translate to English
+
+> data NTree a = NLeaf
+>              | NBranch a [NTree a]
+
+The enumeration enterprise involves some mutual recursion
+when it comes to higher-order functions.  We define the
+top-level enumerator function, for trivial cases, hence:
+
+> enumerate :: Type -> [CDS]
+>
+> enumerate Two = [Zero, One]
+> enumerate (Fn ats) = 
+>    expand_templates (traverse (length ats) (gen_pfx_trees ats))
+
+Enumerating a function space is tricky.  In summary:
+
+   - Generate the prefix trees for each argument.  
+     For non-function arguments this trivial, but for
+     function-valued arguments this means a call to the
+     enumerator to get all the possible values of the
+     (argument) function space.
+
+   - Traverse the prefix trees, generating a series of
+     "templates" for functions.
+
+   - Expand each template thus generated into a genuine CDS.
+     Each template denotes a group of CDSs, all of
+     the same "shape" and differing only in the constants
+     they return.  The Magic and RMagic constructors are
+     used for these purposes.
+
+Generating prefix trees.  For a Two-argument, is easy:
+
+> gen_pfx_trees :: [Type] -> [NTree [CDS]]
+> 
+> gen_pfx_trees ts = zipWith gen_pfx_tree ts [1 .. length ts]
+>
+> gen_pfx_tree :: Type -> Int -> NTree [CDS]
+>
+> gen_pfx_tree Two n = NBranch [Par n] []
+
+Note all prefixes are missing the initial (Par n) selector ...
+
+For a function arg
+
+   - enumerate each of the *function's* args
+
+   - starting with a selector [Empty, ...., Empty],
+     make a tree wherein at each level, branching is 
+     achieved by filling in every Empty with every value
+     of that argument type.  ToDo: fix this
+
+> gen_pfx_tree (Fn arg_types) n
+>   = let number_args = length arg_types
+>         enumed_args = map enumerate arg_types
+>         initial_sel = take number_args (repeat Empty)
+>         init_tree   = NBranch ((Par n):initial_sel) []
+>     in
+>         expand_pfx_tree number_args number_args n enumed_args init_tree
+
+@expand_pfx_tree@ expands a tree until there are no Emptys
+at the leaves.  Its first parameter is the number of Emptys
+in the tree it has been given; when zero, expansion is complete.
+The second parameter is the number of Emptys in the original
+tree (equal to the arity of the function being enumerated).
+Third number is the argument number in the top-level function,
+needed to make the initial "Par n" selector.
+Also needs to carry around the enumeration of the function's
+arguments.
+
+> expand_pfx_tree :: Int -> Int -> Int -> [[CDS]] -> NTree [CDS] -> NTree [CDS]
+>
+> expand_pfx_tree 0 w i enums tree = tree
+>
+> expand_pfx_tree n w i enums (NBranch sels [])
+>   = let indices = [0 .. w - 1]
+>         n_minus_1 = n - 1
+>         new_sels = concat (map expand_sel indices)
+>         expand_sel n
+>           = case sels !! (n+1) of
+>                Empty -> map (upd (n+1) sels) (enums !! n)
+>                other -> []
+>         mk_trivial_tree sel = NBranch sel []
+>     in
+>         NBranch sels (map (expand_pfx_tree n_minus_1 w i enums . mk_trivial_tree) 
+>                        new_sels)
+
+> upd :: Int -> [a] -> a -> [a]
+> upd 0 (y:ys) x = x:ys
+> upd n (y:ys) x = y:upd (n-1) ys x
+
+In the second phase, the prefix trees are traversed to generate
+CDS templates (full of Magic, but no Zero or One).
+The first arg is the number of arguments, and the
+second the prefix trees for each argument.
+
+> traverse :: Int -> [NTree [CDS]] -> [CDS]
+
+Each pfxtree denotes a selector, one for each argument, plus a load
+of more specific selectors.  So for each argument, one manufactures
+all possible sub-cds using the sub-selectors as the set Z.
+You then take this arg's selector, and manufacture a load of CDSs
+like this:
+\begin{verbatim}
+   Case this_selector
+      0 -> z | z <- Z
+      1 -> z | z <- Z
+      Par n -> z | z <- Z for each n in [1 .. length this_selector]
+                          satisfying this_selector !! n == Empty
+\end{verbatim}
+
+
+> traverse n pfxtrees
+>   = Magic : concat (map doOne [0 .. n - 1])
+>     where
+>        doOne i = traverse_arg n i pfxtrees (pfxtrees !! i) 
+
+@traverse_arg@ makes the CDSs corresponding to descending a
+particular argument, the number of which is given as its second
+parameter.  It also gets the complete set of pfxtrees and the one
+to descend.  Note that having descended in the given argument, we
+check its sub-selectors.  If none, (an empty list), this replaced
+by [NLeaf] to make everything work out.  A NLeaf selector
+is a dummy which generates no CDSs.
+
+> traverse_arg n i pfxtrees NLeaf
+>   = []
+
+> traverse_arg n i pfxtrees (NBranch this_selector subsidiary_selectors_init)
+>   = let subsidiary_selectors 
+>            = case subsidiary_selectors_init of 
+>                 [] -> [NLeaf]; (_:_) -> subsidiary_selectors_init
+>         subsidiary_pfxtrees = map (upd i pfxtrees) subsidiary_selectors
+>         par_requests = preq 1 [] this_selector
+>         preq n acc [] = acc
+>         preq n acc (Empty:rest) = preq (n+1) ((RP n):acc) rest
+>         preq n acc (other:rest) = preq (n+1)         acc  rest
+>         subsidiary_cdss = concat (map (traverse n) subsidiary_pfxtrees)
+>         all_poss_rhss = splat (2 + length par_requests) subsidiary_cdss
+>         all_poss_returns = [RZero,  ROne] ++ par_requests
+>     in
+>         [Case this_selector (zip all_poss_returns rhs)
+>         | rhs <- all_poss_rhss]
+>
+> splat :: Int -> [a] -> [[a]]
+> splat 0 set = [[]]
+> splat n set = [x:xs | x <- set, xs <- splat (n-1) set]
+
+The final stage in the game is to fill in all the @Magic@s
+with constants.  A template with $n$ @Magic@s presently generates
+@2^n@ CDSs, obtained by all possible combinations of
+filling each @Magic@ in with @Zero@ or @One@.  To do this we
+first need to count the @Magic@s.
+
+> count_magic :: CDS -> Int
+> 
+> count_magic Magic             = 1
+> count_magic (Case sels alts)  = sum (map (count_magic.snd) alts)
+
+We don't expect to see anything else at this stage.
+Now make $2^n$ lists, each of length $n$, each with a different
+sequence of @Zero@s and @One@s.  Use these to label the 
+@Magic@s in the template.
+
+> label_cds :: CDS -> [CDS] -> ([CDS], CDS)
+>
+> label_cds Magic (l:ls) = (ls, l)
+> label_cds (Case sels alts) ls
+>   = case f ls alts of (l9, alts_done) -> (l9, Case sels alts_done)
+>     where
+>        f l0 []     = (l0, [])
+>        f l0 (a:as) = let (l1, a_done)  = lalt l0 a
+>                          (l2, as_done) = f l1 as
+>                      in  (l2, a_done:as_done)
+>        lalt l0 (ret, cds) = case label_cds cds l0 of 
+>                               (l1, cds_done) -> (l1, (ret, cds_done))
+
+Finally:
+
+> expand_templates :: [CDS] -> [CDS]
+>
+> expand_templates ts
+>    = concat (map f ts)
+>      where
+>         f tem = map (snd . label_cds tem) 
+>                     (splat (count_magic tem) [Zero, One])
+
+--> testq tt = (layn . map show' . nub) (enumerate tt)
+
+> main = putStr (show (apply_cds `myElem` (enumerate (Fn [Fn [Two], Two]))))
+>
+> i `myElem` [] = False
+> i `myElem` (x:xs) = if i == x then True else i `myElem` xs 
+
+%============================================================
+%============================================================
diff --git a/ghc/tests/programs/seward-space-leak/Makefile b/ghc/tests/programs/seward-space-leak/Makefile
new file mode 100644 (file)
index 0000000..de6e7e0
--- /dev/null
@@ -0,0 +1,7 @@
+TOP = ../..
+include $(TOP)/mk/boilerplate.mk
+
+all :: runtest
+
+include $(TOP)/mk/target.mk
+
diff --git a/ghc/tests/programs/seward-space-leak/README b/ghc/tests/programs/seward-space-leak/README
new file mode 100644 (file)
index 0000000..b43c8a7
--- /dev/null
@@ -0,0 +1,13 @@
+I thought this crashed if compiled without -O, but I
+can't make it do so.
+
+       glhc -darity-checks -C Main.hs
+
+then
+
+       glhc -g -v -optc-O Main.hc -o cg023-reg
+
+It eats 3Gbytes and runs for 10mins but doesn't crash.
+
+
+SLPJ 17 june 93
diff --git a/ghc/tests/programs/seward-space-leak/cg023.stdout b/ghc/tests/programs/seward-space-leak/cg023.stdout
new file mode 100644 (file)
index 0000000..c1f22fb
--- /dev/null
@@ -0,0 +1 @@
+False
\ No newline at end of file
diff --git a/ghc/tests/programs/seward-space-leak/seward-space-leak.stdout b/ghc/tests/programs/seward-space-leak/seward-space-leak.stdout
new file mode 100644 (file)
index 0000000..bc59c12
--- /dev/null
@@ -0,0 +1 @@
+False
diff --git a/ghc/tests/programs/strict_anns/Main.hs b/ghc/tests/programs/strict_anns/Main.hs
new file mode 100644 (file)
index 0000000..b2ee82d
--- /dev/null
@@ -0,0 +1,13 @@
+-- This test checks that constructors with strictness annotations
+-- at least parse correctly.  In GHC 2.02 they didn't!
+
+module Main where
+data Foo1 = Crunch1 ! Int ! Int Int deriving( Show )
+
+data Foo2 = Crunch2 ! Int Int Int   deriving( Show )
+
+main = do
+       print (Crunch1 (1+1) (2+2) (3+3))
+       print (Crunch2 (1+1) (2+2) (3+3))
+  
diff --git a/ghc/tests/programs/strict_anns/Makefile b/ghc/tests/programs/strict_anns/Makefile
new file mode 100644 (file)
index 0000000..de6e7e0
--- /dev/null
@@ -0,0 +1,7 @@
+TOP = ../..
+include $(TOP)/mk/boilerplate.mk
+
+all :: runtest
+
+include $(TOP)/mk/target.mk
+
diff --git a/ghc/tests/programs/strict_anns/strict_anns.stdout b/ghc/tests/programs/strict_anns/strict_anns.stdout
new file mode 100644 (file)
index 0000000..0f6e62e
--- /dev/null
@@ -0,0 +1,2 @@
+Crunch1 2 4 6
+Crunch2 2 4 6
diff --git a/ghc/tests/programs/waugh_neural/BpGen.lhs b/ghc/tests/programs/waugh_neural/BpGen.lhs
new file mode 100644 (file)
index 0000000..6901c5c
--- /dev/null
@@ -0,0 +1,193 @@
+BpGen.hs
+Written by Sam Waugh
+Date started : 9th November 1992 
+
+This module implements backprop using pattern presentation style, 
+allowing for a general number of layers.  No sigmoid on last layer.
++ 0.1 to sigmoid derivative.  It does not implement momentum.
+
+Need to use modules for matrix and vector operations.
+
+> module BpGen {-partain:(Dimensions(..),
+>              Layer(..),  Layers(..),
+>              Eg(..),     Egs(..),
+>              Weight(..), Weights(..),
+>              maxplace, classeg, calcerror, selectegs,
+>              trainweights, randweights)-} where
+
+> import {-fool mkdependHS-}
+>       Random
+> import List(transpose)
+> infixl 7 $$
+
+-------------------------------------------------------------------------------
+|                              Data Types                                    |
+-------------------------------------------------------------------------------
+
+> type Dimensions = [Int]        -- for network topology
+> type Layer     = [Double]      -- vector for layers (incl. input and output)
+> type Layers    = [Layer]
+> type Weight    = [[Double]]    -- connections between layers
+> type Weights   = [Weight]
+> type Eg        = (Layer,Layer) -- attributes and classes
+> type Egs       = [Eg]
+
+
+-------------------------------------------------------------------------------
+|                              Utility functions                             |
+-------------------------------------------------------------------------------
+
+Maxplace finds the position of the maximum element in a list.
+sublist subtracts two vectors, $$ performs across vector multiplication
+weivecmult multiplies a matrix and a vector
+classeg takes the weights of a network and an input vector, and produces
+a list of the Layers of the network after classification
+calcerror calculates the root mean squared error of the data set
+Also implemented sqr and sig (Sigmoid function).
+
+> maxplace :: (Ord a) => [a] -> Int
+> maxplace xs = length (takeWhile (/=(maximum xs)) xs)
+
+> sqr :: (Num a) => a -> a
+> sqr x = x * x
+
+> sig :: (Floating a) => a -> a
+> sig x = 1.0 / (1.0 + exp (negate x))
+
+> sublist, ($$) :: (Num a) => [a] -> [a] -> [a]
+> sublist = zipWith (-)
+> ($$)    = zipWith (*)
+
+> weivecmult :: Weight -> Layer -> Layer
+> weivecmult w v = [sum (wi $$ v) | wi <- w]
+
+
+> classeg :: Weights -> Layer -> Layers
+> classeg [] y = [y]
+> classeg (w:ws) l
+>  = let l' = if null ws then weivecmult w templ
+>                       else map sig (weivecmult w templ)
+>       templ = if null ws then l
+>                          else 1.0 : l
+>    in templ : (classeg ws l')
+
+
+
+> calcerror :: Weights -> Egs -> Double
+> calcerror ws egs = sqrt (calcerror1 ws egs)
+
+> calcerror1 :: Weights -> Egs -> Double
+> calcerror1 _ []  = 0.0
+> calcerror1 ws ((x,t):egs)
+>    = (sum.(map sqr).(sublist t).last) (classeg ws x)
+>    + calcerror1 ws egs
+
+
+-------------------------------------------------------------------------------
+|                      Network Training Functions                            |
+-------------------------------------------------------------------------------
+
+selectegs produces a list of random numbers corresponding to the examples
+to be selected during training.  (It takes the range of the examples)
+
+> selectegs :: Int -> [Int]
+> selectegs n = map (`rem` n) (randomInts n n)
+
+
+trainweights calls trainepoch to iteratively train the network.  It
+also checks the error at the end of each call to see if it has fallen to
+a reasonable level.
+
+> trainweights :: Egs -> Weights -> Int -> Double -> Double
+>              -> [Int] -> (Weights, [Double])
+> trainweights _   ws 0       _   _   _  = (ws, [])
+> --should be:trainweights egs ws (eps+1) err eta rs
+> trainweights egs ws eps err eta rs
+>    | eps < 0 = error "BpGen.trainweights"
+>    | otherwise
+>    = let (ws',rs')   = trainepoch egs ws (length egs) eta rs
+>         newerr       = calcerror ws' egs
+>         (ws'', errs) = trainweights egs ws' (eps-1) err eta rs'
+>      in if newerr < err then (ws',  [newerr])
+>                        else (ws'', newerr:errs)
+
+
+trainepoch iteratively calls classeg and backprop to train the network,
+as well as selecting an example.
+
+> trainepoch :: Egs -> Weights -> Int -> Double -> [Int] -> (Weights, [Int])
+> trainepoch _   ws 0        _   rs     = (ws,rs)
+> --should be: trainepoch egs ws (egno+1) eta (r:rs)
+> trainepoch egs ws egno eta (r:rs)
+>    | egno < 0 = error "BpGen.trainepoch"
+>    | otherwise
+>    = let (x,t) = egs !! r
+>         ws'   = backprop eta (classeg ws x) ws t
+>      in trainepoch egs ws' (egno-1) eta rs
+
+
+backprop causes weight changes after calculating the change
+
+> backprop :: Double -> Layers -> Weights -> Layer -> Weights
+> backprop eta (o:os) (w:ws) t
+>  = changeweights eta (o:os) (calcchange os ws t) (w:ws)
+
+
+calcchange calculates the changes to the weights
+
+> calcchange :: Layers -> Weights -> Layer -> Layers
+> calcchange [o]    []     t = [sublist t o]
+> calcchange (o:os) (w:ws) t
+>    = (sigop o (weivecmult (transpose w) (head ds))) : ds
+>        where ds = calcchange os ws t
+
+
+sigop performs the calculations involving the derivative of the sigmoid.
+This uses a constant to eliminate flat spots [Fahlman, 1988]
+
+> sigop :: Layer -> Layer -> Layer
+> sigop out change
+>    = let sig' x = x * (1.0 - x) + 0.1
+>      in (map sig' out) $$ change
+
+
+changeweights makes the actual changes to weights
+
+> changeweights :: Double -> Layers -> Layers -> Weights -> Weights
+> changeweights eta os ds ws
+>    = [[[wji + eta * dj * oi | (oi,wji) <- zip o wj]
+>                            | (dj,wj)  <- zip d w]
+>                            | (w,d,o)  <- zip3 ws ds os]
+
+
+-------------------------------------------------------------------------------
+|                              Weight Manipulation                           |
+-------------------------------------------------------------------------------
+
+randweights generates random weights in the range -1.0 to +1.0
+
+> randweights :: Dimensions -> Weights
+> randweights dimensions
+>    = genweights dimensions (map (\x -> 2.0 * x - 1.0) (randomDoubles 1 1))
+
+
+Generates weights, taking the values from the list of Doubles.
+The weight sizes are taken from the list of dimensions.
+
+> genweights :: Dimensions -> [Double] -> Weights
+> genweights [x] _ = []
+> genweights (x:y:dimensions) rs
+>    = let (w, rs') = if null dimensions then multSplitAt x    y rs
+>                                       else multSplitAt (x+1) y rs
+>      in w : (genweights (y:dimensions) rs')
+
+
+> multSplitAt :: Int -> Int -> [a] -> ([[a]],[a])
+> multSplitAt inner 0 xs = ([], xs)
+> --should be:multSplitAt inner (outer + 1) xs
+> multSplitAt inner outer xs
+>   | outer < 0 = error "BpGen.multSplitAt"
+>   | otherwise
+>     = let (l,  xs')  = splitAt inner xs
+>          (ls, xs'') = multSplitAt inner (outer-1) xs'
+>       in (l:ls, xs'')
diff --git a/ghc/tests/programs/waugh_neural/MAIL b/ghc/tests/programs/waugh_neural/MAIL
new file mode 100644 (file)
index 0000000..9f0fc17
--- /dev/null
@@ -0,0 +1,47 @@
+From: waugh@probitas.cs.utas.edu.au (Sam Waugh)
+Message-Id: <9410100613.AA68794@probitas.cs.utas.edu.au>
+Subject: "Bug" in 0.22 -- order of magnitude slower than hbc
+To: glasgow-haskell-bugs@dcs.gla.ac.uk
+Date: Mon, 10 Oct 1994 17:13:41 +1000 (EETDT)
+
+Hi.
+
+I've come up with what you might consider to be a bug with ghc-0.22 (unless
+I've done something obviously wrong).  I wrote some code to perform a simple
+backpropagation neural network simulator (just to see how it would go), and
+I have just recompiled it using hbc version 0.999.4.  The ghc executable was
+much slower -- even when "optimised".
+
+I've included at the bottom of this message a uuencoded gzipped tar file
+(took a while to make) which includes the following documents:
+
+       *.lhs           -- actual code
+       makefile        -- makefile for ghc (hbc was compiled by producing
+                               object files and linking them together.  The
+                               optimised hbc code used -O.  The optimised
+                               ghc code was generated with the extra options
+                               in the makefile).
+       temp            -- machine and gcc compiler details.
+       compile         -- standard ghc compilation with -v
+       out.0.22        -- output from all trials
+       err.*           -- the timings of the different trials (ignore the
+                               .2 on the .999.4.2 files -- it was a second
+                               try).
+
+Hopefully that is all the files I've included and all the files you need.
+Let me know if you have any problems.
+
+On a final note -- when compiling using all the optimisations for ghc there
+were an awful lot of warnings.  Is there anyway you can get rid of these
+(like by fixing the problems)?  It might be obscuring something important.
+
+Thanks for your time.
+
+Sam.
+-- 
+Sam Waugh                              Phone: +61 02 202962
+Department of Computer Science         Fax:   +61 02 202913
+University of Tasmania                 Email: waugh@cs.utas.edu.au
+GPO Box 252C, Hobart Tasmania 7001, Australia
+
+[snip snip]
diff --git a/ghc/tests/programs/waugh_neural/Main.lhs b/ghc/tests/programs/waugh_neural/Main.lhs
new file mode 100644 (file)
index 0000000..5eed87f
--- /dev/null
@@ -0,0 +1,164 @@
+Main.hs for backprop simulation
+Written by Sam Waugh
+Date started: 10th November 1992.
+
+This main module initialises, runs and gets results from the 
+backpropagation functions and values.
+
+> import BpGen
+> import ReadLists (readWhiteList)
+> import {-fool mkdependHS-}
+>       Printf
+
+-------------------------------------------------------------------------------
+|                              Constant Values                               |
+-------------------------------------------------------------------------------
+The following constants set the training problem and parameters:
+  name         - the name of the file
+  dimensions   - the layered network topology
+  eta          - the learning rate
+  accepterr    - the level of error acceptable to stop training
+  epochs       - the maximum number of epochs in training
+
+> name         :: String
+> name         = "xor"
+> dimensions   :: Dimensions
+> dimensions   = [2,2,1]
+> eta,accepterr        :: Double
+> eta          = 1.0
+> accepterr    = 0.001
+> epochs       :: Int
+> epochs       = 10000
+
+
+-------------------------------------------------------------------------------
+|                      IO and Main Program                                   |
+-------------------------------------------------------------------------------
+
+> main = do
+>   s <- readFile name
+>   putStr (program s "")
+
+> program :: String -> ShowS
+> program s
+>   = let egs      = readegs s
+>        ws        = randweights dimensions
+>        rs        = selectegs (length egs)
+>        (ws',res) = trainweights egs ws epochs accepterr eta rs
+>     in
+>     showString "Examples:\n"
+>     . showegs egs
+>     . showString "Classification:\n"
+>     . showresults egs ws
+>     . showString "Training Error:\n"
+>     . showerr res
+>     . showString "Trained Classification:\n"
+>     . showresults egs ws'
+
+> {- ORIG:
+> program :: String -> String
+> program s
+>   = _scc_ "program" (
+>     let egs      = _scc_ "readegs" readegs s
+>        ws        = _scc_ "randweights" randweights dimensions
+>        rs        = _scc_ "selectegs" selectegs (length egs)
+>        (ws',res) = _scc_ "trainweights" trainweights egs ws epochs accepterr eta rs
+>     in "Examples:\n"
+>     ++ _scc_ "showegs" showegs egs
+>     ++ "Classification:\n"
+>     ++ _scc_ "showresults" showresults egs ws
+>     ++ "Training Error:\n"
+>     ++ _scc_ "showerr" showerr res
+>     ++ "Trained Classification:\n"
+>     ++ _scc_ "showresults2" showresults egs ws'
+>     )
+> -}
+
+-------------------------------------------------------------------------------
+|                              Show Functions                                |
+-------------------------------------------------------------------------------
+
+> showdouble :: Double -> ShowS
+> showdouble v = showString (printf "%6.4f " [UDouble v])
+
+> showdoubles :: [Double] -> ShowS
+> showdoubles []     = showString ""
+> showdoubles (v:vs) = showdouble v . showdoubles vs
+
+> showegs :: Egs -> ShowS
+> showegs [] = showString "\n"
+> showegs ((x,t):egs)
+>      = showdoubles x . showString " " . showdoubles t . showString "\n" . showegs egs
+
+> showresults :: Egs -> Weights -> ShowS
+> showresults [] _ = showString "\n"
+> showresults ((x,t):egs) ws
+>   = let y = last (classeg ws x)
+>        p = maxplace y
+>        c = maxplace t
+>     in shows p . showString "  " . showdouble (y!!p) . showString "    " .
+>        shows c . showString "  " . showdouble (t!!c) . showString "\n" . showresults egs ws
+
+> showerr :: [Double] -> ShowS
+> showerr [] = showString ""
+> showerr (x:xs) = showerr xs . showdouble x . showString "\n" 
+
+> showweights :: Weights -> ShowS
+> showweights [] = showString "\n"
+> showweights (w:ws) = showweight w . showweights ws
+
+> showweight, showl :: Weight -> ShowS
+> showweight []     = showString "[]\n"
+> showweight (x:xs) = showString "[" . showdoubles x . showl xs
+
+> showl []     = showString "]\n"
+> showl (x:xs) = showString "\n " . showdoubles x . showl xs
+
+> {- ORIG:
+> showdouble :: Double -> String
+> showdouble v = printf "%6.4f " [UDouble v]
+
+> showdoubles :: [Double] -> String
+> showdoubles []     = ""
+> showdoubles (v:vs) = showdouble v ++ showdoubles vs
+
+> showegs :: Egs -> String
+> showegs [] = "\n"
+> showegs ((x,t):egs)
+>      = (showdoubles x) ++ " " ++ (showdoubles t) ++ "\n" ++ showegs egs
+
+> showresults :: Egs -> Weights -> String
+> showresults [] _ = "\n"
+> showresults ((x,t):egs) ws
+>   = let y = last (classeg ws x)
+>        p = maxplace y
+>        c = maxplace t
+>     in show p ++ "  " ++ showdouble (y!!p) ++ "    " ++
+>        show c ++ "  " ++ showdouble (t!!c) ++ "\n"   ++ showresults egs ws
+
+> showerr :: [Double] -> String
+> showerr [] = ""
+> showerr (x:xs) = showerr xs ++ showdouble x ++ "\n" 
+
+> showweights :: Weights -> String
+> showweights [] = "\n"
+> showweights (w:ws) = showweight w ++ showweights ws
+> showweight, showl :: Weight -> String
+> showweight []     = "[]\n"
+> showweight (x:xs) = "["    ++ showdoubles x ++ showl xs
+> showl []     = "]\n"
+> showl (x:xs) = "\n " ++ showdoubles x ++ showl xs
+> -}
+
+-------------------------------------------------------------------------------
+|                      Data Reading Functions                                |
+-------------------------------------------------------------------------------
+
+> readegs :: String -> Egs
+> readegs s = readData (readWhiteList s)
+
+> readData :: [Double] -> Egs
+> readData [] = []
+> readData bs = let (inp, bs')  = splitAt (head dimensions) bs
+>                  (out, bs'') = splitAt (last dimensions) bs'
+>              in (inp,out) : (readData bs'')
diff --git a/ghc/tests/programs/waugh_neural/Makefile b/ghc/tests/programs/waugh_neural/Makefile
new file mode 100644 (file)
index 0000000..de6e7e0
--- /dev/null
@@ -0,0 +1,7 @@
+TOP = ../..
+include $(TOP)/mk/boilerplate.mk
+
+all :: runtest
+
+include $(TOP)/mk/target.mk
+
diff --git a/ghc/tests/programs/waugh_neural/ReadLists.lhs b/ghc/tests/programs/waugh_neural/ReadLists.lhs
new file mode 100644 (file)
index 0000000..5303e7a
--- /dev/null
@@ -0,0 +1,43 @@
+ReadLists
+Written by Sam Waugh
+Date Started : 10th September 1992
+Last Modified: 10th November 1992
+
+This module allows the reading of lists of values from a string
+of the one type seperated by white space.
+
+Thanks to Paul Hudak for suggestions concerning getVals.
+
+> module ReadLists (readWhiteList, readNumBools) where
+
+
+readWhiteList reads a white-spaced list from a given string
+
+> readWhiteList :: (Read a) => String -> [a]
+> readWhiteList = getVals reads
+
+
+readNumBools reads a list of white-spaced boolean values from a given
+string.  Booleans in a string are represented as 1's and 0's.
+
+> readNumBools :: String -> [Bool]
+> readNumBools = getVals readBool
+
+> readBool :: ReadS Bool
+> readBool []     = []
+> readBool (x:xs) = [(x == '1', xs)]
+
+
+getVals (base function) takes a string, s, and a reading function, readVal,
+and repeatedly applies readVal to s while removing whitespace
+
+> getVals :: ReadS a -> String -> [a]
+> getVals readVal s = case readVal (stripWhite s) of
+>                       []       -> []
+>                       (x,s'):_ -> x : getVals readVal s'
+
+
+stripWhite removes white space from the front of a string
+
+> stripWhite :: String -> String
+> stripWhite = dropWhile (`elem` " \t\n")
diff --git a/ghc/tests/programs/waugh_neural/waugh_neural.stdout b/ghc/tests/programs/waugh_neural/waugh_neural.stdout
new file mode 100644 (file)
index 0000000..9df417c
--- /dev/null
@@ -0,0 +1,1379 @@
+Examples:
+0.0000 0.0000  0.0000 
+0.0000 1.0000  1.0000 
+1.0000 0.0000  1.0000 
+1.0000 1.0000  0.0000 
+
+Classification:
+0  -0.1059     0  0.0000 
+0  0.0368     0  1.0000 
+0  0.1047     0  1.0000 
+0  0.1930     0  0.0000 
+
+Training Error:
+0.0006 
+0.0013 
+0.0012 
+0.0012 
+0.0015 
+0.0011 
+0.0013 
+0.0018 
+0.0025 
+0.0014 
+0.0017 
+0.0023 
+0.0013 
+0.0022 
+0.0020 
+0.0021 
+0.0023 
+0.0015 
+0.0012 
+0.0023 
+0.0019 
+0.0042 
+0.0031 
+0.0026 
+0.0019 
+0.0020 
+0.0039 
+0.0026 
+0.0031 
+0.0028 
+0.0023 
+0.0022 
+0.0022 
+0.0028 
+0.0027 
+0.0047 
+0.0030 
+0.0027 
+0.0046 
+0.0038 
+0.0027 
+0.0077 
+0.0034 
+0.0041 
+0.0113 
+0.0077 
+0.0156 
+0.0171 
+0.0159 
+0.0126 
+0.0094 
+0.0104 
+0.0095 
+0.0117 
+0.0151 
+0.0150 
+0.0109 
+0.0158 
+0.0136 
+0.0100 
+0.0080 
+0.0067 
+0.0063 
+0.0063 
+0.0070 
+0.0141 
+0.0087 
+0.0090 
+0.0107 
+0.0163 
+0.0127 
+0.0159 
+0.0100 
+0.0078 
+0.0136 
+0.0184 
+0.0264 
+0.0263 
+0.0165 
+0.0277 
+0.0200 
+0.0340 
+0.0156 
+0.0350 
+0.0263 
+0.0175 
+0.0300 
+0.0246 
+0.0285 
+0.0179 
+0.0348 
+0.0139 
+0.0365 
+0.0287 
+0.0216 
+0.0237 
+0.0168 
+0.0153 
+0.0384 
+0.0316 
+0.0286 
+0.0228 
+0.0261 
+0.0219 
+0.0168 
+0.0089 
+0.0098 
+0.0092 
+0.0124 
+0.0105 
+0.0160 
+0.0209 
+0.0283 
+0.0132 
+0.0139 
+0.0192 
+0.0212 
+0.0117 
+0.0120 
+0.0109 
+0.0133 
+0.0292 
+0.0230 
+0.0360 
+0.0266 
+0.0203 
+0.0161 
+0.0172 
+0.0171 
+0.0187 
+0.0377 
+0.0174 
+0.0136 
+0.0127 
+0.0136 
+0.0171 
+0.0163 
+0.0193 
+0.0099 
+0.0177 
+0.0182 
+0.0063 
+0.0092 
+0.0080 
+0.0124 
+0.0145 
+0.0107 
+0.0075 
+0.0073 
+0.0114 
+0.0071 
+0.0081 
+0.0203 
+0.0087 
+0.0114 
+0.0173 
+0.0130 
+0.0081 
+0.0217 
+0.0131 
+0.0139 
+0.0125 
+0.0275 
+0.0174 
+0.0241 
+0.0210 
+0.0123 
+0.0140 
+0.0094 
+0.0084 
+0.0137 
+0.0150 
+0.0137 
+0.0078 
+0.0138 
+0.0078 
+0.0092 
+0.0090 
+0.0090 
+0.0080 
+0.0186 
+0.0081 
+0.0074 
+0.0125 
+0.0306 
+0.0278 
+0.0241 
+0.0451 
+0.0218 
+0.0224 
+0.0605 
+0.0442 
+0.0214 
+0.0072 
+0.0086 
+0.0124 
+0.0130 
+0.0075 
+0.0081 
+0.0069 
+0.0198 
+0.0073 
+0.0114 
+0.0078 
+0.0239 
+0.0125 
+0.0164 
+0.0082 
+0.0075 
+0.0061 
+0.0052 
+0.0136 
+0.0071 
+0.0105 
+0.0137 
+0.0062 
+0.0065 
+0.0128 
+0.0145 
+0.0102 
+0.0064 
+0.0113 
+0.0090 
+0.0107 
+0.0066 
+0.0069 
+0.0052 
+0.0054 
+0.0051 
+0.0113 
+0.0163 
+0.0238 
+0.0115 
+0.0091 
+0.0094 
+0.0094 
+0.0107 
+0.0243 
+0.0206 
+0.0160 
+0.0134 
+0.0132 
+0.0158 
+0.0202 
+0.0291 
+0.0289 
+0.0155 
+0.0206 
+0.0256 
+0.0123 
+0.0153 
+0.0339 
+0.0148 
+0.0360 
+0.0188 
+0.0230 
+0.0388 
+0.0203 
+0.0263 
+0.0179 
+0.0406 
+0.0174 
+0.0163 
+0.0295 
+0.0180 
+0.0356 
+0.0290 
+0.0328 
+0.0419 
+0.0259 
+0.0170 
+0.0198 
+0.0317 
+0.0296 
+0.0452 
+0.0356 
+0.0396 
+0.0251 
+0.0250 
+0.0156 
+0.0286 
+0.0288 
+0.0320 
+0.0232 
+0.0309 
+0.0199 
+0.0365 
+0.0251 
+0.0210 
+0.0362 
+0.0262 
+0.0460 
+0.0453 
+0.0319 
+0.0144 
+0.0257 
+0.0434 
+0.0281 
+0.0432 
+0.0296 
+0.0212 
+0.0292 
+0.0191 
+0.0152 
+0.0235 
+0.0090 
+0.0251 
+0.0153 
+0.0462 
+0.0317 
+0.0218 
+0.0133 
+0.0202 
+0.0421 
+0.0151 
+0.0277 
+0.0136 
+0.0213 
+0.0351 
+0.0287 
+0.0296 
+0.0377 
+0.0419 
+0.0238 
+0.0305 
+0.0285 
+0.0184 
+0.0147 
+0.0292 
+0.0249 
+0.0228 
+0.0314 
+0.0336 
+0.0472 
+0.0721 
+0.0395 
+0.0469 
+0.0238 
+0.0322 
+0.0150 
+0.0125 
+0.0267 
+0.0253 
+0.0177 
+0.0100 
+0.0177 
+0.0246 
+0.0135 
+0.0174 
+0.0122 
+0.0222 
+0.0165 
+0.0214 
+0.0313 
+0.0299 
+0.0172 
+0.0273 
+0.0197 
+0.0261 
+0.0266 
+0.0191 
+0.0272 
+0.0139 
+0.0185 
+0.0132 
+0.0164 
+0.0178 
+0.0179 
+0.0237 
+0.0335 
+0.0205 
+0.0316 
+0.0345 
+0.0643 
+0.0431 
+0.0894 
+0.0560 
+0.0509 
+0.1541 
+0.0750 
+0.0944 
+0.0815 
+0.1373 
+0.0743 
+0.1324 
+0.0990 
+0.1165 
+0.2020 
+0.1822 
+0.3030 
+0.2503 
+0.1155 
+0.3019 
+0.2439 
+0.4729 
+0.1733 
+0.1518 
+0.3804 
+0.1371 
+0.1534 
+0.4186 
+0.2648 
+0.1183 
+0.3230 
+0.2882 
+0.2370 
+0.2439 
+0.1663 
+0.0973 
+0.1101 
+0.2022 
+0.0969 
+0.1587 
+0.0838 
+0.1114 
+0.0676 
+0.1860 
+0.1772 
+0.0820 
+0.0949 
+0.0887 
+0.2098 
+0.0934 
+0.0965 
+0.1262 
+0.0529 
+0.0849 
+0.1050 
+0.0565 
+0.1413 
+0.1486 
+0.1968 
+0.1590 
+0.1195 
+0.1178 
+0.1361 
+0.0793 
+0.2035 
+0.0685 
+0.0888 
+0.0676 
+0.0484 
+0.0430 
+0.0492 
+0.0444 
+0.0696 
+0.0338 
+0.0754 
+0.0768 
+0.0535 
+0.0455 
+0.0331 
+0.0330 
+0.0310 
+0.0343 
+0.0364 
+0.0649 
+0.0419 
+0.0309 
+0.0633 
+0.0419 
+0.0528 
+0.0311 
+0.0421 
+0.0453 
+0.0227 
+0.0259 
+0.0613 
+0.0408 
+0.0224 
+0.0115 
+0.0247 
+0.0109 
+0.0161 
+0.0168 
+0.0104 
+0.0185 
+0.0193 
+0.0067 
+0.0069 
+0.0081 
+0.0077 
+0.0101 
+0.0109 
+0.0182 
+0.0113 
+0.0232 
+0.0111 
+0.0102 
+0.0139 
+0.0115 
+0.0189 
+0.0151 
+0.0203 
+0.0115 
+0.0217 
+0.0189 
+0.0243 
+0.0369 
+0.0417 
+0.0471 
+0.0645 
+0.0411 
+0.0549 
+0.0196 
+0.0393 
+0.0298 
+0.0125 
+0.0093 
+0.0218 
+0.0116 
+0.0118 
+0.0147 
+0.0116 
+0.0210 
+0.0179 
+0.0348 
+0.0198 
+0.0119 
+0.0106 
+0.0101 
+0.0149 
+0.0335 
+0.0257 
+0.0249 
+0.0284 
+0.0340 
+0.0794 
+0.1231 
+0.0752 
+0.1574 
+0.0589 
+0.1023 
+0.1208 
+0.1316 
+0.0805 
+0.0667 
+0.0898 
+0.1548 
+0.1017 
+0.1279 
+0.0981 
+0.1481 
+0.1220 
+0.1387 
+0.2427 
+0.3398 
+0.2162 
+0.2501 
+0.1538 
+0.1318 
+0.0558 
+0.0853 
+0.1432 
+0.1571 
+0.0789 
+0.0717 
+0.0585 
+0.0543 
+0.0529 
+0.1346 
+0.0512 
+0.0431 
+0.0462 
+0.0767 
+0.0596 
+0.0914 
+0.0345 
+0.0331 
+0.0451 
+0.0491 
+0.0318 
+0.0335 
+0.0410 
+0.0354 
+0.0879 
+0.0471 
+0.0492 
+0.0497 
+0.0848 
+0.0490 
+0.0592 
+0.0423 
+0.0585 
+0.0426 
+0.0258 
+0.0402 
+0.0188 
+0.0197 
+0.0195 
+0.0241 
+0.0264 
+0.0408 
+0.0226 
+0.0344 
+0.0188 
+0.0364 
+0.0431 
+0.0198 
+0.0282 
+0.0243 
+0.0521 
+0.0483 
+0.0292 
+0.0342 
+0.0653 
+0.0286 
+0.0381 
+0.0274 
+0.0525 
+0.0661 
+0.0286 
+0.0666 
+0.0384 
+0.0285 
+0.0217 
+0.0405 
+0.0443 
+0.0303 
+0.0601 
+0.0370 
+0.0232 
+0.0259 
+0.0274 
+0.0295 
+0.0694 
+0.0371 
+0.0323 
+0.0515 
+0.0687 
+0.0305 
+0.0508 
+0.0402 
+0.0428 
+0.0922 
+0.0459 
+0.1083 
+0.1454 
+0.1593 
+0.1142 
+0.0774 
+0.1408 
+0.1267 
+0.1318 
+0.0634 
+0.0862 
+0.1191 
+0.0954 
+0.0965 
+0.0734 
+0.0700 
+0.0778 
+0.0901 
+0.0614 
+0.1199 
+0.0618 
+0.0505 
+0.0697 
+0.0410 
+0.0572 
+0.1019 
+0.0856 
+0.0771 
+0.0908 
+0.0332 
+0.0674 
+0.0483 
+0.0339 
+0.0309 
+0.0308 
+0.0443 
+0.0467 
+0.0714 
+0.0540 
+0.0408 
+0.0450 
+0.0482 
+0.0558 
+0.0683 
+0.0407 
+0.0375 
+0.0416 
+0.0891 
+0.0968 
+0.0586 
+0.1387 
+0.0728 
+0.0705 
+0.0565 
+0.1113 
+0.0723 
+0.1056 
+0.0658 
+0.0625 
+0.0344 
+0.0468 
+0.0392 
+0.0317 
+0.0265 
+0.0360 
+0.0338 
+0.0308 
+0.0727 
+0.0286 
+0.0522 
+0.0405 
+0.0375 
+0.0257 
+0.0249 
+0.0346 
+0.0191 
+0.0286 
+0.0311 
+0.0283 
+0.0407 
+0.0275 
+0.0750 
+0.0911 
+0.0425 
+0.0362 
+0.0591 
+0.0270 
+0.0290 
+0.0338 
+0.0592 
+0.0350 
+0.0552 
+0.0564 
+0.0446 
+0.0558 
+0.0369 
+0.0497 
+0.0650 
+0.0433 
+0.0420 
+0.0434 
+0.0546 
+0.0415 
+0.0394 
+0.0488 
+0.0695 
+0.0372 
+0.0458 
+0.0385 
+0.0337 
+0.0354 
+0.0324 
+0.0575 
+0.0505 
+0.0566 
+0.1589 
+0.1263 
+0.1118 
+0.2126 
+0.2967 
+0.2778 
+0.2609 
+0.6322 
+0.7693 
+0.5429 
+0.1965 
+0.3751 
+0.3611 
+0.2222 
+0.2763 
+0.2273 
+0.3213 
+0.2207 
+0.2181 
+0.1717 
+0.1765 
+0.3055 
+0.2081 
+0.2476 
+0.2661 
+0.1559 
+0.1006 
+0.1233 
+0.1502 
+0.1001 
+0.1113 
+0.1471 
+0.1477 
+0.0594 
+0.1124 
+0.0564 
+0.0538 
+0.0451 
+0.0435 
+0.0558 
+0.0365 
+0.0820 
+0.0432 
+0.0735 
+0.0375 
+0.0851 
+0.0587 
+0.1136 
+0.0859 
+0.1611 
+0.0959 
+0.1569 
+0.1321 
+0.0898 
+0.0977 
+0.1466 
+0.1692 
+0.0777 
+0.1352 
+0.0826 
+0.0442 
+0.0398 
+0.0639 
+0.0494 
+0.0545 
+0.0318 
+0.0795 
+0.0540 
+0.0687 
+0.0597 
+0.0709 
+0.0997 
+0.0884 
+0.1047 
+0.1659 
+0.1014 
+0.1369 
+0.1411 
+0.0814 
+0.0963 
+0.0805 
+0.0774 
+0.1477 
+0.0741 
+0.0723 
+0.1459 
+0.0819 
+0.0615 
+0.0622 
+0.0539 
+0.0547 
+0.0599 
+0.0635 
+0.1005 
+0.0703 
+0.0717 
+0.0415 
+0.0654 
+0.0331 
+0.0417 
+0.1216 
+0.0763 
+0.0705 
+0.0923 
+0.0792 
+0.0829 
+0.0462 
+0.0870 
+0.1555 
+0.1023 
+0.1440 
+0.0655 
+0.1040 
+0.2320 
+0.0897 
+0.0833 
+0.0592 
+0.0559 
+0.0569 
+0.0643 
+0.0807 
+0.0862 
+0.0502 
+0.0679 
+0.0652 
+0.0575 
+0.0557 
+0.0711 
+0.1001 
+0.0551 
+0.0560 
+0.0537 
+0.0539 
+0.0600 
+0.0759 
+0.1523 
+0.1705 
+0.1183 
+0.1832 
+0.2640 
+0.1693 
+0.1337 
+0.2807 
+0.8807 
+1.0110 
+1.1298 
+0.8362 
+0.3536 
+0.2293 
+0.0994 
+0.1356 
+0.1334 
+0.2120 
+0.0832 
+0.1290 
+0.0884 
+0.1778 
+0.1456 
+0.1121 
+0.1612 
+0.0711 
+0.1206 
+0.1081 
+0.0507 
+0.0819 
+0.0771 
+0.0783 
+0.0783 
+0.0560 
+0.1450 
+0.2208 
+0.0846 
+0.2032 
+0.1537 
+0.1352 
+0.2858 
+0.3946 
+0.3023 
+0.4804 
+0.3720 
+0.3830 
+0.4174 
+0.3898 
+0.6058 
+0.3161 
+0.2903 
+0.2651 
+0.1544 
+0.4088 
+0.2355 
+0.2825 
+0.4602 
+0.2062 
+0.1985 
+0.1613 
+0.1495 
+0.1726 
+0.3099 
+0.1895 
+0.1237 
+0.1268 
+0.1344 
+0.1068 
+0.1129 
+0.0869 
+0.0912 
+0.0926 
+0.0905 
+0.1214 
+0.0649 
+0.0876 
+0.1203 
+0.1225 
+0.1146 
+0.1131 
+0.1489 
+0.1334 
+0.1083 
+0.0903 
+0.0981 
+0.3364 
+0.2867 
+0.3913 
+0.3200 
+0.3584 
+0.2114 
+0.1862 
+0.1882 
+0.1458 
+0.1275 
+0.2299 
+0.2936 
+0.3161 
+0.3604 
+0.1345 
+0.2309 
+0.2310 
+0.3559 
+0.3741 
+0.3841 
+0.1600 
+0.3186 
+0.1768 
+0.1374 
+0.1833 
+0.1551 
+0.1107 
+0.0685 
+0.1061 
+0.0834 
+0.0876 
+0.0769 
+0.1060 
+0.1000 
+0.0803 
+0.2304 
+0.1964 
+0.3363 
+0.1922 
+0.2041 
+0.1679 
+0.1237 
+0.0920 
+0.1977 
+0.3451 
+0.2789 
+0.2462 
+0.2204 
+0.2798 
+0.3526 
+0.2780 
+0.5861 
+0.3788 
+0.6887 
+0.4506 
+0.3664 
+0.2358 
+0.0767 
+0.2181 
+0.2429 
+0.2658 
+0.3366 
+0.1841 
+0.1113 
+0.0914 
+0.0824 
+0.0719 
+0.1407 
+0.0824 
+0.1721 
+0.1516 
+0.1562 
+0.1351 
+0.1235 
+0.1095 
+0.0962 
+0.1015 
+0.0892 
+0.1545 
+0.1909 
+0.4212 
+0.4129 
+0.3782 
+0.3431 
+0.3330 
+0.2739 
+0.3242 
+0.2353 
+0.2348 
+0.3102 
+0.3587 
+0.5124 
+0.3840 
+0.4732 
+0.4399 
+0.2119 
+0.1322 
+0.1233 
+0.1316 
+0.1150 
+0.0998 
+0.1800 
+0.1273 
+0.2833 
+0.1345 
+0.1112 
+0.1187 
+0.1175 
+0.1231 
+0.4920 
+0.6189 
+0.2811 
+0.2768 
+0.3276 
+0.2768 
+0.4092 
+0.3237 
+0.5175 
+0.3444 
+0.2286 
+0.3363 
+0.2437 
+0.2369 
+0.3936 
+0.2882 
+0.1668 
+0.2125 
+0.1564 
+0.2847 
+0.3474 
+0.3749 
+0.2152 
+0.4767 
+0.3737 
+0.2519 
+0.1675 
+0.1980 
+0.1459 
+0.1549 
+0.1512 
+0.1498 
+0.2775 
+0.3663 
+0.2599 
+0.3337 
+0.1786 
+0.7095 
+0.4253 
+0.2590 
+0.2128 
+0.3139 
+0.4042 
+0.3455 
+0.8963 
+0.5630 
+0.6491 
+0.3273 
+0.5495 
+0.7103 
+0.3689 
+0.3517 
+0.2506 
+0.2394 
+0.2563 
+0.2178 
+0.3305 
+0.2091 
+0.2713 
+0.9382 
+0.4809 
+0.3457 
+0.3757 
+0.3567 
+0.3623 
+0.7483 
+0.2758 
+0.3359 
+0.4226 
+0.4436 
+0.5415 
+0.7246 
+0.5840 
+0.5240 
+0.4820 
+0.4918 
+0.3472 
+0.4292 
+0.2638 
+0.8652 
+0.6386 
+0.2970 
+0.2482 
+0.3634 
+0.5364 
+0.3266 
+0.2738 
+0.3561 
+0.2874 
+0.2952 
+0.3432 
+0.5600 
+0.4412 
+0.7108 
+0.5172 
+1.1662 
+1.0235 
+0.5857 
+0.9115 
+0.8491 
+0.6621 
+0.3065 
+0.4287 
+0.4757 
+0.5191 
+0.3534 
+0.4221 
+0.4662 
+0.3410 
+0.4524 
+0.7814 
+0.4169 
+0.4127 
+0.3937 
+0.5450 
+0.3860 
+0.3942 
+0.4960 
+0.4516 
+0.5248 
+0.4116 
+0.4200 
+0.4214 
+0.5984 
+0.5791 
+0.5775 
+0.6311 
+0.6828 
+1.0524 
+1.0729 
+0.7104 
+0.7662 
+0.5090 
+0.6262 
+0.5004 
+0.8285 
+0.5389 
+0.6671 
+0.7463 
+0.6655 
+0.8002 
+1.0429 
+1.1349 
+0.5813 
+0.5798 
+0.6674 
+0.7338 
+1.0065 
+0.8124 
+0.6703 
+0.6968 
+0.6548 
+0.7707 
+0.6928 
+0.6606 
+0.7861 
+0.7466 
+0.7467 
+0.9788 
+0.7896 
+0.8128 
+0.8151 
+0.8171 
+1.1193 
+1.0804 
+1.0764 
+0.8801 
+0.9400 
+1.0559 
+0.8107 
+0.8610 
+0.8641 
+0.8087 
+0.8159 
+0.8625 
+0.9505 
+0.9631 
+0.9564 
+0.8354 
+0.8608 
+0.9085 
+0.8384 
+1.0629 
+0.8835 
+0.8643 
+0.9080 
+0.9002 
+1.0846 
+0.9661 
+0.9995 
+1.0096 
+1.0039 
+1.0839 
+0.9100 
+1.0386 
+1.2184 
+1.1378 
+0.8842 
+1.0651 
+0.8931 
+0.9578 
+1.0597 
+0.8947 
+0.9176 
+0.9138 
+0.9297 
+1.0663 
+0.9131 
+1.0254 
+1.1214 
+1.0609 
+0.9520 
+1.0866 
+1.0985 
+0.9468 
+0.9588 
+0.9661 
+1.0548 
+1.0921 
+1.1088 
+1.1045 
+1.1313 
+0.9873 
+1.1151 
+1.1237 
+0.9889 
+1.0286 
+1.0728 
+1.1691 
+1.0330 
+1.0835 
+1.1305 
+0.9608 
+1.1476 
+1.0012 
+1.0972 
+1.1373 
+1.0784 
+1.0679 
+1.0392 
+1.1016 
+0.9909 
+1.0779 
+0.9820 
+1.0325 
+1.0863 
+1.1063 
+0.9852 
+1.5432 
+1.0038 
+1.0676 
+0.9857 
+1.1375 
+1.0446 
+1.1342 
+1.1891 
+0.9901 
+1.1802 
+1.1556 
+0.9927 
+1.0766 
+1.1414 
+1.0948 
+1.1492 
+0.9973 
+1.1168 
+1.1166 
+1.0655 
+1.0620 
+1.0904 
+1.0921 
+1.0157 
+1.2459 
+1.3257 
+1.0308 
+1.1034 
+1.0122 
+0.9948 
+1.2459 
+1.3062 
+1.3424 
+Trained Classification:
+0  -0.0001     0  0.0000 
+0  1.0000     0  1.0000 
+0  1.0006     0  1.0000 
+0  0.0002     0  0.0000 
+
diff --git a/ghc/tests/programs/waugh_neural/xor b/ghc/tests/programs/waugh_neural/xor
new file mode 100644 (file)
index 0000000..c829d52
--- /dev/null
@@ -0,0 +1,4 @@
+0.0 0.0  0.0
+0.0 1.0  1.0
+1.0 0.0  1.0
+1.0 1.0  0.0
diff --git a/ghc/tests/programs/zhang_ccall/MAIL b/ghc/tests/programs/zhang_ccall/MAIL
new file mode 100644 (file)
index 0000000..5592db0
--- /dev/null
@@ -0,0 +1,41 @@
+From: Xiaoming Zhang <X.M.Zhang@uk.ac.swansea>
+Date: Thu, 26 May 94 16:48:44 BST
+Message-Id: <1276.9405261548@csterra.swan.ac.uk>
+To: partain@uk.ac.glasgow.dcs
+Subject: ghc
+
+Hi Will,
+
+Have you got any update for ghc 0.20 recently?  The problem
+I am experiencing is that I cannot receive values from C
+subroutines.  The included program highlights the problem.
+The Haskell program gets a 0 instead of 1.  Any comment?
+By the way, is these any work going on over there in running
+Haskell on PVM?
+
+Regards,
+
+Xiaoming
+
+-----------------------
+
+Haskell program:
+
+module Main where
+
+import PreludePrimIO
+
+main =
+       appendChan stdout (shows res "\n")
+       exit done
+       where
+       res = unsafePerformPrimIO (
+               ca `thenPrimIO` \r -> returnPrimIO r)
+       ca :: PrimIO Float
+       ca = _ccall_ nn
+
+C subroutine:
+
+float nn () {return 1;}
+
+--------------------
diff --git a/ghc/tests/programs/zhang_ccall/Main.hs b/ghc/tests/programs/zhang_ccall/Main.hs
new file mode 100644 (file)
index 0000000..1f6de0d
--- /dev/null
@@ -0,0 +1,10 @@
+module Main where
+
+import STBase
+
+main = putStr (shows res "\n")
+       where
+       res = unsafePerformPrimIO (
+               ca `thenPrimIO` \r -> returnPrimIO r)
+       ca :: PrimIO Float
+       ca = _ccall_ nn
diff --git a/ghc/tests/programs/zhang_ccall/Makefile b/ghc/tests/programs/zhang_ccall/Makefile
new file mode 100644 (file)
index 0000000..5b9af21
--- /dev/null
@@ -0,0 +1,9 @@
+TOP = ../..
+include $(TOP)/mk/boilerplate.mk
+
+SRC_HC_OPTS += -fglasgow-exts
+
+all :: runtest
+
+include $(TOP)/mk/target.mk
+
diff --git a/ghc/tests/programs/zhang_ccall/ccall.c b/ghc/tests/programs/zhang_ccall/ccall.c
new file mode 100644 (file)
index 0000000..3602fe2
--- /dev/null
@@ -0,0 +1 @@
+float nn () {return 1;}
diff --git a/ghc/tests/programs/zhang_ccall/zhang_ccall.stdout b/ghc/tests/programs/zhang_ccall/zhang_ccall.stdout
new file mode 100644 (file)
index 0000000..d3827e7
--- /dev/null
@@ -0,0 +1 @@
+1.0